Index: trunk/NEMOGCM/ARCH/arch-ALTIX_NAUTILUS.fcm
===================================================================
--- trunk/NEMOGCM/ARCH/arch-ALTIX_NAUTILUS.fcm	(revision 2528)
+++ trunk/NEMOGCM/ARCH/arch-ALTIX_NAUTILUS.fcm	(revision 2528)
@@ -0,0 +1,33 @@
+# ifort compiler options for NOCS ALTIX cluster nautilus
+# NCDF_INC    netcdf include file
+# NCDF_LIB    netcdf library
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make
+# USER_INC    additional include files for the compiler,  e.g. -I<include dir>
+# USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
+
+
+%NCDF_INC            -I/sw/packages/netcdf/3.6.2/x86_64/include
+%NCDF_LIB            -L/sw/packages/netcdf/3.6.2/x86_64/lib -lnetcdf
+%FC                  mpif90
+%FCFLAGS             -r8 -O3 -xT -ip -vec-report0
+%FFLAGS              -r8 -O3 -xT -ip -vec-report0
+%LD                  mpif90
+%FPPFLAGS            -P -C -traditional
+%LDFLAGS
+%AR                  ar 
+%ARFLAGS             -r
+%MK                  gmake
+%USER_INC            %NCDF_INC
+%USER_LIB            %NCDF_LIB
+
+# - if debugging use these flags
+#FCFLAGS             -g -traceback -r8 -O0 -xT -ip -vec-report0
+#FFLAGS              -g -traceback -r8 -O0 -xT -ip -vec-report0
Index: trunk/NEMOGCM/ARCH/arch-ALTIX_NAUTILUS4.fcm
===================================================================
--- trunk/NEMOGCM/ARCH/arch-ALTIX_NAUTILUS4.fcm	(revision 2528)
+++ trunk/NEMOGCM/ARCH/arch-ALTIX_NAUTILUS4.fcm	(revision 2528)
@@ -0,0 +1,38 @@
+# ifort compiler options for NOCS ALTIX cluster nautilus using NetCDF4 libraries
+# NCDF_HOME   root directory containing lib and include subdirectories for netcdf4
+# HDF5_HOME   root directory containing lib and include subdirectories for HDF5
+# NCDF_INC    netcdf include file
+# NCDF_LIB    netcdf library
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make
+# USER_INC    additional include files for the compiler,  e.g. -I<include dir>
+# USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
+
+
+%NCDF_HOME           /noc/users/jeff/packages/netcdf4/netcdf-4.1.1/x86_64/intel10.1
+%HDF5_HOME           /noc/users/jeff/packages/hdf5/hdf5-1.8.4-patch1/x86_64/intel10.1
+%NCDF_INC            -I%NCDF_HOME/include -I%HDF5_HOME/include
+# Note use of -Bstatic because the library root directories are not accessible to the back-end compute nodes
+%NCDF_LIB            -L%HDF5_HOME/lib -L%NCDF_HOME/lib -Bstatic -lnetcdf -lhdf5_fortran -lhdf5_hl -lhdf5 -Bdynamic -lz
+%FC                  mpif90
+%FCFLAGS             -r8 -O3 -xT -ip -vec-report0
+%FFLAGS              -r8 -O3 -xT -ip -vec-report0
+%LD                  mpif90
+%FPPFLAGS            -P -C -traditional
+%LDFLAGS
+%AR                  ar 
+%ARFLAGS             -r
+%MK                  gmake
+%USER_INC            %NCDF_INC
+%USER_LIB            %NCDF_LIB
+
+# - if debugging use these flags
+#FCFLAGS             -g -traceback -r8 -O0 -xT -ip -vec-report0
+#FFLAGS              -g -traceback -r8 -O0 -xT -ip -vec-report0
Index: trunk/NEMOGCM/ARCH/arch-BG_BABEL.fcm
===================================================================
--- trunk/NEMOGCM/ARCH/arch-BG_BABEL.fcm	(revision 2528)
+++ trunk/NEMOGCM/ARCH/arch-BG_BABEL.fcm	(revision 2528)
@@ -0,0 +1,29 @@
+# babel IBM BlueGene/P at french IDRIS, http://www.idris.fr/su/Scalaire/babel
+# NCDF_INC    netcdf include file
+# NCDF_LIB    netcdf library
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make  
+# USER_INC    additional include files for the compiler,  e.g. -I<include dir> 
+# USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
+
+
+%NCDF_INC            -I/bglocal/prod/tools_ibm/netcdf-3.6.1/includ
+%NCDF_LIB            -L/bglocal/prod/tools_ibm/netcdf-3.6.1/lib -lnetcdf
+%FC                  mpxlf90_r
+%FCFLAGS             -qfree=f90 -O3 -qrealsize=8 -qextname -qsource -q64 -qlargepage -qmaxmem=-1 -qsource
+%FFLAGS              -qfixed -O3 -qrealsize=8 -qextname -qsource -q64 -qlargepage -qmaxmem=-1 -qsource
+%LD                  mpxlf90_r
+%LDFLAGS    
+%FPPFLAGS            -P -C
+%AR                  ar  
+%ARFLAGS             rs
+%MK                  gmake 
+%USER_INC            %NCDF_INC
+%USER_LIB            %NCDF_LIB 
Index: trunk/NEMOGCM/ARCH/arch-IA64_PLATINE.fcm
===================================================================
--- trunk/NEMOGCM/ARCH/arch-IA64_PLATINE.fcm	(revision 2528)
+++ trunk/NEMOGCM/ARCH/arch-IA64_PLATINE.fcm	(revision 2528)
@@ -0,0 +1,29 @@
+# platine BULL cluster at french CCRT, http://www-ccrt.cea.fr/fr/moyen_de_calcul/platine.htm
+# NCDF_INC    netcdf include file
+# NCDF_LIB    netcdf library
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make
+# USER_INC    additional include files for the compiler,  e.g. -I<include dir>
+# USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
+
+
+%NCDF_INC        -I/usr/include 
+%NCDF_LIB        -L usr/lib -lnetcdf -lnetcdff
+%FC              mpif90
+%FCFLAGS         -i4 -r8 -automatic -align all -I/opt/mpi/current/include
+%FFLAGS          %FCFLAGS
+%LD              mpif90
+%LDFLAGS
+%FPPFLAGS        -P -C -traditional
+%AR              ar
+%ARFLAGS         rs
+%MK              gmake
+%USER_INC        %NCDF_INC
+%USER_LIB        %NCDF_LIB
Index: trunk/NEMOGCM/ARCH/arch-PW6MONO_VARGAS.fcm
===================================================================
--- trunk/NEMOGCM/ARCH/arch-PW6MONO_VARGAS.fcm	(revision 2528)
+++ trunk/NEMOGCM/ARCH/arch-PW6MONO_VARGAS.fcm	(revision 2528)
@@ -0,0 +1,29 @@
+# vargas IBM POWER6 (monoprocessor for tools) at french IDRIS, http://www.idris.fr/su/Scalaire/vargas/hw-vargas.html
+# NCDF_INC    netcdf include file
+# NCDF_LIB    netcdf library
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make  
+# USER_INC    additional include files for the compiler,  e.g. -I<include dir> 
+# USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
+
+
+%NCDF_INC            -I/usr/local/pub/NetCDF/3.6.2/include
+%NCDF_LIB            -L /usr/local/pub/NetCDF/3.6.2/lib -lnetcdf
+%FC                  xlf90_r
+%FCFLAGS             -qfree=f90 -O3 -qrealsize=8 -qextname -qsource -q64 -qlargepage -qmaxmem=-1 -qsource
+%FFLAGS              -qfixed -O3 -qrealsize=8 -qextname -qsource -q64 -qlargepage -qmaxmem=-1 -qsource
+%LD                  xlf90_r
+%LDFLAGS    
+%FPPFLAGS            -P -C
+%AR                  ar  
+%ARFLAGS             rs
+%MK                  gmake 
+%USER_INC            %NCDF_INC
+%USER_LIB            %NCDF_LIB 
Index: trunk/NEMOGCM/ARCH/arch-PW6_VARGAS.fcm
===================================================================
--- trunk/NEMOGCM/ARCH/arch-PW6_VARGAS.fcm	(revision 2528)
+++ trunk/NEMOGCM/ARCH/arch-PW6_VARGAS.fcm	(revision 2528)
@@ -0,0 +1,29 @@
+# vargas IBM POWER6 at french IDRIS, http://www.idris.fr/su/Scalaire/vargas/hw-vargas.html
+# NCDF_INC    netcdf include file
+# NCDF_LIB    netcdf library
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make  
+# USER_INC    additional include files for the compiler,  e.g. -I<include dir> 
+# USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
+
+
+%NCDF_INC            -I/usr/local/pub/NetCDF/3.6.2/include
+%NCDF_LIB            -L /usr/local/pub/NetCDF/3.6.2/lib -lnetcdf
+%FC                  mpxlf90_r
+%FCFLAGS             -qfree=f90 -O3 -qrealsize=8 -qextname -qsource -q64 -qlargepage -qmaxmem=-1 -qsource
+%FFLAGS              -qfixed -O3 -qrealsize=8 -qextname -qsource -q64 -qlargepage -qmaxmem=-1 -qsource
+%LD                  mpxlf90_r
+%LDFLAGS    
+%FPPFLAGS            -P -C
+%AR                  ar  
+%ARFLAGS             rs
+%MK                  gmake 
+%USER_INC            %NCDF_INC
+%USER_LIB            %NCDF_LIB 
Index: trunk/NEMOGCM/ARCH/arch-SX8_BRODIE.fcm
===================================================================
--- trunk/NEMOGCM/ARCH/arch-SX8_BRODIE.fcm	(revision 2528)
+++ trunk/NEMOGCM/ARCH/arch-SX8_BRODIE.fcm	(revision 2528)
@@ -0,0 +1,29 @@
+# brodie NEC SX-8 at french IDRIS, http://www.idris.fr/su/Vectoriel/brodie/hw-brodie.html
+# NCDF_INC    netcdf include file
+# NCDF_LIB    netcdf library
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make
+# USER_INC    additional include files for the compiler,  e.g. -I<include dir>
+# USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
+
+
+%NCDF_INC           -I/SXlocal/pub/netCDF/netCDF-3.6.1/include
+%NCDF_LIB           -L/SXlocal/pub/netCDF/netCDF-3.6.1/lib -lnetcdf
+%FC                 sxmpif90
+%FCFLAGS            -f2003 nocbind -dW -Wf,"-A idbl4",-ptr byte -sx8 -C vopt -Wf"-init stack=nan" -Wl"-f nan" -Wf"-P nh -O overlap" -Wf,-pvctl noassume loopcnt=10000  -Wf"-init heap=zero" -R2
+%FFLAGS             %FCFLAGS
+%LD                 sxmpif90
+%LDFLAGS
+%FPPFLAGS           -P -C -traditional
+%AR                 sxar
+%ARFLAGS            rs 
+%MK                 sxgmake
+%USER_INC           %NCDF_INC
+%USER_LIB           %NCDF_LIB 
Index: trunk/NEMOGCM/ARCH/arch-SX8_MERCURE.fcm
===================================================================
--- trunk/NEMOGCM/ARCH/arch-SX8_MERCURE.fcm	(revision 2528)
+++ trunk/NEMOGCM/ARCH/arch-SX8_MERCURE.fcm	(revision 2528)
@@ -0,0 +1,30 @@
+# mercure NEC SX-8 at french CCRT, http://www-ccrt.cea.fr/fr/moyen_de_calcul/mercure.htm
+# NCDF_INC    netcdf include file
+# NCDF_LIB    netcdf library
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make
+# USER_INC    additional include files for the compiler,  e.g. -I<include dir>
+# USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
+
+
+%NCDF_INC        -I/ccc/applications/sx8/netcdf-3.6.1/include
+%NCDF_LIB        -L/ccc/applications/sx8/netcdf-3.6.1/lib -lnetcdf
+%FC              sxmpif90
+%FCFLAGS         -f2003 nocbind -size_t64 -dW -Wf,"-A idbl4", -sx8 -C vopt -P stack -Wf"-init stack=nan" -Wl"-f nan" -Wf"-P nh -O overlap" -Wf"-P nh" -Wf,-pvctl noassume loopcnt=10000 shape=10000000 -R2
+%FFLAGS          %FCFLAGS
+%LD              sxmpif90
+%LDFLAGS         -size_t64
+%FPPFLAGS        -P -C -traditional
+%AR              sxar
+%ARFLAGS         rs
+%MK              sxgmake
+%USER_INC        %NCDF_INC
+%USER_LIB        %NCDF_LIB
+
Index: trunk/NEMOGCM/ARCH/arch-SX9_ES2.fcm
===================================================================
--- trunk/NEMOGCM/ARCH/arch-SX9_ES2.fcm	(revision 2528)
+++ trunk/NEMOGCM/ARCH/arch-SX9_ES2.fcm	(revision 2528)
@@ -0,0 +1,30 @@
+# Earth Simulator 2, NEC SX-9, http://www.jamstec.go.jp/esc/index.en.html
+# NCDF_INC    netcdf include file
+# NCDF_LIB    netcdf library
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make
+# USER_INC    additional include files for the compiler,  e.g. -I<include dir>
+# USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
+
+
+%NCDF_INC        -I/SX/usr/include
+%NCDF_LIB        -L/SX/usr/lib -lnetcdf
+%FC              sxmpif90
+%FCFLAGS         -f2003 nocbind -P stack -dW -Wf,-pvctl res=whole,-A idbl4,-ptr byte -EP -R5 -float0 -size_t64 -dw -Wf,"-pvctl loopcnt=999999 fullmsg noassume"  -Wf"-init heap=zero" -R2
+%FFLAGS          %FCFLAGS
+%LD              sxmpif90
+%LDFLAGS
+%FPPFLAGS        -P -C -traditional
+%AR              sxar
+%ARFLAGS         rs
+%MK              gmake
+%USER_INC        %NCDF_INC
+%USER_LIB        %NCDF_LIB
+
Index: trunk/NEMOGCM/ARCH/arch-SX9_MERCURE.fcm
===================================================================
--- trunk/NEMOGCM/ARCH/arch-SX9_MERCURE.fcm	(revision 2528)
+++ trunk/NEMOGCM/ARCH/arch-SX9_MERCURE.fcm	(revision 2528)
@@ -0,0 +1,30 @@
+# mercure NEC SX-9 at french CCRT, http://www-ccrt.cea.fr/fr/moyen_de_calcul/mercure.htm
+# NCDF_INC    netcdf include file
+# NCDF_LIB    netcdf library
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make
+# USER_INC    additional include files for the compiler,  e.g. -I<include dir>
+# USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
+
+
+%NCDF_INC        -I/usr/local/SX8/soft/netcdf/include
+%NCDF_LIB        -L/usr/local/SX8/soft/netcdf/lib -lnetcdf
+%FC              sxmpif90
+%FCFLAGS         -f2003 nocbind -P stack -dW -Wf,-pvctl res=whole,-A idbl4,-ptr byte -EP -R5 -float0 -size_t64 -dw -Wf,"-pvctl loopcnt=999999 fullmsg noassume"  -Wf"-init heap=zero" -R2
+%FFLAGS          %FCFLAGS
+%LD              sxmpif90
+%LDFLAGS
+%FPPFLAGS        -P -C -traditional
+%AR              sxar
+%ARFLAGS         rs
+%MK              gmake
+%USER_INC        %NCDF_INC
+%USER_LIB        %NCDF_LIB
+
Index: trunk/NEMOGCM/ARCH/arch-TX7_ULAM.fcm
===================================================================
--- trunk/NEMOGCM/ARCH/arch-TX7_ULAM.fcm	(revision 2528)
+++ trunk/NEMOGCM/ARCH/arch-TX7_ULAM.fcm	(revision 2528)
@@ -0,0 +1,29 @@
+# ulam IBM X3950 M2 at french IDRIS, http://www.idris.fr/su/Scalaire/ulam/hw-ulam.html
+# NCDF_INC    netcdf include file
+# NCDF_LIB    netcdf library
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make  
+# USER_INC    additional include files for the compiler,  e.g. -I<include dir> 
+# USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
+
+
+%NCDF_INC            -I/TXlocal/pub/netcdf/netcdf-3.6.2/include
+%NCDF_LIB            -L/TXlocal/pub/netcdf/netcdf-3.6.2/lib -lnetcdf
+%FC                  gfortran
+%FCFLAGS             -fdefault-real-8
+%FFLAGS              %FCFLAGS 
+%LD                  gfortran
+%LDFLAGS    
+%FPPFLAGS            -P -C
+%AR                  ar  
+%ARFLAGS             -r
+%MK                  gmake 
+%USER_INC            %NCDF_INC
+%USER_LIB            %NCDF_LIB 
Index: trunk/NEMOGCM/ARCH/arch-X64_TITANE.fcm
===================================================================
--- trunk/NEMOGCM/ARCH/arch-X64_TITANE.fcm	(revision 2528)
+++ trunk/NEMOGCM/ARCH/arch-X64_TITANE.fcm	(revision 2528)
@@ -0,0 +1,29 @@
+# titane BULL at french CCRT, http://www-ccrt.cea.fr/fr/moyen_de_calcul/titane.htm
+# NCDF_INC    netcdf include file
+# NCDF_LIB    netcdf library
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make
+# USER_INC    additional include files for the compiler,  e.g. -I<include dir>
+# USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
+
+
+%NCDF_INC            -I$NETCDF_INCLUDEDIR
+%NCDF_LIB            -L$NETCDF_LIBDIR -lnetcdff -lnetcdf
+%FC                  mpif90
+%FCFLAGS             -i4 -r8 -automatic -align all
+%FFLAGS              %FCFLAGS
+%LD                  mpif90
+%LDFLAGS          
+%FPPFLAGS            -P -C -traditional
+%AR                  ar
+%ARFLAGS             rs
+%MK                  gmake
+%USER_INC            %NCDF_INC
+%USER_LIB            %NCDF_LIB 
Index: trunk/NEMOGCM/ARCH/arch-X86_CESIUM.fcm
===================================================================
--- trunk/NEMOGCM/ARCH/arch-X86_CESIUM.fcm	(revision 2528)
+++ trunk/NEMOGCM/ARCH/arch-X86_CESIUM.fcm	(revision 2528)
@@ -0,0 +1,29 @@
+# cesium pre/post processing HP at french CCRT, http://www-ccrt.cea.fr/fr/moyen_de_calcul/cesium.htm
+# NCDF_INC    netcdf include file
+# NCDF_LIB    netcdf library
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make
+# USER_INC    additional include files for the compiler,  e.g. -I<include dir>
+# USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
+
+
+%NCDF_INC            -I/applications/netcdf-3.6.3/include
+%NCDF_LIB            -L/applications/netcdf-3.6.3/lib -lnetcdff -lnetcdf
+%FC                  ifort
+%FCFLAGS             -i4 -r8 
+%FFLAGS              %FCFLAGS
+%LD                  ifort
+%LDFLAGS              -Vaxlib 
+%FPPFLAGS            -P -C -traditional
+%AR                  ar
+%ARFLAGS             rs
+%MK                  gmake
+%USER_INC            %NCDF_INC
+%USER_LIB            %NCDF_LIB 
Index: trunk/NEMOGCM/ARCH/arch-XT6_HECTOR.fcm
===================================================================
--- trunk/NEMOGCM/ARCH/arch-XT6_HECTOR.fcm	(revision 2528)
+++ trunk/NEMOGCM/ARCH/arch-XT6_HECTOR.fcm	(revision 2528)
@@ -0,0 +1,44 @@
+# compiler options for hector CRAY XT6
+
+# NCDF_HOME   root directory containing lib and include subdirectories for netcdf4
+# HDF5_HOME   root directory containing lib and include subdirectories for HDF5
+# NCDF_INC    netcdf include file
+# NCDF_LIB    netcdf library
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make
+# USER_INC    additional include files for the compiler,  e.g. -I<include dir>
+# USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
+
+
+# PGI prgenv (default for hector)
+# use "module load netcdf" to setup system netcdf
+
+%NCDF_HOME           $CRAY_NETCDF_DIR/netcdf-pgi
+%HDF5_HOME           $CRAY_HDF5_DIR/hdf5-pgi
+%NCDF_INC            -I%NCDF_HOME/include -I%HDF5_HOME/include
+%NCDF_LIB            -L%HDF5_HOME/lib -L%NCDF_HOME/lib -lnetcdf -lhdf5_fortran -lhdf5_hl -lhdf5 -lz
+%FC                  ftn
+%FCFLAGS             -i4 -r8 -O3
+%FFLAGS              -i4 -r8 -O3
+%LD                  ftn
+%FPPFLAGS            -P -C -traditional
+%LDFLAGS
+%AR                  ar 
+%ARFLAGS             -r
+%MK                  gmake
+%USER_INC            %NCDF_INC
+%USER_LIB            %NCDF_LIB
+
+# replacement options for GNU prgenv
+
+# %NCDF_HOME           $CRAY_NETCDF_DIR/netcdf-gnu
+# %HDF5_HOME           $CRAY_HDF5_DIR/hdf5-gnu
+# %FCFLAGS             -fdefault-real-8 -O3
+# %FFLAGS              -fdefault-real-8 -O3
Index: trunk/NEMOGCM/ARCH/arch-g95_linux.fcm
===================================================================
--- trunk/NEMOGCM/ARCH/arch-g95_linux.fcm	(revision 2528)
+++ trunk/NEMOGCM/ARCH/arch-g95_linux.fcm	(revision 2528)
@@ -0,0 +1,30 @@
+# generic g95 compiler options for linux
+# NCDF_INC    netcdf include file
+# NCDF_LIB    netcdf library
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make
+# USER_INC    additional include files for the compiler,  e.g. -I<include dir>
+# USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
+
+
+%NCDF_INC            -I/usr/local/netcdf/include
+%NCDF_LIB            -L/usr/local/netcdf/lib -lnetcdf
+%FC	             g95
+%FCFLAGS             -i4 -r8 -O3 -funroll-all-loops -fno-second-underscore 
+%FFLAGS              %FCFLAGS
+%LD                  g95
+%LDFLAGS
+%FPPFLAGS            -P -C -traditional
+%AR                  ar
+%ARFLAGS             -r
+%MK                  gmake
+%USER_INC            %NCDF_INC
+%USER_LIB            %NCDF_LIB
+
Index: trunk/NEMOGCM/ARCH/arch-g95_osx.fcm
===================================================================
--- trunk/NEMOGCM/ARCH/arch-g95_osx.fcm	(revision 2528)
+++ trunk/NEMOGCM/ARCH/arch-g95_osx.fcm	(revision 2528)
@@ -0,0 +1,30 @@
+# generic g95 compiler options for OSX (intel)
+# NCDF_INC    netcdf include file
+# NCDF_LIB    netcdf library
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make
+# USER_INC    additional include files for the compiler,  e.g. -I<include dir>
+# USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
+
+
+%NCDF_INC            -I/usr/local/netcdf/include
+%NCDF_LIB            -L/usr/local/netcdf/lib -lnetcdf
+%FC	             g95
+%FCFLAGS             -i4 -r8 -O3 -funroll-all-loops  
+%FFLAGS              %FCFLAGS
+%LD                  g95
+%LDFLAGS
+%FPPFLAGS            -P -C -traditional
+%AR                  libtool
+%ARFLAGS             -c -s -o
+%MK                  make
+%USER_INC            %NCDF_INC
+%USER_LIB            %NCDF_LIB
+
Index: trunk/NEMOGCM/ARCH/arch-gfortran_linux.fcm
===================================================================
--- trunk/NEMOGCM/ARCH/arch-gfortran_linux.fcm	(revision 2528)
+++ trunk/NEMOGCM/ARCH/arch-gfortran_linux.fcm	(revision 2528)
@@ -0,0 +1,30 @@
+# generic gfortran compiler options for linux
+# NCDF_INC    netcdf include file
+# NCDF_LIB    netcdf library
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make
+# USER_INC    additional include files for the compiler,  e.g. -I<include dir>
+# USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
+
+
+%NCDF_INC            -I/usr/local/netcdf/include
+%NCDF_LIB            -L/usr/local/netcdf/lib -lnetcdf
+%FC	             gfortran
+%FCFLAGS             -fdefault-real-8 -O3 -funroll-all-loops -fcray-pointer 
+%FFLAGS              %FCFLAGS
+%LD                  gfortran
+%LDFLAGS
+%FPPFLAGS            -P -C -traditional
+%AR                  ar
+%ARFLAGS             -rs
+%MK                  gmake
+%USER_INC            %NCDF_INC
+%USER_LIB            %NCDF_LIB
+
Index: trunk/NEMOGCM/ARCH/arch-gfortran_osx.fcm
===================================================================
--- trunk/NEMOGCM/ARCH/arch-gfortran_osx.fcm	(revision 2528)
+++ trunk/NEMOGCM/ARCH/arch-gfortran_osx.fcm	(revision 2528)
@@ -0,0 +1,30 @@
+# generic gfortran compiler options for OSX (intel)
+# NCDF_INC    netcdf include file
+# NCDF_LIB    netcdf library
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make
+# USER_INC    additional include files for the compiler,  e.g. -I<include dir>
+# USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
+
+
+%NCDF_INC            -I/usr/local/netcdf/include
+%NCDF_LIB            -L/usr/local/netcdf/lib -lnetcdf
+%FC	             gfortran
+%FCFLAGS             -fdefault-real-8 -O3 -funroll-all-loops -fcray-pointer 
+%FFLAGS              %FCFLAGS
+%LD                  gfortran
+%LDFLAGS
+%FPPFLAGS            -P -C -traditional
+%AR                  libtool
+%ARFLAGS             -c -s -o
+%MK                  make
+%USER_INC            %NCDF_INC
+%USER_LIB            %NCDF_LIB
+
Index: trunk/NEMOGCM/ARCH/arch-ifort_linux.fcm
===================================================================
--- trunk/NEMOGCM/ARCH/arch-ifort_linux.fcm	(revision 2528)
+++ trunk/NEMOGCM/ARCH/arch-ifort_linux.fcm	(revision 2528)
@@ -0,0 +1,29 @@
+# generic ifort compiler options for linux
+# NCDF_INC    netcdf include file
+# NCDF_LIB    netcdf library
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make
+# USER_INC    additional include files for the compiler,  e.g. -I<include dir>
+# USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
+
+
+%NCDF_INC            -I/usr/local/netcdf/include 
+%NCDF_LIB            -L /usr/local/netcdf/lib -lnetcdf   
+%FC                  ifort
+%FCFLAGS 	     -r8 -O3  -traceback 
+%FFLAGS 	     -r8 -O3  -traceback 
+%LD                  ifort
+%FPPFLAGS            -P -C -traditional
+%LDFLAGS
+%AR                  ar 
+%ARFLAGS             -r
+%MK                  gmake
+%USER_INC            %NCDF_INC
+%USER_LIB            %NCDF_LIB 
Index: trunk/NEMOGCM/ARCH/arch-ifort_osx.fcm
===================================================================
--- trunk/NEMOGCM/ARCH/arch-ifort_osx.fcm	(revision 2528)
+++ trunk/NEMOGCM/ARCH/arch-ifort_osx.fcm	(revision 2528)
@@ -0,0 +1,29 @@
+# generic ifort (with mpi) compiler options for OSX (intel)
+# NCDF_INC    netcdf include file
+# NCDF_LIB    netcdf library
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make
+# USER_INC    additional include files for the compiler,  e.g. -I<include dir>
+# USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
+
+
+%NCDF_INC            -I/usr/local/include 
+%NCDF_LIB            -L /usr/local/lib -lnetcdf   
+%FC                  mpif90
+%FCFLAGS 	     -r8 -O3  -traceback 
+%FFLAGS 	     -r8 -O3  -traceback 
+%LD                  mpif90
+%FPPFLAGS            -P -C -traditional
+%LDFLAGS
+%AR                  libtool 
+%ARFLAGS             -c -s -o
+%MK                  make
+%USER_INC            %NCDF_INC
+%USER_LIB            %NCDF_LIB 
Index: trunk/NEMOGCM/ARCH/arch-lahey_linux.fcm
===================================================================
--- trunk/NEMOGCM/ARCH/arch-lahey_linux.fcm	(revision 2528)
+++ trunk/NEMOGCM/ARCH/arch-lahey_linux.fcm	(revision 2528)
@@ -0,0 +1,30 @@
+# generic Lahey/Fujitsu compiler options for linux
+# NCDF_INC    netcdf include file
+# NCDF_LIB    netcdf library
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make
+# USER_INC    additional include files for the compiler,  e.g. -I<include dir>
+# USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
+
+
+%NCDF_INC            -I/usr/local/netcdf/include
+%NCDF_LIB            -L/usr/local/netcdf/lib -lnetcdf
+%FC	             lf95
+%FCFLAGS             -i4 -CcdRR8
+%FFLAGS              %FCFLAGS
+%LD                  lf95
+%LDFLAGS
+%FPPFLAGS            -P -C -traditional
+%AR                  ar
+%ARFLAGS             -r
+%MK                  gmake
+%USER_INC            %NCDF_INC
+%USER_LIB            %NCDF_LIB
+
Index: trunk/NEMOGCM/ARCH/arch-nag_linux.fcm
===================================================================
--- trunk/NEMOGCM/ARCH/arch-nag_linux.fcm	(revision 2528)
+++ trunk/NEMOGCM/ARCH/arch-nag_linux.fcm	(revision 2528)
@@ -0,0 +1,30 @@
+# generic NagWare compiler options for linux
+# NCDF_INC    netcdf include file
+# NCDF_LIB    netcdf library
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make
+# USER_INC    additional include files for the compiler,  e.g. -I<include dir>
+# USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
+
+
+%NCDF_INC            -I/usr/local/netcdf/include
+%NCDF_LIB            -L/usr/local/netcdf/lib -lnetcdf
+%FC	             f95
+%FCFLAGS             -i4 -r8 -gline -O3
+%FFLAGS              %FCFLAGS
+%LD                  f95
+%LDFLAGS
+%FPPFLAGS            -P -C -traditional
+%AR                  ar
+%ARFLAGS             -r
+%MK                  gmake
+%USER_INC            %NCDF_INC
+%USER_LIB            %NCDF_LIB
+
Index: trunk/NEMOGCM/ARCH/arch-pathscale_linux.fcm
===================================================================
--- trunk/NEMOGCM/ARCH/arch-pathscale_linux.fcm	(revision 2528)
+++ trunk/NEMOGCM/ARCH/arch-pathscale_linux.fcm	(revision 2528)
@@ -0,0 +1,30 @@
+# generic pathscale compiler options for linux
+# NCDF_INC    netcdf include file
+# NCDF_LIB    netcdf library
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make
+# USER_INC    additional include files for the compiler,  e.g. -I<include dir>
+# USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
+
+
+%NCDF_INC            -I/usr/local/netcdf/include
+%NCDF_LIB            -L/usr/local/netcdf/lib -lnetcdf
+%FC	             pathf95
+%FCFLAGS             -r8 -O3 -funroll
+%FFLAGS              %FCFLAGS
+%LD                  pathf95
+%LDFLAGS
+%FPPFLAGS            -P -C -traditional
+%AR                  ar
+%ARFLAGS             -r
+%MK                  gmake
+%USER_INC            %NCDF_INC
+%USER_LIB            %NCDF_LIB
+
Index: trunk/NEMOGCM/ARCH/arch-pgf90_linux.fcm
===================================================================
--- trunk/NEMOGCM/ARCH/arch-pgf90_linux.fcm	(revision 2528)
+++ trunk/NEMOGCM/ARCH/arch-pgf90_linux.fcm	(revision 2528)
@@ -0,0 +1,30 @@
+# generic pgf90 compiler options for linux
+# NCDF_INC    netcdf include file
+# NCDF_LIB    netcdf library
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make
+# USER_INC    additional include files for the compiler,  e.g. -I<include dir>
+# USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
+
+
+%NCDF_INC            -I/usr/local/netcdf/include
+%NCDF_LIB            -L/usr/local/netcdf/lib -lnetcdf
+%FC	             pgf90
+%FCFLAGS             -O3 -i4 -r8 
+%FFLAGS              %FCFLAGS
+%LD                  pgf90
+%LDFLAGS
+%FPPFLAGS            -P -C -traditional
+%AR                  ar
+%ARFLAGS             -rs
+%MK                  gmake
+%USER_INC            %NCDF_INC
+%USER_LIB            %NCDF_LIB
+
Index: trunk/NEMOGCM/ARCH/arch-xlf_aix.fcm
===================================================================
--- trunk/NEMOGCM/ARCH/arch-xlf_aix.fcm	(revision 2528)
+++ trunk/NEMOGCM/ARCH/arch-xlf_aix.fcm	(revision 2528)
@@ -0,0 +1,29 @@
+# generic IBM SP
+# NCDF_INC    netcdf include file
+# NCDF_LIB    netcdf library
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make
+# USER_INC    additional include files for the compiler,  e.g. -I<include dir>
+# USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
+
+
+%NCDF_INC            -I/usr/local/pub/NetCDF/3.6.2/include
+%NCDF_LIB            -L /usr/local/pub/NetCDF/3.6.2/lib -lnetcdf
+%FC                  mpxlf90_r
+%FCFLAGS             -qfree=f90 -O3 -qrealsize=8 -qextname -qsource -q64 -qlargepage -qmaxmem=-1
+%FFLAGS              -qfixed -O3 -qrealsize=8 -qextname -qsource -q64 -qlargepage -qmaxmem=-1
+%LD                  mpxlf90_r
+%LDFLAGS
+%FPPFLAGS            -P -C
+%AR                  ar
+%ARFLAGS             rs
+%MK                  gmake
+%USER_INC            %NCDF_INC
+%USER_LIB            %NCDF_LIB
Index: trunk/NEMOGCM/ARCH/arch-xlf_osx.fcm
===================================================================
--- trunk/NEMOGCM/ARCH/arch-xlf_osx.fcm	(revision 2528)
+++ trunk/NEMOGCM/ARCH/arch-xlf_osx.fcm	(revision 2528)
@@ -0,0 +1,29 @@
+# generic xlf compiler options for OSX (ppc)
+# NCDF_INC    netcdf include file
+# NCDF_LIB    netcdf library
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make
+# USER_INC    additional include files for the compiler,  e.g. -I<include dir>
+# USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
+
+
+%NCDF_INC      -I/usr/local/XLF/netcdf/include
+%NCDF_LIB      -L/usr/local/XLF/netcdf/lib -lnetcf
+%FC            xlf90
+%FCFLAGS       -O3 -qrealsize=8 -qextname -qsuffix=f=f90 -qsuffix=cpp=F90
+%FFLAGS        -O3 -qrealsize=8 -qextname -qsuffix=f=f -qsuffix=cpp=F
+%FPPFLAGS        -P -C -traditional
+%LD            xlf90
+%LDFLAGS
+%AR            ar
+%ARFLAGS       rs
+%MK            make
+%USER_INC      %NCDF_INC
+%USER_LIB      %NCDF_LIB 
Index: trunk/NEMOGCM/CONFIG/GYRE/AA_make
===================================================================
--- trunk/NEMOGCM/CONFIG/GYRE/AA_make	(revision 2527)
+++ 	(revision )
@@ -1,13 +1,0 @@
-# $Header$
-all: ioipsl opa
-
-ioipsl:
-	(cd ../../modeles/IOIPSL/src; $(M_K) ;)
-
-
-opa:
-	(cd ../../modeles/NEMO/WORK;  $(M_K) ;)
-
-
-clean:
-	(cd ../../modeles/NEMO/WORK;  $(M_K) clean ;)
Index: trunk/NEMOGCM/CONFIG/GYRE/AA_make.ldef
===================================================================
--- trunk/NEMOGCM/CONFIG/GYRE/AA_make.ldef	(revision 2527)
+++ 	(revision )
@@ -1,11 +1,0 @@
-#---------------------------------------------------------------------
-#- Creation des elements relatifs a ORCA :
-#-      ORCA  (lib, executable : opa)
-#---------------------------------------------------------------------
-SHELL = /bin/sh
-#---------------------------------------------------------------------
-LIBDIR = ../../../../lib
-BINDIR = ../../../../bin
-MODDIR = $(LIBDIR)
-#---------------------------------------------------------------------
-#-
Index: trunk/NEMOGCM/CONFIG/GYRE/EXP00/AA_job
===================================================================
--- trunk/NEMOGCM/CONFIG/GYRE/EXP00/AA_job	(revision 2527)
+++ trunk/NEMOGCM/CONFIG/GYRE/EXP00/AA_job	(revision 2528)
@@ -95,7 +95,4 @@
 #- Namelist for the configuration 
 cp ${R_EXPER}/namelist namelist
-cp ${R_EXPER}/iodef.xml .
-cp ${R_EXPER}/xmlio_server.def .
-
 ls -alF
 
Index: trunk/NEMOGCM/CONFIG/GYRE/EXP00/iodef.xml
===================================================================
--- trunk/NEMOGCM/CONFIG/GYRE/EXP00/iodef.xml	(revision 2527)
+++ trunk/NEMOGCM/CONFIG/GYRE/EXP00/iodef.xml	(revision 2528)
@@ -54,6 +54,6 @@
       <group id="SBC" axis_ref="none" grid_ref="grid_T" > <!-- time step automaticaly defined based on nn_fsbc -->
 
-	<field id="emp"          description="Net Upward Water Flux"                                        unit="kg/m2/s"  />
-	<field id="emps"         description="concentration/dilution water flux"                            unit="kg/m2/s"  />
+	<field id="emp-rnf"      description="Net Upward Water Flux"                                        unit="kg/m2/s"  />
+	<field id="emps-rnf"     description="concentration/dilution water flux"                            unit="kg/m2/s"  />
 	<field id="snowpre"      description="Snow precipitation"                                           unit="kg/m2/s"  />
 	<field id="runoffs"      description="River Runoffs"                                                unit="Kg/m2/s"  />
@@ -133,9 +133,10 @@
 	<field id="utau"         description="Wind Stress along i-axis"                    unit="N/m2" axis_ref="none" />
 	<field id="uoce"         description="ocean current along i-axis"                  unit="m/s"                  />
-	<field id="uoce_eff"     description="Effective ocean current along i-axis"        unit="m/s"                  />
+	<field id="uoce_eff"     description="Effective ocean transport along i-axis"      unit="m3/s"                 />
 	<!-- uoce_eiv: available with key_traldf_eiv and key_diaeiv -->
 	<field id="uoce_eiv"     description="EIV ocean current along i-axis"              unit="m/s"                  />
-	<!-- uoce_eiv: available with key_trabbl_adv -->
+	<!-- uoce_eiv: available with key_trabbl -->
 	<field id="uoce_bbl"     description="BBL ocean current along i-axis"              unit="m/s"                  />
+	<field id="ahu_bbl"      description="BBL diffusive flux along i-axis"             unit="m3/s" axis_ref="none" />
  	<!-- variables available with key_diaar5 -->
 	<field id="u_masstr"     description="ocean eulerian mass transport along i-axis"  unit="kg/s"                 />
@@ -150,9 +151,10 @@
 	<field id="vtau"         description="Wind Stress along j-axis"                    unit="N/m2" axis_ref="none" />
 	<field id="voce"         description="ocean current along j-axis"                  unit="m/s"                  />
-	<field id="voce_eff"     description="Effective ocean current along j-axis"        unit="m/s"                  />
+	<field id="voce_eff"     description="Effective ocean transport along j-axis"      unit="m3/s"                 />
 	<!-- voce_eiv: available with key_traldf_eiv and key_diaeiv -->
 	<field id="voce_eiv"     description="EIV ocean current along j-axis"              unit="m/s"                  />
-	<!-- voce_eiv: available with key_trabbl_adv -->
+	<!-- voce_eiv: available with key_trabbl -->
 	<field id="voce_bbl"     description="BBL ocean current along j-axis"              unit="m/s"                  />
+	<field id="ahv_bbl"      description="BBL diffusive flux along j-axis"             unit="m3/s" axis_ref="none" />
 	<!-- variables available with key_diaar5 -->
 	<field id="v_masstr"     description="ocean eulerian mass transport along j-axis"  unit="kg/s"                 />
@@ -166,9 +168,8 @@
       <group id="grid_W"  axis_ref="depthw" grid_ref="grid_W">
 	<field id="woce"         description="ocean vertical velocity"                     unit="m/s"                  />
-	<field id="woce_eff"     description="effective ocean vertical velocity"           unit="m/s"                  />
+	<field id="woce_eff"     description="effective ocean vertical transport"          unit="m3/s"                 />
 	<!-- woce_eiv: available with key_traldf_eiv and key_diaeiv -->
 	<field id="woce_eiv"     description="EIV ocean vertical velocity"                 unit="m/s"                  />
 	<!-- woce_eiv: available with key_trabbl_adv -->
-	<field id="woce_bbl"     description="BBL ocean vertical velocity"                 unit="m/s"                  />
 	<field id="avt"          description="vertical eddy diffusivity"                   unit="m2/s"                 />
 	<field id="avm"          description="vertical eddy viscosity"                     unit="m2/s"                 />
@@ -232,11 +233,4 @@
 
       <group id="2d" output_freq="172800" output_level="10" enabled=".TRUE.">                      <!-- 2d files -->
-
-        <file id="2d_grid_T" name="auto" description="ocean T grid variables" >
-          <field ref="sst"          name="sosstsst"  />
-	  <field ref="sss"          name="sosaline"  />
-	  <field ref="ssh"          name="sossheig"  />
-        </file>
-
       </group>
 
@@ -249,7 +243,7 @@
 	  <field ref="sss"          name="sosaline"  />
 	  <field ref="ssh"          name="sossheig"  />
-	  <field ref="emp"          name="sowaflup"  />
+	  <field ref="emp-rnf"      name="sowaflup"  />
 	  <field ref="qsr"          name="soshfldo"  />
-	  <field ref="emps"         name="sowaflcd"  />
+	  <field ref="emps-rnf"     name="sowaflcd"  />
 	  <field ref="qns+qsr"      name="sohefldo"  />
 	  <field ref="mldr10_1"     name="somxl010"  />
Index: trunk/NEMOGCM/CONFIG/GYRE/EXP00/namelist
===================================================================
--- trunk/NEMOGCM/CONFIG/GYRE/EXP00/namelist	(revision 2527)
+++ trunk/NEMOGCM/CONFIG/GYRE/EXP00/namelist	(revision 2528)
@@ -1,7 +1,8 @@
 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 !! NEMO/OPA  :  1 - run manager      (namrun)
-!! namelists    2 - Domain           (namzgr, namzgr_sco, namdom)
+!! namelists    2 - Domain           (namzgr, namzgr_sco, namdom, namdta_tem, namdta_sal)
 !!              3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core
-!!                                    namsbc_cpl, namqsr, namsbc_rnf, namsbc_ssr, namsbc_alb)
+!!                                    namsbc_cpl, namsbc_cpl_co2 namtra_qsr, namsbc_rnf, 
+!!                                    namsbc_apr, namsbc_ssr, namsbc_alb)
 !!              4 - lateral boundary (namlbc, namcla, namobc, namagrif, nambdy, nambdy_tide)
 !!              5 - bottom  boundary (nambfr, nambbc, nambbl)
@@ -9,15 +10,15 @@
 !!              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      (namtrd, namgap, namspr, namflo, namptr)
-!!              9 - miscellaneous    (namsol, nammpp, nammpp_dyndist, namctl)
+!!              9 - diagnostics      (namnc4, namtrd, namspr, namflo, namptr, namhsb)
+!!             10 - miscellaneous    (namsol, nammpp, nammpp_dyndist, namctl)
+!!             11 - Obs & Assim      (namobs, nam_asminc)
 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-!  CAUTION: some scripts does not support CAPITALs for logical use .true./.false., not .TRUE./.FALSE.
 
 !!======================================================================
 !!                   ***  Run management namelists  ***
 !!======================================================================
-!!   namrun            parameters of the run
-!!======================================================================
-
+!!   namrun        parameters of the run
+!!======================================================================
+!
 !-----------------------------------------------------------------------
 &namrun        !   parameters of the run
@@ -26,21 +27,22 @@
    cn_exp      =  "GYRE"   !  experience name 
    nn_it000    =       1   !  first time step
-   nn_itend    =    4320   !  last  time step (std 5475)
-   nn_date0    =  010101   !  initial calendar date yymmdd (used if nrstdt=1)
+   nn_itend    =    4320   !  last  time step
+   nn_date0    =  010101   !  initial calendar date yymmdd (used if nn_rstctl=1)
    nn_leapy    =      30   !  Leap year calendar (1) or not (0)
+   ln_rstart   = .false.   !  start from rest (F) or from a restart file (T)
+   nn_rstctl   =       0       !  restart control = 0 nn_it000 is not compared to the restart file value
+                               !                  = 1 use nn_date0 in namelist (not the value in the restart file)
+                               !                  = 2 calendar parameters read in the restart file
+   cn_ocerst_in  = "restart"   !  suffix of ocean restart name (input)
+   cn_ocerst_out = "restart"   !  suffix of ocean restart name (output)
    nn_istate   =       0   !  output the initial state (1) or not (0)
    nn_stock    =    4320   !  frequency of creation of a restart file (modulo referenced to 1)
-   nn_write    =      60   !  frequency of write in the output file   (modulo referenced to nit000)
+   nn_write    =      60   !  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
-   nn_chunksz  = 0         !  chunksize (bytes) for NetCDF file (working only with iom_nf90 routines)
-   ln_rstart   = .false.   !  start from rest (F) or from a restart file (T)
-   nn_rstctl   =       0       !  restart control = 0 nit000 is not compared to the restart file value
-                               !                  = 1 use ndate0 in namelist (not the value in the restart file)
-                               !                  = 2 calendar parameters read in the restart file
-   cn_ocerst_in  = "restart"   !  suffix of ocean restart name (input)
-   cn_ocerst_out = "restart"   !  suffix of ocean restart name (output)
-/
+   nn_chunksz  =       0   !  chunksize (bytes) for NetCDF file (works only with iom_nf90 routines)
+/
+
 !!======================================================================
 !!                      ***  Domain namelists  ***
@@ -49,6 +51,8 @@
 !!   namzgr_sco   s-coordinate or hybrid z-s-coordinate
 !!   namdom       space and time domain (bathymetry, mesh, timestep)
-!!======================================================================
-
+!!   namdta_tem   data: temperature                                     ("key_dtatem")
+!!   namdta_sal   data: salinity                                        ("key_dtasal")
+!!======================================================================
+!
 !-----------------------------------------------------------------------
 &namzgr        !   vertical coordinate
@@ -63,7 +67,7 @@
    rn_sbot_min =  300.     !  minimum depth of s-bottom surface (>0) (m)
    rn_sbot_max = 5250.     !  maximum depth of s-bottom surface (= ocean depth) (>0) (m)
-   rn_theta    =    6.0    !  surface control parameter (0<=theta<=20)
-   rn_thetb    =    0.75   !  bottom control parameter  (0<=thetb<= 1)
-   rn_rmax     =    0.15   !  maximum cut-off r-value allowed (0<r_max<1)
+   rn_theta    =    6.0    !  surface control parameter (0<=rn_theta<=20)
+   rn_thetb    =    0.75   !  bottom control parameter  (0<=rn_thetb<= 1)
+   rn_rmax     =    0.15   !  maximum cut-off r-value allowed (0<rn_max<1)
    ln_s_sigma  = .false.   !  hybrid s-sigma coordinates
    rn_bb       =    0.8    !  stretching with s-sigma
@@ -73,57 +77,77 @@
 &namdom        !   space and time domain (bathymetry, mesh, timestep)
 !-----------------------------------------------------------------------
-   nn_bathy    =    0      !  compute (=0) or read(=1) the bathymetry file
-   nn_closea    =   0      !  closed seas and lakes are removed (=0) or kept (=1) from the ORCA domain
-   nn_msh      =    0      !  create (=1) a mesh file (coordinates, scale factors, masks) or not (=0)
-   rn_e3zps_min=    5.     !  the thickness of the partial step is set larger than the minimum
-   rn_e3zps_rat=    0.1    !  of e3zps_min and e3zps_rat * e3t   (N.B. 0<e3zps_rat<1)
+   nn_bathy    =    0      !  compute (=0) or read (=1) the bathymetry file
+   nn_closea    =   0      !  remove (=0) or keep (=1) closed seas and lakes (ORCA)
+   nn_msh      =    0      !  create (=1) a mesh file or not (=0)
+   rn_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
+   rn_e3zps_rat=    0.1    !  rn_e3zps_min and rn_e3zps_rat*e3t, with 0<rn_e3zps_rat<1
                            !
-   rn_rdt      = 7200.     !  time step for the dynamics (and tracer if nacc=0)   ==> 5760
-   nn_baro     =   60      !  number of barotropic time step (for the split explicit algorithm) ("key_dynspg_ts")
+   rn_rdt      = 7200.     !  time step for the dynamics (and tracer if nn_acc=0)
+   nn_baro     =   60      !  number of barotropic time step            ("key_dynspg_ts")
    rn_atfp     =    0.1    !  asselin time filter parameter
    nn_acc      =    0      !  acceleration of convergence : =1      used, rdt < rdttra(k)
                                  !                          =0, not used, rdt = rdttra
-   rn_rdtmin   = 7200.           !  minimum time step on tracers (used if nacc=1)
-   rn_rdtmax   = 7200.           !  maximum time step on tracers (used if nacc=1)
-   rn_rdth     =  800.           !  depth variation of tracer time step  (used if nacc=1)
-/
+   rn_rdtmin   = 7200.           !  minimum time step on tracers (used if nn_acc=1)
+   rn_rdtmax   = 7200.           !  maximum time step on tracers (used if nn_acc=1)
+   rn_rdth     =  800.           !  depth variation of tracer time step (used if nn_acc=1)
+/
+!-----------------------------------------------------------------------
+&namdta_tem    !   data : temperature                                   ("key_dtatem")
+!-----------------------------------------------------------------------
+!              ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation !
+!              !           !  (if <0  months)     !   name   !  (logical)   ! (T/F) ! 'monthly'  ! filename ! pairing  !
+   sn_tem = 'data_1m_potential_temperature_nomask', -1,'votemper',  .true.  , .true., 'yearly'   , ' '      , ' '
+   !
+   cn_dir       = './'     !  root directory for the location of the runoff files
+/
+!-----------------------------------------------------------------------
+&namdta_sal    !   data : salinity                                      ("key_dtasal")
+!-----------------------------------------------------------------------
+!              ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation !
+!              !           !  (if <0  months)     !   name   !   (logical)  ! (T/F) ! 'monthly'  ! filename ! pairing  !
+   sn_sal      =  'data_1m_salinity_nomask',  -1  ,'vosaline',    .true.    , .true., 'yearly'   , ''       , ' '
+   !
+   cn_dir      = './'      !  root directory for the location of the runoff files
+/
+
 !!======================================================================
 !!            ***  Surface Boundary Condition namelists  ***
 !!======================================================================
-!!   namsbc        surface boundary condition
-!!   namsbc_ana    analytical         formulation
-!!   namsbc_flx    flux               formulation
-!!   namsbc_clio   CLIO bulk formulea formulation
-!!   namsbc_core   CORE bulk formulea formulation
-!!   namsbc_cpl    CouPLed            formulation                       ("key_coupled")
-!!   namtra_qsr    penetrative solar radiation
-!!   namsbc_rnf    river runoffs
-!!   namsbc_ssr    sea surface restoring term (for T and/or S)
-!!   namsbc_alb    albedo parameters
-!!======================================================================
-
+!!   namsbc          surface boundary condition
+!!   namsbc_ana      analytical         formulation
+!!   namsbc_flx      flux               formulation
+!!   namsbc_clio     CLIO bulk formulea formulation
+!!   namsbc_core     CORE bulk formulea formulation
+!!   namsbc_cpl      CouPLed            formulation                     ("key_coupled")
+!!   namsbc_cpl_co2  coupled ocean/biogeo/atmosphere model              ("key_cpl_carbon_cycle")
+!!   namtra_qsr      penetrative solar radiation
+!!   namsbc_rnf      river runoffs
+!!   namsbc_apr      Atmospheric Pressure
+!!   namsbc_ssr      sea surface restoring term (for T and/or S)
+!!   namsbc_alb      albedo parameters
+!!======================================================================
+!
 !-----------------------------------------------------------------------
 &namsbc        !   Surface Boundary Condition (surface module)
 !-----------------------------------------------------------------------
    nn_fsbc     = 1         !  frequency of surface boundary condition computation 
-                           !               (= the frequency of sea-ice model call)
-   ln_ana      = .true.    !  analytical formulation (T => fill namsbc_ana ) 
-   ln_flx      = .false.   !  flux formulation       (T => fill namsbc_flx )
-   ln_blk_clio = .false.   !  CLIO bulk formulation  (T => fill namsbc_clio) 
-   ln_blk_core = .false.   !  CORE bulk formulation  (T => fill namsbc_core) 
-   ln_cpl      = .false.   !  Coupled formulation    (T => fill namsbc_cpl )
+                           !     (also = the frequency of sea-ice model call)
+   ln_ana      = .true.    !  analytical formulation                    (T => fill namsbc_ana ) 
+   ln_flx      = .false.   !  flux formulation                          (T => fill namsbc_flx )
+   ln_blk_clio = .false.   !  CLIO bulk formulation                     (T => fill namsbc_clio) 
+   ln_blk_core = .false.   !  CORE bulk formulation                     (T => fill namsbc_core) 
+   ln_cpl      = .false.   !  Coupled formulation                       (T => fill namsbc_cpl )
+   ln_apr_dyn  = .false.   !  Patm gradient added in ocean & ice Eqs.   (T => fill namsbc_apr )
    nn_ice      = 0         !  =0 no ice boundary condition   ,
                            !  =1 use observed ice-cover      ,
-                           !  =2 ice-model used                             ("key_lim3" or "key_lim2)
-   nn_ico_cpl  = 0         !  ice-ocean coupling : =0 each nn_fsbc 
-                           !                       =1 stresses recomputed each ocean time step ("key_lim3" only)
-                           !                       =2 combination of 0 and 1 cases             ("key_lim3" only)
-   ln_dm2dc    = .false.   !  daily mean to diurnal cycle short wave (qsr)
-   ln_rnf      = .false.   !  runoffs (T => fill namsbc_rnf)
-   ln_ssr      = .false.   !  Sea Surface Restoring on T and/or S (T => fill namsbc_ssr)
-   nn_fwb      = 0         !  FreshWater Budget: =0 unchecked                              , 
-                           !                     =1 global mean of e-p-r set to zero at each nn_fsbc time step   ,
-                           !                     =2 annual global mean of e-p-r set to zero
-                           !                     =3 global emp set to zero and spread out over erp area
+                           !  =2 ice-model used                         ("key_lim3" or "key_lim2)
+   ln_dm2dc    = .false.   !  daily mean to diurnal cycle on short wave
+   ln_rnf      = .false.   !  runoffs                                   (T => fill namsbc_rnf)
+   ln_ssr      = .false.   !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr)
+   nn_fwb      = 0         !  FreshWater Budget: =0 unchecked 
+                           !     =1 global mean of e-p-r set to zero at each time step 
+                           !     =2 annual global mean of e-p-r set to zero
+                           !     =3 global emp set to zero and spread out over erp area
 /
 !-----------------------------------------------------------------------
@@ -140,12 +164,12 @@
 &namsbc_flx    !   surface boundary condition : flux formulation
 !-----------------------------------------------------------------------
-!              !   file name  ! frequency (hours) !  variable  ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
-!              !              !  (if <0  months)  !    name    !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
-   sn_utau     = 'utau'       ,        24         ,    'utau'  ,     .false.    , .false. , 'yearly'  , ''       , ''
-   sn_vtau     = 'vtau'       ,        24         ,    'vtau'  ,     .false.    , .false. , 'yearly'  , ''       , ''
-   sn_qtot     = 'qtot'       ,        24         ,    'qtot'  ,     .false.    , .false. , 'yearly'  , ''       , ''
-   sn_qsr      = 'qsr'        ,        24         ,    'qsr'   ,     .false.    , .false. , 'yearly'  , ''       , ''
-   sn_emp      = 'emp'        ,        24         ,    'emp'   ,     .false.    , .false. , 'yearly'  , ''       , ''
-!
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_utau     = 'utau'      ,        24         , 'utau'    , .false.      , .false., 'yearly'  , ''       , ''
+   sn_vtau     = 'vtau'      ,        24         , 'vtau'    , .false.      , .false., 'yearly'  , ''       , ''
+   sn_qtot     = 'qtot'      ,        24         , 'qtot'    , .false.      , .false., 'yearly'  , ''       , ''
+   sn_qsr      = 'qsr'       ,        24         , 'qsr'     , .false.      , .false., 'yearly'  , ''       , ''
+   sn_emp      = 'emp'       ,        24         , 'emp'     , .false.      , .false., 'yearly'  , ''       , ''
+
    cn_dir      = './'      !  root directory for the location of the flux files
 /      
@@ -153,14 +177,14 @@
 &namsbc_clio   !   namsbc_clio  CLIO bulk formulea
 !-----------------------------------------------------------------------
-!              !   file name  ! frequency (hours) !  variable  ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
-!              !              !  (if <0  months)  !    name    !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
-   sn_utau     = 'taux_1m'    ,       -1          , 'sozotaux' ,    .true.      , .true.  , 'yearly'  , ''       , ''
-   sn_vtau     = 'tauy_1m'    ,       -1          , 'sometauy' ,    .true.      , .true.  , 'yearly'  , ''       , ''
-   sn_wndm     = 'flx'        ,       -1          , 'socliowi' ,    .true.      , .true.  , 'yearly'  , ''       , ''
-   sn_tair     = 'flx'        ,       -1          , 'socliot2' ,    .true.      , .true.  , 'yearly'  , ''       , ''
-   sn_humi     = 'flx'        ,       -1          , 'socliohu' ,    .true.      , .true.  , 'yearly'  , ''       , ''
-   sn_ccov     = 'flx'        ,       -1          , 'socliocl' ,    .false.     , .true.  , 'yearly'  , ''       , ''
-   sn_prec     = 'flx'        ,       -1          , 'socliopl' ,    .false.     , .true.  , 'yearly'  , ''       , ''
-!
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_utau     = 'taux_1m'   ,       -1          , 'sozotaux',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_vtau     = 'tauy_1m'   ,       -1          , 'sometauy',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_wndm     = 'flx'       ,       -1          , 'socliowi',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_tair     = 'flx'       ,       -1          , 'socliot2',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_humi     = 'flx'       ,       -1          , 'socliohu',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_ccov     = 'flx'       ,       -1          , 'socliocl',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_prec     = 'flx'       ,       -1          , 'socliopl',   .false.    , .true. , 'yearly'  , ''       , ''
+
    cn_dir      = './'      !  root directory for the location of the bulk files are
 /
@@ -168,36 +192,63 @@
 &namsbc_core   !   namsbc_core  CORE bulk formulea
 !-----------------------------------------------------------------------
-!              !   file name  ! frequency (hours) ! variable   ! time interpol. !  clim   ! 'yearly'/ ! weights              ! rotation !
-!              !              !  (if <0  months)  !   name     !    (logical)   !  (T/F)  ! 'monthly' ! filename             ! pairing  !
-   sn_wndi     = 'u10_core'   ,       -1          , 'u10'      ,    .true.      , .true.  , 'yearly'  ,'bicubic_weights_orca2.nc' , 'U1'
-   sn_wndj     = 'v10_core'   ,       -1          , 'v10'      ,    .true.      , .true.  , 'yearly'  ,'bicubic_weights_orca2.nc' , 'V1'
-   sn_qsr      = 'qsw_core'   ,       -1          , 'swdn'     ,    .true.      , .true.  , 'yearly'  ,'bilinear_weights_orca2.nc', ''
-   sn_qlw      = 'qlw_core'   ,       -1          , 'lwdn'     ,    .true.      , .true.  , 'yearly'  ,'bilinear_weights_orca2.nc', ''
-   sn_tair     = 't2_core'    ,       -1          , 't2'       ,    .true.      , .true.  , 'yearly'  ,'bilinear_weights_orca2.nc', ''
-   sn_humi     = 'q2_core'    ,       -1          , 'q2'       ,    .true.      , .true.  , 'yearly'  ,'bilinear_weights_orca2.nc', ''
-   sn_prec     = 'precip_core',       -1          , 'precip'   ,    .true.      , .true.  , 'yearly'  ,'bilinear_weights_orca2.nc', ''
-   sn_snow     = 'snow_core'  ,       -1          , 'snow'     ,    .true.      , .true.  , 'yearly'  ,'bilinear_weights_orca2.nc', ''
-   sn_tdif     = 'taudif_core',       24          , 'taudif'   ,    .true.      , .true.  , 'yearly'  ,'bilinear_weights_orca2.nc', ''
-!
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_wndi = 'u_10.15JUNE2009_orca2'       ,  6  , 'U_10_MOD',   .false.    , .true. , 'yearly'  , ''       , 'Uwnd'
+   sn_wndj = 'v_10.15JUNE2009_orca2'       ,  6  , 'V_10_MOD',   .false.    , .true. , 'yearly'  , ''       , 'Vwnd'
+   sn_qsr  = 'ncar_rad.15JUNE2009_orca2'   , 24  , 'SWDN_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_qlw  = 'ncar_rad.15JUNE2009_orca2'   , 24  , 'LWDN_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_tair = 't_10.15JUNE2009_orca2'       ,  6  , 'T_10_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_humi = 'q_10.15JUNE2009_orca2'       ,  6  , 'Q_10_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_prec = 'ncar_precip.15JUNE2009_orca2', -1  , 'PRC_MOD1',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_snow = 'ncar_precip.15JUNE2009_orca2', -1  , 'SNOW'    ,   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_tdif = 'taudif_core'                 , 24  , 'taudif'  ,   .false.    , .true. , 'yearly'  , ''       , ''
+
    cn_dir      = './'      !  root directory for the location of the bulk files
-   ln_2m       = .true.    !  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_2m       = .false.   !  air temperature and humidity referenced at 2m (T) instead 10m (F)
+   ln_taudif   = .false.   !  HF tau contribution: use "mean of stress module - module of the mean stress" data
    rn_pfac     = 1.        !  multiplicative factor for precipitation (total & snow)
 /
 !-----------------------------------------------------------------------
-&namsbc_cpl    !   coupled ocean/atmosphere model                        ("key_coupled")
-!-----------------------------------------------------------------------
+&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_coupled")
+!-----------------------------------------------------------------------
+!                                      ! send
+cn_snd_temperature= 'weighted oce and ice'  !  'oce only' 'weighted oce and ice' 'mixed oce-ice'
+cn_snd_albedo     = 'weighted ice'          !  'none' 'weighted ice' 'mixed oce-ice'
+cn_snd_thickness  = 'none'                  !  'none' 'weighted ice and snow'
+cn_snd_crt_nature = 'none'                  !  'none' 'oce only' 'weighted oce and ice' 'mixed oce-ice'
+cn_snd_crt_refere = 'spherical'             !  'spherical' 'cartesian'
+cn_snd_crt_orient = 'eastward-northward'    !  'eastward-northward' or 'local grid'
+cn_snd_crt_grid   = 'T'                     !  'T'
+!                                      ! receive
+cn_rcv_w10m       = 'none'                  !  'none' 'coupled'
+cn_rcv_taumod     = 'coupled'               !  'none' 'coupled'
+cn_rcv_tau_nature = 'oce only'              !  'oce only' 'oce and ice' 'mixed oce-ice'
+cn_rcv_tau_refere = 'cartesian'             !  'spherical' 'cartesian'
+cn_rcv_tau_orient = 'eastward-northward'    !  'eastward-northward' or 'local grid'
+cn_rcv_tau_grid   = 'U,V'                   !  'T' 'U,V' 'U,V,F' 'U,V,I' 'T,F' 'T,I' 'T,U,V'
+cn_rcv_dqnsdt     = 'coupled'               !  'none' 'coupled'
+cn_rcv_qsr        = 'oce and ice'           !  'conservative' 'oce and ice' 'mixed oce-ice'
+cn_rcv_qns        = 'oce and ice'           !  'conservative' 'oce and ice' 'mixed oce-ice'
+cn_rcv_emp        = 'conservative'          !  'conservative' 'oce and ice' 'mixed oce-ice'
+cn_rcv_rnf        = 'coupled'               !  'coupled' 'climato' 'mixed'
+cn_rcv_cal        = 'coupled'               !  'none' 'coupled'
+/
+!-----------------------------------------------------------------------
+&namsbc_cpl_co2   !   coupled ocean/biogeo/atmosphere model             ("key_cpl_carbon_cycle")
+!-----------------------------------------------------------------------
+   cn_snd_co2     = 'coupled'         ! send    : 'none' 'coupled'
+   cn_rcv_co2     = 'coupled'         ! receive : 'none' 'coupled'
 /
 !-----------------------------------------------------------------------
 &namtra_qsr    !   penetrative solar radiation
 !-----------------------------------------------------------------------
-!              !   file name  ! frequency (hours) ! variable   ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
-!              !              !  (if <0  months)  !   name     !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
-   sn_chl      = 'chlorophyll',        -1         , 'CHLA'     ,    .true.      , .true.  , 'yearly'  , ''       , ''
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_chl      ='chlorophyll',        -1         , 'CHLA'    ,   .true.     , .true. , 'yearly'  , ''       , ''
  
    cn_dir      = './'      !  root directory for the location of the runoff files
    ln_traqsr   = .true.    !  Light penetration (T) or not (F)
-   ln_qsr_rgb  = .true.    !  RGB (Red-Green-Blue) light penetration
-   ln_qsr_2bd  = .false.   !  2 bands              light penetration
+   ln_qsr_rgb  = .false.   !  RGB (Red-Green-Blue) light penetration
+   ln_qsr_2bd  = .true.    !  2 bands              light penetration
    ln_qsr_bio  = .false.   !  bio-model light penetration
    nn_chldta   =      0    !  RGB : Chl data (=1) or cst value (=0)
@@ -205,28 +256,43 @@
    rn_si0      =   0.35    !  RGB & 2 bands: shortess depth of extinction
    rn_si1      =   23.0    !  2 bands: longest depth of extinction
-   rn_si2      =   62.0    !  3 bands: longest depth of extinction (for blue waveband & 0.01 mg/m2 Chl)
 /
 !-----------------------------------------------------------------------
 &namsbc_rnf    !   runoffs namelist surface boundary condition
 !-----------------------------------------------------------------------
-!              !   file name  ! frequency (hours) ! variable   ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
-!              !              !  (if <0  months)  !   name     !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
-   sn_rnf      = 'runoff_1m_nomask' ,  -1         , 'sorunoff' ,    .true.      , .true.  , 'yearly'  , ''       , ''
-   sn_cnf      = 'runoff_1m_nomask' ,   0         , 'socoefr'  ,    .false.     , .true.  , 'yearly'  , ''       , ''
- 
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_rnf      = 'runoff_core_monthly',    -1    , 'sorunoff',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_cnf      = 'runoff_core_monthly',     0    , 'socoefr0',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_s_rnf    = 'runoffs'            ,    24    , 'rosaline',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_t_rnf    = 'runoffs'            ,    24    , 'rotemper',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_dep_rnf  = 'runoffs'            ,     0    , 'rodepth' ,   .false.    , .true. , 'yearly'  , ''       , ''
+
    cn_dir       = './'      !  root directory for the location of the runoff files
-   ln_rnf_emp   =   .false. !  runoffs included into precipitation field (T) or into a file (F)
-   ln_rnf_mouth =   .false. !  specific treatment at rivers mouths
-   rn_hrnf      =   0.e0    !  depth over which enhanced vertical mixing is used
+   ln_rnf_emp   = .false.   !  runoffs included into precipitation field (T) or into a file (F)
+   ln_rnf_mouth = .false.   !  specific treatment at rivers mouths
+   rn_hrnf      =  15.e0    !  depth over which enhanced vertical mixing is used
    rn_avt_rnf   =   1.e-3   !  value of the additional vertical mixing coef. [m2/s]
    rn_rfact     =   1.e0    !  multiplicative factor for runoff
+   ln_rnf_depth = .false.   !  read in depth information for runoff
+   ln_rnf_tem   = .false.   !  read in temperature information for runoff
+   ln_rnf_sal   = .false.   !  read in salinity information for runoff
+/
+!-----------------------------------------------------------------------
+&namsbc_apr    !   Atmospheric pressure used as ocean forcing or in bulk
+!-----------------------------------------------------------------------
+!              ! file name ! frequency (hours) ! variable ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
+!              !           !  (if <0  months)  !   name   !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
+   sn_apr      = 'patm'    ,         -1        ,'somslpre',    .true.      , .true.  , 'yearly'  ,  ''      ,   ''
+
+   cn_dir      = './'      !  root directory for the location of the bulk files
+   ln_ref_apr  = .false.   !  ref. pressure: global mean Patm (T) or a constant (F)
 /
 !-----------------------------------------------------------------------
 &namsbc_ssr    !   surface boundary condition : sea surface restoring
 !-----------------------------------------------------------------------
-!              !   file name  ! frequency (hours) ! variable   ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
-!              !              !  (if <0  months)  !   name     !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
-   sn_sst      = 'sst_data'   ,        24         ,  'sst'     ,     .false.    , .false. , 'yearly'  , ''       , ''
-   sn_sss      = 'sss_data'   ,        -1         ,  'sss'     ,     .true.     , .true.  , 'yearly'  , ''       , ''
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_sst      = 'sst_data'  ,        24         ,  'sst'    ,    .false.   , .false., 'yearly'  , ''       , ''
+   sn_sss      = 'sss_data'  ,        -1         ,  'sss'    ,    .true.    , .true. , 'yearly'  , ''       , ''
     
    cn_dir      = './'      !  root directory for the location of the runoff files
@@ -237,5 +303,5 @@
    rn_deds     =   -27.7   !  magnitude of the damping on salinity   [mm/day]
    ln_sssr_bnd =   .false. !  flag to bound erp term (associated with nn_sssr=2)
-   rn_sssr_bnd =   0.e0    !  ABS(Max/Min) value of the damping erp term [mm/day]
+   rn_sssr_bnd =   4.e0    !  ABS(Max/Min) value of the damping erp term [mm/day]
 /      
 !-----------------------------------------------------------------------
@@ -259,5 +325,5 @@
 !!   namtide       Tidal forcing at open boundaries                     ("key_bdy_tides")
 !!======================================================================
-
+!
 !-----------------------------------------------------------------------
 &namlbc        !   lateral momentum boundary condition
@@ -274,20 +340,20 @@
 &namobc        !   open boundaries parameters                           ("key_obc")
 !-----------------------------------------------------------------------
-    ln_obc_clim= .false.   !  climatological obc data files (T) or not (F)
-    ln_vol_cst = .true.    !  impose the total volume conservation (T) or not (F)
-    ln_obc_fla = .false.   !  Flather open boundary condition 
-    nn_obcdta  =    1      !  = 0 the obc data are equal to the initial state
+   ln_obc_clim = .false.   !  climatological obc data files (T) or not (F)
+   ln_vol_cst  = .true.    !  impose the total volume conservation (T) or not (F)
+   ln_obc_fla  = .false.   !  Flather open boundary condition 
+   nn_obcdta   =    1      !  = 0 the obc data are equal to the initial state
                            !  = 1 the obc data are read in 'obc.dta' files
-    cn_obcdta  = 'annual'  !  set to annual if obc datafile hold 1 year of data
+   cn_obcdta   = 'annual'  !  set to annual if obc datafile hold 1 year of data
                            !  set to monthly if obc datafile hold 1 month of data
-    rn_dpein   =    1.     !  damping time scale for inflow at east  open boundary
-    rn_dpwin   =    1.     !     -           -         -       west    -      -
-    rn_dpnin   =    1.     !     -           -         -       north   -      -
-    rn_dpsin   =    1.     !     -           -         -       south   -      -
-    rn_dpeob   = 3000.     !  time relaxation (days) for the east  open boundary
-    rn_dpwob   =   15.     !     -           -         -     west    -      -
-    rn_dpnob   = 3000.     !     -           -         -     north   -      -
-    rn_dpsob   =   15.     !     -           -         -     south   -      -
-    rn_volemp  =  1.       !  = 0 the total volume change with the surface flux (E-P-R)
+   rn_dpein    =    1.     !  damping time scale for inflow at east  open boundary
+   rn_dpwin    =    1.     !     -           -         -       west    -      -
+   rn_dpnin    =    1.     !     -           -         -       north   -      -
+   rn_dpsin    =    1.     !     -           -         -       south   -      -
+   rn_dpeob    = 3000.     !  time relaxation (days) for the east  open boundary
+   rn_dpwob    =   15.     !     -           -         -     west    -      -
+   rn_dpnob    = 3000.     !     -           -         -     north   -      -
+   rn_dpsob    =   15.     !     -           -         -     south   -      -
+   rn_volemp   =    1.     !  = 0 the total volume change with the surface flux (E-P-R)
                            !  = 1 the total volume remains constant
 /
@@ -295,36 +361,40 @@
 &namagrif      !  AGRIF zoom                                            ("key_agrif")
 !-----------------------------------------------------------------------
-    nn_cln_update = 3      !  baroclinic update frequency
-    ln_spc_dyn    = .true. !  use 0 as special value for dynamics
-    rn_sponge_tra = 2880.  !  coefficient for tracer   sponge layer [s]
-    rn_sponge_dyn = 2880.  !  coefficient for dynamics sponge layer [s]
+   nn_cln_update =    3    !  baroclinic update frequency
+   ln_spc_dyn    = .true.  !  use 0 as special value for dynamics
+   rn_sponge_tra = 2880.   !  coefficient for tracer   sponge layer [m2/s]
+   rn_sponge_dyn = 2880.   !  coefficient for dynamics sponge layer [m2/s]
 /
 !-----------------------------------------------------------------------
 &nambdy        !  unstructured open boundaries                          ("key_bdy")
 !-----------------------------------------------------------------------
-    filbdy_mask    =  ''                  !  name of mask file (if ln_bdy_mask=.TRUE.)
-    filbdy_data_T  = 'bdydata_grid_T.nc'  !  name of data file (T-points)
-    filbdy_data_U  = 'bdydata_grid_U.nc'  !  name of data file (U-points)
-    filbdy_data_V  = 'bdydata_grid_V.nc'  !  name of data file (V-points)
-    ln_bdy_clim    = .false.              !  contain 1 (T) or 12 (F) time dumps and be cyclic
-    ln_bdy_vol     = .true.               !  total volume correction (see volbdy parameter)
-    ln_bdy_mask    = .false.              !  boundary mask from filbdy_mask (T) or boundaries are on edges of domain (F)
-    ln_bdy_tides   = .true.               !  Apply tidal harmonic forcing with Flather condition
-    ln_bdy_dyn_fla = .true.               !  Apply Flather condition to velocities
-    ln_bdy_tra_frs = .false.              !  Apply FRS condition to temperature and salinity 
-    ln_bdy_dyn_frs = .false.              !  Apply FRS condition to velocities
-    nbdy_dta       =  1                   !  = 0, bdy data are equal to the initial state
-                                          !  = 1, bdy data are read in 'bdydata   .nc' files
-    nb_rimwidth    = 9                    !  width of the relaxation zone
-    volbdy         = 0                    !  = 0, the total water flux across open boundaries is zero
-                                          !  = 1, the total volume of the system is conserved
-/
-!-----------------------------------------------------------------------
-&nambdy_tide     ! tidal forcing at unstructured boundaries              
-!-----------------------------------------------------------------------
-    filtide      = 'bdytide_'           !  file name root of tidal forcing files
-    tide_cpt     = 'M2','S1'            !  names of tidal components used
-    tide_speed   = 28.984106, 15.000001 !  phase speeds of tidal components (deg/hour)
-    ln_tide_date = .false.              !  adjust tidal harmonics for start date of run
+   cn_mask     =  ''                     !  name of mask file (ln_mask=T)
+   cn_dta_frs_T= 'bdydata_grid_T.nc'     !  name of data file (T-points)
+   cn_dta_frs_U= 'bdydata_grid_U.nc'     !  name of data file (U-points)
+   cn_dta_frs_V= 'bdydata_grid_V.nc'     !  name of data file (V-points)
+   cn_dta_fla_T= 'bdydata_bt_grid_T.nc'  !  name of data file for Flather condition (T-points)
+   cn_dta_fla_U= 'bdydata_bt_grid_U.nc'  !  name of data file for Flather condition (U-points)
+   cn_dta_fla_V= 'bdydata_bt_grid_V.nc'  !  name of data file for Flather condition (V-points)
+
+   ln_clim     = .false.   !  contain 1 (T) or 12 (F) time dumps and be cyclic
+   ln_vol      = .false.   !  total volume correction (see volbdy parameter)
+   ln_mask     = .false.   !  boundary mask from filbdy_mask (T), boundaries are on edges of domain (F)
+   ln_tides    = .false.   !  Apply tidal harmonic forcing with Flather condition
+   ln_dyn_fla  = .false.   !  Apply Flather condition to velocities
+   ln_tra_frs  = .false.   !  Apply FRS condition to temperature and salinity 
+   ln_dyn_frs  = .false.   !  Apply FRS condition to velocities
+   nn_rimwidth =  9        !  width of the relaxation zone
+   nn_dtactl   =  1        !  = 0, bdy data are equal to the initial state
+                           !  = 1, bdy data are read in 'bdydata   .nc' files
+   nn_volctl   =  0        !  = 0, the total water flux across open boundaries is zero
+                           !  = 1, the total volume of the system is conserved
+/
+!-----------------------------------------------------------------------
+&nambdy_tide   !  tidal forcing at unstructured boundaries              
+!-----------------------------------------------------------------------
+   filtide     = 'bdytide_'           !  file name root of tidal forcing files
+   tide_cpt    = 'M2','S1'            !  names of tidal components used
+   tide_speed  = 28.984106, 15.000001 !  phase speeds of tidal components (deg/hour)
+   ln_tide_date= .false.              !  adjust tidal harmonics for start date of run
 /
 
@@ -333,8 +403,8 @@
 !!======================================================================
 !!   nambfr        bottom friction
-!!   nambbc        bottom temperature boundary condition                ("key_trabbc")
-!!   nambbl        bottom boundary layer scheme                         ("key_trabbl_dif","key_trabbl_adv")
-!!======================================================================
-
+!!   nambbc        bottom temperature boundary condition               
+!!   nambbl        bottom boundary layer scheme                         ("key_trabbl")
+!!======================================================================
+!
 !-----------------------------------------------------------------------
 &nambfr        !   bottom friction
@@ -345,5 +415,5 @@
    rn_bfri2    =    1.e-3  !  bottom drag coefficient (non linear case)
    rn_bfeb2    =    2.5e-3 !  bottom turbulent kinetic energy background  (m^2/s^2)
-   ln_bfr2d    =   .false. !  horizontal variation of the bottom friction coef (read a 2D mask file )
+   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 = .true.)
 /
@@ -351,4 +421,5 @@
 &nambbc        !   bottom temperature boundary condition
 !-----------------------------------------------------------------------
+   ln_trabbc   = .false.   !  Apply a geothermal heating at the ocean bottom
    nn_geoflx   =    0      !  geothermal heat flux: = 0 no flux 
                            !     = 1 constant flux
@@ -359,8 +430,10 @@
 &nambbl        !   bottom boundary layer scheme
 !-----------------------------------------------------------------------
-!                          !  diffusive bbl                             ("key_trabbl")
-!                          !  advective bbl                             ("key_trabbl_adv")
-   rn_ahtbbl   =  10000.   !  lateral mixing coefficient in the bbl  [m2/s]
-/
+   nn_bbl_ldf  =  1      !  diffusive bbl (=1)   or not (=0)
+   nn_bbl_adv  =  0      !  advective bbl (=1/2) or not (=0)
+   rn_ahtbbl   =  1000.  !  lateral mixing coefficient in the bbl  [m2/s]
+   rn_gambbl   =  10.    !  advective bbl coefficient                 [s]
+/
+
 !!======================================================================
 !!                        Tracer (T & S ) namelists
@@ -371,14 +444,14 @@
 !!   namtra_dmp    T & S newtonian damping                              ("key_tradmp")
 !!======================================================================
-
+!
 !-----------------------------------------------------------------------
 &nameos        !   ocean physical parameters
 !-----------------------------------------------------------------------
-   nn_eos      =    2      !  type of equation of state and Brunt-Vaisala frequency
+   nn_eos      =   2       !  type of equation of state and Brunt-Vaisala frequency
                            !     = 0, UNESCO (formulation of Jackett and McDougall (1994) and of McDougall (1987) )
                            !     = 1, linear: rho(T)   = rau0 * ( 1.028 - ralpha * T )
                            !     = 2, linear: rho(T,S) = rau0 * ( rbeta * S - ralpha * T )
-   rn_alpha    =    2.e-4  !  thermal expension coefficient (neos= 1 or 2)
-   rn_beta     =    7.7e-4 !  saline  expension coefficient (neos= 2)
+   rn_alpha    =   2.0e-4  !  thermal expension coefficient (nn_eos= 1 or 2)
+   rn_beta     =   7.7e-4  !  saline  expension coefficient (nn_eos= 2)
 /
 !-----------------------------------------------------------------------
@@ -390,19 +463,22 @@
    ln_traadv_muscl2 =  .false.  !  MUSCL2 scheme + cen2 at boundaries  
    ln_traadv_ubs    =  .false.  !  UBS scheme                 
+   ln_traadv_qck    =  .false.  !  QUCIKEST scheme                 
 /
 !-----------------------------------------------------------------------
 &namtra_ldf    !   lateral diffusion scheme for tracer 
 !-----------------------------------------------------------------------
-                           !  Type of the operator : 
-   ln_traldf_lap    =  .true.   !     laplacian operator       
-   ln_traldf_bilap  =  .false.  !     bilaplacian operator     
-                           !  Direction of action  :
-   ln_traldf_level  =  .false.  !     iso-level                
-   ln_traldf_hor    =  .false.  !     horizontal (geopotential)         (require "key_ldfslp" when ln_sco=T)
-   ln_traldf_iso    =  .true.   !     iso-neutral                       (require "key_ldfslp")
-                           !  Coefficient
-   rn_aht_0         =  1000.    !     horizontal eddy diffusivity for tracers [m2/s]
-   rn_ahtb_0        =     0.    !     background eddy diffusivity for ldf_iso [m2/s]
-   rn_aeiv_0        =     0.    !     eddy induced velocity coefficient [m2/s]    (require "key_traldf_eiv")
+   !                       !  Type of the operator : 
+   ln_traldf_lap    =  .true.   !  laplacian operator       
+   ln_traldf_bilap  =  .false.  !  bilaplacian operator     
+   !                       !  Direction of action  :
+   ln_traldf_level  =  .false.  !  iso-level                
+   ln_traldf_hor    =  .false.  !  horizontal (geopotential)            (require "key_ldfslp" when ln_sco=T)
+   ln_traldf_iso    =  .true.   !  iso-neutral                          (require "key_ldfslp")
+   ln_traldf_grif   =  .false.  !  griffies skew flux formulation       (require "key_ldfslp")  ! UNDER TEST, DO NOT USE
+   ln_traldf_gdia   =  .false.  !  griffies operator strfn diagnostics  (require "key_ldfslp")  ! UNDER TEST, DO NOT USE
+   !                       !  Coefficient
+   rn_aht_0         =  1000.    !  horizontal eddy diffusivity for tracers [m2/s]
+   rn_ahtb_0        =     0.    !  background eddy diffusivity for ldf_iso [m2/s]
+   rn_aeiv_0        =     0.    !  eddy induced velocity coef. [m2/s]   (require "key_traldf_eiv")
 /
 !-----------------------------------------------------------------------
@@ -420,4 +496,5 @@
    nn_file     =    1      !  create a damping.coeff NetCDF file (=1) or not (=0)
 /
+
 !!======================================================================
 !!                      ***  Dynamics namelists  ***
@@ -429,5 +506,5 @@
 !!   namdyn_ldf    lateral diffusion scheme
 !!======================================================================
-
+!
 !-----------------------------------------------------------------------
 &namdyn_adv    !   formulation of the momentum advection
@@ -469,26 +546,28 @@
 &namdyn_ldf    !   lateral diffusion on momentum
 !-----------------------------------------------------------------------
-                           !  Type of the operator : 
+   !                       !  Type of the operator : 
    ln_dynldf_lap    =  .true.   !  laplacian operator         
    ln_dynldf_bilap  =  .false.  !  bilaplacian operator    
-                           !  Direction of action  : 
+   !                       !  Direction of action  : 
    ln_dynldf_level  =  .false.  !  iso-level               
    ln_dynldf_hor    =  .true.   !  horizontal (geopotential)            (require "key_ldfslp" in s-coord.)
    ln_dynldf_iso    =  .false.  !  iso-neutral                          (require "key_ldfslp")
-                           !  Coefficient
-   rn_ahm_0    = 100000.        !  horizontal eddy viscosity   [m2/s]
-   rn_ahmb_0   =     0.         !  background eddy viscosity for ldf_iso [m2/s]
-/
+   !                       !  Coefficient
+   rn_ahm_0_lap     = 100000.   !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahmb_0        =     0.    !  background eddy viscosity for ldf_iso [m2/s]
+   rn_ahm_0_blp     =     0.    !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+
 !!======================================================================
 !!             Tracers & Dynamics vertical physics namelists
 !!======================================================================
-!!       namzdf        vertical physics
-!!       namzdf_ric    richardson number dependent vertical mixing      ("key_zdfric"      )
-!!       namzdf_tke    TKE dependent vertical mixing                    ("key_zdftke"      )
-!!       namzdf_kpp    KPP dependent vertical mixing                    ("key_zdfkpp"      )
-!!       namzdf_ddm    double diffusive mixing parameterization         ("key_zdfddm"      )
-!!       namzdf_tmx    tidal mixing parameterization                    ("key_zdftmx"      )
-!!======================================================================
-
+!!    namzdf        vertical physics
+!!    namzdf_ric    richardson number dependent vertical mixing         ("key_zdfric")
+!!    namzdf_tke    TKE dependent vertical mixing                       ("key_zdftke")
+!!    namzdf_kpp    KPP dependent vertical mixing                       ("key_zdfkpp")
+!!    namzdf_ddm    double diffusive mixing parameterization            ("key_zdfddm")
+!!    namzdf_tmx    tidal mixing parameterization                       ("key_zdftmx")
+!!======================================================================
+!
 !-----------------------------------------------------------------------
 &namzdf        !   vertical physics
@@ -501,5 +580,5 @@
    nn_evdm     =    1      !  evd apply on tracer (=0) or on tracer and momentum (=1)
    rn_avevd    =  100.     !  evd mixing coefficient [m2/s]
-   ln_zdfnpc   = .false.   !  Non-Penetrative algorithm (T) or not (F)
+   ln_zdfnpc   = .false.   !  Non-Penetrative Convective algorithm (T) or not (F)
    nn_npc      =    1            !  frequency of application of npc
    nn_npcp     =  365            !  npc control print frequency
@@ -519,35 +598,28 @@
    rn_ediff    =   0.1     !  coef. for vertical eddy coef. (avt=rn_ediff*mxl*sqrt(e) )
    rn_ediss    =   0.7     !  coef. of the Kolmogoroff dissipation
-   rn_ebb      =   3.75    !  coef. of the surface input of tke
-   rn_emin     =   1.e-5   !  minimum value of tke [m2/s2]
+   rn_ebb      =  67.83    !  coef. of the surface input of tke (=67.83 suggested when ln_mxl0=T)
+   rn_emin     =   1.e-6   !  minimum value of tke [m2/s2]
    rn_emin0    =   1.e-4   !  surface minimum value of tke [m2/s2]
-   rn_bshear   =   1.e-20  !  background shear (>0)
    nn_mxl      =   2       !  mixing length: = 0 bounded by the distance to surface and bottom
                            !                 = 1 bounded by the local vertical scale factor
                            !                 = 2 first vertical derivative of mixing length bounded by 1
-                           !                 = 3 same criteria as case 2 but applied in a different way
+                           !                 = 3 as =2 with distinct disspipative an mixing length scale
    nn_pdl      =   1       !  Prandtl number function of richarson number (=1, avt=pdl(Ri)*avm) or not (=0, avt=avm)
-   ln_mxl0     = .false.   !  mixing length scale surface value as function of wind stress (T) or not (F)
-   rn_lmin     =   0.4     !  interior buoyancy lenght scale minimum value
-   rn_lmin0    =   0.4     !  surface  buoyancy lenght scale minimum value
-   nn_etau     =   0       !  exponentially deceasing penetration of tke due to internal & intertial waves
-                           !        = 0 no penetration ( O(2 km) resolution)
-                           !        = 1 additional tke source (rn_efr * en)
-                           !        = 2 additional tke source (rn_efr * en) applied only at the base of the mixed layer
-                           !        = 3 additional tke source (HF contribution: mean of stress module - module of mean stress)
-   nn_htau     =   1       !  type of exponential decrease of tke penetration
+   ln_mxl0     = .true.    !  surface mixing length scale = F(wind stress) (T) or not (F)
+   rn_mxl0     =   0.04    !  surface  buoyancy lenght scale minimum value
+   ln_lc       = .true.    !  Langmuir cell parameterisation (Axell 2002)
+   rn_lc       =   0.15    !  coef. associated to Langmuir cells
+   nn_etau     =   0       !  penetration of tke below the mixed layer (ML) due to internal & intertial waves
+                           !        = 0 no penetration
+                           !        = 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")
+   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
                            !        = 0  constant 10 m length scale
-                           !        = 1  0.5m at the equator to 30m at high latitudes
-                           !        = 2  30 meters constant depth penetration
-                           !  otion used only if nn_etau = 1 or 2: 
-   rn_efr      =   0.05    !     fraction of surface tke value which penetrates inside the ocean
-                           !  otion used only if nn_etau = 3:
-   rn_addhft   =  -1.e-3   !     add offset   applied to the "mean of stress module - module of mean stress" (always kept > 0)
-   rn_sclhft   =   1.      !     scale factor applied to the "mean of stress module - module of mean stress"
-   ln_lc       = .false.   !  Langmuir cell parameterisation
-   rn_lc       =   0.15    !  coef. associated to Langmuir cells
+                           !        = 1  0.5m at the equator to 30m poleward of 40 degrees
 /
 !------------------------------------------------------------------------
-&namzdf_kpp    !   K-Profile Parameterization dependent vertical mixing  ("key_zdfkpp", and optionnally:
+&namzdf_kpp    !   K-Profile Parameterization dependent vertical mixing  ("key_zdfkpp", and optionally:
 !------------------------------------------------------------------------ "key_kppcustom" or "key_kpplktb")
    ln_kpprimix = .true.    !  shear instability mixing 
@@ -562,4 +634,22 @@
 /
 !-----------------------------------------------------------------------
+&namzdf_gls                !   GLS vertical diffusion                   ("key_zdfgls")
+!-----------------------------------------------------------------------
+   rn_emin       = 1.e-6   !  minimum value of e   [m2/s2]
+   rn_epsmin     = 1.e-12  !  minimum value of eps [m2/s3]
+   ln_length_lim = .true.  !  limit on the dissipation rate under stable stratification (Galperin et al., 1988)
+   rn_clim_galp  = 0.53    !  galperin limit
+   ln_crban      = .true.  !  Use Craig & Banner (1994) surface wave mixing parametrisation
+   ln_sigpsi     = .true.  !  Activate or not Burchard 2001 mods on psi schmidt number in the wb case
+   rn_crban      = 100.    !  Craig and Banner 1994 constant for wb tke flux
+   rn_charn      = 70000.  !  Charnock constant for wb induced roughness length
+   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)
+/
+!-----------------------------------------------------------------------
 &namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
 !-----------------------------------------------------------------------
@@ -574,7 +664,8 @@
    rn_tfe      = 0.333     !  tidal dissipation efficiency
    rn_me       = 0.2       !  mixing efficiency 
-   ln_tmx_itf  = .FALSE.   !  ITF specific parameterisation
+   ln_tmx_itf  = .false.   !  ITF specific parameterisation
    rn_tfe_itf  = 1.        !  ITF tidal dissipation efficiency
 /
+
 !!======================================================================
 !!                  ***  Miscelaneous namelists  ***
@@ -585,5 +676,5 @@
 !!   namsol            elliptic solver / island / free surface 
 !!======================================================================
-
+!
 !-----------------------------------------------------------------------
 &namsol        !   elliptic solver / island / free surface 
@@ -602,5 +693,5 @@
 &nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
 !-----------------------------------------------------------------------
-   cn_mpi_send =  'S'      !  mpi send/recieve type   ='S', 'B', or 'I' for standard send,
+   cn_mpi_send =  'I'      !  mpi send/recieve type   ='S', 'B', or 'I' for standard send,
                            !  buffer blocking send or immediate non-blocking sends, resp.
    nn_buffer   =   0       !  size in bytes of exported buffer ('B' case), 0 no exportation
@@ -626,20 +717,30 @@
    nn_bench    =    0      !  Bench mode (1/0): CAUTION use zero except for bench
                            !     (no physical validity of the results)
-   nn_bit_cmp  =    0      !  bit comparison mode (1/0): CAUTION use zero except for test
-                           !     of comparison between single and multiple processor runs
-/
-
-!!======================================================================
-!!                       ***  Diagnostics namelists  ***
-!!======================================================================
+/
+
+!!======================================================================
+!!                  ***  Diagnostics namelists  ***
+!!======================================================================
+!!   namnc4       netcdf4 chunking and compression settings             ("key_netcdf4")
 !!   namtrd       dynamics and/or tracer trends                         ("key_trddyn","key_trdtra","key_trdmld")
-!!   namgap       level mean model-data gap                             ("key_diagap")
 !!   namflo       float parameters                                      ("key_float")
 !!   namptr       Poleward Transport Diagnostics
-!!======================================================================
-
+!!   namhsb       Heat and salt budgets 
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namnc4        !   netcdf4 chunking and compression settings            ("key_netcdf4")
+!-----------------------------------------------------------------------
+   nn_nchunks_i=   4       !  number of chunks in i-dimension
+   nn_nchunks_j=   4       !  number of chunks in j-dimension
+   nn_nchunks_k=   31      !  number of chunks in k-dimension
+                           !  setting nn_nchunks_k = jpk will give a chunk size of 1 in the vertical which
+                           !  is optimal for postprocessing which works exclusively with horizontal slabs
+   ln_nc4zip   = .true.    !  (T) use netcdf4 chunking and compression
+                           !  (F) ignore chunking information and produce netcdf3-compatible files
+/
 !-----------------------------------------------------------------------
 &namtrd        !   diagnostics on dynamics and/or tracer trends         ("key_trddyn" and/or "key_trdtra")
-!              !       or mixed-layer trends or barotropic vorticity    ('key_trdmld' or  "key_trdvor")
+!              !       or mixed-layer trends or barotropic vorticity    ("key_trdmld" or     "key_trdvor")
 !-----------------------------------------------------------------------
    nn_trd      = 365       !  time step frequency dynamics and tracers trends
@@ -652,17 +753,11 @@
 /
 !-----------------------------------------------------------------------
-&namgap       !   level mean model-data gap                             ('key_diagap')
-!-----------------------------------------------------------------------
-   nn_gap     =  15        !  time-step frequency of model-data gap computation
-   nn_prg     =  10        !  time-step frequency of gap print in model output
-/
-!-----------------------------------------------------------------------
 &namflo       !   float parameters                                      ("key_float")
 !-----------------------------------------------------------------------
-    ln_rstflo = .false.    !  float restart (T) or not (F)
-    nn_writefl=      75    !  frequency of writing in float output file 
-    nn_stockfl=    5475    !  frequency of creation of the float restart file 
-    ln_argo   = .false.    !  Argo type floats (stay at the surface each 10 days)
-    ln_flork4 = .false.    !  trajectories computed with a 4th order Runge-Kutta (T)
+   ln_rstflo  = .false.    !  float restart (T) or not (F)
+   nn_writefl =      75    !  frequency of writing in float output file 
+   nn_stockfl =    5475    !  frequency of creation of the float restart file 
+   ln_argo    = .false.    !  Argo type floats (stay at the surface each 10 days)
+   ln_flork4  = .false.    !  trajectories computed with a 4th order Runge-Kutta (T)
                            !  or computed with Blanke' scheme (F)
 /
@@ -671,8 +766,104 @@
 !-----------------------------------------------------------------------
    ln_diaptr  = .false.    !  Poleward heat and salt transport (T) or not (F)
-   ln_diaznl  = .false.    !  Add zonal means and meridional stream functions
-   ln_subbas  = .false.    !  Atlantic/Pacific/Indian basins computation (T) or not 
+   ln_diaznl  = .true.     !  Add zonal means and meridional stream functions
+   ln_subbas  = .true.     !  Atlantic/Pacific/Indian basins computation (T) or not 
                            !  (orca configuration only, need input basins mask file named "subbasins.nc"
-   nf_ptr     =  1         !  Frequency of ptr computation [time step]
-   nf_ptr_wri =  15        !  Frequency of ptr outputs
-/
+   ln_ptrcomp = .true.     !  Add decomposition : overturning
+   nn_fptr    =  1         !  Frequency of ptr computation [time step]
+   nn_fwri    =  15        !  Frequency of ptr outputs [time step]
+/
+!-----------------------------------------------------------------------
+&namhsb       !  Heat and salt budgets 
+!-----------------------------------------------------------------------
+   ln_diahsb  = .false.    !  check the heat and salt budgets (T) or not (F)
+/
+
+!!======================================================================
+!!            ***  Observation & Assimilation namelists ***
+!!======================================================================
+!!   namobs       observation and model comparison                      ('key_diaobs')
+!!   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               Logical switch for Reynolds observations       
+                           !     ln_ghrsst               Logical switch for GHRSST observations          
+
+   ln_sstfb   = .false.    ! Logical switch for feedback SST data          
+                           !     ln_sss                  Logical switch for SSS observations              
+                           !     ln_seaice               Logical switch for Sea Ice observations        
+                           !     ln_vel3d                Logical switch for velocity observations         
+                           !     ln_velavcur             Logical switch for velocity daily av. cur.    
+                           !     ln_velhrcur             Logical switch for velocity high freq. cur.   
+                           !     ln_velavadcp            Logical switch for velocity daily av. ADCP  
+                           !     ln_velhradcp            Logical switch for velocity high freq. ADCP
+                           !     ln_velfb                Logical switch for feedback velocity data       
+                           !     ln_grid_global          Global distribtion of observations         
+                           !     ln_grid_search_lookup   Logical switch for obs grid search w/lookup table  
+                           !     grid_search_file        Grid search lookup file header 
+                           !     enactfiles              ENACT input observation file names 
+                           !     coriofiles              Coriolis input observation file name  
+   !                       ! profbfiles: Profile feedback input observation file name 
+   profbfiles = 'profiles_01.nc'
+                           !     ln_profb_enatim         Enact feedback input time setting switch    
+                           !     slafilesact             Active SLA input observation file name
+                           !     slafilespas             Passive SLA input observation file name 
+   !                       ! slafbfiles: Feedback SLA input observation file name 
+   slafbfiles = 'sla_01.nc'
+                           !     sstfiles                GHRSST input observation file name       
+   !                       ! sstfbfiles: Feedback SST input observation file name 
+   sstfbfiles = 'sst_01.nc' 'sst_02.nc' 'sst_03.nc' 'sst_04.nc' 'sst_05.nc'
+                           !     seaicefiles             Sea Ice input observation file name 
+                           !     velavcurfiles           Vel. cur. daily av. input file name  
+                           !     velhvcurfiles           Vel. cur. high freq. input file name  
+                           !     velavadcpfiles          Vel. ADCP daily av. input file name    
+                           !     velhvadcpfiles          Vel. ADCP high freq. input file name 
+                           !     velfbfiles              Vel. feedback input observation file name 
+                           !     dobsini                 Initial date in window YYYYMMDD.HHMMSS       
+                           !     dobsend                 Final date in window YYYYMMDD.HHMMSS         
+                           !     n1dint                  Type of vertical interpolation method        
+                           !     n2dint                  Type of horizontal interpolation method       
+                           !     ln_nea                  Rejection of observations near land switch    
+   nmsshc     = 0          ! MSSH correction scheme                         
+                           !     mdtcorr                 MDT  correction                               
+                           !     mdtcutoff               MDT cutoff for computed correction          
+   ln_altbias = .false.    ! Logical switch for alt bias                
+   ln_ignmis  = .true.     ! Logical switch for ignoring missing files   
+                           !     endailyavtypes   ENACT daily average types                    
+   ln_grid_global = .true.
+   ln_grid_search_lookup = .false.
+/ 
+!-----------------------------------------------------------------------
+&nam_asminc   !   assimilation increments                               ('key_asminc')
+!-----------------------------------------------------------------------
+    ln_bkgwri = .false.    !  Logical switch for writing out background state 
+    ln_trjwri = .false.    !  Logical switch for writing out state trajectory
+    ln_trainc = .false.    !  Logical switch for applying tracer increments
+    ln_dyninc = .false.    !  Logical switch for applying velocity increments
+    ln_sshinc = .false.    !  Logical switch for applying SSH increments 
+    ln_asmdin = .false.    !  Logical switch for Direct Initialization (DI)
+    ln_asmiau = .false.    !  Logical switch for Incremental Analysis Updating (IAU)
+    nitbkg    = 0          !  Timestep of background in [0,nitend-nit000-1]
+    nitdin    = 0          !  Timestep of background for DI in [0,nitend-nit000-1]
+    nitiaustr = 1          !  Timestep of start of IAU interval in [0,nitend-nit000-1]
+    nitiaufin = 15         !  Timestep of end of IAU interval in [0,nitend-nit000-1]
+    niaufn    = 0          !  Type of IAU weighting function
+    nittrjfrq = 0          !  Frequency of trajectory output for 4D-VAR
+    ln_salfix = .false.    !  Logical switch for ensuring that the sa > salfixmin
+    salfixmin = -9999      !  Minimum salinity after applying the increments
+/
Index: trunk/NEMOGCM/CONFIG/GYRE/EXP00/xmlio_server.def
===================================================================
--- trunk/NEMOGCM/CONFIG/GYRE/EXP00/xmlio_server.def	(revision 2527)
+++ trunk/NEMOGCM/CONFIG/GYRE/EXP00/xmlio_server.def	(revision 2528)
@@ -17,4 +17,19 @@
   global_mpi_buffer_size = 512
 /  
+
+!!======================================================================
+!!   namnc4            netcdf4 chunking and compression settings
+!!======================================================================
+!-----------------------------------------------------------------------
+&namnc4         !  netcdf4 chunking and compression settings
+                !  (benign if "key_netcdf4" is not used)
+!-----------------------------------------------------------------------
+   nn_nchunks_i   =   4       !  number of chunks in i-dimension
+   nn_nchunks_j   =   4       !  number of chunks in j-dimension
+   nn_nchunks_k   =   31      !  number of chunks in k-dimension
+                              !  setting nn_nchunks_k = jpk will give a chunk size of 1 in the vertical which
+                              !  is optimal for postprocessing which works exclusively with horizontal slabs
+   ln_nc4zip      =   .TRUE.  !  (T) use netcdf4 chunking and compression
+                              !  (F) ignore chunking information and produce netcdf3-compatible files  
+/
   
-  
Index: trunk/NEMOGCM/CONFIG/GYRE/cpp_GYRE.fcm
===================================================================
--- trunk/NEMOGCM/CONFIG/GYRE/cpp_GYRE.fcm	(revision 2528)
+++ trunk/NEMOGCM/CONFIG/GYRE/cpp_GYRE.fcm	(revision 2528)
@@ -0,0 +1,1 @@
+ bld::tool::fppkeys key_gyre key_dynspg_flt key_ldfslp key_zdftke key_vectopt_loop key_iomput key_nproci=1 key_nprocj=1
Index: trunk/NEMOGCM/CONFIG/GYRE_LOBSTER/AA_make
===================================================================
--- trunk/NEMOGCM/CONFIG/GYRE_LOBSTER/AA_make	(revision 2527)
+++ 	(revision )
@@ -1,13 +1,0 @@
-# $Id: $
-all: ioipsl opa
-
-ioipsl:
-	(cd ../../modeles/IOIPSL/src; $(M_K) ;)
-
-
-opa:
-	(cd ../../modeles/NEMO/WORK;  $(M_K) ;)
-
-
-clean:
-	(cd ../../modeles/NEMO/WORK;  $(M_K) clean ;)
Index: trunk/NEMOGCM/CONFIG/GYRE_LOBSTER/AA_make.ldef
===================================================================
--- trunk/NEMOGCM/CONFIG/GYRE_LOBSTER/AA_make.ldef	(revision 2527)
+++ 	(revision )
@@ -1,11 +1,0 @@
-#---------------------------------------------------------------------
-#- Creation des elements relatifs a ORCA :
-#-      ORCA  (lib, executable : opa)
-#---------------------------------------------------------------------
-SHELL = /bin/sh
-#---------------------------------------------------------------------
-LIBDIR = ../../../../lib
-BINDIR = ../../../../bin
-MODDIR = $(LIBDIR)
-#---------------------------------------------------------------------
-#-
Index: trunk/NEMOGCM/CONFIG/GYRE_LOBSTER/EXP00/AA_job
===================================================================
--- trunk/NEMOGCM/CONFIG/GYRE_LOBSTER/EXP00/AA_job	(revision 2527)
+++ trunk/NEMOGCM/CONFIG/GYRE_LOBSTER/EXP00/AA_job	(revision 2528)
@@ -97,7 +97,4 @@
 cp ${R_EXPER}/namelist_top     namelist_top
 cp ${R_EXPER}/namelist_lobster namelist_lobster
-cp ${R_EXPER}/iodef.xml .
-cp ${R_EXPER}/xmlio_server.def .
-
 ls -alF
 
Index: trunk/NEMOGCM/CONFIG/GYRE_LOBSTER/EXP00/iodef.xml
===================================================================
--- trunk/NEMOGCM/CONFIG/GYRE_LOBSTER/EXP00/iodef.xml	(revision 2527)
+++ trunk/NEMOGCM/CONFIG/GYRE_LOBSTER/EXP00/iodef.xml	(revision 2528)
@@ -54,6 +54,6 @@
       <group id="SBC" axis_ref="none" grid_ref="grid_T" > <!-- time step automaticaly defined based on nn_fsbc -->
 
-	<field id="emp"          description="Net Upward Water Flux"                                        unit="kg/m2/s"  />
-	<field id="emps"         description="concentration/dilution water flux"                            unit="kg/m2/s"  />
+	<field id="emp-rnf"      description="Net Upward Water Flux"                                        unit="kg/m2/s"  />
+	<field id="emps-rnf"     description="concentration/dilution water flux"                            unit="kg/m2/s"  />
 	<field id="snowpre"      description="Snow precipitation"                                           unit="kg/m2/s"  />
 	<field id="runoffs"      description="River Runoffs"                                                unit="Kg/m2/s"  />
@@ -133,9 +133,10 @@
 	<field id="utau"         description="Wind Stress along i-axis"                    unit="N/m2" axis_ref="none" />
 	<field id="uoce"         description="ocean current along i-axis"                  unit="m/s"                  />
-	<field id="uoce_eff"     description="Effective ocean current along i-axis"        unit="m/s"                  />
+	<field id="uoce_eff"     description="Effective ocean transport along i-axis"      unit="m3/s"                  />
 	<!-- uoce_eiv: available with key_traldf_eiv and key_diaeiv -->
 	<field id="uoce_eiv"     description="EIV ocean current along i-axis"              unit="m/s"                  />
 	<!-- uoce_eiv: available with key_trabbl_adv -->
 	<field id="uoce_bbl"     description="BBL ocean current along i-axis"              unit="m/s"                  />
+	<field id="ahu_bbl"      description="BBL diffusive flux along i-axis"             unit="m3/s" axis_ref="none" />
  	<!-- variables available with key_diaar5 -->
 	<field id="u_masstr"     description="ocean eulerian mass transport along i-axis"  unit="kg/s"                 />
@@ -150,9 +151,10 @@
 	<field id="vtau"         description="Wind Stress along j-axis"                    unit="N/m2" axis_ref="none" />
 	<field id="voce"         description="ocean current along j-axis"                  unit="m/s"                  />
-	<field id="voce_eff"     description="Effective ocean current along j-axis"        unit="m/s"                  />
+	<field id="voce_eff"     description="Effective ocean transport along j-axis"      unit="m3/s"                  />
 	<!-- voce_eiv: available with key_traldf_eiv and key_diaeiv -->
 	<field id="voce_eiv"     description="EIV ocean current along j-axis"              unit="m/s"                  />
 	<!-- voce_eiv: available with key_trabbl_adv -->
 	<field id="voce_bbl"     description="BBL ocean current along j-axis"              unit="m/s"                  />
+	<field id="ahv_bbl"      description="BBL diffusive flux along j-axis"             unit="m3/s" axis_ref="none" />
 	<!-- variables available with key_diaar5 -->
 	<field id="v_masstr"     description="ocean eulerian mass transport along j-axis"  unit="kg/s"                 />
@@ -166,9 +168,8 @@
       <group id="grid_W"  axis_ref="depthw" grid_ref="grid_W">
 	<field id="woce"         description="ocean vertical velocity"                     unit="m/s"                  />
-	<field id="woce_eff"     description="effective ocean vertical velocity"           unit="m/s"                  />
+	<field id="woce_eff"     description="effective ocean vertical transport"          unit="m3/s"                 />
 	<!-- woce_eiv: available with key_traldf_eiv and key_diaeiv -->
 	<field id="woce_eiv"     description="EIV ocean vertical velocity"                 unit="m/s"                  />
 	<!-- woce_eiv: available with key_trabbl_adv -->
-	<field id="woce_bbl"     description="BBL ocean vertical velocity"                 unit="m/s"                  />
 	<field id="avt"          description="vertical eddy diffusivity"                   unit="m2/s"                 />
 	<field id="avm"          description="vertical eddy viscosity"                     unit="m2/s"                 />
@@ -272,18 +273,4 @@
 
       <group id="2d" output_freq="172800" output_level="10" enabled=".TRUE.">                      <!-- 2d files -->
-
-        <file id="2d_grid_T" name="auto" description="ocean T grid variables" >
-          <field ref="sst"          name="sosstsst"  />
-          <field ref="sss"          name="sosaline"  />
-          <field ref="ssh"          name="sossheig"  />
-        </file>
-
-       <file id="2d_ptrc_T" name="auto" description="lobster sms variables" >
-         <field ref="ZOO"      />
-         <field ref="PHY"      />
-         <field ref="NO3"      />
-       </file>
-
-
       </group>
 
@@ -296,7 +283,7 @@
           <field ref="sss"          name="sosaline"  />
           <field ref="ssh"          name="sossheig"  />
-          <field ref="emp"          name="sowaflup"  />
+          <field ref="emp-rnf"      name="sowaflup"  />
           <field ref="qsr"          name="soshfldo"  />
-          <field ref="emps"         name="sowaflcd"  />
+          <field ref="emps-rnf"     name="sowaflcd"  />
           <field ref="qns+qsr"      name="sohefldo"  />
           <field ref="mldr10_1"     name="somxl010"  />
Index: trunk/NEMOGCM/CONFIG/GYRE_LOBSTER/EXP00/namelist
===================================================================
--- trunk/NEMOGCM/CONFIG/GYRE_LOBSTER/EXP00/namelist	(revision 2527)
+++ trunk/NEMOGCM/CONFIG/GYRE_LOBSTER/EXP00/namelist	(revision 2528)
@@ -1,678 +1,1 @@
-!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-!! NEMO/OPA  :  1 - run manager      (namrun)
-!! namelists    2 - Domain           (namzgr, namzgr_sco, namdom)
-!!              3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core
-!!                                    namsbc_cpl, namqsr, namsbc_rnf, namsbc_ssr, namsbc_alb)
-!!              4 - lateral boundary (namlbc, namcla, namobc, namagrif, nambdy, nambdy_tide)
-!!              5 - bottom  boundary (nambfr, nambbc, nambbl)
-!!              6 - Tracer           (nameos, namtra_adv, namtra_ldf, namtra_dmp)
-!!              7 - dynamics         (namdyn_adv, namdyn_vor, namdyn_hpg, namdyn_spg, namdyn_ldf)
-!!              8 - Verical physics  (namzdf, namzdf_ric, namzdf_tke, namzdf_kpp, namzdf_ddm, namzdf_tmx)
-!!              9 - diagnostics      (namtrd, namgap, namspr, namflo, namptr)
-!!              9 - miscellaneous    (namsol, nammpp, nammpp_dyndist, namctl)
-!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-!  CAUTION: some scripts does not support CAPITALs for logical use .true./.false., not .TRUE./.FALSE.
-
-!!======================================================================
-!!                   ***  Run management namelists  ***
-!!======================================================================
-!!   namrun            parameters of the run
-!!======================================================================
-
-!-----------------------------------------------------------------------
-&namrun        !   parameters of the run
-!-----------------------------------------------------------------------
-   nn_no       =       0   !  job number
-   cn_exp      =  "GYREL"  !  experience name 
-   nn_it000    =       1   !  first time step
-   nn_itend    =    4320   !  last  time step (std 5475)
-   nn_date0    =  010101   !  initial calendar date yymmdd (used if nrstdt=1)
-   nn_leapy    =      30   !  Leap year calendar (1) or not (0)
-   nn_istate   =       0   !  output the initial state (1) or not (0)
-   nn_stock    =    4320   !  frequency of creation of a restart file (modulo referenced to 1)
-   nn_write    =     360   !  frequency of write in the output file   (modulo referenced to nit000)
-   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
-   nn_chunksz  = 0         !  chunksize (bytes) for NetCDF file (working only with iom_nf90 routines)
-   ln_rstart   = .false.   !  start from rest (F) or from a restart file (T)
-   nn_rstctl   =       0       !  restart control = 0 nit000 is not compared to the restart file value
-                               !                  = 1 use ndate0 in namelist (not the value in the restart file)
-                               !                  = 2 calendar parameters read in the restart file
-   cn_ocerst_in  = "restart"   !  suffix of ocean restart name (input)
-   cn_ocerst_out = "restart"   !  suffix of ocean restart name (output)
-/
-!!======================================================================
-!!                      ***  Domain namelists  ***
-!!======================================================================
-!!   namzgr       vertical coordinate
-!!   namzgr_sco   s-coordinate or hybrid z-s-coordinate
-!!   namdom       space and time domain (bathymetry, mesh, timestep)
-!!======================================================================
-
-!-----------------------------------------------------------------------
-&namzgr        !   vertical coordinate
-!-----------------------------------------------------------------------
-   ln_zco      = .true.    !  z-coordinate - full    steps   (T/F)      ("key_zco" may also be defined)
-   ln_zps      = .false.   !  z-coordinate - partial steps   (T/F)
-   ln_sco      = .false.   !  s- or hybrid z-s-coordinate    (T/F)
-/
-!-----------------------------------------------------------------------
-&namzgr_sco    !   s-coordinate or hybrid z-s-coordinate
-!-----------------------------------------------------------------------
-   rn_sbot_min =  300.     !  minimum depth of s-bottom surface (>0) (m)
-   rn_sbot_max = 5250.     !  maximum depth of s-bottom surface (= ocean depth) (>0) (m)
-   rn_theta    =    6.0    !  surface control parameter (0<=theta<=20)
-   rn_thetb    =    0.75   !  bottom control parameter  (0<=thetb<= 1)
-   rn_rmax     =    0.15   !  maximum cut-off r-value allowed (0<r_max<1)
-   ln_s_sigma  = .false.   !  hybrid s-sigma coordinates
-   rn_bb       =    0.8    !  stretching with s-sigma
-   rn_hc       =  150.0    !  critical depth with s-sigma 
-/
-!-----------------------------------------------------------------------
-&namdom        !   space and time domain (bathymetry, mesh, timestep)
-!-----------------------------------------------------------------------
-   nn_bathy    =    0      !  compute (=0) or read(=1) the bathymetry file
-   nn_closea    =   0      !  closed seas and lakes are removed (=0) or kept (=1) from the ORCA domain
-   nn_msh      =    0      !  create (=1) a mesh file (coordinates, scale factors, masks) or not (=0)
-   rn_e3zps_min=    5.     !  the thickness of the partial step is set larger than the minimum
-   rn_e3zps_rat=    0.1    !  of e3zps_min and e3zps_rat * e3t   (N.B. 0<e3zps_rat<1)
-                           !
-   rn_rdt      = 7200.     !  time step for the dynamics (and tracer if nacc=0)   ==> 5760
-   nn_baro     =   60      !  number of barotropic time step (for the split explicit algorithm) ("key_dynspg_ts")
-   rn_atfp     =    0.1    !  asselin time filter parameter
-   nn_acc      =    0      !  acceleration of convergence : =1      used, rdt < rdttra(k)
-                                 !                          =0, not used, rdt = rdttra
-   rn_rdtmin   = 7200.           !  minimum time step on tracers (used if nacc=1)
-   rn_rdtmax   = 7200.           !  maximum time step on tracers (used if nacc=1)
-   rn_rdth     =  800.           !  depth variation of tracer time step  (used if nacc=1)
-/
-!!======================================================================
-!!            ***  Surface Boundary Condition namelists  ***
-!!======================================================================
-!!   namsbc        surface boundary condition
-!!   namsbc_ana    analytical         formulation
-!!   namsbc_flx    flux               formulation
-!!   namsbc_clio   CLIO bulk formulea formulation
-!!   namsbc_core   CORE bulk formulea formulation
-!!   namsbc_cpl    CouPLed            formulation                       ("key_coupled")
-!!   namtra_qsr    penetrative solar radiation
-!!   namsbc_rnf    river runoffs
-!!   namsbc_ssr    sea surface restoring term (for T and/or S)
-!!   namsbc_alb    albedo parameters
-!!======================================================================
-
-!-----------------------------------------------------------------------
-&namsbc        !   Surface Boundary Condition (surface module)
-!-----------------------------------------------------------------------
-   nn_fsbc     = 1         !  frequency of surface boundary condition computation 
-                           !               (= the frequency of sea-ice model call)
-   ln_ana      = .true.    !  analytical formulation (T => fill namsbc_ana ) 
-   ln_flx      = .false.   !  flux formulation       (T => fill namsbc_flx )
-   ln_blk_clio = .false.   !  CLIO bulk formulation  (T => fill namsbc_clio) 
-   ln_blk_core = .false.   !  CORE bulk formulation  (T => fill namsbc_core) 
-   ln_cpl      = .false.   !  Coupled formulation    (T => fill namsbc_cpl )
-   nn_ice      = 0         !  =0 no ice boundary condition   ,
-                           !  =1 use observed ice-cover      ,
-                           !  =2 ice-model used                             ("key_lim3" or "key_lim2)
-   nn_ico_cpl  = 0         !  ice-ocean coupling : =0 each nn_fsbc 
-                           !                       =1 stresses recomputed each ocean time step ("key_lim3" only)
-                           !                       =2 combination of 0 and 1 cases             ("key_lim3" only)
-   ln_dm2dc    = .false.   !  daily mean to diurnal cycle short wave (qsr)
-   ln_rnf      = .false.   !  runoffs (T => fill namsbc_rnf)
-   ln_ssr      = .false.   !  Sea Surface Restoring on T and/or S (T => fill namsbc_ssr)
-   nn_fwb      = 0         !  FreshWater Budget: =0 unchecked                              , 
-                           !                     =1 global mean of e-p-r set to zero at each nn_fsbc time step   ,
-                           !                     =2 annual global mean of e-p-r set to zero
-                           !                     =3 global emp set to zero and spread out over erp area
-/
-!-----------------------------------------------------------------------
-&namsbc_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
-   rn_vtau0    =   0.e0    !  uniform value for the j-stress
-   rn_qns0     =   0.e0    !  uniform value for the total heat flux
-   rn_qsr0     =   0.e0    !  uniform value for the solar radiation
-   rn_emp0     =   0.e0    !  uniform value for the freswater budget (E-P)
-/
-!-----------------------------------------------------------------------
-&namsbc_flx    !   surface boundary condition : flux formulation
-!-----------------------------------------------------------------------
-!              !   file name  ! frequency (hours) !  variable  ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
-!              !              !  (if <0  months)  !    name    !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
-   sn_utau     = 'utau'       ,        24         ,    'utau'  ,     .false.    , .false. , 'yearly'  , ''       , ''
-   sn_vtau     = 'vtau'       ,        24         ,    'vtau'  ,     .false.    , .false. , 'yearly'  , ''       , ''
-   sn_qtot     = 'qtot'       ,        24         ,    'qtot'  ,     .false.    , .false. , 'yearly'  , ''       , ''
-   sn_qsr      = 'qsr'        ,        24         ,    'qsr'   ,     .false.    , .false. , 'yearly'  , ''       , ''
-   sn_emp      = 'emp'        ,        24         ,    'emp'   ,     .false.    , .false. , 'yearly'  , ''       , ''
-!
-   cn_dir      = './'      !  root directory for the location of the flux files
-/      
-!-----------------------------------------------------------------------
-&namsbc_clio   !   namsbc_clio  CLIO bulk formulea
-!-----------------------------------------------------------------------
-!              !   file name  ! frequency (hours) !  variable  ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
-!              !              !  (if <0  months)  !    name    !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
-   sn_utau     = 'taux_1m'    ,       -1          , 'sozotaux' ,    .true.      , .true.  , 'yearly'  , ''       , ''
-   sn_vtau     = 'tauy_1m'    ,       -1          , 'sometauy' ,    .true.      , .true.  , 'yearly'  , ''       , ''
-   sn_wndm     = 'flx'        ,       -1          , 'socliowi' ,    .true.      , .true.  , 'yearly'  , ''       , ''
-   sn_tair     = 'flx'        ,       -1          , 'socliot2' ,    .true.      , .true.  , 'yearly'  , ''       , ''
-   sn_humi     = 'flx'        ,       -1          , 'socliohu' ,    .true.      , .true.  , 'yearly'  , ''       , ''
-   sn_ccov     = 'flx'        ,       -1          , 'socliocl' ,    .false.     , .true.  , 'yearly'  , ''       , ''
-   sn_prec     = 'flx'        ,       -1          , 'socliopl' ,    .false.     , .true.  , 'yearly'  , ''       , ''
-!
-   cn_dir      = './'      !  root directory for the location of the bulk files are
-/
-!-----------------------------------------------------------------------
-&namsbc_core   !   namsbc_core  CORE bulk formulea
-!-----------------------------------------------------------------------
-!              !   file name  ! frequency (hours) ! variable   ! time interpol. !  clim   ! 'yearly'/ ! weights              ! rotation !
-!              !              !  (if <0  months)  !   name     !    (logical)   !  (T/F)  ! 'monthly' ! filename             ! pairing  !
-   sn_wndi     = 'u10_core'   ,       -1          , 'u10'      ,    .true.      , .true.  , 'yearly'  ,'bicubic_weights_orca2.nc' , 'U1'
-   sn_wndj     = 'v10_core'   ,       -1          , 'v10'      ,    .true.      , .true.  , 'yearly'  ,'bicubic_weights_orca2.nc' , 'V1'
-   sn_qsr      = 'qsw_core'   ,       -1          , 'swdn'     ,    .true.      , .true.  , 'yearly'  ,'bilinear_weights_orca2.nc', ''
-   sn_qlw      = 'qlw_core'   ,       -1          , 'lwdn'     ,    .true.      , .true.  , 'yearly'  ,'bilinear_weights_orca2.nc', ''
-   sn_tair     = 't2_core'    ,       -1          , 't2'       ,    .true.      , .true.  , 'yearly'  ,'bilinear_weights_orca2.nc', ''
-   sn_humi     = 'q2_core'    ,       -1          , 'q2'       ,    .true.      , .true.  , 'yearly'  ,'bilinear_weights_orca2.nc', ''
-   sn_prec     = 'precip_core',       -1          , 'precip'   ,    .true.      , .true.  , 'yearly'  ,'bilinear_weights_orca2.nc', ''
-   sn_snow     = 'snow_core'  ,       -1          , 'snow'     ,    .true.      , .true.  , 'yearly'  ,'bilinear_weights_orca2.nc', ''
-   sn_tdif     = 'taudif_core',       24          , 'taudif'   ,    .true.      , .true.  , 'yearly'  ,'bilinear_weights_orca2.nc', ''
-!
-   cn_dir      = './'      !  root directory for the location of the bulk files
-   ln_2m       = .true.    !  air temperature and humidity referenced at 2m (T) instead 10m (F)
-   ln_taudif   = .false.   !  HF tau contribution: use "mean of stress module - module of the mean stress" data ?
-   rn_pfac     = 1.        !  multiplicative factor for precipitation (total & snow)
-/
-!-----------------------------------------------------------------------
-&namsbc_cpl    !   coupled ocean/atmosphere model                        ("key_coupled")
-!-----------------------------------------------------------------------
-/
-!-----------------------------------------------------------------------
-&namtra_qsr    !   penetrative solar radiation
-!-----------------------------------------------------------------------
-!              !   file name  ! frequency (hours) ! variable   ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
-!              !              !  (if <0  months)  !   name     !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
-   sn_chl      = 'chlorophyll',        -1         , 'CHLA'     ,    .true.      , .true.  , 'yearly'  , ''       , ''
- 
-   cn_dir      = './'      !  root directory for the location of the runoff files
-   ln_traqsr   = .true.    !  Light penetration (T) or not (F)
-   ln_qsr_rgb  = .true.    !  RGB (Red-Green-Blue) light penetration
-   ln_qsr_2bd  = .false.   !  2 bands              light penetration
-   ln_qsr_bio  = .false.   !  bio-model light penetration
-   nn_chldta   =      0    !  RGB : Chl data (=1) or cst value (=0)
-   rn_abs      =   0.58    !  RGB & 2 bands: fraction of light (rn_si1)
-   rn_si0      =   0.35    !  RGB & 2 bands: shortess depth of extinction
-   rn_si1      =   23.0    !  2 bands: longest depth of extinction
-   rn_si2      =   62.0    !  3 bands: longest depth of extinction (for blue waveband & 0.01 mg/m2 Chl)
-/
-!-----------------------------------------------------------------------
-&namsbc_rnf    !   runoffs namelist surface boundary condition
-!-----------------------------------------------------------------------
-!              !   file name  ! frequency (hours) ! variable   ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
-!              !              !  (if <0  months)  !   name     !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
-   sn_rnf      = 'runoff_1m_nomask' ,  -1         , 'sorunoff' ,    .true.      , .true.  , 'yearly'  , ''       , ''
-   sn_cnf      = 'runoff_1m_nomask' ,   0         , 'socoefr'  ,    .false.     , .true.  , 'yearly'  , ''       , ''
- 
-   cn_dir       = './'      !  root directory for the location of the runoff files
-   ln_rnf_emp   =   .false. !  runoffs included into precipitation field (T) or into a file (F)
-   ln_rnf_mouth =   .false. !  specific treatment at rivers mouths
-   rn_hrnf      =   0.e0    !  depth over which enhanced vertical mixing is used
-   rn_avt_rnf   =   1.e-3   !  value of the additional vertical mixing coef. [m2/s]
-   rn_rfact     =   1.e0    !  multiplicative factor for runoff
-/
-!-----------------------------------------------------------------------
-&namsbc_ssr    !   surface boundary condition : sea surface restoring
-!-----------------------------------------------------------------------
-!              !   file name  ! frequency (hours) ! variable   ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
-!              !              !  (if <0  months)  !   name     !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
-   sn_sst      = 'sst_data'   ,        24         ,  'sst'     ,     .false.    , .false. , 'yearly'  , ''       , ''
-   sn_sss      = 'sss_data'   ,        -1         ,  'sss'     ,     .true.     , .true.  , 'yearly'  , ''       , ''
-    
-   cn_dir      = './'      !  root directory for the location of the runoff files
-   nn_sstr     =     0     !  add a retroaction term in the surface heat       flux (=1) or not (=0)
-   nn_sssr     =     0     !  add a damping     term in the surface freshwater flux (=2)
-                           !  or to SSS only (=1) or no damping term (=0)
-   rn_dqdt     =   -40.    !  magnitude of the retroaction on temperature   [W/m2/K]
-   rn_deds     =   -27.7   !  magnitude of the damping on salinity   [mm/day]
-   ln_sssr_bnd =   .false. !  flag to bound erp term (associated with nn_sssr=2)
-   rn_sssr_bnd =   0.e0    !  ABS(Max/Min) value of the damping erp term [mm/day]
-/      
-!-----------------------------------------------------------------------
-&namsbc_alb    !   albedo parameters
-!-----------------------------------------------------------------------
-   rn_cloud    =    0.06   !  cloud correction to snow and ice albedo 
-   rn_albice   =    0.53   !  albedo of melting ice in the arctic and antarctic
-   rn_alphd    =    0.80   !  coefficients for linear interpolation used to
-   rn_alphc    =    0.65   !  compute albedo between two extremes values 
-   rn_alphdi   =    0.72   !  (Pyane, 1972)
-/
-
-!!======================================================================
-!!               ***  Lateral boundary condition  ***
-!!======================================================================
-!!   namlbc        lateral momentum boundary condition
-!!   namcla        cross land advection
-!!   namobc        open boundaries parameters                           ("key_obc")
-!!   namagrif      agrif nested grid ( read by child model only )       ("key_agrif") 
-!!   nambdy        Unstructured open boundaries                         ("key_bdy")
-!!   namtide       Tidal forcing at open boundaries                     ("key_bdy_tides")
-!!======================================================================
-
-!-----------------------------------------------------------------------
-&namlbc        !   lateral momentum boundary condition
-!-----------------------------------------------------------------------
-   rn_shlat    =    0.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
-                           !  free slip  !   partial slip  !   no slip   ! strong slip
-/
-!-----------------------------------------------------------------------
-&namcla        !   cross land advection
-!-----------------------------------------------------------------------
-   nn_cla      =    0      !  advection between 2 ocean pts separates by land
-/
-!-----------------------------------------------------------------------
-&namobc        !   open boundaries parameters                           ("key_obc")
-!-----------------------------------------------------------------------
-    ln_obc_clim= .false.   !  climatological obc data files (T) or not (F)
-    ln_vol_cst = .true.    !  impose the total volume conservation (T) or not (F)
-    ln_obc_fla = .false.   !  Flather open boundary condition 
-    nn_obcdta  =    1      !  = 0 the obc data are equal to the initial state
-                           !  = 1 the obc data are read in 'obc.dta' files
-    cn_obcdta  = 'annual'  !  set to annual if obc datafile hold 1 year of data
-                           !  set to monthly if obc datafile hold 1 month of data
-    rn_dpein   =    1.     !  damping time scale for inflow at east  open boundary
-    rn_dpwin   =    1.     !     -           -         -       west    -      -
-    rn_dpnin   =    1.     !     -           -         -       north   -      -
-    rn_dpsin   =    1.     !     -           -         -       south   -      -
-    rn_dpeob   = 3000.     !  time relaxation (days) for the east  open boundary
-    rn_dpwob   =   15.     !     -           -         -     west    -      -
-    rn_dpnob   = 3000.     !     -           -         -     north   -      -
-    rn_dpsob   =   15.     !     -           -         -     south   -      -
-    rn_volemp  =  1.       !  = 0 the total volume change with the surface flux (E-P-R)
-                           !  = 1 the total volume remains constant
-/
-!-----------------------------------------------------------------------
-&namagrif      !  AGRIF zoom                                            ("key_agrif")
-!-----------------------------------------------------------------------
-    nn_cln_update = 3      !  baroclinic update frequency
-    ln_spc_dyn    = .true. !  use 0 as special value for dynamics
-    rn_sponge_tra = 2880.  !  coefficient for tracer   sponge layer [s]
-    rn_sponge_dyn = 2880.  !  coefficient for dynamics sponge layer [s]
-/
-!-----------------------------------------------------------------------
-&nambdy        !  unstructured open boundaries                          ("key_bdy")
-!-----------------------------------------------------------------------
-    filbdy_mask    =  ''                  !  name of mask file (if ln_bdy_mask=.TRUE.)
-    filbdy_data_T  = 'bdydata_grid_T.nc'  !  name of data file (T-points)
-    filbdy_data_U  = 'bdydata_grid_U.nc'  !  name of data file (U-points)
-    filbdy_data_V  = 'bdydata_grid_V.nc'  !  name of data file (V-points)
-    ln_bdy_clim    = .false.              !  contain 1 (T) or 12 (F) time dumps and be cyclic
-    ln_bdy_vol     = .true.               !  total volume correction (see volbdy parameter)
-    ln_bdy_mask    = .false.              !  boundary mask from filbdy_mask (T) or boundaries are on edges of domain (F)
-    ln_bdy_tides   = .true.               !  Apply tidal harmonic forcing with Flather condition
-    ln_bdy_dyn_fla = .true.               !  Apply Flather condition to velocities
-    ln_bdy_tra_frs = .false.              !  Apply FRS condition to temperature and salinity 
-    ln_bdy_dyn_frs = .false.              !  Apply FRS condition to velocities
-    nbdy_dta       =  1                   !  = 0, bdy data are equal to the initial state
-                                          !  = 1, bdy data are read in 'bdydata   .nc' files
-    nb_rimwidth    = 9                    !  width of the relaxation zone
-    volbdy         = 0                    !  = 0, the total water flux across open boundaries is zero
-                                          !  = 1, the total volume of the system is conserved
-/
-!-----------------------------------------------------------------------
-&nambdy_tide     ! tidal forcing at unstructured boundaries              
-!-----------------------------------------------------------------------
-    filtide      = 'bdytide_'           !  file name root of tidal forcing files
-    tide_cpt     = 'M2','S1'            !  names of tidal components used
-    tide_speed   = 28.984106, 15.000001 !  phase speeds of tidal components (deg/hour)
-    ln_tide_date = .false.              !  adjust tidal harmonics for start date of run
-/
-
-!!======================================================================
-!!                 ***  Bottom boundary condition  ***
-!!======================================================================
-!!   nambfr        bottom friction
-!!   nambbc        bottom temperature boundary condition                ("key_trabbc")
-!!   nambbl        bottom boundary layer scheme                         ("key_trabbl_dif","key_trabbl_adv")
-!!======================================================================
-
-!-----------------------------------------------------------------------
-&nambfr        !   bottom friction
-!-----------------------------------------------------------------------
-   nn_bfr      =    2      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
-                           !                              = 2 : nonlinear friction
-   rn_bfri1    =    4.e-4  !  bottom drag coefficient (linear case)
-   rn_bfri2    =    1.e-3  !  bottom drag coefficient (non linear case)
-   rn_bfeb2    =    2.5e-3 !  bottom turbulent kinetic energy background  (m^2/s^2)
-   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 = .true.)
-/
-!-----------------------------------------------------------------------
-&nambbc        !   bottom temperature boundary condition
-!-----------------------------------------------------------------------
-   nn_geoflx   =    0      !  geothermal heat flux: = 0 no flux 
-                           !     = 1 constant flux
-                           !     = 2 variable flux (read in geothermal_heating.nc in mW/m2) 
-   rn_geoflx_cst = 86.4e-3 !  Constant value of geothermal heat flux [W/m2]
-/
-!-----------------------------------------------------------------------
-&nambbl        !   bottom boundary layer scheme
-!-----------------------------------------------------------------------
-!                          !  diffusive bbl                             ("key_trabbl")
-!                          !  advective bbl                             ("key_trabbl_adv")
-   rn_ahtbbl   =  10000.   !  lateral mixing coefficient in the bbl  [m2/s]
-/
-!!======================================================================
-!!                        Tracer (T & S ) namelists
-!!======================================================================
-!!   nameos        equation of state
-!!   namtra_adv    advection scheme
-!!   namtra_ldf    lateral diffusion scheme
-!!   namtra_dmp    T & S newtonian damping                              ("key_tradmp")
-!!======================================================================
-
-!-----------------------------------------------------------------------
-&nameos        !   ocean physical parameters
-!-----------------------------------------------------------------------
-   nn_eos      =    2      !  type of equation of state and Brunt-Vaisala frequency
-                           !     = 0, UNESCO (formulation of Jackett and McDougall (1994) and of McDougall (1987) )
-                           !     = 1, linear: rho(T)   = rau0 * ( 1.028 - ralpha * T )
-                           !     = 2, linear: rho(T,S) = rau0 * ( rbeta * S - ralpha * T )
-   rn_alpha    =    2.e-4  !  thermal expension coefficient (neos= 1 or 2)
-   rn_beta     =    7.7e-4 !  saline  expension coefficient (neos= 2)
-/
-!-----------------------------------------------------------------------
-&namtra_adv    !   advection scheme for tracer 
-!-----------------------------------------------------------------------
-   ln_traadv_cen2   =  .false.  !  2nd order centered scheme   
-   ln_traadv_tvd    =  .true.   !  TVD scheme                
-   ln_traadv_muscl  =  .false.  !  MUSCL scheme             
-   ln_traadv_muscl2 =  .false.  !  MUSCL2 scheme + cen2 at boundaries  
-   ln_traadv_ubs    =  .false.  !  UBS scheme                 
-/
-!-----------------------------------------------------------------------
-&namtra_ldf    !   lateral diffusion scheme for tracer 
-!-----------------------------------------------------------------------
-                           !  Type of the operator : 
-   ln_traldf_lap    =  .true.   !     laplacian operator       
-   ln_traldf_bilap  =  .false.  !     bilaplacian operator     
-                           !  Direction of action  :
-   ln_traldf_level  =  .false.  !     iso-level                
-   ln_traldf_hor    =  .false.  !     horizontal (geopotential)         (require "key_ldfslp" when ln_sco=T)
-   ln_traldf_iso    =  .true.   !     iso-neutral                       (require "key_ldfslp")
-                           !  Coefficient
-   rn_aht_0         =  1000.    !     horizontal eddy diffusivity for tracers [m2/s]
-   rn_ahtb_0        =     0.    !     background eddy diffusivity for ldf_iso [m2/s]
-   rn_aeiv_0        =     0.    !     eddy induced velocity coefficient [m2/s]    (require "key_traldf_eiv")
-/
-!-----------------------------------------------------------------------
-&namtra_dmp    !   tracer: T & S newtonian damping                      ('key_tradmp')
-!-----------------------------------------------------------------------
-   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     =    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     =   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     =    1      !  create a damping.coeff NetCDF file (=1) or not (=0)
-/
-!!======================================================================
-!!                      ***  Dynamics namelists  ***
-!!======================================================================
-!!   namdyn_adv    formulation of the momentum advection
-!!   namdyn_vor    advection scheme
-!!   namdyn_hpg    hydrostatic pressure gradient
-!!   namdyn_spg    surface pressure gradient                            (CPP key only)
-!!   namdyn_ldf    lateral diffusion scheme
-!!======================================================================
-
-!-----------------------------------------------------------------------
-&namdyn_adv    !   formulation of the momentum advection
-!-----------------------------------------------------------------------
-   ln_dynadv_vec = .true.  !  vector form (T) or flux form (F)  
-   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme
-   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme 
-/  
-!-----------------------------------------------------------------------
-&namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
-!-----------------------------------------------------------------------
-   ln_dynvor_ene = .true.  !  enstrophy conserving scheme  
-   ln_dynvor_ens = .false. !  energy conserving scheme    
-   ln_dynvor_mix = .false. !  mixed scheme               
-   ln_dynvor_een = .false. !  energy & enstrophy scheme  
-/
-!-----------------------------------------------------------------------
-&namdyn_hpg    !   Hydrostatic pressure gradient option
-!-----------------------------------------------------------------------
-   ln_hpg_zco  = .true.    !  z-coordinate - full steps                   
-   ln_hpg_zps  = .false.   !  z-coordinate - partial steps (interpolation)
-   ln_hpg_sco  = .false.   !  s-coordinate (standard jacobian formulation)
-   ln_hpg_hel  = .false.   !  s-coordinate (helsinki modification)
-   ln_hpg_wdj  = .false.   !  s-coordinate (weighted density jacobian)
-   ln_hpg_djc  = .false.   !  s-coordinate (Density Jacobian with Cubic polynomial)
-   ln_hpg_rot  = .false.   !  s-coordinate (ROTated axes scheme)
-   rn_gamma    = 0.e0      !  weighting coefficient (wdj scheme)
-   ln_dynhpg_imp = .false. !  time stepping: semi-implicit time scheme  (T)
-                                 !           centered      time scheme  (F)
-/
-!-----------------------------------------------------------------------
-!namdyn_spg    !   surface pressure gradient   (CPP key only)
-!-----------------------------------------------------------------------
-!                          !  explicit free surface                     ("key_dynspg_exp")
-!                          !  filtered free surface                     ("key_dynspg_flt")
-!                          !  split-explicit free surface               ("key_dynspg_ts")
-
-!-----------------------------------------------------------------------
-&namdyn_ldf    !   lateral diffusion on momentum
-!-----------------------------------------------------------------------
-                           !  Type of the operator : 
-   ln_dynldf_lap    =  .true.   !  laplacian operator         
-   ln_dynldf_bilap  =  .false.  !  bilaplacian operator    
-                           !  Direction of action  : 
-   ln_dynldf_level  =  .false.  !  iso-level               
-   ln_dynldf_hor    =  .true.   !  horizontal (geopotential)            (require "key_ldfslp" in s-coord.)
-   ln_dynldf_iso    =  .false.  !  iso-neutral                          (require "key_ldfslp")
-                           !  Coefficient
-   rn_ahm_0    = 100000.        !  horizontal eddy viscosity   [m2/s]
-   rn_ahmb_0   =     0.         !  background eddy viscosity for ldf_iso [m2/s]
-/
-!!======================================================================
-!!             Tracers & Dynamics vertical physics namelists
-!!======================================================================
-!!       namzdf        vertical physics
-!!       namzdf_ric    richardson number dependent vertical mixing      ("key_zdfric"      )
-!!       namzdf_tke    TKE dependent vertical mixing                    ("key_zdftke"      )
-!!       namzdf_kpp    KPP dependent vertical mixing                    ("key_zdfkpp"      )
-!!       namzdf_ddm    double diffusive mixing parameterization         ("key_zdfddm"      )
-!!       namzdf_tmx    tidal mixing parameterization                    ("key_zdftmx"      )
-!!======================================================================
-
-!-----------------------------------------------------------------------
-&namzdf        !   vertical physics
-!-----------------------------------------------------------------------
-   rn_avm0     =   1.2e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
-   rn_avt0     =   1.2e-5  !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
-   nn_avb      =    0      !  profile for background avt & avm (=1) or not (=0)
-   nn_havtb    =    0      !  horizontal shape for avtb (=1) or not (=0)
-   ln_zdfevd   = .true.    !  enhanced vertical diffusion (evd) (T) or not (F)
-   nn_evdm     =    1      !  evd apply on tracer (=0) or on tracer and momentum (=1)
-   rn_avevd    =  100.     !  evd mixing coefficient [m2/s]
-   ln_zdfnpc   = .false.   !  Non-Penetrative algorithm (T) or not (F)
-   nn_npc      =    1            !  frequency of application of npc
-   nn_npcp     =  365            !  npc control print frequency
-   ln_zdfexp   = .false.   !  time-stepping: split-explicit (T) or implicit (F) time stepping
-   nn_zdfexp   =    3            !  number of sub-timestep for ln_zdfexp=T
-/
-!-----------------------------------------------------------------------
-&namzdf_ric    !   richardson number dependent vertical diffusion       ("key_zdfric" )
-!-----------------------------------------------------------------------
-   rn_avmri    = 100.e-4   !  maximum value of the vertical viscosity
-   rn_alp      =   5.      !  coefficient of the parameterization
-   nn_ric      =   2       !  coefficient of the parameterization
-/
-!-----------------------------------------------------------------------
-&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
-!-----------------------------------------------------------------------
-   rn_ediff    =   0.1     !  coef. for vertical eddy coef. (avt=rn_ediff*mxl*sqrt(e) )
-   rn_ediss    =   0.7     !  coef. of the Kolmogoroff dissipation
-   rn_ebb      =   3.75    !  coef. of the surface input of tke
-   rn_emin     =   1.e-5   !  minimum value of tke [m2/s2]
-   rn_emin0    =   1.e-4   !  surface minimum value of tke [m2/s2]
-   rn_bshear   =   1.e-20  !  background shear (>0)
-   nn_mxl      =   2       !  mixing length: = 0 bounded by the distance to surface and bottom
-                           !                 = 1 bounded by the local vertical scale factor
-                           !                 = 2 first vertical derivative of mixing length bounded by 1
-                           !                 = 3 same criteria as case 2 but applied in a different way
-   nn_pdl      =   1       !  Prandtl number function of richarson number (=1, avt=pdl(Ri)*avm) or not (=0, avt=avm)
-   ln_mxl0     = .false.   !  mixing length scale surface value as function of wind stress (T) or not (F)
-   rn_lmin     =   0.4     !  interior buoyancy lenght scale minimum value
-   rn_lmin0    =   0.4     !  surface  buoyancy lenght scale minimum value
-   nn_etau     =   0       !  exponentially deceasing penetration of tke due to internal & intertial waves
-                           !        = 0 no penetration ( O(2 km) resolution)
-                           !        = 1 additional tke source (rn_efr * en)
-                           !        = 2 additional tke source (rn_efr * en) applied only at the base of the mixed layer
-                           !        = 3 additional tke source (HF contribution: mean of stress module - module of mean stress)
-   nn_htau     =   1       !  type of exponential decrease of tke penetration
-                           !        = 0  constant 10 m length scale
-                           !        = 1  0.5m at the equator to 30m at high latitudes
-                           !        = 2  30 meters constant depth penetration
-                           !  otion used only if nn_etau = 1 or 2: 
-   rn_efr      =   0.05    !     fraction of surface tke value which penetrates inside the ocean
-                           !  otion used only if nn_etau = 3:
-   rn_addhft   =  -1.e-3   !     add offset   applied to the "mean of stress module - module of mean stress" (always kept > 0)
-   rn_sclhft   =   1.      !     scale factor applied to the "mean of stress module - module of mean stress"
-   ln_lc       = .false.   !  Langmuir cell parameterisation
-   rn_lc       =   0.15    !  coef. associated to Langmuir cells
-/
-!------------------------------------------------------------------------
-&namzdf_kpp    !   K-Profile Parameterization dependent vertical mixing  ("key_zdfkpp", and optionnally:
-!------------------------------------------------------------------------ "key_kppcustom" or "key_kpplktb")
-   ln_kpprimix = .true.    !  shear instability mixing 
-   rn_difmiw   =  1.0e-04  !  constant internal wave viscosity [m2/s]
-   rn_difsiw   =  0.1e-04  !  constant internal wave diffusivity [m2/s]
-   rn_riinfty  =  0.8      !  local Richardson Number limit for shear instability
-   rn_difri    =  0.0050   !  maximum shear mixing at Rig = 0    [m2/s]
-   rn_bvsqcon  = -0.01e-07 !  Brunt-Vaisala squared for maximum convection [1/s2] 
-   rn_difcon   =  1.       !  maximum mixing in interior convection [m2/s] 
-   nn_avb      =  0        !  horizontal averaged (=1) or not (=0) on avt and amv
-   nn_ave      =  1        !  constant (=0) or profile (=1) background on avt
-/
-!-----------------------------------------------------------------------
-&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
-!-----------------------------------------------------------------------
-   rn_avts     = 1.e-4     !  maximum avs (vertical mixing on salinity)
-   rn_hsbfr    = 1.6       !  heat/salt buoyancy flux ratio
-/
-!-----------------------------------------------------------------------
-&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
-!-----------------------------------------------------------------------
-   rn_htmx     = 500.      !  vertical decay scale for turbulence (meters)
-   rn_n2min    = 1.e-8     !  threshold of the Brunt-Vaisala frequency (s-1)
-   rn_tfe      = 0.333     !  tidal dissipation efficiency
-   rn_me       = 0.2       !  mixing efficiency 
-   ln_tmx_itf  = .FALSE.   !  ITF specific parameterisation
-   rn_tfe_itf  = 1.        !  ITF tidal dissipation efficiency
-/
-!!======================================================================
-!!                  ***  Miscelaneous namelists  ***
-!!======================================================================
-!!   nammpp            Massively Parallel Processing                    ("key_mpp_mpi)
-!!   nammpp_dyndist    Massively Parallel domain decomposition          ("key_agrif" && "key_mpp_dyndist")
-!!   namctl            Control prints & Benchmark
-!!   namsol            elliptic solver / island / free surface 
-!!======================================================================
-
-!-----------------------------------------------------------------------
-&namsol        !   elliptic solver / island / free surface 
-!-----------------------------------------------------------------------
-   nn_solv     =      2    !  elliptic solver: =1 preconditioned conjugate gradient (pcg)
-                           !                   =2 successive-over-relaxation (sor)
-   nn_sol_arp  =      0    !  absolute/relative (0/1) precision convergence test
-   rn_eps      =  1.e-6    !  absolute precision of the solver
-   nn_nmin     =    100    !  minimum of iterations for the SOR solver
-   nn_nmax     =    800    !  maximum of iterations for the SOR solver
-   nn_nmod     =     10    !  frequency of test for the SOR solver
-   rn_resmax   =  1.e-10   !  absolute precision for the SOR solver
-   rn_sor      =  1.96     !  optimal coefficient for SOR solver (to be adjusted with the domain)
-/
-!-----------------------------------------------------------------------
-&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
-!-----------------------------------------------------------------------
-   cn_mpi_send =  'S'      !  mpi send/recieve type   ='S', 'B', or 'I' for standard send,
-                           !  buffer blocking send or immediate non-blocking sends, resp.
-   nn_buffer   =   0       !  size in bytes of exported buffer ('B' case), 0 no exportation
-/
-!-----------------------------------------------------------------------
-&nammpp_dyndist !   Massively Parallel Distribution for AGRIF zoom      ("key_agrif" && "key_mpp_dyndist")
-!-----------------------------------------------------------------------
-   jpni        =    1      !  jpni   number of processors following i
-   jpnj        =    1      !  jpnj   number of processors following j
-   jpnij       =    1      !  jpnij  number of local domains
-/
-!-----------------------------------------------------------------------
-&namctl        !   Control prints & Benchmark
-!-----------------------------------------------------------------------
-   ln_ctl      = .false.   !  trends control print (expensive!)
-   nn_print    =    0      !  level of print (0 no extra print)
-   nn_ictls    =    0      !  start i indice of control sum (use to compare mono versus
-   nn_ictle    =    0      !  end   i indice of control sum        multi processor runs
-   nn_jctls    =    0      !  start j indice of control               over a subdomain)
-   nn_jctle    =    0      !  end   j indice of control
-   nn_isplt    =    1      !  number of processors in i-direction
-   nn_jsplt    =    1      !  number of processors in j-direction
-   nn_bench    =    0      !  Bench mode (1/0): CAUTION use zero except for bench
-                           !     (no physical validity of the results)
-   nn_bit_cmp  =    0      !  bit comparison mode (1/0): CAUTION use zero except for test
-                           !     of comparison between single and multiple processor runs
-/
-
-!!======================================================================
-!!                       ***  Diagnostics namelists  ***
-!!======================================================================
-!!   namtrd       dynamics and/or tracer trends                         ("key_trddyn","key_trdtra","key_trdmld")
-!!   namgap       level mean model-data gap                             ("key_diagap")
-!!   namflo       float parameters                                      ("key_float")
-!!   namptr       Poleward Transport Diagnostics
-!!======================================================================
-
-!-----------------------------------------------------------------------
-&namtrd        !   diagnostics on dynamics and/or tracer trends         ("key_trddyn" and/or "key_trdtra")
-!              !       or mixed-layer trends or barotropic vorticity    ('key_trdmld' or  "key_trdvor")
-!-----------------------------------------------------------------------
-   nn_trd      = 365       !  time step frequency dynamics and tracers trends
-   nn_ctls     =   0       !  control surface type in mixed-layer trends (0,1 or n<jpk)
-   rn_ucf      =   1.      !  unit conversion factor (=1 -> /seconds ; =86400. -> /day)
-   cn_trdrst_in      = "restart_mld"   ! suffix of ocean restart name (input)
-   cn_trdrst_out     = "restart_mld"   ! suffix of ocean restart name (output)
-   ln_trdmld_restart = .false.         !  restart for ML diagnostics
-   ln_trdmld_instant = .false.         !  flag to diagnose trends of instantantaneous or mean ML T/S
-/
-!-----------------------------------------------------------------------
-&namgap       !   level mean model-data gap                             ('key_diagap')
-!-----------------------------------------------------------------------
-   nn_gap     =  15        !  time-step frequency of model-data gap computation
-   nn_prg     =  10        !  time-step frequency of gap print in model output
-/
-!-----------------------------------------------------------------------
-&namflo       !   float parameters                                      ("key_float")
-!-----------------------------------------------------------------------
-    ln_rstflo = .false.    !  float restart (T) or not (F)
-    nn_writefl=      75    !  frequency of writing in float output file 
-    nn_stockfl=    5475    !  frequency of creation of the float restart file 
-    ln_argo   = .false.    !  Argo type floats (stay at the surface each 10 days)
-    ln_flork4 = .false.    !  trajectories computed with a 4th order Runge-Kutta (T)
-                           !  or computed with Blanke' scheme (F)
-/
-!-----------------------------------------------------------------------
-&namptr       !   Poleward Transport Diagnostic
-!-----------------------------------------------------------------------
-   ln_diaptr  = .false.    !  Poleward heat and salt transport (T) or not (F)
-   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"
-   nf_ptr     =  1         !  Frequency of ptr computation [time step]
-   nf_ptr_wri =  15        !  Frequency of ptr outputs
-/
+link ../../GYRE/EXP00/namelist
Index: trunk/NEMOGCM/CONFIG/GYRE_LOBSTER/EXP00/namelist_top
===================================================================
--- trunk/NEMOGCM/CONFIG/GYRE_LOBSTER/EXP00/namelist_top	(revision 2527)
+++ trunk/NEMOGCM/CONFIG/GYRE_LOBSTER/EXP00/namelist_top	(revision 2528)
@@ -1,52 +1,44 @@
 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-!! NEMO/TOP1 :  1 - tracer definition                     (namtoptrc)
-!! namelists    2 - dynamical tracer trends               (namtoptrd)
-!!              6 - tracer advection                      (namtopadv)
-!!              7 - tracer bottom boundary                (namtopbbl)
-!!              8 - tracer lateral diffusion              (namtopldf)
-!!              3 - tracer vertical physics               (namtopzdf)
-!!              9 - tracer newtonian damping              (namtopdmp)
+!! NEMO/TOP1 :  1 - tracer definition                     (namtrc    )
+!! namelists    2 - dynamical tracer trends               (namtrc_trd)
+!!              3 - tracer advection                      (namtrc_adv)
+!!              4 - tracer lateral diffusion              (namtrc_ldf)
+!!              5 - tracer vertical physics               (namtrc_zdf)
+!!              6 - tracer newtonian damping              (namtrc_dmp)
 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 !'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
-&namtoptrc     !   tracers definition
+&namtrc     !   tracers definition
 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
-   ndttrc      =  1        !  time step frequency for passive tracers      
-   nwritetrc   = 360       !  time step frequency for tracer outputs
-   ln_rsttr    = .false.   !  start from a restart file (T) or not (F)
-   nrsttr      =   0       !  restart control = 0 initial time step is not compared to the restart file value
+   nn_dttrc      =  1        !  time step frequency for passive sn_tracers
+   nn_writetrc   =  360      !  time step frequency for sn_tracer outputs
+   ln_rsttr      = .false.   !  start from a restart file (T) or not (F)
+   nn_rsttr      =   0       !  restart control = 0 initial time step is not compared to the restart file value
                            !                  = 1 do not use the value in the restart file
                            !                  = 2 calendar parameters read in the restart file
-   cn_trcrst_in  = "restart_trc"   !  suffix of pass. tracer restart name (input)
-   cn_trcrst_out = "restart_trc"   !  suffix of pass. tracer restart name (output)
+   cn_trcrst_in  = "restart_trc"   !  suffix of pass. sn_tracer restart name (input)
+   cn_trcrst_out = "restart_trc"   !  suffix of pass. sn_tracer restart name (output)
 !
 !              ! name  !     title of the field       !   units       ! initial data ! save   !
 !              !       !                              !               ! from file    ! or not ! 
 !              !       !                              !               ! or not       !        !
-   tracer(1)   = 'DET' , 'Detritus                   ',  'mmole-N/m3' ,  .false.     ,  .true.
-   tracer(2)   = 'ZOO' , 'Zooplankton concentration  ',  'mmole-N/m3' ,  .false.     ,  .true.
-   tracer(3)   = 'PHY' , 'Phytoplankton concentration',  'mmole-N/m3' ,  .false.     ,  .true.
-   tracer(4)   = 'NO3' , 'Nitrate concentration      ',  'mmole-N/m3' ,  .false.     ,  .true.
-   tracer(5)   = 'NH4' , 'Ammonium concentration     ',  'mmole-N/m3' ,  .false.     ,  .true.
-   tracer(6)   = 'DOM' , 'Dissolved organic matter   ',  'mmole-N/m3' ,  .false.     ,  .true.
+   sn_tracer(1)   = 'DET' , 'Detritus                   ',  'mmole-N/m3' ,  .false.     ,  .true.
+   sn_tracer(2)   = 'ZOO' , 'Zooplankton concentration  ',  'mmole-N/m3' ,  .false.     ,  .true.
+   sn_tracer(3)   = 'PHY' , 'Phytoplankton concentration',  'mmole-N/m3' ,  .false.     ,  .true.
+   sn_tracer(4)   = 'NO3' , 'Nitrate concentration      ',  'mmole-N/m3' ,  .false.     ,  .true.
+   sn_tracer(5)   = 'NH4' , 'Ammonium concentration     ',  'mmole-N/m3' ,  .false.     ,  .true.
+   sn_tracer(6)   = 'DOM' , 'Dissolved organic matter   ',  'mmole-N/m3' ,  .false.     ,  .true.
 /
 !-----------------------------------------------------------------------
-&namtopadv    !   advection scheme for passive tracer 
+&namtrc_adv    !   advection scheme for passive tracer
 !-----------------------------------------------------------------------
-   ln_trcadv_cen2   =  .false.  !  2nd order centered scheme   
-   ln_trcadv_tvd    =  .true.  !  TVD scheme   
-   ln_trcadv_muscl  =  .false.   !  MUSCL scheme
+   ln_trcadv_cen2   =  .false.  !  2nd order centered scheme
+   ln_trcadv_tvd    =  .true.   !  TVD scheme
+   ln_trcadv_muscl  =  .false.  !  MUSCL scheme
    ln_trcadv_muscl2 =  .false.  !  MUSCL2 scheme + cen2 at boundaries
-   ln_trcadv_smolar =  .false.  !  SMOLAR scheme
-   rsc              =  1.       !  tuning coefficient for Smolar. scheme 
-   ncortrc          =  1        !  number of corrective phases for Smolar. scheme 
-   crosster         =  .false.  !  computes Smolar crossterms (T) or not (F)
+   ln_trcadv_ubs    =  .false.  !  UBS scheme
+   ln_trcadv_qck    =  .false.  !  QUICKEST scheme
 /
 !-----------------------------------------------------------------------
-&namtopbbl    !   bottom boundary layer scheme for passive tracer 
-!-----------------------------------------------------------------------
-   atrcbbl          = 1000.     !  lateral mixing coefficient in the bbl  [m2/s]
-/
-!-----------------------------------------------------------------------
-&namtopldf    !   lateral diffusion scheme for passive tracer 
+&namtrc_ldf    !   lateral diffusion scheme for passive tracer 
 !-----------------------------------------------------------------------
    ln_trcldf_diff   =  .true.   !  performs lateral diffusion (T) or not (F)
@@ -59,49 +51,45 @@
    ln_trcldf_iso    =  .true.   !     iso-neutral                       (require "key_ldfslp")
 !                               !  Coefficient
-   ahtrc0      =   300.         !     horizontal eddy diffusivity for tracers [m2/s]
-   ahtrb0      =     0.         !     background eddy diffusivity for ldf_iso [m2/s]
-   aeivtr0     =  1000.         !     eddy induced velocity coefficient [m2/s]    (require "key_trcldf_eiv")
-   trcrat      =  1.            !  ratio betweeen passive and active tracer diffusion coeff
+   rn_ahtrb_0       =     0.    !     background eddy diffusivity for ldf_iso [m2/s]
 /
 !-----------------------------------------------------------------------
-&namtopzdf        !   vertical physics
+&namtrc_zdf        !   vertical physics
 !-----------------------------------------------------------------------
    ln_trczdf_exp   =  .false.  !  split explicit (T) or implicit (F) time stepping
-   n_trczdf_exp    =   3       !  number of sub-timestep for ln_trczdfexp=T
+   nn_trczdf_exp   =   3       !  number of sub-timestep for ln_trczdfexp=T
 /
 !-----------------------------------------------------------------------
-&namtoprad        !  treatment of negative concentrations 
+&namtrc_rad        !  treatment of negative concentrations
 !-----------------------------------------------------------------------
-   ln_trcrad   =  .true.  !  artificially correct negative concentrations (T) or not (F)
+   ln_trcrad   =  .false.  !  artificially correct negative concentrations (T) or not (F)
 /
 !-----------------------------------------------------------------------
-&namtopdmp        !   passive tracer newtonian damping                 ('key_trcdmp')
+&namtrc_dmp    !   passive tracer newtonian damping    ('key_tradmp && key_trcdmp')
 !-----------------------------------------------------------------------
-   ndmptr      =   20      !  type of damping in passive tracers
-                           !     ='latitude', damping poleward of 'ndmp' degrees and function 
-                           !                  of the distance-to-coast. Red and Med Seas as ndmptr=-1
-                           !     =-1 damping only in Med and Red Seas
-   ndmpftr     =    0      !  create a damping.coeff NetCDF file (=1) or not (=0)
-   nmldmptr    =    1      !  type of damping: =0 damping throughout the water column
-                           !                   =1 no damping in the mixed layer defined by avt >5cm2/s )
-                           !                   =2 no damping in the mixed layer defined rho<rho(surf)+.01 )
-   sdmptr      =   50.     !  surface time scale for internal damping (days)
-   bdmptr      =  360.     !  bottom  time scale for internal damping (days)
-   hdmptr      =  800.     !  depth of transition between sdmptr and bdmptr (meters)
+   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)
 /
 !-----------------------------------------------------------------------
-&namtoptrd       !   diagnostics on tracer trends
+&namtrc_trd       !   diagnostics on tracer trends        ('key_trdtrc')
 !                          or mixed-layer trends          ('key_trdmld_trc')
 !----------------------------------------------------------------------
-   ntrd_trc   =  360      !  time step frequency and tracers trends
-   nctls_trc  =   0       !  control surface type in mixed-layer trends (0,1 or n<jpk)
-   ucf_trc    =  86400    !  unit conversion factor (=1 -> /seconds ; =86400. -> /day)
+   nn_trd_trc   =  360      !  time step frequency and tracers trends
+   nn_ctls_trc  =   0       !  control surface type in mixed-layer trends (0,1 or n<jpk)
+   rn_ucf_trc   =  86400    !  unit conversion factor (=1 -> /seconds ; =86400. -> /day)
    ln_trdmld_trc_restart = .false.  !  restart for ML diagnostics
    ln_trdmld_trc_instant = .false.  !  flag to diagnose trends of instantantaneous or mean ML T/S
-   luttrd(1)  =   .true.
-   luttrd(2)  =   .true.
-   luttrd(3)  =   .true.
-   luttrd(4)  =   .true.
-   luttrd(5)  =   .true.
-   luttrd(6)  =   .true.
+   ln_trdtrc(1)  =   .true.
+   ln_trdtrc(2)  =   .true.
+   ln_trdtrc(3)  =   .true.
+   ln_trdtrc(4)  =   .true.
+   ln_trdtrc(5)  =   .true.
+   ln_trdtrc(6)  =   .true.
 /
Index: trunk/NEMOGCM/CONFIG/GYRE_LOBSTER/EXP00/xmlio_server.def
===================================================================
--- trunk/NEMOGCM/CONFIG/GYRE_LOBSTER/EXP00/xmlio_server.def	(revision 2527)
+++ trunk/NEMOGCM/CONFIG/GYRE_LOBSTER/EXP00/xmlio_server.def	(revision 2528)
@@ -17,4 +17,19 @@
   global_mpi_buffer_size = 512
 /  
+
+!!======================================================================
+!!   namnc4            netcdf4 chunking and compression settings
+!!======================================================================
+!-----------------------------------------------------------------------
+&namnc4         !  netcdf4 chunking and compression settings
+                !  (benign if "key_netcdf4" is not used)
+!-----------------------------------------------------------------------
+   nn_nchunks_i   =   4       !  number of chunks in i-dimension
+   nn_nchunks_j   =   4       !  number of chunks in j-dimension
+   nn_nchunks_k   =   31      !  number of chunks in k-dimension
+                              !  setting nn_nchunks_k = jpk will give a chunk size of 1 in the vertical which
+                              !  is optimal for postprocessing which works exclusively with horizontal slabs
+   ln_nc4zip      =   .TRUE.  !  (T) use netcdf4 chunking and compression
+                              !  (F) ignore chunking information and produce netcdf3-compatible files  
+/
   
-  
Index: trunk/NEMOGCM/CONFIG/GYRE_LOBSTER/cpp_GYRE_LOBSTER.fcm
===================================================================
--- trunk/NEMOGCM/CONFIG/GYRE_LOBSTER/cpp_GYRE_LOBSTER.fcm	(revision 2528)
+++ trunk/NEMOGCM/CONFIG/GYRE_LOBSTER/cpp_GYRE_LOBSTER.fcm	(revision 2528)
@@ -0,0 +1,1 @@
+bld::tool::fppkeys  key_gyre key_dynspg_flt key_ldfslp key_zdftke key_vectopt_loop key_top key_lobster key_diatrc key_iomput key_nproci=1 key_nprocj=1
Index: trunk/NEMOGCM/CONFIG/ORCA2_LIM/AA_make
===================================================================
--- trunk/NEMOGCM/CONFIG/ORCA2_LIM/AA_make	(revision 2527)
+++ 	(revision )
@@ -1,13 +1,0 @@
-# $Header$
-all: ioipsl opa
-
-ioipsl:
-	(cd ../../modeles/IOIPSL/src; $(M_K) ;)
-
-
-opa:
-	(cd ../../modeles/NEMO/WORK;  $(M_K) ;)
-
-
-clean:
-	(cd ../../modeles/NEMO/WORK;  $(M_K) clean ;)
Index: trunk/NEMOGCM/CONFIG/ORCA2_LIM/AA_make.ldef
===================================================================
--- trunk/NEMOGCM/CONFIG/ORCA2_LIM/AA_make.ldef	(revision 2527)
+++ 	(revision )
@@ -1,11 +1,0 @@
-#---------------------------------------------------------------------
-#- Creation des elements relatifs a ORCA :
-#-      ORCA  (lib, executable : opa)
-#---------------------------------------------------------------------
-SHELL = /bin/sh
-#---------------------------------------------------------------------
-LIBDIR = ../../../../lib
-BINDIR = ../../../../bin
-MODDIR = $(LIBDIR)
-#---------------------------------------------------------------------
-#-
Index: trunk/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist
===================================================================
--- trunk/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist	(revision 2527)
+++ trunk/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist	(revision 2528)
@@ -1,7 +1,8 @@
 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 !! NEMO/OPA  :  1 - run manager      (namrun)
-!! namelists    2 - Domain           (namzgr, namzgr_sco, namdom)
+!! namelists    2 - Domain           (namzgr, namzgr_sco, namdom, namdta_tem, namdta_sal)
 !!              3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core
-!!                                    namsbc_cpl, namqsr, namsbc_rnf, namsbc_ssr, namsbc_alb)
+!!                                    namsbc_cpl, namsbc_cpl_co2 namtra_qsr, namsbc_rnf, 
+!!                                    namsbc_apr, namsbc_ssr, namsbc_alb)
 !!              4 - lateral boundary (namlbc, namcla, namobc, namagrif, nambdy, nambdy_tide)
 !!              5 - bottom  boundary (nambfr, nambbc, nambbl)
@@ -9,38 +10,39 @@
 !!              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      (namtrd, namgap, namspr, namflo, namptr)
-!!              9 - miscellaneous    (namsol, nammpp, nammpp_dyndist, namctl)
+!!              9 - diagnostics      (namnc4, namtrd, namspr, namflo, namptr, namhsb)
+!!             10 - miscellaneous    (namsol, nammpp, nammpp_dyndist, namctl)
+!!             11 - Obs & Assim      (namobs, nam_asminc)
 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-!  CAUTION: some scripts does not support CAPITALs for logical use .true./.false., not .TRUE./.FALSE.
 
 !!======================================================================
 !!                   ***  Run management namelists  ***
 !!======================================================================
-!!   namrun            parameters of the run
-!!======================================================================
-
+!!   namrun        parameters of the run
+!!======================================================================
+!
 !-----------------------------------------------------------------------
 &namrun        !   parameters of the run
 !-----------------------------------------------------------------------
    nn_no       =       0   !  job number
-   cn_exp      =  "Agulhas"!  experience name 
+   cn_exp      = "Agulhas" !  experience name 
    nn_it000    =       1   !  first time step
-   nn_itend    =   10950   !  last  time step (std 5475)
-   nn_date0    =  010101   !  initial calendar date yymmdd (used if nrstdt=1)
+   nn_itend    =   10950   !  last  time step
+   nn_date0    =  010101   !  initial calendar date yymmdd (used if nn_rstctl=1)
    nn_leapy    =       0   !  Leap year calendar (1) or not (0)
+   ln_rstart   = .false.   !  start from rest (F) or from a restart file (T)
+   nn_rstctl   =       0       !  restart control = 0 nn_it000 is not compared to the restart file value
+                               !                  = 1 use nn_date0 in namelist (not the value in the restart file)
+                               !                  = 2 calendar parameters read in the restart file
+   cn_ocerst_in  = "restart"   !  suffix of ocean restart name (input)
+   cn_ocerst_out = "restart"   !  suffix of ocean restart name (output)
    nn_istate   =       0   !  output the initial state (1) or not (0)
    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 nit000)
+   nn_write    =   10950   !  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
-   nn_chunksz  =       0   !  chunksize (bytes) for NetCDF file (working only with iom_nf90 routines)
-   ln_rstart   = .false.   !  start from rest (F) or from a restart file (T)
-   nn_rstctl   =       0       !  restart control = 0 nit000 is not compared to the restart file value
-                               !                  = 1 use ndate0 in namelist (not the value in the restart file)
-                               !                  = 2 calendar parameters read in the restart file
-   cn_ocerst_in  = "restart"   !  suffix of ocean restart name (input)
-   cn_ocerst_out = "restart"   !  suffix of ocean restart name (output)
-/
+   nn_chunksz  =       0   !  chunksize (bytes) for NetCDF file (works only with iom_nf90 routines)
+/
+
 !!======================================================================
 !!                      ***  Domain namelists  ***
@@ -49,6 +51,8 @@
 !!   namzgr_sco   s-coordinate or hybrid z-s-coordinate
 !!   namdom       space and time domain (bathymetry, mesh, timestep)
-!!======================================================================
-
+!!   namdta_tem   data: temperature                                     ("key_dtatem")
+!!   namdta_sal   data: salinity                                        ("key_dtasal")
+!!======================================================================
+!
 !-----------------------------------------------------------------------
 &namzgr        !   vertical coordinate
@@ -63,7 +67,7 @@
    rn_sbot_min =  300.     !  minimum depth of s-bottom surface (>0) (m)
    rn_sbot_max = 5250.     !  maximum depth of s-bottom surface (= ocean depth) (>0) (m)
-   rn_theta    =    6.0    !  surface control parameter (0<=theta<=20)
-   rn_thetb    =    0.75   !  bottom control parameter  (0<=thetb<= 1)
-   rn_rmax     =    0.15   !  maximum cut-off r-value allowed (0<r_max<1)
+   rn_theta    =    6.0    !  surface control parameter (0<=rn_theta<=20)
+   rn_thetb    =    0.75   !  bottom control parameter  (0<=rn_thetb<= 1)
+   rn_rmax     =    0.15   !  maximum cut-off r-value allowed (0<rn_max<1)
    ln_s_sigma  = .false.   !  hybrid s-sigma coordinates
    rn_bb       =    0.8    !  stretching with s-sigma
@@ -73,57 +77,77 @@
 &namdom        !   space and time domain (bathymetry, mesh, timestep)
 !-----------------------------------------------------------------------
-   nn_bathy    =    1      !  compute (=0) or read(=1) the bathymetry file
-   nn_closea   =    0      !  closed seas and lakes are removed (=0) or kept (=1) from the ORCA domain
-   nn_msh      =    0      !  create (=1) a mesh file (coordinates, scale factors, masks) or not (=0)
-   rn_e3zps_min=   20.     !  the thickness of the partial step is set larger than the minimum
-   rn_e3zps_rat=    0.1    !  of e3zps_min and e3zps_rat * e3t   (N.B. 0<e3zps_rat<1)
+   nn_bathy    =    1      !  compute (=0) or read (=1) the bathymetry file
+   nn_closea    =   0      !  remove (=0) or keep (=1) closed seas and lakes (ORCA)
+   nn_msh      =    0      !  create (=1) a mesh file or not (=0)
+   rn_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
+   rn_e3zps_rat=    0.1    !  rn_e3zps_min and rn_e3zps_rat*e3t, with 0<rn_e3zps_rat<1
                            !
-   rn_rdt      = 2880.     !  time step for the dynamics (and tracer if nacc=0)   ==> 5760
-   nn_baro     =   64      !  number of barotropic time step (for the split explicit algorithm) ("key_dynspg_ts")
+   rn_rdt      = 2880.     !  time step for the dynamics (and tracer if nn_acc=0)
+   nn_baro     =   64      !  number of barotropic time step            ("key_dynspg_ts")
    rn_atfp     =    0.1    !  asselin time filter parameter
    nn_acc      =    0      !  acceleration of convergence : =1      used, rdt < rdttra(k)
                                  !                          =0, not used, rdt = rdttra
-   rn_rdtmin   = 14400.          !  minimum time step on tracers (used if nacc=1)
-   rn_rdtmax   = 14400.          !  maximum time step on tracers (used if nacc=1)
-   rn_rdth     =  800.           !  depth variation of tracer time step  (used if nacc=1)
-/
+   rn_rdtmin   = 14400.          !  minimum time step on tracers (used if nn_acc=1)
+   rn_rdtmax   = 14400.          !  maximum time step on tracers (used if nn_acc=1)
+   rn_rdth     =  800.           !  depth variation of tracer time step  (used if nn_acc=1)
+/
+!-----------------------------------------------------------------------
+&namdta_tem    !   data : temperature                                   ("key_dtatem")
+!-----------------------------------------------------------------------
+!              ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation !
+!              !           !  (if <0  months)     !   name   !  (logical)   ! (T/F) ! 'monthly'  ! filename ! pairing  !
+   sn_tem = 'data_1m_potential_temperature_nomask', -1,'votemper',  .true.  , .true., 'yearly'   , ' '      , ' '
+   !
+   cn_dir       = './'     !  root directory for the location of the runoff files
+/
+!-----------------------------------------------------------------------
+&namdta_sal    !   data : salinity                                      ("key_dtasal")
+!-----------------------------------------------------------------------
+!              ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation !
+!              !           !  (if <0  months)     !   name   !   (logical)  ! (T/F) ! 'monthly'  ! filename ! pairing  !
+   sn_sal      =  'data_1m_salinity_nomask',  -1  ,'vosaline',    .true.    , .true., 'yearly'   , ''       , ' '
+   !
+   cn_dir      = './'      !  root directory for the location of the runoff files
+/
+
 !!======================================================================
 !!            ***  Surface Boundary Condition namelists  ***
 !!======================================================================
-!!   namsbc        surface boundary condition
-!!   namsbc_ana    analytical         formulation
-!!   namsbc_flx    flux               formulation
-!!   namsbc_clio   CLIO bulk formulea formulation
-!!   namsbc_core   CORE bulk formulea formulation
-!!   namsbc_cpl    CouPLed            formulation                       ("key_coupled")
-!!   namtra_qsr    penetrative solar radiation
-!!   namsbc_rnf    river runoffs
-!!   namsbc_ssr    sea surface restoring term (for T and/or S)
-!!   namsbc_alb    albedo parameters
-!!======================================================================
-
+!!   namsbc          surface boundary condition
+!!   namsbc_ana      analytical         formulation
+!!   namsbc_flx      flux               formulation
+!!   namsbc_clio     CLIO bulk formulea formulation
+!!   namsbc_core     CORE bulk formulea formulation
+!!   namsbc_cpl      CouPLed            formulation                     ("key_coupled")
+!!   namsbc_cpl_co2  coupled ocean/biogeo/atmosphere model              ("key_cpl_carbon_cycle")
+!!   namtra_qsr      penetrative solar radiation
+!!   namsbc_rnf      river runoffs
+!!   namsbc_apr      Atmospheric Pressure
+!!   namsbc_ssr      sea surface restoring term (for T and/or S)
+!!   namsbc_alb      albedo parameters
+!!======================================================================
+!
 !-----------------------------------------------------------------------
 &namsbc        !   Surface Boundary Condition (surface module)
 !-----------------------------------------------------------------------
    nn_fsbc     = 5         !  frequency of surface boundary condition computation 
-                           !               (= the frequency of sea-ice model call)
-   ln_ana      = .false.   !  analytical formulation (T => fill namsbc_ana ) 
-   ln_flx      = .false.   !  flux formulation       (T => fill namsbc_flx )
-   ln_blk_clio = .true.    !  CLIO bulk formulation  (T => fill namsbc_clio) 
-   ln_blk_core = .false.   !  CORE bulk formulation  (T => fill namsbc_core) 
-   ln_cpl      = .false.   !  Coupled formulation    (T => fill namsbc_cpl )
+                           !     (also = the frequency of sea-ice model call)
+   ln_ana      = .false.   !  analytical formulation                    (T => fill namsbc_ana ) 
+   ln_flx      = .false.   !  flux formulation                          (T => fill namsbc_flx )
+   ln_blk_clio = .false.   !  CLIO bulk formulation                     (T => fill namsbc_clio) 
+   ln_blk_core = .true.    !  CORE bulk formulation                     (T => fill namsbc_core) 
+   ln_cpl      = .false.   !  Coupled formulation                       (T => fill namsbc_cpl )
+   ln_apr_dyn  = .false.   !  Patm gradient added in ocean & ice Eqs.   (T => fill namsbc_apr )
    nn_ice      = 0         !  =0 no ice boundary condition   ,
                            !  =1 use observed ice-cover      ,
-                           !  =2 ice-model used                             ("key_lim3" or "key_lim2)
-   nn_ico_cpl  = 0         !  ice-ocean coupling : =0 each nn_fsbc 
-                           !                       =1 stresses recomputed each ocean time step ("key_lim3" only)
-                           !                       =2 combination of 0 and 1 cases             ("key_lim3" only)
-   ln_dm2dc    = .false.   !  daily mean to diurnal cycle short wave (qsr)
-   ln_rnf      = .false.   !  runoffs (T => fill namsbc_rnf)
-   ln_ssr      = .false.   !  Sea Surface Restoring on T and/or S (T => fill namsbc_ssr)
+                           !  =2 ice-model used                         ("key_lim3" or "key_lim2)
+   ln_dm2dc    = .false.   !  daily mean to diurnal cycle on short wave
+   ln_rnf      = .false.   !  runoffs                                   (T => fill namsbc_rnf)
+   ln_ssr      = .false.   !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr)
    nn_fwb      = 0         !  FreshWater Budget: =0 unchecked 
-                           !                     =1 global mean of e-p-r set to zero at each time step 
-                           !                     =2 annual global mean of e-p-r set to zero
-                           !                     =3 global emp set to zero and spread out over erp area
+                           !     =1 global mean of e-p-r set to zero at each time step 
+                           !     =2 annual global mean of e-p-r set to zero
+                           !     =3 global emp set to zero and spread out over erp area
 /
 !-----------------------------------------------------------------------
@@ -140,12 +164,12 @@
 &namsbc_flx    !   surface boundary condition : flux formulation
 !-----------------------------------------------------------------------
-!              !   file name  ! frequency (hours) !  variable  ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
-!              !              !  (if <0  months)  !    name    !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
-   sn_utau     = 'utau'       ,        24         ,    'utau'  ,     .false.    , .false. , 'yearly'  , ''       , ''
-   sn_vtau     = 'vtau'       ,        24         ,    'vtau'  ,     .false.    , .false. , 'yearly'  , ''       , ''
-   sn_qtot     = 'qtot'       ,        24         ,    'qtot'  ,     .false.    , .false. , 'yearly'  , ''       , ''
-   sn_qsr      = 'qsr'        ,        24         ,    'qsr'   ,     .false.    , .false. , 'yearly'  , ''       , ''
-   sn_emp      = 'emp'        ,        24         ,    'emp'   ,     .false.    , .false. , 'yearly'  , ''       , ''
-!
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_utau     = 'utau'      ,        24         , 'utau'    , .false.      , .false., 'yearly'  , ''       , ''
+   sn_vtau     = 'vtau'      ,        24         , 'vtau'    , .false.      , .false., 'yearly'  , ''       , ''
+   sn_qtot     = 'qtot'      ,        24         , 'qtot'    , .false.      , .false., 'yearly'  , ''       , ''
+   sn_qsr      = 'qsr'       ,        24         , 'qsr'     , .false.      , .false., 'yearly'  , ''       , ''
+   sn_emp      = 'emp'       ,        24         , 'emp'     , .false.      , .false., 'yearly'  , ''       , ''
+
    cn_dir      = './'      !  root directory for the location of the flux files
 /      
@@ -153,14 +177,14 @@
 &namsbc_clio   !   namsbc_clio  CLIO bulk formulea
 !-----------------------------------------------------------------------
-!              !   file name  ! frequency (hours) !  variable  ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
-!              !              !  (if <0  months)  !    name    !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
-   sn_utau     = 'taux_1m'    ,       -1          , 'sozotaux' ,    .true.      , .true.  , 'yearly'  , ''       , ''
-   sn_vtau     = 'tauy_1m'    ,       -1          , 'sometauy' ,    .true.      , .true.  , 'yearly'  , ''       , ''
-   sn_wndm     = 'flx'        ,       -1          , 'socliowi' ,    .true.      , .true.  , 'yearly'  , ''       , ''
-   sn_tair     = 'flx'        ,       -1          , 'socliot2' ,    .true.      , .true.  , 'yearly'  , ''       , ''
-   sn_humi     = 'flx'        ,       -1          , 'socliohu' ,    .true.      , .true.  , 'yearly'  , ''       , ''
-   sn_ccov     = 'flx'        ,       -1          , 'socliocl' ,    .false.     , .true.  , 'yearly'  , ''       , ''
-   sn_prec     = 'flx'        ,       -1          , 'socliopl' ,    .false.     , .true.  , 'yearly'  , ''       , ''
-!
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_utau     = 'taux_1m'   ,       -1          , 'sozotaux',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_vtau     = 'tauy_1m'   ,       -1          , 'sometauy',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_wndm     = 'flx'       ,       -1          , 'socliowi',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_tair     = 'flx'       ,       -1          , 'socliot2',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_humi     = 'flx'       ,       -1          , 'socliohu',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_ccov     = 'flx'       ,       -1          , 'socliocl',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_prec     = 'flx'       ,       -1          , 'socliopl',   .false.    , .true. , 'yearly'  , ''       , ''
+
    cn_dir      = './'      !  root directory for the location of the bulk files are
 /
@@ -168,32 +192,59 @@
 &namsbc_core   !   namsbc_core  CORE bulk formulea
 !-----------------------------------------------------------------------
-!              !   file name  ! frequency (hours) ! variable   ! time interpol. !  clim   ! 'yearly'/ ! weights              ! rotation !
-!              !              !  (if <0  months)  !   name     !    (logical)   !  (T/F)  ! 'monthly' ! filename             ! pairing  !
-   sn_wndi     = 'u10_core'   ,       -1          , 'u10'      ,    .true.      , .true.  , 'yearly'  ,'bicubic_weights_orca2.nc' , 'U1'
-   sn_wndj     = 'v10_core'   ,       -1          , 'v10'      ,    .true.      , .true.  , 'yearly'  ,'bicubic_weights_orca2.nc' , 'V1'
-   sn_qsr      = 'qsw_core'   ,       -1          , 'swdn'     ,    .true.      , .true.  , 'yearly'  ,'bilinear_weights_orca2.nc', ''
-   sn_qlw      = 'qlw_core'   ,       -1          , 'lwdn'     ,    .true.      , .true.  , 'yearly'  ,'bilinear_weights_orca2.nc', ''
-   sn_tair     = 't2_core'    ,       -1          , 't2'       ,    .true.      , .true.  , 'yearly'  ,'bilinear_weights_orca2.nc', ''
-   sn_humi     = 'q2_core'    ,       -1          , 'q2'       ,    .true.      , .true.  , 'yearly'  ,'bilinear_weights_orca2.nc', ''
-   sn_prec     = 'precip_core',       -1          , 'precip'   ,    .true.      , .true.  , 'yearly'  ,'bilinear_weights_orca2.nc', ''
-   sn_snow     = 'snow_core'  ,       -1          , 'snow'     ,    .true.      , .true.  , 'yearly'  ,'bilinear_weights_orca2.nc', ''
-   sn_tdif     = 'taudif_core',       24          , 'taudif'   ,    .true.      , .true.  , 'yearly'  ,'bilinear_weights_orca2.nc', ''
-!
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_wndi = 'u_10.15JUNE2009_orca2'       ,  6  , 'U_10_MOD',   .false.    , .true. , 'yearly'  , ''       , 'Uwnd'
+   sn_wndj = 'v_10.15JUNE2009_orca2'       ,  6  , 'V_10_MOD',   .false.    , .true. , 'yearly'  , ''       , 'Vwnd'
+   sn_qsr  = 'ncar_rad.15JUNE2009_orca2'   , 24  , 'SWDN_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_qlw  = 'ncar_rad.15JUNE2009_orca2'   , 24  , 'LWDN_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_tair = 't_10.15JUNE2009_orca2'       ,  6  , 'T_10_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_humi = 'q_10.15JUNE2009_orca2'       ,  6  , 'Q_10_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_prec = 'ncar_precip.15JUNE2009_orca2', -1  , 'PRC_MOD1',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_snow = 'ncar_precip.15JUNE2009_orca2', -1  , 'SNOW'    ,   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_tdif = 'taudif_core'                 , 24  , 'taudif'  ,   .false.    , .true. , 'yearly'  , ''       , ''
+
    cn_dir      = './'      !  root directory for the location of the bulk files
-   ln_2m       = .true.    !  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_2m       = .false.   !  air temperature and humidity referenced at 2m (T) instead 10m (F)
+   ln_taudif   = .false.   !  HF tau contribution: use "mean of stress module - module of the mean stress" data
    rn_pfac     = 1.        !  multiplicative factor for precipitation (total & snow)
 /
 !-----------------------------------------------------------------------
-&namsbc_cpl    !   coupled ocean/atmosphere model                        ("key_coupled")
-!-----------------------------------------------------------------------
+&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_coupled")
+!-----------------------------------------------------------------------
+!                                      ! send
+cn_snd_temperature= 'weighted oce and ice'  !  'oce only' 'weighted oce and ice' 'mixed oce-ice'
+cn_snd_albedo     = 'weighted ice'          !  'none' 'weighted ice' 'mixed oce-ice'
+cn_snd_thickness  = 'none'                  !  'none' 'weighted ice and snow'
+cn_snd_crt_nature = 'none'                  !  'none' 'oce only' 'weighted oce and ice' 'mixed oce-ice'
+cn_snd_crt_refere = 'spherical'             !  'spherical' 'cartesian'
+cn_snd_crt_orient = 'eastward-northward'    !  'eastward-northward' or 'local grid'
+cn_snd_crt_grid   = 'T'                     !  'T'
+!                                      ! receive
+cn_rcv_w10m       = 'none'                  !  'none' 'coupled'
+cn_rcv_taumod     = 'coupled'               !  'none' 'coupled'
+cn_rcv_tau_nature = 'oce only'              !  'oce only' 'oce and ice' 'mixed oce-ice'
+cn_rcv_tau_refere = 'cartesian'             !  'spherical' 'cartesian'
+cn_rcv_tau_orient = 'eastward-northward'    !  'eastward-northward' or 'local grid'
+cn_rcv_tau_grid   = 'U,V'                   !  'T' 'U,V' 'U,V,F' 'U,V,I' 'T,F' 'T,I' 'T,U,V'
+cn_rcv_dqnsdt     = 'coupled'               !  'none' 'coupled'
+cn_rcv_qsr        = 'oce and ice'           !  'conservative' 'oce and ice' 'mixed oce-ice'
+cn_rcv_qns        = 'oce and ice'           !  'conservative' 'oce and ice' 'mixed oce-ice'
+cn_rcv_emp        = 'conservative'          !  'conservative' 'oce and ice' 'mixed oce-ice'
+cn_rcv_rnf        = 'coupled'               !  'coupled' 'climato' 'mixed'
+cn_rcv_cal        = 'coupled'               !  'none' 'coupled'
+/
+!-----------------------------------------------------------------------
+&namsbc_cpl_co2   !   coupled ocean/biogeo/atmosphere model             ("key_cpl_carbon_cycle")
+!-----------------------------------------------------------------------
+   cn_snd_co2     = 'coupled'         ! send    : 'none' 'coupled'
+   cn_rcv_co2     = 'coupled'         ! receive : 'none' 'coupled'
 /
 !-----------------------------------------------------------------------
 &namtra_qsr    !   penetrative solar radiation
 !-----------------------------------------------------------------------
-!              !   file name  ! frequency (hours) ! variable   ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
-!              !              !  (if <0  months)  !   name     !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
-   sn_chl      = 'chlorophyll',        -1         , 'CHLA'     ,    .true.      , .true.  , 'yearly'  , ''       , ''
- 
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_chl      ='chlorophyll',        -1         , 'CHLA'    ,   .true.     , .true. , 'yearly'  , ''       , ''
+
    cn_dir      = './'      !  root directory for the location of the runoff files
    ln_traqsr   = .true.    !  Light penetration (T) or not (F)
@@ -201,40 +252,56 @@
    ln_qsr_2bd  = .false.   !  2 bands              light penetration
    ln_qsr_bio  = .false.   !  bio-model light penetration
-   nn_chldta   =      0    !  RGB : Chl data (=1) or cst value (=0)
+   nn_chldta   =      1    !  RGB : Chl data (=1) or cst value (=0)
    rn_abs      =   0.58    !  RGB & 2 bands: fraction of light (rn_si1)
    rn_si0      =   0.35    !  RGB & 2 bands: shortess depth of extinction
    rn_si1      =   23.0    !  2 bands: longest depth of extinction
-   rn_si2      =   62.0    !  3 bands: longest depth of extinction (for blue waveband & 0.01 mg/m2 Chl)
 /
 !-----------------------------------------------------------------------
 &namsbc_rnf    !   runoffs namelist surface boundary condition
 !-----------------------------------------------------------------------
-!              !   file name  ! frequency (hours) ! variable   ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
-!              !              !  (if <0  months)  !   name     !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
-   sn_rnf      = 'runoff_1m_nomask' ,  -1         , 'sorunoff' ,    .true.      , .true.  , 'yearly'  , ''       , ''
-   sn_cnf      = 'runoff_1m_nomask' ,   0         , 'socoefr'  ,    .false.     , .true.  , 'yearly'  , ''       , ''
- 
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_rnf      = 'runoff_core_monthly',    -1    , 'sorunoff',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_cnf      = 'runoff_core_monthly',     0    , 'socoefr0',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_s_rnf    = 'runoffs'            ,    24    , 'rosaline',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_t_rnf    = 'runoffs'            ,    24    , 'rotemper',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_dep_rnf  = 'runoffs'            ,     0    , 'rodepth' ,   .false.    , .true. , 'yearly'  , ''       , ''
+
    cn_dir       = './'      !  root directory for the location of the runoff files
-   ln_rnf_emp   =   .false. !  runoffs included into precipitation field (T) or into a file (F)
-   ln_rnf_mouth =   .false. !  specific treatment at rivers mouths
+   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
    rn_avt_rnf   =   1.e-3   !  value of the additional vertical mixing coef. [m2/s]
    rn_rfact     =   1.e0    !  multiplicative factor for runoff
+   ln_rnf_depth = .false.   !  read in depth information for runoff
+   ln_rnf_tem   = .false.   !  read in temperature information for runoff
+   ln_rnf_sal   = .false.   !  read in salinity information for runoff
+/
+!-----------------------------------------------------------------------
+&namsbc_apr    !   Atmospheric pressure used as ocean forcing or in bulk
+!-----------------------------------------------------------------------
+!              ! file name ! frequency (hours) ! variable ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
+!              !           !  (if <0  months)  !   name   !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
+   sn_apr      = 'patm'    ,         -1        ,'somslpre',    .true.      , .true.  , 'yearly'  ,  ''      ,   ''
+
+   cn_dir      = './'      !  root directory for the location of the bulk files
+   ln_ref_apr  = .false.   !  ref. pressure: global mean Patm (T) or a constant (F)
 /
 !-----------------------------------------------------------------------
 &namsbc_ssr    !   surface boundary condition : sea surface restoring
 !-----------------------------------------------------------------------
-!              !   file name  ! frequency (hours) ! variable   ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
-!              !              !  (if <0  months)  !   name     !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
-   sn_sst      = 'sst_data'   ,        24         ,  'sst'     ,     .false.    , .false. , 'yearly'  , ''       , ''
-   sn_sss      = 'sss_data'   ,        -1         ,  'sss'     ,     .true.     , .true.  , 'yearly'  , ''       , ''
-    
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_sst      = 'sst_data'  ,        24         ,  'sst'    ,    .false.   , .false., 'yearly'  , ''       , ''
+   sn_sss      = 'sss_data'  ,        -1         ,  'sss'    ,    .true.    , .true. , 'yearly'  , ''       , ''
+
    cn_dir      = './'      !  root directory for the location of the runoff files
    nn_sstr     =     0     !  add a retroaction term in the surface heat       flux (=1) or not (=0)
-   nn_sssr     =     0     !  add a damping     term in the surface freshwater flux (=1) or not (=0)
+   nn_sssr     =     2     !  add a damping     term in the surface freshwater flux (=2) 
+                           !  or to SSS only (=1) or no damping term (=0)
    rn_dqdt     =   -40.    !  magnitude of the retroaction on temperature   [W/m2/K]
    rn_deds     =   -27.7   !  magnitude of the damping on salinity   [mm/day]
-   ln_sssr_bnd =   .false. !  flag to bound erp term (associated with nn_sssr=2)
-   rn_sssr_bnd =   0.e0    !  ABS(Max/Min) value of the damping erp term [mm/day]
+   ln_sssr_bnd =   .true.  !  flag to bound erp term (associated with nn_sssr=2)
+   rn_sssr_bnd =   4.e0    !  ABS(Max/Min) value of the damping erp term [mm/day]
 /      
 !-----------------------------------------------------------------------
@@ -258,5 +325,5 @@
 !!   namtide       Tidal forcing at open boundaries                     ("key_bdy_tides")
 !!======================================================================
-
+!
 !-----------------------------------------------------------------------
 &namlbc        !   lateral momentum boundary condition
@@ -273,20 +340,20 @@
 &namobc        !   open boundaries parameters                           ("key_obc")
 !-----------------------------------------------------------------------
-    ln_obc_clim= .false.   !  climatological obc data files (T) or not (F)
-    ln_vol_cst = .true.    !  impose the total volume conservation (T) or not (F)
-    ln_obc_fla = .false.   !  Flather open boundary condition 
-    nn_obcdta  =    1      !  = 0 the obc data are equal to the initial state
+   ln_obc_clim = .false.   !  climatological obc data files (T) or not (F)
+   ln_vol_cst  = .true.    !  impose the total volume conservation (T) or not (F)
+   ln_obc_fla  = .false.   !  Flather open boundary condition 
+   nn_obcdta   =    1      !  = 0 the obc data are equal to the initial state
                            !  = 1 the obc data are read in 'obc.dta' files
-    cn_obcdta  = 'annual'  !  set to annual if obc datafile hold 1 year of data
+   cn_obcdta   = 'annual'  !  set to annual if obc datafile hold 1 year of data
                            !  set to monthly if obc datafile hold 1 month of data
-    rn_dpein   =    1.     !  damping time scale for inflow at east  open boundary
-    rn_dpwin   =    1.     !     -           -         -       west    -      -
-    rn_dpnin   =    1.     !     -           -         -       north   -      -
-    rn_dpsin   =    1.     !     -           -         -       south   -      -
-    rn_dpeob   = 3000.     !  time relaxation (days) for the east  open boundary
-    rn_dpwob   =   15.     !     -           -         -     west    -      -
-    rn_dpnob   = 3000.     !     -           -         -     north   -      -
-    rn_dpsob   =   15.     !     -           -         -     south   -      -
-    rn_volemp  =  1.       !  = 0 the total volume change with the surface flux (E-P-R)
+   rn_dpein    =    1.     !  damping time scale for inflow at east  open boundary
+   rn_dpwin    =    1.     !     -           -         -       west    -      -
+   rn_dpnin    =    1.     !     -           -         -       north   -      -
+   rn_dpsin    =    1.     !     -           -         -       south   -      -
+   rn_dpeob    = 3000.     !  time relaxation (days) for the east  open boundary
+   rn_dpwob    =   15.     !     -           -         -     west    -      -
+   rn_dpnob    = 3000.     !     -           -         -     north   -      -
+   rn_dpsob    =   15.     !     -           -         -     south   -      -
+   rn_volemp   =    1.     !  = 0 the total volume change with the surface flux (E-P-R)
                            !  = 1 the total volume remains constant
 /
@@ -294,36 +361,40 @@
 &namagrif      !  AGRIF zoom                                            ("key_agrif")
 !-----------------------------------------------------------------------
-    nn_cln_update = 3      !  baroclinic update frequency
-    ln_spc_dyn    = .true. !  use 0 as special value for dynamics
-    rn_sponge_tra = 2880.  !  coefficient for tracer   sponge layer [s]
-    rn_sponge_dyn = 2880.  !  coefficient for dynamics sponge layer [s]
+   nn_cln_update =    3    !  baroclinic update frequency
+   ln_spc_dyn    = .true.  !  use 0 as special value for dynamics
+   rn_sponge_tra = 2880.   !  coefficient for tracer   sponge layer [m2/s]
+   rn_sponge_dyn = 2880.   !  coefficient for dynamics sponge layer [m2/s]
 /
 !-----------------------------------------------------------------------
 &nambdy        !  unstructured open boundaries                          ("key_bdy")
 !-----------------------------------------------------------------------
-    filbdy_mask    =  ''                  !  name of mask file (if ln_bdy_mask=.TRUE.)
-    filbdy_data_T  = 'bdydata_grid_T.nc'  !  name of data file (T-points)
-    filbdy_data_U  = 'bdydata_grid_U.nc'  !  name of data file (U-points)
-    filbdy_data_V  = 'bdydata_grid_V.nc'  !  name of data file (V-points)
-    ln_bdy_clim    = .false.              !  contain 1 (T) or 12 (F) time dumps and be cyclic
-    ln_bdy_vol     = .true.               !  total volume correction (see volbdy parameter)
-    ln_bdy_mask    = .false.              !  boundary mask from filbdy_mask (T) or boundaries are on edges of domain (F)
-    ln_bdy_tides   = .true.               !  Apply tidal harmonic forcing with Flather condition
-    ln_bdy_dyn_fla = .true.               !  Apply Flather condition to velocities
-    ln_bdy_tra_frs = .false.              !  Apply FRS condition to temperature and salinity 
-    ln_bdy_dyn_frs = .false.              !  Apply FRS condition to velocities
-    nbdy_dta       =  1                   !  = 0, bdy data are equal to the initial state
-                                          !  = 1, bdy data are read in 'bdydata   .nc' files
-    nb_rimwidth    = 9                    !  width of the relaxation zone
-    volbdy         = 0                    !  = 0, the total water flux across open boundaries is zero
-                                          !  = 1, the total volume of the system is conserved
-/
-!-----------------------------------------------------------------------
-&nambdy_tide     ! tidal forcing at unstructured boundaries              
-!-----------------------------------------------------------------------
-    filtide      = 'bdytide_'           !  file name root of tidal forcing files
-    tide_cpt     = 'M2','S1'            !  names of tidal components used
-    tide_speed   = 28.984106, 15.000001 !  phase speeds of tidal components (deg/hour)
-    ln_tide_date = .false.              !  adjust tidal harmonics for start date of run
+   cn_mask     =  ''                     !  name of mask file (ln_mask=T)
+   cn_dta_frs_T= 'bdydata_grid_T.nc'     !  name of data file (T-points)
+   cn_dta_frs_U= 'bdydata_grid_U.nc'     !  name of data file (U-points)
+   cn_dta_frs_V= 'bdydata_grid_V.nc'     !  name of data file (V-points)
+   cn_dta_fla_T= 'bdydata_bt_grid_T.nc'  !  name of data file for Flather condition (T-points)
+   cn_dta_fla_U= 'bdydata_bt_grid_U.nc'  !  name of data file for Flather condition (U-points)
+   cn_dta_fla_V= 'bdydata_bt_grid_V.nc'  !  name of data file for Flather condition (V-points)
+
+   ln_clim     = .false.   !  contain 1 (T) or 12 (F) time dumps and be cyclic
+   ln_vol      = .false.   !  total volume correction (see volbdy parameter)
+   ln_mask     = .false.   !  boundary mask from filbdy_mask (T), boundaries are on edges of domain (F)
+   ln_tides    = .false.   !  Apply tidal harmonic forcing with Flather condition
+   ln_dyn_fla  = .false.   !  Apply Flather condition to velocities
+   ln_tra_frs  = .false.   !  Apply FRS condition to temperature and salinity 
+   ln_dyn_frs  = .false.   !  Apply FRS condition to velocities
+   nn_rimwidth =  9        !  width of the relaxation zone
+   nn_dtactl   =  1        !  = 0, bdy data are equal to the initial state
+                           !  = 1, bdy data are read in 'bdydata   .nc' files
+   nn_volctl   =  0        !  = 0, the total water flux across open boundaries is zero
+                           !  = 1, the total volume of the system is conserved
+/
+!-----------------------------------------------------------------------
+&nambdy_tide   !  tidal forcing at unstructured boundaries              
+!-----------------------------------------------------------------------
+   filtide     = 'bdytide_'           !  file name root of tidal forcing files
+   tide_cpt    = 'M2','S1'            !  names of tidal components used
+   tide_speed  = 28.984106, 15.000001 !  phase speeds of tidal components (deg/hour)
+   ln_tide_date= .false.              !  adjust tidal harmonics for start date of run
 /
 
@@ -332,8 +403,8 @@
 !!======================================================================
 !!   nambfr        bottom friction
-!!   nambbc        bottom temperature boundary condition                ("key_trabbc")
-!!   nambbl        bottom boundary layer scheme                         ("key_trabbl_dif","key_trabbl_adv")
-!!======================================================================
-
+!!   nambbc        bottom temperature boundary condition               
+!!   nambbl        bottom boundary layer scheme                         ("key_trabbl")
+!!======================================================================
+!
 !-----------------------------------------------------------------------
 &nambfr        !   bottom friction
@@ -343,11 +414,12 @@
    rn_bfri1    =    4.e-4  !  bottom drag coefficient (linear case)
    rn_bfri2    =    1.e-3  !  bottom drag coefficient (non linear case)
-   rn_bfeb2    =    2.5e-3 !  bottom turbulent kinetic energy background  (m^2/s^2)
-   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 = .true.)
+   rn_bfeb2    =    2.5e-3 !  bottom turbulent kinetic energy background  (m2/s2)
+   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)
 /
 !-----------------------------------------------------------------------
 &nambbc        !   bottom temperature boundary condition
 !-----------------------------------------------------------------------
+   ln_trabbc   = .true.    !  Apply a geothermal heating at the ocean bottom
    nn_geoflx   =    2      !  geothermal heat flux: = 0 no flux 
                            !     = 1 constant flux
@@ -358,8 +430,10 @@
 &nambbl        !   bottom boundary layer scheme
 !-----------------------------------------------------------------------
-!                          !  diffusive bbl                             ("key_trabbl")
-!                          !  advective bbl                             ("key_trabbl_adv")
-   rn_ahtbbl   =  10000.   !  lateral mixing coefficient in the bbl  [m2/s]
-/
+   nn_bbl_ldf  =  1      !  diffusive bbl (=1)   or not (=0)
+   nn_bbl_adv  =  0      !  advective bbl (=1/2) or not (=0)
+   rn_ahtbbl   =  1000.  !  lateral mixing coefficient in the bbl  [m2/s]
+   rn_gambbl   =  10.    !  advective bbl coefficient                 [s]
+/
+
 !!======================================================================
 !!                        Tracer (T & S ) namelists
@@ -370,14 +444,14 @@
 !!   namtra_dmp    T & S newtonian damping                              ("key_tradmp")
 !!======================================================================
-
+!
 !-----------------------------------------------------------------------
 &nameos        !   ocean physical parameters
 !-----------------------------------------------------------------------
-   nn_eos      =    0      !  type of equation of state and Brunt-Vaisala frequency
+   nn_eos      =   0       !  type of equation of state and Brunt-Vaisala frequency
                            !     = 0, UNESCO (formulation of Jackett and McDougall (1994) and of McDougall (1987) )
                            !     = 1, linear: rho(T)   = rau0 * ( 1.028 - ralpha * T )
                            !     = 2, linear: rho(T,S) = rau0 * ( rbeta * S - ralpha * T )
-   rn_alpha    =    2.e-4  !  thermal expension coefficient (neos= 1 or 2)
-   rn_beta     =    0.001  !  saline  expension coefficient (neos= 2)
+   rn_alpha    =   2.0e-4  !  thermal expension coefficient (nn_eos= 1 or 2)
+   rn_beta     =   7.7e-4  !  saline  expension coefficient (nn_eos= 2)
 /
 !-----------------------------------------------------------------------
@@ -389,19 +463,22 @@
    ln_traadv_muscl2 =  .false.  !  MUSCL2 scheme + cen2 at boundaries  
    ln_traadv_ubs    =  .false.  !  UBS scheme                 
+   ln_traadv_qck    =  .false.  !  QUCIKEST scheme                 
 /
 !-----------------------------------------------------------------------
 &namtra_ldf    !   lateral diffusion scheme for tracer 
 !-----------------------------------------------------------------------
-                           !  Type of the operator : 
-   ln_traldf_lap    =  .true.   !     laplacian operator       
-   ln_traldf_bilap  =  .false.  !     bilaplacian operator     
-                           !  Direction of action  :
-   ln_traldf_level  =  .false.  !     iso-level                
-   ln_traldf_hor    =  .false.  !     horizontal (geopotential)         (require "key_ldfslp" when ln_sco=T)
-   ln_traldf_iso    =  .true.   !     iso-neutral                       (require "key_ldfslp")
-                           !  Coefficient
-   rn_aht_0         =  1000.    !     horizontal eddy diffusivity for tracers [m2/s]
-   rn_ahtb_0        =     0.    !     background eddy diffusivity for ldf_iso [m2/s]
-   rn_aeiv_0        =     0.    !     eddy induced velocity coefficient [m2/s]    (require "key_traldf_eiv")
+   !                       !  Type of the operator : 
+   ln_traldf_lap    =  .true.   !  laplacian operator       
+   ln_traldf_bilap  =  .false.  !  bilaplacian operator     
+   !                       !  Direction of action  :
+   ln_traldf_level  =  .false.  !  iso-level                
+   ln_traldf_hor    =  .false.  !  horizontal (geopotential)            (require "key_ldfslp" when ln_sco=T)
+   ln_traldf_iso    =  .true.   !  iso-neutral                          (require "key_ldfslp")
+   ln_traldf_grif   =  .false.  !  griffies skew flux formulation       (require "key_ldfslp")  ! UNDER TEST, DO NOT USE
+   ln_traldf_gdia   =  .false.  !  griffies operator strfn diagnostics  (require "key_ldfslp")  ! UNDER TEST, DO NOT USE
+   !                       !  Coefficient
+   rn_aht_0         =  1000.    !  horizontal eddy diffusivity for tracers [m2/s]
+   rn_ahtb_0        =     0.    !  background eddy diffusivity for ldf_iso [m2/s]
+   rn_aeiv_0        =     0.    !  eddy induced velocity coefficient [m2/s]    (require "key_traldf_eiv")
 /
 !-----------------------------------------------------------------------
@@ -417,6 +494,7 @@
    rn_bot      =  360.     !  bottom  time scale of damping   [days]
    rn_dep      =  800.     !  depth of transition between rn_surf and rn_bot [meters]
-   nn_file     =    1      !  create a damping.coeff NetCDF file (=1) or not (=0)
-/
+   nn_file     =    0      !  create a damping.coeff NetCDF file (=1) or not (=0)
+/
+
 !!======================================================================
 !!                      ***  Dynamics namelists  ***
@@ -428,5 +506,5 @@
 !!   namdyn_ldf    lateral diffusion scheme
 !!======================================================================
-
+!
 !-----------------------------------------------------------------------
 &namdyn_adv    !   formulation of the momentum advection
@@ -468,26 +546,28 @@
 &namdyn_ldf    !   lateral diffusion on momentum
 !-----------------------------------------------------------------------
-                           !  Type of the operator : 
+   !                       !  Type of the operator : 
    ln_dynldf_lap    =  .false.  !  laplacian operator         
    ln_dynldf_bilap  =  .true.   !  bilaplacian operator    
-                           !  Direction of action  : 
+   !                       !  Direction of action  : 
    ln_dynldf_level  =  .false.  !  iso-level               
    ln_dynldf_hor    =  .true.   !  horizontal (geopotential)            (require "key_ldfslp" in s-coord.)
    ln_dynldf_iso    =  .false.  !  iso-neutral                          (require "key_ldfslp")
-                           !  Coefficient
-   rn_ahm_0    = -8.5e+11       !  horizontal eddy viscosity   [m2/s]
-   rn_ahmb_0   =     0.         !  background eddy viscosity for ldf_iso [m2/s]
-/
+   !                       !  Coefficient
+   rn_ahm_0_lap     = 40000.    !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahmb_0        =     0.    !  background eddy viscosity for ldf_iso [m2/s]
+   rn_ahm_0_blp     = -8.5e+11  !  horizontal bilaplacian eddy viscosity [m4/s] 
+/
+
 !!======================================================================
 !!             Tracers & Dynamics vertical physics namelists
 !!======================================================================
-!!       namzdf        vertical physics
-!!       namzdf_ric    richardson number dependent vertical mixing      ("key_zdfric"      )
-!!       namzdf_tke    TKE dependent vertical mixing                    ("key_zdftke"      )
-!!       namzdf_kpp    KPP dependent vertical mixing                    ("key_zdfkpp"      )
-!!       namzdf_ddm    double diffusive mixing parameterization         ("key_zdfddm"      )
-!!       namzdf_tmx    tidal mixing parameterization                    ("key_zdftmx"      )
-!!======================================================================
-
+!!    namzdf        vertical physics
+!!    namzdf_ric    richardson number dependent vertical mixing         ("key_zdfric")
+!!    namzdf_tke    TKE dependent vertical mixing                       ("key_zdftke")
+!!    namzdf_kpp    KPP dependent vertical mixing                       ("key_zdfkpp")
+!!    namzdf_ddm    double diffusive mixing parameterization            ("key_zdfddm")
+!!    namzdf_tmx    tidal mixing parameterization                       ("key_zdftmx")
+!!======================================================================
+!
 !-----------------------------------------------------------------------
 &namzdf        !   vertical physics
@@ -500,5 +580,5 @@
    nn_evdm     =    0      !  evd apply on tracer (=0) or on tracer and momentum (=1)
    rn_avevd    =  100.     !  evd mixing coefficient [m2/s]
-   ln_zdfnpc   = .false.   !  Non-Penetrative algorithm (T) or not (F)
+   ln_zdfnpc   = .false.   !  Non-Penetrative Convective algorithm (T) or not (F)
    nn_npc      =    1            !  frequency of application of npc
    nn_npcp     =  365            !  npc control print frequency
@@ -518,35 +598,28 @@
    rn_ediff    =   0.1     !  coef. for vertical eddy coef. (avt=rn_ediff*mxl*sqrt(e) )
    rn_ediss    =   0.7     !  coef. of the Kolmogoroff dissipation
-   rn_ebb      =  60.      !  coef. of the surface input of tke
+   rn_ebb      =  67.83    !  coef. of the surface input of tke (=67.83 suggested when ln_mxl0=T)
    rn_emin     =   1.e-6   !  minimum value of tke [m2/s2]
    rn_emin0    =   1.e-4   !  surface minimum value of tke [m2/s2]
-   rn_bshear   =   1.e-20  !  background shear (>0)
    nn_mxl      =   2       !  mixing length: = 0 bounded by the distance to surface and bottom
                            !                 = 1 bounded by the local vertical scale factor
                            !                 = 2 first vertical derivative of mixing length bounded by 1
-                           !                 = 3 same criteria as case 2 but applied in a different way
+                           !                 = 3 as =2 with distinct disspipative an mixing length scale
    nn_pdl      =   1       !  Prandtl number function of richarson number (=1, avt=pdl(Ri)*avm) or not (=0, avt=avm)
-   ln_mxl0     = .false.   !  mixing length scale surface value as function of wind stress (T) or not (F)
-   rn_lmin     =   0.001   !  interior buoyancy lenght scale minimum value
-   rn_lmin0    =   0.01    !  surface  buoyancy lenght scale minimum value
-   nn_etau     =   0       !  exponentially deceasing penetration of tke due to internal & intertial waves
-                           !        = 0 no penetration ( O(2 km) resolution)
-                           !        = 1 additional tke source (rn_efr * en)
-                           !        = 2 additional tke source (rn_efr * en) applied only at the base of the mixed layer
-                           !        = 3 additional tke source (HF contribution: mean of stress module - module of mean stress)
-   nn_htau     =   1       !  type of exponential decrease of tke penetration
+   ln_mxl0     = .true.    !  surface mixing length scale = F(wind stress) (T) or not (F)
+   rn_mxl0     =   0.04    !  surface  buoyancy lenght scale minimum value
+   ln_lc       = .true.    !  Langmuir cell parameterisation (Axell 2002)
+   rn_lc       =   0.15    !  coef. associated to Langmuir cells
+   nn_etau     =   1       !  penetration of tke below the mixed layer (ML) due to internal & intertial waves
+                           !        = 0 no penetration
+                           !        = 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")
+   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
                            !        = 0  constant 10 m length scale
-                           !        = 1  0.5m at the equator to 30m at high latitudes
-                           !        = 2  30 meters constant depth penetration
-                           !  otion used only if nn_etau = 1 or 2: 
-   rn_efr      =   0.05    !     fraction of surface tke value which penetrates inside the ocean
-                           !  otion used only if nn_etau = 3:
-   rn_addhft   =  -1.e-3   !     add offset   applied to the "mean of stress module - module of mean stress" (always kept > 0)
-   rn_sclhft   =   1.      !     scale factor applied to the "mean of stress module - module of mean stress"
-   ln_lc       = .false.   !  Langmuir cell parameterisation
-   rn_lc       =   0.15    !  coef. associated to Langmuir cells
+                           !        = 1  0.5m at the equator to 30m poleward of 40 degrees
 /
 !------------------------------------------------------------------------
-&namzdf_kpp    !   K-Profile Parameterization dependent vertical mixing  ("key_zdfkpp", and optionnally:
+&namzdf_kpp    !   K-Profile Parameterization dependent vertical mixing  ("key_zdfkpp", and optionally:
 !------------------------------------------------------------------------ "key_kppcustom" or "key_kpplktb")
    ln_kpprimix = .true.    !  shear instability mixing 
@@ -561,4 +634,22 @@
 /
 !-----------------------------------------------------------------------
+&namzdf_gls                !   GLS vertical diffusion                   ("key_zdfgls")
+!-----------------------------------------------------------------------
+   rn_emin       = 1.e-6   !  minimum value of e   [m2/s2]
+   rn_epsmin     = 1.e-12  !  minimum value of eps [m2/s3]
+   ln_length_lim = .true.  !  limit on the dissipation rate under stable stratification (Galperin et al., 1988)
+   rn_clim_galp  = 0.53    !  galperin limit
+   ln_crban      = .true.  !  Use Craig & Banner (1994) surface wave mixing parametrisation
+   ln_sigpsi     = .true.  !  Activate or not Burchard 2001 mods on psi schmidt number in the wb case
+   rn_crban      = 100.    !  Craig and Banner 1994 constant for wb tke flux
+   rn_charn      = 70000.  !  Charnock constant for wb induced roughness length
+   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)
+/
+!-----------------------------------------------------------------------
 &namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
 !-----------------------------------------------------------------------
@@ -573,7 +664,8 @@
    rn_tfe      = 0.333     !  tidal dissipation efficiency
    rn_me       = 0.2       !  mixing efficiency 
-   ln_tmx_itf  = .FALSE.   !  ITF specific parameterisation
+   ln_tmx_itf  = .false.   !  ITF specific parameterisation
    rn_tfe_itf  = 1.        !  ITF tidal dissipation efficiency
 /
+
 !!======================================================================
 !!                  ***  Miscelaneous namelists  ***
@@ -584,5 +676,5 @@
 !!   namsol            elliptic solver / island / free surface 
 !!======================================================================
-
+!
 !-----------------------------------------------------------------------
 &namsol        !   elliptic solver / island / free surface 
@@ -601,5 +693,5 @@
 &nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
 !-----------------------------------------------------------------------
-   cn_mpi_send =  'S'      !  mpi send/recieve type   ='S', 'B', or 'I' for standard send,
+   cn_mpi_send =  'I'      !  mpi send/recieve type   ='S', 'B', or 'I' for standard send,
                            !  buffer blocking send or immediate non-blocking sends, resp.
    nn_buffer   =   0       !  size in bytes of exported buffer ('B' case), 0 no exportation
@@ -625,20 +717,30 @@
    nn_bench    =    0      !  Bench mode (1/0): CAUTION use zero except for bench
                            !     (no physical validity of the results)
-   nn_bit_cmp  =    0      !  bit comparison mode (1/0): CAUTION use zero except for test
-                           !     of comparison between single and multiple processor runs
-/
-
-!!======================================================================
-!!                       ***  Diagnostics namelists  ***
-!!======================================================================
+/
+
+!!======================================================================
+!!                  ***  Diagnostics namelists  ***
+!!======================================================================
+!!   namnc4       netcdf4 chunking and compression settings             ("key_netcdf4")
 !!   namtrd       dynamics and/or tracer trends                         ("key_trddyn","key_trdtra","key_trdmld")
-!!   namgap       level mean model-data gap                             ("key_diagap")
 !!   namflo       float parameters                                      ("key_float")
 !!   namptr       Poleward Transport Diagnostics
-!!======================================================================
-
+!!   namhsb       Heat and salt budgets 
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namnc4        !   netcdf4 chunking and compression settings            ("key_netcdf4")
+!-----------------------------------------------------------------------
+   nn_nchunks_i=   4       !  number of chunks in i-dimension
+   nn_nchunks_j=   4       !  number of chunks in j-dimension
+   nn_nchunks_k=   31      !  number of chunks in k-dimension
+                           !  setting nn_nchunks_k = jpk will give a chunk size of 1 in the vertical which
+                           !  is optimal for postprocessing which works exclusively with horizontal slabs
+   ln_nc4zip   = .true.    !  (T) use netcdf4 chunking and compression
+                           !  (F) ignore chunking information and produce netcdf3-compatible files
+/
 !-----------------------------------------------------------------------
 &namtrd        !   diagnostics on dynamics and/or tracer trends         ("key_trddyn" and/or "key_trdtra")
-!              !       or mixed-layer trends or barotropic vorticity    ('key_trdmld' or  "key_trdvor")
+!              !       or mixed-layer trends or barotropic vorticity    ("key_trdmld" or     "key_trdvor")
 !-----------------------------------------------------------------------
    nn_trd      = 365       !  time step frequency dynamics and tracers trends
@@ -651,17 +753,11 @@
 /
 !-----------------------------------------------------------------------
-&namgap       !   level mean model-data gap                             ('key_diagap')
-!-----------------------------------------------------------------------
-   nn_gap     =  15        !  time-step frequency of model-data gap computation
-   nn_prg     =  10        !  time-step frequency of gap print in model output
-/
-!-----------------------------------------------------------------------
 &namflo       !   float parameters                                      ("key_float")
 !-----------------------------------------------------------------------
-    ln_rstflo = .false.    !  float restart (T) or not (F)
-    nn_writefl=      75    !  frequency of writing in float output file 
-    nn_stockfl=    5475    !  frequency of creation of the float restart file 
-    ln_argo   = .false.    !  Argo type floats (stay at the surface each 10 days)
-    ln_flork4 = .false.    !  trajectories computed with a 4th order Runge-Kutta (T)
+   ln_rstflo  = .false.    !  float restart (T) or not (F)
+   nn_writefl =      75    !  frequency of writing in float output file 
+   nn_stockfl =    5475    !  frequency of creation of the float restart file 
+   ln_argo    = .false.    !  Argo type floats (stay at the surface each 10 days)
+   ln_flork4  = .false.    !  trajectories computed with a 4th order Runge-Kutta (T)
                            !  or computed with Blanke' scheme (F)
 /
@@ -670,8 +766,104 @@
 !-----------------------------------------------------------------------
    ln_diaptr  = .false.    !  Poleward heat and salt transport (T) or not (F)
-   ln_diaznl  = .false.    !  Add zonal means and meridional stream functions
-   ln_subbas  = .false.    !  Atlantic/Pacific/Indian basins computation (T) or not 
+   ln_diaznl  = .true.     !  Add zonal means and meridional stream functions
+   ln_subbas  = .true.     !  Atlantic/Pacific/Indian basins computation (T) or not 
                            !  (orca configuration only, need input basins mask file named "subbasins.nc"
-   nf_ptr     =  1         !  Frequency of ptr computation [time step]
-   nf_ptr_wri =  15        !  Frequency of ptr outputs
-/
+   ln_ptrcomp = .true.     !  Add decomposition : overturning
+   nn_fptr    =  1         !  Frequency of ptr computation [time step]
+   nn_fwri    =  15        !  Frequency of ptr outputs [time step]
+/
+!-----------------------------------------------------------------------
+&namhsb       !  Heat and salt budgets 
+!-----------------------------------------------------------------------
+   ln_diahsb  = .false.    !  check the heat and salt budgets (T) or not (F)
+/
+
+!!======================================================================
+!!            ***  Observation & Assimilation namelists ***
+!!======================================================================
+!!   namobs       observation and model comparison                      ('key_diaobs')
+!!   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               Logical switch for Reynolds observations       
+                           !     ln_ghrsst               Logical switch for GHRSST observations          
+
+   ln_sstfb   = .false.    ! Logical switch for feedback SST data          
+                           !     ln_sss                  Logical switch for SSS observations              
+                           !     ln_seaice               Logical switch for Sea Ice observations        
+                           !     ln_vel3d                Logical switch for velocity observations         
+                           !     ln_velavcur             Logical switch for velocity daily av. cur.    
+                           !     ln_velhrcur             Logical switch for velocity high freq. cur.   
+                           !     ln_velavadcp            Logical switch for velocity daily av. ADCP  
+                           !     ln_velhradcp            Logical switch for velocity high freq. ADCP
+                           !     ln_velfb                Logical switch for feedback velocity data       
+                           !     ln_grid_global          Global distribtion of observations         
+                           !     ln_grid_search_lookup   Logical switch for obs grid search w/lookup table  
+                           !     grid_search_file        Grid search lookup file header 
+                           !     enactfiles              ENACT input observation file names 
+                           !     coriofiles              Coriolis input observation file name  
+   !                       ! profbfiles: Profile feedback input observation file name 
+   profbfiles = 'profiles_01.nc'
+                           !     ln_profb_enatim         Enact feedback input time setting switch    
+                           !     slafilesact             Active SLA input observation file name
+                           !     slafilespas             Passive SLA input observation file name 
+   !                       ! slafbfiles: Feedback SLA input observation file name 
+   slafbfiles = 'sla_01.nc'
+                           !     sstfiles                GHRSST input observation file name       
+   !                       ! sstfbfiles: Feedback SST input observation file name 
+   sstfbfiles = 'sst_01.nc' 'sst_02.nc' 'sst_03.nc' 'sst_04.nc' 'sst_05.nc'
+                           !     seaicefiles             Sea Ice input observation file name 
+                           !     velavcurfiles           Vel. cur. daily av. input file name  
+                           !     velhvcurfiles           Vel. cur. high freq. input file name  
+                           !     velavadcpfiles          Vel. ADCP daily av. input file name    
+                           !     velhvadcpfiles          Vel. ADCP high freq. input file name 
+                           !     velfbfiles              Vel. feedback input observation file name 
+                           !     dobsini                 Initial date in window YYYYMMDD.HHMMSS       
+                           !     dobsend                 Final date in window YYYYMMDD.HHMMSS         
+                           !     n1dint                  Type of vertical interpolation method        
+                           !     n2dint                  Type of horizontal interpolation method       
+                           !     ln_nea                  Rejection of observations near land switch    
+   nmsshc     = 0          ! MSSH correction scheme                         
+                           !     mdtcorr                 MDT  correction                               
+                           !     mdtcutoff               MDT cutoff for computed correction          
+   ln_altbias = .false.    ! Logical switch for alt bias                
+   ln_ignmis  = .true.     ! Logical switch for ignoring missing files   
+                           !     endailyavtypes   ENACT daily average types                    
+   ln_grid_global = .true.
+   ln_grid_search_lookup = .false.
+/ 
+!-----------------------------------------------------------------------
+&nam_asminc   !   assimilation increments                               ('key_asminc')
+!-----------------------------------------------------------------------
+    ln_bkgwri = .false.    !  Logical switch for writing out background state 
+    ln_trjwri = .false.    !  Logical switch for writing out state trajectory
+    ln_trainc = .false.    !  Logical switch for applying tracer increments
+    ln_dyninc = .false.    !  Logical switch for applying velocity increments
+    ln_sshinc = .false.    !  Logical switch for applying SSH increments 
+    ln_asmdin = .false.    !  Logical switch for Direct Initialization (DI)
+    ln_asmiau = .false.    !  Logical switch for Incremental Analysis Updating (IAU)
+    nitbkg    = 0          !  Timestep of background in [0,nitend-nit000-1]
+    nitdin    = 0          !  Timestep of background for DI in [0,nitend-nit000-1]
+    nitiaustr = 1          !  Timestep of start of IAU interval in [0,nitend-nit000-1]
+    nitiaufin = 15         !  Timestep of end of IAU interval in [0,nitend-nit000-1]
+    niaufn    = 0          !  Type of IAU weighting function
+    nittrjfrq = 0          !  Frequency of trajectory output for 4D-VAR
+    ln_salfix = .false.    !  Logical switch for ensuring that the sa > salfixmin
+    salfixmin = -9999      !  Minimum salinity after applying the increments
+/
Index: trunk/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist_ice_lim2
===================================================================
--- trunk/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist_ice_lim2	(revision 2527)
+++ trunk/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist_ice_lim2	(revision 2528)
@@ -52,4 +52,7 @@
    ecc         =   2.0     !  eccentricity of the elliptical yield curve
    ahi0        = 350.e0    !  horizontal eddy diffusivity coefficient for sea-ice [m2/s]
+   nevp        =   360     !  number of EVP subcycling iterations
+   telast      =   3600    !  timescale for EVP elastic waves
+   alphaevp    =   1.0     !  coefficient for the solution of EVP int. stresses
 /
 !-----------------------------------------------------------------------
Index: trunk/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/AA_job
===================================================================
--- trunk/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/AA_job	(revision 2527)
+++ trunk/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/AA_job	(revision 2528)
@@ -110,6 +110,4 @@
 cp ${R_EXPER}/namelist_ice_lim2 namelist_ice 
 cp ${R_EXPER}/namelist namelist
-cp ${R_EXPER}/iodef.xml .
-cp ${R_EXPER}/xmlio_server.def .
 
 #- Namelist for ocean and ice (agrif fine grid)
Index: trunk/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef.xml
===================================================================
--- trunk/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef.xml	(revision 2527)
+++ trunk/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef.xml	(revision 2528)
@@ -54,6 +54,6 @@
       <group id="SBC" axis_ref="none" grid_ref="grid_T" > <!-- time step automaticaly defined based on nn_fsbc -->
 
-	<field id="emp"          description="Net Upward Water Flux"                                        unit="kg/m2/s"  />
-	<field id="emps"         description="concentration/dilution water flux"                            unit="kg/m2/s"  />
+	<field id="emp-rnf"      description="Net Upward Water Flux"                                        unit="kg/m2/s"  />
+	<field id="emps-rnf"     description="concentration/dilution water flux"                            unit="kg/m2/s"  />
 	<field id="snowpre"      description="Snow precipitation"                                           unit="kg/m2/s"  />
 	<field id="runoffs"      description="River Runoffs"                                                unit="Kg/m2/s"  />
@@ -133,9 +133,10 @@
 	<field id="utau"         description="Wind Stress along i-axis"                    unit="N/m2" axis_ref="none" />
 	<field id="uoce"         description="ocean current along i-axis"                  unit="m/s"                  />
-	<field id="uoce_eff"     description="Effective ocean current along i-axis"        unit="m/s"                  />
+	<field id="uoce_eff"     description="Effective ocean transport along i-axis"      unit="m3/s"                  />
 	<!-- uoce_eiv: available with key_traldf_eiv and key_diaeiv -->
 	<field id="uoce_eiv"     description="EIV ocean current along i-axis"              unit="m/s"                  />
-	<!-- uoce_eiv: available with key_trabbl_adv -->
-	<field id="uoce_bbl"     description="BBL ocean current along i-axis"              unit="m/s"                  />
+	<!-- uoce_eiv: available with key_trabbl -->
+	<field id="uoce_bbl"     description="BBL ocean current along i-axis"              unit="m/s"  axis_ref="none" />
+	<field id="ahu_bbl"      description="BBL diffusive flux along i-axis"             unit="m3/s" axis_ref="none" />
  	<!-- variables available with key_diaar5 -->
 	<field id="u_masstr"     description="ocean eulerian mass transport along i-axis"  unit="kg/s"                 />
@@ -150,9 +151,10 @@
 	<field id="vtau"         description="Wind Stress along j-axis"                    unit="N/m2" axis_ref="none" />
 	<field id="voce"         description="ocean current along j-axis"                  unit="m/s"                  />
-	<field id="voce_eff"     description="Effective ocean current along j-axis"        unit="m/s"                  />
+	<field id="voce_eff"     description="Effective ocean transport along j-axis"      unit="m3/s"                  />
 	<!-- voce_eiv: available with key_traldf_eiv and key_diaeiv -->
 	<field id="voce_eiv"     description="EIV ocean current along j-axis"              unit="m/s"                  />
-	<!-- voce_eiv: available with key_trabbl_adv -->
-	<field id="voce_bbl"     description="BBL ocean current along j-axis"              unit="m/s"                  />
+	<!-- voce_eiv: available with key_trabbl -->
+	<field id="voce_bbl"     description="BBL ocean current along j-axis"              unit="m/s" axis_ref="none"  />
+	<field id="ahv_bbl"      description="BBL diffusive flux along j-axis"             unit="m3/s" axis_ref="none" />
 	<!-- variables available with key_diaar5 -->
 	<field id="v_masstr"     description="ocean eulerian mass transport along j-axis"  unit="kg/s"                 />
@@ -166,9 +168,8 @@
       <group id="grid_W"  axis_ref="depthw" grid_ref="grid_W">
 	<field id="woce"         description="ocean vertical velocity"                     unit="m/s"                  />
-	<field id="woce_eff"     description="effective ocean vertical velocity"           unit="m/s"                  />
+	<field id="woce_eff"     description="effective ocean vertical transport"          unit="m3/s"                 />
 	<!-- woce_eiv: available with key_traldf_eiv and key_diaeiv -->
 	<field id="woce_eiv"     description="EIV ocean vertical velocity"                 unit="m/s"                  />
 	<!-- woce_eiv: available with key_trabbl_adv -->
-	<field id="woce_bbl"     description="BBL ocean vertical velocity"                 unit="m/s"                  />
 	<field id="avt"          description="vertical eddy diffusivity"                   unit="m2/s"                 />
 	<field id="avm"          description="vertical eddy viscosity"                     unit="m2/s"                 />
@@ -273,7 +274,7 @@
 	  <field ref="sss"          name="sosaline"  />
 	  <field ref="ssh"          name="sossheig"  />
-	  <field ref="emp"          name="sowaflup"  />
+	  <field ref="emp-rnf"      name="sowaflup"  />
 	  <field ref="qsr"          name="soshfldo"  />
-	  <field ref="emps"         name="sowaflcd"  />
+	  <field ref="emps-rnf"     name="sowaflcd"  />
 	  <field ref="qns+qsr"      name="sohefldo"  />
 	  <field ref="mldr10_1"     name="somxl010"  />
@@ -559,381 +560,4 @@
     
   </context>
-  
-  <context id="1_nemo">
-    
-    <!-- 
-============================================================================================================
-=                                  definition of all existing variables                                    =
-=                                            DO NOT CHANGE                                                 =
-============================================================================================================
-    -->
-    
-    <field_definition level="1" prec="4" operation="ave(X)" enabled=".TRUE."> <!-- time step automaticaly defined -->
-
-      <!-- T grid -->
-      
-      <group id="grid_T" axis_ref="none" grid_ref="grid_T">
-	<field id="toce"         description="temperature"                               unit="degC" axis_ref="deptht"   />
-       	<field id="soce"         description="salinity"                                  unit="psu"  axis_ref="deptht"   />
-	<field id="sst"          description="sea surface temperature"                   unit="degC"                     />
-	<field id="sst2"         description="square of sea surface temperature"         unit="degC2"                    />
-	<field id="|sstgrad|"    description="module of sst gradient"                    unit="degC/m"                   />
-	<field id="|sstgrad|2"   description="square of module of sst gradient"          unit="degC2/m2"                 />
-	<field id="sss"          description="sea surface salinity"                      unit="psu"                      />
-	<field id="sss2"         description="square of sea surface salinity"            unit="psu2"                     />
-	<field id="ssh"          description="sea surface height"                        unit="m"                        />
-	<field id="ssh2"         description="square of sea surface height"              unit="m2"                       />
-	<field id="mldkz5"       description="mixing layer depth (Turbocline)"           unit="m"                        />
-	<field id="mldr10_1"     description="Mixed Layer Depth 0.01 ref.10m"            unit="m"                        />
-       	<field id="rhop"         description="potential density (sigma0)"                unit="kg/m3" axis_ref="deptht"  />
-	<!-- next variables available with key_diahth -->
-	<field id="mlddzt"       description="Thermocline Depth (max dT/dz)"             unit="m"                        />
-	<field id="mldr10_3"     description="Mixed Layer Depth dr=0.03 (ref.10m)"       unit="m"                        />
-	<field id="mldr0_1"      description="Mixed Layer Depth dr=0.01 (ref.surf)"      unit="m"                        />
-	<field id="mldr0_3"      description="Mixed Layer Depth dr=0.03 (ref.surf)"      unit="m"                        />
-	<field id="mld|dt|"      description="Mixed Layer Depth |dt|=0.2 (ref.10m)"      unit="m"                        />
-	<field id="topthdep"     description="Top of the thermocline dt=-0.2 (ref.10m)"  unit="m"                        />
-	<field id="pycndep"      description="Pycnocline depth dr~dt=-0.2 (ref.10m)"     unit="m"                        />
-	<field id="BLT"          description="Barrier Layer Thickness"                   unit="m"                        />
-	<field id="tinv"         description="Max of vertical invertion of temperature"  unit="degC"                     />
-	<field id="depti"        description="Depth of max. vert. inv. of temperature"   unit="m"                        />
-        <field id="20d"          description="Depth of 20C isotherm"                     unit="m"                        />
-	<field id="28d"          description="Depth of 28C isotherm"                     unit="m"                        />
-	<field id="hc300"        description="Heat content 300 m"                        unit="W"                        />
-	<!-- variables available with key_diaar5 -->
-	<field id="botpres"      description="Pressure at sea floor"                     unit="dbar"                     />
-	<field id="cellthc"      description="Cell thickness"                            unit="m"     axis_ref="deptht"  />
-     </group>
-
-      <!-- SBC -->
-      
-      <group id="SBC" axis_ref="none" grid_ref="grid_T" > <!-- time step automaticaly defined based on nn_fsbc -->
-
-	<field id="emp"          description="Net Upward Water Flux"                                        unit="kg/m2/s"  />
-	<field id="emps"         description="concentration/dilution water flux"                            unit="kg/m2/s"  />
-	<field id="snowpre"      description="Snow precipitation"                                           unit="kg/m2/s"  />
-	<field id="runoffs"      description="River Runoffs"                                                unit="Kg/m2/s"  />
-
-	<field id="qns+qsr"      description="Net Downward Heat Flux"                                       unit="W/m2"     />
-	<field id="qns"          description="non solar Downward Heat Flux"                                 unit="W/m2"     />
-	<field id="qsr"          description="Shortwave Radiation"                                          unit="W/m2"     />
-	<field id="qsr3d"        description="Shortwave Radiation 3D distribution"        axis_ref="deptht" unit="W/m2"     />
-	<field id="qrp"          description="Surface Heat Flux: Damping"                                   unit="W/m2"     />
-	<field id="erp"          description="Surface Water Flux: Damping"                                  unit="Kg/m2/s"  />
-	<field id="taum"         description="wind stress module"                                           unit="N/m2"     />
-	<field id="wspd"         description="Wind speed module at 10 m"                                    unit="m/s"      />
-	
-	<!-- *_oce variables available with ln_blk_clio or ln_blk_core -->
-	<field id="qns_oce"      description="Non solar Downward Heat Flux over open ocean"                 unit="W/m2"     />
-	<field id="qlw_oce"      description="Longwave Downward Heat Flux over open ocean"                  unit="W/m2"     />
-	<field id="qsb_oce"      description="Sensible Downward Heat Flux over open ocean"                  unit="W/m2"     />
-	<field id="qla_oce"      description="Latent Downward Heat Flux over open ocean"                    unit="W/m2"     />
-	<field id="taum_oce"     description="wind stress module over open ocean"                           unit="N/m2"     />
-
-	<field id="ice_cover"    description="Ice fraction"                                                 unit="1"        />
-
-	<field id="ioceflxb"     description="Oceanic flux at the ice base"                                 unit="W/m2"     />
-	<field id="qsr_ai_cea"   description="Air-Ice downward solar heat flux (cell average)"              unit="W/m2"     />
-	<field id="qns_ai_cea"   description="Air-Ice downward non-solar heat flux (cell average)"          unit="W/m2"     />
-	<field id="qla_ai_cea"   description="Air-Ice downward Latent heat flux (cell average)"             unit="W/m2"     />
-	
-	<field id="qsr_io_cea"   description="Ice-Oce downward solar heat flux (cell average)"              unit="W/m2"     />
-	<field id="qns_io_cea"   description="Ice-Oce downward non-solar heat flux (cell average)"          unit="W/m2"     />
-	
-	<field id="snowthic_cea" description="Snow thickness (cell average)"                                unit="m"        />
-	<field id="icethic_cea"  description="Ice thickness (cell average)"                                 unit="m"        />
-	<field id="iceprod_cea"  description="Ice production (cell average)"                                unit="m/s"      />
-	
-	<field id="ice_pres"     description="Ice presence"                                                 unit="-"        />
-	<field id="ist_cea"      description="Ice surface temperature (cell average)"                       unit="degC"     />
-	<field id="ist_ipa"      description="Ice surface temperature (ice presence average)"               unit="degC"     />      
-	<field id="uice_ipa"     description="Ice velocity along i-axis at I-point (ice presence average)"  unit="m/s"      />      
-	<field id="vice_ipa"     description="Ice velocity along j-axis at I-point (ice presence average)"  unit="m/s"      />      
-	
-	<field id="utau_ice"     description="Wind stress along i-axis over the ice at i-point"             unit="N/m2"     />
-	<field id="vtau_ice"     description="Wind stress along j-axis over the ice at i-point"             unit="N/m2"     />
-	
-	<field id="u_imasstr"    description="Sea-ice mass transport along i-axis"                          unit="kg/s"     />
-	<field id="v_imasstr"    description="Sea-ice mass transport along j-axis"                          unit="kg/s"     />
-
-	<!-- available key_coupled -->
-	<field id="snow_ao_cea"  description="Snow over ice-free ocean (cell average)"                      unit="kg/m2/s"  />
-	<field id="snow_ai_cea"  description="Snow over sea-ice (cell average)"                             unit="kg/m2/s"  />
-	<field id="subl_ai_cea"  description="Sublimation over sea-ice (cell average)"                      unit="kg/m2/s"  />
-	<field id="icealb_cea"   description="Ice albedo (cell average)"                                    unit="1"        />
-	<field id="calving"      description="Calving"                                                      unit="kg/m2/s"  />
-	<!-- available if key_coupled + conservative method -->
-	<field id="rain"         description="Liquid precipitation"                                         unit="Kg/m2/s"  />
-	<field id="evap_ao_cea"  description="Evaporation over ice-free ocean (cell average)"               unit="kg/m2/s"  />
-	<!-- variables available with key_diaar5 -->
-	<field id="isnwmlt_cea"   description="Snow over Ice melting (cell average)"                        unit="kg/m2/s"  />
-	<field id="fsal_virt_cea" description="Virtual salt flux due to ice formation (cell average)"       unit="kg/m2/s"  />
-	<field id="fsal_real_cea" description="Real salt flux due to ice formation (cell average)"          unit="kg/m2/s"  />
-	<field id="hflx_rain_cea" description="heat flux due to rainfall"                                   unit="W/m2"     />
-	<field id="hflx_evap_cea" description="heat flux due to evaporation"                                unit="W/m2"     />
-	<field id="hflx_snow_cea" description="heat flux due to snow falling over ice-free ocean"           unit="W/m2"     />
-	<field id="hflx_ice_cea"  description="heat flux due to ice thermodynamics"                         unit="W/m2"     />
-	<field id="hflx_rnf_cea"  description="heat flux due to runoffs"                                    unit="W/m2"     />
-	<field id="hflx_cal_cea"  description="heat flux due to calving"                                    unit="W/m2"     />
-	<field id="bicemel_cea"  description="Rate of Melt at Sea Ice Base (cell average)"                  unit="kg/m2/s"  />
-	<field id="licepro_cea"  description="Lateral Sea Ice Growth Rate (cell average)"                   unit="kg/m2/s"  />
-	<field id="snowmel_cea"  description="Snow Melt Rate (cell average)"                                unit="kg/m2/s"  />
-	<field id="sntoice_cea"  description="Snow-Ice Formation Rate (cell average)"                       unit="kg/m2/s"  />
-	<field id="ticemel_cea"  description="Rate of Melt at Upper Surface of Sea Ice (cell average)"      unit="kg/m2/s"  />
-
-      </group>
-
-      <!-- U grid -->
-      
-      <group id="grid_U"  axis_ref="depthu" grid_ref="grid_U">
-	<field id="utau"         description="Wind Stress along i-axis"                    unit="N/m2" axis_ref="none" />
-	<field id="uoce"         description="ocean current along i-axis"                  unit="m/s"                  />
-	<field id="uoce_eff"     description="Effective ocean current along i-axis"        unit="m/s"                  />
-	<!-- uoce_eiv: available with key_traldf_eiv and key_diaeiv -->
-	<field id="uoce_eiv"     description="EIV ocean current along i-axis"              unit="m/s"                  />
-	<!-- uoce_eiv: available with key_trabbl_adv -->
-	<field id="uoce_bbl"     description="BBL ocean current along i-axis"              unit="m/s"                  />
- 	<!-- variables available with key_diaar5 -->
-	<field id="u_masstr"     description="ocean eulerian mass transport along i-axis"  unit="kg/s"                 />
-	<field id="u_heattr"     description="ocean eulerian heat transport along i-axis"  unit="W"    axis_ref="none" />
-	<field id="ueiv_heattr"  description="ocean bolus heat transport along i-axis"     unit="W"    axis_ref="none" />
-	<field id="udiff_heattr" description="ocean diffusion heat transport along i-axis" unit="W"    axis_ref="none" />
-     </group>
-      
-      <!-- V grid -->
-      
-      <group id="grid_V"  axis_ref="depthv" grid_ref="grid_V">
-	<field id="vtau"         description="Wind Stress along j-axis"                    unit="N/m2" axis_ref="none" />
-	<field id="voce"         description="ocean current along j-axis"                  unit="m/s"                  />
-	<field id="voce_eff"     description="Effective ocean current along j-axis"        unit="m/s"                  />
-	<!-- voce_eiv: available with key_traldf_eiv and key_diaeiv -->
-	<field id="voce_eiv"     description="EIV ocean current along j-axis"              unit="m/s"                  />
-	<!-- voce_eiv: available with key_trabbl_adv -->
-	<field id="voce_bbl"     description="BBL ocean current along j-axis"              unit="m/s"                  />
-	<!-- variables available with key_diaar5 -->
-	<field id="v_masstr"     description="ocean eulerian mass transport along j-axis"  unit="kg/s"                 />
-	<field id="v_heattr"     description="ocean eulerian heat transport along j-axis"  unit="W"    axis_ref="none" />
-	<field id="veiv_heattr"  description="ocean bolus heat transport along j-axis"     unit="W"    axis_ref="none" />
-	<field id="vdiff_heattr" description="ocean diffusion heat transport along j-axis" unit="W"    axis_ref="none" />
-      </group>
-      
-      <!-- W grid -->
-      
-      <group id="grid_W"  axis_ref="depthw" grid_ref="grid_W">
-	<field id="woce"         description="ocean vertical velocity"                     unit="m/s"                  />
-	<field id="woce_eff"     description="effective ocean vertical velocity"           unit="m/s"                  />
-	<!-- woce_eiv: available with key_traldf_eiv and key_diaeiv -->
-	<field id="woce_eiv"     description="EIV ocean vertical velocity"                 unit="m/s"                  />
-	<!-- woce_eiv: available with key_trabbl_adv -->
-	<field id="woce_bbl"     description="BBL ocean vertical velocity"                 unit="m/s"                  />
-	<field id="avt"          description="vertical eddy diffusivity"                   unit="m2/s"                 />
-	<field id="avm"          description="vertical eddy viscosity"                     unit="m2/s"                 />
-	<!-- avs: available with key_zdfddm -->
-	<field id="avs"          description="salt vertical eddy diffusivity"              unit="m2/s"                 />
-	<!-- avt_evd and avm_evd: available with ln_zdfevd -->
-	<field id="avt_evd"      description="enhanced vertical diffusivity"               unit="m2/s"                 />
-	<field id="avm_evd"      description="enhanced vertical viscosity"                 unit="m2/s"                 />
-	<!-- aht2d and  aht2d_eiv: available with key_traldf_eiv and key_traldf_c2d -->
-	<field id="aht2d"        description="lateral eddy diffusivity"                    unit="m2/s" axis_ref="none" />
-	<field id="aht2d_eiv"    description="EIV lateral eddy diffusivity"                unit="m2/s" axis_ref="none" />
-	<!-- avt_tide: available with key_zdftmx -->
-	<field id="av_tide"      description="tidal vertical diffusivity"                  unit="m2/s"                 />
-	<!-- variables available with key_diaar5 -->   
-	<field id="w_masstr"     description="vertical mass trasport"                      unit="kg/s"                 />
-	<field id="w_masstr2"    description="square of vertical mass trasport"            unit="kg2/s2"               />
-      </group>
-          
-      <!-- scalar -->
-      
-      <!-- variables available with key_diaar5 -->
-      <group id="scalar" axis_ref="none" grid_ref="scalarpoint" zoom_ref="1point" >
-	<field id="voltot"     description="global mean volume"                         unit="m3"   />
-	<field id="sshtot"     description="global mean ssh"                            unit="m"    />
-	<field id="sshsteric"  description="global mean ssh steric"                     unit="m"    />
-	<field id="sshthster"  description="global mean ssh thermosteric"               unit="m"    />
-	<field id="masstot"    description="global mean mass"                           unit="kg"   />
-	<field id="temptot"    description="global mean temperature"                    unit="degC" />
-	<field id="saltot"     description="global mean salinity"                       unit="psu"  />
-	<field id="fram_trans" description="Sea Ice Mass Transport Through Fram Strait" unit="kg/s" />
-      </group>
-
-    </field_definition>
-    
-    <!-- 
-============================================================================================================
-=                                           output files definition                                        =
-=                                            Define your own files                                         =
-=                                         put the variables you want...                                    =
-============================================================================================================
-    -->
-    
-    <file_definition >
-
-      <group id="1h" output_freq="3600"   output_level="10" enabled=".TRUE.">                      <!-- 1h files -->
-      </group>
-      
-      <group id="2h" output_freq="7200"   output_level="10" enabled=".TRUE.">                      <!-- 2h files -->
-      </group>
-      
-      <group id="3h" output_freq="10800"  output_level="10" enabled=".TRUE.">                      <!-- 3h files -->
-      </group>
-      
-      <group id="4h" output_freq="14400"  output_level="10" enabled=".TRUE.">                      <!-- 4h files -->
-      </group>
-      
-      <group id="6h" output_freq="21600"  output_level="10" enabled=".TRUE.">                      <!-- 6h files -->
-      </group>
-      
-      <group id="1d" output_freq="86400"  output_level="10" enabled=".TRUE.">                      <!-- 1d files -->
-	  <!-- global file with different operations on data   -->
-	 <file id="1d_grid_T" name="auto" description="ocean T grid variables" >
-	    <field ref="sst"    name="sst_1d_ave"                       />     <!-- mean -->
-	    <field ref="sst"    name="sst_1d_max"  operation="t_max(X)" />     <!-- max -->
-	  </file>
-      </group>
-      
-      <group id="3d" output_freq="259200" output_level="10" enabled=".TRUE.">                      <!-- 3d files -->
-      </group>
-      
-      <group id="5d" output_freq="432000" output_level="10" enabled=".TRUE.">                      <!-- 5d files -->
-
-	<file id="5d_grid_T" name="auto" description="ocean T grid variables" >
-	  <field ref="toce"         name="votemper"  />
-	  <field ref="soce"         name="vosaline"  />
-	  <field ref="sst"          name="sosstsst"  />
-	  <field ref="sss"          name="sosaline"  />
-	  <field ref="ssh"          name="sossheig"  />
-	  <field ref="emp"          name="sowaflup"  />
-	  <field ref="qsr"          name="soshfldo"  />
-	  <field ref="emps"         name="sowaflcd"  />
-	  <field ref="qns+qsr"      name="sohefldo"  />
-	  <field ref="mldr10_1"     name="somxl010"  />
-	  <field ref="mldkz5"       name="somixhgt"  />
-	  <field ref="ice_cover"    name="soicecov"  />
-	  <field ref="wspd"         name="sowindsp"  />
-	  <field ref="qrp"          name="sohefldp"  />
-	  <field ref="erp"          name="sowafldp"  />
-	  <field ref="mlddzt"       name="sothedep"  />
-	  <field ref="20d"          name="so20chgt"  />
-	  <field ref="28d"          name="so28chgt"  />
-	  <field ref="hc300"        name="sohtc300"  />
-	  <field ref="ist_ipa"      name="soicetem"  />
-	  <field ref="icealb_cea"   name="soicealb"  />   
-	</file>
-	
-	<file id="5d_grid_U" name="auto" description="ocean U grid variables" >
-	  <field ref="uoce"         name="vozocrtx"  />
-	  <field ref="utau"         name="sozotaux"  />
-	</file>
-	
-	<file id="5d_grid_V" name="auto" description="ocean V grid variables" >
-	  <field ref="voce"         name="vomecrty"  />
-	  <field ref="vtau"         name="sometauy"  />
-	</file>
-	
-	<file id="5d_grid_W" name="auto" description="ocean W grid variables" >
-	  <field ref="woce"         name="vovecrtz" />
-	  <field ref="avt"          name="votkeavt" />
-	  <field ref="avt_evd"      name="votkeevd" />
-	  <field ref="avm"          name="votkeavm" />
-	  <field ref="avm_evd"      name="votkeevm" />
-	  <field ref="avs"          name="voddmavs" />
-	  <field ref="aht2d"        name="soleahtw" />
-	</file>
-	
-<!--
-	<file id="5d_icemod" name="auto" description="ice variables" >
-	  <field ref="ice_pres"                     />
-	  <field ref="snowthic_cea" name="isnowthi" />
-	  <field ref="icethic_cea"  name="iicethic" />
-	  <field ref="iceprod_cea"  name="iiceprod" />
-	  <field ref="ist_ipa"      name="iicetemp" />
-	  <field ref="ioceflxb"     name="ioceflxb" />
-	  <field ref="uice_ipa"     name="iicevelu" />
-	  <field ref="vice_ipa"     name="iicevelv" />
-	  <field ref="utau_ice"     name="iicestru" />
-	  <field ref="vtau_ice"     name="iicestrv" />
-	  <field ref="qsr_io_cea"   name="iicesflx" />
-	  <field ref="qns_io_cea"   name="iicenflx" />
-	  <field ref="snowpre"      name="isnowpre" />
-	</file>
--->
-	
-      </group>
-      
-      <group id="1m" output_freq="-1"     output_level="10" enabled=".TRUE.">                      <!-- real monthly files -->
-
-	<file id="1m_grid_T" name="auto" description="ocean T grid variables" >
-	  <field ref="sst"          name="sosstsst"  />
-	</file>   
-
-      </group>
-
-      <group id="2m" output_freq="-2"     output_level="10" enabled=".TRUE.">                      <!-- real 2m files -->
-      </group>
-
-      <group id="3m" output_freq="-3"     output_level="10" enabled=".TRUE.">                      <!-- real 3m files -->
-      </group>
-
-      <group id="4m" output_freq="-4"     output_level="10" enabled=".TRUE.">                      <!-- real 4m files -->
-      </group>
-
-      <group id="6m" output_freq="-6"     output_level="10" enabled=".TRUE.">                      <!-- real 6m files -->
-      </group>
-
-      <group id="1y" output_freq="-12"    output_level="10" enabled=".TRUE.">                      <!-- real yearly files -->
-
-	<file id="1y_grid_T" name="auto" description="ocean T grid variables" >
-	  <field ref="mldr10_1"     name="sobowlin"  operation="t_max(X)" />
-	</file>
-
-      </group>
-
-      <group id="2y"  output_freq="-24"   output_level="10" enabled=".TRUE.">                      <!-- real 2y files -->
-      </group>
-
-      <group id="5y"  output_freq="-60"   output_level="10" enabled=".TRUE.">                      <!-- real 5y files -->
-      </group>
-
-      <group id="10y" output_freq="-120"  output_level="10" enabled=".TRUE.">                      <!-- real 10y files -->
-      </group>
-
-    </file_definition>
-    
-    <!-- 
-============================================================================================================
-=                                           grid definition                                                =
-=                                            DO NOT CHANGE                                                 =
-============================================================================================================
-    -->
-    
-    <axis_definition>  
-      <axis id="deptht" description="Vertical T levels" unit="m" positive=".false." />
-      <axis id="depthu" description="Vertical U levels" unit="m" positive=".false." />
-      <axis id="depthv" description="Vertical V levels" unit="m" positive=".false." />
-      <axis id="depthw" description="Vertical W levels" unit="m" positive=".false." />
-      <axis id="none" description="axe non defini" unit="none" size="1" />
-    </axis_definition> 
-    
-    <grid_definition>
-      <grid id="grid_T" description="grid T" >
-      </grid>
-
-      <grid id="grid_U" description="grid U" >
-      </grid>
-
-      <grid id="grid_V" description="grid V" >
-      </grid>
-
-      <grid id="grid_W" description="grid W" >
-      </grid>
-
-      <grid id="scalarpoint" description="scalar" >
-	<zoom id="1point" ibegin="1" jbegin="1" ni="1" nj="1" />
-      </grid>
-
-    </grid_definition>    
-    
-  </context>
-  
+
 </simulation>
Index: trunk/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef_ar5.xml
===================================================================
--- trunk/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef_ar5.xml	(revision 2527)
+++ trunk/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef_ar5.xml	(revision 2528)
@@ -54,6 +54,6 @@
       <group id="SBC" axis_ref="none" grid_ref="grid_T" > <!-- time step automaticaly defined based on nn_fsbc -->
 
-	<field id="emp"          description="Net Upward Water Flux"                                        unit="kg/m2/s"  />
-	<field id="emps"         description="concentration/dilution water flux"                            unit="kg/m2/s"  />
+	<field id="emp-rnf"      description="Net Upward Water Flux"                                        unit="kg/m2/s"  />
+	<field id="emps-rnf"     description="concentration/dilution water flux"                            unit="kg/m2/s"  />
 	<field id="snowpre"      description="Snow precipitation"                                           unit="kg/m2/s"  />
 	<field id="runoffs"      description="River Runoffs"                                                unit="Kg/m2/s"  />
@@ -133,9 +133,10 @@
 	<field id="utau"         description="Wind Stress along i-axis"                    unit="N/m2" axis_ref="none" />
 	<field id="uoce"         description="ocean current along i-axis"                  unit="m/s"                  />
-	<field id="uoce_eff"     description="Effective ocean current along i-axis"        unit="m/s"                  />
+	<field id="uoce_eff"     description="Effective ocean transport along i-axis"      unit="m3/s"                 />
 	<!-- uoce_eiv: available with key_traldf_eiv and key_diaeiv -->
 	<field id="uoce_eiv"     description="EIV ocean current along i-axis"              unit="m/s"                  />
-	<!-- uoce_eiv: available with key_trabbl_adv -->
-	<field id="uoce_bbl"     description="BBL ocean current along i-axis"              unit="m/s"                  />
+	<!-- uoce_eiv: available with key_trabbl -->
+	<field id="uoce_bbl"     description="BBL ocean current along i-axis"              unit="m/s" axis_ref="none"  />
+	<field id="ahu_bbl"      description="BBL diffusive flux along i-axis"             unit="m3/s" axis_ref="none" />
  	<!-- variables available with key_diaar5 -->
 	<field id="u_masstr"     description="ocean eulerian mass transport along i-axis"  unit="kg/s"                 />
@@ -150,9 +151,10 @@
 	<field id="vtau"         description="Wind Stress along j-axis"                    unit="N/m2" axis_ref="none" />
 	<field id="voce"         description="ocean current along j-axis"                  unit="m/s"                  />
-	<field id="voce_eff"     description="Effective ocean current along j-axis"        unit="m/s"                  />
+	<field id="voce_eff"     description="Effective ocean transport along j-axis"      unit="m3/s"                  />
 	<!-- voce_eiv: available with key_traldf_eiv and key_diaeiv -->
 	<field id="voce_eiv"     description="EIV ocean current along j-axis"              unit="m/s"                  />
-	<!-- voce_eiv: available with key_trabbl_adv -->
-	<field id="voce_bbl"     description="BBL ocean current along j-axis"              unit="m/s"                  />
+	<!-- voce_eiv: available with key_trabbl -->
+	<field id="voce_bbl"     description="BBL ocean current along j-axis"              unit="m/s"  axis_ref="none" />
+	<field id="ahv_bbl"      description="BBL diffusive flux along j-axis"             unit="m3/s" axis_ref="none" />
 	<!-- variables available with key_diaar5 -->
 	<field id="v_masstr"     description="ocean eulerian mass transport along j-axis"  unit="kg/s"                 />
@@ -166,9 +168,8 @@
       <group id="grid_W"  axis_ref="depthw" grid_ref="grid_W">
 	<field id="woce"         description="ocean vertical velocity"                     unit="m/s"                  />
-	<field id="woce_eff"     description="effective ocean vertical velocity"           unit="m/s"                  />
+	<field id="woce_eff"     description="effective ocean vertical transport"          unit="m3/s"                 />
 	<!-- woce_eiv: available with key_traldf_eiv and key_diaeiv -->
 	<field id="woce_eiv"     description="EIV ocean vertical velocity"                 unit="m/s"                  />
 	<!-- woce_eiv: available with key_trabbl_adv -->
-	<field id="woce_bbl"     description="BBL ocean vertical velocity"                 unit="m/s"                  />
 	<field id="avt"          description="vertical eddy diffusivity"                   unit="m2/s"                 />
 	<field id="avm"          description="vertical eddy viscosity"                     unit="m2/s"                 />
@@ -265,5 +266,5 @@
 	    <field ref="calving"      name="ficeberg" description="water_flux_into_sea_water_from_icebergs"                 level="1" />
 	    <field ref="isnwmlt_cea"  name="fsitherm" description="water_flux_into_sea_water_due_to_sea_ice_thermodynamics" level="1" />
-	    <field ref="emp"          name="wfo"      description="water_flux_into_sea_water"                               level="1" />
+	    <field ref="emp-rnf"      name="wfo"      description="water_flux_into_sea_water"                               level="1" />
 	    <!-- wfonocorr : water_flux_into_sea_water_without_flux_correction : emp - erp -->  
 	    <field ref="erp"          name="wfcorr"   description="water_flux_correction"                                   level="1" /> <!-- usually = 0 -->
Index: trunk/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/kRGB61.txt
===================================================================
--- trunk/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/kRGB61.txt	(revision 2528)
+++ trunk/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/kRGB61.txt	(revision 2528)
@@ -0,0 +1,61 @@
+  0.010    0.01618   0.07464   0.37807
+  0.011    0.01654   0.07480   0.37823
+  0.013    0.01693   0.07499   0.37840
+  0.014    0.01736   0.07518   0.37859
+  0.016    0.01782   0.07539   0.37879
+  0.018    0.01831   0.07562   0.37900
+  0.020    0.01885   0.07586   0.37923
+  0.022    0.01943   0.07613   0.37948
+  0.025    0.02005   0.07641   0.37976
+  0.028    0.02073   0.07672   0.38005
+  0.032    0.02146   0.07705   0.38036
+  0.035    0.02224   0.07741   0.38070
+  0.040    0.02310   0.07780   0.38107
+  0.045    0.02402   0.07821   0.38146
+  0.050    0.02501   0.07866   0.38189
+  0.056    0.02608   0.07914   0.38235
+  0.063    0.02724   0.07967   0.38285
+  0.071    0.02849   0.08023   0.38338
+  0.079    0.02984   0.08083   0.38396
+  0.089    0.03131   0.08149   0.38458
+  0.100    0.03288   0.08219   0.38526
+  0.112    0.03459   0.08295   0.38598
+  0.126    0.03643   0.08377   0.38676
+  0.141    0.03842   0.08466   0.38761
+  0.158    0.04057   0.08561   0.38852
+  0.178    0.04289   0.08664   0.38950
+  0.200    0.04540   0.08775   0.39056
+  0.224    0.04811   0.08894   0.39171
+  0.251    0.05103   0.09023   0.39294
+  0.282    0.05420   0.09162   0.39428
+  0.316    0.05761   0.09312   0.39572
+  0.355    0.06130   0.09474   0.39727
+  0.398    0.06529   0.09649   0.39894
+  0.447    0.06959   0.09837   0.40075
+  0.501    0.07424   0.10040   0.40270
+  0.562    0.07927   0.10259   0.40480
+  0.631    0.08470   0.10495   0.40707
+  0.708    0.09056   0.10749   0.40952
+  0.794    0.09690   0.11024   0.41216
+  0.891    0.10374   0.11320   0.41502
+  1.000    0.11114   0.11639   0.41809
+  1.122    0.11912   0.11984   0.42142
+  1.259    0.12775   0.12356   0.42500
+  1.413    0.13707   0.12757   0.42887
+  1.585    0.14715   0.13189   0.43304
+  1.778    0.15803   0.13655   0.43754
+  1.995    0.16978   0.14158   0.44240
+  2.239    0.18248   0.14701   0.44765
+  2.512    0.19620   0.15286   0.45331
+  2.818    0.21102   0.15918   0.45942
+  3.162    0.22703   0.16599   0.46601
+  3.548    0.24433   0.17334   0.47313
+  3.981    0.26301   0.18126   0.48080
+  4.467    0.28320   0.18981   0.48909
+  5.012    0.30502   0.19903   0.49803
+  5.623    0.32858   0.20898   0.50768
+  6.310    0.35404   0.21971   0.51810
+  7.079    0.38154   0.23129   0.52934
+  7.943    0.41125   0.24378   0.54147
+  8.912    0.44336   0.25725   0.55457
+ 10.000    0.47804   0.27178   0.56870
Index: trunk/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist
===================================================================
--- trunk/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist	(revision 2527)
+++ trunk/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist	(revision 2528)
@@ -1,7 +1,8 @@
 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 !! NEMO/OPA  :  1 - run manager      (namrun)
-!! namelists    2 - Domain           (namzgr, namzgr_sco, namdom)
+!! namelists    2 - Domain           (namzgr, namzgr_sco, namdom, namdta_tem, namdta_sal)
 !!              3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core
-!!                                    namsbc_cpl, namqsr, namsbc_rnf, namsbc_ssr, namsbc_alb)
+!!                                    namsbc_cpl, namsbc_cpl_co2 namtra_qsr, namsbc_rnf, 
+!!                                    namsbc_apr, namsbc_ssr, namsbc_alb)
 !!              4 - lateral boundary (namlbc, namcla, namobc, namagrif, nambdy, nambdy_tide)
 !!              5 - bottom  boundary (nambfr, nambbc, nambbl)
@@ -9,15 +10,15 @@
 !!              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      (namtrd, namgap, namspr, namflo, namptr)
-!!              9 - miscellaneous    (namsol, nammpp, nammpp_dyndist, namctl)
+!!              9 - diagnostics      (namnc4, namtrd, namspr, namflo, namptr, namhsb)
+!!             10 - miscellaneous    (namsol, nammpp, nammpp_dyndist, namctl)
+!!             11 - Obs & Assim      (namobs, nam_asminc)
 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-!  CAUTION: some scripts does not support CAPITALs for logical use .true./.false., not .TRUE./.FALSE.
 
 !!======================================================================
 !!                   ***  Run management namelists  ***
 !!======================================================================
-!!   namrun            parameters of the run
-!!======================================================================
-
+!!   namrun        parameters of the run
+!!======================================================================
+!
 !-----------------------------------------------------------------------
 &namrun        !   parameters of the run
@@ -27,20 +28,21 @@
    nn_it000    =       1   !  first time step
    nn_itend    =    5475   !  last  time step (std 5475)
-   nn_date0    =  010101   !  initial calendar date yymmdd (used if nrstdt=1)
+   nn_date0    =  010101   !  initial calendar date yymmdd (used if nn_rstctl=1)
    nn_leapy    =       0   !  Leap year calendar (1) or not (0)
+   ln_rstart   = .false.   !  start from rest (F) or from a restart file (T)
+   nn_rstctl   =       0       !  restart control = 0 nn_it000 is not compared to the restart file value
+                               !                  = 1 use nn_date0 in namelist (not the value in the restart file)
+                               !                  = 2 calendar parameters read in the restart file
+   cn_ocerst_in  = "restart"   !  suffix of ocean restart name (input)
+   cn_ocerst_out = "restart"   !  suffix of ocean restart name (output)
    nn_istate   =       0   !  output the initial state (1) or not (0)
    nn_stock    =    5475   !  frequency of creation of a restart file (modulo referenced to 1)
-   nn_write    =    5475   !  frequency of write in the output file   (modulo referenced to nit000)
+   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
-   nn_chunksz  =       0   !  chunksize (bytes) for NetCDF file (working only with iom_nf90 routines)
-   ln_rstart   = .false.   !  start from rest (F) or from a restart file (T)
-   nn_rstctl   =       0       !  restart control = 0 nit000 is not compared to the restart file value
-                               !                  = 1 use ndate0 in namelist (not the value in the restart file)
-                               !                  = 2 calendar parameters read in the restart file
-   cn_ocerst_in  = "restart"   !  suffix of ocean restart name (input)
-   cn_ocerst_out = "restart"   !  suffix of ocean restart name (output)
-/
+   nn_chunksz  =       0   !  chunksize (bytes) for NetCDF file (works only with iom_nf90 routines)
+/
+
 !!======================================================================
 !!                      ***  Domain namelists  ***
@@ -49,6 +51,8 @@
 !!   namzgr_sco   s-coordinate or hybrid z-s-coordinate
 !!   namdom       space and time domain (bathymetry, mesh, timestep)
-!!======================================================================
-
+!!   namdta_tem   data: temperature                                     ("key_dtatem")
+!!   namdta_sal   data: salinity                                        ("key_dtasal")
+!!======================================================================
+!
 !-----------------------------------------------------------------------
 &namzgr        !   vertical coordinate
@@ -63,7 +67,7 @@
    rn_sbot_min =  300.     !  minimum depth of s-bottom surface (>0) (m)
    rn_sbot_max = 5250.     !  maximum depth of s-bottom surface (= ocean depth) (>0) (m)
-   rn_theta    =    6.0    !  surface control parameter (0<=theta<=20)
-   rn_thetb    =    0.75   !  bottom control parameter  (0<=thetb<= 1)
-   rn_rmax     =    0.15   !  maximum cut-off r-value allowed (0<r_max<1)
+   rn_theta    =    6.0    !  surface control parameter (0<=rn_theta<=20)
+   rn_thetb    =    0.75   !  bottom control parameter  (0<=rn_thetb<= 1)
+   rn_rmax     =    0.15   !  maximum cut-off r-value allowed (0<rn_max<1)
    ln_s_sigma  = .false.   !  hybrid s-sigma coordinates
    rn_bb       =    0.8    !  stretching with s-sigma
@@ -73,57 +77,77 @@
 &namdom        !   space and time domain (bathymetry, mesh, timestep)
 !-----------------------------------------------------------------------
-   nn_bathy    =    1      !  compute (=0) or read(=1) the bathymetry file
-   nn_closea   =    0      !  closed seas and lakes are removed (=0) or kept (=1) from the ORCA domain
-   nn_msh      =    0      !  create (=1) a mesh file (coordinates, scale factors, masks) or not (=0)
-   rn_e3zps_min=   20.     !  the thickness of the partial step is set larger than the minimum
-   rn_e3zps_rat=    0.1    !  of e3zps_min and e3zps_rat * e3t   (N.B. 0<e3zps_rat<1)
+   nn_bathy    =    1      !  compute (=0) or read (=1) the bathymetry file
+   nn_closea    =   0      !  remove (=0) or keep (=1) closed seas and lakes (ORCA)
+   nn_msh      =    0      !  create (=1) a mesh file or not (=0)
+   rn_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
+   rn_e3zps_rat=    0.1    !  rn_e3zps_min and rn_e3zps_rat*e3t, with 0<rn_e3zps_rat<1
                            !
-   rn_rdt      = 5760.     !  time step for the dynamics (and tracer if nacc=0)   ==> 5760
-   nn_baro     =   64      !  number of barotropic time step (for the split explicit algorithm) ("key_dynspg_ts")
+   rn_rdt      = 5760.     !  time step for the dynamics (and tracer if nn_acc=0)
+   nn_baro     =   64      !  number of barotropic time step            ("key_dynspg_ts")
    rn_atfp     =    0.1    !  asselin time filter parameter
    nn_acc      =    0      !  acceleration of convergence : =1      used, rdt < rdttra(k)
                                  !                          =0, not used, rdt = rdttra
-   rn_rdtmin   = 28800.          !  minimum time step on tracers (used if nacc=1)
-   rn_rdtmax   = 28800.          !  maximum time step on tracers (used if nacc=1)
-   rn_rdth     =  800.           !  depth variation of tracer time step  (used if nacc=1)
-/
+   rn_rdtmin   = 28800.          !  minimum time step on tracers (used if nn_acc=1)
+   rn_rdtmax   = 28800.          !  maximum time step on tracers (used if nn_acc=1)
+   rn_rdth     =  800.           !  depth variation of tracer time step  (used if nn_acc=1)
+/
+!-----------------------------------------------------------------------
+&namdta_tem    !   data : temperature                                   ("key_dtatem")
+!-----------------------------------------------------------------------
+!              ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation !
+!              !           !  (if <0  months)     !   name   !  (logical)   ! (T/F) ! 'monthly'  ! filename ! pairing  !
+   sn_tem = 'data_1m_potential_temperature_nomask', -1,'votemper',  .true.  , .true., 'yearly'   , ' '      , ' '
+   !
+   cn_dir       = './'     !  root directory for the location of the runoff files
+/
+!-----------------------------------------------------------------------
+&namdta_sal    !   data : salinity                                      ("key_dtasal")
+!-----------------------------------------------------------------------
+!              ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation !
+!              !           !  (if <0  months)     !   name   !   (logical)  ! (T/F) ! 'monthly'  ! filename ! pairing  !
+   sn_sal      =  'data_1m_salinity_nomask',  -1  ,'vosaline',    .true.    , .true., 'yearly'   , ''       , ' '
+   !
+   cn_dir      = './'      !  root directory for the location of the runoff files
+/
+
 !!======================================================================
 !!            ***  Surface Boundary Condition namelists  ***
 !!======================================================================
-!!   namsbc        surface boundary condition
-!!   namsbc_ana    analytical         formulation
-!!   namsbc_flx    flux               formulation
-!!   namsbc_clio   CLIO bulk formulea formulation
-!!   namsbc_core   CORE bulk formulea formulation
-!!   namsbc_cpl    CouPLed            formulation                       ("key_coupled")
-!!   namtra_qsr    penetrative solar radiation
-!!   namsbc_rnf    river runoffs
-!!   namsbc_ssr    sea surface restoring term (for T and/or S)
-!!   namsbc_alb    albedo parameters
-!!======================================================================
-
+!!   namsbc          surface boundary condition
+!!   namsbc_ana      analytical         formulation
+!!   namsbc_flx      flux               formulation
+!!   namsbc_clio     CLIO bulk formulea formulation
+!!   namsbc_core     CORE bulk formulea formulation
+!!   namsbc_cpl      CouPLed            formulation                     ("key_coupled")
+!!   namsbc_cpl_co2  coupled ocean/biogeo/atmosphere model              ("key_cpl_carbon_cycle")
+!!   namtra_qsr      penetrative solar radiation
+!!   namsbc_rnf      river runoffs
+!!   namsbc_apr      Atmospheric Pressure
+!!   namsbc_ssr      sea surface restoring term (for T and/or S)
+!!   namsbc_alb      albedo parameters
+!!======================================================================
+!
 !-----------------------------------------------------------------------
 &namsbc        !   Surface Boundary Condition (surface module)
 !-----------------------------------------------------------------------
    nn_fsbc     = 5         !  frequency of surface boundary condition computation 
-                           !               (= the frequency of sea-ice model call)
-   ln_ana      = .false.   !  analytical formulation (T => fill namsbc_ana ) 
-   ln_flx      = .false.   !  flux formulation       (T => fill namsbc_flx )
-   ln_blk_clio = .true.    !  CLIO bulk formulation  (T => fill namsbc_clio) 
-   ln_blk_core = .false.   !  CORE bulk formulation  (T => fill namsbc_core) 
-   ln_cpl      = .false.   !  Coupled formulation    (T => fill namsbc_cpl )
+                           !     (also = the frequency of sea-ice model call)
+   ln_ana      = .false.   !  analytical formulation                    (T => fill namsbc_ana ) 
+   ln_flx      = .false.   !  flux formulation                          (T => fill namsbc_flx )
+   ln_blk_clio = .false.   !  CLIO bulk formulation                     (T => fill namsbc_clio) 
+   ln_blk_core = .true.    !  CORE bulk formulation                     (T => fill namsbc_core) 
+   ln_cpl      = .false.   !  Coupled formulation                       (T => fill namsbc_cpl )
+   ln_apr_dyn  = .false.   !  Patm gradient added in ocean & ice Eqs.   (T => fill namsbc_apr )
    nn_ice      = 2         !  =0 no ice boundary condition   ,
                            !  =1 use observed ice-cover      ,
-                           !  =2 ice-model used                             ("key_lim3" or "key_lim2)
-   nn_ico_cpl  = 0         !  ice-ocean coupling : =0 each nn_fsbc 
-                           !                       =1 stresses recomputed each ocean time step ("key_lim3" only)
-                           !                       =2 combination of 0 and 1 cases             ("key_lim3" only)
-   ln_dm2dc    = .false.   !  daily mean to diurnal cycle short wave (qsr)
-   ln_rnf      = .true.    !  runoffs (T => fill namsbc_rnf)
-   ln_ssr      = .true.    !  Sea Surface Restoring on T and/or S (T => fill namsbc_ssr)
+                           !  =2 ice-model used                         ("key_lim3" or "key_lim2)
+   ln_dm2dc    = .false.   !  daily mean to diurnal cycle on short wave
+   ln_rnf      = .true.    !  runoffs                                   (T => fill namsbc_rnf)
+   ln_ssr      = .true.    !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr)
    nn_fwb      = 3         !  FreshWater Budget: =0 unchecked 
-                           !                     =1 global mean of e-p-r set to zero at each time step 
-                           !                     =2 annual global mean of e-p-r set to zero
-                           !                     =3 global emp set to zero and spread out over erp area
+                           !     =1 global mean of e-p-r set to zero at each time step 
+                           !     =2 annual global mean of e-p-r set to zero
+                           !     =3 global emp set to zero and spread out over erp area
 /
 !-----------------------------------------------------------------------
@@ -140,12 +164,12 @@
 &namsbc_flx    !   surface boundary condition : flux formulation
 !-----------------------------------------------------------------------
-!              !   file name  ! frequency (hours) !  variable  ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
-!              !              !  (if <0  months)  !    name    !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
-   sn_utau     = 'utau'       ,        24         ,    'utau'  ,     .false.    , .false. , 'yearly'  , ''       , ''
-   sn_vtau     = 'vtau'       ,        24         ,    'vtau'  ,     .false.    , .false. , 'yearly'  , ''       , ''
-   sn_qtot     = 'qtot'       ,        24         ,    'qtot'  ,     .false.    , .false. , 'yearly'  , ''       , ''
-   sn_qsr      = 'qsr'        ,        24         ,    'qsr'   ,     .false.    , .false. , 'yearly'  , ''       , ''
-   sn_emp      = 'emp'        ,        24         ,    'emp'   ,     .false.    , .false. , 'yearly'  , ''       , ''
-!
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_utau     = 'utau'      ,        24         , 'utau'    , .false.      , .false., 'yearly'  , ''       , ''
+   sn_vtau     = 'vtau'      ,        24         , 'vtau'    , .false.      , .false., 'yearly'  , ''       , ''
+   sn_qtot     = 'qtot'      ,        24         , 'qtot'    , .false.      , .false., 'yearly'  , ''       , ''
+   sn_qsr      = 'qsr'       ,        24         , 'qsr'     , .false.      , .false., 'yearly'  , ''       , ''
+   sn_emp      = 'emp'       ,        24         , 'emp'     , .false.      , .false., 'yearly'  , ''       , ''
+
    cn_dir      = './'      !  root directory for the location of the flux files
 /      
@@ -153,14 +177,14 @@
 &namsbc_clio   !   namsbc_clio  CLIO bulk formulea
 !-----------------------------------------------------------------------
-!              !   file name  ! frequency (hours) !  variable  ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
-!              !              !  (if <0  months)  !    name    !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
-   sn_utau     = 'taux_1m'    ,       -1          , 'sozotaux' ,    .true.      , .true.  , 'yearly'  , ''       , ''
-   sn_vtau     = 'tauy_1m'    ,       -1          , 'sometauy' ,    .true.      , .true.  , 'yearly'  , ''       , ''
-   sn_wndm     = 'flx'        ,       -1          , 'socliowi' ,    .true.      , .true.  , 'yearly'  , ''       , ''
-   sn_tair     = 'flx'        ,       -1          , 'socliot2' ,    .true.      , .true.  , 'yearly'  , ''       , ''
-   sn_humi     = 'flx'        ,       -1          , 'socliohu' ,    .true.      , .true.  , 'yearly'  , ''       , ''
-   sn_ccov     = 'flx'        ,       -1          , 'socliocl' ,    .false.     , .true.  , 'yearly'  , ''       , ''
-   sn_prec     = 'flx'        ,       -1          , 'socliopl' ,    .false.     , .true.  , 'yearly'  , ''       , ''
-!
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_utau     = 'taux_1m'   ,       -1          , 'sozotaux',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_vtau     = 'tauy_1m'   ,       -1          , 'sometauy',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_wndm     = 'flx'       ,       -1          , 'socliowi',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_tair     = 'flx'       ,       -1          , 'socliot2',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_humi     = 'flx'       ,       -1          , 'socliohu',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_ccov     = 'flx'       ,       -1          , 'socliocl',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_prec     = 'flx'       ,       -1          , 'socliopl',   .false.    , .true. , 'yearly'  , ''       , ''
+
    cn_dir      = './'      !  root directory for the location of the bulk files are
 /
@@ -168,59 +192,59 @@
 &namsbc_core   !   namsbc_core  CORE bulk formulea
 !-----------------------------------------------------------------------
-!              !   file name  ! frequency (hours) ! variable   ! time interpol. !  clim   ! 'yearly'/ ! weights              ! rotation !
-!              !              !  (if <0  months)  !   name     !    (logical)   !  (T/F)  ! 'monthly' ! filename             ! pairing  !
-   sn_wndi     = 'u10_core'   ,       -1          , 'u10'      ,    .true.      , .true.  , 'yearly'  ,'bicubic_weights_orca2.nc' , 'U1'
-   sn_wndj     = 'v10_core'   ,       -1          , 'v10'      ,    .true.      , .true.  , 'yearly'  ,'bicubic_weights_orca2.nc' , 'V1'
-   sn_qsr      = 'qsw_core'   ,       -1          , 'swdn'     ,    .true.      , .true.  , 'yearly'  ,'bilinear_weights_orca2.nc', ''
-   sn_qlw      = 'qlw_core'   ,       -1          , 'lwdn'     ,    .true.      , .true.  , 'yearly'  ,'bilinear_weights_orca2.nc', ''
-   sn_tair     = 't2_core'    ,       -1          , 't2'       ,    .true.      , .true.  , 'yearly'  ,'bilinear_weights_orca2.nc', ''
-   sn_humi     = 'q2_core'    ,       -1          , 'q2'       ,    .true.      , .true.  , 'yearly'  ,'bilinear_weights_orca2.nc', ''
-   sn_prec     = 'precip_core',       -1          , 'precip'   ,    .true.      , .true.  , 'yearly'  ,'bilinear_weights_orca2.nc', ''
-   sn_snow     = 'snow_core'  ,       -1          , 'snow'     ,    .true.      , .true.  , 'yearly'  ,'bilinear_weights_orca2.nc', ''
-   sn_tdif     = 'taudif_core',       24          , 'taudif'   ,    .true.      , .true.  , 'yearly'  ,'bilinear_weights_orca2.nc', ''
-!
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_wndi = 'u_10.15JUNE2009_orca2'       ,  6  , 'U_10_MOD',   .false.    , .true. , 'yearly'  , ''       , 'Uwnd'
+   sn_wndj = 'v_10.15JUNE2009_orca2'       ,  6  , 'V_10_MOD',   .false.    , .true. , 'yearly'  , ''       , 'Vwnd'
+   sn_qsr  = 'ncar_rad.15JUNE2009_orca2'   , 24  , 'SWDN_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_qlw  = 'ncar_rad.15JUNE2009_orca2'   , 24  , 'LWDN_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_tair = 't_10.15JUNE2009_orca2'       ,  6  , 'T_10_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_humi = 'q_10.15JUNE2009_orca2'       ,  6  , 'Q_10_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_prec = 'ncar_precip.15JUNE2009_orca2', -1  , 'PRC_MOD1',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_snow = 'ncar_precip.15JUNE2009_orca2', -1  , 'SNOW'    ,   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_tdif = 'taudif_core'                 , 24  , 'taudif'  ,   .false.    , .true. , 'yearly'  , ''       , ''
+
    cn_dir      = './'      !  root directory for the location of the bulk files
-   ln_2m       = .true.    !  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_2m       = .false.   !  air temperature and humidity referenced at 2m (T) instead 10m (F)
+   ln_taudif   = .false.   !  HF tau contribution: use "mean of stress module - module of the mean stress" data
    rn_pfac     = 1.        !  multiplicative factor for precipitation (total & snow)
 /
 !-----------------------------------------------------------------------
-&namsbc_cpl    !   coupled ocean/atmosphere model                        ("key_coupled")
-!-----------------------------------------------------------------------
-                                       ! send
-cn_snd_temperature= 'weighted oce and ice'  ! 'oce only' 'weighted oce and ice' 'mixed oce-ice'
-cn_snd_albedo     = 'weighted ice'          ! 'none' 'weighted ice' 'mixed oce-ice'
-cn_snd_thickness  = 'none'                  ! 'none' 'weighted ice and snow'
-cn_snd_crt_nature = 'none'                  ! 'none' 'oce only' 'weighted oce and ice' 'mixed oce-ice'
-cn_snd_crt_refere = 'spherical'             ! 'spherical' 'cartesian'
-cn_snd_crt_orient = 'eastward-northward'    ! 'eastward-northward' or 'local grid'
-cn_snd_crt_grid   = 'T'                     ! 'T'
-                                       ! receive
-cn_rcv_w10m       = 'none'                  ! 'none' 'coupled'
-cn_rcv_taumod     = 'coupled'               ! 'none' 'coupled'
-cn_rcv_tau_nature = 'oce only'              ! 'oce only' 'oce and ice' 'mixed oce-ice'
-cn_rcv_tau_refere = 'cartesian'             ! 'spherical' 'cartesian'
-cn_rcv_tau_orient = 'eastward-northward'    ! 'eastward-northward' or 'local grid'
-cn_rcv_tau_grid   = 'U,V'                   ! 'T' 'U,V' 'U,V,F' 'U,V,I' 'T,F' 'T,I' 'T,U,V'
-cn_rcv_dqnsdt     = 'coupled'               ! 'none' 'coupled'
-cn_rcv_qsr        = 'oce and ice'           ! 'conservative' 'oce and ice' 'mixed oce-ice'
-cn_rcv_qns        = 'oce and ice'           ! 'conservative' 'oce and ice' 'mixed oce-ice'
-cn_rcv_emp        = 'conservative'          ! 'conservative' 'oce and ice' 'mixed oce-ice'
-cn_rcv_rnf        = 'coupled'               ! 'coupled' 'climato' 'mixed'
-cn_rcv_cal        = 'coupled'               ! 'none' 'coupled'
-/
-!-----------------------------------------------------------------------
-&namsbc_cpl_co2   !   coupled ocean/biogeo/atmosphere model            ("key_cpl_carbon_cycle")
-!-----------------------------------------------------------------------
-cn_snd_co2        = 'coupled'         ! send    :  'none' 'coupled'
-cn_rcv_co2        = 'coupled'         ! receive : 'none' 'coupled'
+&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_coupled")
+!-----------------------------------------------------------------------
+!                                      ! send
+cn_snd_temperature= 'weighted oce and ice'  !  'oce only' 'weighted oce and ice' 'mixed oce-ice'
+cn_snd_albedo     = 'weighted ice'          !  'none' 'weighted ice' 'mixed oce-ice'
+cn_snd_thickness  = 'none'                  !  'none' 'weighted ice and snow'
+cn_snd_crt_nature = 'none'                  !  'none' 'oce only' 'weighted oce and ice' 'mixed oce-ice'
+cn_snd_crt_refere = 'spherical'             !  'spherical' 'cartesian'
+cn_snd_crt_orient = 'eastward-northward'    !  'eastward-northward' or 'local grid'
+cn_snd_crt_grid   = 'T'                     !  'T'
+!                                      ! receive
+cn_rcv_w10m       = 'none'                  !  'none' 'coupled'
+cn_rcv_taumod     = 'coupled'               !  'none' 'coupled'
+cn_rcv_tau_nature = 'oce only'              !  'oce only' 'oce and ice' 'mixed oce-ice'
+cn_rcv_tau_refere = 'cartesian'             !  'spherical' 'cartesian'
+cn_rcv_tau_orient = 'eastward-northward'    !  'eastward-northward' or 'local grid'
+cn_rcv_tau_grid   = 'U,V'                   !  'T' 'U,V' 'U,V,F' 'U,V,I' 'T,F' 'T,I' 'T,U,V'
+cn_rcv_dqnsdt     = 'coupled'               !  'none' 'coupled'
+cn_rcv_qsr        = 'oce and ice'           !  'conservative' 'oce and ice' 'mixed oce-ice'
+cn_rcv_qns        = 'oce and ice'           !  'conservative' 'oce and ice' 'mixed oce-ice'
+cn_rcv_emp        = 'conservative'          !  'conservative' 'oce and ice' 'mixed oce-ice'
+cn_rcv_rnf        = 'coupled'               !  'coupled' 'climato' 'mixed'
+cn_rcv_cal        = 'coupled'               !  'none' 'coupled'
+/
+!-----------------------------------------------------------------------
+&namsbc_cpl_co2   !   coupled ocean/biogeo/atmosphere model             ("key_cpl_carbon_cycle")
+!-----------------------------------------------------------------------
+   cn_snd_co2     = 'coupled'         ! send    : 'none' 'coupled'
+   cn_rcv_co2     = 'coupled'         ! receive : 'none' 'coupled'
 /
 !-----------------------------------------------------------------------
 &namtra_qsr    !   penetrative solar radiation
 !-----------------------------------------------------------------------
-!              !   file name  ! frequency (hours) ! variable   ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
-!              !              !  (if <0  months)  !   name     !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
-   sn_chl      = 'chlorophyll',        -1         , 'CHLA'     ,    .true.      , .true.  , 'yearly'  , ''       , ''
- 
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_chl      ='chlorophyll',        -1         , 'CHLA'    ,   .true.     , .true. , 'yearly'  , ''       , ''
+
    cn_dir      = './'      !  root directory for the location of the runoff files
    ln_traqsr   = .true.    !  Light penetration (T) or not (F)
@@ -228,33 +252,48 @@
    ln_qsr_2bd  = .false.   !  2 bands              light penetration
    ln_qsr_bio  = .false.   !  bio-model light penetration
-   nn_chldta   =      0    !  RGB : Chl data (=1) or cst value (=0)
+   nn_chldta   =      1    !  RGB : Chl data (=1) or cst value (=0)
    rn_abs      =   0.58    !  RGB & 2 bands: fraction of light (rn_si1)
    rn_si0      =   0.35    !  RGB & 2 bands: shortess depth of extinction
    rn_si1      =   23.0    !  2 bands: longest depth of extinction
-   rn_si2      =   62.0    !  3 bands: longest depth of extinction (for blue waveband & 0.01 mg/m2 Chl)
 /
 !-----------------------------------------------------------------------
 &namsbc_rnf    !   runoffs namelist surface boundary condition
 !-----------------------------------------------------------------------
-!              !   file name  ! frequency (hours) ! variable   ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
-!              !              !  (if <0  months)  !   name     !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
-   sn_rnf      = 'runoff_1m_nomask' ,  -1         , 'sorunoff' ,    .true.      , .true.  , 'yearly'  , ''       , ''
-   sn_cnf      = 'runoff_1m_nomask' ,   0         , 'socoefr'  ,    .false.     , .true.  , 'yearly'  , ''       , ''
- 
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_rnf      = 'runoff_core_monthly',    -1    , 'sorunoff',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_cnf      = 'runoff_core_monthly',     0    , 'socoefr0',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_s_rnf    = 'runoffs'            ,    24    , 'rosaline',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_t_rnf    = 'runoffs'            ,    24    , 'rotemper',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_dep_rnf  = 'runoffs'            ,     0    , 'rodepth' ,   .false.    , .true. , 'yearly'  , ''       , ''
+
    cn_dir       = './'      !  root directory for the location of the runoff files
-   ln_rnf_emp   =   .false. !  runoffs included into precipitation field (T) or into a file (F)
-   ln_rnf_mouth =   .false. !  specific treatment at rivers mouths
+   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
    rn_avt_rnf   =   1.e-3   !  value of the additional vertical mixing coef. [m2/s]
    rn_rfact     =   1.e0    !  multiplicative factor for runoff
+   ln_rnf_depth = .false.   !  read in depth information for runoff
+   ln_rnf_tem   = .false.   !  read in temperature information for runoff
+   ln_rnf_sal   = .false.   !  read in salinity information for runoff
+/
+!-----------------------------------------------------------------------
+&namsbc_apr    !   Atmospheric pressure used as ocean forcing or in bulk
+!-----------------------------------------------------------------------
+!              ! file name ! frequency (hours) ! variable ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
+!              !           !  (if <0  months)  !   name   !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
+   sn_apr      = 'patm'    ,         -1        ,'somslpre',    .true.      , .true.  , 'yearly'  ,  ''      ,   ''
+
+   cn_dir      = './'      !  root directory for the location of the bulk files
+   ln_ref_apr  = .false.   !  ref. pressure: global mean Patm (T) or a constant (F)
 /
 !-----------------------------------------------------------------------
 &namsbc_ssr    !   surface boundary condition : sea surface restoring
 !-----------------------------------------------------------------------
-!              !   file name  ! frequency (hours) ! variable   ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
-!              !              !  (if <0  months)  !   name     !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
-   sn_sst      = 'sst_data'   ,        24         ,  'sst'     ,     .false.    , .false. , 'yearly'  , ''       , ''
-   sn_sss      = 'sss_data'   ,        -1         ,  'sss'     ,     .true.     , .true.  , 'yearly'  , ''       , ''
-    
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_sst      = 'sst_data'  ,        24         ,  'sst'    ,    .false.   , .false., 'yearly'  , ''       , ''
+   sn_sss      = 'sss_data'  ,        -1         ,  'sss'    ,    .true.    , .true. , 'yearly'  , ''       , ''
+
    cn_dir      = './'      !  root directory for the location of the runoff files
    nn_sstr     =     0     !  add a retroaction term in the surface heat       flux (=1) or not (=0)
@@ -286,5 +325,5 @@
 !!   namtide       Tidal forcing at open boundaries                     ("key_bdy_tides")
 !!======================================================================
-
+!
 !-----------------------------------------------------------------------
 &namlbc        !   lateral momentum boundary condition
@@ -301,20 +340,20 @@
 &namobc        !   open boundaries parameters                           ("key_obc")
 !-----------------------------------------------------------------------
-    ln_obc_clim= .false.   !  climatological obc data files (T) or not (F)
-    ln_vol_cst = .true.    !  impose the total volume conservation (T) or not (F)
-    ln_obc_fla = .false.   !  Flather open boundary condition 
-    nn_obcdta  =    1      !  = 0 the obc data are equal to the initial state
+   ln_obc_clim = .false.   !  climatological obc data files (T) or not (F)
+   ln_vol_cst  = .true.    !  impose the total volume conservation (T) or not (F)
+   ln_obc_fla  = .false.   !  Flather open boundary condition 
+   nn_obcdta   =    1      !  = 0 the obc data are equal to the initial state
                            !  = 1 the obc data are read in 'obc.dta' files
-    cn_obcdta  = 'annual'  !  set to annual if obc datafile hold 1 year of data
+   cn_obcdta   = 'annual'  !  set to annual if obc datafile hold 1 year of data
                            !  set to monthly if obc datafile hold 1 month of data
-    rn_dpein   =    1.     !  damping time scale for inflow at east  open boundary
-    rn_dpwin   =    1.     !     -           -         -       west    -      -
-    rn_dpnin   =    1.     !     -           -         -       north   -      -
-    rn_dpsin   =    1.     !     -           -         -       south   -      -
-    rn_dpeob   = 3000.     !  time relaxation (days) for the east  open boundary
-    rn_dpwob   =   15.     !     -           -         -     west    -      -
-    rn_dpnob   = 3000.     !     -           -         -     north   -      -
-    rn_dpsob   =   15.     !     -           -         -     south   -      -
-    rn_volemp  =  1.       !  = 0 the total volume change with the surface flux (E-P-R)
+   rn_dpein    =    1.     !  damping time scale for inflow at east  open boundary
+   rn_dpwin    =    1.     !     -           -         -       west    -      -
+   rn_dpnin    =    1.     !     -           -         -       north   -      -
+   rn_dpsin    =    1.     !     -           -         -       south   -      -
+   rn_dpeob    = 3000.     !  time relaxation (days) for the east  open boundary
+   rn_dpwob    =   15.     !     -           -         -     west    -      -
+   rn_dpnob    = 3000.     !     -           -         -     north   -      -
+   rn_dpsob    =   15.     !     -           -         -     south   -      -
+   rn_volemp   =    1.     !  = 0 the total volume change with the surface flux (E-P-R)
                            !  = 1 the total volume remains constant
 /
@@ -322,36 +361,40 @@
 &namagrif      !  AGRIF zoom                                            ("key_agrif")
 !-----------------------------------------------------------------------
-    nn_cln_update = 3      !  baroclinic update frequency
-    ln_spc_dyn    = .true. !  use 0 as special value for dynamics
-    rn_sponge_tra = 2880.  !  coefficient for tracer   sponge layer [s]
-    rn_sponge_dyn = 2880.  !  coefficient for dynamics sponge layer [s]
+   nn_cln_update =    3    !  baroclinic update frequency
+   ln_spc_dyn    = .true.  !  use 0 as special value for dynamics
+   rn_sponge_tra = 2880.   !  coefficient for tracer   sponge layer [m2/s]
+   rn_sponge_dyn = 2880.   !  coefficient for dynamics sponge layer [m2/s]
 /
 !-----------------------------------------------------------------------
 &nambdy        !  unstructured open boundaries                          ("key_bdy")
 !-----------------------------------------------------------------------
-    filbdy_mask    =  ''                  !  name of mask file (if ln_bdy_mask=.TRUE.)
-    filbdy_data_T  = 'bdydata_grid_T.nc'  !  name of data file (T-points)
-    filbdy_data_U  = 'bdydata_grid_U.nc'  !  name of data file (U-points)
-    filbdy_data_V  = 'bdydata_grid_V.nc'  !  name of data file (V-points)
-    ln_bdy_clim    = .false.              !  contain 1 (T) or 12 (F) time dumps and be cyclic
-    ln_bdy_vol     = .true.               !  total volume correction (see volbdy parameter)
-    ln_bdy_mask    = .false.              !  boundary mask from filbdy_mask (T) or boundaries are on edges of domain (F)
-    ln_bdy_tides   = .true.               !  Apply tidal harmonic forcing with Flather condition
-    ln_bdy_dyn_fla = .true.               !  Apply Flather condition to velocities
-    ln_bdy_tra_frs = .false.              !  Apply FRS condition to temperature and salinity 
-    ln_bdy_dyn_frs = .false.              !  Apply FRS condition to velocities
-    nbdy_dta       =  1                   !  = 0, bdy data are equal to the initial state
-                                          !  = 1, bdy data are read in 'bdydata   .nc' files
-    nb_rimwidth    = 9                    !  width of the relaxation zone
-    volbdy         = 0                    !  = 0, the total water flux across open boundaries is zero
-                                          !  = 1, the total volume of the system is conserved
-/
-!-----------------------------------------------------------------------
-&nambdy_tide     ! tidal forcing at unstructured boundaries              
-!-----------------------------------------------------------------------
-    filtide      = 'bdytide_'           !  file name root of tidal forcing files
-    tide_cpt     = 'M2','S1'            !  names of tidal components used
-    tide_speed   = 28.984106, 15.000001 !  phase speeds of tidal components (deg/hour)
-    ln_tide_date = .false.              !  adjust tidal harmonics for start date of run
+   cn_mask     =  ''                     !  name of mask file (ln_mask=T)
+   cn_dta_frs_T= 'bdydata_grid_T.nc'     !  name of data file (T-points)
+   cn_dta_frs_U= 'bdydata_grid_U.nc'     !  name of data file (U-points)
+   cn_dta_frs_V= 'bdydata_grid_V.nc'     !  name of data file (V-points)
+   cn_dta_fla_T= 'bdydata_bt_grid_T.nc'  !  name of data file for Flather condition (T-points)
+   cn_dta_fla_U= 'bdydata_bt_grid_U.nc'  !  name of data file for Flather condition (U-points)
+   cn_dta_fla_V= 'bdydata_bt_grid_V.nc'  !  name of data file for Flather condition (V-points)
+
+   ln_clim     = .false.   !  contain 1 (T) or 12 (F) time dumps and be cyclic
+   ln_vol      = .false.   !  total volume correction (see volbdy parameter)
+   ln_mask     = .false.   !  boundary mask from filbdy_mask (T), boundaries are on edges of domain (F)
+   ln_tides    = .false.   !  Apply tidal harmonic forcing with Flather condition
+   ln_dyn_fla  = .false.   !  Apply Flather condition to velocities
+   ln_tra_frs  = .false.   !  Apply FRS condition to temperature and salinity 
+   ln_dyn_frs  = .false.   !  Apply FRS condition to velocities
+   nn_rimwidth =  9        !  width of the relaxation zone
+   nn_dtactl   =  1        !  = 0, bdy data are equal to the initial state
+                           !  = 1, bdy data are read in 'bdydata   .nc' files
+   nn_volctl   =  0        !  = 0, the total water flux across open boundaries is zero
+                           !  = 1, the total volume of the system is conserved
+/
+!-----------------------------------------------------------------------
+&nambdy_tide   !  tidal forcing at unstructured boundaries              
+!-----------------------------------------------------------------------
+   filtide     = 'bdytide_'           !  file name root of tidal forcing files
+   tide_cpt    = 'M2','S1'            !  names of tidal components used
+   tide_speed  = 28.984106, 15.000001 !  phase speeds of tidal components (deg/hour)
+   ln_tide_date= .false.              !  adjust tidal harmonics for start date of run
 /
 
@@ -360,8 +403,8 @@
 !!======================================================================
 !!   nambfr        bottom friction
-!!   nambbc        bottom temperature boundary condition                ("key_trabbc")
-!!   nambbl        bottom boundary layer scheme                         ("key_trabbl_dif","key_trabbl_adv")
-!!======================================================================
-
+!!   nambbc        bottom temperature boundary condition               
+!!   nambbl        bottom boundary layer scheme                         ("key_trabbl")
+!!======================================================================
+!
 !-----------------------------------------------------------------------
 &nambfr        !   bottom friction
@@ -371,11 +414,12 @@
    rn_bfri1    =    4.e-4  !  bottom drag coefficient (linear case)
    rn_bfri2    =    1.e-3  !  bottom drag coefficient (non linear case)
-   rn_bfeb2    =    2.5e-3 !  bottom turbulent kinetic energy background  (m^2/s^2)
-   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 = .true.)
+   rn_bfeb2    =    2.5e-3 !  bottom turbulent kinetic energy background  (m2/s2)
+   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)
 /
 !-----------------------------------------------------------------------
 &nambbc        !   bottom temperature boundary condition
 !-----------------------------------------------------------------------
+   ln_trabbc   = .true.    !  Apply a geothermal heating at the ocean bottom
    nn_geoflx   =    2      !  geothermal heat flux: = 0 no flux 
                            !     = 1 constant flux
@@ -386,8 +430,10 @@
 &nambbl        !   bottom boundary layer scheme
 !-----------------------------------------------------------------------
-!                          !  diffusive bbl                             ("key_trabbl")
-!                          !  advective bbl                             ("key_trabbl_adv")
-   rn_ahtbbl   =  10000.   !  lateral mixing coefficient in the bbl  [m2/s]
-/
+   nn_bbl_ldf  =  1      !  diffusive bbl (=1)   or not (=0)
+   nn_bbl_adv  =  0      !  advective bbl (=1/2) or not (=0)
+   rn_ahtbbl   =  1000.  !  lateral mixing coefficient in the bbl  [m2/s]
+   rn_gambbl   =  10.    !  advective bbl coefficient                 [s]
+/
+
 !!======================================================================
 !!                        Tracer (T & S ) namelists
@@ -398,14 +444,14 @@
 !!   namtra_dmp    T & S newtonian damping                              ("key_tradmp")
 !!======================================================================
-
+!
 !-----------------------------------------------------------------------
 &nameos        !   ocean physical parameters
 !-----------------------------------------------------------------------
-   nn_eos      =    0      !  type of equation of state and Brunt-Vaisala frequency
+   nn_eos      =   0       !  type of equation of state and Brunt-Vaisala frequency
                            !     = 0, UNESCO (formulation of Jackett and McDougall (1994) and of McDougall (1987) )
                            !     = 1, linear: rho(T)   = rau0 * ( 1.028 - ralpha * T )
                            !     = 2, linear: rho(T,S) = rau0 * ( rbeta * S - ralpha * T )
-   rn_alpha    =    2.e-4  !  thermal expension coefficient (neos= 1 or 2)
-   rn_beta     =    0.001  !  saline  expension coefficient (neos= 2)
+   rn_alpha    =   2.0e-4  !  thermal expension coefficient (nn_eos= 1 or 2)
+   rn_beta     =   7.7e-4  !  saline  expension coefficient (nn_eos= 2)
 /
 !-----------------------------------------------------------------------
@@ -417,19 +463,22 @@
    ln_traadv_muscl2 =  .false.  !  MUSCL2 scheme + cen2 at boundaries  
    ln_traadv_ubs    =  .false.  !  UBS scheme                 
+   ln_traadv_qck    =  .false.  !  QUCIKEST scheme                 
 /
 !-----------------------------------------------------------------------
 &namtra_ldf    !   lateral diffusion scheme for tracer 
 !-----------------------------------------------------------------------
-                           !  Type of the operator : 
-   ln_traldf_lap    =  .true.   !     laplacian operator       
-   ln_traldf_bilap  =  .false.  !     bilaplacian operator     
-                           !  Direction of action  :
-   ln_traldf_level  =  .false.  !     iso-level                
-   ln_traldf_hor    =  .false.  !     horizontal (geopotential)         (require "key_ldfslp" when ln_sco=T)
-   ln_traldf_iso    =  .true.   !     iso-neutral                       (require "key_ldfslp")
-                           !  Coefficient
-   rn_aht_0         =  2000.    !     horizontal eddy diffusivity for tracers [m2/s]
-   rn_ahtb_0        =     0.    !     background eddy diffusivity for ldf_iso [m2/s]
-   rn_aeiv_0        =  2000.    !     eddy induced velocity coefficient [m2/s]    (require "key_traldf_eiv")
+   !                       !  Type of the operator : 
+   ln_traldf_lap    =  .true.   !  laplacian operator       
+   ln_traldf_bilap  =  .false.  !  bilaplacian operator     
+   !                       !  Direction of action  :
+   ln_traldf_level  =  .false.  !  iso-level                
+   ln_traldf_hor    =  .false.  !  horizontal (geopotential)            (require "key_ldfslp" when ln_sco=T)
+   ln_traldf_iso    =  .true.   !  iso-neutral                          (require "key_ldfslp")
+   ln_traldf_grif   =  .false.  !  griffies skew flux formulation       (require "key_ldfslp")  ! UNDER TEST, DO NOT USE
+   ln_traldf_gdia   =  .false.  !  griffies operator strfn diagnostics  (require "key_ldfslp")  ! UNDER TEST, DO NOT USE
+   !                       !  Coefficient
+   rn_aht_0         =  2000.    !  horizontal eddy diffusivity for tracers [m2/s]
+   rn_ahtb_0        =     0.    !  background eddy diffusivity for ldf_iso [m2/s]
+   rn_aeiv_0        =  2000.    !  eddy induced velocity coefficient [m2/s]    (require "key_traldf_eiv")
 /
 !-----------------------------------------------------------------------
@@ -445,6 +494,7 @@
    rn_bot      =  360.     !  bottom  time scale of damping   [days]
    rn_dep      =  800.     !  depth of transition between rn_surf and rn_bot [meters]
-   nn_file     =    1      !  create a damping.coeff NetCDF file (=1) or not (=0)
-/
+   nn_file     =    0      !  create a damping.coeff NetCDF file (=1) or not (=0)
+/
+
 !!======================================================================
 !!                      ***  Dynamics namelists  ***
@@ -456,5 +506,5 @@
 !!   namdyn_ldf    lateral diffusion scheme
 !!======================================================================
-
+!
 !-----------------------------------------------------------------------
 &namdyn_adv    !   formulation of the momentum advection
@@ -496,26 +546,28 @@
 &namdyn_ldf    !   lateral diffusion on momentum
 !-----------------------------------------------------------------------
-                           !  Type of the operator : 
+   !                       !  Type of the operator : 
    ln_dynldf_lap    =  .true.   !  laplacian operator         
    ln_dynldf_bilap  =  .false.  !  bilaplacian operator    
-                           !  Direction of action  : 
+   !                       !  Direction of action  : 
    ln_dynldf_level  =  .false.  !  iso-level               
    ln_dynldf_hor    =  .true.   !  horizontal (geopotential)            (require "key_ldfslp" in s-coord.)
    ln_dynldf_iso    =  .false.  !  iso-neutral                          (require "key_ldfslp")
-                           !  Coefficient
-   rn_ahm_0    = 40000.         !  horizontal eddy viscosity   [m2/s]
-   rn_ahmb_0   =     0.         !  background eddy viscosity for ldf_iso [m2/s]
-/
+   !                       !  Coefficient
+   rn_ahm_0_lap     = 40000.    !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahmb_0        =     0.    !  background eddy viscosity for ldf_iso [m2/s]
+   rn_ahm_0_blp     =     0.    !  horizontal bilaplacian eddy viscosity [m4/s] 
+/
+
 !!======================================================================
 !!             Tracers & Dynamics vertical physics namelists
 !!======================================================================
-!!       namzdf        vertical physics
-!!       namzdf_ric    richardson number dependent vertical mixing      ("key_zdfric"      )
-!!       namzdf_tke    TKE dependent vertical mixing                    ("key_zdftke"      )
-!!       namzdf_kpp    KPP dependent vertical mixing                    ("key_zdfkpp"      )
-!!       namzdf_ddm    double diffusive mixing parameterization         ("key_zdfddm"      )
-!!       namzdf_tmx    tidal mixing parameterization                    ("key_zdftmx"      )
-!!======================================================================
-
+!!    namzdf        vertical physics
+!!    namzdf_ric    richardson number dependent vertical mixing         ("key_zdfric")
+!!    namzdf_tke    TKE dependent vertical mixing                       ("key_zdftke")
+!!    namzdf_kpp    KPP dependent vertical mixing                       ("key_zdfkpp")
+!!    namzdf_ddm    double diffusive mixing parameterization            ("key_zdfddm")
+!!    namzdf_tmx    tidal mixing parameterization                       ("key_zdftmx")
+!!======================================================================
+!
 !-----------------------------------------------------------------------
 &namzdf        !   vertical physics
@@ -528,5 +580,5 @@
    nn_evdm     =    0      !  evd apply on tracer (=0) or on tracer and momentum (=1)
    rn_avevd    =  100.     !  evd mixing coefficient [m2/s]
-   ln_zdfnpc   = .false.   !  Non-Penetrative algorithm (T) or not (F)
+   ln_zdfnpc   = .false.   !  Non-Penetrative Convective algorithm (T) or not (F)
    nn_npc      =    1            !  frequency of application of npc
    nn_npcp     =  365            !  npc control print frequency
@@ -546,35 +598,28 @@
    rn_ediff    =   0.1     !  coef. for vertical eddy coef. (avt=rn_ediff*mxl*sqrt(e) )
    rn_ediss    =   0.7     !  coef. of the Kolmogoroff dissipation
-   rn_ebb      =  60.      !  coef. of the surface input of tke
+   rn_ebb      =  67.83    !  coef. of the surface input of tke (=67.83 suggested when ln_mxl0=T)
    rn_emin     =   1.e-6   !  minimum value of tke [m2/s2]
    rn_emin0    =   1.e-4   !  surface minimum value of tke [m2/s2]
-   rn_bshear   =   1.e-20  !  background shear (>0)
    nn_mxl      =   2       !  mixing length: = 0 bounded by the distance to surface and bottom
                            !                 = 1 bounded by the local vertical scale factor
                            !                 = 2 first vertical derivative of mixing length bounded by 1
-                           !                 = 3 same criteria as case 2 but applied in a different way
+                           !                 = 3 as =2 with distinct disspipative an mixing length scale
    nn_pdl      =   1       !  Prandtl number function of richarson number (=1, avt=pdl(Ri)*avm) or not (=0, avt=avm)
-   ln_mxl0     = .false.   !  mixing length scale surface value as function of wind stress (T) or not (F)
-   rn_lmin     =   0.001   !  interior buoyancy lenght scale minimum value
-   rn_lmin0    =   0.01    !  surface  buoyancy lenght scale minimum value
-   nn_etau     =   0       !  exponentially deceasing penetration of tke due to internal & intertial waves
-                           !        = 0 no penetration ( O(2 km) resolution)
-                           !        = 1 additional tke source (rn_efr * en)
-                           !        = 2 additional tke source (rn_efr * en) applied only at the base of the mixed layer
-                           !        = 3 additional tke source (HF contribution: mean of stress module - module of mean stress)
-   nn_htau     =   1       !  type of exponential decrease of tke penetration
+   ln_mxl0     = .true.    !  surface mixing length scale = F(wind stress) (T) or not (F)
+   rn_mxl0     =   0.04    !  surface  buoyancy lenght scale minimum value
+   ln_lc       = .true.    !  Langmuir cell parameterisation (Axell 2002)
+   rn_lc       =   0.15    !  coef. associated to Langmuir cells
+   nn_etau     =   1       !  penetration of tke below the mixed layer (ML) due to internal & intertial waves
+                           !        = 0 no penetration
+                           !        = 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")
+   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
                            !        = 0  constant 10 m length scale
-                           !        = 1  0.5m at the equator to 30m at high latitudes
-                           !        = 2  30 meters constant depth penetration
-                           !  otion used only if nn_etau = 1 or 2: 
-   rn_efr      =   0.05    !     fraction of surface tke value which penetrates inside the ocean
-                           !  otion used only if nn_etau = 3:
-   rn_addhft   =  -1.e-3   !     add offset   applied to the "mean of stress module - module of mean stress" (always kept > 0)
-   rn_sclhft   =   1.      !     scale factor applied to the "mean of stress module - module of mean stress"
-   ln_lc       = .false.   !  Langmuir cell parameterisation
-   rn_lc       =   0.15    !  coef. associated to Langmuir cells
+                           !        = 1  0.5m at the equator to 30m poleward of 40 degrees
 /
 !------------------------------------------------------------------------
-&namzdf_kpp    !   K-Profile Parameterization dependent vertical mixing  ("key_zdfkpp", and optionnally:
+&namzdf_kpp    !   K-Profile Parameterization dependent vertical mixing  ("key_zdfkpp", and optionally:
 !------------------------------------------------------------------------ "key_kppcustom" or "key_kpplktb")
    ln_kpprimix = .true.    !  shear instability mixing 
@@ -589,4 +634,22 @@
 /
 !-----------------------------------------------------------------------
+&namzdf_gls                !   GLS vertical diffusion                   ("key_zdfgls")
+!-----------------------------------------------------------------------
+   rn_emin       = 1.e-6   !  minimum value of e   [m2/s2]
+   rn_epsmin     = 1.e-12  !  minimum value of eps [m2/s3]
+   ln_length_lim = .true.  !  limit on the dissipation rate under stable stratification (Galperin et al., 1988)
+   rn_clim_galp  = 0.53    !  galperin limit
+   ln_crban      = .true.  !  Use Craig & Banner (1994) surface wave mixing parametrisation
+   ln_sigpsi     = .true.  !  Activate or not Burchard 2001 mods on psi schmidt number in the wb case
+   rn_crban      = 100.    !  Craig and Banner 1994 constant for wb tke flux
+   rn_charn      = 70000.  !  Charnock constant for wb induced roughness length
+   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)
+/
+!-----------------------------------------------------------------------
 &namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
 !-----------------------------------------------------------------------
@@ -601,7 +664,8 @@
    rn_tfe      = 0.333     !  tidal dissipation efficiency
    rn_me       = 0.2       !  mixing efficiency 
-   ln_tmx_itf  = .FALSE.   !  ITF specific parameterisation
+   ln_tmx_itf  = .true.    !  ITF specific parameterisation
    rn_tfe_itf  = 1.        !  ITF tidal dissipation efficiency
 /
+
 !!======================================================================
 !!                  ***  Miscelaneous namelists  ***
@@ -612,5 +676,5 @@
 !!   namsol            elliptic solver / island / free surface 
 !!======================================================================
-
+!
 !-----------------------------------------------------------------------
 &namsol        !   elliptic solver / island / free surface 
@@ -629,5 +693,5 @@
 &nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
 !-----------------------------------------------------------------------
-   cn_mpi_send =  'S'      !  mpi send/recieve type   ='S', 'B', or 'I' for standard send,
+   cn_mpi_send =  'I'      !  mpi send/recieve type   ='S', 'B', or 'I' for standard send,
                            !  buffer blocking send or immediate non-blocking sends, resp.
    nn_buffer   =   0       !  size in bytes of exported buffer ('B' case), 0 no exportation
@@ -653,20 +717,30 @@
    nn_bench    =    0      !  Bench mode (1/0): CAUTION use zero except for bench
                            !     (no physical validity of the results)
-   nn_bit_cmp  =    0      !  bit comparison mode (1/0): CAUTION use zero except for test
-                           !     of comparison between single and multiple processor runs
-/
-
-!!======================================================================
-!!                       ***  Diagnostics namelists  ***
-!!======================================================================
+/
+
+!!======================================================================
+!!                  ***  Diagnostics namelists  ***
+!!======================================================================
+!!   namnc4       netcdf4 chunking and compression settings             ("key_netcdf4")
 !!   namtrd       dynamics and/or tracer trends                         ("key_trddyn","key_trdtra","key_trdmld")
-!!   namgap       level mean model-data gap                             ("key_diagap")
 !!   namflo       float parameters                                      ("key_float")
 !!   namptr       Poleward Transport Diagnostics
-!!======================================================================
-
+!!   namhsb       Heat and salt budgets 
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namnc4        !   netcdf4 chunking and compression settings            ("key_netcdf4")
+!-----------------------------------------------------------------------
+   nn_nchunks_i=   4       !  number of chunks in i-dimension
+   nn_nchunks_j=   4       !  number of chunks in j-dimension
+   nn_nchunks_k=   31      !  number of chunks in k-dimension
+                           !  setting nn_nchunks_k = jpk will give a chunk size of 1 in the vertical which
+                           !  is optimal for postprocessing which works exclusively with horizontal slabs
+   ln_nc4zip   = .true.    !  (T) use netcdf4 chunking and compression
+                           !  (F) ignore chunking information and produce netcdf3-compatible files
+/
 !-----------------------------------------------------------------------
 &namtrd        !   diagnostics on dynamics and/or tracer trends         ("key_trddyn" and/or "key_trdtra")
-!              !       or mixed-layer trends or barotropic vorticity    ('key_trdmld' or  "key_trdvor")
+!              !       or mixed-layer trends or barotropic vorticity    ("key_trdmld" or     "key_trdvor")
 !-----------------------------------------------------------------------
    nn_trd      = 365       !  time step frequency dynamics and tracers trends
@@ -679,17 +753,11 @@
 /
 !-----------------------------------------------------------------------
-&namgap       !   level mean model-data gap                             ('key_diagap')
-!-----------------------------------------------------------------------
-   nn_gap     =  15        !  time-step frequency of model-data gap computation
-   nn_prg     =  10        !  time-step frequency of gap print in model output
-/
-!-----------------------------------------------------------------------
 &namflo       !   float parameters                                      ("key_float")
 !-----------------------------------------------------------------------
-    ln_rstflo = .false.    !  float restart (T) or not (F)
-    nn_writefl=      75    !  frequency of writing in float output file 
-    nn_stockfl=    5475    !  frequency of creation of the float restart file 
-    ln_argo   = .false.    !  Argo type floats (stay at the surface each 10 days)
-    ln_flork4 = .false.    !  trajectories computed with a 4th order Runge-Kutta (T)
+   ln_rstflo  = .false.    !  float restart (T) or not (F)
+   nn_writefl =      75    !  frequency of writing in float output file 
+   nn_stockfl =    5475    !  frequency of creation of the float restart file 
+   ln_argo    = .false.    !  Argo type floats (stay at the surface each 10 days)
+   ln_flork4  = .false.    !  trajectories computed with a 4th order Runge-Kutta (T)
                            !  or computed with Blanke' scheme (F)
 /
@@ -697,10 +765,105 @@
 &namptr       !   Poleward Transport Diagnostic
 !-----------------------------------------------------------------------
-   ln_diaptr  = .true.     !  Poleward heat and salt transport (T) or not (F)
+   ln_diaptr  = .false.    !  Poleward heat and salt transport (T) or not (F)
    ln_diaznl  = .true.     !  Add zonal means and meridional stream functions
    ln_subbas  = .true.     !  Atlantic/Pacific/Indian basins computation (T) or not 
                            !  (orca configuration only, need input basins mask file named "subbasins.nc"
    ln_ptrcomp = .true.     !  Add decomposition : overturning
-   nf_ptr     =  1         !  Frequency of ptr computation [time step]
-   nf_ptr_wri =  15        !  Frequency of ptr outputs
-/
+   nn_fptr    =  1         !  Frequency of ptr computation [time step]
+   nn_fwri    =  15        !  Frequency of ptr outputs [time step]
+/
+!-----------------------------------------------------------------------
+&namhsb       !  Heat and salt budgets 
+!-----------------------------------------------------------------------
+   ln_diahsb  = .false.    !  check the heat and salt budgets (T) or not (F)
+/
+
+!!======================================================================
+!!            ***  Observation & Assimilation namelists ***
+!!======================================================================
+!!   namobs       observation and model comparison                      ('key_diaobs')
+!!   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               Logical switch for Reynolds observations       
+                           !     ln_ghrsst               Logical switch for GHRSST observations          
+
+   ln_sstfb   = .false.    ! Logical switch for feedback SST data          
+                           !     ln_sss                  Logical switch for SSS observations              
+                           !     ln_seaice               Logical switch for Sea Ice observations        
+                           !     ln_vel3d                Logical switch for velocity observations         
+                           !     ln_velavcur             Logical switch for velocity daily av. cur.    
+                           !     ln_velhrcur             Logical switch for velocity high freq. cur.   
+                           !     ln_velavadcp            Logical switch for velocity daily av. ADCP  
+                           !     ln_velhradcp            Logical switch for velocity high freq. ADCP
+                           !     ln_velfb                Logical switch for feedback velocity data       
+                           !     ln_grid_global          Global distribtion of observations         
+                           !     ln_grid_search_lookup   Logical switch for obs grid search w/lookup table  
+                           !     grid_search_file        Grid search lookup file header 
+                           !     enactfiles              ENACT input observation file names 
+                           !     coriofiles              Coriolis input observation file name  
+   !                       ! profbfiles: Profile feedback input observation file name 
+   profbfiles = 'profiles_01.nc'
+                           !     ln_profb_enatim         Enact feedback input time setting switch    
+                           !     slafilesact             Active SLA input observation file name
+                           !     slafilespas             Passive SLA input observation file name 
+   !                       ! slafbfiles: Feedback SLA input observation file name 
+   slafbfiles = 'sla_01.nc'
+                           !     sstfiles                GHRSST input observation file name       
+   !                       ! sstfbfiles: Feedback SST input observation file name 
+   sstfbfiles = 'sst_01.nc' 'sst_02.nc' 'sst_03.nc' 'sst_04.nc' 'sst_05.nc'
+                           !     seaicefiles             Sea Ice input observation file name 
+                           !     velavcurfiles           Vel. cur. daily av. input file name  
+                           !     velhvcurfiles           Vel. cur. high freq. input file name  
+                           !     velavadcpfiles          Vel. ADCP daily av. input file name    
+                           !     velhvadcpfiles          Vel. ADCP high freq. input file name 
+                           !     velfbfiles              Vel. feedback input observation file name 
+                           !     dobsini                 Initial date in window YYYYMMDD.HHMMSS       
+                           !     dobsend                 Final date in window YYYYMMDD.HHMMSS         
+                           !     n1dint                  Type of vertical interpolation method        
+                           !     n2dint                  Type of horizontal interpolation method       
+                           !     ln_nea                  Rejection of observations near land switch    
+   nmsshc     = 0          ! MSSH correction scheme                         
+                           !     mdtcorr                 MDT  correction                               
+                           !     mdtcutoff               MDT cutoff for computed correction          
+   ln_altbias = .false.    ! Logical switch for alt bias                
+   ln_ignmis  = .true.     ! Logical switch for ignoring missing files   
+                           !     endailyavtypes   ENACT daily average types                    
+   ln_grid_global = .true.
+   ln_grid_search_lookup = .false.
+/ 
+!-----------------------------------------------------------------------
+&nam_asminc   !   assimilation increments                               ('key_asminc')
+!-----------------------------------------------------------------------
+    ln_bkgwri = .false.    !  Logical switch for writing out background state 
+    ln_trjwri = .false.    !  Logical switch for writing out state trajectory
+    ln_trainc = .false.    !  Logical switch for applying tracer increments
+    ln_dyninc = .false.    !  Logical switch for applying velocity increments
+    ln_sshinc = .false.    !  Logical switch for applying SSH increments 
+    ln_asmdin = .false.    !  Logical switch for Direct Initialization (DI)
+    ln_asmiau = .false.    !  Logical switch for Incremental Analysis Updating (IAU)
+    nitbkg    = 0          !  Timestep of background in [0,nitend-nit000-1]
+    nitdin    = 0          !  Timestep of background for DI in [0,nitend-nit000-1]
+    nitiaustr = 1          !  Timestep of start of IAU interval in [0,nitend-nit000-1]
+    nitiaufin = 15         !  Timestep of end of IAU interval in [0,nitend-nit000-1]
+    niaufn    = 0          !  Type of IAU weighting function
+    nittrjfrq = 0          !  Frequency of trajectory output for 4D-VAR
+    ln_salfix = .false.    !  Logical switch for ensuring that the sa > salfixmin
+    salfixmin = -9999      !  Minimum salinity after applying the increments
+/
Index: trunk/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist_ice_lim2
===================================================================
--- trunk/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist_ice_lim2	(revision 2527)
+++ trunk/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist_ice_lim2	(revision 2528)
@@ -1,12 +1,11 @@
 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-!! NEMO/LIM2 :  1 - dynamics/advection/thermo          (namicerun)
+!! NEMO/LIM-2 : 1 - dynamics/advection/thermo          (namicerun)
 !! namelists    2 - ice intialisation                  (namiceini)
 !!              3 - ice dynamic                        (namicedyn)
-!!              5 - ice advection                      (namicetrp)
-!!              6 - thermodynamic                      (namicethd)
-!!              7 - ice salinity                       (namicesal)
-!!              8 - mechanical redistribution of ice   (namiceitdme)
-!!              3 - ice diagnostics                    (namicedia)
-!!              9 - ice outputs                        (namiceout)
+!!              4 - ice advection                      (namicetrp)
+!!              5 - thermodynamic                      (namicethd)
+!!              6 - ice damping                        (namice_dmp)
+!!              7 - ice diagnostics                    (namicedia)
+!!              8 - ice outputs                        (namiceout)
 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 
@@ -16,14 +15,14 @@
    cn_icerst_in  = "restart_ice_in"   !  suffix of ice restart name (input)
    cn_icerst_out = "restart_ice"      !  suffix of ice restart name (output)
-   ln_limdyn   = .true.    !  ice dynamics (T) or thermodynamics only (F)
-   ln_limdmp   = .false.   !  restoring ice thickness and fraction leads (T) or not (F)
-   acrit       = 1.0e-06   , 1.0e-06   ! minimum fraction for leads in the Northern (Southern) Hemisphere
-   hsndif      =  0.0      !  computation of temperature in snow (=0.0) or not
-   hicdif      =  0.0      !  computation of temperature in ice  (=0.0) or not (=9999.0)
+   ln_limdyn     = .true.             !  ice dynamics (T) or thermodynamics only (F)
+   ln_limdmp     = .false.            !  restoring ice thickness and fraction leads   (T => fill  namice_dmp)
+   acrit         = 1.0e-06 , 1.0e-06  !  minimum lead fraction in the Northern & Southern Hemispheres
+   hsndif        =  0.e0              !  computation of temperature in snow (=0.0) or not
+   hicdif        =  0.e0              !  computation of temperature in ice  (=0.0) or not (=9999.0)
 /
 !-----------------------------------------------------------------------
 &namiceini     !   ice initialisation
 !-----------------------------------------------------------------------
-   ln_limini   = .false.   !  read the ice initial state in the file 'Ice_initialization.nc' (T) or not (F)
+   ln_limini   = .false.   !  read the initial state in 'Ice_initialization.nc' (T) or not (F)
    ttest       =  2.0      !  threshold water temperature for initial sea ice
    hninn       =  0.5      !  initial snow thickness in the north
@@ -52,34 +51,19 @@
    ecc         =   2.0     !  eccentricity of the elliptical yield curve
    ahi0        = 350.e0    !  horizontal eddy diffusivity coefficient for sea-ice [m2/s]
+   nevp        =   360     !  number of EVP subcycling iterations
+   telast      =   3600    !  timescale for EVP elastic waves
+   alphaevp    =   1.0     !  coefficient for the solution of EVP int. stresses
 /
 !-----------------------------------------------------------------------
 &namicetrp     !   ice transport
 !-----------------------------------------------------------------------
-   bound       =   0.      !  boundary conditions (=0.0 no-slip, =1.0 free-slip)
+   bound       =   0.0     !  boundary conditions (=0. no-slip, =1. free-slip)
 /
 !-----------------------------------------------------------------------
 &namicethd     !   ice thermodynamic
 !-----------------------------------------------------------------------
-!  hmelt       : maximum melting at the bottom
-!  hiccrit(1/2): ice thickness for lateral accretion in the Northern (Southern) Hemisphere
-!                caution 1.0, 1.0 best value to be used!!! (gilles G.)
-!  hicmin      : ice thickness corr. to max. energy stored in brine pocket
-!  hiclim      : minimum ice thickness
-!  amax        : maximum lead fraction
-!  swiqst      : energy stored in brine pocket (=1) or not (=0)	
-!  sbeta       : numerical caracteritic of the scheme for diffusion in ice
-!               Cranck-Nicholson (=0.5), implicit (=1), explicit (=0)
-!  parlat      : percentage of energy used for lateral ablation
-!  hakspl      : slope of distr. for Hakkinen-Mellor's lateral melting
-!  hibspl      : slope of distribution for Hibler's lateral melting
-!  exld        : exponent for leads-closure rate
-!  hakdif      : coefficient for diffusions of ice and snow
-!  thth         : threshold thickness for comp. of eq. thermal conductivity
-!  hnzst       : thickness of the surf. layer in temp. computation
-!  parsub      : switch for snow sublimation or not
-!  alphs       : coefficient for snow density when snow ice formation
-! 
    hmelt       = -0.15     !  maximum melting at the bottom
    hiccrit     = 0.3 , 0.3 !  ice thickness for lateral accretion in the Northern (Southern) Hemisphere
+   !                       !  (caution 1.0, 1.0 best value to be used!!! (gilles G.))
    hicmin      = 0.2       !  ice thickness corr. to max. energy stored in brine pocket
    hiclim      = 0.05      !  minimum ice thickness
@@ -99,36 +83,47 @@
 /
 !-----------------------------------------------------------------------
+&namice_dmp    !   damping of sea ice alone open boundaries
+!              !   (hard coded damping area: check if it fit your config)
+!-----------------------------------------------------------------------
+!              !  file name   ! frequency (hours) ! variable ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !              !  (if <0  months)  !   name   !  (logical)   !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_hicif    = 'ice_damping',  -1.              , 'hicif'  ,   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_cnf      = 'ice_damping',  -1.              , 'frld'   ,   .true.     , .true. , 'yearly'  , ''       , ''
+!
+   cn_dir      = './'      !  root directory for the location of the runoff files
+/
+!-----------------------------------------------------------------------
 &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
+   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
 /
 !'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 &namiceout     !   parameters for outputs
 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+!              !         title of the field           !  name     !   units   !  save  ! multipl. ! additive !
+!              !                                      !           !           ! or not !  factor  !  factor  !
+   field_1     = 'Snow thickness                     ', 'isnowthi', 'm       ',    1   ,  1.0     ,    0.0
+   field_2     = 'Ice thickness                      ', 'iicethic', 'm       ',    1   ,  1.0     ,    0.0
+   field_3     = 'Ice produced                       ', 'iiceprod', 'm/kt    ',    1   ,  1.0     ,    0.0
+   field_4     = 'Ice concentration                  ', 'ileadfra', '%       ',    1   , -1.0     ,    1.0
+   field_5     = 'Ice temperature                    ', 'iicetemp', 'C       ',    1   ,  1.0     , -273.15
+   field_6     = 'Oceanic flux at the ice base       ', 'ioceflxb', 'w/m2    ',    1   ,  1.0     ,    0.0
+   field_7     = 'Ice velocity u                     ', 'iicevelu', 'm/s     ',    1   ,  1.0     ,    0.0
+   field_8     = 'Ice velocity v                     ', 'iicevelv', 'm/s     ',    1   ,  1.0     ,    0.0
+   field_9     = 'Sea surface temperature            ', 'isstempe', 'C       ',    1   ,  1.0     , -273.15
+   field_10    = 'Sea surface salinity               ', 'isssalin', 'PSU     ',    1   ,  1.0     ,    0.0
+   field_11    = 'Total flux at ocean surface        ', 'iocetflx', 'w/m2    ',    1   ,  1.0     ,    0.0
+   field_12    = 'Solar flux at ocean surface        ', 'iocesflx', 'w/m2    ',    1   ,  1.0     ,    0.0
+   field_13    = 'Non-solar flux at ocean surface    ', 'iocwnsfl', 'w/m2    ',    1   ,  1.0     ,    0.0
+   field_14    = 'Salt flux at ocean surface         ', 'iocesafl', 'kg/m2/kt',    1   ,  1.0     ,    0.0
+   field_15    = 'Wind stress u                      ', 'iocestru', 'Pa      ',    1   ,  1.0     ,    0.0
+   field_16    = 'Wind stress v                      ', 'iocestrv', 'Pa      ',    1   ,  1.0     ,    0.0 
+   field_17    = 'Solar flux at ice/ocean surface    ', 'iicesflx', 'w/m2    ',    1   ,  1.0     ,    0.0
+   field_18    = 'Non-solar flux at ice/ocean surface', 'iicenflx', 'w/m2    ',    1   ,  1.0     ,    0.0
+   field_19    = 'Snow precipitation                 ', 'isnowpre', 'kg/day  ',    1   ,  1.0     ,    0.0
+!
    noumef      =   19      !  number of fields
-!
-!           !         title of the field           !  name     !   units   !  save  ! multipl. ! additive !
-!           !                                      !           !           ! or not !  factor  !  factor  !
-   field_1  = 'Snow thickness                     ', 'isnowthi', 'm       ',    1   ,  1.0     ,    0.0
-   field_2  = 'Ice thickness                      ', 'iicethic', 'm       ',    1   ,  1.0     ,    0.0
-   field_3  = 'Ice produced                       ', 'iiceprod', 'm/kt    ',    1   ,  1.0     ,    0.0
-   field_4  = 'Ice concentration                  ', 'ileadfra', '%       ',    1   , -1.0     ,    1.0
-   field_5  = 'Ice temperature                    ', 'iicetemp', 'C       ',    1   ,  1.0     , -273.15
-   field_6  = 'Oceanic flux at the ice base       ', 'ioceflxb', 'w/m2    ',    1   ,  1.0     ,    0.0
-   field_7  = 'Ice velocity u                     ', 'iicevelu', 'm/s     ',    1   ,  1.0     ,    0.0
-   field_8  = 'Ice velocity v                     ', 'iicevelv', 'm/s     ',    1   ,  1.0     ,    0.0
-   field_9  = 'Sea surface temperature            ', 'isstempe', 'C       ',    1   ,  1.0     , -273.15
-   field_10 = 'Sea surface salinity               ', 'isssalin', 'PSU     ',    1   ,  1.0     ,    0.0
-   field_11 = 'Total flux at ocean surface        ', 'iocetflx', 'w/m2    ',    1   ,  1.0     ,    0.0
-   field_12 = 'Solar flux at ocean surface        ', 'iocesflx', 'w/m2    ',    1   ,  1.0     ,    0.0
-   field_13 = 'Non-solar flux at ocean surface    ', 'iocwnsfl', 'w/m2    ',    1   ,  1.0     ,    0.0
-   field_14 = 'Salt flux at ocean surface         ', 'iocesafl', 'kg/m2/kt',    1   ,  1.0     ,    0.0
-   field_15 = 'Wind stress u                      ', 'iocestru', 'Pa      ',    1   ,  1.0     ,    0.0
-   field_16 = 'Wind stress v                      ', 'iocestrv', 'Pa      ',    1   ,  1.0     ,    0.0 
-   field_17 = 'Solar flux at ice/ocean surface    ', 'iicesflx', 'w/m2    ',    1   ,  1.0     ,    0.0
-   field_18 = 'Non-solar flux at ice/ocean surface', 'iicenflx', 'w/m2    ',    1   ,  1.0     ,    0.0
-   field_19 = 'Snow precipitation                 ', 'isnowpre', 'kg/day  ',    1   ,  1.0     ,    0.0
 /      
Index: trunk/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/xmlio_server.def
===================================================================
--- trunk/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/xmlio_server.def	(revision 2527)
+++ trunk/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/xmlio_server.def	(revision 2528)
@@ -17,4 +17,19 @@
   global_mpi_buffer_size = 512
 /  
+
+!!======================================================================
+!!   namnc4            netcdf4 chunking and compression settings
+!!======================================================================
+!-----------------------------------------------------------------------
+&namnc4         !  netcdf4 chunking and compression settings
+                !  (benign if "key_netcdf4" is not used)
+!-----------------------------------------------------------------------
+   nn_nchunks_i   =   4       !  number of chunks in i-dimension
+   nn_nchunks_j   =   4       !  number of chunks in j-dimension
+   nn_nchunks_k   =   31      !  number of chunks in k-dimension
+                              !  setting nn_nchunks_k = jpk will give a chunk size of 1 in the vertical which
+                              !  is optimal for postprocessing which works exclusively with horizontal slabs
+   ln_nc4zip      =   .TRUE.  !  (T) use netcdf4 chunking and compression
+                              !  (F) ignore chunking information and produce netcdf3-compatible files  
+/
   
-  
Index: trunk/NEMOGCM/CONFIG/ORCA2_LIM/IGCM00/COMP/lim2.card
===================================================================
--- trunk/NEMOGCM/CONFIG/ORCA2_LIM/IGCM00/COMP/lim2.card	(revision 2527)
+++ trunk/NEMOGCM/CONFIG/ORCA2_LIM/IGCM00/COMP/lim2.card	(revision 2528)
@@ -21,5 +21,5 @@
 
 [OutputFiles]
-List=   (${PREFIX_WFI1}_icemod.nc, ${R_OUT_ICE_WFI1}/${PREFIX}_${WFI1}_icemod.nc, Post_5D_icemod)
+List=   (${PREFIX_WFI1}_icemod.nc, ${R_OUT_ICE_WFI1}/${PREFIX}_${WFI1}_icemod.nc, Post_1M_icemod)
 
 [Post_1M_icemod]
Index: trunk/NEMOGCM/CONFIG/ORCA2_LIM/IGCM00/COMP/opa9.card
===================================================================
--- trunk/NEMOGCM/CONFIG/ORCA2_LIM/IGCM00/COMP/opa9.card	(revision 2527)
+++ trunk/NEMOGCM/CONFIG/ORCA2_LIM/IGCM00/COMP/opa9.card	(revision 2528)
@@ -54,8 +54,8 @@
             (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/sst_data.nc, .),\
 	    (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/subbasins.nc, .),\
-            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/chlaseawifs_c1m-99-05_smooth_ORCA_R2.nc, chlorophyll.nc),\
-            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/Tides_K1_drg_ORCA_R2.nc, K1rowdrg.nc),\
-            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/Tides_M2_drg_ORCA_R2.nc, M2rowdrg.nc),\
-            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/tmaskitf_ORCA2_bis.nc, mask_itf.nc),\
+            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/chlorophyll.nc, .),\
+            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/K1rowdrg.nc, .),\
+            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/M2rowdrg.nc, .),\
+            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/mask_itf.nc, .),\
             (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/kRGB61.txt, .)
 
Index: trunk/NEMOGCM/CONFIG/ORCA2_LIM/cpp_ORCA2_LIM.fcm
===================================================================
--- trunk/NEMOGCM/CONFIG/ORCA2_LIM/cpp_ORCA2_LIM.fcm	(revision 2528)
+++ trunk/NEMOGCM/CONFIG/ORCA2_LIM/cpp_ORCA2_LIM.fcm	(revision 2528)
@@ -0,0 +1,1 @@
+ bld::tool::fppkeys  key_trabbl key_vectopt_loop key_orca_r2 key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_dtatem key_dtasal key_tradmp key_zdftke key_zdfddm key_iomput key_nproci=1 key_nprocj=1 
Index: trunk/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/AA_make
===================================================================
--- trunk/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/AA_make	(revision 2527)
+++ 	(revision )
@@ -1,13 +1,0 @@
-# $Header$
-all: ioipsl opa
-
-ioipsl:
-	(cd ../../modeles/IOIPSL/src; $(M_K) ;)
-
-
-opa:
-	(cd ../../modeles/NEMO/WORK;  $(M_K) ;)
-
-
-clean:
-	(cd ../../modeles/NEMO/WORK;  $(M_K) clean ;)
Index: trunk/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/AA_make.ldef
===================================================================
--- trunk/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/AA_make.ldef	(revision 2527)
+++ 	(revision )
@@ -1,11 +1,0 @@
-#---------------------------------------------------------------------
-#- Creation des elements relatifs a ORCA :
-#-      ORCA  (lib, executable : opa)
-#---------------------------------------------------------------------
-SHELL = /bin/sh
-#---------------------------------------------------------------------
-LIBDIR = ../../../../lib
-BINDIR = ../../../../bin
-MODDIR = $(LIBDIR)
-#---------------------------------------------------------------------
-#-
Index: trunk/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/AA_job
===================================================================
--- trunk/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/AA_job	(revision 2527)
+++ trunk/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/AA_job	(revision 2528)
@@ -113,6 +113,4 @@
 cp ${R_EXPER}/namelist_pisces     namelist_pisces
 cp ${R_EXPER}/kRGB61.txt          kRGB61.txt
-cp ${R_EXPER}/iodef.xml .
-cp ${R_EXPER}/xmlio_server.def .
 
 ls -alF
Index: trunk/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/iodef.xml
===================================================================
--- trunk/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/iodef.xml	(revision 2527)
+++ trunk/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/iodef.xml	(revision 2528)
@@ -54,6 +54,6 @@
       <group id="SBC" axis_ref="none" grid_ref="grid_T" > <!-- time step automaticaly defined based on nn_fsbc -->
 
-	<field id="emp"          description="Net Upward Water Flux"                                        unit="kg/m2/s"  />
-	<field id="emps"         description="concentration/dilution water flux"                            unit="kg/m2/s"  />
+	<field id="emp-rnf"      description="Net Upward Water Flux"                                        unit="kg/m2/s"  />
+	<field id="emps-rnf"     description="concentration/dilution water flux"                            unit="kg/m2/s"  />
 	<field id="snowpre"      description="Snow precipitation"                                           unit="kg/m2/s"  />
 	<field id="runoffs"      description="River Runoffs"                                                unit="Kg/m2/s"  />
@@ -133,9 +133,10 @@
 	<field id="utau"         description="Wind Stress along i-axis"                    unit="N/m2" axis_ref="none" />
 	<field id="uoce"         description="ocean current along i-axis"                  unit="m/s"                  />
-	<field id="uoce_eff"     description="Effective ocean current along i-axis"        unit="m/s"                  />
+	<field id="uoce_eff"     description="Effective ocean transport along i-axis"      unit="m3/s"                 />
 	<!-- uoce_eiv: available with key_traldf_eiv and key_diaeiv -->
 	<field id="uoce_eiv"     description="EIV ocean current along i-axis"              unit="m/s"                  />
-	<!-- uoce_eiv: available with key_trabbl_adv -->
-	<field id="uoce_bbl"     description="BBL ocean current along i-axis"              unit="m/s"                  />
+	<!-- uoce_eiv: available with key_trabbl -->
+	<field id="uoce_bbl"     description="BBL ocean current along i-axis"              unit="m/s"  axis_ref="none" />
+	<field id="ahu_bbl"      description="BBL diffusive flux along i-axis"             unit="m3/s" axis_ref="none" />
  	<!-- variables available with key_diaar5 -->
 	<field id="u_masstr"     description="ocean eulerian mass transport along i-axis"  unit="kg/s"                 />
@@ -150,9 +151,10 @@
 	<field id="vtau"         description="Wind Stress along j-axis"                    unit="N/m2" axis_ref="none" />
 	<field id="voce"         description="ocean current along j-axis"                  unit="m/s"                  />
-	<field id="voce_eff"     description="Effective ocean current along j-axis"        unit="m/s"                  />
+	<field id="voce_eff"     description="Effective ocean tra,sport along j-axis"      unit="m3/s"                 />
 	<!-- voce_eiv: available with key_traldf_eiv and key_diaeiv -->
 	<field id="voce_eiv"     description="EIV ocean current along j-axis"              unit="m/s"                  />
-	<!-- voce_eiv: available with key_trabbl_adv -->
-	<field id="voce_bbl"     description="BBL ocean current along j-axis"              unit="m/s"                  />
+	<!-- voce_eiv: available with key_trabbl -->
+	<field id="voce_bbl"     description="BBL ocean current along j-axis"              unit="m/s" axis_ref="none"  />
+	<field id="ahv_bbl"      description="BBL diffusive flux along j-axis"             unit="m3/s" axis_ref="none" />
 	<!-- variables available with key_diaar5 -->
 	<field id="v_masstr"     description="ocean eulerian mass transport along j-axis"  unit="kg/s"                 />
@@ -166,9 +168,8 @@
       <group id="grid_W"  axis_ref="depthw" grid_ref="grid_W">
 	<field id="woce"         description="ocean vertical velocity"                     unit="m/s"                  />
-	<field id="woce_eff"     description="effective ocean vertical velocity"           unit="m/s"                  />
+	<field id="woce_eff"     description="effective ocean vertical transport"          unit="m3/s"                 />
 	<!-- woce_eiv: available with key_traldf_eiv and key_diaeiv -->
 	<field id="woce_eiv"     description="EIV ocean vertical velocity"                 unit="m/s"                  />
 	<!-- woce_eiv: available with key_trabbl_adv -->
-	<field id="woce_bbl"     description="BBL ocean vertical velocity"                 unit="m/s"                  />
 	<field id="avt"          description="vertical eddy diffusivity"                   unit="m2/s"                 />
 	<field id="avm"          description="vertical eddy viscosity"                     unit="m2/s"                 />
@@ -205,59 +206,59 @@
 
      <group id="ptrc_T" axis_ref="deptht" grid_ref="grid_T">  
-       <field id="DIC"      description="Dissolved inorganic Concentration"        unit="mol-C/L" />
+       <field id="DIC"      description="Dissolved inorganic Concentration"        unit="molC/L" />
        <field id="Alkalini" description="Total Alkalinity Concentration"           unit="eq/L"    />
-       <field id="O2"       description="Oxygen Concentration"                     unit="mol-C/L" />
-       <field id="CaCO3"    description="Calcite Concentration"                    unit="mol-C/L" />
-       <field id="PO4"      description="Phosphate Concentration"                  unit="mol-C/L" />
-       <field id="POC"      description="Small organic carbon Concentration"       unit="mol-C/L" />
-       <field id="Si"       description="Silicate Concentration"                   unit="mol-C/L" />
-       <field id="PHY"      description="Nanophytoplankton Concentration"          unit="mol-C/L" />
-       <field id="ZOO"      description="Microzooplankton Concentration"           unit="mol-C/L" />
-       <field id="DOC"      description="Dissolved organic Concentration"          unit="mol-C/L" />
-       <field id="PHY2"     description="Diatoms Concentration"                    unit="mol-C/L" />
-       <field id="ZOO2"     description="Mesozooplankton Concentration"            unit="mol-C/L" />
-       <field id="BSi"      description="Diatoms Silicate Concentration"           unit="mol-C/L" />
-       <field id="Fer"      description="Dissolved Iron Concentration"             unit="mol-C/L" />
-       <field id="BFe"      description="Big iron particles Concentration"         unit="mol-C/L" />
-       <field id="GOC"      description="Big organic carbon Concentration"         unit="mol-C/L" />
-       <field id="SFe"      description="Small iron particles Concentration"       unit="mol-C/L" />
-       <field id="DFe"      description="Diatoms iron  Concentration"              unit="mol-C/L" />
-       <field id="DSi"      description="Sinking biogenic Silicate Concentration"  unit="mol-C/L" />
-       <field id="NFe"      description="Nano iron Concentration"                  unit="mol-C/L" />
-       <field id="NCHL"     description="Nano chlorophyl Concentration"            unit="mol-C/L" />
-       <field id="DCHL"     description="Diatoms chlorophyl Concentration"         unit="mol-C/L" />
-       <field id="NO3"      description="Nitrates Concentration"                   unit="mol-C/L" />
-       <field id="NH4"      description="Ammonium Concentration"                   unit="mol-C/L" />
+       <field id="O2"       description="Oxygen Concentration"                     unit="molO2/L" />
+       <field id="CaCO3"    description="Calcite Concentration"                    unit="molC/L" />
+       <field id="PO4"      description="Phosphate Concentration"                  unit="molC/L" />
+       <field id="POC"      description="Small organic carbon Concentration"       unit="molC/L" />
+       <field id="Si"       description="Silicate Concentration"                   unit="molSi/L" />
+       <field id="PHY"      description="Nanophytoplankton Concentration"          unit="molC/L" />
+       <field id="ZOO"      description="Microzooplankton Concentration"           unit="molC/L" />
+       <field id="DOC"      description="Dissolved organic Concentration"          unit="molC/L" />
+       <field id="PHY2"     description="Diatoms Concentration"                    unit="molC/L" />
+       <field id="ZOO2"     description="Mesozooplankton Concentration"            unit="molC/L" />
+       <field id="BSi"      description="Diatoms Silicate Concentration"           unit="molC/L" />
+       <field id="Fer"      description="Dissolved Iron Concentration"             unit="molFe/L" />
+       <field id="BFe"      description="Big iron particles Concentration"         unit="molFe/L" />
+       <field id="GOC"      description="Big organic carbon Concentration"         unit="molC/L" />
+       <field id="SFe"      description="Small iron particles Concentration"       unit="molFe/L" />
+       <field id="DFe"      description="Diatoms iron  Concentration"              unit="molFe/L" />
+       <field id="DSi"      description="Sinking biogenic Silicate Concentration"  unit="molC/L" />
+       <field id="NFe"      description="Nano iron Concentration"                  unit="molC/L" />
+       <field id="NCHL"     description="Nano chlorophyl Concentration"            unit="gChl/L" />
+       <field id="DCHL"     description="Diatoms chlorophyl Concentration"         unit="gChl/L" />
+       <field id="NO3"      description="Nitrates Concentration"                   unit="molC/L" />
+       <field id="NH4"      description="Ammonium Concentration"                   unit="molC/L" />
      </group>
 
-      <!-- diad on T grid -->
+      <!-- diad on T grid : variables available with key_diatrc -->
 
      <group id="diad_T" axis_ref="none" grid_ref="grid_T">
-       <field id="PH"          description="PH"                                       unit="-"            axis_ref="deptht" />
-       <field id="CO3"         description="Bicarbonates"                             unit="mol/L"        axis_ref="deptht" />
-       <field id="CO3sat"      description="CO3 saturation"                           unit="mol/L"        axis_ref="deptht" />
-       <field id="PAR"         description="Photosynthetically Available Radiation"   unit="W/m2"         axis_ref="deptht" />
-       <field id="PPPHY"       description="Primary production of nanophyto"          unit="mol-C/m3/s"   axis_ref="deptht" />
-       <field id="PPPHY2"      description="Primary production of diatoms"            unit="mol-C/m3/s"   axis_ref="deptht" />
-       <field id="PPNEWN"      description="New Primary production of nanophyto"      unit="mol-C/m3/s"   axis_ref="deptht" />
-       <field id="PPNEWD"      description="New Primary production of diatoms"        unit="mol-C/m3/s"   axis_ref="deptht" />
-       <field id="PBSi"        description="Primary production of Si diatoms"         unit="mol-Si/m3/s"  axis_ref="deptht" />
-       <field id="PFeN"        description="Primary production of nano iron"          unit="mol-Fe/m3/s"  axis_ref="deptht" />
-       <field id="PFeD"        description="Primary production of diatoms iron"       unit="mol-Fe/m3/s"  axis_ref="deptht" />
-       <field id="PCAL"        description="Calcite production"                       unit="mol-C/m3/s"   axis_ref="deptht" />
-       <field id="DCAL"        description="Calcite dissolution"                      unit="mol-C/m3/s"   axis_ref="deptht" />
-       <field id="GRAZ"        description="Grazing by zooplankton"                   unit="mol-C/m3/s"   axis_ref="deptht" />
-       <field id="Nfix"        description="Nitrogen fixation at surface"             unit="mol-N/m2/s"      />
-       <field id="EPC100"      description="Export of carbon particles at 100 m"      unit="mol-C/m2/s"      />
-       <field id="EPFE100"     description="Export of biogenic iron at 100 m"         unit="mol-Fe/m2/s"     />
-       <field id="EPSI100"     description="Export of Silicate at 100 m"              unit="mol-Si/m2/s"     />
-       <field id="EPCAL100"    description="Export of Calcite at 100 m"               unit="mol-C/m2/s"      />
-       <field id="Cflx"        description="DIC flux"                                 unit="mol-C/m2/s"      />
-       <field id="Oflx"        description="Oxygen flux"                              unit="mol-C/m2/s" />
-       <field id="Kg"          description="Gas transfer"                             unit="mol-C/m2/s/uatm" />
-       <field id="Dpco2"       description="Delta CO2"                                unit="uatm" />
-       <field id="Dpo2"        description="Delta O2"                                 unit="uatm" />
-       <field id="Heup"        description="Euphotic layer depth"                     unit="m" />
-       <field id="Irondep"     description="Iron deposition"                          unit="mol-Fe/m2/s" />
+       <field id="PH"          description="PH"                                       unit="-"           axis_ref="deptht" />
+       <field id="CO3"         description="Bicarbonates"                             unit="mol/L"       axis_ref="deptht" />
+       <field id="CO3sat"      description="CO3 saturation"                           unit="mol/L"       axis_ref="deptht" />
+       <field id="PAR"         description="Photosynthetically Available Radiation"   unit="W/m2"        axis_ref="deptht" />
+       <field id="PPPHY"       description="Primary production of nanophyto"          unit="molC/m3/s"   axis_ref="deptht" />
+       <field id="PPPHY2"      description="Primary production of diatoms"            unit="molC/m3/s"   axis_ref="deptht" />
+       <field id="PPNEWN"      description="New Primary production of nanophyto"      unit="molC/m3/s"   axis_ref="deptht" />
+       <field id="PPNEWD"      description="New Primary production of diatoms"        unit="molC/m3/s"   axis_ref="deptht" />
+       <field id="PBSi"        description="Primary production of Si diatoms"         unit="molSi/m3/s"  axis_ref="deptht" />
+       <field id="PFeN"        description="Primary production of nano iron"          unit="molFe/m3/s"  axis_ref="deptht" />
+       <field id="PFeD"        description="Primary production of diatoms iron"       unit="molFe/m3/s"  axis_ref="deptht" />
+       <field id="PCAL"        description="Calcite production"                       unit="molC/m3/s"   axis_ref="deptht" />
+       <field id="DCAL"        description="Calcite dissolution"                      unit="molC/m3/s"   axis_ref="deptht" />
+       <field id="GRAZ"        description="Grazing by zooplankton"                   unit="molC/m3/s"   axis_ref="deptht" />
+       <field id="Nfix"        description="Nitrogen fixation at surface"             unit="molN/m2/s"      />
+       <field id="EPC100"      description="Export of carbon particles at 100 m"      unit="molC/m2/s"      />
+       <field id="EPFE100"     description="Export of biogenic iron at 100 m"         unit="molFe/m2/s"     />
+       <field id="EPSI100"     description="Export of Silicate at 100 m"              unit="molSi/m2/s"     />
+       <field id="EPCAL100"    description="Export of Calcite at 100 m"               unit="molC/m2/s"      />
+       <field id="Cflx"        description="DIC flux"                                 unit="molC/m2/s"      />
+       <field id="Oflx"        description="Oxygen flux"                              unit="molC/m2/s"      />
+       <field id="Kg"          description="Gas transfer"                             unit="molC/m2/s/uatm" />
+       <field id="Dpco2"       description="Delta CO2"                                unit="uatm"            />
+       <field id="Dpo2"        description="Delta O2"                                 unit="uatm"            />
+       <field id="Heup"        description="Euphotic layer depth"                     unit="m"               />
+       <field id="Irondep"     description="Iron deposition"                          unit="molFe/m2/s"     />
      </group>
        
@@ -333,7 +334,7 @@
 	  <field ref="sss"          name="sosaline"  />
 	  <field ref="ssh"          name="sossheig"  />
-	  <field ref="emp"          name="sowaflup"  />
+	  <field ref="emp-rnf"      name="sowaflup"  />
 	  <field ref="qsr"          name="soshfldo"  />
-	  <field ref="emps"         name="sowaflcd"  />
+	  <field ref="emps-rnf"     name="sowaflcd"  />
 	  <field ref="qns+qsr"      name="sohefldo"  />
 	  <field ref="mldr10_1"     name="somxl010"  />
@@ -691,4 +692,5 @@
       </grid>
 
+
     </grid_definition>    
     
Index: trunk/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist
===================================================================
--- trunk/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist	(revision 2527)
+++ trunk/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist	(revision 2528)
@@ -1,706 +1,1 @@
-!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-!! NEMO/OPA  :  1 - run manager      (namrun)
-!! namelists    2 - Domain           (namzgr, namzgr_sco, namdom)
-!!              3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core
-!!                                    namsbc_cpl, namqsr, namsbc_rnf, namsbc_ssr, namsbc_alb)
-!!              4 - lateral boundary (namlbc, namcla, namobc, namagrif, nambdy, nambdy_tide)
-!!              5 - bottom  boundary (nambfr, nambbc, nambbl)
-!!              6 - Tracer           (nameos, namtra_adv, namtra_ldf, namtra_dmp)
-!!              7 - dynamics         (namdyn_adv, namdyn_vor, namdyn_hpg, namdyn_spg, namdyn_ldf)
-!!              8 - Verical physics  (namzdf, namzdf_ric, namzdf_tke, namzdf_kpp, namzdf_ddm, namzdf_tmx)
-!!              9 - diagnostics      (namtrd, namgap, namspr, namflo, namptr)
-!!              9 - miscellaneous    (namsol, nammpp, nammpp_dyndist, namctl)
-!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-!  CAUTION: some scripts does not support CAPITALs for logical use .true./.false., not .TRUE./.FALSE.
-
-!!======================================================================
-!!                   ***  Run management namelists  ***
-!!======================================================================
-!!   namrun            parameters of the run
-!!======================================================================
-
-!-----------------------------------------------------------------------
-&namrun        !   parameters of the run
-!-----------------------------------------------------------------------
-   nn_no       =       0   !  job number
-   cn_exp      =  "ORCA2P" !  experience name 
-   nn_it000    =       1   !  first time step
-   nn_itend    =    5475   !  last  time step (std 5475)
-   nn_date0    =  010101   !  initial calendar date yymmdd (used if nrstdt=1)
-   nn_leapy    =       0   !  Leap year calendar (1) or not (0)
-   nn_istate   =       0   !  output the initial state (1) or not (0)
-   nn_stock    =    5475   !  frequency of creation of a restart file (modulo referenced to 1)
-   nn_write    =    5475   !  frequency of write in the output file   (modulo referenced to nit000)
-   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
-   nn_chunksz  =       0   !  chunksize (bytes) for NetCDF file (working only with iom_nf90 routines)
-   ln_rstart   = .false.   !  start from rest (F) or from a restart file (T)
-   nn_rstctl   =       0       !  restart control = 0 nit000 is not compared to the restart file value
-                               !                  = 1 use ndate0 in namelist (not the value in the restart file)
-                               !                  = 2 calendar parameters read in the restart file
-   cn_ocerst_in  = "restart"   !  suffix of ocean restart name (input)
-   cn_ocerst_out = "restart"   !  suffix of ocean restart name (output)
-/
-!!======================================================================
-!!                      ***  Domain namelists  ***
-!!======================================================================
-!!   namzgr       vertical coordinate
-!!   namzgr_sco   s-coordinate or hybrid z-s-coordinate
-!!   namdom       space and time domain (bathymetry, mesh, timestep)
-!!======================================================================
-
-!-----------------------------------------------------------------------
-&namzgr        !   vertical coordinate
-!-----------------------------------------------------------------------
-   ln_zco      = .false.   !  z-coordinate - full    steps   (T/F)      ("key_zco" may also be defined)
-   ln_zps      = .true.    !  z-coordinate - partial steps   (T/F)
-   ln_sco      = .false.   !  s- or hybrid z-s-coordinate    (T/F)
-/
-!-----------------------------------------------------------------------
-&namzgr_sco    !   s-coordinate or hybrid z-s-coordinate
-!-----------------------------------------------------------------------
-   rn_sbot_min =  300.     !  minimum depth of s-bottom surface (>0) (m)
-   rn_sbot_max = 5250.     !  maximum depth of s-bottom surface (= ocean depth) (>0) (m)
-   rn_theta    =    6.0    !  surface control parameter (0<=theta<=20)
-   rn_thetb    =    0.75   !  bottom control parameter  (0<=thetb<= 1)
-   rn_rmax     =    0.15   !  maximum cut-off r-value allowed (0<r_max<1)
-   ln_s_sigma  = .false.   !  hybrid s-sigma coordinates
-   rn_bb       =    0.8    !  stretching with s-sigma
-   rn_hc       =  150.0    !  critical depth with s-sigma 
-/
-!-----------------------------------------------------------------------
-&namdom        !   space and time domain (bathymetry, mesh, timestep)
-!-----------------------------------------------------------------------
-   nn_bathy    =    1      !  compute (=0) or read(=1) the bathymetry file
-   nn_closea   =    0      !  closed seas and lakes are removed (=0) or kept (=1) from the ORCA domain
-   nn_msh      =    0      !  create (=1) a mesh file (coordinates, scale factors, masks) or not (=0)
-   rn_e3zps_min=   20.     !  the thickness of the partial step is set larger than the minimum
-   rn_e3zps_rat=    0.1    !  of e3zps_min and e3zps_rat * e3t   (N.B. 0<e3zps_rat<1)
-                           !
-   rn_rdt      = 5760.     !  time step for the dynamics (and tracer if nacc=0)   ==> 5760
-   nn_baro     =   64      !  number of barotropic time step (for the split explicit algorithm) ("key_dynspg_ts")
-   rn_atfp     =    0.1    !  asselin time filter parameter
-   nn_acc      =    0      !  acceleration of convergence : =1      used, rdt < rdttra(k)
-                                 !                          =0, not used, rdt = rdttra
-   rn_rdtmin   = 28800.          !  minimum time step on tracers (used if nacc=1)
-   rn_rdtmax   = 28800.          !  maximum time step on tracers (used if nacc=1)
-   rn_rdth     =  800.           !  depth variation of tracer time step  (used if nacc=1)
-/
-!!======================================================================
-!!            ***  Surface Boundary Condition namelists  ***
-!!======================================================================
-!!   namsbc        surface boundary condition
-!!   namsbc_ana    analytical         formulation
-!!   namsbc_flx    flux               formulation
-!!   namsbc_clio   CLIO bulk formulea formulation
-!!   namsbc_core   CORE bulk formulea formulation
-!!   namsbc_cpl    CouPLed            formulation                       ("key_coupled")
-!!   namtra_qsr    penetrative solar radiation
-!!   namsbc_rnf    river runoffs
-!!   namsbc_ssr    sea surface restoring term (for T and/or S)
-!!   namsbc_alb    albedo parameters
-!!======================================================================
-
-!-----------------------------------------------------------------------
-&namsbc        !   Surface Boundary Condition (surface module)
-!-----------------------------------------------------------------------
-   nn_fsbc     = 5         !  frequency of surface boundary condition computation 
-                           !               (= the frequency of sea-ice model call)
-   ln_ana      = .false.   !  analytical formulation (T => fill namsbc_ana ) 
-   ln_flx      = .false.   !  flux formulation       (T => fill namsbc_flx )
-   ln_blk_clio = .true.    !  CLIO bulk formulation  (T => fill namsbc_clio) 
-   ln_blk_core = .false.   !  CORE bulk formulation  (T => fill namsbc_core) 
-   ln_cpl      = .false.   !  Coupled formulation    (T => fill namsbc_cpl )
-   nn_ice      = 2         !  =0 no ice boundary condition   ,
-                           !  =1 use observed ice-cover      ,
-                           !  =2 ice-model used                             ("key_lim3" or "key_lim2)
-   nn_ico_cpl  = 0         !  ice-ocean coupling : =0 each nn_fsbc 
-                           !                       =1 stresses recomputed each ocean time step ("key_lim3" only)
-                           !                       =2 combination of 0 and 1 cases             ("key_lim3" only)
-   ln_dm2dc    = .false.   !  daily mean to diurnal cycle short wave (qsr)
-   ln_rnf      = .true.    !  runoffs (T => fill namsbc_rnf)
-   ln_ssr      = .true.    !  Sea Surface Restoring on T and/or S (T => fill namsbc_ssr)
-   nn_fwb      = 3         !  FreshWater Budget: =0 unchecked 
-                           !                     =1 global mean of e-p-r set to zero at each time step 
-                           !                     =2 annual global mean of e-p-r set to zero
-                           !                     =3 global emp set to zero and spread out over erp area
-/
-!-----------------------------------------------------------------------
-&namsbc_ana    !   analytical surface boundary condition
-!-----------------------------------------------------------------------
-   nn_tau000   =   0       !  gently increase the stress over the first ntau_rst time-steps
-   rn_utau0    =   0.5     !  uniform value for the i-stress
-   rn_vtau0    =   0.e0    !  uniform value for the j-stress
-   rn_qns0     =   0.e0    !  uniform value for the total heat flux
-   rn_qsr0     =   0.e0    !  uniform value for the solar radiation
-   rn_emp0     =   0.e0    !  uniform value for the freswater budget (E-P)
-/
-!-----------------------------------------------------------------------
-&namsbc_flx    !   surface boundary condition : flux formulation
-!-----------------------------------------------------------------------
-!              !   file name  ! frequency (hours) !  variable  ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
-!              !              !  (if <0  months)  !    name    !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
-   sn_utau     = 'utau'       ,        24         ,    'utau'  ,     .false.    , .false. , 'yearly'  , ''       , ''
-   sn_vtau     = 'vtau'       ,        24         ,    'vtau'  ,     .false.    , .false. , 'yearly'  , ''       , ''
-   sn_qtot     = 'qtot'       ,        24         ,    'qtot'  ,     .false.    , .false. , 'yearly'  , ''       , ''
-   sn_qsr      = 'qsr'        ,        24         ,    'qsr'   ,     .false.    , .false. , 'yearly'  , ''       , ''
-   sn_emp      = 'emp'        ,        24         ,    'emp'   ,     .false.    , .false. , 'yearly'  , ''       , ''
-!
-   cn_dir      = './'      !  root directory for the location of the flux files
-/      
-!-----------------------------------------------------------------------
-&namsbc_clio   !   namsbc_clio  CLIO bulk formulea
-!-----------------------------------------------------------------------
-!              !   file name  ! frequency (hours) !  variable  ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
-!              !              !  (if <0  months)  !    name    !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
-   sn_utau     = 'taux_1m'    ,       -1          , 'sozotaux' ,    .true.      , .true.  , 'yearly'  , ''       , ''
-   sn_vtau     = 'tauy_1m'    ,       -1          , 'sometauy' ,    .true.      , .true.  , 'yearly'  , ''       , ''
-   sn_wndm     = 'flx'        ,       -1          , 'socliowi' ,    .true.      , .true.  , 'yearly'  , ''       , ''
-   sn_tair     = 'flx'        ,       -1          , 'socliot2' ,    .true.      , .true.  , 'yearly'  , ''       , ''
-   sn_humi     = 'flx'        ,       -1          , 'socliohu' ,    .true.      , .true.  , 'yearly'  , ''       , ''
-   sn_ccov     = 'flx'        ,       -1          , 'socliocl' ,    .false.     , .true.  , 'yearly'  , ''       , ''
-   sn_prec     = 'flx'        ,       -1          , 'socliopl' ,    .false.     , .true.  , 'yearly'  , ''       , ''
-!
-   cn_dir      = './'      !  root directory for the location of the bulk files are
-/
-!-----------------------------------------------------------------------
-&namsbc_core   !   namsbc_core  CORE bulk formulea
-!-----------------------------------------------------------------------
-!              !   file name  ! frequency (hours) ! variable   ! time interpol. !  clim   ! 'yearly'/ ! weights              ! rotation !
-!              !              !  (if <0  months)  !   name     !    (logical)   !  (T/F)  ! 'monthly' ! filename             ! pairing  !
-   sn_wndi     = 'u10_core'   ,       -1          , 'u10'      ,    .true.      , .true.  , 'yearly'  ,'bicubic_weights_orca2.nc' , 'U1'
-   sn_wndj     = 'v10_core'   ,       -1          , 'v10'      ,    .true.      , .true.  , 'yearly'  ,'bicubic_weights_orca2.nc' , 'V1'
-   sn_qsr      = 'qsw_core'   ,       -1          , 'swdn'     ,    .true.      , .true.  , 'yearly'  ,'bilinear_weights_orca2.nc', ''
-   sn_qlw      = 'qlw_core'   ,       -1          , 'lwdn'     ,    .true.      , .true.  , 'yearly'  ,'bilinear_weights_orca2.nc', ''
-   sn_tair     = 't2_core'    ,       -1          , 't2'       ,    .true.      , .true.  , 'yearly'  ,'bilinear_weights_orca2.nc', ''
-   sn_humi     = 'q2_core'    ,       -1          , 'q2'       ,    .true.      , .true.  , 'yearly'  ,'bilinear_weights_orca2.nc', ''
-   sn_prec     = 'precip_core',       -1          , 'precip'   ,    .true.      , .true.  , 'yearly'  ,'bilinear_weights_orca2.nc', ''
-   sn_snow     = 'snow_core'  ,       -1          , 'snow'     ,    .true.      , .true.  , 'yearly'  ,'bilinear_weights_orca2.nc', ''
-   sn_tdif     = 'taudif_core',       24          , 'taudif'   ,    .true.      , .true.  , 'yearly'  ,'bilinear_weights_orca2.nc', ''
-!
-   cn_dir      = './'      !  root directory for the location of the bulk files
-   ln_2m       = .true.    !  air temperature and humidity referenced at 2m (T) instead 10m (F)
-   ln_taudif   = .false.   !  HF tau contribution: use "mean of stress module - module of the mean stress" data ?
-   rn_pfac     = 1.        !  multiplicative factor for precipitation (total & snow)
-/
-!-----------------------------------------------------------------------
-&namsbc_cpl    !   coupled ocean/atmosphere model                        ("key_coupled")
-!-----------------------------------------------------------------------
-                                       ! send
-cn_snd_temperature= 'weighted oce and ice'  ! 'oce only' 'weighted oce and ice' 'mixed oce-ice'
-cn_snd_albedo     = 'weighted ice'          ! 'none' 'weighted ice' 'mixed oce-ice'
-cn_snd_thickness  = 'none'                  ! 'none' 'weighted ice and snow'
-cn_snd_crt_nature = 'none'                  ! 'none' 'oce only' 'weighted oce and ice' 'mixed oce-ice'
-cn_snd_crt_refere = 'spherical'             ! 'spherical' 'cartesian'
-cn_snd_crt_orient = 'eastward-northward'    ! 'eastward-northward' or 'local grid'
-cn_snd_crt_grid   = 'T'                     ! 'T'
-                                       ! receive
-cn_rcv_w10m       = 'coupled'               ! 'none' 'coupled'
-cn_rcv_taumod     = 'coupled'               ! 'none' 'coupled'
-cn_rcv_tau_nature = 'oce only'              ! 'oce only' 'oce and ice' 'mixed oce-ice'
-cn_rcv_tau_refere = 'cartesian'             ! 'spherical' 'cartesian'
-cn_rcv_tau_orient = 'eastward-northward'    ! 'eastward-northward' or 'local grid'
-cn_rcv_tau_grid   = 'U,V'                   ! 'T' 'U,V' 'U,V,F' 'U,V,I' 'T,F' 'T,I' 'T,U,V'
-cn_rcv_dqnsdt     = 'coupled'               ! 'none' 'coupled'
-cn_rcv_qsr        = 'oce and ice'           ! 'conservative' 'oce and ice' 'mixed oce-ice'
-cn_rcv_qns        = 'oce and ice'           ! 'conservative' 'oce and ice' 'mixed oce-ice'
-cn_rcv_emp        = 'conservative'          ! 'conservative' 'oce and ice' 'mixed oce-ice'
-cn_rcv_rnf        = 'coupled'               ! 'coupled' 'climato' 'mixed'
-cn_rcv_cal        = 'coupled'               ! 'none' 'coupled'
-/
-!-----------------------------------------------------------------------
-&namsbc_cpl_co2   !   coupled ocean/biogeo/atmosphere model            ("key_cpl_carbon_cycle")
-!-----------------------------------------------------------------------
-cn_snd_co2        = 'coupled'         ! send    :  'none' 'coupled'
-cn_rcv_co2        = 'coupled'         ! receive : 'none' 'coupled'
-/
-!-----------------------------------------------------------------------
-&namtra_qsr    !   penetrative solar radiation
-!-----------------------------------------------------------------------
-!              !   file name  ! frequency (hours) ! variable   ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
-!              !              !  (if <0  months)  !   name     !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
-   sn_chl      = 'chlorophyll',        -1         , 'CHLA'     ,    .true.      , .true.  , 'yearly'  , ''       , ''
- 
-   cn_dir      = './'      !  root directory for the location of the runoff files
-   ln_traqsr   = .true.    !  Light penetration (T) or not (F)
-   ln_qsr_rgb  = .true.    !  RGB (Red-Green-Blue) light penetration
-   ln_qsr_2bd  = .false.   !  2 bands              light penetration
-   ln_qsr_bio  = .false.   !  bio-model light penetration
-   nn_chldta   =      0    !  RGB : Chl data (=1) or cst value (=0)
-   rn_abs      =   0.58    !  RGB & 2 bands: fraction of light (rn_si1)
-   rn_si0      =   0.35    !  RGB & 2 bands: shortess depth of extinction
-   rn_si1      =   23.0    !  2 bands: longest depth of extinction
-   rn_si2      =   62.0    !  3 bands: longest depth of extinction (for blue waveband & 0.01 mg/m2 Chl)
-/
-!-----------------------------------------------------------------------
-&namsbc_rnf    !   runoffs namelist surface boundary condition
-!-----------------------------------------------------------------------
-!              !   file name  ! frequency (hours) ! variable   ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
-!              !              !  (if <0  months)  !   name     !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
-   sn_rnf      = 'runoff_1m_nomask' ,  -1         , 'sorunoff' ,    .true.      , .true.  , 'yearly'  , ''       , ''
-   sn_cnf      = 'runoff_1m_nomask' ,   0         , 'socoefr'  ,    .false.     , .true.  , 'yearly'  , ''       , ''
- 
-   cn_dir       = './'      !  root directory for the location of the runoff files
-   ln_rnf_emp   =   .false. !  runoffs included into precipitation field (T) or into a file (F)
-   ln_rnf_mouth =   .false. !  specific treatment at rivers mouths
-   rn_hrnf      =  15.e0    !  depth over which enhanced vertical mixing is used
-   rn_avt_rnf   =   1.e-3   !  value of the additional vertical mixing coef. [m2/s]
-   rn_rfact     =   1.e0    !  multiplicative factor for runoff
-/
-!-----------------------------------------------------------------------
-&namsbc_ssr    !   surface boundary condition : sea surface restoring
-!-----------------------------------------------------------------------
-!              !   file name  ! frequency (hours) ! variable   ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
-!              !              !  (if <0  months)  !   name     !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
-   sn_sst      = 'sst_data'   ,        24         ,  'sst'     ,     .false.    , .false. , 'yearly'  , ''       , ''
-   sn_sss      = 'sss_data'   ,        -1         ,  'sss'     ,     .true.     , .true.  , 'yearly'  , ''       , ''
-    
-   cn_dir      = './'      !  root directory for the location of the runoff files
-   nn_sstr     =     0     !  add a retroaction term in the surface heat       flux (=1) or not (=0)
-   nn_sssr     =     2     !  add a damping     term in the surface freshwater flux (=2) 
-                           !  or to SSS only (=1) or no damping term (=0)
-   rn_dqdt     =   -40.    !  magnitude of the retroaction on temperature   [W/m2/K]
-   rn_deds     =   -27.7   !  magnitude of the damping on salinity   [mm/day]
-   ln_sssr_bnd =   .true.  !  flag to bound erp term (associated with nn_sssr=2)
-   rn_sssr_bnd =   4.e0    !  ABS(Max/Min) value of the damping erp term [mm/day]
-/      
-!-----------------------------------------------------------------------
-&namsbc_alb    !   albedo parameters
-!-----------------------------------------------------------------------
-   rn_cloud    =    0.06   !  cloud correction to snow and ice albedo 
-   rn_albice   =    0.53   !  albedo of melting ice in the arctic and antarctic
-   rn_alphd    =    0.80   !  coefficients for linear interpolation used to
-   rn_alphc    =    0.65   !  compute albedo between two extremes values 
-   rn_alphdi   =    0.72   !  (Pyane, 1972)
-/
-
-!!======================================================================
-!!               ***  Lateral boundary condition  ***
-!!======================================================================
-!!   namlbc        lateral momentum boundary condition
-!!   namcla        cross land advection
-!!   namobc        open boundaries parameters                           ("key_obc")
-!!   namagrif      agrif nested grid ( read by child model only )       ("key_agrif") 
-!!   nambdy        Unstructured open boundaries                         ("key_bdy")
-!!   namtide       Tidal forcing at open boundaries                     ("key_bdy_tides")
-!!======================================================================
-
-!-----------------------------------------------------------------------
-&namlbc        !   lateral momentum boundary condition
-!-----------------------------------------------------------------------
-   rn_shlat    =    2.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
-                           !  free slip  !   partial slip  !   no slip   ! strong slip
-/
-!-----------------------------------------------------------------------
-&namcla        !   cross land advection
-!-----------------------------------------------------------------------
-   nn_cla      =    0      !  advection between 2 ocean pts separates by land
-/
-!-----------------------------------------------------------------------
-&namobc        !   open boundaries parameters                           ("key_obc")
-!-----------------------------------------------------------------------
-    ln_obc_clim= .false.   !  climatological obc data files (T) or not (F)
-    ln_vol_cst = .true.    !  impose the total volume conservation (T) or not (F)
-    ln_obc_fla = .false.   !  Flather open boundary condition 
-    nn_obcdta  =    1      !  = 0 the obc data are equal to the initial state
-                           !  = 1 the obc data are read in 'obc.dta' files
-    cn_obcdta  = 'annual'  !  set to annual if obc datafile hold 1 year of data
-                           !  set to monthly if obc datafile hold 1 month of data
-    rn_dpein   =    1.     !  damping time scale for inflow at east  open boundary
-    rn_dpwin   =    1.     !     -           -         -       west    -      -
-    rn_dpnin   =    1.     !     -           -         -       north   -      -
-    rn_dpsin   =    1.     !     -           -         -       south   -      -
-    rn_dpeob   = 3000.     !  time relaxation (days) for the east  open boundary
-    rn_dpwob   =   15.     !     -           -         -     west    -      -
-    rn_dpnob   = 3000.     !     -           -         -     north   -      -
-    rn_dpsob   =   15.     !     -           -         -     south   -      -
-    rn_volemp  =  1.       !  = 0 the total volume change with the surface flux (E-P-R)
-                           !  = 1 the total volume remains constant
-/
-!-----------------------------------------------------------------------
-&namagrif      !  AGRIF zoom                                            ("key_agrif")
-!-----------------------------------------------------------------------
-    nn_cln_update = 3      !  baroclinic update frequency
-    ln_spc_dyn    = .true. !  use 0 as special value for dynamics
-    rn_sponge_tra = 2880.  !  coefficient for tracer   sponge layer [s]
-    rn_sponge_dyn = 2880.  !  coefficient for dynamics sponge layer [s]
-/
-!-----------------------------------------------------------------------
-&nambdy        !  unstructured open boundaries                          ("key_bdy")
-!-----------------------------------------------------------------------
-    filbdy_mask    =  ''                  !  name of mask file (if ln_bdy_mask=.TRUE.)
-    filbdy_data_T  = 'bdydata_grid_T.nc'  !  name of data file (T-points)
-    filbdy_data_U  = 'bdydata_grid_U.nc'  !  name of data file (U-points)
-    filbdy_data_V  = 'bdydata_grid_V.nc'  !  name of data file (V-points)
-    ln_bdy_clim    = .false.              !  contain 1 (T) or 12 (F) time dumps and be cyclic
-    ln_bdy_vol     = .true.               !  total volume correction (see volbdy parameter)
-    ln_bdy_mask    = .false.              !  boundary mask from filbdy_mask (T) or boundaries are on edges of domain (F)
-    ln_bdy_tides   = .true.               !  Apply tidal harmonic forcing with Flather condition
-    ln_bdy_dyn_fla = .true.               !  Apply Flather condition to velocities
-    ln_bdy_tra_frs = .false.              !  Apply FRS condition to temperature and salinity 
-    ln_bdy_dyn_frs = .false.              !  Apply FRS condition to velocities
-    nbdy_dta       =  1                   !  = 0, bdy data are equal to the initial state
-                                          !  = 1, bdy data are read in 'bdydata   .nc' files
-    nb_rimwidth    = 9                    !  width of the relaxation zone
-    volbdy         = 0                    !  = 0, the total water flux across open boundaries is zero
-                                          !  = 1, the total volume of the system is conserved
-/
-!-----------------------------------------------------------------------
-&nambdy_tide     ! tidal forcing at unstructured boundaries              
-!-----------------------------------------------------------------------
-    filtide      = 'bdytide_'           !  file name root of tidal forcing files
-    tide_cpt     = 'M2','S1'            !  names of tidal components used
-    tide_speed   = 28.984106, 15.000001 !  phase speeds of tidal components (deg/hour)
-    ln_tide_date = .false.              !  adjust tidal harmonics for start date of run
-/
-
-!!======================================================================
-!!                 ***  Bottom boundary condition  ***
-!!======================================================================
-!!   nambfr        bottom friction
-!!   nambbc        bottom temperature boundary condition                ("key_trabbc")
-!!   nambbl        bottom boundary layer scheme                         ("key_trabbl_dif","key_trabbl_adv")
-!!======================================================================
-
-!-----------------------------------------------------------------------
-&nambfr        !   bottom friction
-!-----------------------------------------------------------------------
-   nn_bfr      =    1      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
-                           !                              = 2 : nonlinear friction
-   rn_bfri1    =    4.e-4  !  bottom drag coefficient (linear case)
-   rn_bfri2    =    1.e-3  !  bottom drag coefficient (non linear case)
-   rn_bfeb2    =    2.5e-3 !  bottom turbulent kinetic energy background  (m^2/s^2)
-   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 = .true.)
-/
-!-----------------------------------------------------------------------
-&nambbc        !   bottom temperature boundary condition
-!-----------------------------------------------------------------------
-   nn_geoflx   =    2      !  geothermal heat flux: = 0 no flux 
-                           !     = 1 constant flux
-                           !     = 2 variable flux (read in geothermal_heating.nc in mW/m2) 
-   rn_geoflx_cst = 86.4e-3 !  Constant value of geothermal heat flux [W/m2]
-/
-!-----------------------------------------------------------------------
-&nambbl        !   bottom boundary layer scheme
-!-----------------------------------------------------------------------
-!                          !  diffusive bbl                             ("key_trabbl")
-!                          !  advective bbl                             ("key_trabbl_adv")
-   rn_ahtbbl   =  10000.   !  lateral mixing coefficient in the bbl  [m2/s]
-/
-!!======================================================================
-!!                        Tracer (T & S ) namelists
-!!======================================================================
-!!   nameos        equation of state
-!!   namtra_adv    advection scheme
-!!   namtra_ldf    lateral diffusion scheme
-!!   namtra_dmp    T & S newtonian damping                              ("key_tradmp")
-!!======================================================================
-
-!-----------------------------------------------------------------------
-&nameos        !   ocean physical parameters
-!-----------------------------------------------------------------------
-   nn_eos      =    0      !  type of equation of state and Brunt-Vaisala frequency
-                           !     = 0, UNESCO (formulation of Jackett and McDougall (1994) and of McDougall (1987) )
-                           !     = 1, linear: rho(T)   = rau0 * ( 1.028 - ralpha * T )
-                           !     = 2, linear: rho(T,S) = rau0 * ( rbeta * S - ralpha * T )
-   rn_alpha    =    2.e-4  !  thermal expension coefficient (neos= 1 or 2)
-   rn_beta     =    0.001  !  saline  expension coefficient (neos= 2)
-/
-!-----------------------------------------------------------------------
-&namtra_adv    !   advection scheme for tracer 
-!-----------------------------------------------------------------------
-   ln_traadv_cen2   =  .false.  !  2nd order centered scheme   
-   ln_traadv_tvd    =  .true.   !  TVD scheme                
-   ln_traadv_muscl  =  .false.  !  MUSCL scheme             
-   ln_traadv_muscl2 =  .false.  !  MUSCL2 scheme + cen2 at boundaries  
-   ln_traadv_ubs    =  .false.  !  UBS scheme                 
-/
-!-----------------------------------------------------------------------
-&namtra_ldf    !   lateral diffusion scheme for tracer 
-!-----------------------------------------------------------------------
-                           !  Type of the operator : 
-   ln_traldf_lap    =  .true.   !     laplacian operator       
-   ln_traldf_bilap  =  .false.  !     bilaplacian operator     
-                           !  Direction of action  :
-   ln_traldf_level  =  .false.  !     iso-level                
-   ln_traldf_hor    =  .false.  !     horizontal (geopotential)         (require "key_ldfslp" when ln_sco=T)
-   ln_traldf_iso    =  .true.   !     iso-neutral                       (require "key_ldfslp")
-                           !  Coefficient
-   rn_aht_0         =  2000.    !     horizontal eddy diffusivity for tracers [m2/s]
-   rn_ahtb_0        =     0.    !     background eddy diffusivity for ldf_iso [m2/s]
-   rn_aeiv_0        =  2000.    !     eddy induced velocity coefficient [m2/s]    (require "key_traldf_eiv")
-/
-!-----------------------------------------------------------------------
-&namtra_dmp    !   tracer: T & S newtonian damping                      ('key_tradmp')
-!-----------------------------------------------------------------------
-   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     =    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     =   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     =    1      !  create a damping.coeff NetCDF file (=1) or not (=0)
-/
-!!======================================================================
-!!                      ***  Dynamics namelists  ***
-!!======================================================================
-!!   namdyn_adv    formulation of the momentum advection
-!!   namdyn_vor    advection scheme
-!!   namdyn_hpg    hydrostatic pressure gradient
-!!   namdyn_spg    surface pressure gradient                            (CPP key only)
-!!   namdyn_ldf    lateral diffusion scheme
-!!======================================================================
-
-!-----------------------------------------------------------------------
-&namdyn_adv    !   formulation of the momentum advection
-!-----------------------------------------------------------------------
-   ln_dynadv_vec = .true.  !  vector form (T) or flux form (F)  
-   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme
-   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme 
-/  
-!-----------------------------------------------------------------------
-&namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
-!-----------------------------------------------------------------------
-   ln_dynvor_ene = .false. !  enstrophy conserving scheme  
-   ln_dynvor_ens = .false. !  energy conserving scheme    
-   ln_dynvor_mix = .false. !  mixed scheme               
-   ln_dynvor_een = .true.  !  energy & enstrophy scheme  
-/
-!-----------------------------------------------------------------------
-&namdyn_hpg    !   Hydrostatic pressure gradient option
-!-----------------------------------------------------------------------
-   ln_hpg_zco  = .false.   !  z-coordinate - full steps                   
-   ln_hpg_zps  = .true.    !  z-coordinate - partial steps (interpolation)
-   ln_hpg_sco  = .false.   !  s-coordinate (standard jacobian formulation)
-   ln_hpg_hel  = .false.   !  s-coordinate (helsinki modification)
-   ln_hpg_wdj  = .false.   !  s-coordinate (weighted density jacobian)
-   ln_hpg_djc  = .false.   !  s-coordinate (Density Jacobian with Cubic polynomial)
-   ln_hpg_rot  = .false.   !  s-coordinate (ROTated axes scheme)
-   rn_gamma    = 0.e0      !  weighting coefficient (wdj scheme)
-   ln_dynhpg_imp = .false. !  time stepping: semi-implicit time scheme  (T)
-                                 !           centered      time scheme  (F)
-/
-!-----------------------------------------------------------------------
-!namdyn_spg    !   surface pressure gradient   (CPP key only)
-!-----------------------------------------------------------------------
-!                          !  explicit free surface                     ("key_dynspg_exp")
-!                          !  filtered free surface                     ("key_dynspg_flt")
-!                          !  split-explicit free surface               ("key_dynspg_ts")
-
-!-----------------------------------------------------------------------
-&namdyn_ldf    !   lateral diffusion on momentum
-!-----------------------------------------------------------------------
-                           !  Type of the operator : 
-   ln_dynldf_lap    =  .true.   !  laplacian operator         
-   ln_dynldf_bilap  =  .false.  !  bilaplacian operator    
-                           !  Direction of action  : 
-   ln_dynldf_level  =  .false.  !  iso-level               
-   ln_dynldf_hor    =  .true.   !  horizontal (geopotential)            (require "key_ldfslp" in s-coord.)
-   ln_dynldf_iso    =  .false.  !  iso-neutral                          (require "key_ldfslp")
-                           !  Coefficient
-   rn_ahm_0    = 40000.         !  horizontal eddy viscosity   [m2/s]
-   rn_ahmb_0   =     0.         !  background eddy viscosity for ldf_iso [m2/s]
-/
-!!======================================================================
-!!             Tracers & Dynamics vertical physics namelists
-!!======================================================================
-!!       namzdf        vertical physics
-!!       namzdf_ric    richardson number dependent vertical mixing      ("key_zdfric"      )
-!!       namzdf_tke    TKE dependent vertical mixing                    ("key_zdftke"      )
-!!       namzdf_kpp    KPP dependent vertical mixing                    ("key_zdfkpp"      )
-!!       namzdf_ddm    double diffusive mixing parameterization         ("key_zdfddm"      )
-!!       namzdf_tmx    tidal mixing parameterization                    ("key_zdftmx"      )
-!!======================================================================
-
-!-----------------------------------------------------------------------
-&namzdf        !   vertical physics
-!-----------------------------------------------------------------------
-   rn_avm0     =   1.2e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
-   rn_avt0     =   1.2e-5  !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
-   nn_avb      =    0      !  profile for background avt & avm (=1) or not (=0)
-   nn_havtb    =    0      !  horizontal shape for avtb (=1) or not (=0)
-   ln_zdfevd   = .true.    !  enhanced vertical diffusion (evd) (T) or not (F)
-   nn_evdm     =    0      !  evd apply on tracer (=0) or on tracer and momentum (=1)
-   rn_avevd    =  100.     !  evd mixing coefficient [m2/s]
-   ln_zdfnpc   = .false.   !  Non-Penetrative algorithm (T) or not (F)
-   nn_npc      =    1            !  frequency of application of npc
-   nn_npcp     =  365            !  npc control print frequency
-   ln_zdfexp   = .false.   !  time-stepping: split-explicit (T) or implicit (F) time stepping
-   nn_zdfexp   =    3            !  number of sub-timestep for ln_zdfexp=T
-/
-!-----------------------------------------------------------------------
-&namzdf_ric    !   richardson number dependent vertical diffusion       ("key_zdfric" )
-!-----------------------------------------------------------------------
-   rn_avmri    = 100.e-4   !  maximum value of the vertical viscosity
-   rn_alp      =   5.      !  coefficient of the parameterization
-   nn_ric      =   2       !  coefficient of the parameterization
-/
-!-----------------------------------------------------------------------
-&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
-!-----------------------------------------------------------------------
-   rn_ediff    =   0.1     !  coef. for vertical eddy coef. (avt=rn_ediff*mxl*sqrt(e) )
-   rn_ediss    =   0.7     !  coef. of the Kolmogoroff dissipation
-   rn_ebb      =  60.      !  coef. of the surface input of tke
-   rn_emin     =   1.e-6   !  minimum value of tke [m2/s2]
-   rn_emin0    =   1.e-4   !  surface minimum value of tke [m2/s2]
-   rn_bshear   =   1.e-20  !  background shear (>0)
-   nn_mxl      =   2       !  mixing length: = 0 bounded by the distance to surface and bottom
-                           !                 = 1 bounded by the local vertical scale factor
-                           !                 = 2 first vertical derivative of mixing length bounded by 1
-                           !                 = 3 same criteria as case 2 but applied in a different way
-   nn_pdl      =   1       !  Prandtl number function of richarson number (=1, avt=pdl(Ri)*avm) or not (=0, avt=avm)
-   ln_mxl0     = .false.   !  mixing length scale surface value as function of wind stress (T) or not (F)
-   rn_lmin     =   0.001   !  interior buoyancy lenght scale minimum value
-   rn_lmin0    =   0.01    !  surface  buoyancy lenght scale minimum value
-   nn_etau     =   0       !  exponentially deceasing penetration of tke due to internal & intertial waves
-                           !        = 0 no penetration ( O(2 km) resolution)
-                           !        = 1 additional tke source (rn_efr * en)
-                           !        = 2 additional tke source (rn_efr * en) applied only at the base of the mixed layer
-                           !        = 3 additional tke source (HF contribution: mean of stress module - module of mean stress)
-   nn_htau     =   1       !  type of exponential decrease of tke penetration
-                           !        = 0  constant 10 m length scale
-                           !        = 1  0.5m at the equator to 30m at high latitudes
-                           !        = 2  30 meters constant depth penetration
-                           !  otion used only if nn_etau = 1 or 2: 
-   rn_efr      =   0.05    !     fraction of surface tke value which penetrates inside the ocean
-                           !  otion used only if nn_etau = 3:
-   rn_addhft   =  -1.e-3   !     add offset   applied to the "mean of stress module - module of mean stress" (always kept > 0)
-   rn_sclhft   =   1.      !     scale factor applied to the "mean of stress module - module of mean stress"
-   ln_lc       = .false.   !  Langmuir cell parameterisation
-   rn_lc       =   0.15    !  coef. associated to Langmuir cells
-/
-!------------------------------------------------------------------------
-&namzdf_kpp    !   K-Profile Parameterization dependent vertical mixing  ("key_zdfkpp", and optionnally:
-!------------------------------------------------------------------------ "key_kppcustom" or "key_kpplktb")
-   ln_kpprimix = .true.    !  shear instability mixing 
-   rn_difmiw   =  1.0e-04  !  constant internal wave viscosity [m2/s]
-   rn_difsiw   =  0.1e-04  !  constant internal wave diffusivity [m2/s]
-   rn_riinfty  =  0.8      !  local Richardson Number limit for shear instability
-   rn_difri    =  0.0050   !  maximum shear mixing at Rig = 0    [m2/s]
-   rn_bvsqcon  = -0.01e-07 !  Brunt-Vaisala squared for maximum convection [1/s2] 
-   rn_difcon   =  1.       !  maximum mixing in interior convection [m2/s] 
-   nn_avb      =  0        !  horizontal averaged (=1) or not (=0) on avt and amv
-   nn_ave      =  1        !  constant (=0) or profile (=1) background on avt
-/
-!-----------------------------------------------------------------------
-&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
-!-----------------------------------------------------------------------
-   rn_avts     = 1.e-4     !  maximum avs (vertical mixing on salinity)
-   rn_hsbfr    = 1.6       !  heat/salt buoyancy flux ratio
-/
-!-----------------------------------------------------------------------
-&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
-!-----------------------------------------------------------------------
-   rn_htmx     = 500.      !  vertical decay scale for turbulence (meters)
-   rn_n2min    = 1.e-8     !  threshold of the Brunt-Vaisala frequency (s-1)
-   rn_tfe      = 0.333     !  tidal dissipation efficiency
-   rn_me       = 0.2       !  mixing efficiency 
-   ln_tmx_itf  = .FALSE.   !  ITF specific parameterisation
-   rn_tfe_itf  = 1.        !  ITF tidal dissipation efficiency
-/
-!!======================================================================
-!!                  ***  Miscelaneous namelists  ***
-!!======================================================================
-!!   nammpp            Massively Parallel Processing                    ("key_mpp_mpi)
-!!   nammpp_dyndist    Massively Parallel domain decomposition          ("key_agrif" && "key_mpp_dyndist")
-!!   namctl            Control prints & Benchmark
-!!   namsol            elliptic solver / island / free surface 
-!!======================================================================
-
-!-----------------------------------------------------------------------
-&namsol        !   elliptic solver / island / free surface 
-!-----------------------------------------------------------------------
-   nn_solv     =      1    !  elliptic solver: =1 preconditioned conjugate gradient (pcg)
-                           !                   =2 successive-over-relaxation (sor)
-   nn_sol_arp  =      0    !  absolute/relative (0/1) precision convergence test
-   rn_eps      =  1.e-6    !  absolute precision of the solver
-   nn_nmin     =    300    !  minimum of iterations for the SOR solver
-   nn_nmax     =    800    !  maximum of iterations for the SOR solver
-   nn_nmod     =     10    !  frequency of test for the SOR solver
-   rn_resmax   =  1.e-10   !  absolute precision for the SOR solver
-   rn_sor      =  1.92     !  optimal coefficient for SOR solver (to be adjusted with the domain)
-/
-!-----------------------------------------------------------------------
-&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
-!-----------------------------------------------------------------------
-   cn_mpi_send =  'S'      !  mpi send/recieve type   ='S', 'B', or 'I' for standard send,
-                           !  buffer blocking send or immediate non-blocking sends, resp.
-   nn_buffer   =   0       !  size in bytes of exported buffer ('B' case), 0 no exportation
-/
-!-----------------------------------------------------------------------
-&nammpp_dyndist !   Massively Parallel Distribution for AGRIF zoom      ("key_agrif" && "key_mpp_dyndist")
-!-----------------------------------------------------------------------
-   jpni        =    1      !  jpni   number of processors following i
-   jpnj        =    1      !  jpnj   number of processors following j
-   jpnij       =    1      !  jpnij  number of local domains
-/
-!-----------------------------------------------------------------------
-&namctl        !   Control prints & Benchmark
-!-----------------------------------------------------------------------
-   ln_ctl      = .false.   !  trends control print (expensive!)
-   nn_print    =    0      !  level of print (0 no extra print)
-   nn_ictls    =    0      !  start i indice of control sum (use to compare mono versus
-   nn_ictle    =    0      !  end   i indice of control sum        multi processor runs
-   nn_jctls    =    0      !  start j indice of control               over a subdomain)
-   nn_jctle    =    0      !  end   j indice of control
-   nn_isplt    =    1      !  number of processors in i-direction
-   nn_jsplt    =    1      !  number of processors in j-direction
-   nn_bench    =    0      !  Bench mode (1/0): CAUTION use zero except for bench
-                           !     (no physical validity of the results)
-   nn_bit_cmp  =    0      !  bit comparison mode (1/0): CAUTION use zero except for test
-                           !     of comparison between single and multiple processor runs
-/
-
-!!======================================================================
-!!                       ***  Diagnostics namelists  ***
-!!======================================================================
-!!   namtrd       dynamics and/or tracer trends                         ("key_trddyn","key_trdtra","key_trdmld")
-!!   namgap       level mean model-data gap                             ("key_diagap")
-!!   namflo       float parameters                                      ("key_float")
-!!   namptr       Poleward Transport Diagnostics
-!!======================================================================
-
-!-----------------------------------------------------------------------
-&namtrd        !   diagnostics on dynamics and/or tracer trends         ("key_trddyn" and/or "key_trdtra")
-!              !       or mixed-layer trends or barotropic vorticity    ('key_trdmld' or  "key_trdvor")
-!-----------------------------------------------------------------------
-   nn_trd      = 365       !  time step frequency dynamics and tracers trends
-   nn_ctls     =   0       !  control surface type in mixed-layer trends (0,1 or n<jpk)
-   rn_ucf      =   1.      !  unit conversion factor (=1 -> /seconds ; =86400. -> /day)
-   cn_trdrst_in      = "restart_mld"   ! suffix of ocean restart name (input)
-   cn_trdrst_out     = "restart_mld"   ! suffix of ocean restart name (output)
-   ln_trdmld_restart = .false.         !  restart for ML diagnostics
-   ln_trdmld_instant = .false.         !  flag to diagnose trends of instantantaneous or mean ML T/S
-/
-!-----------------------------------------------------------------------
-&namgap       !   level mean model-data gap                             ('key_diagap')
-!-----------------------------------------------------------------------
-   nn_gap     =  15        !  time-step frequency of model-data gap computation
-   nn_prg     =  10        !  time-step frequency of gap print in model output
-/
-!-----------------------------------------------------------------------
-&namflo       !   float parameters                                      ("key_float")
-!-----------------------------------------------------------------------
-    ln_rstflo = .false.    !  float restart (T) or not (F)
-    nn_writefl=      75    !  frequency of writing in float output file 
-    nn_stockfl=    5475    !  frequency of creation of the float restart file 
-    ln_argo   = .false.    !  Argo type floats (stay at the surface each 10 days)
-    ln_flork4 = .false.    !  trajectories computed with a 4th order Runge-Kutta (T)
-                           !  or computed with Blanke' scheme (F)
-/
-!-----------------------------------------------------------------------
-&namptr       !   Poleward Transport Diagnostic
-!-----------------------------------------------------------------------
-   ln_diaptr  = .true.     !  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 
-   nf_ptr     =  1         !  Frequency of ptr computation [time step]
-   nf_ptr_wri =  15        !  Frequency of ptr outputs
-/
+link ../../ORCA2_LIM/EXP00/namelist
Index: trunk/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_ice_lim2
===================================================================
--- trunk/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_ice_lim2	(revision 2527)
+++ trunk/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_ice_lim2	(revision 2528)
@@ -1,134 +1,1 @@
-!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-!! NEMO/LIM2 :  1 - dynamics/advection/thermo          (namicerun)
-!! namelists    2 - ice intialisation                  (namiceini)
-!!              3 - ice dynamic                        (namicedyn)
-!!              5 - ice advection                      (namicetrp)
-!!              6 - thermodynamic                      (namicethd)
-!!              7 - ice salinity                       (namicesal)
-!!              8 - mechanical redistribution of ice   (namiceitdme)
-!!              3 - ice diagnostics                    (namicedia)
-!!              9 - ice outputs                        (namiceout)
-!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-
-!-----------------------------------------------------------------------
-&namicerun     !   Share parameters for dynamics/advection/thermo
-!-----------------------------------------------------------------------
-   cn_icerst_in  = "restart_ice_in"   !  suffix of ice restart name (input)
-   cn_icerst_out = "restart_ice"      !  suffix of ice restart name (output)
-   ln_limdyn   = .true.    !  ice dynamics (T) or thermodynamics only (F)
-   ln_limdmp   = .false.   !  restoring ice thickness and fraction leads (T) or not (F)
-   acrit       = 1.0e-06   , 1.0e-06   ! minimum fraction for leads in the Northern (Southern) Hemisphere
-   hsndif      =  0.0      !  computation of temperature in snow (=0.0) or not
-   hicdif      =  0.0      !  computation of temperature in ice  (=0.0) or not (=9999.0)
-/
-!-----------------------------------------------------------------------
-&namiceini     !   ice initialisation
-!-----------------------------------------------------------------------
-   ln_limini   = .false.   !  read the ice initial state in the file 'Ice_initialization.nc' (T) or not (F)
-   ttest       =  2.0      !  threshold water temperature for initial sea ice
-   hninn       =  0.5      !  initial snow thickness in the north
-   hginn       =  3.0      !  initial ice  thickness in the north
-   alinn       =  0.05     !  initial leads area     in the north
-   hnins       =  0.1      !  same  three parameter  in the south
-   hgins       =  1.0      !        "                 "     south   
-   alins       =  0.1      !        "                 "     south
-/
-!-----------------------------------------------------------------------
-&namicedyn     !   ice dynamic
-!-----------------------------------------------------------------------
-   epsd        =   1.0e-20 !  tolerance parameter
-   alpha       =   0.5     !  coefficient for semi-implicit coriolis
-   dm          =   0.6e+03 !  diffusion constant for dynamics
-   nbiter      =   1       !  number of sub-time steps for relaxation
-   nbitdr      = 100       !  maximum number of iterations for relaxation
-   om          =   0.5     !  relaxation constant 
-   resl        =   5.0e-05 !  maximum value for the residual of relaxation
-   cw          =   5.0e-03 !  drag coefficient for oceanic stress
-   angvg       =   0.0     !  turning angle for oceanic stress
-   pstar       =   1.0e+04 !  1st bulk-rheology parameter
-   c_rhg       =  20.0     !  2nd bulk-rhelogy parameter
-   etamn       =   0.0e+07 !  minimun value for viscosity
-   creepl      =   2.0e-08 !  creep limit
-   ecc         =   2.0     !  eccentricity of the elliptical yield curve
-   ahi0        = 350.e0    !  horizontal eddy diffusivity coefficient for sea-ice [m2/s]
-/
-!-----------------------------------------------------------------------
-&namicetrp     !   ice transport
-!-----------------------------------------------------------------------
-   bound       =   0.      !  boundary conditions (=0.0 no-slip, =1.0 free-slip)
-/
-!-----------------------------------------------------------------------
-&namicethd     !   ice thermodynamic
-!-----------------------------------------------------------------------
-!  hmelt       : maximum melting at the bottom
-!  hiccrit(1/2): ice thickness for lateral accretion in the Northern (Southern) Hemisphere
-!                caution 1.0, 1.0 best value to be used!!! (gilles G.)
-!  hicmin      : ice thickness corr. to max. energy stored in brine pocket
-!  hiclim      : minimum ice thickness
-!  amax        : maximum lead fraction
-!  swiqst      : energy stored in brine pocket (=1) or not (=0)	
-!  sbeta       : numerical caracteritic of the scheme for diffusion in ice
-!               Cranck-Nicholson (=0.5), implicit (=1), explicit (=0)
-!  parlat      : percentage of energy used for lateral ablation
-!  hakspl      : slope of distr. for Hakkinen-Mellor's lateral melting
-!  hibspl      : slope of distribution for Hibler's lateral melting
-!  exld        : exponent for leads-closure rate
-!  hakdif      : coefficient for diffusions of ice and snow
-!  thth         : threshold thickness for comp. of eq. thermal conductivity
-!  hnzst       : thickness of the surf. layer in temp. computation
-!  parsub      : switch for snow sublimation or not
-!  alphs       : coefficient for snow density when snow ice formation
-! 
-   hmelt       = -0.15     !  maximum melting at the bottom
-   hiccrit     = 0.3 , 0.3 !  ice thickness for lateral accretion in the Northern (Southern) Hemisphere
-   hicmin      = 0.2       !  ice thickness corr. to max. energy stored in brine pocket
-   hiclim      = 0.05      !  minimum ice thickness
-   amax        = 0.999     !  maximum lead fraction
-   swiqst      = 1.        !  energy stored in brine pocket (=1) or not (=0)	
-   sbeta       = 1.        !  numerical caracteritic of the scheme for diffusion in ice
-                           !        Cranck-Nicholson (=0.5), implicit (=1), explicit (=0)
-   parlat      = 0.0       !  percentage of energy used for lateral ablation
-   hakspl      = 0.5       !  slope of distr. for Hakkinen-Mellor's lateral melting
-   hibspl      = 0.5       !  slope of distribution for Hibler's lateral melting
-   exld        = 2.0       !  exponent for leads-closure rate
-   hakdif      = 1.0       !  coefficient for diffusions of ice and snow
-   thth        = 0.2       !  threshold thickness for comp. of eq. thermal conductivity
-   hnzst       = 0.1       !  thickness of the surf. layer in temp. computation
-   parsub      = 1.0       !  switch for snow sublimation or not
-   alphs       = 1.0       !  coefficient for snow density when snow ice formation
-/
-!-----------------------------------------------------------------------
-&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
-/
-!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
-&namiceout     !   parameters for outputs
-!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
-   noumef      =   19      !  number of fields
-!
-!           !         title of the field           !  name     !   units   !  save  ! multipl. ! additive !
-!           !                                      !           !           ! or not !  factor  !  factor  !
-   field_1  = 'Snow thickness                     ', 'isnowthi', 'm       ',    1   ,  1.0     ,    0.0
-   field_2  = 'Ice thickness                      ', 'iicethic', 'm       ',    1   ,  1.0     ,    0.0
-   field_3  = 'Ice produced                       ', 'iiceprod', 'm/kt    ',    1   ,  1.0     ,    0.0
-   field_4  = 'Ice concentration                  ', 'ileadfra', '%       ',    1   , -1.0     ,    1.0
-   field_5  = 'Ice temperature                    ', 'iicetemp', 'C       ',    1   ,  1.0     , -273.15
-   field_6  = 'Oceanic flux at the ice base       ', 'ioceflxb', 'w/m2    ',    1   ,  1.0     ,    0.0
-   field_7  = 'Ice velocity u                     ', 'iicevelu', 'm/s     ',    1   ,  1.0     ,    0.0
-   field_8  = 'Ice velocity v                     ', 'iicevelv', 'm/s     ',    1   ,  1.0     ,    0.0
-   field_9  = 'Sea surface temperature            ', 'isstempe', 'C       ',    1   ,  1.0     , -273.15
-   field_10 = 'Sea surface salinity               ', 'isssalin', 'PSU     ',    1   ,  1.0     ,    0.0
-   field_11 = 'Total flux at ocean surface        ', 'iocetflx', 'w/m2    ',    1   ,  1.0     ,    0.0
-   field_12 = 'Solar flux at ocean surface        ', 'iocesflx', 'w/m2    ',    1   ,  1.0     ,    0.0
-   field_13 = 'Non-solar flux at ocean surface    ', 'iocwnsfl', 'w/m2    ',    1   ,  1.0     ,    0.0
-   field_14 = 'Salt flux at ocean surface         ', 'iocesafl', 'kg/m2/kt',    1   ,  1.0     ,    0.0
-   field_15 = 'Wind stress u                      ', 'iocestru', 'Pa      ',    1   ,  1.0     ,    0.0
-   field_16 = 'Wind stress v                      ', 'iocestrv', 'Pa      ',    1   ,  1.0     ,    0.0 
-   field_17 = 'Solar flux at ice/ocean surface    ', 'iicesflx', 'w/m2    ',    1   ,  1.0     ,    0.0
-   field_18 = 'Non-solar flux at ice/ocean surface', 'iicenflx', 'w/m2    ',    1   ,  1.0     ,    0.0
-   field_19 = 'Snow precipitation                 ', 'isnowpre', 'kg/day  ',    1   ,  1.0     ,    0.0
-/      
+link ../../ORCA2_LIM/EXP00/namelist_ice_lim2
Index: trunk/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_ice_lim3
===================================================================
--- trunk/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_ice_lim3	(revision 2527)
+++ trunk/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_ice_lim3	(revision 2528)
@@ -1,193 +1,1 @@
-!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-!! 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)
-!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-
-!-----------------------------------------------------------------------
-&namicerun     !   Share parameters for dynamics/advection/thermo
-!-----------------------------------------------------------------------
-   cn_icerst_in  = "restart_ice_in"   !  suffix of ice restart name (input)
-   cn_icerst_out = "restart_ice"      !  suffix of ice restart name (output)
-   ln_limdyn   = .true.    !  ice dynamics (T) or thermodynamics only (F)
-   acrit       =  1.0e-02 , 1.0e-02  !  minimum fraction for leads in the Northern (Southern) Hemisphere
-   hsndif      =  0.0      !  computation of temperature in snow (=0.0) or not
-   hicdif      =  0.0      !  computation of temperature in ice  (=0.0) or not (=9999.0)
-   cai         =  1.40e-3  !  atmospheric drag over sea ice
-   cao         =  1.00e-3  !  atmospheric drag over ocean
-   ln_nicep    = .false.   !  Ice points output for debug (yes or no)
-/
-!-----------------------------------------------------------------------
-&namiceini     !   ice initialisation
-!-----------------------------------------------------------------------
-   ttest       =  2.0      !  threshold water temperature for initial sea ice
-   hninn       =  0.3      !  initial snow thickness in the north
-   hnins       =  0.1      !        "            "          south
-   hginn_u     =  3.50     !  initial undeformed ice thickness in the north
-   hgins_u     =  1.0      !        "            "              "     south
-   aginn_u     =  0.95     !  initial undeformed ice concentration in the north
-   agins_u     =  0.9      !        "            "              "         south
-   hginn_d     =  0.0      !  initial  deformed  ice thickness     in the north
-   hgins_d     =  0.0      !  
-   aginn_d     =  0.00     !  initial  deformed  ice concentration in the north
-   agins_d     =  0.00     !        "            "              "         south
-   sinn        =  6.301    !  initial salinity in the north
-   sins        =  6.301    !        "            "    south
-/
-!-----------------------------------------------------------------------
-&namicedyn     !   ice dynamic
-!-----------------------------------------------------------------------
-   epsd        =   1.0e-20 !  tolerance parameter
-   alpha       =   0.5     !  coefficient for semi-implicit coriolis
-   dm          =   0.6e+03 !  diffusion constant for dynamics
-   nbiter      =   1       !  number of sub-time steps for relaxation
-   nbitdr      = 500       !  maximum number of iterations for relaxation
-   om          =   0.5     !  relaxation constant 
-   resl        =   5.0e-05 !  maximum value for the residual of relaxation
-   cw          =   5.0e-03 !  drag coefficient for oceanic stress
-   angvg       =   0.0     !  turning angle for oceanic stress
-   pstar       =   4.0e+04 !  1st bulk-rheology parameter
-   c_rhg       =  20.0     !  2nd bulk-rhelogy parameter
-   etamn       =   0.0e+07 !  minimun value for viscosity
-   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        = 300       !  number of iterations for subcycling in EVP, SB, 400
-   telast      =9600.0     !  timescale for elastic waves, SB, 720.0
-   alphaevp    =   1.0     !  coefficient for the solution of internal ice stresses
-/
-!-----------------------------------------------------------------------
-&namicetrp     !   ice transport
-!-----------------------------------------------------------------------
-   bound       =   0.      !  boundary conditions (=0.0 no-slip, =1.0 free-slip)
-/
-!-----------------------------------------------------------------------
-&namicethd     !   ice thermodynamic
-!-----------------------------------------------------------------------
-   hmelt       = -0.15     !  maximum melting at the bottom
-   hiccrit     = 0.1 , 0.1 !  ice thickness for lateral accretion in the Northern (Southern) Hemisphere
-                           !         caution 1.0, 1.0 best value to be used!!! (gilles G.)  ????
-   fraz_swi    = 0.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
-   hicmin      = 0.2       !  ice thickness corr. to max. energy stored in brine pocket
-   hiclim      = 0.10      !  minimum ice thickness
-   amax        = 0.999     !  maximum lead fraction
-   sbeta       = 1.        !  numerical caracteritic of the scheme for diffusion in ice
-                           !        Cranck-Nicholson (=0.5), implicit (=1), explicit (=0)
-   parlat      = 0.0       !  percentage of energy used for lateral ablation
-   hakspl      = 0.25      !  slope of distr. for Hakkinen-Mellor's lateral melting
-   hibspl      = 0.5       !  slope of distribution for Hibler's lateral melting
-   exld        = 2.0       !  exponent for leads-closure rate
-   hakdif      = 1.0       !  coefficient for diffusions of ice and snow
-   thth        = 0.2       !  threshold thickness for comp. of eq. thermal conductivity
-   hnzst       = 0.1       !  thickness of the surf. layer in temp. computation
-   parsub      = 1.0       !  switch for snow sublimation or not
-   alphs       = 1.0       !  coefficient for snow density when snow ice formation
-   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)
-/
-!-----------------------------------------------------------------------
-&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
-/
-!-----------------------------------------------------------------------
-&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
-   raftswi          =   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)
-   sal_max_ridge    =  15.0  !  maximum ridged ice salinity
-   partfun_swi      =   1    !  participation function linear, TH75 (0) or exponential Letal07 (1)
-   transfun_swi     =   0    !  transfer function uniform of H80 (0) or exponential Letal07 (1)
-   brinstren_swi    =   0    !  (1) use brine volume to diminish ice strength
-/
-!-----------------------------------------------------------------------
-&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
-/
-!-----------------------------------------------------------------------
-&namiceout     !   parameters for outputs
-!-----------------------------------------------------------------------
-   noumef      =   37      !  number of fields
-   add_diag_swi=    1      !  1 -> diagnose distribution in thickness space
-                           !  0 -> only simple diagnostics
-!
-!           !         title of the field           !  name     !   units   !  save  ! multipl. ! additive !
-!           !                                      !           !           ! or not !  factor  !  factor  !
-   field_1  = 'Ice concentration                  ', 'iiceconc', '%       ',    1   ,  1.0     ,    0.0
-   field_2  = 'Ice thickness                      ', 'iicethic', 'm       ',    1   ,  1.0     ,    0.0
-   field_3  = 'Snow thickness                     ', 'isnowthi', 'm       ',    1   ,  1.0     ,    0.0
-   field_4  = 'Daily bottom thermo ice production ', 'iicebopr', 'cm/day  ',    1   , 100.     ,    0.0
-   field_5  = 'Daily dynamic ice production       ', 'iicedypr', 'cm/day  ',    1   , 100.     ,    0.0
-   field_6  = 'Oceanic flux at the ice base       ', 'ioceflxb', 'w/m2    ',    1   ,  1.0     ,    0.0
-   field_7  = 'Ice velocity u                     ', 'iicevelu', 'm/s     ',    1   ,  1.0     ,    0.0
-   field_8  = 'Ice velocity v                     ', 'iicevelv', 'm/s     ',    1   ,  1.0     ,    0.0
-   field_9  = 'Sea surface temperature            ', 'isstempe', 'C       ',    1   ,  1.0     , -273.15
-   field_10 = 'Sea surface salinity               ', 'isssalin', 'PSU     ',    1   ,  1.0     ,    0.0
-   field_11 = 'Total flux at ocean surface        ', 'iocetflx', 'w/m2    ',    1   ,  1.0     ,    0.0
-   field_12 = 'Solar flux at ocean surface        ', 'iocesflx', 'w/m2    ',    1   ,  1.0     ,    0.0
-   field_13 = 'Non-solar flux at ocean surface    ', 'iocwnsfl', 'w/m2    ',    1   ,  1.0     ,    0.0
-   field_14 = 'Heat flux due to brine release     ', 'iocehebr', 'w/m2    ',    1   ,  1.0     ,    0.0
-   field_15 = 'Wind stress u                      ', 'iocestru', 'Pa      ',    1   ,  1.0     ,    0.0
-   field_16 = 'Wind stress v                      ', 'iocestrv', 'Pa      ',    1   ,  1.0     ,    0.0 
-   field_17 = 'Solar flux at ice/ocean surface    ', 'iicesflx', 'w/m2    ',    1   ,  1.0     ,    0.0
-   field_18 = 'Non-solar flux at ice/ocean surface', 'iicenflx', 'w/m2    ',    1   ,  1.0     ,    0.0
-   field_19 = 'Snow precipitation                 ', 'isnowpre', 'kg/day  ',    1   ,  1.0     ,    0.0
-   field_20 = 'Mean ice salinity                  ', 'iicesali', 'psu     ',    1   ,  1.0     ,    0.0
-   field_21 = 'Mean ice age                       ', 'iiceages', 'years   ',    1   ,  0.002739,    0.0
-   field_22 = 'Daily lateral thermo ice prod.     ', 'iicelapr', 'cm/day  ',    1   ,100.      ,    0.0
-   field_23 = 'Daily snowice ice production       ', 'iicesipr', 'cm/day  ',    1   ,100.      ,    0.0
-   field_24 = 'Mean ice temperature               ', 'iicetemp', 'C       ',    1   ,  1.0     , -273.15
-   field_25 = 'Ice total heat content             ', 'iiceheco', '10^9 J  ',    1   ,  1.0     ,    0.0
-   field_26 = 'Ice surface temperature            ', 'iicesurt', 'C       ',    1   ,  1.0     , -273.15
-   field_27 = 'Snow temperature                   ', 'isnotem2', 'C       ',    1   ,  1.0     , -273.15
-   field_28 = 'Fsbri - brine salt flux            ', 'iicfsbri', 'kg/m2/s ',    1   ,  1.0     ,    0.0
-   field_29 = 'Fseqv - equivalent FW salt flux    ', 'iicfseqv', 'kg/m2/s ',    1   ,  1.0     ,    0.0
-   field_30 = 'Brine volume                       ', 'ibrinvol', '%       ',    1   ,  100.0   ,    0.0
-   field_31 = 'Frazil ice collection thickness    ', 'iicecolf', 'm       ',    1   ,  1.0     ,    0.0
-   field_32 = 'Ice strength                       ', 'iicestre', 'N/m     ',    1   ,  0.001   ,    0.0
-   field_33 = 'Ice velocity                       ', 'iicevelo', 'm/s     ',    1   ,  1.0     ,    0.0
-   field_34 = 'Surface melt                       ', 'iicesume', 'cm/day  ',    1   ,100.      ,    0.0
-   field_35 = 'Bottom melt                        ', 'iicebome', 'cm/day  ',    1   ,100.      ,    0.0
-   field_36 = 'Divergence                         ', 'iicedive', '10-8s-1 ',    1   ,  1.0e8   ,    0.0
-   field_37 = 'Shear                              ', 'iiceshea', '10-8s-1 ',    1   ,  1.0e8   ,    0.0
-/      
+link ../../ORCA2_LIM/EXP00/namelist_ice_lim3
Index: trunk/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_pisces
===================================================================
--- trunk/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_pisces	(revision 2527)
+++ trunk/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_pisces	(revision 2528)
@@ -41,5 +41,5 @@
    xksi2      =  3.33E-6  ! half saturation constant for Si/C
    xkdoc      =  417.E-6  ! half-saturation constant of DOC remineralization
-   caco3r     =  0.3      ! mean rain ratio
+   caco3r     =  0.15     ! mean rain ratio
 /
 !'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
@@ -115,5 +115,5 @@
 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
    ln_dustfer  =  .true.   ! boolean for dust input from the atmosphere
-   ln_river    =  .false.  ! boolean for river input of nutrients
+   ln_river    =  .true.  ! boolean for river input of nutrients
    ln_ndepo    =  .true.   ! boolean for atmospheric deposition of N
    ln_sedinput =  .true.   ! boolean for Fe input from sediments
Index: trunk/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_top
===================================================================
--- trunk/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_top	(revision 2527)
+++ trunk/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_top	(revision 2528)
@@ -1,70 +1,62 @@
 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-!! NEMO/TOP1 :  1 - tracer definition                     (namtoptrc)
-!! namelists    2 - dynamical tracer trends               (namtoptrd)
-!!              6 - tracer advection                      (namtopadv)
-!!              7 - tracer bottom boundary                (namtopbbl)
-!!              8 - tracer lateral diffusion              (namtopldf)
-!!              3 - tracer vertical physics               (namtopzdf)
-!!              9 - tracer newtonian damping              (namtopdmp)
+!! NEMO/TOP1 :  1 - tracer definition                     (namtrc    )
+!! namelists    2 - dynamical tracer trends               (namtrc_trd)
+!!              3 - tracer advection                      (namtrc_adv)
+!!              4 - tracer lateral diffusion              (namtrc_ldf)
+!!              5 - tracer vertical physics               (namtrc_zdf)
+!!              6 - tracer newtonian damping              (namtrc_dmp)
 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 !'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
-&namtoptrc     !   tracers definition
+&namtrc     !   tracers definition
 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
-   ndttrc      =  1        !  time step frequency for passive tracers      
-   nwritetrc   =  5475     !  time step frequency for tracer outputs
-   ln_rsttr    = .false.   !  start from a restart file (T) or not (F)
-   nrsttr      =   0       !  restart control = 0 initial time step is not compared to the restart file value
+   nn_dttrc      =  1        !  time step frequency for passive sn_tracers      
+   nn_writetrc   =  5475     !  time step frequency for sn_tracer outputs
+   ln_rsttr      = .false.   !  start from a restart file (T) or not (F)
+   nn_rsttr      =   0       !  restart control = 0 initial time step is not compared to the restart file value
                            !                  = 1 do not use the value in the restart file
                            !                  = 2 calendar parameters read in the restart file
-   cn_trcrst_in  = "restart_trc"   !  suffix of pass. tracer restart name (input)
-   cn_trcrst_out = "restart_trc"   !  suffix of pass. tracer restart name (output)
+   cn_trcrst_in  = "restart_trc"   !  suffix of pass. sn_tracer restart name (input)
+   cn_trcrst_out = "restart_trc"   !  suffix of pass. sn_tracer restart name (output)
 !
 !              !    name   !           title of the field              !   units    ! initial data ! save   !
 !              !           !                                           !            ! from file    ! or not ! 
 !              !           !                                           !            ! or not       !        !
-   tracer(1)   = 'DIC     ' , 'Dissolved inorganic Concentration      ',  'mol-C/L' ,  .true.     ,  .true.
-   tracer(2)   = 'Alkalini' , 'Total Alkalinity Concentration         ',  'eq/L '   ,  .true.     ,  .true.
-   tracer(3)   = 'O2      ' , 'Dissolved Oxygen Concentration         ',  'mol-C/L' ,  .true.     ,  .true.
-   tracer(4)   = 'CaCO3   ' , 'Calcite Concentration                  ',  'mol-C/L' ,  .false.    ,  .true.
-   tracer(5)   = 'PO4     ' , 'Phosphate Concentration                ',  'mol-C/L' ,  .true.     ,  .true.
-   tracer(6)   = 'POC     ' , 'Small organic carbon Concentration     ',  'mol-C/L' ,  .false.    ,  .true.
-   tracer(7)   = 'Si      ' , 'Silicate Concentration                 ',  'mol-C/L' ,  .true.     ,  .true.
-   tracer(8)   = 'PHY     ' , 'Nanophytoplankton Concentration        ',  'mol-C/L' ,  .false.    ,  .true.
-   tracer(9)   = 'ZOO     ' , 'Microzooplankton Concentration         ',  'mol-C/L' ,  .false.    ,  .true.
-   tracer(10)  = 'DOC     ' , 'Dissolved organic Concentration        ',  'mol-C/L' ,  .false.    ,  .true.
-   tracer(11)  = 'PHY2    ' , 'Diatoms Concentration                  ',  'mol-C/L' ,  .false.    ,  .true.
-   tracer(12)  = 'ZOO2    ' , 'Mesozooplankton Concentration          ',  'mol-C/L' ,  .false.    ,  .true.
-   tracer(13)  = 'BSi     ' , 'Diatoms Silicate Concentration         ',  'mol-C/L' ,  .false.    ,  .true.
-   tracer(14)  = 'Fer     ' , 'Dissolved Iron Concentration           ',  'mol-C/L' ,  .true.     ,  .true.
-   tracer(15)  = 'BFe     ' , 'Big iron particles Concentration       ',  'mol-C/L' ,  .false.    ,  .true.
-   tracer(16)  = 'GOC     ' , 'Big organic carbon Concentration       ',  'mol-C/L' ,  .false.    ,  .true.
-   tracer(17)  = 'SFe     ' , 'Small iron particles Concentration     ',  'mol-C/L' ,  .false.    ,  .true.
-   tracer(18)  = 'DFe     ' , 'Diatoms iron  Concentration            ',  'mol-C/L' ,  .false.    ,  .true.
-   tracer(19)  = 'DSi     ' , 'Sinking biogenic Silicate Concentration',  'mol-C/L' ,  .false.    ,  .true.
-   tracer(20)  = 'NFe     ' , 'Nano iron Concentration                ',  'mol-C/L' ,  .false.    ,  .true.
-   tracer(21)  = 'NCHL    ' , 'Nano chlorophyl Concentration          ',  'mol-C/L' ,  .false.    ,  .true.
-   tracer(22)  = 'DCHL    ' , 'Diatoms chlorophyl Concentration       ',  'mol-C/L' ,  .false.    ,  .true.
-   tracer(23)  = 'NO3     ' , 'Nitrates Concentration                 ',  'mol-C/L' ,  .true.     ,  .true.
-   tracer(24)  = 'NH4     ' , 'Ammonium Concentration                 ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(1)   = 'DIC     ' , 'Dissolved inorganic Concentration      ',  'mol-C/L' ,  .true.     ,  .true.
+   sn_tracer(2)   = 'Alkalini' , 'Total Alkalinity Concentration         ',  'eq/L '   ,  .true.     ,  .true.
+   sn_tracer(3)   = 'O2      ' , 'Dissolved Oxygen Concentration         ',  'mol-C/L' ,  .true.     ,  .true.
+   sn_tracer(4)   = 'CaCO3   ' , 'Calcite Concentration                  ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(5)   = 'PO4     ' , 'Phosphate Concentration                ',  'mol-C/L' ,  .true.     ,  .true.
+   sn_tracer(6)   = 'POC     ' , 'Small organic carbon Concentration     ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(7)   = 'Si      ' , 'Silicate Concentration                 ',  'mol-C/L' ,  .true.     ,  .true.
+   sn_tracer(8)   = 'PHY     ' , 'Nanophytoplankton Concentration        ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(9)   = 'ZOO     ' , 'Microzooplankton Concentration         ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(10)  = 'DOC     ' , 'Dissolved organic Concentration        ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(11)  = 'PHY2    ' , 'Diatoms Concentration                  ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(12)  = 'ZOO2    ' , 'Mesozooplankton Concentration          ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(13)  = 'BSi     ' , 'Diatoms Silicate Concentration         ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(14)  = 'Fer     ' , 'Dissolved Iron Concentration           ',  'mol-C/L' ,  .true.     ,  .true.
+   sn_tracer(15)  = 'BFe     ' , 'Big iron particles Concentration       ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(16)  = 'GOC     ' , 'Big organic carbon Concentration       ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(17)  = 'SFe     ' , 'Small iron particles Concentration     ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(18)  = 'DFe     ' , 'Diatoms iron  Concentration            ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(19)  = 'DSi     ' , 'Sinking biogenic Silicate Concentration',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(20)  = 'NFe     ' , 'Nano iron Concentration                ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(21)  = 'NCHL    ' , 'Nano chlorophyl Concentration          ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(22)  = 'DCHL    ' , 'Diatoms chlorophyl Concentration       ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(23)  = 'NO3     ' , 'Nitrates Concentration                 ',  'mol-C/L' ,  .true.     ,  .true.
+   sn_tracer(24)  = 'NH4     ' , 'Ammonium Concentration                 ',  'mol-C/L' ,  .false.    ,  .true.
 /
 !-----------------------------------------------------------------------
-&namtopadv    !   advection scheme for passive tracer 
+&namtrc_adv    !   advection scheme for passive tracer 
 !-----------------------------------------------------------------------
    ln_trcadv_cen2   =  .false.  !  2nd order centered scheme   
-   ln_trcadv_tvd    =  .false.  !  TVD scheme   
+   ln_trcadv_tvd    =  .false.  !  TVD scheme
    ln_trcadv_muscl  =  .true.   !  MUSCL scheme
    ln_trcadv_muscl2 =  .false.  !  MUSCL2 scheme + cen2 at boundaries
-   ln_trcadv_smolar =  .false.  !  SMOLAR scheme
-   rsc              =  1.       !  tuning coefficient for Smol-Car. scheme 
-   ncortrc          =  1        !  number of corrective phases for Smol-Car. scheme 
-   crosster         =  .false.  !  computes Smol-Car crossterms (T) or not (F)
+   ln_trcadv_ubs    =  .false.  !  UBS scheme
+   ln_trcadv_qck    =  .false.  !  QUICKEST scheme
 /
 !-----------------------------------------------------------------------
-&namtopbbl    !   bottom boundary layer scheme for passive tracer 
-!-----------------------------------------------------------------------
-   atrcbbl          = 1000.     !  lateral mixing coefficient in the bbl  [m2/s]
-/
-!-----------------------------------------------------------------------
-&namtopldf    !   lateral diffusion scheme for passive tracer 
+&namtrc_ldf    !   lateral diffusion scheme for passive tracer 
 !-----------------------------------------------------------------------
    ln_trcldf_diff   =  .true.   !  performs lateral diffusion (T) or not (F)
@@ -77,67 +69,63 @@
    ln_trcldf_iso    =  .true.   !     iso-neutral                       (require "key_ldfslp")
 !                               !  Coefficient
-   ahtrc0      =  2000.         !     horizontal eddy diffusivity for tracers [m2/s]
-   ahtrb0      =     0.         !     background eddy diffusivity for ldf_iso [m2/s]
-   aeivtr0     =  2000.         !     eddy induced velocity coefficient [m2/s]    (require "key_trcldf_eiv")
-   trcrat      =  1.            !  ratio betweeen passive and active tracer diffusion coeff
+   rn_ahtrb_0       =     0.    !     background eddy diffusivity for ldf_iso [m2/s]
 /
 !-----------------------------------------------------------------------
-&namtopzdf        !   vertical physics
+&namtrc_zdf        !   vertical physics
 !-----------------------------------------------------------------------
    ln_trczdf_exp   =  .false.  !  split explicit (T) or implicit (F) time stepping
-   n_trczdf_exp    =   3       !  number of sub-timestep for ln_trczdfexp=T
+   nn_trczdf_exp   =   3       !  number of sub-timestep for ln_trczdfexp=T
 /
 !-----------------------------------------------------------------------
-&namtoprad        !  treatment of negative concentrations 
+&namtrc_rad        !  treatment of negative concentrations 
 !-----------------------------------------------------------------------
    ln_trcrad   =  .true.  !  artificially correct negative concentrations (T) or not (F)
 /
 !-----------------------------------------------------------------------
-&namtopdmp        !   passive tracer newtonian damping                 ('key_trcdmp')
+&namtrc_dmp    !   passive tracer newtonian damping    ('key_tradmp && key_trcdmp')
 !-----------------------------------------------------------------------
-   ndmptr      =   20      !  type of damping in passive tracers
-                           !     ='latitude', damping poleward of 'ndmp' degrees and function 
-                           !                  of the distance-to-coast. Red and Med Seas as ndmptr=-1
-                           !     =-1 damping only in Med and Red Seas
-   ndmpftr     =    0      !  create a damping.coeff NetCDF file (=1) or not (=0)
-   nmldmptr    =    1      !  type of damping: =0 damping throughout the water column
-                           !                   =1 no damping in the mixed layer defined by avt >5cm2/s )
-                           !                   =2 no damping in the mixed layer defined rho<rho(surf)+.01 )
-   sdmptr      =   50.     !  surface time scale for internal damping (days)
-   bdmptr      =  360.     !  bottom  time scale for internal damping (days)
-   hdmptr      =  800.     !  depth of transition between sdmptr and bdmptr (meters)
+   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)
 /
 !-----------------------------------------------------------------------
-&namtoptrd       !   diagnostics on tracer trends
+&namtrc_trd       !   diagnostics on tracer trends        ('key_trdtrc')
 !                          or mixed-layer trends          ('key_trdmld_trc')
 !----------------------------------------------------------------------
-   ntrd_trc   =  5475      !  time step frequency and tracers trends
-   nctls_trc  =   0        !  control surface type in mixed-layer trends (0,1 or n<jpk)
-   ucf_trc    =   1        !  unit conversion factor (=1 -> /seconds ; =86400. -> /day)
+   nn_trd_trc  =  5475      !  time step frequency and tracers trends
+   nn_ctls_trc =   0        !  control surface type in mixed-layer trends (0,1 or n<jpk)
+   rn_ucf_trc  =   1        !  unit conversion factor (=1 -> /seconds ; =86400. -> /day)
    ln_trdmld_trc_restart = .false.  !  restart for ML diagnostics
    ln_trdmld_trc_instant = .true.  !  flag to diagnose trends of instantantaneous or mean ML T/S
-   luttrd(1)  =   .true.
-   luttrd(2)  =   .true.
-   luttrd(3)  =   .false.
-   luttrd(4)  =   .false.
-   luttrd(5)  =   .false.
-   luttrd(6)  =   .false.
-   luttrd(7)  =   .false.
-   luttrd(8)  =   .false.
-   luttrd(9)  =   .false.
-   luttrd(10) =   .false.
-   luttrd(11) =   .false.
-   luttrd(12) =   .false.
-   luttrd(13) =   .false.
-   luttrd(14) =   .false.
-   luttrd(15) =   .false.
-   luttrd(16) =   .false.
-   luttrd(17) =   .false.
-   luttrd(18) =   .false.
-   luttrd(19) =   .false.
-   luttrd(20) =   .false.
-   luttrd(21) =   .false.
-   luttrd(22) =   .false.
-   luttrd(23) =   .true.
-   luttrd(24) =   .false.
+   ln_trdtrc(1)  =   .true.
+   ln_trdtrc(2)  =   .true.
+   ln_trdtrc(3)  =   .false.
+   ln_trdtrc(4)  =   .false.
+   ln_trdtrc(5)  =   .false.
+   ln_trdtrc(6)  =   .false.
+   ln_trdtrc(7)  =   .false.
+   ln_trdtrc(8)  =   .false.
+   ln_trdtrc(9)  =   .false.
+   ln_trdtrc(10) =   .false.
+   ln_trdtrc(11) =   .false.
+   ln_trdtrc(12) =   .false.
+   ln_trdtrc(13) =   .false.
+   ln_trdtrc(14) =   .false.
+   ln_trdtrc(15) =   .false.
+   ln_trdtrc(16) =   .false.
+   ln_trdtrc(17) =   .false.
+   ln_trdtrc(18) =   .false.
+   ln_trdtrc(19) =   .false.
+   ln_trdtrc(20) =   .false.
+   ln_trdtrc(21) =   .false.
+   ln_trdtrc(22) =   .false.
+   ln_trdtrc(23) =   .true.
+   ln_trdtrc(24) =   .false.
 /
Index: trunk/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/xmlio_server.def
===================================================================
--- trunk/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/xmlio_server.def	(revision 2527)
+++ trunk/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/xmlio_server.def	(revision 2528)
@@ -17,4 +17,19 @@
   global_mpi_buffer_size = 512
 /  
+
+!!======================================================================
+!!   namnc4            netcdf4 chunking and compression settings
+!!======================================================================
+!-----------------------------------------------------------------------
+&namnc4         !  netcdf4 chunking and compression settings
+                !  (benign if "key_netcdf4" is not used)
+!-----------------------------------------------------------------------
+   nn_nchunks_i   =   4       !  number of chunks in i-dimension
+   nn_nchunks_j   =   4       !  number of chunks in j-dimension
+   nn_nchunks_k   =   31      !  number of chunks in k-dimension
+                              !  setting nn_nchunks_k = jpk will give a chunk size of 1 in the vertical which
+                              !  is optimal for postprocessing which works exclusively with horizontal slabs
+   ln_nc4zip      =   .TRUE.  !  (T) use netcdf4 chunking and compression
+                              !  (F) ignore chunking information and produce netcdf3-compatible files  
+/
   
-  
Index: trunk/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/cpp_ORCA2_LIM_PISCES.fcm
===================================================================
--- trunk/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/cpp_ORCA2_LIM_PISCES.fcm	(revision 2528)
+++ trunk/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/cpp_ORCA2_LIM_PISCES.fcm	(revision 2528)
@@ -0,0 +1,1 @@
+bld::tool::fppkeys key_trabbl key_vectopt_loop key_orca_r2 key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_dtatem key_dtasal key_tradmp key_zdftke key_zdfddm key_top key_pisces key_dtatrc key_diatrc key_iomput key_nproci=1 key_nprocj=1
Index: trunk/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/AA_make
===================================================================
--- trunk/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/AA_make	(revision 2527)
+++ 	(revision )
@@ -1,13 +1,0 @@
-# $Header$
-all: ioipsl opa
-
-ioipsl:
-	(cd ../../modeles/IOIPSL/src; $(M_K) ;)
-
-
-opa:
-	(cd ../../modeles/NEMO/WORK;  $(M_K) ;)
-
-
-clean:
-	(cd ../../modeles/NEMO/WORK;  $(M_K) clean ;)
Index: trunk/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/AA_make.ldef
===================================================================
--- trunk/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/AA_make.ldef	(revision 2527)
+++ 	(revision )
@@ -1,11 +1,0 @@
-#---------------------------------------------------------------------
-#- Creation des elements relatifs a ORCA :
-#-      ORCA  (lib, executable : opa)
-#---------------------------------------------------------------------
-SHELL = /bin/sh
-#---------------------------------------------------------------------
-LIBDIR = ../../../../lib
-BINDIR = ../../../../bin
-MODDIR = $(LIBDIR)
-#---------------------------------------------------------------------
-#-
Index: trunk/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/AA_job
===================================================================
--- trunk/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/AA_job	(revision 2527)
+++ trunk/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/AA_job	(revision 2528)
@@ -113,6 +113,4 @@
 cp ${R_EXPER}/namelist_pisces     namelist_pisces
 cp ${R_EXPER}/kRGB61.txt          kRGB61.txt
-cp ${R_EXPER}/iodef.xml .
-cp ${R_EXPER}/xmlio_server.def .
 
 ls -alF
@@ -122,5 +120,4 @@
 Rapatrie ${R_TMP} INPUTS_DYNA_v3.tar
 Rapatrie ${R_TMP} INPUTS_PISCES_v3.tar
-\mv NEMOV3_mesh_mask.nc mesh_mask.nc
 
 ls -alF
Index: trunk/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/iodef.xml
===================================================================
--- trunk/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/iodef.xml	(revision 2527)
+++ trunk/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/iodef.xml	(revision 2528)
@@ -16,62 +16,62 @@
  
       <!-- ptrc on T grid -->
-          
-     <group id="ptrc_T" axis_ref="deptht" grid_ref="grid_T">  
-       <field id="DIC"      description="Dissolved inorganic Concentration"        unit="mol-C/L" />
+ 
+     <group id="ptrc_T" axis_ref="deptht" grid_ref="grid_T">
+       <field id="DIC"      description="Dissolved inorganic Concentration"        unit="molC/L" />
        <field id="Alkalini" description="Total Alkalinity Concentration"           unit="eq/L"    />
-       <field id="O2"       description="Oxygen Concentration"                     unit="mol-C/L" />
-       <field id="CaCO3"    description="Calcite Concentration"                    unit="mol-C/L" />
-       <field id="PO4"      description="Phosphate Concentration"                  unit="mol-C/L" />
-       <field id="POC"      description="Small organic carbon Concentration"       unit="mol-C/L" />
-       <field id="Si"       description="Silicate Concentration"                   unit="mol-C/L" />
-       <field id="PHY"      description="Nanophytoplankton Concentration"          unit="mol-C/L" />
-       <field id="ZOO"      description="Microzooplankton Concentration"           unit="mol-C/L" />
-       <field id="DOC"      description="Dissolved organic Concentration"          unit="mol-C/L" />
-       <field id="PHY2"     description="Diatoms Concentration"                    unit="mol-C/L" />
-       <field id="ZOO2"     description="Mesozooplankton Concentration"            unit="mol-C/L" />
-       <field id="BSi"      description="Diatoms Silicate Concentration"           unit="mol-C/L" />
-       <field id="Fer"      description="Dissolved Iron Concentration"             unit="mol-C/L" />
-       <field id="BFe"      description="Big iron particles Concentration"         unit="mol-C/L" />
-       <field id="GOC"      description="Big organic carbon Concentration"         unit="mol-C/L" />
-       <field id="SFe"      description="Small iron particles Concentration"       unit="mol-C/L" />
-       <field id="DFe"      description="Diatoms iron  Concentration"              unit="mol-C/L" />
-       <field id="DSi"      description="Sinking biogenic Silicate Concentration"  unit="mol-C/L" />
-       <field id="NFe"      description="Nano iron Concentration"                  unit="mol-C/L" />
-       <field id="NCHL"     description="Nano chlorophyl Concentration"            unit="mol-C/L" />
-       <field id="DCHL"     description="Diatoms chlorophyl Concentration"         unit="mol-C/L" />
-       <field id="NO3"      description="Nitrates Concentration"                   unit="mol-C/L" />
-       <field id="NH4"      description="Ammonium Concentration"                   unit="mol-C/L" />
+       <field id="O2"       description="Oxygen Concentration"                     unit="molO2/L" />
+       <field id="CaCO3"    description="Calcite Concentration"                    unit="molC/L" />
+       <field id="PO4"      description="Phosphate Concentration"                  unit="molC/L" />
+       <field id="POC"      description="Small organic carbon Concentration"       unit="molC/L" />
+       <field id="Si"       description="Silicate Concentration"                   unit="molSi/L" />
+       <field id="PHY"      description="Nanophytoplankton Concentration"          unit="molC/L" />
+       <field id="ZOO"      description="Microzooplankton Concentration"           unit="molC/L" />
+       <field id="DOC"      description="Dissolved organic Concentration"          unit="molC/L" />
+       <field id="PHY2"     description="Diatoms Concentration"                    unit="molC/L" />
+       <field id="ZOO2"     description="Mesozooplankton Concentration"            unit="molC/L" />
+       <field id="BSi"      description="Diatoms Silicate Concentration"           unit="molC/L" />
+       <field id="Fer"      description="Dissolved Iron Concentration"             unit="molFe/L" />
+       <field id="BFe"      description="Big iron particles Concentration"         unit="molFe/L" />
+       <field id="GOC"      description="Big organic carbon Concentration"         unit="molC/L" />
+       <field id="SFe"      description="Small iron particles Concentration"       unit="molFe/L" />
+       <field id="DFe"      description="Diatoms iron  Concentration"              unit="molFe/L" />
+       <field id="DSi"      description="Sinking biogenic Silicate Concentration"  unit="molC/L" />
+       <field id="NFe"      description="Nano iron Concentration"                  unit="molC/L" />
+       <field id="NCHL"     description="Nano chlorophyl Concentration"            unit="gChl/L" />
+       <field id="DCHL"     description="Diatoms chlorophyl Concentration"         unit="gChl/L" />
+       <field id="NO3"      description="Nitrates Concentration"                   unit="molC/L" />
+       <field id="NH4"      description="Ammonium Concentration"                   unit="molC/L" />
      </group>
 
-      <!-- diad on T grid -->
+      <!-- diad on T grid : variables available with key_diatrc -->
 
      <group id="diad_T" axis_ref="none" grid_ref="grid_T">
-       <field id="PH"          description="PH"                                       unit="-"            axis_ref="deptht" />
-       <field id="CO3"         description="Bicarbonates"                             unit="mol/L"        axis_ref="deptht" />
-       <field id="CO3sat"      description="CO3 saturation"                           unit="mol/L"        axis_ref="deptht" />
-       <field id="PAR"         description="Photosynthetically Available Radiation"   unit="W/m2"         axis_ref="deptht" />
-       <field id="PPPHY"       description="Primary production of nanophyto"          unit="mol-C/m3/s"   axis_ref="deptht" />
-       <field id="PPPHY2"      description="Primary production of diatoms"            unit="mol-C/m3/s"   axis_ref="deptht" />
-       <field id="PPNEWN"      description="New Primary production of nanophyto"      unit="mol-C/m3/s"   axis_ref="deptht" />
-       <field id="PPNEWD"      description="New Primary production of diatoms"        unit="mol-C/m3/s"   axis_ref="deptht" />
-       <field id="PBSi"        description="Primary production of Si diatoms"         unit="mol-Si/m3/s"  axis_ref="deptht" />
-       <field id="PFeN"        description="Primary production of nano iron"          unit="mol-Fe/m3/s"  axis_ref="deptht" />
-       <field id="PFeD"        description="Primary production of diatoms iron"       unit="mol-Fe/m3/s"  axis_ref="deptht" />
-       <field id="PCAL"        description="Calcite production"                       unit="mol-C/m3/s"   axis_ref="deptht" />
-       <field id="DCAL"        description="Calcite dissolution"                      unit="mol-C/m3/s"   axis_ref="deptht" />
-       <field id="GRAZ"        description="Grazing by zooplankton"                   unit="mol-C/m3/s"   axis_ref="deptht" />
-       <field id="Nfix"        description="Nitrogen fixation at surface"             unit="mol-N/m2/s"      />
-       <field id="EPC100"      description="Export of carbon particles at 100 m"      unit="mol-C/m2/s"      />
-       <field id="EPFE100"     description="Export of biogenic iron at 100 m"         unit="mol-Fe/m2/s"     />
-       <field id="EPSI100"     description="Export of Silicate at 100 m"              unit="mol-Si/m2/s"     />
-       <field id="EPCAL100"    description="Export of Calcite at 100 m"               unit="mol-C/m2/s"      />
-       <field id="Cflx"        description="DIC flux"                                 unit="mol-C/m2/s" />
-       <field id="Oflx"        description="Oxygen flux"                              unit="mol-C/m2/s" />
-       <field id="Kg"          description="Gas transfer"                             unit="mol-C/m2/s/uatm" />
-       <field id="Dpco2"       description="Delta CO2"                                unit="uatm" />
-       <field id="Dpo2"        description="Delta O2"                                 unit="uatm" />
-       <field id="Heup"        description="Euphotic layer depth"                     unit="m" />
-       <field id="Irondep"     description="Iron deposition"                          unit="mol-Fe/m2/s" />
-     </group>
+       <field id="PH"          description="PH"                                       unit="-"           axis_ref="deptht" />
+       <field id="CO3"         description="Bicarbonates"                             unit="mol/L"       axis_ref="deptht" />
+       <field id="CO3sat"      description="CO3 saturation"                           unit="mol/L"       axis_ref="deptht" />
+       <field id="PAR"         description="Photosynthetically Available Radiation"   unit="W/m2"        axis_ref="deptht" />
+       <field id="PPPHY"       description="Primary production of nanophyto"          unit="molC/m3/s"   axis_ref="deptht" />
+       <field id="PPPHY2"      description="Primary production of diatoms"            unit="molC/m3/s"   axis_ref="deptht" />
+       <field id="PPNEWN"      description="New Primary production of nanophyto"      unit="molC/m3/s"   axis_ref="deptht" />
+       <field id="PPNEWD"      description="New Primary production of diatoms"        unit="molC/m3/s"   axis_ref="deptht" />
+       <field id="PBSi"        description="Primary production of Si diatoms"         unit="molSi/m3/s"  axis_ref="deptht" />
+       <field id="PFeN"        description="Primary production of nano iron"          unit="molFe/m3/s"  axis_ref="deptht" />
+       <field id="PFeD"        description="Primary production of diatoms iron"       unit="molFe/m3/s"  axis_ref="deptht" />
+       <field id="PCAL"        description="Calcite production"                       unit="molC/m3/s"   axis_ref="deptht" />
+       <field id="DCAL"        description="Calcite dissolution"                      unit="molC/m3/s"   axis_ref="deptht" />
+       <field id="GRAZ"        description="Grazing by zooplankton"                   unit="molC/m3/s"   axis_ref="deptht" />
+       <field id="Nfix"        description="Nitrogen fixation at surface"             unit="molN/m2/s"      />
+       <field id="EPC100"      description="Export of carbon particles at 100 m"      unit="molC/m2/s"      />
+       <field id="EPFE100"     description="Export of biogenic iron at 100 m"         unit="molFe/m2/s"     />
+       <field id="EPSI100"     description="Export of Silicate at 100 m"              unit="molSi/m2/s"     />
+       <field id="EPCAL100"    description="Export of Calcite at 100 m"               unit="molC/m2/s"      />
+       <field id="Cflx"        description="DIC flux"                                 unit="molC/m2/s"      />
+       <field id="Oflx"        description="Oxygen flux"                              unit="molC/m2/s"      />
+       <field id="Kg"          description="Gas transfer"                             unit="molC/m2/s/uatm" />
+       <field id="Dpco2"       description="Delta CO2"                                unit="uatm"            />
+       <field id="Dpo2"        description="Delta O2"                                 unit="uatm"            />
+       <field id="Heup"        description="Euphotic layer depth"                     unit="m"               />
+       <field id="Irondep"     description="Iron deposition"                          unit="molFe/m2/s"     />
+     </group>         
 
       <!-- scalar -->
Index: trunk/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist
===================================================================
--- trunk/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist	(revision 2527)
+++ trunk/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist	(revision 2528)
@@ -1,56 +1,60 @@
 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 !! NEMO/OPA  :  1 - run manager      (namrun)
-!! namelists    2 - miscellaneous    (namctl,nammpp)
-!!              3 - Domain           (namzgr, namzgr_sco, namdom)
-!!              6 - Tracer           (nameos, namcla, namqsr)
-!!              7 - Inputs dynamics  (namdyna)
+!! namelists    2 - Domain           (namzgr, namzgr_sco, namdom, namdta_tem, namdta_sal)
+!!              3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core
+!!                                    namsbc_cpl, namsbc_cpl_co2 namtra_qsr, namsbc_rnf, 
+!!                                    namsbc_apr, namsbc_ssr, namsbc_alb)
+!!              4 - lateral boundary (namlbc, namcla, namobc, namagrif, nambdy, nambdy_tide)
+!!              5 - bottom  boundary (nambfr, nambbc, nambbl)
+!!              6 - Tracer           (nameos, namtra_adv, namtra_ldf, namtra_dmp)
+!!              7 - dynamics         (namdyn_adv, namdyn_vor, namdyn_hpg, namdyn_spg, namdyn_ldf)
+!!              8 - Verical physics  (namzdf, namzdf_ric, namzdf_tke, namzdf_kpp, namzdf_ddm, namzdf_tmx)
+!!              9 - diagnostics      (namnc4, namtrd, namspr, namflo, namptr, namhsb)
+!!             10 - miscellaneous    (namsol, nammpp, nammpp_dyndist, namctl)
+!!             11 - Obs & Assim      (namobs, nam_asminc)
 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-!  CAUTION: some scripts does not support CAPITALs for logical use .true./.false., not .TRUE./.FALSE.
 
 !!======================================================================
 !!                   ***  Run management namelists  ***
 !!======================================================================
-!!   namrun            parameters of the run
-!!======================================================================
-
+!!   namrun        parameters of the run
+!!======================================================================
+!
 !-----------------------------------------------------------------------
 &namrun        !   parameters of the run
 !-----------------------------------------------------------------------
-   no          =       0   !  job number
-   cexper      =  "PISCES"  !  experience name 
+   nn_no       =       0   !  job number
+   cn_exp      =  "ORCA2P"  !  experience name 
+   nn_it000    =       1   !  first time step
+   nn_itend    =    1460   !  last  time step (std 5475)
+   nn_date0    =  010101   !  initial calendar date yymmdd (used if nrstdt=1)
+   nn_leapy    =       0   !  Leap year calendar (1) or not (0)
+   nn_istate   =       0   !  output the initial state (1) or not (0)
+   nn_stock    =    1460   !  frequency of creation of a restart file (modulo referenced to 1)
+   nn_write    =    1460   !  frequency of write in the output file   (modulo referenced to nit000)
+   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
+   nn_chunksz  =       0   !  chunksize (bytes) for NetCDF file (working only with iom_nf90 routines)
    ln_rstart   = .false.   !  start from rest (F) or from a restart file (T)
-   nrstdt      =       0   !  restart control = 0 nit000 is not compared to the restart file value
-                           !                  = 1 use ndate0 in namelist (not the value in the restart file)
-                           !                  = 2 calendar parameters read in the restart file
-   nit000      =       1   !  first time step
-   nitend      =     1460  !  last  time step
-   ndate0      =  010101   !  initial calendar date yymmdd (used if nrstdt=1)
-   nleapy      =       0   !  Leap year calendar (1) or not (0)
-   ninist      =       0   !  output the initial state (1) or not (0)
-   nstock      =     1460  !  frequency of creation of a restart file (modulo referenced to 1)
-   nwrite      =     1460  !  frequency of write in the output file   (modulo referenced to nit000)
-   ln_mskland  = .false.   !  mask land points in NetCDF outputs (costly: + ~15%)
-/
-!-----------------------------------------------------------------------
-&namctl       !   Control prints & Benchmark
-!-----------------------------------------------------------------------
-   ln_ctl     = .false.    !  trends control print (expensive!)
-   nprint     =    0       !  level of print (0 no extra print)
-   nictls     =    1       !  start i indice of control sum (use to compare mono versus
-   nictle     =    182       !  end   i indice of control sum        multi processor runs
-   njctls     =    1       !  start j indice of control               over a subdomain)
-   njctle     =    149       !  end   j indice of control 
-   isplt      =    1       !  number of processors in i-direction
-   jsplt      =    1       !  number of processors in j-direction
-   nbench     =    0       !  Bench mode (1/0): CAUTION use zero except for bench
-/
-!-----------------------------------------------------------------------
-&nammpp      !   Massively Parallel Processing                         ("key_mpp_mpi)
-!-----------------------------------------------------------------------
-   c_mpi_send =  'S'       !  mpi send/recieve type   ='S', 'B', or 'I' for standard send,
-                           !  buffer blocking send or immediate non-blocking sends, resp.
-/
-!-----------------------------------------------------------------------
-&namzgr       !   vertical coordinate
+   nn_rstctl   =       0       !  restart control = 0 nit000 is not compared to the restart file value
+                               !                  = 1 use ndate0 in namelist (not the value in the restart file)
+                               !                  = 2 calendar parameters read in the restart file
+   cn_ocerst_in  = "restart"   !  suffix of ocean restart name (input)
+   cn_ocerst_out = "restart"   !  suffix of ocean restart name (output)
+/
+
+!!======================================================================
+!!                      ***  Domain namelists  ***
+!!======================================================================
+!!   namzgr       vertical coordinate
+!!   namzgr_sco   s-coordinate or hybrid z-s-coordinate
+!!   namdom       space and time domain (bathymetry, mesh, timestep)
+!!   namdta_tem   data: temperature                                     ("key_dtatem")
+!!   namdta_sal   data: salinity                                        ("key_dtasal")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namzgr        !   vertical coordinate
 !-----------------------------------------------------------------------
    ln_zco      = .false.   !  z-coordinate - full    steps   (T/F)      ("key_zco" may also be defined)
@@ -59,77 +63,822 @@
 /
 !-----------------------------------------------------------------------
-&namzgr_sco   !   s-coordinate or hybrid z-s-coordinate
-!-----------------------------------------------------------------------
-   sbot_min    =  300.     !  minimum depth of s-bottom surface (>0) (m)
-   sbot_max    = 5250.     !  maximum depth of s-bottom surface (= ocean depth) (>0) (m)
-   theta       =    6.0    !  surface control parameter (0<=theta<=20)
-   thetb       =    0.75   !  bottom control parameter  (0<=thetb<= 1)
-   r_max       =    0.15   !  maximum cut-off r-value allowed (0<r_max<1)
+&namzgr_sco    !   s-coordinate or hybrid z-s-coordinate
+!-----------------------------------------------------------------------
+   rn_sbot_min =  300.     !  minimum depth of s-bottom surface (>0) (m)
+   rn_sbot_max = 5250.     !  maximum depth of s-bottom surface (= ocean depth) (>0) (m)
+   rn_theta    =    6.0    !  surface control parameter (0<=theta<=20)
+   rn_thetb    =    0.75   !  bottom control parameter  (0<=thetb<= 1)
+   rn_rmax     =    0.15   !  maximum cut-off r-value allowed (0<r_max<1)
+   ln_s_sigma  = .false.   !  hybrid s-sigma coordinates
+   rn_bb       =    0.8    !  stretching with s-sigma
+   rn_hc       =  150.0    !  critical depth with s-sigma 
 /
 !-----------------------------------------------------------------------
 &namdom        !   space and time domain (bathymetry, mesh, timestep)
 !-----------------------------------------------------------------------
-   e3zps_min   =    25.    !  the thickness of the partial step is set larger than the minimum
-   e3zps_rat   =    0.2    !  of e3zps_min and e3zps_rat * e3t   (N.B. 0<e3zps_rat<1)
-   nmsh        =    1      !  create (=1) a mesh file (coordinates, scale factors, masks) or not (=0)
-   nacc        =    0      !  =1 acceleration of convergence method used, rdt < rdttra(k)
-                           !  =0, no acceleration, rdt = rdttra
-   atfp        =    0.1    !  asselin time filter parameter
-   rdt         = 21600.    !  time step for the dynamics (and tracer if nacc=0)
-   rdtmin      = 21600.    !  minimum time step on tracers (used if nacc=1)
-   rdtmax      = 21600.    !  maximum time step on tracers (used if nacc=1)
-   rdth        =  800.     !  depth variation of tracer time step  (used if nacc=1)
-/
-!-----------------------------------------------------------------------
-&namtraldf    !   lateral diffusion scheme for tracer
-!-----------------------------------------------------------------------
-!                               !  Type of the operator :
-   ln_traldf_lap    =  .true.   !     laplacian operator
-   ln_traldf_bilap  =  .false.  !     bilaplacian operator
-                                !  Direction of action  :
-   ln_traldf_level  =  .false.  !     iso-level
-   ln_traldf_hor    =  .false.  !     horizontal (geopotential)         (require "key_ldfslp" when ln_sco=T)
-   ln_traldf_iso    =  .true.   !     iso-neutral                       (require "key_ldfslp")
-!                               !  Coefficient
-   aht0        =  2000.         !     horizontal eddy diffusivity for tracers [m2/s]
-   ahtb0       =     0.         !     background eddy diffusivity for ldf_iso [m2/s]
-   aeiv0       =  2000.         !     eddy induced velocity coefficient [m2/s]    (require "key_traldf_eiv")
-/
-!-----------------------------------------------------------------------
-&namcla        !   cross land advection
-!-----------------------------------------------------------------------
-   n_cla       =    0      !  advection between 2 ocean pts separates by land
-/
-!-----------------------------------------------------------------------
-&namqsr        !   penetrative solar radiation
-!-----------------------------------------------------------------------
+   nn_bathy    =    1      !  compute (=0) or read (=1) the bathymetry file
+   nn_closea   =    0      !  closed seas and lakes are removed (=0) or kept (=1) from the ORCA domain
+   nn_msh      =    1      !  create (=1) a mesh file (coordinates, scale factors, masks) or not (=0)
+   rn_hmin     =   -3.     !  minimum depth of the ocean (>0) or minimum number of ocean level (<0)
+   rn_e3zps_min=   20.     !  the thickness of the partial step is set larger than the minimum
+   rn_e3zps_rat=    0.1    !  of e3zps_min and e3zps_rat * e3t   (N.B. 0<e3zps_rat<1)
+                           !
+   rn_rdt      = 21600.     !  time step for the dynamics (and tracer if nacc=0)   ==> 5760
+   nn_baro     =   64      !  number of barotropic time step (for the split explicit algorithm) ("key_dynspg_ts")
+   rn_atfp     =    0.1    !  asselin time filter parameter
+   nn_acc      =    0      !  acceleration of convergence : =1      used, rdt < rdttra(k)
+                                 !                          =0, not used, rdt = rdttra
+   rn_rdtmin   = 21600.          !  minimum time step on tracers (used if nacc=1)
+   rn_rdtmax   = 21600.          !  maximum time step on tracers (used if nacc=1)
+   rn_rdth     =  800.           !  depth variation of tracer time step  (used if nacc=1)
+/
+!-----------------------------------------------------------------------
+&namdta_tem    !   data : temperature                                   ("key_dtatem")
+!-----------------------------------------------------------------------
+!              ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation !
+!              !           !  (if <0  months)     !   name   !  (logical)   ! (T/F) ! 'monthly'  ! filename ! pairing  !
+   sn_tem = 'data_1m_potential_temperature_nomask', -1,'votemper',  .true.  , .true., 'yearly'   , ' '      , ' '
+   !
+   cn_dir       = './'     !  root directory for the location of the runoff files
+/
+!-----------------------------------------------------------------------
+&namdta_sal    !   data : salinity                                      ("key_dtasal")
+!-----------------------------------------------------------------------
+!              ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation !
+!              !           !  (if <0  months)     !   name   !   (logical)  ! (T/F) ! 'monthly'  ! filename ! pairing  !
+   sn_sal      =  'data_1m_salinity_nomask',  -1  ,'vosaline',    .true.    , .true., 'yearly'   , ''       , ' '
+   !
+   cn_dir      = './'      !  root directory for the location of the runoff files
+/
+
+!!======================================================================
+!!            ***  Surface Boundary Condition namelists  ***
+!!======================================================================
+!!   namsbc          surface boundary condition
+!!   namsbc_ana      analytical         formulation
+!!   namsbc_flx      flux               formulation
+!!   namsbc_clio     CLIO bulk formulea formulation
+!!   namsbc_core     CORE bulk formulea formulation
+!!   namsbc_cpl      CouPLed            formulation                     ("key_coupled")
+!!   namsbc_cpl_co2  coupled ocean/biogeo/atmosphere model              ("key_cpl_carbon_cycle")
+!!   namtra_qsr      penetrative solar radiation
+!!   namsbc_rnf      river runoffs
+!!   namsbc_apr      Atmospheric Pressure
+!!   namsbc_ssr      sea surface restoring term (for T and/or S)
+!!   namsbc_alb      albedo parameters
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+   nn_fsbc     = 5         !  frequency of surface boundary condition computation 
+                           !     (also = the frequency of sea-ice model call)
+   ln_ana      = .false.   !  analytical formulation                    (T => fill namsbc_ana ) 
+   ln_flx      = .false.   !  flux formulation                          (T => fill namsbc_flx )
+   ln_blk_clio = .false.   !  CLIO bulk formulation                     (T => fill namsbc_clio) 
+   ln_blk_core = .true.    !  CORE bulk formulation                     (T => fill namsbc_core) 
+   ln_cpl      = .false.   !  Coupled formulation                       (T => fill namsbc_cpl )
+   ln_apr_dyn  = .false.   !  Patm gradient added in ocean & ice Eqs.   (T => fill namsbc_apr )
+   nn_ice      = 2         !  =0 no ice boundary condition   ,
+                           !  =1 use observed ice-cover      ,
+                           !  =2 ice-model used                         ("key_lim3" or "key_lim2)
+   ln_dm2dc    = .false.   !  daily mean to diurnal cycle short wave (qsr)
+   ln_rnf      = .true.    !  runoffs                                   (T => fill namsbc_rnf)
+   ln_ssr      = .true.    !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr)
+   nn_fwb      = 3         !  FreshWater Budget: =0 unchecked 
+                           !     =1 global mean of e-p-r set to zero at each time step 
+                           !     =2 annual global mean of e-p-r set to zero
+                           !     =3 global emp set to zero and spread out over erp area
+/
+!-----------------------------------------------------------------------
+&namsbc_ana    !   analytical surface boundary condition
+!-----------------------------------------------------------------------
+   nn_tau000   =   0       !  gently increase the stress over the first ntau_rst time-steps
+   rn_utau0    =   0.5     !  uniform value for the i-stress
+   rn_vtau0    =   0.e0    !  uniform value for the j-stress
+   rn_qns0     =   0.e0    !  uniform value for the total heat flux
+   rn_qsr0     =   0.e0    !  uniform value for the solar radiation
+   rn_emp0     =   0.e0    !  uniform value for the freswater budget (E-P)
+/
+!-----------------------------------------------------------------------
+&namsbc_flx    !   surface boundary condition : flux formulation
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_utau     = 'utau'      ,        24         , 'utau'    , .false.      , .false., 'yearly'  , ''       , ''
+   sn_vtau     = 'vtau'      ,        24         , 'vtau'    , .false.      , .false., 'yearly'  , ''       , ''
+   sn_qtot     = 'qtot'      ,        24         , 'qtot'    , .false.      , .false., 'yearly'  , ''       , ''
+   sn_qsr      = 'qsr'       ,        24         , 'qsr'     , .false.      , .false., 'yearly'  , ''       , ''
+   sn_emp      = 'emp'       ,        24         , 'emp'     , .false.      , .false., 'yearly'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the flux files
+/      
+!-----------------------------------------------------------------------
+&namsbc_clio   !   namsbc_clio  CLIO bulk formulea
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_utau     = 'taux_1m'   ,       -1          , 'sozotaux',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_vtau     = 'tauy_1m'   ,       -1          , 'sometauy',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_wndm     = 'flx'       ,       -1          , 'socliowi',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_tair     = 'flx'       ,       -1          , 'socliot2',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_humi     = 'flx'       ,       -1          , 'socliohu',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_ccov     = 'flx'       ,       -1          , 'socliocl',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_prec     = 'flx'       ,       -1          , 'socliopl',   .false.    , .true. , 'yearly'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the bulk files are
+/
+!-----------------------------------------------------------------------
+&namsbc_core   !   namsbc_core  CORE bulk formulea
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_wndi = 'u_10.15JUNE2009_orca2'       ,  6  , 'U_10_MOD',   .false.    , .true. , 'yearly'  , ''       , 'Uwnd'
+   sn_wndj = 'v_10.15JUNE2009_orca2'       ,  6  , 'V_10_MOD',   .false.    , .true. , 'yearly'  , ''       , 'Vwnd'
+   sn_qsr  = 'ncar_rad.15JUNE2009_orca2'   , 24  , 'SWDN_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_qlw  = 'ncar_rad.15JUNE2009_orca2'   , 24  , 'LWDN_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_tair = 't_10.15JUNE2009_orca2'       ,  6  , 'T_10_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_humi = 'q_10.15JUNE2009_orca2'       ,  6  , 'Q_10_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_prec = 'ncar_precip.15JUNE2009_orca2', -1  , 'PRC_MOD1',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_snow = 'ncar_precip.15JUNE2009_orca2', -1  , 'SNOW'    ,   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_tdif = 'taudif_core'                 , 24  , 'taudif'  ,   .false.    , .true. , 'yearly'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the bulk files
+   ln_2m       = .false.   !  air temperature and humidity referenced at 2m (T) instead 10m (F)
+   ln_taudif   = .false.   !  HF tau contribution: use "mean of stress module - module of the mean stress" data ?
+   rn_pfac     = 1.        !  multiplicative factor for precipitation (total & snow)
+/
+!-----------------------------------------------------------------------
+&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_coupled")
+!-----------------------------------------------------------------------
+!                                      ! send
+cn_snd_temperature= 'weighted oce and ice'  !  'oce only' 'weighted oce and ice' 'mixed oce-ice'
+cn_snd_albedo     = 'weighted ice'          !  'none' 'weighted ice' 'mixed oce-ice'
+cn_snd_thickness  = 'none'                  !  'none' 'weighted ice and snow'
+cn_snd_crt_nature = 'none'                  !  'none' 'oce only' 'weighted oce and ice' 'mixed oce-ice'
+cn_snd_crt_refere = 'spherical'             !  'spherical' 'cartesian'
+cn_snd_crt_orient = 'eastward-northward'    !  'eastward-northward' or 'local grid'
+cn_snd_crt_grid   = 'T'                     !  'T'
+!                                      ! receive
+cn_rcv_w10m       = 'none'                  !  'none' 'coupled'
+cn_rcv_taumod     = 'coupled'               !  'none' 'coupled'
+cn_rcv_tau_nature = 'oce only'              !  'oce only' 'oce and ice' 'mixed oce-ice'
+cn_rcv_tau_refere = 'cartesian'             !  'spherical' 'cartesian'
+cn_rcv_tau_orient = 'eastward-northward'    !  'eastward-northward' or 'local grid'
+cn_rcv_tau_grid   = 'U,V'                   !  'T' 'U,V' 'U,V,F' 'U,V,I' 'T,F' 'T,I' 'T,U,V'
+cn_rcv_dqnsdt     = 'coupled'               !  'none' 'coupled'
+cn_rcv_qsr        = 'oce and ice'           !  'conservative' 'oce and ice' 'mixed oce-ice'
+cn_rcv_qns        = 'oce and ice'           !  'conservative' 'oce and ice' 'mixed oce-ice'
+cn_rcv_emp        = 'conservative'          !  'conservative' 'oce and ice' 'mixed oce-ice'
+cn_rcv_rnf        = 'coupled'               !  'coupled' 'climato' 'mixed'
+cn_rcv_cal        = 'coupled'               !  'none' 'coupled'
+/
+!-----------------------------------------------------------------------
+&namsbc_cpl_co2   !   coupled ocean/biogeo/atmosphere model             ("key_cpl_carbon_cycle")
+!-----------------------------------------------------------------------
+cn_snd_co2        = 'coupled'         ! send    :  'none' 'coupled'
+cn_rcv_co2        = 'coupled'         ! receive : 'none' 'coupled'
+/
+!-----------------------------------------------------------------------
+&namtra_qsr    !   penetrative solar radiation
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_chl      ='chlorophyll',        -1         , 'CHLA'    ,   .true.     , .true. , 'yearly'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the runoff files
+   ln_traqsr   = .false.   !  Light penetration (T) or not (F)
+   ln_qsr_rgb  = .true.    !  RGB (Red-Green-Blue) light penetration
+   ln_qsr_2bd  = .false.   !  2 bands              light penetration
    ln_qsr_bio  = .false.   !  bio-model light penetration
+   nn_chldta   =      1    !  RGB : Chl data (=1) or cst value (=0)
    rn_abs      =   0.58    !  RGB & 2 bands: fraction of light (rn_si1)
    rn_si0      =   0.35    !  RGB & 2 bands: shortess depth of extinction
-   rn_si2      =   62.0    !  3 bands: longest depth of extinction (for blue waveband & 0.01 mg/m2 Chl)
-/  
+   rn_si1      =   23.0    !  2 bands: longest depth of extinction
+/
+!-----------------------------------------------------------------------
+&namsbc_rnf    !   runoffs namelist surface boundary condition
+!-----------------------------------------------------------------------
+!              !  file name              ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !                         !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_rnf      = 'runoff_core_monthly'   ,        -1         , 'sorunoff',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_cnf      = 'runoff_core_monthly'   ,         0         , 'socoefr0',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_s_rnf    = 'runoffs'               ,        24         , 'rosaline',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_t_rnf    = 'runoffs'               ,        24         , 'rotemper',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_dep_rnf  = 'runoffs'               ,         0         , 'rodepth' ,   .false.    , .true. , 'yearly'  , ''       , ''
+
+   cn_dir       = './'      !  root directory for the location of the runoff files
+   ln_rnf_emp   =   .false. !  runoffs included into precipitation field (T) or into a file (F)
+   ln_rnf_mouth =   .false. !  specific treatment at rivers mouths
+   rn_hrnf      =  15.e0    !  depth over which enhanced vertical mixing is used
+   rn_avt_rnf   =   1.e-3   !  value of the additional vertical mixing coef. [m2/s]
+   rn_rfact     =   1.e0    !  multiplicative factor for runoff
+   ln_rnf_depth =  .false.  !  read in depth information for runoff
+   ln_rnf_tem   =  .false.  !  read in temperature information for runoff
+   ln_rnf_sal   =  .false.  !  read in salinity information for runoff
+/
+!-----------------------------------------------------------------------
+&namsbc_apr    !   Atmospheric pressure used as ocean forcing or in bulk
+!-----------------------------------------------------------------------
+!              ! file name ! frequency (hours) ! variable ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
+!              !           !  (if <0  months)  !   name   !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
+   sn_apr      = 'patm'    ,         -1        ,'somslpre',    .true.      , .true.  , 'yearly'  ,  ''      ,   ''
+
+   cn_dir      = './'      !  root directory for the location of the bulk files
+   ln_ref_apr  = .false.   !  ref. pressure: global mean Patm (T) or a constant (F)
+/
+!-----------------------------------------------------------------------
+&namsbc_ssr    !   surface boundary condition : sea surface restoring
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_sst      = 'sst_data'  ,        24         ,  'sst'    ,    .false.   , .false., 'yearly'  , ''       , ''
+   sn_sss      = 'sss_data'  ,        -1         ,  'sss'    ,    .true.    , .true. , 'yearly'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the runoff files
+   nn_sstr     =     0     !  add a retroaction term in the surface heat       flux (=1) or not (=0)
+   nn_sssr     =     2     !  add a damping     term in the surface freshwater flux (=2) 
+                           !  or to SSS only (=1) or no damping term (=0)
+   rn_dqdt     =   -40.    !  magnitude of the retroaction on temperature   [W/m2/K]
+   rn_deds     =   -27.7   !  magnitude of the damping on salinity   [mm/day]
+   ln_sssr_bnd =   .true.  !  flag to bound erp term (associated with nn_sssr=2)
+   rn_sssr_bnd =   4.e0    !  ABS(Max/Min) value of the damping erp term [mm/day]
+/      
+!-----------------------------------------------------------------------
+&namsbc_alb    !   albedo parameters
+!-----------------------------------------------------------------------
+   rn_cloud    =    0.06   !  cloud correction to snow and ice albedo 
+   rn_albice   =    0.53   !  albedo of melting ice in the arctic and antarctic
+   rn_alphd    =    0.80   !  coefficients for linear interpolation used to
+   rn_alphc    =    0.65   !  compute albedo between two extremes values 
+   rn_alphdi   =    0.72   !  (Pyane, 1972)
+/
+
+!!======================================================================
+!!               ***  Lateral boundary condition  ***
+!!======================================================================
+!!   namlbc        lateral momentum boundary condition
+!!   namcla        cross land advection
+!!   namobc        open boundaries parameters                           ("key_obc")
+!!   namagrif      agrif nested grid ( read by child model only )       ("key_agrif") 
+!!   nambdy        Unstructured open boundaries                         ("key_bdy")
+!!   namtide       Tidal forcing at open boundaries                     ("key_bdy_tides")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+   rn_shlat    =    2.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+                           !  free slip  !   partial slip  !   no slip   ! strong slip
+/
+!-----------------------------------------------------------------------
+&namcla        !   cross land advection
+!-----------------------------------------------------------------------
+   nn_cla      =    0      !  advection between 2 ocean pts separates by land
+/
+!-----------------------------------------------------------------------
+&namobc        !   open boundaries parameters                           ("key_obc")
+!-----------------------------------------------------------------------
+   ln_obc_clim = .false.   !  climatological obc data files (T) or not (F)
+   ln_vol_cst  = .true.    !  impose the total volume conservation (T) or not (F)
+   ln_obc_fla  = .false.   !  Flather open boundary condition 
+   nn_obcdta   =    1      !  = 0 the obc data are equal to the initial state
+                           !  = 1 the obc data are read in 'obc.dta' files
+   cn_obcdta   = 'annual'  !  set to annual if obc datafile hold 1 year of data
+                           !  set to monthly if obc datafile hold 1 month of data
+   rn_dpein    =    1.     !  damping time scale for inflow at east  open boundary
+   rn_dpwin    =    1.     !     -           -         -       west    -      -
+   rn_dpnin    =    1.     !     -           -         -       north   -      -
+   rn_dpsin    =    1.     !     -           -         -       south   -      -
+   rn_dpeob    = 3000.     !  time relaxation (days) for the east  open boundary
+   rn_dpwob    =   15.     !     -           -         -     west    -      -
+   rn_dpnob    = 3000.     !     -           -         -     north   -      -
+   rn_dpsob    =   15.     !     -           -         -     south   -      -
+   rn_volemp   =  1.       !  = 0 the total volume change with the surface flux (E-P-R)
+                           !  = 1 the total volume remains constant
+/
+!-----------------------------------------------------------------------
+&namagrif      !  AGRIF zoom                                            ("key_agrif")
+!-----------------------------------------------------------------------
+   nn_cln_update = 3       !  baroclinic update frequency
+   ln_spc_dyn    = .true.  !  use 0 as special value for dynamics
+   rn_sponge_tra = 2880.   !  coefficient for tracer   sponge layer [s]
+   rn_sponge_dyn = 2880.   !  coefficient for dynamics sponge layer [s]
+/
+!-----------------------------------------------------------------------
+&nambdy        !  unstructured open boundaries                          ("key_bdy")
+!-----------------------------------------------------------------------
+   cn_mask       =  ''                     !  name of mask file (if ln_bdy_mask=.TRUE.)
+   cn_dta_frs_T  = 'bdydata_grid_T.nc'     !  name of data file (T-points)
+   cn_dta_frs_U  = 'bdydata_grid_U.nc'     !  name of data file (U-points)
+   cn_dta_frs_V  = 'bdydata_grid_V.nc'     !  name of data file (V-points)
+   cn_dta_fla_T  = 'bdydata_bt_grid_T.nc'  !  name of data file for Flather condition (T-points)
+   cn_dta_fla_U  = 'bdydata_bt_grid_U.nc'  !  name of data file for Flather condition (U-points)
+   cn_dta_fla_V  = 'bdydata_bt_grid_V.nc'  !  name of data file for Flather condition (V-points)
+
+   ln_clim     = .false.   !  contain 1 (T) or 12 (F) time dumps and be cyclic
+   ln_vol      = .false.   !  total volume correction (see volbdy parameter)
+   ln_mask     = .false.   !  boundary mask from filbdy_mask (T), boundaries are on edges of domain (F)
+   ln_tides    = .false.   !  Apply tidal harmonic forcing with Flather condition
+   ln_dyn_fla  = .false.   !  Apply Flather condition to velocities
+   ln_tra_frs  = .false.   !  Apply FRS condition to temperature and salinity 
+   ln_dyn_frs  = .false.   !  Apply FRS condition to velocities
+   nn_rimwidth =  9        !  width of the relaxation zone
+   nn_dtactl   =  1        !  = 0, bdy data are equal to the initial state
+                           !  = 1, bdy data are read in 'bdydata   .nc' files
+   nn_volctl   =  0        !  = 0, the total water flux across open boundaries is zero
+                           !  = 1, the total volume of the system is conserved
+/
+!-----------------------------------------------------------------------
+&nambdy_tide   !  tidal forcing at unstructured boundaries              
+!-----------------------------------------------------------------------
+   filtide     = 'bdytide_'           !  file name root of tidal forcing files
+   tide_cpt    = 'M2','S1'            !  names of tidal components used
+   tide_speed  = 28.984106, 15.000001 !  phase speeds of tidal components (deg/hour)
+   ln_tide_date= .false.              !  adjust tidal harmonics for start date of run
+/
+
+!!======================================================================
+!!                 ***  Bottom boundary condition  ***
+!!======================================================================
+!!   nambfr        bottom friction
+!!   nambbc        bottom temperature boundary condition               
+!!   nambbl        bottom boundary layer scheme                         ("key_trabbl")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    1      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+   rn_bfri1    =    4.e-4  !  bottom drag coefficient (linear case)
+   rn_bfri2    =    1.e-3  !  bottom drag coefficient (non linear case)
+   rn_bfeb2    =    2.5e-3 !  bottom turbulent kinetic energy background  (m^2/s^2)
+   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 = .true.)
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition
+!-----------------------------------------------------------------------
+   ln_trabbc   = .false.   !  Apply a geothermal heating at the ocean bottom
+   nn_geoflx   =    2      !  geothermal heat flux: = 0 no flux 
+                           !     = 1 constant flux
+                           !     = 2 variable flux (read in geothermal_heating.nc in mW/m2) 
+   rn_geoflx_cst = 86.4e-3 !  Constant value of geothermal heat flux [W/m2]
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme
+!-----------------------------------------------------------------------
+   nn_bbl_ldf  =  1      !  diffusive bbl (=1)   or not (=0)
+   nn_bbl_adv  =  0      !  advective bbl (=1/2) or not (=0)
+   rn_ahtbbl   =  1000.  !  lateral mixing coefficient in the bbl  [m2/s]
+   rn_gambbl   =  10.    !  advective bbl coefficient                 [s]
+/
+
+!!======================================================================
+!!                        Tracer (T & S ) namelists
+!!======================================================================
+!!   nameos        equation of state
+!!   namtra_adv    advection scheme
+!!   namtra_ldf    lateral diffusion scheme
+!!   namtra_dmp    T & S newtonian damping                              ("key_tradmp")
+!!======================================================================
+
 !-----------------------------------------------------------------------
 &nameos        !   ocean physical parameters
 !-----------------------------------------------------------------------
-   neos        =    0      !  type of equation of state and Brunt-Vaisala frequency
+   nn_eos      =    0      !  type of equation of state and Brunt-Vaisala frequency
                            !     = 0, UNESCO (formulation of Jackett and McDougall (1994) and of McDougall (1987) )
                            !     = 1, linear: rho(T)   = rau0 * ( 1.028 - ralpha * T )
                            !     = 2, linear: rho(T,S) = rau0 * ( rbeta * S - ralpha * T )
-   ralpha      =    2.e-4  !  thermal expension coefficient (neos= 1 or 2)
-   rbeta       =    0.001  !  saline  expension coefficient (neos= 2)
-/
-!-----------------------------------------------------------------------
-&namdyn        !   offline parameters 
-!-----------------------------------------------------------------------
-    ndtadyn   =  73        ! number of period in the file for one year    
-    ndtatot   =  73        ! total number of period in the file    
-    nsptint   =  1         ! indicator for time interpolation    
-    nficdyn   =  2         ! number of file to read    
+   rn_alpha    =    2.e-4  !  thermal expension coefficient (neos= 1 or 2)
+   rn_beta     =    0.001  !  saline  expension coefficient (neos= 2)
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer 
+!-----------------------------------------------------------------------
+   ln_traadv_cen2   =  .false.  !  2nd order centered scheme   
+   ln_traadv_tvd    =  .true.   !  TVD scheme                
+   ln_traadv_muscl  =  .false.  !  MUSCL scheme             
+   ln_traadv_muscl2 =  .false.  !  MUSCL2 scheme + cen2 at boundaries  
+   ln_traadv_ubs    =  .false.  !  UBS scheme                 
+   ln_traadv_qck    =  .false.  !  QUCIKEST scheme                 
+/
+!-----------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracer 
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator : 
+   ln_traldf_lap    =  .true.   !  laplacian operator       
+   ln_traldf_bilap  =  .false.  !  bilaplacian operator     
+   !                       !  Direction of action  :
+   ln_traldf_level  =  .false.  !  iso-level                
+   ln_traldf_hor    =  .false.  !  horizontal (geopotential)            (require "key_ldfslp" when ln_sco=T)
+   ln_traldf_iso    =  .true.   !  iso-neutral                          (require "key_ldfslp")
+   ln_traldf_grif   =  .false.  !  griffies skew flux formulation       (require "key_ldfslp")  ! UNDER TEST, DO NOT USE
+   ln_traldf_gdia   =  .false.  !  griffies operator strfn diagnostics  (require "key_ldfslp")  ! UNDER TEST, DO NOT USE
+   !                       !  Coefficient
+   rn_aht_0         =  2000.    !  horizontal eddy diffusivity for tracers [m2/s]
+   rn_ahtb_0        =     0.    !  background eddy diffusivity for ldf_iso [m2/s]
+   rn_aeiv_0        =  2000.    !  eddy induced velocity coefficient [m2/s]    (require "key_traldf_eiv")
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping                      ('key_tradmp')
+!-----------------------------------------------------------------------
+   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     =    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     =   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)
+/
+
+!!======================================================================
+!!                      ***  Dynamics namelists  ***
+!!======================================================================
+!!   namdyn_adv    formulation of the momentum advection
+!!   namdyn_vor    advection scheme
+!!   namdyn_hpg    hydrostatic pressure gradient
+!!   namdyn_spg    surface pressure gradient                            (CPP key only)
+!!   namdyn_ldf    lateral diffusion scheme
+!!   namdyn        offline: dynamics read in files                      ("key_offline")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+   ln_dynadv_vec = .true.  !  vector form (T) or flux form (F)  
+   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme
+   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme 
+/  
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme  
+   ln_dynvor_ens = .false. !  energy conserving scheme    
+   ln_dynvor_mix = .false. !  mixed scheme               
+   ln_dynvor_een = .true.  !  energy & enstrophy scheme  
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+   ln_hpg_zco  = .false.   !  z-coordinate - full steps                   
+   ln_hpg_zps  = .true.    !  z-coordinate - partial steps (interpolation)
+   ln_hpg_sco  = .false.   !  s-coordinate (standard jacobian formulation)
+   ln_hpg_hel  = .false.   !  s-coordinate (helsinki modification)
+   ln_hpg_wdj  = .false.   !  s-coordinate (weighted density jacobian)
+   ln_hpg_djc  = .false.   !  s-coordinate (Density Jacobian with Cubic polynomial)
+   ln_hpg_rot  = .false.   !  s-coordinate (ROTated axes scheme)
+   rn_gamma    = 0.e0      !  weighting coefficient (wdj scheme)
+   ln_dynhpg_imp = .false. !  time stepping: semi-implicit time scheme  (T)
+                                 !           centered      time scheme  (F)
+/
+!-----------------------------------------------------------------------
+!namdyn_spg    !   surface pressure gradient   (CPP key only)
+!-----------------------------------------------------------------------
+!                          !  explicit free surface                     ("key_dynspg_exp")
+!                          !  filtered free surface                     ("key_dynspg_flt")
+!                          !  split-explicit free surface               ("key_dynspg_ts")
+
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator : 
+   ln_dynldf_lap    =  .true.   !  laplacian operator         
+   ln_dynldf_bilap  =  .false.  !  bilaplacian operator    
+   !                       !  Direction of action  : 
+   ln_dynldf_level  =  .false.  !  iso-level               
+   ln_dynldf_hor    =  .true.   !  horizontal (geopotential)            (require "key_ldfslp" in s-coord.)
+   ln_dynldf_iso    =  .false.  !  iso-neutral                          (require "key_ldfslp")
+   !                       !  Coefficient
+   rn_ahm_0_lap     = 40000.    !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahmb_0        =     0.    !  background eddy viscosity for ldf_iso [m2/s]
+   rn_ahm_0_blp     =     0.    !  horizontal bilaplacian eddy viscosity [m4/s] 
+/
+!-----------------------------------------------------------------------
+&namdyn        !   offline dynamics read in files                       ("key_offline")
+!-----------------------------------------------------------------------
+    ndtadyn   =  73        ! number of period in the file for one year
+    ndtatot   =  73        ! total number of period in the file
+    nsptint   =  1         ! indicator for time interpolation
     lperdyn   = .true.     ! periodicity of the unique file (T)
-!                          ! F  (default)   computed with Blanke' scheme 
-    cfile_grid_T = 'NEMOV3_5d_21210101_21211231_grid_T.nc' ! name of grid_T file
-    cfile_grid_U = 'NEMOV3_5d_21210101_21211231_grid_U.nc' ! name of grid_U file
-    cfile_grid_V = 'NEMOV3_5d_21210101_21211231_grid_V.nc' ! name of grid_V file
-    cfile_grid_W = 'NEMOV3_5d_21210101_21211231_grid_W.nc' ! name of grid_W file
-/
-
+                           ! F  (default)   computed with Blanke' scheme
+    cfile_grid_T = 'dyna_grid_T.nc' ! name of grid_T file
+    cfile_grid_U = 'dyna_grid_U.nc' ! name of grid_U file
+    cfile_grid_V = 'dyna_grid_V.nc' ! name of grid_V file
+    cfile_grid_W = 'dyna_grid_W.nc' ! name of grid_W file
+/
+
+!!======================================================================
+!!             Tracers & Dynamics vertical physics namelists
+!!======================================================================
+!!    namzdf        vertical physics
+!!    namzdf_ric    richardson number dependent vertical mixing         ("key_zdfric")
+!!    namzdf_tke    TKE dependent vertical mixing                       ("key_zdftke")
+!!    namzdf_kpp    KPP dependent vertical mixing                       ("key_zdfkpp")
+!!    namzdf_ddm    double diffusive mixing parameterization            ("key_zdfddm")
+!!    namzdf_tmx    tidal mixing parameterization                       ("key_zdftmx")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.2e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   1.2e-5  !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   nn_avb      =    0      !  profile for background avt & avm (=1) or not (=0)
+   nn_havtb    =    0      !  horizontal shape for avtb (=1) or not (=0)
+   ln_zdfevd   = .true.    !  enhanced vertical diffusion (evd) (T) or not (F)
+   nn_evdm     =    0      !  evd apply on tracer (=0) or on tracer and momentum (=1)
+   rn_avevd    =  100.     !  evd mixing coefficient [m2/s]
+   ln_zdfnpc   = .false.   !  Non-Penetrative algorithm (T) or not (F)
+   nn_npc      =    1            !  frequency of application of npc
+   nn_npcp     =  365            !  npc control print frequency
+   ln_zdfexp   = .false.   !  time-stepping: split-explicit (T) or implicit (F) time stepping
+   nn_zdfexp   =    3            !  number of sub-timestep for ln_zdfexp=T
+/
+!-----------------------------------------------------------------------
+&namzdf_ric    !   richardson number dependent vertical diffusion       ("key_zdfric" )
+!-----------------------------------------------------------------------
+   rn_avmri    = 100.e-4   !  maximum value of the vertical viscosity
+   rn_alp      =   5.      !  coefficient of the parameterization
+   nn_ric      =   2       !  coefficient of the parameterization
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
+!-----------------------------------------------------------------------
+   rn_ediff    =   0.1     !  coef. for vertical eddy coef. (avt=rn_ediff*mxl*sqrt(e) )
+   rn_ediss    =   0.7     !  coef. of the Kolmogoroff dissipation
+   rn_ebb      =  67.83    !  coef. of the surface input of tke (=67.83 suggested when ln_mxl0=T)
+   rn_emin     =   1.e-6   !  minimum value of tke [m2/s2]
+   rn_emin0    =   1.e-4   !  surface minimum value of tke [m2/s2]
+   nn_mxl      =   2       !  mixing length: = 0 bounded by the distance to surface and bottom
+                           !                 = 1 bounded by the local vertical scale factor
+                           !                 = 2 first vertical derivative of mixing length bounded by 1
+                           !                 = 3 as =2 with distinct disspipative an mixing length scale
+   nn_pdl      =   1       !  Prandtl number function of richarson number (=1, avt=pdl(Ri)*avm) or not (=0, avt=avm)
+   ln_mxl0     = .true.    !  surface mixing length scale = F(wind stress) (T) or not (F)
+   rn_mxl0     =   0.04    !  surface  buoyancy lenght scale minimum value
+   ln_lc       = .true.    !  Langmuir cell parameterisation (Axell 2002)
+   rn_lc       =   0.15    !  coef. associated to Langmuir cells
+   nn_etau     =   1       !  penetration of tke below the mixed layer (ML) due to internal & intertial waves
+                           !        = 0 no penetration
+                           !        = 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")
+   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
+                           !        = 0  constant 10 m length scale
+                           !        = 1  0.5m at the equator to 30m poleward of 40 degrees
+/
+!------------------------------------------------------------------------
+&namzdf_kpp    !   K-Profile Parameterization dependent vertical mixing  ("key_zdfkpp", and optionnally:
+!------------------------------------------------------------------------ "key_kppcustom" or "key_kpplktb")
+   ln_kpprimix = .true.    !  shear instability mixing 
+   rn_difmiw   =  1.0e-04  !  constant internal wave viscosity [m2/s]
+   rn_difsiw   =  0.1e-04  !  constant internal wave diffusivity [m2/s]
+   rn_riinfty  =  0.8      !  local Richardson Number limit for shear instability
+   rn_difri    =  0.0050   !  maximum shear mixing at Rig = 0    [m2/s]
+   rn_bvsqcon  = -0.01e-07 !  Brunt-Vaisala squared for maximum convection [1/s2] 
+   rn_difcon   =  1.       !  maximum mixing in interior convection [m2/s] 
+   nn_avb      =  0        !  horizontal averaged (=1) or not (=0) on avt and amv
+   nn_ave      =  1        !  constant (=0) or profile (=1) background on avt
+/
+!-----------------------------------------------------------------------
+&namzdf_gls                !   GLS vertical diffusion                   ("key_zdfgls")
+!-----------------------------------------------------------------------
+   rn_emin       = 1.e-6   !  minimum value of e   [m2/s2]
+   rn_epsmin     = 1.e-12  !  minimum value of eps [m2/s3]
+   ln_length_lim = .true.  !  limit on the dissipation rate under stable stratification (Galperin et al., 1988)
+   rn_clim_galp  = 0.53    !  galperin limit
+   ln_crban      = .TRUE.  !  Use Craig & Banner (1994) surface wave mixing parametrisation
+   ln_sigpsi     = .TRUE.  !  Activate or not Burchard 2001 mods on psi schmidt number in the wb case
+   rn_crban      = 100.    !  Craig and Banner 1994 constant for wb tke flux
+   rn_charn      = 70000.  !  Charnock constant for wb induced roughness length
+   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)
+/
+!-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+   rn_avts     = 1.e-4     !  maximum avs (vertical mixing on salinity)
+   rn_hsbfr    = 1.6       !  heat/salt buoyancy flux ratio
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+   rn_htmx     = 500.      !  vertical decay scale for turbulence (meters)
+   rn_n2min    = 1.e-8     !  threshold of the Brunt-Vaisala frequency (s-1)
+   rn_tfe      = 0.333     !  tidal dissipation efficiency
+   rn_me       = 0.2       !  mixing efficiency 
+   ln_tmx_itf  = .FALSE.   !  ITF specific parameterisation
+   rn_tfe_itf  = 1.        !  ITF tidal dissipation efficiency
+/
+
+!!======================================================================
+!!                  ***  Miscelaneous namelists  ***
+!!======================================================================
+!!   nammpp            Massively Parallel Processing                    ("key_mpp_mpi)
+!!   nammpp_dyndist    Massively Parallel domain decomposition          ("key_agrif" && "key_mpp_dyndist")
+!!   namctl            Control prints & Benchmark
+!!   namsol            elliptic solver / island / free surface 
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namsol        !   elliptic solver / island / free surface 
+!-----------------------------------------------------------------------
+   nn_solv     =      1    !  elliptic solver: =1 preconditioned conjugate gradient (pcg)
+                           !                   =2 successive-over-relaxation (sor)
+   nn_sol_arp  =      0    !  absolute/relative (0/1) precision convergence test
+   rn_eps      =  1.e-6    !  absolute precision of the solver
+   nn_nmin     =    300    !  minimum of iterations for the SOR solver
+   nn_nmax     =    800    !  maximum of iterations for the SOR solver
+   nn_nmod     =     10    !  frequency of test for the SOR solver
+   rn_resmax   =  1.e-10   !  absolute precision for the SOR solver
+   rn_sor      =  1.92     !  optimal coefficient for SOR solver (to be adjusted with the domain)
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+   cn_mpi_send =  'I'      !  mpi send/recieve type   ='S', 'B', or 'I' for standard send,
+                           !  buffer blocking send or immediate non-blocking sends, resp.
+   nn_buffer   =   0       !  size in bytes of exported buffer ('B' case), 0 no exportation
+/
+!-----------------------------------------------------------------------
+&nammpp_dyndist !   Massively Parallel Distribution for AGRIF zoom      ("key_agrif" && "key_mpp_dyndist")
+!-----------------------------------------------------------------------
+   jpni        =    1      !  jpni   number of processors following i
+   jpnj        =    1      !  jpnj   number of processors following j
+   jpnij       =    1      !  jpnij  number of local domains
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+   ln_ctl      = .false.   !  trends control print (expensive!)
+   nn_print    =    0      !  level of print (0 no extra print)
+   nn_ictls    =    0      !  start i indice of control sum (use to compare mono versus
+   nn_ictle    =    0      !  end   i indice of control sum        multi processor runs
+   nn_jctls    =    0      !  start j indice of control               over a subdomain)
+   nn_jctle    =    0      !  end   j indice of control
+   nn_isplt    =    1      !  number of processors in i-direction
+   nn_jsplt    =    1      !  number of processors in j-direction
+   nn_bench    =    0      !  Bench mode (1/0): CAUTION use zero except for bench
+                           !     (no physical validity of the results)
+/
+
+!!======================================================================
+!!                  ***  Diagnostics namelists  ***
+!!======================================================================
+!!   namnc4       netcdf4 chunking and compression settings             ("key_netcdf4")
+!!   namtrd       dynamics and/or tracer trends                         ("key_trddyn","key_trdtra","key_trdmld")
+!!   namflo       float parameters                                      ("key_float")
+!!   namptr       Poleward Transport Diagnostics
+!!   namhsb       Heat and salt budgets 
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namnc4        !   netcdf4 chunking and compression settings            ("key_netcdf4")
+!-----------------------------------------------------------------------
+   nn_nchunks_i=   4       !  number of chunks in i-dimension
+   nn_nchunks_j=   4       !  number of chunks in j-dimension
+   nn_nchunks_k=   31      !  number of chunks in k-dimension
+                           !  setting nn_nchunks_k = jpk will give a chunk size of 1 in the vertical which
+                           !  is optimal for postprocessing which works exclusively with horizontal slabs
+   ln_nc4zip   = .TRUE.    !  (T) use netcdf4 chunking and compression
+                           !  (F) ignore chunking information and produce netcdf3-compatible files
+/
+!-----------------------------------------------------------------------
+&namtrd        !   diagnostics on dynamics and/or tracer trends         ("key_trddyn" and/or "key_trdtra")
+!              !       or mixed-layer trends or barotropic vorticity    ("key_trdmld" or     "key_trdvor")
+!-----------------------------------------------------------------------
+   nn_trd      = 365       !  time step frequency dynamics and tracers trends
+   nn_ctls     =   0       !  control surface type in mixed-layer trends (0,1 or n<jpk)
+   rn_ucf      =   1.      !  unit conversion factor (=1 -> /seconds ; =86400. -> /day)
+   cn_trdrst_in      = "restart_mld"   ! suffix of ocean restart name (input)
+   cn_trdrst_out     = "restart_mld"   ! suffix of ocean restart name (output)
+   ln_trdmld_restart = .false.         !  restart for ML diagnostics
+   ln_trdmld_instant = .false.         !  flag to diagnose trends of instantantaneous or mean ML T/S
+/
+!-----------------------------------------------------------------------
+&namflo       !   float parameters                                      ("key_float")
+!-----------------------------------------------------------------------
+   ln_rstflo  = .false.    !  float restart (T) or not (F)
+   nn_writefl =      75    !  frequency of writing in float output file 
+   nn_stockfl =    5475    !  frequency of creation of the float restart file 
+   ln_argo    = .false.    !  Argo type floats (stay at the surface each 10 days)
+   ln_flork4  = .false.    !  trajectories computed with a 4th order Runge-Kutta (T)
+                           !  or computed with Blanke' scheme (F)
+                           !  or computed with Blanke' scheme (F)
+/
+!-----------------------------------------------------------------------
+&namptr       !   Poleward Transport Diagnostic
+!-----------------------------------------------------------------------
+   ln_diaptr  = .false.    !  Poleward heat and salt transport (T) or not (F)
+   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
+   nn_fptr    =  1         !  Frequency of ptr computation [time step]
+   nn_fwri    =  15        !  Frequency of ptr outputs [time step]
+/
+!-----------------------------------------------------------------------
+&namhsb       !  Heat and salt budgets 
+!-----------------------------------------------------------------------
+   ln_diahsb  = .false.     !  check the heat and salt budgets (T) or not (F)
+/
+
+!!======================================================================
+!!            ***  Observation & Assimilation namelists ***
+!!======================================================================
+!!   namobs       observation and model comparison                      ('key_diaobs')
+!!   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               Logical switch for Reynolds observations       
+                           !     ln_ghrsst               Logical switch for GHRSST observations          
+
+   ln_sstfb   = .false.    ! Logical switch for feedback SST data          
+                           !     ln_sss                  Logical switch for SSS observations              
+                           !     ln_seaice               Logical switch for Sea Ice observations        
+                           !     ln_vel3d                Logical switch for velocity observations         
+                           !     ln_velavcur             Logical switch for velocity daily av. cur.    
+                           !     ln_velhrcur             Logical switch for velocity high freq. cur.   
+                           !     ln_velavadcp            Logical switch for velocity daily av. ADCP  
+                           !     ln_velhradcp            Logical switch for velocity high freq. ADCP
+                           !     ln_velfb                Logical switch for feedback velocity data       
+                           !     ln_grid_global          Global distribtion of observations         
+                           !     ln_grid_search_lookup   Logical switch for obs grid search w/lookup table  
+                           !     grid_search_file        Grid search lookup file header 
+                           !     enactfiles              ENACT input observation file names 
+                           !     coriofiles              Coriolis input observation file name  
+   !                       ! profbfiles: Profile feedback input observation file name 
+   profbfiles = 'profiles_01.nc'
+                           !     ln_profb_enatim         Enact feedback input time setting switch    
+                           !     slafilesact             Active SLA input observation file name
+                           !     slafilespas             Passive SLA input observation file name 
+   !                       ! slafbfiles: Feedback SLA input observation file name 
+   slafbfiles = 'sla_01.nc'
+                           !     sstfiles                GHRSST input observation file name       
+   !                       ! sstfbfiles: Feedback SST input observation file name 
+   sstfbfiles = 'sst_01.nc' 'sst_02.nc' 'sst_03.nc' 'sst_04.nc' 'sst_05.nc'
+                           !     seaicefiles             Sea Ice input observation file name 
+                           !     velavcurfiles           Vel. cur. daily av. input file name  
+                           !     velhvcurfiles           Vel. cur. high freq. input file name  
+                           !     velavadcpfiles          Vel. ADCP daily av. input file name    
+                           !     velhvadcpfiles          Vel. ADCP high freq. input file name 
+                           !     velfbfiles              Vel. feedback input observation file name 
+                           !     dobsini                 Initial date in window YYYYMMDD.HHMMSS       
+                           !     dobsend                 Final date in window YYYYMMDD.HHMMSS         
+                           !     n1dint                  Type of vertical interpolation method        
+                           !     n2dint                  Type of horizontal interpolation method       
+                           !     ln_nea                  Rejection of observations near land switch    
+   nmsshc     = 0          ! MSSH correction scheme                         
+                           !     mdtcorr                 MDT  correction                               
+                           !     mdtcutoff               MDT cutoff for computed correction          
+   ln_altbias = .false.    ! Logical switch for alt bias                
+   ln_ignmis  = .true.     ! Logical switch for ignoring missing files   
+                           !     endailyavtypes   ENACT daily average types                    
+   ln_grid_global = .true.
+   ln_grid_search_lookup = .false.
+/ 
+!-----------------------------------------------------------------------
+&nam_asminc   !   assimilation increments                               ('key_asminc')
+!-----------------------------------------------------------------------
+    ln_bkgwri = .false.    !  Logical switch for writing out background state 
+    ln_trjwri = .false.    !  Logical switch for writing out state trajectory
+    ln_trainc = .false.    !  Logical switch for applying tracer increments
+    ln_dyninc = .false.    !  Logical switch for applying velocity increments
+    ln_sshinc = .false.    !  Logical switch for applying SSH increments 
+    ln_asmdin = .false.    !  Logical switch for Direct Initialization (DI)
+    ln_asmiau = .false.    !  Logical switch for Incremental Analysis Updating (IAU)
+    nitbkg    = 0          !  Timestep of background in [0,nitend-nit000-1]
+    nitdin    = 0          !  Timestep of background for DI in [0,nitend-nit000-1]
+    nitiaustr = 1          !  Timestep of start of IAU interval in [0,nitend-nit000-1]
+    nitiaufin = 15         !  Timestep of end of IAU interval in [0,nitend-nit000-1]
+    niaufn    = 0          !  Type of IAU weighting function
+    nittrjfrq = 0          !  Frequency of trajectory output for 4D-VAR
+    ln_salfix = .false.    !  Logical switch for ensuring that the sa > salfixmin
+    salfixmin = -9999      !  Minimum salinity after applying the increments
+/
Index: trunk/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_pisces
===================================================================
--- trunk/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_pisces	(revision 2527)
+++ trunk/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_pisces	(revision 2528)
@@ -41,5 +41,5 @@
    xksi2      =  3.33E-6  ! half saturation constant for Si/C
    xkdoc      =  417.E-6  ! half-saturation constant of DOC remineralization
-   caco3r     =  0.3      ! mean rain ratio
+   caco3r     =  0.15     ! mean rain ratio
 /
 !'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
@@ -115,5 +115,5 @@
 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
    ln_dustfer  =  .true.   ! boolean for dust input from the atmosphere
-   ln_river    =  .false.   ! boolean for river input of nutrients
+   ln_river    =  .true.   ! boolean for river input of nutrients
    ln_ndepo    =  .true.   ! boolean for atmospheric deposition of N
    ln_sedinput =  .true.   ! boolean for Fe input from sediments
Index: trunk/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_top
===================================================================
--- trunk/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_top	(revision 2527)
+++ trunk/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_top	(revision 2528)
@@ -1,70 +1,62 @@
 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-!! NEMO/TOP1 :  1 - tracer definition                     (namtoptrc)
-!! namelists    2 - dynamical tracer trends               (namtoptrd)
-!!              6 - tracer advection                      (namtopadv)
-!!              7 - tracer bottom boundary                (namtopbbl)
-!!              8 - tracer lateral diffusion              (namtopldf)
-!!              3 - tracer vertical physics               (namtopzdf)
-!!              9 - tracer newtonian damping              (namtopdmp)
+!! NEMO/TOP1 :  1 - tracer definition                     (namtrc    )
+!! namelists    2 - dynamical tracer trends               (namtrc_trd)
+!!              3 - tracer advection                      (namtrc_adv)
+!!              4 - tracer lateral diffusion              (namtrc_ldf)
+!!              5 - tracer vertical physics               (namtrc_zdf)
+!!              6 - tracer newtonian damping              (namtrc_dmp)
 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 !'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
-&namtoptrc     !   tracers definition
+&namtrc     !   tracers definition
 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
-   ndttrc      =  1        !  time step frequency for passive tracers      
-   nwritetrc   =  1460     !  time step frequency for tracer outputs
-   ln_rsttr    = .false.   !  start from a restart file (T) or not (F)
-   nrsttr      =   0       !  restart control = 0 initial time step is not compared to the restart file value
+   nn_dttrc      =  1        !  time step frequency for passive sn_tracers      
+   nn_writetrc   =  1460     !  time step frequency for sn_tracer outputs
+   ln_rsttr      = .false.   !  start from a restart file (T) or not (F)
+   nn_rsttr      =   0       !  restart control = 0 initial time step is not compared to the restart file value
                            !                  = 1 do not use the value in the restart file
                            !                  = 2 calendar parameters read in the restart file
-   cn_trcrst_in  = "restart_trc"   !  suffix of pass. tracer restart name (input)
-   cn_trcrst_out = "restart_trc"   !  suffix of pass. tracer restart name (output)
+   cn_trcrst_in  = "restart_trc"   !  suffix of pass. sn_tracer restart name (input)
+   cn_trcrst_out = "restart_trc"   !  suffix of pass. sn_tracer restart name (output)
 !
 !              !    name   !           title of the field              !   units    ! initial data ! save   !
 !              !           !                                           !            ! from file    ! or not ! 
 !              !           !                                           !            ! or not       !        !
-   tracer(1)   = 'DIC     ' , 'Dissolved inorganic Concentration      ',  'mol-C/L' ,  .true.     ,  .true.
-   tracer(2)   = 'Alkalini' , 'Total Alkalinity Concentration         ',  'eq/L '   ,  .true.     ,  .true.
-   tracer(3)   = 'O2      ' , 'Dissolved Oxygen Concentration         ',  'mol-C/L' ,  .true.     ,  .true.
-   tracer(4)   = 'CaCO3   ' , 'Calcite Concentration                  ',  'mol-C/L' ,  .false.    ,  .true.
-   tracer(5)   = 'PO4     ' , 'Phosphate Concentration                ',  'mol-C/L' ,  .true.     ,  .true.
-   tracer(6)   = 'POC     ' , 'Small organic carbon Concentration     ',  'mol-C/L' ,  .false.    ,  .true.
-   tracer(7)   = 'Si      ' , 'Silicate Concentration                 ',  'mol-C/L' ,  .true.     ,  .true.
-   tracer(8)   = 'PHY     ' , 'Nanophytoplankton Concentration        ',  'mol-C/L' ,  .false.    ,  .true.
-   tracer(9)   = 'ZOO     ' , 'Microzooplankton Concentration         ',  'mol-C/L' ,  .false.    ,  .true.
-   tracer(10)  = 'DOC     ' , 'Dissolved organic Concentration        ',  'mol-C/L' ,  .false.    ,  .true.
-   tracer(11)  = 'PHY2    ' , 'Diatoms Concentration                  ',  'mol-C/L' ,  .false.    ,  .true.
-   tracer(12)  = 'ZOO2    ' , 'Mesozooplankton Concentration          ',  'mol-C/L' ,  .false.    ,  .true.
-   tracer(13)  = 'BSi     ' , 'Diatoms Silicate Concentration         ',  'mol-C/L' ,  .false.    ,  .true.
-   tracer(14)  = 'Fer     ' , 'Dissolved Iron Concentration           ',  'mol-C/L' ,  .true.     ,  .true.
-   tracer(15)  = 'BFe     ' , 'Big iron particles Concentration       ',  'mol-C/L' ,  .false.    ,  .true.
-   tracer(16)  = 'GOC     ' , 'Big organic carbon Concentration       ',  'mol-C/L' ,  .false.    ,  .true.
-   tracer(17)  = 'SFe     ' , 'Small iron particles Concentration     ',  'mol-C/L' ,  .false.    ,  .true.
-   tracer(18)  = 'DFe     ' , 'Diatoms iron  Concentration            ',  'mol-C/L' ,  .false.    ,  .true.
-   tracer(19)  = 'DSi     ' , 'Sinking biogenic Silicate Concentration',  'mol-C/L' ,  .false.    ,  .true.
-   tracer(20)  = 'NFe     ' , 'Nano iron Concentration                ',  'mol-C/L' ,  .false.    ,  .true.
-   tracer(21)  = 'NCHL    ' , 'Nano chlorophyl Concentration          ',  'mol-C/L' ,  .false.    ,  .true.
-   tracer(22)  = 'DCHL    ' , 'Diatoms chlorophyl Concentration       ',  'mol-C/L' ,  .false.    ,  .true.
-   tracer(23)  = 'NO3     ' , 'Nitrates Concentration                 ',  'mol-C/L' ,  .true.     ,  .true.
-   tracer(24)  = 'NH4     ' , 'Ammonium Concentration                 ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(1)   = 'DIC     ' , 'Dissolved inorganic Concentration      ',  'mol-C/L' ,  .true.     ,  .true.
+   sn_tracer(2)   = 'Alkalini' , 'Total Alkalinity Concentration         ',  'eq/L '   ,  .true.     ,  .true.
+   sn_tracer(3)   = 'O2      ' , 'Dissolved Oxygen Concentration         ',  'mol-C/L' ,  .true.     ,  .true.
+   sn_tracer(4)   = 'CaCO3   ' , 'Calcite Concentration                  ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(5)   = 'PO4     ' , 'Phosphate Concentration                ',  'mol-C/L' ,  .true.     ,  .true.
+   sn_tracer(6)   = 'POC     ' , 'Small organic carbon Concentration     ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(7)   = 'Si      ' , 'Silicate Concentration                 ',  'mol-C/L' ,  .true.     ,  .true.
+   sn_tracer(8)   = 'PHY     ' , 'Nanophytoplankton Concentration        ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(9)   = 'ZOO     ' , 'Microzooplankton Concentration         ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(10)  = 'DOC     ' , 'Dissolved organic Concentration        ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(11)  = 'PHY2    ' , 'Diatoms Concentration                  ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(12)  = 'ZOO2    ' , 'Mesozooplankton Concentration          ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(13)  = 'BSi     ' , 'Diatoms Silicate Concentration         ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(14)  = 'Fer     ' , 'Dissolved Iron Concentration           ',  'mol-C/L' ,  .true.     ,  .true.
+   sn_tracer(15)  = 'BFe     ' , 'Big iron particles Concentration       ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(16)  = 'GOC     ' , 'Big organic carbon Concentration       ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(17)  = 'SFe     ' , 'Small iron particles Concentration     ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(18)  = 'DFe     ' , 'Diatoms iron  Concentration            ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(19)  = 'DSi     ' , 'Sinking biogenic Silicate Concentration',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(20)  = 'NFe     ' , 'Nano iron Concentration                ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(21)  = 'NCHL    ' , 'Nano chlorophyl Concentration          ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(22)  = 'DCHL    ' , 'Diatoms chlorophyl Concentration       ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(23)  = 'NO3     ' , 'Nitrates Concentration                 ',  'mol-C/L' ,  .true.     ,  .true.
+   sn_tracer(24)  = 'NH4     ' , 'Ammonium Concentration                 ',  'mol-C/L' ,  .false.    ,  .true.
 /
 !-----------------------------------------------------------------------
-&namtopadv    !   advection scheme for passive tracer 
+&namtrc_adv    !   advection scheme for passive tracer 
 !-----------------------------------------------------------------------
    ln_trcadv_cen2   =  .false.  !  2nd order centered scheme   
-   ln_trcadv_tvd    =  .false.  !  TVD scheme   
+   ln_trcadv_tvd    =  .false.  !  TVD scheme
    ln_trcadv_muscl  =  .true.   !  MUSCL scheme
    ln_trcadv_muscl2 =  .false.  !  MUSCL2 scheme + cen2 at boundaries
-   ln_trcadv_smolar =  .false.  !  SMOLAR scheme
-   rsc              =  1.       !  tuning coefficient for Smol-Car. scheme 
-   ncortrc          =  1        !  number of corrective phases for Smol-Car. scheme 
-   crosster         =  .false.  !  computes Smol-Car crossterms (T) or not (F)
+   ln_trcadv_ubs    =  .false.  !  UBS scheme
+   ln_trcadv_qck    =  .false.  !  QUICKEST scheme
 /
 !-----------------------------------------------------------------------
-&namtopbbl    !   bottom boundary layer scheme for passive tracer 
-!-----------------------------------------------------------------------
-   atrcbbl          = 1000.     !  lateral mixing coefficient in the bbl  [m2/s]
-/
-!-----------------------------------------------------------------------
-&namtopldf    !   lateral diffusion scheme for passive tracer 
+&namtrc_ldf    !   lateral diffusion scheme for passive tracer 
 !-----------------------------------------------------------------------
    ln_trcldf_diff   =  .true.   !  performs lateral diffusion (T) or not (F)
@@ -77,67 +69,63 @@
    ln_trcldf_iso    =  .true.   !     iso-neutral                       (require "key_ldfslp")
 !                               !  Coefficient
-   ahtrc0      =  2000.         !     horizontal eddy diffusivity for tracers [m2/s]
-   ahtrb0      =     0.         !     background eddy diffusivity for ldf_iso [m2/s]
-   aeivtr0     =  2000.         !     eddy induced velocity coefficient [m2/s]    (require "key_trcldf_eiv")
-   trcrat      =  1.            !  ratio betweeen passive and active tracer diffusion coeff
+   rn_ahtrb_0       =     0.    !     background eddy diffusivity for ldf_iso [m2/s]
 /
 !-----------------------------------------------------------------------
-&namtopzdf        !   vertical physics
+&namtrc_zdf        !   vertical physics
 !-----------------------------------------------------------------------
    ln_trczdf_exp   =  .false.  !  split explicit (T) or implicit (F) time stepping
-   n_trczdf_exp    =   3       !  number of sub-timestep for ln_trczdfexp=T
+   nn_trczdf_exp   =   3       !  number of sub-timestep for ln_trczdfexp=T
 /
 !-----------------------------------------------------------------------
-&namtoprad        !  treatment of negative concentrations 
+&namtrc_rad        !  treatment of negative concentrations 
 !-----------------------------------------------------------------------
    ln_trcrad   =  .true.  !  artificially correct negative concentrations (T) or not (F)
 /
 !-----------------------------------------------------------------------
-&namtopdmp        !   passive tracer newtonian damping                 ('key_trcdmp')
+&namtrc_dmp    !   passive tracer newtonian damping    ('key_tradmp && key_trcdmp')
 !-----------------------------------------------------------------------
-   ndmptr      =   20      !  type of damping in passive tracers
-                           !     ='latitude', damping poleward of 'ndmp' degrees and function 
-                           !                  of the distance-to-coast. Red and Med Seas as ndmptr=-1
-                           !     =-1 damping only in Med and Red Seas
-   ndmpftr     =    0      !  create a damping.coeff NetCDF file (=1) or not (=0)
-   nmldmptr    =    1      !  type of damping: =0 damping throughout the water column
-                           !                   =1 no damping in the mixed layer defined by avt >5cm2/s )
-                           !                   =2 no damping in the mixed layer defined rho<rho(surf)+.01 )
-   sdmptr      =   50.     !  surface time scale for internal damping (days)
-   bdmptr      =  360.     !  bottom  time scale for internal damping (days)
-   hdmptr      =  800.     !  depth of transition between sdmptr and bdmptr (meters)
+   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)
 /
 !-----------------------------------------------------------------------
-&namtoptrd       !   diagnostics on tracer trends
+&namtrc_trd       !   diagnostics on tracer trends        ('key_trdtrc')
 !                          or mixed-layer trends          ('key_trdmld_trc')
 !----------------------------------------------------------------------
-   ntrd_trc   =  1460      !  time step frequency and tracers trends
-   nctls_trc  =   0        !  control surface type in mixed-layer trends (0,1 or n<jpk)
-   ucf_trc    =   1        !  unit conversion factor (=1 -> /seconds ; =86400. -> /day)
+   nn_trd_trc  =  5475      !  time step frequency and tracers trends
+   nn_ctls_trc =   0        !  control surface type in mixed-layer trends (0,1 or n<jpk)
+   rn_ucf_trc  =   1        !  unit conversion factor (=1 -> /seconds ; =86400. -> /day)
    ln_trdmld_trc_restart = .false.  !  restart for ML diagnostics
    ln_trdmld_trc_instant = .true.  !  flag to diagnose trends of instantantaneous or mean ML T/S
-   luttrd(1)  =   .true.
-   luttrd(2)  =   .true.
-   luttrd(3)  =   .false.
-   luttrd(4)  =   .false.
-   luttrd(5)  =   .false.
-   luttrd(6)  =   .false.
-   luttrd(7)  =   .false.
-   luttrd(8)  =   .false.
-   luttrd(9)  =   .false.
-   luttrd(10) =   .false.
-   luttrd(11) =   .false.
-   luttrd(12) =   .false.
-   luttrd(13) =   .false.
-   luttrd(14) =   .false.
-   luttrd(15) =   .false.
-   luttrd(16) =   .false.
-   luttrd(17) =   .false.
-   luttrd(18) =   .false.
-   luttrd(19) =   .false.
-   luttrd(20) =   .false.
-   luttrd(21) =   .false.
-   luttrd(22) =   .false.
-   luttrd(23) =   .true.
-   luttrd(24) =   .false.
+   ln_trdtrc(1)  =   .true.
+   ln_trdtrc(2)  =   .true.
+   ln_trdtrc(3)  =   .false.
+   ln_trdtrc(4)  =   .false.
+   ln_trdtrc(5)  =   .false.
+   ln_trdtrc(6)  =   .false.
+   ln_trdtrc(7)  =   .false.
+   ln_trdtrc(8)  =   .false.
+   ln_trdtrc(9)  =   .false.
+   ln_trdtrc(10) =   .false.
+   ln_trdtrc(11) =   .false.
+   ln_trdtrc(12) =   .false.
+   ln_trdtrc(13) =   .false.
+   ln_trdtrc(14) =   .false.
+   ln_trdtrc(15) =   .false.
+   ln_trdtrc(16) =   .false.
+   ln_trdtrc(17) =   .false.
+   ln_trdtrc(18) =   .false.
+   ln_trdtrc(19) =   .false.
+   ln_trdtrc(20) =   .false.
+   ln_trdtrc(21) =   .false.
+   ln_trdtrc(22) =   .false.
+   ln_trdtrc(23) =   .true.
+   ln_trdtrc(24) =   .false.
 /
Index: trunk/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/xmlio_server.def
===================================================================
--- trunk/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/xmlio_server.def	(revision 2527)
+++ trunk/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/xmlio_server.def	(revision 2528)
@@ -17,2 +17,19 @@
   global_mpi_buffer_size = 512
 /  
+
+!!======================================================================
+!!   namnc4            netcdf4 chunking and compression settings
+!!======================================================================
+!-----------------------------------------------------------------------
+&namnc4         !  netcdf4 chunking and compression settings
+                !  (benign if "key_netcdf4" is not used)
+!-----------------------------------------------------------------------
+   nn_nchunks_i   =   4       !  number of chunks in i-dimension
+   nn_nchunks_j   =   4       !  number of chunks in j-dimension
+   nn_nchunks_k   =   31      !  number of chunks in k-dimension
+                              !  setting nn_nchunks_k = jpk will give a chunk size of 1 in the vertical which
+                              !  is optimal for postprocessing which works exclusively with horizontal slabs
+   ln_nc4zip      =   .TRUE.  !  (T) use netcdf4 chunking and compression
+                              !  (F) ignore chunking information and produce netcdf3-compatible files  
+/
+  
Index: trunk/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/cpp_ORCA2_OFF_PISCES.fcm
===================================================================
--- trunk/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/cpp_ORCA2_OFF_PISCES.fcm	(revision 2528)
+++ trunk/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/cpp_ORCA2_OFF_PISCES.fcm	(revision 2528)
@@ -0,0 +1,1 @@
+bld::tool::fppkeys key_trabbl key_vectopt_loop key_orca_r2 key_dynspg_flt key_ldfslp key_traldf_c2d key_traldf_eiv key_zdftke key_top key_offline key_pisces key_dtatrc key_diatrc key_iomput key_nproci=1 key_nprocj=1
Index: trunk/NEMOGCM/CONFIG/POMME/AA_make
===================================================================
--- trunk/NEMOGCM/CONFIG/POMME/AA_make	(revision 2527)
+++ 	(revision )
@@ -1,13 +1,0 @@
-# $Header$
-all: ioipsl opa
-
-ioipsl:
-	(cd ../../modeles/IOIPSL/src; $(M_K) ;)
-
-
-opa:
-	(cd ../../modeles/NEMO/WORK;  $(M_K) ;)
-
-
-clean:
-	(cd ../../modeles/NEMO/WORK;  $(M_K) clean ;)
Index: trunk/NEMOGCM/CONFIG/POMME/AA_make.ldef
===================================================================
--- trunk/NEMOGCM/CONFIG/POMME/AA_make.ldef	(revision 2527)
+++ 	(revision )
@@ -1,11 +1,0 @@
-#---------------------------------------------------------------------
-#- Creation des elements relatifs a ORCA :
-#-      ORCA  (lib, executable : opa)
-#---------------------------------------------------------------------
-SHELL = /bin/sh
-#---------------------------------------------------------------------
-LIBDIR = ../../../../lib
-BINDIR = ../../../../bin
-MODDIR = $(LIBDIR)
-#---------------------------------------------------------------------
-#-
Index: trunk/NEMOGCM/CONFIG/POMME/EXP00/AA_job
===================================================================
--- trunk/NEMOGCM/CONFIG/POMME/EXP00/AA_job	(revision 2527)
+++ trunk/NEMOGCM/CONFIG/POMME/EXP00/AA_job	(revision 2528)
@@ -109,6 +109,4 @@
 #- Namelist for ocean
 cp ${R_EXPER}/namelist namelist
-cp ${R_EXPER}/iodef.xml .
-cp ${R_EXPER}/xmlio_server.def .
 
 #- Files for the configuration and ocean dynamics
Index: trunk/NEMOGCM/CONFIG/POMME/EXP00/iodef.xml
===================================================================
--- trunk/NEMOGCM/CONFIG/POMME/EXP00/iodef.xml	(revision 2527)
+++ trunk/NEMOGCM/CONFIG/POMME/EXP00/iodef.xml	(revision 2528)
@@ -54,6 +54,6 @@
       <group id="SBC" axis_ref="none" grid_ref="grid_T" > <!-- time step automaticaly defined based on nn_fsbc -->
 
-	<field id="emp"          description="Net Upward Water Flux"                                        unit="kg/m2/s"  />
-	<field id="emps"         description="concentration/dilution water flux"                            unit="kg/m2/s"  />
+	<field id="emp-rnf"      description="Net Upward Water Flux"                                        unit="kg/m2/s"  />
+	<field id="emps-rnf"     description="concentration/dilution water flux"                            unit="kg/m2/s"  />
 	<field id="snowpre"      description="Snow precipitation"                                           unit="kg/m2/s"  />
 	<field id="runoffs"      description="River Runoffs"                                                unit="Kg/m2/s"  />
@@ -138,4 +138,5 @@
 	<!-- uoce_eiv: available with key_trabbl_adv -->
 	<field id="uoce_bbl"     description="BBL ocean current along i-axis"              unit="m/s"                  />
+	<field id="ahu_bbl"      description="BBL diffusive flux along i-axis"             unit="m3/s" axis_ref="none" />
  	<!-- variables available with key_diaar5 -->
 	<field id="u_masstr"     description="ocean eulerian mass transport along i-axis"  unit="kg/s"                 />
@@ -155,4 +156,5 @@
 	<!-- voce_eiv: available with key_trabbl_adv -->
 	<field id="voce_bbl"     description="BBL ocean current along j-axis"              unit="m/s"                  />
+	<field id="ahv_bbl"      description="BBL diffusive flux along j-axis"             unit="m3/s" axis_ref="none" />
 	<!-- variables available with key_diaar5 -->
 	<field id="v_masstr"     description="ocean eulerian mass transport along j-axis"  unit="kg/s"                 />
@@ -170,5 +172,4 @@
 	<field id="woce_eiv"     description="EIV ocean vertical velocity"                 unit="m/s"                  />
 	<!-- woce_eiv: available with key_trabbl_adv -->
-	<field id="woce_bbl"     description="BBL ocean vertical velocity"                 unit="m/s"                  />
 	<field id="avt"          description="vertical eddy diffusivity"                   unit="m2/s"                 />
 	<field id="avm"          description="vertical eddy viscosity"                     unit="m2/s"                 />
@@ -220,7 +221,7 @@
 	<field ref="sss"          name="sosaline"  />
 	<field ref="ssh"          name="sossheig"  />
-	<field ref="emp"          name="sowaflup"  />
+	<field ref="emp-rnf"      name="sowaflup"  />
 	<field ref="qsr"          name="soshfldo"  />
-	<field ref="emps"         name="sowaflcd"  />
+	<field ref="emps-rnf"     name="sowaflcd"  />
 	<field ref="qns+qsr"      name="sohefldo"  />
 	<field ref="mldr10_1"     name="somxl010"  />
Index: trunk/NEMOGCM/CONFIG/POMME/EXP00/namelist
===================================================================
--- trunk/NEMOGCM/CONFIG/POMME/EXP00/namelist	(revision 2527)
+++ trunk/NEMOGCM/CONFIG/POMME/EXP00/namelist	(revision 2528)
@@ -1,7 +1,8 @@
 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 !! NEMO/OPA  :  1 - run manager      (namrun)
-!! namelists    2 - Domain           (namzgr, namzgr_sco, namdom)
+!! namelists    2 - Domain           (namzgr, namzgr_sco, namdom, namdta_tem, namdta_sal)
 !!              3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core
-!!                                    namsbc_cpl, namqsr, namsbc_rnf, namsbc_ssr, namsbc_alb)
+!!                                    namsbc_cpl, namsbc_cpl_co2 namtra_qsr, namsbc_rnf, 
+!!                                    namsbc_apr, namsbc_ssr, namsbc_alb)
 !!              4 - lateral boundary (namlbc, namcla, namobc, namagrif, nambdy, nambdy_tide)
 !!              5 - bottom  boundary (nambfr, nambbc, nambbl)
@@ -9,15 +10,15 @@
 !!              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      (namtrd, namgap, namspr, namflo, namptr)
-!!              9 - miscellaneous    (namsol, nammpp, nammpp_dyndist, namctl)
+!!              9 - diagnostics      (namnc4, namtrd, namspr, namflo, namptr, namhsb)
+!!             10 - miscellaneous    (namsol, nammpp, nammpp_dyndist, namctl)
+!!             11 - Obs & Assim      (namobs, nam_asminc)
 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-!  CAUTION: some scripts does not support CAPITALs for logical use .true./.false., not .TRUE./.FALSE.
 
 !!======================================================================
 !!                   ***  Run management namelists  ***
 !!======================================================================
-!!   namrun            parameters of the run
-!!======================================================================
-
+!!   namrun        parameters of the run
+!!======================================================================
+!
 !-----------------------------------------------------------------------
 &namrun        !   parameters of the run
@@ -26,21 +27,22 @@
    cn_exp      = "POMM025" !  experience name 
    nn_it000    =       1   !  first time step
-   nn_itend    =   21900   !  last  time step (std 5475)
-   nn_date0    =  19880101 !  initial calendar date yymmdd (used if nrstdt=1)
+   nn_itend    =   21900   !  last  time step
+   nn_date0    =  19880101 !  initial calendar date yymmdd (used if nn_rstctl=1)
    nn_leapy    =       0   !  Leap year calendar (1) or not (0)
-   nn_istate   =       0   !  output the initial state (1) or not (0)
-   nn_stock    =   21900   !  frequency of creation of a restart file (modulo referenced to 1)
-   nn_write    =     300   !  frequency of write in the output file   (modulo referenced to nit000)
-   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  = .true.    !  clobber (overwrite) an existing file
-   nn_chunksz  =       0   !  chunksize (bytes) for NetCDF file (working only with iom_nf90 routines)
    ln_rstart   = .false.   !  start from rest (F) or from a restart file (T)
-   nn_rstctl   =       0       !  restart control = 0 nit000 is not compared to the restart file value
-                               !                  = 1 use ndate0 in namelist (not the value in the restart file)
+   nn_rstctl   =       0       !  restart control = 0 nn_it000 is not compared to the restart file value
+                               !                  = 1 use nn_date0 in namelist (not the value in the restart file)
                                !                  = 2 calendar parameters read in the restart file
    cn_ocerst_in  = "restart"   !  suffix of ocean restart name (input)
    cn_ocerst_out = "restart"   !  suffix of ocean restart name (output)
-/
+   nn_istate   =       0   !  output the initial state (1) or not (0)
+   nn_stock    =   21900   !  frequency of creation of a restart file (modulo referenced to 1)
+   nn_write    =     300   !  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
+   nn_chunksz  =       0   !  chunksize (bytes) for NetCDF file (works only with iom_nf90 routines)
+/
+
 !!======================================================================
 !!                      ***  Domain namelists  ***
@@ -49,6 +51,8 @@
 !!   namzgr_sco   s-coordinate or hybrid z-s-coordinate
 !!   namdom       space and time domain (bathymetry, mesh, timestep)
-!!======================================================================
-
+!!   namdta_tem   data: temperature                                     ("key_dtatem")
+!!   namdta_sal   data: salinity                                        ("key_dtasal")
+!!======================================================================
+!
 !-----------------------------------------------------------------------
 &namzgr        !   vertical coordinate
@@ -63,7 +67,7 @@
    rn_sbot_min =  300.     !  minimum depth of s-bottom surface (>0) (m)
    rn_sbot_max = 5250.     !  maximum depth of s-bottom surface (= ocean depth) (>0) (m)
-   rn_theta    =    6.0    !  surface control parameter (0<=theta<=20)
-   rn_thetb    =    0.75   !  bottom control parameter  (0<=thetb<= 1)
-   rn_rmax     =    0.15   !  maximum cut-off r-value allowed (0<r_max<1)
+   rn_theta    =    6.0    !  surface control parameter (0<=rn_theta<=20)
+   rn_thetb    =    0.75   !  bottom control parameter  (0<=rn_thetb<= 1)
+   rn_rmax     =    0.15   !  maximum cut-off r-value allowed (0<rn_max<1)
    ln_s_sigma  = .false.   !  hybrid s-sigma coordinates
    rn_bb       =    0.8    !  stretching with s-sigma
@@ -73,57 +77,77 @@
 &namdom        !   space and time domain (bathymetry, mesh, timestep)
 !-----------------------------------------------------------------------
-   nn_bathy    =    1      !  compute (=0) or read(=1) the bathymetry file
-   nn_closea   =    0      !  closed seas and lakes are removed (=0) or kept (=1) from the ORCA domain
-   nn_msh      =    0      !  create (=1) a mesh file (coordinates, scale factors, masks) or not (=0)
-   rn_e3zps_min=   25.     !  the thickness of the partial step is set larger than the minimum
-   rn_e3zps_rat=    0.2    !  of e3zps_min and e3zps_rat * e3t   (N.B. 0<e3zps_rat<1)
+   nn_bathy    =    1      !  compute (=0) or read (=1) the bathymetry file
+   nn_closea    =   0      !  remove (=0) or keep (=1) closed seas and lakes (ORCA)
+   nn_msh      =    0      !  create (=1) a mesh file or not (=0)
+   rn_hmin     =   -3.     !  min depth of the ocean (>0) or min number of ocean level (<0)
+   rn_e3zps_min=   25.     !  partial step thickness is set larger than the minimum of
+   rn_e3zps_rat=    0.2    !  rn_e3zps_min and rn_e3zps_rat * e3t   (N.B. 0<rn_e3zps_rat<1)
                            !
    rn_rdt      = 1440.     !  time step for the dynamics (and tracer if nacc=0)   ==> 5760
-   nn_baro     =   64      !  number of barotropic time step (for the split explicit algorithm) ("key_dynspg_ts")
+   nn_baro     =   64      !  number of barotropic time step            ("key_dynspg_ts")
    rn_atfp     =    0.1    !  asselin time filter parameter
    nn_acc      =    0      !  acceleration of convergence : =1      used, rdt < rdttra(k)
                                  !                          =0, not used, rdt = rdttra
-   rn_rdtmin   = 1440.          !  minimum time step on tracers (used if nacc=1)
-   rn_rdtmax   = 1440.          !  maximum time step on tracers (used if nacc=1)
-   rn_rdth     =  800.           !  depth variation of tracer time step  (used if nacc=1)
-/
+   rn_rdtmin   = 1440.           !  minimum time step on tracers (used if nn_acc=1)
+   rn_rdtmax   = 1440.           !  maximum time step on tracers (used if nn_acc=1)
+   rn_rdth     =  800.           !  depth variation of tracer time step  (used if nn_acc=1)
+/
+!-----------------------------------------------------------------------
+&namdta_tem    !   data : temperature                                   ("key_dtatem")
+!-----------------------------------------------------------------------
+!              ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation !
+!              !           !  (if <0  months)     !   name   !  (logical)   ! (T/F) ! 'monthly'  ! filename ! pairing  !
+   sn_tem = 'data_1m_potential_temperature_nomask', -1,'votemper',  .true.  , .true., 'yearly'   , ' '      , ' '
+   !
+   cn_dir       = './'     !  root directory for the location of the runoff files
+/
+!-----------------------------------------------------------------------
+&namdta_sal    !   data : salinity                                      ("key_dtasal")
+!-----------------------------------------------------------------------
+!              ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation !
+!              !           !  (if <0  months)     !   name   !   (logical)  ! (T/F) ! 'monthly'  ! filename ! pairing  !
+   sn_sal      =  'data_1m_salinity_nomask',  -1  ,'vosaline',    .true.    , .true., 'yearly'   , ''       , ' '
+   !
+   cn_dir      = './'      !  root directory for the location of the runoff files
+/
+
 !!======================================================================
 !!            ***  Surface Boundary Condition namelists  ***
 !!======================================================================
-!!   namsbc        surface boundary condition
-!!   namsbc_ana    analytical         formulation
-!!   namsbc_flx    flux               formulation
-!!   namsbc_clio   CLIO bulk formulea formulation
-!!   namsbc_core   CORE bulk formulea formulation
-!!   namsbc_cpl    CouPLed            formulation                       ("key_coupled")
-!!   namtra_qsr    penetrative solar radiation
-!!   namsbc_rnf    river runoffs
-!!   namsbc_ssr    sea surface restoring term (for T and/or S)
-!!   namsbc_alb    albedo parameters
-!!======================================================================
-
+!!   namsbc          surface boundary condition
+!!   namsbc_ana      analytical         formulation
+!!   namsbc_flx      flux               formulation
+!!   namsbc_clio     CLIO bulk formulea formulation
+!!   namsbc_core     CORE bulk formulea formulation
+!!   namsbc_cpl      CouPLed            formulation                     ("key_coupled")
+!!   namsbc_cpl_co2  coupled ocean/biogeo/atmosphere model              ("key_cpl_carbon_cycle")
+!!   namtra_qsr      penetrative solar radiation
+!!   namsbc_rnf      river runoffs
+!!   namsbc_apr      Atmospheric Pressure
+!!   namsbc_ssr      sea surface restoring term (for T and/or S)
+!!   namsbc_alb      albedo parameters
+!!======================================================================
+!
 !-----------------------------------------------------------------------
 &namsbc        !   Surface Boundary Condition (surface module)
 !-----------------------------------------------------------------------
    nn_fsbc     = 5         !  frequency of surface boundary condition computation 
-                           !               (= the frequency of sea-ice model call)
-   ln_ana      = .false.   !  analytical formulation (T => fill namsbc_ana ) 
-   ln_flx      = .false.   !  flux formulation       (T => fill namsbc_flx )
-   ln_blk_clio = .false.   !  CLIO bulk formulation  (T => fill namsbc_clio) 
-   ln_blk_core = .true.    !  CORE bulk formulation  (T => fill namsbc_core) 
-   ln_cpl      = .false.   !  Coupled formulation    (T => fill namsbc_cpl )
+                           !     (also = the frequency of sea-ice model call)
+   ln_ana      = .false.   !  analytical formulation                    (T => fill namsbc_ana ) 
+   ln_flx      = .false.   !  flux formulation                          (T => fill namsbc_flx )
+   ln_blk_clio = .false.   !  CLIO bulk formulation                     (T => fill namsbc_clio) 
+   ln_blk_core = .true.    !  CORE bulk formulation                     (T => fill namsbc_core) 
+   ln_cpl      = .false.   !  Coupled formulation                       (T => fill namsbc_cpl )
+   ln_apr_dyn  = .false.   !  Patm gradient added in ocean & ice Eqs.   (T => fill namsbc_apr )
    nn_ice      = 0         !  =0 no ice boundary condition   ,
                            !  =1 use observed ice-cover      ,
-                           !  =2 ice-model used                             ("key_lim3" or "key_lim2)
-   nn_ico_cpl  = 0         !  ice-ocean coupling : =0 each nn_fsbc 
-                           !                       =1 stresses recomputed each ocean time step ("key_lim3" only)
-                           !                       =2 combination of 0 and 1 cases             ("key_lim3" only)
-   ln_dm2dc    = .false.   !  daily mean to diurnal cycle short wave (qsr)
-   ln_rnf      = .false.    !  runoffs (T => fill namsbc_rnf)
-   ln_ssr      = .true.    !  Sea Surface Restoring on T and/or S (T => fill namsbc_ssr)
+                           !  =2 ice-model used                         ("key_lim3" or "key_lim2)
+   ln_dm2dc    = .false.   !  daily mean to diurnal cycle on short wave
+   ln_rnf      = .false.   !  runoffs                                   (T => fill namsbc_rnf)
+   ln_ssr      = .true.    !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr)
    nn_fwb      = 0         !  FreshWater Budget: =0 unchecked 
-                           !                     =1 global mean of e-p-r set to zero at each time step 
-                           !                     =2 annual global mean of e-p-r set to zero
-                           !                     =3 global emp set to zero and spread out over erp area
+                           !     =1 global mean of e-p-r set to zero at each time step 
+                           !     =2 annual global mean of e-p-r set to zero
+                           !     =3 global emp set to zero and spread out over erp area
 /
 !-----------------------------------------------------------------------
@@ -133,5 +157,5 @@
    rn_utau0    =   0.5     !  uniform value for the i-stress
    rn_vtau0    =   0.e0    !  uniform value for the j-stress
-   rn_q0       =   0.e0    !  uniform value for the total heat flux
+   rn_qns0     =   0.e0    !  uniform value for the total heat flux
    rn_qsr0     =   0.e0    !  uniform value for the solar radiation
    rn_emp0     =   0.e0    !  uniform value for the freswater budget (E-P)
@@ -140,12 +164,12 @@
 &namsbc_flx    !   surface boundary condition : flux formulation
 !-----------------------------------------------------------------------
-!              !   file name  ! frequency (hours) !  variable  ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
-!              !              !  (if <0  months)  !    name    !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
-   sn_utau     = 'utau'       ,        24         ,    'utau'  ,     .false.    , .false. , 'yearly'  , ''       , ''
-   sn_vtau     = 'vtau'       ,        24         ,    'vtau'  ,     .false.    , .false. , 'yearly'  , ''       , ''
-   sn_qtot     = 'qtot'       ,        24         ,    'qtot'  ,     .false.    , .false. , 'yearly'  , ''       , ''
-   sn_qsr      = 'qsr'        ,        24         ,    'qsr'   ,     .false.    , .false. , 'yearly'  , ''       , ''
-   sn_emp      = 'emp'        ,        24         ,    'emp'   ,     .false.    , .false. , 'yearly'  , ''       , ''
-!
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_utau     = 'utau'      ,        24         , 'utau'    , .false.      , .false., 'yearly'  , ''       , ''
+   sn_vtau     = 'vtau'      ,        24         , 'vtau'    , .false.      , .false., 'yearly'  , ''       , ''
+   sn_qtot     = 'qtot'      ,        24         , 'qtot'    , .false.      , .false., 'yearly'  , ''       , ''
+   sn_qsr      = 'qsr'       ,        24         , 'qsr'     , .false.      , .false., 'yearly'  , ''       , ''
+   sn_emp      = 'emp'       ,        24         , 'emp'     , .false.      , .false., 'yearly'  , ''       , ''
+
    cn_dir      = './'      !  root directory for the location of the flux files
 /      
@@ -153,14 +177,14 @@
 &namsbc_clio   !   namsbc_clio  CLIO bulk formulea
 !-----------------------------------------------------------------------
-!              !   file name  ! frequency (hours) !  variable  ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
-!              !              !  (if <0  months)  !    name    !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
-   sn_utau     = 'taux_1m'    ,       -1          , 'sozotaux' ,    .true.      , .true.  , 'yearly'  , ''       , ''
-   sn_vtau     = 'tauy_1m'    ,       -1          , 'sometauy' ,    .true.      , .true.  , 'yearly'  , ''       , ''
-   sn_wndm     = 'flx'        ,       -1          , 'socliowi' ,    .true.      , .true.  , 'yearly'  , ''       , ''
-   sn_tair     = 'flx'        ,       -1          , 'socliot2' ,    .true.      , .true.  , 'yearly'  , ''       , ''
-   sn_humi     = 'flx'        ,       -1          , 'socliohu' ,    .true.      , .true.  , 'yearly'  , ''       , ''
-   sn_ccov     = 'flx'        ,       -1          , 'socliocl' ,    .false.     , .true.  , 'yearly'  , ''       , ''
-   sn_prec     = 'flx'        ,       -1          , 'socliopl' ,    .false.     , .true.  , 'yearly'  , ''       , ''
-!
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_utau     = 'taux_1m'   ,       -1          , 'sozotaux',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_vtau     = 'tauy_1m'   ,       -1          , 'sometauy',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_wndm     = 'flx'       ,       -1          , 'socliowi',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_tair     = 'flx'       ,       -1          , 'socliot2',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_humi     = 'flx'       ,       -1          , 'socliohu',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_ccov     = 'flx'       ,       -1          , 'socliocl',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_prec     = 'flx'       ,       -1          , 'socliopl',   .false.    , .true. , 'yearly'  , ''       , ''
+
    cn_dir      = './'      !  root directory for the location of the bulk files are
 /
@@ -168,62 +192,62 @@
 &namsbc_core   !   namsbc_core  CORE bulk formulea
 !-----------------------------------------------------------------------
-!              !   file name      ! frequency (hours) ! variable   ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
-!              !                  !  (if <0  months)  !   name     !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
-   sn_wndi     = 'u10_1988'       ,       24          , 'u10'      ,    .true.      , .true. ,   'yearly' , ''
-   sn_wndj     = 'v10_1988'       ,       24          , 'v10'      ,    .true.      , .true. ,   'yearly' , ''
-   sn_qsr      = 'radsw_1988'     ,       24          , 'radsw'    ,    .true.      , .true. ,   'yearly' , ''
-   sn_qlw      = 'radlw_1988'     ,       24          , 'radlw'    ,    .true.      , .true. ,   'yearly' , ''
-   sn_tair     = 't2_1988.nc'     ,       24          , 't2'       ,    .true.      , .true. ,   'yearly' , ''
-   sn_humi     = 'q2_1988'        ,       24          , 'q2'       ,    .true.      , .true. ,   'yearly' , ''
-   sn_prec     = 'precip_1988.nc' ,       -1          , 'precip'   ,    .true.      , .true. ,   'yearly' , ''
-   sn_snow     = 'precip_1988.nc' ,       -1          , 'precip'   ,    .true.      , .true. ,   'yearly' , ''
-   sn_tdif     = 'taudif_core'    ,       24          , 'taudif'   ,    .true.      , .true.  ,   'yearly'  ,''
-!
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_wndi = 'u_10.15JUNE2009_orca2'       ,  6  , 'U_10_MOD',   .false.    , .true. , 'yearly'  , ''       , 'Uwnd'
+   sn_wndj = 'v_10.15JUNE2009_orca2'       ,  6  , 'V_10_MOD',   .false.    , .true. , 'yearly'  , ''       , 'Vwnd'
+   sn_qsr  = 'ncar_rad.15JUNE2009_orca2'   , 24  , 'SWDN_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_qlw  = 'ncar_rad.15JUNE2009_orca2'   , 24  , 'LWDN_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_tair = 't_10.15JUNE2009_orca2'       ,  6  , 'T_10_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_humi = 'q_10.15JUNE2009_orca2'       ,  6  , 'Q_10_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_prec = 'ncar_precip.15JUNE2009_orca2', -1  , 'PRC_MOD1',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_snow = 'ncar_precip.15JUNE2009_orca2', -1  , 'SNOW'    ,   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_tdif = 'taudif_core'                 , 24  , 'taudif'  ,   .false.    , .true. , 'yearly'  , ''       , ''
+
    cn_dir      = './'      !  root directory for the location of the bulk files
    ln_2m       = .false.   !  air temperature and humidity referenced at 2m (T) instead 10m (F)
-   ln_taudif   = .false.   !  HF tau contribution: use "mean of stress module - module of the mean stress" data ?
+   ln_taudif   = .false.   !  HF tau contribution: use "mean of stress module - module of the mean stress" data
    rn_pfac     = 1.        !  multiplicative factor for precipitation (total & snow)
 /
 !-----------------------------------------------------------------------
-&namsbc_cpl    !   coupled ocean/atmosphere model                        ("key_coupled")
-!-----------------------------------------------------------------------
-                                       ! send
-cn_snd_temperature= 'weighted oce and ice'  ! 'oce only' 'weighted oce and ice' 'mixed oce-ice'
-cn_snd_albedo     = 'weighted ice'          ! 'none' 'weighted ice' 'mixed oce-ice'
-cn_snd_thickness  = 'none'                  ! 'none' 'weighted ice and snow'
-cn_snd_crt_nature = 'none'                  ! 'none' 'oce only' 'weighted oce and ice' 'mixed oce-ice'
-cn_snd_crt_refere = 'spherical'             ! 'spherical' 'cartesian'
-cn_snd_crt_orient = 'eastward-northward'    ! 'eastward-northward' or 'local grid'
-cn_snd_crt_grid   = 'T'                     ! 'T'
-                                       ! receive
-cn_rcv_w10m       = 'none'                  ! 'none' 'coupled'
-cn_rcv_taumod     = 'coupled'               ! 'none' 'coupled'
-cn_rcv_tau_nature = 'oce only'              ! 'oce only' 'oce and ice' 'mixed oce-ice'
-cn_rcv_tau_refere = 'cartesian'             ! 'spherical' 'cartesian'
-cn_rcv_tau_orient = 'eastward-northward'    ! 'eastward-northward' or 'local grid'
-cn_rcv_tau_grid   = 'U,V'                   ! 'T' 'U,V' 'U,V,F' 'U,V,I' 'T,F' 'T,I' 'T,U,V'
-cn_rcv_dqnsdt     = 'coupled'               ! 'none' 'coupled'
-cn_rcv_qsr        = 'oce and ice'           ! 'conservative' 'oce and ice' 'mixed oce-ice'
-cn_rcv_qns        = 'oce and ice'           ! 'conservative' 'oce and ice' 'mixed oce-ice'
-cn_rcv_emp        = 'conservative'          ! 'conservative' 'oce and ice' 'mixed oce-ice'
-cn_rcv_rnf        = 'coupled'               ! 'coupled' 'climato' 'mixed'
-cn_rcv_cal        = 'coupled'               ! 'none' 'coupled'
-/
-!-----------------------------------------------------------------------
-&namsbc_cpl_co2   !   coupled ocean/biogeo/atmosphere model            ("key_cpl_carbon_cycle")
-!-----------------------------------------------------------------------
-cn_snd_co2        = 'coupled'         ! send    :  'none' 'coupled'
-cn_rcv_co2        = 'coupled'         ! receive : 'none' 'coupled'
+&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_coupled")
+!-----------------------------------------------------------------------
+!                                      ! send
+cn_snd_temperature= 'weighted oce and ice'  !  'oce only' 'weighted oce and ice' 'mixed oce-ice'
+cn_snd_albedo     = 'weighted ice'          !  'none' 'weighted ice' 'mixed oce-ice'
+cn_snd_thickness  = 'none'                  !  'none' 'weighted ice and snow'
+cn_snd_crt_nature = 'none'                  !  'none' 'oce only' 'weighted oce and ice' 'mixed oce-ice'
+cn_snd_crt_refere = 'spherical'             !  'spherical' 'cartesian'
+cn_snd_crt_orient = 'eastward-northward'    !  'eastward-northward' or 'local grid'
+cn_snd_crt_grid   = 'T'                     !  'T'
+!                                      ! receive
+cn_rcv_w10m       = 'none'                  !  'none' 'coupled'
+cn_rcv_taumod     = 'coupled'               !  'none' 'coupled'
+cn_rcv_tau_nature = 'oce only'              !  'oce only' 'oce and ice' 'mixed oce-ice'
+cn_rcv_tau_refere = 'cartesian'             !  'spherical' 'cartesian'
+cn_rcv_tau_orient = 'eastward-northward'    !  'eastward-northward' or 'local grid'
+cn_rcv_tau_grid   = 'U,V'                   !  'T' 'U,V' 'U,V,F' 'U,V,I' 'T,F' 'T,I' 'T,U,V'
+cn_rcv_dqnsdt     = 'coupled'               !  'none' 'coupled'
+cn_rcv_qsr        = 'oce and ice'           !  'conservative' 'oce and ice' 'mixed oce-ice'
+cn_rcv_qns        = 'oce and ice'           !  'conservative' 'oce and ice' 'mixed oce-ice'
+cn_rcv_emp        = 'conservative'          !  'conservative' 'oce and ice' 'mixed oce-ice'
+cn_rcv_rnf        = 'coupled'               !  'coupled' 'climato' 'mixed'
+cn_rcv_cal        = 'coupled'               !  'none' 'coupled'
+/
+!-----------------------------------------------------------------------
+&namsbc_cpl_co2   !   coupled ocean/biogeo/atmosphere model             ("key_cpl_carbon_cycle")
+!-----------------------------------------------------------------------
+   cn_snd_co2     = 'coupled'         ! send    : 'none' 'coupled'
+   cn_rcv_co2     = 'coupled'         ! receive : 'none' 'coupled'
 /
 !-----------------------------------------------------------------------
 &namtra_qsr    !   penetrative solar radiation
 !-----------------------------------------------------------------------
-!              !   file name  ! frequency (hours) ! variable   ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
-!              !              !  (if <0  months)  !   name     !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
-   sn_chl      = 'chlorophyll',        -1         , 'CHLA'     ,    .true.      , .true.  , 'yearly'  , ''       , ''
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_chl      ='chlorophyll',        -1         , 'CHLA'    ,   .true.     , .true. , 'yearly'  , ''       , ''
  
    cn_dir      = './'      !  root directory for the location of the runoff files
-   ln_traqsr   = .false.    !  Light penetration (T) or not (F)
-   ln_qsr_rgb  = .false.    !  RGB (Red-Green-Blue) light penetration
+   ln_traqsr   = .false.   !  Light penetration (T) or not (F)
+   ln_qsr_rgb  = .false.   !  RGB (Red-Green-Blue) light penetration
    ln_qsr_2bd  = .false.   !  2 bands              light penetration
    ln_qsr_bio  = .false.   !  bio-model light penetration
@@ -232,35 +256,50 @@
    rn_si0      =   0.35    !  RGB & 2 bands: shortess depth of extinction
    rn_si1      =   23.0    !  2 bands: longest depth of extinction
-   rn_si2      =   62.0    !  3 bands: longest depth of extinction (for blue waveband & 0.01 mg/m2 Chl)
 /
 !-----------------------------------------------------------------------
 &namsbc_rnf    !   runoffs namelist surface boundary condition
 !-----------------------------------------------------------------------
-!              !   file name  ! frequency (hours) ! variable   ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
-!              !              !  (if <0  months)  !   name     !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
-   sn_rnf      = 'runoff_1m_nomask' ,  -1         , 'sorunoff' ,    .true.      , .true.  , 'yearly'  , ''       , ''
-   sn_cnf      = 'runoff_1m_nomask' ,   0         , 'socoefr'  ,    .false.     , .true.  , 'yearly'  , ''       , ''
- 
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_rnf      = 'runoff_core_monthly',    -1    , 'sorunoff',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_cnf      = 'runoff_core_monthly',     0    , 'socoefr0',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_s_rnf    = 'runoffs'            ,    24    , 'rosaline',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_t_rnf    = 'runoffs'            ,    24    , 'rotemper',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_dep_rnf  = 'runoffs'            ,     0    , 'rodepth' ,   .false.    , .true. , 'yearly'  , ''       , ''
+
    cn_dir       = './'      !  root directory for the location of the runoff files
-   ln_rnf_emp   =   .false. !  runoffs included into precipitation field (T) or into a file (F)
-   ln_rnf_mouth =   .false. !  specific treatment at rivers mouths
-   rn_hrnf      =  0.e0    !  depth over which enhanced vertical mixing is used
+   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
    rn_avt_rnf   =   1.e-3   !  value of the additional vertical mixing coef. [m2/s]
    rn_rfact     =   1.e0    !  multiplicative factor for runoff
+   ln_rnf_depth =  .false.  !  read in depth information for runoff
+   ln_rnf_tem   =  .false.  !  read in temperature information for runoff
+   ln_rnf_sal   =  .false.  !  read in salinity information for runoff
+/
+!-----------------------------------------------------------------------
+&namsbc_apr    !   Atmospheric pressure used as ocean forcing or in bulk
+!-----------------------------------------------------------------------
+!              ! file name ! frequency (hours) ! variable ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
+!              !           !  (if <0  months)  !   name   !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
+   sn_apr      = 'patm'    ,         -1        ,'somslpre',    .true.      , .true.  , 'yearly'  ,  ''      ,   ''
+
+   cn_dir      = './'      !  root directory for the location of the bulk files
+   ln_ref_apr  = .false.   !  ref. pressure: global mean Patm (T) or a constant (F)
 /
 !-----------------------------------------------------------------------
 &namsbc_ssr    !   surface boundary condition : sea surface restoring
 !-----------------------------------------------------------------------
-!              !   file name  ! frequency (hours) ! variable   ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
-!              !              !  (if <0  months)  !   name     !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
-   sn_sst      = 'sst_data'   ,        24         ,  'sst'     ,     .false.    , .false. , 'yearly'  , ''       , ''
-   sn_sss      = 'sss_1m'     ,        -1         ,  'vosaline',     .true.     , .true.  , 'yearly'  , ''       , ''
-    
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_sst      = 'sst_data'  ,        24         ,  'sst'    ,    .false.   , .false., 'yearly'  , ''       , ''
+   sn_sss      = 'sss_data'  ,        -1         , 'vosaline',    .true.    , .true. , 'yearly'  , ''       , ''
+
    cn_dir      = './'      !  root directory for the location of the runoff files
    nn_sstr     =     0     !  add a retroaction term in the surface heat       flux (=1) or not (=0)
-   nn_sssr     =     1     !  add a damping     term in the surface freshwater flux (=2) 
+   nn_sssr     =     2     !  add a damping     term in the surface freshwater flux (=2) 
                            !  or to SSS only (=1) or no damping term (=0)
    rn_dqdt     =   -40.    !  magnitude of the retroaction on temperature   [W/m2/K]
-   rn_deds     =   -27.7   !  magnitude of the damping on salinity   [mm/day/psu]
+   rn_deds     =   -27.7   !  magnitude of the damping on salinity   [mm/day]
    ln_sssr_bnd =   .true.  !  flag to bound erp term (associated with nn_sssr=2)
    rn_sssr_bnd =   4.e0    !  ABS(Max/Min) value of the damping erp term [mm/day]
@@ -286,5 +325,5 @@
 !!   namtide       Tidal forcing at open boundaries                     ("key_bdy_tides")
 !!======================================================================
-
+!
 !-----------------------------------------------------------------------
 &namlbc        !   lateral momentum boundary condition
@@ -301,20 +340,20 @@
 &namobc        !   open boundaries parameters                           ("key_obc")
 !-----------------------------------------------------------------------
-    ln_obc_clim= .false.   !  climatological obc data files (T) or not (F)
-    ln_vol_cst = .false.    !  impose the total volume conservation (T) or not (F)
-    ln_obc_fla = .false.   !  Flather open boundary condition 
-    nn_obcdta  =    1      !  = 0 the obc data are equal to the initial state
+   ln_obc_clim = .false.   !  climatological obc data files (T) or not (F)
+   ln_vol_cst  = .false.   !  impose the total volume conservation (T) or not (F)
+   ln_obc_fla  = .false.   !  Flather open boundary condition 
+   nn_obcdta   =    1      !  = 0 the obc data are equal to the initial state
                            !  = 1 the obc data are read in 'obc.dta' files
-    cn_obcdta  = 'annual'  !  set to annual if obc datafile hold 1 year of data
+   cn_obcdta   = 'annual'  !  set to annual if obc datafile hold 1 year of data
                            !  set to monthly if obc datafile hold 1 month of data
-    rn_dpein   =    1.     !  damping time scale for inflow at east  open boundary
-    rn_dpwin   =    1.     !     -           -         -       west    -      -
-    rn_dpnin   =   30.     !     -           -         -       north   -      -
-    rn_dpsin   =    1.     !     -           -         -       south   -      -
-    rn_dpeob   = 1500.     !  time relaxation (days) for the east  open boundary
-    rn_dpwob   =  150.     !     -           -         -     west    -      -
-    rn_dpnob   =  150.     !     -           -         -     north   -      -
-    rn_dpsob   =  150.     !     -           -         -     south   -      -
-    rn_volemp  =  1.       !  = 0 the total volume change with the surface flux (E-P-R)
+   rn_dpein    =    1.     !  damping time scale for inflow at east  open boundary
+   rn_dpwin    =    1.     !     -           -         -       west    -      -
+   rn_dpnin    =   30.     !     -           -         -       north   -      -
+   rn_dpsin    =    1.     !     -           -         -       south   -      -
+   rn_dpeob    = 1500.     !  time relaxation (days) for the east  open boundary
+   rn_dpwob    =  150.     !     -           -         -     west    -      -
+   rn_dpnob    =  150.     !     -           -         -     north   -      -
+   rn_dpsob    =  150.     !     -           -         -     south   -      -
+   rn_volemp   =    1.     !  = 0 the total volume change with the surface flux (E-P-R)
                            !  = 1 the total volume remains constant
 /
@@ -322,36 +361,40 @@
 &namagrif      !  AGRIF zoom                                            ("key_agrif")
 !-----------------------------------------------------------------------
-    nn_cln_update = 3      !  baroclinic update frequency
-    ln_spc_dyn    = .true. !  use 0 as special value for dynamics
-    rn_sponge_tra = 2880.  !  coefficient for tracer   sponge layer [s]
-    rn_sponge_dyn = 2880.  !  coefficient for dynamics sponge layer [s]
+   nn_cln_update =    3    !  baroclinic update frequency
+   ln_spc_dyn    = .true.  !  use 0 as special value for dynamics
+   rn_sponge_tra = 2880.   !  coefficient for tracer   sponge layer [s]
+   rn_sponge_dyn = 2880.   !  coefficient for dynamics sponge layer [s]
 /
 !-----------------------------------------------------------------------
 &nambdy        !  unstructured open boundaries                          ("key_bdy")
 !-----------------------------------------------------------------------
-    filbdy_mask    =  ''                  !  name of mask file (if ln_bdy_mask=.TRUE.)
-    filbdy_data_T  = 'bdydata_grid_T.nc'  !  name of data file (T-points)
-    filbdy_data_U  = 'bdydata_grid_U.nc'  !  name of data file (U-points)
-    filbdy_data_V  = 'bdydata_grid_V.nc'  !  name of data file (V-points)
-    ln_bdy_clim    = .false.              !  contain 1 (T) or 12 (F) time dumps and be cyclic
-    ln_bdy_vol     = .true.               !  total volume correction (see volbdy parameter)
-    ln_bdy_mask    = .false.              !  boundary mask from filbdy_mask (T) or boundaries are on edges of domain (F)
-    ln_bdy_tides   = .true.               !  Apply tidal harmonic forcing with Flather condition
-    ln_bdy_dyn_fla = .true.               !  Apply Flather condition to velocities
-    ln_bdy_tra_frs = .false.              !  Apply FRS condition to temperature and salinity 
-    ln_bdy_dyn_frs = .false.              !  Apply FRS condition to velocities
-    nbdy_dta       =  1                   !  = 0, bdy data are equal to the initial state
-                                          !  = 1, bdy data are read in 'bdydata   .nc' files
-    nb_rimwidth    = 9                    !  width of the relaxation zone
-    volbdy         = 0                    !  = 0, the total water flux across open boundaries is zero
-                                          !  = 1, the total volume of the system is conserved
-/
-!-----------------------------------------------------------------------
-&nambdy_tide     ! tidal forcing at unstructured boundaries              
-!-----------------------------------------------------------------------
-    filtide      = 'bdytide_'           !  file name root of tidal forcing files
-    tide_cpt     = 'M2','S1'            !  names of tidal components used
-    tide_speed   = 28.984106, 15.000001 !  phase speeds of tidal components (deg/hour)
-    ln_tide_date = .false.              !  adjust tidal harmonics for start date of run
+   cn_mask     =  ''                     !  name of mask file (ln_mask=T)
+   cn_dta_frs_T= 'bdydata_grid_T.nc'     !  name of data file (T-points)
+   cn_dta_frs_U= 'bdydata_grid_U.nc'     !  name of data file (U-points)
+   cn_dta_frs_V= 'bdydata_grid_V.nc'     !  name of data file (V-points)
+   cn_dta_fla_T= 'bdydata_bt_grid_T.nc'  !  name of data file for Flather condition (T-points)
+   cn_dta_fla_U= 'bdydata_bt_grid_U.nc'  !  name of data file for Flather condition (U-points)
+   cn_dta_fla_V= 'bdydata_bt_grid_V.nc'  !  name of data file for Flather condition (V-points)
+
+   ln_clim     = .false.   !  contain 1 (T) or 12 (F) time dumps and be cyclic
+   ln_vol      = .false.   !  total volume correction (see volbdy parameter)
+   ln_mask     = .false.   !  boundary mask from filbdy_mask (T), boundaries are on edges of domain (F)
+   ln_tides    = .false.   !  Apply tidal harmonic forcing with Flather condition
+   ln_dyn_fla  = .false.   !  Apply Flather condition to velocities
+   ln_tra_frs  = .false.   !  Apply FRS condition to temperature and salinity 
+   ln_dyn_frs  = .false.   !  Apply FRS condition to velocities
+   nn_rimwidth =  9        !  width of the relaxation zone
+   nn_dtactl   =  1        !  = 0, bdy data are equal to the initial state
+                           !  = 1, bdy data are read in 'bdydata   .nc' files
+   nn_volctl   =  0        !  = 0, the total water flux across open boundaries is zero
+                           !  = 1, the total volume of the system is conserved
+/
+!-----------------------------------------------------------------------
+&nambdy_tide   !  tidal forcing at unstructured boundaries              
+!-----------------------------------------------------------------------
+   filtide     = 'bdytide_'           !  file name root of tidal forcing files
+   tide_cpt    = 'M2','S1'            !  names of tidal components used
+   tide_speed  = 28.984106, 15.000001 !  phase speeds of tidal components (deg/hour)
+   ln_tide_date= .false.              !  adjust tidal harmonics for start date of run
 /
 
@@ -360,20 +403,23 @@
 !!======================================================================
 !!   nambfr        bottom friction
-!!   nambbc        bottom temperature boundary condition                ("key_trabbc")
-!!   nambbl        bottom boundary layer scheme                         ("key_trabbl_dif","key_trabbl_adv")
-!!======================================================================
-
+!!   nambbc        bottom temperature boundary condition               
+!!   nambbl        bottom boundary layer scheme                         ("key_trabbl")
+!!======================================================================
+!
 !-----------------------------------------------------------------------
 &nambfr        !   bottom friction
 !-----------------------------------------------------------------------
-   nn_bfr      =    2      !  type of bottom friction :   = 0 : no   slip,  = 2 : nonlinear friction
-                           !                              = 3 : free slip,  = 1 :    linear friction
+   nn_bfr      =    2      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
    rn_bfri1    =    4.e-4  !  bottom drag coefficient (linear case)
    rn_bfri2    =    1.e-3  !  bottom drag coefficient (non linear case)
-   rn_bfeb2    =    2.5e-3 !  bottom turbulent kinetic energy background  (m^2/s^2)
+   rn_bfeb2    =    2.5e-3 !  bottom turbulent kinetic energy background  (m2/s2)
+   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)
 /
 !-----------------------------------------------------------------------
 &nambbc        !   bottom temperature boundary condition
 !-----------------------------------------------------------------------
+   ln_trabbc   = .false.   !  Apply a geothermal heating at the ocean bottom
    nn_geoflx   =    0      !  geothermal heat flux: = 0 no flux 
                            !     = 1 constant flux
@@ -384,8 +430,10 @@
 &nambbl        !   bottom boundary layer scheme
 !-----------------------------------------------------------------------
-!                          !  diffusive bbl                             ("key_trabbl")
-!                          !  advective bbl                             ("key_trabbl_adv")
-   rn_ahtbbl   =  10000.   !  lateral mixing coefficient in the bbl  [m2/s]
-/
+   nn_bbl_ldf  =  1      !  diffusive bbl (=1)   or not (=0)
+   nn_bbl_adv  =  0      !  advective bbl (=1/2) or not (=0)
+   rn_ahtbbl   =  1000.  !  lateral mixing coefficient in the bbl  [m2/s]
+   rn_gambbl   =  10.    !  advective bbl coefficient                 [s]
+/
+
 !!======================================================================
 !!                        Tracer (T & S ) namelists
@@ -396,14 +444,14 @@
 !!   namtra_dmp    T & S newtonian damping                              ("key_tradmp")
 !!======================================================================
-
+!
 !-----------------------------------------------------------------------
 &nameos        !   ocean physical parameters
 !-----------------------------------------------------------------------
-   nn_eos      =    0      !  type of equation of state and Brunt-Vaisala frequency
+   nn_eos      =   0       !  type of equation of state and Brunt-Vaisala frequency
                            !     = 0, UNESCO (formulation of Jackett and McDougall (1994) and of McDougall (1987) )
                            !     = 1, linear: rho(T)   = rau0 * ( 1.028 - ralpha * T )
                            !     = 2, linear: rho(T,S) = rau0 * ( rbeta * S - ralpha * T )
-   rn_alpha    =    2.e-4  !  thermal expension coefficient (neos= 1 or 2)
-   rn_beta     =    0.001  !  saline  expension coefficient (neos= 2)
+   rn_alpha    =   2.0e-4  !  thermal expension coefficient (nn_eos= 1 or 2)
+   rn_beta     =   7.7e-4  !  saline  expension coefficient (nn_eos= 2)
 /
 !-----------------------------------------------------------------------
@@ -415,24 +463,27 @@
    ln_traadv_muscl2 =  .false.  !  MUSCL2 scheme + cen2 at boundaries  
    ln_traadv_ubs    =  .false.  !  UBS scheme                 
+   ln_traadv_qck    =  .false.  !  QUCIKEST scheme                 
 /
 !-----------------------------------------------------------------------
 &namtra_ldf    !   lateral diffusion scheme for tracer 
 !-----------------------------------------------------------------------
-                           !  Type of the operator : 
-   ln_traldf_lap    =  .true.   !     laplacian operator       
-   ln_traldf_bilap  =  .false.  !     bilaplacian operator     
-                           !  Direction of action  :
-   ln_traldf_level  =  .false.  !     iso-level                
-   ln_traldf_hor    =  .false.  !     horizontal (geopotential)         (require "key_ldfslp" when ln_sco=T)
-   ln_traldf_iso    =  .true.   !     iso-neutral                       (require "key_ldfslp")
-                           !  Coefficient
-   rn_aht_0         =   300.    !     horizontal eddy diffusivity for tracers [m2/s]
-   rn_ahtb_0        =     0.    !     background eddy diffusivity for ldf_iso [m2/s]
-   rn_aeiv_0        =     0.    !     eddy induced velocity coefficient [m2/s]    (require "key_traldf_eiv")
+   !                       !  Type of the operator : 
+   ln_traldf_lap    =  .true.   !  laplacian operator       
+   ln_traldf_bilap  =  .false.  !  bilaplacian operator     
+   !                       !  Direction of action  :
+   ln_traldf_level  =  .false.  !  iso-level                
+   ln_traldf_hor    =  .false.  !  horizontal (geopotential)            (require "key_ldfslp" when ln_sco=T)
+   ln_traldf_iso    =  .true.   !  iso-neutral                          (require "key_ldfslp")
+   ln_traldf_grif   =  .false.  !  griffies skew flux formulation       (require "key_ldfslp")  ! UNDER TEST, DO NOT USE
+   ln_traldf_gdia   =  .false.  !  griffies operator strfn diagnostics  (require "key_ldfslp")  ! UNDER TEST, DO NOT USE
+   !                       !  Coefficient
+   rn_aht_0         =   300.    !  horizontal eddy diffusivity for tracers [m2/s]
+   rn_ahtb_0        =     0.    !  background eddy diffusivity for ldf_iso [m2/s]
+   rn_aeiv_0        =     0.    !  eddy induced velocity coefficient [m2/s]    (require "key_traldf_eiv")
 /
 !-----------------------------------------------------------------------
 &namtra_dmp    !   tracer: T & S newtonian damping                      ('key_tradmp')
 !-----------------------------------------------------------------------
-   nn_hdmp     =   1       !  horizontal shape =-1, damping in Med and Red Seas only
+   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
@@ -445,4 +496,5 @@
    nn_file     =    0      !  create a damping.coeff NetCDF file (=1) or not (=0)
 /
+
 !!======================================================================
 !!                      ***  Dynamics namelists  ***
@@ -454,5 +506,5 @@
 !!   namdyn_ldf    lateral diffusion scheme
 !!======================================================================
-
+!
 !-----------------------------------------------------------------------
 &namdyn_adv    !   formulation of the momentum advection
@@ -494,26 +546,28 @@
 &namdyn_ldf    !   lateral diffusion on momentum
 !-----------------------------------------------------------------------
-                           !  Type of the operator : 
+   !                       !  Type of the operator : 
    ln_dynldf_lap    =  .false.  !  laplacian operator         
    ln_dynldf_bilap  =  .true.  !  bilaplacian operator    
-                           !  Direction of action  : 
+   !                       !  Direction of action  : 
    ln_dynldf_level  =  .false.  !  iso-level               
    ln_dynldf_hor    =  .true.   !  horizontal (geopotential)            (require "key_ldfslp" in s-coord.)
    ln_dynldf_iso    =  .false.  !  iso-neutral                          (require "key_ldfslp")
-                           !  Coefficient
-   rn_ahm_0    = -1.5e11        !  horizontal eddy viscosity   [m2/s]
-   rn_ahmb_0   =    500.        !  background eddy viscosity for ldf_iso [m2/s]
-/
+   !                       !  Coefficient
+   rn_ahm_0_lap     =     0.    !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahmb_0        =    500.   !  background eddy viscosity for ldf_iso [m2/s]
+   rn_ahm_0_blp     = -1.5e11   !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+
 !!======================================================================
 !!             Tracers & Dynamics vertical physics namelists
 !!======================================================================
-!!       namzdf        vertical physics
-!!       namzdf_ric    richardson number dependent vertical mixing      ("key_zdfric"      )
-!!       namzdf_tke    TKE dependent vertical mixing                    ("key_zdftke"      )
-!!       namzdf_kpp    KPP dependent vertical mixing                    ("key_zdfkpp"      )
-!!       namzdf_ddm    double diffusive mixing parameterization         ("key_zdfddm"      )
-!!       namzdf_tmx    tidal mixing parameterization                    ("key_zdftmx"      )
-!!======================================================================
-
+!!    namzdf        vertical physics
+!!    namzdf_ric    richardson number dependent vertical mixing         ("key_zdfric")
+!!    namzdf_tke    TKE dependent vertical mixing                       ("key_zdftke")
+!!    namzdf_kpp    KPP dependent vertical mixing                       ("key_zdfkpp")
+!!    namzdf_ddm    double diffusive mixing parameterization            ("key_zdfddm")
+!!    namzdf_tmx    tidal mixing parameterization                       ("key_zdftmx")
+!!======================================================================
+!
 !-----------------------------------------------------------------------
 &namzdf        !   vertical physics
@@ -544,35 +598,28 @@
    rn_ediff    =   0.1     !  coef. for vertical eddy coef. (avt=rn_ediff*mxl*sqrt(e) )
    rn_ediss    =   0.7     !  coef. of the Kolmogoroff dissipation
-   rn_ebb      =   3.75    !  coef. of the surface input of tke
+   rn_ebb      =  67.83    !  coef. of the surface input of tke (=67.83 suggested when ln_mxl0=T)
    rn_emin     =   1.e-6   !  minimum value of tke [m2/s2]
    rn_emin0    =   1.e-4   !  surface minimum value of tke [m2/s2]
-   rn_bshear   =   1.e-20  !  background shear (>0)
-   nn_mxl      =   3       !  mixing length: = 0 bounded by the distance to surface and bottom
+   nn_mxl      =   2       !  mixing length: = 0 bounded by the distance to surface and bottom
                            !                 = 1 bounded by the local vertical scale factor
                            !                 = 2 first vertical derivative of mixing length bounded by 1
-                           !                 = 3 same criteria as case 2 but applied in a different way
+                           !                 = 3 as =2 with distinct disspipative an mixing length scale
    nn_pdl      =   1       !  Prandtl number function of richarson number (=1, avt=pdl(Ri)*avm) or not (=0, avt=avm)
-   ln_mxl0     = .false.   !  mixing length scale surface value as function of wind stress (T) or not (F)
-   rn_lmin     =   0.4     !  interior buoyancy lenght scale minimum value
-   rn_lmin0    =   0.4     !  surface  buoyancy lenght scale minimum value
-   nn_etau     =   0       !  exponentially deceasing penetration of tke due to internal & intertial waves
-                           !        = 0 no penetration ( O(2 km) resolution)
-                           !        = 1 additional tke source (rn_efr * en)
-                           !        = 2 additional tke source (rn_efr * en) applied only at the base of the mixed layer
-                           !        = 3 additional tke source (HF contribution: mean of stress module - module of mean stress)
-   nn_htau     =   1       !  type of exponential decrease of tke penetration
+   ln_mxl0     = .true.    !  surface mixing length scale = F(wind stress) (T) or not (F)
+   rn_mxl0     =   0.04    !  surface  buoyancy lenght scale minimum value
+   ln_lc       = .true.    !  Langmuir cell parameterisation (Axell 2002)
+   rn_lc       =   0.15    !  coef. associated to Langmuir cells
+   nn_etau     =   1       !  penetration of tke below the mixed layer (ML) due to internal & intertial waves
+                           !        = 0 no penetration
+                           !        = 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")
+   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
                            !        = 0  constant 10 m length scale
-                           !        = 1  0.5m at the equator to 30m at high latitudes
-                           !        = 2  30 meters constant depth penetration
-                           !  otion used only if nn_etau = 1 or 2: 
-   rn_efr      =   0.05    !     fraction of surface tke value which penetrates inside the ocean
-                           !  otion used only if nn_etau = 3:
-   rn_addhft   =  -1.e-3   !     add offset   applied to the "mean of stress module - module of mean stress" (always kept > 0)
-   rn_sclhft   =   1.      !     scale factor applied to the "mean of stress module - module of mean stress"
-   ln_lc       = .false.   !  Langmuir cell parameterisation
-   rn_lc       =   0.15    !  coef. associated to Langmuir cells
+                           !        = 1  0.5m at the equator to 30m poleward of 40 degrees
 /
 !------------------------------------------------------------------------
-&namzdf_kpp    !   K-Profile Parameterization dependent vertical mixing  ("key_zdfkpp", and optionnally:
+&namzdf_kpp    !   K-Profile Parameterization dependent vertical mixing  ("key_zdfkpp", and optionally:
 !------------------------------------------------------------------------ "key_kppcustom" or "key_kpplktb")
    ln_kpprimix = .true.    !  shear instability mixing 
@@ -587,4 +634,22 @@
 /
 !-----------------------------------------------------------------------
+&namzdf_gls                !   GLS vertical diffusion                   ("key_zdfgls")
+!-----------------------------------------------------------------------
+   rn_emin       = 1.e-6   !  minimum value of e   [m2/s2]
+   rn_epsmin     = 1.e-12  !  minimum value of eps [m2/s3]
+   ln_length_lim = .true.  !  limit on the dissipation rate under stable stratification (Galperin et al., 1988)
+   rn_clim_galp  = 0.53    !  galperin limit
+   ln_crban      = .TRUE.  !  Use Craig & Banner (1994) surface wave mixing parametrisation
+   ln_sigpsi     = .TRUE.  !  Activate or not Burchard 2001 mods on psi schmidt number in the wb case
+   rn_crban      = 100.    !  Craig and Banner 1994 constant for wb tke flux
+   rn_charn      = 70000.  !  Charnock constant for wb induced roughness length
+   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)
+/
+!-----------------------------------------------------------------------
 &namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
 !-----------------------------------------------------------------------
@@ -599,7 +664,8 @@
    rn_tfe      = 0.333     !  tidal dissipation efficiency
    rn_me       = 0.2       !  mixing efficiency 
-   ln_tmx_itf  = .FALSE.   !  ITF specific parameterisation
+   ln_tmx_itf  = .false.   !  ITF specific parameterisation
    rn_tfe_itf  = 1.        !  ITF tidal dissipation efficiency
 /
+
 !!======================================================================
 !!                  ***  Miscelaneous namelists  ***
@@ -610,5 +676,5 @@
 !!   namsol            elliptic solver / island / free surface 
 !!======================================================================
-
+!
 !-----------------------------------------------------------------------
 &namsol        !   elliptic solver / island / free surface 
@@ -627,5 +693,5 @@
 &nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
 !-----------------------------------------------------------------------
-   cn_mpi_send =  'S'      !  mpi send/recieve type   ='S', 'B', or 'I' for standard send,
+   cn_mpi_send =  'I'      !  mpi send/recieve type   ='S', 'B', or 'I' for standard send,
                            !  buffer blocking send or immediate non-blocking sends, resp.
    nn_buffer   =   0       !  size in bytes of exported buffer ('B' case), 0 no exportation
@@ -651,20 +717,30 @@
    nn_bench    =    0      !  Bench mode (1/0): CAUTION use zero except for bench
                            !     (no physical validity of the results)
-   nn_bit_cmp  =    0      !  bit comparison mode (1/0): CAUTION use zero except for test
-                           !     of comparison between single and multiple processor runs
-/
-
-!!======================================================================
-!!                       ***  Diagnostics namelists  ***
-!!======================================================================
+/
+
+!!======================================================================
+!!                  ***  Diagnostics namelists  ***
+!!======================================================================
+!!   namnc4       netcdf4 chunking and compression settings             ("key_netcdf4")
 !!   namtrd       dynamics and/or tracer trends                         ("key_trddyn","key_trdtra","key_trdmld")
-!!   namgap       level mean model-data gap                             ("key_diagap")
 !!   namflo       float parameters                                      ("key_float")
 !!   namptr       Poleward Transport Diagnostics
-!!======================================================================
-
+!!   namhsb       Heat and salt budgets 
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namnc4        !   netcdf4 chunking and compression settings            ("key_netcdf4")
+!-----------------------------------------------------------------------
+   nn_nchunks_i=   4       !  number of chunks in i-dimension
+   nn_nchunks_j=   4       !  number of chunks in j-dimension
+   nn_nchunks_k=   31      !  number of chunks in k-dimension
+                           !  setting nn_nchunks_k = jpk will give a chunk size of 1 in the vertical which
+                           !  is optimal for postprocessing which works exclusively with horizontal slabs
+   ln_nc4zip   = .true.    !  (T) use netcdf4 chunking and compression
+                           !  (F) ignore chunking information and produce netcdf3-compatible files
+/
 !-----------------------------------------------------------------------
 &namtrd        !   diagnostics on dynamics and/or tracer trends         ("key_trddyn" and/or "key_trdtra")
-!              !       or mixed-layer trends or barotropic vorticity    ('key_trdmld' or  "key_trdvor")
+!              !       or mixed-layer trends or barotropic vorticity    ("key_trdmld" or     "key_trdvor")
 !-----------------------------------------------------------------------
    nn_trd      = 365       !  time step frequency dynamics and tracers trends
@@ -677,17 +753,11 @@
 /
 !-----------------------------------------------------------------------
-&namgap       !   level mean model-data gap                             ('key_diagap')
-!-----------------------------------------------------------------------
-   nn_gap     =  15        !  time-step frequency of model-data gap computation
-   nn_prg     =  10        !  time-step frequency of gap print in model output
-/
-!-----------------------------------------------------------------------
 &namflo       !   float parameters                                      ("key_float")
 !-----------------------------------------------------------------------
-    ln_rstflo = .false.    !  float restart (T) or not (F)
-    nn_writefl=      75    !  frequency of writing in float output file 
-    nn_stockfl=    5475    !  frequency of creation of the float restart file 
-    ln_argo   = .false.    !  Argo type floats (stay at the surface each 10 days)
-    ln_flork4 = .false.    !  trajectories computed with a 4th order Runge-Kutta (T)
+   ln_rstflo  = .false.    !  float restart (T) or not (F)
+   nn_writefl =      75    !  frequency of writing in float output file 
+   nn_stockfl =    5475    !  frequency of creation of the float restart file 
+   ln_argo    = .false.    !  Argo type floats (stay at the surface each 10 days)
+   ln_flork4  = .false.    !  trajectories computed with a 4th order Runge-Kutta (T)
                            !  or computed with Blanke' scheme (F)
 /
@@ -699,5 +769,101 @@
    ln_subbas  = .false.    !  Atlantic/Pacific/Indian basins computation (T) or not 
                            !  (orca configuration only, need input basins mask file named "subbasins.nc"
-   nf_ptr     =  1         !  Frequency of ptr computation [time step]
-   nf_ptr_wri =  15        !  Frequency of ptr outputs
-/
+   ln_ptrcomp = .false.    !  Add decomposition : overturning
+   nn_fptr    =  1         !  Frequency of ptr computation [time step]
+   nn_fwri    =  15        !  Frequency of ptr outputs [time step]
+/
+!-----------------------------------------------------------------------
+&namhsb       !  Heat and salt budgets 
+!-----------------------------------------------------------------------
+   ln_diahsb  = .false.    !  check the heat and salt budgets (T) or not (F)
+/
+
+!!======================================================================
+!!            ***  Observation & Assimilation namelists ***
+!!======================================================================
+!!   namobs       observation and model comparison                      ('key_diaobs')
+!!   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               Logical switch for Reynolds observations       
+                           !     ln_ghrsst               Logical switch for GHRSST observations          
+
+   ln_sstfb   = .false.    ! Logical switch for feedback SST data          
+                           !     ln_sss                  Logical switch for SSS observations              
+                           !     ln_seaice               Logical switch for Sea Ice observations        
+                           !     ln_vel3d                Logical switch for velocity observations         
+                           !     ln_velavcur             Logical switch for velocity daily av. cur.    
+                           !     ln_velhrcur             Logical switch for velocity high freq. cur.   
+                           !     ln_velavadcp            Logical switch for velocity daily av. ADCP  
+                           !     ln_velhradcp            Logical switch for velocity high freq. ADCP
+                           !     ln_velfb                Logical switch for feedback velocity data       
+                           !     ln_grid_global          Global distribtion of observations         
+                           !     ln_grid_search_lookup   Logical switch for obs grid search w/lookup table  
+                           !     grid_search_file        Grid search lookup file header 
+                           !     enactfiles              ENACT input observation file names 
+                           !     coriofiles              Coriolis input observation file name  
+   !                       ! profbfiles: Profile feedback input observation file name 
+   profbfiles = 'profiles_01.nc'
+                           !     ln_profb_enatim         Enact feedback input time setting switch    
+                           !     slafilesact             Active SLA input observation file name
+                           !     slafilespas             Passive SLA input observation file name 
+   !                       ! slafbfiles: Feedback SLA input observation file name 
+   slafbfiles = 'sla_01.nc'
+                           !     sstfiles                GHRSST input observation file name       
+   !                       ! sstfbfiles: Feedback SST input observation file name 
+   sstfbfiles = 'sst_01.nc' 'sst_02.nc' 'sst_03.nc' 'sst_04.nc' 'sst_05.nc'
+                           !     seaicefiles             Sea Ice input observation file name 
+                           !     velavcurfiles           Vel. cur. daily av. input file name  
+                           !     velhvcurfiles           Vel. cur. high freq. input file name  
+                           !     velavadcpfiles          Vel. ADCP daily av. input file name    
+                           !     velhvadcpfiles          Vel. ADCP high freq. input file name 
+                           !     velfbfiles              Vel. feedback input observation file name 
+                           !     dobsini                 Initial date in window YYYYMMDD.HHMMSS       
+                           !     dobsend                 Final date in window YYYYMMDD.HHMMSS         
+                           !     n1dint                  Type of vertical interpolation method        
+                           !     n2dint                  Type of horizontal interpolation method       
+                           !     ln_nea                  Rejection of observations near land switch    
+   nmsshc     = 0          ! MSSH correction scheme                         
+                           !     mdtcorr                 MDT  correction                               
+                           !     mdtcutoff               MDT cutoff for computed correction          
+   ln_altbias = .false.    ! Logical switch for alt bias                
+   ln_ignmis  = .true.     ! Logical switch for ignoring missing files   
+                           !     endailyavtypes   ENACT daily average types                    
+   ln_grid_global = .true.
+   ln_grid_search_lookup = .false.
+/ 
+!-----------------------------------------------------------------------
+&nam_asminc   !   assimilation increments                               ('key_asminc')
+!-----------------------------------------------------------------------
+    ln_bkgwri = .false.    !  Logical switch for writing out background state 
+    ln_trjwri = .false.    !  Logical switch for writing out state trajectory
+    ln_trainc = .false.    !  Logical switch for applying tracer increments
+    ln_dyninc = .false.    !  Logical switch for applying velocity increments
+    ln_sshinc = .false.    !  Logical switch for applying SSH increments 
+    ln_asmdin = .false.    !  Logical switch for Direct Initialization (DI)
+    ln_asmiau = .false.    !  Logical switch for Incremental Analysis Updating (IAU)
+    nitbkg    = 0          !  Timestep of background in [0,nitend-nit000-1]
+    nitdin    = 0          !  Timestep of background for DI in [0,nitend-nit000-1]
+    nitiaustr = 1          !  Timestep of start of IAU interval in [0,nitend-nit000-1]
+    nitiaufin = 15         !  Timestep of end of IAU interval in [0,nitend-nit000-1]
+    niaufn    = 0          !  Type of IAU weighting function
+    nittrjfrq = 0          !  Frequency of trajectory output for 4D-VAR
+    ln_salfix = .false.    !  Logical switch for ensuring that the sa > salfixmin
+    salfixmin = -9999      !  Minimum salinity after applying the increments
+/
Index: trunk/NEMOGCM/CONFIG/POMME/EXP00/xmlio_server.def
===================================================================
--- trunk/NEMOGCM/CONFIG/POMME/EXP00/xmlio_server.def	(revision 2527)
+++ trunk/NEMOGCM/CONFIG/POMME/EXP00/xmlio_server.def	(revision 2528)
@@ -17,4 +17,19 @@
   global_mpi_buffer_size = 512
 /  
+
+!!======================================================================
+!!   namnc4            netcdf4 chunking and compression settings
+!!======================================================================
+!-----------------------------------------------------------------------
+&namnc4         !  netcdf4 chunking and compression settings
+                !  (benign if "key_netcdf4" is not used)
+!-----------------------------------------------------------------------
+   nn_nchunks_i   =   4       !  number of chunks in i-dimension
+   nn_nchunks_j   =   4       !  number of chunks in j-dimension
+   nn_nchunks_k   =   31      !  number of chunks in k-dimension
+                              !  setting nn_nchunks_k = jpk will give a chunk size of 1 in the vertical which
+                              !  is optimal for postprocessing which works exclusively with horizontal slabs
+   ln_nc4zip      =   .TRUE.  !  (T) use netcdf4 chunking and compression
+                              !  (F) ignore chunking information and produce netcdf3-compatible files  
+/
   
-  
Index: trunk/NEMOGCM/CONFIG/POMME/cpp_POMME.fcm
===================================================================
--- trunk/NEMOGCM/CONFIG/POMME/cpp_POMME.fcm	(revision 2528)
+++ trunk/NEMOGCM/CONFIG/POMME/cpp_POMME.fcm	(revision 2528)
@@ -0,0 +1,2 @@
+bld::tool::fppkeys key_pomme_r025 key_dynspg_flt key_zdftke key_dtatem key_dtasal key_traldf_c2d key_dynldf_c2d key_ldfslp key_obc key_iomput key_nproci=1 key_nprocj=1
+
Index: trunk/NEMOGCM/CONFIG/makenemo
===================================================================
--- trunk/NEMOGCM/CONFIG/makenemo	(revision 2528)
+++ trunk/NEMOGCM/CONFIG/makenemo	(revision 2528)
@@ -0,0 +1,312 @@
+#!/bin/bash
+#set -x
+set -o posix
+#set -u 
+#set -e
+#+
+#
+# ===============
+# makenemo
+# ===============
+#
+# --------------------------
+# Compile NEMO
+# --------------------------
+#
+# SYNOPSIS
+# ========
+#
+# ::
+#
+#  $ makenemo
+#
+#
+# DESCRIPTION
+# ===========
+#
+#
+# This script aims :
+#
+# - to choose MYCONFIG
+# - to choose compiler options  
+# - to create the CONFIG/MYCONFIG/WORK directory
+# - to compile this configuration
+#
+#  Variables used :
+#
+#  From user input
+#
+# - NEW_CONF    : configuration to be created
+# - REF_CONF    : reference configuration to build the new one 
+# - CMP_NAM     : compiler name 
+# - NBR_PRC     : number of processes used to compile  
+# - NEM_SUBDIR  : NEMO subdirectory used (specified)
+#
+#  Locally defined :
+#
+# - TAB         : NEMO subdirectory used (read)  
+# - MAIN_DIR    : self explaining
+# - CONFIG_DIR  :   "    "    "   
+# - MODELES_DIR :   "    "    " 
+# - TOOLS_DIR   :   "    "    " 
+# - NEMO_DIR    :   "    "    "
+#
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./makenemo -m ifort_osx - j3 -n ORCA2_LIM
+#
+#
+# TODO
+# ====
+#
+# option debug
+#
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id$
+#
+#
+#
+#   * creation
+#
+#-
+
+#- Local variables ---
+b_n=$(basename ${0})
+OPTIND=1
+MAIN_DIR=$(cd $(dirname "$0"); pwd)
+MAIN_DIR=${MAIN_DIR%/SETTE*}
+MAIN_DIR=${MAIN_DIR%/TOOLS*}
+MAIN_DIR=${MAIN_DIR%/CONFIG*}
+export MAIN_DIR
+#
+export CONFIG_DIR=${MAIN_DIR}/CONFIG
+export TOOLS_DIR=${MAIN_DIR}/TOOLS
+export COMPIL_DIR=${MAIN_DIR}/TOOLS/COMPILE
+export NEMO_DIR=${MAIN_DIR}/NEMO
+export AGRIFUSE=10
+
+declare -a TAB
+#-
+#- FCM and functions location ---
+export PATH=${MAIN_DIR}/EXTERNAL/fcm/bin:$PATH
+
+#-
+#- Choice of the options ---
+x_d="";
+x_n="";
+x_r="";
+x_m="";
+x_t="";
+x_c="";
+x_j=1;
+while getopts :hd:n:r:m:j:t: V
+do
+    case $V in
+	(h)  echo "Usage	 : "${b_n} \
+	    " [-h] [-n name] [-m arch] [-d "dir1 dir2"] [-r conf] [-j No]";
+	echo " -h	 : help";
+	echo " -n name : config name, [-n help] to list existing configurations";
+	echo " -m arch : choose compiler, [-m help] to list existing compilers";
+	echo " -d dir  : choose NEMO sub-directories";
+	echo " -r conf : choose reference configuration";
+	echo " -j No	 : number of processes used to compile (0=nocompilation)";
+	echo " -t dir  : temporary directory for compilation"
+	echo "";
+	echo "Example to install a new configuration MY_CONFIG";
+	echo "with OPA_SRC and LIM_SRC_2 ";
+	echo "makenemo -n MY_CONFIG -d \"OPA_SRC LIM_SRC_2\"";
+	echo "";
+	echo "Available configurations :"; cat ${COMPIL_DIR}/cfg.txt; 
+	echo "";
+	echo "Example to remove bad configuration ";
+	echo "./makenemo -n MY_CONFIG clean_config";
+	echo "";
+	echo "Example to clean ";
+	echo "./makenemo clean";
+	echo "";
+	echo "Example to add and remove keys";
+	echo "./makenemo add_key \"key_iomput key_mpp_mpi\" del_key \"key_agrif\" ";
+	echo "";
+	echo "Example to add and remove keys for a new configuration, and do not compile";
+	echo "./makenemo -n MY_CONFIG -j0 add_key \"key_iomput key_mpp_mpi\" del_key \"key_agrif\" ";
+	echo "";
+	. ${COMPIL_DIR}/Flist_archfile.sh  ;
+	echo "";
+	echo "Default : previous configuration and compiler";
+	exit 0;;
+	(d)  x_d=${OPTARG};;
+	(n)  x_n=${OPTARG};;
+	(r)  x_r=${OPTARG};;
+	(m)  x_m=${OPTARG};;
+	(j)  x_j=${OPTARG};;
+	(t)  x_t=${OPTARG};;
+	(:)  echo ${b_n}" : -"${OPTARG}" option : missing value" 1>&2;
+	exit 2;;
+	(\?) echo ${b_n}" : -"${OPTARG}" option : not supported" 1>&2;
+	exit 2;;
+    esac
+done
+shift $(($OPTIND-1));
+
+while [ ${#1} -gt 0 ]   # Get clean, clean_config options
+do
+    case "$1" in
+	clean)
+	    x_c="--$1"
+	    ;;
+	clean_config)
+	    . ${COMPIL_DIR}/Fclean_config.sh
+	    exit
+	    ;;
+	add_key)
+	    list_add_key=$2
+	    export ${list_add_key}
+	    shift
+	    ;;
+	del_key)
+	    list_del_key=$2
+	    export ${list_del_key}
+	    shift
+	    ;;
+	*)
+	    echo " \"$1\" BAD OPTION" 
+	    exit
+	    ;;
+	
+    esac
+    shift
+done
+
+
+#-
+#- Go to NEMOGCM/config directory ---
+cd ${CONFIG_DIR}
+
+#-
+#- Initialisation from input ---
+export NEW_CONF=${x_n}
+NBR_PRC=${x_j}
+CMP_NAM=${x_m}
+NEM_SUBDIR=${x_d}
+REF_CONF=${x_r}
+NEMO_TDIR=${x_t:-$NEMO_TDIR}
+export NEMO_TDIR=${NEMO_TDIR:-$CONFIG_DIR}
+
+#- Check if the tool or the compiler exist or list it
+if [ "${NEW_CONF}" == help ] ; then
+    echo "Available configurations :" 
+    cat ${COMPIL_DIR}/cfg.txt
+    exit
+fi
+[ "${CMP_NAM}" ==  help ] && . ${COMPIL_DIR}/Flist_archfile.sh && exit
+
+#- When used for the first time, choose a compiler ---
+. ${COMPIL_DIR}/Fcheck_archfile.sh arch_nemo.fcm ${CMP_NAM} || exit
+
+#-
+#- Choose a default configuration if needed ---
+#- ORCA2_LIM or last one used ---
+. ${COMPIL_DIR}/Fcheck_config.sh cfg.txt ${NEW_CONF} || exit 
+
+
+if [ ${#NEW_CONF} -eq 0 ] ; then
+    if [ ${#NEM_SUBDIR} -eq 0 -a ${#REF_CONF} -eq 0 ]; then
+	echo "You are  installing a new configuration"
+	ind=0
+	. ${COMPIL_DIR}/Fread_dir.sh OPA_SRC	 YES 
+	. ${COMPIL_DIR}/Fread_dir.sh LIM_SRC_2   YES 
+	. ${COMPIL_DIR}/Fread_dir.sh LIM_SRC_3   NO  
+	. ${COMPIL_DIR}/Fread_dir.sh TOP_SRC	 NO  
+	. ${COMPIL_DIR}/Fread_dir.sh NST_SRC	 YES 
+	. ${COMPIL_DIR}/Fread_dir.sh OFF_SRC	 NO  
+	REF_CONF=ORCA2_LIM
+    elif [ ${#NEM_SUBDIR} -gt 0 ] && [ ${#REF_CONF} -eq 0 ]; then
+	echo "You are  installing a new configuration"
+	TAB=( ${NEM_SUBDIR} )
+	REF_CONF=ORCA2_LIM
+    elif [ ${#NEM_SUBDIR} -eq 0 ] && [ ${#REF_CONF} -gt 0 ]; then
+	echo "You are  installing a new configuration based on ${REF_CONF}"
+	. ${COMPIL_DIR}/Fcopy_dir.sh ${REF_CONF}  
+    fi
+    NEW_CONF=${x_n}
+    . ${COMPIL_DIR}/Fmake_config.sh ${NEW_CONF} ${REF_CONF}
+else
+    sed -e "/${NEW_CONF} /d"  ${COMPIL_DIR}/cfg.txt >  ${COMPIL_DIR}/cfg.tmp
+    \mv  ${COMPIL_DIR}/cfg.tmp  ${COMPIL_DIR}/cfg.txt
+fi
+
+#-
+#- Save new configuration and directories names ---
+echo ${NEW_CONF} ${TAB[*]} >> ${COMPIL_DIR}/cfg.txt
+
+#-
+#- Create the WORK ---
+#- Clean links and librairies ---
+#- Creating the good links, at first on OPA_SRC ---
+. ${COMPIL_DIR}/Fmake_WORK.sh ${NEW_CONF} ${TAB[*]} || exit
+
+. ${COMPIL_DIR}/Fmake_bld.sh ${CONFIG_DIR} ${NEW_CONF}  ${NEMO_TDIR} || exit
+
+#- 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 the configuration has beeen chosen
+#- We look after agrif
+grep key_agrif ${COMPIL_DIR}/cpp.fcm && export AGRIFUSE=1
+. ${COMPIL_DIR}/Fprep_agrif.sh ${NEW_CONF} ${NEMO_TDIR} || exit
+
+#- and test whether we need to build the ioserver
+export USEBLD=bldxio.cfg
+grep key_iomput ${COMPIL_DIR}/cpp.fcm && export USEBLD=bld.cfg
+
+#-
+#_ END OF CONFIGURATION PHASE
+#_
+
+#-
+#- Compile ---
+
+if [ "${NBR_PRC}" -gt 0 ]; then
+    cd ${NEMO_TDIR}/${NEW_CONF} || cd -
+
+#if AGRIF we do a first preprocessing
+    if [ ${#x_c} -eq 0 ]; then
+        [ "$AGRIFUSE" == 1 ] && fcm build --ignore-lock -s 2 ${COMPIL_DIR}/$USEBLD
+        [ "$AGRIFUSE" == 1 ] && rm -rf  ${NEMO_TDIR}/${NEW_CONF}/BLD/*
+    fi
+    fcm build ${x_c} --ignore-lock -v 1 -j ${NBR_PRC} ${COMPIL_DIR}/$USEBLD || cd -
+    [ -f ${NEMO_TDIR}/${NEW_CONF}/BLD/bin/nemo.exe ] && ln -sf ${NEMO_TDIR}/${NEW_CONF}/BLD/bin/nemo.exe  ${CONFIG_DIR}/${NEW_CONF}/EXP00/opa
+    [ -f ${NEMO_TDIR}/${NEW_CONF}/BLD/bin/server.exe ] && ln -sf ${NEMO_TDIR}/${NEW_CONF}/BLD/bin/server.exe  ${CONFIG_DIR}/${NEW_CONF}/EXP00/server.exe
+
+#add remove for clean option
+    if  [ ${#x_c} -ne 0 ]; then
+        rm -rf ${NEMO_TDIR}/${NEW_CONF}/WORK
+        rm -rf ${NEMO_TDIR}/${NEW_CONF}/BLD
+        rm -rf ${NEMO_TDIR}/${NEW_CONF}/EXP00/opa
+        rm -rf ${NEMO_TDIR}/${NEW_CONF}/EXP00/server.exe
+        echo "cleaning ${NEW_CONF} WORK, BLD"
+    fi
+
+fi
+
+#- Come back to original directory ---
+cd -
+
+#-
+#- Unset variables
+${COMPIL_DIR}/Fclean_var.sh
+
+
Index: trunk/NEMOGCM/EXTERNAL/AGRIF/AA_make
===================================================================
--- trunk/NEMOGCM/EXTERNAL/AGRIF/AA_make	(revision 2527)
+++ 	(revision )
@@ -1,133 +1,0 @@
-#- $Id$
-
-TMP=../../../tmp
-
-SRM=/bin/rm -f
-
-#-Q- sx8mercure C_L	= $(FC_L) 
-#-Q- sx8mercure C_O	= $(FC_O) 
-#-Q- sx9mercure C_L	= $(FC_L) 
-#-Q- sx9mercure C_O	= $(FC_O) 
-#-Q- sx8brodie C_L= $(FC_L) 
-#-Q- sx8brodie C_O= $(FC_O) 
-#-Q- sxdkrz C_L	= $(FC_L) 
-#-Q- sxdkrz C_O	= $(FC_O) 
-#-Q- es2 C_L	= $(FC_L) 
-#-Q- es2 C_O	= $(FC_O) 
-#-Q- sx8mercure F_O +=  -Wf"-init heap=zero"
-#-Q- sx9mercure F_O +=  -Wf"-init heap=zero" 
-#-Q- sx8brodie F_O +=   -Wf"-init heap=zero" 
-#-Q- sxdkrz F_O +=  -Wf"-init heap=zero" 
-#-Q- es2 F_O +=  -Wf"-init heap=zero" 
-#-Q- aix F_O = $(w_w) -I$(MODDIR) -qmoddir=$(MODDIR) -qextname
-#-Q- aix6 F_O = $(w_w) -I$(MODDIR) -qmoddir=$(MODDIR) -qextname
-#-Q- osxxlf F_O = $(w_w) -I$(MODDIR) -qmoddir=$(MODDIR) -qextname
-#-Q- linux F_O = $(F_D) $(F_P) -Mfixed -module $(MODDIR)
-
-AGRIFOBJS=AGRIF_OBJS
-AGRIFFILES=AGRIF_FILES
-AGRIFYOURFILES=AGRIF_YOURFILES
-
-FILENAMES= modbc modmpp modcluster modinit modinitvars modinterp  \
-	   modtypes modbcfunction modutil modcurgridfunctions \
-	   modmask modsauv modupdate modinterpbasic\
-	   modupdatebasic modlinktomodel modarrays modflux
-	   
-OBJS1=$(addprefix $(AGRIFOBJS)/,$(FILENAMES))
-OBJS=$(addsuffix .o,$(OBJS1))
-
-
-AGRIF_FILES1=$(addprefix $(AGRIFFILES)/,$(FILENAMES))
-AGRIF_FILES=$(addsuffix .F,$(AGRIF_FILES1))
-
-all :   conv_exe key $(MODDIR)/libagrif.a $(SXMODEL_LIB)
-	@echo AGRIF is OK
-
-conv_exe : 
-	@( cd LIB ; $(M_K) -f Makefile C_L="$(C_L)" C_O="$(C_O)" )
-
-key : 
-	-@if [ "`cat KEY_CPP`" != "$(P_P)" ] ; then \
-	echo "$(P_P)" > KEY_CPP ; fi
-
-$(MODDIR)/libagrif.a : $(OBJS)
-	@$(A_C) $@ $(OBJS)
-
-$(SXMODEL_LIB) : $(OBJS)
-#-Q- sxdkrz     @$(A_X) $@ $(OBJS)
-#-Q- es2     @$(A_X) $@ $(OBJS)
-
-$(AGRIFOBJS)/%.o : $(AGRIFFILES)/%.F KEY_CPP
-	@$(SRM) $(AGRIFYOURFILES)/$(*F).f
-	@$(P_C) $(P_O) $(AGRIFFILES)/$(*F).F > $(AGRIFYOURFILES)/$(*F).f
-	@$(F_C) $(F_O) $(FFLAGS_EXTEND) $(AGRIF_OPTS) -c $(AGRIFYOURFILES)/$(*F).f -o $(AGRIFOBJS)/$(*F).o
-#-Q- linux	@$(SRM) $*.lst
-#-Q- ibm	@$(SRM) $*.lst
-#-Q- aix	@$(SRM) $*.lst
-#-Q- aix6	@$(SRM) $*.lst
-#-Q- sx8mercure	mv *.mod $(MODDIR)
-#-Q- sx9mercure	mv *.mod $(MODDIR)
-#-Q- sx8brodie	mv *.mod $(MODDIR)
-#-Q- sxdkrz	mv *.mod $(MODDIR)
-#-Q- es2	mv *.mod $(MODDIR)
-#-Q- solaris	mv *.mod $(MODDIR)
-
-
-$(AGRIFOBJS)/modarrays.o: $(AGRIFOBJS)/modtypes.o
-
-$(AGRIFOBJS)/modbc.o: $(AGRIFOBJS)/modinterp.o
-
-$(AGRIFOBJS)/modbcfunction.o: $(AGRIFOBJS)/modupdate.o \
-			 $(AGRIFOBJS)/modflux.o  \
-			 $(AGRIFOBJS)/modbc.o 
-
-$(AGRIFOBJS)/modcluster.o: $(AGRIFOBJS)/modsauv.o \
-			$(AGRIFOBJS)/modinitvars.o \
-			$(AGRIFOBJS)/modcurgridfunctions.o
-
-$(AGRIFOBJS)/modcurgridfunctions.o: $(AGRIFOBJS)/modinit.o
-
-$(AGRIFOBJS)/modinit.o: $(AGRIFOBJS)/modlinktomodel.o \
-			$(AGRIFOBJS)/modtypes.o
-
-$(AGRIFOBJS)/modinitvars.o: $(AGRIFOBJS)/modlinktomodel.o \
-			$(AGRIFOBJS)/modtypes.o
-
-$(AGRIFOBJS)/modinterpbasic.o: $(AGRIFOBJS)/modtypes.o
-
-$(AGRIFOBJS)/modinterp.o: $(AGRIFOBJS)/modcurgridfunctions.o \
-			$(AGRIFOBJS)/modmask.o \
-			$(AGRIFOBJS)/modarrays.o \
-			$(AGRIFOBJS)/modmpp.o \
-			$(AGRIFOBJS)/modinterpbasic.o
-
-$(AGRIFOBJS)/modlinktomodel.o: $(AGRIFOBJS)/modtypes.o
-
-$(AGRIFOBJS)/modmask.o: $(AGRIFOBJS)/modtypes.o
-
-$(AGRIFOBJS)/modsauv.o: $(AGRIFOBJS)/modarrays.o \
-			$(AGRIFOBJS)/modlinktomodel.o \
-			$(AGRIFOBJS)/modtypes.o
-
-$(AGRIFOBJS)/modupdatebasic.o: $(AGRIFOBJS)/modtypes.o
-
-$(AGRIFOBJS)/modupdate.o: $(AGRIFOBJS)/modmask.o \
-			$(AGRIFOBJS)/modcurgridfunctions.o \
-			$(AGRIFOBJS)/modarrays.o \
-			$(AGRIFOBJS)/modmpp.o \
-			$(AGRIFOBJS)/modupdatebasic.o
-
-$(AGRIFOBJS)/modutil.o: $(AGRIFOBJS)/modcurgridfunctions.o \
-			$(AGRIFOBJS)/modcluster.o
-
-$(AGRIFOBJS)/modmpp.o: $(AGRIFOBJS)/modtypes.o \
-			$(AGRIFOBJS)/modarrays.o
-
-clean : FORCE
-	$(SRM) $(OBJS) $(MODOBJS)$(LIBDIR)/libagrif.a 
-	
-cleanall : FORCE
-	$(SRM) $(OBJS) $(MODOBJS)$(LIBDIR)/libagrif.a 
-	@(cd LIB ; $(M_K) -f Makefile clean )
-
-FORCE :
Index: trunk/NEMOGCM/EXTERNAL/AGRIF/AA_make.ldef
===================================================================
--- trunk/NEMOGCM/EXTERNAL/AGRIF/AA_make.ldef	(revision 2527)
+++ 	(revision )
@@ -1,29 +1,0 @@
-#- $Id$
-#---------------------------------------------------------------------
-#- Creation des elements relatifs a AGRIF (lib, config)
-#---------------------------------------------------------------------
-SHELL = /bin/sh
-#---------------------------------------------------------------------
-LIBDIR = ../../lib
-MODDIR = $(LIBDIR)
-#---------------------------------------------------------------------
-#--- -DNC_REAL option is needed if compiled in simple precision
-#--- In case you switch to double precision use -DNC_DOUBLE
-#-
-# Compilation:
-#-Q- lxiv7 FFLAGS_EXTEND=  -I..
-#-Q- lxiv8 FFLAGS_EXTEND=  -I..
-#-Q- sun   FFLAGS_EXTEND= -I..
-#-Q- aix   FFLAGS_EXTEND = -I.. -I$(HOME)/include/ -qsuffix=f=f
-#-Q- aix   AGRIF_OPTS = -qfixed -qrecur
-#-Q- aix6  FFLAGS_EXTEND = -I.. -I$(HOME)/include/ -qsuffix=f=f
-#-Q- aix6  AGRIF_OPTS = -qfixed -qrecur
-#-Q- ibm   FFLAGS_EXTEND = -I.. -I$(HOME)/include/ -qsuffix=f=f
-#-Q- ibm   AGRIF_OPTS = -qfixed -qrecur
-#-
-MODEL_LIB = $(LIBDIR)/libagrif.a
-SXMODEL_LIB = $(MODEL_LIB)
-#-Q- sxdkrz SXMODEL_LIB = $(LIBDIR)/libsxagrif.a
-#-Q- es2 SXMODEL_LIB = $(LIBDIR)/libsxagrif.a
-#-
-P_P=$(AGRIF_MPI)
Index: trunk/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modarrays.F
===================================================================
--- trunk/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modarrays.F	(revision 2527)
+++ trunk/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modarrays.F	(revision 2528)
@@ -55,5 +55,5 @@
       INTEGER :: i,lbglob,ubglob
 C
-#ifdef AGRIF_MPI
+#ifdef key_mpp_mpi
       INTEGER :: indglob1,indglob2
 #endif
@@ -65,5 +65,5 @@
         ubglob = uboundloc(i)
 C
-#ifdef AGRIF_MPI
+#ifdef key_mpp_mpi
 C
         Call AGRIF_InvLoc(lbglob,Agrif_ProcRank,i,indglob1)
@@ -335,5 +335,5 @@
 C
 C
-#if !defined AGRIF_MPI
+#if !defined key_mpp_mpi
 C     **************************************************************************
 CCC   Subroutine Agrif_nbdim_VarEQreal
@@ -754,5 +754,5 @@
 C
 C
-#ifdef AGRIF_MPI
+#ifdef key_mpp_mpi
 C     **************************************************************************
 CCC   Subroutine Where_ValTabToTab_mpi
@@ -1029,5 +1029,5 @@
       End Subroutine PreProcessToInterpOrUpdate     
 
-#ifdef AGRIF_MPI
+#ifdef key_mpp_mpi
 C
 C     **************************************************************************
@@ -1091,5 +1091,5 @@
 C
 C
-#ifdef AGRIF_MPI
+#ifdef key_mpp_mpi
 C
 C
Index: trunk/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbc.F
===================================================================
--- trunk/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbc.F	(revision 2527)
+++ trunk/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbc.F	(revision 2528)
@@ -717,7 +717,7 @@
       
 C
-#ifdef AGRIF_MPI
-C
-#include "mpif.h"
+#ifdef key_mpp_mpi
+C
+      INCLUDE 'mpif.h'
 C
 #endif
@@ -772,5 +772,5 @@
                                        !    (c2t=1-c1t) 
 C
-#ifdef AGRIF_MPI
+#ifdef key_mpp_mpi
 C
       INTEGER,DIMENSION(nbdim)   :: lower,upper
@@ -796,5 +796,5 @@
       
 
-#if !defined AGRIF_MPI
+#if !defined key_mpp_mpi
       Call Agrif_nbdim_Get_bound_dimension(child%var,lubglob(:,1),
      &              lubglob(:,2),nbdim)
@@ -886,5 +886,5 @@
       
 C
-#if defined AGRIF_MPI
+#if defined key_mpp_mpi
                  Call Agrif_nbdim_Get_bound_dimension
      &                    (child%var,lower,upper,nbdim)
Index: trunk/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterp.F
===================================================================
--- trunk/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterp.F	(revision 2527)
+++ trunk/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterp.F	(revision 2528)
@@ -37,5 +37,5 @@
       Use Agrif_Mask 
       Use Agrif_CurgridFunctions
-#if defined AGRIF_MPI
+#if defined key_mpp_mpi
       Use Agrif_mpp
 #endif
@@ -656,7 +656,7 @@
       
 C
-#ifdef AGRIF_MPI
-C
-#include "mpif.h"
+#ifdef key_mpp_mpi
+C
+        INCLUDE 'mpif.h'
 C
 #endif
@@ -715,5 +715,5 @@
       INTEGER,DIMENSION(nbdim)    :: indminglob2,indmaxglob2      
 C
-#ifdef AGRIF_MPI
+#ifdef key_mpp_mpi
 C
       LOGICAL :: memberout
@@ -739,5 +739,5 @@
      &       indmaxglob,indminglob2,indmaxglob2,parentarray,
      &       pttruetab,cetruetab,member,memberin,find_list_interp
-#if defined AGRIF_MPI
+#if defined key_mpp_mpi
      &       ,tab4t,memberinall,sendtoproc1,recvfromproc1
 #endif
@@ -766,5 +766,5 @@
      &                        child % var % root_var % interptab)
        
-#ifdef AGRIF_MPI
+#ifdef key_mpp_mpi
        IF (memberin) THEN
         Call Agrif_Parentbounds(TYPEinterp,nbdim,indmin,indmax,
@@ -810,5 +810,5 @@
       ELSE
       
-#if !defined AGRIF_MPI
+#if !defined key_mpp_mpi
       parentarray(:,1,1) = indminglob
       parentarray(:,2,1) = indmaxglob
@@ -885,5 +885,5 @@
             endif
 
-#ifdef AGRIF_MPI
+#ifdef key_mpp_mpi
       if (.not.find_list_interp) then
       tab3(:,1) = indminglob2(:)
@@ -936,5 +936,5 @@
      &   indminglob,indmaxglob,indminglob2,indmaxglob2,parentarray,
      &   pttruetab,cetruetab,member,memberin,nbdim
-#if defined AGRIF_MPI
+#if defined key_mpp_mpi
      &   ,tab4t,memberinall,sendtoproc1,recvfromproc1
 #endif
@@ -1034,5 +1034,5 @@
      &                               lowerbound,upperbound,nbdim)
 
-#ifdef AGRIF_MPI
+#ifdef key_mpp_mpi
       Call Agrif_GlobtoLocInd2(childarray,
      &                     lowerbound,upperbound,
@@ -1069,5 +1069,5 @@
       if (torestore) then
 C
-#ifdef AGRIF_MPI
+#ifdef key_mpp_mpi
 C
         SELECT CASE (nbdim)
@@ -1301,5 +1301,5 @@
 C             
 C     Deallocations
-#ifdef AGRIF_MPI        
+#ifdef key_mpp_mpi        
       IF (member) THEN
       Call Agrif_nbdim_deallocation(tempP%var,nbdim)
@@ -2136,5 +2136,5 @@
      &       pttruetab,cetruetab,member,memberin,
      &      find_list_interp
-#if defined AGRIF_MPI
+#if defined key_mpp_mpi
      &     ,tab4t,memberinall,sendtoproc1,recvfromproc1
 #endif
@@ -2152,5 +2152,5 @@
       LOGICAL :: member, memberin
       INTEGER :: i
-#ifdef AGRIF_MPI
+#ifdef key_mpp_mpi
 C
       INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t
@@ -2180,5 +2180,5 @@
         cetruetab = parcours%interp_loc%cetruetab(1:nbdim)
                 
-#if !defined AGRIF_MPI
+#if !defined key_mpp_mpi
         indminglob = parcours%interp_loc%indminglob(1:nbdim)
         indmaxglob = parcours%interp_loc%indmaxglob(1:nbdim)
@@ -2207,5 +2207,5 @@
      &                          parentarray,pttruetab,cetruetab,
      &                          member,memberin,nbdim
-#if defined AGRIF_MPI
+#if defined key_mpp_mpi
      &      ,tab4t,memberinall,sendtoproc1,recvfromproc1
 #endif
@@ -2221,5 +2221,5 @@
       INTEGER,DIMENSION(nbdim,2,2) :: parentarray
       LOGICAL :: member, memberin
-#ifdef AGRIF_MPI
+#ifdef key_mpp_mpi
 C
       INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t
@@ -2243,5 +2243,5 @@
 
       parcours%interp_loc%memberin = memberin
-#if !defined AGRIF_MPI
+#if !defined key_mpp_mpi
       parcours%interp_loc%indminglob(1:nbdim) = indminglob(1:nbdim)
       parcours%interp_loc%indmaxglob(1:nbdim) = indmaxglob(1:nbdim)
Index: trunk/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmpp.F
===================================================================
--- trunk/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmpp.F	(revision 2527)
+++ trunk/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmpp.F	(revision 2528)
@@ -30,5 +30,5 @@
 
       Contains
-#ifdef AGRIF_MPI
+#ifdef key_mpp_mpi
       Subroutine Get_External_Data_first(pttruetab,
      &   cetruetab,pttruetabwhole,cetruetabwhole,nbdim,memberin,
@@ -37,5 +37,5 @@
 
       IMPLICIT NONE
-#include "mpif.h"
+      INCLUDE 'mpif.h'
       INTEGER :: nbdim
       INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1)    :: pttruetab,
@@ -177,5 +177,5 @@
 
       IMPLICIT NONE
-#include "mpif.h"
+      INCLUDE 'mpif.h'
       INTEGER :: nbdim
       TYPE(Agrif_PVariable) :: tempC, tempCextend
@@ -345,5 +345,5 @@
       TYPE(AGRIF_PVARIABLE), SAVE                      :: temprecv
 
-#include "mpif.h"
+      INCLUDE 'mpif.h'
           INTEGER :: i,k
           INTEGER :: etiquette = 100
@@ -682,5 +682,5 @@
       LOGICAL                                    :: res
 
-#include "mpif.h"
+      INCLUDE 'mpif.h'
           INTEGER :: i,k
           INTEGER :: etiquette = 100
@@ -798,5 +798,5 @@
       TYPE(AGRIF_PVARIABLE), SAVE                      :: temprecv
 
-#include "mpif.h"
+      INCLUDE 'mpif.h'
           INTEGER :: i,k
           INTEGER :: etiquette = 100
@@ -1096,5 +1096,5 @@
           integer :: etiquette = 100
           integer :: datasize, code
-#include "mpif.h"   
+        INCLUDE 'mpif.h'
 
           datasize = SIZE(tab3D(
Index: trunk/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modsauv.F
===================================================================
--- trunk/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modsauv.F	(revision 2527)
+++ trunk/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modsauv.F	(revision 2528)
@@ -199,5 +199,5 @@
      &      Call Agrif_Free_list_interp(list_interp%suiv)
      
-#ifdef AGRIF_MPI
+#ifdef key_mpp_mpi
        Deallocate(list_interp%interp_loc%tab4t)
        Deallocate(list_interp%interp_loc%memberinall)
Index: trunk/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modtypes.F
===================================================================
--- trunk/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modtypes.F	(revision 2527)
+++ trunk/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modtypes.F	(revision 2528)
@@ -276,5 +276,5 @@
       INTEGER,DIMENSION(6)    :: pttruetab,cetruetab
       logical :: member, memberin      
-#if !defined AGRIF_MPI      
+#if !defined key_mpp_mpi      
       integer,dimension(6) :: indminglob,indmaxglob
 #else
@@ -408,5 +408,5 @@
       INTEGER               :: Agrif_USE_FIXED_GRIDS         
 C
-#ifdef AGRIF_MPI
+#ifdef key_mpp_mpi
       INTEGER :: Agrif_Nbprocs  ! Number of processors
       INTEGER :: Agrif_ProcRank ! Rank of the current processor 
Index: trunk/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdate.F
===================================================================
--- trunk/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdate.F	(revision 2527)
+++ trunk/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdate.F	(revision 2528)
@@ -37,5 +37,5 @@
       Use Agrif_CurgridFunctions
       Use Agrif_Mask
-#ifdef AGRIF_MPI
+#ifdef key_mpp_mpi
       Use Agrif_mpp
 #endif
@@ -627,7 +627,7 @@
       
 C
-#ifdef AGRIF_MPI
-C
-#include "mpif.h"
+#ifdef key_mpp_mpi
+C
+      INCLUDE 'mpif.h'
 C
 #endif
@@ -676,5 +676,5 @@
       INTEGER :: debloc, finloc
 C
-#ifdef AGRIF_MPI
+#ifdef key_mpp_mpi
 C
       INTEGER,DIMENSION(nbdim)   :: lb,ub
@@ -740,5 +740,5 @@
 C lubglob(:,2) : global lbound for each dimension
 
-#if !defined AGRIF_MPI
+#if !defined key_mpp_mpi
         Call Agrif_nbdim_Get_bound_dimension(child % var,lubglob(:,1),
      &               lubglob(:,2),nbdim)
@@ -817,7 +817,7 @@
       
 C
-#ifdef AGRIF_MPI
-C
-#include "mpif.h"
+#ifdef key_mpp_mpi
+C
+       INCLUDE 'mpif.h'
 C
 #endif
@@ -866,5 +866,5 @@
       integer :: coeffraf
 C
-#ifdef AGRIF_MPI
+#ifdef key_mpp_mpi
 C
       INTEGER,DIMENSION(nbdim)   :: lb,ub
@@ -907,5 +907,5 @@
       ENDDO
 
-#if !defined AGRIF_MPI      
+#if !defined key_mpp_mpi      
         Call Agrif_nbdim_Get_bound_dimension(child % var,lubglob(:,1),
      &               lubglob(:,2),nbdim)
@@ -1059,7 +1059,7 @@
       
 C
-#ifdef AGRIF_MPI
-C
-#include "mpif.h"
+#ifdef key_mpp_mpi
+C
+       INCLUDE 'mpif.h'
 C
 #endif
@@ -1117,5 +1117,5 @@
       INTEGER :: nbin, ndirin
 C
-#ifdef AGRIF_MPI
+#ifdef key_mpp_mpi
 C
       INTEGER,DIMENSION(nbdim)    :: indminglob2,indmaxglob2
@@ -1157,10 +1157,10 @@
      &                     pttab_Parent,
      &                     posvartab_Child,TypeUpdate,loctab_Child
-#ifdef AGRIF_MPI
+#ifdef key_mpp_mpi
      &                 ,pttruetabwhole,cetruetabwhole
 #endif
      &     )
 
-#ifdef AGRIF_MPI
+#ifdef key_mpp_mpi
       IF (memberin) THEN
        Call Agrif_GlobtoLocInd2(childarray,
@@ -1266,5 +1266,5 @@
 C
 C
-#ifdef AGRIF_MPI
+#ifdef key_mpp_mpi
 C
 C     tab2 contains the necessary limits of the parent grid for each processor
@@ -1391,5 +1391,5 @@
       ENDIF
 
-#ifdef AGRIF_MPI
+#ifdef key_mpp_mpi
       Call Agrif_nbdim_Get_bound_dimension(parent%var,
      &                              lowerbound,upperbound,nbdim)
@@ -1475,5 +1475,5 @@
 ccc     &    child % var % root_var % interptab(1:nbdim) .EQ. 'N'
 C
-#ifdef AGRIF_MPI
+#ifdef key_mpp_mpi
 C
 c          Allocate(childvalues% var)
@@ -1513,5 +1513,5 @@
       if (Agrif_UseSpecialValue) then
 C
-#ifdef AGRIF_MPI
+#ifdef key_mpp_mpi
 C
 c          Call GiveAgrif_SpecialValueToTab_mpi(parent%var,tempP%var,
@@ -1678,5 +1678,5 @@
 
       IF (memberin) THEN
-#ifdef AGRIF_MPI
+#ifdef key_mpp_mpi
       Call Agrif_nbdim_deallocation(tempP%var,nbdim)
       Call Agrif_nbdim_deallocation(tempC%var,nbdim)
@@ -1685,5 +1685,5 @@
 !      Deallocate(tempP % var)
       ENDIF
-#ifdef AGRIF_MPI
+#ifdef key_mpp_mpi
 !      Deallocate(tempPextend%var)
 !      IF (.Not.memberin) Deallocate(tempCextend%var)
@@ -1706,5 +1706,5 @@
      &                              posvartab_child,TypeUpdate,
      &                              loctab_Child
-#ifdef AGRIF_MPI
+#ifdef key_mpp_mpi
      &                 ,pttruetabwhole,cetruetabwhole
 #endif
@@ -1720,5 +1720,5 @@
       
 C
-#ifdef AGRIF_MPI
+#ifdef key_mpp_mpi
 cccccccccccccccccccccccccc#include "mpif.h"
 #endif
@@ -1738,5 +1738,5 @@
       INTEGER :: i
       REAL,DIMENSION(nbdim) :: dim_newmin,dim_newmax      
-#ifdef AGRIF_MPI
+#ifdef key_mpp_mpi
       INTEGER,DIMENSION(nbdim)    :: pttruetabwhole,cetruetabwhole
       REAL :: positionmin,positionmax
@@ -1759,5 +1759,5 @@
      &        agrif_int((dim_newmax(i)-s_Parent(i))/ds_Parent(i))
 C
-#ifdef AGRIF_MPI
+#ifdef key_mpp_mpi
         positionmin = s_Parent(i) + (indmin(i)-
      &                          pttab_Parent(i))*ds_Parent(i)
@@ -1816,5 +1816,5 @@
         s_Child_temp(i) = dim_newmin(i)
 
-#ifdef AGRIF_MPI
+#ifdef key_mpp_mpi
         s_Child_temp(i) = positionmin
 #endif
@@ -2521,5 +2521,5 @@
       End Subroutine Agrif_Compute_nbdim_update
  
-#if defined AGRIF_MPI      
+#if defined key_mpp_mpi      
       Subroutine Agrif_Find_list_update(list_update,pttab,petab,
      &                          pttab_Child,pttab_Parent,nbdim,
Index: trunk/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modutil.F
===================================================================
--- trunk/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modutil.F	(revision 2527)
+++ trunk/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modutil.F	(revision 2528)
@@ -62,8 +62,8 @@
       External :: procname
 C
-#ifdef AGRIF_MPI
+#ifdef key_mpp_mpi
       Logical      :: mpi_was_called
       Integer      :: code, ierr
-#include "mpif.h"
+      INCLUDE 'mpif.h'
 C
 C
@@ -670,6 +670,6 @@
 C             definition of the probdim and modtypes variables
 C
-#ifdef AGRIF_MPI
-#include "mpif.h"
+#ifdef key_mpp_mpi
+      INCLUDE 'mpif.h'
       Agrif_MPIPREC = MPI_DOUBLE_PRECISION
 #endif
Index: trunk/NEMOGCM/EXTERNAL/AGRIF/KEY_CPP
===================================================================
--- trunk/NEMOGCM/EXTERNAL/AGRIF/KEY_CPP	(revision 2527)
+++ 	(revision )
@@ -1,1 +1,0 @@
-
Index: trunk/NEMOGCM/EXTERNAL/AGRIF/efface
===================================================================
--- trunk/NEMOGCM/EXTERNAL/AGRIF/efface	(revision 2527)
+++ 	(revision )
@@ -1,9 +1,0 @@
-rm -f AGRIF_INC/*
-rm -f AGRIF_MODELFILES/*
-rm -f AGRIF_OBJS/*
-rm -f AGRIF_YOURFILES/*
-rm -f SORTIE/*
-
-rm -f .depend*
-rm -f .agrif*
-rm -f LIB/*.o
Index: trunk/NEMOGCM/EXTERNAL/IOIPSL/IOIPSL_License_CeCILL.txt
===================================================================
--- trunk/NEMOGCM/EXTERNAL/IOIPSL/IOIPSL_License_CeCILL.txt	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/IOIPSL/IOIPSL_License_CeCILL.txt	(revision 2528)
@@ -0,0 +1,36 @@
+The following licence information concerns ONLY the IOIPSL directory
+====================================================================
+
+Copyright (C) Institut Pierre Simon Laplace : IPSL
+
+This software is composed by a set of subroutines working as an
+interface between climate models and NETCDF files following CF
+convention. Library sources, examples of use and tools based on
+IOIPSL are provided. This library requires NetCDF library :
+http://www.unidata.ucar.edu/software/netcdf/
+
+This software is governed by the CeCILL 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
+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 license and that you accept its terms.
Index: trunk/NEMOGCM/EXTERNAL/IOIPSL/src/calendar.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/IOIPSL/src/calendar.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/IOIPSL/src/calendar.f90	(revision 2528)
@@ -0,0 +1,1044 @@
+MODULE calendar
+!-
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+!- This is the calendar which going to be used to do all
+!- calculations on time. Three types of calendars are possible :
+!-
+!-  - gregorian :
+!-      The normal calendar. The time origin for the
+!-      julian day in this case is 24 Nov -4713
+!-      (other names : 'standard','proleptic_gregorian')
+!-  - noleap :
+!-      A 365 day year without leap years.
+!-      The origin for the julian days is in this case 1 Jan 0
+!-      (other names : '365_day','365d')
+!-  - all_leap :
+!-      A 366 day year with leap years.
+!-      The origin for the julian days is in this case ????
+!-      (other names : '366_day','366d'
+!-  - julian :
+!-      same as gregorian, but with all leap century years
+!-  - xxxd :
+!-      Year of xxx days with month of equal length.
+!-      The origin for the julian days is then also 1 Jan 0
+!-
+!- As one can see it is difficult to go from one calendar to the other.
+!- All operations involving julian days will be wrong.
+!- This calendar will lock as soon as possible
+!- the length of the year and forbid any further modification.
+!-
+!- For the non leap-year calendar the method is still brute force.
+!- We need to find an Integer series which takes care of the length
+!- of the various month. (Jan)
+!-
+!-   one_day  : one day in seconds
+!-   one_year : one year in days
+!---------------------------------------------------------------------
+  USE stringop,ONLY  : strlowercase
+  USE errioipsl,ONLY : ipslerr
+!-
+  PRIVATE
+  PUBLIC :: ymds2ju,ju2ymds,tlen2itau,isittime,ioconf_calendar, &
+ &          ioget_calendar,ioget_mon_len,ioget_year_len,itau2date, &
+ &          ioget_timestamp,ioconf_startdate,itau2ymds, &
+ &          time_diff,time_add,lock_calendar
+!-
+  INTERFACE ioget_calendar
+    MODULE PROCEDURE &
+ &    ioget_calendar_real1,ioget_calendar_real2,ioget_calendar_str
+  END INTERFACE
+!-
+  INTERFACE ioconf_startdate
+     MODULE PROCEDURE &
+ &    ioconf_startdate_simple,ioconf_startdate_internal, &
+ &    ioconf_startdate_ymds
+  END INTERFACE
+!-
+  REAL,PARAMETER :: one_day = 86400.0
+  LOGICAL,SAVE :: lock_startdate = .FALSE.
+!-
+  CHARACTER(LEN=30),SAVE :: time_stamp='XXXXXXXXXXXXXXXX'
+!-
+!- Description of calendar
+!-
+  CHARACTER(LEN=20),SAVE :: calendar_used="gregorian"
+  LOGICAL,SAVE :: lock_one_year = .FALSE.
+  REAL,SAVE :: one_year = 365.2425
+  INTEGER,SAVE :: mon_len(12)=(/31,28,31,30,31,30,31,31,30,31,30,31/)
+!-
+  CHARACTER(LEN=3),PARAMETER :: &
+ &  cal(12) = (/'JAN','FEB','MAR','APR','MAY','JUN', &
+ &              'JUL','AUG','SEP','OCT','NOV','DEC'/)
+!-
+  REAL,SAVE :: start_day,start_sec
+!-
+CONTAINS
+!-
+!===
+!-
+SUBROUTINE lock_calendar (new_status,old_status)
+!!--------------------------------------------------------------------
+!! The "lock_calendar" routine
+!! allows to lock or unlock the calendar,
+!! and to know the current status of the calendar.
+!! Be careful !
+!!
+!! SUBROUTINE lock_calendar (new_status,old_status)
+!!
+!! Optional INPUT argument
+!!
+!! (L) new_status : new status of the calendar
+!!
+!! Optional OUTPUT argument
+!!
+!! (L) old_status : current status of the calendar
+!!--------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  LOGICAL,OPTIONAL,INTENT(IN)  :: new_status
+  LOGICAL,OPTIONAL,INTENT(OUT) :: old_status
+!---------------------------------------------------------------------
+  IF (PRESENT(old_status)) THEN
+    old_status = lock_one_year
+  ENDIF
+  IF (PRESENT(new_status)) THEN
+    lock_one_year = new_status
+  ENDIF
+!---------------------------
+END SUBROUTINE lock_calendar
+!-
+!===
+!-
+SUBROUTINE ymds2ju (year,month,day,sec,julian)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: year,month,day
+  REAL,INTENT(IN)    :: sec
+!-
+  REAL,INTENT(OUT) :: julian
+!-
+  INTEGER :: julian_day
+  REAL    :: julian_sec
+!---------------------------------------------------------------------
+  CALL ymds2ju_internal (year,month,day,sec,julian_day,julian_sec)
+!-
+  julian = julian_day+julian_sec/one_day
+!---------------------
+END SUBROUTINE ymds2ju
+!-
+!===
+!-
+SUBROUTINE ymds2ju_internal (year,month,day,sec,julian_day,julian_sec)
+!---------------------------------------------------------------------
+!- Converts year, month, day and seconds into a julian day
+!-
+!- In 1968 in a letter to the editor of Communications of the ACM
+!- (CACM, volume 11, number 10, October 1968, p.657) Henry F. Fliegel
+!- and Thomas C. Van Flandern presented such an algorithm.
+!-
+!- See also : http://www.magnet.ch/serendipity/hermetic/cal_stud/jdn.htm
+!-
+!- In the case of the Gregorian calendar we have chosen to use
+!- the Lilian day numbers. This is the day counter which starts
+!- on the 15th October 1582.
+!- This is the day at which Pope Gregory XIII introduced the
+!- Gregorian calendar.
+!- Compared to the true Julian calendar, which starts some
+!- 7980 years ago, the Lilian days are smaler and are dealt with
+!- easily on 32 bit machines. With the true Julian days you can only
+!- the fraction of the day in the real part to a precision of
+!- a 1/4 of a day with 32 bits.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: year,month,day
+  REAL,INTENT(IN)    :: sec
+!-
+  INTEGER,INTENT(OUT) :: julian_day
+  REAL,INTENT(OUT)    :: julian_sec
+!-
+  INTEGER :: jd,m,y,d,ml
+!---------------------------------------------------------------------
+  lock_one_year = .TRUE.
+!-
+  m = month
+  y = year
+  d = day
+!-
+!- We deduce the calendar from the length of the year as it
+!- is faster than an INDEX on the calendar variable.
+!-
+  IF ( (one_year > 365.0).AND.(one_year < 366.0) ) THEN
+!-- "Gregorian"
+    jd = (1461*(y+4800+INT((m-14)/12)))/4 &
+ &      +(367*(m-2-12*(INT((m-14)/12))))/12 &
+ &      -(3*((y+4900+INT((m-14)/12))/100))/4 &
+ &      +d-32075
+    jd = jd-2299160
+  ELSE IF (    (ABS(one_year-365.0) <= EPSILON(one_year))  &
+ &         .OR.(ABS(one_year-366.0) <= EPSILON(one_year)) ) THEN
+!-- "No leap" or "All leap"
+    ml = SUM(mon_len(1:m-1))
+    jd = y*NINT(one_year)+ml+(d-1)
+  ELSE
+!-- Calendar with regular month
+    ml = NINT(one_year/12.)
+    jd = y*NINT(one_year)+(m-1)*ml+(d-1)
+  ENDIF
+!-
+  julian_day = jd
+  julian_sec = sec
+!------------------------------
+END SUBROUTINE ymds2ju_internal
+!-
+!===
+!-
+SUBROUTINE ju2ymds (julian,year,month,day,sec)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  REAL,INTENT(IN) :: julian
+!-
+  INTEGER,INTENT(OUT) :: year,month,day
+  REAL,INTENT(OUT)    :: sec
+!-
+  INTEGER :: julian_day
+  REAL    :: julian_sec
+!---------------------------------------------------------------------
+  julian_day = INT(julian)
+  julian_sec = (julian-julian_day)*one_day
+!-
+  CALL ju2ymds_internal(julian_day,julian_sec,year,month,day,sec)
+!---------------------
+END SUBROUTINE ju2ymds
+!-
+!===
+!-
+SUBROUTINE ju2ymds_internal (julian_day,julian_sec,year,month,day,sec)
+!---------------------------------------------------------------------
+!- This subroutine computes from the julian day the year,
+!- month, day and seconds
+!-
+!- In 1968 in a letter to the editor of Communications of the ACM
+!- (CACM, volume 11, number 10, October 1968, p.657) Henry F. Fliegel
+!- and Thomas C. Van Flandern presented such an algorithm.
+!-
+!- See also : http://www.magnet.ch/serendipity/hermetic/cal_stud/jdn.htm
+!-
+!- In the case of the Gregorian calendar we have chosen to use
+!- the Lilian day numbers. This is the day counter which starts
+!- on the 15th October 1582. This is the day at which Pope
+!- Gregory XIII introduced the Gregorian calendar.
+!- Compared to the true Julian calendar, which starts some 7980
+!- years ago, the Lilian days are smaler and are dealt with easily
+!- on 32 bit machines. With the true Julian days you can only the
+!- fraction of the day in the real part to a precision of a 1/4 of
+!- a day with 32 bits.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: julian_day
+  REAL,INTENT(IN)    :: julian_sec
+!-
+  INTEGER,INTENT(OUT) :: year,month,day
+  REAL,INTENT(OUT)    :: sec
+!-
+  INTEGER :: l,n,i,jd,j,d,m,y,ml
+  INTEGER :: add_day
+  REAL :: eps_day
+!---------------------------------------------------------------------
+  eps_day = SPACING(one_day)
+  lock_one_year = .TRUE.
+!-
+  jd = julian_day
+  sec = julian_sec
+  IF (sec > (one_day-eps_day)) THEN
+    add_day = INT(sec/one_day)
+    sec = sec-add_day*one_day
+    jd = jd+add_day
+  ENDIF
+  IF (sec < -eps_day) THEN
+    sec = sec+one_day
+    jd = jd-1
+  ENDIF
+!-
+  IF ( (one_year > 365.0).AND.(one_year < 366.0) ) THEN
+!-- Gregorian
+    jd = jd+2299160
+!-
+    l = jd+68569
+    n = (4*l)/146097
+    l = l-(146097*n+3)/4
+    i = (4000*(l+1))/1461001
+    l = l-(1461*i)/4+31
+    j = (80*l)/2447
+    d = l-(2447*j)/80
+    l = j/11
+    m = j+2-(12*l)
+    y = 100*(n-49)+i+l
+  ELSE IF (    (ABS(one_year-365.0) <= EPSILON(one_year)) &
+ &         .OR.(ABS(one_year-366.0) <= EPSILON(one_year)) ) THEN
+!-- No leap or All leap
+    y = jd/NINT(one_year)
+    l = jd-y*NINT(one_year)
+    m = 1
+    ml = 0
+    DO WHILE (ml+mon_len(m) <= l)
+      ml = ml+mon_len(m)
+      m = m+1
+    ENDDO
+    d = l-ml+1
+  ELSE
+!-- others
+    ml = NINT(one_year/12.)
+    y = jd/NINT(one_year)
+    l = jd-y*NINT(one_year)
+    m = (l/ml)+1
+    d = l-(m-1)*ml+1
+  ENDIF
+!-
+  day = d
+  month = m
+  year = y
+!------------------------------
+END SUBROUTINE ju2ymds_internal
+!-
+!===
+!-
+SUBROUTINE tlen2itau (input_str,dt,date,itau)
+!---------------------------------------------------------------------
+!- This subroutine transforms a string containing a time length
+!- into a number of time steps.
+!- To do this operation the date (in julian days is needed as the
+!- length of the month varies.
+!- The following convention is used :
+!-   n   : n time steps
+!-   nS  : n seconds is transformed into itaus
+!-   nH  : n hours
+!-   nD  : n days
+!-   nM  : n month
+!-   nY  : n years
+!- Combinations are also possible
+!-   nYmD : nyears plus m days !
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(IN) :: input_str
+  REAL,INTENT(IN)             :: dt,date
+!-
+  INTEGER,INTENT(OUT)         :: itau
+!-
+  INTEGER           :: y_pos,m_pos,d_pos,h_pos,s_pos
+  INTEGER           :: read_time
+  CHARACTER(LEN=13) :: fmt
+  CHARACTER(LEN=80) :: tmp_str
+!-
+  INTEGER :: year,month,day
+  REAL    :: sec,date_new,dd,ss
+!---------------------------------------------------------------------
+  itau = 0
+  CALL ju2ymds (date,year,month,day,sec)
+!-
+  y_pos = MAX(INDEX(input_str,'y'),INDEX(input_str,'Y'))
+  m_pos = MAX(INDEX(input_str,'m'),INDEX(input_str,'M'))
+  d_pos = MAX(INDEX(input_str,'d'),INDEX(input_str,'D'))
+  h_pos = MAX(INDEX(input_str,'h'),INDEX(input_str,'H'))
+  s_pos = MAX(INDEX(input_str,'s'),INDEX(input_str,'S'))
+!-
+  IF (MAX(y_pos,m_pos,d_pos,s_pos) > 0) THEN
+    tmp_str = input_str
+    DO WHILE ( MAX(y_pos,m_pos,d_pos,s_pos) > 0)
+!---- WRITE(*,*) tmp_str
+!---- WRITE(*,*) y_pos,m_pos,d_pos,s_pos
+      IF (y_pos > 0) THEN
+        WRITE(fmt,'("(I",I10.10,")")') y_pos-1
+        READ(tmp_str(1:y_pos-1),fmt) read_time
+        CALL ymds2ju (year+read_time,month,day,sec,date_new)
+        dd = date_new-date
+        ss = INT(dd)*one_day+dd-INT(dd)
+        itau = itau+NINT(ss/dt)
+        tmp_str = tmp_str(y_pos+1:LEN_TRIM(tmp_str))
+      ELSE IF (m_pos > 0) THEN
+        WRITE(fmt,'("(I",I10.10,")")') m_pos-1
+        READ(tmp_str(1:m_pos-1),fmt) read_time
+        CALL ymds2ju (year,month+read_time,day,sec,date_new)
+        dd = date_new-date
+        ss = INT(dd)*one_day+dd-INT(dd)
+        itau = itau+NINT(ss/dt)
+        tmp_str = tmp_str(m_pos+1:LEN_TRIM(tmp_str))
+      ELSE IF (d_pos > 0) THEN
+        WRITE(fmt,'("(I",I10.10,")")') d_pos-1
+        READ(tmp_str(1:d_pos-1),fmt) read_time
+        itau = itau+NINT(read_time*one_day/dt)
+        tmp_str = tmp_str(d_pos+1:LEN_TRIM(tmp_str))
+      ELSE IF (h_pos > 0) THEN
+        WRITE(fmt,'("(I",I10.10,")")') h_pos-1
+        READ(tmp_str(1:h_pos-1),fmt) read_time
+        itau = itau+NINT(read_time*60.*60./dt)
+        tmp_str = tmp_str(d_pos+1:LEN_TRIM(tmp_str))
+      ELSE IF  (s_pos > 0) THEN
+        WRITE(fmt,'("(I",I10.10,")")') s_pos-1
+        READ(tmp_str(1:s_pos-1),fmt) read_time
+        itau = itau+NINT(read_time/dt)
+        tmp_str = tmp_str(s_pos+1:LEN_TRIM(tmp_str))
+      ENDIF
+!-
+      y_pos = MAX(INDEX(tmp_str,'y'),INDEX(tmp_str,'Y'))
+      m_pos = MAX(INDEX(tmp_str,'m'),INDEX(tmp_str,'M'))
+      d_pos = MAX(INDEX(tmp_str,'d'),INDEX(tmp_str,'D'))
+      h_pos = MAX(INDEX(tmp_str,'h'),INDEX(tmp_str,'H'))
+      s_pos = MAX(INDEX(tmp_str,'s'),INDEX(tmp_str,'S'))
+    ENDDO
+  ELSE
+    WRITE(fmt,'("(I",I10.10,")")') LEN_TRIM(input_str)
+    READ(input_str(1:LEN_TRIM(input_str)),fmt) itau
+  ENDIF
+!-----------------------
+END SUBROUTINE tlen2itau
+!-
+!===
+!-
+REAL FUNCTION itau2date (itau,date0,deltat)
+!---------------------------------------------------------------------
+!- This function transforms itau into a date. The date with which
+!- the time axis is going to be labeled
+!-
+!- INPUT
+!-   itau   : current time step
+!-   date0  : Date at which itau was equal to 0
+!-   deltat : time step between itau s
+!-
+!- OUTPUT
+!-   itau2date : Date for the given itau
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER  :: itau
+  REAL     :: date0,deltat
+!---------------------------------------------------------------------
+  itau2date = REAL(itau)*deltat/one_day+date0
+!---------------------
+END FUNCTION itau2date
+!-
+!===
+!-
+SUBROUTINE itau2ymds (itau,deltat,year,month,day,sec)
+!---------------------------------------------------------------------
+!- This subroutine transforms itau into a date. The date with which
+!- the time axis is going to be labeled
+!-
+!- INPUT
+!-   itau   : current time step
+!-   deltat : time step between itau s
+!-
+!- OUTPUT
+!-   year  : year
+!-   month : month
+!-   day   : day
+!-   sec   : seconds since midnight
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: itau
+  REAL,INTENT(IN)    :: deltat
+!-
+  INTEGER,INTENT(OUT) :: year,month,day
+  REAL,INTENT(OUT)    :: sec
+!-
+  INTEGER :: julian_day
+  REAL    :: julian_sec
+!---------------------------------------------------------------------
+  IF (.NOT.lock_startdate) THEN
+    CALL ipslerr (2,'itau2ymds', &
+ &   'You try to call this function, itau2ymds, but you didn''t', &
+ &   ' call ioconf_startdate to initialize date0 in calendar.', &
+ &   ' Please call ioconf_startdate before itau2ymds.')
+  ENDIF
+  julian_day = start_day
+  julian_sec = start_sec+REAL(itau)*deltat
+  CALL ju2ymds_internal (julian_day,julian_sec,year,month,day,sec)
+!-----------------------
+END SUBROUTINE itau2ymds
+!-
+!===
+!-
+REAL FUNCTION dtchdate (itau,date0,old_dt,new_dt)
+!---------------------------------------------------------------------
+!- This function changes the date so that the simulation can
+!- continue with the same itau but a different dt.
+!-
+!- INPUT
+!-   itau   : current time step
+!-   date0  : Date at which itau was equal to 0
+!-   old_dt : Old time step between itaus
+!-   new_dt : New time step between itaus
+!-
+!- OUTPUT
+!-   dtchdate : Date for the given itau
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: itau
+  REAL,INTENT(IN)    :: date0,old_dt,new_dt
+!-
+  REAL :: rtime
+!---------------------------------------------------------------------
+  rtime = itau2date (itau,date0,old_dt)
+  dtchdate = rtime-REAL(itau)*new_dt/one_day
+!--------------------
+END FUNCTION dtchdate
+!-
+!===
+!-
+SUBROUTINE isittime &
+ &  (itau,date0,dt,freq,last_action,last_check,do_action)
+!---------------------------------------------------------------------
+!- This subroutine checks the time as come for a given action.
+!- This is computed from the current time-step(itau).
+!- Thus we need to have the time delta (dt), the frequency
+!- of the action (freq) and the last time it was done
+!- (last_action in units of itau).
+!- In order to extrapolate when will be the next check we need
+!- the time step of the last call (last_check).
+!-
+!- The test is done on the following condition :
+!- the distance from the current time to the time for the next
+!- action is smaller than the one from the next expected
+!- check to the next action.
+!- When the test is done on the time steps simplifications make
+!- it more difficult to read in the code.
+!- For the real time case it is easier to understand !
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: itau
+  REAL,INTENT(IN)    :: dt,freq
+  INTEGER,INTENT(IN) :: last_action,last_check
+  REAL,INTENT(IN)    :: date0
+!-
+  LOGICAL,INTENT(OUT)  :: do_action
+!-
+  REAL :: dt_action,dt_check
+  REAL :: date_last_act,date_next_check,date_next_act, &
+ &        date_now,date_mp1,date_mpf
+  INTEGER :: year,month,monthp1,day,next_check_itau,next_act_itau
+  INTEGER :: yearp,dayp
+  REAL :: sec,secp
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (check) THEN
+    WRITE(*,*) &
+ &    "isittime 1.0 ",itau,date0,dt,freq,last_action,last_check
+  ENDIF
+!-
+  IF (last_check >= 0) THEN
+    dt_action = (itau-last_action)*dt
+    dt_check = (itau-last_check)*dt
+    next_check_itau = itau+(itau-last_check)
+!-
+!-- We are dealing with frequencies in seconds and thus operation
+!-- can be done on the time steps.
+!-
+    IF (freq > 0) THEN
+      IF (ABS(dt_action-freq) <= ABS(dt_action+dt_check-freq)) THEN
+        do_action = .TRUE.
+      ELSE
+        do_action = .FALSE.
+      ENDIF
+!-
+!---- Here we deal with frequencies in month and work on julian days.
+!-
+    ELSE
+      date_now = itau2date (itau,date0,dt)
+      date_last_act = itau2date (last_action,date0,dt)
+      CALL ju2ymds (date_last_act,year,month,day,sec)
+      monthp1 = month-freq
+      yearp = year
+!-
+!---- Here we compute what logically should be the next month
+!-
+      DO WHILE (monthp1 >= 13)
+        yearp = yearp+1
+        monthp1 = monthp1-12
+      END DO
+      CALL ymds2ju (yearp,monthp1,day,sec,date_mpf)
+!-
+!---- But it could be that because of a shorter month or a bad
+!---- starting date that we end up further than we should be.
+!---- Thus we compute the first day of the next month.
+!---- We can not be beyond this date and if we are close
+!---- then we will take it as it is better.
+!-
+      monthp1 = month+ABS(freq)
+      yearp=year
+      DO WHILE (monthp1 >= 13)
+        yearp = yearp+1
+        monthp1 = monthp1-12
+      END DO
+      dayp = 1
+      secp = 0.0
+      CALL ymds2ju (yearp,monthp1,dayp,secp,date_mp1)
+!-
+!---- If date_mp1 is smaller than date_mpf or only less than 4 days
+!---- larger then we take it. This needed to ensure that short month
+!---- like February do not mess up the thing !
+!-
+      IF (date_mp1-date_mpf < 4.) THEN
+        date_next_act = date_mp1
+      ELSE
+        date_next_act = date_mpf
+      ENDIF
+      date_next_check = itau2date (next_check_itau,date0,dt)
+!-
+!---- Transform the dates into time-steps for the needed precisions.
+!-
+      next_act_itau = &
+ &      last_action+INT((date_next_act-date_last_act)*(one_day/dt))
+!-----
+      IF (   ABS(itau-next_act_itau) &
+ &        <= ABS( next_check_itau-next_act_itau)) THEN
+        do_action = .TRUE.
+        IF (check) THEN
+          WRITE(*,*) &
+ &         'ACT-TIME : itau, next_act_itau, next_check_itau : ', &
+ &         itau,next_act_itau,next_check_itau
+          CALL ju2ymds (date_now,year,month,day,sec)
+          WRITE(*,*) 'ACT-TIME : y, m, d, s : ',year,month,day,sec
+          WRITE(*,*) &
+ &         'ACT-TIME : date_mp1, date_mpf : ',date_mp1,date_mpf
+        ENDIF
+      ELSE
+        do_action = .FALSE.
+      ENDIF
+    ENDIF
+!-
+    IF (check) THEN
+      WRITE(*,*) "isittime 2.0 ", &
+ &     date_next_check,date_next_act,ABS(dt_action-freq), &
+ &     ABS(dt_action+dt_check-freq),dt_action,dt_check, &
+ &     next_check_itau,do_action
+    ENDIF
+  ELSE
+    do_action=.FALSE.
+  ENDIF
+!----------------------
+END SUBROUTINE isittime
+!-
+!===
+!-
+SUBROUTINE ioconf_calendar (str)
+!---------------------------------------------------------------------
+!- This routine allows to configure the calendar to be used.
+!- This operation is only allowed once and the first call to
+!- ymds2ju or ju2ymsd will lock the current configuration.
+!- the argument to ioconf_calendar can be any of the following :
+!-  - gregorian : This is the gregorian calendar (default here)
+!-  - noleap    : A calendar without leap years = 365 days
+!-  - xxxd      : A calendar of xxx days (has to be a modulo of 12)
+!-                with 12 month of equal length
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(IN) :: str
+!-
+  INTEGER :: leng,ipos
+  CHARACTER(LEN=20) :: str_w
+!---------------------------------------------------------------------
+!-
+! Clean up the string !
+!-
+  str_w = str
+  CALL strlowercase (str_w)
+!-
+  IF (.NOT.lock_one_year) THEN
+!---
+    lock_one_year=.TRUE.
+!---
+    SELECT CASE(TRIM(str_w))
+    CASE('gregorian','standard','proleptic_gregorian')
+      calendar_used = 'gregorian'
+      one_year = 365.2425
+      mon_len(:)=(/31,28,31,30,31,30,31,31,30,31,30,31/)
+    CASE('noleap','365_day','365d')
+      calendar_used = 'noleap'
+      one_year = 365.0
+      mon_len(:)=(/31,28,31,30,31,30,31,31,30,31,30,31/)
+    CASE('all_leap','366_day','366d')
+      calendar_used = 'all_leap'
+      one_year = 366.0
+      mon_len(:)=(/31,29,31,30,31,30,31,31,30,31,30,31/)
+    CASE('360_day','360d')
+      calendar_used = '360d'
+      one_year = 360.0
+      mon_len(:)=(/30,30,30,30,30,30,30,30,30,30,30,30/)
+    CASE('julian')
+      calendar_used = 'julian'
+      one_year = 365.25
+      mon_len(:)=(/31,28,31,30,31,30,31,31,30,31,30,31/)
+    CASE DEFAULT
+      ipos = INDEX(str_w,'d')
+      IF (ipos == 4) THEN
+        READ(str_w(1:3),'(I3)') leng
+        IF ( (MOD(leng,12) == 0).AND.(leng > 1) ) THEN
+          calendar_used = str_w
+          one_year = leng
+          mon_len(:) = leng/12
+        ELSE
+          CALL ipslerr (3,'ioconf_calendar', &
+ &         'The length of the year as to be a modulo of 12', &
+ &         'so that it can be divided into 12 month of equal length', &
+ &         TRIM(str_w))
+        ENDIF
+      ELSE
+        CALL ipslerr (3,'ioconf_calendar', &
+ &       'Unrecognized input, please check the man pages.', &
+ &       TRIM(str_w),' ')
+      ENDIF
+    END SELECT
+  ELSE IF (TRIM(str_w) /= TRIM(calendar_used)) THEN
+    WRITE(str_w,'(f10.4)') one_year
+    CALL ipslerr (2,'ioconf_calendar', &
+ &   'The calendar was already used or configured to : '// &
+ &    TRIM(calendar_used)//'.', &
+ &   'You are not allowed to change it to : '//TRIM(str)//'.', &
+ &   'The following length of year is used : '//TRIM(ADJUSTL(str_w)))
+  ENDIF
+!-----------------------------
+END SUBROUTINE ioconf_calendar
+!-
+!===
+!-
+SUBROUTINE ioconf_startdate_simple (julian)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  REAL,INTENT(IN) :: julian
+!-
+  INTEGER :: julian_day
+  REAL    :: julian_sec
+!---------------------------------------------------------------------
+  julian_day = INT(julian)
+  julian_sec = (julian-julian_day)*one_day
+!-
+  CALL ioconf_startdate_internal (julian_day,julian_sec)
+!-------------------------------------
+END SUBROUTINE ioconf_startdate_simple
+!-
+!===
+!-
+SUBROUTINE ioconf_startdate_ymds (year,month,day,sec)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: year,month,day
+  REAL,INTENT(IN)    :: sec
+!-
+  INTEGER :: julian_day
+  REAL    :: julian_sec
+!---------------------------------------------------------------------
+  CALL ymds2ju_internal (year,month,day,sec,julian_day,julian_sec)
+!-
+  CALL ioconf_startdate_internal (julian_day,julian_sec)
+!-----------------------------------
+END SUBROUTINE ioconf_startdate_ymds
+!-
+!===
+!-
+SUBROUTINE ioconf_startdate_internal (julian_day,julian_sec)
+!---------------------------------------------------------------------
+! This subroutine allows to set the startdate for later
+! use. It allows the applications to access the date directly from
+! the timestep. In order to avoid any problems the start date will
+! be locked and can not be changed once set.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN)  :: julian_day
+  REAL,INTENT(IN)     :: julian_sec
+!-
+  CHARACTER(len=70) :: str70a,str70b
+!---------------------------------------------------------------------
+  IF (.NOT.lock_startdate) THEN
+    start_day = julian_day
+    start_sec = julian_sec
+    lock_startdate = .TRUE.
+  ELSE
+    WRITE(str70a,'("The date you tried to set : ",f10.4)') &
+ &   julian_day,julian_sec/one_day
+    WRITE(str70b, &
+ &   '("The date which was already set in the calendar : ",f10.4)') &
+ &   start_day+start_sec/one_day
+    CALL ipslerr (2,'ioconf_startdate', &
+ &   'The start date has already been set and you tried to change it', &
+ &   str70a,str70b)
+  ENDIF
+!---------------------------------------
+END SUBROUTINE ioconf_startdate_internal
+!-
+!===
+!-
+SUBROUTINE ioget_calendar_str (str)
+!---------------------------------------------------------------------
+!- This subroutine returns the name of the calendar used here.
+!- Three options exist :
+!-  - gregorian : This is the gregorian calendar (default here)
+!-  - noleap    : A calendar without leap years = 365 days
+!-  - xxxd      : A calendar of xxx days (has to be a modulo of 12)
+!-                with 12 month of equal length
+!-
+!- This routine will lock the calendar.
+!- You do not want it to change after your inquiry.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(OUT) :: str
+!---------------------------------------------------------------------
+  lock_one_year = .TRUE.
+!-
+  str = calendar_used
+!--------------------------------
+END SUBROUTINE ioget_calendar_str
+!-
+!===
+!-
+SUBROUTINE ioget_calendar_real1 (long_year)
+!---------------------------------------------------------------------
+!- This subroutine returns the name of the calendar used here.
+!- Three options exist :
+!-  - gregorian : This is the gregorian calendar (default here)
+!-  - noleap    : A calendar without leap years = 365 days
+!-  - xxxd      : A calendar of xxx days (has to be a modulo of 12)
+!-                with 12 month of equal length
+!-
+!- This routine will lock the calendar.
+!- You do not want it to change after your inquiry.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  REAL,INTENT(OUT) :: long_year
+!---------------------------------------------------------------------
+  long_year = one_year
+  lock_one_year = .TRUE.
+!----------------------------------
+END SUBROUTINE ioget_calendar_real1
+!-
+!===
+!-
+SUBROUTINE ioget_calendar_real2 (long_year,long_day)
+!---------------------------------------------------------------------
+!- This subroutine returns the name of the calendar used here.
+!- Three options exist :
+!-  - gregorian : This is the gregorian calendar (default here)
+!-  - noleap    : A calendar without leap years = 365 days
+!-  - xxxd      : A calendar of xxx days (has to be a modulo of 12)
+!-                with 12 month of equal length
+!-
+!- This routine will lock the calendar.
+!- You do not want it to change after your inquiry.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  REAL,INTENT(OUT) :: long_year,long_day
+!---------------------------------------------------------------------
+  long_year = one_year
+  long_day  = one_day
+  lock_one_year = .TRUE.
+!----------------------------------
+END SUBROUTINE ioget_calendar_real2
+!-
+!===
+!-
+INTEGER FUNCTION ioget_mon_len (year,month)
+!!--------------------------------------------------------------------
+!! The "ioget_mon_len" function returns
+!! the number of days in a "month" of a "year",
+!! in the current calendar.
+!!
+!! INTEGER FUNCTION ioget_mon_len (year,month)
+!!
+!! INPUT
+!!
+!! (I) year  : year
+!! (I) month : month in the year (1 --> 12)
+!!
+!! OUTPUT
+!!
+!! (I) ioget_mon_len : number of days in the month
+!!--------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: year,month
+!-
+  INTEGER :: ml
+!---------------------------------------------------------------------
+  IF ( (month >= 1).AND.(month <= 12) ) THEN
+    IF ( (one_year > 365.0).AND.(one_year < 366.0) ) THEN
+!---- "Gregorian" or "Julian"
+      ml = mon_len(month)
+      IF (month == 2) THEN
+        IF (ABS(one_year-365.2425) <= EPSILON(one_year) ) THEN
+!-------- "Gregorian"
+          IF (    ((MOD(year,4) == 0).AND.(MOD(year,100) /= 0)) &
+              .OR.(MOD(year,400) == 0) ) THEN
+            ml = ml+1
+          ENDIF
+        ELSE
+!-------- "Julian"
+          IF (MOD(year,4) == 0) THEN
+            ml = ml+1
+          ENDIF
+        ENDIF
+      ENDIF
+      ioget_mon_len = ml
+    ELSE
+!---- "No leap" or "All leap" or "Calendar with regular month"
+      ioget_mon_len = mon_len(month)
+    ENDIF
+  ELSE
+    CALL ipslerr (3,'ioget_mon_len', &
+ &    'The number of the month','must be between','1 and 12')
+  ENDIF
+!-------------------------
+END FUNCTION ioget_mon_len
+!-
+!===
+!-
+INTEGER FUNCTION ioget_year_len (year)
+!!--------------------------------------------------------------------
+!! The "ioget_year_len" function returns
+!! the number of days in "year", in the current calendar.
+!!
+!! INTEGER FUNCTION ioget_year_len (year)
+!!
+!! INPUT
+!!
+!! (I) year  : year
+!!
+!! OUTPUT
+!!
+!! (I) ioget_year_len : number of days in the year
+!!--------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: year
+!-
+  INTEGER :: yl
+!---------------------------------------------------------------------
+  SELECT CASE(TRIM(calendar_used))
+  CASE('gregorian')
+    yl = 365
+    IF (    ((MOD(year,4) == 0).AND.(MOD(year,100) /= 0)) &
+        .OR.(MOD(year,400) == 0) ) THEN
+      yl = yl+1
+    ENDIF
+  CASE('julian')
+    yl = 365
+    IF (MOD(year,4) == 0) THEN
+      yl = yl+1
+    ENDIF
+  CASE DEFAULT
+    yl = NINT(one_year)
+  END SELECT
+  ioget_year_len = yl
+!--------------------------
+END FUNCTION ioget_year_len
+!-
+!===
+!-
+SUBROUTINE ioget_timestamp (string)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=30),INTENT(OUT) :: string
+!-
+  INTEGER :: date_time(8)
+  CHARACTER(LEN=10) :: bigben(3)
+!---------------------------------------------------------------------
+  IF (INDEX(time_stamp,'XXXXXX') > 0) THEN
+    CALL DATE_AND_TIME (bigben(1),bigben(2),bigben(3),date_time)
+!---
+    WRITE(time_stamp, &
+ &   "(I4.4,'-',A3,'-',I2.2,' ',I2.2,':',I2.2,':',I2.2,' GMT',a5)") &
+ &   date_time(1),cal(date_time(2)),date_time(3),date_time(5), &
+ &   date_time(6),date_time(7),bigben(3)
+  ENDIF
+!-
+  string = time_stamp
+!-----------------------------
+END SUBROUTINE ioget_timestamp
+!-
+!===
+!-
+SUBROUTINE time_add &
+ &  (year_s,month_s,day_s,sec_s,sec_increment, &
+ &   year_e,month_e,day_e,sec_e)
+!---------------------------------------------------------------------
+!- This subroutine allows to increment a date by a number of seconds.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: year_s,month_s,day_s
+  REAL,INTENT(IN)    :: sec_s
+!-
+! Time in seconds to be added to the date
+!-
+  REAL,INTENT(IN)    :: sec_increment
+!-
+  INTEGER,INTENT(OUT) :: year_e,month_e,day_e
+  REAL,INTENT(OUT)    :: sec_e
+!-
+  INTEGER :: julian_day
+  REAL    :: julian_sec
+!---------------------------------------------------------------------
+  CALL ymds2ju_internal &
+ &  (year_s,month_s,day_s,sec_s,julian_day,julian_sec)
+!-
+  julian_sec = julian_sec+sec_increment
+!-
+  CALL ju2ymds_internal &
+ &  (julian_day,julian_sec,year_e,month_e,day_e,sec_e)
+!----------------------
+END SUBROUTINE time_add
+!-
+!===
+!-
+SUBROUTINE time_diff &
+ &  (year_s,month_s,day_s,sec_s,year_e,month_e,day_e,sec_e,sec_diff)
+!---------------------------------------------------------------------
+!- This subroutine allows to determine the number of seconds
+!- between two dates.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: year_s,month_s,day_s
+  REAL,INTENT(IN)    :: sec_s
+  INTEGER,INTENT(IN) :: year_e,month_e,day_e
+  REAL,INTENT(IN)    :: sec_e
+!-
+! Time in seconds between the two dates
+!-
+  REAL,INTENT(OUT)    :: sec_diff
+!-
+  INTEGER :: julian_day_s,julian_day_e,day_diff
+  REAL    :: julian_sec_s,julian_sec_e
+!---------------------------------------------------------------------
+  CALL ymds2ju_internal &
+ &  (year_s,month_s,day_s,sec_s,julian_day_s,julian_sec_s)
+  CALL ymds2ju_internal &
+ &  (year_e,month_e,day_e,sec_e,julian_day_e,julian_sec_e)
+!-
+  day_diff = julian_day_e-julian_day_s
+  sec_diff = julian_sec_e-julian_sec_s
+!-
+  sec_diff = sec_diff+day_diff*one_day
+!-----------------------
+END SUBROUTINE time_diff
+!-
+!===
+!-
+END MODULE calendar
Index: trunk/NEMOGCM/EXTERNAL/IOIPSL/src/defprec.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/IOIPSL/src/defprec.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/IOIPSL/src/defprec.f90	(revision 2528)
@@ -0,0 +1,22 @@
+MODULE defprec 
+!-
+! $Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!!--------------------------------------------------------------------
+!! The module "defprec" set default precision for computation
+!!
+!! This module should be used by every modules
+!! to keep the right precision for every variable
+!!--------------------------------------------------------------------
+!?INTEGERS of KIND 1 are not supported on all computers
+!?INTEGER,PARAMETER :: i_1=SELECTED_INT_KIND(2)
+  INTEGER,PARAMETER :: i_2=SELECTED_INT_KIND(4)
+  INTEGER,PARAMETER :: i_4=SELECTED_INT_KIND(9)
+  INTEGER,PARAMETER :: i_8=SELECTED_INT_KIND(13)
+  INTEGER,PARAMETER :: r_4=SELECTED_REAL_KIND(6,37)
+  INTEGER,PARAMETER :: r_8=SELECTED_REAL_KIND(15,307)
+  INTEGER,PARAMETER :: i_std=i_4, r_std=r_8
+!-----------------
+END MODULE defprec
Index: trunk/NEMOGCM/EXTERNAL/IOIPSL/src/errioipsl.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/IOIPSL/src/errioipsl.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/IOIPSL/src/errioipsl.f90	(revision 2528)
@@ -0,0 +1,215 @@
+MODULE errioipsl
+!-
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+IMPLICIT NONE
+!-
+PRIVATE
+!-
+PUBLIC :: ipslnlf, ipslerr, ipslerr_act, ipslerr_inq, histerr, ipsldbg
+!-
+  INTEGER :: n_l=6, ilv_cur=0, ilv_max=0
+  LOGICAL :: ioipsl_debug=.FALSE., lact_mode=.TRUE.
+!-
+!===
+CONTAINS
+!===
+SUBROUTINE ipslnlf (new_number,old_number)
+!!--------------------------------------------------------------------
+!! The "ipslnlf" routine allows to know and modify
+!! the current logical number for the messages.
+!!
+!! SUBROUTINE ipslnlf (new_number,old_number)
+!!
+!! Optional INPUT argument
+!!
+!! (I) new_number : new logical number of the file
+!!
+!! Optional OUTPUT argument
+!!
+!! (I) old_number : current logical number of the file
+!!--------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,OPTIONAL,INTENT(IN)  :: new_number
+  INTEGER,OPTIONAL,INTENT(OUT) :: old_number
+!---------------------------------------------------------------------
+  IF (PRESENT(old_number)) THEN
+    old_number = n_l
+  ENDIF
+  IF (PRESENT(new_number)) THEN
+    n_l = new_number
+  ENDIF
+!---------------------
+END SUBROUTINE ipslnlf
+!===
+SUBROUTINE ipslerr (plev,pcname,pstr1,pstr2,pstr3)
+!---------------------------------------------------------------------
+!! The "ipslerr" routine
+!! allows to handle the messages to the user.
+!!
+!! INPUT
+!!
+!! plev   : Category of message to be reported to the user
+!!          1 = Note to the user
+!!          2 = Warning to the user
+!!          3 = Fatal error
+!! pcname : Name of subroutine which has called ipslerr
+!! pstr1   
+!! pstr2  : Strings containing the explanations to the user
+!! pstr3
+!---------------------------------------------------------------------
+   IMPLICIT NONE
+!-
+   INTEGER :: plev
+   CHARACTER(LEN=*) :: pcname,pstr1,pstr2,pstr3
+!-
+   CHARACTER(LEN=30),DIMENSION(3) :: pemsg = &
+  &  (/ "NOTE TO THE USER FROM ROUTINE ", &
+  &     "WARNING FROM ROUTINE          ", &
+  &     "FATAL ERROR FROM ROUTINE      " /)
+!---------------------------------------------------------------------
+   IF ( (plev >= 1).AND.(plev <= 3) ) THEN
+     ilv_cur = plev
+     ilv_max = MAX(ilv_max,plev)
+     WRITE(n_l,'(/,A," ",A)') TRIM(pemsg(plev)),TRIM(pcname)
+     WRITE(n_l,'(3(" --> ",A,/))') TRIM(pstr1),TRIM(pstr2),TRIM(pstr3)
+   ENDIF
+   IF ( (plev == 3).AND.lact_mode) THEN
+     WRITE(n_l,'("Fatal error from IOIPSL. STOP in ipslerr with code")')
+     STOP 1
+   ENDIF
+!---------------------
+END SUBROUTINE ipslerr
+!===
+SUBROUTINE ipslerr_act (new_mode,old_mode)
+!!--------------------------------------------------------------------
+!! The "ipslerr_act" routine allows to know and modify
+!! the current "action mode" for the error messages,
+!! and reinitialize the error level values.
+!!
+!! SUBROUTINE ipslerr_act (new_mode,old_mode)
+!!
+!! Optional INPUT argument
+!!
+!! (I) new_mode : new error action mode
+!!                .TRUE.  -> STOP     in case of fatal error
+!!                .FALSE. -> CONTINUE in case of fatal error
+!!
+!! Optional OUTPUT argument
+!!
+!! (I) old_mode : current error action mode
+!!--------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  LOGICAL,OPTIONAL,INTENT(IN)  :: new_mode
+  LOGICAL,OPTIONAL,INTENT(OUT) :: old_mode
+!---------------------------------------------------------------------
+  IF (PRESENT(old_mode)) THEN
+    old_mode = lact_mode
+  ENDIF
+  IF (PRESENT(new_mode)) THEN
+    lact_mode = new_mode
+  ENDIF
+  ilv_cur = 0
+  ilv_max = 0
+!-------------------------
+END SUBROUTINE ipslerr_act
+!===
+SUBROUTINE ipslerr_inq (current_level,maximum_level)
+!!--------------------------------------------------------------------
+!! The "ipslerr_inq" routine allows to know
+!! the current level of the error messages
+!! and the maximum level encountered since the
+!! last call to "ipslerr_act".
+!!
+!! SUBROUTINE ipslerr_inq (current_level,maximum_level)
+!!
+!! Optional OUTPUT argument
+!!
+!! (I) current_level : current error level
+!! (I) maximum_level : maximum error level
+!!--------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,OPTIONAL,INTENT(OUT) :: current_level,maximum_level
+!---------------------------------------------------------------------
+  IF (PRESENT(current_level)) THEN
+    current_level = ilv_cur
+  ENDIF
+  IF (PRESENT(maximum_level)) THEN
+    maximum_level = ilv_max
+  ENDIF
+!-------------------------
+END SUBROUTINE ipslerr_inq
+!===
+SUBROUTINE histerr (plev,pcname,pstr1,pstr2,pstr3)
+!---------------------------------------------------------------------
+!- INPUT
+!- plev   : Category of message to be reported to the user
+!-          1 = Note to the user
+!-          2 = Warning to the user
+!-          3 = Fatal error
+!- pcname : Name of subroutine which has called histerr
+!- pstr1   
+!- pstr2  : String containing the explanations to the user
+!- pstr3
+!---------------------------------------------------------------------
+   IMPLICIT NONE
+!-
+   INTEGER :: plev
+   CHARACTER(LEN=*) :: pcname,pstr1,pstr2,pstr3
+!-
+   CHARACTER(LEN=30),DIMENSION(3) :: pemsg = &
+  &  (/ "NOTE TO THE USER FROM ROUTINE ", &
+  &     "WARNING FROM ROUTINE          ", &
+  &     "FATAL ERROR FROM ROUTINE      " /)
+!---------------------------------------------------------------------
+   IF ( (plev >= 1).AND.(plev <= 3) ) THEN
+     WRITE(*,'("     ")')
+     WRITE(*,'(A," ",A)') TRIM(pemsg(plev)),TRIM(pcname)
+     WRITE(*,'(" --> ",A)') pstr1
+     WRITE(*,'(" --> ",A)') pstr2
+     WRITE(*,'(" --> ",A)') pstr3
+   ENDIF
+   IF (plev == 3) THEN
+     STOP 'Fatal error from IOIPSL. See stdout for more details'
+   ENDIF
+!---------------------
+END SUBROUTINE histerr
+!===
+SUBROUTINE ipsldbg (new_status,old_status)
+!!--------------------------------------------------------------------
+!! The "ipsldbg" routine
+!! allows to activate or deactivate the debug,
+!! and to know the current status of the debug.
+!!
+!! SUBROUTINE ipsldbg (new_status,old_status)
+!!
+!! Optional INPUT argument
+!!
+!! (L) new_status : new status of the debug
+!!
+!! Optional OUTPUT argument
+!!
+!! (L) old_status : current status of the debug
+!!--------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  LOGICAL,OPTIONAL,INTENT(IN)  :: new_status
+  LOGICAL,OPTIONAL,INTENT(OUT) :: old_status
+!---------------------------------------------------------------------
+  IF (PRESENT(old_status)) THEN
+    old_status = ioipsl_debug
+  ENDIF
+  IF (PRESENT(new_status)) THEN
+    ioipsl_debug = new_status
+  ENDIF
+!---------------------
+END SUBROUTINE ipsldbg
+!===
+!-------------------
+END MODULE errioipsl
Index: trunk/NEMOGCM/EXTERNAL/IOIPSL/src/flincom.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/IOIPSL/src/flincom.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/IOIPSL/src/flincom.f90	(revision 2528)
@@ -0,0 +1,1939 @@
+MODULE flincom
+!-
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+  USE netcdf
+!-
+  USE calendar,  ONLY : ju2ymds, ymds2ju, ioconf_calendar
+  USE errioipsl, ONLY : histerr
+  USE stringop,  ONLY : strlowercase
+!-
+  IMPLICIT NONE
+!-
+  PRIVATE
+  PUBLIC :: flinput, flincre, flinget, flinclo, &
+            flinopen, flininfo, flininspect, flinquery_var
+!-
+  INTERFACE flinopen
+!---------------------------------------------------------------------
+!- The "flinopen" routines will open an input file
+!-
+!- INPUT
+!-
+!- filename  : Name of the netCDF file to be opened
+!-
+!- iideb     : index i for zoom     !
+!- iilen     : length  of  zoom     !   for
+!- jjdeb     : index j for zoom     !   zoom
+!- jjlen     : length  of  zoom     !
+!-
+!- do_test   : A flag that enables the testing of the content
+!-             of the file against the input from the model
+!-
+!- INPUT if do_test=TRUE      OUTPUT else
+!-
+!- iim       : size in the x direction in the file (longitude)
+!- jjm       : size in the y direction
+!- llm       : number of levels
+!-             (llm = 0 means no axis to be expected)
+!- lon       : array of (iilen,jjlen) (zoom), or (iim,jjm) (no zoom),
+!-             that contains the longitude of each point
+!- lat       : same for latitude
+!- lev       : An array of llm for the latitude
+!-
+!- WARNING :
+!- In the case of do_test=FALSE it is for the user to check
+!- that the dimensions of lon lat and lev are correct when passed to
+!- flinopen. This can be done after the call when iim and jjm have
+!- been retrieved from the netCDF file. In F90 this problem will
+!- be solved with an internal assign
+!- IF iim, jjm, llm or ttm are parameters in the calling program and
+!- you use the option do_test=FALSE it will create a segmentation fault
+!-
+!-  OUTPUT
+!-
+!-  ttm       : size of time axis
+!-  itaus     : Time steps within this file
+!-  date0     : Julian date at which itau = 0
+!-  dt        : length of the time steps of the data
+!-  fid       : returned file ID which is later used to read the data
+!---------------------------------------------------------------------
+    MODULE PROCEDURE flinopen_zoom2d, flinopen_nozoom
+  END INTERFACE
+!-
+  INTERFACE flinput
+!---------------------------------------------------------------------
+!- The "flinput" routines will put a variable
+!- on the netCDF file created by flincre.
+!- If the sizes of the axis do not match the one of the IDs
+!- then a new axis is created.
+!- That is we loose the possibility of writting hyperslabs of data.
+!-
+!- Again here if iim = jjm = llm = ttm = 0
+!- then a global attribute is added to the file.
+!-
+!- INPUT
+!-
+!- fid      : Identification of the file in which we will write
+!- varname  : Name of variable to be written
+!- iim      : size in x of variable
+!- nlonid   : ID of x axis which could fit for this axis
+!- jjm      : size in y of variable
+!- nlatid   : ID of y axis which could fit for this axis
+!- llm      : size in z of variable
+!- zdimid   : ID of z axis which could fit for this axis
+!- ttm      : size in t of variable
+!- tdimid   : ID of t axis which could fit for this axis
+!-
+!- OUTPUT
+!-
+!- NONE
+!---------------------------------------------------------------------
+    MODULE PROCEDURE flinput_r4d, flinput_r3d, flinput_r2d, &
+                     flinput_r1d, flinput_scal
+  END INTERFACE
+!-
+  INTERFACE flinget
+    MODULE PROCEDURE flinget_r4d, flinget_r3d, flinget_r2d, &
+                     flinget_r1d, flinget_scal, &
+                     flinget_r4d_zoom2d, flinget_r3d_zoom2d, &
+                     flinget_r2d_zoom2d
+  END INTERFACE
+!-
+! This is the data we keep on each file we open
+!-
+  INTEGER, PARAMETER :: nbfile_max = 200
+  INTEGER, SAVE :: nbfiles = 0
+  INTEGER, SAVE :: ncids(nbfile_max), ncnbd(nbfile_max), &
+                   ncfunli(nbfile_max), ncnba(nbfile_max)
+  INTEGER, SAVE :: ncnbva(nbfile_max), ncdims(nbfile_max,4)
+  LOGICAL, SAVE :: ncfileopen(nbfile_max)=.FALSE.
+!-
+  INTEGER, SAVE :: cind_vid, cind_fid, cind_len
+  INTEGER,DIMENSION(:),ALLOCATABLE,SAVE :: cindex
+!-
+  INTEGER,DIMENSION(4) :: w_sta, w_len, w_dim
+!-
+CONTAINS
+!-
+!===
+!-
+SUBROUTINE flincre &
+  (filename, iim1, jjm1, lon1, lat1, llm1, lev1, ttm1, itaus, &
+   time0, dt, fid_out, nlonid1, nlatid1, zdimid1, tdimid1)
+!---------------------------------------------------------------------
+!- This is a "low level" subroutine for opening netCDF files wich
+!- contain the major coordinate system of the model.
+!- Other coordinates needed for other variables
+!- will be added as they are needed.
+!-
+!- INPUT
+!-
+!- filename    : Name of the file to be created
+!- iim1, jjm1  : Horizontal size of the grid
+!-               which will be stored in the file
+!- lon1, lat1  : Horizontal grids
+!- llm1        : Size of the vertical grid
+!- lev1        : Vertical grid
+!- ttm1        : Size of time axis
+!- itaus       : time steps on the time axis
+!- time0       : Time in julian days at which itau = 0
+!- dt          : time step in seconds between itaus
+!-               (one step of itau)
+!-
+!- OUTPUT
+!-
+!- fid         : File identification
+!- nlonid1     : Identification of longitudinal axis
+!- nlatid1     : Identification of latitudinal axis
+!- zdimid1     : ID of vertical axis
+!- tdimid1     : ID of time axis
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! ARGUMENTS
+!-
+  CHARACTER(LEN=*) :: filename
+  INTEGER :: iim1, jjm1, llm1, ttm1
+  REAL :: lon1(iim1,jjm1)
+  REAL :: lat1(iim1,jjm1)
+  REAL :: lev1(llm1)
+  INTEGER :: itaus(ttm1)
+  REAL :: time0
+  REAL :: dt
+  INTEGER :: fid_out, zdimid1, nlonid1, nlatid1, tdimid1
+!-
+! LOCAL
+!-
+  INTEGER :: iret, lll, fid
+  INTEGER :: lonid, latid, levid, timeid
+  INTEGER :: year, month, day
+  REAL :: sec
+  CHARACTER(LEN=250):: name
+!-
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  lll = LEN_TRIM(filename)
+  IF (filename(lll-2:lll) /= '.nc') THEN
+    name=filename(1:lll)//'.nc'
+  ELSE
+    name=filename(1:lll)
+  ENDIF
+!-
+  iret = NF90_CREATE (name, NF90_CLOBBER, fid)
+!-
+  iret = NF90_DEF_DIM (fid, 'x',     iim1, nlonid1)
+  iret = NF90_DEF_DIM (fid, 'y',     jjm1, nlatid1)
+  iret = NF90_DEF_DIM (fid, 'lev',   llm1, zdimid1)
+  iret = NF90_DEF_DIM (fid, 'tstep', ttm1, tdimid1)
+!-
+! Vertical axis
+!-
+  IF (check) WRITE(*,*) 'flincre Vertical axis'
+!-
+  iret = NF90_DEF_VAR (fid, 'lev', NF90_FLOAT, zdimid1, levid)
+  iret = NF90_PUT_ATT (fid, levid, 'units',     '-')
+  iret = NF90_PUT_ATT (fid, levid, 'title',     'levels')
+  iret = NF90_PUT_ATT (fid, levid, 'long_name', 'Sigma Levels')
+!-
+! Time axis
+!-
+  IF (check) WRITE(*,*) 'flincre time axis'
+!-
+  iret = NF90_DEF_VAR (fid, 'tstep', NF90_FLOAT, tdimid1, timeid)
+  iret = NF90_PUT_ATT (fid, timeid, 'units',     '-')
+  iret = NF90_PUT_ATT (fid, timeid, 'title',     'time')
+  iret = NF90_PUT_ATT (fid, timeid, 'long_name', 'time steps')
+!-
+! The longitude
+!-
+  IF (check) WRITE(*,*) 'flincre Longitude axis'
+!-
+  iret = NF90_DEF_VAR (fid, "nav_lon", NF90_FLOAT, &
+                       (/ nlonid1, nlatid1 /), lonid)
+  iret = NF90_PUT_ATT (fid, lonid, 'units', "degrees_east")
+  iret = NF90_PUT_ATT (fid, lonid, 'title', "Longitude")
+  iret = NF90_PUT_ATT (fid, lonid, 'nav_model', &
+                       "Lambert projection of PROMES")
+  iret = NF90_PUT_ATT (fid, lonid, 'valid_min', &
+                       REAL(MINVAL(lon1),KIND=4))
+  iret = NF90_PUT_ATT (fid, lonid, 'valid_max', &
+                       REAL(MAXVAL(lon1),KIND=4))
+!-
+! The Latitude
+!-
+  IF (check) WRITE(*,*) 'flincre Latitude axis'
+!-
+  iret = NF90_DEF_VAR (fid, "nav_lat", NF90_FLOAT, &
+                     (/ nlonid1, nlatid1 /), latid)
+  iret = NF90_PUT_ATT (fid, latid, 'units', "degrees_north")
+  iret = NF90_PUT_ATT (fid, latid, 'title', "Latitude")
+  iret = NF90_PUT_ATT (fid, latid, 'nav_model', &
+                       "Lambert projection of PROMES")
+  iret = NF90_PUT_ATT (fid, latid, 'valid_min', &
+                       REAL(MINVAL(lat1),KIND=4))
+  iret = NF90_PUT_ATT (fid, latid, 'valid_max', &
+                       REAL(MAXVAL(lat1),KIND=4))
+!-
+! The time coordinates
+!-
+  iret = NF90_PUT_ATT (fid, NF90_GLOBAL, 'delta_tstep_sec', &
+                       REAL(dt,KIND=4))
+!-
+  CALL ju2ymds (time0, year, month, day, sec)
+!-
+  iret = NF90_PUT_ATT (fid, NF90_GLOBAL, 'year0',  REAL(year,KIND=4))
+  iret = NF90_PUT_ATT (fid, NF90_GLOBAL, 'month0', REAL(month,KIND=4))
+  iret = NF90_PUT_ATT (fid, NF90_GLOBAL, 'day0',   REAL(day,KIND=4))
+  iret = NF90_PUT_ATT (fid, NF90_GLOBAL, 'sec0',   REAL(sec,KIND=4))
+!-
+  iret = NF90_ENDDEF (fid)
+!-
+  IF (check) WRITE(*,*) 'flincre Variable'
+!-
+  iret = NF90_PUT_VAR (fid, levid, lev1(1:llm1))
+!-
+  IF (check) WRITE(*,*) 'flincre Time Variable'
+!-
+  iret = NF90_PUT_VAR (fid, timeid, REAL(itaus(1:ttm1)))
+!-
+  IF (check) WRITE(*,*) 'flincre Longitude'
+!-
+  iret = NF90_PUT_VAR (fid, lonid, lon1(1:iim1,1:jjm1))
+!-
+  IF (check) WRITE(*,*) 'flincre Latitude'
+!-
+  iret = NF90_PUT_VAR (fid, latid, lat1(1:iim1,1:jjm1))
+!-
+! Keep all this information
+!-
+  nbfiles = nbfiles+1
+!-
+  IF (nbfiles > nbfile_max) THEN
+    CALL histerr (3,'flincre', &
+     'Too many files. Please increase nbfil_max', &
+     'in program flincom.F90.',' ')
+  ENDIF
+!-
+  ncids(nbfiles) = fid
+  ncnbd(nbfiles) = 4
+!-
+  ncdims(nbfiles,1:4) = (/ iim1, jjm1, llm1, ttm1 /)
+!-
+  ncfunli(nbfiles) = -1
+  ncnba(nbfiles)   =  4
+  ncnbva(nbfiles)  =  0
+  ncfileopen(nbfiles) = .TRUE.
+!-
+  fid_out = nbfiles
+!---------------------
+END SUBROUTINE flincre
+!-
+!===
+!-
+SUBROUTINE flinopen_zoom2d &
+  (filename, iideb, iilen, jjdeb, jjlen, do_test, &
+  iim, jjm, llm, lon, lat, lev, ttm, itaus, date0, dt, fid_out)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! ARGUMENTS
+!-
+  CHARACTER(LEN=*) :: filename
+  LOGICAL :: do_test
+  INTEGER :: iim, jjm, llm, ttm, iideb, iilen, jjdeb, jjlen
+  REAL :: lon(iilen,jjlen), lat(iilen,jjlen), lev(llm)
+  INTEGER :: itaus(ttm)
+  REAL :: date0, dt
+  INTEGER :: fid_out
+!-
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (check) WRITE (*,*) ' iideb, iilen, jjdeb, jjlen, iim, jjm ', &
+                           iideb, iilen, jjdeb, jjlen, iim, jjm
+  IF (check) WRITE (*,*) ' lon ', lon(1,1), lon(iilen,jjlen)
+  IF (check) WRITE (*,*) ' lat ', lat(1,1), lat(iilen,jjlen)
+!-
+  CALL flinopen_work &
+    (filename, iideb, iilen, jjdeb, jjlen, do_test, &
+     iim, jjm, llm, lon, lat, lev, ttm, itaus, date0, dt, fid_out)
+!-----------------------------
+END SUBROUTINE flinopen_zoom2d
+!-
+!===
+!-
+SUBROUTINE flinopen_nozoom &
+  (filename, do_test, iim, jjm, llm, lon, lat, lev, ttm, &
+   itaus, date0, dt, fid_out)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! ARGUMENTS
+!-
+  CHARACTER(LEN=*) :: filename
+  LOGICAL :: do_test
+  INTEGER :: iim, jjm, llm, ttm
+  REAL :: lon(iim,jjm), lat(iim,jjm), lev(llm)
+  INTEGER :: itaus(ttm)
+  REAL :: date0, dt
+  INTEGER :: fid_out
+!---------------------------------------------------------------------
+  CALL flinopen_work &
+    (filename, 1, iim, 1, jjm, do_test, &
+     iim, jjm, llm, lon, lat, lev, ttm, itaus, date0, dt, fid_out)
+!-------------------------
+END SUBROUTINE flinopen_nozoom
+!-
+!===
+!-
+SUBROUTINE flinopen_work &
+  (filename, iideb, iilen, jjdeb, jjlen, do_test, &
+   iim, jjm, llm, lon, lat, lev, ttm, itaus, date0, dt, fid_out)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! ARGUMENTS
+!-
+  CHARACTER(LEN=*) :: filename
+  LOGICAL :: do_test
+  INTEGER :: iim, jjm, llm, ttm, iideb, iilen, jjdeb, jjlen
+  REAL :: lon(iilen,jjlen), lat(iilen,jjlen), lev(llm)
+  INTEGER :: itaus(ttm)
+  REAL :: date0, dt
+  INTEGER :: fid_out
+!-
+! LOCAL
+!-
+  REAL, PARAMETER :: eps = 1.e-4
+!-
+  INTEGER :: iret, vid, fid, nbdim, i, iilast, jjlast
+  INTEGER :: gdtt_id, old_id, iv, gdtmaf_id
+  CHARACTER(LEN=250) :: name
+  CHARACTER(LEN=80) :: units, calendar
+  INTEGER :: tmp_iim, tmp_jjm, tmp_llm, tmp_ttm
+  REAL :: x_first, x_last
+  INTEGER :: year, month, day
+  REAL :: r_year, r_month, r_day
+  INTEGER :: year0, month0, day0, hours0, minutes0, seci
+  REAL :: sec, sec0
+  CHARACTER :: strc
+!-
+  REAL,DIMENSION(:),ALLOCATABLE :: vec_tmp
+!-
+  LOGICAL :: open_file
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  iilast = iideb+iilen-1
+  jjlast = jjdeb+jjlen-1
+  IF (check) WRITE (*,*) &
+    ' flinopen_work zoom 2D information '// &
+    ' iideb, iilen, iilast, jjdeb, jjlen, jjlast ', &
+      iideb, iilen, iilast, jjdeb, jjlen, jjlast
+!-
+! 1.0 get all infos on the file
+!-
+! Either the fid_out has not been initialized (0 or very large)
+! then we have to open anyway. Else we only need to open the file
+! if it has not been opened before.
+!-
+  IF ( (fid_out < 1).OR.(fid_out > nbfile_max) ) THEN
+    open_file = .TRUE.
+  ELSE IF (.NOT.ncfileopen(fid_out)) THEN
+    open_file = .TRUE.
+  ELSE
+    open_file = .FALSE.
+  ENDIF
+!-
+  IF (open_file) THEN
+    CALL flininfo (filename,tmp_iim,tmp_jjm,tmp_llm,tmp_ttm,fid_out)
+  ELSE
+!-- The user has already opened the file
+!-- and we trust that he knows the dimensions
+    tmp_iim = iim
+    tmp_jjm = jjm
+    tmp_llm = llm
+    tmp_ttm = ttm
+  ENDIF
+!-
+  IF (check) &
+    WRITE(*,*) 'OUT OF flininfo :',tmp_iim,tmp_jjm,tmp_llm,tmp_ttm
+!-
+  fid = ncids(fid_out)
+!-
+! 2.0 get the sizes and names of the different coordinates
+!     and do a first set of verification.
+!-
+! 2.2 We test the axis if we have to.
+!-
+  IF (check) &
+    WRITE(*,*) 'flininfo 2.2 We test if we have to test : ',do_test
+!-
+  IF (do_test) THEN
+    IF      (iim /= tmp_iim) THEN
+      CALL histerr (3,'flinopen', &
+        'file '//filename//' does not have the ', &
+        'required dimension in x direction (longitude)',' ')
+    ELSE IF (jjm /= tmp_jjm) THEN
+      CALL histerr (3,'flinopen', &
+        'file '//filename//' does not have the ', &
+        'required dimension in y direction (latitude)',' ')
+    ELSE IF ( llm /= tmp_llm .AND. llm > 0 ) THEN
+      CALL histerr (3,'flinopen', &
+        'file '//filename//' does not have the ', &
+        'required dimension in the vertical',' ')
+    ENDIF
+  ELSE
+!---
+!-- 2.3 Else the sizes of the axes are returned to the user
+!---
+    IF (check) WRITE(*,*) 'flinopen 2.3 Else sizes are returned'
+!---
+    iim = tmp_iim
+    jjm = tmp_jjm
+    llm = tmp_llm
+  ENDIF
+!-
+  ttm = tmp_ttm
+!-
+! 3.0 Check if we are realy talking about the same coodinate system
+!     if not then we get the lon, lat and lev variables from the file
+!-
+  IF (check) WRITE(*,*) 'flinopen 3.0 we are realy talking'
+!-
+  IF (do_test) THEN
+!---
+    CALL flinfindcood (fid_out, 'lon', vid, nbdim)
+    iret = NF90_GET_VAR (fid, vid, x_first, start=(/ iideb, jjdeb /))
+    iret = NF90_GET_VAR (fid, vid, x_last, start=(/ iilast, jjlast /))
+!---
+    IF (check) &
+      WRITE(*,*) 'from file lon first and last, modulo 360. ', &
+        x_first, x_last, MODULO(x_first,360.), MODULO(x_last,360.)
+    IF (check) &
+      WRITE(*,*) 'from model lon first and last, modulo 360. ', &
+        lon(1,1),lon(iilen,jjlen), &
+        MODULO(lon(1,1),360.), MODULO(lon(iilen,jjlen),360.)
+    IF (    (ABS( MODULO(x_first,360.) &
+                 -MODULO(lon(1,1),360.)) > eps) &
+        .OR.(ABS( MODULO(x_last,360.) &
+                 -MODULO(lon(iilen ,jjlen),360.)) > eps ) ) THEN
+      CALL histerr (3,'flinopen', &
+        'file '//filename//' and the model do not', &
+        'share the same longitude coordinate', &
+        'Obtained by comparing the first and last values ')
+    ENDIF
+!---
+    CALL flinfindcood (fid_out, 'lat', vid, nbdim)
+    iret = NF90_GET_VAR (fid, vid, x_first, start=(/ iideb, jjdeb /))
+    iret = NF90_GET_VAR (fid, vid, x_last, start=(/ iilast, jjlast /))
+!---
+    IF (check) WRITE(*,*) &
+      'from file lat first and last ',x_first,x_last
+    IF (check) WRITE(*,*) &
+      'from model lat first and last ',lat(1,1),lat(iilen,jjlen)
+!---
+    IF (    (ABS(x_first-lat(1,1)) > eps) &
+        .OR.(ABS(x_last-lat(iilen,jjlen)) > eps) ) THEN
+      CALL histerr (3,'flinopen', &
+        'file '//filename//' and the model do not', &
+        'share the same latitude coordinate', &
+        'Obtained by comparing the first and last values ')
+    ENDIF
+!---
+    IF (llm > 0) THEN
+      CALL flinfindcood (fid_out, 'lev', vid, nbdim)
+      iret = NF90_GET_VAR (fid, vid, x_first, start=(/ 1 /))
+      iret = NF90_GET_VAR (fid, vid, x_last, start=(/ llm /))
+!-----
+      IF (check) WRITE(*,*) &
+        'from file lev first and last ',x_first ,x_last
+      IF (check) WRITE(*,*) &
+        'from model lev first and last ',lev(1),lev(llm)
+!-----
+      IF (    (ABS(x_first-lev(1)) > eps) &
+          .OR.(ABS(x_last-lev(llm)) > eps) ) THEN
+        CALL histerr (3,'flinopen', &
+          'file '//filename//' and the model do not', &
+          'share the same vertical coordinate', &
+          'Obtained by comparing the first and last values')
+      ENDIF
+    ENDIF
+!---
+  ELSE
+!---
+!-- 4.0 extracting the coordinates if we do not check
+!---
+    IF (check) WRITE(*,*) 'flinopen 4.0 extracting the coordinates'
+!---
+    CALL flinfindcood (fid_out, 'lon', vid, nbdim)
+    IF (nbdim == 2) THEN
+      iret = NF90_GET_VAR (fid, vid, lon, &
+               start=(/ iideb, jjdeb /), count=(/ iilen, jjlen /))
+    ELSE
+      ALLOCATE(vec_tmp(iilen))
+      iret = NF90_GET_VAR (fid, vid, vec_tmp, &
+               start=(/ iideb /), count=(/ iilen /))
+      DO i=1,jjlen
+        lon(:,i) = vec_tmp(:)
+      ENDDO
+      DEALLOCATE(vec_tmp)
+    ENDIF
+!---
+    CALL flinfindcood (fid_out, 'lat', vid, nbdim)
+    IF (nbdim == 2) THEN
+      iret = NF90_GET_VAR (fid, vid, lat, &
+               start=(/ iideb, jjdeb /), count=(/ iilen, jjlen /))
+    ELSE
+      ALLOCATE(vec_tmp(jjlen))
+      iret = NF90_GET_VAR (fid, vid, vec_tmp, &
+               start=(/ jjdeb /), count=(/ jjlen /))
+      DO i=1,iilen
+        lat(i,:) = vec_tmp(:)
+      ENDDO
+      DEALLOCATE(vec_tmp)
+    ENDIF
+!---
+    IF (llm > 0) THEN
+      CALL flinfindcood (fid_out, 'lev', vid, nbdim)
+      IF (nbdim == 1) THEN
+        iret = NF90_GET_VAR (fid, vid, lev, &
+                 start=(/ 1 /), count=(/ llm /))
+      ELSE
+        CALL histerr (3,'flinopen', &
+          'Can not handle vertical coordinates that have more',&
+          'than 1 dimension',' ')
+      ENDIF
+    ENDIF
+  ENDIF
+!-
+! 5.0 Get all the details for the time if possible needed
+!-
+  IF (check) WRITE(*,*) 'flinopen 5.0 Get time'
+!-
+  IF (ttm > 0) THEN
+!---
+!-- 5.1 Find the time axis. Prefered method is the 'timestep since'
+!---
+    gdtmaf_id = -1
+    gdtt_id = -1
+    old_id = -1
+    DO iv=1,ncnbva(fid_out)
+      name=''
+      iret = NF90_INQUIRE_VARIABLE (fid, iv, name=name)
+      units=''
+      iret = NF90_GET_ATT (fid, iv, 'units', units)
+      IF (INDEX(units,'seconds since') > 0) gdtmaf_id = iv
+      IF (INDEX(units,'timesteps since') > 0) gdtt_id = iv
+      IF (INDEX(name, 'tstep') > 0) old_id = iv
+    ENDDO
+!---
+    IF (gdtt_id > 0) THEN
+      vid = gdtt_id
+    ELSE IF (gdtmaf_id > 0) THEN
+      vid = gdtmaf_id
+    ELSE IF (old_id > 0) THEN
+      vid = old_id
+    ELSE
+      CALL histerr (3, 'flinopen', 'No time axis found',' ',' ')
+    ENDIF
+!---
+    ALLOCATE(vec_tmp(ttm))
+    iret = NF90_GET_VAR (fid,vid,vec_tmp,start=(/ 1 /),count=(/ ttm /))
+    itaus(1:ttm) = NINT(vec_tmp(1:ttm))
+    DEALLOCATE(vec_tmp)
+!---
+    IF (check) WRITE(*,*) 'flinopen 5.1 Times ',itaus
+!---
+!-- Getting all the details for the time axis
+!---
+!-- Find the calendar
+    calendar = ''
+    iret = NF90_GET_ATT (fid,gdtmaf_id,'calendar',calendar)
+    IF (iret == NF90_NOERR) THEN
+      CALL ioconf_calendar(calendar)
+    ENDIF
+!--
+    units = ''
+    iret = NF90_GET_ATT (fid,vid,'units',units)
+    IF (gdtt_id > 0) THEN
+      units = units(INDEX(units,'since')+6:LEN_TRIM(units))
+      READ (units,'(I4.4,5(a,I2.2))') &
+        year0, strc, month0, strc, day0, &
+               strc, hours0, strc, minutes0, strc, seci
+      sec0 = hours0*3600. + minutes0*60. + seci
+      CALL ymds2ju (year0, month0, day0, sec0, date0)
+      IF (check) &
+        WRITE(*,*) 'flinopen 5.1 gdtt_id year0 ... date0 ', &
+                   year0, month0, day0, sec0, date0
+!-----
+      iret = NF90_GET_ATT (fid, gdtt_id, 'tstep_sec', dt)
+    ELSE IF (gdtmaf_id > 0) THEN
+      units = units(INDEX(units,'since')+6:LEN_TRIM(units))
+      READ (units,'(I4.4,5(a,I2.2))') &
+        year0, strc, month0, strc, day0, &
+               strc, hours0, strc, minutes0, strc, seci
+      sec0 = hours0*3600. + minutes0*60. + seci
+      CALL ymds2ju (year0, month0, day0, sec0, date0)
+!-----
+      IF (check) &
+        WRITE(*,*) 'flinopen 5.1 gdtmaf_id year0 ... date0 ', &
+                   year0, month0, day0, sec0, date0
+    ELSE IF (old_id > 0) THEN
+      iret = NF90_GET_ATT (fid, NF90_GLOBAL, 'delta_tstep_sec', dt)
+      iret = NF90_GET_ATT (fid, NF90_GLOBAL, 'day0', r_day)
+      iret = NF90_GET_ATT (fid, NF90_GLOBAL, 'sec0', sec)
+      iret = NF90_GET_ATT (fid, NF90_GLOBAL, 'year0', r_year)
+      iret = NF90_GET_ATT (fid, NF90_GLOBAL, 'month0', r_month)
+!-----
+      day = INT(r_day)
+      month = INT(r_month)
+      year = INT(r_year)
+!-----
+      CALL ymds2ju (year, month, day, sec, date0)
+    ENDIF
+  ENDIF
+!-
+  IF (check) WRITE(*,*) 'flinopen 6.0 File opened', date0, dt
+!---------------------------
+END SUBROUTINE flinopen_work
+!-
+!===
+!-
+SUBROUTINE flininfo (filename, iim, jjm, llm, ttm, fid_out)
+!---------------------------------------------------------------------
+!- This subroutine allows to get some information.
+!- It is usualy done within flinopen but the user may want to call
+!- it before in order to allocate the space needed to extract the
+!- data from the file.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! ARGUMENTS
+!-
+  CHARACTER(LEN=*) :: filename
+  INTEGER :: iim, jjm, llm, ttm, fid_out
+!-
+! LOCAL
+!-
+  INTEGER :: iret, fid, ndims, nvars, nb_atts, id_unlim
+  INTEGER :: iv, lll
+  INTEGER :: xid, yid, zid, tid
+  CHARACTER(LEN=80) :: name
+  CHARACTER(LEN=30) :: axname
+!-
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  lll = LEN_TRIM(filename)
+  IF (filename(lll-2:lll) /= '.nc') THEN
+    name = filename(1:lll)//'.nc'
+  ELSE
+    name = filename(1:lll)
+  ENDIF
+!-
+  iret = NF90_OPEN (name, NF90_NOWRITE, fid)
+  IF (iret /= NF90_NOERR) THEN
+    CALL histerr(3, 'flininfo','Could not open file :',TRIM(name),' ')
+  ENDIF
+!-
+  iret = NF90_INQUIRE (fid, nDimensions=ndims, nVariables=nvars, &
+                      nAttributes=nb_atts, unlimitedDimId=id_unlim)
+!-
+  xid = -1; iim = 0;
+  yid = -1; jjm = 0;
+  zid = -1; llm = 0;
+  tid = -1; ttm = 0;
+!-
+  DO iv=1,ndims
+!---
+    iret = NF90_INQUIRE_DIMENSION (fid, iv, name=axname, len=lll)
+    CALL strlowercase (axname)
+    axname = ADJUSTL(axname)
+!---
+    IF (check) WRITE(*,*) &
+      'flininfo - getting axname',iv,axname,lll
+!---
+    IF      (    (INDEX(axname,'x') == 1) &
+             .OR.(INDEX(axname,'lon') == 1) ) THEN
+      xid = iv; iim = lll;
+    ELSE IF (    (INDEX(axname,'y') == 1) &
+             .OR.(INDEX(axname,'lat') == 1) ) THEN
+      yid = iv; jjm = lll;
+    ELSE IF (    (INDEX(axname,'lev') == 1) &
+             .OR.(INDEX(axname,'plev') == 1) &
+             .OR.(INDEX(axname,'z') == 1) &
+             .OR.(INDEX(axname,'depth') == 1) ) THEN
+      zid = iv; llm = lll;
+    ELSE IF (    (INDEX(axname,'tstep') == 1) &
+             .OR.(INDEX(axname,'time_counter') == 1) ) THEN
+!---- For the time we certainly need to allow for other names
+      tid = iv; ttm = lll;
+    ELSE IF (ndims == 1) THEN
+!---- Nothing was found and ndims=1 then we have a vector of data
+      xid = 1; iim = lll;
+    ENDIF
+!---
+  ENDDO
+!-
+! Keep all this information
+!-
+  nbfiles = nbfiles+1
+!-
+  IF (nbfiles > nbfile_max) THEN
+    CALL histerr (3,'flininfo', &
+      'Too many files. Please increase nbfil_max', &
+      'in program flincom.F90.',' ')
+  ENDIF
+!-
+  ncids(nbfiles) = fid
+  ncnbd(nbfiles) = ndims
+!-
+  ncdims(nbfiles,1:4) = (/ iim, jjm, llm, ttm /)
+!-
+  ncfunli(nbfiles) = id_unlim
+  ncnba(nbfiles)   = nb_atts
+  ncnbva(nbfiles)  = nvars
+  ncfileopen(nbfiles) = .TRUE.
+!-
+  fid_out = nbfiles
+!----------------------
+END SUBROUTINE flininfo
+!-
+!===
+!-
+SUBROUTINE flinput_r1d &
+  (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, nlonid, jjm, nlatid, llm, zdimid, ttm, tdimid
+  REAL :: var(:)
+!-
+  INTEGER :: fid, ncvarid, ndim, iret
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (check) WRITE(*,*) &
+     "flinput_r1d : SIZE(var) = ",SIZE(var)
+!-
+  CALL flinput_mat &
+    (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid, &
+     fid,ncvarid,ndim)
+!-
+  iret = NF90_PUT_VAR (fid, ncvarid, var, &
+           start=w_sta(1:ndim), count=w_len(1:ndim))
+!-------------------------
+END SUBROUTINE flinput_r1d
+!-
+!===
+!-
+SUBROUTINE flinput_r2d &
+  (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, nlonid, jjm, nlatid, llm, zdimid, ttm, tdimid
+  REAL :: var(:,:)
+!-
+  INTEGER :: fid, ncvarid, ndim, iret
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (check) WRITE(*,*) &
+     "flinput_r2d : SIZE(var) = ",SIZE(var)
+!-
+  CALL flinput_mat &
+    (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid, &
+     fid,ncvarid,ndim)
+!-
+  iret = NF90_PUT_VAR (fid, ncvarid, var, &
+           start=w_sta(1:ndim), count=w_len(1:ndim))
+!-------------------------
+END SUBROUTINE flinput_r2d
+!-
+!===
+!-
+SUBROUTINE flinput_r3d &
+  (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, nlonid, jjm, nlatid, llm, zdimid, ttm, tdimid
+  REAL :: var(:,:,:)
+!-
+  INTEGER :: fid, ncvarid, ndim, iret
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (check) WRITE(*,*) &
+     "flinput_r3d : SIZE(var) = ",SIZE(var)
+!-
+  CALL flinput_mat &
+    (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid, &
+     fid,ncvarid,ndim)
+!-
+  iret = NF90_PUT_VAR (fid, ncvarid, var, &
+           start=w_sta(1:ndim), count=w_len(1:ndim))
+!-------------------------
+END SUBROUTINE flinput_r3d
+!-
+!===
+!-
+SUBROUTINE flinput_r4d &
+  (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, nlonid, jjm, nlatid, llm, zdimid, ttm, tdimid
+  REAL :: var(:,:,:,:)
+!-
+  INTEGER :: fid, ncvarid, ndim, iret
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (check) WRITE(*,*) &
+     "flinput_r4d : SIZE(var) = ",SIZE(var)
+!-
+  CALL flinput_mat &
+    (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid, &
+     fid,ncvarid,ndim)
+!-
+  iret = NF90_PUT_VAR (fid, ncvarid, var, &
+           start=w_sta(1:ndim), count=w_len(1:ndim))
+!-------------------------
+END SUBROUTINE flinput_r4d
+!-
+!===
+!-
+SUBROUTINE flinput_mat &
+  (fid_in,varname,iim,nlonid,jjm,nlatid, &
+                  llm,zdimid,ttm,tdimid,fid,ncvarid,ndim)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, nlonid, jjm, nlatid, llm, zdimid, ttm, tdimid
+  INTEGER :: fid, ncvarid, ndim
+!-
+! LOCAL
+!-
+  INTEGER :: iret
+!---------------------------------------------------------------------
+  fid = ncids(fid_in)
+!-
+  w_sta(1:4) = (/      1,      1,  1,  1 /)
+  w_len(1:2) = (/    iim,    jjm /)
+  w_dim(1:2) = (/ nlonid, nlatid /)
+!-
+  IF ( (llm > 0).AND.(ttm > 0) ) THEN
+    ndim = 4
+    w_len(3:4) = (/    llm,    ttm /)
+    w_dim(3:4) = (/ zdimid, tdimid /)
+  ELSE IF (llm > 0) THEN
+    ndim = 3
+    w_dim(3) = zdimid
+    w_len(3) = llm
+  ELSE IF (ttm > 0) THEN
+    ndim = 3
+    w_dim(3) = tdimid
+    w_len(3) = ttm
+  ELSE
+    ndim = 2
+  ENDIF
+!-
+  iret = NF90_REDEF   (fid)
+  iret = NF90_DEF_VAR (fid,varname,NF90_FLOAT,w_dim(1:ndim),ncvarid)
+  iret = NF90_PUT_ATT (fid,ncvarid,'short_name',TRIM(varname))
+  iret = NF90_ENDDEF  (fid)
+!--------------------------
+END  SUBROUTINE flinput_mat
+!-
+!===
+!-
+SUBROUTINE flinput_scal &
+  (fid_in, varname, iim, nlonid, jjm, nlatid, &
+                    llm, zdimid, ttm, tdimid, var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, nlonid, jjm, nlatid, llm, zdimid, ttm, tdimid
+  REAL :: var
+!-
+! LOCAL
+!-
+  INTEGER :: fid, iret
+!---------------------------------------------------------------------
+  fid = ncids(fid_in)
+!-
+  iret = NF90_REDEF   (fid)
+  iret = NF90_PUT_ATT (fid, NF90_GLOBAL, varname, REAL(var,KIND=4))
+  iret = NF90_ENDDEF  (fid)
+!---------------------------
+END  SUBROUTINE flinput_scal
+!-
+!===
+!-
+SUBROUTINE flinget_r1d &
+  (fid_in,varname,iim,jjm,llm,ttm,itau_dep,itau_fin,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, jjm, llm, ttm, itau_dep, itau_fin
+  REAL :: var(:)
+!-
+  INTEGER :: jl, ji
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (.NOT.ALLOCATED(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r1d : allocate buff_tmp for buff_sz = ",SIZE(var)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r1d : re-allocate buff_tmp for buff_sz = ",SIZE(var)
+    DEALLOCATE (buff_tmp)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ENDIF
+!-
+  CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &
+                    itau_dep,itau_fin,1,iim,1,jjm,buff_tmp)
+!-
+  jl=0
+  DO ji=1,SIZE(var,1)
+    jl=jl+1
+    var(ji) = buff_tmp(jl)
+  ENDDO
+!-------------------------
+END SUBROUTINE flinget_r1d
+!-
+!===
+!-
+SUBROUTINE flinget_r2d &
+  (fid_in,varname,iim,jjm,llm,ttm,itau_dep,itau_fin,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, jjm, llm, ttm, itau_dep, itau_fin
+  REAL :: var(:,:)
+!-
+  INTEGER :: jl, jj, ji
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (.NOT.ALLOCATED(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r2d : allocate buff_tmp for buff_sz = ",SIZE(var)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r2d : re-allocate buff_tmp for buff_sz = ",SIZE(var)
+    DEALLOCATE (buff_tmp)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ENDIF
+!-
+  CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &
+                    itau_dep,itau_fin,1,iim,1,jjm,buff_tmp)
+!-
+  jl=0
+  DO jj=1,SIZE(var,2)
+    DO ji=1,SIZE(var,1)
+      jl=jl+1
+      var(ji,jj) = buff_tmp(jl)
+    ENDDO
+  ENDDO
+!-------------------------
+END SUBROUTINE flinget_r2d
+!-
+!===
+!-
+SUBROUTINE flinget_r2d_zoom2d &
+  (fid_in,varname,iim,jjm,llm,ttm, &
+   itau_dep,itau_fin,iideb,iilen,jjdeb,jjlen,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim,jjm,llm,ttm,itau_dep,itau_fin,iideb,jjdeb,iilen,jjlen
+  REAL :: var(:,:)
+!-
+  INTEGER :: jl, jj, ji
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (.NOT.ALLOCATED(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r2d_zoom : allocate buff_tmp for buff_sz = ",SIZE(var)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r2d_zoom : re-allocate buff_tmp for buff_sz = ",SIZE(var)
+    DEALLOCATE (buff_tmp)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ENDIF
+!-
+  CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &
+                    itau_dep,itau_fin,iideb,iilen,jjdeb,jjlen,buff_tmp)
+!-
+  jl=0
+  DO jj=1,SIZE(var,2)
+    DO ji=1,SIZE(var,1)
+      jl=jl+1
+      var(ji,jj) = buff_tmp(jl)
+    ENDDO
+  ENDDO
+!--------------------------------
+END SUBROUTINE flinget_r2d_zoom2d
+!-
+!===
+!-
+SUBROUTINE flinget_r3d &
+  (fid_in,varname,iim,jjm,llm,ttm,itau_dep,itau_fin,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, jjm, llm, ttm, itau_dep, itau_fin
+  REAL :: var(:,:,:)
+!-
+  INTEGER :: jl, jk, jj, ji
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (.NOT.ALLOCATED(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r3d : allocate buff_tmp for buff_sz = ",SIZE(var)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r3d : re-allocate buff_tmp for buff_sz = ",SIZE(var)
+    DEALLOCATE (buff_tmp)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ENDIF
+!-
+  CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &
+                    itau_dep,itau_fin,1,iim,1,jjm,buff_tmp)
+!-
+  jl=0
+  DO jk=1,SIZE(var,3)
+    DO jj=1,SIZE(var,2)
+      DO ji=1,SIZE(var,1)
+        jl=jl+1
+        var(ji,jj,jk) = buff_tmp(jl)
+      ENDDO
+    ENDDO
+  ENDDO
+!-------------------------
+END SUBROUTINE flinget_r3d
+!-
+!===
+!-
+SUBROUTINE flinget_r3d_zoom2d &
+  (fid_in,varname,iim,jjm,llm,ttm, &
+   itau_dep,itau_fin,iideb,iilen,jjdeb,jjlen,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim,jjm,llm,ttm,itau_dep,itau_fin,iideb,jjdeb,iilen,jjlen
+  REAL :: var(:,:,:)
+!-
+  INTEGER :: jl, jk, jj, ji
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (.NOT.ALLOCATED(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r3d_zoom : allocate buff_tmp for buff_sz = ",SIZE(var)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r3d_zoom : re-allocate buff_tmp for buff_sz = ",SIZE(var)
+    DEALLOCATE (buff_tmp)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ENDIF
+!-
+  CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &
+                    itau_dep,itau_fin,iideb,iilen,jjdeb,jjlen,buff_tmp)
+!-
+  jl=0
+  DO jk=1,SIZE(var,3)
+    DO jj=1,SIZE(var,2)
+      DO ji=1,SIZE(var,1)
+        jl=jl+1
+        var(ji,jj,jk) = buff_tmp(jl)
+      ENDDO
+    ENDDO
+  ENDDO
+!--------------------------------
+END SUBROUTINE flinget_r3d_zoom2d
+!-
+!===
+!-
+SUBROUTINE flinget_r4d &
+  (fid_in,varname,iim,jjm,llm,ttm,itau_dep,itau_fin,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, jjm, llm, ttm, itau_dep, itau_fin
+  REAL :: var(:,:,:,:)
+!-
+  INTEGER :: jl, jk, jj, ji, jm
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (.NOT.ALLOCATED(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r4d : allocate buff_tmp for buff_sz = ",SIZE(var)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r4d : re-allocate buff_tmp for buff_sz = ",SIZE(var)
+    DEALLOCATE (buff_tmp)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ENDIF
+!-
+  CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &
+                    itau_dep,itau_fin,1,iim,1,jjm,buff_tmp)
+!-
+  jl=0
+  DO jm=1,SIZE(var,4)
+    DO jk=1,SIZE(var,3)
+      DO jj=1,SIZE(var,2)
+        DO ji=1,SIZE(var,1)
+          jl=jl+1
+          var(ji,jj,jk,jm) = buff_tmp(jl)
+        ENDDO
+      ENDDO
+    ENDDO
+  ENDDO
+!-------------------------
+END SUBROUTINE flinget_r4d
+!-
+!===
+!-
+SUBROUTINE flinget_r4d_zoom2d &
+  (fid_in,varname,iim,jjm,llm,ttm, &
+   itau_dep,itau_fin,iideb,iilen,jjdeb,jjlen,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim,jjm,llm,ttm,itau_dep,itau_fin,iideb,jjdeb,iilen,jjlen
+  REAL :: var(:,:,:,:)
+!-
+  INTEGER :: jl, jk, jj, ji, jm
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (.NOT.ALLOCATED(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r4d_zoom : allocate buff_tmp for buff_sz = ",SIZE(var)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r4d_zoom : re-allocate buff_tmp for buff_sz = ",SIZE(var)
+    DEALLOCATE (buff_tmp)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ENDIF
+!-
+  CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &
+                    itau_dep,itau_fin,iideb,iilen,jjdeb,jjlen,buff_tmp)
+!-
+  jl=0
+  DO jm=1,SIZE(var,4)
+    DO jk=1,SIZE(var,3)
+      DO jj=1,SIZE(var,2)
+        DO ji=1,SIZE(var,1)
+          jl=jl+1
+          var(ji,jj,jk,jm) = buff_tmp(jl)
+        ENDDO
+      ENDDO
+    ENDDO
+  ENDDO
+!--------------------------------
+END SUBROUTINE flinget_r4d_zoom2d
+!-
+!===
+!-
+SUBROUTINE flinget_mat &
+  (fid_in, varname, iim, jjm, llm, ttm, itau_dep, &
+   itau_fin, iideb, iilen, jjdeb, jjlen, var)
+!---------------------------------------------------------------------
+!- This subroutine will read the variable named varname from
+!- the file previously opened by flinopen and identified by fid
+!-
+!- It is checked that the dimensions of the variable to be read
+!- correspond to what the user requested when he specified
+!- iim, jjm and llm. The only exception which is allowed is
+!- for compressed data where the horizontal grid is not expected
+!- to be iim x jjm.
+!-
+!- If variable is of size zero a global attribute is read.
+!- This global attribute will be of type real
+!-
+!- INPUT
+!-
+!- fid      : File ID returned by flinopen
+!- varname  : Name of the variable to be read from the file
+!- iim      : | These three variables give the size of the variables
+!- jjm      : | to be read. It will be verified that the variables
+!- llm      : | fits in there.
+!- ttm      : |
+!- itau_dep : Time step at which we will start to read
+!- itau_fin : Time step until which we are going to read
+!-            For the moment this is done on indexes
+!-            but it should be in the physical space.
+!-            If there is no time-axis in the file then use a
+!-            itau_fin < itau_dep, this will tell flinget not to
+!-            expect a time-axis in the file.
+!- iideb    : index i for zoom
+!- iilen    : length of zoom
+!- jjdeb    : index j for zoom
+!- jjlen    : length of zoom
+!-
+!- OUTPUT
+!-
+!- var      : array that will contain the data
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! ARGUMENTS
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, jjm, llm, ttm
+  INTEGER :: itau_dep, itau_fin, iideb, iilen, jjdeb, jjlen
+  REAL :: var(:)
+!-
+! LOCAL
+!-
+  INTEGER :: iret, fid
+  INTEGER :: vid, cvid, clen
+  CHARACTER(LEN=70) :: str1
+  CHARACTER(LEN=250) :: att_n, tmp_n
+  CHARACTER(LEN=5) :: axs_l
+  INTEGER :: tmp_i
+  REAL,SAVE :: mis_v=0.
+  REAL :: tmp_r
+  INTEGER :: ndims, x_typ, nb_atts
+  INTEGER,DIMENSION(NF90_MAX_VAR_DIMS) :: dimids
+  INTEGER :: i, nvars, i2d, cnd
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: var_tmp
+  LOGICAL :: uncompress = .FALSE.
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  fid = ncids(fid_in)
+!-
+  IF (check) THEN
+    WRITE(*,*) &
+    'flinget_mat : fid_in, fid, varname :', fid_in, fid, TRIM(varname)
+    WRITE(*,*) &
+    'flinget_mat : iim, jjm, llm, ttm, itau_dep, itau_fin :', &
+    iim, jjm, llm, ttm, itau_dep, itau_fin
+    WRITE(*,*) &
+    'flinget_mat : iideb, iilen, jjdeb, jjlen :', &
+    iideb, iilen, jjdeb, jjlen
+  ENDIF
+!-
+  uncompress = .FALSE.
+!-
+! 1.0 We get first all the details on this variable from the file
+!-
+  nvars = ncnbva(fid_in)
+!-
+  vid = -1
+  iret = NF90_INQ_VARID (fid, varname, vid)
+!-
+  IF (vid < 0 .OR. iret /= NF90_NOERR) THEN
+    CALL histerr (3,'flinget', &
+      'Variable '//TRIM(varname)//' not found in file',' ',' ')
+  ENDIF
+!-
+  iret = NF90_INQUIRE_VARIABLE (fid, vid, &
+           ndims=ndims, dimids=dimids, nAtts=nb_atts)
+  IF (check) THEN
+    WRITE(*,*) &
+    'flinget_mat : fid, vid :', fid, vid
+    WRITE(*,*) &
+    'flinget_mat : ndims, dimids(1:ndims), nb_atts :', &
+    ndims, dimids(1:ndims), nb_atts
+  ENDIF
+!-
+  w_dim(:) = 0
+  DO i=1,ndims
+    iret  = NF90_INQUIRE_DIMENSION (fid, dimids(i), len=w_dim(i))
+  ENDDO
+  IF (check) WRITE(*,*) &
+    'flinget_mat : w_dim :', w_dim(1:ndims)
+!-
+  mis_v = 0.0; axs_l = ' ';
+!-
+  IF (nb_atts > 0) THEN
+    IF (check) THEN
+      WRITE(*,*) 'flinget_mat : attributes for variable :'
+    ENDIF
+  ENDIF
+  DO i=1,nb_atts
+    iret = NF90_INQ_ATTNAME (fid, vid, i, att_n)
+    iret = NF90_INQUIRE_ATTRIBUTE (fid, vid, att_n, xtype=x_typ)
+    CALL strlowercase (att_n)
+    IF      (    (x_typ == NF90_INT).OR.(x_typ == NF90_SHORT) &
+             .OR.(x_typ == NF90_BYTE) ) THEN
+      iret = NF90_GET_ATT (fid, vid, att_n, tmp_i)
+      IF (check) THEN
+        WRITE(*,*) '   ',TRIM(att_n),' : ',tmp_i
+      ENDIF
+    ELSE IF ( (x_typ == NF90_FLOAT).OR.(x_typ == NF90_DOUBLE) ) THEN
+      iret = NF90_GET_ATT (fid, vid, att_n, tmp_r)
+      IF (check) THEN
+        WRITE(*,*) '   ',TRIM(att_n),' : ',tmp_r
+      ENDIF
+      IF (index(att_n,'missing_value') > 0) THEN
+        mis_v = tmp_r
+      ENDIF
+    ELSE
+      tmp_n = ''
+      iret = NF90_GET_ATT (fid, vid, att_n, tmp_n)
+      IF (check) THEN
+        WRITE(*,*) '   ',TRIM(att_n),' : ',TRIM(tmp_n)
+      ENDIF
+      IF (index(att_n,'axis') > 0) THEN
+        axs_l = tmp_n
+      ENDIF
+    ENDIF
+  ENDDO
+!?
+!!!!!!!!!! We will need a verification on the type of the variable
+!?
+!-
+! 2.0 The dimensions are analysed to determine what is to be read
+!-
+! 2.1 the longitudes
+!-
+  IF ( w_dim(1) /= iim .OR. w_dim(2) /= jjm) THEN
+!---
+!-- There is a possibility that we have to deal with a compressed axis !
+!---
+    iret = NF90_INQUIRE_DIMENSION (fid, dimids(1), &
+             name=tmp_n, len=clen)
+    iret = NF90_INQ_VARID (fid, tmp_n, cvid)
+!---
+    IF (check) WRITE(*,*) &
+      'Dimname, iret , NF90_NOERR : ',TRIM(tmp_n),iret,NF90_NOERR
+!---
+!-- If we have an axis which has the same name
+!-- as the dimension we can see if it is compressed
+!---
+!-- TODO TODO for zoom2d
+!---
+    IF (iret == NF90_NOERR) THEN
+      iret = NF90_GET_ATT (fid, cvid, 'compress', str1)
+!-----
+      IF (iret == NF90_NOERR) THEN
+        iret = NF90_INQUIRE_VARIABLE (fid,cvid,xtype=x_typ,ndims=cnd)
+!-------
+        IF ( cnd /= 1 .AND. x_typ /= NF90_INT) THEN
+          CALL histerr (3,'flinget', &
+            'Variable '//TRIM(tmp_n)//' can not be a compressed axis', &
+            'Either it has too many dimensions'// &
+            ' or it is not of type integer', ' ')
+        ELSE
+!---------
+!-------- Let us see if we already have that index table
+!---------
+          IF (    (cind_len /= clen).OR.(cind_vid /= cvid) &
+              .OR.(cind_fid /= fid) ) THEN
+            IF (ALLOCATED(cindex))   DEALLOCATE(cindex)
+            ALLOCATE(cindex(clen))
+            cind_len = clen
+            cind_vid = cvid
+            cind_fid = fid
+            iret = NF90_GET_VAR (fid, cvid, cindex)
+          ENDIF
+!---------
+!-------- In any case we need to set the slab of data to be read
+!---------
+          uncompress = .TRUE.
+          w_sta(1) = 1
+          w_len(1) = clen
+          i2d = 1
+        ENDIF
+      ELSE
+        str1 = 'The horizontal dimensions of '//varname
+        CALL histerr (3,'flinget',str1, &
+          'is not compressed and does not'// &
+          ' correspond to the requested size',' ')
+      ENDIF
+    ELSE
+      IF (w_dim(1) /= iim) THEN
+        str1 = 'The longitude dimension of '//varname
+        CALL histerr (3,'flinget',str1, &
+          'in the file is not equal to the dimension', &
+          'that should be read')
+      ENDIF
+      IF (w_dim(2) /= jjm) THEN
+        str1 = 'The latitude dimension of '//varname
+        CALL histerr (3,'flinget',str1, &
+          'in the file is not equal to the dimension', &
+          'that should be read')
+      ENDIF
+    ENDIF
+  ELSE
+    w_sta(1:2) = (/ iideb, jjdeb /)
+    w_len(1:2) = (/ iilen, jjlen /)
+    i2d = 2
+  ENDIF
+!-
+! 2.3 Now the difficult part, the 3rd dimension which can be
+! time or levels.
+!-
+! Priority is given to the time axis if only three axes are present.
+!-
+  IF (ndims > i2d) THEN
+!---
+!-- 2.3.1 We have a vertical axis
+!---
+    IF (llm == 1 .AND. ndims == i2d+2 .OR. llm == w_dim(i2d+1)) THEN
+!-----
+      IF (w_dim(i2d+1) /= llm) THEN
+        CALL histerr (3,'flinget', &
+          'The vertical dimension of '//varname, &
+          'in the file is not equal to the dimension', &
+          'that should be read')
+      ELSE
+        w_sta(i2d+1) = 1
+        IF (llm > 0) THEN
+          w_len(i2d+1) = llm
+        ELSE
+          w_len(i2d+1) = w_sta(i2d+1)
+        ENDIF
+      ENDIF
+!-----
+      IF ((itau_fin-itau_dep) >= 0) THEN
+        IF      (ndims /= i2d+2) THEN
+          CALL histerr (3,'flinget', &
+            'You attempt to read a time slab', &
+            'but there is no time axis on this variable', varname)
+        ELSE IF ((itau_fin - itau_dep) <= w_dim(i2d+2)) THEN
+          w_sta(i2d+2) = itau_dep
+          w_len(i2d+2) = itau_fin-itau_dep+1
+        ELSE
+          CALL histerr (3,'flinget', &
+            'The time step you try to read is not', &
+            'in the file (1)', varname)
+        ENDIF
+      ELSE IF (ndims == i2d+2 .AND. w_dim(i2d+2) > 1) THEN
+        CALL histerr (3,'flinget', &
+          'There is a time axis in the file but no', &
+          'time step give in the call', varname)
+      ELSE
+        w_sta(i2d+2) = 1
+        w_len(i2d+2) = 1
+      ENDIF
+    ELSE
+!-----
+!---- 2.3.2 We do not have any vertical axis
+!-----
+      IF (ndims == i2d+2) THEN
+        CALL histerr (3,'flinget', &
+          'The file contains 4 dimensions', &
+          'but only 3 are requestes for variable ', varname)
+      ENDIF
+      IF ((itau_fin-itau_dep) >= 0) THEN
+        IF (ndims == i2d+1) THEN
+          IF ((itau_fin-itau_dep) < w_dim(i2d+1) ) THEN
+            w_sta(i2d+1) = itau_dep
+            w_len(i2d+1) = itau_fin-itau_dep+1
+          ELSE
+            CALL histerr (3,'flinget', &
+              'The time step you try to read is not', &
+              'in the file (2)', varname)
+          ENDIF
+        ELSE
+          CALL histerr (3,'flinget', &
+            'From your input you sould have 3 dimensions', &
+            'in the file but there are 4', varname)
+        ENDIF
+      ELSE
+        IF (ndims == i2d+1 .AND. w_dim(i2d+1) > 1) THEN
+          CALL histerr (3,'flinget', &
+            'There is a time axis in the file but no', &
+            'time step given in the call', varname)
+        ELSE
+          w_sta(i2d+1) = 1
+          w_len(i2d+1) = 1
+        ENDIF
+      ENDIF
+    ENDIF
+  ELSE
+!---
+!-- 2.3.3 We do not have any vertical axis
+!---
+    w_sta(i2d+1:i2d+2) = (/ 0, 0 /)
+    w_len(i2d+1:i2d+2) = (/ 0, 0 /)
+  ENDIF
+!-
+! 3.0 Reading the data
+!-
+  IF (check) WRITE(*,*) &
+    'flinget_mat 3.0 : ', uncompress, w_sta, w_len
+!---
+  IF (uncompress) THEN
+!---
+    IF (ALLOCATED(var_tmp)) THEN
+      IF (SIZE(var_tmp) < clen) THEN
+        DEALLOCATE(var_tmp)
+        ALLOCATE(var_tmp(clen))
+      ENDIF
+    ELSE
+      ALLOCATE(var_tmp(clen))
+    ENDIF
+!---
+    iret = NF90_GET_VAR (fid, vid, var_tmp, &
+             start=w_sta(:), count=w_len(:))
+!---
+    var(:) = mis_v
+    var(cindex(:)) = var_tmp(:)
+!---
+  ELSE
+    iret = NF90_GET_VAR (fid, vid, var, &
+             start=w_sta(:), count=w_len(:))
+  ENDIF
+!-
+  IF (check) WRITE(*,*) 'flinget_mat 3.1 : ',NF90_STRERROR (iret)
+!--------------------------
+END  SUBROUTINE flinget_mat
+!-
+!===
+!-
+SUBROUTINE flinget_scal &
+  (fid_in, varname, iim, jjm, llm, ttm, itau_dep, itau_fin, var)
+!---------------------------------------------------------------------
+!- This subroutine will read the variable named varname from
+!- the file previously opened by flinopen and identified by fid
+!-
+!- If variable is of size zero a global attribute is read. This
+!- global attribute will be of type real
+!-
+!- INPUT
+!-
+!- fid      : File ID returned by flinopen
+!- varname  : Name of the variable to be read from the file
+!- iim      : | These three variables give the size of the variables
+!- jjm      : | to be read. It will be verified that the variables
+!- llm      : | fits in there.
+!- ttm      : |
+!- itau_dep : Time step at which we will start to read
+!- itau_fin : Time step until which we are going to read
+!-           For the moment this is done on indeces but it should be
+!-           in the physical space
+!-           If there is no time-axis in the file then use a
+!-           itau_fin < itau_dep, this will tell flinget not to
+!-           expect a time-axis in the file.
+!-
+!- OUTPUT
+!-
+!- var      : scalar that will contain the data
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! ARGUMENTS
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, jjm, llm, ttm, itau_dep, itau_fin
+  REAL :: var
+!-
+! LOCAL
+!-
+  INTEGER :: iret, fid
+!-
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (check) THEN
+    WRITE (*,*) 'flinget_scal in file with id ',fid_in
+  ENDIF
+!-
+  fid = ncids(fid_in)
+!-
+! 1.0 Reading a global attribute
+!-
+  iret = NF90_GET_ATT (fid, NF90_GLOBAL, varname, var)
+!---------------------------
+END  SUBROUTINE flinget_scal
+!-
+!===
+!-
+SUBROUTINE flinfindcood (fid_in, axtype, vid, ndim)
+!---------------------------------------------------------------------
+!- This subroutine explores the file in order to find
+!- the coordinate according to a number of rules
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! ARGUMENTS
+!-
+  INTEGER :: fid_in, vid, ndim
+  CHARACTER(LEN=3) :: axtype
+!-
+! LOCAL
+!-
+  INTEGER :: iv, iret, dimnb
+  CHARACTER(LEN=40) :: dimname, dimuni1, dimuni2, dimuni3
+  CHARACTER(LEN=80) :: str1
+  LOGICAL :: found_rule = .FALSE.
+!---------------------------------------------------------------------
+  vid = -1
+!-
+! Make sure all strings are invalid
+!-
+  dimname = '?-?'
+  dimuni1 = '?-?'
+  dimuni2 = '?-?'
+  dimuni3 = '?-?'
+!-
+! First rule : we look for the correct units
+! lon : east
+! lat : north
+! We make an exact check as it would be too easy to mistake
+! some units by just comparing the substrings.
+!-
+  SELECTCASE(axtype)
+  CASE ('lon')
+    dimuni1 = 'degree_e'
+    dimuni2 = 'degrees_e'
+    found_rule = .TRUE.
+  CASE('lat')
+    dimuni1 = 'degree_n'
+    dimuni2 = 'degrees_n'
+    found_rule = .TRUE.
+  CASE('lev')
+    dimuni1 = 'm'
+    dimuni2 = 'km'
+    dimuni3 = 'hpa'
+    found_rule = .TRUE.
+  CASE DEFAULT
+    found_rule = .FALSE.
+  END SELECT
+!-
+  IF (found_rule) THEN
+    iv = 0
+    DO WHILE ( (vid < 0).AND.(iv < ncnbva(fid_in)) )
+      iv = iv+1
+      str1 = ''
+      iret = NF90_GET_ATT (ncids(fid_in), iv, 'units', str1)
+      IF (iret == NF90_NOERR) THEN
+        CALL strlowercase (str1)
+        IF (    (INDEX(str1, TRIM(dimuni1)) == 1) &
+            .OR.(INDEX(str1, TRIM(dimuni2)) == 1) &
+            .OR.(INDEX(str1, TRIM(dimuni3)) == 1) ) THEN
+          vid = iv
+          iret = NF90_INQUIRE_VARIABLE (ncids(fid_in), iv, ndims=ndim)
+        ENDIF
+      ENDIF
+    ENDDO
+  ENDIF
+!-
+! Second rule : we find specific names :
+! lon : nav_lon
+! lat : nav_lat
+! Here we can check if we find the substring as the
+! names are more specific.
+!-
+  SELECTCASE(axtype)
+  CASE ('lon')
+    dimname = 'nav_lon lon longitude'
+    found_rule = .TRUE.
+  CASE('lat')
+    dimname = 'nav_lat lat latitude'
+    found_rule = .TRUE.
+  CASE('lev')
+    dimname = 'plev level depth deptht'
+    found_rule = .TRUE.
+  CASE DEFAULT
+    found_rule = .FALSE.
+  END SELECT
+!-
+  IF (found_rule) THEN
+    iv = 0
+    DO WHILE ( (vid < 0).AND.(iv < ncnbva(fid_in)) )
+      iv = iv+1
+      str1=''
+      iret = NF90_INQUIRE_VARIABLE (ncids(fid_in), iv, &
+                                    name=str1, ndims=ndim)
+      IF (INDEX(dimname,TRIM(str1)) >= 1) THEN
+        vid = iv
+      ENDIF
+    ENDDO
+  ENDIF
+!-
+! Third rule : we find a variable with the same name as the dimension
+! lon = 1
+! lat = 2
+! lev = 3
+!-
+  IF (vid < 0) THEN
+    SELECTCASE(axtype)
+    CASE ('lon')
+      dimnb = 1
+      found_rule = .TRUE.
+    CASE('lat')
+      dimnb = 2
+      found_rule = .TRUE.
+    CASE('lev')
+      dimnb = 3
+      found_rule = .TRUE.
+    CASE DEFAULT
+      found_rule = .FALSE.
+    END SELECT
+!---
+    IF (found_rule) THEN
+      iret = NF90_INQUIRE_DIMENSION (ncids(fid_in), dimnb, name=dimname)
+      iv = 0
+      DO WHILE ( (vid < 0).AND.(iv < ncnbva(fid_in)) )
+        iv = iv+1
+        str1=''
+        iret = NF90_INQUIRE_VARIABLE (ncids(fid_in), iv, &
+                                      name=str1, ndims=ndim)
+        IF (INDEX(dimname,TRIM(str1)) == 1) THEN
+          vid = iv
+        ENDIF
+      ENDDO
+    ENDIF
+  ENDIF
+!-
+! Stop the program if no coordinate was found
+!-
+  IF (vid < 0) THEN
+    CALL histerr (3,'flinfindcood', &
+           'No coordinate axis was found in the file', &
+           'The data in this file can not be used', axtype)
+  ENDIF
+!--------------------------
+END SUBROUTINE flinfindcood
+!-
+!===
+!-
+SUBROUTINE flinclo (fid_in)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+!-
+  INTEGER :: iret
+!---------------------------------------------------------------------
+  iret = NF90_CLOSE (ncids(fid_in))
+  ncfileopen(fid_in) = .FALSE.
+!---------------------
+END SUBROUTINE flinclo
+!-
+!===
+!-
+SUBROUTINE flinquery_var(fid_in, varname, exists)
+!---------------------------------------------------------------------
+!- Queries the existance of a variable in the file.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) varname
+  LOGICAL :: exists
+!-
+  INTEGER :: iret, fid, vid
+!---------------------------------------------------------------------
+  fid = ncids(fid_in)
+  vid = -1
+  iret = NF90_INQ_VARID (fid, varname, vid)
+!-
+  exists = ( (vid >= 0).AND.(iret == NF90_NOERR) )
+!---------------------------
+END SUBROUTINE flinquery_var
+!-
+!===
+!-
+SUBROUTINE flininspect (fid_in)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! fid : File id to inspect
+!-
+  INTEGER :: fid_in
+!-
+!- LOCAL
+!-
+  INTEGER :: iim, jjm, llm, ttm, fid_out
+  INTEGER :: iret, fid, ndims, nvars, nb_atts, id_unlim
+  INTEGER :: iv, in, lll
+  INTEGER :: xid, yid, zid, tid
+  INTEGER,DIMENSION(NF90_MAX_VAR_DIMS) :: idimid
+  CHARACTER(LEN=80) :: name
+  CHARACTER(LEN=30) :: axname
+!---------------------------------------------------------------------
+  fid = ncids(fid_in)
+!-
+  iret = NF90_INQUIRE (fid, nDimensions=ndims, nVariables=nvars, &
+                       nAttributes=nb_atts, unlimitedDimId=id_unlim)
+!-
+  WRITE (*,*) 'IOIPSL ID                   : ',fid_in
+  WRITE (*,*) 'NetCDF ID                   : ',fid
+  WRITE (*,*) 'Number of dimensions        : ',ndims
+  WRITE (*,*) 'Number of variables         : ',nvars
+  WRITE (*,*) 'Number of global attributes : ',nb_atts
+  WRITE (*,*) 'ID unlimited                : ',id_unlim
+!-
+  xid = -1; iim = 0;
+  yid = -1; jjm = 0;
+  zid = -1; llm = 0;
+  tid = -1; ttm = 0;
+!-
+  DO iv=1,ndims
+!---
+    iret = NF90_INQUIRE_DIMENSION (fid, iv, name=axname, len=lll)
+    CALL strlowercase (axname)
+    axname = ADJUSTL(axname)
+!---
+    WRITE (*,*) 'Dimension number : ',iv
+    WRITE (*,*) 'Dimension name   : ',TRIM(axname)
+!---
+    IF      (    (INDEX(axname,'x') == 1) &
+             .OR.(INDEX(axname,'lon') == 1)) THEN
+      xid = iv; iim = lll;
+      WRITE (*,*) 'Dimension X size   : ',iim
+    ELSE IF (    (INDEX(axname,'y') == 1) &
+             .OR.(INDEX(axname,'lat') == 1)) THEN
+      yid = iv; jjm = lll;
+      WRITE (*,*) 'Dimension Y size   : ',jjm
+    ELSE IF (    (INDEX(axname,'lev') == 1) &
+             .OR.(INDEX(axname,'plev') == 1) &
+             .OR.(INDEX(axname,'z') == 1) &
+             .OR.(INDEX(axname,'depth') == 1)) THEN
+      zid = iv; llm = lll;
+      WRITE (*,*) 'Dimension Z size   : ',llm
+    ELSE IF (    (INDEX(axname,'tstep') == 1) &
+             .OR.(INDEX(axname,'time_counter') == 1)) THEN
+!---- For the time we certainly need to allow for other names
+      tid = iv; ttm = lll;
+    ELSE IF (ndims == 1) THEN
+!---- Nothing was found and ndims=1 then we have a vector of data
+      xid = 1; iim = lll;
+    ENDIF
+!---
+  ENDDO
+!-
+! Keep all this information
+!-
+  nbfiles = nbfiles+1
+!-
+  IF (nbfiles > nbfile_max) THEN
+    CALL histerr(3,'flininspect', &
+      'Too many files. Please increase nbfil_max', &
+      'in program flincom.F90.',' ')
+  ENDIF
+!-
+  ncids(nbfiles) = fid
+  ncnbd(nbfiles) = ndims
+!-
+  ncdims(nbfiles,1:4) = (/ iim, jjm, llm, ttm /)
+!-
+  ncfunli(nbfiles) = id_unlim
+  ncnba(nbfiles)   = nb_atts
+  ncnbva(nbfiles)  = nvars
+  ncfileopen(nbfiles) = .TRUE.
+!-
+  fid_out = nbfiles
+!-
+  DO in=1,nvars
+    iret = NF90_INQUIRE_VARIABLE (fid, in, &
+             name=name, ndims=ndims, dimids=idimid, nAtts=nb_atts)
+    WRITE (*,*) 'Variable number  ------------ > ', in
+    WRITE (*,*) 'Variable name        : ', TRIM(name)
+    WRITE (*,*) 'Number of dimensions : ', ndims
+    WRITE (*,*) 'Dimensions ID''s     : ', idimid(1:ndims)
+    WRITE (*,*) 'Number of attributes : ', nb_atts
+  ENDDO
+!-------------------------
+END SUBROUTINE flininspect
+!-
+!===
+!-
+END MODULE flincom
Index: trunk/NEMOGCM/EXTERNAL/IOIPSL/src/fliocom.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/IOIPSL/src/fliocom.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/IOIPSL/src/fliocom.f90	(revision 2528)
@@ -0,0 +1,5173 @@
+MODULE fliocom
+!-
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+USE netcdf
+!-
+USE defprec
+USE calendar,  ONLY : lock_calendar,ioget_calendar, &
+ &                    ioconf_calendar,ju2ymds,ymds2ju
+USE errioipsl, ONLY : ipslerr,ipsldbg
+USE stringop,  ONLY : strlowercase,str_xfw
+!-
+IMPLICIT NONE
+!-
+PRIVATE
+!-
+PUBLIC :: &
+ &  fliocrfd, fliopstc, fliodefv, flioputv, flioputa, &
+ &  flioopfd, flioinqf, flioinqn, fliogstc, &
+ &  flioinqv, fliogetv, flioinqa, fliogeta, &
+ &  fliorenv, fliorena, fliodela, fliocpya, &
+ &  flioqstc, fliosync, flioclo,  fliodmpf, &
+ &  flio_dom_set,    flio_dom_unset, &
+ &  flio_dom_defset, flio_dom_defunset, flio_dom_definq, &
+ &  flio_dom_file,   flio_dom_att
+!-
+!!--------------------------------------------------------------------
+!! The following PUBLIC parameters (with "flio_" prefix)
+!! are used in the module "fliocom" :
+!!
+!! flio_max_files     : maximum number of simultaneously opened files
+!! flio_max_dims      : maximum number of dimensions for a file
+!! flio_max_var_dims  : maximum number of dimensions for a variable
+!!
+!! FLIO_DOM_NONE    : "named constant" for no_domain identifier
+!! FLIO_DOM_DEFAULT : "named constant" for default_domain identifier
+!!
+!! flio_i  : standard INTEGER external type
+!! flio_r  : standard REAL external type
+!! flio_c  : CHARACTER external type
+!! flio_i1 : INTEGER*1 external type
+!! flio_i2 : INTEGER*2 external type
+!! flio_i4 : INTEGER*4 external type
+!! flio_r4 : REAL*4 external type
+!! flio_r8 : REAL*8 external type
+!!--------------------------------------------------------------------
+  INTEGER,PARAMETER,PUBLIC :: &
+ &  flio_max_files=100, flio_max_dims=10, flio_max_var_dims=5
+  INTEGER,PARAMETER,PUBLIC :: &
+ &  flio_i = -1,        flio_r = -2,        flio_c =nf90_char, &
+ &  flio_i1=nf90_int1,  flio_i2=nf90_int2,  flio_i4=nf90_int4, &
+ &  flio_r4=nf90_real4, flio_r8=nf90_real8
+!-
+  INTEGER,PARAMETER,PUBLIC :: FLIO_DOM_NONE    =-1
+  INTEGER,PARAMETER,PUBLIC :: FLIO_DOM_DEFAULT = 0
+!-
+!!--------------------------------------------------------------------
+!! The "fliocrfd" routine creates a model file
+!! which contains the dimensions needed.
+!!
+!! SUBROUTINE fliocrfd (f_n,f_d_n,f_d_l,f_i,id_dom,mode,c_f_n)
+!!
+!! INPUT
+!!
+!! (C) f_n      : Name of the file to be created
+!! (C) f_d_n(:) : Array of (max nb_fd_mx) names of the dimensions
+!! (I) f_d_l(:) : Array of (max nb_fd_mx) lengths of the dimensions
+!!                For an unlimited dimension, enter a length of -1.
+!!                Actually, only one unlimited dimension is supported.
+!!
+!! OUTPUT
+!!
+!! (I) f_i  : Model file identifier
+!!
+!! Optional INPUT arguments
+!!
+!! (I) id_dom : Identifier of a domain defined by calling
+!!              "flio_dom_set". If this argument is present,
+!!              and not equal to FLIO_DOM_NONE, it will be
+!!              appended to the file name and
+!!              the attributes describing the related DOMAIN
+!!              will be put in the created file.
+!!              This argument can be equal to FLIO_DOM_DEFAULT
+!!              (see "flio_dom_defset").
+!! (C) mode   : String of (case insensitive) blank-separated words
+!!              defining the mode used to create the file.
+!!              Supported keywords : REPLACE, 32, 64
+!!              If this argument is present with the keyword "REPLACE",
+!!              the file will be created in mode "CLOBBER",
+!!              else the file will be created in mode "NOCLOBBER".
+!!              "32/64" defines the offset mode.
+!!              The default offset mode is 64 bits.
+!!              Keywords "NETCDF4" and "CLASSIC" are reserved
+!!              for future use.
+!!
+!! Optional OUTPUT arguments
+!!
+!! (C) c_f_n : Name of the created file.
+!!             This name can be different of "f_n",
+!!             if a suffix is added to the original name
+!!             (".nc" or "DOMAIN_identifier.nc").
+!!             The length of "c_f_n" must be sufficient
+!!             to receive the created file name.
+!!
+!!- NOTES
+!!
+!! The names used to identify the spatio-temporal dimensions
+!! (dimension associated to a coordinate variable)
+!! are the following :
+!!
+!!  Axis       Names
+!!
+!!    x        'x[...]'  'lon[...]'
+!!    y        'y[...]'  'lat[...]'
+!!    z        'z[...]'  'lev[...]'  'plev[...]'   'depth[...]'
+!!    t        't'       'time'      'tstep[...]'  'time_counter[...]'
+!!
+!! Please, apply these rules so that coordinates are
+!! correctly defined.
+!!--------------------------------------------------------------------
+!-
+!!--------------------------------------------------------------------
+!! The "fliopstc" routine defines the major coordinates system
+!! (spatio-temporal axis) of the model file (created by fliocrfd).
+!!
+!! SUBROUTINE fliopstc &
+!! & (f_i,x_axis,x_axis_2d,y_axis,y_axis_2d,z_axis, &
+!! &      t_axis,t_init,t_step,t_calendar)
+!!
+!! INPUT
+!!
+!! (I) f_i  : Model file identifier
+!!
+!! Optional INPUT arguments
+!!
+!! (R) x_axis(:)      : longitudinal grids
+!! (R) x_axis_2d(:,:) : longitudinal grids
+!! (R) y_axis(:)      : latitudinal grids
+!! (R) y_axis_2d(:,:) : latitudinal grids
+!! (R) z_axis(:)      : vertical grid
+!! (I) t_axis(:)      : timesteps on the time axis
+!! (R) t_init         : date in julian days at the beginning
+!! (R) t_step         : timestep in seconds between t_axis steps
+!! (C) t_calendar     : calendar
+!!
+!! [x/y]_axis and [x/y]_axis_2d are mutually exclusive.
+!!
+!!- NOTES
+!!
+!! The variables corresponding to the spatio-temporal coordinates
+!! are created according to the following characteristics :
+!!
+!!- Longitude axis     x_axis / x_axis_2d
+!!   Variable name     'lon'  / 'nav_lon'
+!!   Attributes        Values
+!!   'axis'            "X"
+!!   'standard_name'   "longitude"
+!!   'units'           "degrees_east"
+!!   'valid_min'       MINVAL(x_axis/x_axis_2d)
+!!   'valid_max'       MAXVAL(x_axis/x_axis_2d)
+!!
+!!- Latitude axis      y_axis / y_axis_2d
+!!   Variable name     'lat'  / 'nav_lat'
+!!   Attributes        Values
+!!   'axis'            "Y"
+!!   'standard_name'   "latitude"
+!!   'units'           "degrees_north"
+!!   'valid_min'       MINVAL(y_axis/y_axis_2d)
+!!   'valid_max'       MAXVAL(y_axis/y_axis_2d)
+!!
+!!- Vertical axis      z_axis
+!!   Variable name     'lev'
+!!   Attributes        Values
+!!   'axis'            "Z"
+!!   'standard_name'   "model_level_number"
+!!   'units'           "sigma_level"
+!!   'long_name'       "Sigma Levels"
+!!   'valid_min'       MINVAL(z_axis)
+!!   'valid_max'       MAXVAL(z_axis)
+!!
+!!- Time axis          t_axis
+!!   Variable name     'time'
+!!   Attributes        Values
+!!   'axis'            "T"
+!!   'standard_name'   "time"
+!!   'long_name'       "time steps"
+!!  ['calendar'        user/default valued]
+!!   'units'           calculated
+!!
+!! If you are not satisfied, it is possible
+!! to rename variables ("fliorenv")
+!! or overload the values of attributes ("flioputa").
+!! Be careful : the new values you use must allow to read variables
+!! as coordinates.
+!!
+!! The dimensions associated to the coordinates variables
+!! are searched according to their names (see "fliocrfd")
+!!--------------------------------------------------------------------
+!-
+INTERFACE fliodefv
+!!--------------------------------------------------------------------
+!! The "fliodefv" routines define a variable in a model file.
+!!
+!! SUBROUTINE fliodefv &
+!! & (f_i,v_n,[v_d],v_t, &
+!! &  axis,standard_name,long_name,units, &
+!! &  valid_min,valid_max,fillvalue)
+!!
+!! INPUT
+!!
+!! (I)  f_i  : Model file identifier
+!! (C)  v_n  : Name of variable to be defined
+!! (I) [v_d] :
+!!             "not present"
+!!                --> scalar variable
+!!             "array of one or several integers containing
+!!              the identifiers of the dimensions of the variable
+!!              (in the order specified to "fliocrfd"
+!!               or obtained from "flioopfd")"
+!!                --> multidimensioned variable
+!!
+!! Optional INPUT arguments
+!!
+!! (I) v_t : External type of the variable
+!!           "present"     --> see flio_..
+!!           "not present" --> type of standard real
+!! (C) axis,standard_name,long_name,units : Attributes
+!!     (axis should be used only for coordinates)
+!! (R) valid_min,valid_max,fillvalue : Attributes
+!!--------------------------------------------------------------------
+  MODULE PROCEDURE &
+ &  fliodv_r0d,fliodv_rnd
+END INTERFACE
+!-
+INTERFACE flioputv
+!!--------------------------------------------------------------------
+!! The "flioputv" routines put a variable (defined by fliodefv)
+!! in a model file.
+!!
+!! SUBROUTINE flioputv (f_i,v_n,v_v,start,count)
+!!
+!! INPUT
+!!
+!! (I) f_i    : model file identifier
+!! (C) v_n    : name of the variable to be written
+!! (R/I) v_v  : scalar or array (up to flio_max_var_dims dimensions)
+!!              containing the (standard) real/integer values
+!!
+!! Optional INPUT arguments
+!!
+!! (I) start(:) : array of integers specifying the index
+!!                where the first data value will be written
+!! (I) count(:) : array of integers specifying the number of
+!!                indices that will be written along each dimension
+!!                (not present if v_v is a scalar)
+!!--------------------------------------------------------------------
+!?INTEGERS of KIND 1 are not supported on all computers
+  MODULE PROCEDURE &
+ & fliopv_i40,fliopv_i41,fliopv_i42,fliopv_i43,fliopv_i44,fliopv_i45, &
+ & fliopv_i20,fliopv_i21,fliopv_i22,fliopv_i23,fliopv_i24,fliopv_i25, &
+!& fliopv_i10,fliopv_i11,fliopv_i12,fliopv_i13,fliopv_i14,fliopv_i15, &
+ & fliopv_r40,fliopv_r41,fliopv_r42,fliopv_r43,fliopv_r44,fliopv_r45, &
+ & fliopv_r80,fliopv_r81,fliopv_r82,fliopv_r83,fliopv_r84,fliopv_r85
+END INTERFACE
+!-
+INTERFACE flioputa
+!!--------------------------------------------------------------------
+!! The "flioputa" routines put a value for an attribute
+!! in a model file.
+!! If this attribute does not exist, it will be created.
+!!
+!! SUBROUTINE flioputa (f_i,v_n,a_n,a_v)
+!!
+!! INPUT
+!!
+!! (I) f_i  : Model file identifier
+!! (C) v_n  : Name of variable to which the attribute is assigned.
+!!            If this name is "?", the attribute will be global.
+!! (C) a_n  : Name of the attribute to be defined.
+!! ( ) a_v  : scalar or array of real (kind 4 or 8) or integer values,
+!!            or character string
+!!--------------------------------------------------------------------
+  MODULE PROCEDURE &
+ &  fliopa_r4_0d,fliopa_r4_1d,fliopa_r8_0d,fliopa_r8_1d, &
+ &  fliopa_i4_0d,fliopa_i4_1d,fliopa_tx_0d
+END INTERFACE
+!-
+!!--------------------------------------------------------------------
+!! The "flioopfd" routine opens an existing model file,
+!! and returns the dimensions used in the file and a file identifier.
+!! This information can be used to allocate the space needed
+!! to extract the data from the file.
+!!
+!! SUBROUTINE flioopfd (f_n,f_i,mode,nb_dim,nb_var,nb_gat)
+!!
+!! INPUT
+!!
+!! (C) f_n     : Name of the file to be opened
+!!
+!! OUTPUT
+!!
+!! (I) f_i      : Model file identifier
+!!
+!! Optional INPUT arguments
+!!
+!! (C) mode : Access mode to the file.
+!!            If this argument is present with the value "WRITE",
+!!            the file will be accessed in mode "READ-WRITE",
+!!            else the file will be accessed in mode "READ-ONLY".
+!!
+!! Optional OUTPUT arguments
+!!
+!! (I) nb_dim : number of dimensions
+!! (I) nb_var : number of variables
+!! (I) nb_gat : number of global attributes
+!!--------------------------------------------------------------------
+!-
+!!--------------------------------------------------------------------
+!! The "flioinqf" routine returns information
+!! about an opened model file given its identifier.
+!!
+!! SUBROUTINE flioinqf &
+!! & (f_i,nb_dim,nb_var,nb_gat,id_uld,id_dim,ln_dim)
+!!
+!! INPUT
+!!
+!! (I) f_i  : Model file identifier
+!!
+!! Optional OUTPUT arguments
+!!
+!! (I) nb_dim    : number of dimensions
+!! (I) nb_var    : number of variables
+!! (I) nb_gat    : number of global attributes
+!! (I) id_uld    : identifier of the unlimited dimension (0 if none)
+!! (I) id_dim(:) : identifiers of the dimensions
+!! (I) ln_dim(:) : lengths of the dimensions
+!!--------------------------------------------------------------------
+!-
+!!--------------------------------------------------------------------
+!! The "flioinqn" routine returns the names
+!! of the entities encountered in an opened model file.
+!!
+!! SUBROUTINE flioinqn &
+!! & (f_i,cn_dim,cn_var,cn_gat,cn_uld, &
+!! &  id_start,id_count,iv_start,iv_count,ia_start,ia_count)
+!!
+!! INPUT
+!!
+!! (I) f_i  : Model file identifier
+!!
+!! Optional OUTPUT arguments
+!!
+!! (C) cn_dim(:) : names of dimensions
+!! (C) cn_var(:) : names of variables
+!! (C) cn_gat(:) : names of global attributes
+!! (C) cn_uld    : names of the unlimited dimension
+!!
+!! Optional INPUT arguments
+!!
+!! (I) id_start,id_count,iv_start,iv_count,ia_start,ia_count
+!!
+!!  The prefix ( id       / iv      / ia              ) specifies
+!!         the (dimensions/variables/global attributes) entities
+!!
+!!  The suffix "start" specify the index from which
+!!  the first name will be retrieved (1 by default)
+!!
+!!  The suffix "count" specifies the number of names to be retrieved
+!!  (all by default)
+!!
+!!  If a requested entity is not available, a "?" will be returned.
+!!--------------------------------------------------------------------
+!-
+!!--------------------------------------------------------------------
+!! The "fliogstc" routine extracts the major coordinates system
+!! (spatio-temporal axis) of the model file (opened by flioopfd).
+!!
+!! SUBROUTINE fliogstc &
+!! & (f_i,x_axis,x_axis_2d,y_axis,y_axis_2d,z_axis, &
+!! &      t_axis,t_init,t_step,t_calendar, &
+!! &      x_start,x_count,y_start,y_count, &
+!! &      z_start,z_count,t_start,t_count)
+!!
+!! INPUT
+!!
+!! (I) f_i  : Model file identifier
+!!
+!! Optional OUTPUT arguments
+!!
+!! (R) x_axis(:)      : longitudinal grids
+!! (R) x_axis_2d(:,:) : longitudinal grids
+!! (R) y_axis(:)      : latitudinal grids
+!! (R) y_axis_2d(:,:) : latitudinal grids
+!! (R) z_axis(:)      : vertical grid
+!! (I) t_axis(:)      : timesteps on the time axis
+!! (R) t_init         : date in julian days at the beginning
+!! (R) t_step         : timestep in seconds between t_axis steps
+!! (C) t_calendar     : calendar attribute
+!!                      (the value is "not found" if the attribute
+!!                       is not present in the model file)
+!!
+!! [x/y]_axis and [x/y]_axis_2d are mutually exclusive.
+!!
+!! Optional INPUT arguments
+!!
+!! (I) x_start,x_count,y_start,y_count,z_start,z_count,t_start,t_count
+!!
+!!  The prefix (x/y/z/t) specifies the concerned direction.
+!!
+!!  The suffix "start" specify the index from which
+!!  the first data value will be read (1 by default)
+!!
+!!  The suffix "count" specifies the number of values to be read
+!!  (all by default)
+!!--------------------------------------------------------------------
+!-
+!!--------------------------------------------------------------------
+!! The "flioinqv" routine returns information about a model
+!! variable given its name.
+!! This information can be used to allocate the space needed
+!! to extract the variable from the file.
+!!
+!! SUBROUTINE flioinqv &
+!! & (f_i,v_n,l_ex,nb_dims,len_dims,id_dims, &
+!! &  nb_atts,cn_atts,ia_start,ia_count)
+!!
+!! INPUT
+!!
+!! (I) f_i  : Model file identifier
+!! (C) v_n  : Name of the variable
+!!
+!! OUTPUT
+!!
+!! (L) l_ex  : Existence of the variable
+!!
+!! Optional OUTPUT arguments
+!!
+!! (I) v_t          : External type of the variable (see flio_..)
+!! (I) nb_dims      : number of dimensions of the variable
+!! (I) len_dims(:)  : list of dimension lengths of the variable
+!! (I) id_dims(:)   : list of dimension identifiers of the variable
+!! (I) nb_atts      : number of attributes of the variable
+!! (C) cn_atts(:)   : names of the attributes
+!!
+!! Optional INPUT arguments
+!!
+!! (I) ia_start : index of the first attribute whose the name
+!!                will be retrieved (1 by default)
+!! (I) ia_count : number of names to be retrieved (all by default)
+!!
+!!  If a requested entity is not available, a "?" will be returned.
+!!--------------------------------------------------------------------
+!-
+INTERFACE fliogetv
+!!--------------------------------------------------------------------
+!! The "fliogetv" routines get a variable from a model file.
+!!
+!! SUBROUTINE fliogetv (f_i,v_n,v_v,start,count)
+!!
+!! INPUT
+!!
+!! (I) f_i  : Model file identifier
+!! (C) v_n  : Name of the variable to be read
+!!
+!! OUTPUT
+!!
+!! (R/I) v_v  : scalar or array (up to flio_max_var_dims dimensions)
+!!              that will contain the (standard) real/integer values
+!!
+!! Optional INPUT arguments
+!!
+!! (I) start(:) : array of integers specifying the index
+!!                from which the first data value will be read
+!! (I) count(:) : array of integers specifying the number of
+!!                indices that will be read along each dimension
+!!                (not present if v_v is a scalar)
+!!--------------------------------------------------------------------
+!?INTEGERS of KIND 1 are not supported on all computers
+  MODULE PROCEDURE &
+ & fliogv_i40,fliogv_i41,fliogv_i42,fliogv_i43,fliogv_i44,fliogv_i45, &
+ & fliogv_i20,fliogv_i21,fliogv_i22,fliogv_i23,fliogv_i24,fliogv_i25, &
+!& fliogv_i10,fliogv_i11,fliogv_i12,fliogv_i13,fliogv_i14,fliogv_i15, &
+ & fliogv_r40,fliogv_r41,fliogv_r42,fliogv_r43,fliogv_r44,fliogv_r45, &
+ & fliogv_r80,fliogv_r81,fliogv_r82,fliogv_r83,fliogv_r84,fliogv_r85
+END INTERFACE
+!-
+!!--------------------------------------------------------------------
+!! The "flioinqa" routine returns information about an
+!! attribute of a variable given their names, in a model file.
+!! Information about a variable includes its existence,
+!! and the number of values currently stored in the attribute.
+!! For a string-valued attribute, this is the number of
+!! characters in the string.
+!! This information can be used to allocate the space needed
+!! to extract the attribute from the file.
+!!
+!! SUBROUTINE flioinqa (f_i,v_n,a_n,l_ex,a_t,a_l)
+!!
+!! INPUT
+!!
+!! (I) f_i : Model file identifier
+!! (C) v_n : Name of variable to which the attribute is assigned.
+!!           This name is "?" for a global attribute.
+!! (C) a_n : Name of the concerned attribute.
+!!
+!! OUTPUT
+!!
+!! (L) l_ex : existence of the variable
+!!
+!! Optional OUTPUT arguments
+!!
+!! (I) a_t : external type of the attribute
+!! (I) a_l : number of values of the attribute
+!!--------------------------------------------------------------------
+!-
+INTERFACE fliogeta
+!!--------------------------------------------------------------------
+!! The "fliogeta" routines get a value for an attribute
+!! in a model file.
+!!
+!! SUBROUTINE fliogeta (f_i,v_n,a_n,a_v)
+!!
+!! INPUT
+!!
+!! (I) f_i  : Model file identifier
+!! (C) v_n  : Name of variable to which the attribute is assigned.
+!!            This name is "?" for a global attribute.
+!! (C) a_n  : Name of the attribute to be retrieved.
+!! ( ) a_v  : scalar or array of real (kind 4 or 8) or integer values,
+!!            or character string
+!!--------------------------------------------------------------------
+  MODULE PROCEDURE &
+ &  flioga_r4_0d,flioga_r4_1d,flioga_r8_0d,flioga_r8_1d, &
+ &  flioga_i4_0d,flioga_i4_1d,flioga_tx_0d
+END INTERFACE
+!-
+!!--------------------------------------------------------------------
+!! The "fliorenv" routine renames a variable, in a model file.
+!!
+!! SUBROUTINE fliorenv (f_i,v_o_n,v_n_n)
+!!
+!! INPUT
+!!
+!! (I) f_i    : Model file identifier
+!! (C) v_o_n  : Old name of the variable
+!! (C) v_n_n  : New name of the variable
+!!--------------------------------------------------------------------
+!-
+!!--------------------------------------------------------------------
+!! The "fliorena" routine renames an attribute
+!! of a variable, in a model file.
+!!
+!! SUBROUTINE fliorena (f_i,v_n,a_o_n,a_n_n)
+!!
+!! INPUT
+!!
+!! (I) f_i    : Model file identifier
+!! (C) v_n    : Name of variable to which the attribute is assigned.
+!!              This name is "?" for a global attribute.
+!! (C) a_o_n  : Old name of the concerned attribute.
+!! (C) a_n_n  : New name of the concerned attribute.
+!!--------------------------------------------------------------------
+!-
+!!--------------------------------------------------------------------
+!! The "fliodela" routine deletes an attribute in a model file.
+!!
+!! SUBROUTINE fliodela (f_i,v_n,a_n)
+!!
+!! INPUT
+!!
+!! (I) f_i  : Model file identifier
+!! (C) v_n  : Name of variable to which the attribute is assigned.
+!!            This name is "?" for a global attribute.
+!! (C) a_n  : Name of the concerned attribute.
+!!--------------------------------------------------------------------
+!-
+!!--------------------------------------------------------------------
+!! The "fliocpya" routine copies an attribute
+!! from one open model file to another.
+!! It can also be used to copy an attribute from
+!! one variable to another within the same model file.
+!!
+!! SUBROUTINE fliocpya (f_i_i,v_n_i,a_n,f_i_o,v_n_o)
+!!
+!! INPUT
+!!
+!! (I) f_i_i : Identifier of the input  model file
+!! (C) v_n_i : Name of the input variable
+!!             This name is "?" for a global attribute.
+!! (C) a_n   : Name of the concerned attribute.
+!! (I) f_i_o : Identifier of the output model file
+!!             It can be the same as the input identifier.
+!! (C) v_n_o : Name of the output variable
+!!             This name is "?" for a global attribute.
+!!--------------------------------------------------------------------
+!-
+!!--------------------------------------------------------------------
+!! The "flioqstc" routine search for a spatio-temporal coordinate
+!! in a model file and returns its name.
+!!
+!! SUBROUTINE flioqstc (f_i,c_type,l_ex,c_name)
+!!
+!! INPUT
+!!
+!! (I) f_i     : Model file identifier
+!! (C) c_type  : Type of the coordinate ("x"/"y"/"z"/"t")
+!!
+!! OUTPUT
+!!
+!! (L) l_ex    : existence of the coordinate
+!! (C) c_name  : name of the coordinate
+!!
+!!- NOTES
+!!
+!! The following rules are used for searching variables
+!! which are spatio-temporal coordinates (x/y/z/t).
+!!
+!!-- Rule 1 : we look for a variable with one dimension
+!!--          and which has the same name as its dimension
+!!
+!!-- Rule 2 : we look for a correct "axis" attribute
+!!
+!!  Axis       Axis attribute             Number of dimensions
+!!             (case insensitive)
+!!
+!!    x         X                         1/2
+!!    y         Y                         1/2
+!!    z         Z                         1
+!!    t         T                         1
+!!
+!!-- Rule 3 : we look for a correct "standard_name" attribute
+!!
+!!  Axis       Axis attribute          Number of dimensions
+!!             (case insensitive)
+!!
+!!    x         longitude              1/2
+!!    y         latitude               1/2
+!!    z         model_level_number     1
+!!    t         time                   1
+!!
+!!-- Rule 4 : we look for a specific name
+!!
+!!  Axis   Names
+!!
+!!    x    'nav_lon' 'lon'    'longitude'
+!!    y    'nav_lat' 'lat'    'latitude'
+!!    z    'depth'   'deptht' 'height'      'level'
+!!         'lev'     'plev'   'sigma_level' 'layer'
+!!    t    'time'    'tstep'  'timesteps'
+!!
+!!--------------------------------------------------------------------
+!-
+!!--------------------------------------------------------------------
+!! The "fliosync" routine synchronise one or all opened model files,
+!! to minimize data loss in case of abnormal termination.
+!!
+!! SUBROUTINE fliosync (f_i)
+!!
+!! Optional INPUT arguments
+!!
+!! (I) f_i  : Model file identifier
+!!            If this argument is not present,
+!!            all the opened model files are synchronised.
+!---------------------------------------------------------------------
+!-
+!!--------------------------------------------------------------------
+!! The "flioclo" routine closes one or all opened model files
+!! and frees the space needed to keep information about the files
+!!
+!! SUBROUTINE flioclo (f_i)
+!!
+!! Optional INPUT arguments
+!!
+!! (I) f_i  : Model file identifier
+!!            If this argument is not present,
+!!            all the opened model files are closed.
+!!--------------------------------------------------------------------
+!-
+!!--------------------------------------------------------------------
+!! The "fliodmpf" routine dumps a model file
+!! and prints the result on the standard output.
+!!
+!! SUBROUTINE fliodmpf (f_n)
+!!
+!! INPUT
+!!
+!! (C) f_n  : Name of the model file to be dumped
+!!--------------------------------------------------------------------
+!-
+!!--------------------------------------------------------------------
+!! This "flio_dom_set" sets up the domain activity of IOIPSL.
+!! It stores all the domain information and allows it to be stored
+!! in the model file and change the file names.
+!!
+!! This routine must be called by the user before opening
+!! the model file.
+!!
+!! SUBROUTINE flio_dom_set &
+!!  & (dtnb,dnb,did,dsg,dsl,dpf,dpl,dhs,dhe,cdnm,id_dom)
+!!
+!! INPUT
+!!
+!! (I) dtnb   : total number of domains
+!! (I) dnb    : domain number
+!! (I) did(:) : distributed dimensions identifiers
+!!              (up to 5 dimensions are supported)
+!! (I) dsg(:) : total number of points for each dimension
+!! (I) dsl(:) : local number of points for each dimension
+!! (I) dpf(:) : position of first local point for each dimension
+!! (I) dpl(:) : position of last local point for each dimension
+!! (I) dhs(:) : start halo size for each dimension
+!! (I) dhe(:) : end halo size for each dimension
+!! (C) cdnm   : Model domain definition name.
+!!              The names actually supported are :
+!!              "BOX", "APPLE", "ORANGE".
+!!              These names are case insensitive.
+!!
+!! OUTPUT argument
+!!
+!! (I) id_dom : Model domain identifier
+!!
+!!--------------------------------------------------------------------
+!!
+!!--------------------------------------------------------------------
+!! The "flio_dom_unset" routine unsets one or all set domains
+!! and frees the space needed to keep information about the domains
+!!
+!! This routine should be called by the user to free useless domains.
+!!
+!! SUBROUTINE flio_dom_unset (id_dom)
+!!
+!! Optional INPUT arguments
+!!
+!! (I) id_dom : Model domain identifier
+!!      >=1 & <= dom_max_nb : the domain is closed
+!!      not present         : all the set model domains are unset
+!!--------------------------------------------------------------------
+!!
+!!--------------------------------------------------------------------
+!! The "flio_dom_defset" sets
+!! the default domain identifier.
+!!
+!! SUBROUTINE flio_dom_defset (id_dom)
+!!
+!! INPUT argument
+!!
+!! (I) id_dom : Model default domain identifier
+!!     ( >=1 & <= dom_max_nb )
+!!     This identifier will be able to be taken by calling
+!!     "flio_dom_definq" and used to create model files
+!!     with the corresponding domain definitions
+!!--------------------------------------------------------------------
+!!
+!!--------------------------------------------------------------------
+!! The "flio_dom_defunset" routine unsets
+!! the default domain identifier.
+!!
+!! SUBROUTINE flio_dom_defunset ()
+!!
+!!--------------------------------------------------------------------
+!!
+!!--------------------------------------------------------------------
+!! The "flio_dom_definq" routine inquires about
+!! the default domain identifier.
+!! You should call this procedure to safeguard the current
+!! default domain identifier if you wish to use locally
+!! another default domain, in order to restore it.
+!!
+!! SUBROUTINE flio_dom_definq (id_dom)
+!!
+!! OUTPUT argument
+!!
+!! (I) id_dom : Model default domain identifier
+!!     IF no default domain identifier has been set,
+!!     the returned value is "FLIO_DOM_NONE".
+!!--------------------------------------------------------------------
+!-
+!---------------------------------------------------------------------
+! This is the data we keep concerning each file we open
+!---------------------------------------------------------------------
+!- For each file
+!- (I) nw_id(f_i)   : index to access at this file
+!- (I) nw_nd(f_i)   : number of dimensions
+!- (I) nw_nv(f_i)   : number of variables
+!- (I) nw_na(f_i)   : number of global attributes
+!- (I) nw_un(f_i)   : ID of the first unlimited dimension
+!- (L) lw_hm(f_i)   : for mode handling (.TRUE. define, .FALSE. data)
+!- (I) nw_di(:,f_i) : dimension IDs in the file "f_i"
+!- (I) nw_dl(:,f_i) : dimension lengths in the file "f_i"
+!- (I) nw_ai(:,f_i) : dimension Ids for the axis in the file "f_i"
+!---------------------------------------------------------------------
+  INTEGER,PARAMETER :: &
+ &  nb_fi_mx=flio_max_files, &
+ &  nb_fd_mx=flio_max_dims, &
+ &  nb_vd_mx=flio_max_var_dims
+  INTEGER,PARAMETER :: nb_ax_mx=4
+!-
+  INTEGER,PARAMETER :: k_lon=1, k_lat=2, k_lev=3, k_tim=4
+!-
+  INTEGER,DIMENSION(nb_fi_mx),SAVE :: &
+ &  nw_id=-1,nw_nd,nw_nv,nw_na,nw_un
+  LOGICAL,DIMENSION(nb_fi_mx),SAVE :: lw_hm
+  INTEGER,DIMENSION(nb_fd_mx,nb_fi_mx),SAVE :: nw_di=-1,nw_dl=-1
+  INTEGER,DIMENSION(nb_ax_mx,nb_fi_mx),SAVE :: nw_ai=-1
+!-
+! Maximum number of simultaneously defined domains
+  INTEGER,PARAMETER :: dom_max_nb=200
+!-
+! Maximum number of distributed dimensions for each domain
+  INTEGER,PARAMETER :: dom_max_dims=5
+!-
+! Default domain identifier
+  INTEGER,SAVE :: id_def_dom=FLIO_DOM_NONE
+!-
+! Supported domain definition names
+  INTEGER,PARAMETER :: n_dns=3, l_dns=7
+  CHARACTER(LEN=l_dns),DIMENSION(n_dns),SAVE :: &
+ &  c_dns=(/ "box    ","apple  ","orange "/)
+!-
+! DOMAINS related variables
+  INTEGER,DIMENSION(1:dom_max_nb),SAVE :: &
+ &  d_d_n=-1, d_n_t=0, d_n_c=0
+  INTEGER,DIMENSION(1:dom_max_dims,1:dom_max_nb),SAVE :: &
+ &  d_d_i, d_s_g, d_s_l, d_p_f, d_p_l, d_h_s, d_h_e
+  CHARACTER(LEN=l_dns),DIMENSION(1:dom_max_nb),SAVE :: c_d_t
+!-
+!===
+CONTAINS
+!===
+!-
+!---------------------------------------------------------------------
+!- Public procedures
+!---------------------------------------------------------------------
+!-
+!===
+SUBROUTINE fliocrfd (f_n,f_d_n,f_d_l,f_i,id_dom,mode,c_f_n)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(IN) :: f_n
+  CHARACTER(LEN=*),DIMENSION(:),INTENT(IN) :: f_d_n
+  INTEGER,DIMENSION(:),INTENT(IN) :: f_d_l
+  INTEGER,INTENT(OUT) :: f_i
+  INTEGER,OPTIONAL,INTENT(IN) :: id_dom
+  CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: mode
+  CHARACTER(LEN=*),OPTIONAL,INTENT(OUT) :: c_f_n
+!-
+  INTEGER :: i_rc,f_e,idid,ii,m_c,n_u
+  CHARACTER(LEN=NF90_MAX_NAME) :: f_nw
+  INTEGER,PARAMETER :: l_string=80,l_word=10
+  CHARACTER(LEN=l_string) :: c_string
+  CHARACTER(LEN=l_word)   :: c_word
+  LOGICAL :: l_ok
+  INTEGER,PARAMETER :: k_replace=1
+  INTEGER,PARAMETER :: k_32=1,k_64=2
+!- !? : Code to be activated for NETCDF4
+!?  INTEGER,PARAMETER :: k_netcdf4=1,k_classic=1
+  INTEGER,PARAMETER :: n_opt=4
+  INTEGER,DIMENSION(n_opt) :: i_opt
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "->fliocrfd - file name : ",TRIM(f_n)
+  ENDIF
+!-
+! Search for a free local identifier
+  f_i = flio_rid()
+  IF (f_i < 0) THEN
+    CALL ipslerr (3,'fliocrfd', &
+ &   'Too many files.','Please increase nb_fi_mx', &
+ &   'in module fliocom.f90.')
+  ENDIF
+!-
+! Update the name of the file
+  f_nw = f_n
+  CALL flio_dom_file (f_nw,id_dom)
+!-
+! Check the dimensions
+  IF (SIZE(f_d_l) /= SIZE(f_d_n)) THEN
+    CALL ipslerr (3,'fliocrfd', &
+ &   'The number of names is not equal to the number of lengths', &
+ &   'for the dimensions of the file',TRIM(f_nw))
+  ENDIF
+  IF (SIZE(f_d_l) > nb_fd_mx) THEN
+    CALL ipslerr (3,'fliocrfd', &
+ &   'Too many dimensions','to create the file',TRIM(f_nw))
+  ENDIF
+!-
+! Check the mode
+!-
+  i_opt(:)=-1
+!-
+  IF (PRESENT(mode)) THEN
+!---
+    IF (LEN_TRIM(mode) > l_string) THEN
+      CALL ipslerr (3,'fliocrfd', &
+ &     '"mode" argument','too long','to be treated')
+    ENDIF
+    c_string = mode(:)
+    CALL strlowercase (c_string)
+!---
+    DO
+      CALL str_xfw  (c_string,c_word,l_ok)
+      IF (l_ok) THEN
+!- !? : Code to be activated for NETCDF4
+        SELECT CASE (TRIM(c_word))
+        CASE('replace')
+          IF (i_opt(1) > 0) THEN
+            CALL ipslerr (3,'fliocrfd', &
+ &           'Replace option','already','defined')
+          ELSE
+            i_opt(1) = k_replace
+          ENDIF
+!?      CASE('netcdf4')
+!?        IF (i_opt(2) > 0) THEN
+!?          CALL ipslerr (3,'fliocrfd', &
+!? &         'Netcdf4 format','already','defined')
+!?        ELSE
+!?          i_opt(2) = k_netcdf4
+!?        ENDIF
+        CASE('32')
+          IF (i_opt(3) > 0) THEN
+            CALL ipslerr (3,'fliocrfd', &
+ &           'Offset format','already','defined')
+          ELSE
+            i_opt(3) = k_32
+          ENDIF
+        CASE('64')
+          IF (i_opt(3) > 0) THEN
+            CALL ipslerr (3,'fliocrfd', &
+ &           'Offset format','already','defined')
+          ELSE
+            i_opt(3) = k_64
+          ENDIF
+!?      CASE('CLASSIC')
+!?        IF (i_opt(4) > 0) THEN
+!?          CALL ipslerr (3,'fliocrfd', &
+!? &         'Netcdf4 classic format','already','defined')
+!?        ELSE
+!?          i_opt(4) = k_classic
+!?        ENDIF
+        CASE DEFAULT
+          CALL ipslerr (3,'fliocrfd', &
+ &         'Option '//TRIM(c_word),'not','supported')
+        END SELECT
+      ELSE
+        EXIT
+      ENDIF
+    ENDDO
+  ENDIF
+!-
+  IF (i_opt(1) == k_replace) THEN
+    m_c = NF90_CLOBBER
+  ELSE
+    m_c = NF90_NOCLOBBER
+  ENDIF
+!-
+!- Code to be replaced by the following for NETCDF4
+!?  IF (i_opt(2) == k_netcdf4) THEN
+!?    m_c = IOR(m_c,NF90_NETCDF4)
+!?    IF (i_opt(3) > 0) THEN
+!?      CALL ipslerr (3,'fliocrfd', &
+!? &     'Netcdf4 format','and offset option','are not compatible')
+!?    ELSE IF (i_opt(4) == k_classic) THEN
+!?      m_c = IOR(m_c,NF90_CLASSIC_MODEL)
+!?    ENDIF
+!?   LSE IF (i_opt(4) > 0) THEN
+!?    CALL ipslerr (3,'fliocrfd', &
+!? &   'Classic option','is reserved','for the Netcdf4 format')
+!?  ELSE
+    IF (i_opt(3) /= k_32) THEN
+      m_c = IOR(m_c,NF90_64BIT_OFFSET)
+    ENDIF
+!?  ENDIF
+!-
+! Create file (and enter the definition mode)
+  i_rc = NF90_CREATE(f_nw,m_c,f_e)
+  lw_hm(f_i) = .TRUE.
+  IF (i_rc /= NF90_NOERR) THEN
+    CALL ipslerr (3,'fliocrfd', &
+ &   'Could not create file :',TRIM(f_nw), &
+ &   TRIM(NF90_STRERROR(i_rc))//' (Netcdf)')
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) '  fliocrfd, external model file-id : ',f_e
+  ENDIF
+!-
+! Create dimensions
+  n_u = 0
+  DO ii=1,SIZE(f_d_l)
+    IF (f_d_l(ii) == -1) THEN
+      IF (n_u == 0) THEN
+        i_rc = NF90_DEF_DIM(f_e,TRIM(f_d_n(ii)),NF90_UNLIMITED,idid)
+        n_u = n_u+1
+      ELSE
+        CALL ipslerr (3,'fliocrfd', &
+ &       'Can not handle more than one unlimited dimension', &
+ &       'for file :',TRIM(f_nw))
+      ENDIF
+    ELSE IF (f_d_l(ii) > 0) THEN
+      i_rc = NF90_DEF_DIM(f_e,TRIM(f_d_n(ii)),f_d_l(ii),idid)
+    ENDIF
+    IF ( ((f_d_l(ii) == -1).OR.(f_d_l(ii) > 0)) &
+ &      .AND.(i_rc /= NF90_NOERR) ) THEN
+      CALL ipslerr (3,'fliocrfd', &
+ &     'One dimension can not be defined', &
+ &     'for the file :',TRIM(f_nw))
+    ENDIF
+  ENDDO
+!-
+! Define "Conventions" global attribute
+  i_rc = NF90_PUT_ATT(f_e,NF90_GLOBAL,'Conventions',"CF-1.1")
+!-
+! Add the DOMAIN attributes if needed
+  CALL flio_dom_att (f_e,id_dom)
+!-
+! Keep the file information
+  nw_id(f_i) = f_e
+  CALL flio_inf (f_e, &
+ &  nb_dims=nw_nd(f_i),id_unlm=nw_un(f_i),nb_atts=nw_na(f_i), &
+ &  nn_idm=nw_di(:,f_i),nn_ldm=nw_dl(:,f_i),nn_aid=nw_ai(:,f_i))
+!-
+! Return the created file name if needed
+  IF (PRESENT(c_f_n)) THEN
+    IF (LEN(c_f_n) >= LEN_TRIM(f_nw)) THEN
+      c_f_n = TRIM(f_nw)
+    ELSE
+      CALL ipslerr (3,'fliocrfd', &
+ &     'the length of "c_f_n" is not sufficient to receive', &
+ &     'the name of the created file :',TRIM(f_nw))
+    ENDIF
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) '<-fliocrfd'
+  ENDIF
+!----------------------
+END SUBROUTINE fliocrfd
+!===
+SUBROUTINE fliopstc &
+ & (f_i,x_axis,x_axis_2d,y_axis,y_axis_2d,z_axis, &
+ &      t_axis,t_init,t_step,t_calendar)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  REAL,DIMENSION(:),OPTIONAL,INTENT(IN)    :: x_axis,y_axis
+  REAL,DIMENSION(:,:),OPTIONAL,INTENT(IN)  :: x_axis_2d,y_axis_2d
+  REAL,DIMENSION(:),OPTIONAL,INTENT(IN)    :: z_axis
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: t_axis
+  CHARACTER(LEN=*),OPTIONAL,INTENT(IN)     :: t_calendar
+  REAL,OPTIONAL,INTENT(IN)                 :: t_init,t_step
+!-
+  INTEGER :: i_rc,f_e
+  INTEGER :: lonid,latid,levid,timeid
+  INTEGER :: j_yy,j_mo,j_dd,j_hh,j_mn,j_ss
+  REAL    :: dt,r_ss,v_min,v_max
+  INTEGER :: k,k_1,k_2
+  LOGICAL :: l_tmp
+  CHARACTER(LEN=20) :: c_tmp1
+  CHARACTER(LEN=40) :: c_tmp2
+  CHARACTER(LEN=80) :: c_tmp3
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "->fliopstc"
+  ENDIF
+!-
+! Retrieve the external file index
+  CALL flio_qvid ('fliopstc',f_i,f_e)
+!-
+! Validate the coherence of the arguments
+!-
+  IF (    (PRESENT(x_axis).AND.PRESENT(x_axis_2d)) &
+ &    .OR.(PRESENT(y_axis).AND.PRESENT(y_axis_2d)) ) THEN
+    CALL ipslerr (3,'fliopstc', &
+ &    'The [x/y]_axis arguments', &
+ &    'are not coherent :',&
+ &    'can not handle two [x/y]_axis')
+  ENDIF
+!-
+  IF (    PRESENT(x_axis).OR.PRESENT(x_axis_2d) &
+ &    .OR.PRESENT(y_axis).OR.PRESENT(y_axis_2d) ) THEN
+    k_1=nw_ai(k_lon,f_i); k_2=nw_ai(k_lat,f_i);
+  ENDIF
+!-
+! Define the longitude axis
+!-
+  IF (PRESENT(x_axis).OR.PRESENT(x_axis_2d)) THEN
+!---
+    IF (l_dbg) THEN
+      WRITE(*,*) '  fliopstc : Define the Longitude axis'
+    ENDIF
+!---
+    IF (PRESENT(x_axis)) THEN
+      IF (SIZE(x_axis) /= nw_dl(k_1,f_i)) THEN
+        CALL ipslerr (3,'fliopstc', &
+ &       'Invalid x_axis dimension :', &
+ &       'not equal to the dimension', &
+ &       'defined at the creation of the file')
+      ENDIF
+    ELSE
+      IF (    (SIZE(x_axis_2d,DIM=1) /= nw_dl(k_1,f_i)) &
+ &        .OR.(SIZE(x_axis_2d,DIM=2) /= nw_dl(k_2,f_i)) ) THEN
+        CALL ipslerr (3,'fliopstc', &
+ &       'Invalid x_axis_2d dimensions :', &
+ &       'not equal to the dimensions', &
+ &       'defined at the creation of the file')
+      ENDIF
+    ENDIF
+!---
+    CALL flio_hdm (f_i,f_e,.TRUE.)
+    IF (PRESENT(x_axis)) THEN
+      i_rc = NF90_DEF_VAR(f_e,"lon",NF90_REAL4, &
+ &                        nw_di(k_1,f_i),lonid)
+      v_min = MINVAL(x_axis)
+      v_max = MAXVAL(x_axis)
+    ELSE
+      i_rc = NF90_DEF_VAR(f_e,"nav_lon",NF90_REAL4, &
+ &             nw_di((/k_1,k_2/),f_i),lonid)
+      v_min = MINVAL(x_axis_2d)
+      v_max = MAXVAL(x_axis_2d)
+    ENDIF
+    i_rc = NF90_PUT_ATT(f_e,lonid,"axis","X")
+    i_rc = NF90_PUT_ATT(f_e,lonid,'standard_name',"longitude")
+    i_rc = NF90_PUT_ATT(f_e,lonid,'units',"degrees_east")
+    i_rc = NF90_PUT_ATT(f_e,lonid,'valid_min',REAL(v_min,KIND=4))
+    i_rc = NF90_PUT_ATT(f_e,lonid,'valid_max',REAL(v_max,KIND=4))
+  ENDIF
+!-
+! Define the Latitude axis
+!-
+  IF (PRESENT(y_axis).OR.PRESENT(y_axis_2d)) THEN
+!---
+    IF (l_dbg) THEN
+      WRITE(*,*) '  fliopstc : Define the Latitude axis'
+    ENDIF
+!---
+    IF (PRESENT(y_axis)) THEN
+      IF (SIZE(y_axis) /= nw_dl(k_2,f_i)) THEN
+        CALL ipslerr (3,'fliopstc', &
+ &       'Invalid y_axis dimension :', &
+ &       'not equal to the dimension', &
+ &       'defined at the creation of the file')
+      ENDIF
+    ELSE
+      IF (    (SIZE(y_axis_2d,DIM=1) /= nw_dl(k_1,f_i)) &
+ &        .OR.(SIZE(y_axis_2d,DIM=2) /= nw_dl(k_2,f_i)) ) THEN
+        CALL ipslerr (3,'fliopstc', &
+ &       'Invalid y_axis_2d dimensions :', &
+ &       'not equal to the dimensions', &
+ &       'defined at the creation of the file')
+      ENDIF
+    ENDIF
+!---
+    CALL flio_hdm (f_i,f_e,.TRUE.)
+    IF (PRESENT(y_axis)) THEN
+      i_rc = NF90_DEF_VAR(f_e,"lat",NF90_REAL4, &
+ &                        nw_di(k_2,f_i),latid)
+      v_min = MINVAL(y_axis)
+      v_max = MAXVAL(y_axis)
+    ELSE
+      i_rc = NF90_DEF_VAR(f_e,"nav_lat",NF90_REAL4, &
+ &             nw_di((/k_1,k_2/),f_i),latid)
+      v_min = MINVAL(y_axis_2d)
+      v_max = MAXVAL(y_axis_2d)
+    ENDIF
+    i_rc = NF90_PUT_ATT(f_e,latid,"axis","Y")
+    i_rc = NF90_PUT_ATT(f_e,latid,'standard_name',"latitude")
+    i_rc = NF90_PUT_ATT(f_e,latid,'units',"degrees_north")
+    i_rc = NF90_PUT_ATT(f_e,latid,'valid_min',REAL(v_min,KIND=4))
+    i_rc = NF90_PUT_ATT(f_e,latid,'valid_max',REAL(v_max,KIND=4))
+  ENDIF
+!-
+! Define the Vertical axis
+!-
+  IF (PRESENT(z_axis)) THEN
+!---
+    IF (l_dbg) THEN
+      WRITE(*,*) '  fliopstc : Define the Vertical axis'
+    ENDIF
+!---
+    k_1=nw_ai(k_lev,f_i);
+!---
+    IF (SIZE(z_axis) /= nw_dl(k_1,f_i)) THEN
+      CALL ipslerr (3,'fliopstc', &
+ &     'Invalid z_axis dimension :', &
+ &     'not equal to the dimension', &
+ &     'defined at the creation of the file')
+    ENDIF
+!---
+    v_min = MINVAL(z_axis)
+    v_max = MAXVAL(z_axis)
+!---
+    CALL flio_hdm (f_i,f_e,.TRUE.)
+    i_rc = NF90_DEF_VAR(f_e,'lev',NF90_REAL4, &
+ &                      nw_di(k_1,f_i),levid)
+    i_rc = NF90_PUT_ATT(f_e,levid,"axis","Z")
+    i_rc = NF90_PUT_ATT(f_e,levid,'standard_name','model_level_number')
+    i_rc = NF90_PUT_ATT(f_e,levid,'units','sigma_level')
+    i_rc = NF90_PUT_ATT(f_e,levid,'long_name','Sigma Levels')
+    i_rc = NF90_PUT_ATT(f_e,levid,'valid_min',REAL(v_min,KIND=4))
+    i_rc = NF90_PUT_ATT(f_e,levid,'valid_max',REAL(v_max,KIND=4))
+  ENDIF
+!-
+! Define the Time axis
+!-
+  IF (PRESENT(t_axis).AND.PRESENT(t_init).AND.PRESENT(t_step)) THEN
+!---
+    IF (l_dbg) THEN
+      WRITE(*,*) '  fliopstc : Define the Time axis'
+    ENDIF
+!---
+    k_1=nw_ai(k_tim,f_i);
+!---
+    IF (     (nw_dl(k_1,f_i) /= 0) &
+ &      .AND.(SIZE(t_axis) /= nw_dl(k_1,f_i)) ) THEN
+      CALL ipslerr (3,'fliopstc', &
+ &     'Invalid t_axis dimension :', &
+ &     'not equal to the dimension', &
+ &     'defined at the creation of the file')
+    ENDIF
+!-- Retrieve the calendar date
+    CALL lock_calendar (old_status=l_tmp)
+    IF (PRESENT(t_calendar)) THEN
+      CALL ioget_calendar (c_tmp1)
+      CALL lock_calendar (new_status=.FALSE.)
+      CALL ioconf_calendar (TRIM(t_calendar))
+    ENDIF
+    CALL ju2ymds (t_init,j_yy,j_mo,j_dd,r_ss)
+    IF (PRESENT(t_calendar)) THEN
+      CALL lock_calendar (new_status=.FALSE.)
+      CALL ioconf_calendar (TRIM(c_tmp1))
+    ENDIF
+    CALL lock_calendar (new_status=l_tmp)
+!--
+    k=NINT(r_ss)
+    j_hh=k/3600
+    k=k-3600*j_hh
+    j_mn=k/60
+    j_ss=k-60*j_mn
+!-- Calculate the step unit
+    IF      (ABS(t_step) >= 604800.) THEN
+      dt = t_step/604800.
+      c_tmp2 = 'weeks'
+    ELSE IF (ABS(t_step) >= 86400.) THEN
+      dt = t_step/86400.
+      c_tmp2 = 'days'
+    ELSE IF (ABS(t_step) >=  3600.) THEN
+      dt = t_step/3600.
+      c_tmp2 = 'hours'
+    ELSE IF (ABS(t_step) >=    60.) THEN
+      dt = t_step/60.
+      c_tmp2 = 'minutes'
+    ELSE
+      dt = t_step
+      c_tmp2 = 'seconds'
+    ENDIF
+!---
+    c_tmp1 = ''
+    IF (ABS(dt-NINT(dt)) <= ABS(10.*EPSILON(dt))) THEN
+      IF (NINT(dt) /= 1) THEN
+        WRITE (UNIT=c_tmp1,FMT='(I15)') NINT(dt)
+      ENDIF
+    ELSE
+      IF (dt < 1.) THEN
+       WRITE (UNIT=c_tmp1,FMT='(F8.5)') dt
+      ELSE
+       WRITE (UNIT=c_tmp1,FMT='(F17.5)') dt
+      ENDIF
+      DO k=LEN_TRIM(c_tmp1),1,-1
+        IF (c_tmp1(k:k) /= '0') THEN
+          EXIT
+        ELSE
+          c_tmp1(k:k) = ' '
+        ENDIF
+      ENDDO
+    ENDIF
+    c_tmp2 = TRIM(c_tmp1)//' '//TRIM(c_tmp2)
+    WRITE (UNIT=c_tmp3, &
+ &   FMT='(A,I4.4,"-",I2.2,"-",I2.2," ",I2.2,":",I2.2,":",I2.2)') &
+ &    TRIM(ADJUSTL(c_tmp2))//' since ',j_yy,j_mo,j_dd,j_hh,j_mn,j_ss
+!---
+    CALL flio_hdm (f_i,f_e,.TRUE.)
+    i_rc = NF90_DEF_VAR(f_e,'time',NF90_REAL4, &
+ &                      nw_di(k_1,f_i),timeid)
+    i_rc = NF90_PUT_ATT(f_e,timeid,"axis",'T')
+    i_rc = NF90_PUT_ATT(f_e,timeid,'standard_name','time')
+    i_rc = NF90_PUT_ATT(f_e,timeid,'long_name','time steps')
+    IF (PRESENT(t_calendar)) THEN
+      i_rc = NF90_PUT_ATT(f_e,timeid,'calendar',TRIM(t_calendar))
+    ENDIF
+    i_rc = NF90_PUT_ATT(f_e,timeid,'units',TRIM(c_tmp3))
+  ELSE IF (PRESENT(t_axis).OR.PRESENT(t_init).OR.PRESENT(t_step)) THEN
+    CALL ipslerr (3,'fliopstc', &
+ &   'For time axis and coordinates', &
+ &   'arguments t_axis AND t_init AND t_step', &
+ &   'must be PRESENT')
+  ENDIF
+!-
+! Ensuring data mode
+!-
+  CALL flio_hdm (f_i,f_e,.FALSE.)
+!-
+! Create the longitude axis
+!-
+  IF (PRESENT(x_axis).OR.PRESENT(x_axis_2d)) THEN
+    IF (l_dbg) THEN
+      WRITE(*,*) '  fliopstc : Create the Longitude axis'
+    ENDIF
+    IF (PRESENT(x_axis)) THEN
+      i_rc = NF90_PUT_VAR(f_e,lonid,x_axis(:))
+    ELSE
+      i_rc = NF90_PUT_VAR(f_e,lonid,x_axis_2d(:,:))
+    ENDIF
+  ENDIF
+!-
+! Create the Latitude axis
+!-
+  IF (PRESENT(y_axis).OR.PRESENT(y_axis_2d)) THEN
+    IF (l_dbg) THEN
+      WRITE(*,*) '  fliopstc : Create the Latitude axis'
+    ENDIF
+    IF (PRESENT(y_axis)) THEN
+      i_rc = NF90_PUT_VAR(f_e,latid,y_axis(:))
+    ELSE
+      i_rc = NF90_PUT_VAR(f_e,latid,y_axis_2d(:,:))
+    ENDIF
+  ENDIF
+!-
+! Create the Vertical axis
+!-
+  IF (PRESENT(z_axis)) THEN
+    IF (l_dbg) THEN
+      WRITE(*,*) '  fliopstc : Create the Vertical axis'
+    ENDIF
+    i_rc = NF90_PUT_VAR(f_e,levid,z_axis(:))
+  ENDIF
+!-
+! Create the Time axis
+!-
+  IF (PRESENT(t_axis)) THEN
+    IF (l_dbg) THEN
+      WRITE(*,*) '  fliopstc : Create the Time axis'
+    ENDIF
+    i_rc = NF90_PUT_VAR(f_e,timeid,REAL(t_axis(:)))
+  ENDIF
+!-
+! Keep all this information
+!-
+  CALL flio_inf (f_e,nb_vars=nw_nv(f_i),nb_atts=nw_na(f_i))
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-fliopstc"
+  ENDIF
+!----------------------
+END SUBROUTINE fliopstc
+!===
+SUBROUTINE fliodv_r0d &
+ & (f_i,v_n,v_t, &
+ &  axis,standard_name,long_name,units,valid_min,valid_max,fillvalue)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER,OPTIONAL,INTENT(IN) :: v_t
+  CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: &
+ & axis,standard_name,long_name,units
+  REAL,OPTIONAL,INTENT(IN) :: valid_min,valid_max,fillvalue
+!---------------------------------------------------------------------
+  CALL flio_udv &
+ &  (f_i,0,v_n,(/0/),v_t, &
+ &   axis,standard_name,long_name,units,valid_min,valid_max,fillvalue)
+!------------------------
+END SUBROUTINE fliodv_r0d
+!===
+SUBROUTINE fliodv_rnd &
+ & (f_i,v_n,v_d,v_t, &
+ &  axis,standard_name,long_name,units,valid_min,valid_max,fillvalue)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER,DIMENSION(:),INTENT(IN) :: v_d
+  INTEGER,OPTIONAL,INTENT(IN) :: v_t
+  CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: &
+ & axis,standard_name,long_name,units
+  REAL,OPTIONAL,INTENT(IN) :: valid_min,valid_max,fillvalue
+!---------------------------------------------------------------------
+  CALL flio_udv &
+ &  (f_i,SIZE(v_d),v_n,v_d,v_t, &
+ &   axis,standard_name,long_name,units,valid_min,valid_max,fillvalue)
+!------------------------
+END SUBROUTINE fliodv_rnd
+!===
+SUBROUTINE flio_udv &
+ & (f_i,n_d,v_n,v_d,v_t, &
+ &  axis,standard_name,long_name,units,valid_min,valid_max,fillvalue)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i,n_d
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER,DIMENSION(:),INTENT(IN) :: v_d
+  INTEGER,OPTIONAL,INTENT(IN) :: v_t
+  CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: &
+ & axis,standard_name,long_name,units
+  REAL,OPTIONAL,INTENT(IN) :: valid_min,valid_max,fillvalue
+!-
+  INTEGER :: f_e,m_k,i_v,i_rc,ii,idd
+  INTEGER,DIMENSION(nb_vd_mx) :: a_i
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "->fliodefv ",TRIM(v_n)," ",n_d,"D"
+  ENDIF
+!-
+! Retrieve the external file index
+  CALL flio_qvid ('fliodefv',f_i,f_e)
+!-
+  IF (n_d > 0) THEN
+    IF (n_d > nb_vd_mx) THEN
+      CALL ipslerr (3,'fliodefv', &
+ &     'Too many dimensions', &
+ &     'required for the variable',TRIM(v_n))
+    ENDIF
+  ENDIF
+!-
+  DO ii=1,n_d
+    IF ( (v_d(ii) >= 1).AND.(v_d(ii) <= nb_fd_mx) ) THEN
+      idd = nw_di(v_d(ii),f_i)
+      IF (idd > 0) THEN
+        a_i(ii) = idd
+      ELSE
+        CALL ipslerr (3,'fliodefv', &
+ &       'Invalid dimension identifier','(not defined)',' ')
+      ENDIF
+    ELSE
+      CALL ipslerr (3,'fliodefv', &
+ &     'Invalid dimension identifier','(not supported)',' ')
+    ENDIF
+  ENDDO
+!-
+  i_rc = NF90_INQ_VARID(f_e,v_n,i_v)
+  IF (i_rc /= NF90_NOERR) THEN
+    CALL flio_hdm (f_i,f_e,.TRUE.)
+!---
+    IF (PRESENT(v_t)) THEN
+      SELECT CASE (v_t)
+      CASE(flio_i)
+        IF (i_std == i_8) THEN
+!-------- I8 not yet supported by NETCDF
+!-------- m_k = flio_i8
+          m_k = flio_i4
+        ELSE
+          m_k = flio_i4
+        ENDIF
+      CASE(flio_r)
+        IF (r_std == r_8) THEN
+          m_k = flio_r8
+        ELSE
+          m_k = flio_r4
+        ENDIF
+      CASE(flio_c,flio_i1,flio_i2,flio_i4,flio_r4,flio_r8)
+        m_k = v_t
+      CASE DEFAULT
+        CALL ipslerr (3,'fliodefv', &
+ &        'Variable '//TRIM(v_n),'External type','not supported')
+      END SELECT
+    ELSE IF (r_std == r_8) THEN
+      m_k = flio_r8
+    ELSE
+      m_k = flio_r4
+    ENDIF
+!---
+    IF (n_d > 0) THEN
+      i_rc = NF90_DEF_VAR(f_e,v_n,m_k,a_i(1:n_d),i_v)
+    ELSE
+      i_rc = NF90_DEF_VAR(f_e,v_n,m_k,i_v)
+    ENDIF
+    IF (i_rc /= NF90_NOERR) THEN
+      CALL ipslerr (3,'fliodefv', &
+ &      'Variable '//TRIM(v_n)//' not defined','Error :', &
+ &      TRIM(NF90_STRERROR(i_rc)))
+    ENDIF
+    nw_nv(f_i) = nw_nv(f_i)+1
+!---
+    IF (PRESENT(axis)) THEN
+      i_rc = NF90_PUT_ATT(f_e,i_v,'axis',TRIM(axis))
+    ENDIF
+    IF (PRESENT(standard_name)) THEN
+      i_rc = NF90_PUT_ATT(f_e,i_v,'standard_name',TRIM(standard_name))
+    ENDIF
+    IF (PRESENT(long_name)) THEN
+      i_rc = NF90_PUT_ATT(f_e,i_v,'long_name',TRIM(long_name))
+    ENDIF
+    IF (PRESENT(units)) THEN
+      i_rc = NF90_PUT_ATT(f_e,i_v,'units',TRIM(units))
+    ENDIF
+    IF (PRESENT(valid_min)) THEN
+      SELECT CASE (m_k)
+      CASE(flio_i1,flio_i2)
+        i_rc = NF90_PUT_ATT(f_e,i_v,'valid_min',NINT(valid_min,KIND=i_2))
+      CASE(flio_i4)
+        i_rc = NF90_PUT_ATT(f_e,i_v,'valid_min',NINT(valid_min,KIND=i_4))
+      CASE(flio_r4)
+        i_rc = NF90_PUT_ATT(f_e,i_v,'valid_min',REAL(valid_min,KIND=r_4))
+      CASE(flio_r8)
+        i_rc = NF90_PUT_ATT(f_e,i_v,'valid_min',REAL(valid_min,KIND=r_8))
+      CASE DEFAULT
+        CALL ipslerr (2,'fliodefv', &
+   &      'Variable '//TRIM(v_n),'attribute valid_min', &
+   &      'not supported for this external type')
+      END SELECT
+    ENDIF
+    IF (PRESENT(valid_max)) THEN
+      SELECT CASE (m_k)
+      CASE(flio_i1,flio_i2)
+        i_rc = NF90_PUT_ATT(f_e,i_v,'valid_max',NINT(valid_max,KIND=i_2))
+      CASE(flio_i4)
+        i_rc = NF90_PUT_ATT(f_e,i_v,'valid_max',NINT(valid_max,KIND=i_4))
+      CASE(flio_r4)
+        i_rc = NF90_PUT_ATT(f_e,i_v,'valid_max',REAL(valid_max,KIND=r_4))
+      CASE(flio_r8)
+        i_rc = NF90_PUT_ATT(f_e,i_v,'valid_max',REAL(valid_max,KIND=r_8))
+      CASE DEFAULT
+        CALL ipslerr (2,'fliodefv', &
+   &      'Variable '//TRIM(v_n),'attribute valid_max', &
+   &      'not supported for this external type')
+      END SELECT
+    ENDIF
+    IF (PRESENT(fillvalue)) THEN
+      SELECT CASE (m_k)
+      CASE(flio_i1,flio_i2)
+        i_rc = NF90_PUT_ATT(f_e,i_v,'_FillValue',NINT(fillvalue,KIND=i_2))
+      CASE(flio_i4)
+        i_rc = NF90_PUT_ATT(f_e,i_v,'_FillValue',NINT(fillvalue,KIND=i_4))
+      CASE(flio_r4)
+        i_rc = NF90_PUT_ATT(f_e,i_v,'_FillValue',REAL(fillvalue,KIND=r_4))
+      CASE(flio_r8)
+        i_rc = NF90_PUT_ATT(f_e,i_v,'_FillValue',REAL(fillvalue,KIND=r_8))
+      CASE DEFAULT
+        CALL ipslerr (2,'fliodefv', &
+   &      'Variable '//TRIM(v_n),'attribute fillvalue', &
+   &      'not supported for this external type')
+      END SELECT
+    ENDIF
+!---
+  ELSE
+    CALL ipslerr (3,'fliodefv','Variable',TRIM(v_n),'already exist')
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-fliodefv"
+  ENDIF
+!----------------------
+END SUBROUTINE flio_udv
+!===
+SUBROUTINE fliopv_i40 (f_i,v_n,v_v,start)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_4),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,i_40=v_v,start=start)
+!------------------------
+END SUBROUTINE fliopv_i40
+!===
+SUBROUTINE fliopv_i41 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_4),DIMENSION(:),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,i_41=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliopv_i41
+!===
+SUBROUTINE fliopv_i42 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_4),DIMENSION(:,:),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,i_42=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliopv_i42
+!===
+SUBROUTINE fliopv_i43 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_4),DIMENSION(:,:,:),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,i_43=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliopv_i43
+!===
+SUBROUTINE fliopv_i44 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_4),DIMENSION(:,:,:,:),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,i_44=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliopv_i44
+!===
+SUBROUTINE fliopv_i45 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_4),DIMENSION(:,:,:,:,:),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,i_45=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliopv_i45
+!===
+SUBROUTINE fliopv_i20 (f_i,v_n,v_v,start)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_2),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,i_20=v_v,start=start)
+!------------------------
+END SUBROUTINE fliopv_i20
+!===
+SUBROUTINE fliopv_i21 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_2),DIMENSION(:),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,i_21=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliopv_i21
+!===
+SUBROUTINE fliopv_i22 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_2),DIMENSION(:,:),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,i_22=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliopv_i22
+!===
+SUBROUTINE fliopv_i23 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_2),DIMENSION(:,:,:),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,i_23=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliopv_i23
+!===
+SUBROUTINE fliopv_i24 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_2),DIMENSION(:,:,:,:),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,i_24=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliopv_i24
+!===
+SUBROUTINE fliopv_i25 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_2),DIMENSION(:,:,:,:,:),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,i_25=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliopv_i25
+!===
+!?INTEGERS of KIND 1 are not supported on all computers
+!?SUBROUTINE fliopv_i10 (f_i,v_n,v_v,start)
+!?!---------------------------------------------------------------------
+!?  IMPLICIT NONE
+!?!-
+!?  INTEGER,INTENT(IN) :: f_i
+!?  CHARACTER(LEN=*),INTENT(IN) :: v_n
+!?  INTEGER(KIND=i_1),INTENT(IN) :: v_v
+!?  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start
+!?!---------------------------------------------------------------------
+!?  CALL flio_upv (f_i,v_n,i_10=v_v,start=start)
+!?!------------------------
+!?END SUBROUTINE fliopv_i10
+!?!===
+!?SUBROUTINE fliopv_i11 (f_i,v_n,v_v,start,count)
+!?!---------------------------------------------------------------------
+!?  IMPLICIT NONE
+!?!-
+!?  INTEGER,INTENT(IN) :: f_i
+!?  CHARACTER(LEN=*),INTENT(IN) :: v_n
+!?  INTEGER(KIND=i_1),DIMENSION(:),INTENT(IN) :: v_v
+!?  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!?!---------------------------------------------------------------------
+!?  CALL flio_upv (f_i,v_n,i_11=v_v,start=start,count=count)
+!?!------------------------
+!?END SUBROUTINE fliopv_i11
+!?!===
+!?SUBROUTINE fliopv_i12 (f_i,v_n,v_v,start,count)
+!?!---------------------------------------------------------------------
+!?  IMPLICIT NONE
+!?!-
+!?  INTEGER,INTENT(IN) :: f_i
+!?  CHARACTER(LEN=*),INTENT(IN) :: v_n
+!?  INTEGER(KIND=i_1),DIMENSION(:,:),INTENT(IN) :: v_v
+!?  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!?!---------------------------------------------------------------------
+!?  CALL flio_upv (f_i,v_n,i_12=v_v,start=start,count=count)
+!?!------------------------
+!?END SUBROUTINE fliopv_i12
+!?!===
+!?SUBROUTINE fliopv_i13 (f_i,v_n,v_v,start,count)
+!?!---------------------------------------------------------------------
+!?  IMPLICIT NONE
+!?!-
+!?  INTEGER,INTENT(IN) :: f_i
+!?  CHARACTER(LEN=*),INTENT(IN) :: v_n
+!?  INTEGER(KIND=i_1),DIMENSION(:,:,:),INTENT(IN) :: v_v
+!?  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!?!---------------------------------------------------------------------
+!?  CALL flio_upv (f_i,v_n,i_13=v_v,start=start,count=count)
+!?!------------------------
+!?END SUBROUTINE fliopv_i13
+!?!===
+!?SUBROUTINE fliopv_i14 (f_i,v_n,v_v,start,count)
+!?!---------------------------------------------------------------------
+!?  IMPLICIT NONE
+!?!-
+!?  INTEGER,INTENT(IN) :: f_i
+!?  CHARACTER(LEN=*),INTENT(IN) :: v_n
+!?  INTEGER(KIND=i_1),DIMENSION(:,:,:,:),INTENT(IN) :: v_v
+!?  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!?!---------------------------------------------------------------------
+!?  CALL flio_upv (f_i,v_n,i_14=v_v,start=start,count=count)
+!?!------------------------
+!?END SUBROUTINE fliopv_i14
+!?!===
+!?SUBROUTINE fliopv_i15 (f_i,v_n,v_v,start,count)
+!?!---------------------------------------------------------------------
+!?  IMPLICIT NONE
+!?!-
+!?  INTEGER,INTENT(IN) :: f_i
+!?  CHARACTER(LEN=*),INTENT(IN) :: v_n
+!?  INTEGER(KIND=i_1),DIMENSION(:,:,:,:,:),INTENT(IN) :: v_v
+!?  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!?!---------------------------------------------------------------------
+!?  CALL flio_upv (f_i,v_n,i_15=v_v,start=start,count=count)
+!?!------------------------
+!?END SUBROUTINE fliopv_i15
+!===
+SUBROUTINE fliopv_r40 (f_i,v_n,v_v,start)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_4),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,r_40=v_v,start=start)
+!------------------------
+END SUBROUTINE fliopv_r40
+!===
+SUBROUTINE fliopv_r41 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_4),DIMENSION(:),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,r_41=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliopv_r41
+!===
+SUBROUTINE fliopv_r42 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_4),DIMENSION(:,:),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,r_42=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliopv_r42
+!===
+SUBROUTINE fliopv_r43 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_4),DIMENSION(:,:,:),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,r_43=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliopv_r43
+!===
+SUBROUTINE fliopv_r44 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_4),DIMENSION(:,:,:,:),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,r_44=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliopv_r44
+!===
+SUBROUTINE fliopv_r45 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_4),DIMENSION(:,:,:,:,:),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,r_45=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliopv_r45
+!===
+SUBROUTINE fliopv_r80 (f_i,v_n,v_v,start)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_8),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,r_80=v_v,start=start)
+!------------------------
+END SUBROUTINE fliopv_r80
+!===
+SUBROUTINE fliopv_r81 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_8),DIMENSION(:),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,r_81=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliopv_r81
+!===
+SUBROUTINE fliopv_r82 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_8),DIMENSION(:,:),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,r_82=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliopv_r82
+!===
+SUBROUTINE fliopv_r83 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_8),DIMENSION(:,:,:),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,r_83=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliopv_r83
+!===
+SUBROUTINE fliopv_r84 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_8),DIMENSION(:,:,:,:),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,r_84=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliopv_r84
+!===
+SUBROUTINE fliopv_r85 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_8),DIMENSION(:,:,:,:,:),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,r_85=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliopv_r85
+!===
+SUBROUTINE flio_upv &
+ & (f_i,v_n, &
+ &  i_40,i_41,i_42,i_43,i_44,i_45, &
+ &  i_20,i_21,i_22,i_23,i_24,i_25, &
+!? &  i_10,i_11,i_12,i_13,i_14,i_15, &
+ &  r_40,r_41,r_42,r_43,r_44,r_45, &
+ &  r_80,r_81,r_82,r_83,r_84,r_85, &
+ &  start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_4),INTENT(IN),OPTIONAL :: i_40
+  INTEGER(KIND=i_4),DIMENSION(:),INTENT(IN),OPTIONAL :: i_41
+  INTEGER(KIND=i_4),DIMENSION(:,:),INTENT(IN),OPTIONAL :: i_42
+  INTEGER(KIND=i_4),DIMENSION(:,:,:),INTENT(IN),OPTIONAL :: i_43
+  INTEGER(KIND=i_4),DIMENSION(:,:,:,:),INTENT(IN),OPTIONAL :: i_44
+  INTEGER(KIND=i_4),DIMENSION(:,:,:,:,:),INTENT(IN),OPTIONAL :: i_45
+  INTEGER(KIND=i_2),INTENT(IN),OPTIONAL :: i_20
+  INTEGER(KIND=i_2),DIMENSION(:),INTENT(IN),OPTIONAL :: i_21
+  INTEGER(KIND=i_2),DIMENSION(:,:),INTENT(IN),OPTIONAL :: i_22
+  INTEGER(KIND=i_2),DIMENSION(:,:,:),INTENT(IN),OPTIONAL :: i_23
+  INTEGER(KIND=i_2),DIMENSION(:,:,:,:),INTENT(IN),OPTIONAL :: i_24
+  INTEGER(KIND=i_2),DIMENSION(:,:,:,:,:),INTENT(IN),OPTIONAL :: i_25
+!?INTEGERS of KIND 1 are not supported on all computers
+!?INTEGER(KIND=i_1),INTENT(IN),OPTIONAL :: i_10
+!?INTEGER(KIND=i_1),DIMENSION(:),INTENT(IN),OPTIONAL :: i_11
+!?INTEGER(KIND=i_1),DIMENSION(:,:),INTENT(IN),OPTIONAL :: i_12
+!?INTEGER(KIND=i_1),DIMENSION(:,:,:),INTENT(IN),OPTIONAL :: i_13
+!?INTEGER(KIND=i_1),DIMENSION(:,:,:,:),INTENT(IN),OPTIONAL :: i_14
+!?INTEGER(KIND=i_1),DIMENSION(:,:,:,:,:),INTENT(IN),OPTIONAL :: i_15
+  REAL(KIND=r_4),INTENT(IN),OPTIONAL :: r_40
+  REAL(KIND=r_4),DIMENSION(:),INTENT(IN),OPTIONAL :: r_41
+  REAL(KIND=r_4),DIMENSION(:,:),INTENT(IN),OPTIONAL :: r_42
+  REAL(KIND=r_4),DIMENSION(:,:,:),INTENT(IN),OPTIONAL :: r_43
+  REAL(KIND=r_4),DIMENSION(:,:,:,:),INTENT(IN),OPTIONAL :: r_44
+  REAL(KIND=r_4),DIMENSION(:,:,:,:,:),INTENT(IN),OPTIONAL :: r_45
+  REAL(KIND=r_8),INTENT(IN),OPTIONAL :: r_80
+  REAL(KIND=r_8),DIMENSION(:),INTENT(IN),OPTIONAL :: r_81
+  REAL(KIND=r_8),DIMENSION(:,:),INTENT(IN),OPTIONAL :: r_82
+  REAL(KIND=r_8),DIMENSION(:,:,:),INTENT(IN),OPTIONAL :: r_83
+  REAL(KIND=r_8),DIMENSION(:,:,:,:),INTENT(IN),OPTIONAL :: r_84
+  REAL(KIND=r_8),DIMENSION(:,:,:,:,:),INTENT(IN),OPTIONAL :: r_85
+  INTEGER,DIMENSION(:),INTENT(IN),OPTIONAL :: start,count
+!-
+  INTEGER :: f_e,i_v,i_rc
+  CHARACTER(LEN=5) :: cvr_d
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    IF      (PRESENT(i_40)) THEN; cvr_d = "I1 0D";
+    ELSE IF (PRESENT(i_41)) THEN; cvr_d = "I1 1D";
+    ELSE IF (PRESENT(i_42)) THEN; cvr_d = "I1 2D";
+    ELSE IF (PRESENT(i_43)) THEN; cvr_d = "I1 3D";
+    ELSE IF (PRESENT(i_44)) THEN; cvr_d = "I1 4D";
+    ELSE IF (PRESENT(i_45)) THEN; cvr_d = "I1 5D";
+    ELSE IF (PRESENT(i_20)) THEN; cvr_d = "I2 0D";
+    ELSE IF (PRESENT(i_21)) THEN; cvr_d = "I2 1D";
+    ELSE IF (PRESENT(i_22)) THEN; cvr_d = "I2 2D";
+    ELSE IF (PRESENT(i_23)) THEN; cvr_d = "I2 3D";
+    ELSE IF (PRESENT(i_24)) THEN; cvr_d = "I2 4D";
+    ELSE IF (PRESENT(i_25)) THEN; cvr_d = "I2 5D";
+!?  ELSE IF (PRESENT(i_10)) THEN; cvr_d = "I4 0D";
+!?  ELSE IF (PRESENT(i_11)) THEN; cvr_d = "I4 1D";
+!?  ELSE IF (PRESENT(i_12)) THEN; cvr_d = "I4 2D";
+!?  ELSE IF (PRESENT(i_13)) THEN; cvr_d = "I4 3D";
+!?  ELSE IF (PRESENT(i_14)) THEN; cvr_d = "I4 4D";
+!?  ELSE IF (PRESENT(i_15)) THEN; cvr_d = "I4 5D";
+    ELSE IF (PRESENT(r_40)) THEN; cvr_d = "R4 0D";
+    ELSE IF (PRESENT(r_41)) THEN; cvr_d = "R4 1D";
+    ELSE IF (PRESENT(r_42)) THEN; cvr_d = "R4 2D";
+    ELSE IF (PRESENT(r_43)) THEN; cvr_d = "R4 3D";
+    ELSE IF (PRESENT(r_44)) THEN; cvr_d = "R4 4D";
+    ELSE IF (PRESENT(r_45)) THEN; cvr_d = "R4 5D";
+    ELSE IF (PRESENT(r_80)) THEN; cvr_d = "R8 0D";
+    ELSE IF (PRESENT(r_81)) THEN; cvr_d = "R8 1D";
+    ELSE IF (PRESENT(r_82)) THEN; cvr_d = "R8 2D";
+    ELSE IF (PRESENT(r_83)) THEN; cvr_d = "R8 3D";
+    ELSE IF (PRESENT(r_84)) THEN; cvr_d = "R8 4D";
+    ELSE IF (PRESENT(r_85)) THEN; cvr_d = "R8 5D";
+    ENDIF
+    WRITE(*,*) "->flioputv ",TRIM(v_n)," ",TRIM(cvr_d)
+  ENDIF
+!-
+! Retrieve the external file index
+  CALL flio_qvid ('flioputv',f_i,f_e)
+!-
+! Ensuring data mode
+!-
+  CALL flio_hdm (f_i,f_e,.FALSE.)
+!-
+  i_rc = NF90_INQ_VARID(f_e,v_n,i_v)
+  IF (i_rc == NF90_NOERR) THEN
+    IF      (PRESENT(i_40)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,i_40,start=start)
+    ELSE IF (PRESENT(i_41)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,i_41,start=start,count=count)
+    ELSE IF (PRESENT(i_42)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,i_42,start=start,count=count)
+    ELSE IF (PRESENT(i_43)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,i_43,start=start,count=count)
+    ELSE IF (PRESENT(i_44)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,i_44,start=start,count=count)
+    ELSE IF (PRESENT(i_45)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,i_45,start=start,count=count)
+    ELSE IF (PRESENT(i_20)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,i_20,start=start)
+    ELSE IF (PRESENT(i_21)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,i_21,start=start,count=count)
+    ELSE IF (PRESENT(i_22)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,i_22,start=start,count=count)
+    ELSE IF (PRESENT(i_23)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,i_23,start=start,count=count)
+    ELSE IF (PRESENT(i_24)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,i_24,start=start,count=count)
+    ELSE IF (PRESENT(i_25)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,i_25,start=start,count=count)
+!?  ELSE IF (PRESENT(i_10)) THEN
+!?    i_rc = NF90_PUT_VAR(f_e,i_v,i_10,start=start)
+!?  ELSE IF (PRESENT(i_11)) THEN
+!?    i_rc = NF90_PUT_VAR(f_e,i_v,i_11,start=start,count=count)
+!?  ELSE IF (PRESENT(i_12)) THEN
+!?    i_rc = NF90_PUT_VAR(f_e,i_v,i_12,start=start,count=count)
+!?  ELSE IF (PRESENT(i_13)) THEN
+!?    i_rc = NF90_PUT_VAR(f_e,i_v,i_13,start=start,count=count)
+!?  ELSE IF (PRESENT(i_14)) THEN
+!?    i_rc = NF90_PUT_VAR(f_e,i_v,i_14,start=start,count=count)
+!?  ELSE IF (PRESENT(i_15)) THEN
+!?    i_rc = NF90_PUT_VAR(f_e,i_v,i_15,start=start,count=count)
+    ELSE IF (PRESENT(r_40)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,r_40,start=start)
+    ELSE IF (PRESENT(r_41)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,r_41,start=start,count=count)
+    ELSE IF (PRESENT(r_42)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,r_42,start=start,count=count)
+    ELSE IF (PRESENT(r_43)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,r_43,start=start,count=count)
+    ELSE IF (PRESENT(r_44)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,r_44,start=start,count=count)
+    ELSE IF (PRESENT(r_45)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,r_45,start=start,count=count)
+    ELSE IF (PRESENT(r_80)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,r_80,start=start)
+    ELSE IF (PRESENT(r_81)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,r_81,start=start,count=count)
+    ELSE IF (PRESENT(r_82)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,r_82,start=start,count=count)
+    ELSE IF (PRESENT(r_83)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,r_83,start=start,count=count)
+    ELSE IF (PRESENT(r_84)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,r_84,start=start,count=count)
+    ELSE IF (PRESENT(r_85)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,r_85,start=start,count=count)
+    ENDIF
+    IF (i_rc /= NF90_NOERR) THEN
+      CALL ipslerr (3,'flioputv', &
+ &      'Variable '//TRIM(v_n)//' not put','Error :', &
+ &      TRIM(NF90_STRERROR(i_rc)))
+    ENDIF
+  ELSE
+    CALL ipslerr (3,'flioputv','Variable',TRIM(v_n),'not defined')
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-flioputv"
+  ENDIF
+!----------------------
+END SUBROUTINE flio_upv
+!===
+SUBROUTINE fliopa_r4_0d (f_i,v_n,a_n,a_v)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
+  REAL(KIND=4),INTENT(IN) :: a_v
+!---------------------------------------------------------------------
+  CALL flio_upa (f_i,1,v_n,a_n,avr4=(/a_v/))
+!--------------------------
+END SUBROUTINE fliopa_r4_0d
+!===
+SUBROUTINE fliopa_r4_1d (f_i,v_n,a_n,a_v)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
+  REAL(KIND=4),DIMENSION(:),INTENT(IN) :: a_v
+!---------------------------------------------------------------------
+  CALL flio_upa (f_i,SIZE(a_v),v_n,a_n,avr4=a_v)
+!--------------------------
+END SUBROUTINE fliopa_r4_1d
+!===
+SUBROUTINE fliopa_r8_0d (f_i,v_n,a_n,a_v)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
+  REAL(KIND=8),INTENT(IN) :: a_v
+!---------------------------------------------------------------------
+  CALL flio_upa (f_i,1,v_n,a_n,avr8=(/a_v/))
+!--------------------------
+END SUBROUTINE fliopa_r8_0d
+!===
+SUBROUTINE fliopa_r8_1d (f_i,v_n,a_n,a_v)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
+  REAL(KIND=8),DIMENSION(:),INTENT(IN) :: a_v
+!---------------------------------------------------------------------
+  CALL flio_upa (f_i,SIZE(a_v),v_n,a_n,avr8=a_v)
+!--------------------------
+END SUBROUTINE fliopa_r8_1d
+!===
+SUBROUTINE fliopa_i4_0d (f_i,v_n,a_n,a_v)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
+  INTEGER(KIND=4),INTENT(IN) :: a_v
+!---------------------------------------------------------------------
+  CALL flio_upa (f_i,1,v_n,a_n,avi4=(/a_v/))
+!--------------------------
+END SUBROUTINE fliopa_i4_0d
+!===
+SUBROUTINE fliopa_i4_1d (f_i,v_n,a_n,a_v)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
+  INTEGER(KIND=4),DIMENSION(:),INTENT(IN) :: a_v
+!---------------------------------------------------------------------
+  CALL flio_upa (f_i,SIZE(a_v),v_n,a_n,avi4=a_v)
+!--------------------------
+END SUBROUTINE fliopa_i4_1d
+!===
+SUBROUTINE fliopa_tx_0d (f_i,v_n,a_n,a_v)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
+  CHARACTER(LEN=*),INTENT(IN) :: a_v
+!---------------------------------------------------------------------
+  CALL flio_upa (f_i,1,v_n,a_n,avtx=a_v)
+!--------------------------
+END SUBROUTINE fliopa_tx_0d
+!===
+SUBROUTINE flio_upa (f_i,l_a,v_n,a_n,avr4,avr8,avi4,avtx)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i,l_a
+  CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
+  REAL(KIND=4),DIMENSION(:),OPTIONAL,INTENT(IN) :: avr4
+  REAL(KIND=8),DIMENSION(:),OPTIONAL,INTENT(IN) :: avr8
+  INTEGER(KIND=4),DIMENSION(:),OPTIONAL,INTENT(IN) :: avi4
+  CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: avtx
+!-
+  INTEGER :: f_e,i_v,i_a,i_rc
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "->flioputa ",TRIM(v_n)," ",TRIM(a_n)
+  ENDIF
+!-
+! Retrieve the external file index
+  CALL flio_qvid ('flioputa',f_i,f_e)
+!-
+  IF (TRIM(v_n) == '?') THEN
+    i_v = NF90_GLOBAL
+  ELSE
+    i_rc = NF90_INQ_VARID(f_e,v_n,i_v)
+    IF (i_rc /= NF90_NOERR) THEN
+      CALL ipslerr (3,'flioputa', &
+       'Variable :',TRIM(v_n),'not found')
+    ENDIF
+  ENDIF
+!-
+  i_rc = NF90_INQUIRE_ATTRIBUTE(f_e,i_v,a_n,attnum=i_a)
+  IF ( (i_v == NF90_GLOBAL).AND.(i_rc /= NF90_NOERR) ) THEN
+    nw_na(f_i) = nw_na(f_i)+1
+  ENDIF
+  CALL flio_hdm (f_i,f_e,.TRUE.)
+  IF      (PRESENT(avr4)) THEN
+    i_rc = NF90_PUT_ATT(f_e,i_v,a_n,avr4(1:l_a))
+  ELSE IF (PRESENT(avr8)) THEN
+    i_rc = NF90_PUT_ATT(f_e,i_v,a_n,avr8(1:l_a))
+  ELSE IF (PRESENT(avi4)) THEN
+    i_rc = NF90_PUT_ATT(f_e,i_v,a_n,avi4(1:l_a))
+  ELSE IF (PRESENT(avtx)) THEN
+    i_rc = NF90_PUT_ATT(f_e,i_v,a_n,TRIM(avtx))
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-flioputa"
+  ENDIF
+!----------------------
+END SUBROUTINE flio_upa
+!===
+SUBROUTINE flioopfd (f_n,f_i,mode,nb_dim,nb_var,nb_gat)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(IN) :: f_n
+  INTEGER,INTENT(OUT) :: f_i
+  CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: mode
+  INTEGER,OPTIONAL,INTENT(OUT) :: nb_dim,nb_var,nb_gat
+!-
+  INTEGER :: i_rc,f_e,m_c
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) '->flioopfd, file name : ',TRIM(f_n)
+  ENDIF
+!-
+! Search for a free local identifier
+!-
+  f_i = flio_rid()
+  IF (f_i < 0) THEN
+    CALL ipslerr (3,'flioopfd', &
+      'Too many files.','Please increase nb_fi_mx', &
+      'in module fliocom.f90.')
+  ENDIF
+!-
+! Check the mode
+!-
+  IF (PRESENT(mode)) THEN
+    IF (TRIM(mode) == "WRITE") THEN
+      m_c = NF90_WRITE
+    ELSE
+      m_c = NF90_NOWRITE
+    ENDIF
+  ELSE
+    m_c = NF90_NOWRITE
+  ENDIF
+!-
+! Open the file.
+!-
+  i_rc = NF90_OPEN(TRIM(f_n),m_c,f_e)
+  IF (i_rc /= NF90_NOERR) THEN
+    CALL ipslerr (3,'flioopfd', &
+ &   'Could not open file :',TRIM(f_n), &
+ &   TRIM(NF90_STRERROR(i_rc))//' (Netcdf)')
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) '  flioopfd, model file-id : ',f_e
+  ENDIF
+!-
+! Retrieve and keep information about the file
+!-
+  nw_id(f_i) = f_e
+  lw_hm(f_i) = .FALSE.
+  CALL flio_inf (f_e, &
+ &  nb_dims=nw_nd(f_i),nb_vars=nw_nv(f_i), &
+ &  nb_atts=nw_na(f_i),id_unlm=nw_un(f_i), &
+ &  nn_idm=nw_di(:,f_i),nn_ldm=nw_dl(:,f_i),nn_aid=nw_ai(:,f_i))
+!-
+! Return information to the user
+!-
+  IF (PRESENT(nb_dim)) THEN
+    nb_dim = nw_nd(f_i)
+  ENDIF
+  IF (PRESENT(nb_var)) THEN
+    nb_var = nw_nv(f_i)
+  ENDIF
+  IF (PRESENT(nb_gat)) THEN
+    nb_gat = nw_na(f_i)
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,'("   flioopfd - dimensions :",/,(5(1X,I10),:))') &
+ &    nw_dl(:,f_i)
+    WRITE(*,*) "<-flioopfd"
+  ENDIF
+!----------------------
+END SUBROUTINE flioopfd
+!===
+SUBROUTINE flioinqf &
+ & (f_i,nb_dim,nb_var,nb_gat,id_uld,id_dim,ln_dim)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  INTEGER,OPTIONAL,INTENT(OUT) :: nb_dim,nb_var,nb_gat,id_uld
+  INTEGER,OPTIONAL,INTENT(OUT),DIMENSION(:) :: id_dim,ln_dim
+!-
+  INTEGER :: lll
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "->flioinqf"
+  ENDIF
+!-
+  IF ( (f_i < 1).OR.(f_i > nb_fi_mx) ) THEN
+    CALL ipslerr (2,'flioinqf', &
+ &   'Invalid file identifier',' ',' ')
+  ELSE IF (nw_id(f_i) <= 0) THEN
+    CALL ipslerr (2,'flioinqf', &
+ &   'Unable to inquire about the file :','probably','not opened')
+  ELSE
+    IF (PRESENT(nb_dim)) THEN
+      nb_dim = nw_nd(f_i)
+    ENDIF
+    IF (PRESENT(nb_var)) THEN
+      nb_var = nw_nv(f_i)
+    ENDIF
+    IF (PRESENT(nb_gat)) THEN
+      nb_gat = nw_na(f_i)
+    ENDIF
+    IF (PRESENT(id_uld)) THEN
+      id_uld = nw_un(f_i)
+    ENDIF
+    IF (PRESENT(id_dim)) THEN
+      lll = SIZE(id_dim)
+      IF (lll < nw_nd(f_i)) THEN
+        CALL ipslerr (2,'flioinqf', &
+ &       'Only the first identifiers', &
+ &       'of the dimensions','will be returned')
+      ENDIF
+      lll=MIN(SIZE(id_dim),nw_nd(f_i))
+      id_dim(1:lll) = nw_di(1:lll,f_i)
+    ENDIF
+    IF (PRESENT(ln_dim)) THEN
+      lll = SIZE(ln_dim)
+      IF (lll < nw_nd(f_i)) THEN
+        CALL ipslerr (2,'flioinqf', &
+ &       'Only the first lengths', &
+ &       'of the dimensions','will be returned')
+      ENDIF
+      lll=MIN(SIZE(ln_dim),nw_nd(f_i))
+      ln_dim(1:lll) = nw_dl(1:lll,f_i)
+    ENDIF
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-flioinqf"
+  ENDIF
+!----------------------
+END SUBROUTINE flioinqf
+!===
+SUBROUTINE flioinqn &
+ & (f_i,cn_dim,cn_var,cn_gat,cn_uld, &
+ &  id_start,id_count,iv_start,iv_count,ia_start,ia_count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL,INTENT(OUT) :: &
+ & cn_dim,cn_var,cn_gat
+  CHARACTER(LEN=*),OPTIONAL,INTENT(OUT) :: &
+ & cn_uld
+  INTEGER,OPTIONAL,INTENT(IN) :: &
+ & id_start,id_count,iv_start,iv_count,ia_start,ia_count
+!-
+  INTEGER :: f_e,i_s,i_w,iws,iwc,i_rc
+  LOGICAL :: l_ok
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "->flioinqn"
+  ENDIF
+!-
+! Retrieve the external file index
+  CALL flio_qvid ('flioinqn',f_i,f_e)
+!-
+  IF (PRESENT(cn_dim)) THEN
+    l_ok = .TRUE.
+    i_s = SIZE(cn_dim)
+    DO i_w=1,i_s
+      cn_dim(i_w)(:) = '?'
+    ENDDO
+    IF (PRESENT(id_start)) THEN
+      iws = id_start
+    ELSE
+      iws = 1
+    ENDIF
+    IF (PRESENT(id_count)) THEN
+      iwc = id_count
+    ELSE
+      iwc = nw_nd(f_i)
+    ENDIF
+    IF (iws > nw_nd(f_i)) THEN
+      l_ok = .FALSE.
+      CALL ipslerr (2,'flioinqn', &
+ &     'The start index of requested dimensions', &
+ &     'is greater than the number of dimensions', &
+ &     'in the file')
+    ELSE IF (iws < 1) THEN
+      l_ok = .FALSE.
+      CALL ipslerr (2,'flioinqn', &
+ &     'The start index of requested dimensions', &
+ &     'is invalid', &
+ &     '( < 1 )')
+    ENDIF
+    IF ((iws+iwc-1) > nw_nd(f_i)) THEN
+      CALL ipslerr (2,'flioinqn', &
+ &     'The number of requested dimensions', &
+ &     'is greater than the number of dimensions', &
+ &     'in the file')
+    ENDIF
+    IF (iwc > i_s) THEN
+      CALL ipslerr (2,'flioinqn', &
+ &     'The number of dimensions to retrieve', &
+ &     'is greater than the size of the array,', &
+ &     'only the first dimensions of the file will be returned')
+    ELSE IF (iwc < 1) THEN
+      l_ok = .FALSE.
+      CALL ipslerr (2,'flioinqn', &
+ &     'The number of requested dimensions', &
+ &     'is invalid', &
+ &     '( < 1 )')
+    ENDIF
+    IF (l_ok) THEN
+      DO i_w=1,MIN(iwc,i_s,nw_nd(f_i)-iws+1)
+        i_rc = NF90_INQUIRE_DIMENSION(f_e,i_w+iws-1,name=cn_dim(i_w))
+      ENDDO
+    ENDIF
+  ENDIF
+!-
+  IF (PRESENT(cn_var)) THEN
+    l_ok = .TRUE.
+    i_s = SIZE(cn_var)
+    DO i_w=1,i_s
+      cn_var(i_w)(:) = '?'
+    ENDDO
+    IF (PRESENT(iv_start)) THEN
+      iws = iv_start
+    ELSE
+      iws = 1
+    ENDIF
+    IF (PRESENT(iv_count)) THEN
+      iwc = iv_count
+    ELSE
+      iwc = nw_nv(f_i)
+    ENDIF
+    IF (iws > nw_nv(f_i)) THEN
+      l_ok = .FALSE.
+      CALL ipslerr (2,'flioinqn', &
+ &     'The start index of requested variables', &
+ &     'is greater than the number of variables', &
+ &     'in the file')
+    ELSE IF (iws < 1) THEN
+      l_ok = .FALSE.
+      CALL ipslerr (2,'flioinqn', &
+ &     'The start index of requested variables', &
+ &     'is invalid', &
+ &     '( < 1 )')
+    ENDIF
+    IF ((iws+iwc-1) > nw_nv(f_i)) THEN
+      CALL ipslerr (2,'flioinqn', &
+ &     'The number of requested variables', &
+ &     'is greater than the number of variables', &
+ &     'in the file')
+    ENDIF
+    IF (iwc > i_s) THEN
+      CALL ipslerr (2,'flioinqn', &
+ &     'The number of variables to retrieve', &
+ &     'is greater than the size of the array,', &
+ &     'only the first variables of the file will be returned')
+    ELSE IF (iwc < 1) THEN
+      l_ok = .FALSE.
+      CALL ipslerr (2,'flioinqn', &
+ &     'The number of requested variables', &
+ &     'is invalid', &
+ &     '( < 1 )')
+    ENDIF
+    IF (l_ok) THEN
+      DO i_w=1,MIN(iwc,i_s,nw_nv(f_i)-iws+1)
+        i_rc = NF90_INQUIRE_VARIABLE(f_e,i_w+iws-1,name=cn_var(i_w))
+      ENDDO
+    ENDIF
+  ENDIF
+!-
+  IF (PRESENT(cn_gat)) THEN
+    l_ok = .TRUE.
+    i_s = SIZE(cn_gat)
+    DO i_w=1,i_s
+      cn_gat(i_w)(:) = '?'
+    ENDDO
+    IF (PRESENT(ia_start)) THEN
+      iws = ia_start
+    ELSE
+      iws = 1
+    ENDIF
+    IF (PRESENT(ia_count)) THEN
+      iwc = ia_count
+    ELSE
+      iwc = nw_na(f_i)
+    ENDIF
+    IF (iws > nw_na(f_i)) THEN
+      l_ok = .FALSE.
+      CALL ipslerr (2,'flioinqn', &
+ &     'The start index of requested global attributes', &
+ &     'is greater than the number of global attributes', &
+ &     'in the file')
+    ELSE IF (iws < 1) THEN
+      l_ok = .FALSE.
+      CALL ipslerr (2,'flioinqn', &
+ &     'The start index of requested global attributes', &
+ &     'is invalid', &
+ &     '( < 1 )')
+    ENDIF
+    IF ((iws+iwc-1) > nw_na(f_i)) THEN
+      CALL ipslerr (2,'flioinqn', &
+ &     'The number of requested global attributes', &
+ &     'is greater than the number of global attributes', &
+ &     'in the file')
+    ENDIF
+    IF (iwc > i_s) THEN
+      CALL ipslerr (2,'flioinqn', &
+ &     'The number of global attributes to retrieve', &
+ &     'is greater than the size of the array,', &
+ &     'only the first global attributes of the file will be returned')
+    ELSE IF (iwc < 1) THEN
+      l_ok = .FALSE.
+      CALL ipslerr (2,'flioinqn', &
+ &     'The number of requested global attributes', &
+ &     'is invalid', &
+ &     '( < 1 )')
+    ENDIF
+    IF (l_ok) THEN
+      DO i_w=1,MIN(iwc,i_s,nw_na(f_i)-iws+1)
+        i_rc = NF90_INQ_ATTNAME(f_e, &
+ &              NF90_GLOBAL,i_w+iws-1,name=cn_gat(i_w))
+      ENDDO
+    ENDIF
+  ENDIF
+!-
+  IF (PRESENT(cn_uld)) THEN
+    cn_uld = '?'
+    IF (nw_un(f_i) > 0) THEN
+      i_rc = NF90_INQUIRE_DIMENSION(f_e,nw_un(f_i),name=cn_uld)
+    ENDIF
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-flioinqn"
+  ENDIF
+!----------------------
+END SUBROUTINE flioinqn
+!===
+SUBROUTINE fliogstc &
+ & (f_i,x_axis,x_axis_2d,y_axis,y_axis_2d,z_axis, &
+ &      t_axis,t_init,t_step,t_calendar, &
+ &      x_start,x_count,y_start,y_count, &
+ &      z_start,z_count,t_start,t_count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  REAL,DIMENSION(:),OPTIONAL,INTENT(OUT)    :: x_axis,y_axis
+  REAL,DIMENSION(:,:),OPTIONAL,INTENT(OUT)  :: x_axis_2d,y_axis_2d
+  REAL,DIMENSION(:),OPTIONAL,INTENT(OUT)    :: z_axis
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(OUT) :: t_axis
+  REAL,OPTIONAL,INTENT(OUT)                 :: t_init,t_step
+  CHARACTER(LEN=*),OPTIONAL,INTENT(OUT)     :: t_calendar
+  INTEGER,OPTIONAL,INTENT(IN) :: &
+ &  x_start,x_count,y_start,y_count,z_start,z_count,t_start,t_count
+!-
+  INTEGER :: i_rc,f_e,i_v,it_t,nbdim,kv
+  INTEGER :: m_x,i_x,l_x,m_y,i_y,l_y,m_z,i_z,l_z,m_t,i_t,l_t
+  CHARACTER(LEN=NF90_MAX_NAME) :: name
+  CHARACTER(LEN=80) :: units
+  CHARACTER(LEN=20) :: c_tmp
+  CHARACTER(LEN=1) :: c_1
+  REAL    :: r_yy,r_mo,r_dd,r_ss,dtv,dtn
+  INTEGER :: j_yy,j_mo,j_dd,j_hh,j_mn,j_ss
+  LOGICAL :: l_ok,l_tmp
+!-
+  REAL,DIMENSION(:),ALLOCATABLE :: v_tmp
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "->fliogstc"
+  ENDIF
+!-
+! Retrieve the external file index
+  CALL flio_qvid ('fliogstc',f_i,f_e)
+!-
+! Validate the coherence of the arguments
+!-
+  IF (    (PRESENT(x_axis).AND.PRESENT(x_axis_2d)) &
+ &    .OR.(PRESENT(y_axis).AND.PRESENT(y_axis_2d)) ) THEN
+    CALL ipslerr (3,'fliogstc', &
+ &    'The [x/y]_axis arguments', &
+ &    'are not coherent :',&
+ &    'can not handle two [x/y]_axis')
+  ENDIF
+!-
+! Retrieve spatio-temporal dimensions
+!-
+  IF (nw_ai(k_lon,f_i) > 0) THEN
+    m_x = nw_dl(nw_ai(k_lon,f_i),f_i);
+  ELSE
+    m_x = -1;
+  ENDIF
+  IF (nw_ai(k_lat,f_i) > 0) THEN
+    m_y = nw_dl(nw_ai(k_lat,f_i),f_i);
+  ELSE
+    m_y = -1;
+  ENDIF
+  IF (nw_ai(k_lev,f_i) > 0) THEN
+    m_z = nw_dl(nw_ai(k_lev,f_i),f_i);
+  ELSE
+    m_z = -1;
+  ENDIF
+  IF (nw_ai(k_tim,f_i) > 0) THEN
+    m_t = nw_dl(nw_ai(k_tim,f_i),f_i);
+  ELSE
+    m_t = -1;
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,'("   fliogstc - dimensions :",/,(5(1X,I10),:))') &
+ &    m_x,m_y,m_z,m_t
+  ENDIF
+!-
+! Initialize the x-y indices
+!-
+  IF (    PRESENT(x_axis)    &
+ &    .OR.PRESENT(x_axis_2d) &
+ &    .OR.PRESENT(y_axis_2d) ) THEN
+    IF (PRESENT(x_start)) THEN
+      i_x = x_start
+    ELSE
+      i_x = 1
+    ENDIF
+    IF (PRESENT(x_count)) THEN
+      l_x = x_count
+    ELSE
+      l_x = m_x-i_x+1
+    ENDIF
+  ENDIF
+  IF (    PRESENT(y_axis)    &
+ &    .OR.PRESENT(y_axis_2d) &
+ &    .OR.PRESENT(x_axis_2d) ) THEN
+    IF (PRESENT(y_start)) THEN
+      i_y = y_start
+    ELSE
+      i_y = 1
+    ENDIF
+    IF (PRESENT(y_count)) THEN
+      l_y = y_count
+    ELSE
+      l_y = m_y-i_y+1
+    ENDIF
+  ENDIF
+  IF (PRESENT(x_axis)) THEN
+    IF (m_x <= 0) THEN
+      CALL ipslerr (3,'fliogstc', &
+ &      'Requested x_axis', &
+ &      'but the coordinate is not present','in the file')
+    ELSE IF ((i_x+l_x-1) > m_x) THEN
+      CALL ipslerr (3,'fliogstc', &
+ &      'The requested size for the x_axis', &
+ &      'is greater than the size of the coordinate','in the file')
+    ENDIF
+  ENDIF
+  IF (PRESENT(y_axis)) THEN
+    IF (m_y <= 0) THEN
+      CALL ipslerr (3,'fliogstc', &
+ &      'Requested y_axis', &
+ &      'but the coordinate is not present','in the file')
+    ELSE IF ((i_y+l_y-1) > m_y) THEN
+      CALL ipslerr (3,'fliogstc', &
+ &      'The requested size for the y_axis', &
+ &      'is greater than the size of the coordinate','in the file')
+    ENDIF
+  ENDIF
+  IF (PRESENT(x_axis_2d).OR.PRESENT(y_axis_2d) )THEN
+    IF ( (m_x <= 0).OR.(m_y <= 0) ) THEN
+      CALL ipslerr (3,'fliogstc', &
+ &      'Requested [x/y]_axis_2d', &
+ &      'but the coordinates are not iboth present','in the file')
+    ELSE IF ( ((i_x+l_x-1) > m_x).OR.((i_y+l_y-1) > m_y) ) THEN
+      CALL ipslerr (3,'fliogstc', &
+ &      'The requested size for the [x/y]_axis_2d', &
+ &      'is greater than the size of the coordinate','in the file')
+    ENDIF
+  ENDIF
+!-
+! Ensuring data mode
+!-
+  CALL flio_hdm (f_i,f_e,.FALSE.)
+!-
+! Extracting the x coordinate, if needed
+!-
+  IF (PRESENT(x_axis).OR.PRESENT(x_axis_2d)) THEN
+    CALL flio_qax (f_i,'x',i_v,nbdim)
+    IF (i_v > 0) THEN
+      IF      (nbdim == 1) THEN
+        IF (PRESENT(x_axis)) THEN
+          i_rc = NF90_GET_VAR(f_e,i_v,x_axis, &
+ &                 start=(/i_x/),count=(/l_x/))
+        ELSE
+          ALLOCATE(v_tmp(l_x))
+          i_rc = NF90_GET_VAR(f_e,i_v,v_tmp, &
+ &                 start=(/i_x/),count=(/l_x/))
+          DO kv=1,l_y
+            x_axis_2d(:,kv) = v_tmp(:)
+          ENDDO
+          DEALLOCATE(v_tmp)
+        ENDIF
+      ELSE IF (nbdim == 2) THEN
+        IF (PRESENT(x_axis)) THEN
+          l_ok = .TRUE.
+          IF (l_y > 1) THEN
+            ALLOCATE(v_tmp(l_y))
+            DO kv=i_x,i_x+l_x-1
+              i_rc = NF90_GET_VAR(f_e,i_v,v_tmp, &
+ &                     start=(/kv,i_y/),count=(/1,l_y/))
+              IF (ANY(v_tmp(2:l_y) /= v_tmp(1))) THEN
+                l_ok = .FALSE.
+                EXIT
+              ENDIF
+            ENDDO
+            DEALLOCATE(v_tmp)
+          ENDIF
+          IF (l_ok) THEN
+            i_rc = NF90_GET_VAR(f_e,i_v,x_axis, &
+ &                   start=(/i_x,i_y/),count=(/l_x,1/))
+          ELSE
+            CALL ipslerr (3,'fliogstc', &
+ &            'Requested 1D x_axis', &
+ &            'which have 2 not regular dimensions', &
+ &            'in the file')
+          ENDIF
+        ELSE
+          i_rc = NF90_GET_VAR(f_e,i_v,x_axis_2d, &
+ &                 start=(/i_x,i_y/),count=(/l_x,l_y/))
+        ENDIF
+      ELSE
+        CALL ipslerr (3,'fliogstc', &
+ &        'Can not handle x_axis', &
+ &        'that have more than 2 dimensions', &
+ &        'in the file')
+      ENDIF
+    ELSE
+      CALL ipslerr (3,'fliogstc','No x_axis found','in the file',' ')
+    ENDIF
+  ENDIF
+!-
+! Extracting the y coordinate, if needed
+!-
+  IF (PRESENT(y_axis).OR.PRESENT(y_axis_2d)) THEN
+    CALL flio_qax (f_i,'y',i_v,nbdim)
+    IF (i_v > 0) THEN
+      IF      (nbdim == 1) THEN
+        IF (PRESENT(y_axis)) THEN
+          i_rc = NF90_GET_VAR(f_e,i_v,y_axis, &
+ &                 start=(/i_y/),count=(/l_y/))
+        ELSE
+          ALLOCATE(v_tmp(l_y))
+          i_rc = NF90_GET_VAR(f_e,i_v,v_tmp, &
+ &                 start=(/i_y/),count=(/l_y/))
+          DO kv=1,l_x
+            y_axis_2d(kv,:) = v_tmp(:)
+          ENDDO
+          DEALLOCATE(v_tmp)
+        ENDIF
+      ELSE IF (nbdim == 2) THEN
+        IF (PRESENT(y_axis)) THEN
+          l_ok = .TRUE.
+          IF (l_x > 1) THEN
+            ALLOCATE(v_tmp(l_x))
+            DO kv=i_y,i_y+l_y-1
+              i_rc = NF90_GET_VAR(f_e,i_v,v_tmp, &
+ &                     start=(/i_x,kv/),count=(/l_x,1/))
+              IF (ANY(v_tmp(2:l_x) /= v_tmp(1))) THEN
+                l_ok = .FALSE.
+                EXIT
+              ENDIF
+            ENDDO
+            DEALLOCATE(v_tmp)
+          ENDIF
+          IF (l_ok) THEN
+            i_rc = NF90_GET_VAR(f_e,i_v,y_axis, &
+ &                   start=(/i_x,i_y/),count=(/1,l_y/))
+          ELSE
+            CALL ipslerr (3,'fliogstc', &
+ &            'Requested 1D y_axis', &
+ &            'which have 2 not regular dimensions', &
+ &            'in the file')
+          ENDIF
+        ELSE
+          i_rc = NF90_GET_VAR(f_e,i_v,y_axis_2d, &
+ &                 start=(/i_x,i_y/),count=(/l_x,l_y/))
+        ENDIF
+      ELSE
+        CALL ipslerr (3,'fliogstc', &
+ &        'Can not handle y axis', &
+ &        'that have more than 2 dimensions', &
+ &        'in the file')
+      ENDIF
+    ELSE
+      CALL ipslerr (3,'fliogstc','No y_axis found','in the file',' ')
+    ENDIF
+  ENDIF
+!-
+! Extracting the z coordinate, if needed
+!-
+  IF (PRESENT(z_axis)) THEN
+    IF (PRESENT(z_start)) THEN
+      i_z = z_start
+    ELSE
+      i_z = 1
+    ENDIF
+    IF (PRESENT(z_count)) THEN
+      l_z = z_count
+    ELSE
+      l_z = m_z-i_z+1
+    ENDIF
+    IF ((i_z+l_z-1) > m_z) THEN
+      CALL ipslerr (3,'fliogstc', &
+ &      'The requested size for the z axis', &
+ &      'is greater than the size of the coordinate',&
+ &      'in the file')
+    ENDIF
+    CALL flio_qax (f_i,'z',i_v,nbdim)
+    IF (i_v > 0) THEN
+      IF (nbdim == 1) THEN
+        i_rc = NF90_GET_VAR(f_e,i_v,z_axis, &
+ &               start=(/i_z/),count=(/l_z/))
+      ELSE
+        CALL ipslerr (3,'fliogstc', &
+ &        'Can not handle z_axis', &
+ &        'that have more than 1 dimension', &
+ &        'in the file')
+      ENDIF
+    ELSE
+      CALL ipslerr (3,'fliogstc','No z_axis found','in the file',' ')
+    ENDIF
+  ENDIF
+!-
+! Extracting the t coordinate, if needed
+!-
+  IF (PRESENT(t_axis).OR.PRESENT(t_init).OR.PRESENT(t_step)) THEN
+    CALL flio_qax (f_i,'t',i_v,nbdim)
+    IF (i_v < 0) THEN
+      CALL ipslerr (3,'fliogstc','No t_axis found','in the file',' ')
+    ENDIF
+!---
+    IF (l_dbg) THEN
+      WRITE(*,*) '  fliogstc - get time details'
+    ENDIF
+!---
+!-- Get all the details for the time
+!-- Prefered method is '"time_steps" since'
+!---
+    name=''
+    i_rc = NF90_INQUIRE_VARIABLE(f_e,i_v,name=name)
+    units=''
+    i_rc = NF90_GET_ATT(f_e,i_v,'units',units)
+    IF      (INDEX(units,' since ') > 0) THEN
+      it_t = 1
+    ELSE IF (INDEX(name,'tstep') > 0) THEN
+      it_t = 2
+    ELSE
+      it_t = 0;
+    ENDIF
+  ENDIF
+!-
+! Extracting the t coordinate, if needed
+!-
+  IF (PRESENT(t_axis)) THEN
+    IF (PRESENT(t_start)) THEN
+      i_t = t_start
+    ELSE
+      i_t = 1
+    ENDIF
+    IF (PRESENT(t_count)) THEN
+      l_t = t_count
+    ELSE
+      l_t = m_t-i_t+1
+    ENDIF
+    IF ((i_t+l_t-1) > m_t) THEN
+      CALL ipslerr (3,'fliogstc', &
+ &      'The requested size for the t axis', &
+ &      'is greater than the size of the coordinate',&
+ &      'in the file')
+    ENDIF
+    ALLOCATE(v_tmp(l_t))
+    i_rc = NF90_GET_VAR(f_e,i_v,v_tmp, &
+ &           start=(/i_t/),count=(/l_t/))
+    t_axis(1:l_t) = NINT(v_tmp(1:l_t))
+    DEALLOCATE(v_tmp)
+!---
+    IF (l_dbg) THEN
+      WRITE(*,*) '  fliogstc - first time : ',t_axis(1:1)
+    ENDIF
+  ENDIF
+!-
+! Extracting the time at the beginning, if needed
+!-
+  IF (PRESENT(t_init)) THEN
+!-- Find the calendar
+    CALL lock_calendar (old_status=l_tmp)
+    CALL ioget_calendar (c_tmp)
+    units = ''
+    i_rc = NF90_GET_ATT(f_e,i_v,'calendar',units)
+    IF (i_rc == NF90_NOERR) THEN
+      CALL lock_calendar (new_status=.FALSE.)
+      CALL ioconf_calendar (TRIM(units))
+    ENDIF
+    IF (it_t == 1) THEN
+      units = ''
+      i_rc = NF90_GET_ATT(f_e,i_v,'units',units)
+      units = units(INDEX(units,' since ')+7:LEN_TRIM(units))
+      READ (units,'(I4.4,5(A,I2.2))') &
+ &      j_yy,c_1,j_mo,c_1,j_dd,c_1,j_hh,c_1,j_mn,c_1,j_ss
+      r_ss = j_hh*3600.+j_mn*60.+j_ss
+      CALL ymds2ju (j_yy,j_mo,j_dd,r_ss,t_init)
+    ELSE IF (it_t == 2) THEN
+      i_rc = NF90_GET_ATT(f_e,NF90_GLOBAL,'year0',r_yy)
+      i_rc = NF90_GET_ATT(f_e,NF90_GLOBAL,'month0',r_mo)
+      i_rc = NF90_GET_ATT(f_e,NF90_GLOBAL,'day0',r_dd)
+      i_rc = NF90_GET_ATT(f_e,NF90_GLOBAL,'sec0',r_ss)
+      j_yy = NINT(r_yy); j_mo = NINT(r_mo); j_dd = NINT(r_dd);
+      CALL ymds2ju (j_yy,j_mo,j_dd,r_ss,t_init)
+    ELSE
+      t_init = 0.
+    ENDIF
+    CALL lock_calendar (new_status=.FALSE.)
+    CALL ioconf_calendar (TRIM(c_tmp))
+    CALL lock_calendar (new_status=l_tmp)
+    IF (l_dbg) THEN
+      WRITE(*,*) '  fliogstc - time_type : '
+      WRITE(*,*) it_t
+      WRITE(*,*) '  fliogstc - year month day second t_init : '
+      WRITE(*,*) j_yy,j_mo,j_dd,r_ss,t_init
+    ENDIF
+  ENDIF
+!-
+! Extracting the timestep in seconds, if needed
+!-
+  IF (PRESENT(t_step)) THEN
+    IF      (it_t == 1) THEN
+      units = ''
+      i_rc = NF90_GET_ATT(f_e,i_v,'units',units)
+      units = ADJUSTL(units(1:INDEX(units,' since ')-1))
+      dtn = 1.
+      IF      (INDEX(units,"week") /= 0) THEN
+        kv  = INDEX(units,"week")
+        dtv = 604800.
+      ELSE IF (INDEX(units,"day")  /= 0) THEN
+        kv  = INDEX(units,"day")
+        dtv = 86400.
+      ELSE IF (INDEX(units,"h")    /= 0) THEN
+        kv  = INDEX(units,"h")
+        dtv = 3600.
+      ELSE IF (INDEX(units,"min")  /= 0) THEN
+        kv  = INDEX(units,"min")
+        dtv = 60.
+      ELSE IF (INDEX(units,"sec")  /= 0) THEN
+        kv  = INDEX(units,"sec")
+        dtv = 1.
+      ELSE IF (INDEX(units,"timesteps") /= 0) THEN
+        kv  = INDEX(units,"timesteps")
+        i_rc = NF90_GET_ATT(f_e,i_v,'tstep_sec',dtv)
+        IF (i_rc /= NF90_NOERR) THEN
+          CALL ipslerr (3,'fliogstc','"timesteps" value', &
+ &                        'not found','in the file')
+        ENDIF
+      ELSE
+        kv  = 1
+        dtv = 1.
+      ENDIF
+      IF (kv > 1) THEN
+        READ (unit=units(1:kv-1),FMT=*) dtn
+      ENDIF
+      t_step = dtn*dtv
+    ELSE IF (it_t == 2) THEN
+      i_rc = NF90_GET_ATT(f_e,NF90_GLOBAL,'delta_tstep_sec',t_step)
+    ELSE
+      t_step = 1.
+    ENDIF
+  ENDIF
+!-
+! Extracting the calendar attribute, if needed
+!-
+  IF (PRESENT(t_calendar)) THEN
+    units = ''
+    i_rc = NF90_GET_ATT(f_e,i_v,'calendar',units)
+    IF (i_rc == NF90_NOERR) THEN
+      t_calendar = units
+    ELSE
+      t_calendar = "not found"
+    ENDIF
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-fliogstc"
+  ENDIF
+!----------------------
+END SUBROUTINE fliogstc
+!===
+SUBROUTINE flioinqv &
+ & (f_i,v_n,l_ex,v_t,nb_dims,len_dims,id_dims, &
+ &  nb_atts,cn_atts,ia_start,ia_count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  LOGICAL,INTENT(OUT) :: l_ex
+  INTEGER,OPTIONAL,INTENT(OUT) :: v_t,nb_dims,nb_atts
+  INTEGER,OPTIONAL,INTENT(OUT),DIMENSION(:) :: len_dims,id_dims
+  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL,INTENT(OUT) :: cn_atts
+  INTEGER,OPTIONAL,INTENT(IN) :: ia_start,ia_count
+!-
+  INTEGER :: f_e,i_v,n_w,i_s,i_w,iws,iwc,i_rc
+  LOGICAL :: l_ok
+  INTEGER,DIMENSION(NF90_MAX_VAR_DIMS) :: dim_ids
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "->flioinqv ",TRIM(v_n)
+  ENDIF
+!-
+! Retrieve the external file index
+  CALL flio_qvid ('flioinqv',f_i,f_e)
+!-
+  i_v = -1
+  i_rc = NF90_INQ_VARID(f_e,v_n,i_v)
+!-
+  l_ex = ( (i_v >= 0).AND.(i_rc == NF90_NOERR) )
+!-
+  IF (l_ex) THEN
+    IF (PRESENT(v_t)) THEN
+      i_rc = NF90_INQUIRE_VARIABLE(f_e,i_v,xtype=v_t)
+    ENDIF
+    n_w = -1
+    IF (PRESENT(nb_dims).OR.PRESENT(len_dims)) THEN
+      i_rc = NF90_INQUIRE_VARIABLE(f_e,i_v, &
+ &             ndims=n_w,dimids=dim_ids)
+      IF (PRESENT(nb_dims)) THEN
+        nb_dims = n_w
+      ENDIF
+      IF (PRESENT(len_dims)) THEN
+        i_s = SIZE(len_dims)
+        len_dims(:) = -1
+        IF (i_s < n_w) THEN
+          CALL ipslerr (2,'flioinqv', &
+ &         'Only the first dimensions of the variable', &
+ &         TRIM(v_n),'will be returned')
+        ENDIF
+        DO i_w=1,MIN(n_w,i_s)
+          i_rc = NF90_INQUIRE_DIMENSION(f_e,dim_ids(i_w), &
+ &                                      len=len_dims(i_w))
+        ENDDO
+      ENDIF
+      IF (PRESENT(id_dims)) THEN
+        i_s = SIZE(id_dims)
+        id_dims(:) = -1
+        IF (i_s < n_w) THEN
+          CALL ipslerr (2,'flioinqv', &
+ &         'The number of dimensions to retrieve', &
+ &         'is greater than the size of the array,', &
+ &         'only the first dimensions of "' &
+ &           //TRIM(v_n)//'" will be returned')
+        ENDIF
+        i_w = MIN(n_w,i_s)
+        id_dims(1:i_w) = dim_ids(1:i_w)
+      ENDIF
+    ENDIF
+    IF (PRESENT(nb_atts).OR.PRESENT(cn_atts)) THEN
+      i_rc = NF90_INQUIRE_VARIABLE(f_e,i_v,nAtts=n_w)
+      IF (PRESENT(nb_atts)) THEN
+        nb_atts = n_w
+      ENDIF
+      IF (PRESENT(cn_atts)) THEN
+        l_ok = .TRUE.
+        i_s = SIZE(cn_atts)
+        DO i_w=1,i_s
+          cn_atts(i_w)(:) = '?'
+        ENDDO
+        IF (PRESENT(ia_start)) THEN
+          iws = ia_start
+        ELSE
+          iws = 1
+        ENDIF
+        IF (PRESENT(ia_count)) THEN
+          iwc = ia_count
+        ELSE
+          iwc = n_w
+        ENDIF
+        IF (iws > n_w) THEN
+          l_ok = .FALSE.
+          CALL ipslerr (2,'flioinqv', &
+ &         'The start index of requested attributes', &
+ &         'is greater than the number of attributes of', &
+ &         '"'//TRIM(v_n)//'"')
+        ELSE IF (iws < 1) THEN
+          l_ok = .FALSE.
+          CALL ipslerr (2,'flioinqv', &
+ &         'The start index of requested attributes', &
+ &         'is invalid ( < 1 ) for', &
+ &         '"'//TRIM(v_n)//'"')
+        ENDIF
+        IF ((iws+iwc-1) > n_w) THEN
+          CALL ipslerr (2,'flioinqv', &
+ &         'The number of requested attributes', &
+ &         'is greater than the number of attributes of', &
+ &         '"'//TRIM(v_n)//'"')
+        ENDIF
+        IF (iwc > i_s) THEN
+          CALL ipslerr (2,'flioinqv', &
+ &         'The number of attributes to retrieve', &
+ &         'is greater than the size of the array,', &
+ &         'only the first attributes of "' &
+ &           //TRIM(v_n)//'" will be returned')
+        ELSE IF (iwc < 1) THEN
+          l_ok = .FALSE.
+          CALL ipslerr (2,'flioinqv', &
+ &         'The number of requested attributes', &
+ &         'is invalid ( < 1 ) for', &
+ &         '"'//TRIM(v_n)//'"')
+        ENDIF
+        IF (l_ok) THEN
+          DO i_w=1,MIN(iwc,i_s,n_w-iws+1)
+            i_rc = NF90_INQ_ATTNAME(f_e, &
+ &                  i_v,i_w+iws-1,name=cn_atts(i_w))
+          ENDDO
+        ENDIF
+      ENDIF
+    ENDIF
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-flioinqv"
+  ENDIF
+!----------------------
+END SUBROUTINE flioinqv
+!===
+SUBROUTINE fliogv_i40 (f_i,v_n,v_v,start)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_4),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,i_40=v_v,start=start)
+!------------------------
+END SUBROUTINE fliogv_i40
+!===
+SUBROUTINE fliogv_i41 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_4),DIMENSION(:),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,i_41=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliogv_i41
+!===
+SUBROUTINE fliogv_i42 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_4),DIMENSION(:,:),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,i_42=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliogv_i42
+!===
+SUBROUTINE fliogv_i43 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_4),DIMENSION(:,:,:),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,i_43=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliogv_i43
+!===
+SUBROUTINE fliogv_i44 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_4),DIMENSION(:,:,:,:),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,i_44=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliogv_i44
+!===
+SUBROUTINE fliogv_i45 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_4),DIMENSION(:,:,:,:,:),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,i_45=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliogv_i45
+!===
+SUBROUTINE fliogv_i20 (f_i,v_n,v_v,start)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_2),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,i_20=v_v,start=start)
+!------------------------
+END SUBROUTINE fliogv_i20
+!===
+SUBROUTINE fliogv_i21 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_2),DIMENSION(:),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,i_21=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliogv_i21
+!===
+SUBROUTINE fliogv_i22 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_2),DIMENSION(:,:),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,i_22=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliogv_i22
+!===
+SUBROUTINE fliogv_i23 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_2),DIMENSION(:,:,:),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,i_23=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliogv_i23
+!===
+SUBROUTINE fliogv_i24 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_2),DIMENSION(:,:,:,:),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,i_24=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliogv_i24
+!===
+SUBROUTINE fliogv_i25 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_2),DIMENSION(:,:,:,:,:),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,i_25=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliogv_i25
+!===
+!?INTEGERS of KIND 1 are not supported on all computers
+!?SUBROUTINE fliogv_i10 (f_i,v_n,v_v,start)
+!?!---------------------------------------------------------------------
+!?  IMPLICIT NONE
+!?!-
+!?  INTEGER,INTENT(IN) :: f_i
+!?  CHARACTER(LEN=*),INTENT(IN) :: v_n
+!?  INTEGER(KIND=i_1),INTENT(OUT) :: v_v
+!?  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start
+!?!---------------------------------------------------------------------
+!?  CALL flio_ugv (f_i,v_n,i_10=v_v,start=start)
+!?!------------------------
+!?END SUBROUTINE fliogv_i10
+!?!===
+!?SUBROUTINE fliogv_i11 (f_i,v_n,v_v,start,count)
+!?!---------------------------------------------------------------------
+!?  IMPLICIT NONE
+!?!-
+!?  INTEGER,INTENT(IN) :: f_i
+!?  CHARACTER(LEN=*),INTENT(IN) :: v_n
+!?  INTEGER(KIND=i_1),DIMENSION(:),INTENT(OUT) :: v_v
+!?  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!?!---------------------------------------------------------------------
+!?  CALL flio_ugv (f_i,v_n,i_11=v_v,start=start,count=count)
+!?!------------------------
+!?END SUBROUTINE fliogv_i11
+!?!===
+!?SUBROUTINE fliogv_i12 (f_i,v_n,v_v,start,count)
+!?!---------------------------------------------------------------------
+!?  IMPLICIT NONE
+!?!-
+!?  INTEGER,INTENT(IN) :: f_i
+!?  CHARACTER(LEN=*),INTENT(IN) :: v_n
+!?  INTEGER(KIND=i_1),DIMENSION(:,:),INTENT(OUT) :: v_v
+!?  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!?!---------------------------------------------------------------------
+!?  CALL flio_ugv (f_i,v_n,i_12=v_v,start=start,count=count)
+!?!------------------------
+!?END SUBROUTINE fliogv_i12
+!?!===
+!?SUBROUTINE fliogv_i13 (f_i,v_n,v_v,start,count)
+!?!---------------------------------------------------------------------
+!?  IMPLICIT NONE
+!?!-
+!?  INTEGER,INTENT(IN) :: f_i
+!?  CHARACTER(LEN=*),INTENT(IN) :: v_n
+!?  INTEGER(KIND=i_1),DIMENSION(:,:,:),INTENT(OUT) :: v_v
+!?  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!?!---------------------------------------------------------------------
+!?  CALL flio_ugv (f_i,v_n,i_13=v_v,start=start,count=count)
+!?!------------------------
+!?END SUBROUTINE fliogv_i13
+!?!===
+!?SUBROUTINE fliogv_i14 (f_i,v_n,v_v,start,count)
+!?!---------------------------------------------------------------------
+!?  IMPLICIT NONE
+!?!-
+!?  INTEGER,INTENT(IN) :: f_i
+!?  CHARACTER(LEN=*),INTENT(IN) :: v_n
+!?  INTEGER(KIND=i_1),DIMENSION(:,:,:,:),INTENT(OUT) :: v_v
+!?  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!?!---------------------------------------------------------------------
+!?  CALL flio_ugv (f_i,v_n,i_14=v_v,start=start,count=count)
+!?!------------------------
+!?END SUBROUTINE fliogv_i14
+!?!===
+!?SUBROUTINE fliogv_i15 (f_i,v_n,v_v,start,count)
+!?!---------------------------------------------------------------------
+!?  IMPLICIT NONE
+!?!-
+!?  INTEGER,INTENT(IN) :: f_i
+!?  CHARACTER(LEN=*),INTENT(IN) :: v_n
+!?  INTEGER(KIND=i_1),DIMENSION(:,:,:,:,:),INTENT(OUT) :: v_v
+!?  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!?!---------------------------------------------------------------------
+!?  CALL flio_ugv (f_i,v_n,i_15=v_v,start=start,count=count)
+!?!------------------------
+!?END SUBROUTINE fliogv_i15
+!===
+SUBROUTINE fliogv_r40 (f_i,v_n,v_v,start)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_4),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,r_40=v_v,start=start)
+!------------------------
+END SUBROUTINE fliogv_r40
+!===
+SUBROUTINE fliogv_r41 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_4),DIMENSION(:),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,r_41=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliogv_r41
+!===
+SUBROUTINE fliogv_r42 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_4),DIMENSION(:,:),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,r_42=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliogv_r42
+!===
+SUBROUTINE fliogv_r43 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_4),DIMENSION(:,:,:),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,r_43=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliogv_r43
+!===
+SUBROUTINE fliogv_r44 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_4),DIMENSION(:,:,:,:),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,r_44=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliogv_r44
+!===
+SUBROUTINE fliogv_r45 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_4),DIMENSION(:,:,:,:,:),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,r_45=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliogv_r45
+!===
+SUBROUTINE fliogv_r80 (f_i,v_n,v_v,start)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_8),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,r_80=v_v,start=start)
+!------------------------
+END SUBROUTINE fliogv_r80
+!===
+SUBROUTINE fliogv_r81 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_8),DIMENSION(:),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,r_81=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliogv_r81
+!===
+SUBROUTINE fliogv_r82 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_8),DIMENSION(:,:),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,r_82=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliogv_r82
+!===
+SUBROUTINE fliogv_r83 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_8),DIMENSION(:,:,:),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,r_83=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliogv_r83
+!===
+SUBROUTINE fliogv_r84 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_8),DIMENSION(:,:,:,:),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,r_84=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliogv_r84
+!===
+SUBROUTINE fliogv_r85 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_8),DIMENSION(:,:,:,:,:),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,r_85=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliogv_r85
+!===
+SUBROUTINE flio_ugv &
+ & (f_i,v_n, &
+ &  i_40,i_41,i_42,i_43,i_44,i_45, &
+ &  i_20,i_21,i_22,i_23,i_24,i_25, &
+!? &  i_10,i_11,i_12,i_13,i_14,i_15, &
+ &  r_40,r_41,r_42,r_43,r_44,r_45, &
+ &  r_80,r_81,r_82,r_83,r_84,r_85, &
+ &  start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_4),INTENT(OUT),OPTIONAL :: i_40
+  INTEGER(KIND=i_4),DIMENSION(:),INTENT(OUT),OPTIONAL :: i_41
+  INTEGER(KIND=i_4),DIMENSION(:,:),INTENT(OUT),OPTIONAL :: i_42
+  INTEGER(KIND=i_4),DIMENSION(:,:,:),INTENT(OUT),OPTIONAL :: i_43
+  INTEGER(KIND=i_4),DIMENSION(:,:,:,:),INTENT(OUT),OPTIONAL :: i_44
+  INTEGER(KIND=i_4),DIMENSION(:,:,:,:,:),INTENT(OUT),OPTIONAL :: i_45
+  INTEGER(KIND=i_2),INTENT(OUT),OPTIONAL :: i_20
+  INTEGER(KIND=i_2),DIMENSION(:),INTENT(OUT),OPTIONAL :: i_21
+  INTEGER(KIND=i_2),DIMENSION(:,:),INTENT(OUT),OPTIONAL :: i_22
+  INTEGER(KIND=i_2),DIMENSION(:,:,:),INTENT(OUT),OPTIONAL :: i_23
+  INTEGER(KIND=i_2),DIMENSION(:,:,:,:),INTENT(OUT),OPTIONAL :: i_24
+  INTEGER(KIND=i_2),DIMENSION(:,:,:,:,:),INTENT(OUT),OPTIONAL :: i_25
+!?INTEGERS of KIND 1 are not supported on all computers
+!?INTEGER(KIND=i_1),INTENT(OUT),OPTIONAL :: i_10
+!?INTEGER(KIND=i_1),DIMENSION(:),INTENT(OUT),OPTIONAL :: i_11
+!?INTEGER(KIND=i_1),DIMENSION(:,:),INTENT(OUT),OPTIONAL :: i_12
+!?INTEGER(KIND=i_1),DIMENSION(:,:,:),INTENT(OUT),OPTIONAL :: i_13
+!?INTEGER(KIND=i_1),DIMENSION(:,:,:,:),INTENT(OUT),OPTIONAL :: i_14
+!?INTEGER(KIND=i_1),DIMENSION(:,:,:,:,:),INTENT(OUT),OPTIONAL :: i_15
+  REAL(KIND=r_4),INTENT(OUT),OPTIONAL :: r_40
+  REAL(KIND=r_4),DIMENSION(:),INTENT(OUT),OPTIONAL :: r_41
+  REAL(KIND=r_4),DIMENSION(:,:),INTENT(OUT),OPTIONAL :: r_42
+  REAL(KIND=r_4),DIMENSION(:,:,:),INTENT(OUT),OPTIONAL :: r_43
+  REAL(KIND=r_4),DIMENSION(:,:,:,:),INTENT(OUT),OPTIONAL :: r_44
+  REAL(KIND=r_4),DIMENSION(:,:,:,:,:),INTENT(OUT),OPTIONAL :: r_45
+  REAL(KIND=r_8),INTENT(OUT),OPTIONAL :: r_80
+  REAL(KIND=r_8),DIMENSION(:),INTENT(OUT),OPTIONAL :: r_81
+  REAL(KIND=r_8),DIMENSION(:,:),INTENT(OUT),OPTIONAL :: r_82
+  REAL(KIND=r_8),DIMENSION(:,:,:),INTENT(OUT),OPTIONAL :: r_83
+  REAL(KIND=r_8),DIMENSION(:,:,:,:),INTENT(OUT),OPTIONAL :: r_84
+  REAL(KIND=r_8),DIMENSION(:,:,:,:,:),INTENT(OUT),OPTIONAL :: r_85
+  INTEGER,DIMENSION(:),INTENT(IN),OPTIONAL :: start,count
+!-
+  INTEGER :: f_e,i_v,i_rc
+  CHARACTER(LEN=5) :: cvr_d
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    IF      (PRESENT(i_40)) THEN; cvr_d = "I1 0D";
+    ELSE IF (PRESENT(i_41)) THEN; cvr_d = "I1 1D";
+    ELSE IF (PRESENT(i_42)) THEN; cvr_d = "I1 2D";
+    ELSE IF (PRESENT(i_43)) THEN; cvr_d = "I1 3D";
+    ELSE IF (PRESENT(i_44)) THEN; cvr_d = "I1 4D";
+    ELSE IF (PRESENT(i_45)) THEN; cvr_d = "I1 5D";
+    ELSE IF (PRESENT(i_20)) THEN; cvr_d = "I2 0D";
+    ELSE IF (PRESENT(i_21)) THEN; cvr_d = "I2 1D";
+    ELSE IF (PRESENT(i_22)) THEN; cvr_d = "I2 2D";
+    ELSE IF (PRESENT(i_23)) THEN; cvr_d = "I2 3D";
+    ELSE IF (PRESENT(i_24)) THEN; cvr_d = "I2 4D";
+    ELSE IF (PRESENT(i_25)) THEN; cvr_d = "I2 5D";
+!?  ELSE IF (PRESENT(i_10)) THEN; cvr_d = "I4 0D";
+!?  ELSE IF (PRESENT(i_11)) THEN; cvr_d = "I4 1D";
+!?  ELSE IF (PRESENT(i_12)) THEN; cvr_d = "I4 2D";
+!?  ELSE IF (PRESENT(i_13)) THEN; cvr_d = "I4 3D";
+!?  ELSE IF (PRESENT(i_14)) THEN; cvr_d = "I4 4D";
+!?  ELSE IF (PRESENT(i_15)) THEN; cvr_d = "I4 5D";
+    ELSE IF (PRESENT(r_40)) THEN; cvr_d = "R4 0D";
+    ELSE IF (PRESENT(r_41)) THEN; cvr_d = "R4 1D";
+    ELSE IF (PRESENT(r_42)) THEN; cvr_d = "R4 2D";
+    ELSE IF (PRESENT(r_43)) THEN; cvr_d = "R4 3D";
+    ELSE IF (PRESENT(r_44)) THEN; cvr_d = "R4 4D";
+    ELSE IF (PRESENT(r_45)) THEN; cvr_d = "R4 5D";
+    ELSE IF (PRESENT(r_80)) THEN; cvr_d = "R8 0D";
+    ELSE IF (PRESENT(r_81)) THEN; cvr_d = "R8 1D";
+    ELSE IF (PRESENT(r_82)) THEN; cvr_d = "R8 2D";
+    ELSE IF (PRESENT(r_83)) THEN; cvr_d = "R8 3D";
+    ELSE IF (PRESENT(r_84)) THEN; cvr_d = "R8 4D";
+    ELSE IF (PRESENT(r_85)) THEN; cvr_d = "R8 5D";
+    ENDIF
+    WRITE(*,*) "->fliogetv ",TRIM(v_n)," ",TRIM(cvr_d)
+  ENDIF
+!-
+! Retrieve the external file index
+  CALL flio_qvid ('fliogetv',f_i,f_e)
+!-
+! Ensuring data mode
+!-
+  CALL flio_hdm (f_i,f_e,.FALSE.)
+!-
+  i_rc = NF90_INQ_VARID(f_e,v_n,i_v)
+  IF (i_rc == NF90_NOERR) THEN
+    IF      (PRESENT(i_40)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,i_40,start=start)
+    ELSE IF (PRESENT(i_41)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,i_41,start=start,count=count)
+    ELSE IF (PRESENT(i_42)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,i_42,start=start,count=count)
+    ELSE IF (PRESENT(i_43)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,i_43,start=start,count=count)
+    ELSE IF (PRESENT(i_44)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,i_44,start=start,count=count)
+    ELSE IF (PRESENT(i_45)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,i_45,start=start,count=count)
+    ELSE IF (PRESENT(i_20)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,i_20,start=start)
+    ELSE IF (PRESENT(i_21)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,i_21,start=start,count=count)
+    ELSE IF (PRESENT(i_22)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,i_22,start=start,count=count)
+    ELSE IF (PRESENT(i_23)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,i_23,start=start,count=count)
+    ELSE IF (PRESENT(i_24)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,i_24,start=start,count=count)
+    ELSE IF (PRESENT(i_25)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,i_25,start=start,count=count)
+!?  ELSE IF (PRESENT(i_10)) THEN
+!?    i_rc = NF90_GET_VAR(f_e,i_v,i_10,start=start)
+!?  ELSE IF (PRESENT(i_11)) THEN
+!?    i_rc = NF90_GET_VAR(f_e,i_v,i_11,start=start,count=count)
+!?  ELSE IF (PRESENT(i_12)) THEN
+!?    i_rc = NF90_GET_VAR(f_e,i_v,i_12,start=start,count=count)
+!?  ELSE IF (PRESENT(i_13)) THEN
+!?    i_rc = NF90_GET_VAR(f_e,i_v,i_13,start=start,count=count)
+!?  ELSE IF (PRESENT(i_14)) THEN
+!?    i_rc = NF90_GET_VAR(f_e,i_v,i_14,start=start,count=count)
+!?  ELSE IF (PRESENT(i_15)) THEN
+!?    i_rc = NF90_GET_VAR(f_e,i_v,i_15,start=start,count=count)
+    ELSE IF (PRESENT(r_40)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,r_40,start=start)
+    ELSE IF (PRESENT(r_41)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,r_41,start=start,count=count)
+    ELSE IF (PRESENT(r_42)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,r_42,start=start,count=count)
+    ELSE IF (PRESENT(r_43)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,r_43,start=start,count=count)
+    ELSE IF (PRESENT(r_44)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,r_44,start=start,count=count)
+    ELSE IF (PRESENT(r_45)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,r_45,start=start,count=count)
+    ELSE IF (PRESENT(r_80)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,r_80,start=start)
+    ELSE IF (PRESENT(r_81)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,r_81,start=start,count=count)
+    ELSE IF (PRESENT(r_82)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,r_82,start=start,count=count)
+    ELSE IF (PRESENT(r_83)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,r_83,start=start,count=count)
+    ELSE IF (PRESENT(r_84)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,r_84,start=start,count=count)
+    ELSE IF (PRESENT(r_85)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,r_85,start=start,count=count)
+    ENDIF
+    IF (i_rc /= NF90_NOERR) THEN
+      CALL ipslerr (3,'fliogetv', &
+ &      'Variable '//TRIM(v_n)//' not get','Error :', &
+ &      TRIM(NF90_STRERROR(i_rc)))
+    ENDIF
+  ELSE
+    CALL ipslerr (3,'fliogetv','Variable',TRIM(v_n),'not found')
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-fliogetv"
+  ENDIF
+!----------------------
+END SUBROUTINE flio_ugv
+!===
+SUBROUTINE flioinqa (f_i,v_n,a_n,l_ex,a_t,a_l)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
+  LOGICAL,INTENT(OUT) :: l_ex
+  INTEGER,OPTIONAL,INTENT(OUT) :: a_t,a_l
+!-
+  INTEGER :: i_rc,f_e,i_v,t_ea,l_ea
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "->flioinqa ",TRIM(v_n),"-",TRIM(a_n)
+  ENDIF
+!-
+! Retrieve the external file index
+  CALL flio_qvid ('flioinqa',f_i,f_e)
+!-
+  IF (TRIM(v_n) == '?') THEN
+    i_v = NF90_GLOBAL
+  ELSE
+    i_rc = NF90_INQ_VARID(f_e,v_n,i_v)
+    IF (i_rc /= NF90_NOERR) THEN
+      CALL ipslerr (3,'flioinqa', &
+       'Variable :',TRIM(v_n),'not found')
+    ENDIF
+  ENDIF
+!-
+  i_rc = NF90_INQUIRE_ATTRIBUTE(f_e,i_v,a_n,xtype=t_ea,len=l_ea)
+!-
+  l_ex = (i_rc == NF90_NOERR)
+!-
+  IF (l_ex) THEN
+    IF (PRESENT(a_t)) THEN
+      a_t = t_ea
+    ENDIF
+    IF (PRESENT(a_l)) THEN
+      a_l = l_ea
+    ENDIF
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-flioinqa"
+  ENDIF
+!----------------------
+END SUBROUTINE flioinqa
+!===
+SUBROUTINE flioga_r4_0d (f_i,v_n,a_n,a_v)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
+  REAL(KIND=4),INTENT(OUT) :: a_v
+!---------------------------------------------------------------------
+  CALL flio_uga (f_i,v_n,a_n,avr_4_0=a_v)
+!---------------------------
+END SUBROUTINE flioga_r4_0d
+!===
+SUBROUTINE flioga_r4_1d (f_i,v_n,a_n,a_v)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
+  REAL(KIND=4),DIMENSION(:),INTENT(OUT) :: a_v
+!---------------------------------------------------------------------
+  CALL flio_uga (f_i,v_n,a_n,avr_4_1=a_v)
+!--------------------------
+END SUBROUTINE flioga_r4_1d
+!===
+SUBROUTINE flioga_r8_0d (f_i,v_n,a_n,a_v)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
+  REAL(KIND=8),INTENT(OUT) :: a_v
+!---------------------------------------------------------------------
+  CALL flio_uga (f_i,v_n,a_n,avr_8_0=a_v)
+!---------------------------
+END SUBROUTINE flioga_r8_0d
+!===
+SUBROUTINE flioga_r8_1d (f_i,v_n,a_n,a_v)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
+  REAL(KIND=8),DIMENSION(:),INTENT(OUT) :: a_v
+!---------------------------------------------------------------------
+  CALL flio_uga (f_i,v_n,a_n,avr_8_1=a_v)
+!--------------------------
+END SUBROUTINE flioga_r8_1d
+!===
+SUBROUTINE flioga_i4_0d (f_i,v_n,a_n,a_v)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
+  INTEGER(KIND=4),INTENT(OUT) :: a_v
+!---------------------------------------------------------------------
+  CALL flio_uga (f_i,v_n,a_n,avi_4_0=a_v)
+!---------------------------
+END SUBROUTINE flioga_i4_0d
+!===
+SUBROUTINE flioga_i4_1d (f_i,v_n,a_n,a_v)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
+  INTEGER(KIND=4),DIMENSION(:),INTENT(OUT) :: a_v
+!---------------------------------------------------------------------
+  CALL flio_uga (f_i,v_n,a_n,avi_4_1=a_v)
+!--------------------------
+END SUBROUTINE flioga_i4_1d
+!===
+SUBROUTINE flioga_tx_0d (f_i,v_n,a_n,a_v)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
+  CHARACTER(LEN=*),INTENT(OUT) :: a_v
+!---------------------------------------------------------------------
+  CALL flio_uga (f_i,v_n,a_n,avtx=a_v)
+!---------------------------
+END SUBROUTINE flioga_tx_0d
+!===
+SUBROUTINE flio_uga &
+ & (f_i,v_n,a_n, &
+ &  avr_4_0,avr_4_1,avr_8_0,avr_8_1,avi_4_0,avi_4_1,avtx)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
+  REAL(KIND=4),OPTIONAL,INTENT(OUT) :: avr_4_0
+  REAL(KIND=4),DIMENSION(:),OPTIONAL,INTENT(OUT) :: avr_4_1
+  REAL(KIND=8),OPTIONAL,INTENT(OUT) :: avr_8_0
+  REAL(KIND=8),DIMENSION(:),OPTIONAL,INTENT(OUT) :: avr_8_1
+  INTEGER(KIND=4),OPTIONAL,INTENT(OUT) :: avi_4_0
+  INTEGER(KIND=4),DIMENSION(:),OPTIONAL,INTENT(OUT) :: avi_4_1
+  CHARACTER(LEN=*),OPTIONAL,INTENT(OUT) :: avtx
+!-
+  INTEGER :: f_e,l_ua,i_v,t_ea,l_ea,i_rc
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "->fliogeta ",TRIM(v_n)," ",TRIM(a_n)
+  ENDIF
+!-
+! Retrieve the external file index
+  CALL flio_qvid ('fliogeta',f_i,f_e)
+!-
+  IF (TRIM(v_n) == '?') THEN
+    i_v = NF90_GLOBAL
+  ELSE
+    i_rc = NF90_INQ_VARID(f_e,v_n,i_v)
+    IF (i_rc /= NF90_NOERR) THEN
+      CALL ipslerr (3,'fliogeta', &
+       'Variable :',TRIM(v_n),'not found')
+    ENDIF
+  ENDIF
+!-
+  i_rc = NF90_INQUIRE_ATTRIBUTE(f_e,i_v,a_n,xtype=t_ea,len=l_ea)
+  IF (i_rc /= NF90_NOERR) THEN
+    CALL ipslerr (3,'fliogeta', &
+ &   'Attribute :',TRIM(a_n),'not found')
+  ENDIF
+!-
+  IF ( (.NOT.PRESENT(avtx).AND.(t_ea == NF90_CHAR)) &
+ &      .OR.(PRESENT(avtx).AND.(t_ea /= NF90_CHAR)) ) THEN
+    CALL ipslerr (3,'fliogeta', &
+ &   'The external type of the attribute :',TRIM(a_n), &
+ &   'is not compatible with the type of the argument')
+  ENDIF
+!-
+  IF      (PRESENT(avr_4_1)) THEN
+    l_ua = SIZE(avr_4_1)
+  ELSE IF (PRESENT(avr_8_1)) THEN
+    l_ua = SIZE(avr_8_1)
+  ELSE IF (PRESENT(avi_4_1)) THEN
+    l_ua = SIZE(avi_4_1)
+  ELSE IF (PRESENT(avtx)) THEN
+    l_ua = LEN(avtx)
+  ELSE
+    l_ua = 1
+  ENDIF
+!-
+  IF (l_ua < l_ea) THEN
+    CALL ipslerr (3,'fliogeta', &
+     'Insufficient size of the argument', &
+ &   'to receive the values of the attribute :',TRIM(a_n))
+  ENDIF
+!-
+  IF      (PRESENT(avr_4_0)) THEN
+    i_rc = NF90_GET_ATT(f_e,i_v,a_n,avr_4_0)
+  ELSE IF (PRESENT(avr_4_1)) THEN
+    i_rc = NF90_GET_ATT(f_e,i_v,a_n,avr_4_1(1:l_ea))
+  ELSE IF (PRESENT(avr_8_0)) THEN
+    i_rc = NF90_GET_ATT(f_e,i_v,a_n,avr_8_0)
+  ELSE IF (PRESENT(avr_8_1)) THEN
+    i_rc = NF90_GET_ATT(f_e,i_v,a_n,avr_8_1(1:l_ea))
+  ELSE IF (PRESENT(avi_4_0)) THEN
+    i_rc = NF90_GET_ATT(f_e,i_v,a_n,avi_4_0)
+  ELSE IF (PRESENT(avi_4_1)) THEN
+    i_rc = NF90_GET_ATT(f_e,i_v,a_n,avi_4_1(1:l_ea))
+  ELSE IF (PRESENT(avtx)) THEN
+    i_rc = NF90_GET_ATT(f_e,i_v,a_n,avtx)
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-fliogeta"
+  ENDIF
+!----------------------
+END SUBROUTINE flio_uga
+!===
+SUBROUTINE fliorenv (f_i,v_o_n,v_n_n)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_o_n,v_n_n
+!-
+  INTEGER :: f_e,i_v,i_rc
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) &
+ &    "->fliorenv ",TRIM(v_o_n),"->",TRIM(v_n_n)
+  ENDIF
+!-
+! Retrieve the external file index
+  CALL flio_qvid ('fliorenv',f_i,f_e)
+!-
+  i_rc = NF90_INQ_VARID(f_e,v_o_n,i_v)
+  IF (i_rc /= NF90_NOERR) THEN
+    CALL ipslerr (2,'fliorenv', &
+     'Variable :',TRIM(v_o_n),'not found')
+  ELSE
+    CALL flio_hdm (f_i,f_e,.TRUE.)
+    i_rc = NF90_RENAME_VAR(f_e,i_v,v_n_n)
+    IF (i_rc /= NF90_NOERR) THEN
+      CALL ipslerr (2,'fliorenv', &
+       'Variable :',TRIM(v_o_n),'can not be renamed')
+    ENDIF
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-fliorenv"
+  ENDIF
+!----------------------
+END SUBROUTINE fliorenv
+!===
+SUBROUTINE fliorena (f_i,v_n,a_o_n,a_n_n)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n,a_o_n,a_n_n
+!-
+  INTEGER :: f_e,i_v,i_a,i_rc
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) &
+ &    "->fliorena ",TRIM(v_n),"-",TRIM(a_o_n),"->",TRIM(a_n_n)
+  ENDIF
+!-
+! Retrieve the external file index
+  CALL flio_qvid ('fliorena',f_i,f_e)
+!-
+  IF (TRIM(v_n) == '?') THEN
+    i_v = NF90_GLOBAL
+  ELSE
+    i_rc = NF90_INQ_VARID(f_e,v_n,i_v)
+    IF (i_rc /= NF90_NOERR) THEN
+      CALL ipslerr (3,'fliorena', &
+       'Variable :',TRIM(v_n),'not found')
+    ENDIF
+  ENDIF
+!-
+  i_rc = NF90_INQUIRE_ATTRIBUTE(f_e,i_v,a_o_n,attnum=i_a)
+  IF (i_rc /= NF90_NOERR) THEN
+    CALL ipslerr (2,'fliorena', &
+     'Attribute :',TRIM(a_o_n),'not found')
+  ELSE
+    CALL flio_hdm (f_i,f_e,.TRUE.)
+    i_rc = NF90_RENAME_ATT(f_e,i_v,a_o_n,a_n_n)
+    IF (i_rc /= NF90_NOERR) THEN
+      CALL ipslerr (2,'fliorena', &
+       'Attribute :',TRIM(a_o_n),'can not be renamed')
+    ENDIF
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-fliorena"
+  ENDIF
+!----------------------
+END SUBROUTINE fliorena
+!===
+SUBROUTINE fliodela (f_i,v_n,a_n)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
+!-
+  INTEGER :: f_e,i_v,i_a,i_rc
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "->fliodela ",TRIM(v_n),"-",TRIM(a_n)
+  ENDIF
+!-
+! Retrieve the external file index
+  CALL flio_qvid ('fliodela',f_i,f_e)
+!-
+  IF (TRIM(v_n) == '?') THEN
+    i_v = NF90_GLOBAL
+  ELSE
+    i_rc = NF90_INQ_VARID(f_e,v_n,i_v)
+    IF (i_rc /= NF90_NOERR) THEN
+      CALL ipslerr (3,'fliodela', &
+ &     'Variable :',TRIM(v_n),'not found')
+    ENDIF
+  ENDIF
+!-
+  i_rc = NF90_INQUIRE_ATTRIBUTE(f_e,i_v,a_n,attnum=i_a)
+  IF (i_rc /= NF90_NOERR) THEN
+    CALL ipslerr (2,'fliodela', &
+ &   'Attribute :',TRIM(a_n),'not found')
+  ELSE
+    IF (i_v == NF90_GLOBAL) THEN
+      nw_na(f_i) = nw_na(f_i)-1
+    ENDIF
+    CALL flio_hdm (f_i,f_e,.TRUE.)
+    i_rc = NF90_DEL_ATT(f_e,i_v,a_n)
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-fliodela"
+  ENDIF
+!----------------------
+END SUBROUTINE fliodela
+!===
+SUBROUTINE fliocpya (f_i_i,v_n_i,a_n,f_i_o,v_n_o)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i_i,f_i_o
+  CHARACTER(LEN=*),INTENT(IN) :: v_n_i,a_n,v_n_o
+!-
+  INTEGER :: f_e_i,f_e_o,i_v_i,i_v_o,i_a,i_rc
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "->fliocpya - file",f_i_i,"-",TRIM(v_n_i),"-",TRIM(a_n)
+    WRITE(*,*) "  copied to file ",f_i_o,"-",TRIM(v_n_o)
+  ENDIF
+!-
+! Retrieve the external file index
+  CALL flio_qvid ('fliocpya',f_i_i,f_e_i)
+  CALL flio_qvid ('fliocpya',f_i_o,f_e_o)
+!-
+  IF (TRIM(v_n_i) == '?') THEN
+    i_v_i = NF90_GLOBAL
+  ELSE
+    i_rc = NF90_INQ_VARID(f_e_i,v_n_i,i_v_i)
+    IF (i_rc /= NF90_NOERR) THEN
+      CALL ipslerr (3,'fliocpya', &
+ &     'Variable :',TRIM(v_n_i),'not found')
+    ENDIF
+  ENDIF
+!-
+  IF (TRIM(v_n_o) == '?') THEN
+    i_v_o = NF90_GLOBAL
+  ELSE
+    i_rc = NF90_INQ_VARID(f_e_o,v_n_o,i_v_o)
+    IF (i_rc /= NF90_NOERR) THEN
+      CALL ipslerr (3,'fliocpya', &
+ &     'Variable :',TRIM(v_n_o),'not found')
+    ENDIF
+  ENDIF
+!-
+  i_rc = NF90_INQUIRE_ATTRIBUTE(f_e_i,i_v_i,a_n,attnum=i_a)
+  IF (i_rc /= NF90_NOERR) THEN
+    CALL ipslerr (3,'fliocpya', &
+     'Attribute :',TRIM(a_n),'not found')
+  ELSE
+    i_rc = NF90_INQUIRE_ATTRIBUTE(f_e_o,i_v_o,a_n,attnum=i_a)
+    IF ( (i_v_o == NF90_GLOBAL).AND.(i_rc /= NF90_NOERR) ) THEN
+      nw_na(f_i_o) = nw_na(f_i_o)+1
+    ENDIF
+    CALL flio_hdm (f_i_o,f_e_o,.TRUE.)
+    i_rc = NF90_COPY_ATT(f_e_i,i_v_i,a_n,f_e_o,i_v_o)
+    IF (i_rc /= NF90_NOERR) THEN
+      CALL ipslerr (3,'fliocpya', &
+ &      'Attribute '//TRIM(a_n)//' not copied','Error :', &
+ &      TRIM(NF90_STRERROR(i_rc)))
+    ENDIF
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-fliocpya"
+  ENDIF
+!----------------------
+END SUBROUTINE fliocpya
+!===
+SUBROUTINE flioqstc (f_i,c_type,l_ex,c_name)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: c_type
+  LOGICAL,INTENT(OUT) :: l_ex
+  CHARACTER(LEN=*),INTENT(OUT) :: c_name
+!-
+  CHARACTER(LEN=1) :: c_ax
+  INTEGER :: f_e,idc,ndc,i_rc
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "->flioqstc ",TRIM(c_type)
+  ENDIF
+!-
+! Retrieve the external file index
+  CALL flio_qvid ('flioqstc',f_i,f_e)
+!-
+  c_ax = TRIM(c_type)
+  IF (    (LEN_TRIM(c_type) == 1) &
+ &    .AND.(    (c_ax == 'x').OR.(c_ax == 'y') &
+ &          .OR.(c_ax == 'z').OR.(c_ax == 't')) ) THEN
+    CALL flio_qax (f_i,c_ax,idc,ndc)
+    l_ex = (idc > 0)
+    IF (l_ex) THEN
+      i_rc = NF90_INQUIRE_VARIABLE(f_e,idc,name=c_name)
+    ENDIF
+  ELSE
+    l_ex = .FALSE.
+    CALL ipslerr (2,'flioqstc', &
+ &   'The name of the coordinate,',TRIM(c_type),'is not valid')
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-flioqstc"
+  ENDIF
+!----------------------
+END SUBROUTINE flioqstc
+!===
+SUBROUTINE fliosync (f_i)
+!---------------------------------------------------------------------
+  INTEGER,INTENT(in),OPTIONAL :: f_i
+!-
+  INTEGER :: i_f,f_e,i_rc,i_s,i_e
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "->fliosync"
+  ENDIF
+!-
+  IF (PRESENT(f_i)) THEN
+    IF ( (f_i >= 1).AND.(f_i <= nb_fi_mx) ) THEN
+      i_s = f_i
+      i_e = f_i
+    ELSE
+      i_s = 1
+      i_e = 0
+      CALL ipslerr (2,'fliosync', &
+ &     'Invalid file identifier',' ',' ')
+    ENDIF
+  ELSE
+    i_s = 1
+    i_e = nb_fi_mx
+  ENDIF
+!-
+! Ensuring data mode
+!-
+  CALL flio_hdm (f_i,f_e,.FALSE.)
+!-
+  DO i_f=i_s,i_e
+    f_e = nw_id(i_f)
+    IF (f_e > 0) THEN
+      IF (l_dbg) THEN
+        WRITE(*,*) '  fliosync - synchronising file number ',i_f
+      ENDIF
+      i_rc = NF90_SYNC(f_e)
+    ELSE IF (PRESENT(f_i)) THEN
+      CALL ipslerr (2,'fliosync', &
+ &     'Unable to synchronise the file :','probably','not opened')
+    ENDIF
+  ENDDO
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-fliosync"
+  ENDIF
+!----------------------
+END SUBROUTINE fliosync
+!===
+SUBROUTINE flioclo (f_i)
+!---------------------------------------------------------------------
+  INTEGER,INTENT(in),OPTIONAL :: f_i
+!-
+  INTEGER :: i_f,f_e,i_rc,i_s,i_e
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "->flioclo"
+  ENDIF
+!-
+  IF (PRESENT(f_i)) THEN
+    IF ( (f_i >= 1).AND.(f_i <= nb_fi_mx) ) THEN
+      i_s = f_i
+      i_e = f_i
+    ELSE
+      i_s = 1
+      i_e = 0
+      CALL ipslerr (2,'flioclo', &
+ &     'Invalid file identifier',' ',' ')
+    ENDIF
+  ELSE
+    i_s = 1
+    i_e = nb_fi_mx
+  ENDIF
+!-
+  DO i_f=i_s,i_e
+    f_e = nw_id(i_f)
+    IF (f_e > 0) THEN
+      IF (l_dbg) THEN
+        WRITE(*,*) '  flioclo - closing file number ',i_f
+      ENDIF
+      i_rc = NF90_CLOSE(f_e)
+      nw_id(i_f) = -1
+    ELSE IF (PRESENT(f_i)) THEN
+      CALL ipslerr (2,'flioclo', &
+ &     'Unable to close the file :','probably','not opened')
+    ENDIF
+  ENDDO
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-flioclo"
+  ENDIF
+!---------------------
+END SUBROUTINE flioclo
+!===
+SUBROUTINE fliodmpf (f_n)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(IN) :: f_n
+!-
+  INTEGER :: f_e,n_dims,n_vars,n_atts,i_unlm
+  INTEGER :: i_rc,i_n,k_n,t_ea,l_ea
+  INTEGER :: tmp_i
+  REAL    :: tmp_r
+  INTEGER,DIMENSION(:),ALLOCATABLE :: tma_i
+  REAL,DIMENSION(:),ALLOCATABLE    :: tma_r
+  CHARACTER(LEN=256) :: tmp_c
+  INTEGER,DIMENSION(nb_fd_mx) :: n_idim,n_ldim
+  INTEGER,DIMENSION(nb_ax_mx) :: n_ai
+  CHARACTER(LEN=NF90_MAX_NAME),DIMENSION(nb_fd_mx) :: c_ndim
+  INTEGER,DIMENSION(NF90_MAX_VAR_DIMS) :: idimid
+  CHARACTER(LEN=NF90_MAX_NAME) :: c_name
+!---------------------------------------------------------------------
+  i_rc = NF90_OPEN(TRIM(f_n),NF90_NOWRITE,f_e)
+  IF (i_rc /= NF90_NOERR) THEN
+    CALL ipslerr (3,'fliodmpf', &
+ &   'Could not open file :',TRIM(f_n), &
+ &   TRIM(NF90_STRERROR(i_rc))//' (Netcdf)')
+  ENDIF
+!-
+  WRITE (*,*) "---"
+  WRITE (*,*) "--- File '",TRIM(f_n),"'"
+  WRITE (*,*) "---"
+!-
+  CALL flio_inf &
+ &  (f_e,nb_dims=n_dims,nb_vars=n_vars, &
+ &       nb_atts=n_atts,id_unlm=i_unlm, &
+ &       nn_idm=n_idim,nn_ldm=n_ldim,cc_ndm=c_ndim,nn_aid=n_ai)
+!-
+  WRITE (*,*) 'External model identifier   : ',f_e
+  WRITE (*,*) 'Number of dimensions        : ',n_dims
+  WRITE (*,*) 'Number of variables         : ',n_vars
+  WRITE (*,*) 'ID unlimited                : ',i_unlm
+!-
+  WRITE (*,*) "---"
+  WRITE (*,*) 'Presumed axis dimensions identifiers :'
+  IF (n_ai(k_lon) > 0) THEN
+    WRITE (*,*) 'x axis : ',n_ai(k_lon)
+  ELSE
+    WRITE (*,*) 'x axis : NONE'
+  ENDIF
+  IF (n_ai(k_lat) > 0) THEN
+    WRITE (*,*) 'y axis : ',n_ai(k_lat)
+  ELSE
+    WRITE (*,*) 'y axis : NONE'
+  ENDIF
+  IF (n_ai(k_lev) > 0) THEN
+    WRITE (*,*) 'z axis : ',n_ai(k_lev)
+  ELSE
+    WRITE (*,*) 'z axis : NONE'
+  ENDIF
+  IF (n_ai(k_tim) > 0) THEN
+    WRITE (*,*) 't axis : ',n_ai(k_tim)
+  ELSE
+    WRITE (*,*) 't axis : NONE'
+  ENDIF
+!-
+  WRITE (*,*) "---"
+  WRITE (*,*) 'Number of global attributes : ',n_atts
+  DO k_n=1,n_atts
+    i_rc = NF90_INQ_ATTNAME(f_e,NF90_GLOBAL,k_n,c_name)
+    i_rc = NF90_INQUIRE_ATTRIBUTE(f_e,NF90_GLOBAL,c_name, &
+ &                                xtype=t_ea,len=l_ea)
+    IF      (    (t_ea == NF90_INT4).OR.(t_ea == NF90_INT2) &
+             .OR.(t_ea == NF90_INT1) ) THEN
+      IF (l_ea > 1) THEN
+        ALLOCATE(tma_i(l_ea))
+        i_rc = NF90_GET_ATT(f_e,NF90_GLOBAL,c_name,tma_i)
+        WRITE (*,'("    ",A," :",/,(5(1X,I10),:))') &
+ &        TRIM(c_name),tma_i(1:l_ea)
+        DEALLOCATE(tma_i)
+      ELSE
+        i_rc = NF90_GET_ATT(f_e,NF90_GLOBAL,c_name,tmp_i)
+        WRITE(*,*) '   ',TRIM(c_name),' : ',tmp_i
+      ENDIF
+    ELSE IF ( (t_ea == NF90_REAL4).OR.(t_ea == NF90_REAL8) ) THEN
+      IF (l_ea > 1) THEN
+        ALLOCATE(tma_r(l_ea))
+        i_rc = NF90_GET_ATT(f_e,NF90_GLOBAL,c_name,tma_r)
+        WRITE (*,'("    ",A," :",/,(5(1X,1PE11.3),:))') &
+ &        TRIM(c_name),tma_r(1:l_ea)
+        DEALLOCATE(tma_r)
+      ELSE
+        i_rc = NF90_GET_ATT(f_e,NF90_GLOBAL,c_name,tmp_r)
+        WRITE(*,*) '   ',TRIM(c_name),' : ',tmp_r
+      ENDIF
+    ELSE
+      tmp_c = ''
+      i_rc = NF90_GET_ATT(f_e,NF90_GLOBAL,c_name,tmp_c)
+      WRITE(*,*) '   ',TRIM(c_name),' : "',TRIM(tmp_c),'"'
+    ENDIF
+  ENDDO
+!-
+  DO i_n=1,nb_fd_mx
+    IF (n_idim(i_n) > 0) THEN
+      WRITE (*,*) "---"
+      WRITE (*,*) 'Dimension id   : ',n_idim(i_n)
+      WRITE (*,*) 'Dimension name : ',TRIM(c_ndim(i_n))
+      WRITE (*,*) 'Dimension size : ',n_ldim(i_n)
+    ENDIF
+  ENDDO
+!-
+  DO i_n=1,n_vars
+    i_rc = NF90_INQUIRE_VARIABLE(f_e,i_n, &
+ &           name=c_name,ndims=n_dims,dimids=idimid,nAtts=n_atts)
+    WRITE (*,*) "---"
+    WRITE (*,*) "Variable name        : ",TRIM(c_name)
+    WRITE (*,*) "Variable identifier  : ",i_n
+    WRITE (*,*) "Number of dimensions : ",n_dims
+    IF (n_dims > 0) THEN
+      WRITE (*,*) "Dimensions ID's      : ",idimid(1:n_dims)
+    ENDIF
+    WRITE (*,*) "Number of attributes : ",n_atts
+    DO k_n=1,n_atts
+      i_rc = NF90_INQ_ATTNAME(f_e,i_n,k_n,c_name)
+      i_rc = NF90_INQUIRE_ATTRIBUTE(f_e,i_n,c_name, &
+ &                                  xtype=t_ea,len=l_ea)
+      IF      (    (t_ea == NF90_INT4).OR.(t_ea == NF90_INT2) &
+ &             .OR.(t_ea == NF90_INT1) ) THEN
+        IF (l_ea > 1) THEN
+          ALLOCATE(tma_i(l_ea))
+          i_rc = NF90_GET_ATT(f_e,i_n,c_name,tma_i)
+          WRITE (*,'("    ",A," :",/,(5(1X,I10),:))') &
+ &              TRIM(c_name),tma_i(1:l_ea)
+          DEALLOCATE(tma_i)
+        ELSE
+          i_rc = NF90_GET_ATT(f_e,i_n,c_name,tmp_i)
+          WRITE(*,*) '   ',TRIM(c_name),' : ',tmp_i
+        ENDIF
+      ELSE IF ( (t_ea == NF90_REAL4).OR.(t_ea == NF90_REAL8) ) THEN
+        IF (l_ea > 1) THEN
+          ALLOCATE(tma_r(l_ea))
+          i_rc = NF90_GET_ATT(f_e,i_n,c_name,tma_r)
+          WRITE (*,'("    ",A," :",/,(5(1X,1PE11.3),:))') &
+ &          TRIM(c_name),tma_r(1:l_ea)
+          DEALLOCATE(tma_r)
+        ELSE
+          i_rc = NF90_GET_ATT(f_e,i_n,c_name,tmp_r)
+          WRITE(*,*) '   ',TRIM(c_name),' : ',tmp_r
+        ENDIF
+      ELSE
+        tmp_c = ''
+        i_rc = NF90_GET_ATT(f_e,i_n,c_name,tmp_c)
+        WRITE(*,*) '   ',TRIM(c_name),' : "',TRIM(tmp_c),'"'
+      ENDIF
+    ENDDO
+  ENDDO
+  WRITE (*,*) "---"
+!-
+  i_rc = NF90_CLOSE(f_e)
+!----------------------
+END SUBROUTINE fliodmpf
+!===
+SUBROUTINE flio_dom_set &
+ & (dtnb,dnb,did,dsg,dsl,dpf,dpl,dhs,dhe,cdnm,id_dom)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: dtnb,dnb
+  INTEGER,DIMENSION(:),INTENT(IN) :: did,dsg,dsl,dpf,dpl,dhs,dhe
+  CHARACTER(LEN=*),INTENT(IN) :: cdnm
+  INTEGER,INTENT(OUT) :: id_dom
+!-
+  INTEGER :: k_w,i_w,i_s
+  CHARACTER(LEN=l_dns) :: cd_p,cd_w
+!---------------------------------------------------------------------
+  k_w = flio_dom_rid()
+  IF (k_w < 0) THEN
+    CALL ipslerr (3,'flio_dom_set', &
+ &   'too many domains simultaneously defined', &
+ &   'please unset useless domains', &
+ &   'by calling flio_dom_unset')
+  ENDIF
+  id_dom = k_w
+!-
+  d_n_t(k_w) = dtnb
+  d_n_c(k_w) = dnb
+!-
+  i_s = SIZE(did)
+  IF (i_s > dom_max_dims) THEN
+    CALL ipslerr (3,'flio_dom_set', &
+ &   'too many distributed dimensions', &
+ &   'simultaneously defined',' ')
+  ENDIF
+  d_d_n(k_w) = i_s
+  d_d_i(1:i_s,k_w) = did(1:i_s)
+!-
+  i_w = SIZE(dsg)
+  IF (i_w /= i_s) THEN
+    CALL ipslerr (3,'flio_dom_set', &
+ &   'the size of the DOMAIN_size_global array', &
+ &   'is not equal to the size', &
+ &   'of the distributed dimensions array')
+  ENDIF
+  d_s_g(1:i_w,k_w) = dsg(1:i_w)
+!-
+  i_w = SIZE(dsl)
+  IF (i_w /= i_s) THEN
+    CALL ipslerr (3,'flio_dom_set', &
+ &   'the size of the DOMAIN_size_local array', &
+ &   'is not equal to the size', &
+ &   'of the distributed dimensions array')
+  ENDIF
+  d_s_l(1:i_w,k_w) = dsl(1:i_w)
+!-
+  i_w = SIZE(dpf)
+  IF (i_w /= i_s) THEN
+    CALL ipslerr (3,'flio_dom_set', &
+ &   'the size of the DOMAIN_position_first array', &
+ &   'is not equal to the size', &
+ &   'of the distributed dimensions array')
+  ENDIF
+  d_p_f(1:i_w,k_w) = dpf(1:i_w)
+!-
+  i_w = SIZE(dpl)
+  IF (i_w /= i_s) THEN
+    CALL ipslerr (3,'flio_dom_set', &
+ &   'the size of the DOMAIN_position_last array', &
+ &   'is not equal to the size', &
+ &   'of the distributed dimensions array')
+  ENDIF
+  d_p_l(1:i_w,k_w) = dpl(1:i_w)
+!-
+  i_w = SIZE(dhs)
+  IF (i_w /= i_s) THEN
+    CALL ipslerr (3,'flio_dom_set', &
+ &   'the size of the DOMAIN_halo_size_start array', &
+ &   'is not equal to the size', &
+ &   'of the distributed dimensions array')
+  ENDIF
+  d_h_s(1:i_w,k_w) = dhs(1:i_w)
+!-
+  i_w = SIZE(dhe)
+  IF (i_w /= i_s) THEN
+    CALL ipslerr (3,'flio_dom_set', &
+ &   'the size of the DOMAIN_halo_size_end array', &
+ &   'is not equal to the size', &
+ &   'of the distributed dimensions array')
+  ENDIF
+  d_h_e(1:i_w,k_w) = dhe(1:i_w)
+!-
+  cd_p = "unknown"
+  cd_w = cdnm; CALL strlowercase (cd_w)
+  DO i_w=1,n_dns
+    IF (TRIM(cd_w) == TRIM(c_dns(i_w))) THEN
+      cd_p = cd_w; EXIT;
+    ENDIF
+  ENDDO
+  IF (TRIM(cd_p) == "unknown") THEN
+    CALL ipslerr (3,'flio_dom_set', &
+ &   'DOMAIN_type "'//TRIM(cdnm)//'"', &
+ &   'is actually not supported', &
+ &   'please use one of the supported names')
+  ENDIF
+  c_d_t(k_w) = cd_p
+!--------------------------
+END SUBROUTINE flio_dom_set
+!===
+SUBROUTINE flio_dom_unset (id_dom)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN),OPTIONAL :: id_dom
+!-
+  INTEGER :: i_w
+!---------------------------------------------------------------------
+  IF (PRESENT(id_dom)) THEN
+    IF ( (id_dom >= 1).AND.(id_dom <= dom_max_nb) ) THEN
+      IF (d_d_n(id_dom) > 0) THEN
+        d_d_n(id_dom) = -1
+      ELSE
+        CALL ipslerr (2,'flio_dom_unset', &
+ &       'The domain is not set',' ',' ')
+      ENDIF
+    ELSE
+      CALL ipslerr (2,'flio_dom_unset', &
+ &     'Invalid file identifier',' ',' ')
+    ENDIF
+  ELSE
+    DO i_w=1,dom_max_nb
+      d_d_n(id_dom) = -1
+    ENDDO
+  ENDIF
+!----------------------------
+END SUBROUTINE flio_dom_unset
+!===
+SUBROUTINE flio_dom_defset (id_dom)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: id_dom
+!---------------------------------------------------------------------
+  IF ( (id_dom >= 1).AND.(id_dom <= dom_max_nb) ) THEN
+    id_def_dom = id_dom
+  ELSE
+    CALL ipslerr (3,'flio_dom_defset', &
+ &   'Invalid domain identifier',' ',' ')
+  ENDIF
+!-----------------------------
+END SUBROUTINE flio_dom_defset
+!===
+SUBROUTINE flio_dom_defunset ()
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!---------------------------------------------------------------------
+  id_def_dom = FLIO_DOM_NONE
+!-------------------------------
+END SUBROUTINE flio_dom_defunset
+!===
+SUBROUTINE flio_dom_definq (id_dom)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(OUT) :: id_dom
+!---------------------------------------------------------------------
+  id_dom = id_def_dom
+!-----------------------------
+END SUBROUTINE flio_dom_definq
+!===
+!-
+!---------------------------------------------------------------------
+!- Semi-public procedures
+!---------------------------------------------------------------------
+!-
+!===
+SUBROUTINE flio_dom_file (f_n,id_dom)
+!---------------------------------------------------------------------
+!- Update the model file name to include the ".nc" suffix and
+!- the DOMAIN number on which this copy of IOIPSL runs, if needed.
+!- This routine is called by IOIPSL and not by user anyway.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(INOUT) :: f_n
+  INTEGER,OPTIONAL,INTENT(IN) :: id_dom
+!-
+  INTEGER :: il,iw
+  CHARACTER(LEN=4) :: str
+!---------------------------------------------------------------------
+!-
+! Add the ".nc" suffix if needed
+  il = LEN_TRIM(f_n)
+  IF (f_n(il-2:il) /= '.nc') THEN
+    f_n = f_n(1:il)//'.nc'
+  ENDIF
+!-
+! Add the DOMAIN identifier if needed
+  IF (PRESENT(id_dom)) THEN
+    IF (id_dom == FLIO_DOM_DEFAULT) THEN
+      CALL flio_dom_definq (iw)
+    ELSE
+      iw = id_dom
+    ENDIF
+    IF (iw /= FLIO_DOM_NONE) THEN
+      IF ( (id_dom >= 1).AND.(id_dom <= dom_max_nb) ) THEN
+        IF (d_d_n(iw) > 0) THEN
+          WRITE(str,'(I4.4)') d_n_c(iw)
+          il = INDEX(f_n,'.nc')
+          f_n = f_n(1:il-1)//'_'//str//'.nc'
+        ELSE
+          CALL ipslerr (3,'flio_dom_file', &
+ &         'The domain has not been defined', &
+ &         'please call flio_dom_set', &
+ &         'before calling flio_dom_file')
+        ENDIF
+      ELSE
+        CALL ipslerr (3,'flio_dom_file', &
+ &       'Invalid domain identifier',' ',' ')
+      ENDIF
+    ENDIF
+  ENDIF
+!---------------------------
+END SUBROUTINE flio_dom_file
+!===
+SUBROUTINE flio_dom_att (f_e,id_dom)
+!---------------------------------------------------------------------
+!- Add the DOMAIN attributes to the NETCDF file.
+!- This routine is called by IOIPSL and not by user anyway.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(in) :: f_e
+  INTEGER,OPTIONAL,INTENT(IN) :: id_dom
+!-
+  INTEGER :: iw,i_rc,i_n
+  CHARACTER(LEN=15) :: c_ddim
+  INTEGER :: n_idim
+  CHARACTER(LEN=NF90_MAX_NAME) :: c_ndim
+!---------------------------------------------------------------------
+  IF (PRESENT(id_dom)) THEN
+    IF (id_dom == FLIO_DOM_DEFAULT) THEN
+      CALL flio_dom_definq (iw)
+    ELSE
+      iw = id_dom
+    ENDIF
+    IF (iw /= FLIO_DOM_NONE) THEN
+      IF ( (id_dom >= 1).AND.(id_dom <= dom_max_nb) ) THEN
+        IF (d_d_n(iw) > 0) THEN
+          i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL, &
+ &          'DOMAIN_number_total',d_n_t(iw))
+          i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL, &
+ &          'DOMAIN_number',d_n_c(iw))
+          i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL, &
+ &          'DOMAIN_dimensions_ids',d_d_i(1:d_d_n(iw),iw))
+          i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL, &
+ &          'DOMAIN_size_global',d_s_g(1:d_d_n(iw),iw))
+          i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL, &
+ &          'DOMAIN_size_local',d_s_l(1:d_d_n(iw),iw))
+          i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL, &
+ &          'DOMAIN_position_first',d_p_f(1:d_d_n(iw),iw))
+          i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL, &
+ &          'DOMAIN_position_last',d_p_l(1:d_d_n(iw),iw))
+          i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL, &
+ &          'DOMAIN_halo_size_start',d_h_s(1:d_d_n(iw),iw))
+          i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL, &
+ &          'DOMAIN_halo_size_end',d_h_e(1:d_d_n(iw),iw))
+          i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL, &
+ &          'DOMAIN_type',TRIM(c_d_t(iw)))
+          i_rc = NF90_INQUIRE (f_e,nDimensions=n_idim)
+          DO i_n=1,n_idim
+            i_rc = NF90_INQUIRE_DIMENSION (f_e,i_n,name=c_ndim)
+            WRITE (UNIT=c_ddim,FMT='("DOMAIN_DIM_N",I3.3)') i_n
+            i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL,c_ddim,TRIM(c_ndim))
+          ENDDO
+        ELSE
+          CALL ipslerr (3,'flio_dom_att', &
+ &         'The domain has not been defined', &
+ &         'please call flio_dom_set', &
+ &         'before calling flio_dom_att')
+        ENDIF
+      ELSE
+        CALL ipslerr (3,'flio_dom_att', &
+ &       'Invalid domain identifier',' ',' ')
+      ENDIF
+    ENDIF
+  ENDIF
+!--------------------------
+END SUBROUTINE flio_dom_att
+!===
+!-
+!---------------------------------------------------------------------
+!- Local procedures
+!---------------------------------------------------------------------
+!-
+!===
+INTEGER FUNCTION flio_rid()
+!---------------------------------------------------------------------
+!- returns a free index in nw_id(:)
+!---------------------------------------------------------------------
+  INTEGER,DIMENSION(1:1) :: nfi
+!-
+  IF (ANY(nw_id < 0)) THEN
+    nfi = MINLOC(nw_id,MASK=nw_id < 0)
+    flio_rid = nfi(1)
+  ELSE
+    flio_rid = -1
+  ENDIF
+!--------------------
+END FUNCTION flio_rid
+!===
+INTEGER FUNCTION flio_dom_rid()
+!---------------------------------------------------------------------
+!- returns a free index in d_d_n(:)
+!---------------------------------------------------------------------
+  INTEGER,DIMENSION(1:1) :: nd
+!---------------------------------------------------------------------
+  IF (ANY(d_d_n < 0)) THEN
+    nd = MINLOC(d_d_n,MASK=d_d_n < 0)
+    flio_dom_rid = nd(1)
+  ELSE
+    flio_dom_rid = -1
+  ENDIF
+!------------------------
+END FUNCTION flio_dom_rid
+!===
+INTEGER FUNCTION flio_qid(iid)
+!---------------------------------------------------------------------
+!- returns the external index associated with the internal index "iid"
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: iid
+!---------------------------------------------------------------------
+  IF ( (iid >= 1).AND.(iid <= nb_fi_mx) ) THEN
+    flio_qid = nw_id(iid)
+  ELSE
+    flio_qid = -1
+  ENDIF
+!--------------------
+END FUNCTION flio_qid
+!===
+SUBROUTINE flio_qvid (cpg,iid,ixd)
+!---------------------------------------------------------------------
+!- This subroutine, called by the procedure "cpg",
+!- validates and returns the external file index "ixd"
+!- associated with the internal file index "iid"
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(IN) :: cpg
+  INTEGER,INTENT(IN)  :: iid
+  INTEGER,INTENT(OUT) :: ixd
+!-
+  CHARACTER(LEN=20) :: c_t
+!---------------------------------------------------------------------
+  ixd = flio_qid(iid)
+  IF (ixd < 0) THEN
+    WRITE (UNIT=c_t,FMT='(I15)') iid
+    CALL ipslerr (3,TRIM(cpg), &
+ &    'Invalid internal file index :',TRIM(ADJUSTL(c_t)),' ')
+  ENDIF
+!-----------------------
+END SUBROUTINE flio_qvid
+!===
+SUBROUTINE flio_hdm (f_i,f_e,lk_hm)
+!---------------------------------------------------------------------
+!- This subroutine handles the "define/data mode" of NETCDF.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i,f_e
+  LOGICAL,INTENT(IN) :: lk_hm
+!-
+  INTEGER :: i_rc
+!---------------------------------------------------------------------
+  i_rc = NF90_NOERR
+!-
+  IF      ( (.NOT.lw_hm(f_i)).AND.(lk_hm) ) THEN
+    i_rc = NF90_REDEF(f_e)
+    lw_hm(f_i) = .TRUE.
+  ELSE IF ( (lw_hm(f_i)).AND.(.NOT.lk_hm) ) THEN
+    i_rc = NF90_ENDDEF(f_e)
+    lw_hm(f_i) = .FALSE.
+  ENDIF
+!-
+  IF (i_rc /= NF90_NOERR) THEN
+    CALL ipslerr (3,'flio_hdm', &
+ &    'Internal error ','in define/data mode :', &
+ &    TRIM(NF90_STRERROR(i_rc)))
+  ENDIF
+!----------------------
+END SUBROUTINE flio_hdm
+!===
+SUBROUTINE flio_inf (f_e, &
+ & nb_dims,nb_vars,nb_atts,id_unlm,nn_idm,nn_ldm,nn_aid,cc_ndm)
+!---------------------------------------------------------------------
+!- This subroutine allows to get some information concerning
+!- the model file whose the external identifier is "f_e".
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_e
+  INTEGER,OPTIONAL,INTENT(OUT) :: nb_dims,nb_vars,nb_atts,id_unlm
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(OUT) :: nn_idm,nn_ldm,nn_aid
+  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL,INTENT(OUT) :: cc_ndm
+!-
+  INTEGER :: nm_dims,nm_vars,nm_atts,nm_unlm,ml
+  INTEGER :: i_rc,kv
+  CHARACTER(LEN=NF90_MAX_NAME) :: f_d_n
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "->flio_inf"
+  ENDIF
+!-
+  i_rc = NF90_INQUIRE(f_e,nDimensions=nm_dims,nVariables=nm_vars, &
+ &                    nAttributes=nm_atts,unlimitedDimId=nm_unlm)
+!-
+  IF (PRESENT(nb_dims))  nb_dims = nm_dims;
+  IF (PRESENT(nb_vars))  nb_vars = nm_vars;
+  IF (PRESENT(nb_atts))  nb_atts = nm_atts;
+  IF (PRESENT(id_unlm))  id_unlm = nm_unlm;
+!-
+  IF (PRESENT(nn_idm))  nn_idm(:) =  -1;
+  IF (PRESENT(nn_ldm))  nn_ldm(:) =   0;
+  IF (PRESENT(cc_ndm))  cc_ndm(:) = ' ';
+  IF (PRESENT(nn_aid))  nn_aid(:) =  -1;
+!-
+  DO kv=1,nm_dims
+!---
+    i_rc = NF90_INQUIRE_DIMENSION(f_e,kv,name=f_d_n,len=ml)
+    CALL strlowercase (f_d_n)
+    f_d_n = ADJUSTL(f_d_n)
+!---
+    IF (l_dbg) THEN
+      WRITE(*,*) "  flio_inf ",kv,ml," ",TRIM(f_d_n)
+    ENDIF
+!---
+    IF (PRESENT(nn_idm))  nn_idm(kv)=kv;
+    IF (PRESENT(nn_ldm))  nn_ldm(kv)=ml;
+    IF (PRESENT(cc_ndm))  cc_ndm(kv)=TRIM(f_d_n);
+!---
+    IF      (    (INDEX(f_d_n,'x') == 1)   &
+ &           .OR.(INDEX(f_d_n,'lon') == 1) ) THEN
+      IF (PRESENT(nn_aid)) THEN
+        IF (nn_aid(k_lon) < 0) THEN
+          nn_aid(k_lon)=kv;
+        ENDIF
+      ENDIF
+    ELSE IF (    (INDEX(f_d_n,'y') == 1)   &
+ &           .OR.(INDEX(f_d_n,'lat') == 1) ) THEN
+      IF (PRESENT(nn_aid)) THEN
+        IF (nn_aid(k_lat) < 0) THEN
+          nn_aid(k_lat)=kv;
+        ENDIF
+      ENDIF
+    ELSE IF (    (INDEX(f_d_n,'z') == 1)     &
+ &           .OR.(INDEX(f_d_n,'lev') == 1)   &
+ &           .OR.(INDEX(f_d_n,'plev') == 1)  &
+ &           .OR.(INDEX(f_d_n,'depth') == 1) ) THEN
+      IF (PRESENT(nn_aid)) THEN
+        IF (nn_aid(k_lev) < 0) THEN
+          nn_aid(k_lev)=kv;
+        ENDIF
+      ENDIF
+    ELSE IF (    (TRIM(f_d_n) == 't')         &
+ &           .OR.(TRIM(f_d_n) == 'time')      &
+ &           .OR.(INDEX(f_d_n,'tstep') == 1)  &
+ &           .OR.(INDEX(f_d_n,'time_counter') == 1) ) THEN
+!---- For the time we certainly need to allow for other names
+      IF (PRESENT(nn_aid)) THEN
+        IF (nn_aid(k_tim) < 0) THEN
+          nn_aid(k_tim)=kv;
+        ENDIF
+      ENDIF
+    ENDIF
+!---
+  ENDDO
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-flio_inf"
+  ENDIF
+!----------------------
+END SUBROUTINE flio_inf
+!===
+SUBROUTINE flio_qax (f_i,axtype,i_v,nbd)
+!---------------------------------------------------------------------
+!- This subroutine explores the file in order to find
+!- an axis (x/y/z/t) according to a number of rules
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: f_i,i_v,nbd
+  CHARACTER(LEN=*) :: axtype
+!-
+  INTEGER :: kv,k,n_r,l_d,n_d,i_rc,dimnb
+  CHARACTER(LEN=1)  :: c_ax
+  CHARACTER(LEN=18) :: c_sn
+  CHARACTER(LEN=15),DIMENSION(10) :: c_r
+  CHARACTER(LEN=40) :: c_t1,c_t2
+!---------------------------------------------------------------------
+  i_v = -1; nbd = -1;
+!---
+!- Keep the name of the axis
+!---
+  c_ax = TRIM(axtype)
+!-
+! Validate axis type
+!-
+  IF (    (LEN_TRIM(axtype) == 1) &
+ &    .AND.(    (c_ax == 'x').OR.(c_ax == 'y') &
+ &          .OR.(c_ax == 'z').OR.(c_ax == 't')) ) THEN
+!---
+!-- Define the maximum number of dimensions for the coordinate
+!---
+      SELECT CASE (c_ax)
+      CASE('x')
+        l_d = 2
+        c_sn = 'longitude'
+      CASE('y')
+        l_d = 2
+        c_sn = 'latitude'
+      CASE('z')
+        l_d = 1
+        c_sn = 'model_level_number'
+      CASE('t')
+        l_d = 1
+        c_sn = 'time'
+      END SELECT
+!---
+!-- Rule 1 : we look for a variable with one dimension
+!--          and which has the same name as its dimension (NUG)
+!---
+    IF (i_v < 0) THEN
+      SELECT CASE (c_ax)
+      CASE('x')
+        k = nw_ai(k_lon,f_i)
+      CASE('y')
+        k = nw_ai(k_lat,f_i)
+      CASE('z')
+        k = nw_ai(k_lev,f_i)
+      CASE('t')
+        k = nw_ai(k_tim,f_i)
+      END SELECT
+      IF ( (k >= 1).AND.(k <= nb_ax_mx) ) THEN
+        dimnb = nw_di(k,f_i)
+      ELSE
+        dimnb = -1
+      ENDIF
+!-----
+      i_rc = NF90_INQUIRE_DIMENSION(nw_id(f_i),dimnb,name=c_t1)
+      IF (i_rc == NF90_NOERR) THEN
+        CALL strlowercase (c_t1)
+        L_R1: DO kv=1,nw_nv(f_i)
+          i_rc = NF90_INQUIRE_VARIABLE &
+ &                 (nw_id(f_i),kv,name=c_t2,ndims=n_d)
+          IF (n_d == 1) THEN
+            CALL strlowercase (c_t2)
+            IF (TRIM(c_t1) == TRIM(c_t2)) THEN
+              i_v = kv; nbd = n_d;
+              EXIT L_R1
+            ENDIF
+          ENDIF
+        ENDDO L_R1
+      ENDIF
+    ENDIF
+!---
+!-- Rule 2 : we look for a correct "axis" attribute (CF)
+!---
+    IF (i_v < 0) THEN
+      L_R2: DO kv=1,nw_nv(f_i)
+        i_rc = NF90_GET_ATT(nw_id(f_i),kv,'axis',c_t1)
+        IF (i_rc == NF90_NOERR) THEN
+          CALL strlowercase (c_t1)
+          IF (TRIM(c_t1) == c_ax) THEN
+            i_rc = NF90_INQUIRE_VARIABLE(nw_id(f_i),kv,ndims=n_d)
+            IF (n_d <= l_d) THEN
+              i_v = kv; nbd = n_d;
+              EXIT L_R2
+            ENDIF
+          ENDIF
+        ENDIF
+      ENDDO L_R2
+    ENDIF
+!---
+!-- Rule 3 : we look for a correct "standard_name" attribute (CF)
+!---
+    IF (i_v < 0) THEN
+      L_R3: DO kv=1,nw_nv(f_i)
+        i_rc = NF90_GET_ATT(nw_id(f_i),kv,'standard_name',c_t1)
+        IF (i_rc == NF90_NOERR) THEN
+          CALL strlowercase (c_t1)
+          IF (TRIM(c_t1) == TRIM(c_sn)) THEN
+            i_rc = NF90_INQUIRE_VARIABLE(nw_id(f_i),kv,ndims=n_d)
+            IF (n_d <= l_d) THEN
+              i_v = kv; nbd = n_d;
+              EXIT L_R3
+            ENDIF
+          ENDIF
+        ENDIF
+      ENDDO L_R3
+    ENDIF
+!---
+!-- Rule 4 : we look for a specific name (IOIPSL)
+!---
+    IF (i_v < 0) THEN
+      SELECT CASE (c_ax)
+      CASE('x')
+        n_r = 3
+        c_r(1)='nav_lon'; c_r(2)='lon'; c_r(3)='longitude';
+      CASE('y')
+        n_r = 3
+        c_r(1)='nav_lat'; c_r(2)='lat'; c_r(3)='latitude';
+      CASE('z')
+        n_r = 8
+        c_r(1)='depth'; c_r(2)='deptht'; c_r(3)='height';
+        c_r(4)='level'; c_r(5)='lev'; c_r(6)='plev';
+        c_r(7)='sigma_level'; c_r(8)='layer';
+      CASE('t')
+        n_r = 3
+        c_r(1)='time'; c_r(2)='tstep'; c_r(3)='timesteps';
+      END SELECT
+!-----
+      L_R4: DO kv=1,nw_nv(f_i)
+        i_rc = NF90_INQUIRE_VARIABLE &
+ &               (nw_id(f_i),kv,name=c_t1,ndims=n_d)
+        IF (i_rc == NF90_NOERR) THEN
+          CALL strlowercase (c_t1)
+          IF (n_d <= l_d) THEN
+            DO k=1,n_r
+              IF (TRIM(c_t1) == TRIM(c_r(k))) THEN
+                i_v = kv; nbd = n_d;
+                EXIT L_R4
+              ENDIF
+            ENDDO
+          ENDIF
+        ENDIF
+      ENDDO L_R4
+    ENDIF
+!---
+  ENDIF
+!----------------------
+END SUBROUTINE flio_qax
+!-
+!===
+!-
+END MODULE fliocom
Index: trunk/NEMOGCM/EXTERNAL/IOIPSL/src/getincom.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/IOIPSL/src/getincom.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/IOIPSL/src/getincom.f90	(revision 2528)
@@ -0,0 +1,2008 @@
+MODULE getincom
+!-
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+USE errioipsl, ONLY : ipslerr
+USE stringop, &
+ &   ONLY : nocomma,cmpblank,strlowercase
+!-
+IMPLICIT NONE
+!-
+PRIVATE
+PUBLIC :: getin_name, getin, getin_dump
+!-
+!!--------------------------------------------------------------------
+!! The "getin_name" routine allows the user to change the name
+!! of the definition file in which the data will be read.
+!! ("run.def" by default)
+!!
+!!  SUBROUTINE getin_name (file_name)
+!!
+!! OPTIONAL INPUT argument
+!!
+!! (C) file_name :  the name of the file
+!!                  in which the data will be read
+!!--------------------------------------------------------------------
+!-
+!-
+INTERFACE getin
+!!--------------------------------------------------------------------
+!! The "getin" routines get a variable.
+!! We first check if we find it in the database
+!! and if not we get it from the definition file.
+!!
+!! SUBROUTINE getin (target,ret_val)
+!!
+!! INPUT
+!!
+!! (C) target : Name of the variable
+!!
+!! OUTPUT
+!!
+!! (I/R/C/L) ret_val : scalar, vector or matrix that will contain
+!!                     that will contain the (standard)
+!!                     integer/real/character/logical values
+!!--------------------------------------------------------------------
+  MODULE PROCEDURE getinrs, getinr1d, getinr2d, &
+ &                 getinis, getini1d, getini2d, &
+ &                 getincs, getinc1d, getinc2d, &
+ &                 getinls, getinl1d, getinl2d
+END INTERFACE
+!-
+!!--------------------------------------------------------------------
+!! The "getin_dump" routine will dump the content of the database
+!! into a file which has the same format as the definition file.
+!! The idea is that the user can see which parameters were used
+!! and re-use the file for another run.
+!!
+!!  SUBROUTINE getin_dump (fileprefix)
+!!
+!! OPTIONAL INPUT argument
+!!
+!! (C) fileprefix : allows the user to change the name of the file
+!!                  in which the data will be archived
+!!--------------------------------------------------------------------
+!-
+  INTEGER,PARAMETER :: max_files=100
+  CHARACTER(LEN=100),DIMENSION(max_files),SAVE :: filelist
+  INTEGER,SAVE      :: nbfiles
+!-
+  INTEGER,SAVE :: allread=0
+  CHARACTER(LEN=100),SAVE :: def_file = 'run.def'
+!-
+  INTEGER,PARAMETER :: i_txtslab=1000,l_n=30
+  INTEGER,SAVE :: nb_lines,i_txtsize=0
+  CHARACTER(LEN=100),SAVE,ALLOCATABLE,DIMENSION(:) :: fichier
+  CHARACTER(LEN=l_n),SAVE,ALLOCATABLE,DIMENSION(:) :: targetlist
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: fromfile,compline
+!-
+  INTEGER,PARAMETER :: n_d_fmt=5,max_msgs=15
+  CHARACTER(LEN=6),SAVE :: c_i_fmt = '(I5.5)'
+!-
+! The data base of parameters
+!-
+  INTEGER,PARAMETER :: memslabs=200
+  INTEGER,PARAMETER :: compress_lim=20
+!-
+  INTEGER,SAVE :: nb_keys=0
+  INTEGER,SAVE :: keymemsize=0
+!-
+! keystr definition
+! name of a key
+!-
+! keystatus definition
+! keystatus = 1 : Value comes from the file defined by 'def_file'
+! keystatus = 2 : Default value is used
+! keystatus = 3 : Some vector elements were taken from default
+!-
+! keytype definition
+! keytype = 1 : Integer
+! keytype = 2 : Real
+! keytype = 3 : Character
+! keytype = 4 : Logical
+!-
+  INTEGER,PARAMETER :: k_i=1, k_r=2, k_c=3, k_l=4
+!-
+! Allow compression for keys (only for integer and real)
+! keycompress < 0 : not compressed
+! keycompress > 0 : number of repeat of the value
+!-
+TYPE :: t_key
+  CHARACTER(LEN=l_n) :: keystr
+  INTEGER :: keystatus, keytype, keycompress, &
+ &           keyfromfile, keymemstart, keymemlen
+END TYPE t_key
+!-
+  TYPE(t_key),SAVE,ALLOCATABLE,DIMENSION(:) :: key_tab
+!-
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: i_mem
+  INTEGER,SAVE :: i_memsize=0, i_mempos=0
+  REAL,SAVE,ALLOCATABLE,DIMENSION(:) :: r_mem
+  INTEGER,SAVE :: r_memsize=0, r_mempos=0
+  CHARACTER(LEN=100),SAVE,ALLOCATABLE,DIMENSION(:) :: c_mem
+  INTEGER,SAVE :: c_memsize=0, c_mempos=0
+  LOGICAL,SAVE,ALLOCATABLE,DIMENSION(:) :: l_mem
+  INTEGER,SAVE :: l_memsize=0, l_mempos=0
+!-
+CONTAINS
+!-
+!=== DEFINITION FILE NAME INTERFACE
+!-
+SUBROUTINE getin_name (cname)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: cname
+!---------------------------------------------------------------------
+  IF (allread == 0) THEN
+    def_file = ADJUSTL(cname)
+  ELSE
+    CALL ipslerr (3,'getin_name', &
+ &   'The name of the database file (any_name.def)', &
+ &   'must be changed *before* any attempt','to read the database.')
+  ENDIF
+!------------------------
+END SUBROUTINE getin_name
+!-
+!=== INTEGER INTERFACE
+!-
+SUBROUTINE getinis (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER :: ret_val
+!-
+  INTEGER,DIMENSION(1) :: tmp_ret_val
+  INTEGER :: pos,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  tmp_ret_val(1) = ret_val
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,i_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,1,i_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,1,target,i_val=tmp_ret_val)
+  ENDIF
+  ret_val = tmp_ret_val(1)
+!---------------------
+END SUBROUTINE getinis
+!===
+SUBROUTINE getini1d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER,DIMENSION(:) :: ret_val
+!-
+  INTEGER,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+  tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,i_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,i_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,i_val=tmp_ret_val)
+  ENDIF
+  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
+!----------------------
+END SUBROUTINE getini1d
+!===
+SUBROUTINE getini2d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER,DIMENSION(:,:) :: ret_val
+!-
+  INTEGER,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig
+  INTEGER :: jl,jj,ji
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  size_1 = SIZE(ret_val,1)
+  size_2 = SIZE(ret_val,2)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      tmp_ret_val(jl) = ret_val(ji,jj)
+    ENDDO
+  ENDDO
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,i_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,i_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,i_val=tmp_ret_val)
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      ret_val(ji,jj) = tmp_ret_val(jl)
+    ENDDO
+  ENDDO
+!----------------------
+END SUBROUTINE getini2d
+!-
+!=== REAL INTERFACE
+!-
+SUBROUTINE getinrs (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  REAL :: ret_val
+!-
+  REAL,DIMENSION(1) :: tmp_ret_val
+  INTEGER :: pos,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  tmp_ret_val(1) = ret_val
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,r_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,1,r_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,1,target,r_val=tmp_ret_val)
+  ENDIF
+  ret_val = tmp_ret_val(1)
+!---------------------
+END SUBROUTINE getinrs
+!===
+SUBROUTINE getinr1d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  REAL,DIMENSION(:) :: ret_val
+!-
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+  tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,r_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,r_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,r_val=tmp_ret_val)
+  ENDIF
+  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
+!----------------------
+END SUBROUTINE getinr1d
+!===
+SUBROUTINE getinr2d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  REAL,DIMENSION(:,:) :: ret_val
+!-
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig
+  INTEGER :: jl,jj,ji
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  size_1 = SIZE(ret_val,1)
+  size_2 = SIZE(ret_val,2)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      tmp_ret_val(jl) = ret_val(ji,jj)
+    ENDDO
+  ENDDO
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,r_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,r_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,r_val=tmp_ret_val)
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      ret_val(ji,jj) = tmp_ret_val(jl)
+    ENDDO
+  ENDDO
+!----------------------
+END SUBROUTINE getinr2d
+!-
+!=== CHARACTER INTERFACE
+!-
+SUBROUTINE getincs (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  CHARACTER(LEN=*) :: ret_val
+!-
+  CHARACTER(LEN=100),DIMENSION(1) :: tmp_ret_val
+  INTEGER :: pos,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  tmp_ret_val(1) = ret_val
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,c_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,1,c_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,1,target,c_val=tmp_ret_val)
+  ENDIF
+  ret_val = tmp_ret_val(1)
+!---------------------
+END SUBROUTINE getincs
+!===
+SUBROUTINE getinc1d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  CHARACTER(LEN=*),DIMENSION(:) :: ret_val
+!-
+  CHARACTER(LEN=100),DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+  tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,c_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,c_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,c_val=tmp_ret_val)
+  ENDIF
+  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
+!----------------------
+END SUBROUTINE getinc1d
+!===
+SUBROUTINE getinc2d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  CHARACTER(LEN=*),DIMENSION(:,:) :: ret_val
+!-
+  CHARACTER(LEN=100),DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig
+  INTEGER :: jl,jj,ji
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  size_1 = SIZE(ret_val,1)
+  size_2 = SIZE(ret_val,2)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      tmp_ret_val(jl) = ret_val(ji,jj)
+    ENDDO
+  ENDDO
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,c_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,c_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,c_val=tmp_ret_val)
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      ret_val(ji,jj) = tmp_ret_val(jl)
+    ENDDO
+  ENDDO
+!----------------------
+END SUBROUTINE getinc2d
+!-
+!=== LOGICAL INTERFACE
+!-
+SUBROUTINE getinls (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  LOGICAL :: ret_val
+!-
+  LOGICAL,DIMENSION(1) :: tmp_ret_val
+  INTEGER :: pos,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  tmp_ret_val(1) = ret_val
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,l_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,1,l_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,1,target,l_val=tmp_ret_val)
+  ENDIF
+  ret_val = tmp_ret_val(1)
+!---------------------
+END SUBROUTINE getinls
+!===
+SUBROUTINE getinl1d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  LOGICAL,DIMENSION(:) :: ret_val
+!-
+  LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+  tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,l_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,l_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,l_val=tmp_ret_val)
+  ENDIF
+  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
+!----------------------
+END SUBROUTINE getinl1d
+!===
+SUBROUTINE getinl2d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  LOGICAL,DIMENSION(:,:) :: ret_val
+!-
+  LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig
+  INTEGER :: jl,jj,ji
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  size_1 = SIZE(ret_val,1)
+  size_2 = SIZE(ret_val,2)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      tmp_ret_val(jl) = ret_val(ji,jj)
+    ENDDO
+  ENDDO
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,l_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,l_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,l_val=tmp_ret_val)
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      ret_val(ji,jj) = tmp_ret_val(jl)
+    ENDDO
+  ENDDO
+!----------------------
+END SUBROUTINE getinl2d
+!-
+!=== Generic file/database INTERFACE
+!-
+SUBROUTINE get_fil (target,status,fileorig,i_val,r_val,c_val,l_val)
+!---------------------------------------------------------------------
+!- Subroutine that will extract from the file the values
+!- attributed to the keyword target
+!-
+!- (C) target    : target for which we will look in the file
+!- (I) status    : tells us from where we obtained the data
+!- (I) fileorig  : index of the file from which the key comes
+!- (I) i_val(:)  : INTEGER(nb_to_ret)   values
+!- (R) r_val(:)  : REAL(nb_to_ret)      values
+!- (L) l_val(:)  : LOGICAL(nb_to_ret)   values
+!- (C) c_val(:)  : CHARACTER(nb_to_ret) values
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER,INTENT(OUT) :: status,fileorig
+  INTEGER,DIMENSION(:),OPTIONAL          :: i_val
+  REAL,DIMENSION(:),OPTIONAL             :: r_val
+  LOGICAL,DIMENSION(:),OPTIONAL          :: l_val
+  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_val
+!-
+  INTEGER :: k_typ,nb_to_ret,it,pos,len_str,status_cnt,io_err
+  CHARACTER(LEN=n_d_fmt)  :: cnt
+  CHARACTER(LEN=80) :: str_READ,str_READ_lower
+  CHARACTER(LEN=9)  :: c_vtyp
+  LOGICAL,DIMENSION(:),ALLOCATABLE :: found
+  LOGICAL :: def_beha,compressed
+  CHARACTER(LEN=10) :: c_fmt
+  INTEGER :: i_cmpval
+  REAL    :: r_cmpval
+  INTEGER :: ipos_tr,ipos_fl
+!---------------------------------------------------------------------
+!-
+! Get the type of the argument
+  CALL get_qtyp (k_typ,c_vtyp,i_val,r_val,c_val,l_val)
+  SELECT CASE (k_typ)
+  CASE(k_i)
+    nb_to_ret = SIZE(i_val)
+  CASE(k_r)
+    nb_to_ret = SIZE(r_val)
+  CASE(k_c)
+    nb_to_ret = SIZE(c_val)
+  CASE(k_l)
+    nb_to_ret = SIZE(l_val)
+  CASE DEFAULT
+    CALL ipslerr (3,'get_fil', &
+ &   'Internal error','Unknown type of data',' ')
+  END SELECT
+!-
+! Read the file(s)
+  CALL getin_read
+!-
+! Allocate and initialize the memory we need
+  ALLOCATE(found(nb_to_ret))
+  found(:) = .FALSE.
+!-
+! See what we find in the files read
+  DO it=1,nb_to_ret
+!---
+!-- First try the target as it is
+    CALL get_findkey (2,target,pos)
+!---
+!-- Another try
+!---
+    IF (pos < 0) THEN
+      WRITE(UNIT=cnt,FMT=c_i_fmt) it
+      CALL get_findkey (2,TRIM(target)//'__'//cnt,pos)
+    ENDIF
+!---
+!-- We dont know from which file the target could come.
+!-- Thus by default we attribute it to the first file :
+    fileorig = 1
+!---
+    IF (pos > 0) THEN
+!-----
+      found(it) = .TRUE.
+      fileorig = fromfile(pos)
+!-----
+!---- DECODE
+!-----
+      str_READ = ADJUSTL(fichier(pos))
+      str_READ_lower = str_READ
+      CALL strlowercase (str_READ_lower)
+!-----
+      IF (    (TRIM(str_READ_lower) == 'def')     &
+ &        .OR.(TRIM(str_READ_lower) == 'default') ) THEN
+        def_beha = .TRUE.
+      ELSE
+        def_beha = .FALSE.
+        len_str = LEN_TRIM(str_READ)
+        io_err = 0
+        SELECT CASE (k_typ)
+        CASE(k_i)
+          WRITE (UNIT=c_fmt,FMT='("(I",I3.3,")")') len_str
+          READ (UNIT=str_READ(1:len_str), &
+ &              FMT=c_fmt,IOSTAT=io_err) i_val(it)
+        CASE(k_r)
+          READ (UNIT=str_READ(1:len_str), &
+ &              FMT=*,IOSTAT=io_err) r_val(it)
+        CASE(k_c)
+          c_val(it) = str_READ(1:len_str)
+        CASE(k_l)
+          ipos_tr = -1
+          ipos_fl = -1
+          ipos_tr = MAX(INDEX(str_READ_lower,'tru'), &
+ &                      INDEX(str_READ_lower,'y'))
+          ipos_fl = MAX(INDEX(str_READ_lower,'fal'), &
+ &                      INDEX(str_READ_lower,'n'))
+          IF (ipos_tr > 0) THEN
+            l_val(it) = .TRUE.
+          ELSE IF (ipos_fl > 0) THEN
+            l_val(it) = .FALSE.
+          ELSE
+            io_err = 100
+          ENDIF
+        END SELECT
+        IF (io_err /= 0) THEN
+          CALL ipslerr (3,'get_fil', &
+ &         'Target '//TRIM(target), &
+ &         'is not of '//TRIM(c_vtyp)//' type',' ')
+        ENDIF
+      ENDIF
+!-----
+      IF ( (k_typ == k_i).OR.(k_typ == k_r) ) THEN
+!-------
+!------ Is this the value of a compressed field ?
+        compressed = (compline(pos) > 0)
+        IF (compressed) THEN
+          IF (compline(pos) /= nb_to_ret) THEN
+            CALL ipslerr (2,'get_fil', &
+ &           'For key '//TRIM(target)//' we have a compressed field', &
+ &           'which does not have the right size.', &
+ &           'We will try to fix that.')
+          ENDIF
+          IF      (k_typ == k_i) THEN
+            i_cmpval = i_val(it)
+          ELSE IF (k_typ == k_r) THEN
+            r_cmpval = r_val(it)
+          ENDIF
+        ENDIF
+      ENDIF
+    ELSE
+      found(it) = .FALSE.
+      def_beha = .FALSE.
+      compressed = .FALSE.
+    ENDIF
+  ENDDO
+!-
+  IF ( (k_typ == k_i).OR.(k_typ == k_r) ) THEN
+!---
+!-- If this is a compressed field then we will uncompress it
+    IF (compressed) THEN
+      DO it=1,nb_to_ret
+        IF (.NOT.found(it)) THEN
+          IF      (k_typ == k_i) THEN
+            i_val(it) = i_cmpval
+          ELSE IF (k_typ == k_r) THEN
+          ENDIF
+          found(it) = .TRUE.
+        ENDIF
+      ENDDO
+    ENDIF
+  ENDIF
+!-
+! Now we set the status for what we found
+  IF (def_beha) THEN
+    status = 2
+    WRITE(*,*) 'USING DEFAULT BEHAVIOUR FOR ',TRIM(target)
+  ELSE
+    status_cnt = 0
+    DO it=1,nb_to_ret
+      IF (.NOT.found(it)) THEN
+        status_cnt = status_cnt+1
+        IF      (status_cnt <= max_msgs) THEN
+          WRITE (UNIT=*,FMT='(" USING DEFAULTS : ",A)', &
+ &               ADVANCE='NO') TRIM(target)
+          IF (nb_to_ret > 1) THEN
+            WRITE (UNIT=*,FMT='("__")',ADVANCE='NO')
+            WRITE (UNIT=*,FMT=c_i_fmt,ADVANCE='NO') it
+          ENDIF
+          SELECT CASE (k_typ)
+          CASE(k_i)
+            WRITE (UNIT=*,FMT=*) "=",i_val(it)
+          CASE(k_r)
+            WRITE (UNIT=*,FMT=*) "=",r_val(it)
+          CASE(k_c)
+            WRITE (UNIT=*,FMT=*) "=",c_val(it)
+          CASE(k_l)
+            WRITE (UNIT=*,FMT=*) "=",l_val(it)
+          END SELECT
+        ELSE IF (status_cnt == max_msgs+1) THEN
+          WRITE (UNIT=*,FMT='(" USING DEFAULTS ... ",A)')
+        ENDIF
+      ENDIF
+    ENDDO
+!---
+    IF (status_cnt == 0) THEN
+      status = 1
+    ELSE IF (status_cnt == nb_to_ret) THEN
+      status = 2
+    ELSE
+      status = 3
+    ENDIF
+  ENDIF
+! Deallocate the memory
+  DEALLOCATE(found)
+!---------------------
+END SUBROUTINE get_fil
+!===
+SUBROUTINE get_rdb (pos,size_of_in,target,i_val,r_val,c_val,l_val)
+!---------------------------------------------------------------------
+!- Read the required variable in the database
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: pos,size_of_in
+  CHARACTER(LEN=*) :: target
+  INTEGER,DIMENSION(:),OPTIONAL          :: i_val
+  REAL,DIMENSION(:),OPTIONAL             :: r_val
+  LOGICAL,DIMENSION(:),OPTIONAL          :: l_val
+  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_val
+!-
+  INTEGER :: k_typ,k_beg,k_end
+  CHARACTER(LEN=9) :: c_vtyp
+!---------------------------------------------------------------------
+!-
+! Get the type of the argument
+  CALL get_qtyp (k_typ,c_vtyp,i_val,r_val,c_val,l_val)
+  IF (     (k_typ /= k_i).AND.(k_typ /= k_r) &
+ &    .AND.(k_typ /= k_c).AND.(k_typ /= k_l) )THEN
+    CALL ipslerr (3,'get_rdb', &
+ &   'Internal error','Unknown type of data',' ')
+  ENDIF
+!-
+  IF (key_tab(pos)%keytype /= k_typ) THEN
+    CALL ipslerr (3,'get_rdb', &
+ &   'Wrong data type for keyword '//TRIM(target), &
+ &   '(NOT '//TRIM(c_vtyp)//')',' ')
+  ENDIF
+!-
+  IF (key_tab(pos)%keycompress > 0) THEN
+    IF (    (key_tab(pos)%keycompress /= size_of_in) &
+ &      .OR.(key_tab(pos)%keymemlen /= 1) ) THEN
+      CALL ipslerr (3,'get_rdb', &
+ &     'Wrong compression length','for keyword '//TRIM(target),' ')
+    ELSE
+      SELECT CASE (k_typ)
+      CASE(k_i)
+        i_val(1:size_of_in) = i_mem(key_tab(pos)%keymemstart)
+      CASE(k_r)
+        r_val(1:size_of_in) = r_mem(key_tab(pos)%keymemstart)
+      END SELECT
+    ENDIF
+  ELSE
+    IF (key_tab(pos)%keymemlen /= size_of_in) THEN
+      CALL ipslerr (3,'get_rdb', &
+ &     'Wrong array length','for keyword '//TRIM(target),' ')
+    ELSE
+      k_beg = key_tab(pos)%keymemstart
+      k_end = k_beg+key_tab(pos)%keymemlen-1
+      SELECT CASE (k_typ)
+      CASE(k_i)
+        i_val(1:size_of_in) = i_mem(k_beg:k_end)
+      CASE(k_r)
+        r_val(1:size_of_in) = r_mem(k_beg:k_end)
+      CASE(k_c)
+        c_val(1:size_of_in) = c_mem(k_beg:k_end)
+      CASE(k_l)
+        l_val(1:size_of_in) = l_mem(k_beg:k_end)
+      END SELECT
+    ENDIF
+  ENDIF
+!---------------------
+END SUBROUTINE get_rdb
+!===
+SUBROUTINE get_wdb &
+ &  (target,status,fileorig,size_of_in, &
+ &   i_val,r_val,c_val,l_val)
+!---------------------------------------------------------------------
+!- Write data into the data base
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER :: status,fileorig,size_of_in
+  INTEGER,DIMENSION(:),OPTIONAL          :: i_val
+  REAL,DIMENSION(:),OPTIONAL             :: r_val
+  LOGICAL,DIMENSION(:),OPTIONAL          :: l_val
+  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_val
+!-
+  INTEGER :: k_typ
+  CHARACTER(LEN=9) :: c_vtyp
+  INTEGER :: k_mempos,k_memsize,k_beg,k_end
+  LOGICAL :: l_cmp
+!---------------------------------------------------------------------
+!-
+! Get the type of the argument
+  CALL get_qtyp (k_typ,c_vtyp,i_val,r_val,c_val,l_val)
+  IF (     (k_typ /= k_i).AND.(k_typ /= k_r) &
+ &    .AND.(k_typ /= k_c).AND.(k_typ /= k_l) )THEN
+    CALL ipslerr (3,'get_wdb', &
+ &   'Internal error','Unknown type of data',' ')
+  ENDIF
+!-
+! First check if we have sufficiant space for the new key
+  IF (nb_keys+1 > keymemsize) THEN
+    CALL getin_allockeys ()
+  ENDIF
+!-
+  SELECT CASE (k_typ)
+  CASE(k_i)
+    k_mempos = i_mempos; k_memsize = i_memsize;
+    l_cmp = (MINVAL(i_val) == MAXVAL(i_val)) &
+ &         .AND.(size_of_in > compress_lim)
+  CASE(k_r)
+    k_mempos = r_mempos; k_memsize = r_memsize;
+    l_cmp = (MINVAL(r_val) == MAXVAL(r_val)) &
+ &         .AND.(size_of_in > compress_lim)
+  CASE(k_c)
+    k_mempos = c_mempos; k_memsize = c_memsize;
+    l_cmp = .FALSE.
+  CASE(k_l)
+    k_mempos = l_mempos; k_memsize = l_memsize;
+    l_cmp = .FALSE.
+  END SELECT
+!-
+! Fill out the items of the data base
+  nb_keys = nb_keys+1
+  key_tab(nb_keys)%keystr = target(1:MIN(LEN_TRIM(target),l_n))
+  key_tab(nb_keys)%keystatus = status
+  key_tab(nb_keys)%keytype = k_typ
+  key_tab(nb_keys)%keyfromfile = fileorig
+  key_tab(nb_keys)%keymemstart = k_mempos+1
+  IF (l_cmp) THEN
+    key_tab(nb_keys)%keycompress = size_of_in
+    key_tab(nb_keys)%keymemlen = 1
+  ELSE
+    key_tab(nb_keys)%keycompress = -1
+    key_tab(nb_keys)%keymemlen = size_of_in
+  ENDIF
+!-
+! Before writing the actual size lets see if we have the space
+  IF (key_tab(nb_keys)%keymemstart+key_tab(nb_keys)%keymemlen &
+ &    > k_memsize) THEN
+    CALL getin_allocmem (k_typ,key_tab(nb_keys)%keymemlen)
+  ENDIF
+!-
+  k_beg = key_tab(nb_keys)%keymemstart
+  k_end = k_beg+key_tab(nb_keys)%keymemlen-1
+  SELECT CASE (k_typ)
+  CASE(k_i)
+    i_mem(k_beg:k_end) = i_val(1:key_tab(nb_keys)%keymemlen)
+    i_mempos = k_end
+  CASE(k_r)
+    r_mem(k_beg:k_end) = r_val(1:key_tab(nb_keys)%keymemlen)
+    r_mempos = k_end
+  CASE(k_c)
+    c_mem(k_beg:k_end) = c_val(1:key_tab(nb_keys)%keymemlen)
+    c_mempos = k_end
+  CASE(k_l)
+    l_mem(k_beg:k_end) = l_val(1:key_tab(nb_keys)%keymemlen)
+    l_mempos = k_end
+  END SELECT
+!---------------------
+END SUBROUTINE get_wdb
+!-
+!===
+!-
+SUBROUTINE getin_read
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,SAVE :: current
+!---------------------------------------------------------------------
+  IF (allread == 0) THEN
+!-- Allocate a first set of memory.
+    CALL getin_alloctxt ()
+    CALL getin_allockeys ()
+    CALL getin_allocmem (k_i,0)
+    CALL getin_allocmem (k_r,0)
+    CALL getin_allocmem (k_c,0)
+    CALL getin_allocmem (k_l,0)
+!-- Start with reading the files
+    nbfiles = 1
+    filelist(1) = TRIM(def_file)
+    current = 1
+!--
+    DO WHILE (current <= nbfiles)
+      CALL getin_readdef (current)
+      current = current+1
+    ENDDO
+    allread = 1
+    CALL getin_checkcohe ()
+  ENDIF
+!------------------------
+END SUBROUTINE getin_read
+!-
+!===
+!-
+  SUBROUTINE getin_readdef(current)
+!---------------------------------------------------------------------
+!- This subroutine will read the files and only keep the
+!- the relevant information. The information is kept as it
+!- found in the file. The data will be analysed later.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: current
+!-
+  CHARACTER(LEN=100) :: READ_str,NEW_str,last_key,key_str
+  CHARACTER(LEN=n_d_fmt) :: cnt
+  CHARACTER(LEN=10) :: c_fmt
+  INTEGER :: nb_lastkey
+!-
+  INTEGER :: eof,ptn,len_str,i,it,iund,io_err
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  eof = 0
+  ptn = 1
+  nb_lastkey = 0
+!-
+  IF (check) THEN
+    WRITE(*,*) 'getin_readdef : Open file ',TRIM(filelist(current))
+  ENDIF
+!-
+  OPEN (UNIT=22,FILE=filelist(current),STATUS="OLD",IOSTAT=io_err)
+  IF (io_err /= 0) THEN
+    CALL ipslerr (2,'getin_readdef', &
+ &  'Could not open file '//TRIM(filelist(current)),' ',' ')
+    RETURN
+  ENDIF
+!-
+  DO WHILE (eof /= 1)
+!---
+    CALL getin_skipafew (22,READ_str,eof,nb_lastkey)
+    len_str = LEN_TRIM(READ_str)
+    ptn = INDEX(READ_str,'=')
+!---
+    IF (ptn > 0) THEN
+!---- Get the target
+      key_str = TRIM(ADJUSTL(READ_str(1:ptn-1)))
+!---- Make sure that a vector keyword has the right length
+      iund = INDEX(key_str,'__')
+      IF (iund > 0) THEN
+        WRITE (UNIT=c_fmt,FMT='("(I",I3.3,")")') &
+ &        LEN_TRIM(key_str)-iund-1
+        READ(UNIT=key_str(iund+2:LEN_TRIM(key_str)), &
+ &           FMT=c_fmt,IOSTAT=io_err) it
+        IF ( (io_err == 0).AND.(it > 0) ) THEN
+          WRITE(UNIT=cnt,FMT=c_i_fmt) it
+          key_str = key_str(1:iund+1)//cnt
+        ELSE
+          CALL ipslerr (3,'getin_readdef', &
+ &         'A very strange key has just been found :', &
+ &         TRIM(key_str),' ')
+        ENDIF
+      ENDIF
+!---- Prepare the content
+      NEW_str = TRIM(ADJUSTL(READ_str(ptn+1:len_str)))
+      CALL nocomma (NEW_str)
+      CALL cmpblank (NEW_str)
+      NEW_str  = TRIM(ADJUSTL(NEW_str))
+      IF (check) THEN
+        WRITE(*,*) &
+ &        '--> getin_readdef : ',TRIM(key_str),' :: ',TRIM(NEW_str)
+      ENDIF
+!---- Decypher the content of NEW_str
+!-
+!---- This has to be a new key word, thus :
+      nb_lastkey = 0
+!----
+      CALL getin_decrypt (current,key_str,NEW_str,last_key,nb_lastkey)
+!----
+    ELSE IF (len_str > 0) THEN
+!---- Prepare the key if we have an old one to which
+!---- we will add the line just read
+      IF (nb_lastkey > 0) THEN
+        iund =  INDEX(last_key,'__')
+        IF (iund > 0) THEN
+!-------- We only continue a keyword, thus it is easy
+          key_str = last_key(1:iund-1)
+        ELSE
+          IF (nb_lastkey /= 1) THEN
+            CALL ipslerr (3,'getin_readdef', &
+ &           'We can not have a scalar keyword', &
+ &           'and a vector content',' ')
+          ENDIF
+!-------- The last keyword needs to be transformed into a vector.
+          WRITE(UNIT=cnt,FMT=c_i_fmt) 1
+          targetlist(nb_lines) = &
+ &         last_key(1:MIN(LEN_TRIM(last_key),l_n-n_d_fmt-2))//'__'//cnt
+          key_str = last_key(1:LEN_TRIM(last_key))
+        ENDIF
+      ENDIF
+!---- Prepare the content
+      NEW_str = TRIM(ADJUSTL(READ_str(1:len_str)))
+      CALL getin_decrypt (current,key_str,NEW_str,last_key,nb_lastkey)
+    ELSE
+!---- If we have an empty line then the keyword finishes
+      nb_lastkey = 0
+      IF (check) THEN
+        WRITE(*,*) 'getin_readdef : Have found an emtpy line '
+      ENDIF
+    ENDIF
+  ENDDO
+!-
+  CLOSE(UNIT=22)
+!-
+  IF (check) THEN
+    OPEN (UNIT=22,file=TRIM(def_file)//'.test')
+    DO i=1,nb_lines
+      WRITE(UNIT=22,FMT=*) targetlist(i)," : ",fichier(i)
+    ENDDO
+    CLOSE(UNIT=22)
+  ENDIF
+!---------------------------
+END SUBROUTINE getin_readdef
+!-
+!===
+!-
+SUBROUTINE getin_decrypt(current,key_str,NEW_str,last_key,nb_lastkey)
+!---------------------------------------------------------------------
+!- This subroutine is going to decypher the line.
+!- It essentialy checks how many items are included and
+!- it they can be attached to a key.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! ARGUMENTS
+!-
+  INTEGER :: current,nb_lastkey
+  CHARACTER(LEN=*) :: key_str,NEW_str,last_key
+!-
+! LOCAL
+!-
+  INTEGER :: len_str,blk,nbve,starpos
+  CHARACTER(LEN=100) :: tmp_str,new_key,mult
+  CHARACTER(LEN=n_d_fmt) :: cnt
+  CHARACTER(LEN=10) :: c_fmt
+!---------------------------------------------------------------------
+  len_str = LEN_TRIM(NEW_str)
+  blk = INDEX(NEW_str(1:len_str),' ')
+  tmp_str = NEW_str(1:len_str)
+!-
+! If the key is a new file then we take it up. Else
+! we save the line and go on.
+!-
+  IF (INDEX(key_str,'INCLUDEDEF') > 0) THEN
+    DO WHILE (blk > 0)
+      IF (nbfiles+1 > max_files) THEN
+        CALL ipslerr (3,'getin_decrypt', &
+ &       'Too many files to include',' ',' ')
+      ENDIF
+!-----
+      nbfiles = nbfiles+1
+      filelist(nbfiles) = tmp_str(1:blk)
+!-----
+      tmp_str = TRIM(ADJUSTL(tmp_str(blk+1:LEN_TRIM(tmp_str))))
+      blk = INDEX(tmp_str(1:LEN_TRIM(tmp_str)),' ')
+    ENDDO
+!---
+    IF (nbfiles+1 > max_files) THEN
+      CALL ipslerr (3,'getin_decrypt', &
+ &     'Too many files to include',' ',' ')
+    ENDIF
+!---
+    nbfiles =  nbfiles+1
+    filelist(nbfiles) = TRIM(ADJUSTL(tmp_str))
+!---
+    last_key = 'INCLUDEDEF'
+    nb_lastkey = 1
+  ELSE
+!-
+!-- We are working on a new line of input
+!-
+    IF (nb_lines+1 > i_txtsize) THEN
+      CALL getin_alloctxt ()
+    ENDIF
+    nb_lines = nb_lines+1
+!-
+!-- First we solve the issue of conpressed information. Once
+!-- this is done all line can be handled in the same way.
+!-
+    starpos = INDEX(NEW_str(1:len_str),'*')
+    IF ( (starpos > 0).AND.(tmp_str(1:1) /= '"') &
+ &                    .AND.(tmp_str(1:1) /= "'") ) THEN
+!-----
+      IF (INDEX(key_str(1:LEN_TRIM(key_str)),'__') > 0) THEN
+        CALL ipslerr (3,'getin_decrypt', &
+ &       'We can not have a compressed field of values', &
+ &       'in a vector notation (TARGET__n).', &
+ &       'The key at fault : '//TRIM(key_str))
+      ENDIF
+!-
+!---- Read the multiplied
+!-
+      mult = TRIM(ADJUSTL(NEW_str(1:starpos-1)))
+!---- Construct the new string and its parameters
+      NEW_str = TRIM(ADJUSTL(NEW_str(starpos+1:len_str)))
+      len_str = LEN_TRIM(NEW_str)
+      blk = INDEX(NEW_str(1:len_str),' ')
+      IF (blk > 1) THEN
+        CALL ipslerr (2,'getin_decrypt', &
+ &       'This is a strange behavior','you could report',' ')
+      ENDIF
+      WRITE (UNIT=c_fmt,FMT='("(I",I5.5,")")') LEN_TRIM(mult)
+      READ(UNIT=mult,FMT=c_fmt) compline(nb_lines)
+!---
+    ELSE
+      compline(nb_lines) = -1
+    ENDIF
+!-
+!-- If there is no space wthin the line then the target is a scalar
+!-- or the element of a properly written vector.
+!-- (ie of the type TARGET__00001)
+!-
+    IF (    (blk <= 1) &
+ &      .OR.(tmp_str(1:1) == '"') &
+ &      .OR.(tmp_str(1:1) == "'") ) THEN
+!-
+      IF (nb_lastkey == 0) THEN
+!------ Save info of current keyword as a scalar
+!------ if it is not a continuation
+        targetlist(nb_lines) = key_str(1:MIN(LEN_TRIM(key_str),l_n))
+        last_key = key_str(1:MIN(LEN_TRIM(key_str),l_n))
+        nb_lastkey = 1
+      ELSE
+!------ We are continuing a vector so the keyword needs
+!------ to get the underscores
+        WRITE(UNIT=cnt,FMT=c_i_fmt) nb_lastkey+1
+        targetlist(nb_lines) = &
+ &        key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
+        last_key = &
+ &        key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
+        nb_lastkey = nb_lastkey+1
+      ENDIF
+!-----
+      fichier(nb_lines) = NEW_str(1:len_str)
+      fromfile(nb_lines) = current
+    ELSE
+!-
+!---- If there are blanks whithin the line then we are dealing
+!---- with a vector and we need to split it in many entries
+!---- with the TARGET__n notation.
+!----
+!---- Test if the targer is not already a vector target !
+!-
+      IF (INDEX(TRIM(key_str),'__') > 0) THEN
+        CALL ipslerr (3,'getin_decrypt', &
+ &       'We have found a mixed vector notation (TARGET__n).', &
+ &       'The key at fault : '//TRIM(key_str),' ')
+      ENDIF
+!-
+      nbve = nb_lastkey
+      nbve = nbve+1
+      WRITE(UNIT=cnt,FMT=c_i_fmt) nbve
+!-
+      DO WHILE (blk > 0)
+!-
+!------ Save the content of target__nbve
+!-
+        fichier(nb_lines) = tmp_str(1:blk)
+        new_key = &
+ &       key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
+        targetlist(nb_lines) = new_key(1:MIN(LEN_TRIM(new_key),l_n))
+        fromfile(nb_lines) = current
+!-
+        tmp_str = TRIM(ADJUSTL(tmp_str(blk+1:LEN_TRIM(tmp_str))))
+        blk = INDEX(TRIM(tmp_str),' ')
+!-
+        IF (nb_lines+1 > i_txtsize) THEN
+          CALL getin_alloctxt ()
+        ENDIF
+        nb_lines = nb_lines+1
+        nbve = nbve+1
+        WRITE(UNIT=cnt,FMT=c_i_fmt) nbve
+!-
+      ENDDO
+!-
+!---- Save the content of the last target
+!-
+      fichier(nb_lines) = tmp_str(1:LEN_TRIM(tmp_str))
+      new_key = &
+ &      key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
+      targetlist(nb_lines) = new_key(1:MIN(LEN_TRIM(new_key),l_n))
+      fromfile(nb_lines) = current
+!-
+      last_key = &
+ &      key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
+      nb_lastkey = nbve
+!-
+    ENDIF
+!-
+  ENDIF
+!---------------------------
+END SUBROUTINE getin_decrypt
+!-
+!===
+!-
+SUBROUTINE getin_checkcohe ()
+!---------------------------------------------------------------------
+!- This subroutine checks for redundancies.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: line,n_k,k
+!---------------------------------------------------------------------
+  DO line=1,nb_lines-1
+!-
+    n_k = 0
+    DO k=line+1,nb_lines
+      IF (TRIM(targetlist(line)) == TRIM(targetlist(k))) THEN
+        n_k = k
+        EXIT
+      ENDIF
+    ENDDO
+!---
+!-- IF we have found it we have a problem to solve.
+!---
+    IF (n_k > 0) THEN
+      WRITE(*,*) 'COUNT : ',n_k
+      WRITE(*,*) &
+ &  'getin_checkcohe : Found a problem on key ',TRIM(targetlist(line))
+      WRITE(*,*) &
+ &  'getin_checkcohe : The following values were encoutered :'
+      WRITE(*,*) &
+ &  '                ',TRIM(targetlist(line)),' == ',fichier(line)
+      WRITE(*,*) &
+ &  '                ',TRIM(targetlist(k)),' == ',fichier(k)
+      WRITE(*,*) &
+ &  'getin_checkcohe : We will keep only the last value'
+      targetlist(line) = ' '
+    ENDIF
+  ENDDO
+!-----------------------------
+END SUBROUTINE getin_checkcohe
+!-
+!===
+!-
+SUBROUTINE getin_skipafew (unit,out_string,eof,nb_lastkey)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: unit,eof,nb_lastkey
+  CHARACTER(LEN=100) :: dummy
+  CHARACTER(LEN=100) :: out_string
+  CHARACTER(LEN=1) :: first
+!---------------------------------------------------------------------
+  first="#"
+  eof = 0
+  out_string = "    "
+!-
+  DO WHILE (first == "#")
+    READ (UNIT=unit,FMT='(A)',ERR=9998,END=7778) dummy
+    dummy = TRIM(ADJUSTL(dummy))
+    first=dummy(1:1)
+    IF (first == "#") THEN
+      nb_lastkey = 0
+    ENDIF
+  ENDDO
+  out_string=dummy
+!-
+  RETURN
+!-
+9998 CONTINUE
+  CALL ipslerr (3,'getin_skipafew','Error while reading file',' ',' ')
+!-
+7778 CONTINUE
+  eof = 1
+!----------------------------
+END SUBROUTINE getin_skipafew
+!-
+!===
+!-
+SUBROUTINE getin_allockeys ()
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  TYPE(t_key),ALLOCATABLE,DIMENSION(:) :: tmp_key_tab
+!-
+  INTEGER :: ier
+  CHARACTER(LEN=20) :: c_tmp
+!---------------------------------------------------------------------
+  IF (keymemsize == 0) THEN
+!---
+!-- Nothing exists in memory arrays and it is easy to do.
+!---
+    WRITE (UNIT=c_tmp,FMT=*) memslabs
+    ALLOCATE(key_tab(memslabs),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_allockeys', &
+ &     'Can not allocate key_tab', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+    ENDIF
+    nb_keys = 0
+    keymemsize = memslabs
+    key_tab(:)%keycompress = -1
+!---
+  ELSE
+!---
+!-- There is something already in the memory,
+!-- we need to transfer and reallocate.
+!---
+    WRITE (UNIT=c_tmp,FMT=*) keymemsize
+    ALLOCATE(tmp_key_tab(keymemsize),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_allockeys', &
+ &     'Can not allocate tmp_key_tab', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+    ENDIF
+    WRITE (UNIT=c_tmp,FMT=*) keymemsize+memslabs
+    tmp_key_tab(1:keymemsize) = key_tab(1:keymemsize)
+    DEALLOCATE(key_tab)
+    ALLOCATE(key_tab(keymemsize+memslabs),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_allockeys', &
+ &     'Can not allocate key_tab', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+    ENDIF
+    key_tab(:)%keycompress = -1
+    key_tab(1:keymemsize) = tmp_key_tab(1:keymemsize)
+    DEALLOCATE(tmp_key_tab)
+    keymemsize = keymemsize+memslabs
+  ENDIF
+!-----------------------------
+END SUBROUTINE getin_allockeys
+!-
+!===
+!-
+SUBROUTINE getin_allocmem (type,len_wanted)
+!---------------------------------------------------------------------
+!- Allocate the memory of the data base for all 4 types of memory
+!- INTEGER / REAL / CHARACTER / LOGICAL
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: type,len_wanted
+!-
+  INTEGER,ALLOCATABLE :: tmp_int(:)
+  REAL,ALLOCATABLE :: tmp_real(:)
+  CHARACTER(LEN=100),ALLOCATABLE :: tmp_char(:)
+  LOGICAL,ALLOCATABLE :: tmp_logic(:)
+  INTEGER :: ier
+  CHARACTER(LEN=20) :: c_tmp
+!---------------------------------------------------------------------
+  SELECT CASE (type)
+  CASE(k_i)
+    IF (i_memsize == 0) THEN
+      ALLOCATE(i_mem(memslabs),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) memslabs
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate db-memory', &
+ &       'i_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      i_memsize=memslabs
+    ELSE
+      ALLOCATE(tmp_int(i_memsize),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) i_memsize
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate tmp_int', &
+ &       'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      tmp_int(1:i_memsize) = i_mem(1:i_memsize)
+      DEALLOCATE(i_mem)
+      ALLOCATE(i_mem(i_memsize+MAX(memslabs,len_wanted)),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) i_memsize+MAX(memslabs,len_wanted)
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to re-allocate db-memory', &
+ &       'i_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      i_mem(1:i_memsize) = tmp_int(1:i_memsize)
+      i_memsize = i_memsize+MAX(memslabs,len_wanted)
+      DEALLOCATE(tmp_int)
+    ENDIF
+  CASE(k_r)
+    IF (r_memsize == 0) THEN
+      ALLOCATE(r_mem(memslabs),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) memslabs
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate db-memory', &
+ &       'r_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      r_memsize =  memslabs
+    ELSE
+      ALLOCATE(tmp_real(r_memsize),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) r_memsize
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate tmp_real', &
+ &       'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      tmp_real(1:r_memsize) = r_mem(1:r_memsize)
+      DEALLOCATE(r_mem)
+      ALLOCATE(r_mem(r_memsize+MAX(memslabs,len_wanted)),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) r_memsize+MAX(memslabs,len_wanted)
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to re-allocate db-memory', &
+ &       'r_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      r_mem(1:r_memsize) = tmp_real(1:r_memsize)
+      r_memsize = r_memsize+MAX(memslabs,len_wanted)
+      DEALLOCATE(tmp_real)
+    ENDIF
+  CASE(k_c)
+    IF (c_memsize == 0) THEN
+      ALLOCATE(c_mem(memslabs),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) memslabs
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate db-memory', &
+ &       'c_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      c_memsize = memslabs
+    ELSE
+      ALLOCATE(tmp_char(c_memsize),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) c_memsize
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate tmp_char', &
+ &       'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      tmp_char(1:c_memsize) = c_mem(1:c_memsize)
+      DEALLOCATE(c_mem)
+      ALLOCATE(c_mem(c_memsize+MAX(memslabs,len_wanted)),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) c_memsize+MAX(memslabs,len_wanted)
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to re-allocate db-memory', &
+ &       'c_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      c_mem(1:c_memsize) = tmp_char(1:c_memsize)
+      c_memsize = c_memsize+MAX(memslabs,len_wanted)
+      DEALLOCATE(tmp_char)
+    ENDIF
+  CASE(k_l)
+    IF (l_memsize == 0) THEN
+      ALLOCATE(l_mem(memslabs),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) memslabs
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate db-memory', &
+ &       'l_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      l_memsize = memslabs
+    ELSE
+      ALLOCATE(tmp_logic(l_memsize),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) l_memsize
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate tmp_logic', &
+ &       'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      tmp_logic(1:l_memsize) = l_mem(1:l_memsize)
+      DEALLOCATE(l_mem)
+      ALLOCATE(l_mem(l_memsize+MAX(memslabs,len_wanted)),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) l_memsize+MAX(memslabs,len_wanted)
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to re-allocate db-memory', &
+ &       'l_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      l_mem(1:l_memsize) = tmp_logic(1:l_memsize)
+      l_memsize = l_memsize+MAX(memslabs,len_wanted)
+      DEALLOCATE(tmp_logic)
+    ENDIF
+  CASE DEFAULT
+    CALL ipslerr (3,'getin_allocmem','Unknown type of data',' ',' ')
+  END SELECT
+!----------------------------
+END SUBROUTINE getin_allocmem
+!-
+!===
+!-
+SUBROUTINE getin_alloctxt ()
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=100),ALLOCATABLE :: tmp_fic(:)
+  CHARACTER(LEN=l_n),ALLOCATABLE :: tmp_tgl(:)
+  INTEGER,ALLOCATABLE :: tmp_int(:)
+!-
+  INTEGER :: ier
+  CHARACTER(LEN=20) :: c_tmp1,c_tmp2
+!---------------------------------------------------------------------
+  IF (i_txtsize == 0) THEN
+!---
+!-- Nothing exists in memory arrays and it is easy to do.
+!---
+    WRITE (UNIT=c_tmp1,FMT=*) i_txtslab
+    ALLOCATE(fichier(i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate fichier', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+!---
+    ALLOCATE(targetlist(i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate targetlist', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+!---
+    ALLOCATE(fromfile(i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate fromfile', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+!---
+    ALLOCATE(compline(i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate compline', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+!---
+    nb_lines = 0
+    i_txtsize = i_txtslab
+  ELSE
+!---
+!-- There is something already in the memory,
+!-- we need to transfer and reallocate.
+!---
+    WRITE (UNIT=c_tmp1,FMT=*) i_txtsize
+    WRITE (UNIT=c_tmp2,FMT=*) i_txtsize+i_txtslab
+    ALLOCATE(tmp_fic(i_txtsize),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate tmp_fic', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+    tmp_fic(1:i_txtsize) = fichier(1:i_txtsize)
+    DEALLOCATE(fichier)
+    ALLOCATE(fichier(i_txtsize+i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate fichier', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp2)),' ')
+    ENDIF
+    fichier(1:i_txtsize) = tmp_fic(1:i_txtsize)
+    DEALLOCATE(tmp_fic)
+!---
+    ALLOCATE(tmp_tgl(i_txtsize),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate tmp_tgl', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+    tmp_tgl(1:i_txtsize) = targetlist(1:i_txtsize)
+    DEALLOCATE(targetlist)
+    ALLOCATE(targetlist(i_txtsize+i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate targetlist', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp2)),' ')
+    ENDIF
+    targetlist(1:i_txtsize) = tmp_tgl(1:i_txtsize)
+    DEALLOCATE(tmp_tgl)
+!---
+    ALLOCATE(tmp_int(i_txtsize),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate tmp_int', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+    tmp_int(1:i_txtsize) = fromfile(1:i_txtsize)
+    DEALLOCATE(fromfile)
+    ALLOCATE(fromfile(i_txtsize+i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate fromfile', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp2)),' ')
+    ENDIF
+    fromfile(1:i_txtsize) = tmp_int(1:i_txtsize)
+!---
+    tmp_int(1:i_txtsize) = compline(1:i_txtsize)
+    DEALLOCATE(compline)
+    ALLOCATE(compline(i_txtsize+i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate compline', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp2)),' ')
+    ENDIF
+    compline(1:i_txtsize) = tmp_int(1:i_txtsize)
+    DEALLOCATE(tmp_int)
+!---
+    i_txtsize = i_txtsize+i_txtslab
+  ENDIF
+!----------------------------
+END SUBROUTINE getin_alloctxt
+!-
+!===
+!-
+SUBROUTINE getin_dump (fileprefix)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(*),OPTIONAL :: fileprefix
+!-
+  CHARACTER(LEN=80) :: usedfileprefix
+  INTEGER :: ikey,if,iff,iv
+  CHARACTER(LEN=20) :: c_tmp
+  CHARACTER(LEN=100) :: tmp_str,used_filename
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (PRESENT(fileprefix)) THEN
+    usedfileprefix = fileprefix(1:MIN(LEN_TRIM(fileprefix),80))
+  ELSE
+    usedfileprefix = "used"
+  ENDIF
+!-
+  DO if=1,nbfiles
+!---
+    used_filename = TRIM(usedfileprefix)//'_'//TRIM(filelist(if))
+    IF (check) THEN
+      WRITE(*,*) &
+ &      'GETIN_DUMP : opens file : ',TRIM(used_filename),' if = ',if
+      WRITE(*,*) 'GETIN_DUMP : NUMBER OF KEYS : ',nb_keys
+    ENDIF
+    OPEN (UNIT=22,FILE=used_filename)
+!---
+!-- If this is the first file we need to add the list
+!-- of file which belong to it
+    IF ( (if == 1).AND.(nbfiles > 1) ) THEN
+      WRITE(22,*) '# '
+      WRITE(22,*) '# This file is linked to the following files :'
+      WRITE(22,*) '# '
+      DO iff=2,nbfiles
+        WRITE(22,*) 'INCLUDEDEF = ',TRIM(filelist(iff))
+      ENDDO
+      WRITE(22,*) '# '
+    ENDIF
+!---
+    DO ikey=1,nb_keys
+!-----
+!---- Is this key from this file ?
+      IF (key_tab(ikey)%keyfromfile == if) THEN
+!-------
+!------ Write some comments
+        WRITE(22,*) '#'
+        SELECT CASE (key_tab(ikey)%keystatus)
+        CASE(1)
+          WRITE(22,*) '# Values of ', &
+ &          TRIM(key_tab(ikey)%keystr),' comes from ',TRIM(def_file)
+        CASE(2)
+          WRITE(22,*) '# Values of ', &
+ &          TRIM(key_tab(ikey)%keystr),' are all defaults.'
+        CASE(3)
+          WRITE(22,*) '# Values of ', &
+ &          TRIM(key_tab(ikey)%keystr), &
+ &          ' are a mix of ',TRIM(def_file),' and defaults.'
+        CASE DEFAULT
+          WRITE(22,*) '# Dont know from where the value of ', &
+ &          TRIM(key_tab(ikey)%keystr),' comes.'
+        END SELECT
+        WRITE(22,*) '#'
+!-------
+!------ Write the values
+        SELECT CASE (key_tab(ikey)%keytype)
+        CASE(k_i)
+          IF (key_tab(ikey)%keymemlen == 1) THEN
+            IF (key_tab(ikey)%keycompress < 0) THEN
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              ' = ',i_mem(key_tab(ikey)%keymemstart)
+            ELSE
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              ' = ',key_tab(ikey)%keycompress, &
+ &              ' * ',i_mem(key_tab(ikey)%keymemstart)
+            ENDIF
+          ELSE
+            DO iv=0,key_tab(ikey)%keymemlen-1
+              WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              '__',TRIM(ADJUSTL(c_tmp)), &
+ &              ' = ',i_mem(key_tab(ikey)%keymemstart+iv)
+            ENDDO
+          ENDIF
+        CASE(k_r)
+          IF (key_tab(ikey)%keymemlen == 1) THEN
+            IF (key_tab(ikey)%keycompress < 0) THEN
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              ' = ',r_mem(key_tab(ikey)%keymemstart)
+            ELSE
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              ' = ',key_tab(ikey)%keycompress, &
+                   & ' * ',r_mem(key_tab(ikey)%keymemstart)
+            ENDIF
+          ELSE
+            DO iv=0,key_tab(ikey)%keymemlen-1
+              WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr),'__',TRIM(ADJUSTL(c_tmp)), &
+ &              ' = ',r_mem(key_tab(ikey)%keymemstart+iv)
+            ENDDO
+          ENDIF
+        CASE(k_c)
+          IF (key_tab(ikey)%keymemlen == 1) THEN
+            tmp_str = c_mem(key_tab(ikey)%keymemstart)
+            WRITE(22,*) TRIM(key_tab(ikey)%keystr), &
+ &              ' = ',TRIM(tmp_str)
+          ELSE
+            DO iv=0,key_tab(ikey)%keymemlen-1
+              WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1
+              tmp_str = c_mem(key_tab(ikey)%keymemstart+iv)
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              '__',TRIM(ADJUSTL(c_tmp)), &
+ &              ' = ',TRIM(tmp_str)
+            ENDDO
+          ENDIF
+        CASE(k_l)
+          IF (key_tab(ikey)%keymemlen == 1) THEN
+            IF (l_mem(key_tab(ikey)%keymemstart)) THEN
+              WRITE(22,*) TRIM(key_tab(ikey)%keystr),' = TRUE '
+            ELSE
+              WRITE(22,*) TRIM(key_tab(ikey)%keystr),' = FALSE '
+            ENDIF
+          ELSE
+            DO iv=0,key_tab(ikey)%keymemlen-1
+              WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1
+              IF (l_mem(key_tab(ikey)%keymemstart+iv)) THEN
+                WRITE(22,*) TRIM(key_tab(ikey)%keystr),'__', &
+ &                          TRIM(ADJUSTL(c_tmp)),' = TRUE '
+              ELSE
+                WRITE(22,*) TRIM(key_tab(ikey)%keystr),'__', &
+ &                          TRIM(ADJUSTL(c_tmp)),' = FALSE '
+              ENDIF
+            ENDDO
+          ENDIF
+        CASE DEFAULT
+          CALL ipslerr (3,'getin_dump', &
+ &         'Unknown type for variable '//TRIM(key_tab(ikey)%keystr), &
+ &         ' ',' ')
+        END SELECT
+      ENDIF
+    ENDDO
+!-
+    CLOSE(UNIT=22)
+!-
+  ENDDO
+!------------------------
+END SUBROUTINE getin_dump
+!===
+SUBROUTINE get_qtyp (k_typ,c_vtyp,i_v,r_v,c_v,l_v)
+!---------------------------------------------------------------------
+!- Returns the type of the argument (mutually exclusive)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(OUT) :: k_typ
+  CHARACTER(LEN=*),INTENT(OUT) :: c_vtyp
+  INTEGER,DIMENSION(:),OPTIONAL          :: i_v
+  REAL,DIMENSION(:),OPTIONAL             :: r_v
+  LOGICAL,DIMENSION(:),OPTIONAL          :: l_v
+  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_v
+!---------------------------------------------------------------------
+  k_typ = 0
+  IF (COUNT((/PRESENT(i_v),PRESENT(r_v),PRESENT(c_v),PRESENT(l_v)/)) &
+ &    /= 1) THEN
+    CALL ipslerr (3,'get_qtyp', &
+ &   'Invalid number of optional arguments','(/= 1)',' ')
+  ENDIF
+!-
+  IF     (PRESENT(i_v)) THEN
+    k_typ = k_i
+    c_vtyp = 'INTEGER'
+  ELSEIF (PRESENT(r_v)) THEN
+    k_typ = k_r
+    c_vtyp = 'REAL'
+  ELSEIF (PRESENT(c_v)) THEN
+    k_typ = k_c
+    c_vtyp = 'CHARACTER'
+  ELSEIF (PRESENT(l_v)) THEN
+    k_typ = k_l
+    c_vtyp = 'LOGICAL'
+  ENDIF
+!----------------------
+END SUBROUTINE get_qtyp
+!===
+SUBROUTINE get_findkey (i_tab,c_key,pos)
+!---------------------------------------------------------------------
+!- This subroutine looks for a key in a table
+!---------------------------------------------------------------------
+!- INPUT
+!-   i_tab  : 1 -> search in key_tab(1:nb_keys)%keystr
+!-            2 -> search in targetlist(1:nb_lines)
+!-   c_key  : Name of the key we are looking for
+!- OUTPUT
+!-   pos    : -1 if key not found, else value in the table
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(in) :: i_tab
+  CHARACTER(LEN=*),INTENT(in) :: c_key
+  INTEGER,INTENT(out) :: pos
+!-
+  INTEGER :: ikey_max,ikey
+  CHARACTER(LEN=l_n) :: c_q_key
+!---------------------------------------------------------------------
+  pos = -1
+  IF     (i_tab == 1) THEN
+    ikey_max = nb_keys
+  ELSEIF (i_tab == 2) THEN
+    ikey_max = nb_lines
+  ELSE
+    ikey_max = 0
+  ENDIF
+  IF ( ikey_max > 0 ) THEN
+    DO ikey=1,ikey_max
+      IF (i_tab == 1) THEN
+        c_q_key = key_tab(ikey)%keystr
+      ELSE
+        c_q_key = targetlist(ikey)
+      ENDIF
+      IF (TRIM(c_q_key) == TRIM(c_key)) THEN
+        pos = ikey
+        EXIT
+      ENDIF
+    ENDDO
+  ENDIF
+!-------------------------
+END SUBROUTINE get_findkey
+!===
+!------------------
+END MODULE getincom
Index: trunk/NEMOGCM/EXTERNAL/IOIPSL/src/histcom.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/IOIPSL/src/histcom.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/IOIPSL/src/histcom.f90	(revision 2528)
@@ -0,0 +1,2501 @@
+MODULE histcom
+!-
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!-
+  USE netcdf
+  USE nc4interface ! needed to allow compilation with netcdf3 libraries
+!-
+  USE stringop, ONLY : nocomma,cmpblank,findpos,find_str,strlowercase
+  USE mathelp,  ONLY : mathop,moycum,buildop
+  USE fliocom,  ONLY : flio_dom_file,flio_dom_att
+  USE calendar
+  USE errioipsl, ONLY : ipslerr,ipsldbg
+!-
+  IMPLICIT NONE
+!-
+  PRIVATE
+  PUBLIC :: histbeg,histdef,histhori,histvert,histend, &
+ &          histwrite,histclo,histsync,ioconf_modname
+!---------------------------------------------------------------------
+!- Some confusing vocabulary in this code !
+!- =========================================
+!-
+!- A REGULAR grid is a grid which is i,j indexes
+!- and thus it is stored in a 2D matrix.
+!- This is opposed to a IRREGULAR grid which is only in a vector
+!- and where we do not know which neighbors we have.
+!- As a consequence we need the bounds for each grid-cell.
+!-
+!- A RECTILINEAR grid is a special case of a regular grid
+!- in which all longitudes for i constant are equal
+!- and all latitudes for j constant.
+!- In other words we do not need the full 2D matrix
+!- to describe the grid, just two vectors.
+!---------------------------------------------------------------------
+!-
+  INTERFACE histbeg
+    MODULE PROCEDURE histb_reg1d,histb_reg2d,histb_irreg
+  END INTERFACE
+!-
+  INTERFACE histhori
+    MODULE PROCEDURE histh_reg1d,histh_reg2d,histh_irreg
+  END INTERFACE
+!-
+  INTERFACE histwrite
+!---------------------------------------------------------------------
+!- The "histwrite" routines will give the data to the I/O system.
+!- It will trigger the operations to be performed,
+!- and the writting to the file if needed
+!-
+!- We test for the work to be done at this time here so that at a
+!- later stage we can call different operation and write subroutine
+!- for the REAL and INTEGER interfaces
+!-
+!- INPUT
+!- idf      : The ID of the file on which this variable is to be,
+!-            written. The variable should have been defined in
+!-            this file before.
+!- pvarname : The short name of the variable
+!- pitau    : Current timestep
+!- pdata    : The variable, I mean the real data !
+!- nbindex  : The number of indexes provided. If it is equal to
+!-            the size of the full field as provided in histdef
+!-            then nothing is done.
+!- nindex   : The indices used to expand the variable (pdata)
+!-            onto the full field.
+!---------------------------------------------------------------------
+!- histwrite - we have to prepare different type of fields :
+!-             real and integer, 1,2 or 3D
+    MODULE PROCEDURE histwrite_r1d,histwrite_r2d,histwrite_r3d
+  END INTERFACE
+!-
+! Fixed parameter
+!-
+  INTEGER,PARAMETER :: nb_files_max=20,nb_var_max=400, &
+ &                     nb_hax_max=5,nb_zax_max=10,nbopp_max=10
+  REAL,PARAMETER :: missing_val=nf90_fill_real
+  INTEGER,PARAMETER,PUBLIC :: &
+ &  hist_r4=nf90_real4, hist_r8=nf90_real8
+!-
+! Variable derived type
+!-
+TYPE T_D_V
+  INTEGER :: ncvid
+  INTEGER :: nbopp
+  CHARACTER(LEN=20)  :: v_name,unit_name
+  CHARACTER(LEN=256) :: title,std_name
+  CHARACTER(LEN=80)  :: fullop
+  CHARACTER(LEN=7)   :: topp
+  CHARACTER(LEN=7),DIMENSION(nbopp_max) :: sopp
+  REAL,DIMENSION(nbopp_max) :: scal
+!-External type (for R4/R8)
+  INTEGER :: v_typ
+!-Sizes of the associated grid and zommed area
+  INTEGER,DIMENSION(3) :: scsize,zorig,zsize
+!-Sizes for the data as it goes through the various math operations
+  INTEGER,DIMENSION(3) :: datasz_in = -1
+  INTEGER :: datasz_max = -1
+!-
+  INTEGER :: h_axid,z_axid,t_axid
+!-
+  REAL,DIMENSION(2) :: hist_minmax
+  LOGICAL :: hist_calc_rng=.FALSE.,hist_wrt_rng=.FALSE.
+!-Book keeping of the axes
+  INTEGER :: tdimid,tbndid=-1,tax_last
+  LOGICAL :: l_bnd
+  CHARACTER(LEN=40) :: tax_name
+!-
+  REAL :: freq_opp,freq_wrt
+  INTEGER :: &
+ &  last_opp,last_wrt,last_opp_chk,last_wrt_chk,nb_opp,nb_wrt
+!- For future optimization
+  REAL,POINTER,DIMENSION(:) :: t_bf
+!#  REAL,ALLOCATABLE,DIMENSION(:) :: V_1_D
+!#  REAL,ALLOCATABLE,DIMENSION(:,:) :: V_2_D
+!#  REAL,ALLOCATABLE,DIMENSION(:,:,:) :: V_3_D
+END TYPE T_D_V
+!-
+! File derived type
+!-
+TYPE :: T_D_F
+!-NETCDF IDs for file
+  INTEGER :: ncfid=-1
+!-Time variables
+  INTEGER :: itau0=0
+  REAL :: date0,deltat
+!-Counter of elements (variables, time-horizontal-vertical axis
+  INTEGER :: n_var=0,n_tax=0,n_hax=0,n_zax=0
+!-NETCDF dimension IDs for time-[time_bounds]-longitude-latitude
+  INTEGER :: tid,bid,xid,yid
+!-General definitions in the NETCDF file
+  INTEGER,DIMENSION(2) :: full_size=0,slab_ori,slab_siz
+!-The horizontal axes
+  CHARACTER(LEN=25),DIMENSION(nb_hax_max,2) :: hax_name
+!-The vertical axes
+  INTEGER,DIMENSION(nb_zax_max) :: zax_size,zax_ids
+  CHARACTER(LEN=20),DIMENSION(nb_zax_max) :: zax_name
+!-
+  LOGICAL :: regular=.TRUE.
+!-DOMAIN ID
+  INTEGER :: dom_id_svg=-1
+!-
+  TYPE(T_D_V),DIMENSION(nb_var_max) :: W_V
+END TYPE T_D_F
+!-
+TYPE(T_D_F),DIMENSION(nb_files_max),SAVE :: W_F
+!-
+! A list of functions which require special action
+! (Needs to be updated when functions are added
+!  but they are well located here)
+!-
+  CHARACTER(LEN=30),SAVE :: fuchnbout = 'scatter, fill'
+!- Some configurable variables with locks
+  CHARACTER(LEN=80),SAVE :: model_name='An IPSL model'
+  LOGICAL,SAVE :: lock_modname=.FALSE.
+!-
+!===
+CONTAINS
+!===
+!-
+SUBROUTINE histb_reg1d                 &
+ & (pfilename,pim,plon,pjm,plat,       &
+ &  par_orix,par_szx,par_oriy,par_szy, &
+ &  pitau0,pdate0,pdeltat,phoriid,idf,domain_id,mode,snc4chunks)
+!---------------------------------------------------------------------
+!- histbeg for 1D regular horizontal coordinates (see histb_all)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: pfilename
+  INTEGER,INTENT(IN) :: pim,pjm
+  REAL,DIMENSION(pim),INTENT(IN) :: plon
+  REAL,DIMENSION(pjm),INTENT(IN) :: plat
+  INTEGER,INTENT(IN):: par_orix,par_szx,par_oriy,par_szy
+  INTEGER,INTENT(IN) :: pitau0
+  REAL,INTENT(IN) :: pdate0,pdeltat
+  INTEGER,INTENT(OUT) :: idf,phoriid
+  INTEGER,INTENT(IN),OPTIONAL :: domain_id
+  CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: mode
+  TYPE(snc4_ctl), OPTIONAL,INTENT(IN) :: snc4chunks
+!---------------------------------------------------------------------
+  CALL histb_all &
+ & (1,pfilename,pim,pjm,pitau0,pdate0,pdeltat,phoriid,idf, &
+ &  x_1d=plon,y_1d=plat, &
+ &  k_orx=par_orix,k_szx=par_szx,k_ory=par_oriy,k_szy=par_szy, &
+ &  domain_id=domain_id,mode=mode,snc4chunks=snc4chunks)
+!-------------------------
+END SUBROUTINE histb_reg1d
+!===
+SUBROUTINE histb_reg2d &
+ & (pfilename,pim,plon,pjm,plat,       &
+ &  par_orix,par_szx,par_oriy,par_szy, &
+ &  pitau0,pdate0,pdeltat,phoriid,idf,domain_id,mode,snc4chunks)
+!---------------------------------------------------------------------
+!- histbeg for 2D regular horizontal coordinates (see histb_all)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: pfilename
+  INTEGER,INTENT(IN) :: pim,pjm
+  REAL,DIMENSION(pim,pjm),INTENT(IN) :: plon,plat
+  INTEGER,INTENT(IN):: par_orix,par_szx,par_oriy,par_szy
+  INTEGER,INTENT(IN) :: pitau0
+  REAL,INTENT(IN) :: pdate0,pdeltat
+  INTEGER,INTENT(OUT) :: idf,phoriid
+  INTEGER,INTENT(IN),OPTIONAL :: domain_id
+  CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: mode
+  TYPE(snc4_ctl), OPTIONAL,INTENT(IN) :: snc4chunks
+!---------------------------------------------------------------------
+  CALL histb_all &
+ & (2,pfilename,pim,pjm,pitau0,pdate0,pdeltat,phoriid,idf,  &
+ &  x_2d=plon,y_2d=plat, &
+ &  k_orx=par_orix,k_szx=par_szx,k_ory=par_oriy,k_szy=par_szy,    &
+ &  domain_id=domain_id,mode=mode,snc4chunks=snc4chunks)
+!-------------------------
+END SUBROUTINE histb_reg2d
+!===
+SUBROUTINE histb_irreg &
+ &  (pfilename,pim,plon,plon_bounds,plat,plat_bounds, &
+ &   pitau0,pdate0,pdeltat,phoriid,idf,domain_id,mode,snc4chunks)
+!---------------------------------------------------------------------
+!- histbeg for irregular horizontal coordinates (see histb_all)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: pfilename
+  INTEGER,INTENT(IN) :: pim
+  REAL,DIMENSION(pim),INTENT(IN) :: plon,plat
+  REAL,DIMENSION(:,:),INTENT(IN) :: plon_bounds,plat_bounds
+  INTEGER,INTENT(IN) :: pitau0
+  REAL,INTENT(IN) :: pdate0,pdeltat
+  INTEGER,INTENT(OUT) :: idf,phoriid
+  INTEGER,INTENT(IN),OPTIONAL :: domain_id
+  CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: mode
+  TYPE(snc4_ctl), OPTIONAL,INTENT(IN) :: snc4chunks
+!---------------------------------------------------------------------
+  CALL histb_all &
+ & (3,pfilename,pim,pim,pitau0,pdate0,pdeltat,phoriid,idf,  &
+ &  x_1d=plon,y_1d=plat,x_bnds=plon_bounds,y_bnds=plat_bounds, &
+ &  domain_id=domain_id,mode=mode,snc4chunks=snc4chunks)
+!-------------------------
+END SUBROUTINE histb_irreg
+!===
+SUBROUTINE histb_all &
+ & (k_typ,nc_name,pim,pjm,pitau0,pdate0,pdeltat,phoriid,idf, &
+ &  x_1d,y_1d,x_2d,y_2d,k_orx,k_szx,k_ory,k_szy, &
+ &  x_bnds,y_bnds,domain_id,mode,snc4chunks)
+!---------------------------------------------------------------------
+!- General interface for horizontal grids.
+!- This subroutine initializes a netcdf file and returns the ID.
+!- It will set up the geographical space on which the data will be
+!- stored and offers the possibility of seting a zoom.
+!- In the case of irregular grids, all the data comes in as vectors
+!- and for the grid we have the coordinates of the 4 corners.
+!- It also gets the global parameters into the I/O subsystem.
+!-
+!- INPUT
+!-
+!- k_typ    : Type of the grid (1 rectilinear, 2 regular, 3 irregular)
+!- nc_name  : Name of the netcdf file to be created
+!- pim      : Size of arrays in longitude direction
+!- pjm      : Size of arrays in latitude direction (pjm=pim for type 3)
+!-
+!- pitau0   : time step at which the history tape starts
+!- pdate0   : The Julian date at which the itau was equal to 0
+!- pdeltat  : Time step, in seconds, of the counter itau
+!-            used in histwrite for instance
+!-
+!- OUTPUT
+!-
+!- phoriid  : Identifier of the horizontal grid
+!- idf      : Identifier of the file
+!-
+!- Optional INPUT arguments
+!-
+!- For rectilinear or irregular grid
+!- x_1d  : The longitudes
+!- y_1d  : The latitudes
+!- For regular grid
+!- x_2d  : The longitudes
+!- y_2d  : The latitudes
+!- One pair (x_1d,y_1d) or (x_2d,y_2d) must be supplied.
+!-
+!- For regular grid (reg1d or reg2d),
+!- the next 4 arguments allow to define a horizontal zoom
+!- for this file. It is assumed that all variables to come
+!- have the same index space. This can not be assumed for
+!- the z axis and thus we define the zoom in histdef.
+!- k_orx  : Origin of the slab of data within the X axis (pim)
+!- k_szx  : Size of the slab of data in X
+!- k_ory  : Origin of the slab of data within the Y axis (pjm)
+!- k_szy  : Size of the slab of data in Y
+!-
+!- For irregular grid.
+!- x_bnds : The boundaries of the grid in longitude
+!- y_bnds : The boundaries of the grid in latitude
+!-
+!- For all grids.
+!-
+!- domain_id  : Domain identifier
+!-
+!- mode       : String of (case insensitive) blank-separated words
+!-              defining the mode used to create the file.
+!-              Supported keywords : 32, 64
+!-              "32/64" defines the offset mode.
+!-              The default offset mode is 64 bits.
+!-              Keywords "NETCDF4" and "CLASSIC" are reserved
+!-              for future use.
+!-
+!- snc4chunks    : Structure containing chunk partitioning parameters
+!-              for 4-D variables and a logical switch to toggle
+!-              between netcdf3 o/p (false) and netcdf4 chunked
+!-              and compressed o/p (true)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: k_typ
+  CHARACTER(LEN=*),INTENT(IN) :: nc_name
+  INTEGER,INTENT(IN) :: pim,pjm
+  INTEGER,INTENT(IN) :: pitau0
+  REAL,INTENT(IN) :: pdate0,pdeltat
+  INTEGER,INTENT(OUT) :: idf,phoriid
+  REAL,DIMENSION(:),INTENT(IN),OPTIONAL :: x_1d,y_1d
+  REAL,DIMENSION(:,:),INTENT(IN),OPTIONAL :: x_2d,y_2d
+  INTEGER,INTENT(IN),OPTIONAL :: k_orx,k_szx,k_ory,k_szy
+  REAL,DIMENSION(:,:),INTENT(IN),OPTIONAL :: x_bnds,y_bnds
+  INTEGER,INTENT(IN),OPTIONAL :: domain_id
+  CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: mode
+  TYPE(snc4_ctl), OPTIONAL,INTENT(IN) :: snc4chunks
+!-
+  INTEGER :: nfid,iret,m_c
+  CHARACTER(LEN=120) :: file
+  CHARACTER(LEN=30) :: timenow
+  CHARACTER(LEN=11) :: c_nam
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF     (k_typ == 1) THEN
+    c_nam = 'histb_reg1d'
+  ELSEIF (k_typ == 2) THEN
+    c_nam = 'histb_reg2d'
+  ELSEIF (k_typ == 3) THEN
+    c_nam = 'histb_irreg'
+  ELSE
+    CALL ipslerr (3,"histbeg", &
+ &    'Illegal value of k_typ argument','in internal interface','?')
+  ENDIF
+!-
+  IF (l_dbg) WRITE(*,*) c_nam//" 0.0"
+!-
+! Search for a free index
+!-
+  idf = -1
+  DO nfid=1,nb_files_max
+    IF (W_F(nfid)%ncfid < 0) THEN
+      idf = nfid; EXIT;
+    ENDIF
+  ENDDO
+  IF (idf < 0) THEN
+    CALL ipslerr (3,"histbeg", &
+   &  'Table of files too small. You should increase nb_files_max', &
+   &  'in histcom.f90 in order to accomodate all these files',' ')
+  ENDIF
+!-
+! 1.0 Transfering into the common for future use
+!-
+  IF (l_dbg) WRITE(*,*) c_nam//" 1.0"
+!-
+  W_F(idf)%itau0  = pitau0
+  W_F(idf)%date0  = pdate0
+  W_F(idf)%deltat = pdeltat
+!-
+! 2.0 Initializes all variables for this file
+!-
+  IF (l_dbg) WRITE(*,*) c_nam//" 2.0"
+!-
+  W_F(idf)%n_var = 0
+  W_F(idf)%n_tax = 0
+  W_F(idf)%n_hax = 0
+  W_F(idf)%n_zax = 0
+!-
+  IF ( (k_typ == 1).OR.(k_typ == 2) ) THEN
+    W_F(idf)%slab_ori(1:2) = (/ k_orx,k_ory /)
+    W_F(idf)%slab_siz(1:2)  = (/ k_szx,k_szy /)
+  ELSE
+    W_F(idf)%slab_ori(1:2) = (/ 1,1 /)
+    W_F(idf)%slab_siz(1:2) = (/ pim,1 /)
+  ENDIF
+!-
+! 3.0 Opening netcdf file and defining dimensions
+!-
+  IF (l_dbg) WRITE(*,*) c_nam//" 3.0"
+!-
+! Add DOMAIN number and ".nc" suffix in file name if needed
+!-
+  file = nc_name
+  CALL flio_dom_file (file,domain_id)
+!-
+! Check the mode
+!? See fliocom for HDF4 ????????????????????????????????????????????????
+!-
+  IF (PRESENT(mode)) THEN
+    SELECT CASE (TRIM(mode))
+    CASE('32')
+      m_c = NF90_CLOBBER
+    CASE('64')
+      m_c = IOR(NF90_CLOBBER,NF90_64BIT_OFFSET)
+    CASE DEFAULT
+      CALL ipslerr (3,"histbeg", &
+ &      'Invalid argument mode for file :',TRIM(file), &
+ &      'Supported values are 32 or 64')
+    END SELECT
+  ELSE
+    m_c = IOR(NF90_CLOBBER,NF90_64BIT_OFFSET)
+  ENDIF
+!-
+  IF (PRESENT(snc4chunks)) THEN
+    IF (snc4chunks%luse) CALL get_nf90_symbol("NF90_HDF5", m_c)
+  ENDIF
+!-
+! Create file
+!-
+  iret = NF90_CREATE(file,m_c,nfid)
+!-
+  IF     (k_typ == 1) THEN
+    iret = NF90_DEF_DIM(nfid,'lon',k_szx,W_F(idf)%xid)
+    iret = NF90_DEF_DIM(nfid,'lat',k_szy,W_F(idf)%yid)
+  ELSEIF (k_typ == 2) THEN
+    iret = NF90_DEF_DIM(nfid,'x',k_szx,W_F(idf)%xid)
+    iret = NF90_DEF_DIM(nfid,'y',k_szy,W_F(idf)%yid)
+  ELSEIF (k_typ == 3) THEN
+    iret = NF90_DEF_DIM(nfid,'x',pim,W_F(idf)%xid)
+    W_F(idf)%yid = W_F(idf)%xid
+  ENDIF
+!-
+! 4.0 Declaring the geographical coordinates and other attributes
+!-
+  IF (l_dbg) WRITE(*,*) c_nam//" 4.0"
+!-
+  iret = NF90_PUT_ATT(nfid,NF90_GLOBAL,'Conventions','CF-1.1')
+  iret = NF90_PUT_ATT(nfid,NF90_GLOBAL,'file_name',TRIM(file))
+  iret = NF90_PUT_ATT(nfid,NF90_GLOBAL,'production',TRIM(model_name))
+  lock_modname = .TRUE.
+  CALL ioget_timestamp (timenow)
+  iret = NF90_PUT_ATT(nfid,NF90_GLOBAL,'TimeStamp',TRIM(timenow))
+!-
+! 5.0 Saving some important information on this file in the common
+!-
+  IF (l_dbg) WRITE(*,*) c_nam//" 5.0"
+!-
+  IF (PRESENT(domain_id)) THEN
+    W_F(idf)%dom_id_svg = domain_id
+  ENDIF
+  W_F(idf)%ncfid = nfid
+  IF ( (k_typ == 1).OR.(k_typ == 2) ) THEN
+    W_F(idf)%full_size(1:2) = (/ pim,pjm /)
+    W_F(idf)%regular=.TRUE.
+  ELSEIF (k_typ == 3) THEN
+    W_F(idf)%full_size(1:2) = (/ pim,1 /)
+    W_F(idf)%regular=.FALSE.
+  ENDIF
+!-
+! 6.0 storing the geographical coordinates
+!-
+  IF     (k_typ == 1) THEN
+    CALL histh_all &
+ &   (k_typ,idf,pim,pjm,' ','Default grid',phoriid, &
+ &    x_1d=x_1d,y_1d=y_1d)
+  ELSEIF (k_typ == 2) THEN
+    CALL histh_all &
+ &   (k_typ,idf,pim,pjm,' ','Default grid',phoriid, &
+ &    x_2d=x_2d,y_2d=y_2d)
+  ELSEIF (k_typ == 3) THEN
+    CALL histh_all &
+ &   (k_typ,idf,pim,pim,' ','Default grid',phoriid, &
+ &    x_1d=x_1d,y_1d=y_1d,x_bnds=x_bnds,y_bnds=y_bnds)
+  ENDIF
+!-----------------------
+END SUBROUTINE histb_all
+!===
+SUBROUTINE histh_reg1d &
+ &  (idf,pim,plon,pjm,plat,phname,phtitle,phid)
+!---------------------------------------------------------------------
+!- histhori for 1d regular grid (see histh_all)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: idf,pim,pjm
+  REAL,INTENT(IN),DIMENSION(:) :: plon,plat
+  CHARACTER(LEN=*),INTENT(IN) :: phname,phtitle
+  INTEGER,INTENT(OUT) :: phid
+!---------------------------------------------------------------------
+  CALL histh_all &
+ & (1,idf,pim,pjm,phname,phtitle,phid,x_1d=plon,y_1d=plat)
+!-------------------------
+END SUBROUTINE histh_reg1d
+!===
+SUBROUTINE histh_reg2d &
+ & (idf,pim,plon,pjm,plat,phname,phtitle,phid)
+!---------------------------------------------------------------------
+!- histhori for 2d regular grid (see histh_all)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: idf,pim,pjm
+  REAL,INTENT(IN),DIMENSION(:,:) :: plon,plat
+  CHARACTER(LEN=*),INTENT(IN) :: phname,phtitle
+  INTEGER,INTENT(OUT) :: phid
+!---------------------------------------------------------------------
+  CALL histh_all &
+ & (2,idf,pim,pjm,phname,phtitle,phid,x_2d=plon,y_2d=plat)
+!-------------------------
+END SUBROUTINE histh_reg2d
+!===
+SUBROUTINE histh_irreg &
+ & (idf,pim,plon,plon_bounds,plat,plat_bounds,phname,phtitle,phid)
+!---------------------------------------------------------------------
+!- histhori for irregular grid (see histh_all)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: idf,pim
+  REAL,DIMENSION(:),INTENT(IN) :: plon,plat
+  REAL,DIMENSION(:,:),INTENT(IN) :: plon_bounds,plat_bounds
+  CHARACTER(LEN=*),INTENT(IN) :: phname,phtitle
+  INTEGER,INTENT(OUT) :: phid
+!---------------------------------------------------------------------
+  CALL histh_all &
+ & (3,idf,pim,pim,phname,phtitle,phid, &
+ &  x_1d=plon,y_1d=plat,x_bnds=plon_bounds,y_bnds=plat_bounds)
+!-------------------------
+END SUBROUTINE histh_irreg
+!===
+SUBROUTINE histh_all &
+ & (k_typ,idf,pim,pjm,phname,phtitle,phid, &
+ &  x_1d,y_1d,x_2d,y_2d,x_bnds,y_bnds)
+!---------------------------------------------------------------------
+!- General interface for horizontal grids.
+!- This subroutine is made to declare a new horizontal grid.
+!- It has to have the same number of points as
+!- the original and thus in this routine we will only
+!- add two variable (longitude and latitude).
+!- Any variable in the file can thus point to this pair
+!- through an attribute. This routine is very usefull
+!- to allow staggered grids.
+!-
+!- INPUT
+!-
+!- k_typ   : Type of the grid (1 rectilinear, 2 regular, 3 irregular)
+!- idf     : The id of the file to which the grid should be added
+!- pim     : Size in the longitude direction
+!- pjm     : Size in the latitude direction (pjm=pim for type 3)
+!- phname  : The name of grid
+!- phtitle : The title of the grid
+!-
+!- OUTPUT
+!-
+!- phid    : Id of the created grid
+!-
+!- Optional INPUT arguments
+!-
+!- For rectilinear or irregular grid
+!- x_1d  : The longitudes
+!- y_1d  : The latitudes
+!- For regular grid
+!- x_2d  : The longitudes
+!- y_2d  : The latitudes
+!- One pair (x_1d,y_1d) or (x_2d,y_2d) must be supplied.
+!-
+!- For irregular grid.
+!- x_bnds : The boundaries of the grid in longitude
+!- y_bnds : The boundaries of the grid in latitude
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: k_typ
+  INTEGER,INTENT(IN) :: idf,pim,pjm
+  CHARACTER(LEN=*),INTENT(IN) :: phname,phtitle
+  INTEGER,INTENT(OUT) :: phid
+  REAL,DIMENSION(:),INTENT(IN),OPTIONAL :: x_1d,y_1d
+  REAL,DIMENSION(:,:),INTENT(IN),OPTIONAL :: x_2d,y_2d
+  REAL,DIMENSION(:,:),INTENT(IN),OPTIONAL :: x_bnds,y_bnds
+!-
+  CHARACTER(LEN=25) :: lon_name,lat_name
+  CHARACTER(LEN=30) :: lonbound_name,latbound_name
+  INTEGER :: i_s,i_e
+  INTEGER,DIMENSION(2) :: dims,dims_b
+  INTEGER :: nbbounds
+  INTEGER :: nlonidb,nlatidb,twoid
+  LOGICAL :: transp = .FALSE.
+  REAL,ALLOCATABLE,DIMENSION(:,:) :: bounds_trans
+  REAL :: wmn,wmx
+  INTEGER :: nlonid,nlatid
+  INTEGER :: o_x,o_y,s_x,s_y
+  INTEGER :: iret,nfid
+  CHARACTER(LEN=11) :: c_nam
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF     (k_typ == 1) THEN
+    c_nam = 'histh_reg1d'
+  ELSEIF (k_typ == 2) THEN
+    c_nam = 'histh_reg2d'
+  ELSEIF (k_typ == 3) THEN
+    c_nam = 'histh_irreg'
+  ELSE
+    CALL ipslerr (3,"histhori", &
+ &    'Illegal value of k_typ argument','in internal interface','?')
+  ENDIF
+!-
+! 1.0 Check that all fits in the buffers
+!-
+  IF (    (pim /= W_F(idf)%full_size(1)) &
+ &    .OR.(W_F(idf)%regular.AND.(pjm /= W_F(idf)%full_size(2)))  &
+ &    .OR.(.NOT.W_F(idf)%regular.AND.(W_F(idf)%full_size(2) /= 1)) ) THEN
+    CALL ipslerr (3,"histhori", &
+ &   'The new horizontal grid does not have the same size', &
+ &   'as the one provided to histbeg. This is not yet ', &
+ &   'possible in the hist package.')
+  ENDIF
+!-
+! 1.1 Create all the variables needed
+!-
+  IF (l_dbg) WRITE(*,*) c_nam//" 1.0"
+!-
+  nfid = W_F(idf)%ncfid
+!-
+  IF (k_typ == 3) THEN
+    IF     (SIZE(x_bnds,DIM=1) == pim) THEN
+      nbbounds = SIZE(x_bnds,DIM=2)
+      transp = .TRUE.
+    ELSEIF (SIZE(x_bnds,DIM=2) == pim) THEN
+      nbbounds = SIZE(x_bnds,DIM=1)
+      transp = .FALSE.
+    ELSE
+      CALL ipslerr (3,"histhori", &
+ &     'The boundary variable does not have any axis corresponding', &
+ &     'to the size of the longitude or latitude variable','.')
+    ENDIF
+    ALLOCATE(bounds_trans(nbbounds,pim))
+    iret = NF90_DEF_DIM(nfid,'nbnd',nbbounds,twoid)
+    dims_b(1:2) = (/ twoid,W_F(idf)%xid /)
+  ENDIF
+!-
+  dims(1:2) = (/ W_F(idf)%xid,W_F(idf)%yid /)
+!-
+  IF     (k_typ == 1) THEN
+    IF (W_F(idf)%n_hax == 0) THEN
+      lon_name = 'lon'
+      lat_name = 'lat'
+    ELSE
+      lon_name = 'lon_'//TRIM(phname)
+      lat_name = 'lat_'//TRIM(phname)
+    ENDIF
+  ELSEIF (k_typ == 2) THEN
+    IF (W_F(idf)%n_hax == 0) THEN
+      lon_name = 'nav_lon'
+      lat_name = 'nav_lat'
+    ELSE
+      lon_name = 'nav_lon_'//TRIM(phname)
+      lat_name = 'nav_lat_'//TRIM(phname)
+    ENDIF
+  ELSEIF (k_typ == 3) THEN
+    IF (W_F(idf)%n_hax == 0) THEN
+      lon_name = 'nav_lon'
+      lat_name = 'nav_lat'
+    ELSE
+      lon_name = 'nav_lon_'//TRIM(phname)
+      lat_name = 'nav_lat_'//TRIM(phname)
+    ENDIF
+    lonbound_name = TRIM(lon_name)//'_bounds'
+    latbound_name = TRIM(lat_name)//'_bounds'
+  ENDIF
+!-
+! 1.2 Save the informations
+!-
+  phid = W_F(idf)%n_hax+1
+  W_F(idf)%n_hax = phid
+  W_F(idf)%hax_name(phid,1:2) = (/ lon_name,lat_name /)
+!-
+! 2.0 Longitude
+!-
+  IF (l_dbg) WRITE(*,*) c_nam//" 2.0"
+!-
+  i_s = 1;
+  IF ( (k_typ == 1).OR.(k_typ == 3) ) THEN
+    i_e = 1; wmn = MINVAL(x_1d); wmx = MAXVAL(x_1d);
+  ELSEIF (k_typ == 2) THEN
+    i_e = 2; wmn = MINVAL(x_2d); wmx = MAXVAL(x_2d);
+  ENDIF
+  iret = NF90_DEF_VAR(nfid,lon_name,NF90_REAL4,dims(i_s:i_e),nlonid)
+  IF (k_typ == 1) THEN
+    iret = NF90_PUT_ATT(nfid,nlonid,'axis',"X")
+  ENDIF
+  iret = NF90_PUT_ATT(nfid,nlonid,'standard_name',"longitude")
+  iret = NF90_PUT_ATT(nfid,nlonid,'units',"degrees_east")
+  iret = NF90_PUT_ATT(nfid,nlonid,'valid_min',REAL(wmn,KIND=4))
+  iret = NF90_PUT_ATT(nfid,nlonid,'valid_max',REAL(wmx,KIND=4))
+  iret = NF90_PUT_ATT(nfid,nlonid,'long_name',"Longitude")
+  iret = NF90_PUT_ATT(nfid,nlonid,'nav_model',TRIM(phtitle))
+!-
+  IF (k_typ == 3) THEN
+!---
+!-- 2.1 Longitude bounds
+!---
+    iret = NF90_PUT_ATT(nfid,nlonid,'bounds',TRIM(lonbound_name))
+    iret = NF90_DEF_VAR(nfid,lonbound_name,NF90_REAL4,dims_b(1:2),nlonidb)
+    iret = NF90_PUT_ATT(nfid,nlonidb,'long_name', &
+ &          'Boundaries for coordinate variable '//TRIM(lon_name))
+  ENDIF
+!-
+! 3.0 Latitude
+!-
+  IF (l_dbg) WRITE(*,*) c_nam//" 3.0"
+!-
+  i_e = 2;
+  IF ( (k_typ == 1).OR.(k_typ == 3) ) THEN
+    i_s = 2; wmn = MINVAL(y_1d); wmx = MAXVAL(y_1d);
+  ELSEIF (k_typ == 2) THEN
+    i_s = 1; wmn = MINVAL(y_2d); wmx = MAXVAL(y_2d);
+  ENDIF
+  iret = NF90_DEF_VAR(nfid,lat_name,NF90_REAL4,dims(i_s:i_e),nlatid)
+  IF (k_typ == 1) THEN
+    iret = NF90_PUT_ATT(nfid,nlatid,'axis',"Y")
+  ENDIF
+!-
+  iret = NF90_PUT_ATT(nfid,nlatid,'standard_name',"latitude")
+  iret = NF90_PUT_ATT(nfid,nlatid,'units',"degrees_north")
+  iret = NF90_PUT_ATT(nfid,nlatid,'valid_min',REAL(wmn,KIND=4))
+  iret = NF90_PUT_ATT(nfid,nlatid,'valid_max',REAL(wmx,KIND=4))
+  iret = NF90_PUT_ATT(nfid,nlatid,'long_name',"Latitude")
+  iret = NF90_PUT_ATT(nfid,nlatid,'nav_model',TRIM(phtitle))
+!-
+  IF (k_typ == 3) THEN
+!---
+!-- 3.1 Latitude bounds
+!---
+    iret = NF90_PUT_ATT(nfid,nlatid,'bounds',TRIM(latbound_name))
+    iret = NF90_DEF_VAR(nfid,latbound_name,NF90_REAL4,dims_b(1:2),nlatidb)
+    iret = NF90_PUT_ATT(nfid,nlatidb,'long_name', &
+ &          'Boundaries for coordinate variable '//TRIM(lat_name))
+  ENDIF
+!-
+  iret = NF90_ENDDEF(nfid)
+!-
+! 4.0 storing the geographical coordinates
+!-
+  IF (l_dbg) WRITE(*,*) c_nam//" 4.0"
+!-
+  IF ( (k_typ == 1).OR.(k_typ == 2) ) THEN
+    o_x = W_F(idf)%slab_ori(1)
+    o_y = W_F(idf)%slab_ori(2)
+    s_x = W_F(idf)%slab_siz(1)
+    s_y = W_F(idf)%slab_siz(2)
+!---
+!-- Transfer the longitude and  the latitude
+!---
+    IF     (k_typ == 1) THEN
+      iret = NF90_PUT_VAR(nfid,nlonid,x_1d(o_x:o_x+s_x-1))
+      iret = NF90_PUT_VAR(nfid,nlatid,y_1d(o_y:o_y+s_y-1))
+    ELSEIF (k_typ == 2) THEN
+      iret = NF90_PUT_VAR(nfid,nlonid, &
+ &            x_2d(o_x:o_x+s_x-1,o_y:o_y+s_y-1))
+      iret = NF90_PUT_VAR(nfid,nlatid, &
+ &            y_2d(o_x:o_x+s_x-1,o_y:o_y+s_y-1))
+    ENDIF
+  ELSEIF (k_typ == 3) THEN
+!---
+!-- Transfer the longitude and the longitude bounds
+!---
+    iret = NF90_PUT_VAR(nfid,nlonid,x_1d(1:pim))
+!---
+    IF (transp) THEN
+      bounds_trans = TRANSPOSE(x_bnds)
+    ELSE
+      bounds_trans = x_bnds
+    ENDIF
+    iret = NF90_PUT_VAR(nfid,nlonidb,bounds_trans(1:nbbounds,1:pim))
+!---
+!-- Transfer the latitude and the latitude bounds
+!---
+    iret = NF90_PUT_VAR(nfid,nlatid,y_1d(1:pim))
+!---
+    IF (transp) THEN
+      bounds_trans = TRANSPOSE(y_bnds)
+    ELSE
+      bounds_trans = y_bnds
+    ENDIF
+    iret = NF90_PUT_VAR(nfid,nlatidb,bounds_trans(1:nbbounds,1:pim))
+!---
+    DEALLOCATE(bounds_trans)
+  ENDIF
+!-
+  iret = NF90_REDEF(nfid)
+!-----------------------
+END SUBROUTINE histh_all
+!===
+SUBROUTINE histvert (idf,pzaxname,pzaxtitle,pzaxunit, &
+ &                   pzsize,pzvalues,pzaxid,pdirect)
+!---------------------------------------------------------------------
+!- This subroutine defines a vertical axis and returns it s id.
+!- It gives the user the possibility to the user to define many
+!- different vertical axes. For each variable defined with histdef a
+!- vertical axis can be specified with by it s ID.
+!-
+!- INPUT
+!-
+!- idf      : ID of the file the variable should be archived in
+!- pzaxname : Name of the vertical axis
+!- pzaxtitle: title of the vertical axis
+!- pzaxunit : Units of the vertical axis (no units if blank string)
+!- pzsize   : size of the vertical axis
+!- pzvalues : Coordinate values of the vetical axis
+!-
+!- pdirect  : is an optional argument which allows to specify the
+!-            the positive direction of the axis : up or down.
+!- OUTPUT
+!-
+!- pzaxid   : Returns the ID of the axis.
+!-            Note that this is not the netCDF ID !
+!-
+!- VERSION
+!-
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: idf,pzsize
+  CHARACTER(LEN=*),INTENT(IN) :: pzaxname,pzaxunit,pzaxtitle
+  REAL,INTENT(IN) :: pzvalues(pzsize)
+  INTEGER,INTENT(OUT) :: pzaxid
+  CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: pdirect
+!-
+  INTEGER :: pos,iv,zdimid,zaxid_tmp
+  CHARACTER(LEN=70) :: str71
+  CHARACTER(LEN=20) :: direction
+  INTEGER :: iret,leng,nfid
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 1.0 Verifications :
+!    Do we have enough space for an extra axis ?
+!    Is the name already in use ?
+!-
+  IF (l_dbg) WRITE(*,*) "histvert : 1.0 Verifications", &
+ &                      pzaxname,'---',pzaxunit,'---',pzaxtitle
+!-
+! Direction of the vertical axis. Can we get if from the user.
+!-
+  IF (PRESENT(pdirect)) THEN
+    direction = TRIM(pdirect)
+    CALL strlowercase (direction)
+  ELSE
+    direction = 'unknown'
+  ENDIF
+!-
+! Check the consistency of the attribute
+!-
+  IF (     PRESENT(pdirect)    &
+ &    .AND.(direction /= 'up') &
+ &    .AND.(direction /= 'down') ) THEN
+    direction = 'unknown'
+    CALL ipslerr (2,"histvert",&
+ & "The specified positive direction for the vertical axis is invalid.",&
+ & "The value must be up or down.","The attribute will not be written.")
+  ENDIF
+!-
+  IF (W_F(idf)%n_zax+1 > nb_zax_max) THEN
+    CALL ipslerr (3,"histvert", &
+   &  'Table of vertical axes too small. You should increase ',&
+   &  'nb_zax_max in histcom.f90 in order to accomodate all ', &
+   &  'these variables ')
+  ENDIF
+!-
+  iv = W_F(idf)%n_zax
+  IF (iv > 1) THEN
+    CALL find_str (W_F(idf)%zax_name(1:iv-1),pzaxname,pos)
+  ELSE
+    pos = 0
+  ENDIF
+!-
+  IF (pos > 0) THEN
+    WRITE(str71,'("Check variable ",A," in file",I3)') &
+ &    TRIM(pzaxname),idf
+    CALL ipslerr (3,"histvert", &
+ &    "Vertical axis already exists",TRIM(str71), &
+ &    "Can also be a wrong file ID in another declaration")
+  ENDIF
+!-
+  iv = W_F(idf)%n_zax+1
+!-
+! 2.0 Add the information to the file
+!-
+  IF (l_dbg) &
+ &  WRITE(*,*) "histvert : 2.0 Add the information to the file"
+!-
+  nfid = W_F(idf)%ncfid
+!-
+  leng = MIN(LEN_TRIM(pzaxname),20)
+  iret = NF90_DEF_DIM (nfid,pzaxname(1:leng),pzsize,zaxid_tmp)
+  iret = NF90_DEF_VAR (nfid,pzaxname(1:leng),NF90_REAL4, &
+ &                     zaxid_tmp,zdimid)
+  iret = NF90_PUT_ATT (nfid,zdimid,'axis',"Z")
+  iret = NF90_PUT_ATT (nfid,zdimid,'standard_name',"model_level_number")
+  leng = MIN(LEN_TRIM(pzaxunit),20)
+  IF (leng > 0) THEN
+    iret = NF90_PUT_ATT (nfid,zdimid,'units',pzaxunit(1:leng))
+  ENDIF
+  IF (direction /= 'unknown') THEN
+    iret = NF90_PUT_ATT (nfid,zdimid,'positive',TRIM(direction))
+  ENDIF
+  iret = NF90_PUT_ATT (nfid,zdimid,'valid_min', &
+ &                     REAL(MINVAL(pzvalues(1:pzsize)),KIND=4))
+  iret = NF90_PUT_ATT (nfid,zdimid,'valid_max', &
+ &                     REAL(MAXVAL(pzvalues(1:pzsize)),KIND=4))
+  leng = MIN(LEN_TRIM(pzaxname),20)
+  iret = NF90_PUT_ATT (nfid,zdimid,'title',pzaxname(1:leng))
+  leng = MIN(LEN_TRIM(pzaxtitle),80)
+  iret = NF90_PUT_ATT (nfid,zdimid,'long_name',pzaxtitle(1:leng))
+!-
+  iret = NF90_ENDDEF (nfid)
+!-
+  iret = NF90_PUT_VAR (nfid,zdimid,pzvalues(1:pzsize))
+!-
+  iret = NF90_REDEF (nfid)
+!-
+!- 3.0 add the information to the common
+!-
+  IF (l_dbg) &
+  &  WRITE(*,*) "histvert : 3.0 add the information to the common"
+!-
+  W_F(idf)%n_zax = iv
+  W_F(idf)%zax_size(iv) = pzsize
+  W_F(idf)%zax_name(iv) = pzaxname
+  W_F(idf)%zax_ids(iv) = zaxid_tmp
+  pzaxid = iv
+!----------------------
+END SUBROUTINE histvert
+!===
+SUBROUTINE histdef &
+ &  (idf,pvarname,ptitle,punit, &
+ &   pxsize,pysize,phoriid,pzsize,par_oriz,par_szz,pzid, &
+ &   xtype,popp,pfreq_opp,pfreq_wrt,var_range,standard_name)
+!---------------------------------------------------------------------
+!- With this subroutine each variable to be archived on the history
+!- tape should be declared.
+!-
+!- It gives the user the choise of operation
+!- to be performed on the variables, the frequency of this operation
+!- and finaly the frequency of the archiving.
+!-
+!- INPUT
+!-
+!- idf      : ID of the file the variable should be archived in
+!- pvarname : Name of the variable, short and easy to remember
+!- ptitle   : Full name of the variable
+!- punit    : Units of the variable (no units if blank string)
+!-
+!- The next 3 arguments give the size of that data
+!- that will be passed to histwrite. The zoom will be
+!- done there with the horizontal information obtained
+!- in histbeg and the vertical information to follow.
+!-
+!- pxsize   : Size in X direction (size of the data that will be
+!-            given to histwrite)
+!- pysize   : Size in Y direction
+!- phoriid  : ID of the horizontal axis
+!-
+!- The next two arguments give the vertical zoom to use.
+!-
+!- pzsize   : Size in Z direction (If 1 then no axis is declared
+!-            for this variable and pzid is not used)
+!- par_oriz : Off set of the zoom
+!- par_szz  : Size of the zoom
+!-
+!- pzid     : ID of the vertical axis to use. It has to have
+!-            the size of the zoom.
+!- xtype    : External netCDF type (hist_r4/hist_r8)
+!- popp     : Operation to be performed. The following options
+!-            exist today :
+!- inst : keeps instantaneous values for writting
+!- ave  : Computes the average from call between writes
+!- pfreq_opp: Frequency of this operation (in seconds)
+!- pfreq_wrt: Frequency at which the variable should be
+!-            written (in seconds)
+!- var_range: Range of the variable.
+!-            If the minimum is greater than the maximum,
+!-            the values will be calculated.
+!-
+!- VERSION
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: idf,pxsize,pysize,pzsize,pzid
+  INTEGER,INTENT(IN) :: par_oriz,par_szz,xtype,phoriid
+  CHARACTER(LEN=*),INTENT(IN) :: pvarname,punit,popp,ptitle
+  REAL,INTENT(IN) :: pfreq_opp,pfreq_wrt
+  REAL,DIMENSION(2),OPTIONAL,INTENT(IN) :: var_range
+  CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: standard_name
+!-
+  INTEGER :: iv
+  CHARACTER(LEN=70) :: str70,str71,str72
+  CHARACTER(LEN=20) :: tmp_name
+  CHARACTER(LEN=40) :: str40
+  CHARACTER(LEN=10) :: str10
+  CHARACTER(LEN=120) :: ex_topps
+  REAL :: un_an,un_jour,test_fopp,test_fwrt
+  INTEGER :: pos,buff_sz
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  ex_topps = 'ave, inst, t_min, t_max, t_sum, once, never, l_max, l_min'
+!-
+  W_F(idf)%n_var = W_F(idf)%n_var+1
+  iv = W_F(idf)%n_var
+!-
+  IF (iv > nb_var_max) THEN
+    CALL ipslerr (3,"histdef", &
+   &  'Table of variables too small. You should increase nb_var_max',&
+   &  'in histcom.f90 in order to accomodate all these variables', &
+   &  ' ')
+  ENDIF
+!-
+! 1.0 Transfer informations on the variable to the common
+!     and verify that it does not already exist
+!-
+  IF (l_dbg) WRITE(*,*) "histdef : 1.0"
+!-
+  IF (iv > 1) THEN
+    CALL find_str (W_F(idf)%W_V(1:iv-1)%v_name,pvarname,pos)
+  ELSE
+    pos = 0
+  ENDIF
+!-
+  IF (pos > 0) THEN
+    str70 = "Variable already exists"
+    WRITE(str71,'("Check variable  ",a," in file",I3)') &
+ &    TRIM(pvarname),idf
+    str72 = "Can also be a wrong file ID in another declaration"
+    CALL ipslerr (3,"histdef",str70,str71,str72)
+  ENDIF
+!-
+  W_F(idf)%W_V(iv)%v_name = pvarname
+  W_F(idf)%W_V(iv)%title = ptitle
+  W_F(idf)%W_V(iv)%unit_name = punit
+  IF (PRESENT(standard_name)) THEN
+    W_F(idf)%W_V(iv)%std_name = standard_name
+  ELSE
+    W_F(idf)%W_V(iv)%std_name = ptitle
+  ENDIF
+  tmp_name = W_F(idf)%W_V(iv)%v_name
+!-
+! 1.1 decode the operations
+!-
+  W_F(idf)%W_V(iv)%fullop = popp
+  CALL buildop &
+ &  (TRIM(popp),ex_topps,W_F(idf)%W_V(iv)%topp,missing_val, &
+ &   W_F(idf)%W_V(iv)%sopp,W_F(idf)%W_V(iv)%scal, &
+ &   W_F(idf)%W_V(iv)%nbopp)
+!-
+! 1.2 If we have an even number of operations
+!     then we need to add identity
+!-
+  IF ( MOD(W_F(idf)%W_V(iv)%nbopp,2) == 0) THEN
+    W_F(idf)%W_V(iv)%nbopp = W_F(idf)%W_V(iv)%nbopp+1
+    W_F(idf)%W_V(iv)%sopp(W_F(idf)%W_V(iv)%nbopp) = 'ident'
+    W_F(idf)%W_V(iv)%scal(W_F(idf)%W_V(iv)%nbopp) = missing_val
+  ENDIF
+!-
+! 1.3 External type of the variable
+!-
+  IF (xtype == hist_r8) THEN
+    W_F(idf)%W_V(iv)%v_typ = hist_r8
+  ELSE
+    W_F(idf)%W_V(iv)%v_typ = hist_r4
+  ENDIF
+!-
+! 2.0 Put the size of the variable in the common and check
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "histdef : 2.0",idf,iv,W_F(idf)%W_V(iv)%nbopp, &
+ &    W_F(idf)%W_V(iv)%sopp(1:W_F(idf)%W_V(iv)%nbopp), &
+ &    W_F(idf)%W_V(iv)%scal(1:W_F(idf)%W_V(iv)%nbopp)
+  ENDIF
+!-
+  W_F(idf)%W_V(iv)%scsize(1:3) = (/ pxsize,pysize,pzsize /)
+  W_F(idf)%W_V(iv)%zorig(1:3) = &
+ &  (/ W_F(idf)%slab_ori(1),W_F(idf)%slab_ori(2),par_oriz /)
+  W_F(idf)%W_V(iv)%zsize(1:3) = &
+ &  (/ W_F(idf)%slab_siz(1),W_F(idf)%slab_siz(2),par_szz /)
+!-
+! Is the size of the full array the same as that of the coordinates ?
+!-
+  IF (    (pxsize > W_F(idf)%full_size(1)) &
+ &    .OR.(pysize > W_F(idf)%full_size(2)) ) THEN
+!-
+    str70 = "The size of the variable is different "// &
+ &          "from the one of the coordinates"
+    WRITE(str71,'("Size of coordinates :",2I4)') &
+ &   W_F(idf)%full_size(1),W_F(idf)%full_size(2)
+    WRITE(str72,'("Size declared for variable ",a," :",2I4)') &
+ &   TRIM(tmp_name),pxsize,pysize
+    CALL ipslerr (3,"histdef",str70,str71,str72)
+  ENDIF
+!-
+! Is the size of the zoom smaller than the coordinates ?
+!-
+  IF (    (W_F(idf)%full_size(1) < W_F(idf)%slab_siz(1)) &
+ &    .OR.(W_F(idf)%full_size(2) < W_F(idf)%slab_siz(2)) ) THEN
+    str70 = &
+ &   "Size of variable should be greater or equal to those of the zoom"
+    WRITE(str71,'("Size of XY zoom :",2I4)') &
+ &   W_F(idf)%slab_siz(1),W_F(idf)%slab_siz(2)
+    WRITE(str72,'("Size declared for variable ",A," :",2I4)') &
+ &   TRIM(tmp_name),pxsize,pysize
+    CALL ipslerr (3,"histdef",str70,str71,str72)
+  ENDIF
+!-
+! 2.1 We store the horizontal grid information with minimal
+!     and a fall back onto the default grid
+!-
+  IF ( (phoriid > 0).AND.(phoriid <= W_F(idf)%n_hax) ) THEN
+    W_F(idf)%W_V(iv)%h_axid = phoriid
+  ELSE
+    W_F(idf)%W_V(iv)%h_axid = 1
+    CALL ipslerr (2,"histdef", &
+   &  'We use the default grid for variable as an invalide',&
+   &  'ID was provided for variable : ',TRIM(pvarname))
+  ENDIF
+!-
+! 2.2 Check the vertical coordinates if needed
+!-
+  IF (par_szz > 1) THEN
+!-
+!-- Does the vertical coordinate exist ?
+!-
+    IF (pzid > W_F(idf)%n_zax) THEN
+      WRITE(str70, &
+ &    '("The vertical coordinate chosen for variable ",A)') &
+ &     TRIM(tmp_name)
+      str71 = " Does not exist."
+      CALL ipslerr (3,"histdef",str70,str71," ")
+    ENDIF
+!-
+!-- Is the vertical size of the variable equal to that of the axis ?
+!-
+    IF (par_szz /= W_F(idf)%zax_size(pzid)) THEN
+      str70 = "The size of the zoom does not correspond "// &
+ &            "to the size of the chosen vertical axis"
+      WRITE(str71,'("Size of zoom in z :",I4)') par_szz
+      WRITE(str72,'("Size declared for axis ",A," :",I4)') &
+ &     TRIM(W_F(idf)%zax_name(pzid)),W_F(idf)%zax_size(pzid)
+      CALL ipslerr (3,"histdef",str70,str71,str72)
+    ENDIF
+!-
+!-- Is the zoom smaller that the total size of the variable ?
+!-
+    IF (pzsize < par_szz) THEN
+      str70 = "The vertical size of variable "// &
+ &            "is smaller than that of the zoom."
+      WRITE(str71,'("Declared vertical size of data :",I5)') pzsize
+      WRITE(str72,'("Size of zoom for variable ",a," = ",I5)') &
+ &     TRIM(tmp_name),par_szz
+      CALL ipslerr (3,"histdef",str70,str71,str72)
+    ENDIF
+    W_F(idf)%W_V(iv)%z_axid = pzid
+  ELSE
+    W_F(idf)%W_V(iv)%z_axid = -99
+  ENDIF
+!-
+! 3.0 We get the size of the arrays histwrite will get
+!     and eventually allocate the time_buffer
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "histdef : 3.0"
+  ENDIF
+!-
+  buff_sz = W_F(idf)%W_V(iv)%zsize(1) &
+ &         *W_F(idf)%W_V(iv)%zsize(2) &
+ &         *W_F(idf)%W_V(iv)%zsize(3)
+!-
+  IF (     (TRIM(W_F(idf)%W_V(iv)%topp) /= "inst") &
+ &    .AND.(TRIM(W_F(idf)%W_V(iv)%topp) /= "once") &
+ &    .AND.(TRIM(W_F(idf)%W_V(iv)%topp) /= "never") )THEN
+    ALLOCATE(W_F(idf)%W_V(iv)%t_bf(buff_sz))
+    W_F(idf)%W_V(iv)%t_bf(:) = 0.
+    IF (l_dbg) THEN
+      WRITE(*,*) "histdef : 3.0 allocating time_buffer for", &
+ &      " idf = ",idf," iv = ",iv," size = ",buff_sz
+    ENDIF
+  ENDIF
+!-
+! 4.0 Transfer the frequency of the operations and check
+!     for validity. We have to pay attention to negative values
+!     of the frequency which indicate monthly time-steps.
+!     The strategy is to bring it back to seconds for the tests
+!-
+  IF (l_dbg) WRITE(*,*) "histdef : 4.0"
+!-
+  W_F(idf)%W_V(iv)%freq_opp = pfreq_opp
+  W_F(idf)%W_V(iv)%freq_wrt = pfreq_wrt
+!-
+  CALL ioget_calendar(un_an,un_jour)
+  IF (pfreq_opp < 0) THEN
+    CALL ioget_calendar(un_an)
+    test_fopp = pfreq_opp*(-1.)*un_an/12.*un_jour
+  ELSE
+    test_fopp = pfreq_opp
+  ENDIF
+  IF (pfreq_wrt < 0) THEN
+    CALL ioget_calendar(un_an)
+    test_fwrt = pfreq_wrt*(-1.)*un_an/12.*un_jour
+  ELSE
+    test_fwrt = pfreq_wrt
+  ENDIF
+!-
+! 4.1 Frequency of operations and output should be larger than deltat !
+!-
+  IF (test_fopp < W_F(idf)%deltat) THEN
+    str70 = 'Frequency of operations should be larger than deltat'
+    WRITE(str71,'("It is not the case for variable ",a," :",F10.4)') &
+ &   TRIM(tmp_name),pfreq_opp
+    str72 = "PATCH : frequency set to deltat"
+!-
+    CALL ipslerr (2,"histdef",str70,str71,str72)
+!-
+    W_F(idf)%W_V(iv)%freq_opp = W_F(idf)%deltat
+  ENDIF
+!-
+  IF (test_fwrt < W_F(idf)%deltat) THEN
+    str70 = 'Frequency of output should be larger than deltat'
+    WRITE(str71,'("It is not the case for variable ",a," :",F10.4)') &
+ &   TRIM(tmp_name),pfreq_wrt
+    str72 = "PATCH : frequency set to deltat"
+!-
+    CALL ipslerr (2,"histdef",str70,str71,str72)
+!-
+    W_F(idf)%W_V(iv)%freq_wrt = W_F(idf)%deltat
+  ENDIF
+!-
+! 4.2 First the existence of the operation is tested and then
+!     its compaticility with the choice of frequencies
+!-
+  IF (TRIM(W_F(idf)%W_V(iv)%topp) == "inst") THEN
+    IF (test_fopp /= test_fwrt) THEN
+      str70 = 'For instantaneous output the frequency '// &
+ &            'of operations and output'
+      WRITE(str71, &
+ &     '("should be the same, this was not case for variable ",a)') &
+ &      TRIM(tmp_name)
+      str72 = "PATCH : The smalest frequency of both is used"
+      CALL ipslerr (2,"histdef",str70,str71,str72)
+      IF (test_fopp < test_fwrt) THEN
+        W_F(idf)%W_V(iv)%freq_opp = pfreq_opp
+        W_F(idf)%W_V(iv)%freq_wrt = pfreq_opp
+      ELSE
+        W_F(idf)%W_V(iv)%freq_opp = pfreq_wrt
+        W_F(idf)%W_V(iv)%freq_wrt = pfreq_wrt
+      ENDIF
+    ENDIF
+  ELSE IF (INDEX(ex_topps,TRIM(W_F(idf)%W_V(iv)%topp)) > 0) THEN
+    IF (test_fopp > test_fwrt) THEN
+      str70 = 'For averages the frequency of operations '// &
+ &            'should be smaller or equal'
+      WRITE(str71, &
+ &     '("to that of output. It is not the case for variable ",a)') &
+ &     TRIM(tmp_name)
+      str72 = 'PATCH : The output frequency is used for both'
+      CALL ipslerr (2,"histdef",str70,str71,str72)
+      W_F(idf)%W_V(iv)%freq_opp = pfreq_wrt
+    ENDIF
+  ELSE
+    WRITE (str70,'("Operation on variable ",A," is unknown")') &
+ &   TRIM(tmp_name)
+    WRITE (str71,'("operation requested is :",A)') &
+ &   W_F(idf)%W_V(iv)%topp
+    WRITE (str72,'("File ID :",I3)') idf
+    CALL ipslerr (3,"histdef",str70,str71,str72)
+  ENDIF
+!-
+! 5.0 Initialize other variables of the common
+!-
+  IF (l_dbg) WRITE(*,*) "histdef : 5.0"
+!-
+  W_F(idf)%W_V(iv)%hist_wrt_rng = (PRESENT(var_range))
+  IF (W_F(idf)%W_V(iv)%hist_wrt_rng) THEN
+    W_F(idf)%W_V(iv)%hist_calc_rng = (var_range(1) > var_range(2))
+    IF (W_F(idf)%W_V(iv)%hist_calc_rng) THEN
+      W_F(idf)%W_V(iv)%hist_minmax(1:2) = &
+ &      (/ ABS(missing_val),-ABS(missing_val) /)
+    ELSE
+      W_F(idf)%W_V(iv)%hist_minmax(1:2) = var_range(1:2)
+    ENDIF
+  ENDIF
+!-
+! - freq_opp(idf,iv)/2./deltat(idf)
+  W_F(idf)%W_V(iv)%last_opp = W_F(idf)%itau0
+! - freq_wrt(idf,iv)/2./deltat(idf)
+  W_F(idf)%W_V(iv)%last_wrt = W_F(idf)%itau0
+! - freq_opp(idf,iv)/2./deltat(idf)
+  W_F(idf)%W_V(iv)%last_opp_chk = W_F(idf)%itau0
+! - freq_wrt(idf,iv)/2./deltat(idf)
+  W_F(idf)%W_V(iv)%last_wrt_chk = W_F(idf)%itau0
+  W_F(idf)%W_V(iv)%nb_opp = 0
+  W_F(idf)%W_V(iv)%nb_wrt = 0
+!-
+! 6.0 Get the time axis for this variable
+!-
+  IF (l_dbg) WRITE(*,*) "histdef : 6.0"
+!-
+! No time axis for once, l_max, l_min or never operation
+!-
+  IF (     (TRIM(W_F(idf)%W_V(iv)%topp) /= 'once')  &
+ &    .AND.(TRIM(W_F(idf)%W_V(iv)%topp) /= 'never') &
+ &    .AND.(TRIM(W_F(idf)%W_V(iv)%topp) /= 'l_max') &
+ &    .AND.(TRIM(W_F(idf)%W_V(iv)%topp) /= 'l_min') ) THEN
+    IF (TRIM(W_F(idf)%W_V(iv)%topp) == 'inst') THEN
+      str10 = 't_inst_'
+    ELSE
+      str10 = 't_op_'
+    ENDIF
+    IF (W_F(idf)%W_V(iv)%freq_wrt > 0) THEN
+      WRITE (UNIT=str40,FMT='(A,I8.8)') &
+&      TRIM(str10),INT(W_F(idf)%W_V(iv)%freq_wrt)
+    ELSE
+      WRITE (UNIT=str40,FMT='(A,I2.2,"month")') &
+&      TRIM(str10),ABS(INT(W_F(idf)%W_V(iv)%freq_wrt))
+    ENDIF
+    CALL find_str (W_F(idf)%W_V(1:W_F(idf)%n_tax)%tax_name,str40,pos)
+    IF (pos < 0) THEN
+      W_F(idf)%n_tax = W_F(idf)%n_tax+1
+      W_F(idf)%W_V(iv)%l_bnd = &
+ &      (TRIM(W_F(idf)%W_V(iv)%topp) /= 'inst')
+      W_F(idf)%W_V(W_F(idf)%n_tax)%tax_name = str40
+      W_F(idf)%W_V(W_F(idf)%n_tax)%tax_last = 0
+      W_F(idf)%W_V(iv)%t_axid = W_F(idf)%n_tax
+    ELSE
+      W_F(idf)%W_V(iv)%t_axid = pos
+    ENDIF
+  ELSE
+    IF (l_dbg) THEN
+      WRITE(*,*) "histdef : 7.0 ",TRIM(W_F(idf)%W_V(iv)%topp),'----'
+    ENDIF
+    W_F(idf)%W_V(iv)%t_axid = -99
+  ENDIF
+!-
+! 7.0 prepare frequence of writing and operation
+!     for never or once operation
+!-
+  IF (    (TRIM(W_F(idf)%W_V(iv)%topp) == 'once')  &
+ &    .OR.(TRIM(W_F(idf)%W_V(iv)%topp) == 'never') ) THEN
+    W_F(idf)%W_V(iv)%freq_opp = 0.
+    W_F(idf)%W_V(iv)%freq_wrt = 0.
+  ENDIF
+!---------------------
+END SUBROUTINE histdef
+!===
+SUBROUTINE histend (idf, snc4chunks)
+!---------------------------------------------------------------------
+!- This subroutine end the decalaration of variables and sets the
+!- time axes in the netcdf file and puts it into the write mode.
+!-
+!- INPUT
+!-
+!- idf : ID of the file to be worked on
+!-
+!- VERSION
+!-
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: idf
+  TYPE(snc4_ctl), OPTIONAL,INTENT(IN) :: snc4chunks
+!-
+  INTEGER :: nfid,nvid,iret,ndim,iv,itx,ziv,itax,dim_cnt
+  INTEGER,DIMENSION(4) :: dims
+  INTEGER :: year,month,day,hours,minutes
+  REAL :: sec
+  REAL :: rtime0
+  CHARACTER(LEN=30) :: str30
+  CHARACTER(LEN=35) :: str35
+  CHARACTER(LEN=120) :: assoc
+  CHARACTER(LEN=70) :: str70
+  CHARACTER(LEN=3),DIMENSION(12) :: cal =   &
+ &  (/ 'JAN','FEB','MAR','APR','MAY','JUN', &
+ &     'JUL','AUG','SEP','OCT','NOV','DEC' /)
+  CHARACTER(LEN=7) :: tmp_opp
+  LOGICAL :: l_b
+  LOGICAL :: l_dbg
+  INTEGER, DIMENSION(4) :: ichunksz    ! NETCDF4 chunk sizes
+  INTEGER :: ichunkalg, ishuffle,&
+             ideflate, ideflate_level
+  LOGICAL :: lchunk = .FALSE.   ! logical switch to activate chunking when appropriate
+!-
+  ! NetCDF4 chunking and compression parameters
+  ichunkalg = 0
+  ishuffle = 1
+  ideflate = 1
+  ideflate_level = 1
+  !
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  nfid = W_F(idf)%ncfid
+!-
+! 1.0 Create the time axes
+!-
+  IF (l_dbg) WRITE(*,*) "histend : 1.0"
+!-
+! 1.1 Define the time dimensions needed for this file
+!-
+  iret = NF90_DEF_DIM (nfid,'time_counter', &
+ &                     NF90_UNLIMITED,W_F(idf)%tid)
+  DO iv=1,W_F(idf)%n_var
+    IF (W_F(idf)%W_V(iv)%l_bnd) THEN
+      iret = NF90_DEF_DIM (nfid,'tbnds',2,W_F(idf)%bid)
+      EXIT
+    ENDIF
+  ENDDO
+!-
+! 1.2 Define all the time axes needed for this file
+!-
+  DO itx=1,W_F(idf)%n_tax
+    dims(1) = W_F(idf)%tid
+    l_b = (INDEX(W_F(idf)%W_V(itx)%tax_name,"t_op_") == 1)
+    IF (itx > 1) THEN
+      str30 = W_F(idf)%W_V(itx)%tax_name
+    ELSE
+      str30 = "time_counter"
+    ENDIF
+    IF (l_b) THEN
+      str35 = TRIM(str30)//'_bnds'
+    ENDIF
+    iret = NF90_DEF_VAR (nfid,TRIM(str30),NF90_REAL8, &
+ &          dims(1),W_F(idf)%W_V(itx)%tdimid)
+    IF (itx <= 1) THEN
+      iret = NF90_PUT_ATT (nfid,W_F(idf)%W_V(itx)%tdimid,'axis',"T")
+    ENDIF
+    iret = NF90_PUT_ATT (nfid,W_F(idf)%W_V(itx)%tdimid, &
+ &          'standard_name',"time")
+!---
+!   To transform the current itau into a real date and take it
+!   as the origin of the file requires the time counter to change.
+!   Thus it is an operation the user has to ask for.
+!   This function should thus only be re-instated
+!   if there is a ioconf routine to control it.
+!---
+!-- rtime0 = itau2date(itau0(idf),date0(idf),deltat(idf))
+    rtime0 = W_F(idf)%date0
+!-
+    CALL ju2ymds(rtime0,year,month,day,sec)
+!---
+!   Catch any error induced by a change in calendar !
+!---
+    IF (year < 0) THEN
+      year = 2000+year
+    ENDIF
+!-
+    hours = INT(sec/(60.*60.))
+    minutes = INT((sec-hours*60.*60.)/60.)
+    sec = sec-(hours*60.*60.+minutes*60.)
+!-
+    WRITE (UNIT=str70, &
+ &   FMT='(A,I4.4,"-",I2.2,"-",I2.2," ",I2.2,":",I2.2,":",I2.2)') &
+ &    'seconds since ',year,month,day,hours,minutes,INT(sec)
+    iret = NF90_PUT_ATT (nfid,W_F(idf)%W_V(itx)%tdimid, &
+ &           'units',TRIM(str70))
+!-
+    CALL ioget_calendar (str30)
+    iret = NF90_PUT_ATT (nfid,W_F(idf)%W_V(itx)%tdimid, &
+ &           'calendar',TRIM(str30))
+!-
+    iret = NF90_PUT_ATT (nfid,W_F(idf)%W_V(itx)%tdimid, &
+ &           'title','Time')
+!-
+    iret = NF90_PUT_ATT (nfid,W_F(idf)%W_V(itx)%tdimid, &
+ &           'long_name','Time axis')
+!-
+    WRITE (UNIT=str70, &
+ &   FMT='(" ",I4.4,"-",A3,"-",I2.2," ",I2.2,":",I2.2,":",I2.2)') &
+ &    year,cal(month),day,hours,minutes,INT(sec)
+    iret = NF90_PUT_ATT (nfid,W_F(idf)%W_V(itx)%tdimid, &
+ &           'time_origin',TRIM(str70))
+!---
+    IF (l_b) THEN
+      iret = NF90_PUT_ATT (nfid,W_F(idf)%W_V(itx)%tdimid, &
+ &             'bounds',TRIM(str35))
+      dims(1:2) = (/ W_F(idf)%bid,W_F(idf)%tid /)
+      iret = NF90_DEF_VAR (nfid,TRIM(str35),NF90_REAL8, &
+ &            dims(1:2),W_F(idf)%W_V(itx)%tbndid)
+    ENDIF
+  ENDDO
+!-
+! 2.0 declare the variables
+!-
+  IF (l_dbg) WRITE(*,*) "histend : 2.0"
+!-
+  DO iv=1,W_F(idf)%n_var
+!---
+    itax = W_F(idf)%W_V(iv)%t_axid
+!---
+    IF (W_F(idf)%regular) THEN
+      dims(1:2) = (/ W_F(idf)%xid,W_F(idf)%yid /)
+      dim_cnt = 2
+    ELSE
+      dims(1) = W_F(idf)%xid
+      dim_cnt = 1
+    ENDIF
+!---
+    tmp_opp = W_F(idf)%W_V(iv)%topp
+    ziv = W_F(idf)%W_V(iv)%z_axid
+!---
+!   2.1 dimension of field
+!---
+    IF ((TRIM(tmp_opp) /= 'never')) THEN
+      IF (     (TRIM(tmp_opp) /= 'once')  &
+     &    .AND.(TRIM(tmp_opp) /= 'l_max') &
+     &    .AND.(TRIM(tmp_opp) /= 'l_min') ) THEN
+        IF (ziv == -99) THEN
+          ndim = dim_cnt+1
+          dims(dim_cnt+1:dim_cnt+2) = (/ W_F(idf)%tid,0 /)
+        ELSE
+          ndim = dim_cnt+2
+          dims(dim_cnt+1:dim_cnt+2) = &
+ &         (/ W_F(idf)%zax_ids(ziv),W_F(idf)%tid /)
+        ENDIF
+      ELSE
+        IF (ziv == -99) THEN
+          ndim = dim_cnt
+          dims(dim_cnt+1:dim_cnt+2) = (/ 0,0 /)
+        ELSE
+          ndim = dim_cnt+1
+          dims(dim_cnt+1:dim_cnt+2) = (/ W_F(idf)%zax_ids(ziv),0 /)
+        ENDIF
+      ENDIF
+!-
+      iret = NF90_DEF_VAR (nfid,TRIM(W_F(idf)%W_V(iv)%v_name), &
+ &             W_F(idf)%W_V(iv)%v_typ,dims(1:ABS(ndim)),nvid)
+!-
+      IF( ndim == 4 ) THEN
+        IF( PRESENT( snc4chunks ) ) THEN
+          IF( snc4chunks%luse ) THEN
+           ichunksz = 1
+           iret = NF90_INQUIRE_DIMENSION( nfid, W_F(idf)%xid, len = ichunksz(1) )
+           iret = NF90_INQUIRE_DIMENSION( nfid, W_F(idf)%yid, len = ichunksz(2) )
+           IF ( ziv .NE. -99 ) &
+              iret = NF90_INQUIRE_DIMENSION( nfid, W_F(idf)%zax_ids(ziv), len = ichunksz(3) )
+           ichunksz(1) = MIN(ichunksz(1), MAX((ichunksz(1)-1)/snc4chunks%ni + 1,16))
+           ichunksz(2) = MIN(ichunksz(2), MAX((ichunksz(2)-1)/snc4chunks%nj + 1,16))
+           ichunksz(3) = MIN(ichunksz(3), MAX((ichunksz(3)-1)/snc4chunks%nk + 1, 1))
+           ! Always use a chunk size of 1 for the unlimited dimension
+           iret = SET_NF90_DEF_VAR_CHUNKING(nfid, nvid, ichunkalg, ichunksz)
+           iret = SET_NF90_DEF_VAR_DEFLATE(nfid, nvid, ishuffle, ideflate, ideflate_level)
+          ENDIF
+        ENDIF
+      ENDIF
+      W_F(idf)%W_V(iv)%ncvid = nvid
+!-
+      IF (LEN_TRIM(W_F(idf)%W_V(iv)%unit_name) > 0) THEN
+        iret = NF90_PUT_ATT (nfid,nvid,'units', &
+ &                           TRIM(W_F(idf)%W_V(iv)%unit_name))
+      ENDIF
+      iret = NF90_PUT_ATT (nfid,nvid,'standard_name', &
+ &                         TRIM(W_F(idf)%W_V(iv)%std_name))
+!-
+      IF (W_F(idf)%W_V(iv)%v_typ == hist_r8) THEN
+        iret = NF90_PUT_ATT (nfid,nvid,'_FillValue',NF90_FILL_REAL8)
+      ELSE
+        iret = NF90_PUT_ATT (nfid,nvid,'_FillValue',NF90_FILL_REAL4)
+      ENDIF
+      IF (W_F(idf)%W_V(iv)%hist_wrt_rng) THEN
+        IF (W_F(idf)%W_V(iv)%v_typ == hist_r8) THEN
+          iret = NF90_PUT_ATT (nfid,nvid,'valid_min', &
+ &                 REAL(W_F(idf)%W_V(iv)%hist_minmax(1),KIND=8))
+          iret = NF90_PUT_ATT (nfid,nvid,'valid_max', &
+ &                 REAL(W_F(idf)%W_V(iv)%hist_minmax(2),KIND=8))
+        ELSE
+          iret = NF90_PUT_ATT (nfid,nvid,'valid_min', &
+ &                 REAL(W_F(idf)%W_V(iv)%hist_minmax(1),KIND=4))
+          iret = NF90_PUT_ATT (nfid,nvid,'valid_max', &
+ &                 REAL(W_F(idf)%W_V(iv)%hist_minmax(2),KIND=4))
+        ENDIF
+      ENDIF
+      iret = NF90_PUT_ATT (nfid,nvid,'long_name', &
+ &                         TRIM(W_F(idf)%W_V(iv)%title))
+      iret = NF90_PUT_ATT (nfid,nvid,'online_operation', &
+ &                         TRIM(W_F(idf)%W_V(iv)%fullop))
+!-
+      SELECT CASE(ndim)
+      CASE(-3,2:4)
+      CASE DEFAULT
+        CALL ipslerr (3,"histend", &
+       &  'less than 2 or more than 4 dimensions are not', &
+       &  'allowed at this stage',' ')
+      END SELECT
+!-
+      assoc=TRIM(W_F(idf)%hax_name(W_F(idf)%W_V(iv)%h_axid,2)) &
+ &   //' '//TRIM(W_F(idf)%hax_name(W_F(idf)%W_V(iv)%h_axid,1))
+!-
+      ziv = W_F(idf)%W_V(iv)%z_axid
+      IF (ziv > 0) THEN
+        str30 = W_F(idf)%zax_name(ziv)
+        assoc = TRIM(str30)//' '//TRIM(assoc)
+      ENDIF
+!-
+      IF (itax > 0) THEN
+        IF (itax > 1) THEN
+          str30 = W_F(idf)%W_V(itax)%tax_name
+        ELSE
+          str30 = "time_counter"
+        ENDIF
+        assoc = TRIM(str30)//' '//TRIM(assoc)
+!-
+        IF (l_dbg) THEN
+          WRITE(*,*) "histend : 2.0.n, freq_opp, freq_wrt", &
+ &          W_F(idf)%W_V(iv)%freq_opp,W_F(idf)%W_V(iv)%freq_wrt
+        ENDIF
+!-
+        iret = NF90_PUT_ATT (nfid,nvid,'interval_operation', &
+ &                           REAL(W_F(idf)%W_V(iv)%freq_opp,KIND=4))
+        iret = NF90_PUT_ATT (nfid,nvid,'interval_write', &
+ &                           REAL(W_F(idf)%W_V(iv)%freq_wrt,KIND=4))
+      ENDIF
+      iret = NF90_PUT_ATT (nfid,nvid,'coordinates',TRIM(assoc))
+    ENDIF
+  ENDDO
+!-
+! 2.2 Add DOMAIN attributes if needed
+!-
+  IF (W_F(idf)%dom_id_svg >= 0) THEN
+    CALL flio_dom_att (nfid,W_F(idf)%dom_id_svg)
+  ENDIF
+!-
+! 3.0 Put the netcdf file into write mode
+!-
+  IF (l_dbg) WRITE(*,*) "histend : 3.0"
+!-
+  iret = NF90_ENDDEF (nfid)
+!-
+! 4.0 Give some informations to the user
+!-
+  IF (l_dbg) WRITE(*,*) "histend : 4.0"
+!-
+!!$  WRITE(str70,'("All variables have been initialized on file :",I3)') idf
+!!$  CALL ipslerr (1,'histend',str70,'',' ')
+!---------------------
+END SUBROUTINE histend
+!===
+SUBROUTINE histwrite_r1d (idf,pvarname,pitau,pdata,nbindex,nindex)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: idf,pitau,nbindex
+  INTEGER,DIMENSION(nbindex),INTENT(IN) :: nindex
+  REAL,DIMENSION(:),INTENT(IN) :: pdata
+  CHARACTER(LEN=*),INTENT(IN) :: pvarname
+!---------------------------------------------------------------------
+  CALL histw_rnd (idf,pvarname,pitau,nbindex,nindex,pdata_1d=pdata)
+!---------------------------
+END SUBROUTINE histwrite_r1d
+!===
+SUBROUTINE histwrite_r2d (idf,pvarname,pitau,pdata,nbindex,nindex)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: idf,pitau,nbindex
+  INTEGER,DIMENSION(nbindex),INTENT(IN) :: nindex
+  REAL,DIMENSION(:,:),INTENT(IN) :: pdata
+  CHARACTER(LEN=*),INTENT(IN) :: pvarname
+!---------------------------------------------------------------------
+  CALL histw_rnd (idf,pvarname,pitau,nbindex,nindex,pdata_2d=pdata)
+!---------------------------
+END SUBROUTINE histwrite_r2d
+!===
+SUBROUTINE histwrite_r3d (idf,pvarname,pitau,pdata,nbindex,nindex)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: idf,pitau,nbindex
+  INTEGER,DIMENSION(nbindex),INTENT(IN) :: nindex
+  REAL,DIMENSION(:,:,:),INTENT(IN) :: pdata
+  CHARACTER(LEN=*),INTENT(IN) :: pvarname
+!---------------------------------------------------------------------
+  CALL histw_rnd (idf,pvarname,pitau,nbindex,nindex,pdata_3d=pdata)
+!---------------------------
+END SUBROUTINE histwrite_r3d
+!===
+SUBROUTINE histw_rnd (idf,pvarname,pitau,nbindex,nindex, &
+  &                   pdata_1d,pdata_2d,pdata_3d)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: idf,pitau,nbindex
+  INTEGER,DIMENSION(nbindex),INTENT(IN) :: nindex
+  CHARACTER(LEN=*),INTENT(IN) :: pvarname
+  REAL,DIMENSION(:),INTENT(IN),OPTIONAL     :: pdata_1d
+  REAL,DIMENSION(:,:),INTENT(IN),OPTIONAL   :: pdata_2d
+  REAL,DIMENSION(:,:,:),INTENT(IN),OPTIONAL :: pdata_3d
+!-
+  LOGICAL :: do_oper,do_write,largebuf,l1d,l2d,l3d
+  INTEGER :: iv,io,nbpt_out
+  INTEGER              :: nbpt_in1
+  INTEGER,DIMENSION(2) :: nbpt_in2
+  INTEGER,DIMENSION(3) :: nbpt_in3
+  REAL,ALLOCATABLE,DIMENSION(:),SAVE :: tbf_1
+  CHARACTER(LEN=7) :: tmp_opp
+  CHARACTER(LEN=13) :: c_nam
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  l1d=PRESENT(pdata_1d); l2d=PRESENT(pdata_2d); l3d=PRESENT(pdata_3d);
+  IF      (l1d) THEN
+    c_nam = 'histwrite_r1d'
+  ELSE IF (l2d) THEN
+    c_nam = 'histwrite_r2d'
+  ELSE IF (l3d) THEN
+    c_nam = 'histwrite_r3d'
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "histwrite : ",c_nam
+  ENDIF
+!-
+! 1.0 Try to catch errors like specifying the wrong file ID.
+!     Thanks Marine for showing us what errors users can make !
+!-
+  IF ( (idf < 1).OR.(idf > nb_files_max) ) THEN
+    CALL ipslerr (3,"histwrite", &
+ &    'Illegal file ID in the histwrite of variable',pvarname,' ')
+  ENDIF
+!-
+! 1.1 Find the id of the variable to be written and the real time
+!-
+  CALL histvar_seq (idf,pvarname,iv)
+!-
+! 2.0 do nothing for never operation
+!-
+  tmp_opp = W_F(idf)%W_V(iv)%topp
+!-
+  IF (TRIM(tmp_opp) == "never") THEN
+    W_F(idf)%W_V(iv)%last_opp_chk = -99
+    W_F(idf)%W_V(iv)%last_wrt_chk = -99
+  ENDIF
+!-
+! 3.0 We check if we need to do an operation
+!-
+  IF (W_F(idf)%W_V(iv)%last_opp_chk == pitau) THEN
+    CALL ipslerr (3,"histwrite", &
+ &    'This variable has already been analysed at the present', &
+ &    'time step',TRIM(pvarname))
+  ENDIF
+!-
+  CALL isittime &
+ &  (pitau,W_F(idf)%date0,W_F(idf)%deltat, &
+ &   W_F(idf)%W_V(iv)%freq_opp, &
+ &   W_F(idf)%W_V(iv)%last_opp, &
+ &   W_F(idf)%W_V(iv)%last_opp_chk,do_oper)
+!-
+! 4.0 We check if we need to write the data
+!-
+  IF (W_F(idf)%W_V(iv)%last_wrt_chk == pitau) THEN
+    CALL ipslerr (3,"histwrite", &
+ &    'This variable as already been written for the present', &
+ &    'time step',' ')
+  ENDIF
+!-
+  CALL isittime &
+ &  (pitau,W_F(idf)%date0,W_F(idf)%deltat, &
+ &   W_F(idf)%W_V(iv)%freq_wrt, &
+ &   W_F(idf)%W_V(iv)%last_wrt, &
+ &   W_F(idf)%W_V(iv)%last_wrt_chk,do_write)
+!-
+! 5.0 histwrite called
+!-
+  IF (do_oper.OR.do_write) THEN
+!-
+!-- 5.1 Get the sizes of the data we will handle
+!-
+    IF (W_F(idf)%W_V(iv)%datasz_in(1) <= 0) THEN
+!---- There is the risk here that the user has over-sized the array.
+!---- But how can we catch this ?
+!---- In the worst case we will do impossible operations
+!---- on part of the data !
+      W_F(idf)%W_V(iv)%datasz_in(1:3) = -1
+      IF      (l1d) THEN
+        W_F(idf)%W_V(iv)%datasz_in(1) = SIZE(pdata_1d)
+      ELSE IF (l2d) THEN
+        W_F(idf)%W_V(iv)%datasz_in(1) = SIZE(pdata_2d,DIM=1)
+        W_F(idf)%W_V(iv)%datasz_in(2) = SIZE(pdata_2d,DIM=2)
+      ELSE IF (l3d) THEN
+        W_F(idf)%W_V(iv)%datasz_in(1) = SIZE(pdata_3d,DIM=1)
+        W_F(idf)%W_V(iv)%datasz_in(2) = SIZE(pdata_3d,DIM=2)
+        W_F(idf)%W_V(iv)%datasz_in(3) = SIZE(pdata_3d,DIM=3)
+      ENDIF
+    ENDIF
+!-
+!-- 5.2 The maximum size of the data will give the size of the buffer
+!-
+    IF (W_F(idf)%W_V(iv)%datasz_max <= 0) THEN
+      largebuf = .FALSE.
+      DO io=1,W_F(idf)%W_V(iv)%nbopp
+        IF (INDEX(fuchnbout,W_F(idf)%W_V(iv)%sopp(io)) > 0) THEN
+          largebuf = .TRUE.
+        ENDIF
+      ENDDO
+      IF (largebuf) THEN
+        W_F(idf)%W_V(iv)%datasz_max = &
+ &        W_F(idf)%W_V(iv)%scsize(1) &
+ &       *W_F(idf)%W_V(iv)%scsize(2) &
+ &       *W_F(idf)%W_V(iv)%scsize(3)
+      ELSE
+        IF      (l1d) THEN
+          W_F(idf)%W_V(iv)%datasz_max = &
+ &          W_F(idf)%W_V(iv)%datasz_in(1)
+        ELSE IF (l2d) THEN
+          W_F(idf)%W_V(iv)%datasz_max = &
+ &          W_F(idf)%W_V(iv)%datasz_in(1) &
+ &         *W_F(idf)%W_V(iv)%datasz_in(2)
+        ELSE IF (l3d) THEN
+          W_F(idf)%W_V(iv)%datasz_max = &
+ &          W_F(idf)%W_V(iv)%datasz_in(1) &
+ &         *W_F(idf)%W_V(iv)%datasz_in(2) &
+ &         *W_F(idf)%W_V(iv)%datasz_in(3)
+        ENDIF
+      ENDIF
+    ENDIF
+!-
+    IF (.NOT.ALLOCATED(tbf_1)) THEN
+      IF (l_dbg) THEN
+        WRITE(*,*) &
+ &       c_nam//" : allocate tbf_1 for size = ", &
+ &       W_F(idf)%W_V(iv)%datasz_max
+      ENDIF
+      ALLOCATE(tbf_1(W_F(idf)%W_V(iv)%datasz_max))
+    ELSE IF (W_F(idf)%W_V(iv)%datasz_max > SIZE(tbf_1)) THEN
+      IF (l_dbg) THEN
+        WRITE(*,*) &
+ &       c_nam//" : re-allocate tbf_1 for size = ", &
+ &       W_F(idf)%W_V(iv)%datasz_max
+      ENDIF
+      DEALLOCATE(tbf_1)
+      ALLOCATE(tbf_1(W_F(idf)%W_V(iv)%datasz_max))
+    ENDIF
+!-
+!-- We have to do the first operation anyway.
+!-- Thus we do it here and change the ranke
+!-- of the data at the same time. This should speed up things.
+!-
+    nbpt_out = W_F(idf)%W_V(iv)%datasz_max
+    IF      (l1d) THEN
+      nbpt_in1 = W_F(idf)%W_V(iv)%datasz_in(1)
+      CALL mathop (W_F(idf)%W_V(iv)%sopp(1),nbpt_in1,pdata_1d, &
+ &                 missing_val,nbindex,nindex, &
+ &                 W_F(idf)%W_V(iv)%scal(1),nbpt_out,tbf_1)
+    ELSE IF (l2d) THEN
+      nbpt_in2(1:2) = W_F(idf)%W_V(iv)%datasz_in(1:2)
+      CALL mathop (W_F(idf)%W_V(iv)%sopp(1),nbpt_in2,pdata_2d, &
+ &                 missing_val,nbindex,nindex, &
+ &                 W_F(idf)%W_V(iv)%scal(1),nbpt_out,tbf_1)
+    ELSE IF (l3d) THEN
+      nbpt_in3(1:3) = W_F(idf)%W_V(iv)%datasz_in(1:3)
+      CALL mathop (W_F(idf)%W_V(iv)%sopp(1),nbpt_in3,pdata_3d, &
+ &                 missing_val,nbindex,nindex, &
+ &                 W_F(idf)%W_V(iv)%scal(1),nbpt_out,tbf_1)
+    ENDIF
+    CALL histwrite_real (idf,iv,pitau,nbpt_out, &
+ &            tbf_1,nbindex,nindex,do_oper,do_write)
+  ENDIF
+!-
+! 6.0 Manage time steps
+!-
+  IF ((TRIM(tmp_opp) /= "once").AND.(TRIM(tmp_opp) /= "never")) THEN
+    W_F(idf)%W_V(iv)%last_opp_chk = pitau
+    W_F(idf)%W_V(iv)%last_wrt_chk = pitau
+  ELSE
+    W_F(idf)%W_V(iv)%last_opp_chk = -99
+    W_F(idf)%W_V(iv)%last_wrt_chk = -99
+  ENDIF
+!-----------------------
+END SUBROUTINE histw_rnd
+!===
+SUBROUTINE histwrite_real &
+ & (idf,iv,pitau,nbdpt,tbf_1,nbindex,nindex,do_oper,do_write)
+!---------------------------------------------------------------------
+!- This subroutine is internal and does the calculations and writing
+!- if needed. At a later stage it should be split into an operation
+!- and writing subroutines.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: idf,pitau,iv, &
+ &                      nbindex,nindex(nbindex),nbdpt
+  REAL,DIMENSION(:)  :: tbf_1
+  LOGICAL,INTENT(IN) :: do_oper,do_write
+!-
+  INTEGER :: tsz,nfid,nvid,iret,itax,io,nbin,nbout
+  INTEGER :: nx,ny,nz,ky,kz,kt,kc
+  INTEGER,DIMENSION(4) :: corner,edges
+  INTEGER :: itime
+!-
+  REAL :: rtime
+  REAL,DIMENSION(2) :: t_bnd
+  CHARACTER(LEN=7) :: tmp_opp
+  REAL,ALLOCATABLE,DIMENSION(:),SAVE :: tbf_2
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "histwrite 0.0 : VAR : ",W_F(idf)%W_V(iv)%v_name
+    WRITE(*,*) "histwrite 0.0 : nbindex :",nbindex
+    WRITE(*,*) "histwrite 0.0 : nindex  :",nindex(1:MIN(3,nbindex)),'...'
+  ENDIF
+!-
+! The sizes which can be encoutered
+!-
+  tsz =  W_F(idf)%W_V(iv)%zsize(1) &
+ &      *W_F(idf)%W_V(iv)%zsize(2) &
+ &      *W_F(idf)%W_V(iv)%zsize(3)
+!-
+! 1.0 We allocate and the temporary space needed for operations.
+!     The buffers are only deallocated when more space is needed.
+!     This reduces the umber of allocates but increases memory needs.
+!-
+  IF (.NOT.ALLOCATED(tbf_2)) THEN
+    IF (l_dbg) THEN
+      WRITE(*,*) "histwrite_real 1.1 allocate tbf_2 ",SIZE(tbf_1)
+    ENDIF
+    ALLOCATE(tbf_2(W_F(idf)%W_V(iv)%datasz_max))
+  ELSE IF (W_F(idf)%W_V(iv)%datasz_max > SIZE(tbf_2)) THEN
+    IF (l_dbg) THEN
+      WRITE(*,*) "histwrite_real 1.2 re-allocate tbf_2 : ", &
+     & SIZE(tbf_1)," instead of ",SIZE(tbf_2)
+    ENDIF
+    DEALLOCATE(tbf_2)
+    ALLOCATE(tbf_2(W_F(idf)%W_V(iv)%datasz_max))
+  ENDIF
+!-
+  rtime = pitau*W_F(idf)%deltat
+  tmp_opp = W_F(idf)%W_V(iv)%topp
+!-
+! 3.0 Do the operations or transfer the slab of data into tbf_1
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "histwrite: 3.0",idf
+  ENDIF
+!-
+! 3.1 DO the Operations only if needed
+!-
+  IF (do_oper) THEN
+    nbout = nbdpt
+!-
+!-- 3.4 We continue the sequence of operations
+!--     we started in the interface routine
+!-
+    DO io=2,W_F(idf)%W_V(iv)%nbopp,2
+      nbin = nbout
+      nbout = W_F(idf)%W_V(iv)%datasz_max
+      CALL mathop(W_F(idf)%W_V(iv)%sopp(io),nbin,tbf_1, &
+ &      missing_val,nbindex,nindex,W_F(idf)%W_V(iv)%scal(io), &
+ &      nbout,tbf_2)
+      IF (l_dbg) THEN
+        WRITE(*,*) &
+ &       "histwrite: 3.4a nbout : ",nbin,nbout,W_F(idf)%W_V(iv)%sopp(io)
+      ENDIF
+!-
+      nbin = nbout
+      nbout = W_F(idf)%W_V(iv)%datasz_max
+      CALL mathop(W_F(idf)%W_V(iv)%sopp(io+1),nbin,tbf_2, &
+ &      missing_val,nbindex,nindex,W_F(idf)%W_V(iv)%scal(io+1), &
+ &      nbout,tbf_1)
+      IF (l_dbg) THEN
+        WRITE(*,*) &
+ &     "histwrite: 3.4b nbout : ",nbin,nbout,W_F(idf)%W_V(iv)%sopp(io+1)
+      ENDIF
+    ENDDO
+!-
+!   3.5 Zoom into the data
+!-
+    IF (l_dbg) THEN
+      WRITE(*,*) &
+ &     "histwrite: 3.5 size(tbf_1) : ",SIZE(tbf_1)
+      WRITE(*,*) &
+ &     "histwrite: 3.5 slab in X :", &
+ &     W_F(idf)%W_V(iv)%zorig(1),W_F(idf)%W_V(iv)%zsize(1)
+      WRITE(*,*) &
+ &     "histwrite: 3.5 slab in Y :", &
+ &     W_F(idf)%W_V(iv)%zorig(2),W_F(idf)%W_V(iv)%zsize(2)
+      WRITE(*,*) &
+ &     "histwrite: 3.5 slab in Z :", &
+ &     W_F(idf)%W_V(iv)%zorig(3),W_F(idf)%W_V(iv)%zsize(3)
+      WRITE(*,*) &
+ &     "histwrite: 3.5 slab of input:", &
+ &     W_F(idf)%W_V(iv)%scsize(1), &
+ &     W_F(idf)%W_V(iv)%scsize(2), &
+ &     W_F(idf)%W_V(iv)%scsize(3)
+    ENDIF
+!---
+!-- We have to consider blocks of contiguous data
+!---
+    nx=MAX(W_F(idf)%W_V(iv)%zsize(1),1)
+    ny=MAX(W_F(idf)%W_V(iv)%zsize(2),1)
+    nz=MAX(W_F(idf)%W_V(iv)%zsize(3),1)
+    IF     (     (W_F(idf)%W_V(iv)%zorig(1) == 1) &
+ &          .AND.(   W_F(idf)%W_V(iv)%zsize(1) &
+ &                == W_F(idf)%W_V(iv)%scsize(1)) &
+ &          .AND.(W_F(idf)%W_V(iv)%zorig(2) == 1) &
+ &          .AND.(   W_F(idf)%W_V(iv)%zsize(2) &
+ &                == W_F(idf)%W_V(iv)%scsize(2))) THEN
+      kt = (W_F(idf)%W_V(iv)%zorig(3)-1)*nx*ny
+      tbf_2(1:nx*ny*nz) = tbf_1(kt+1:kt+nx*ny*nz)
+    ELSEIF (     (W_F(idf)%W_V(iv)%zorig(1) == 1) &
+ &          .AND.(   W_F(idf)%W_V(iv)%zsize(1) &
+ &                == W_F(idf)%W_V(iv)%scsize(1))) THEN
+      kc = -nx*ny
+      DO kz=W_F(idf)%W_V(iv)%zorig(3),W_F(idf)%W_V(iv)%zorig(3)+nz-1
+        kc = kc+nx*ny
+        kt = ( (kz-1)*W_F(idf)%W_V(iv)%scsize(2) &
+ &            +W_F(idf)%W_V(iv)%zorig(2)-1)*nx
+        tbf_2(kc+1:kc+nx*ny) = tbf_1(kt+1:kt+nx*ny)
+      ENDDO
+    ELSE
+      kc = -nx
+      DO kz=W_F(idf)%W_V(iv)%zorig(3),W_F(idf)%W_V(iv)%zorig(3)+nz-1
+        DO ky=W_F(idf)%W_V(iv)%zorig(2),W_F(idf)%W_V(iv)%zorig(2)+ny-1
+          kc = kc+nx
+          kt = ((kz-1)*W_F(idf)%W_V(iv)%scsize(2)+ky-1) &
+ &            *W_F(idf)%W_V(iv)%scsize(1) &
+ &            +W_F(idf)%W_V(iv)%zorig(1)-1
+          tbf_2(kc+1:kc+nx) = tbf_1(kt+1:kt+nx)
+        ENDDO
+      ENDDO
+    ENDIF
+!-
+!-- 4.0 Get the min and max of the field
+!-
+    IF (l_dbg) THEN
+      WRITE(*,*) "histwrite: 4.0 tbf_1",idf,iv, &
+ &      TRIM(tmp_opp),' ---- ',LEN_TRIM(tmp_opp),nbindex
+    ENDIF
+!-
+    IF (W_F(idf)%W_V(iv)%hist_calc_rng) THEN
+      W_F(idf)%W_V(iv)%hist_minmax(1) = &
+ &      MIN(W_F(idf)%W_V(iv)%hist_minmax(1), &
+ &      MINVAL(tbf_2(1:tsz),MASK=tbf_2(1:tsz) /= missing_val))
+      W_F(idf)%W_V(iv)%hist_minmax(2) = &
+ &      MAX(W_F(idf)%W_V(iv)%hist_minmax(2), &
+ &      MAXVAL(tbf_2(1:tsz),MASK=tbf_2(1:tsz) /= missing_val))
+    ENDIF
+!-
+!-- 5.0 Do the operations if needed. In the case of instantaneous
+!--     output we do not transfer to the time_buffer.
+!-
+    IF (l_dbg) THEN
+      WRITE(*,*) "histwrite: 5.0 idf : ",idf," iv : ",iv," tsz : ",tsz
+    ENDIF
+!-
+    IF (     (TRIM(tmp_opp) /= "inst") &
+ &      .AND.(TRIM(tmp_opp) /= "once") ) THEN
+      CALL moycum(tmp_opp,tsz,W_F(idf)%W_V(iv)%t_bf, &
+ &           tbf_2,W_F(idf)%W_V(iv)%nb_opp)
+    ENDIF
+!-
+    W_F(idf)%W_V(iv)%last_opp = pitau
+    W_F(idf)%W_V(iv)%nb_opp = W_F(idf)%W_V(iv)%nb_opp+1
+!-
+  ENDIF
+!-
+! 6.0 Write to file if needed
+!-
+  IF (l_dbg) WRITE(*,*) "histwrite: 6.0",idf
+!-
+  IF (do_write) THEN
+!-
+    nfid = W_F(idf)%ncfid
+    nvid = W_F(idf)%W_V(iv)%ncvid
+!-
+!-- 6.1 Do the operations that are needed before writting
+!-
+    IF (l_dbg) WRITE(*,*) "histwrite: 6.1",idf
+!-
+    IF (     (TRIM(tmp_opp) /= "inst") &
+ &      .AND.(TRIM(tmp_opp) /= "once") ) THEN
+      t_bnd(1:2) = (/ W_F(idf)%W_V(iv)%last_wrt*W_F(idf)%deltat,rtime /)
+      rtime = (t_bnd(1)+t_bnd(2))/2.0
+    ENDIF
+!-
+!-- 6.2 Add a value to the time axis of this variable if needed
+!-
+    IF (     (TRIM(tmp_opp) /= "l_max") &
+ &      .AND.(TRIM(tmp_opp) /= "l_min") &
+ &      .AND.(TRIM(tmp_opp) /= "once") ) THEN
+!-
+      IF (l_dbg) WRITE(*,*) "histwrite: 6.2",idf
+!-
+      itax  = W_F(idf)%W_V(iv)%t_axid
+      itime = W_F(idf)%W_V(iv)%nb_wrt+1
+!-
+      IF (W_F(idf)%W_V(itax)%tax_last < itime) THEN
+        iret = NF90_PUT_VAR (nfid,W_F(idf)%W_V(itax)%tdimid, &
+ &               (/ rtime /),start=(/ itime /),count=(/ 1 /))
+        IF (W_F(idf)%W_V(itax)%tbndid > 0) THEN
+          iret = NF90_PUT_VAR (nfid,W_F(idf)%W_V(itax)%tbndid, &
+ &                 t_bnd,start=(/ 1,itime /),count=(/ 2,1 /))
+        ENDIF
+        W_F(idf)%W_V(itax)%tax_last = itime
+      ENDIF
+    ELSE
+      itime=1
+    ENDIF
+!-
+!-- 6.3 Write the data. Only in the case of instantaneous output
+!       we do not write the buffer.
+!-
+    IF (l_dbg) THEN
+      WRITE(*,*) "histwrite: 6.3",idf,nfid,nvid,iv,itime
+    ENDIF
+!-
+    IF (W_F(idf)%W_V(iv)%scsize(3) == 1) THEN
+      IF (W_F(idf)%regular) THEN
+        corner(1:4) = (/ 1,1,itime,0 /)
+        edges(1:4) = (/ W_F(idf)%W_V(iv)%zsize(1), &
+ &                      W_F(idf)%W_V(iv)%zsize(2),1,0 /)
+      ELSE
+        corner(1:4) = (/ 1,itime,0,0 /)
+        edges(1:4) = (/ W_F(idf)%W_V(iv)%zsize(1),1,0,0 /)
+      ENDIF
+    ELSE
+      IF (W_F(idf)%regular) THEN
+        corner(1:4) = (/ 1,1,1,itime /)
+        edges(1:4) = (/ W_F(idf)%W_V(iv)%zsize(1), &
+ &                      W_F(idf)%W_V(iv)%zsize(2), &
+ &                      W_F(idf)%W_V(iv)%zsize(3),1 /)
+      ELSE
+        corner(1:4) = (/ 1,1,itime,0 /)
+        edges(1:4) = (/ W_F(idf)%W_V(iv)%zsize(1), &
+ &                      W_F(idf)%W_V(iv)%zsize(3),1,0 /)
+      ENDIF
+    ENDIF
+!-
+    IF (     (TRIM(tmp_opp) /= "inst") &
+ &      .AND.(TRIM(tmp_opp) /= "once") ) THEN
+      iret = NF90_PUT_VAR (nfid,nvid,W_F(idf)%W_V(iv)%t_bf, &
+ &                         start=corner(1:4),count=edges(1:4))
+    ELSE
+      iret = NF90_PUT_VAR (nfid,nvid,tbf_2, &
+ &                         start=corner(1:4),count=edges(1:4))
+    ENDIF
+!-
+    W_F(idf)%W_V(iv)%last_wrt = pitau
+    W_F(idf)%W_V(iv)%nb_wrt = W_F(idf)%W_V(iv)%nb_wrt+1
+    W_F(idf)%W_V(iv)%nb_opp = 0
+!---
+!   After the write the file can be synchronized so that no data is
+!   lost in case of a crash. This feature gives up on the benefits of
+!   buffering and should only be used in debuging mode. A flag is
+!   needed here to switch to this mode.
+!---
+!   iret = NF90_SYNC (nfid)
+!-
+  ENDIF
+!----------------------------
+END SUBROUTINE histwrite_real
+!===
+SUBROUTINE histvar_seq (idf,pvarname,idv)
+!---------------------------------------------------------------------
+!- This subroutine optimize the search for the variable in the table.
+!- In a first phase it will learn the succession of the variables
+!- called and then it will use the table to guess what comes next.
+!- It is the best solution to avoid lengthy searches through array
+!- vectors.
+!-
+!- ARGUMENTS :
+!-
+!- idf      : id of the file on which we work
+!- pvarname : The name of the variable we are looking for
+!- idv      : The var id we found
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(in)  :: idf
+  CHARACTER(LEN=*),INTENT(IN) :: pvarname
+  INTEGER,INTENT(out) :: idv
+!-
+  LOGICAL,SAVE :: learning(nb_files_max)=.TRUE.
+  INTEGER,SAVE :: overlap(nb_files_max) = -1
+  INTEGER,SAVE :: varseq(nb_files_max,nb_var_max*3)
+  INTEGER,SAVE :: varseq_len(nb_files_max) = 0
+  INTEGER,SAVE :: varseq_pos(nb_files_max)
+  INTEGER,SAVE :: varseq_err(nb_files_max) = 0
+  INTEGER      :: ib,sp,nn,pos
+  CHARACTER(LEN=70) :: str70
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) 'histvar_seq, start of the subroutine :',learning(idf)
+  ENDIF
+!-
+  IF (learning(idf)) THEN
+!-
+!-- 1.0 We compute the length over which we are going
+!--     to check the overlap
+!-
+    IF (overlap(idf) <= 0) THEN
+      IF (W_F(idf)%n_var > 6) THEN
+        overlap(idf) = W_F(idf)%n_var/3*2
+      ELSE
+        overlap(idf) = W_F(idf)%n_var
+      ENDIF
+    ENDIF
+!-
+!-- 1.1 Find the position of this string
+!-
+    CALL find_str (W_F(idf)%W_V(1:W_F(idf)%n_var)%v_name,pvarname,pos)
+    IF (pos > 0) THEN
+      idv = pos
+    ELSE
+      CALL ipslerr (3,"histvar_seq", &
+ &      'The name of the variable you gave has not been declared', &
+ &      'You should use subroutine histdef for declaring variable', &
+ &      TRIM(pvarname))
+    ENDIF
+!-
+!-- 1.2 If we have not given up we store the position
+!--     in the sequence of calls
+!-
+    IF (varseq_err(idf) >= 0) THEN
+      sp = varseq_len(idf)+1
+      IF (sp <= nb_var_max*3) THEN
+        varseq(idf,sp) = idv
+        varseq_len(idf) = sp
+      ELSE
+        CALL ipslerr (2,"histvar_seq",&
+ &       'The learning process has failed and we give up. '// &
+ &       'Either you sequence is',&
+ &       'too complex or I am too dumb. '// &
+ &       'This will only affect the efficiency',&
+ &       'of your code. Thus if you wish to save time'// &
+ &       ' contact the IOIPSL team. ')
+        WRITE(*,*) 'The sequence we have found up to now :'
+        WRITE(*,*) varseq(idf,1:sp-1)
+        varseq_err(idf) = -1
+      ENDIF
+!-
+!---- 1.3 Check if we have found the right overlap
+!-
+      IF (varseq_len(idf) >= overlap(idf)*2) THEN
+!-
+!------ We skip a few variables if needed as they could come
+!------ from the initialisation of the model.
+!-
+        DO ib = 0,sp-overlap(idf)*2
+          IF ( learning(idf) .AND.&
+            & SUM(ABS(varseq(idf,ib+1:ib+overlap(idf)) -&
+            & varseq(idf,sp-overlap(idf)+1:sp))) == 0 ) THEN
+            learning(idf) = .FALSE.
+            varseq_len(idf) = sp-overlap(idf)-ib
+            varseq_pos(idf) = overlap(idf)+ib
+            varseq(idf,1:varseq_len(idf)) = &
+ &            varseq(idf,ib+1:ib+varseq_len(idf))
+          ENDIF
+        ENDDO
+      ENDIF
+    ENDIF
+  ELSE
+!-
+!-- 2.0 Now we know how the calls to histwrite are sequenced
+!--     and we can get a guess at the var ID
+!-
+    nn = varseq_pos(idf)+1
+    IF (nn > varseq_len(idf)) nn = 1
+!-
+    idv = varseq(idf,nn)
+!-
+    IF (TRIM(W_F(idf)%W_V(idv)%v_name) /= TRIM(pvarname)) THEN
+      CALL find_str (W_F(idf)%W_V(1:W_F(idf)%n_var)%v_name,pvarname,pos)
+      IF (pos > 0) THEN
+        idv = pos
+      ELSE
+        CALL ipslerr (3,"histvar_seq", &
+ &  'The name of the variable you gave has not been declared',&
+ &  'You should use subroutine histdef for declaring variable', &
+ &  TRIM(pvarname))
+      ENDIF
+      varseq_err(idf) = varseq_err(idf)+1
+    ELSE
+!-
+!---- We only keep the new position if we have found the variable
+!---- this way. This way an out of sequence call to histwrite does
+!---- not defeat the process.
+!-
+      varseq_pos(idf) = nn
+    ENDIF
+!-
+!!$    IF (varseq_err(idf) >= 10) THEN
+!!$      WRITE(str70,'("for file ",I3)') idf
+!!$      CALL ipslerr (2,"histvar_seq", &
+!!$ &  'There were 10 errors in the learned sequence of variables',&
+!!$ &  str70,'This looks like a bug, please report it.')
+!!$         varseq_err(idf) = 0
+!!$    ENDIF
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) &
+ &   'histvar_seq, end of the subroutine :',TRIM(pvarname),idv
+  ENDIF
+!-------------------------
+END SUBROUTINE histvar_seq
+!===
+SUBROUTINE histsync (idf)
+!---------------------------------------------------------------------
+!- This subroutine will synchronise all
+!- (or one if defined) opened files.
+!-
+!- VERSION
+!-
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! idf  : optional argument for fileid
+  INTEGER,INTENT(in),OPTIONAL :: idf
+!-
+  INTEGER :: ifile,iret,i_s,i_e
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "->histsync"
+  ENDIF
+!-
+  IF (PRESENT(idf)) THEN
+    IF ( (idf >= 1).AND.(idf <= nb_files_max) ) THEN
+      IF (W_F(idf)%ncfid > 0) THEN
+        i_s = idf
+        i_e = idf
+      ELSE
+        i_s = 1
+        i_e = 0
+        CALL ipslerr (2,'histsync', &
+ &       'Unable to synchronise the file :','probably','not opened')
+      ENDIF
+    ELSE
+      CALL ipslerr (3,'histsync','Invalid file identifier',' ',' ')
+    ENDIF
+  ELSE
+    i_s = 1
+    i_e = nb_files_max
+  ENDIF
+!-
+  DO ifile=i_s,i_e
+    IF (W_F(ifile)%ncfid > 0) THEN
+      IF (l_dbg) THEN
+        WRITE(*,*) '  histsync - synchronising file number ',ifile
+      ENDIF
+      iret = NF90_SYNC(W_F(ifile)%ncfid)
+    ENDIF
+  ENDDO
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-histsync"
+  ENDIF
+!----------------------
+END SUBROUTINE histsync
+!===
+SUBROUTINE histclo (idf)
+!---------------------------------------------------------------------
+!- This subroutine will close all (or one if defined) opened files
+!-
+!- VERSION
+!-
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! idf  : optional argument for fileid
+  INTEGER,INTENT(in),OPTIONAL :: idf
+!-
+  INTEGER :: ifile,nfid,nvid,iret,iv,i_s,i_e
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "->histclo"
+  ENDIF
+!-
+  IF (PRESENT(idf)) THEN
+    IF ( (idf >= 1).AND.(idf <= nb_files_max) ) THEN
+      IF (W_F(idf)%ncfid > 0) THEN
+        i_s = idf
+        i_e = idf
+      ELSE
+        i_s = 1
+        i_e = 0
+        CALL ipslerr (2,'histclo', &
+ &       'Unable to close the file :','probably','not opened')
+      ENDIF
+    ELSE
+      CALL ipslerr (3,'histclo','Invalid file identifier',' ',' ')
+    ENDIF
+  ELSE
+    i_s = 1
+    i_e = nb_files_max
+  ENDIF
+!-
+  DO ifile=i_s,i_e
+    IF (W_F(ifile)%ncfid > 0) THEN
+      IF (l_dbg) THEN
+        WRITE(*,*) '  histclo - closing specified file number :',ifile
+      ENDIF
+      nfid = W_F(ifile)%ncfid
+      iret = NF90_REDEF(nfid)
+!-----
+!---- 1. Loop on the number of variables to add some final information
+!-----
+      IF (l_dbg) THEN
+        WRITE(*,*) '  Entering loop on vars : ',W_F(ifile)%n_var
+      ENDIF
+      DO iv=1,W_F(ifile)%n_var
+!------ Extrema
+        IF (W_F(ifile)%W_V(iv)%hist_wrt_rng) THEN
+          IF (l_dbg) THEN
+            WRITE(*,*) 'min value for file :',ifile,' var n. :',iv, &
+ &                     ' is : ',W_F(ifile)%W_V(iv)%hist_minmax(1)
+            WRITE(*,*) 'max value for file :',ifile,' var n. :',iv, &
+ &                     ' is : ',W_F(ifile)%W_V(iv)%hist_minmax(2)
+          ENDIF
+          IF (W_F(ifile)%W_V(iv)%hist_calc_rng) THEN
+!---------- Put the min and max values on the file
+            nvid = W_F(ifile)%W_V(iv)%ncvid
+            IF (W_F(ifile)%W_V(iv)%v_typ == hist_r8) THEN
+              iret = NF90_PUT_ATT(nfid,nvid,'valid_min', &
+ &                     REAL(W_F(ifile)%W_V(iv)%hist_minmax(1),KIND=8))
+              iret = NF90_PUT_ATT(nfid,nvid,'valid_max', &
+ &                     REAL(W_F(ifile)%W_V(iv)%hist_minmax(2),KIND=8))
+            ELSE
+              iret = NF90_PUT_ATT(nfid,nvid,'valid_min', &
+ &                     REAL(W_F(ifile)%W_V(iv)%hist_minmax(1),KIND=4))
+              iret = NF90_PUT_ATT(nfid,nvid,'valid_max', &
+ &                     REAL(W_F(ifile)%W_V(iv)%hist_minmax(2),KIND=4))
+            ENDIF
+          ENDIF
+        ENDIF
+!------ Time-Buffers
+        IF (ASSOCIATED(W_F(ifile)%W_V(iv)%t_bf)) THEN
+          DEALLOCATE(W_F(ifile)%W_V(iv)%t_bf)
+        ENDIF
+!------ Reinitialize the sizes
+        W_F(ifile)%W_V(iv)%datasz_in(:) = -1
+        W_F(ifile)%W_V(iv)%datasz_max = -1
+      ENDDO
+!-----
+!---- 2. Close the file
+!-----
+      IF (l_dbg) WRITE(*,*) '  close file :',nfid
+      iret = NF90_CLOSE(nfid)
+      W_F(ifile)%ncfid = -1
+      W_F(ifile)%dom_id_svg = -1
+    ENDIF
+  ENDDO
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-histclo"
+  ENDIF
+!---------------------
+END SUBROUTINE histclo
+!===
+SUBROUTINE ioconf_modname (str)
+!---------------------------------------------------------------------
+!- This subroutine allows to configure the name
+!- of the model written into the file
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(IN) :: str
+!---------------------------------------------------------------------
+  IF (.NOT.lock_modname) THEN
+    model_name = str(1:MIN(LEN_TRIM(str),80))
+    lock_modname = .TRUE.
+  ELSE
+    CALL ipslerr (2,"ioconf_modname", &
+   &  'The model name can only be changed once and only', &
+   &  'before it is used. It is now set to :',model_name)
+  ENDIF
+!----------------------------
+END SUBROUTINE ioconf_modname
+!-
+!===
+!-
+!-----------------
+END MODULE histcom
Index: trunk/NEMOGCM/EXTERNAL/IOIPSL/src/ioipsl.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/IOIPSL/src/ioipsl.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/IOIPSL/src/ioipsl.f90	(revision 2528)
@@ -0,0 +1,17 @@
+MODULE ioipsl
+!
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!
+  USE errioipsl 
+  USE stringop
+  USE mathelp    
+  USE getincom
+  USE calendar   
+  USE fliocom    
+  USE flincom    
+  USE histcom    
+  USE restcom
+END MODULE ioipsl
Index: trunk/NEMOGCM/EXTERNAL/IOIPSL/src/mathelp.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/IOIPSL/src/mathelp.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/IOIPSL/src/mathelp.f90	(revision 2528)
@@ -0,0 +1,3122 @@
+MODULE mathelp
+!-
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+  USE errioipsl,ONLY : ipslerr
+  USE stringop
+!-
+  PRIVATE
+  PUBLIC :: mathop,moycum,buildop
+!-
+  INTERFACE mathop
+    MODULE PROCEDURE mathop_r11,mathop_r21,mathop_r31
+  END INTERFACE
+!-
+!- Variables used to detect and identify the operations
+!-
+  CHARACTER(LEN=80),SAVE :: &
+ &  seps='( ) , + - / * ^', ops = '+ - * / ^', mima = 'min max'
+  CHARACTER(LEN=250),SAVE :: &
+ &  funcs = 'sin cos tan asin acos atan exp log sqrt chs abs '&
+ & //'cels kelv deg rad gather scatter fill coll undef only ident'
+  CHARACTER(LEN=120),SAVE :: &
+ &  indexfu = 'gather, scatter, fill, coll, undef, only'
+!---------------------------------------------------------------------
+CONTAINS
+!===
+SUBROUTINE buildop (c_str,ex_topps,topp,fill_val,opps,scal,nbops)
+!---------------------------------------------------------------------
+!- This subroutine decomposes the input string in the elementary
+!- functions which need to be applied to the vector of data.
+!- This vector is represented by X in the string.
+!- This subroutine is the driver of the decomposition and gets
+!- the time operation but then call decoop for the other operations
+!-
+!- INPUT
+!-
+!- c_str    : String containing the operations
+!- ex_toops : Time operations that can be expected within the string
+!- fill_val :
+!-
+!- OUTPUT
+!-
+!- topp   : Time operation
+!- opps   :
+!- scal   :
+!- nbops  :
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(IN) :: c_str,ex_topps
+  CHARACTER(LEN=*),INTENT(OUT) :: topp
+  CHARACTER(LEN=*),DIMENSION(:),INTENT(OUT) :: opps
+  REAL,INTENT(IN) :: fill_val
+  REAL,DIMENSION(:),INTENT(OUT) :: scal
+  INTEGER,INTENT(OUT) :: nbops
+!-
+  CHARACTER(LEN=LEN(c_str)) :: str,new_str
+  INTEGER :: leng,ind_opb,ind_clb
+!-
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (check) WRITE(*,*) 'buildop : Some preliminary cleaning'
+!-
+  str = c_str
+  leng = LEN_TRIM(str)
+  IF ( str(1:1) == '(' .AND. str(leng:leng) == ')' ) THEN
+    str = str(2:leng-1)
+    leng = leng-2
+  ENDIF
+!-
+  IF (check) &
+ &  WRITE(*,*) 'buildop : Starting to test the various options'
+!-
+  IF (leng <= 5 .AND. INDEX(ex_topps,str(1:leng)) > 0) THEN
+    IF (check) WRITE(*,*) 'buildop : Time operation only'
+    nbops = 0
+    topp = str(1:leng)
+  ELSE
+    IF (check) THEN
+      WRITE(*,*) 'buildop : Time operation and something else'
+    ENDIF
+!--
+    ind_opb = INDEX(str(1:leng),'(')
+    IF (ind_opb > 0) THEN
+      IF (INDEX(ex_topps,str(1:ind_opb-1)) > 0) THEN
+        IF (check) THEN
+          WRITE(*,'(2a)') &
+ &          ' buildop : Extract time operation from : ',str
+        ENDIF
+        topp = str(1:ind_opb-1)
+        ind_clb = INDEX(str(1:leng),')',BACK=.TRUE.)
+        new_str = str(ind_opb+1:ind_clb-1)
+        IF (check) THEN
+          WRITE(*,'(2a,2I3)') &
+ &          ' buildop : Call decoop ',new_str,ind_opb,ind_clb
+        ENDIF
+        CALL decoop (new_str,fill_val,opps,scal,nbops)
+      ELSE
+        CALL ipslerr(3,'buildop', &
+ &        'time operation does not exist',str(1:ind_opb-1),' ')
+      ENDIF
+    ELSE
+      CALL ipslerr(3,'buildop', &
+ &      'some long operation exists but wihout parenthesis', &
+ &      str(1:leng),' ')
+    ENDIF
+  ENDIF
+!-
+  IF (check) THEN
+    DO leng=1,nbops
+      WRITE(*,*) &
+ &      'buildop : i -- opps, scal : ',leng,opps(leng),scal(leng)
+    ENDDO
+  ENDIF
+!---------------------
+END SUBROUTINE buildop
+!===
+SUBROUTINE decoop (pstr,fill_val,opps,scal,nbops)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(IN) :: pstr
+  REAL,INTENT(IN) :: fill_val
+  CHARACTER(LEN=*),DIMENSION(:),INTENT(OUT) :: opps
+  REAL,DIMENSION(:),INTENT(OUT) :: scal
+  INTEGER,INTENT(OUT) :: nbops
+!-
+  CHARACTER(LEN=1),DIMENSION(2) :: f_char,s_char
+  INTEGER,DIMENSION(2) :: f_pos,s_pos
+  CHARACTER(LEN=20) :: opp_str,scal_str
+  CHARACTER(LEN=LEN(pstr)) :: str
+  INTEGER :: nbsep,nbops_max,xpos,leng,ppos,epos,int_tmp
+  CHARACTER(LEN=3) :: tl,dl
+  CHARACTER(LEN=10) :: fmt
+!-
+  LOGICAL :: check = .FALSE.,prio
+!---------------------------------------------------------------------
+  IF (check) WRITE(*,'(2A)') ' decoop : Incoming string : ',pstr
+!-
+  str = pstr; nbops = 0;
+!-
+  CALL findsep (str,nbsep,f_char,f_pos,s_char,s_pos)
+  IF (check) WRITE(*,*) 'decoop : Out of findsep',nbsep
+!-
+  nbops_max = min(SIZE(opps),SIZE(scal))
+!-
+  DO WHILE (nbsep > 0)
+    IF (nbops >= nbops_max) THEN
+      CALL ipslerr(3,'decoop','Expression too complex',TRIM(str),' ')
+    ENDIF
+!--
+    xpos = INDEX(str,'X')
+    leng = LEN_TRIM(str)
+    nbops = nbops+1
+!--
+    IF (check) THEN
+      WRITE(*,*) 'decoop : str   -> ',TRIM(str)
+      WRITE(*,*) 'decoop : nbops -> ',nbops
+      WRITE(*,*) s_char(1),'-',f_char(1),'|',f_char(2),'-',s_char(2)
+      WRITE(*,*) s_pos(1),'-',f_pos(1),'|',f_pos(2),'-',s_pos(2)
+    ENDIF
+!---
+!-- Start the analysis of the syntax. 3 types of constructs
+!-- are recognized.  They are scanned sequentialy
+!---
+    IF (nbsep == 1) THEN
+      IF (check) WRITE(*,*) 'decoop : Only one operation'
+      IF (INDEX(ops,f_char(1)) > 0) THEN
+!------ Type : scal+X
+        IF (f_char(1) == '-' .OR. f_char(1) == '/') THEN
+          opp_str = f_char(1)//'I'
+        ELSE
+          opp_str = f_char(1)
+        ENDIF
+        scal_str = str(s_pos(1)+1:f_pos(1)-1)
+        str = 'X'
+      ELSE IF (INDEX(ops,f_char(2)) > 0) THEN
+!------ Type : X+scal
+        opp_str = f_char(2)
+        scal_str = str(f_pos(2)+1:s_pos(2)-1)
+        str = 'X'
+      ELSE
+        CALL ipslerr(3,'decoop', &
+ &        'Unknown operations of type X+scal',f_char(1),pstr)
+      ENDIF
+    ELSE
+      IF (check) WRITE(*,*) 'decoop : More complex operation'
+      IF ( f_char(1) == '(' .AND. f_char(2) == ')' ) THEN
+!------ Type : sin(X)
+        opp_str = str(s_pos(1)+1:f_pos(1)-1)
+        scal_str = '?'
+        str = str(1:s_pos(1))//'X'//str(f_pos(2)+1:leng)
+      ELSE IF (    (f_char(1) == '(' .AND. f_char(2) == ',')&
+ &             .OR.(f_char(1) == ',' .AND. f_char(2) == ')')) THEN
+!------ Type : max(X,scal) or max(scal,X)
+        IF (f_char(1) == '(' .AND. s_char(2) == ')') THEN
+!-------- Type : max(X,scal)
+          opp_str = str(f_pos(1)-3:f_pos(1)-1)
+          scal_str = str(f_pos(2)+1:s_pos(2)-1)
+          str = str(1:f_pos(1)-4)//'X'//str(s_pos(2)+1:leng)
+        ELSE IF (f_char(1) == ',' .AND. s_char(1) == '(') THEN
+!-------- Type : max(scal,X)
+          opp_str = str(s_pos(1)-3:s_pos(1)-1)
+          scal_str = str(s_pos(1)+1:f_pos(1)-1)
+          str = str(1:s_pos(1)-4)//'X'//str(f_pos(2)+1:leng)
+        ELSE
+          CALL ipslerr(3,'decoop','Syntax error 1',str,' ')
+        ENDIF
+      ELSE
+        prio = (f_char(2) == '*').OR.(f_char(2) == '^')
+        IF (     (INDEX(ops,f_char(1)) > 0) &
+ &          .AND.(xpos-f_pos(1) == 1).AND.(.NOT.prio) ) THEN
+!-------- Type : ... scal+X ...
+          IF (f_char(1) == '-' .OR. f_char(1) == '/') THEN
+            opp_str = f_char(1)//'I'
+          ELSE
+            opp_str = f_char(1)
+          ENDIF
+          scal_str = str(s_pos(1)+1:f_pos(1)-1)
+          str = str(1:s_pos(1))//'X'//str(f_pos(1)+2:leng)
+        ELSE IF (     (INDEX(ops,f_char(2)) > 0) &
+ &               .AND.(f_pos(2)-xpos == 1) ) THEN
+!-------- Type : ... X+scal ...
+          opp_str = f_char(2)
+          scal_str = str(f_pos(2)+1:s_pos(2)-1)
+          str = str(1:f_pos(2)-2)//'X'//str(s_pos(2):leng)
+        ELSE
+          CALL ipslerr(3,'decoop','Syntax error 2',str,' ')
+        ENDIF
+      ENDIF
+    ENDIF
+!---
+    IF (check) WRITE(*,*) 'decoop : Finished syntax,str = ',TRIM(str)
+!---
+!-- Now that the different components of the operation are identified
+!-- we transform them into what is going to be used in the program
+!---
+    IF (INDEX(scal_str,'?') > 0) THEN
+      IF (INDEX(funcs,opp_str(1:LEN_TRIM(opp_str))) > 0) THEN
+        opps(nbops) = opp_str(1:LEN_TRIM(opp_str))
+        scal(nbops) = fill_val
+      ELSE
+        CALL ipslerr(3,'decoop', &
+ &        'Unknown function',opp_str(1:LEN_TRIM(opp_str)),' ')
+      ENDIF
+    ELSE
+      leng = LEN_TRIM(opp_str)
+      IF (INDEX(mima,opp_str(1:leng)) > 0) THEN
+        opps(nbops) = 'fu'//opp_str(1:leng)
+      ELSE
+        IF (INDEX(opp_str(1:leng),'+') > 0) THEN
+          opps(nbops) = 'add'
+        ELSE IF (INDEX(opp_str(1:leng),'-I') > 0) THEN
+          opps(nbops) = 'subi'
+        ELSE IF (INDEX(opp_str(1:leng),'-') > 0) THEN
+          opps(nbops) = 'sub'
+        ELSE IF (INDEX(opp_str(1:leng),'*') > 0) THEN
+          opps(nbops) = 'mult'
+        ELSE IF (INDEX(opp_str(1:leng),'/') > 0) THEN
+          opps(nbops) = 'div'
+        ELSE IF (INDEX(opp_str(1:leng),'/I') > 0) THEN
+          opps(nbops) = 'divi'
+        ELSE IF (INDEX(opp_str(1:leng),'^') > 0) THEN
+          opps(nbops) = 'power'
+        ELSE
+          CALL ipslerr(3,'decoop', &
+ &          'Unknown operation',opp_str(1:leng),' ')
+        ENDIF
+      ENDIF
+!-----
+      leng = LEN_TRIM(scal_str)
+      ppos = INDEX(scal_str,'.')
+      epos = INDEX(scal_str,'e')
+      IF (epos == 0) epos = INDEX(scal_str,'E')
+!-----
+!---- Try to catch a few errors
+!-----
+      IF (INDEX(ops,scal_str) > 0) THEN
+        CALL ipslerr(3,'decoop', &
+ &        'Strange scalar you have here ',scal_str,pstr)
+      ENDIF
+      IF (epos > 0) THEN
+        WRITE(tl,'(I3.3)') leng
+        WRITE(dl,'(I3.3)') epos-ppos-1
+        fmt='(e'//tl//'.'//dl//')'
+        READ(scal_str,fmt) scal(nbops)
+      ELSE IF (ppos > 0) THEN
+        WRITE(tl,'(I3.3)') leng
+        WRITE(dl,'(I3.3)') leng-ppos
+        fmt='(f'//tl//'.'//dl//')'
+        READ(scal_str,fmt) scal(nbops)
+      ELSE
+        WRITE(tl,'(I3.3)') leng
+        fmt = '(I'//tl//')'
+        READ(scal_str,fmt) int_tmp
+        scal(nbops) = REAL(int_tmp)
+      ENDIF
+    ENDIF
+    IF (check) WRITE(*,*) 'decoop : Finished interpretation'
+    CALL findsep(str,nbsep,f_char,f_pos,s_char,s_pos)
+  ENDDO
+!--------------------
+END SUBROUTINE decoop
+!===
+SUBROUTINE findsep (str,nbsep,f_char,f_pos,s_char,s_pos)
+!---------------------------------------------------------------------
+!- Subroutine finds all separators in a given string
+!- It returns the following information about str :
+!-   f_char : The first separation character
+!-            (1 for before and 2 for after)
+!-   f_pos  : The position of the first separator
+!-   s_char : The second separation character
+!-            (1 for before and 2 for after)
+!-   s_pos  : The position of the second separator
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(INOUT) :: str
+  INTEGER :: nbsep
+  CHARACTER(LEN=1),DIMENSION(2) :: f_char,s_char
+  INTEGER,DIMENSION(2) :: f_pos,s_pos
+!-
+  CHARACTER(LEN=10) :: str_tmp
+  LOGICAL :: f_found,s_found
+  INTEGER :: ind,xpos,leng,i
+!-
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (check) WRITE(*,*) 'findsep : call cleanstr: ',TRIM(str)
+!-
+  CALL cleanstr(str)
+!-
+  IF (check) WRITE(*,*) 'findsep : out of cleanstr: ',TRIM(str)
+!-
+  xpos = INDEX(str,'X')
+  leng = LEN_TRIM(str)
+!-
+  f_pos(1:2) = (/ 0,leng+1 /)
+  f_char(1:2) = (/ '?','?' /)
+  s_pos(1:2) = (/ 0,leng+1 /)
+  s_char(1:2) = (/ '?','?' /)
+!-
+  nbsep = 0
+!-
+  f_found = .FALSE.
+  s_found = .FALSE.
+  IF (xpos > 1) THEN
+    DO i=xpos-1,1,-1
+      ind = INDEX(seps,str(i:i))
+      IF (ind > 0) THEN
+        IF (.NOT.f_found) THEN
+          f_char(1) = str(i:i)
+          f_pos(1) = i
+          nbsep = nbsep+1
+          f_found = .TRUE.
+        ELSE IF (.NOT.s_found) THEN
+          s_char(1) = str(i:i)
+          s_pos(1) = i
+          nbsep = nbsep+1
+          s_found = .TRUE.
+        ENDIF
+      ENDIF
+    ENDDO
+  ENDIF
+!-
+  f_found = .FALSE.
+  s_found = .FALSE.
+  IF (xpos < leng) THEN
+    DO i=xpos+1,leng
+      ind = INDEX(seps,str(i:i))
+      IF (ind > 0) THEN
+        IF (.NOT.f_found) THEN
+          f_char(2) = str(i:i)
+          f_pos(2) = i
+          nbsep = nbsep+1
+          f_found = .TRUE.
+        ELSE IF (.NOT.s_found) THEN
+          s_char(2) = str(i:i)
+          s_pos(2) = i
+          nbsep = nbsep+1
+          s_found = .TRUE.
+        ENDIF
+      ENDIF
+    ENDDO
+  ENDIF
+!-
+  IF (nbsep > 4) THEN
+    WRITE(str_tmp,'("number :",I3)') nbsep
+    CALL ipslerr(3,'findsep', &
+ &    'How can I find that many separators',str_tmp,TRIM(str))
+  ENDIF
+!-
+  IF (check) WRITE(*,*) 'Finished findsep : ',nbsep,leng
+!---------------------
+END SUBROUTINE findsep
+!===
+SUBROUTINE cleanstr(str)
+!---------------------------------------------------------------------
+!- We clean up the string by taking out the extra () and puting
+!- everything in lower case except for the X describing the variable
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(INOUT) :: str
+!-
+  INTEGER :: ind,leng,ic,it
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  leng = LEN_TRIM(str)
+  CALL strlowercase(str)
+!-
+  ind = INDEX(str,'x')
+  IF (check) THEN
+    WRITE (*,*) 'cleanstr 1.0 : ind = ',ind, &
+&               ' str = ',str(1:leng),'---'
+  ENDIF
+!-
+! If the character before the x is not a letter then we can assume
+! that it is the variable and promote it to a capital letter
+!-
+  DO WHILE (ind > 0)
+    ic = 0
+    IF (ind > 1) ic = IACHAR(str(ind-1:ind-1))
+    IF (ic < 97 .OR. ic > 122) THEN
+      str(ind:ind) = 'X'
+    ENDIF
+    it = INDEX(str(ind+1:leng),'x')
+    IF (it > 0) THEN
+      ind = ind+it
+    ELSE
+      ind = it
+    ENDIF
+  ENDDO
+!-
+  IF (check) WRITE (*,*) 'cleanstr 2.0 : str = ',str(1:leng),'---'
+!-
+  IF ( str(1:1) == '(' .AND. str(leng:leng) == ')' ) THEN
+    str = str(2:leng-1)
+  ENDIF
+!-
+  IF (check) WRITE (*,*) 'cleanstr 3.0 : str = ',str(1:leng),'---'
+!-
+  leng = LEN_TRIM(str)
+  ind = INDEX(str,'((X))')
+  IF (ind > 0) THEN
+    str=str(1:ind-1)//'(X)'//str(ind+5:leng)//'  '
+  ENDIF
+!-
+  IF (check) WRITE (*,*) 'cleanstr 4.0 : str = ',str(1:leng),'---'
+!-
+  leng = LEN_TRIM(str)
+  ind = INDEX(str,'(X)')
+  IF (ind > 0 .AND. ind+3 < leng) THEN
+    IF (      (INDEX(seps,str(ind-1:ind-1)) > 0) &
+ &      .AND. (INDEX(seps,str(ind+3:ind+3)) > 0) ) THEN
+      str=str(1:ind-1)//'X'//str(ind+3:leng)//'  '
+    ENDIF
+  ENDIF
+!-
+  IF (check) WRITE (*,*) 'cleanstr 5.0 : str = ',str(1:leng),'---'
+!-
+  leng = LEN_TRIM(str)
+  ind = INDEX(str(1:leng),' ')
+  DO WHILE (ind > 0)
+    str=str(1:ind-1)//str(ind+1:leng)//' '
+    leng = LEN_TRIM(str)
+    ind = INDEX(str(1:leng),' ')
+  ENDDO
+!-
+  IF (check) WRITE (*,*) 'cleanstr 6.0 : str = ',str(1:leng),'---'
+!----------------------
+END SUBROUTINE cleanstr
+!===
+!===
+SUBROUTINE mathop_r11 &
+ &  (fun,nb,work_in,miss_val,nb_index,nindex,scal,nb_max,work_out)
+!---------------------------------------------------------------------
+!- This subroutines gives an interface to the various operation
+!- which are allowed. The interface is general enough to allow its use
+!- for other cases.
+!-
+!- INPUT
+!-
+!- fun      : function to be applied to the vector of data
+!- nb       : Length of input vector
+!- work_in  : Input vector of data (REAL)
+!- miss_val : The value of the missing data flag (it has to be a
+!-            maximum value, in f90 : huge( a real ))
+!- nb_index : Length of index vector
+!- nindex   : Vector of indices
+!- scal     : A scalar value for vector/scalar operations
+!- nb_max   : maximum length of output vector
+!-
+!- OUTPUT
+!-
+!- nb_max   : Actual length of output variable
+!- work_out : Output vector after the operation was applied
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=7) :: fun
+  INTEGER :: nb,nb_max,nb_index
+  INTEGER :: nindex(nb_index)
+  REAL :: work_in(nb),scal,miss_val
+  REAL :: work_out(nb_max)
+!-
+  INTEGER :: ierr
+!-
+  INTRINSIC SIN,COS,TAN,ASIN,ACOS,ATAN,EXP,LOG,SQRT,ABS
+!---------------------------------------------------------------------
+  ierr = 0
+!-
+  IF (scal >= miss_val-1.) THEN
+    IF (INDEX(indexfu,fun(1:LEN_TRIM(fun))) == 0) THEN
+      SELECT CASE (fun)
+      CASE('sin')
+        ierr = ma_sin_r11(nb,work_in,nb_max,work_out)
+      CASE('cos')
+        ierr = ma_cos_r11(nb,work_in,nb_max,work_out)
+      CASE('tan')
+        ierr = ma_tan_r11(nb,work_in,nb_max,work_out)
+      CASE('asin')
+        ierr = ma_asin_r11(nb,work_in,nb_max,work_out)
+      CASE('acos')
+        ierr = ma_acos_r11(nb,work_in,nb_max,work_out)
+      CASE('atan')
+        ierr = ma_atan_r11(nb,work_in,nb_max,work_out)
+      CASE('exp')
+        ierr = ma_exp_r11(nb,work_in,nb_max,work_out)
+      CASE('log')
+        ierr = ma_log_r11(nb,work_in,nb_max,work_out)
+      CASE('sqrt')
+        ierr = ma_sqrt_r11(nb,work_in,nb_max,work_out)
+      CASE('chs')
+        ierr = ma_chs_r11(nb,work_in,nb_max,work_out)
+      CASE('abs')
+        ierr = ma_abs_r11(nb,work_in,nb_max,work_out)
+      CASE('cels')
+        ierr = ma_cels_r11(nb,work_in,nb_max,work_out)
+      CASE('kelv')
+        ierr = ma_kelv_r11(nb,work_in,nb_max,work_out)
+      CASE('deg')
+        ierr = ma_deg_r11(nb,work_in,nb_max,work_out)
+      CASE('rad')
+        ierr = ma_rad_r11(nb,work_in,nb_max,work_out)
+      CASE('ident')
+        ierr = ma_ident_r11(nb,work_in,nb_max,work_out)
+      CASE DEFAULT
+        CALL ipslerr(3,"mathop", &
+ &        'scalar variable undefined and no indexing', &
+ &        'but still unknown function',fun)
+      END SELECT
+      IF (ierr > 0) THEN
+        CALL ipslerr(3,"mathop", &
+ &        'Error while executing a simple function',fun,' ')
+      ENDIF
+    ELSE
+      SELECT CASE (fun)
+      CASE('gather')
+        ierr = ma_fugath_r11(nb,work_in,nb_index,nindex, &
+&                            miss_val,nb_max,work_out)
+      CASE('scatter')
+        IF (nb_index > nb) THEN
+          work_out(1:nb_max) = miss_val
+          ierr=1
+        ELSE
+          ierr = ma_fuscat_r11(nb,work_in,nb_index,nindex, &
+&                              miss_val,nb_max,work_out)
+        ENDIF
+      CASE('coll')
+        ierr = ma_fucoll_r11(nb,work_in,nb_index,nindex, &
+&                            miss_val,nb_max,work_out)
+      CASE('fill')
+        ierr = ma_fufill_r11(nb,work_in,nb_index,nindex, &
+&                            miss_val,nb_max,work_out)
+      CASE('undef')
+        ierr = ma_fuundef_r11(nb,work_in,nb_index,nindex, &
+&                            miss_val,nb_max,work_out)
+      CASE('only')
+        ierr = ma_fuonly_r11(nb,work_in,nb_index,nindex, &
+&                            miss_val,nb_max,work_out)
+      CASE DEFAULT
+        CALL ipslerr(3,"mathop", &
+ &        'scalar variable undefined and indexing',&
+ &        'was requested but with unknown function',fun)
+      END SELECT
+      IF (ierr > 0) THEN
+        CALL ipslerr(3,"mathop_r11", &
+ &        'Error while executing an indexing function',fun,' ')
+      ENDIF
+    ENDIF
+  ELSE
+    SELECT CASE (fun)
+    CASE('fumin')
+      ierr = ma_fumin_r11(nb,work_in,scal,nb_max,work_out)
+    CASE('fumax')
+      ierr = ma_fumax_r11(nb,work_in,scal,nb_max,work_out)
+    CASE('add')
+      ierr = ma_add_r11(nb,work_in,scal,nb_max,work_out)
+    CASE('subi')
+      ierr = ma_subi_r11(nb,work_in,scal,nb_max,work_out)
+    CASE('sub')
+      ierr = ma_sub_r11(nb,work_in,scal,nb_max,work_out)
+    CASE('mult')
+      ierr = ma_mult_r11(nb,work_in,scal,nb_max,work_out)
+    CASE('div')
+      ierr = ma_div_r11(nb,work_in,scal,nb_max,work_out)
+    CASE('divi')
+      ierr = ma_divi_r11(nb,work_in,scal,nb_max,work_out)
+    CASE('power')
+      ierr = ma_power_r11(nb,work_in,scal,nb_max,work_out)
+    CASE DEFAULT
+      CALL ipslerr(3,"mathop", &
+ &      'Unknown operation with a scalar',fun,' ')
+    END SELECT
+    IF (ierr > 0) THEN
+      CALL ipslerr(3,"mathop", &
+ &      'Error while executing a scalar function',fun,' ')
+    ENDIF
+  ENDIF
+!------------------------
+END SUBROUTINE mathop_r11
+!-
+!=== FUNCTIONS (only one argument)
+!-
+INTEGER FUNCTION ma_sin_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = SIN(x(i))
+  ENDDO
+!-
+  nbo = nb
+  ma_sin_r11 = 0
+!----------------------
+END FUNCTION ma_sin_r11
+!===
+INTEGER FUNCTION ma_cos_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = COS(x(i))
+  ENDDO
+!-
+  nbo = nb
+  ma_cos_r11 = 0
+!----------------------
+END FUNCTION ma_cos_r11
+!===
+INTEGER FUNCTION ma_tan_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = TAN(x(i))
+  ENDDO
+!-
+  nbo = nb
+  ma_tan_r11 = 0
+!----------------------
+END FUNCTION ma_tan_r11
+!===
+INTEGER FUNCTION ma_asin_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = ASIN(x(i))
+  ENDDO
+!-
+  nbo = nb
+  ma_asin_r11 = 0
+!-----------------------
+END FUNCTION ma_asin_r11
+!===
+INTEGER FUNCTION ma_acos_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = ACOS(x(i))
+  ENDDO
+!-
+  nbo = nb
+  ma_acos_r11 = 0
+!-----------------------
+END FUNCTION ma_acos_r11
+!===
+INTEGER FUNCTION ma_atan_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = ATAN(x(i))
+  ENDDO
+!-
+  nbo = nb
+  ma_atan_r11 = 0
+!-----------------------
+END FUNCTION ma_atan_r11
+!===
+INTEGER FUNCTION ma_exp_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = EXP(x(i))
+  ENDDO
+!-
+  nbo = nb
+  ma_exp_r11 = 0
+!----------------------
+END FUNCTION ma_exp_r11
+!===
+INTEGER FUNCTION ma_log_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = log(x(i))
+  ENDDO
+!-
+  nbo = nb
+  ma_log_r11 = 0
+!----------------------
+END FUNCTION ma_log_r11
+!===
+INTEGER FUNCTION ma_sqrt_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = SQRT(x(i))
+  ENDDO
+!-
+  nbo = nb
+  ma_sqrt_r11 = 0
+!-----------------------
+END FUNCTION ma_sqrt_r11
+!===
+INTEGER FUNCTION ma_abs_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = ABS(x(i))
+  ENDDO
+!-
+  nbo = nb
+  ma_abs_r11 = 0
+!----------------------
+END FUNCTION ma_abs_r11
+!===
+INTEGER FUNCTION ma_chs_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = x(i)*(-1.)
+  ENDDO
+!-
+  nbo = nb
+  ma_chs_r11 = 0
+!----------------------
+END FUNCTION ma_chs_r11
+!===
+INTEGER FUNCTION ma_cels_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = x(i)-273.15
+  ENDDO
+!-
+  nbo = nb
+  ma_cels_r11 = 0
+!-----------------------
+END FUNCTION ma_cels_r11
+!===
+INTEGER FUNCTION ma_kelv_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = x(i)+273.15
+  ENDDO
+!-
+  nbo = nb
+  ma_kelv_r11 = 0
+!-----------------------
+END FUNCTION ma_kelv_r11
+!===
+INTEGER FUNCTION ma_deg_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = x(i)*57.29577951
+  ENDDO
+!-
+  nbo = nb
+  ma_deg_r11 = 0
+!-----------------------
+END FUNCTION ma_deg_r11
+!===
+INTEGER FUNCTION ma_rad_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = x(i)*0.01745329252
+  ENDDO
+!-
+  nbo = nb
+  ma_rad_r11 = 0
+!----------------------
+END FUNCTION ma_rad_r11
+!===
+INTEGER FUNCTION ma_ident_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = x(i)
+  ENDDO
+!-
+  nbo = nb
+  ma_ident_r11 = 0
+!------------------------
+END FUNCTION ma_ident_r11
+!-
+!=== OPERATIONS (two argument)
+!-
+INTEGER FUNCTION ma_add_r11(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo
+  REAL :: x(nb),s,y(nbo)
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = x(i)+s
+  ENDDO
+!-
+  nbo = nb
+  ma_add_r11 = 0
+!-----------------------
+  END FUNCTION ma_add_r11
+!===
+INTEGER FUNCTION ma_sub_r11(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo
+  REAL :: x(nb),s,y(nbo)
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = x(i)-s
+  ENDDO
+!-
+  nbo = nb
+  ma_sub_r11 = 0
+!----------------------
+END FUNCTION ma_sub_r11
+!===
+INTEGER FUNCTION ma_subi_r11(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo
+  REAL :: x(nb),s,y(nbo)
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) =  s-x(i)
+  ENDDO
+!-
+  nbo = nb
+  ma_subi_r11 = 0
+!-----------------------
+END FUNCTION ma_subi_r11
+!===
+INTEGER FUNCTION ma_mult_r11(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo
+  REAL :: x(nb),s,y(nbo)
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = x(i)*s
+  ENDDO
+!-
+  nbo = nb
+  ma_mult_r11 = 0
+!-----------------------
+END FUNCTION ma_mult_r11
+!===
+INTEGER FUNCTION ma_div_r11(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo
+  REAL :: x(nb),s,y(nbo)
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = x(i)/s
+  ENDDO
+!-
+  nbo = nb
+  ma_div_r11 = 0
+!-----------------------
+  END FUNCTION ma_div_r11
+!===
+INTEGER FUNCTION ma_divi_r11(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo
+  REAL :: x(nb),s,y(nbo)
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = s/x(i)
+  ENDDO
+!-
+  nbo = nb
+  ma_divi_r11 = 0
+!-----------------------
+END FUNCTION ma_divi_r11
+!===
+INTEGER FUNCTION ma_power_r11(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo
+  REAL :: x(nb),s,y(nbo)
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = x(i)**s
+  ENDDO
+!-
+  nbo = nb
+  ma_power_r11 = 0
+!-----------------------
+END FUNCTION ma_power_r11
+!===
+INTEGER FUNCTION ma_fumin_r11(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo
+  REAL :: x(nb),s,y(nbo)
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = MIN(x(i),s)
+  ENDDO
+!-
+  nbo = nb
+  ma_fumin_r11 = 0
+!------------------------
+END FUNCTION ma_fumin_r11
+!===
+INTEGER FUNCTION ma_fumax_r11(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo
+  REAL :: x(nb),s,y(nbo)
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = MAX(x(i),s)
+  ENDDO
+!-
+  nbo = nb
+  ma_fumax_r11 = 0
+!------------------------
+END FUNCTION ma_fumax_r11
+!===
+INTEGER FUNCTION ma_fuscat_r11(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb),miss_val,y(nbo)
+!-
+  INTEGER :: i,ii,ipos
+!---------------------------------------------------------------------
+  ma_fuscat_r11 = 0
+!-
+  y(1:nbo) = miss_val
+!-
+  IF (nbi <= nb) THEN
+    ipos = 0
+    DO i=1,nbi
+      IF (ind(i) <= nbo .AND. ind(i) > 0) THEN
+        ipos = ipos+1
+        y(ind(i)) = x(ipos)
+      ELSE
+        IF (ind(i) > nbo) ma_fuscat_r11  = ma_fuscat_r11+1
+      ENDIF
+    ENDDO
+!-- Repeat the data if needed
+    IF (MINVAL(ind) < 0) THEN
+      DO i=1,nbi
+        IF (ind(i) <= 0) THEN
+          DO ii=1,ABS(ind(i))-1
+            IF (ind(i+1)+ii <= nbo) THEN
+              y(ind(i+1)+ii) = y(ind(i+1))
+            ELSE
+              ma_fuscat_r11  = ma_fuscat_r11+1
+            ENDIF
+          ENDDO
+        ENDIF
+      ENDDO
+    ENDIF
+  ELSE
+    ma_fuscat_r11  = 1
+  ENDIF
+!-------------------------
+END FUNCTION ma_fuscat_r11
+!===
+INTEGER FUNCTION ma_fugath_r11(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb),miss_val,y(nbo)
+!-
+  INTEGER :: i,ipos
+!---------------------------------------------------------------------
+  IF (nbi <= nbo) THEN
+    ma_fugath_r11 = 0
+    y(1:nbo) = miss_val
+    ipos = 0
+    DO i=1,nbi
+      IF (ipos+1 <= nbo) THEN
+        IF (ind(i) > 0) THEN
+          ipos = ipos+1
+          y(ipos) = x(ind(i))
+        ENDIF
+      ELSE
+        IF (ipos+1 > nbo) ma_fugath_r11  = ma_fugath_r11+1
+      ENDIF
+    ENDDO
+  ELSE
+    ma_fugath_r11 = 1
+  ENDIF
+!-
+  nbo = ipos
+!-------------------------
+END FUNCTION ma_fugath_r11
+!===
+INTEGER FUNCTION ma_fufill_r11(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb),miss_val,y(nbo)
+!-
+  INTEGER :: i,ii,ipos
+!---------------------------------------------------------------------
+  ma_fufill_r11 = 0
+!-
+  IF (nbi <= nb) THEN
+    ipos = 0
+    DO i=1,nbi
+      IF (ind(i) <= nbo .AND. ind(i) > 0) THEN
+        ipos = ipos+1
+        y(ind(i)) = x(ipos)
+      ELSE
+        IF (ind(i) > nbo) ma_fufill_r11  = ma_fufill_r11+1
+      ENDIF
+    ENDDO
+!-- Repeat the data if needed
+    IF (MINVAL(ind) < 0) THEN
+      DO i=1,nbi
+        IF (ind(i) <= 0) THEN
+          DO ii=1,ABS(ind(i))-1
+            IF (ind(i+1)+ii <= nbo) THEN
+              y(ind(i+1)+ii) = y(ind(i+1))
+            ELSE
+              ma_fufill_r11  = ma_fufill_r11+1
+            ENDIF
+          ENDDO
+        ENDIF
+      ENDDO
+    ENDIF
+  ELSE
+    ma_fufill_r11  = 1
+  ENDIF
+!-------------------------
+END FUNCTION ma_fufill_r11
+!===
+INTEGER FUNCTION ma_fucoll_r11(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb),miss_val,y(nbo)
+!-
+  INTEGER :: i,ipos
+!---------------------------------------------------------------------
+  IF (nbi <= nbo) THEN
+    ma_fucoll_r11 = 0
+    ipos = 0
+    DO i=1,nbi
+      IF (ipos+1 <= nbo) THEN
+        IF (ind(i) > 0) THEN
+          ipos = ipos+1
+          y(ipos) = x(ind(i))
+        ENDIF
+      ELSE
+        IF (ipos+1 > nbo) ma_fucoll_r11  = ma_fucoll_r11+1
+      ENDIF
+    ENDDO
+  ELSE
+    ma_fucoll_r11 = 1
+  ENDIF
+!-
+  nbo = ipos
+!-------------------------
+END FUNCTION ma_fucoll_r11
+!===
+INTEGER FUNCTION ma_fuundef_r11(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb),miss_val,y(nbo)
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  IF (nbi <= nbo .AND. nbo == nb) THEN
+    ma_fuundef_r11 = 0
+    DO i=1,nbo
+      y(i) = x(i)
+    ENDDO
+    DO i=1,nbi
+      IF (ind(i) <= nbo .AND. ind(i) > 0) THEN
+        y(ind(i)) =  miss_val
+      ELSE
+        IF (ind(i) > nbo) ma_fuundef_r11  = ma_fuundef_r11+1
+      ENDIF
+    ENDDO
+  ELSE
+    ma_fuundef_r11 = 1
+  ENDIF
+!--------------------------
+END FUNCTION ma_fuundef_r11
+!===
+INTEGER FUNCTION ma_fuonly_r11(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb),miss_val,y(nbo)
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  IF (     (nbi <= nbo).AND.(nbo == nb) &
+ &    .AND.ALL(ind(1:nbi) <= nbo) ) THEN
+    ma_fuonly_r11 = 0
+    y(1:nbo) = miss_val
+    DO i=1,nbi
+      IF (ind(i) > 0) THEN
+        y(ind(i)) =  x(ind(i))
+      ENDIF
+    ENDDO
+  ELSE
+    ma_fuonly_r11 = 1
+  ENDIF
+!-------------------------
+END FUNCTION ma_fuonly_r11
+!===
+!===
+SUBROUTINE mathop_r21 &
+ &  (fun,nb,work_in,miss_val,nb_index,nindex,scal,nb_max,work_out)
+!---------------------------------------------------------------------
+!- This subroutines gives an interface to the various operations
+!- which are allowed. The interface is general enough to allow its use
+!- for other cases.
+!-
+!- INPUT
+!-
+!- fun      : function to be applied to the vector of data
+!- nb       : Length of input vector
+!- work_in  : Input vector of data (REAL)
+!- miss_val : The value of the missing data flag (it has to be a
+!-            maximum value, in f90 : huge( a real ))
+!- nb_index : Length of index vector
+!- nindex   : Vector of indices
+!- scal     : A scalar value for vector/scalar operations
+!- nb_max   : maximum length of output vector
+!-
+!- OUTPUT
+!-
+!- nb_max   : Actual length of output variable
+!- work_out : Output vector after the operation was applied
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=7) :: fun
+  INTEGER :: nb(2),nb_max,nb_index
+  INTEGER :: nindex(nb_index)
+  REAL :: work_in(nb(1),nb(2)),scal,miss_val
+  REAL :: work_out(nb_max)
+!-
+  INTEGER :: ierr
+!-
+  INTRINSIC SIN,COS,TAN,ASIN,ACOS,ATAN,EXP,LOG,SQRT,ABS
+!---------------------------------------------------------------------
+  ierr = 0
+!-
+  IF (scal >= miss_val-1.) THEN
+    IF (INDEX(indexfu,fun(1:LEN_TRIM(fun))) == 0) THEN
+      SELECT CASE (fun)
+      CASE('sin')
+        ierr = ma_sin_r21(nb,work_in,nb_max,work_out)
+      CASE('cos')
+        ierr = ma_cos_r21(nb,work_in,nb_max,work_out)
+      CASE('tan')
+        ierr = ma_tan_r21(nb,work_in,nb_max,work_out)
+      CASE('asin')
+        ierr = ma_asin_r21(nb,work_in,nb_max,work_out)
+      CASE('acos')
+        ierr = ma_acos_r21(nb,work_in,nb_max,work_out)
+      CASE('atan')
+        ierr = ma_atan_r21(nb,work_in,nb_max,work_out)
+      CASE('exp')
+        ierr = ma_exp_r21(nb,work_in,nb_max,work_out)
+      CASE('log')
+        ierr = ma_log_r21(nb,work_in,nb_max,work_out)
+      CASE('sqrt')
+        ierr = ma_sqrt_r21(nb,work_in,nb_max,work_out)
+      CASE('chs')
+        ierr = ma_chs_r21(nb,work_in,nb_max,work_out)
+      CASE('abs')
+        ierr = ma_abs_r21(nb,work_in,nb_max,work_out)
+      CASE('cels')
+        ierr = ma_cels_r21(nb,work_in,nb_max,work_out)
+      CASE('kelv')
+        ierr = ma_kelv_r21(nb,work_in,nb_max,work_out)
+      CASE('deg')
+        ierr = ma_deg_r21(nb,work_in,nb_max,work_out)
+      CASE('rad')
+        ierr = ma_rad_r21(nb,work_in,nb_max,work_out)
+      CASE('ident')
+        ierr = ma_ident_r21(nb,work_in,nb_max,work_out)
+      CASE DEFAULT
+        CALL ipslerr(3,"mathop", &
+ &        'scalar variable undefined and no indexing', &
+ &        'but still unknown function',fun)
+      END SELECT
+      IF (ierr > 0) THEN
+        CALL ipslerr(3,"mathop", &
+ &        'Error while executing a simple function',fun,' ')
+      ENDIF
+    ELSE
+      SELECT CASE (fun)
+      CASE('gather')
+        ierr = ma_fugath_r21(nb,work_in,nb_index,nindex, &
+ &                            miss_val,nb_max,work_out)
+      CASE('scatter')
+        IF (nb_index > (nb(1)*nb(2)) ) THEN
+          work_out(1:nb_max) = miss_val
+          ierr=1
+        ELSE
+          ierr = ma_fuscat_r21(nb,work_in,nb_index,nindex, &
+ &                             miss_val,nb_max,work_out)
+        ENDIF
+      CASE('coll')
+        ierr = ma_fucoll_r21(nb,work_in,nb_index,nindex, &
+ &                           miss_val,nb_max,work_out)
+      CASE('fill')
+        ierr = ma_fufill_r21(nb,work_in,nb_index,nindex, &
+ &                           miss_val,nb_max,work_out)
+      CASE('undef')
+        ierr = ma_fuundef_r21(nb,work_in,nb_index,nindex, &
+ &                           miss_val,nb_max,work_out)
+      CASE('only')
+        ierr = ma_fuonly_r21(nb,work_in,nb_index,nindex, &
+ &                           miss_val,nb_max,work_out)
+      CASE DEFAULT
+        CALL ipslerr(3,"mathop", &
+ &        'scalar variable undefined and indexing', &
+ &        'was requested but with unknown function',fun)
+      END SELECT
+      IF (ierr > 0) THEN
+        CALL ipslerr(3,"mathop_r21", &
+ &        'Error while executing an indexing function',fun,' ')
+      ENDIF
+    ENDIF
+  ELSE
+    SELECT CASE (fun)
+    CASE('fumin')
+      ierr = ma_fumin_r21(nb,work_in,scal,nb_max,work_out)
+    CASE('fumax')
+      ierr = ma_fumax_r21(nb,work_in,scal,nb_max,work_out)
+    CASE('add')
+      ierr = ma_add_r21(nb,work_in,scal,nb_max,work_out)
+    CASE('subi')
+      ierr = ma_subi_r21(nb,work_in,scal,nb_max,work_out)
+    CASE('sub')
+      ierr = ma_sub_r21(nb,work_in,scal,nb_max,work_out)
+    CASE('mult')
+      ierr = ma_mult_r21(nb,work_in,scal,nb_max,work_out)
+    CASE('div')
+      ierr = ma_div_r21(nb,work_in,scal,nb_max,work_out)
+    CASE('divi')
+      ierr = ma_divi_r21(nb,work_in,scal,nb_max,work_out)
+    CASE('power')
+      ierr = ma_power_r21(nb,work_in,scal,nb_max,work_out)
+    CASE DEFAULT
+      CALL ipslerr(3,"mathop", &
+ &      'Unknown operation with a scalar',fun,' ')
+    END SELECT
+    IF (ierr > 0) THEN
+      CALL ipslerr(3,"mathop", &
+ &      'Error while executing a scalar function',fun,' ')
+    ENDIF
+  ENDIF
+!------------------------
+END SUBROUTINE mathop_r21
+!-
+!=== FUNCTIONS (only one argument)
+!-
+INTEGER FUNCTION ma_sin_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = SIN(x(i,j))
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_sin_r21 = 0
+!----------------------
+END FUNCTION ma_sin_r21
+!===
+INTEGER FUNCTION ma_cos_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = COS(x(i,j))
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_cos_r21 = 0
+!----------------------
+END FUNCTION ma_cos_r21
+!===
+INTEGER FUNCTION ma_tan_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = TAN(x(i,j))
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_tan_r21 = 0
+!----------------------
+END FUNCTION ma_tan_r21
+!===
+  INTEGER FUNCTION ma_asin_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = ASIN(x(i,j))
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_asin_r21 = 0
+!-----------------------
+END FUNCTION ma_asin_r21
+!===
+INTEGER FUNCTION ma_acos_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = ACOS(x(i,j))
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_acos_r21 = 0
+!-----------------------
+END FUNCTION ma_acos_r21
+!===
+INTEGER FUNCTION ma_atan_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = ATAN(x(i,j))
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_atan_r21 = 0
+!-----------------------
+END FUNCTION ma_atan_r21
+!===
+INTEGER FUNCTION ma_exp_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = EXP(x(i,j))
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_exp_r21 = 0
+!----------------------
+END FUNCTION ma_exp_r21
+!===
+INTEGER FUNCTION ma_log_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = LOG(x(i,j))
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_log_r21 = 0
+!----------------------
+END FUNCTION ma_log_r21
+!===
+INTEGER FUNCTION ma_sqrt_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = SQRT(x(i,j))
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_sqrt_r21 = 0
+!-----------------------
+END FUNCTION ma_sqrt_r21
+!===
+INTEGER FUNCTION ma_abs_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = ABS(x(i,j))
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_abs_r21 = 0
+!----------------------
+END FUNCTION ma_abs_r21
+!===
+INTEGER FUNCTION ma_chs_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = x(i,j)*(-1.)
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_chs_r21 = 0
+!----------------------
+END FUNCTION ma_chs_r21
+!===
+INTEGER FUNCTION ma_cels_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = x(i,j)-273.15
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_cels_r21 = 0
+!-----------------------
+END FUNCTION ma_cels_r21
+!===
+INTEGER FUNCTION ma_kelv_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = x(i,j)+273.15
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_kelv_r21 = 0
+!-----------------------
+END FUNCTION ma_kelv_r21
+!===
+INTEGER FUNCTION ma_deg_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = x(i,j)*57.29577951
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_deg_r21 = 0
+!----------------------
+END FUNCTION ma_deg_r21
+!===
+INTEGER FUNCTION ma_rad_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = x(i,j)*0.01745329252
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_rad_r21 = 0
+!----------------------
+END FUNCTION ma_rad_r21
+!===
+INTEGER FUNCTION ma_ident_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = x(i,j)
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_ident_r21 = 0
+!------------------------
+END FUNCTION ma_ident_r21
+!-
+!=== OPERATIONS (two argument)
+!-
+INTEGER FUNCTION ma_add_r21(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo
+  REAL :: x(nb(1),nb(2)),s,y(nbo)
+!-
+  INTEGER :: i,j,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = x(i,j)+s
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_add_r21 = 0
+!----------------------
+END FUNCTION ma_add_r21
+!===
+INTEGER FUNCTION ma_sub_r21(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo
+  REAL :: x(nb(1),nb(2)),s,y(nbo)
+!-
+  INTEGER :: i,j,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = x(i,j)-s
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_sub_r21 = 0
+!----------------------
+END FUNCTION ma_sub_r21
+!===
+INTEGER FUNCTION ma_subi_r21(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo
+  REAL :: x(nb(1),nb(2)),s,y(nbo)
+!-
+  INTEGER :: i,j,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) =  s-x(i,j)
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_subi_r21 = 0
+!-----------------------
+END FUNCTION ma_subi_r21
+!===
+INTEGER FUNCTION ma_mult_r21(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo
+  REAL :: x(nb(1),nb(2)),s,y(nbo)
+!-
+  INTEGER :: i,j,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = x(i,j)*s
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_mult_r21 = 0
+!-----------------------
+END FUNCTION ma_mult_r21
+!===
+INTEGER FUNCTION ma_div_r21(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo
+  REAL :: x(nb(1),nb(2)),s,y(nbo)
+!-
+  INTEGER :: i,j,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = x(i,j)/s
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_div_r21 = 0
+!----------------------
+END FUNCTION ma_div_r21
+!===
+INTEGER FUNCTION ma_divi_r21(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo
+  REAL :: x(nb(1),nb(2)),s,y(nbo)
+!-
+  INTEGER :: i,j,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = s/x(i,j)
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_divi_r21 = 0
+!-----------------------
+END FUNCTION ma_divi_r21
+!===
+INTEGER FUNCTION ma_power_r21(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo
+  REAL :: x(nb(1),nb(2)),s,y(nbo)
+!-
+  INTEGER :: i,j,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = x(i,j) ** s
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_power_r21 = 0
+!------------------------
+END FUNCTION ma_power_r21
+!===
+INTEGER FUNCTION ma_fumin_r21(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo
+  REAL :: x(nb(1),nb(2)),s,y(nbo)
+!-
+  INTEGER :: i,j,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = MIN(x(i,j),s)
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_fumin_r21 = 0
+!------------------------
+END FUNCTION ma_fumin_r21
+!===
+INTEGER FUNCTION ma_fumax_r21(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo
+  REAL :: x(nb(1),nb(2)),s,y(nbo)
+!-
+  INTEGER :: i,j,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = MAX(x(i,j),s)
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_fumax_r21 = 0
+!------------------------
+END FUNCTION ma_fumax_r21
+!===
+INTEGER FUNCTION ma_fuscat_r21(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb(1),nb(2)),miss_val,y(nbo)
+!-
+  INTEGER :: i,j,ij,ii,ipos
+!---------------------------------------------------------------------
+  ma_fuscat_r21 = 0
+!-
+  y(1:nbo) = miss_val
+!-
+  IF (nbi <= nb(1)*nb(2)) THEN
+    ipos = 0
+    DO ij=1,nbi
+       IF (ind(ij) <= nbo .AND. ind(ij) > 0) THEN
+         ipos = ipos+1
+         j = ((ipos-1)/nb(1))+1
+         i = (ipos-(j-1)*nb(1))
+         y(ind(ij)) = x(i,j)
+       ELSE
+         IF (ind(ij) > nbo) ma_fuscat_r21  = ma_fuscat_r21+1
+       ENDIF
+    ENDDO
+!-- Repeat the data if needed
+    IF (MINVAL(ind) < 0) THEN
+      DO i=1,nbi
+        IF (ind(i) <= 0) THEN
+          DO ii=1,ABS(ind(i))-1
+            IF (ind(i+1)+ii <= nbo) THEN
+              y(ind(i+1)+ii) = y(ind(i+1))
+            ELSE
+              ma_fuscat_r21  = ma_fuscat_r21+1
+            ENDIF
+          ENDDO
+        ENDIF
+      ENDDO
+    ENDIF
+  ELSE
+    ma_fuscat_r21  = 1
+  ENDIF
+!-------------------------
+END FUNCTION ma_fuscat_r21
+!===
+INTEGER FUNCTION ma_fugath_r21(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb(1),nb(2)),miss_val,y(nbo)
+!-
+  INTEGER :: i,j,ij,ipos
+!---------------------------------------------------------------------
+  IF (nbi <= nbo) THEN
+    ma_fugath_r21 = 0
+    y(1:nbo) = miss_val
+    ipos = 0
+    DO ij=1,nbi
+      IF (ipos+1 <= nbo) THEN
+        IF (ind(ij) > 0) THEN
+          j = ((ind(ij)-1)/nb(1))+1
+          i = (ind(ij)-(j-1)*nb(1))
+          ipos = ipos+1
+          y(ipos) = x(i,j)
+        ENDIF
+      ELSE
+        IF (ipos+1 > nbo) ma_fugath_r21  = ma_fugath_r21+1
+      ENDIF
+    ENDDO
+  ELSE
+    ma_fugath_r21 = 1
+  ENDIF
+  nbo = ipos
+!-------------------------
+END FUNCTION ma_fugath_r21
+!===
+INTEGER FUNCTION ma_fufill_r21(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb(1),nb(2)),miss_val,y(nbo)
+!-
+  INTEGER :: i,j,ij,ii,ipos
+!---------------------------------------------------------------------
+  ma_fufill_r21 = 0
+!-
+  IF (nbi <= nb(1)*nb(2)) THEN
+    ipos = 0
+    DO ij=1,nbi
+      IF (ind(ij) <= nbo .AND. ind(ij) > 0) THEN
+        ipos = ipos+1
+        j = ((ipos-1)/nb(1))+1
+        i = (ipos-(j-1)*nb(1))
+        y(ind(ij)) = x(i,j)
+      ELSE
+        IF (ind(ij) > nbo) ma_fufill_r21  = ma_fufill_r21+1
+      ENDIF
+    ENDDO
+!-- Repeat the data if needed
+    IF (MINVAL(ind) < 0) THEN
+      DO i=1,nbi
+        IF (ind(i) <= 0) THEN
+          DO ii=1,ABS(ind(i))-1
+            IF (ind(i+1)+ii <= nbo) THEN
+              y(ind(i+1)+ii) = y(ind(i+1))
+            ELSE
+              ma_fufill_r21  = ma_fufill_r21+1
+            ENDIF
+          ENDDO
+        ENDIF
+      ENDDO
+    ENDIF
+  ELSE
+    ma_fufill_r21  = 1
+  ENDIF
+!-------------------------
+END FUNCTION ma_fufill_r21
+!===
+INTEGER FUNCTION ma_fucoll_r21(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb(1),nb(2)),miss_val,y(nbo)
+!-
+  INTEGER :: i,j,ij,ipos
+!---------------------------------------------------------------------
+  IF (nbi <= nbo) THEN
+    ma_fucoll_r21 = 0
+    ipos = 0
+    DO ij=1,nbi
+      IF (ipos+1 <= nbo) THEN
+        IF (ind(ij) > 0) THEN
+          j = ((ind(ij)-1)/nb(1))+1
+          i = (ind(ij)-(j-1)*nb(1))
+          ipos = ipos+1
+          y(ipos) = x(i,j)
+        ENDIF
+      ELSE
+        IF (ipos+1 > nbo) ma_fucoll_r21  = ma_fucoll_r21+1
+      ENDIF
+    ENDDO
+  ELSE
+    ma_fucoll_r21 = 1
+  ENDIF
+  nbo = ipos
+!-------------------------
+END FUNCTION ma_fucoll_r21
+!===
+INTEGER FUNCTION ma_fuundef_r21(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb(1),nb(2)),miss_val,y(nbo)
+!-
+  INTEGER :: i,j,ij
+!---------------------------------------------------------------------
+  IF (nbi <= nbo .AND. nbo == nb(1)*nb(2)) THEN
+    ma_fuundef_r21 = 0
+    DO ij=1,nbo
+      j = ((ij-1)/nb(1))+1
+      i = (ij-(j-1)*nb(1))
+      y(ij) = x(i,j)
+    ENDDO
+    DO i=1,nbi
+      IF (ind(i) <= nbo .AND. ind(i) > 0) THEN
+        y(ind(i)) =  miss_val
+      ELSE
+        IF (ind(i) > nbo) ma_fuundef_r21 = ma_fuundef_r21+1
+      ENDIF
+    ENDDO
+  ELSE
+    ma_fuundef_r21 = 1
+  ENDIF
+!--------------------------
+END FUNCTION ma_fuundef_r21
+!===
+INTEGER FUNCTION ma_fuonly_r21(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb(1),nb(2)),miss_val,y(nbo)
+!-
+  INTEGER :: i,j,ij
+!---------------------------------------------------------------------
+  IF (     (nbi <= nbo).AND.(nbo == nb(1)*nb(2)) &
+ &    .AND.ALL(ind(1:nbi) <= nbo) ) THEN
+    ma_fuonly_r21 = 0
+    y(1:nbo) = miss_val
+    DO ij=1,nbi
+      IF (ind(ij) > 0) THEN
+        j = ((ind(ij)-1)/nb(1))+1
+        i = (ind(ij)-(j-1)*nb(1))
+        y(ind(ij)) =  x(i,j)
+      ENDIF
+    ENDDO
+  ELSE
+    ma_fuonly_r21 = 1
+  ENDIF
+!-------------------------
+END FUNCTION ma_fuonly_r21
+!===
+!===
+SUBROUTINE mathop_r31 &
+ &  (fun,nb,work_in,miss_val,nb_index,nindex,scal,nb_max,work_out)
+!---------------------------------------------------------------------
+!- This subroutines gives an interface to the various operations
+!- which are allowed. The interface is general enough to allow its use
+!- for other cases.
+!-
+!- INPUT
+!-
+!- fun      : function to be applied to the vector of data
+!- nb       : Length of input vector
+!- work_in  : Input vector of data (REAL)
+!- miss_val : The value of the missing data flag (it has to be a
+!-            maximum value, in f90 : huge( a real ))
+!- nb_index : Length of index vector
+!- nindex   : Vector of indices
+!- scal     : A scalar value for vector/scalar operations
+!- nb_max   : maximum length of output vector
+!-
+!- OUTPUT
+!-
+!- nb_max   : Actual length of output variable
+!- work_out : Output vector after the operation was applied
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=7) :: fun
+  INTEGER :: nb(3),nb_max,nb_index
+  INTEGER :: nindex(nb_index)
+  REAL :: work_in(nb(1),nb(2),nb(3)),scal,miss_val
+  REAL :: work_out(nb_max)
+!-
+  INTEGER :: ierr
+!-
+  INTRINSIC SIN,COS,TAN,ASIN,ACOS,ATAN,EXP,LOG,SQRT,ABS
+!---------------------------------------------------------------------
+  ierr = 0
+!-
+  IF (scal >= miss_val-1.) THEN
+    IF (INDEX(indexfu,fun(1:LEN_TRIM(fun))) == 0) THEN
+      SELECT CASE (fun)
+      CASE('sin')
+        ierr = ma_sin_r31(nb,work_in,nb_max,work_out)
+      CASE('cos')
+        ierr = ma_cos_r31(nb,work_in,nb_max,work_out)
+      CASE('tan')
+        ierr = ma_tan_r31(nb,work_in,nb_max,work_out)
+      CASE('asin')
+        ierr = ma_asin_r31(nb,work_in,nb_max,work_out)
+      CASE('acos')
+        ierr = ma_acos_r31(nb,work_in,nb_max,work_out)
+      CASE('atan')
+        ierr = ma_atan_r31(nb,work_in,nb_max,work_out)
+      CASE('exp')
+        ierr = ma_exp_r31(nb,work_in,nb_max,work_out)
+      CASE('log')
+        ierr = ma_log_r31(nb,work_in,nb_max,work_out)
+      CASE('sqrt')
+        ierr = ma_sqrt_r31(nb,work_in,nb_max,work_out)
+      CASE('chs')
+        ierr = ma_chs_r31(nb,work_in,nb_max,work_out)
+      CASE('abs')
+        ierr = ma_abs_r31(nb,work_in,nb_max,work_out)
+      CASE('cels')
+        ierr = ma_cels_r31(nb,work_in,nb_max,work_out)
+      CASE('kelv')
+        ierr = ma_kelv_r31(nb,work_in,nb_max,work_out)
+      CASE('deg')
+        ierr = ma_deg_r31(nb,work_in,nb_max,work_out)
+      CASE('rad')
+        ierr = ma_rad_r31(nb,work_in,nb_max,work_out)
+      CASE('ident')
+        ierr = ma_ident_r31(nb,work_in,nb_max,work_out)
+      CASE DEFAULT
+        CALL ipslerr(3,"mathop", &
+ &        'scalar variable undefined and no indexing', &
+ &        'but still unknown function',fun)
+      END SELECT
+      IF (ierr > 0) THEN
+         CALL ipslerr(3,"mathop", &
+ &        'Error while executing a simple function',fun,' ')
+      ENDIF
+    ELSE
+      SELECT CASE (fun)
+      CASE('gather')
+        ierr = ma_fugath_r31(nb,work_in,nb_index,nindex, &
+ &                           miss_val,nb_max,work_out)
+      CASE('scatter')
+        IF (nb_index > (nb(1)*nb(2)*nb(3))) THEN
+          work_out(1:nb_max) = miss_val
+          ierr=1
+        ELSE
+          ierr = ma_fuscat_r31(nb,work_in,nb_index,nindex, &
+ &                             miss_val,nb_max,work_out)
+        ENDIF
+      CASE('coll')
+        ierr = ma_fucoll_r31(nb,work_in,nb_index,nindex, &
+ &                           miss_val,nb_max,work_out)
+      CASE('fill')
+        ierr = ma_fufill_r31(nb,work_in,nb_index,nindex, &
+ &                           miss_val,nb_max,work_out)
+      CASE('undef')
+        ierr = ma_fuundef_r31(nb,work_in,nb_index,nindex, &
+ &                           miss_val,nb_max,work_out)
+      CASE('only')
+        ierr = ma_fuonly_r31(nb,work_in,nb_index,nindex, &
+ &                           miss_val,nb_max,work_out)
+      CASE DEFAULT
+        CALL ipslerr(3,"mathop", &
+ &        'scalar variable undefined and indexing', &
+ &        'was requested but with unknown function',fun)
+      END SELECT
+      IF (ierr > 0) THEN
+        CALL ipslerr(3,"mathop_r31", &
+ &        'Error while executing an indexing function',fun,' ')
+      ENDIF
+    ENDIF
+  ELSE
+    SELECT CASE (fun)
+    CASE('fumin')
+      ierr = ma_fumin_r31(nb,work_in,scal,nb_max,work_out)
+    CASE('fumax')
+      ierr = ma_fumax_r31(nb,work_in,scal,nb_max,work_out)
+    CASE('add')
+      ierr = ma_add_r31(nb,work_in,scal,nb_max,work_out)
+    CASE('subi')
+      ierr = ma_subi_r31(nb,work_in,scal,nb_max,work_out)
+    CASE('sub')
+      ierr = ma_sub_r31(nb,work_in,scal,nb_max,work_out)
+    CASE('mult')
+      ierr = ma_mult_r31(nb,work_in,scal,nb_max,work_out)
+    CASE('div')
+      ierr = ma_div_r31(nb,work_in,scal,nb_max,work_out)
+    CASE('divi')
+      ierr = ma_divi_r31(nb,work_in,scal,nb_max,work_out)
+    CASE('power')
+      ierr = ma_power_r31(nb,work_in,scal,nb_max,work_out)
+    CASE DEFAULT
+      CALL ipslerr(3,"mathop", &
+ &      'Unknown operation with a scalar',fun,' ')
+    END SELECT
+    IF (ierr > 0) THEN
+      CALL ipslerr(3,"mathop", &
+ &      'Error while executing a scalar function',fun,' ')
+    ENDIF
+  ENDIF
+!------------------------
+END SUBROUTINE mathop_r31
+!-
+!=== FUNCTIONS (only one argument)
+!-
+INTEGER FUNCTION ma_sin_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = SIN(x(i,j,k))
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_sin_r31 = 0
+!----------------------
+END FUNCTION ma_sin_r31
+!===
+INTEGER FUNCTION ma_cos_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = COS(x(i,j,k))
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_cos_r31 = 0
+!----------------------
+END FUNCTION ma_cos_r31
+!===
+INTEGER FUNCTION ma_tan_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = TAN(x(i,j,k))
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_tan_r31 = 0
+!----------------------
+END FUNCTION ma_tan_r31
+!===
+INTEGER FUNCTION ma_asin_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = ASIN(x(i,j,k))
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_asin_r31 = 0
+!-----------------------
+END FUNCTION ma_asin_r31
+!===
+INTEGER FUNCTION ma_acos_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = ACOS(x(i,j,k))
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_acos_r31 = 0
+!-----------------------
+END FUNCTION ma_acos_r31
+!===
+INTEGER FUNCTION ma_atan_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = ATAN(x(i,j,k))
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_atan_r31 = 0
+!-----------------------
+  END FUNCTION ma_atan_r31
+!===
+INTEGER FUNCTION ma_exp_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = EXP(x(i,j,k))
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_exp_r31 = 0
+!----------------------
+END FUNCTION ma_exp_r31
+!===
+INTEGER FUNCTION ma_log_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = LOG(x(i,j,k))
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_log_r31 = 0
+!----------------------
+END FUNCTION ma_log_r31
+!===
+INTEGER FUNCTION ma_sqrt_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = SQRT(x(i,j,k))
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_sqrt_r31 = 0
+!-----------------------
+END FUNCTION ma_sqrt_r31
+!===
+INTEGER FUNCTION ma_abs_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = ABS(x(i,j,k))
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_abs_r31 = 0
+!----------------------
+END FUNCTION ma_abs_r31
+!===
+INTEGER FUNCTION ma_chs_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = x(i,j,k)*(-1.)
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_chs_r31 = 0
+!----------------------
+END FUNCTION ma_chs_r31
+!===
+INTEGER FUNCTION ma_cels_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = x(i,j,k)-273.15
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_cels_r31 = 0
+!-----------------------
+END FUNCTION ma_cels_r31
+!===
+INTEGER FUNCTION ma_kelv_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = x(i,j,k)+273.15
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_kelv_r31 = 0
+!-----------------------
+  END FUNCTION ma_kelv_r31
+!===
+INTEGER FUNCTION ma_deg_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = x(i,j,k)*57.29577951
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_deg_r31 = 0
+!----------------------
+END FUNCTION ma_deg_r31
+!===
+INTEGER FUNCTION ma_rad_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = x(i,j,k)*0.01745329252
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_rad_r31 = 0
+!----------------------
+END FUNCTION ma_rad_r31
+!===
+INTEGER FUNCTION ma_ident_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = x(i,j,k)
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_ident_r31 = 0
+!------------------------
+END FUNCTION ma_ident_r31
+!-
+!=== OPERATIONS (two argument)
+!-
+INTEGER FUNCTION ma_add_r31(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo
+  REAL :: x(nb(1),nb(2),nb(3)),s,y(nbo)
+!-
+  INTEGER :: i,j,k,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = x(i,j,k)+s
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_add_r31 = 0
+!----------------------
+END FUNCTION ma_add_r31
+!===
+INTEGER FUNCTION ma_sub_r31(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo
+  REAL :: x(nb(1),nb(2),nb(3)),s,y(nbo)
+!-
+  INTEGER :: i,j,k,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = x(i,j,k)-s
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_sub_r31 = 0
+!----------------------
+END FUNCTION ma_sub_r31
+!===
+INTEGER FUNCTION ma_subi_r31(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo
+  REAL :: x(nb(1),nb(2),nb(3)),s,y(nbo)
+!-
+  INTEGER :: i,j,k,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) =  s-x(i,j,k)
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_subi_r31 = 0
+!-----------------------
+END FUNCTION ma_subi_r31
+!===
+INTEGER FUNCTION ma_mult_r31(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo
+  REAL :: x(nb(1),nb(2),nb(3)),s,y(nbo)
+!-
+  INTEGER :: i,j,k,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = x(i,j,k)*s
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_mult_r31 = 0
+!-----------------------
+END FUNCTION ma_mult_r31
+!===
+INTEGER FUNCTION ma_div_r31(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo
+  REAL :: x(nb(1),nb(2),nb(3)),s,y(nbo)
+!-
+  INTEGER :: i,j,k,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = x(i,j,k)/s
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_div_r31 = 0
+!----------------------
+END FUNCTION ma_div_r31
+!===
+INTEGER FUNCTION ma_divi_r31(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo
+  REAL :: x(nb(1),nb(2),nb(3)),s,y(nbo)
+!-
+  INTEGER :: i,j,k,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = s/x(i,j,k)
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_divi_r31 = 0
+!-----------------------
+END FUNCTION ma_divi_r31
+!===
+INTEGER FUNCTION ma_power_r31(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo
+  REAL :: x(nb(1),nb(2),nb(3)),s,y(nbo)
+!-
+  INTEGER :: i,j,k,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = x(i,j,k)**s
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_power_r31 = 0
+!------------------------
+END FUNCTION ma_power_r31
+!===
+INTEGER FUNCTION ma_fumin_r31(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo
+  REAL :: x(nb(1),nb(2),nb(3)),s,y(nbo)
+!-
+  INTEGER :: i,j,k,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = MIN(x(i,j,k),s)
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_fumin_r31 = 0
+!------------------------
+END FUNCTION ma_fumin_r31
+!===
+INTEGER FUNCTION ma_fumax_r31(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo
+  REAL :: x(nb(1),nb(2),nb(3)),s,y(nbo)
+!-
+  INTEGER :: i,j,k,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = MAX(x(i,j,k),s)
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_fumax_r31 = 0
+!------------------------
+END FUNCTION ma_fumax_r31
+!===
+INTEGER FUNCTION ma_fuscat_r31(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb(1),nb(2),nb(3)),miss_val,y(nbo)
+!-
+  INTEGER :: i,j,k,ij,ii,ipos,ipp,isb
+!---------------------------------------------------------------------
+  ma_fuscat_r31 = 0
+!-
+  y(1:nbo) = miss_val
+!-
+  IF (nbi <= nb(1)*nb(2)*nb(3)) THEN
+    ipos = 0
+    isb = nb(1)*nb(2)
+    DO ij=1,nbi
+      IF (ind(ij) <= nbo .AND. ind(ij) > 0) THEN
+        ipos = ipos+1
+        k = ((ipos-1)/isb)+1
+        ipp = ipos-(k-1)*isb
+        j = ((ipp-1)/nb(1))+1
+        i = (ipp-(j-1)*nb(1))
+        y(ind(ij)) = x(i,j,k)
+      ELSE
+        IF (ind(ij) > nbo) ma_fuscat_r31  = ma_fuscat_r31+1
+      ENDIF
+    ENDDO
+!-- Repeat the data if needed
+    IF (MINVAL(ind) < 0) THEN
+      DO i=1,nbi
+        IF (ind(i) <= 0) THEN
+          DO ii=1,ABS(ind(i))-1
+            IF (ind(i+1)+ii <= nbo) THEN
+              y(ind(i+1)+ii) = y(ind(i+1))
+            ELSE
+              ma_fuscat_r31  = ma_fuscat_r31+1
+            ENDIF
+          ENDDO
+        ENDIF
+      ENDDO
+    ENDIF
+  ELSE
+    ma_fuscat_r31  = 1
+  ENDIF
+!-------------------------
+END FUNCTION ma_fuscat_r31
+!===
+INTEGER FUNCTION ma_fugath_r31(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb(1),nb(2),nb(3)),miss_val,y(nbo)
+!-
+  INTEGER :: i,j,k,ij,ipos,ipp,isb
+!---------------------------------------------------------------------
+  IF (nbi <= nbo) THEN
+    ma_fugath_r31 = 0
+    y(1:nbo) = miss_val
+    ipos = 0
+    isb = nb(1)*nb(2)
+    DO ij=1,nbi
+      IF (ipos+1 <= nbo) THEN
+        IF (ind(ij) > 0) THEN
+          k = ((ind(ij)-1)/isb)+1
+          ipp = ind(ij)-(k-1)*isb
+          j = ((ipp-1)/nb(1))+1
+          i = (ipp-(j-1)*nb(1))
+          ipos = ipos+1
+          y(ipos) = x(i,j,k)
+        ENDIF
+      ELSE
+        IF (ipos+1 > nbo) ma_fugath_r31  = ma_fugath_r31+1
+      ENDIF
+    ENDDO
+  ELSE
+    ma_fugath_r31 = 1
+  ENDIF
+  nbo = ipos
+!-------------------------
+END FUNCTION ma_fugath_r31
+!===
+INTEGER FUNCTION ma_fufill_r31(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb(1),nb(2),nb(3)),miss_val,y(nbo)
+!-
+  INTEGER :: i,j,k,ij,ii,ipos,ipp,isb
+!---------------------------------------------------------------------
+  ma_fufill_r31 = 0
+  IF (nbi <= nb(1)*nb(2)*nb(3)) THEN
+    ipos = 0
+    isb = nb(1)*nb(2)
+    DO ij=1,nbi
+      IF (ind(ij) <= nbo .AND. ind(ij) > 0) THEN
+        ipos = ipos+1
+        k = ((ipos-1)/isb)+1
+        ipp = ipos-(k-1)*isb
+        j = ((ipp-1)/nb(1))+1
+        i = (ipp-(j-1)*nb(1))
+        y(ind(ij)) = x(i,j,k)
+      ELSE
+        IF (ind(ij) > nbo) ma_fufill_r31  = ma_fufill_r31+1
+      ENDIF
+    ENDDO
+!-- Repeat the data if needed
+    IF (MINVAL(ind) < 0) THEN
+      DO i=1,nbi
+        IF (ind(i) <= 0) THEN
+          DO ii=1,ABS(ind(i))-1
+            IF (ind(i+1)+ii <= nbo) THEN
+              y(ind(i+1)+ii) = y(ind(i+1))
+            ELSE
+              ma_fufill_r31  = ma_fufill_r31+1
+            ENDIF
+          ENDDO
+        ENDIF
+      ENDDO
+    ENDIF
+  ELSE
+    ma_fufill_r31  = 1
+  ENDIF
+!-------------------------
+END FUNCTION ma_fufill_r31
+!===
+INTEGER FUNCTION ma_fucoll_r31(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb(1),nb(2),nb(3)),miss_val,y(nbo)
+!-
+  INTEGER :: i,j,k,ij,ipos,ipp,isb
+!---------------------------------------------------------------------
+  IF (nbi <= nbo) THEN
+    ma_fucoll_r31 = 0
+    ipos = 0
+    isb = nb(1)*nb(2)
+    DO ij=1,nbi
+      IF (ipos+1 <= nbo) THEN
+        IF (ind(ij) > 0) THEN
+          k = ((ind(ij)-1)/isb)+1
+          ipp = ind(ij)-(k-1)*isb
+          j = ((ipp-1)/nb(1))+1
+          i = (ipp-(j-1)*nb(1))
+          ipos = ipos+1
+          y(ipos) = x(i,j,k)
+        ENDIF
+      ELSE
+        IF (ipos+1 > nbo) ma_fucoll_r31  = ma_fucoll_r31+1
+      ENDIF
+    ENDDO
+  ELSE
+    ma_fucoll_r31 = 1
+  ENDIF
+  nbo = ipos
+!-------------------------
+END FUNCTION ma_fucoll_r31
+!===
+INTEGER FUNCTION ma_fuundef_r31(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb(1),nb(2),nb(3)),miss_val,y(nbo)
+!-
+  INTEGER :: i,j,k,ij,ipp,isb
+!---------------------------------------------------------------------
+  IF (nbi <= nbo .AND. nbo == nb(1)*nb(2)*nb(3)) THEN
+    ma_fuundef_r31 = 0
+    isb = nb(1)*nb(2)
+    DO ij=1,nbo
+      k = ((ij-1)/isb)+1
+      ipp = ij-(k-1)*isb
+      j = ((ipp-1)/nb(1))+1
+      i = (ipp-(j-1)*nb(1))
+      y(ij) = x(i,j,k)
+    ENDDO
+    DO i=1,nbi
+      IF (ind(i) <= nbo .AND. ind(i) > 0) THEN
+        y(ind(i)) =  miss_val
+      ELSE
+        IF (ind(i) > nbo) ma_fuundef_r31  = ma_fuundef_r31+1
+      ENDIF
+    ENDDO
+  ELSE
+    ma_fuundef_r31 = 1
+  ENDIF
+!--------------------------
+END FUNCTION ma_fuundef_r31
+!===
+INTEGER FUNCTION ma_fuonly_r31(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb(1),nb(2),nb(3)),miss_val,y(nbo)
+!-
+  INTEGER :: i,j,k,ij,ipp,isb
+!---------------------------------------------------------------------
+  IF (     (nbi <= nbo).AND.(nbo == nb(1)*nb(2)*nb(3)) &
+ &    .AND.ALL(ind(1:nbi) <= nbo) ) THEN
+    ma_fuonly_r31 = 0
+    y(1:nbo) = miss_val
+    isb = nb(1)*nb(2)
+    DO ij=1,nbi
+      IF (ind(ij) > 0) THEN
+        k = ((ind(ij)-1)/isb)+1
+        ipp = ind(ij)-(k-1)*isb
+        j = ((ipp-1)/nb(1))+1
+        i = (ipp-(j-1)*nb(1))
+        y(ind(ij)) = x(i,j,k)
+      ENDIF
+    ENDDO
+  ELSE
+    ma_fuonly_r31 = 1
+  ENDIF
+!-------------------------
+END FUNCTION ma_fuonly_r31
+!===
+SUBROUTINE moycum (opp,np,px,py,pwx)
+!---------------------------------------------------------------------
+!- Does time operations
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=7) :: opp
+  INTEGER :: np
+  REAL,DIMENSION(:) :: px,py
+  INTEGER :: pwx
+!---------------------------------------------------------------------
+  IF (pwx /= 0) THEN
+    IF      (opp == 'ave') THEN
+      px(1:np)=(px(1:np)*pwx+py(1:np))/REAL(pwx+1)
+    ELSE IF (opp == 't_sum') THEN
+      px(1:np)=px(1:np)+py(1:np)
+    ELSE IF ( (opp == 'l_min').OR.(opp == 't_min') ) THEN
+      px(1:np)=MIN(px(1:np),py(1:np))
+    ELSE IF ( (opp == 'l_max').OR.(opp == 't_max') ) THEN
+      px(1:np)=MAX(px(1:np),py(1:np))
+    ELSE
+      CALL ipslerr(3,"moycum",'Unknown time operation',opp,' ')
+    ENDIF
+  ELSE
+    IF      (opp == 'l_min') THEN
+      px(1:np)=MIN(px(1:np),py(1:np))
+    ELSE IF (opp == 'l_max') THEN
+      px(1:np)=MAX(px(1:np),py(1:np))
+    ELSE
+      px(1:np)=py(1:np)
+    ENDIF
+  ENDIF
+!--------------------
+END SUBROUTINE moycum
+!===
+!-----------------
+END MODULE mathelp
Index: trunk/NEMOGCM/EXTERNAL/IOIPSL/src/nc4interface.F90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/IOIPSL/src/nc4interface.F90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/IOIPSL/src/nc4interface.F90	(revision 2528)
@@ -0,0 +1,124 @@
+MODULE nc4interface
+!-
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+#if ! defined key_netcdf4
+      !!--------------------------------------------------------------------
+      !! NOT 'key_netcdf4' Defines dummy routines for netcdf4
+      !!                   calls when compiling without netcdf4 libraries
+      !!--------------------------------------------------------------------
+  !- netcdf4 chunking control structure
+  !- (optional on histbeg and histend calls)
+!$AGRIF_DO_NOT_TREAT
+  TYPE, PUBLIC :: snc4_ctl
+     SEQUENCE
+     INTEGER :: ni
+     INTEGER :: nj
+     INTEGER :: nk
+     LOGICAL :: luse
+  END TYPE snc4_ctl
+!$AGRIF_END_DO_NOT_TREAT
+
+CONTAINS
+!===
+   SUBROUTINE GET_NF90_SYMBOL(sym_name, ivalue)
+      CHARACTER(len=*),      INTENT(in)  :: sym_name
+      INTEGER,               INTENT(out) :: ivalue
+      ivalue = -999
+   END SUBROUTINE GET_NF90_SYMBOL
+   INTEGER FUNCTION SET_NF90_DEF_VAR_CHUNKING(idum1, idum2, idum3, iarr1)
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE NF90_DEF_VAR_CHUNKING  ***
+      !!
+      !! ** Purpose :   Dummy NetCDF4 routine to enable compiling with NetCDF3 libraries
+      !!--------------------------------------------------------------------
+      INTEGER,               INTENT(in) :: idum1, idum2, idum3
+      INTEGER, DIMENSION(4), INTENT(in) :: iarr1
+      WRITE(*,*) 'Warning: Attempt to chunk output variable without NetCDF4 support'
+      SET_NF90_DEF_VAR_CHUNKING = -1
+   END FUNCTION SET_NF90_DEF_VAR_CHUNKING
+
+   INTEGER FUNCTION SET_NF90_DEF_VAR_DEFLATE(idum1, idum2, idum3, idum4, idum5)
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE NF90_DEF_VAR_DEFLATE  ***
+      !!
+      !! ** Purpose :   Dummy NetCDF4 routine to enable compiling with NetCDF3 libraries
+      !!--------------------------------------------------------------------
+      INTEGER,               INTENT(in) :: idum1, idum2, idum3, idum4, idum5
+      WRITE(*,*) 'Warning: Attempt to compress output variable without NetCDF4 support'
+      SET_NF90_DEF_VAR_DEFLATE = -1
+   END FUNCTION SET_NF90_DEF_VAR_DEFLATE
+#else
+      !!--------------------------------------------------------------------
+      !! 'key_netcdf4' Dummy module (usually defines dummy routines for netcdf4
+      !!               calls when compiling without netcdf4 libraries
+      !!--------------------------------------------------------------------
+
+   USE netcdf
+
+   !- netcdf4 chunking control structure
+   !- (optional on histbeg and histend calls)
+!$AGRIF_DO_NOT_TREAT
+   TYPE, PUBLIC :: snc4_ctl
+      SEQUENCE
+      INTEGER :: ni
+      INTEGER :: nj
+      INTEGER :: nk
+      LOGICAL :: luse
+   END TYPE snc4_ctl
+!$AGRIF_END_DO_NOT_TREAT
+
+CONTAINS
+   INTEGER FUNCTION SET_NF90_DEF_VAR_CHUNKING(nfid, nvid, ichunkalg, ichunksz)
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE NF90_DEF_VAR_CHUNKING  ***
+      !!
+      !! ** Purpose :   Interface NetCDF4 routine to enable compiling with NetCDF4 libraries
+      !!                but no key_netcdf4
+      !!--------------------------------------------------------------------
+      INTEGER,               INTENT(in) :: nfid
+      INTEGER,               INTENT(in) :: nvid
+      INTEGER,               INTENT(in) :: ichunkalg
+      INTEGER, DIMENSION(:), INTENT(in) :: ichunksz
+      !!
+      INTEGER                           :: iret
+      !!
+      iret = NF90_DEF_VAR_CHUNKING(nfid, nvid, ichunkalg, ichunksz)
+      SET_NF90_DEF_VAR_CHUNKING = iret
+   END FUNCTION SET_NF90_DEF_VAR_CHUNKING
+
+   INTEGER FUNCTION SET_NF90_DEF_VAR_DEFLATE(nfid, nvid, ishuffle, ideflate, ideflate_level)
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE NF90_DEF_VAR_DEFLATE  ***
+      !!
+      !! ** Purpose :   Interface NetCDF4 routine to enable compiling with NetCDF4 libraries
+      !!                but no key_netcdf4
+      !!--------------------------------------------------------------------
+      INTEGER,               INTENT(in) :: nfid
+      INTEGER,               INTENT(in) :: nvid
+      INTEGER,               INTENT(in) :: ishuffle
+      INTEGER,               INTENT(in) :: ideflate
+      INTEGER,               INTENT(in) :: ideflate_level
+      !!
+      INTEGER                           :: iret
+      !!
+      iret = NF90_DEF_VAR_DEFLATE(nfid, nvid, ishuffle, ideflate, ideflate_level)
+      SET_NF90_DEF_VAR_DEFLATE = iret
+   END FUNCTION SET_NF90_DEF_VAR_DEFLATE
+
+   SUBROUTINE GET_NF90_SYMBOL(sym_name, ivalue)
+      CHARACTER(len=*),      INTENT(in)  :: sym_name
+      INTEGER,               INTENT(out) :: ivalue
+      SELECT CASE (sym_name)
+         CASE ("NF90_HDF5")
+            ivalue = NF90_HDF5
+         CASE DEFAULT
+            WRITE(*,*) "Warning: unknown case in GET_NF90_SYMBOL"
+      END SELECT
+   END SUBROUTINE GET_NF90_SYMBOL
+#endif
+
+!------------------
+END MODULE nc4interface
Index: trunk/NEMOGCM/EXTERNAL/IOIPSL/src/restcom.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/IOIPSL/src/restcom.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/IOIPSL/src/restcom.f90	(revision 2528)
@@ -0,0 +1,2546 @@
+MODULE restcom
+!-
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!-
+USE netcdf
+!-
+USE errioipsl, ONLY : ipslerr,ipsldbg
+USE stringop
+USE calendar
+USE mathelp
+USE fliocom,   ONLY : flio_dom_file,flio_dom_att
+!-
+IMPLICIT NONE
+!-
+PRIVATE
+!-
+PUBLIC :: &
+ &  restini, restget, restput, restclo, &
+ &  ioconf_setatt, ioget_vname, ioconf_expval, &
+ &  ioget_expval, ioget_vdim
+!-
+INTERFACE restput
+  MODULE PROCEDURE &
+ &  restput_r3d, restput_r2d, restput_r1d, &
+ &  restput_opp_r2d, restput_opp_r1d
+END INTERFACE
+!-
+INTERFACE restget
+  MODULE PROCEDURE &
+ &  restget_r3d,restget_r2d,restget_r1d, &
+ &  restget_opp_r2d,restget_opp_r1d
+END INTERFACE
+!-
+! We do not use allocatable arrays because these sizes are safe
+! and we do not know from start how many variables will be in
+! the out file.
+!-
+  INTEGER,PARAMETER :: &
+ &  max_var=500, max_file=50, max_dim=NF90_MAX_VAR_DIMS
+!-
+  CHARACTER(LEN=9),SAVE :: calend_str='unknown'
+!-
+! The IDs of the netCDF files are going in pairs.
+! The input one (netcdf_id(?,1)) and the output one (netcdf_id(?,2))
+!-
+  INTEGER,SAVE :: nb_fi = 0
+  INTEGER,DIMENSION(max_file,2),SAVE :: netcdf_id = -1
+!-
+! Description of the content of the 'in' files and the 'out' files.
+!   Number of variables   : nbvar_*
+!   Number of dimensions  : nbdim_*
+!   ID of the time axis   : tdimid_*
+!-
+  INTEGER,SAVE :: nbvar_in(max_file), nbvar_out(max_file)
+  INTEGER,SAVE :: tdimid_in(max_file), tdimid_out(max_file)
+!-
+! Variables for one or the other file
+!-
+! Number of dimensions in the input file               : nbdim_in
+! Number of variables read so far from the input file  : nbvar_read
+! Type of variable read from the input file            : vartyp_in
+!   (Could be used later to test if we have a restart file)
+!-
+  INTEGER,SAVE :: nbdim_in(max_file), nbvar_read(max_file)
+  INTEGER,SAVE :: vartyp_in(max_file, max_var)
+!-
+! Time step and time origine in the input file.
+!-
+  REAL,DIMENSION(max_file),SAVE :: deltat,timeorig
+!-
+! Description of the axes in the output file
+!-
+!   tstp_out  : Index on the tie axis currently beeing written
+!   itau_out  : Time step which is written on this index of the file
+!-
+  INTEGER,DIMENSION(max_file),SAVE :: tstp_out,itau_out
+!-
+! Description of the axes in the output file
+!-
+! For the ?ax_infs variable the following order is used :
+!   ?ax_infs (if,in,1) = size of axis
+!   ?ax_infs (if,in,2) = id of dimension
+! Number of x,y and z axes in the output file :
+!   ?ax_nb(if)
+!-
+  INTEGER,DIMENSION(max_file,max_dim,2),SAVE :: &
+ &  xax_infs,yax_infs,zax_infs
+  INTEGER,DIMENSION(max_file),SAVE :: &
+ &  xax_nb=0,yax_nb=0,zax_nb=0
+!-
+! Description of the time axes in the input and output files
+!-
+!   ID of the variable which contains the itaus :
+!     tind_varid_*
+!   ID of the variables which contains the seconds since date :
+!     tax_varid_*
+!   Size of the time axis in the input file :
+!     tax_size_in
+!-
+  INTEGER,SAVE :: tind_varid_in(max_file),  tax_varid_in(max_file), &
+ &                tind_varid_out(max_file), tax_varid_out(max_file)
+  INTEGER,SAVE :: tax_size_in(max_file)=1
+!-
+! The two time axes we have in the input file :
+!   t_index   : dates in itaus
+!               (thus the variable has a tstep_sec attribute)
+!   t_julian  : Julian days of the time axis
+!-
+  INTEGER,SAVE,ALLOCATABLE :: t_index(:,:)
+  REAL,SAVE,ALLOCATABLE :: t_julian(:,:)
+!-
+! Here we save a number of informations on the variables
+! in the files we are handling
+!-
+! Name of variables :                                    varname_*
+! ID of the variables :                                  varid_*
+! Number of dimensions of the variable :                 varnbdim_*
+! Dimensions which are used for the variable :           vardims_*
+! Number of attributes for a variables :                 varatt_*
+! A flag which markes the variables we have worked on :  touched_*
+!-
+  CHARACTER(LEN=20),DIMENSION(max_file,max_var),SAVE :: &
+ &  varname_in,varname_out
+  INTEGER,DIMENSION(max_file,max_var),SAVE :: &
+ &  varid_in,varid_out,varnbdim_in,varatt_in
+  INTEGER,DIMENSION(max_file,max_var,max_dim),SAVE :: &
+ &  vardims_in
+  LOGICAL,DIMENSION(max_file,max_var),SAVE :: &
+ &  touched_in,touched_out
+!-
+  CHARACTER(LEN=120),SAVE :: indchfun= 'scatter, fill, gather, coll'
+  REAL,PARAMETER :: missing_val=1.e20
+!                or HUGE(1.0) (maximum real number)
+!-
+! The default value we will use for variables
+! which are not present in the restart file
+!-
+  REAL,SAVE :: val_exp =  999999.
+  LOGICAL,SAVE :: lock_valexp = .FALSE.
+!-
+! Temporary variables in which we store the attributed which are going
+! to be given to a new variable which is going to be defined.
+!-
+  CHARACTER(LEN=80),SAVE :: rest_units='XXXXX',rest_lname='XXXXX'
+!-
+! For allocations
+!-
+  REAL,ALLOCATABLE,DIMENSION(:),SAVE :: buff_tmp1,buff_tmp2
+!-
+!===
+CONTAINS
+!===
+!-
+SUBROUTINE restini &
+ & (fnamein,iim,jjm,lon,lat,llm,lev, &
+ &  fnameout,itau,date0,dt,fid,owrite_time_in,domain_id)
+!---------------------------------------------------------------------
+!- This subroutine sets up all the restart process.
+!- It will call the subroutine which opens the input
+!- and output files.
+!- The time step (itau), date of origine (date0) and time step are
+!- READ from the input file.
+!- A file ID, which is common to the input and output file is returned
+!-
+!- If fnamein = fnameout then the same file is used for the reading
+!- the restart conditions and writing the new restart.
+!-
+!- A special mode can be switched in with filename='NONE'.
+!- This means that no restart file is present.
+!- Usefull for creating the first restart file
+!- or to get elements in a file without creating an output file.
+!-
+!- A mode needs to be written in which itau, date0 and dt
+!- are given to the restart process and thus
+!- written into the output restart file.
+!-
+!- INPUT
+!-
+!- fnamein  : name of the file for the restart
+!- iim      : Dimension in x
+!- jjm      : Dimension in y
+!- lon      : Longitude in the x,y domain
+!- lat      : Latitude in the x,y domain
+!- llm      : Dimension in the vertical
+!- lev      : Positions of the levels
+!- fnameout :
+!-
+!- OUTPUT
+!-
+!- itau     : Time step of the restart file and at which the model
+!-            should restart
+!- date0    : Time at which itau = 0
+!- dt       : time step in seconds between two succesiv itaus
+!- fid      : File identification of the restart file
+!-
+!- Optional INPUT arguments
+!-
+!- owrite_time_in : logical  argument which allows to
+!-                  overwrite the time in the restart file
+!- domain_id      : Domain identifier
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(IN) :: fnamein,fnameout
+  INTEGER :: iim,jjm,llm,fid,itau
+  REAL :: lon(iim,jjm),lat(iim,jjm),lev(llm)
+  REAL :: date0,dt
+  LOGICAL,OPTIONAL :: owrite_time_in
+  INTEGER,INTENT(IN),OPTIONAL :: domain_id
+!-
+  INTEGER :: ncfid
+  REAL :: dt_tmp,date0_tmp
+  LOGICAL :: l_fi,l_fo,l_rw
+  LOGICAL :: overwrite_time
+  CHARACTER(LEN=120) :: fname
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 0.0 Prepare the configuration before opening any files
+!-
+  IF (.NOT.PRESENT(owrite_time_in)) THEN
+    overwrite_time = .FALSE.
+  ELSE
+    overwrite_time = owrite_time_in
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) 'restini 0.0 : ',TRIM(fnamein),' , ',TRIM(fnameout)
+  ENDIF
+!-
+  nb_fi = nb_fi+1
+!-
+  IF (nb_fi > max_file) THEN
+    CALL ipslerr (3,'restini',&
+ &   'Too many restart files are used. The problem can be',&
+ &   'solved by increasing max_file in restcom.f90 ',&
+ &   'and recompiling ioipsl.')
+  ENDIF
+!-
+! 0.1 Define the open flags
+!-
+  l_fi = (TRIM(fnamein)  /= 'NONE')
+  l_fo = (TRIM(fnameout) /= 'NONE')
+  IF ((.NOT.l_fi).AND.(.NOT.l_fo)) THEN
+    CALL ipslerr (3,'restini',&
+ &   'Input and output file names are both to NONE.',&
+ &   'It is probably an error.','Verify your logic.')
+  ENDIF
+  l_rw = l_fi.AND.l_fo.AND.(TRIM(fnamein) == TRIM(fnameout))
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) 'restini 0.1 l_fi, l_fo, l_rw : ',l_fi,l_fo,l_rw
+  ENDIF
+!-
+! 1.0 Open the input file.
+!-
+  IF (l_fi) THEN
+!---
+    IF (l_dbg) WRITE(*,*) 'restini 1.0 : Open input file'
+!-- Add DOMAIN number and ".nc" suffix in file names if needed
+    fname = fnamein
+    CALL flio_dom_file (fname,domain_id)
+!-- Open the file
+    CALL restopenin (nb_fi,fname,l_rw,iim,jjm,lon,lat,llm,lev,ncfid)
+    netcdf_id(nb_fi,1) = ncfid
+!---
+!-- 1.3 Extract the time information
+!---
+    IF (overwrite_time) THEN
+       date0_tmp = date0
+    ENDIF
+    CALL restsett (dt_tmp,date0_tmp,itau,overwrite_time)
+    IF (.NOT.overwrite_time) THEN
+      dt = dt_tmp
+      date0 = date0_tmp
+    ENDIF
+!---
+  ELSE
+!---
+!-- 2.0 The case of a missing restart file is dealt with
+!---
+    IF (l_dbg) WRITE(*,*) 'restini 2.0'
+!---
+    IF (     (ALL(MINLOC(lon(:iim,:jjm)) == MAXLOC(lon(:iim,:jjm)))) &
+        .AND.(iim > 1) ) THEN
+      CALL ipslerr (3,'restini',&
+        & 'For creating a restart file the longitudes of the',&
+        & 'grid need to be provided to restini. This ',&
+        & 'information is needed for the restart files')
+    ENDIF
+    IF (     (ALL(MINLOC(lat(:iim,:jjm)) == MAXLOC(lat(:iim,:jjm)))) &
+        .AND.(jjm > 1) ) THEN
+      CALL ipslerr (3,'restini',&
+        & 'For creating a restart file the latitudes of the',&
+        & 'grid need to be provided to restini. This ',&
+        & 'information is needed for the restart files')
+    ENDIF
+    IF (     (ALL(MINLOC(lev(:llm)) == MAXLOC(lev(:llm)))) &
+        .AND.(llm > 1) ) THEN
+      CALL ipslerr (3,'restini',&
+        & 'For creating a restart file the levels of the',&
+        & 'grid need to be provided to restini. This',&
+        & 'information is needed for the restart files')
+    ENDIF
+!---
+!-- 2.2 Allocate the time axes and write the inputed variables
+!---
+    tax_size_in(nb_fi) = 1
+    CALL rest_atim (l_dbg,'restini')
+    t_index(nb_fi,1) = itau
+    t_julian(nb_fi,1) = date0
+  ENDIF
+!-
+  IF (l_fo.AND.(.NOT.l_rw)) THEN
+!-- Add DOMAIN number and ".nc" suffix in file names if needed
+    fname = fnameout
+    CALL flio_dom_file (fname,domain_id)
+!-- Open the file
+    CALL restopenout &
+      (nb_fi,fname,iim,jjm,lon,lat,llm,lev,dt,date0,ncfid,domain_id)
+    netcdf_id(nb_fi,2) = ncfid
+  ELSE IF (l_fi.AND.l_fo) THEN
+    netcdf_id(nb_fi,2) = netcdf_id(nb_fi,1)
+    varname_out(nb_fi,:) = varname_in(nb_fi,:)
+    nbvar_out(nb_fi) = nbvar_in(nb_fi)
+    tind_varid_out(nb_fi) = tind_varid_in(nb_fi)
+    tax_varid_out(nb_fi) = tax_varid_in(nb_fi)
+    varid_out(nb_fi,:) = varid_in(nb_fi,:)
+    touched_out(nb_fi,:) = .TRUE.
+  ENDIF
+!-
+! 2.3 Set the calendar for the run.
+!     This should not produce any error message if
+!     This does not mean any change in calendar
+!     (to be modified in ioconf_calendar)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) 'restini 2.3 : Configure calendar if needed : ', &
+                calend_str
+  ENDIF
+!-
+  IF (INDEX(calend_str,'unknown') < 1) THEN
+    CALL ioconf_calendar (calend_str)
+    IF (l_dbg) THEN
+      WRITE(*,*) 'restini 2.3b : new calendar : ',calend_str
+    ENDIF
+  ENDIF
+!-
+! Save some data in the module
+!-
+  deltat(nb_fi) = dt
+!-
+! Prepare the variables which will be returned
+!-
+  fid = nb_fi
+  IF (l_dbg) THEN
+    WRITE(*,*) 'SIZE of t_index :',SIZE(t_index), &
+               SIZE(t_index,dim=1),SIZE(t_index,dim=2)
+    WRITE(*,*) 't_index = ',t_index(fid,:)
+  ENDIF
+  itau = t_index(fid,1)
+!-
+  IF (l_dbg) WRITE(*,*) 'restini END'
+!---------------------
+END SUBROUTINE restini
+!===
+SUBROUTINE restopenin &
+  (fid,fname,l_rw,iim,jjm,lon,lat,llm,lev,ncfid)
+!---------------------------------------------------------------------
+!- Opens the restart file and checks that it belongsd to the model.
+!- This means that the coordinates of the model are compared to the
+!- ones in the file.
+!-
+!- The number and name of variable in the file are exctracted. Also
+!- the time details.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: fid,iim,jjm,llm
+  CHARACTER(LEN=*),INTENT(IN) :: fname
+  REAL :: lon(iim,jjm),lat(iim,jjm),lev(llm)
+  LOGICAL,INTENT(IN) :: l_rw
+  INTEGER,INTENT(OUT) :: ncfid
+!-
+  INTEGER,DIMENSION(max_dim) :: var_dims,dimlen
+  INTEGER :: nb_dim,nb_var,id_unl,id,iv
+  INTEGER :: iread,jread,lread,iret
+  INTEGER :: lon_vid,lat_vid
+  REAL :: lon_read(iim,jjm),lat_read(iim,jjm)
+  REAL :: lev_read(llm)
+  REAL :: mdlon,mdlat
+  CHARACTER(LEN=80) :: units
+  CHARACTER(LEN=NF90_max_name),DIMENSION(max_dim) :: dimname
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! If we reuse the same file for input and output
+! then we open it in write mode
+!-
+  IF (l_rw) THEN; id = NF90_WRITE; ELSE; id = NF90_NOWRITE; ENDIF
+  iret = NF90_OPEN(fname,id,ncfid)
+  IF (iret /= NF90_NOERR) THEN
+    CALL ipslerr (3,'restopenin','Could not open file :',fname,' ')
+  ENDIF
+!-
+  IF (l_dbg) WRITE (*,*) "restopenin 0.0 ",TRIM(fname)
+  iret = NF90_INQUIRE(ncfid,nDimensions=nb_dim, &
+ &         nVariables=nb_var,unlimitedDimId=id_unl)
+  tdimid_in(fid) = id_unl
+!-
+  IF (nb_dim > max_dim) THEN
+    CALL ipslerr (3,'restopenin',&
+      & 'More dimensions present in file that can be store',&
+      & 'Please increase max_dim in the global variables ',&
+      & 'in restcom.F90')
+  ENDIF
+  IF (nb_var > max_var) THEN
+    CALL ipslerr (3,'restopenin',&
+      & 'More variables present in file that can be store',&
+      & 'Please increase max_var in the global variables ',&
+      & 'in restcom.F90')
+  ENDIF
+!-
+  nbvar_in(fid) = nb_var
+  nbdim_in(fid) = nb_dim
+  iread = -1; jread = -1; lread = -1;
+  DO id=1,nb_dim
+    iret = NF90_INQUIRE_DIMENSION(ncfid,id, &
+ &           len=dimlen(id),name=dimname(id))
+    IF (l_dbg) THEN
+      WRITE (*,*) "restopenin 0.0 dimname",id,TRIM(dimname(id))
+    ENDIF
+    IF      (TRIM(dimname(id)) == 'x') THEN
+      iread = dimlen(id)
+      IF (l_dbg) WRITE (*,*) "iread",iread
+    ELSE IF (TRIM(dimname(id)) == 'y') THEN
+      jread = dimlen(id)
+      IF (l_dbg) WRITE (*,*) "jread",jread
+    ELSE IF (TRIM(dimname(id)) == 'z') THEN
+      lread = dimlen(id)
+      IF (l_dbg) WRITE (*,*) "lread",lread
+    ENDIF
+  ENDDO
+!-
+  IF (id_unl > 0) THEN
+!---
+!-- 0.1 If we are going to add values to this file
+!--     we need to know where it ends
+!--     We also need to have all the dimensions in the file
+!---
+    IF (l_rw) THEN
+      tstp_out(fid) = dimlen(id_unl)
+      itau_out(fid) = -1
+      tdimid_out(fid) =  tdimid_in(fid)
+      IF (l_dbg) THEN
+        WRITE (*,*) &
+ &       "restopenin 0.0 unlimited axis dimname", &
+ &       dimname(id_unl),tstp_out(fid)
+      ENDIF
+!-----
+      xax_nb(fid) = 0
+      yax_nb(fid) = 0
+      zax_nb(fid) = 0
+!-----
+      DO id=1,nb_dim
+        IF      (dimname(id)(1:1) == 'x') THEN
+          xax_nb(fid) = xax_nb(fid)+1
+          xax_infs(fid,xax_nb(fid),1) = dimlen(id)
+          xax_infs(fid,xax_nb(fid),2) = id
+        ELSE IF (dimname(id)(1:1) == 'y') THEN
+          yax_nb(fid) = yax_nb(fid)+1
+          yax_infs(fid,yax_nb(fid),1) = dimlen(id)
+          yax_infs(fid,yax_nb(fid),2) = id
+        ELSE IF (dimname(id)(1:1) == 'z') THEN
+          zax_nb(fid) = zax_nb(fid)+1
+          zax_infs(fid,zax_nb(fid),1) = dimlen(id)
+          zax_infs(fid,zax_nb(fid),2) = id
+        ENDIF
+      ENDDO
+    ENDIF
+  ELSE
+!---
+!-- Still need to find a method for dealing with this
+!---
+!  CALL ipslerr (3,'restopenin',&
+!    & ' We do not deal yet with files without time axis.',' ',' ')
+  ENDIF
+!-
+! 1.0 First let us check that we have the righ restart file
+!-
+  IF ((iread /= iim).OR.(jread /= jjm).OR.(lread /= llm)) THEN
+    CALL ipslerr (3,'restopenin',&
+ &    'The grid of the restart file does not correspond',&
+ &    'to that of the model',' ')
+  ENDIF
+!-
+! 2.0 Get the list of variables
+!-
+  IF (l_dbg) WRITE(*,*) 'restopenin 1.2'
+!-
+  lat_vid = -1
+  lon_vid = -1
+  tind_varid_in(fid) = -1
+  tax_varid_in(fid) = -1
+!-
+  DO iv=1,nb_var
+!---
+    varid_in(fid,iv) = iv
+    var_dims(:) = 0
+    iret = NF90_INQUIRE_VARIABLE(ncfid,iv, &
+ &           name=varname_in(fid,iv),xtype=vartyp_in(fid,iv), &
+ &           ndims=varnbdim_in(fid,iv),dimids=var_dims, &
+ &           nAtts=varatt_in(fid,iv))
+!---
+    DO id=1,varnbdim_in(fid,iv)
+      iret = NF90_INQUIRE_DIMENSION &
+ &             (ncfid,var_dims(id),len=vardims_in(fid,iv,id))
+    ENDDO
+!---
+!-- 2.1 Read the units of the variable
+!---
+    units=''
+    iret = NF90_GET_ATT(ncfid,iv,'units',units)
+    CALL strlowercase (units)
+    CALL cmpblank (units)
+!---
+!-- 2.2 Catch the time variables
+!---
+    IF (varnbdim_in(fid,iv) == 1) THEN
+      IF (     (INDEX(units,'timesteps since') > 0) &
+          .AND.(tind_varid_in(fid) < 0) ) THEN
+        tind_varid_in(fid) = iv
+        tax_size_in(fid) = vardims_in(fid,iv,1)
+      ENDIF
+      IF (     (INDEX(units,'seconds since') > 0) &
+          .AND.(tax_varid_in(fid) < 0) ) THEN
+        tax_varid_in(fid) = iv
+        tax_size_in(fid) = vardims_in(fid,iv,1)
+      ENDIF
+    ENDIF
+!---
+!-- 2.3 Catch longitude and latitude variables
+!---
+    IF      (INDEX(units,'degrees_nort') > 0) THEN
+      lat_vid = iv
+    ELSE IF (INDEX(units,'degrees_east') > 0) THEN
+      lon_vid = iv
+    ENDIF
+!---
+  ENDDO
+!-
+! 2.4 None of the variables was yet read
+!-
+  nbvar_read(fid) = 0
+  touched_in(fid,:) = .FALSE.
+!-
+! 3.0 Reading the coordinates from the input restart file
+!-
+  lon_read = missing_val
+  lat_read = missing_val
+!-
+  IF (lon_vid < 0 .OR. lat_vid < 0) THEN
+    CALL ipslerr (3,'restopenin',&
+      & ' No variables containing longitude or latitude were ',&
+      & ' found in the restart file.',' ')
+  ELSE
+    iret = NF90_GET_VAR(ncfid,lon_vid,lon_read)
+    iret = NF90_GET_VAR(ncfid,lat_vid,lat_read)
+!---
+    IF (  (ABS( MAXVAL(lon(:,:)) &
+ &             -MINVAL(lon(:,:))) < EPSILON(MAXVAL(lon(:,:)))) &
+ &   .AND.(ABS( MAXVAL(lat(:,:)) &
+ &             -MINVAL(lat(:,:))) < EPSILON(MAXVAL(lat(:,:)))) ) THEN
+!-----
+!---- 3.1 No longitude nor latitude are provided thus
+!---- they are taken from the restart file
+!-----
+      lon(:,:) = lon_read(:,:)
+      lat(:,:) = lat_read(:,:)
+    ELSE
+!-----
+!---- 3.2 We check that the longitudes and latitudes
+!----     in the file and the model are the same
+!-----
+      mdlon = MAXVAL(ABS(lon_read-lon))
+      mdlat = MAXVAL(ABS(lat_read-lat))
+!-----
+!---- We can not test against epsilon here as the longitude
+!---- can be stored at another precision in the netCDF file.
+!---- The test here does not need to be very precise.
+!-----
+      IF (mdlon > 1.e-4 .OR. mdlat > 1.e-4) THEN
+        CALL ipslerr (3,'restopenin',&
+          & ' The longitude or latitude found in the restart ',&
+          & ' file are not the same as the ones used in the model.',&
+          & ' ')
+      ENDIF
+    ENDIF
+  ENDIF
+!------------------------
+END SUBROUTINE restopenin
+!===
+SUBROUTINE restsett (timestep,date0,itau,owrite_time_in)
+!---------------------------------------------------------------------
+!- Here we get all the time information from the file.
+!-
+!- The time information can come in three forms :
+!- -global attributes which give the time origine and the
+!-  time step is taken from the input to restinit
+!- -A physical time exists and thus the julian date from the
+!-  input is used for positioning using the itau as input
+!- -A time-step axis exists and itau is positioned on it.
+!-
+!- What takes precedence : the model
+!-
+!- itau     : Time step of the model
+!-
+!- Optional INPUT arguments
+!-
+!- owrite_time_in : logical  argument which allows to
+!-                  overwrite the time in the restart file
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  REAL :: date0,timestep
+  INTEGER :: itau
+  LOGICAL,OPTIONAL :: owrite_time_in
+!-
+  INTEGER :: ncfid,iret,it,iax,iv
+  CHARACTER(LEN=80) :: itau_orig,tax_orig,calendar
+  CHARACTER(LEN=9) :: tmp_cal
+  INTEGER :: year0,month0,day0,hours0,minutes0,seci
+  REAL :: sec0,one_day,one_year,date0_ju,ttmp
+  CHARACTER :: strc
+  LOGICAL :: ow_time
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (PRESENT(owrite_time_in)) THEN
+    ow_time = owrite_time_in
+  ELSE
+    ow_time = .FALSE.
+  ENDIF
+!-
+  ncfid = netcdf_id(nb_fi,1)
+!-
+! Allocate the space we need for the time axes
+!-
+  CALL rest_atim (l_dbg,'restsett')
+!-
+! Get the calendar if possible. Else it will be gregorian.
+!-
+  IF (tax_size_in(nb_fi) > 0) THEN
+    calendar = ' '
+    iret = NF90_GET_ATT(ncfid,tax_varid_in(nb_fi),'calendar',calendar)
+    IF (iret == NF90_NOERR) THEN
+      CALL ioconf_calendar (calendar)
+      IF (l_dbg) THEN
+        WRITE(*,*) 'restsett : calendar of the restart ',calendar
+      ENDIF
+    ENDIF
+  ENDIF
+  CALL ioget_calendar (one_year,one_day)
+  IF (l_dbg) THEN
+    WRITE(*,*) 'one_year,one_day = ',one_year,one_day
+  ENDIF
+!-
+  itau_orig = 'XXXXX'
+  tax_orig  = 'XXXXX'
+!-
+! Get the time steps of the time axis if available on the restart file
+!-
+  IF (tind_varid_in(nb_fi) > 0) THEN
+    IF (ow_time) THEN
+      t_index(nb_fi,:) = itau
+      IF (l_dbg) THEN
+        WRITE(*,*) "nb_fi,t_index",nb_fi,t_index(nb_fi,:)
+      ENDIF
+      CALL ju2ymds (date0,year0,month0,day0,sec0)
+      hours0 = NINT(sec0/3600)
+      sec0 = sec0 - 3600 * hours0
+      minutes0 = NINT(sec0 / 60)
+      sec0 = sec0 - 60 * minutes0
+      seci = NINT(sec0)
+      strc=':'
+      IF (l_dbg) THEN
+        WRITE(*,*) date0
+        WRITE (UNIT=itau_orig,FMT='(I4.4,5(A,I2.2))') &
+ &       year0,'-',month0,'-',day0,' ',hours0,':',minutes0,':',seci
+        WRITE(*,*) "itau_orig : ",itau_orig
+      ENDIF
+    ELSE
+      iret = NF90_GET_VAR(ncfid,tind_varid_in(nb_fi),t_index(nb_fi,:))
+      IF (l_dbg) THEN
+        WRITE(*,*) "restsett, time axis : ",t_index(nb_fi,:)
+      ENDIF
+      iret = NF90_GET_ATT(ncfid,tind_varid_in(nb_fi),'units',itau_orig)
+      itau_orig = &
+ &      itau_orig(INDEX(itau_orig,'since')+6:LEN_TRIM(itau_orig))
+      iret = &
+ &      NF90_GET_ATT(ncfid,tind_varid_in(nb_fi),'tstep_sec',timestep)
+!-----
+!---- This time origin will dominate as it is linked to the time steps.
+!-----
+      READ (UNIT=itau_orig,FMT='(I4.4,5(A,I2.2))') &
+ &      year0,strc,month0,strc,day0,strc, &
+ &      hours0,strc,minutes0,strc,seci
+      sec0 = REAL(seci)
+      sec0 = hours0*3600.+minutes0*60.+sec0
+      CALL ymds2ju (year0,month0,day0,sec0,date0)
+    ENDIF
+  ENDIF
+!-
+! If a julian day time axis is available then we get it
+!-
+  IF (tax_varid_in(nb_fi) > 0) THEN
+    iret = NF90_GET_VAR(ncfid,tax_varid_in(nb_fi),t_julian(nb_fi,:))
+    iret = NF90_GET_ATT(ncfid,tax_varid_in(nb_fi),'units',tax_orig)
+    tax_orig = tax_orig(INDEX(tax_orig,'since')+6:LEN_TRIM(tax_orig))
+    tmp_cal = ' '
+    iret = NF90_GET_ATT(ncfid,tax_varid_in(nb_fi),'calendar',tmp_cal)
+    IF (l_dbg) THEN
+      WRITE(*,*) 'restsett : tmp_calendar of the restart ',tmp_cal
+    ENDIF
+!---
+    CALL strlowercase (tmp_cal)
+    IF (INDEX(calend_str,tmp_cal) < 1) THEN
+      IF (INDEX(calend_str,'unknown') > 0) THEN
+        calend_str = tmp_cal
+      ELSE
+        CALL ipslerr (2,'restsett', &
+ &       ' In the restart files two different calendars were found.', &
+ &       ' Please check the files you have used.',' ')
+      ENDIF
+    ENDIF
+!---
+!-- We need to transform that into julian days
+!-- to get ride of the intial date.
+!---
+    IF (l_dbg) WRITE(*,*) 'tax_orig : ',TRIM(tax_orig)
+    READ (UNIT=tax_orig,FMT='(I4.4,5(a,I2.2))') &
+      year0,strc,month0,strc,day0,strc, &
+      hours0,strc,minutes0,strc,seci
+    sec0 = REAL(seci)
+    sec0 = hours0*3600.+minutes0*60.+sec0
+    CALL ymds2ju (year0,month0,day0,sec0,date0_ju)
+    t_julian(nb_fi,:) = t_julian(nb_fi,:)/one_day+date0_ju
+  ENDIF
+!-
+  IF (     (INDEX(itau_orig,'XXXXX') > 0) &
+      .AND.(INDEX(tax_orig,'XXXXX')  < 1) ) THEN
+!!- Compute the t_itau from the date read and the timestep in the input
+  ENDIF
+!-
+  IF (     (INDEX(tax_orig,'XXXXX')  > 0) &
+      .AND.(INDEX(itau_orig,'XXXXX') < 1) ) THEN
+    DO it=1,tax_size_in(nb_fi)
+      t_julian(nb_fi,it) = itau2date(t_index(nb_fi,it),date0,timestep)
+    ENDDO
+  ENDIF
+!-
+! If neither the indices or time is present then get global attributes
+! This is for compatibility reasons and should not be used.
+!-
+  IF ((tax_varid_in(nb_fi) < 0).AND.(tind_varid_in(nb_fi) < 0)) THEN
+    iax = -1
+    DO iv=1,nbvar_in(nb_fi)
+      IF (    (INDEX(varname_in(nb_fi,iv),'tsteps') > 0) &
+ &        .OR.(INDEX(varname_in(nb_fi,iv),'time_steps') > 0)) THEN
+        iax = iv
+      ENDIF
+    ENDDO
+!---
+    IF (iax < 0) THEN
+      CALL ipslerr (3,'restsett',&
+        & 'No time axis was found in the restart file. Please check',&
+        & 'that it corresponds to the convention used in restsett',&
+        & ' ')
+    ELSE
+      iret = NF90_GET_VAR(ncfid,tind_varid_in(nb_fi),t_index(nb_fi,:))
+      iret = NF90_GET_ATT(ncfid,NF90_GLOBAL,'delta_tstep_sec',timestep)
+      iret = NF90_GET_ATT(ncfid,NF90_GLOBAL,'year0',ttmp)
+      year0 = NINT(ttmp)
+      iret = NF90_GET_ATT(ncfid,NF90_GLOBAL,'month0',ttmp)
+      month0 = NINT(ttmp)
+      iret = NF90_GET_ATT(ncfid,NF90_GLOBAL,'day0',ttmp)
+      day0 = NINT(ttmp)
+      iret = NF90_GET_ATT(ncfid,NF90_GLOBAL,'sec0',sec0)
+!---
+      CALL ymds2ju (year0,month0,day0,sec0,date0)
+      t_julian(nb_fi,1) = itau2date(t_index(nb_fi,1),date0,timestep)
+    ENDIF
+  ENDIF
+!----------------------
+END SUBROUTINE restsett
+!===
+SUBROUTINE restopenout &
+  (fid,fname,iim,jjm, &
+   lon,lat,llm,lev,timestep,date,ncfid,domain_id)
+!---------------------------------------------------------------------
+!- Opens the restart file for output.
+!- The longitude and time variables are written.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: fid,iim,jjm,llm
+  CHARACTER(LEN=*) :: fname
+  REAL :: date,timestep
+  REAL :: lon(iim,jjm),lat(iim,jjm),lev(llm)
+  INTEGER,INTENT(OUT) :: ncfid
+  INTEGER,INTENT(IN),OPTIONAL :: domain_id
+!-
+  INTEGER :: iret
+  CHARACTER(LEN=70) :: str_t
+  INTEGER :: x_id,y_id,z_id,itauid
+  INTEGER :: nlonid,nlatid,nlevid,timeid
+  INTEGER :: year,month,day,hours,minutes
+  REAL :: sec
+  CHARACTER(LEN=3),DIMENSION(12) :: &
+    cal = (/'JAN','FEB','MAR','APR','MAY','JUN', &
+            'JUL','AUG','SEP','OCT','NOV','DEC'/)
+  CHARACTER(LEN=30) :: timenow
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) WRITE(*,*) "restopenout 0.0 ",TRIM(fname)
+!-
+!  If we use the same file for input and output
+!- we will not even call restopenout
+!-
+  iret = NF90_CREATE(fname,NF90_NOCLOBBER,ncfid)
+  IF (iret == -35) THEN
+    CALL ipslerr (3,'restopenout',&
+      & ' The restart file aready exists on the disc. IOIPSL ',&
+      & ' will not overwrite it. You should remove the old one or ',&
+      & ' generate the new one with another name')
+  ENDIF
+!-
+  iret = NF90_DEF_DIM(ncfid,'x',iim,x_id)
+  xax_nb(fid) = xax_nb(fid)+1
+  xax_infs(fid,xax_nb(fid),1) = iim
+  xax_infs(fid,xax_nb(fid),2) = x_id
+!-
+  iret = NF90_DEF_DIM(ncfid,'y',jjm,y_id)
+  yax_nb(fid)  = yax_nb(fid)+1
+  yax_infs(fid,yax_nb(fid),1) = jjm
+  yax_infs(fid,yax_nb(fid),2) = y_id
+!-
+  iret = NF90_DEF_DIM(ncfid,'z',llm,z_id)
+  zax_nb(fid) = zax_nb(fid)+1
+  zax_infs(fid,zax_nb(fid),1) = llm
+  zax_infs(fid,zax_nb(fid),2) = z_id
+!-
+  iret = NF90_DEF_DIM(ncfid,'time',NF90_UNLIMITED,tdimid_out(fid))
+!-
+! 1.0 Longitude
+!-
+  IF (l_dbg) WRITE(*,*) "restopenout 1.0"
+!-
+  iret = NF90_DEF_VAR(ncfid,"nav_lon",NF90_FLOAT,(/x_id,y_id/),nlonid)
+  iret = NF90_PUT_ATT(ncfid,nlonid,'units',"degrees_east")
+  iret = NF90_PUT_ATT(ncfid,nlonid,'valid_min',REAL(-180.,KIND=4))
+  iret = NF90_PUT_ATT(ncfid,nlonid,'valid_max',REAL( 180.,KIND=4))
+  iret = NF90_PUT_ATT(ncfid,nlonid,'long_name',"Longitude")
+!-
+! 2.0 Latitude
+!-
+  IF (l_dbg) WRITE(*,*) "restopenout 2.0"
+!-
+  iret = NF90_DEF_VAR(ncfid,"nav_lat",NF90_FLOAT,(/x_id,y_id/),nlatid)
+  iret = NF90_PUT_ATT(ncfid,nlatid,'units',"degrees_north")
+  iret = NF90_PUT_ATT(ncfid,nlatid,'valid_min',REAL(-90.,KIND=4))
+  iret = NF90_PUT_ATT(ncfid,nlatid,'valid_max',REAL( 90.,KIND=4))
+  iret = NF90_PUT_ATT(ncfid,nlatid,'long_name',"Latitude")
+!-
+! 3.0 Levels
+!-
+  IF (l_dbg) WRITE(*,*) "restopenout 3.0"
+!-
+  iret = NF90_DEF_VAR(ncfid,"nav_lev",NF90_FLOAT,z_id,nlevid)
+  iret = NF90_PUT_ATT(ncfid,nlevid,'units',"model_levels")
+  iret = NF90_PUT_ATT(ncfid,nlevid,'valid_min', &
+ &                     REAL(MINVAL(lev),KIND=4))
+  iret = NF90_PUT_ATT(ncfid,nlevid,'valid_max', &
+ &                     REAL(MAXVAL(lev),KIND=4))
+  iret = NF90_PUT_ATT(ncfid,nlevid,'long_name',"Model levels")
+!-
+! 4.0 Time axis, this is the seconds since axis
+!-
+  IF (l_dbg) WRITE(*,*) "restopenout 4.0"
+!-
+  iret = NF90_DEF_VAR(ncfid,"time",NF90_FLOAT, &
+                       tdimid_out(fid),timeid)
+  tax_varid_out(fid) = timeid
+!-
+  timeorig(fid) = date
+  CALL ju2ymds (date,year,month,day,sec)
+  hours   = INT(sec/(60.*60.))
+  minutes = INT((sec-hours*60.*60.)/60.)
+  sec     = sec-(hours*60.*60.+minutes*60.)
+  WRITE (UNIT=str_t, &
+   FMT='("seconds since ",I4.4,2("-",I2.2)," ",I2.2,2(":",I2.2))') &
+ &  year,month,day,hours,minutes,INT(sec)
+  iret = NF90_PUT_ATT(ncfid,timeid,'units',TRIM(str_t))
+!-
+  CALL ioget_calendar (str_t)
+  iret = NF90_PUT_ATT(ncfid,timeid,'calendar',TRIM(str_t))
+  iret = NF90_PUT_ATT(ncfid,timeid,'title','Time')
+  iret = NF90_PUT_ATT(ncfid,timeid,'long_name','Time axis')
+!-
+  WRITE(UNIT=str_t, &
+   FMT='(" ",I4.4,"-",A3,"-",I2.2," ",I2.2,2(":",I2.2))') &
+ &  year,cal(month),day,hours,minutes,INT(sec)
+  iret = NF90_PUT_ATT(ncfid,timeid,'time_origin',TRIM(str_t))
+!-
+! 5.0 Time axis, this is the time steps since axis
+!-
+  IF (l_dbg) WRITE(*,*) "restopenout 5.0"
+!-
+  iret = NF90_DEF_VAR(ncfid,"time_steps",NF90_INT, &
+ &                    tdimid_out(fid),itauid)
+  tind_varid_out(fid) = itauid
+!-
+  CALL ju2ymds (date,year,month,day,sec)
+!-
+  hours   = INT(sec/(60.*60.))
+  minutes = INT((sec-hours*60.*60.)/60.)
+  sec     = sec-(hours*60.*60.+minutes*60.)
+!-
+  WRITE (UNIT=str_t, &
+   FMT='("timesteps since ",I4.4,2("-",I2.2)," ",I2.2,2(":",I2.2))') &
+ &  year,month,day,hours,minutes,INT(sec)
+!-
+  iret = NF90_PUT_ATT(ncfid,itauid,'units',TRIM(str_t))
+  iret = NF90_PUT_ATT(ncfid,itauid,'title','Time steps')
+  iret = NF90_PUT_ATT(ncfid,itauid,'tstep_sec',REAL(timestep,KIND=4))
+  iret = NF90_PUT_ATT(ncfid,itauid,'long_name','Time step axis')
+!-
+  WRITE(UNIT=str_t, &
+   FMT='(" ",I4.4,"-",A3,"-",I2.2," ",I2.2,2(":",I2.2))') &
+ &  year,cal(month),day,hours,minutes,INT(sec)
+  iret = NF90_PUT_ATT(ncfid,itauid,'time_origin',TRIM(str_t))
+!-
+!  5.2 Write global attributes
+!-
+  iret = NF90_PUT_ATT(ncfid,NF90_GLOBAL,'Conventions',"CF-1.1")
+  iret = NF90_PUT_ATT(ncfid,NF90_GLOBAL,'file_name',TRIM(fname))
+!!  TO BE DONE LATER
+!!   iret = NF90_PUT_ATT(ncfid,NF90_GLOBAL, &
+!!                       'production',TRIM(model_name))
+!!   lock_modname = .TRUE.
+  CALL ioget_timestamp (timenow)
+  iret = NF90_PUT_ATT(ncfid,NF90_GLOBAL,'TimeStamp',TRIM(timenow))
+!-
+! Add DOMAIN attributes if needed
+!-
+  CALL flio_dom_att (ncfid,domain_id)
+!-
+! 6.0 The coordinates are written to the file
+!-
+  iret = NF90_ENDDEF(ncfid)
+!-
+  iret = NF90_PUT_VAR(ncfid,nlonid,lon)
+  iret = NF90_PUT_VAR(ncfid,nlatid,lat)
+  iret = NF90_PUT_VAR(ncfid,nlevid,lev)
+!-
+! 7.0 Set a few variables related to the out file
+!-
+  nbvar_out(fid) = 0
+  itau_out(fid) = -1
+  tstp_out(fid) = 0
+  touched_out(fid,:) = .FALSE.
+!-
+! 7.1 The file is put back in define mode.
+!     This will last until itau_out >= 0
+!-
+  iret = NF90_REDEF(ncfid)
+!-
+  IF (l_dbg) WRITE(*,*) "restopenout END"
+!-------------------------
+END SUBROUTINE restopenout
+!===
+SUBROUTINE restget_opp_r1d &
+ & (fid,vname_q,iim,jjm,llm,itau,def_beha, &
+ &  var,MY_OPERATOR,nbindex,ijndex)
+!---------------------------------------------------------------------
+!- This subroutine serves as an interface to restget_real
+!-
+!- Should work as restput_opp_r1d but the other way around !
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  LOGICAL def_beha
+  REAL :: var(:)
+  CHARACTER(LEN=*) :: MY_OPERATOR
+  INTEGER :: nbindex,ijndex(nbindex)
+!-
+  INTEGER :: req_sz,siz1
+  REAL :: scal
+  CHARACTER(LEN=7) :: topp
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 0.0 What size should be the data in the file
+!-
+  req_sz = 1
+  IF (nbindex == iim .AND. jjm <= 1 .AND. llm <= 1) THEN
+    IF (xax_infs(fid,1,1) > 0) req_sz = req_sz*xax_infs(fid,1,1)
+    IF (yax_infs(fid,1,1) > 0) req_sz = req_sz*yax_infs(fid,1,1)
+    IF (zax_infs(fid,1,1) > 0) req_sz = req_sz*zax_infs(fid,1,1)
+  ELSE
+    CALL ipslerr (3,'resget_opp_r1d', &
+      'Unable to performe an operation on this variable as it has',&
+      'a second and third dimension',vname_q)
+  ENDIF
+!-
+! 1.0 Allocate the temporary buffer we need
+!     to put the variable in right dimension
+!-
+  siz1 = SIZE(var)
+  CALL rest_alloc (1,siz1,l_dbg,'restget_opp_r1d')
+  CALL rest_alloc (2,req_sz,l_dbg,'restget_opp_r1d')
+!-
+! 2.0 Here we get the variable from the restart file
+!-
+  CALL restget_real &
+    (fid,vname_q,xax_infs(fid,1,1),yax_infs(fid,1,1), &
+     zax_infs(fid,1,1),itau,def_beha,buff_tmp2)
+!-
+! 4.0 Transfer the buffer obtained from the restart file
+!     into the variable the model expects
+!-
+  topp = MY_OPERATOR(1:MIN(LEN_TRIM(MY_OPERATOR),7))
+!-
+  IF (INDEX(indchfun,topp(:LEN_TRIM(topp))) > 0) THEN
+    scal = missing_val
+    CALL mathop (topp,req_sz,buff_tmp2,missing_val, &
+ &               nbindex,ijndex,scal,siz1,buff_tmp1)
+    var(:) = buff_tmp1(1:siz1)
+  ELSE
+    CALL ipslerr (3,'resget_opp_r1d', &
+      'The operation you wish to do on the variable for the ',&
+      'restart file is not allowed.',topp)
+  ENDIF
+!-----------------------------
+END SUBROUTINE restget_opp_r1d
+!===
+SUBROUTINE restget_opp_r2d &
+ & (fid,vname_q,iim,jjm,llm,itau,def_beha, &
+ &  var,MY_OPERATOR,nbindex,ijndex)
+!---------------------------------------------------------------------
+!- This subroutine serves as an interface to restget_real
+!-
+!- Should work as restput_opp_r2d but the other way around !
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  LOGICAL def_beha
+  REAL :: var(:,:)
+  CHARACTER(LEN=*) :: MY_OPERATOR
+  INTEGER :: nbindex,ijndex(nbindex)
+!-
+  INTEGER :: jj,req_sz,ist,var_sz,siz1
+  REAL :: scal
+  CHARACTER(LEN=7) :: topp
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 0.0 What size should be the data in the file
+!-
+  req_sz = 1
+  IF (nbindex == iim  .AND. llm <= 1) THEN
+    IF (xax_infs(fid,1,1) > 0) req_sz = req_sz*xax_infs(fid,1,1)
+    IF (yax_infs(fid,1,1) > 0) req_sz = req_sz*yax_infs(fid,1,1)
+  ELSE
+    CALL ipslerr (3,'resget_opp_r2d', &
+      'Unable to performe an operation on this variable as it has', &
+      'a second and third dimension',vname_q)
+  ENDIF
+!-
+  IF (jjm < 1) THEN
+    CALL ipslerr (3,'resget_opp_r2d', &
+      'Please specify a second dimension which is the', &
+      'layer on which the operations are performed',vname_q)
+  ENDIF
+!-
+! 1.0 Allocate the temporary buffer we need
+!     to put the variable in right dimension
+!-
+  siz1 = SIZE(var,1)
+  CALL rest_alloc (1,siz1,l_dbg,'restget_opp_r2d')
+  CALL rest_alloc (2,req_sz*jjm,l_dbg,'restget_opp_r2d')
+!-
+! 2.0 Here we get the full variable from the restart file
+!-
+  CALL restget_real &
+ & (fid,vname_q,xax_infs(fid,1,1),yax_infs(fid,1,1), &
+ &  jjm,itau,def_beha,buff_tmp2)
+!-
+! 4.0 Transfer the buffer obtained from the restart file
+!     into the variable the model expects
+!-
+  topp = MY_OPERATOR(1:MIN(LEN_TRIM(MY_OPERATOR),7))
+!-
+  IF (INDEX(indchfun,topp(:LEN_TRIM(topp))) > 0) THEN
+    scal = missing_val
+    var_sz = siz1
+    DO jj = 1,jjm
+      ist = (jj-1)*req_sz+1
+      CALL mathop (topp,req_sz,buff_tmp2(ist:ist+req_sz-1), &
+ &      missing_val,nbindex,ijndex,scal,var_sz,buff_tmp1)
+      var(:,jj) = buff_tmp1(1:siz1)
+    ENDDO
+  ELSE
+    CALL ipslerr (3,'resget_opp_r2d', &
+      'The operation you wish to do on the variable for the ',&
+      'restart file is not allowed.',topp)
+  ENDIF
+!-----------------------------
+END SUBROUTINE restget_opp_r2d
+!===
+SUBROUTINE restget_r1d &
+ & (fid,vname_q,iim,jjm,llm,itau,def_beha,var)
+!---------------------------------------------------------------------
+!- This subroutine serves as an interface to restget_real
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  LOGICAL :: def_beha
+  REAL :: var(:)
+!-
+  INTEGER :: ji,jl,req_sz,var_sz,siz1
+  CHARACTER(LEN=70) :: str,str2
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 1.0 Allocate the temporary buffer we need
+!     to put the variable in right dimension
+!-
+  siz1 = SIZE(var)
+  var_sz = siz1
+  CALL rest_alloc (1,var_sz,l_dbg,'restget_r1d')
+!-
+! 2.0 Here we could check if the sizes specified agree
+!     with the size of the variable provided
+!-
+  req_sz = 1
+  IF (iim > 0) req_sz = req_sz*iim
+  IF (jjm > 0) req_sz = req_sz*jjm
+  IF (llm > 0) req_sz = req_sz*llm
+  IF (req_sz > var_sz) THEN
+    WRITE(str, &
+ &    '("Size of variable requested from file should be ",I6)') req_sz
+    WRITE(str2, &
+ &    '("but the provided variable can only hold ",I6)') var_sz
+    CALL ipslerr (3,'restget_r1d',str,str2,' ')
+  ENDIF
+  IF (req_sz < var_sz) THEN
+    WRITE(str, &
+ &    '("the size of variable requested from file is ",I6)') req_sz
+    WRITE(str2, &
+ &    '("but the provided variable can hold ",I6)') var_sz
+    CALL ipslerr (2,'restget_r1d', &
+      'There could be a problem here :',str,str2)
+  ENDIF
+!-
+  CALL restget_real &
+ & (fid,vname_q,iim,jjm,llm,itau,def_beha,buff_tmp1)
+!-
+! 4.0 Transfer the buffer obtained from the restart file
+!     into the variable the model expects
+!-
+  jl=0
+  DO ji=1,siz1
+    jl=jl+1
+    var(ji) = buff_tmp1(jl)
+  ENDDO
+!-------------------------
+END SUBROUTINE restget_r1d
+!===
+SUBROUTINE restget_r2d &
+ & (fid,vname_q,iim,jjm,llm,itau,def_beha,var)
+!---------------------------------------------------------------------
+!- This subroutine serves as an interface to restget_real
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  LOGICAL :: def_beha
+  REAL :: var(:,:)
+!-
+  INTEGER :: ji,jj,jl,req_sz,var_sz,siz1,siz2
+  CHARACTER(LEN=70) :: str,str2
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 1.0 Allocate the temporary buffer we need
+!     to put the variable in right dimension
+!-
+  siz1 = SIZE(var,1)
+  siz2 = SIZE(var,2)
+  var_sz = siz1*siz2
+  CALL rest_alloc (1,var_sz,l_dbg,'restget_r2d')
+!-
+! 2.0 Here we check if the sizes specified agree
+!     with the size of the variable provided
+!-
+  req_sz = 1
+  IF (iim > 0) req_sz = req_sz*iim
+  IF (jjm > 0) req_sz = req_sz*jjm
+  IF (llm > 0) req_sz = req_sz*llm
+  IF (req_sz > var_sz) THEN
+    WRITE(str, &
+ &    '("Size of variable ",A, &
+ &      //" requested from file should be ",I6)') TRIM(vname_q),req_sz
+    WRITE(str2, &
+ &    '("but the provided variable can only hold ",I6)') var_sz
+    CALL ipslerr (3,'restget_r2d',str,str2,' ')
+  ENDIF
+  IF (req_sz < var_sz) THEN
+    WRITE(str, &
+ &    '("Size of variable ",A, &
+ &      //" requested from file is ",I6)') TRIM(vname_q),req_sz
+    WRITE(str2,'("but the provided variable can hold ",I6)') var_sz
+    CALL ipslerr (2,'restget_r2d', &
+      'There could be a problem here :',str,str2)
+  ENDIF
+!-
+  CALL restget_real &
+ & (fid,vname_q,iim,jjm,llm,itau,def_beha,buff_tmp1)
+!-
+! 4.0 Transfer the buffer obtained from the restart file
+!     into the variable the model expects
+!-
+  jl=0
+  DO jj=1,siz2
+    DO ji=1,siz1
+      jl=jl+1
+      var(ji,jj) = buff_tmp1(jl)
+    ENDDO
+  ENDDO
+!-------------------------
+END SUBROUTINE restget_r2d
+!===
+SUBROUTINE restget_r3d &
+  (fid,vname_q,iim,jjm,llm,itau,def_beha,var)
+!---------------------------------------------------------------------
+!- This subroutine serves as an interface to restget_real
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  LOGICAL def_beha
+  REAL :: var(:,:,:)
+!-
+  INTEGER :: ji,jj,jk,jl,req_sz,var_sz,siz1,siz2,siz3
+  CHARACTER(LEN=70) :: str,str2
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 1.0 Allocate the temporary buffer we need
+!     to put the variable in right dimension
+!-
+  siz1 = SIZE(var,1)
+  siz2 = SIZE(var,2)
+  siz3 = SIZE(var,3)
+  var_sz = siz1*siz2*siz3
+  CALL rest_alloc (1,var_sz,l_dbg,'restget_r3d')
+!-
+! 2.0 Here we check if the sizes specified agree
+!     with the size of the variable provided
+!-
+  req_sz = 1
+  IF (iim > 0) req_sz = req_sz*iim
+  IF (jjm > 0) req_sz = req_sz*jjm
+  IF (llm > 0) req_sz = req_sz*llm
+  IF (req_sz > var_sz) THEN
+    WRITE(str, &
+ &    '("Size of variable ",A, &
+ &      //" requested from file should be ",I6)') TRIM(vname_q),req_sz
+    WRITE(str2, &
+ &    '("but the provided variable can only hold ",I6)') var_sz
+    CALL ipslerr (3,'restget_r3d',str,str2,' ')
+  ENDIF
+  IF (req_sz < var_sz) THEN
+    WRITE(str, &
+ &    '("Size of variable ",A, &
+ &      //" requested from file is ",I6)') TRIM(vname_q),req_sz
+    WRITE(str2,'("but the provided variable can hold ",I6)') var_sz
+    CALL ipslerr (2,'restget_r3d', &
+      'There could be a problem here :',str,str2)
+  ENDIF
+!-
+  CALL restget_real &
+    (fid,vname_q,iim,jjm,llm,itau,def_beha,buff_tmp1)
+!-
+! 4.0 Transfer the buffer obtained from the restart file
+!     into the variable the model expects
+!-
+  jl=0
+  DO jk=1,siz3
+    DO jj=1,siz2
+      DO ji=1,siz1
+        jl=jl+1
+        var(ji,jj,jk) = buff_tmp1(jl)
+      ENDDO
+    ENDDO
+  ENDDO
+!-------------------------
+END SUBROUTINE restget_r3d
+!===
+SUBROUTINE restget_real &
+  (fid,vname_q,iim,jjm,llm,itau,def_beha,var)
+!---------------------------------------------------------------------
+!- This subroutine is for getting a variable from the restart file.
+!- A number of verifications will be made :
+!- - Is this the first time we read this variable ?
+!- - Are the dimensions correct ?
+!- - Is the correct time step present in the file
+!- - is a default behaviour possible. If not the model is stoped.
+!- Default procedure is to write the content of val_exp on all values.
+!-
+!- INPUT
+!-
+!- fid            : Identification of the file
+!- vname_q        : Name of the variable to be read
+!- iim, jjm ,llm  : Dimensions of the variable that should be read
+!- itau           : Time step at whcih we are when we want
+!-                  to read the variable
+!- def_beha       : If the model can restart without this variable
+!-                  then some strange value is given.
+!-
+!- OUTPUT
+!-
+!- var            : Variable in which the data is put
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  LOGICAL :: def_beha
+  REAL :: var(:)
+!-
+  INTEGER :: vid,vnb,ncfid,iret,index,it,ndim,ia
+  CHARACTER(LEN=70) str,str2
+  CHARACTER(LEN=80) attname
+  INTEGER,DIMENSION(4) :: corner,edge
+!---------------------------------------------------------------------
+  ncfid = netcdf_id(fid,1)
+!-
+  CALL find_str (varname_in(fid,1:nbvar_in(fid)),vname_q,vnb)
+!-
+! 1.0 If the variable is not present then ERROR or filled up
+!     by default values if allowed
+!-
+  IF (vnb < 0) THEN
+    IF (def_beha) THEN
+!-----
+      lock_valexp = .TRUE.
+      var(:) = val_exp
+!----
+      str = 'Variable '//TRIM(vname_q) &
+          //' is not present in the restart file'
+      CALL ipslerr (1,'restget', &
+ &      str,'but default values are used to fill in',' ')
+!----
+      IF (nbvar_in(fid) >= max_var) THEN
+        CALL ipslerr (3,'restget', &
+         'Too many variables for the restcom module', &
+         'Please increase the value of max_var',' ')
+      ENDIF
+      nbvar_in(fid) = nbvar_in(fid)+1
+      vnb = nbvar_in(fid)
+      varname_in(fid,vnb) = vname_q
+      touched_in(fid,vnb) = .TRUE.
+!-----
+      CALL restdefv (fid,vname_q,iim,jjm,llm,.TRUE.)
+!-----
+    ELSE
+      str = 'Variable '//TRIM(vname_q) &
+          //' is not present in the restart file'
+      CALL ipslerr (3,'restget', &
+ &      str,'but it is need to restart the model',' ')
+    ENDIF
+!---
+  ELSE
+!---
+!--  2.0 Check if the variable has not yet been read
+!--      and that the time is OK
+!---
+    vid = varid_in(fid,vnb)
+!---
+    nbvar_read(fid) = nbvar_read(fid)+1
+!---
+    IF (touched_in(fid,vnb)) THEN
+      str = 'Variable '//TRIM(vname_q) &
+          //' has already been read from file'
+      CALL ipslerr (3,'restget',str,' ',' ')
+    ENDIF
+!---
+!-- 3.0 get the time step of the restart file
+!--     and check if it is correct
+!---
+    index = -1
+    DO it=1,tax_size_in(fid)
+      IF (t_index(fid,it) == itau)  index = it
+    ENDDO
+    IF (index < 0) THEN
+      str = 'The time step requested for variable '//TRIM(vname_q)
+      CALL ipslerr (3,'restget', &
+ &      str,'is not available in the current file',' ')
+    ENDIF
+!---
+!-- 4.0 Read the data. Note that the variables in the restart files
+!--     have no time axis is and thus we write -1
+!---
+    str='Incorrect dimension for '//TRIM(vname_q)
+    ndim = 0
+    IF (iim > 0) THEN
+      ndim = ndim+1
+      IF (vardims_in(fid,vnb,ndim) == iim) THEN
+        corner(ndim) = 1
+        edge(ndim) = iim
+      ELSE
+        WRITE (str2,'("Incompatibility for iim : ",I6,I6)') &
+             iim,vardims_in(fid,vnb,ndim)
+        CALL ipslerr (3,'restget',str,str2,' ')
+      ENDIF
+    ENDIF
+!---
+    IF (jjm > 0) THEN
+      ndim = ndim+1
+      IF (vardims_in(fid,vnb,ndim) == jjm) THEN
+        corner(ndim) = 1
+        edge(ndim) = jjm
+      ELSE
+        WRITE (str2,'("Incompatibility for jjm : ",I6,I6)') &
+             jjm,vardims_in(fid,vnb,ndim)
+        CALL ipslerr (3,'restget',str,str2,' ')
+      ENDIF
+    ENDIF
+!---
+    IF (llm > 0) THEN
+      ndim = ndim+1
+      IF (vardims_in(fid,vnb,ndim) == llm) THEN
+        corner(ndim) = 1
+        edge(ndim) = llm
+      ELSE
+        WRITE (str2,'("Incompatibility for llm : ",I6,I6)') &
+             llm,vardims_in(fid,vnb,ndim)
+        CALL ipslerr (3,'restget',str,str2,' ')
+      ENDIF
+    ENDIF
+!---
+!-- Time
+!---
+    ndim = ndim+1
+    corner(ndim) = index
+!!????? edge(ndim) = index
+    edge(ndim) = 1
+!---
+    iret = NF90_GET_VAR(ncfid,vid,var, &
+ &                      start=corner(1:ndim),count=edge(1:ndim))
+!---
+!-- 5.0 The variable we have just read is created
+!--      in the next restart file
+!---
+    IF (     (netcdf_id(fid,1) /= netcdf_id(fid,2))  &
+ &      .AND.(netcdf_id(fid,2) > 0) ) THEN
+!-----
+      CALL restdefv (fid,vname_q,iim,jjm,llm,.FALSE.)
+!-----
+      DO ia = 1,varatt_in(fid,vnb)
+        iret = NF90_INQ_ATTNAME(ncfid,vid,ia,attname)
+        iret = NF90_COPY_ATT(ncfid,vid,attname, &
+ &               netcdf_id(fid,2),varid_out(fid,nbvar_out(fid)))
+      ENDDO
+!-----
+      IF (itau_out(fid) >= 0) THEN
+        iret = NF90_ENDDEF(netcdf_id(fid,2))
+      ENDIF
+    ENDIF
+!---
+  ENDIF
+!--------------------------
+END SUBROUTINE restget_real
+!===
+SUBROUTINE restput_opp_r1d &
+ & (fid,vname_q,iim,jjm,llm,itau,var,MY_OPERATOR,nbindex,ijndex)
+!---------------------------------------------------------------------
+!- This subroutine is the interface to restput_real which allows
+!- to re-index data onto the original grid of the restart file.
+!- The logic we use is still fuzzy in my mind but that is probably
+!- only because I have not yet though through everything.
+!-
+!- In the case iim = nbindex it means that the user attempts
+!- to project a vector back onto the original 2D or 3D field.
+!- This requires that jjm and llm be equal to 1 or 0,
+!- else I would not know what it means.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  REAL :: var(:)
+  CHARACTER(LEN=*) :: MY_OPERATOR
+  INTEGER :: nbindex,ijndex(nbindex)
+!-
+  INTEGER :: req_sz,siz1
+  REAL :: scal
+  CHARACTER(LEN=7) :: topp
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 0.0 What size should be the data in the file
+!-
+  req_sz = 1
+  IF ( nbindex == iim .AND. jjm <= 1 .AND. llm <= 1) THEN
+    IF (xax_infs(fid,1,1) > 0) req_sz = req_sz*xax_infs(fid,1,1)
+    IF (yax_infs(fid,1,1) > 0) req_sz = req_sz*yax_infs(fid,1,1)
+    IF (zax_infs(fid,1,1) > 0) req_sz = req_sz*zax_infs(fid,1,1)
+  ELSE
+    CALL ipslerr (3,'restput_opp_r1d', &
+      'Unable to performe an operation on this variable as it has', &
+      'a second and third dimension',vname_q)
+  ENDIF
+!-
+! 1.0 Allocate the temporary buffer we need
+!     to put the variable in right dimension
+!-
+  siz1 = SIZE(var)
+  CALL rest_alloc (1,siz1,l_dbg,'restput_opp_r1d')
+  CALL rest_alloc (2,req_sz,l_dbg,'restput_opp_r1d')
+!-
+! 2.0 We do the operation needed.
+!     It can only be a re-indexing operation.
+!     You would not want to change the values in a restart file or ?
+!-
+  topp = MY_OPERATOR(1:MIN(LEN_TRIM(MY_OPERATOR),7))
+!-
+  IF (INDEX(indchfun,topp(:LEN_TRIM(topp))) > 0) THEN
+    scal = missing_val
+    buff_tmp1(1:siz1) = var(:)
+    CALL mathop &
+ &    (topp,siz1,buff_tmp1,missing_val,nbindex,ijndex, &
+ &     scal,req_sz,buff_tmp2)
+  ELSE
+    CALL ipslerr (3,'restput_opp_r1d', &
+ &    'The operation you wish to do on the variable for the ', &
+ &    'restart file is not allowed.',topp)
+  ENDIF
+!-
+  CALL restput_real &
+ & (fid,vname_q,xax_infs(fid,1,1),yax_infs(fid,1,1), &
+ &  zax_infs(fid,1,1),itau,buff_tmp2)
+!-----------------------------
+END SUBROUTINE restput_opp_r1d
+!===
+SUBROUTINE restput_opp_r2d &
+ & (fid,vname_q,iim,jjm,llm,itau,var,MY_OPERATOR,nbindex,ijndex)
+!---------------------------------------------------------------------
+!- This subroutine is the interface to restput_real which allows
+!- to re-index data onto the original grid of the restart file.
+!- The logic we use is still fuzzy in my mind but that is probably
+!- only because I have not yet though through everything.
+!-
+!- In the case iim = nbindex it means that the user attempts
+!- to project the first dimension of the matrix back onto a 3D field
+!- where jjm will be the third dimension.
+!- Here we do not allow for 4D data, thus we will take the first
+!- two dimensions in the file and require that llm = 1.
+!- These are pretty heavy constraints but I do not know how
+!- to make it more general. I need to think about it some more.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  REAL :: var(:,:)
+  CHARACTER(LEN=*) :: MY_OPERATOR
+  INTEGER :: nbindex,ijndex(nbindex)
+!-
+  INTEGER :: jj,req_sz,ist,siz1
+  REAL :: scal
+  CHARACTER(LEN=7) :: topp
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 0.0 What size should be the data in the file
+!-
+  req_sz = 1
+  IF ( nbindex == iim .AND. llm <= 1) THEN
+    IF (xax_infs(fid,1,1) > 0) req_sz = req_sz*xax_infs(fid,1,1)
+    IF (yax_infs(fid,1,1) > 0) req_sz = req_sz*yax_infs(fid,1,1)
+  ELSE
+    CALL ipslerr (3,'restput_opp_r2d', &
+      'Unable to performe an operation on this variable as it has', &
+      'a second and third dimension',vname_q)
+  ENDIF
+!-
+  IF (jjm < 1) THEN
+    CALL ipslerr (3,'restput_opp_r2d', &
+      'Please specify a second dimension which is the', &
+      'layer on which the operations are performed',vname_q)
+  ENDIF
+!-
+! 1.0 Allocate the temporary buffer we need
+!     to put the variable in right dimension
+!-
+  siz1 = SIZE(var,1)
+  CALL rest_alloc (1,siz1,l_dbg,'restput_opp_r2d')
+  CALL rest_alloc (2,req_sz*jjm,l_dbg,'restput_opp_r2d')
+!-
+! 2.0 We do the operation needed.
+!     It can only be a re-indexing operation.
+!     You would not want to change the values in a restart file or ?
+!-
+  topp = MY_OPERATOR(1:MIN(LEN_TRIM(MY_OPERATOR),7))
+!-
+  IF (INDEX(indchfun,topp(:LEN_TRIM(topp))) > 0) THEN
+    scal = missing_val
+    DO jj = 1,jjm
+      buff_tmp1(1:siz1) = var(:,jj)
+      ist = (jj-1)*req_sz+1
+      CALL mathop &
+ &      (topp,siz1,buff_tmp1,missing_val,nbindex,ijndex, &
+ &       scal,req_sz,buff_tmp2(ist:ist+req_sz-1))
+    ENDDO
+  ELSE
+    CALL ipslerr (3,'restput_opp_r2d', &
+ &    'The operation you wish to do on the variable for the ', &
+ &    'restart file is not allowed.',topp)
+  ENDIF
+!-
+  CALL restput_real &
+ & (fid,vname_q,xax_infs(fid,1,1),yax_infs(fid,1,1), &
+ &  jjm,itau,buff_tmp2)
+!-----------------------------
+END SUBROUTINE restput_opp_r2d
+!===
+SUBROUTINE restput_r1d (fid,vname_q,iim,jjm,llm,itau,var)
+!---------------------------------------------------------------------
+!- This subroutine serves as an interface to restput_real
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  REAL :: var(:)
+!-
+  INTEGER :: ji,jl,req_sz,var_sz,siz1
+  CHARACTER(LEN=70) :: str,str2
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 1.0 Allocate the temporary buffer we need
+!     to put the variable in right dimension
+!-
+  siz1 = SIZE(var)
+  var_sz = siz1
+  CALL rest_alloc (1,var_sz,l_dbg,'restput_r1d')
+!-
+! 2.0 Here we could check if the sizes specified agree
+!     with the size of the variable provided
+!-
+  req_sz = 1
+  IF (iim > 0) req_sz = req_sz*iim
+  IF (jjm > 0) req_sz = req_sz*jjm
+  IF (llm > 0) req_sz = req_sz*llm
+  IF (req_sz > var_sz) THEN
+    WRITE(str, &
+ &    '("Size of variable put to the file should be ",I6)') req_sz
+    WRITE(str2, &
+ &    '("but the provided variable is of size ",I6)') var_sz
+    CALL ipslerr (3,'restput_r1d',str,str2,' ')
+  ENDIF
+  IF (req_sz < var_sz) THEN
+    WRITE(str,'("the size of variable put to the file is ",I6)') req_sz
+    WRITE(str2,'("but the provided variable is larger ",I6)') var_sz
+    CALL ipslerr (2,'restput_r1d', &
+      'There could be a problem here :',str,str2)
+  ENDIF
+!-
+! 4.0 Transfer the buffer obtained from the restart file
+!     into the variable the model expects
+!-
+  jl=0
+  DO ji=1,siz1
+    jl=jl+1
+    buff_tmp1(jl) = var(ji)
+  ENDDO
+!-
+  CALL restput_real (fid,vname_q,iim,jjm,llm,itau,buff_tmp1)
+!-------------------------
+END SUBROUTINE restput_r1d
+!===
+SUBROUTINE restput_r2d (fid,vname_q,iim,jjm,llm,itau,var)
+!---------------------------------------------------------------------
+!- This subroutine serves as an interface to restput_real
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  REAL :: var(:,:)
+!-
+  INTEGER :: ji,jj,jl,req_sz,var_sz,siz1,siz2
+  CHARACTER(LEN=70) :: str,str2
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 1.0 Allocate the temporary buffer we need
+!     to put the variable in right dimension
+!-
+  siz1 = SIZE(var,1)
+  siz2 = SIZE(var,2)
+  var_sz = siz1*siz2
+  CALL rest_alloc (1,var_sz,l_dbg,'restput_r2d')
+!-
+! 2.0 Here we could check if the sizes specified agree
+!     with the size of the variable provided
+!-
+  req_sz = 1
+  IF (iim > 0) req_sz = req_sz*iim
+  IF (jjm > 0) req_sz = req_sz*jjm
+  IF (llm > 0) req_sz = req_sz*llm
+  IF (req_sz > var_sz) THEN
+    WRITE(str, &
+&         '("Size of variable put to the file should be ",I6)') req_sz
+    WRITE(str2,'("but the provided variable is of size  ",I6)') var_sz
+    CALL ipslerr (3,'restput_r2d',str,str2,' ')
+  ENDIF
+  IF (req_sz < var_sz) THEN
+    WRITE(str,'("the size of variable put to the file is ",I6)') req_sz
+    WRITE(str2,'("but the provided variable is larger ",I6)')  var_sz
+    CALL ipslerr (2,'restput_r2d', &
+      'There could be a problem here :',str,str2)
+  ENDIF
+!-
+! 4.0 Transfer the buffer obtained from the restart file
+!     into the variable the model expects
+!-
+  jl=0
+  DO jj=1,siz2
+    DO ji=1,siz1
+      jl=jl+1
+      buff_tmp1(jl) = var(ji,jj)
+    ENDDO
+  ENDDO
+!-
+  CALL restput_real(fid,vname_q,iim,jjm,llm,itau,buff_tmp1)
+!-------------------------
+END SUBROUTINE restput_r2d
+!===
+SUBROUTINE restput_r3d (fid,vname_q,iim,jjm,llm,itau,var)
+!---------------------------------------------------------------------
+!- This subroutine serves as an interface to restput_real
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  REAL :: var(:,:,:)
+!-
+  INTEGER :: ji,jj,jk,jl,req_sz,var_sz,siz1,siz2,siz3
+  CHARACTER(LEN=70) :: str,str2
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 1.0 Allocate the temporary buffer we need
+!     to put the variable in right dimension
+!-
+  siz1 = SIZE(var,1)
+  siz2 = SIZE(var,2)
+  siz3 = SIZE(var,3)
+  var_sz = siz1*siz2*siz3
+  CALL rest_alloc (1,var_sz,l_dbg,'restput_r3d')
+!-
+! 2.0 Here we could check if the sizes specified agree
+!     with the size of the variable provided
+!-
+  req_sz = 1
+  IF (iim > 0) req_sz = req_sz*iim
+  IF (jjm > 0) req_sz = req_sz*jjm
+  IF (llm > 0) req_sz = req_sz*llm
+  IF (req_sz > var_sz) THEN
+    WRITE(str, &
+ &    '("Size of variable put to the file should be ",I6)') req_sz
+    WRITE(str2, &
+ &    '("but the provided variable is of size  ",I6)')  var_sz
+    CALL ipslerr (3,'restput_r3d',str,str2,' ')
+  ENDIF
+  IF (req_sz < var_sz) THEN
+    WRITE(str,'("the size of variable put to the file is ",I6)') req_sz
+    WRITE(str2,'("but the provided variable is larger ",I6)')  var_sz
+    CALL ipslerr (2,'restput_r3d', &
+      'There could be a problem here :',str,str2)
+  ENDIF
+!-
+! 4.0 Transfer the buffer obtained from the restart file
+!     into the variable the model expects
+!-
+  jl=0
+  DO jk=1,siz3
+    DO jj=1,siz2
+      DO ji=1,siz1
+        jl=jl+1
+        buff_tmp1(jl) = var(ji,jj,jk)
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  CALL restput_real(fid,vname_q,iim,jjm,llm,itau,buff_tmp1)
+!-------------------------
+END SUBROUTINE restput_r3d
+!===
+SUBROUTINE restput_real (fid,vname_q,iim,jjm,llm,itau,var)
+!---------------------------------------------------------------------
+!- This subroutine will put a variable into the restart file.
+!- But it will do a lot of other things if needed :
+!- - Open a file if non is opened for this time-step
+!-   and all variables were written.
+!- - Add an axis if needed
+!- - verify that the variable has the right time step for this file
+!- - If it is time for a new file then it is opened
+!-   and the old one closed
+!- This requires that variables read from the last restart file were all
+!- written
+!-
+!- INPUT
+!-
+!- fid         : Id of the file in which we will write the variable
+!- vname_q     : Name of the variable to be written
+!- iim,jjm,llm : Size in 3D of the variable
+!- itau        : Time step at which the variable is written
+!- var         : Variable
+!-
+!- OUTPUT
+!-
+!- NONE
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: fid,iim,jjm,llm,itau
+  REAL :: var(:)
+!-
+  INTEGER :: iret,vid,ncid,iv,vnb
+  INTEGER :: ierr
+  REAL :: secsince,one_day,one_year
+  INTEGER :: ndims
+  INTEGER,DIMENSION(4) :: corner,edge
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 0.0 Get some variables
+!-
+  ncid = netcdf_id(fid,2)
+  IF (netcdf_id(fid,2) < 0) THEN
+    CALL ipslerr (3,'restput', &
+ &    'The output restart file is undefined.',' ',' ')
+  ENDIF
+  CALL ioget_calendar (one_year,one_day)
+!-
+! 1.0 Check if the variable is already present
+!-
+  IF (l_dbg) WRITE(*,*) 'RESTPUT 1.0 : ',TRIM(vname_q)
+!-
+  CALL find_str (varname_out(fid,1:nbvar_out(fid)),vname_q,vnb)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) 'RESTPUT 1.1 : ',varname_out(fid,1:nbvar_out(fid)),vnb
+  ENDIF
+!-
+! 2.0 If variable is not present then declare it
+!     and add extra dimensions if needed.
+!-
+  IF (vnb <= 0) THEN
+    CALL restdefv (fid,vname_q,iim,jjm,llm,.TRUE.)
+    vnb = nbvar_out(fid)
+  ENDIF
+  vid = varid_out(fid,vnb)
+!-
+  IF (l_dbg) WRITE(*,*) 'RESTPUT 2.0 : ',vnb,vid
+!-
+! 2.1 Is this file already in write mode ?
+!     If itau_out is still negative then we have
+!     never written to it and we need to go into write mode.
+!-
+  IF (itau_out(fid) < 0) THEN
+    iret = NF90_ENDDEF(ncid)
+  ENDIF
+!-
+! 3.0 Is this itau already on the axis ?
+!     If not then check that all variables of previous time is OK.
+!-
+  IF (l_dbg) WRITE(*,*) 'RESTPUT 3.0 : ',itau,itau_out(fid)
+!-
+  IF (itau /= itau_out(fid)) THEN
+!---
+!-- If it is the first time step written on the restart
+!-- then we only check the number
+!-- Else we see if every variable was written
+!---
+    IF (tstp_out(fid) == 0) THEN
+      IF (nbvar_out(fid) < nbvar_read(fid)) THEN
+        WRITE(*,*) "ERROR :",tstp_out(fid), &
+                   nbvar_out(fid),nbvar_read(fid)
+        CALL ipslerr (1,'restput', &
+ &        'There are fewer variables read from the output file', &
+ &        'than written onto the input file.', &
+ &        'We trust you know what you are doing')
+      ENDIF
+    ELSE
+      ierr = 0
+      DO iv=1,nbvar_out(fid)
+        IF (.NOT.touched_out(fid,iv)) ierr = ierr+1
+      ENDDO
+      IF (ierr > 0) THEN
+        WRITE(*,*) "ERROR :",nbvar_out(fid)
+        CALL ipslerr (1,'restput', &
+ &        'There are fewer variables in the output file for this', &
+ &        'time step than for the previous one',' ')
+      ELSE
+        touched_out(fid,:) = .FALSE.
+      ENDIF
+    ENDIF
+!---
+    secsince = itau*deltat(fid)
+    corner(1) =  tstp_out(fid)+1
+    edge(1) = 1
+!---
+!-- 3.1 Here we add the values to the time axes
+!---
+    IF (l_dbg) THEN
+      WRITE(*,*) 'RESTPUT 3.1 : ',itau,secsince,corner(1),edge(1)
+    ENDIF
+!---
+    iret = NF90_PUT_VAR(ncid,tind_varid_out(fid),itau, &
+ &                      start=corner(1:1))
+    iret = NF90_PUT_VAR(ncid,tax_varid_out(fid),secsince, &
+ &                      start=corner(1:1))
+!---
+    tstp_out(fid) = tstp_out(fid)+1
+    itau_out(fid) = itau
+  ENDIF
+!-
+! 4.0 Variable and time step should be present
+!     now so we can dump variable
+!-
+  ndims = 0
+  IF (iim > 0) THEN
+    ndims = ndims+1
+    corner(ndims) = 1
+    edge(ndims) = iim
+  ENDIF
+  IF (jjm > 0) THEN
+    ndims = ndims+1
+    corner(ndims) = 1
+    edge(ndims) = jjm
+  ENDIF
+  IF (llm > 0) THEN
+    ndims = ndims+1
+    corner(ndims) = 1
+    edge(ndims) = llm
+  ENDIF
+  ndims = ndims+1
+  corner(ndims) = tstp_out(fid)
+  edge(ndims) = 1
+!-
+  iret = NF90_PUT_VAR(ncid,vid,var, &
+ &                    start=corner(1:ndims),count=edge(1:ndims))
+!-
+  IF (iret /= NF90_NOERR) THEN
+    CALL ipslerr (2,'restput_real',NF90_STRERROR(iret), &
+ &    'Bug in restput.',&
+ &    'Please, verify compatibility between get and put commands.')
+  ENDIF
+!-
+!  5.0 Note that the variables was treated
+!-
+  touched_out(fid,vnb) = .TRUE.
+!---------------------------
+END  SUBROUTINE restput_real
+!===
+SUBROUTINE restdefv (fid,varname,iim,jjm,llm,write_att)
+!---------------------------------------------------------------------
+! This subroutine adds a variable to the output file.
+! The attributes are either taken from.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER ::fid
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim,jjm,llm
+  LOGICAL :: write_att
+!-
+  INTEGER :: dims(4),ic,xloc,ndim,ncfid
+  INTEGER :: iret,ax_id
+  CHARACTER(LEN=3) :: str
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  ncfid = netcdf_id(fid,2)
+  IF (nbvar_out(fid) >= max_var) THEN
+    CALL ipslerr (3,'restdefv', &
+      'Too many variables for the restcom module', &
+      'Please increase the value of max_var',' ')
+  ENDIF
+  nbvar_out(fid) = nbvar_out(fid)+1
+  varname_out(fid,nbvar_out(fid)) = varname
+!-
+! 0.0 Put the file in define mode if needed
+!-
+  IF (itau_out(fid) >= 0) THEN
+    iret = NF90_REDEF(ncfid)
+  ENDIF
+!-
+! 1.0 Do we have all dimensions and can we go ahead
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) 'restdefv 1.0 :',TRIM(varname),nbvar_out(fid)
+  ENDIF
+!-
+  ndim = 0
+!-
+! 1.1 Work on x
+!-
+  IF (iim > 0) THEN
+    ndim = ndim+1
+    xloc = 0
+    DO ic=1,xax_nb(fid)
+      IF (xax_infs(fid,ic,1) == iim) xloc = ic
+    ENDDO
+!---
+    IF (xloc > 0) THEN
+      dims(ndim) = xax_infs(fid,xloc,2)
+    ELSE
+      str='x_'//CHAR(96+xax_nb(fid))
+      iret = NF90_DEF_DIM(ncfid,str,iim,ax_id)
+      xax_nb(fid) = xax_nb(fid)+1
+      xax_infs(fid,xax_nb(fid),1) = iim
+      xax_infs(fid,xax_nb(fid),2) = ax_id
+      dims(ndim) = ax_id
+    ENDIF
+  ENDIF
+!-
+! 1.2 Work on y
+!-
+  IF (jjm > 0) THEN
+    ndim = ndim+1
+    xloc = 0
+    DO ic=1,yax_nb(fid)
+      IF (yax_infs(fid,ic,1) == jjm) xloc = ic
+    ENDDO
+!---
+    IF (xloc > 0) THEN
+      dims(ndim) = yax_infs(fid,xloc,2)
+    ELSE
+      str='y_'//CHAR(96+yax_nb(fid))
+      iret = NF90_DEF_DIM(ncfid,str,jjm,ax_id)
+      yax_nb(fid) = yax_nb(fid)+1
+      yax_infs(fid,yax_nb(fid),1) = jjm
+      yax_infs(fid,yax_nb(fid),2) = ax_id
+      dims(ndim) = ax_id
+    ENDIF
+  ENDIF
+!-
+! 1.3 Work on z
+!-
+  IF (llm > 0) THEN
+    ndim = ndim+1
+    xloc = 0
+    DO ic=1,zax_nb(fid)
+      IF (zax_infs(fid,ic,1) == llm) xloc = ic
+    ENDDO
+!---
+    IF (xloc > 0) THEN
+      dims(ndim) = zax_infs(fid,xloc,2)
+    ELSE
+      str='z_'//CHAR(96+zax_nb(fid))
+      iret = NF90_DEF_DIM(ncfid,str,llm,ax_id)
+      zax_nb(fid) = zax_nb(fid)+1
+      zax_infs(fid,zax_nb(fid),1) = llm
+      zax_infs(fid,zax_nb(fid),2) = ax_id
+      dims(ndim) = ax_id
+    ENDIF
+  ENDIF
+!-
+! 1.4  Time needs to be added
+!-
+  ndim = ndim+1
+  dims(ndim) = tdimid_out(fid)
+!-
+! 2.0  Declare the variable
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) 'restdefv 2.0 :',ndim,' :: ',dims(1:ndim),tdimid_out(fid)
+  ENDIF
+!-
+  iret = NF90_DEF_VAR(ncfid,varname,NF90_DOUBLE,dims(1:ndim), &
+ &                    varid_out(fid,nbvar_out(fid)))
+  IF (iret /= NF90_NOERR) THEN
+    CALL ipslerr (3,'restdefv', &
+      'Could not define new variable in file', &
+      NF90_STRERROR(iret),varname)
+  ENDIF
+!-
+! 3.0 Add the attributes if requested
+!-
+  IF (write_att) THEN
+    IF (rest_units /= 'XXXXX') THEN
+      iret =  NF90_PUT_ATT(ncfid,varid_out(fid,nbvar_out(fid)), &
+ &                         'units',TRIM(rest_units))
+      rest_units = 'XXXXX'
+    ENDIF
+!---
+    IF (rest_lname /= 'XXXXX') THEN
+      iret =  NF90_PUT_ATT(ncfid,varid_out(fid,nbvar_out(fid)), &
+ &                         'long_name',TRIM(rest_lname))
+      rest_lname = 'XXXXX'
+    ENDIF
+!---
+    iret = NF90_PUT_ATT(ncfid,varid_out(fid,nbvar_out(fid)), &
+ &                      'missing_value',REAL(missing_val,KIND=4))
+!---
+    IF (itau_out(fid) >= 0) THEN
+      iret = NF90_ENDDEF(ncfid)
+    ENDIF
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) &
+ &    'restdefv 3.0 : LIST OF VARS ',varname_out(fid,1:nbvar_out(fid))
+  ENDIF
+!----------------------
+END SUBROUTINE restdefv
+!===
+SUBROUTINE rest_atim (l_msg,c_p)
+!---------------------------------------------------------------------
+! Called by "c_p", [re]allocate the time axes
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  LOGICAL,INTENT(IN) :: l_msg
+  CHARACTER(LEN=*),INTENT(IN) :: c_p
+!-
+  INTEGER :: i_err,tszij
+  INTEGER,ALLOCATABLE :: tmp_index(:,:)
+  REAL,ALLOCATABLE :: tmp_julian(:,:)
+!---------------------------------------------------------------------
+!-
+!  Allocate the space we need for the time axes
+!-
+  IF (.NOT.ALLOCATED(t_index) .AND. .NOT.ALLOCATED(t_julian)) THEN
+    IF (l_msg) THEN
+      WRITE(*,*) TRIM(c_p)//' : Allocate times axes at :', &
+ &               max_file,tax_size_in(nb_fi)
+    ENDIF
+!---
+    ALLOCATE(t_index(max_file,tax_size_in(nb_fi)),STAT=i_err)
+    IF (i_err/=0) THEN
+      WRITE(*,*) "ERROR IN ALLOCATION of t_index : ",i_err
+      CALL ipslerr (3,TRIM(c_p), &
+ &      'Problem in allocation of t_index','', &
+ &      '(you must increase memory)')
+    ENDIF
+    t_index (:,:) = 0
+!---
+    ALLOCATE(t_julian(max_file,tax_size_in(nb_fi)),STAT=i_err)
+    IF (i_err/=0) THEN
+      WRITE(*,*) "ERROR IN ALLOCATION of t_julian : ",i_err
+      CALL ipslerr (3,TRIM(c_p), &
+ &      'Problem in allocation of max_file,tax_size_in','', &
+ &      '(you must increase memory)')
+    ENDIF
+    t_julian (:,:) = 0.0
+  ELSE IF (    (SIZE(t_index,DIM=2)  < tax_size_in(nb_fi)) &
+ &         .OR.(SIZE(t_julian,DIM=2) < tax_size_in(nb_fi)) ) THEN
+    IF (l_msg) THEN
+      WRITE(*,*) TRIM(c_p)//' : Reallocate times axes at :', &
+ &               max_file,tax_size_in(nb_fi)
+    ENDIF
+!---
+    ALLOCATE (tmp_index(max_file,tax_size_in(nb_fi)),STAT=i_err)
+    IF (i_err/=0) THEN
+      WRITE(*,*) "ERROR IN ALLOCATION of tmp_index : ",i_err
+      CALL ipslerr (3,TRIM(c_p), &
+ &      'Problem in allocation of tmp_index','', &
+ &      '(you must increase memory)')
+    ENDIF
+    tszij = SIZE(t_index,DIM=2)
+    tmp_index(:,1:tszij) = t_index(:,1:tszij)
+    DEALLOCATE(t_index)
+    ALLOCATE (t_index(max_file,tax_size_in(nb_fi)),STAT=i_err)
+    IF (i_err/=0) THEN
+      WRITE(*,*) "ERROR IN ALLOCATION of t_index : ",i_err
+      CALL ipslerr (3,TRIM(c_p), &
+ &     'Problem in reallocation of t_index','', &
+ &     '(you must increase memory)')
+    ENDIF
+    t_index(:,1:tszij) = tmp_index(:,1:tszij)
+!---
+    ALLOCATE (tmp_julian(max_file,tax_size_in(nb_fi)),STAT=i_err)
+    IF (i_err/=0) THEN
+      WRITE(*,*) "ERROR IN ALLOCATION of tmp_julian : ",i_err
+      CALL ipslerr (3,TRIM(c_p), &
+ &     'Problem in allocation of tmp_julian','', &
+ &     '(you must increase memory)')
+    ENDIF
+    tszij = SIZE(t_julian,DIM=2)
+    tmp_julian(:,1:tszij) = t_julian(:,1:tszij)
+    DEALLOCATE(t_julian)
+    ALLOCATE (t_julian(max_file,tax_size_in(nb_fi)),STAT=i_err)
+    IF (i_err/=0) THEN
+      WRITE(*,*) "ERROR IN ALLOCATION of t_julian : ",i_err
+      CALL ipslerr (3,TRIM(c_p), &
+ &      'Problem in reallocation of t_julian','', &
+ &      '(you must increase memory)')
+    ENDIF
+    t_julian(:,1:tszij) = tmp_julian(:,1:tszij)
+  ENDIF
+!-----------------------
+END SUBROUTINE rest_atim
+!===
+SUBROUTINE rest_alloc (i_buff,i_qsz,l_msg,c_p)
+!---------------------------------------------------------------------
+! Called by "c_p", allocate a temporary buffer
+! (buff_tmp[1/2] depending on "i_buff" value) to the size "i_qsz".
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: i_buff,i_qsz
+  LOGICAL,INTENT(IN) :: l_msg
+  CHARACTER(LEN=*),INTENT(IN) :: c_p
+!-
+  INTEGER :: i_bsz,i_err
+  LOGICAL :: l_alloc1,l_alloc2
+  CHARACTER(LEN=9) :: cbn
+  CHARACTER(LEN=5) :: c_err
+!---------------------------------------------------------------------
+  IF      (i_buff == 1) THEN
+    IF (ALLOCATED(buff_tmp1)) THEN
+      i_bsz = SIZE(buff_tmp1)
+    ELSE
+      i_bsz = 0
+    ENDIF
+    l_alloc1 =    (.NOT.ALLOCATED(buff_tmp1)) &
+ &            .OR.((ALLOCATED(buff_tmp1)).AND.(i_qsz > i_bsz))
+    l_alloc2 = .FALSE.
+    cbn = 'buff_tmp1'
+  ELSE IF (i_buff == 2) THEN
+    IF (ALLOCATED(buff_tmp2)) THEN
+      i_bsz = SIZE(buff_tmp2)
+    ELSE
+      i_bsz = 0
+    ENDIF
+    l_alloc1 = .FALSE.
+    l_alloc2 =    (.NOT.ALLOCATED(buff_tmp2)) &
+ &            .OR.((ALLOCATED(buff_tmp2)).AND.(i_qsz > i_bsz))
+    cbn = 'buff_tmp2'
+  ELSE
+    CALL ipslerr (3,'rest_alloc', &
+ &    'Called by '//TRIM(c_p),'with a wrong value of i_buff','')
+  ENDIF
+!-
+!-
+  IF (l_alloc1.OR.l_alloc2) THEN
+    IF (l_msg) THEN
+      IF (    (l_alloc1.AND.ALLOCATED(buff_tmp1)) &
+ &        .OR.(l_alloc2.AND.ALLOCATED(buff_tmp2)) ) THEN
+        WRITE(*,*) TRIM(c_p)//" : re_allocate "//TRIM(cbn)//"=",i_qsz
+      ELSE
+        WRITE(*,*) TRIM(c_p)//" : allocate "//TRIM(cbn)//"=",i_qsz
+      ENDIF
+    ENDIF
+    IF (l_alloc1) THEN
+      IF (ALLOCATED(buff_tmp1)) THEN
+        DEALLOCATE(buff_tmp1)
+      ENDIF
+      ALLOCATE (buff_tmp1(i_qsz),STAT=i_err)
+    ELSE
+      IF (ALLOCATED(buff_tmp2)) THEN
+        DEALLOCATE(buff_tmp2)
+      ENDIF
+      ALLOCATE (buff_tmp2(i_qsz),STAT=i_err)
+    ENDIF
+    IF (i_err /= 0) THEN
+      WRITE (UNIT=c_err,FMT='(I5)') i_err
+      CALL ipslerr (3,TRIM(c_p), &
+ &      'Problem in allocation of',TRIM(cbn), &
+ &      'Error : '//TRIM(c_err)//' (you must increase memory)')
+    ENDIF
+  ENDIF
+!------------------------
+END SUBROUTINE rest_alloc
+!===
+SUBROUTINE ioconf_setatt (attname,value)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: attname,value
+!-
+  CHARACTER(LEN=LEN_TRIM(attname)) :: tmp_str
+!---------------------------------------------------------------------
+  tmp_str = attname
+  CALL strlowercase (tmp_str)
+!-
+  SELECT CASE(tmp_str)
+    CASE('units')
+      rest_units = value
+    CASE('long_name')
+      rest_lname = value
+    CASE DEFAULT
+      CALL ipslerr (2,'ioconf_restatt', &
+        'The attribute name provided is unknown',attname,' ')
+  END SELECT
+!---------------------------
+END SUBROUTINE ioconf_setatt
+!===
+SUBROUTINE ioget_vdim (fid,vname_q,varnbdim_max,varnbdim,vardims)
+!---------------------------------------------------------------------
+!- This routine allows the user to get the dimensions
+!- of a field in the restart file.
+!- This is the file which is read.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER,INTENT(IN) :: varnbdim_max
+  INTEGER,INTENT(OUT) ::  varnbdim
+  INTEGER,DIMENSION(varnbdim_max),INTENT(OUT) :: vardims
+!-
+  INTEGER :: vnb
+!---------------------------------------------------------------------
+! Find the index of the variable
+  CALL find_str (varname_in(fid,1:nbvar_in(fid)),vname_q,vnb)
+!-
+  IF (vnb > 0) THEN
+    varnbdim = varnbdim_in(fid,vnb)
+    IF (varnbdim_max < varnbdim) THEN
+      CALL ipslerr (3,'ioget_vdim', &
+        'The provided array for the variable dimensions is too small', &
+        '','')
+    ELSE
+      vardims(1:varnbdim) = vardims_in(fid,vnb,1:varnbdim)
+    ENDIF
+  ELSE
+    varnbdim = 0
+    CALL ipslerr (2,'ioget_vdim', &
+      'Variable '//TRIM(vname_q)//' not found','','')
+  ENDIF
+!------------------------
+END SUBROUTINE ioget_vdim
+!===
+SUBROUTINE ioget_vname (fid,nbvar,varnames)
+!---------------------------------------------------------------------
+!- This routine allows the user to extract the list
+!- of variables in an opened restart file.
+!- This is the file which is read
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: fid
+  INTEGER,INTENT(OUT) ::  nbvar
+  CHARACTER(LEN=*),INTENT(OUT) :: varnames(:)
+!---------------------------------------------------------------------
+  nbvar = nbvar_in(fid)
+!-
+  IF (SIZE(varnames) < nbvar) THEN
+    CALL ipslerr (3,'ioget_vname', &
+      'The provided array for the variable names is too small','','')
+  ELSE
+    varnames(1:nbvar) = varname_in(fid,1:nbvar)
+  ENDIF
+!-------------------------
+END SUBROUTINE ioget_vname
+!===
+SUBROUTINE ioconf_expval (new_exp_val)
+!---------------------------------------------------------------------
+!- The default value written into the variables which are not
+!- in the restart file can only be changed once.
+!- This avoids further complications.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  REAL :: new_exp_val
+!---------------------------------------------------------------------
+  IF (.NOT.lock_valexp) THEN
+    lock_valexp = .TRUE.
+    val_exp = new_exp_val
+  ELSE
+    CALL ipslerr (2,'ioconf_expval', &
+     'The default value for variable' &
+   //'not available in the restart file ', &
+     'has already been locked and can not be changed at this point', &
+     ' ')
+  ENDIF
+!---------------------------
+END SUBROUTINE ioconf_expval
+!===
+SUBROUTINE ioget_expval (get_exp_val)
+!---------------------------------------------------------------------
+!- Once the user has extracted the default value,
+!- we lock it so that it can not be changed anymore.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  REAL :: get_exp_val
+!---------------------------------------------------------------------
+  get_exp_val = val_exp
+  lock_valexp = .TRUE.
+!--------------------------
+END SUBROUTINE ioget_expval
+!===
+SUBROUTINE restclo (fid)
+!---------------------------------------------------------------------
+!- This subroutine closes one or any opened restart file.
+!-
+!- INPUT
+!-
+!- fid    : File ID in the restcom system (not the netCDF ID)(optional)
+!-
+!- OUTPUT
+!-
+!- NONE
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(in),OPTIONAL :: fid
+!-
+  INTEGER :: iret,ifnc
+  CHARACTER(LEN=6) :: n_e
+  CHARACTER(LEN=3) :: n_f
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (PRESENT(fid)) THEN
+!---
+    IF (l_dbg) THEN
+      WRITE(*,*) &
+        'restclo : Closing specified restart file number :', &
+        fid,netcdf_id(fid,1:2)
+    ENDIF
+!---
+    IF (netcdf_id(fid,1) > 0) THEN
+      iret = NF90_CLOSE(netcdf_id(fid,1))
+      IF (iret /= NF90_NOERR) THEN
+        WRITE (n_e,'(I6)') iret
+        WRITE (n_f,'(I3)') netcdf_id(fid,1)
+        CALL ipslerr (2,'restclo', &
+          "Error "//n_e//" in closing file : "//n_f,'',' ')
+      ENDIF
+      IF (netcdf_id(fid,1) == netcdf_id(fid,2)) THEN
+        netcdf_id(fid,2) = -1
+      ENDIF
+      netcdf_id(fid,1) = -1
+    ENDIF
+!---
+    IF (netcdf_id(fid,2) > 0)  THEN
+      iret = NF90_CLOSE(netcdf_id(fid,2))
+      IF (iret /= NF90_NOERR) THEN
+        WRITE (n_e,'(I6)') iret
+        WRITE (n_f,'(I3)') netcdf_id(fid,2)
+        CALL ipslerr (2,'restclo', &
+          "Error "//n_e//" in closing file : "//n_f,'',' ')
+      ENDIF
+      netcdf_id(fid,2) = -1
+    ENDIF
+!---
+  ELSE
+!---
+    IF (l_dbg) WRITE(*,*) 'restclo : Closing all files'
+!---
+    DO ifnc=1,nb_fi
+      IF (netcdf_id(ifnc,1) > 0) THEN
+        iret = NF90_CLOSE(netcdf_id(ifnc,1))
+        IF (iret /= NF90_NOERR) THEN
+          WRITE (n_e,'(I6)') iret
+          WRITE (n_f,'(I3)') netcdf_id(ifnc,1)
+          CALL ipslerr (2,'restclo', &
+            "Error "//n_e//" in closing file : "//n_f,'',' ')
+        ENDIF
+        IF (netcdf_id(ifnc,1) == netcdf_id(ifnc,2)) THEN
+          netcdf_id(ifnc,2) = -1
+        ENDIF
+        netcdf_id(ifnc,1) = -1
+      ENDIF
+!-----
+      IF (netcdf_id(ifnc,2) > 0) THEN
+        iret = NF90_CLOSE(netcdf_id(ifnc,2))
+        IF (iret /= NF90_NOERR) THEN
+          WRITE (n_e,'(I6)') iret
+          WRITE (n_f,'(I3)') netcdf_id(ifnc,2)
+          CALL ipslerr (2,'restclo', &
+            "Error "//n_e//" in closing file : "//n_f,'',' ')
+        END IF
+        netcdf_id(ifnc,2) = -1
+      ENDIF
+    ENDDO
+  ENDIF
+!---------------------
+END SUBROUTINE restclo
+!===
+!-----------------
+END MODULE restcom
Index: trunk/NEMOGCM/EXTERNAL/IOIPSL/src/stringop.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/IOIPSL/src/stringop.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/IOIPSL/src/stringop.f90	(revision 2528)
@@ -0,0 +1,185 @@
+MODULE stringop
+!-
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+CONTAINS
+!=
+SUBROUTINE cmpblank (str)
+!---------------------------------------------------------------------
+!- Compact blanks
+!---------------------------------------------------------------------
+  CHARACTER(LEN=*),INTENT(inout) :: str
+!-
+  INTEGER :: lcc,ipb
+!---------------------------------------------------------------------
+  lcc = LEN_TRIM(str)
+  ipb = 1
+  DO
+    IF (ipb >= lcc)   EXIT
+    IF (str(ipb:ipb+1) == '  ') THEN
+      str(ipb+1:) = str(ipb+2:lcc)
+      lcc = lcc-1
+    ELSE
+      ipb = ipb+1
+    ENDIF
+  ENDDO
+!----------------------
+END SUBROUTINE cmpblank
+!===
+INTEGER FUNCTION cntpos (c_c,l_c,c_r,l_r)
+!---------------------------------------------------------------------
+!- Finds number of occurences of c_r in c_c
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(in) :: c_c
+  INTEGER,INTENT(IN) :: l_c
+  CHARACTER(LEN=*),INTENT(in) :: c_r
+  INTEGER,INTENT(IN) :: l_r
+!-
+  INTEGER :: ipos,indx
+!---------------------------------------------------------------------
+  cntpos = 0
+  ipos   = 1
+  DO
+    indx = INDEX(c_c(ipos:l_c),c_r(1:l_r))
+    IF (indx > 0) THEN
+      cntpos = cntpos+1
+      ipos   = ipos+indx+l_r-1
+    ELSE
+      EXIT
+    ENDIF
+  ENDDO
+!------------------
+END FUNCTION cntpos
+!===
+INTEGER FUNCTION findpos (c_c,l_c,c_r,l_r)
+!---------------------------------------------------------------------
+!- Finds position of c_r in c_c
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(in) :: c_c
+  INTEGER,INTENT(IN) :: l_c
+  CHARACTER(LEN=*),INTENT(in) :: c_r
+  INTEGER,INTENT(IN) :: l_r
+!---------------------------------------------------------------------
+  findpos = INDEX(c_c(1:l_c),c_r(1:l_r))
+  IF (findpos == 0)  findpos=-1
+!-------------------
+END FUNCTION findpos
+!===
+SUBROUTINE find_str (str_tab,str,pos)
+!---------------------------------------------------------------------
+!- This subroutine looks for a string in a table
+!---------------------------------------------------------------------
+!- INPUT
+!-   str_tab  : Table  of strings
+!-   str      : Target we are looking for
+!- OUTPUT
+!-   pos      : -1 if str not found, else value in the table
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),DIMENSION(:),INTENT(in) :: str_tab
+  CHARACTER(LEN=*),INTENT(in) :: str
+  INTEGER,INTENT(out) :: pos
+!-
+  INTEGER :: nb_str,i
+!---------------------------------------------------------------------
+  pos = -1
+  nb_str=SIZE(str_tab)
+  IF ( nb_str > 0 ) THEN
+    DO i=1,nb_str
+      IF ( TRIM(str_tab(i)) == TRIM(str) ) THEN
+        pos = i
+        EXIT
+      ENDIF
+    ENDDO
+  ENDIF
+!----------------------
+END SUBROUTINE find_str
+!===
+SUBROUTINE nocomma (str)
+!---------------------------------------------------------------------
+!- Replace commas with blanks
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: str
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  DO i=1,LEN_TRIM(str)
+    IF (str(i:i) == ',')   str(i:i) = ' '
+  ENDDO
+!---------------------
+END SUBROUTINE nocomma
+!===
+SUBROUTINE strlowercase (str)
+!---------------------------------------------------------------------
+!- Converts a string into lowercase
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: str
+!-
+  INTEGER :: i,ic
+!---------------------------------------------------------------------
+  DO i=1,LEN_TRIM(str)
+    ic = IACHAR(str(i:i))
+    IF ( (ic >= 65).AND.(ic <= 90) )  str(i:i) = ACHAR(ic+32)
+  ENDDO
+!--------------------------
+END SUBROUTINE strlowercase
+!===
+SUBROUTINE struppercase (str)
+!---------------------------------------------------------------------
+!- Converts a string into uppercase
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: str
+!-
+  INTEGER :: i,ic
+!---------------------------------------------------------------------
+  DO i=1,LEN_TRIM(str)
+    ic = IACHAR(str(i:i))
+    IF ( (ic >= 97).AND.(ic <= 122) )  str(i:i) = ACHAR(ic-32)
+  ENDDO
+!--------------------------
+END SUBROUTINE struppercase
+!===
+SUBROUTINE str_xfw (c_string,c_word,l_ok)
+!---------------------------------------------------------------------
+!- Given a character string "c_string", of arbitrary length,
+!- returns a logical flag "l_ok" if a word is found in it,
+!- the first word "c_word" if found and the new string "c_string"
+!- without the first word "c_word"
+!---------------------------------------------------------------------
+  CHARACTER(LEN=*),INTENT(INOUT) :: c_string
+  CHARACTER(LEN=*),INTENT(OUT) :: c_word
+  LOGICAL,INTENT(OUT) :: l_ok
+!-
+  INTEGER :: i_b,i_e
+!---------------------------------------------------------------------
+  l_ok = (LEN_TRIM(c_string) > 0)
+  IF (l_ok) THEN
+    i_b = VERIFY(c_string,' ')
+    i_e = INDEX(c_string(i_b:),' ')
+    IF (i_e == 0) THEN
+      c_word = c_string(i_b:)
+      c_string = ""
+    ELSE
+      c_word = c_string(i_b:i_b+i_e-2)
+      c_string = ADJUSTL(c_string(i_b+i_e-1:))
+    ENDIF
+  ENDIF
+!---------------------
+END SUBROUTINE str_xfw
+!===
+!------------------
+END MODULE stringop
Index: trunk/NEMOGCM/EXTERNAL/IOIPSL/tools/Fparser.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/IOIPSL/tools/Fparser.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/IOIPSL/tools/Fparser.f90	(revision 2528)
@@ -0,0 +1,793 @@
+PROGRAM fparser
+!-
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+
+  USE stringop
+
+  IMPLICIT NONE
+  !
+  !
+  !     Parses the code to create the Config.in Config.default and Config.help
+  !     which are used by the tk shell.
+  !
+  !
+  INTEGER nbkeymax, nbhelpmax, nbcasemax, nbsourmax, nbelmax
+  PARAMETER (nbkeymax=100, nbhelpmax=50, nbcasemax=50, nbsourmax=20,nbelmax=nbhelpmax+10)
+  INTEGER nbfilesmax
+  PARAMETER (nbfilesmax=150)
+
+  !
+  CHARACTER*120 :: configs(nbkeymax,nbelmax)
+  CHARACTER*120 :: tmp_help, tmp_key, tmp_desc, tmp_def
+  INTEGER :: keylen(nbkeymax), nbkeys
+  INTEGER :: key_pos(nbkeymax), help_pos(nbkeymax,2), def_pos(nbkeymax,2)
+  INTEGER :: des_pos(nbkeymax), IF_pos(nbkeymax)
+  CHARACTER*6 TYPE_op(nbkeymax)
+  !
+  CHARACTER*120 :: def_out(nbkeymax, nbhelpmax)
+  INTEGER :: nbdef_out(nbkeymax)
+  !
+  CHARACTER*120 :: tke
+  !
+  CHARACTER*2 :: nbstr
+  !
+  CHARACTER*80 :: files(nbfilesmax), source(nbsourmax), filetmp
+  CHARACTER*80 :: tmp, main_name
+  CHARACTER*120 :: keycase(nbcasemax), tmp_CASE
+  INTEGER :: nbcase, ii, find, nbsource
+  LOGICAL :: next_source, next_name, last_or
+
+  LOGICAL :: is_main, cont
+
+  CHARACTER*1 :: backslash, simplequote, doublequote
+
+  INTEGER :: ia, iread, iret, IFF, ih, nb_line, iv, id
+  INTEGER :: ind_space, ind_comma, ind_USE
+  INTEGER :: nbfiles, nb_key, nb_key_file
+  !
+  INTEGER, EXTERNAL ::  iargc, getarg 
+  !
+  !
+  next_source = .FALSE.
+  next_name = .FALSE.
+  is_main = .FALSE.
+  nbsource = 0
+  nbfiles = 0
+  main_name = 'IPSL'
+  !
+  backslash = ACHAR(92)
+  simplequote = ACHAR(39)
+  doublequote = ACHAR(34)
+  !
+  !
+  !
+  !     Analyse command line
+  !
+  !
+  !     Get the number of arguments, that is the options and the
+  !     files to be parsed.
+  !
+  !
+
+  iread = iargc()
+  !
+  DO ia=1,iread
+     !
+     iret = getarg(ia,tmp)
+     !
+     IF (next_source) THEN
+
+        nbsource = nbsource + 1
+        IF ( nbsource .GT. nbsourmax) THEN
+           WRITE(*,*) 'Too many files to source in the arguments.' 
+           WRITE(*,*) 'Increase nbsourmax'
+           STOP
+        ELSE
+           source(nbsource) = tmp(1:LEN_TRIM(tmp))
+        ENDIF
+        next_source = .FALSE.
+
+     ELSE IF (next_name) THEN
+        main_name = tmp(1:LEN_TRIM(tmp))
+        next_name = .FALSE.
+
+     ELSE
+        !     
+        IF ( INDEX(tmp,'-m') .GT. 0) THEN
+           is_main = .TRUE.
+        ELSE IF ( INDEX(tmp,'-n') .GT. 0) THEN
+           next_name = .TRUE.
+        ELSE IF ( INDEX(tmp,'-s') .GT. 0) THEN
+           next_source = .TRUE.
+        ELSE IF ( INDEX(tmp,'-h') .GT. 0) THEN
+           WRITE(*,*) 'USAGE : Fparse [-name NAME] '
+           WRITE(*,*) '               [-source file_to_source]'
+           WRITE(*,*) '               [-main] FORTAN_files'
+        ELSE
+           nbfiles = nbfiles + 1
+           IF ( nbfiles .GT. nbfilesmax) THEN
+              WRITE(*,*) 'Too many files to include in &
+                   &                 the arguments.' 
+              WRITE(*,*) 'Increase nbfilesmax'
+              STOP
+           ELSE
+              files(nbfiles) = tmp(1:LEN_TRIM(tmp))
+           ENDIF
+        ENDIF
+
+     ENDIF
+
+  ENDDO
+  !
+  IF ( nbfiles .LT. 1 ) THEN
+     WRITE(*,*) 'No files provided'
+     STOP
+  ENDIF
+  !
+  !
+  !     1.0 Read files and extract the lines which we need
+  !
+  !
+  nb_key = 0
+  !
+  DO IFF=1,nbfiles
+     !
+     filetmp = files(IFF)
+     CALL READ_from_file(filetmp, nbkeymax, nbelmax, configs, nb_key, keylen)
+     !
+  ENDDO
+  !
+  !     2.0 Scan the information we have extracted from the file for the elements we need
+  !
+  !
+  CALL analyse_configs(nbkeymax, nb_key, nbelmax, keylen, configs, key_pos, help_pos, def_pos, des_pos, IF_pos, TYPE_op)
+  !
+  !
+  !  3.0 Prepare the default values to put them in an array
+  !
+  !
+  DO ia = 1,nb_key
+     !
+     !  3.1 Go to blank delimited lines
+     !
+     nbdef_out(ia) = 0
+     !
+     DO ii=def_pos(ia,1), def_pos(ia,2)
+        !
+        tmp_help = configs(ia,ii)
+        ind_comma = INDEX(tmp_help(1:len_TRIM(tmp_help)),',')
+        DO WHILE (ind_comma .GT. 0) 
+           tmp_help(ind_comma:ind_comma) = ' '
+           ind_comma = INDEX(tmp_help,',')
+        ENDDO
+        CALL cmpblank(tmp_help)
+        configs(ia,ii) = tmp_help
+        !
+        !  3.2 extract the values
+        !
+        tmp_help = TRIM(ADJUSTL(configs(ia,ii)))
+        ind_space= INDEX(tmp_help(1:LEN_TRIM(tmp_help)),' ')
+        ! Get the first one (there is no space in between)
+        IF ( ind_space .EQ. 0) THEN
+           nbdef_out(ia) = nbdef_out(ia) + 1
+           def_out(ia, nbdef_out(ia)) = tmp_help(1:LEN_TRIM(tmp_help))
+        ELSE
+           ! Get all those which are before spaces
+           DO WHILE (ind_space .GT. 0) 
+              nbdef_out(ia) = nbdef_out(ia) + 1
+              def_out(ia, nbdef_out(ia)) = tmp_help(1:ind_space)
+              tmp_help = ADJUSTL(tmp_help(ind_space+1:LEN_TRIM(tmp_help)))
+              ind_space= INDEX(tmp_help(1:LEN_TRIM(tmp_help)),' ')
+           ENDDO
+           !    Get the last one which does not have a space behind
+           IF ( LEN_TRIM(tmp_help) .GT. 0) THEN
+              nbdef_out(ia) = nbdef_out(ia) + 1
+              def_out(ia, nbdef_out(ia)) = tmp_help(1:LEN_TRIM(tmp_help))
+           ENDIF
+           !
+        ENDIF
+     ENDDO
+     !
+  ENDDO
+  !
+  !
+  !
+  !      4.0 OPEN Config.in Defaults and Help files
+  !
+  !
+  OPEN (16, FILE='Config.in')
+  OPEN (17, FILE='Config.help')
+  OPEN (18, FILE='Config.defaults')
+  !
+  !     Some explantation
+  !
+  DO IFF=16,18
+     WRITE(IFF,'(1a)') '# '
+     WRITE(IFF,'(1a)') '# File created by Fparser, DO NOT EDIT'
+     WRITE(IFF,'(2a)') '# ', main_name(1:LEN_TRIM(main_name))
+     WRITE(IFF,'(1a)') '# '
+     WRITE(IFF,'(1a)') '# '
+  ENDDO
+  !
+  WRITE(17,'(2a)') '# Format of this file: description<nl>', &
+       &     ' variable<nl>helptext<nl><nl>.'
+  WRITE(17,'(2a)') '# If the question being documented is of', &
+       &     ' type "choice", we list'
+  WRITE(17,'(2a)') '# only the first occurring config variable.', &
+       &     ' The help texts'
+  WRITE(17,'(2a)') '# must not contain empty lines. No variable', &
+       &     ' should occur twice; if it'
+  WRITE(17,'(2a)') '# does, only the first occurrence will be', &
+       &     ' used by Configure. The lines'
+  WRITE(17,'(2a)') '# in a help text should be indented two', &
+       &     ' positions. Lines starting with'
+  WRITE(17,'(2a)') '# "#" are ignored. To be nice to menuconfig,', &
+       &     ' limit your lines to 70'
+  WRITE(17,'(2a)') '# characters. Use emacs" kfill.el to edit', &
+       &     ' this file or you lose.'
+  WRITE(17,'(2a)') '#'
+  !
+  IF ( is_main ) THEN
+     WRITE(16,'(3a)') 'mainmenu_name "Configuration of model ', &
+          &        main_name(1:LEN_TRIM(main_name)), '"'
+     WRITE(16,'(1a)') '# '
+  ENDIF
+  !
+  WRITE(16,'(1a)') 'mainmenu_option next_comment'
+  WRITE(16,'(3a)') 'comment "', main_name(1:LEN_TRIM(main_name)), '"'
+  WRITE(16,'(1a)') '# '
+  !
+  !   5.0 Loop through the KEYWORDS to prepare the output
+  !
+  DO IFF =1,nb_key
+     !
+     !     Config.in file
+     !
+
+     !
+     !     Is it a conditional option ?
+     !
+     IF ( IF_pos(IFF) .GE. 0)  THEN
+        tmp_help = configs(IFF,IF_pos(IFF))
+        !
+        IF ( (index(tmp_help,'||') .LE. 0) .AND. (index(tmp_help,'&&') .LE. 0) ) THEN
+           IF ( tmp_help(1:1) .EQ. '!') THEN
+              WRITE(16,'(3a)') 'if [ "$', tmp_help(2:LEN_TRIM(tmp_help)),  '" = "n" ]; then'
+           ELSE
+              WRITE(16,'(3a)') 'if [ "$', tmp_help(1:LEN_TRIM(tmp_help)),  '" = "y" ]; then'
+           ENDIF
+        ELSE
+           !
+           last_or = .TRUE.
+           nbcase = 0
+           !
+           DO WHILE( INDEX(tmp_help,'||') .GT. 0)
+              ii = INDEX(tmp_help,'||')
+              nbcase = nbcase + 1
+              if ( nbcase .EQ. 1 ) THEN
+                 IF ( tmp_help(1:1) .EQ. '!') THEN
+                    WRITE(16,'(3a)') 'if [ "$', tmp_help(2:ii-1),  '" = "n" \\'
+                 ELSE
+                    WRITE(16,'(3a)') 'if [ "$', tmp_help(1:ii-1),  '" = "y" \\'
+                 ENDIF
+              ELSE
+                 IF ( tmp_help(1:1) .EQ. '!') THEN
+                    WRITE(16,'(3a)') '-o "$', tmp_help(2:ii-1),  '" = "n" \\'
+                 ELSE
+                    WRITE(16,'(3a)') '-o "$', tmp_help(1:ii-1),  '" = "y" \\'
+                 ENDIF
+              ENDIF
+              tmp_help = TRIM(ADJUSTL(tmp_help(ii+2:LEN_TRIM(tmp_help))))
+           ENDDO
+           !
+           DO WHILE( INDEX(tmp_help,'&&') .GT. 0)
+              ii = INDEX(tmp_help,'&&')
+              nbcase = nbcase + 1
+              if ( nbcase .EQ. 1 ) THEN
+                 IF ( tmp_help(1:1) .EQ. '!') THEN
+                    WRITE(16,'(3a)') 'if [ "$', tmp_help(2:ii-1),  '" = "n" \\'
+                 ELSE
+                    WRITE(16,'(3a)') 'if [ "$', tmp_help(1:ii-1),  '" = "y" \\'
+                 ENDIF
+              ELSE
+                 IF ( tmp_help(1:1) .EQ. '!') THEN
+                    WRITE(16,'(3a)') '-a "$', tmp_help(2:ii-1),  '" = "n" \\'
+                 ELSE
+                    WRITE(16,'(3a)') '-a "$', tmp_help(1:ii-1),  '" = "y" \\'
+                 ENDIF
+              ENDIF
+              tmp_help = TRIM(ADJUSTL(tmp_help(ii+2:LEN_TRIM(tmp_help))))
+              last_or = .FALSE.
+           ENDDO
+           !
+           IF ( last_or ) THEN
+              IF ( tmp_help(1:1) .EQ. '!') THEN
+                 WRITE(16,'(3a)') '-o "$', tmp_help(2:LEN_TRIM(tmp_help)),  '" = "n" ]; then'
+              ELSE
+                 WRITE(16,'(3a)') '-o "$', tmp_help(1:LEN_TRIM(tmp_help)),  '" = "y" ]; then'
+              ENDIF
+           ELSE
+              IF ( tmp_help(1:1) .EQ. '!') THEN
+                 WRITE(16,'(3a)') '-a "$', tmp_help(2:LEN_TRIM(tmp_help)),  '" = "n" ]; then'
+              ELSE
+                 WRITE(16,'(3a)') '-a "$', tmp_help(1:LEN_TRIM(tmp_help)),  '" = "y" ]; then'
+              ENDIF
+           ENDIF
+        ENDIF
+        WRITE(16,'(1a)') '       '
+     ENDIF
+     !
+     !      Extract the information from configs
+     !
+     DO iv = 1,nbdef_out(IFF)
+
+        IF (nbdef_out(IFF) .EQ. 1) THEN
+           tmp_key = configs(IFF,key_pos(IFF))
+           tmp_desc = configs(IFF,des_pos(IFF))
+           tmp_def = def_out(IFF,iv)
+        ELSE
+           tmp_key = configs(IFF,key_pos(IFF))
+           WRITE(nbstr,'(I2.2)') iv
+           tmp_key = tmp_key(1:LEN_TRIM(tmp_key))//'__'//nbstr
+           tmp_desc = configs(IFF,des_pos(IFF))
+           IF ( iv .EQ. 1) THEN
+              tmp_desc = tmp_desc(1:LEN_TRIM(tmp_desc))//' (Vector)'
+           ELSE
+              tmp_desc = 'Cont...    '//tmp_key(1:LEN_TRIM(tmp_key))
+           ENDIF
+           tmp_def = def_out(IFF,iv)
+        ENDIF
+        !
+        !
+        !
+        IF (INDEX(TYPE_op(IFF),'bool') .GT. 0) THEN
+           !
+           WRITE(16,'(4a)') 'bool "', tmp_desc(1:LEN_TRIM(tmp_desc)), &
+                &              '" ',tmp_key(1:LEN_TRIM(tmp_key))
+           !
+        ELSE IF (INDEX(TYPE_op(IFF),'hex') .GT. 0) THEN
+           !
+           WRITE(16,'(6a)') 'hex "', tmp_desc(1:LEN_TRIM(tmp_desc)) &
+                &              ,'" ',tmp_key(1:LEN_TRIM(tmp_key)) &
+                &              ,' ',tmp_def(1:LEN_TRIM(tmp_def))
+           !
+        ELSE IF (INDEX(TYPE_op(IFF),'choice') .GT. 0) THEN
+           !
+           !   Get number of options
+           !
+           nbcase = 0
+           DO WHILE( INDEX(tmp_key,'||') .GT. 0)
+              ii = INDEX(tmp_key,'||')
+              nbcase = nbcase + 1
+              keycase(nbcase) = tmp_key(1:ii-1)
+              tmp_key=tmp_key(ii+2:LEN_TRIM(tmp_key))
+           ENDDO
+           nbcase = nbcase + 1
+           keycase(nbcase) = tmp_key(1:LEN_TRIM(tmp_key))
+
+           WRITE(16,'(4a)') "choice '", tmp_desc(1:LEN_TRIM(tmp_desc))," '",backslash
+           !
+           !   List options
+           !
+           tmp_CASE = keycase(1)
+           WRITE(16,'(5a)') '        "', tmp_CASE(1:LEN_TRIM(tmp_CASE)), "          "&
+                &,tmp_CASE(1:LEN_TRIM(tmp_CASE)), backslash
+           !
+           DO ii=2,nbcase-1
+              tmp_CASE = keycase(ii)
+              WRITE(16,'(5a)') '         ',   tmp_CASE(1:LEN_TRIM(tmp_CASE)),  '          ',&
+                   & tmp_CASE(1:LEN_TRIM(tmp_CASE)),  backslash
+           ENDDO
+           !
+           tmp_CASE = keycase(nbcase)
+           WRITE(16,'(6a)') '         ', &
+                &              tmp_CASE(1:LEN_TRIM(tmp_CASE)), &
+                &              '          ', tmp_CASE(1:LEN_TRIM(tmp_CASE)), &
+                &              '"  ',tmp_def(1:LEN_TRIM(tmp_def)) 
+           !
+        ELSE
+           WRITE(*,'(2a)') 'Uniplemented operation : ', TYPE_op(IFF)
+           STOP
+        ENDIF
+        !
+        !     Config.help file
+        !
+        tmp_key = configs(IFF,key_pos(IFF))
+        IF (INDEX(TYPE_op(IFF),'choice') .GT. 0) THEN
+           ii = INDEX(tmp_key,'||')-1
+        ELSE
+           ii = LEN_TRIM(tmp_key)
+        ENDIF
+
+        IF ( nbdef_out(IFF) .GT. 1) THEN
+           WRITE(17,'(1a)') tmp_desc(1:LEN_TRIM(tmp_desc))
+           WRITE(nbstr,'(I2.2)') iv
+           tke = tmp_key(1:ii)//'__'//nbstr
+           WRITE(17,'(1a)') tke(1:LEN_TRIM(tke))
+           WRITE(17,'(1a)') '  (Vector)'
+        ELSE
+           WRITE(17,'(1a)') tmp_desc(1:LEN_TRIM(tmp_desc))
+           WRITE(17,'(1a)') tmp_key(1:ii)
+        ENDIF
+        !
+        DO ih=help_pos(IFF,1),help_pos(IFF,2)
+           tmp_help = configs(IFF,ih)
+           WRITE(17,'("  ",1a)') tmp_help(1:LEN_TRIM(tmp_help))
+        ENDDO
+        !
+        !     Config.default file
+        !
+        IF (INDEX(TYPE_op(IFF),'choice') .GT. 0) THEN
+
+           WRITE(18,'(2a)') tmp_def(1:LEN_TRIM(tmp_def)),'=y'
+
+        ELSE
+
+           WRITE(18,'(3a)') tmp_key(1:LEN_TRIM(tmp_key)),'=', &
+                &              tmp_def(1:LEN_TRIM(tmp_def))
+
+        ENDIF
+        !     
+        !     Add some empty line to all files
+        !     
+        WRITE(16,'(1a)') '       '
+        WRITE(17,'(1a)') '       '
+        WRITE(17,'(1a)') '       '
+     ENDDO
+     !
+     !
+     !     Close the IF if needed
+     !
+
+     IF ( IF_pos(IFF) .GT. 0) THEN
+        WRITE(16,'(1a)') 'fi'
+        WRITE(16,'(1a)') '       '
+     ENDIF
+
+     !
+  ENDDO
+  !
+  WRITE(16,'(1a)') 'endmenu'
+  WRITE(16,'(1a)') '       '
+  IF ( nbsource .GT. 0) THEN
+     DO ih=1,nbsource
+        tmp = source(ih)
+        WRITE(16,'(1a)') '              '
+        WRITE(16,'(3a)') 'source ',tmp(1:LEN_TRIM(tmp)), &
+             &           '/Config.in'
+     ENDDO
+  ENDIF
+  !
+  !
+  CLOSE(16)
+  CLOSE(17)
+  CLOSE(18)
+  !
+  !
+  !
+  STOP
+
+END PROGRAM fparser
+!
+!
+!==========================================================
+!
+!
+SUBROUTINE READ_from_file(file, nbkeymax, nbelmax, configs, nbitems, itemlen)
+  !
+  USE stringop
+  !
+  IMPLICIT NONE
+  !
+  !
+  !     This routine reads the file and adds the config info it finds to the configs array.
+  !     Thus the nbitems is an imput variable as it can be increased as we go through the files.
+  !
+  !
+  CHARACTER*(*) :: file
+  INTEGER :: nbkeymax, nbelmax
+  CHARACTER*120 :: configs(nbkeymax, nbelmax)
+  INTEGER ::  nbitems, itemlen(nbkeymax)
+  !
+  INTEGER :: conf_pos, ip
+  CHARACTER*250 line
+  LOGICAL :: cont, conf_END
+  !
+  cont = .TRUE.
+  conf_END = .TRUE.
+  !
+  OPEN (12, file=file)
+  !
+  !   1.0 Loop over all the lines of a given file to extract all the configuration line
+  !
+  DO WHILE (cont)
+    READ(12,'(a)',END=9999) line
+    !
+    !   1.0  A configuration line is detected by the line below.
+    !
+    IF ( INDEX(line,'Config') .EQ. 1 .OR. INDEX(line,'!'//'Config') .GE. 1 ) THEN
+        !
+        IF ( conf_END ) THEN
+            nbitems = nbitems + 1
+            IF ( nbitems .GT. nbkeymax) THEN
+                WRITE(*,*) 'read_from_file : The number of keys in the input array is too small for this file'
+                STOP
+            ENDIF
+            itemlen(nbitems) = 0
+            conf_END = .FALSE.
+        ENDIF
+        !
+        itemlen(nbitems) = itemlen(nbitems) + 1
+        IF ( itemlen(nbitems) .GT. nbelmax ) THEN
+            WRITE(*,*) 'read_from_file : The number of elements per key in the input array is too small'
+            STOP
+        ENDIF
+        !
+        !  The detected line is shaved !
+        !
+        IF ( INDEX(line,'Config') .EQ. 1) THEN
+            conf_pos = 7
+        ELSE
+            conf_pos = INDEX(line,'!'//'Config') +7
+        ENDIF
+        line = line(conf_pos:LEN_TRIM(line))
+        line = TRIM(ADJUSTL(line))
+        CALL cmpblank(line)
+        !
+        configs(nbitems,itemlen(nbitems)) = line
+        !
+    ELSE
+        !
+        !   Look for the end of a configuration structure.
+        !  It is determined by a call to the getin subroutine
+        !
+        CALL strlowercase(line)
+        CALL cmpblank(line)
+        ip = INDEX(line,' (')
+        DO WHILE (ip .GT. 0)
+          line = line(1:ip-1)//line(ip+1:LEN_TRIM(line))
+          ip = INDEX(line,' (')
+        ENDDO
+        IF ( INDEX(line, 'call getin(') .GT. 0 .OR. INDEX(line, 'call setvar(') .GT. 0) THEN
+            conf_END = .TRUE.
+        ENDIF
+        !
+    ENDIF
+    !
+    cont = .TRUE.
+    GOTO 8888
+9999 cont = .FALSE.
+8888 CONTINUE
+    
+    ENDDO
+  !
+  CLOSE(12)
+  !
+  END SUBROUTINE READ_from_file
+  !
+  !==========================================================
+  !
+  !
+  SUBROUTINE analyse_configs(nbkmax, nb_key, nbelmax, keylen, configs, key_pos, help_pos, def_pos, des_pos, IF_pos, TYPE_op)
+    !
+  USE stringop
+  !
+    IMPLICIT NONE
+    !
+    !
+    !    This subroutine will localize the KEYWORDS in the configs array
+    !    and extract all their arguments. For the moment 5 arguments are recognized :
+    !    KEY  : The keyword by which the all is identified
+    !    HELP : This identifies the help text
+    !    DEF : The default value of for this KEYWORD
+    !    DESC : A short description, not more than one line
+    !    IF : Specifies the other Keyword it depend on. This is a nice features for the menus as it can hide 
+    !            things we do not need
+    !
+    !    The DEF and HELP keywords can be multi line
+    !
+    INTEGER :: nbkmax, nb_key, nbelmax
+    INTEGER :: keylen(nbkmax)
+    INTEGER :: key_pos(nbkmax), help_pos(nbkmax,2), def_pos(nbkmax,2), des_pos(nbkmax), IF_pos(nbkmax)
+    CHARACTER*120 :: configs(nbkmax,nbelmax)
+    CHARACTER*6 :: TYPE_op(nbkmax)
+    !
+    !   This is the number of arguments we need to find an end for and the total number of arguments  we can have.
+    !   Thus these parameters needs to be updated when the list of arguments to the routine is changed
+    !
+    INTEGER, PARAMETER :: toendlen=2, indexlen=5
+    !
+    INTEGER :: toend(toendlen), foundend(toendlen), kindex(indexlen)
+    INTEGER :: ik, il, ieq
+    CHARACTER*120 :: tmp_str, tmp_str2
+    !
+    !
+    key_pos(1:nb_key)=-1
+    help_pos(1:nb_key,1:2)=-1
+    def_pos(1:nb_key,1:2)=-1
+    des_pos(1:nb_key)=-1
+    IF_pos(1:nb_key)=-1
+    TYPE_op(1:nb_key)='hex'
+    !
+    DO ik=1,nb_key
+      !
+      !
+      DO il=1,keylen(ik)
+        !
+        ieq = INDEX(configs(ik,il),'=')
+        tmp_str = configs(ik,il)
+        tmp_str = tmp_str(1:ieq)
+        CALL struppercase(tmp_str)
+        !
+        !      Decide if this is a reserved name and where it fits
+        !
+        !      At the same time we clean up the configs array
+        !
+        IF ( INDEX(tmp_str,'KEY') .GT. 0) THEN
+            IF ( key_pos(ik) .GT. 0) THEN
+                WRITE(*,*) 'analyse_config : Already have a KEYWORD, check that you have a call to getin'
+                WRITE(*,*) 'analyse_config : ', configs(ik,il)
+                STOP
+            ENDIF
+            key_pos(ik) = il
+            tmp_str2 = configs(ik,il)
+            tmp_str2 = tmp_str2(ieq+1:LEN_TRIM(tmp_str2))
+            configs(ik,il) = TRIM(ADJUSTL(tmp_str2))
+            !
+            !   Here we have to check that we are not in an 'choice' case
+            !
+            IF ( INDEX(tmp_str2,'||') .GT. 0) THEN
+                TYPE_op(ik) = 'choice'
+            ENDIF
+            !
+        ENDIF
+        !
+        IF ( INDEX(tmp_str,'DEF') .GT. 0) THEN
+            IF ( def_pos(ik,1) .GT. 0) THEN
+                WRITE(*,*) 'analyse_config : Already have a DEF, check that you have a call to getin'
+                WRITE(*,*) 'analyse_config : ', configs(ik,il)
+                STOP
+            ENDIF
+            def_pos(ik,1) = il
+            tmp_str2 = configs(ik,il)
+            tmp_str2 = tmp_str2(ieq+1:LEN_TRIM(tmp_str2))
+            tmp_str2 = TRIM(ADJUSTL(tmp_str2))
+            configs(ik,il) = tmp_str2 
+            !
+            !  Here we can check if we have a boolean operation
+            !  We also wish to standardise the value of booleans
+            !
+            CALL struppercase(tmp_str2)
+            IF (INDEX(tmp_str2,'Y') .EQ. 1 .AND. LEN_TRIM(tmp_str2) .EQ. 1 .OR.&
+               & INDEX(tmp_str2,'T') .EQ. 1 .AND. LEN_TRIM(tmp_str2) .EQ. 1 .OR.&
+               & INDEX(tmp_str2,'YES') .EQ. 1 .AND. LEN_TRIM(tmp_str2) .EQ. 3 .OR.&
+               & INDEX(tmp_str2,'TRUE') .EQ. 1 .AND. LEN_TRIM(tmp_str2) .EQ. 4 .OR.&
+               & INDEX(tmp_str2,'.TRUE.') .EQ. 1) THEN
+                configs(ik,il) = 'y'
+                TYPE_op(ik) = 'bool'
+            ENDIF
+            !
+            IF (INDEX(tmp_str2,'N') .EQ. 1 .AND. LEN_TRIM(tmp_str2) .EQ. 1 .OR.&
+               & INDEX(tmp_str2,'F') .EQ. 1 .AND. LEN_TRIM(tmp_str2) .EQ. 1 .OR.&
+               & INDEX(tmp_str2,'NO') .EQ. 1 .AND. LEN_TRIM(tmp_str2) .EQ. 2 .OR.&
+               & INDEX(tmp_str2,'FALSE') .EQ. 1  .AND. LEN_TRIM(tmp_str2) .EQ. 5 .OR.&
+               & INDEX(tmp_str2,'.FALSE.') .EQ. 1) THEN
+                configs(ik,il) = 'n'
+                TYPE_op(ik) = 'bool'
+            ENDIF
+            !
+            ! Here we check if we have a default behavior and put a standard name
+            !
+            IF (INDEX(tmp_str2,'DEF') .EQ. 1 .OR. INDEX(tmp_str2,'NONE') .EQ. 1) THEN
+                configs(ik,il) = 'default'
+            ENDIF
+            !
+        ENDIF
+        !
+        IF ( INDEX(tmp_str,'DESC') .GT. 0) THEN
+            IF ( des_pos(ik) .GT. 0) THEN
+                WRITE(*,*) 'analyse_config : Already have a DESC, check that you have a call to getin'
+                WRITE(*,*) 'analyse_config : ', configs(ik,il)
+                STOP
+            ENDIF
+            des_pos(ik) = il
+            tmp_str2 = configs(ik,il)
+            tmp_str2 = tmp_str2(ieq+1:LEN_TRIM(tmp_str2))
+            configs(ik,il) = TRIM(ADJUSTL(tmp_str2))
+        ENDIF
+        !
+        IF ( INDEX(tmp_str,'IF') .GT. 0) THEN
+            IF ( IF_pos(ik) .GT. 0) THEN
+                WRITE(*,*) 'analyse_config : Already have a IF, check that you have a call to getin'
+                WRITE(*,*) 'analyse_config : ', configs(ik,il)
+                STOP
+            ENDIF
+            IF_pos(ik) = il
+            tmp_str2 = configs(ik,il)
+            tmp_str2 = tmp_str2(ieq+1:LEN_TRIM(tmp_str2))
+            configs(ik,il) = TRIM(ADJUSTL(tmp_str2))
+        ENDIF 
+        !
+        IF ( INDEX(tmp_str,'HELP') .GT. 0) THEN
+            help_pos(ik,1) = il
+            tmp_str2 = configs(ik,il)
+            tmp_str2 = tmp_str2(ieq+1:LEN_TRIM(tmp_str2))
+            configs(ik,il) = TRIM(ADJUSTL(tmp_str2))
+        ENDIF
+        !
+      ENDDO
+      !
+      !     Check if we not missing some important informations as for instance
+      !
+      !     THE KEYWORD 
+      !
+      IF ( key_pos(ik) .LT. 1) THEN
+          WRITE(*,*) 'analyse_configs : Could not find a keyword in the following entry :'
+          DO il=1,keylen(ik)
+            WRITE(*,'(a70)') configs(ik,il)
+          ENDDO
+          STOP
+      ENDIF
+      !
+      !      THE DEFAULT VALUE
+      !
+      IF ( def_pos(ik,1) .LT. 1) THEN
+          WRITE(*,*) 'analyse_configs : Could not find a default value in the following entry :'
+          DO il=1,keylen(ik)
+            WRITE(*,'(a70)') configs(ik,il)
+          ENDDO
+          STOP
+      ENDIF
+      !
+      !   Get the end of all the multi line arguments
+      !
+      toend(1) = MAX(def_pos(ik,1),1)
+      toend(2) = MAX(help_pos(ik,1),1)
+      foundend(:) = keylen(ik)
+      kindex(1) = MAX(key_pos(ik),1)
+      kindex(2) = MAX(des_pos(ik),1)
+      kindex(3) = MAX(def_pos(ik,1),1)
+      kindex(4) = MAX(IF_pos(ik),1)
+      kindex(5) = MAX(help_pos(ik,1),1)
+      CALL find_ends(toendlen, toend, indexlen, kindex, foundend)
+      def_pos(ik,2) = foundend(1)
+      help_pos(ik,2) = foundend(2)
+      !
+    ENDDO
+    !
+  END SUBROUTINE analyse_configs
+  !
+  SUBROUTINE find_ends(toendlen, toend, indexlen, kindex, foundend)
+    !
+    IMPLICIT NONE
+    !
+    !
+    !  We find the end of the text for all the elements in the key which are multi line
+    !   This subroutine aims at providing a flexible way to determine this so that other
+    !   elements in the Keyword can be multi line. For the moment it is only the Help and Ded 
+    !  which are allowed to be multi line.
+    !
+    !  Foundend need to be initialized to the maximum value of the elements
+    !
+    !
+    INTEGER :: toendlen, toend(toendlen), indexlen, kindex(indexlen), foundend(toendlen)
+    !
+    INTEGER :: whmin(1), ie, ii
+    !
+    DO ie=1,toendlen
+      !
+      whmin = MINLOC(toend(1:toendlen))
+      !
+      DO ii=1,indexlen
+        IF ( kindex(ii) .GT. toend(whmin(1)) .AND. foundend(whmin(1)) .GE. kindex(ii)) THEN
+            foundend(whmin(1)) = kindex(ii)-1
+            toend(whmin(1)) = 100000
+        ENDIF
+      ENDDO
+      !
+    ENDDO
+    !
+  END SUBROUTINE find_ends
Index: trunk/NEMOGCM/EXTERNAL/IOIPSL/tools/flio_rbld.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/IOIPSL/tools/flio_rbld.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/IOIPSL/tools/flio_rbld.f90	(revision 2528)
@@ -0,0 +1,1624 @@
+PROGRAM flio_rbld
+!
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!!--------------------------------------------------------------------
+!! PROGRAM flio_rbld
+!!
+!! PURPOSE :
+!!   Recombine the files of MPI version of IOIPSL
+!!   along several dimensions.
+!!
+!! CALLING SEQUENCE :
+!!
+!!   "flio_rbld" is usually invoked by the script "rebuild"
+!!
+!!   rebuild -h
+!!
+!!   rebuild [-v lev] [-f] -o outfile infile[1] ... infile[n]
+!!
+!! INPUT for "rebuild" :
+!!
+!!   -h         : help
+!!   -v lev     : verbosity level
+!!   -f         : force executing mode
+!!   -o outfile : name of the recombined file.
+!!   infiles    : names of the files that must be recombined.
+!!
+!! INPUT for "flio_rbld" :
+!!
+!!  (I) i_v_lev  : verbosity level
+!!  (C) c_force  : executing mode (noforce/force)
+!!  (I) f_nb     : total number of files
+!!  (C) f_nm(:)  : names of the files (input_files output_file)
+!!
+!!
+!! ASSOCIATED MODULES :
+!!   IOIPSL(fliocom)
+!!
+!! RESTRICTIONS :
+!!
+!!   Cases for character are not coded.
+!!
+!!   Cases for netCDF variables such as array with more
+!!   than 5 dimensions are not coded.
+!!
+!!   Input files must have the following global attributes :
+!!
+!!     "DOMAIN_number_total"
+!!     "DOMAIN_number"
+!!     "DOMAIN_dimensions_ids"
+!!     "DOMAIN_size_global"
+!!     "DOMAIN_size_local"
+!!     "DOMAIN_position_first"
+!!     "DOMAIN_position_last"
+!!     "DOMAIN_halo_size_start"
+!!     "DOMAIN_halo_size_end"
+!!     "DOMAIN_type"
+!!
+!!   NetCDF files must be smaller than 2 Gb.
+!!
+!!   Character variables should have less than 257 letters
+!!
+!! EXAMPLE :
+!!
+!!   rebuild -v -o sst.nc sst_[0-9][0-9][0-9][0-9].nc
+!!
+!! MODIFICATION HISTORY :
+!!   Sebastien Masson   (smasson@jamstec.go.jp)   March 2004
+!!   Jacques   Bellier  (Jacques.Bellier@cea.fr)  June  2005
+!!--------------------------------------------------------------------
+  USE IOIPSL
+  USE defprec
+!-
+  IMPLICIT NONE
+!-
+! Character length
+  INTEGER,PARAMETER :: chlen=256
+!-
+! DO loops and test related variables
+  INTEGER :: i,ia,id,iv,iw,i_i,i_n
+  INTEGER :: ik,itmin,itmax,it1,it2,it
+  LOGICAL :: l_force,l_uld
+!-
+! Input arguments related variables
+  INTEGER :: i_v_lev
+  CHARACTER(LEN=15) :: c_force
+  INTEGER :: f_nb,f_nb_in
+  CHARACTER(LEN=chlen),DIMENSION(:),ALLOCATABLE :: f_nm
+!-
+! Domains related variables
+  INTEGER :: d_n_t,i_ntd
+  INTEGER,DIMENSION(:),ALLOCATABLE :: dom_att,d_d_i,d_s_g
+  INTEGER,DIMENSION(:,:),ALLOCATABLE :: d_s_l,d_p_f,d_p_l,d_h_s,d_h_e
+  LOGICAL :: l_cgd,l_cof,l_col,l_o_f,l_o_m,l_o_l
+  CHARACTER(LEN=chlen) :: c_d_n
+!-
+! Model files related variables
+  LOGICAL :: l_ocf
+  INTEGER,DIMENSION(:),ALLOCATABLE :: f_a_id
+  INTEGER :: f_id_i1,f_id_i,f_id_o
+  INTEGER :: f_d_nb,f_v_nb,f_a_nb,f_d_ul
+  INTEGER :: v_a_nb,a_type
+  CHARACTER(LEN=chlen),DIMENSION(:),ALLOCATABLE :: &
+&  f_d_nm,f_v_nm,f_a_nm,v_a_nm
+  CHARACTER(LEN=chlen) :: f_u_nm
+  INTEGER,DIMENSION(:),ALLOCATABLE :: v_d_nb,v_d_ul,v_type
+  INTEGER,DIMENSION(:,:),ALLOCATABLE :: v_d_i
+  INTEGER,DIMENSION(:),ALLOCATABLE :: f_d_i,f_d_l
+  INTEGER :: a_l
+  INTEGER,DIMENSION(flio_max_var_dims) :: d_i,ib,ie
+  INTEGER,DIMENSION(:),ALLOCATABLE :: &
+ &  io_i,io_n,ia_sf,io_sf,io_cf,ia_sm,io_sm,io_cm,ia_sl,io_sl,io_cl
+  LOGICAL :: l_ex
+  CHARACTER(LEN=chlen) :: c_wn1,c_wn2
+!-
+!?INTEGERS of KIND 1 are not supported on all computers
+!?INTEGER(KIND=i_1) :: i1_0d
+!?INTEGER(KIND=i_1),DIMENSION(:),ALLOCATABLE :: i1_1d
+!?INTEGER(KIND=i_1),DIMENSION(:,:),ALLOCATABLE :: i1_2d
+!?INTEGER(KIND=i_1),DIMENSION(:,:,:),ALLOCATABLE :: i1_3d
+!?INTEGER(KIND=i_1),DIMENSION(:,:,:,:),ALLOCATABLE :: i1_4d
+!?INTEGER(KIND=i_1),DIMENSION(:,:,:,:,:),ALLOCATABLE :: i1_5d
+  INTEGER(KIND=i_2) :: i2_0d
+  INTEGER(KIND=i_2),DIMENSION(:),ALLOCATABLE :: i2_1d
+  INTEGER(KIND=i_2),DIMENSION(:,:),ALLOCATABLE :: i2_2d
+  INTEGER(KIND=i_2),DIMENSION(:,:,:),ALLOCATABLE :: i2_3d
+  INTEGER(KIND=i_2),DIMENSION(:,:,:,:),ALLOCATABLE :: i2_4d
+  INTEGER(KIND=i_2),DIMENSION(:,:,:,:,:),ALLOCATABLE :: i2_5d
+  INTEGER(KIND=i_4) :: i4_0d
+  INTEGER(KIND=i_4),DIMENSION(:),ALLOCATABLE :: i4_1d
+  INTEGER(KIND=i_4),DIMENSION(:,:),ALLOCATABLE :: i4_2d
+  INTEGER(KIND=i_4),DIMENSION(:,:,:),ALLOCATABLE :: i4_3d
+  INTEGER(KIND=i_4),DIMENSION(:,:,:,:),ALLOCATABLE :: i4_4d
+  INTEGER(KIND=i_4),DIMENSION(:,:,:,:,:),ALLOCATABLE :: i4_5d
+  REAL(KIND=r_4) :: r4_0d
+  REAL(KIND=r_4),DIMENSION(:),ALLOCATABLE :: r4_1d
+  REAL(KIND=r_4),DIMENSION(:,:),ALLOCATABLE :: r4_2d
+  REAL(KIND=r_4),DIMENSION(:,:,:),ALLOCATABLE :: r4_3d
+  REAL(KIND=r_4),DIMENSION(:,:,:,:),ALLOCATABLE :: r4_4d
+  REAL(KIND=r_8),DIMENSION(:,:,:,:,:),ALLOCATABLE :: r4_5d
+  REAL(KIND=r_8) :: r8_0d
+  REAL(KIND=r_8),DIMENSION(:),ALLOCATABLE :: r8_1d
+  REAL(KIND=r_8),DIMENSION(:,:),ALLOCATABLE :: r8_2d
+  REAL(KIND=r_8),DIMENSION(:,:,:),ALLOCATABLE :: r8_3d
+  REAL(KIND=r_8),DIMENSION(:,:,:,:),ALLOCATABLE :: r8_4d
+  REAL(KIND=r_8),DIMENSION(:,:,:,:,:),ALLOCATABLE :: r8_5d
+!-
+! elapsed and cpu time computation variables
+  INTEGER :: nb_cc_ini,nb_cc_end,nb_cc_sec,nb_cc_max
+  REAL :: t_cpu_ini,t_cpu_end
+!---------------------------------------------------------------------
+!-
+!-------------------
+! INPUT arguments
+!-------------------
+!-
+! Retrieve the verbosity level
+  READ (UNIT=*,FMT=*) i_v_lev
+!-
+! Retrieve the executing mode
+  READ (UNIT=*,FMT='(A)') c_force
+  l_force = (TRIM(c_force)  == 'force')
+!-
+! Retrieve the number of arguments
+  READ (UNIT=*,FMT=*) f_nb
+  f_nb_in = f_nb-1
+!-
+! Retrieve the file names
+  ALLOCATE(f_nm(f_nb))
+  DO iw=1,f_nb
+    READ (UNIT=*,FMT='(A)') f_nm(iw)
+  ENDDO
+!-
+! Allocate and initialize the array of file access identifiers
+  ALLOCATE(f_a_id(f_nb_in)); f_a_id(:) = -1;
+!-
+  IF (i_v_lev >= 1) THEN
+    WRITE (UNIT=*,FMT='("")')
+    WRITE (UNIT=*,FMT='(" verbosity level : ",I4)') i_v_lev
+    WRITE (UNIT=*,FMT='(" executing  mode : ",A)') TRIM(c_force)
+    WRITE (UNIT=*,FMT='(" number of args  : ",I4)') f_nb
+    WRITE (UNIT=*,FMT='(" Input  files :")')
+    DO iw=1,f_nb_in
+      WRITE (*,'("   ",A)') TRIM(f_nm(iw))
+    ENDDO
+    WRITE (UNIT=*,FMT='(" Output file  :")')
+    WRITE (*,'("   ",A)') TRIM(f_nm(f_nb))
+!-- time initializations
+    CALL system_clock &
+ &   (count=nb_cc_ini,count_rate=nb_cc_sec,count_max=nb_cc_max)
+    CALL cpu_time (t_cpu_ini)
+  ENDIF
+!-
+!---------------------------------------------------
+! Retrieve basic informations from the first file
+!---------------------------------------------------
+!-
+! Open the first file
+  CALL flrb_of (1,f_id_i)
+!-
+! Get the attribute "DOMAIN_number_total"
+  CALL fliogeta (f_id_i,"?","DOMAIN_number_total",d_n_t)
+!-
+! Validate the number of input files :
+! should be equal to the total number
+! of domains used in the simulation
+  IF (d_n_t /= f_nb_in) THEN
+    IF (l_force) THEN
+      iw = 2
+    ELSE
+      iw = 3
+      DEALLOCATE(f_nm,f_a_id)
+      CALL flrb_cf (1,.TRUE.)
+    ENDIF
+    CALL ipslerr (iw,"flio_rbld", &
+ &   "The number of input files", &
+ &   "is not equal to the number of DOMAINS"," ")
+  ENDIF
+!-
+! Retrieve the basic characteristics of the first input file
+  CALL flioinqf &
+ & (f_id_i,nb_dim=f_d_nb,nb_var=f_v_nb,nb_gat=f_a_nb,id_uld=f_d_ul)
+!-
+! Build the list of the names of the
+! dimensions/variables/global_attributes and retrieve
+! the unlimited_dimension name from the first input file
+  ALLOCATE(f_d_nm(f_d_nb),f_v_nm(f_v_nb),f_a_nm(f_a_nb))
+  CALL flioinqn (f_id_i,cn_dim=f_d_nm,cn_var=f_v_nm, &
+ &                      cn_gat=f_a_nm,cn_uld=f_u_nm)
+!-
+! Build the list of the dimensions identifiers and lengths
+  ALLOCATE(f_d_i(f_d_nb),f_d_l(f_d_nb))
+  CALL flioinqf (f_id_i,id_dim=f_d_i,ln_dim=f_d_l)
+!-
+! Close the file
+  CALL flrb_cf (1,.FALSE.)
+!-
+! Check if the number of needed files is greater than
+! the maximum number of simultaneously opened files.
+! In that case, open and close model files for each reading,
+! otherwise keep the "flio" identifiers of the opened files.
+  l_ocf = (f_nb > flio_max_files)
+!-
+!----------------------------------------------------
+! Retrieve domain informations for each input file
+!----------------------------------------------------
+!-
+  DO iw=1,f_nb_in
+!---
+    CALL flrb_of (iw,f_id_i)
+!---
+    IF (iw > 1) THEN
+      c_wn1 = "DOMAIN_number_total"
+      CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
+      IF (l_ex) THEN
+        CALL fliogeta (f_id_i,"?",TRIM(c_wn1),i_ntd)
+        IF (i_ntd /= d_n_t) THEN
+          CALL ipslerr (3,"flio_rbld", &
+ &        "File      : "//TRIM(f_nm(iw)), &
+ &        "Attribute : "//TRIM(c_wn1), &
+ &        "not equal to the one of the first file")
+        ENDIF
+      ELSE
+        CALL ipslerr (3,"flio_rbld", &
+ &       "File      : "//TRIM(f_nm(iw)), &
+ &       "Attribute : "//TRIM(c_wn1),"not found")
+      ENDIF
+    ENDIF
+!---
+    c_wn1 = "DOMAIN_dimensions_ids"
+    CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
+    IF (l_ex) THEN
+      ALLOCATE(dom_att(a_l))
+      CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att)
+      IF (iw == 1) THEN
+        IF (ANY(dom_att(:) == f_d_ul)) THEN
+          CALL ipslerr (3,"flio_rbld", &
+ &         "File      : "//TRIM(f_nm(iw)), &
+ &         "Attribute : "//TRIM(c_wn1), &
+ &         "contains the unlimited dimension")
+        ENDIF
+        ALLOCATE (d_d_i(a_l))
+        d_d_i(:) = dom_att(:)
+      ELSEIF (SIZE(dom_att) /= SIZE(d_d_i)) THEN
+        CALL ipslerr (3,"flio_rbld", &
+ &       "File      : "//TRIM(f_nm(iw)), &
+ &       "size of the attribute : "//TRIM(c_wn1), &
+ &       "not equal to the one of the first file")
+      ELSEIF (ANY(dom_att(:) /= d_d_i(:))) THEN
+        CALL ipslerr (3,"flio_rbld", &
+ &       "File      : "//TRIM(f_nm(iw)), &
+ &       "Attribute : "//TRIM(c_wn1), &
+ &       "not equal to the one of the first file")
+      ENDIF
+      DEALLOCATE(dom_att)
+    ELSE
+      CALL ipslerr (3,"flio_rbld", &
+ &     "File      : "//TRIM(f_nm(iw)), &
+ &     "Attribute : "//TRIM(c_wn1),"not found")
+    ENDIF
+!---
+    c_wn1 = "DOMAIN_size_global"
+    CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
+    IF (l_ex) THEN
+      IF (a_l /= SIZE(d_d_i)) THEN
+        CALL ipslerr (3,"flio_rbld", &
+ &       "File      : "//TRIM(f_nm(iw)), &
+ &       "size of the attribute : "//TRIM(c_wn1), &
+ &       "not equal to the size of DOMAIN_dimensions_ids")
+      ELSE
+        ALLOCATE(dom_att(a_l))
+        CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att)
+        IF (iw == 1) THEN
+          ALLOCATE (d_s_g(a_l))
+          d_s_g(:)=dom_att(:)
+        ELSEIF (ANY(dom_att(:) /= d_s_g(:))) THEN
+          CALL ipslerr (3,"flio_rbld", &
+ &         "File      : "//TRIM(f_nm(iw)), &
+ &         "Attribute : "//TRIM(c_wn1), &
+ &         "not equal to the one of the first file")
+        ENDIF
+        DEALLOCATE(dom_att)
+      ENDIF
+    ELSE
+      CALL ipslerr (3,"flio_rbld", &
+ &     "File      : "//TRIM(f_nm(iw)), &
+ &     "Attribute : "//TRIM(c_wn1),"not found")
+    ENDIF
+!---
+    c_wn1 = "DOMAIN_size_local"
+    CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
+    IF (l_ex) THEN
+      IF (a_l /= SIZE(d_d_i)) THEN
+        CALL ipslerr (3,"flio_rbld", &
+ &       "File      : "//TRIM(f_nm(iw)), &
+ &       "size of the attribute : "//TRIM(c_wn1), &
+ &       "not equal to the size of DOMAIN_dimensions_ids")
+      ELSE
+        ALLOCATE(dom_att(a_l))
+        CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att)
+        IF (iw == 1) THEN
+          ALLOCATE (d_s_l(a_l,f_nb_in))
+        ENDIF
+        d_s_l(:,iw)=dom_att(:)
+        DEALLOCATE(dom_att)
+      ENDIF
+    ELSE
+      CALL ipslerr (3,"flio_rbld", &
+ &     "File      : "//TRIM(f_nm(iw)), &
+ &     "Attribute : "//TRIM(c_wn1),"not found")
+    ENDIF
+!---
+    c_wn1 = "DOMAIN_position_first"
+    CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
+    IF (l_ex) THEN
+      IF (a_l /= SIZE(d_d_i)) THEN
+        CALL ipslerr (3,"flio_rbld", &
+ &       "File      : "//TRIM(f_nm(iw)), &
+ &       "size of the attribute : "//TRIM(c_wn1), &
+ &       "not equal to the size of DOMAIN_dimensions_ids")
+      ELSE
+        ALLOCATE(dom_att(a_l))
+        CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att)
+        IF (iw == 1) THEN
+          ALLOCATE (d_p_f(a_l,f_nb_in))
+        ENDIF
+        d_p_f(:,iw)=dom_att(:)
+        DEALLOCATE(dom_att)
+      ENDIF
+    ELSE
+      CALL ipslerr (3,"flio_rbld", &
+ &     "File      : "//TRIM(f_nm(iw)), &
+ &     "Attribute : "//TRIM(c_wn1),"not found")
+    ENDIF
+!---
+    c_wn1 = "DOMAIN_position_last"
+    CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
+    IF (l_ex) THEN
+      IF (a_l /= SIZE(d_d_i)) THEN
+        CALL ipslerr (3,"flio_rbld", &
+ &       "File      : "//TRIM(f_nm(iw)), &
+ &       "size of the attribute : "//TRIM(c_wn1), &
+ &       "not equal to the size of DOMAIN_dimensions_ids")
+      ELSE
+        ALLOCATE(dom_att(a_l))
+        CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att)
+        IF (iw == 1) THEN
+          ALLOCATE (d_p_l(a_l,f_nb_in))
+        ENDIF
+        d_p_l(:,iw)=dom_att(:)
+        DEALLOCATE(dom_att)
+      ENDIF
+    ELSE
+      CALL ipslerr (3,"flio_rbld", &
+ &     "File      : "//TRIM(f_nm(iw)), &
+ &     "Attribute : "//TRIM(c_wn1),"not found")
+    ENDIF
+!---
+    c_wn1 = "DOMAIN_halo_size_start"
+    CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
+    IF (l_ex) THEN
+      IF (a_l /= SIZE(d_d_i)) THEN
+        CALL ipslerr (3,"flio_rbld", &
+ &       "File      : "//TRIM(f_nm(iw)), &
+ &       "size of the attribute : "//TRIM(c_wn1), &
+ &       "not equal to the size of DOMAIN_dimensions_ids")
+      ELSE
+        ALLOCATE(dom_att(a_l))
+        CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att)
+        IF (iw == 1) THEN
+          ALLOCATE (d_h_s(a_l,f_nb_in))
+        ENDIF
+        d_h_s(:,iw)=dom_att(:)
+        DEALLOCATE(dom_att)
+      ENDIF
+    ELSE
+      CALL ipslerr (3,"flio_rbld", &
+ &     "File      : "//TRIM(f_nm(iw)), &
+ &     "Attribute : "//TRIM(c_wn1),"not found")
+    ENDIF
+!---
+    c_wn1 = "DOMAIN_halo_size_end"
+    CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
+    IF (l_ex) THEN
+      IF (a_l /= SIZE(d_d_i)) THEN
+        CALL ipslerr (3,"flio_rbld", &
+ &       "File      : "//TRIM(f_nm(iw)), &
+ &       "size of the attribute : "//TRIM(c_wn1), &
+ &       "not equal to the size of DOMAIN_dimensions_ids")
+      ELSE
+        ALLOCATE(dom_att(a_l))
+        CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att)
+        IF (iw == 1) THEN
+          ALLOCATE (d_h_e(a_l,f_nb_in))
+        ENDIF
+        d_h_e(:,iw)=dom_att(:)
+        DEALLOCATE(dom_att)
+      ENDIF
+    ELSE
+      CALL ipslerr (3,"flio_rbld", &
+ &     "File      : "//TRIM(f_nm(iw)), &
+ &     "Attribute : "//TRIM(c_wn1),"not found")
+    ENDIF
+!---
+    c_wn1 = "DOMAIN_type"
+    c_wn2 = " "
+    CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
+    IF (l_ex) THEN
+      CALL fliogeta (f_id_i,"?",TRIM(c_wn1),c_wn2)
+      CALL strlowercase (c_wn2)
+      IF (iw == 1) THEN
+        IF (    (TRIM(c_wn2) == "box") &
+ &          .OR.(TRIM(c_wn2) == "apple") ) THEN
+          c_d_n = c_wn2
+        ELSE
+          CALL ipslerr (3,"flio_rbld", &
+ &         "File      : "//TRIM(f_nm(iw)), &
+ &         "Attribute : "//TRIM(c_wn1), &
+ &         "type "//TRIM(c_wn2)//" not (yet) supported")
+        ENDIF
+      ELSEIF (TRIM(c_wn2) /= TRIM(c_d_n)) THEN
+        CALL ipslerr (3,"flio_rbld", &
+ &       "File      : "//TRIM(f_nm(iw)), &
+ &       "Attribute : "//TRIM(c_wn1), &
+ &       "not equal to the one of the first file")
+      ENDIF
+    ELSE
+      CALL ipslerr (3,"flio_rbld", &
+ &     "File      : "//TRIM(f_nm(iw)), &
+ &     "Attribute : "//TRIM(c_wn1),"not found")
+    ENDIF
+!---
+    CALL flrb_cf (iw,l_ocf)
+!---
+  ENDDO
+!-
+  IF (i_v_lev >= 2) THEN
+    WRITE (UNIT=*,FMT='("")')
+    WRITE (*,'(" From the first file : ")')
+    WRITE (*,'("   Number of dimensions : ",I2)') f_d_nb
+    WRITE (*,'("     Idents  : ",(10(1X,I4),:))') f_d_i(1:f_d_nb)
+    WRITE (*,'("     Lengths : ",(10(1X,I4),:))') f_d_l(1:f_d_nb)
+    WRITE (*,'("     Names: ")')
+    DO i=1,f_d_nb
+      WRITE (*,'("       """,A,"""")') TRIM(f_d_nm(i))
+    ENDDO
+    IF (f_d_ul > 0) THEN
+      WRITE (*,'("   Unlimited dimension id : ",I2)') f_d_i(f_d_ul)
+    ENDIF
+    WRITE (*,'("   Number of variables  : ",I2)') f_v_nb
+    WRITE (*,'("     Names: ")')
+    DO i=1,f_v_nb
+      WRITE (*,'("       """,A,"""")') TRIM(f_v_nm(i))
+    ENDDO
+    WRITE (*,'("   Number of global attributes : ",I2)') f_a_nb
+    WRITE (*,'("     Names: ")')
+    DO i=1,f_a_nb
+      WRITE (*,'("       """,A,"""")') TRIM(f_a_nm(i))
+    ENDDO
+  ENDIF
+  IF (i_v_lev >= 3) THEN
+    WRITE (UNIT=*,FMT='("")')
+    WRITE (*,'(" From input files : ")')
+    WRITE (*,'("   Total number of DOMAINS : ",I4)') d_n_t
+    WRITE (*,'("   DOMAIN_dimensions_ids :",(10(1X,I5),:))') d_d_i(:)
+    WRITE (*,'("   DOMAIN_size_global    :",(10(1X,I5),:))') d_s_g(:)
+    WRITE (*,'("   DOMAIN_type           : """,(A),"""")') TRIM(c_d_n)
+    DO iw=1,f_nb_in
+      WRITE (*,'("   File   : ",A)') TRIM(f_nm(iw))
+      WRITE (*,'("     d_s_l  :",(10(1X,I5),:))') d_s_l(:,iw)
+      WRITE (*,'("     d_p_f  :",(10(1X,I5),:))') d_p_f(:,iw)
+      WRITE (*,'("     d_p_l  :",(10(1X,I5),:))') d_p_l(:,iw)
+      WRITE (*,'("     d_h_s  :",(10(1X,I5),:))') d_h_s(:,iw)
+      IF (TRIM(c_d_n) == "apple") THEN
+        IF (COUNT(d_h_s(:,iw) /= 0) > 1) THEN
+          CALL ipslerr (3,"flio_rbld", &
+ &          "Beginning offset is not yet supported", &
+ &          "for more than one dimension"," ")
+        ENDIF
+      ENDIF
+      WRITE (*,'("     d_h_e  :",(10(1X,I5),:))') d_h_e(:,iw)
+      IF (TRIM(c_d_n) == "apple") THEN
+        IF (COUNT(d_h_e(:,iw) /= 0) > 1) THEN
+          CALL ipslerr (3,"flio_rbld", &
+ &          "Ending offset is not yet supported", &
+ &          "for more than one dimension"," ")
+        ENDIF
+      ENDIF
+    ENDDO
+  ENDIF
+!-
+!---------------------------------------
+! Create the dimensionned output file
+!---------------------------------------
+!-
+! Define the dimensions used in the output file
+  DO id=1,f_d_nb
+    DO i=1,SIZE(d_d_i)
+      IF (f_d_i(id) == d_d_i(i)) THEN
+        f_d_l(id) = d_s_g(i)
+      ENDIF
+    ENDDO
+  ENDDO
+!-
+  IF (f_d_ul > 0) THEN
+    i = f_d_l(f_d_ul); f_d_l(f_d_ul) = -1;
+  ENDIF
+!-
+! Create the output file
+  CALL fliocrfd (TRIM(f_nm(f_nb)),f_d_nm,f_d_l,f_id_o,c_f_n=c_wn1)
+!-
+  IF (f_d_ul > 0) THEN
+    f_d_l(f_d_ul) = i; itmin = 1; itmax = f_d_l(f_d_ul);
+  ELSE
+    itmin = 1; itmax = 1;
+  ENDIF
+!-
+! open the first input file used to build the output file
+!-
+  CALL flrb_of (1,f_id_i1)
+!-
+! define the global attributes in the output file
+! copy all global attributes except those beginning by "DOMAIN_"
+! eventually actualize the "file_name" attribute
+!-
+  DO ia=1,f_a_nb
+    IF (INDEX(TRIM(f_a_nm(ia)),"DOMAIN_") == 1)  CYCLE
+    IF (TRIM(f_a_nm(ia)) == "file_name") THEN
+      CALL flioputa (f_id_o,"?",TRIM(f_a_nm(ia)),TRIM(c_wn1))
+    ELSE
+      CALL fliocpya (f_id_i1,"?",TRIM(f_a_nm(ia)),f_id_o,"?")
+    ENDIF
+  ENDDO
+!-
+! define the variables in the output file
+!-
+  ALLOCATE(v_d_nb(f_v_nb)); v_d_nb(:) = 0;
+  ALLOCATE(v_d_ul(f_v_nb)); v_d_ul(:) = 0;
+  ALLOCATE(v_type(f_v_nb),v_d_i(flio_max_var_dims,f_v_nb));
+  DO iv=1,f_v_nb
+!-- get variable informations
+    CALL flioinqv &
+ &   (f_id_i1,TRIM(f_v_nm(iv)),l_ex,v_t=v_type(iv), &
+ &    nb_dims=v_d_nb(iv),id_dims=d_i,nb_atts=v_a_nb)
+!-- define the new variable
+    IF (v_d_nb(iv) == 0) THEN
+      CALL fliodefv &
+ &     (f_id_o,TRIM(f_v_nm(iv)),v_t=v_type(iv))
+    ELSE
+      CALL fliodefv &
+ &     (f_id_o,TRIM(f_v_nm(iv)),d_i(1:v_d_nb(iv)),v_t=v_type(iv))
+      DO iw=1,v_d_nb(iv)
+        IF (f_d_ul > 0) THEN
+          IF (d_i(iw) == f_d_ul) THEN
+            v_d_ul(iv) = iw
+          ENDIF
+        ENDIF
+      ENDDO
+      v_d_i(1:v_d_nb(iv),iv) = d_i(1:v_d_nb(iv))
+    ENDIF
+!-- copy all variable attributes
+    IF (v_a_nb > 0) THEN
+      ALLOCATE(v_a_nm(v_a_nb))
+      CALL flioinqv (f_id_i1,TRIM(f_v_nm(iv)),l_ex,cn_atts=v_a_nm)
+      DO ia=1,v_a_nb
+        CALL fliocpya &
+ &       (f_id_i1,TRIM(f_v_nm(iv)),TRIM(v_a_nm(ia)), &
+ &        f_id_o,TRIM(f_v_nm(iv)))
+      ENDDO
+      DEALLOCATE(v_a_nm)
+    ENDIF
+  ENDDO
+!-
+! update valid_min valid_max attributes values
+!-
+  CALL flrb_rg
+!-
+!------------------------
+! Fill the output file
+!------------------------
+!-
+  DO ik=1,2
+    l_uld = (ik /= 1)
+    IF (l_uld) THEN
+      it1=itmin; it2=itmax;
+    ELSE
+      it1=1; it2=1;
+    ENDIF
+    DO it=it1,it2
+      DO iv=1,f_v_nb
+        IF (    (.NOT.l_uld.AND.(v_d_ul(iv) > 0)) &
+ &          .OR.(l_uld.AND.(v_d_ul(iv) <= 0)) ) THEN
+          CYCLE
+        ENDIF
+        IF (i_v_lev >= 3) THEN
+          WRITE (UNIT=*,FMT='("")')
+          IF (l_uld) THEN
+            WRITE (UNIT=*,FMT=*) "time step     : ",it
+          ENDIF
+          WRITE (UNIT=*,FMT=*) "variable      : ",TRIM(f_v_nm(iv))
+          WRITE (UNIT=*,FMT=*) "var unlim dim : ",v_d_ul(iv)
+        ENDIF
+!------ do the variable contains dimensions to be recombined ?
+        l_cgd = .FALSE.
+        i_n = 1
+        DO i=1,SIZE(d_d_i)
+          l_cgd = ANY(v_d_i(1:v_d_nb(iv),iv) == d_d_i(i))
+          l_cgd = l_cgd.AND.ANY(d_s_l(i,1:f_nb_in) /= d_s_g(i))
+          IF (l_cgd) THEN
+            i_n = f_nb_in
+              EXIT
+          ENDIF
+        ENDDO
+        IF (v_d_nb(iv) > 0) THEN
+!-------- Allocate io_i,io_n,ia_sm,io_sm,io_cm
+          i = v_d_nb(iv)
+          ALLOCATE(io_i(i),io_n(i),ia_sm(i),io_sm(i),io_cm(i))
+!-------- Default definition of io_i,io_n,io_sm,io_cm
+          io_i(:) = 1; io_n(:) = f_d_l(v_d_i(1:v_d_nb(iv),iv));
+          ia_sm(:) = 1; io_sm(:) = 1;
+          IF (v_d_ul(iv) > 0) THEN
+            io_i(v_d_ul(iv))=it
+            io_n(v_d_ul(iv))=1
+            io_sm(v_d_ul(iv))=it
+          ENDIF
+          io_cm(:) = io_n(:);
+!-------- If needed, allocate offset
+          l_o_f = .FALSE.; l_o_m = .TRUE.; l_o_l = .FALSE.;
+          IF (TRIM(c_d_n) == "apple") THEN
+            ALLOCATE(ia_sf(i),io_sf(i),io_cf(i))
+            ALLOCATE(ia_sl(i),io_sl(i),io_cl(i))
+            ia_sf(:) = 1; io_sf(:) = 1; io_cf(:) = io_n(:);
+            ia_sl(:) = 1; io_sl(:) = 1; io_cl(:) = io_n(:);
+            IF (v_d_ul(iv) > 0) THEN
+              io_sf(v_d_ul(iv))=it
+              io_sl(v_d_ul(iv))=it
+            ENDIF
+          ENDIF
+        ENDIF
+!------
+        DO i_i=1,i_n
+          IF (l_cgd) THEN
+!---------- the variable contains dimensions to be recombined
+!-----------
+!---------- open each file containing a small piece of data
+            CALL flrb_of (i_i,f_id_i)
+!-----------
+!---------- do the variable has offset at first/last block ?
+            l_cof = .FALSE.; l_col = .FALSE.;
+            IF (TRIM(c_d_n) == "apple") THEN
+              L_BF: DO id=1,v_d_nb(iv)
+                DO i=1,SIZE(d_d_i)
+                  IF (v_d_i(id,iv) == d_d_i(i)) THEN
+                    l_cof = (d_h_s(i,i_i) /= 0)
+                    IF (l_cof)  EXIT L_BF
+                  ENDIF
+                ENDDO
+              ENDDO L_BF
+              L_BL: DO id=1,v_d_nb(iv)
+                DO i=1,SIZE(d_d_i)
+                  IF (v_d_i(id,iv) == d_d_i(i)) THEN
+                    l_col = (d_h_e(i,i_i) /= 0)
+                    IF (l_col)  EXIT L_BL
+                  ENDIF
+                ENDDO
+              ENDDO L_BL
+            ENDIF
+!---------- if needed, redefine start and count for dimensions
+            l_o_f = .FALSE.; l_o_m = .TRUE.; l_o_l = .FALSE.;
+            DO id=1,v_d_nb(iv)
+              DO i=1,SIZE(d_d_i)
+                IF (v_d_i(id,iv) == d_d_i(i)) THEN
+                  io_n(id) = d_p_l(i,i_i)-d_p_f(i,i_i)+1
+                  ia_sm(id) = 1
+                  io_sm(id) = d_p_f(i,i_i)
+                  io_cm(id) = io_n(id)
+                  IF     (TRIM(c_d_n) == "box") THEN
+                    ia_sm(id) = ia_sm(id)+d_h_s(i,i_i)
+                    io_sm(id) = io_sm(id)+d_h_s(i,i_i)
+                    io_cm(id) = io_cm(id)-d_h_s(i,i_i)-d_h_e(i,i_i)
+                  ELSEIF (TRIM(c_d_n) == "apple") THEN
+                    IF (l_cof) THEN
+                      IF (d_h_s(i,i_i) /= 0) THEN
+                        ia_sf(id) = 1+d_h_s(i,i_i)
+                        io_sf(id) = d_p_f(i,i_i)+d_h_s(i,i_i)
+                        io_cf(id) = io_n(id)-d_h_s(i,i_i)
+                      ELSE
+                        io_sf(id) = d_p_f(i,i_i)
+                        io_cf(id) = 1
+                        ia_sm(id) = ia_sm(id)+1
+                        io_sm(id) = io_sm(id)+1
+                        io_cm(id) = io_cm(id)-1
+                        l_o_f = .TRUE.
+                      ENDIF
+                    ENDIF
+                    IF (l_col) THEN
+                      IF (d_h_e(i,i_i) /= 0) THEN
+                        ia_sl(id) = 1
+                        io_sl(id) = d_p_f(i,i_i)
+                        io_cl(id) = io_n(id)-d_h_e(i,i_i)
+                      ELSE
+                        io_cm(id) = io_cm(id)-1
+                        ia_sl(id) = 1+io_n(id)-1
+                        io_sl(id) = d_p_f(i,i_i)+io_n(id)-1
+                        io_cl(id) = 1
+                        l_o_l = .TRUE.
+                      ENDIF
+                    ENDIF
+                  ENDIF
+                ENDIF
+              ENDDO
+            ENDDO
+            l_o_m = ALL(io_cm > 0)
+          ELSE
+!---------- the data can be read/write in one piece
+            f_id_i = f_id_i1
+          ENDIF
+!---------
+          IF (i_v_lev >= 3) THEN
+            WRITE (UNIT=*,FMT=*) &
+ &            TRIM(f_nm(i_i))//" - "//TRIM(f_v_nm(iv))
+            WRITE (UNIT=*,FMT=*) "io_i  : ",io_i(:)
+            WRITE (UNIT=*,FMT=*) "io_n  : ",io_n(:)
+            WRITE (UNIT=*,FMT=*) "l_o_f : ",l_o_f
+            IF (l_o_f) THEN
+              WRITE (UNIT=*,FMT=*) "ia_sf : ",ia_sf(:)
+              WRITE (UNIT=*,FMT=*) "io_sf : ",io_sf(:)
+              WRITE (UNIT=*,FMT=*) "io_cf : ",io_cf(:)
+            ENDIF
+            WRITE (UNIT=*,FMT=*) "l_o_m : ",l_o_m
+            IF (l_o_m) THEN
+              WRITE (UNIT=*,FMT=*) "ia_sm : ",ia_sm(:)
+              WRITE (UNIT=*,FMT=*) "io_sm : ",io_sm(:)
+              WRITE (UNIT=*,FMT=*) "io_cm : ",io_cm(:)
+            ENDIF
+            WRITE (UNIT=*,FMT=*) "l_o_l : ",l_o_l
+            IF (l_o_l) THEN
+              WRITE (UNIT=*,FMT=*) "ia_sl : ",ia_sl(:)
+              WRITE (UNIT=*,FMT=*) "io_sl : ",io_sl(:)
+              WRITE (UNIT=*,FMT=*) "io_cl : ",io_cl(:)
+            ENDIF
+          ENDIF
+!---------
+!-------- Cases according to the type, shape and offsets of the data
+!---------
+          SELECT CASE (v_type(iv))
+!?INTEGERS of KIND 1 are not supported on all computers
+!?        CASE (flio_i1) !--- INTEGER 1
+!?          SELECT CASE (v_d_nb(iv))
+!?          CASE (0) !--- Scalar
+!?            CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_0d)
+!?            CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),i1_0d)
+!?          CASE (1) !--- 1d array
+!?            ALLOCATE(i1_1d(io_n(1)))
+!?            CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_1d, &
+!? &            start=io_i(:),count=io_n(:))
+!?            IF (l_o_f) THEN
+!?              ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_1d(ib(1):ie(1)), &
+!? &              start=io_sf(:),count=io_cf(:))
+!?            ENDIF
+!?            IF (l_o_m) THEN
+!?              ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_1d(ib(1):ie(1)), &
+!? &              start=io_sm(:),count=io_cm(:))
+!?            ENDIF
+!?            IF (l_o_l) THEN
+!?              ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_1d(ib(1):ie(1)), &
+!? &              start=io_sl(:),count=io_cl(:))
+!?            ENDIF
+!?            DEALLOCATE(i1_1d)
+!?          CASE (2) !--- 2d array
+!?            ALLOCATE(i1_2d(io_n(1),io_n(2)))
+!?            CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_2d, &
+!? &            start=io_i(:),count=io_n(:))
+!?            IF (l_o_f) THEN
+!?              ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_2d(ib(1):ie(1),ib(2):ie(2)), &
+!? &              start=io_sf(:),count=io_cf(:))
+!?            ENDIF
+!?            IF (l_o_m) THEN
+!?              ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_2d(ib(1):ie(1),ib(2):ie(2)), &
+!? &              start=io_sm(:),count=io_cm(:))
+!?            ENDIF
+!?            IF (l_o_l) THEN
+!?              ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_2d(ib(1):ie(1),ib(2):ie(2)), &
+!? &              start=io_sl(:),count=io_cl(:))
+!?            ENDIF
+!?            DEALLOCATE(i1_2d)
+!?          CASE (3) !--- 3d array
+!?            ALLOCATE(i1_3d(io_n(1),io_n(2),io_n(3)))
+!?            CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_3d, &
+!? &            start=io_i(:),count=io_n(:))
+!?            IF (l_o_f) THEN
+!?              ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+!? &              start=io_sf(:),count=io_cf(:))
+!?            ENDIF
+!?            IF (l_o_m) THEN
+!?              ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+!? &              start=io_sm(:),count=io_cm(:))
+!?            ENDIF
+!?            IF (l_o_l) THEN
+!?              ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+!? &              start=io_sl(:),count=io_cl(:))
+!?            ENDIF
+!?            DEALLOCATE(i1_3d)
+!?          CASE (4) !--- 4d array
+!?            ALLOCATE(i1_4d(io_n(1),io_n(2),io_n(3),io_n(4)))
+!?            CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_4d, &
+!? &            start=io_i(:),count=io_n(:))
+!?            IF (l_o_f) THEN
+!?              ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_4d(ib(1):ie(1),ib(2):ie(2), &
+!? &                    ib(3):ie(3),ib(4):ie(4)), &
+!? &              start=io_sf(:),count=io_cf(:))
+!?            ENDIF
+!?            IF (l_o_m) THEN
+!?              ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_4d(ib(1):ie(1),ib(2):ie(2), &
+!? &                    ib(3):ie(3),ib(4):ie(4)), &
+!? &              start=io_sm(:),count=io_cm(:))
+!?            ENDIF
+!?            IF (l_o_l) THEN
+!?              ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_4d(ib(1):ie(1),ib(2):ie(2), &
+!? &                    ib(3):ie(3),ib(4):ie(4)), &
+!? &              start=io_sl(:),count=io_cl(:))
+!?            ENDIF
+!?            DEALLOCATE(i1_4d)
+!?          CASE (5) !--- 5d array
+!?            ALLOCATE(i1_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5)))
+!?            CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_5d, &
+!? &            start=io_i(:),count=io_n(:))
+!?            IF (l_o_f) THEN
+!?              ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+!? &                    ib(4):ie(4),ib(5):ie(5)), &
+!? &              start=io_sf(:),count=io_cf(:))
+!?            ENDIF
+!?            IF (l_o_m) THEN
+!?              ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+!? &                    ib(4):ie(4),ib(5):ie(5)), &
+!? &              start=io_sm(:),count=io_cm(:))
+!?            ENDIF
+!?            IF (l_o_l) THEN
+!?              ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+!? &                    ib(4):ie(4),ib(5):ie(5)), &
+!? &              start=io_sl(:),count=io_cl(:))
+!?            ENDIF
+!?            DEALLOCATE(i1_5d)
+!?          END SELECT
+!?        CASE (flio_i2) !--- INTEGER 2
+          CASE (flio_i1,flio_i2) !--- INTEGER 1/INTEGER 2
+            SELECT CASE (v_d_nb(iv))
+            CASE (0) !--- Scalar
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_0d)
+              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),i2_0d)
+            CASE (1) !--- 1d array
+              ALLOCATE(i2_1d(io_n(1)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_1d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_1d(ib(1):ie(1)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_1d(ib(1):ie(1)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_1d(ib(1):ie(1)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(i2_1d)
+            CASE (2) !--- 2d array
+              ALLOCATE(i2_2d(io_n(1),io_n(2)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_2d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(i2_2d)
+            CASE (3) !--- 3d array
+              ALLOCATE(i2_3d(io_n(1),io_n(2),io_n(3)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_3d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(i2_3d)
+            CASE (4) !--- 4d array
+              ALLOCATE(i2_4d(io_n(1),io_n(2),io_n(3),io_n(4)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_4d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(i2_4d)
+            CASE (5) !--- 5d array
+              ALLOCATE(i2_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_5d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(i2_5d)
+            END SELECT
+          CASE (flio_i4) !--- INTEGER 4
+            SELECT CASE (v_d_nb(iv))
+            CASE (0) !--- Scalar
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_0d)
+              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),i4_0d)
+            CASE (1) !--- 1d array
+              ALLOCATE(i4_1d(io_n(1)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_1d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_1d(ib(1):ie(1)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_1d(ib(1):ie(1)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_1d(ib(1):ie(1)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(i4_1d)
+            CASE (2) !--- 2d array
+              ALLOCATE(i4_2d(io_n(1),io_n(2)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_2d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(i4_2d)
+            CASE (3) !--- 3d array
+              ALLOCATE(i4_3d(io_n(1),io_n(2),io_n(3)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_3d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(i4_3d)
+            CASE (4) !--- 4d array
+              ALLOCATE(i4_4d(io_n(1),io_n(2),io_n(3),io_n(4)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_4d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(i4_4d)
+            CASE (5) !--- 5d array
+              ALLOCATE(i4_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_5d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(i4_5d)
+            END SELECT
+          CASE (flio_r4) !--- REAL 4
+            SELECT CASE (v_d_nb(iv))
+            CASE (0) !--- Scalar
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_0d)
+              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),r4_0d)
+            CASE (1) !--- 1d array
+              ALLOCATE(r4_1d(io_n(1)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_1d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_1d(ib(1):ie(1)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_1d(ib(1):ie(1)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_1d(ib(1):ie(1)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(r4_1d)
+            CASE (2) !--- 2d array
+              ALLOCATE(r4_2d(io_n(1),io_n(2)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_2d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(r4_2d)
+            CASE (3) !--- 3d array
+              ALLOCATE(r4_3d(io_n(1),io_n(2),io_n(3)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_3d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(r4_3d)
+            CASE (4) !--- 4d array
+              ALLOCATE(r4_4d(io_n(1),io_n(2),io_n(3),io_n(4)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_4d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(r4_4d)
+            CASE (5) !--- 5d array
+              ALLOCATE(r4_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_5d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(r4_5d)
+            END SELECT
+          CASE (flio_r8) !--- REAL 8
+            SELECT CASE (v_d_nb(iv))
+            CASE (0) !--- Scalar
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_0d)
+              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),r8_0d)
+            CASE (1) !--- 1d array
+              ALLOCATE(r8_1d(io_n(1)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_1d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_1d(ib(1):ie(1)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_1d(ib(1):ie(1)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_1d(ib(1):ie(1)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(r8_1d)
+            CASE (2) !--- 2d array
+              ALLOCATE(r8_2d(io_n(1),io_n(2)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_2d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(r8_2d)
+            CASE (3) !--- 3d array
+              ALLOCATE(r8_3d(io_n(1),io_n(2),io_n(3)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_3d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(r8_3d)
+            CASE (4) !--- 4d array
+              ALLOCATE(r8_4d(io_n(1),io_n(2),io_n(3),io_n(4)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_4d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(r8_4d)
+            CASE (5) !--- 5d array
+              ALLOCATE(r8_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_5d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(r8_5d)
+            END SELECT
+          END SELECT
+!-------- eventually close each file containing a small piece of data
+          CALL flrb_cf (i_i,l_ocf.AND.l_cgd.AND.(i_i /= 1))
+        ENDDO
+!------ If needed, deallocate io_* arrays
+        IF (v_d_nb(iv) > 0) THEN
+          DEALLOCATE(io_i,io_n,ia_sm,io_sm,io_cm)
+          IF (TRIM(c_d_n) == "apple") THEN
+            DEALLOCATE(ia_sf,io_sf,io_cf)
+            DEALLOCATE(ia_sl,io_sl,io_cl)
+          ENDIF
+        ENDIF
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+!-------------------
+! Ending the work
+!-------------------
+!-
+! Close files
+  CALL flrb_cf (0,.TRUE.)
+!-
+! Deallocate
+  DEALLOCATE(f_nm,f_a_id)
+  DEALLOCATE(f_d_nm,f_v_nm,f_a_nm)
+  DEALLOCATE(f_d_i,f_d_l)
+  DEALLOCATE(v_d_nb,v_d_ul,v_type,v_d_i)
+  DEALLOCATE(d_d_i,d_s_g)
+  DEALLOCATE(d_s_l,d_p_f,d_p_l,d_h_s,d_h_e)
+!-
+  IF (i_v_lev >= 1) THEN
+!-- elapsed and cpu time computation
+    CALL cpu_time (t_cpu_end)
+    CALL system_clock(count=nb_cc_end)
+    WRITE (UNIT=*,FMT='("")')
+    WRITE (UNIT=*,fmt='(" elapsed time (s) : ",1PE11.4)') &
+ &   REAL(nb_cc_end-nb_cc_ini)/REAL(nb_cc_sec)
+    WRITE (UNIT=*,fmt='(" CPU time (s) : ",1PE11.4)') &
+ &   t_cpu_end-t_cpu_ini
+  ENDIF
+!=======
+CONTAINS
+!=======
+SUBROUTINE flrb_of (i_f_n,i_f_i)
+!---------------------------------------------------------------------
+! Open the file of number "i_f_n" if necessary,
+! and returns its identifier in "i_f_i".
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN)  :: i_f_n
+  INTEGER,INTENT(OUT) :: i_f_i
+!---------------------------------------------------------------------
+  IF (f_a_id(i_f_n) < 0) THEN
+    CALL flioopfd (TRIM(f_nm(i_f_n)),i_f_i)
+    f_a_id(i_f_n) = i_f_i
+  ELSE
+    i_f_i = f_a_id(i_f_n)
+  ENDIF
+!---------------------
+END SUBROUTINE flrb_of
+!===
+SUBROUTINE flrb_cf (i_f_n,l_cf)
+!---------------------------------------------------------------------
+! Close the file of number "i_f_n" if "l_cf" is TRUE.
+! Close all files if "i_f_n <= 0".
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: i_f_n
+  LOGICAL,INTENT(IN) :: l_cf
+!---------------------------------------------------------------------
+  IF (i_f_n <= 0) THEN
+    CALL flioclo ()
+    f_a_id(:) = -1
+  ELSE
+    IF (l_cf) THEN
+      IF (f_a_id(i_f_n) < 0) THEN
+        CALL ipslerr (2,"flio_rbld", &
+ &       "The file",TRIM(f_nm(i_f_n)),"is already closed")
+      ELSE
+        CALL flioclo (f_a_id(i_f_n))
+        f_a_id(i_f_n) = -1
+      ENDIF
+    ENDIF
+  ENDIF
+!---------------------
+END SUBROUTINE flrb_cf
+!===
+SUBROUTINE flrb_rg
+!---------------------------------------------------------------------
+! Update valid_min valid_max attributes values
+!---------------------------------------------------------------------
+  INTEGER :: k,j
+  LOGICAL :: l_vmin,l_vmax
+  INTEGER(KIND=i_4) :: i4_vmin,i4_vmax
+  REAL(KIND=r_4) :: r4_vmin,r4_vmax
+  REAL(KIND=r_8) :: r8_vmin,r8_vmax
+!---------------------------------------------------------------------
+  DO k=1,f_v_nb
+!-- get attribute informations
+    CALL flioinqa &
+ &    (f_id_i1,TRIM(f_v_nm(k)),'valid_min',l_vmin,a_t=a_type)
+    CALL flioinqa &
+ &    (f_id_i1,TRIM(f_v_nm(k)),'valid_max',l_vmax,a_t=a_type)
+!---
+    IF (l_vmin.OR.l_vmax) THEN
+!---- get values of min/max
+      SELECT CASE (a_type)
+      CASE (flio_i1,flio_i2,flio_i4) !--- INTEGER 1/2/4
+        DO j=1,f_nb_in
+          CALL flrb_of (j,f_id_i)
+          IF (l_vmin) THEN
+            CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_min",i4_0d)
+            IF (j == 1) THEN
+              i4_vmin = i4_0d
+            ELSE
+              i4_vmin = MIN(i4_vmin,i4_0d)
+            ENDIF
+          ENDIF
+          IF (l_vmax) THEN
+            CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_max",i4_0d)
+            IF (j == 1) THEN
+              i4_vmax = i4_0d
+            ELSE
+              i4_vmax = MAX(i4_vmax,i4_0d)
+            ENDIF
+          ENDIF
+          CALL flrb_cf (j,l_ocf.AND.(f_id_i /= f_id_i1))
+        ENDDO
+        IF (l_vmin) THEN
+          CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_min",i4_vmin)
+        ENDIF
+        IF (l_vmax) THEN
+          CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_max",i4_vmax)
+        ENDIF
+      CASE (flio_r4) !--- REAL 4
+        DO j=1,f_nb_in
+          CALL flrb_of (j,f_id_i)
+          IF (l_vmin) THEN
+            CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_min",r4_0d)
+            IF (j == 1) THEN
+              r4_vmin = r4_0d
+            ELSE
+              r4_vmin = MIN(r4_vmin,r4_0d)
+            ENDIF
+          ENDIF
+          IF (l_vmax) THEN
+            CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_max",r4_0d)
+            IF (j == 1) THEN
+              r4_vmax = r4_0d
+            ELSE
+              r4_vmax = MAX(r4_vmax,r4_0d)
+            ENDIF
+          ENDIF
+          CALL flrb_cf (j,l_ocf.AND.(f_id_i /= f_id_i1))
+        ENDDO
+        IF (l_vmin) THEN
+          CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_min",r4_vmin)
+        ENDIF
+        IF (l_vmax) THEN
+          CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_max",r4_vmax)
+        ENDIF
+      CASE (flio_r8) !--- REAL 8
+        DO j=1,f_nb_in
+          CALL flrb_of (j,f_id_i)
+          IF (l_vmin) THEN
+            CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_min",r8_0d)
+            IF (j == 1) THEN
+              r8_vmin = r8_0d
+            ELSE
+              r8_vmin = MIN(r8_vmin,r8_0d)
+            ENDIF
+          ENDIF
+          IF (l_vmax) THEN
+            CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_max",r8_0d)
+            IF (j == 1) THEN
+              r8_vmax = r8_0d
+            ELSE
+              r8_vmax = MAX(r8_vmax,r8_0d)
+            ENDIF
+          ENDIF
+          CALL flrb_cf (j,l_ocf.AND.(f_id_i /= f_id_i1))
+        ENDDO
+        IF (l_vmin) THEN
+          CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_min",r8_vmin)
+        ENDIF
+        IF (l_vmax) THEN
+          CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_max",r8_vmax)
+        ENDIF
+      END SELECT
+    ENDIF
+  ENDDO
+!---------------------
+END SUBROUTINE flrb_rg
+!===
+!--------------------
+END PROGRAM flio_rbld
Index: trunk/NEMOGCM/EXTERNAL/IOIPSL/tools/ncregular.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/IOIPSL/tools/ncregular.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/IOIPSL/tools/ncregular.f90	(revision 2528)
@@ -0,0 +1,328 @@
+PROGRAM ncregular
+!
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+!- This code replaces a 2D surface grid by vectors.
+!- Obviously it only works if you have a regular grid.
+!-
+!- Jan Polcher (polcher@lmd.jussieu.fr)
+!- Jacques Bellier (jacques.bellier@cea.fr)
+!---------------------------------------------------------------------
+  USE netcdf
+!-
+  IMPLICIT NONE
+!-
+  INTEGER :: iread, if, in, iv, sz
+  INTEGER :: ier, nb_files, iret, ndims, nvars, nb_glat
+  INTEGER :: lon_dim_id, lat_dim_id
+  INTEGER :: lon_len, lat_len, lon_id, lat_id
+  INTEGER :: nav_lon_id, nav_lat_id
+  INTEGER :: alloc_stat_lon, alloc_stat_lat
+!-
+  INTEGER,ALLOCATABLE ::  file_id(:), tax_id(:)
+  CHARACTER(LEN=80),ALLOCATABLE :: names(:)
+  CHARACTER(LEN=80) :: dim_name
+  CHARACTER(LEN=80) :: varname
+  CHARACTER(LEN=20) :: xname, yname, lonname, latname
+  LOGICAL :: check, regular
+!-
+  REAL,ALLOCATABLE :: lon(:), lat(:), lon2(:), lat2(:)
+  REAL,ALLOCATABLE :: del_lon(:), del_lat(:)
+!-
+  INTEGER iargc, getarg
+  EXTERNAL iargc, getarg
+!---------------------------------------------------------------------
+  alloc_stat_lon = 0
+  alloc_stat_lat = 0
+!-
+  iread = iargc()
+!-
+  ALLOCATE (names(iread),stat=ier)
+  IF (ier /= 0) THEN
+    WRITE (*,*) ' Could not allocate names of size ', iread
+    STOP 'nctax'
+  ENDIF
+!-
+  CALL nct_getarg (iread, nb_files, names, check, &
+ &                 xname, yname, lonname, latname)
+!-
+! Allocate space
+!-
+  ALLOCATE (file_id(nb_files),stat=ier)
+  IF (ier /= 0) THEN
+    WRITE (*,*) ' Could not allocate file_id of size ', nb_files
+    STOP 'nctax'
+  ENDIF
+!-
+  ALLOCATE (tax_id(nb_files),stat=ier)
+  IF (ier /= 0) THEN
+    WRITE (*,*) ' Could not allocate tax_id of size ', nb_files
+    STOP 'nctax'
+  ENDIF
+!-
+  DO if=1,nb_files
+!---
+    IF (check) THEN
+      WRITE(*,*) 'ncregular : ', if,  names(if)
+    ENDIF
+!---
+    iret = NF90_OPEN (names(if),NF90_WRITE,file_id(if))
+    iret = NF90_INQUIRE (file_id(if),ndims,nvars,nb_glat,tax_id(if))
+!---
+!-- Get the IDs of the variables
+!---
+    lon_len = -9999
+    lat_len = -9999
+    DO in=1,ndims
+!-----
+      iret = NF90_INQUIRE_DIMENSION (file_id(if), in, dim_name, sz)
+!-----
+      IF (     (LEN_TRIM(dim_name) == 1) &
+ &        .AND.(INDEX(dim_name,TRIM(xname)) == 1) ) THEN
+        lon_dim_id = in
+        lon_len = sz
+      ENDIF
+!-----
+      IF (     (LEN_TRIM(dim_name) == 1) &
+ &        .AND.(INDEX(dim_name,TRIM(yname)) == 1) ) THEN
+        lat_dim_id = in
+        lat_len = sz
+      ENDIF
+!-----
+    ENDDO
+!---
+    IF ( (lon_len == -9999).OR.(lat_len == -9999) ) THEN
+      WRITE(*,*) 'ncregular : The specified dimensions were not'
+      WRITE(*,*) 'found in file : ',names(if)
+      iret = NF90_CLOSE (file_id(if))
+      STOP
+    ENDIF
+!---
+    IF (check) THEN
+      WRITE(*,*) 'ncregular : lon_dim_id, lon_len',lon_dim_id,lon_len
+      WRITE(*,*) 'ncregular : lat_dim_id, lat_len',lat_dim_id,lat_len
+    ENDIF
+!---
+!-- Look for the right variables
+!---
+    nav_lon_id = -9999
+    nav_lat_id = -9999
+    DO iv=1,nvars
+      iret = NF90_INQUIRE_VARIABLE (file_id(if),iv,name=varname)
+      IF (INDEX(varname,TRIM(lonname)) > 0) THEN
+        nav_lon_id = iv
+      ENDIF
+      IF (INDEX(varname,TRIM(latname)) > 0) THEN
+        nav_lat_id = iv
+      ENDIF
+    ENDDO
+!---
+    IF ( (nav_lon_id == -9999).OR.(nav_lat_id == -9999) ) THEN
+      WRITE(*,*) 'ncregular : The specified coordinate fields'
+      WRITE(*,*) 'were not found in file : ',names(if)
+      iret = NF90_CLOSE (file_id(if))
+      STOP
+    ENDIF
+!---
+    IF (check) THEN
+      WRITE(*,*) 'ncregular : nav_lon_id :', nav_lon_id
+      WRITE(*,*) 'ncregular : nav_lat_id :', nav_lat_id
+    ENDIF
+!---
+!-- Read variables from file and check if regular
+!---
+!-- Do we have the variable to read the
+!---
+    IF ( alloc_stat_lon < lon_len) THEN
+      IF ( alloc_stat_lon > 0) THEN
+        deallocate(lon)
+        deallocate(lon2)
+        deallocate(del_lon)
+      ENDIF
+      allocate(lon(lon_len))
+      allocate(lon2(lon_len))
+      allocate(del_lon(lon_len))
+      alloc_stat_lon = lon_len
+    ENDIF
+!---
+    IF ( alloc_stat_lat < lat_len) THEN
+      IF ( alloc_stat_lat > 0) THEN
+        deallocate(lat)
+        deallocate(lat2)
+        deallocate(del_lat)
+      ENDIF
+      allocate(lat(lat_len))
+      allocate(lat2(lat_len))
+      allocate(del_lat(lat_len))
+      alloc_stat_lat = lat_len
+    ENDIF
+!---
+!-- Read data
+!---
+    iret = NF90_GET_VAR (file_id(if),nav_lon_id,lon, &
+ & start=(/1,1/),count=(/lon_len,1/),stride=(/1,1/))
+    iret = NF90_GET_VAR (file_id(if),nav_lon_id,lon2, &
+ & start=(/1,int(lat_len/2)/),count=(/lon_len,1/),stride=(/1,1/))
+    del_lon = lon-lon2
+!-
+    iret = NF90_GET_VAR (file_id(if),nav_lat_id,lat, &
+ & start=(/1,1/),count=(/1,lat_len/),stride=(/lon_len,1/))
+    iret = NF90_GET_VAR (file_id(if),nav_lat_id,lat2, &
+ & start=(/int(lon_len/2),1/),count=(/1,lat_len/),stride=(/lon_len,1/))
+    del_lat = lat-lat2
+!-
+    regular = (    (MAXVAL(del_lon) < 0.001) &
+ &             .OR.(MAXVAL(del_lat) < 0.001) )
+!---
+!-- Create the new variables
+!---
+    IF (regular) THEN
+      IF (check) THEN
+        WRITE(*,*) 'Regular case'
+      ENDIF
+      iret = NF90_REDEF (file_id(if))
+      iret = NF90_RENAME_DIM (file_id(if), lon_dim_id, 'lon')
+      iret = NF90_RENAME_DIM (file_id(if), lat_dim_id, 'lat')
+      IF (check) THEN
+        WRITE(*,*) 'Dimensions renamed'
+      ENDIF
+      iret = NF90_DEF_VAR (file_id(if), 'lon', NF90_FLOAT, &
+ &                         lon_dim_id, lon_id)
+      iret = NF90_DEF_VAR (file_id(if), 'lat', NF90_FLOAT, &
+ &                         lat_dim_id, lat_id)
+      IF (check) THEN
+        WRITE(*,*) 'New variables defined'
+      ENDIF
+!-----
+!---- Copy attributes
+!-----
+      iret = NF90_COPY_ATT (file_id(if),nav_lon_id,'units', &
+ &                          file_id(if),lon_id)
+      iret = NF90_COPY_ATT (file_id(if),nav_lon_id,'title', &
+ &                          file_id(if),lon_id)
+      iret = NF90_COPY_ATT (file_id(if),nav_lon_id,'valid_max', &
+ &                          file_id(if),lon_id)
+      iret = NF90_COPY_ATT (file_id(if),nav_lon_id,'valid_min', &
+ &                          file_id(if),lon_id)
+!-----
+      iret = NF90_COPY_ATT (file_id(if),nav_lat_id,'units', &
+ &                          file_id(if),lat_id)
+      iret = NF90_COPY_ATT (file_id(if),nav_lat_id,'title', &
+ &                          file_id(if),lat_id)
+      iret = NF90_COPY_ATT (file_id(if),nav_lat_id,'valid_max', &
+ &                          file_id(if),lat_id)
+      iret = NF90_COPY_ATT (file_id(if),nav_lat_id,'valid_min', &
+ &                          file_id(if),lat_id)
+!-----
+!---- Go into write mode
+!-----
+      iret = NF90_ENDDEF (file_id(if))
+!-----
+!---- Write data
+!-----
+      iret = NF90_PUT_VAR (file_id(if),lon_id,lon(1:lon_len))
+      iret = NF90_PUT_VAR (file_id(if),lat_id,lat(1:lat_len))
+!-
+      iret = NF90_CLOSE (file_id(if))
+    ELSE
+      WRITE(*,*) 'ncregular : Your grid is not regular'
+      WRITE(*,*) names(if), 'remains unchanged'
+      iret = NF90_CLOSE (file_id(if))
+    ENDIF
+!-
+  ENDDO
+!--------------------
+END PROGRAM ncregular
+!-
+!===
+!-
+SUBROUTINE nct_getarg (argx, nb_files, names, check, &
+ &                     xname, yname, lonname, latname)
+!---------------------------------------------------------------------
+!- Read the arguments of nctax.
+!---------------------------------------------------------------------
+  INTEGER,INTENT(in) :: argx
+  INTEGER, INTENT(out) :: nb_files
+  CHARACTER(LEN=80),INTENT(out) :: names(argx)
+  CHARACTER(LEN=20) :: xname, yname, lonname, latname
+!-
+  CHARACTER(LEN=80) :: tmp, tmp_arg
+  LOGICAL :: check
+!---------------------------------------------------------------------
+  check = .FALSE.
+!-
+! Get the number of arguments
+!-
+  nb_files = 0
+!-
+  xname = 'x'
+  yname = 'y'
+  lonname = 'nav_lon'
+  latname = 'nav_lat'
+!-
+! Go through the arguments and analyse them one by one
+!-
+  IF (check) WRITE(*,*) 'Start going through the arguments'
+!-
+  IF (argx == 0) THEN
+    WRITE(*,*) 'To get usage : nctax -h '
+    STOP
+  ENDIF
+!-
+  iread = 1
+  DO WHILE (iread <= argx)
+    iret = getarg(iread,tmp)
+    IF (check) WRITE(*,*) ' iread, tmp :', iread, tmp
+    SELECTCASE(tmp)
+      CASE('-d')
+        WRITE(*,*) 'DEBUG MODE SELECTED'
+        check = .TRUE.
+        iread = iread+1
+      CASE('-h')
+        WRITE(*,*) 'Usage : nregular [options] file1 [file2 ...]'
+        WRITE(*,*) '    -d : Verbose mode'
+        WRITE(*,*) '    -h : This output'
+        STOP
+      CASE('-dim_lon')
+        iread = iread+1
+        iret  = getarg(iread,tmp_arg)
+        xname = TRIM(tmp_arg)
+        iread = iread+1
+      CASE('-dim_lat')
+        iread = iread+1
+        iret  = getarg(iread,tmp_arg)
+        yname = TRIM(tmp_arg)
+        iread = iread+1
+      CASE('-coo_lon')
+        iread = iread+1
+        iret  = getarg(iread,tmp_arg)
+        lonname = TRIM(tmp_arg)
+        iread = iread+1
+      CASE('-coo_lat')
+        iread = iread+1
+        iret  = getarg(iread,tmp_arg)
+        latname = TRIM(tmp_arg)
+        iread = iread+1
+      CASE DEFAULT
+        IF (check) WRITE(*,*) 'nct_getarg : CASE default'
+        IF (INDEX(tmp,'-') /= 1) THEN
+          nb_files = nb_files+1
+          names(nb_files) = tmp
+          iread = iread+1
+        ELSE
+          WRITE(*,*) "WARNING Unknown option ",tmp
+          WRITE(*,*) "For ore information : nctax -h"
+        ENDIF
+    END SELECT
+  ENDDO
+!-
+  IF (check) THEN
+    WRITE(*,*) ' nct_getarg : output >> '
+    WRITE(*,*) '>> nb_files : ', nb_files
+    WRITE(*,*) '>> names :', (names(ii), ii=1,nb_files)
+  ENDIF
+!------------------------
+END SUBROUTINE nct_getarg
Index: trunk/NEMOGCM/EXTERNAL/IOIPSL/tools/ncunderflow.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/IOIPSL/tools/ncunderflow.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/IOIPSL/tools/ncunderflow.f90	(revision 2528)
@@ -0,0 +1,393 @@
+MODULE declare
+! -*- Mode: f90 -*-
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!-
+! f90 -L/usr/local/lib -lnetcdf -align dcommons -g
+!     -ladebug -check format -check bounds
+!     -check output_conversion -fpe1
+!     -I/usr/local/include -free -arch host -tune host
+!     -warn declarations -warn argument_checking
+!     ncunderflow.f  -o ncunderflow
+!
+! ifc -FR -cl,ncunderflow.pcl -o ncunderflow ncunderflow.f
+!     -L/usr/local/install/netcdf/lib/libnetcdf.a -lPEPCF90
+!
+  IMPLICIT NONE
+  INTEGER, PARAMETER :: r4 = 4, r8 = 8, i4 = 4, i8 = 8
+  INTEGER, PARAMETER :: il = KIND(1)
+  LOGICAL :: ldebug = .FALSE.
+  INTEGER (kind = il) :: nout = 0, nerr = 0         ! Standard output, standard error
+  CHARACTER (LEN=4), PARAMETER :: cerror = 'VOID'
+END MODULE declare
+!!
+MODULE mod_nfdiag
+CONTAINS
+  SUBROUTINE nfdiag ( kios, clmess, lcd)
+    !!
+    !! Imprime un message d'erreur NetCDF
+    !!
+    USE declare
+    IMPLICIT NONE
+    INCLUDE 'netcdf.inc'
+    !!
+    INTEGER (kind=i4), INTENT (in) :: kios
+    CHARACTER (len = *), INTENT (in) :: clmess
+    LOGICAL, INTENT (in), OPTIONAL :: lcd 
+    CHARACTER (len = 80) :: clt
+    LOGICAL :: ld
+    !!
+    IF ( PRESENT ( lcd)) THEN
+        ld = lcd
+    ELSE
+        ld = ldebug
+    ENDIF
+    !!
+    clt = TRIM ( NF_STRERROR ( kios) )
+    !!
+    IF ( ld ) THEN 
+        IF ( kios == NF_NOERR ) THEN 
+            WRITE ( unit = nout, fmt = * ) "OK : ", TRIM (clmess)
+        ELSE
+            WRITE ( unit = nout, fmt = * ) "ERROR : ", TRIM (clmess), " : ", TRIM ( clt), " : ", kios
+            IF ( .NOT. ld ) STOP
+        END IF
+    ELSE
+        IF ( kios /= NF_NOERR ) THEN 
+            WRITE ( unit = nout, fmt = * ) "ERROR : ", TRIM (clmess), " : ", TRIM ( clt), " : ", kios
+            STOP
+        END IF
+    ENDIF
+    !!
+    RETURN
+    !!
+  END SUBROUTINE nfdiag
+  !!
+END MODULE mod_nfdiag
+
+MODULE mod_lec
+CONTAINS
+  !!
+  SUBROUTINE lec (chaine, cval, c_c)
+    !!
+    USE declare
+    IMPLICIT NONE
+    !!
+    CHARACTER (len = *), INTENT ( inout) :: chaine
+    CHARACTER (len = *), INTENT ( inout) :: cval
+    CHARACTER (len=*), OPTIONAL :: c_c
+    INTEGER (kind = il) :: ji, ji1, ji2, ji3, jl, jb
+    INTEGER (kind = i4) :: index
+    !!
+    !! Read character string up to ':' or ',', or in c_c if present
+    !! Returns the real before the character (xerror if not available)
+    !! Reduce the string
+    !!
+    jl = LEN (chaine) ; jb = LEN_TRIM (chaine)
+    IF ( ldebug) WRITE ( nout, *) 'Lec : jl, jb ', jl, jb
+    IF ( jb == 0 ) THEN 
+        cval = cerror
+    ELSE
+        ji1 = INDEX (chaine, ':') ; ji2 = INDEX (chaine, ',')
+        IF ( PRESENT (c_c)) THEN 
+            ji3 = INDEX (chaine, c_c) ; ji = MAX (ji1, ji2, ji3)
+        ELSE
+            ji = MAX (ji1, ji2)
+        ENDIF
+        IF ( ji == 0 ) THEN 
+            READ ( chaine (1:jb) , fmt = * ) cval
+            chaine (1:jl-jb) = chaine (jb+1:jl)
+        ELSE IF ( ji == 1 ) THEN 
+            cval = cerror
+            chaine (1:jl-1) = chaine (2:jl)
+        ELSE
+            cval = chaine (1:ji-1)
+            chaine (1:jl-ji) = chaine (ji+1:jl )
+        END IF
+    END IF
+    !!
+  END SUBROUTINE lec
+END MODULE mod_lec
+
+PROGRAM ncunderflow
+
+  ! Ce programme ouvre un fichier de donnees au format netcdf
+  ! et met a zero toutes les valeurs trop petites pour etre
+  ! representees par un reel sur 4 octets au format IEEE
+  !
+  ! Revision 2.0  2004/04/05 14:47:50  adm
+  ! JB+MAF+AC: switch to IOIPSL 2.0 (1)
+  !
+  ! Revision 1.1  2003/04/09 15:21:56  adm
+  ! add ncunderflow in IOIPSL
+  ! and modify AA_make to take it into account
+  ! SD + MAF
+  !
+  ! Revision 1.1  2001/02/07  14:36:07  jypeter
+  ! J-Y Peterschmitt / LMCE / 07/02/2001
+  ! Initial revision
+  !
+  USE declare
+  USE mod_nfdiag
+  USE mod_lec
+  IMPLICIT NONE
+
+  INCLUDE 'netcdf.inc'
+
+  INTEGER (kind=il), EXTERNAL :: iargc
+
+  ! Nombre maximal de dimensions : 6
+
+  INTEGER (kind=il), PARAMETER :: jpmaxdim = 6, jpmaxvar = 1024
+
+  CHARACTER (len = 128) :: clnomprog, clnomfic
+  CHARACTER (len = 1024) :: clistvar, clecline
+  CHARACTER (len = 128), DIMENSION(jpmaxdim) :: clnomdim
+  CHARACTER (len = 128), DIMENSION(jpmaxvar) :: clvarcmd, clvarfic, clvar ! Nom des variables dans le fichier est sur la ligne de commande.
+  LOGICAL :: lrever = .FALSE. ! Si .true., on traite toutes les variables sauf celle de la ligne de commande
+  LOGICAL :: lnocoord = .FALSE. ! Si .truee., on exclu les variables coordonnées
+  LOGICAL :: lverbose = .TRUE.
+  
+  INTEGER (kind=il) :: incid, ircode, ivarid, ivartype, inbdim, inbatt
+  INTEGER (kind=il) :: nvarcmd, nvarfic, nvar, nfile, jvarcmd, jvarfic, jvar, jfile, ierr
+  INTEGER (kind=il) :: ji, jdim3, jdim4, jdim5, jdim6, j1, j2, j3, jarg, ncumul
+  INTEGER (kind=il), DIMENSION(jpmaxdim) :: idimid, idimsize, istart, icount
+  REAL (kind=r4), DIMENSION(:,:), ALLOCATABLE :: zdatacorr
+  REAL (kind=r8), DIMENSION(:,:), ALLOCATABLE :: zdata
+  REAL (kind=r4) :: reps = TINY (1.0_r4) * 10.0_r4
+  LOGICAL :: lok
+
+  ! Verification du nombre de parametres
+  IF(iargc() .LT. 2) THEN
+      CALL usage
+      STOP
+  ENDIF
+
+  ! Aide
+  jarg = 1
+  Lab1: DO WHILE ( jarg <= 3 )
+    IF (ldebug) WRITE(nout,*) 'lecture ligne commande ', jarg
+    CALL getarg (jarg,clecline)
+    IF ( clecline(1:1) /= '-' ) EXIT Lab1
+    IF ( clecline(1:2) == '-h' .OR. clecline(1:2) == '-?'  ) THEN
+        CALL usage
+        STOP 
+    ELSE IF ( clecline(1:2) == '-x' ) THEN
+        lrever = .TRUE. 
+    ELSE IF ( clecline(1:2) == '-d' ) THEN
+        ldebug = .TRUE. 
+    ELSE IF ( clecline(1:2) == '-V' ) THEN
+        lverbose = .FALSE. 
+    ELSE IF ( clecline(1:2) == '-v' ) THEN
+        jarg = jarg + 1
+        ! Recuperation des noms de variables
+        IF (ldebug) WRITE(nout,*) 'lecture liste vriables ', jarg
+        CALL getarg (jarg,clistvar)
+        clistvar = TRIM(ADJUSTL(clistvar))
+        jvarcmd = 0 ; nvarcmd = 0
+        SeekVar: DO WHILE ( .TRUE. )
+          CALL lec ( clistvar, clvarcmd(jvarcmd+1)(:) )
+          IF ( TRIM(clvarcmd(jvarcmd+1)(:)) == cerror ) EXIT SeekVar
+          jvarcmd = jvarcmd + 1
+          nvarcmd = jvarcmd
+          IF (ldebug) WRITE(nout,*) 'affecte variable ', jvarcmd, TRIM(clvarcmd(jvarcmd))
+        END DO SeekVar
+    ENDIF
+    jarg = jarg + 1
+  END DO Lab1
+
+  ! Boucle sur les fichiers
+  FileLoop: DO jfile = jarg, iargc()
+    
+    ! Recuperation du nom du fichier a traiter
+    CALL getarg ( jfile, clnomfic)
+    
+    ! Ouverture du fichier
+    CALL nfdiag ( NF_OPEN ( TRIM(clnomfic), NF_WRITE, incid ), "Opening " // TRIM(clnomfic) )
+    WRITE (nout,*) TRIM(clnomfic)
+
+    ! Recuparation de la liste des variables du fichier
+    nvarfic = 0
+    DO jvarfic = 1, jpmaxvar
+      j3 = NF_INQ_VAR ( incid, jvarfic, clvarfic(jvarfic)(:), ivartype, inbdim, idimid, inbatt)
+      IF ( j3 /= NF_NOERR ) EXIT
+      nvarfic = jvarfic
+    END DO
+
+    ! Liste des variables a traiter
+    IF ( lrever ) THEN
+        IF ( nvarcmd == 0) THEN 
+            clvar = clvarfic
+            nvar  = nvarfic
+        ELSE 
+            jvar = 0
+            DO jvarfic = 1, nvarfic
+              lok = .TRUE.
+              DO jvarcmd = 1, nvarcmd
+                IF ( TRIM(clvarfic(jvarfic)(:)) == TRIM(clvarcmd(jvarcmd)(:)) ) THEN
+                    lok = .FALSE.
+                END IF
+              END DO
+              IF ( lok) THEN 
+                  jvar = jvar + 1
+                  clvar(jvar) = clvarfic(jvarfic)
+              END IF
+            END DO
+            nvar = jvar
+        END IF
+    ELSE
+        clvar = clvarcmd
+        nvar  = nvarcmd
+    END IF
+
+    ncumul = 0
+    VarLoop: DO jvar = 1, nvar 
+      
+      IF (lverbose) &
+         & WRITE(nout, FMT='("Correction de ", A, " dans ", A, " : ", $)') TRIM(clvar(jvar)(:)), TRIM(clnomfic)
+
+      ! Passage de netcdf en mode 'erreurs non fatales'
+      !  CALL ncpopt(NCVERBOS)
+      ! En fait, on reste dans le mode par defaut, dans lequel une erreur
+      ! netcdf cause un arret du programme. Du coup, il n'est pas
+      ! necessaire de tester la valeur de la variable ircode
+      ! ATTENTION! Si jamais on veut arreter le programme a cause d'une
+      ! erreur ne provenant pas de netcdf, il faut penser a fermer
+      ! manuellement le fichier avec un appel a ncclos
+      
+      ! Recuperation de l'identificateur de la variable
+      CALL nfdiag ( NF_INQ_VARID ( incid, TRIM(clvar(jvar)(:)), ivarid), "Get var id " // TRIM(clvar(jvar)(:)))
+
+      ivartype = 0 ; idimid = 0 ; inbdim = 0 ; inbatt = 0
+      ! Recuperation du nombre de dimensions de la variable
+      CALL nfdiag ( NF_INQ_VAR ( incid, ivarid, clvar(jvar)(:), ivartype, inbdim, idimid, inbatt),  &
+         & "Get var info " // TRIM(clvar(jvar)(:)))
+      
+      IF(inbdim .GT. jpmaxdim) THEN
+          WRITE(nout,*)
+          WRITE(nout, *) 'La variable ', TRIM(clvar(jvar)(:)), ' a trop de dimensions'
+          CALL nfdiag ( NF_CLOSE (incid), "Closing file")
+          STOP
+      ENDIF
+      
+      ! Recuperation des dimensions effectives
+      idimsize(3:jpmaxdim) = 1 ! Au cas ou la variable n'ait que
+      ! 2 ou 3 dims, on initialise ces valeurs
+      ! qui serviront dans le controle des boucles
+      ! et qui auraient une valeur indefinie sinon
+      DO ji = 1, inbdim
+        CALL nfdiag ( NF_INQ_DIM ( incid, idimid(ji), clnomdim(ji), idimsize(ji)), "NF_INQ_DIM")
+        IF (lverbose) WRITE(nout, '(A,A,A,I3,$)') '    ', TRIM(clnomdim(ji)), ' = ', idimsize(ji)
+        IF ( idimsize(ji) == 0 ) THEN
+            WRITE(nout, '(A,A,A,A,I3)') TRIM(clvar(jvar)(:)), ', ', TRIM(clnomdim(ji)), ' = ', idimsize(ji)
+            CYCLE VarLoop
+        END IF
+      ENDDO
+      IF (lverbose) WRITE(nout,*)
+      idimsize = MAX ( idimsize, 1)
+      ncumul = ncumul + 1
+      
+      ! Determination du type de la variable, en fonction du nom de
+      ! la premiere dimension
+!$$$  IF(INDEX(TRIM(clnomdim(1)),'ongitude') .NE. 0) THEN
+!$$$      ! var de type map ou 3d
+!$$$      write(nout, *) '  --> MAP/3D'
+!$$$  ELSE IF(INDEX(TRIM(clnomdim(1)),'atitude') .NE. 0) THEN
+!$$$      ! var de type xsec 
+!$$$      write(nout, *) '  --> XSEC'
+!$$$  ELSE
+!$$$      WRITE(nout, *)
+!$$$      WRITE(nout, *) 'Bizarre, la premiere dimension n''est ni "longitude" ni "latitude"'
+!$$$      CALL ncclos(incid, ircode)
+!$$$      STOP
+!$$$  ENDIF
+
+      ! Reservation de memoire pour charger et traiter
+      ! une grille idimsize(1)*idimsize(2) de la variable
+      ALLOCATE(zdata(idimsize(1), idimsize(2)), stat=ierr)
+      IF(ierr .NE. 0) THEN
+          WRITE(nout, *) 'Erreur d''allocation memoire pour zdata'
+          CALL nfdiag ( NF_CLOSE (incid), "NF_CLOSE")
+          STOP
+      ENDIF
+      ALLOCATE(zdatacorr(idimsize(1), idimsize(2)), stat=ierr)
+      IF(ierr .NE. 0) THEN
+          WRITE(nout, *) 'Erreur d''allocation memoire pour zdatacorr'
+          CALL nfdiag ( NF_CLOSE (incid), "NF_CLOSE")
+          STOP
+      ENDIF
+
+      ! Parametrisation de la partie de la variable a charger en memoire
+      ! (une 'grille' que l'on lira autant de fois qu'il y a de niveaux et
+      !  de pas de temps)
+      ! Rappel : seuls les elements 1..inbdim des tableaux sont
+      ! significatifs et utiles
+
+      icount = 0
+      
+      DO jdim6 = 1, idimsize(6)
+        DO jdim5 = 1, idimsize(5)
+          DO jdim4 = 1, idimsize(4)
+            DO jdim3 = 1, idimsize(3)
+              istart = (/   1        ,      1      , jdim3, jdim4, jdim5, jdim6 /)
+              icount = (/ idimsize(1),  idimsize(2),   1  ,  1   ,  1   ,  1    /)
+
+              ! Chargement d'une 'grille' de donnees, en real*8
+              CALL nfdiag ( NF_GET_VARA_DOUBLE(incid, ivarid, istart(1:inbdim), icount(1:inbdim), zdata), &
+                 & "NF_GET_VARA_DOUBLE")
+              ! Mise a zero de toutes les valeurs trop petites pour etre
+              ! representees par un reel sur 4 octets au format IEEE.
+              ! Le truc est de faire une operation nulle (addition de 0)
+              ! sur des donnees qui posent problemes, EN AYANT COMPILE LE PROG
+              ! AVEC l'OPTION "-fpe1". Dans ce cas, les valeurs trop petites
+              ! sont remplacees par zero (0.0) et le programme continue,
+              ! au lieu de planter.
+              ! Il est possible de faire afficher le nb de valeurs qui ont pose
+              ! un pb en utilisant en plus l'option "-check underflow"
+              zdata = zdata + 0.0_r8
+              zdatacorr = REAL(zdata, KIND=r4)
+              WHERE ( ABS (zdatacorr) < reps) zdatacorr = 0.0_r4
+              
+              ! Sauvegarde de la grille corrigee dans le fichier
+              ! (a la place de la grille initiale), en real*4
+              CALL nfdiag ( NF_PUT_VARA_REAL(incid, ivarid, istart, icount, zdatacorr), "NF_PUT_VARA_REAL" )
+              
+            END DO
+          END DO
+        END DO
+      END DO
+      
+      DEALLOCATE ( zdata)
+      DEALLOCATE ( zdatacorr)
+      
+    END DO VarLoop
+    
+    WRITE (nout,*) 'ncunderflow, nombre de variables corrigees : ', ncumul
+
+    ! Fermeture du fichier
+    CALL nfdiag ( NF_CLOSE (incid), "Closing" )
+    
+  END DO FileLoop
+
+CONTAINS
+  SUBROUTINE usage
+    IMPLICIT NONE
+    CALL getarg (0, clnomprog)
+
+    WRITE(nout, FMT='("Command : ", A)') TRIM(clnomprog)
+    WRITE(nout, FMT='("Removes underflows in NetCDF files") ')
+    WRITE(nout, FMT='("Usage : ", A, " [-x] [-V] [-d] -v nomvar[,nomvar] nomfic [nomfic]")' ) TRIM(clnomprog)
+    WRITE(nout, FMT='("Options : ")' )
+    WRITE(nout, FMT='("  -V : mode verbose off. Default is verbose on.")' )
+    WRITE(nout, FMT='("  -d : debug mode on. Default is debug off.")' )
+    WRITE(nout, FMT='("  -v : gives list of variables to be corrected, separated by a coma.")' )
+    WRITE(nout, FMT='("  -x : reverses meaning of -v : given variable are not corrected")' )
+    WRITE(nout, FMT='("       if -x is given, and not -v, all variables are corrected.")' )
+    
+    
+    STOP
+  END SUBROUTINE usage
+  
+END PROGRAM ncunderflow
Index: trunk/NEMOGCM/EXTERNAL/IOIPSL/tools/rebuild
===================================================================
--- trunk/NEMOGCM/EXTERNAL/IOIPSL/tools/rebuild	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/IOIPSL/tools/rebuild	(revision 2528)
@@ -0,0 +1,110 @@
+#!/bin/ksh
+#
+#$Id$
+#
+# This software is governed by the CeCILL license
+# See IOIPSL/IOIPSL_License_CeCILL.txt
+#---------------------------------------------------------------------
+# @(#)Rebuild IOIPSL domains
+#---------------------------------------------------------------------
+function rebuild_Usage
+{
+print - "
+\"${b_n}\"
+  rebuild a model_file from several input files.
+Each input file contains the model_data for a domain.
+
+Usage :
+  ${b_n} [-h]
+  ${b_n} [-v level] [-f] -o output_file_name input_file_names
+
+Options :
+  -h         : help
+  -v O/1/2/3 : verbose mode (verbosity increasing with level)
+  -f         : executing mode
+               (execute the program even if the number of input files
+                is not equal to the total number of domains)
+"
+}
+#-
+#set -xv
+#-
+# Extract the calling sequence of the script (d_n/b_n)
+#-
+d_n=${0%/*}; b_n=${0##*/};
+#-
+# Retrieving the options
+#-
+r_v='0'; r_f='noforce'; r_o="";
+while getopts :hv:fo: V
+ do
+  case $V in
+   (h) rebuild_Usage; exit 0;;
+   (v) r_v=${OPTARG};;
+   (f) r_f='force';;
+   (o) r_o=${OPTARG};;
+   (:) print -u2 "${b_n} : missing value for option $OPTARG"; exit 2;;
+   (\?) print -u2 "${b_n} : option $OPTARG not supported"; exit 2;;
+  esac
+ done
+shift $(($OPTIND-1));
+#-
+# Validate the -v option
+#-
+case ${r_v} in
+  ( 0 | 1 | 2 | 3 );;
+  ("") r_v='0';;
+  (*)
+    print -u2 "${b_n} :";
+    print -u2 "Invalid verbosity level requested : ${r_v}";
+    print -u2 "(must be 0, 1, 2 or 3)";
+    exit 1;;
+esac
+#-
+# Validate the number of arguments
+#-
+[[ ${#} < 1 ]] && \
+ {
+  print -u2 "${b_n} : Too few arguments have been specified. (Use -h)";
+  exit 3;
+ }
+#-
+# Check for the output file name
+#-
+[[ -z ${r_o} ]] && \
+ {
+  r_o='rebuilt_file.nc';
+  print -u2 - "
+   ${b_n} : output_file_name not specified. (Use -h)
+            rebuilt_file.nc should be created."
+ }
+#-
+# Validate the names of the input files
+#-
+for i in $*;
+ do
+  [[ ! -f ${i} ]] && { echo "${i} unreachable ..."; exit 3;}
+ done
+#-
+# Create the information file for the program
+#-
+echo ${r_v} > tmp.$$;
+echo ${r_f} >> tmp.$$;
+echo $((${#}+1)) >> tmp.$$;
+for i in $*;
+ do echo ${i} >> tmp.$$;
+ done
+echo ${r_o} >> tmp.$$;
+#-
+# Create the output file
+#-
+${d_n}/flio_rbld.exe < tmp.$$
+r_c=$?
+#-
+# Clear
+#-
+rm -f tmp.$$
+#-
+# End
+#-
+exit ${r_c};
Index: trunk/NEMOGCM/EXTERNAL/IOIPSL/tools/tkcond.c
===================================================================
--- trunk/NEMOGCM/EXTERNAL/IOIPSL/tools/tkcond.c	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/IOIPSL/tools/tkcond.c	(revision 2528)
@@ -0,0 +1,546 @@
+/* parser config.in
+ * $Id$
+ *
+ * This software is governed by the CeCILL license
+ * See IOIPSL/IOIPSL_License_CeCILL.txt
+ *
+ * Version 1.0
+ * Eric Youngdale
+ * 10/95
+ *
+ * The general idea here is that we want to parse a config.in file and 
+ * from this, we generate a wish script which gives us effectively the
+ * same functionality that the original config.in script provided.
+ *
+ * This task is split roughly into 3 parts.  The first parse is the parse
+ * of the input file itself.  The second part is where we analyze the 
+ * #ifdef clauses, and attach a linked list of tokens to each of the
+ * menu items.  In this way, each menu item has a complete list of
+ * dependencies that are used to enable/disable the options.
+ * The third part is to take the configuration database we have build,
+ * and build the actual wish script.
+ *
+ * This file contains the code to further process the conditions from
+ * the "ifdef" clauses.
+ *
+ * The conditions are assumed to be one of the following formats
+ *
+ * simple_condition:= "$VARIABLE" == y/n/m
+ * simple_condition:= "$VARIABLE != y/n/m
+ *
+ * simple_condition -a simple_condition
+ *
+ * If the input condition contains '(' or ')' it would screw us up, but for now
+ * this is not a problem.
+ */
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include "tkparse.h"
+
+
+/*
+ * Walk a condition chain and invert it so that the logical result is
+ * inverted.
+ */
+static void invert_condition(struct condition * cnd)
+{
+  /*
+   * This is simple.  Just walk through the list, and invert
+   * all of the operators.
+   */
+  for(;cnd; cnd = cnd->next)
+    {
+      switch(cnd->op)
+	{
+	case op_and:
+	  cnd->op = op_or;
+	  break;
+	case op_or:
+	  /*
+	   * This is not turned into op_and - we need to keep track
+	   * of what operators were used here since we have an optimization
+	   * later on to remove duplicate conditions, and having
+	   * inverted ors in there would make it harder if we did not
+	   * distinguish an inverted or from an and we inserted because
+	   * of nested ifs.
+	   */
+	  cnd->op = op_and1;
+	  break;
+	case op_neq:
+	  cnd->op = op_eq;
+	  break;
+	case op_eq:
+	  cnd->op = op_neq;
+	  break;
+	default:
+	  break;
+	}
+    }
+}
+
+/*
+ * Walk a condition chain, and free the memory associated with it.
+ */
+static void free_condition(struct condition * cnd)
+{
+  struct condition * next;
+  for(;cnd; cnd = next)
+    {
+      next = cnd->next;
+
+      if( cnd->variable.str != NULL )
+	free(cnd->variable.str);
+
+      free(cnd);
+    }
+}
+
+/*
+ * Walk all of the conditions, and look for choice values.  Convert
+ * the tokens into something more digestible.
+ */
+void fix_choice_cond()
+{
+  struct condition * cond;
+  struct condition * cond2;
+  struct kconfig * cfg;
+  char tmpbuf[10];
+
+  for(cfg = config;cfg != NULL; cfg = cfg->next)
+    {
+      if( cfg->cond == NULL )
+	{
+	  continue;
+	}
+
+      for(cond = cfg->cond; cond != NULL; cond = cond->next)
+	{
+	  if( cond->op != op_kvariable )
+	    continue;
+
+	  if( cond->variable.cfg->tok != tok_choice )
+	    continue;
+
+	  /*
+	   * Look ahead for what we are comparing this to.  There should
+	   * be one operator in between.
+	   */
+	  cond2 = cond->next->next;
+	  strcpy(tmpbuf, cond->variable.cfg->label);
+
+	  if( strcmp(cond2->variable.str, "y") == 0 )
+	    {
+	      cond->variable.cfg = cond->variable.cfg->choice_label;
+	      cond2->variable.str = strdup(tmpbuf);
+	    }
+	  else
+	    {
+	      fprintf(stderr,"Ooops\n");
+	      exit(0);
+	    }
+	}
+
+    }
+}
+
+/*
+ * Walk the stack of conditions, and clone all of them with "&&" operators
+ * gluing them together.  The conditions from each level of the stack
+ * are wrapped in parenthesis so as to guarantee that the results
+ * are logically correct.
+ */
+struct condition * get_token_cond(struct condition ** cond, int depth)
+{
+  int i;
+  struct condition * newcond;
+  struct condition * tail;
+  struct condition * new;
+  struct condition * ocond;
+  struct kconfig * cfg;
+
+  newcond = tail = NULL;
+  for(i=0; i<depth; i++, cond++)
+    {
+      /*
+       * First insert the left parenthesis
+       */
+      new = (struct condition *) malloc(sizeof(struct condition));
+      memset(new, 0, sizeof(*new));
+      new->op = op_lparen;
+      if( tail == NULL )
+	{
+	  newcond = tail = new;
+	}
+      else
+	{
+	  tail->next = new;
+	  tail = new;
+	}
+
+      /*
+       * Now duplicate the chain.
+       */
+      ocond = *cond;
+      for(;ocond != NULL; ocond = ocond->next)
+	{
+	  new = (struct condition *) malloc(sizeof(struct condition));
+	  memset(new, 0, sizeof(*new));
+	  new->op = ocond->op;
+	  if( ocond->variable.str != NULL )
+	    {
+	      if( ocond->op == op_variable )
+		{
+		  /*
+		   * Search for structure to insert here.
+		   */
+		  for(cfg = config;cfg != NULL; cfg = cfg->next)
+		    {
+		      if( cfg->tok != tok_bool
+		         && cfg->tok != tok_int
+		         && cfg->tok != tok_hex
+			 && cfg->tok != tok_tristate 
+			 && cfg->tok != tok_choice
+			 && cfg->tok != tok_dep_tristate)
+			{
+			  continue;
+			}
+		      if( strcmp(cfg->optionname, ocond->variable.str) == 0)
+			{
+			  new->variable.cfg = cfg;
+			  new->op = op_kvariable;
+			  break;
+			}
+		    }
+		  if( cfg == NULL )
+		    {
+		      new->variable.str = strdup(ocond->variable.str);
+		    }
+		}
+	      else
+		{
+		  new->variable.str = strdup(ocond->variable.str);
+		}
+	    }
+	  tail->next = new;
+	  tail = new;
+	}
+
+      /*
+       * Next insert the left parenthesis
+       */
+      new = (struct condition *) malloc(sizeof(struct condition));
+      memset(new, 0, sizeof(*new));
+      new->op = op_rparen;
+      tail->next = new;
+      tail = new;
+
+      /*
+       * Insert an and operator, if we have another condition.
+       */
+      if( i < depth - 1 )
+	{
+	  new = (struct condition *) malloc(sizeof(struct condition));
+	  memset(new, 0, sizeof(*new));
+	  new->op = op_and;
+	  tail->next = new;
+	  tail = new;
+	}
+
+    }
+
+  return newcond;
+}
+
+/*
+ * Walk a single chain of conditions and clone it.  These are assumed
+ * to be created/processed by  get_token_cond in a previous pass.
+ */
+struct condition * get_token_cond_frag(struct condition * cond, 
+				       struct condition ** last)
+{
+  struct condition * newcond;
+  struct condition * tail;
+  struct condition * new;
+  struct condition * ocond;
+
+  newcond = tail = NULL;
+
+  /*
+   * Now duplicate the chain.
+   */
+  for(ocond = cond;ocond != NULL; ocond = ocond->next)
+    {
+      new = (struct condition *) malloc(sizeof(struct condition));
+      memset(new, 0, sizeof(*new));
+      new->op = ocond->op;
+      new->variable.cfg = ocond->variable.cfg;
+      if( tail == NULL )
+	{
+	  newcond = tail = new;
+	}
+      else
+	{
+	  tail->next = new;
+	  tail = new;
+	}
+    }
+
+  new = (struct condition *) malloc(sizeof(struct condition));
+  memset(new, 0, sizeof(*new));
+  new->op = op_and;
+  tail->next = new;
+  tail = new;
+  
+  *last = tail;
+  return newcond;
+}
+
+/*
+ * Walk through the if conditionals and maintain a chain.
+ */
+void fix_conditionals(struct kconfig * scfg)
+{
+  int depth = 0;
+  int i;
+  struct kconfig * cfg;
+  struct kconfig * cfg1;
+  struct condition * conditions[25];
+  struct condition * cnd;
+  struct condition * cnd1;
+  struct condition * cnd2;
+  struct condition * cnd3;
+  struct condition * newcond;
+  struct condition * last;
+
+  /*
+   * Start by walking the chain.  Every time we see an ifdef, push
+   * the condition chain on the stack.  When we see an "else", we invert
+   * the condition at the top of the stack, and when we see an "endif"
+   * we free all of the memory for the condition at the top of the stack
+   * and remove the condition from the top of the stack.
+   *
+   * For any other type of token (i.e. a bool), we clone a new condition chain
+   * by anding together all of the conditions that are currently stored on
+   * the stack.  In this way, we have a correct representation of whatever
+   * conditions govern the usage of each option.
+   */
+  memset(conditions, 0, sizeof(conditions));
+  for(cfg=scfg;cfg != NULL; cfg = cfg->next)
+    {
+      switch(cfg->tok)
+	{
+	case tok_if:
+	  /*
+	   * Push this condition on the stack, and nuke the token
+	   * representing the ifdef, since we no longer need it.
+	   */
+	  conditions[depth] = cfg->cond;
+	  depth++;
+	  cfg->tok = tok_nop;
+	  cfg->cond =  NULL;
+	  break;
+	case tok_else:
+	  /*
+	   * For an else, we just invert the condition at the top of
+	   * the stack.  This is done in place with no reallocation
+	   * of memory taking place.
+	   */
+	  invert_condition(conditions[depth-1]);
+	  cfg->tok = tok_nop;
+	  break;
+	case tok_fi:
+	  depth--;
+	  free_condition(conditions[depth]);
+	  conditions[depth] = NULL;
+	  cfg->tok = tok_nop;
+	  break;
+	case tok_comment:
+	case tok_define:
+	case tok_menuoption:
+	case tok_bool:
+	case tok_tristate:
+	case tok_int:
+	case tok_hex:
+	case tok_choice:
+	case tok_make:
+	  /*
+	   * We need to duplicate the chain of conditions and attach them to
+	   * this token.
+	   */
+	  cfg->cond = get_token_cond(&conditions[0], depth);
+	  break;
+	case tok_dep_tristate:
+	  /*
+	   * Same as tok_tristate et al except we have a temporary
+	   * conditional. (Sort of a hybrid tok_if, tok_tristate, tok_fi
+	   * option)
+	   */
+	  conditions[depth] = cfg->cond;
+	  depth++;
+	  cfg->cond = get_token_cond(&conditions[0], depth);
+	  depth--;
+	  free_condition(conditions[depth]);
+	  conditions[depth] = NULL;
+	default:
+	  break;
+	}
+    }
+
+  /*
+   * Fix any conditions involving the "choice" operator.
+   */
+  fix_choice_cond();
+
+  /*
+   * Walk through and see if there are multiple options that control the
+   * same kvariable.  If there are we need to treat them a little bit
+   * special.
+   */
+  for(cfg=scfg;cfg != NULL; cfg = cfg->next)
+    {
+      switch(cfg->tok)
+	{
+	case tok_bool:
+	case tok_tristate:
+	case tok_dep_tristate:
+	case tok_int:
+	case tok_hex:
+	  for(cfg1=cfg;cfg1 != NULL; cfg1 = cfg1->next)
+	    {
+	      switch(cfg1->tok)
+		{
+		case tok_define:
+		case tok_bool:
+		case tok_tristate:
+		case tok_dep_tristate:
+		case tok_int:
+		case tok_hex:
+		  if( strcmp(cfg->optionname, cfg1->optionname) == 0)
+		    {
+		      cfg->flags |= CFG_DUP;
+		      cfg1->flags |= CFG_DUP;
+		    }
+		  break;
+		default:
+		  break;
+		}
+	    }
+	  break;
+	default:
+	  break;
+	}
+    }
+
+  /*
+   * Now go through the list, and every time we see a kvariable, check
+   * to see whether it also has some dependencies.  If so, then
+   * append it to our list.  The reason we do this is that we might have
+   * option CONFIG_FOO which is only used if CONFIG_BAR is set.  It may
+   * turn out that in config.in that the default value for CONFIG_BAR is
+   * set to "y", but that CONFIG_BAR is not enabled because CONFIG_XYZZY
+   * is not set.  The current condition chain does not reflect this, but
+   * we can fix this by searching for the tokens that this option depends
+   * upon and cloning the conditions and merging them with the list.
+   */
+  for(cfg=scfg;cfg != NULL; cfg = cfg->next)
+    {
+      /*
+       * Search for a token that has a condition list.
+       */
+      if(cfg->cond == NULL) continue;
+      for(cnd = cfg->cond; cnd; cnd=cnd->next)
+	{
+	  /*
+	   * Now search the condition list for a known configuration variable
+	   * that has conditions of its own.
+	   */
+	  if(cnd->op != op_kvariable) continue;
+	  if(cnd->variable.cfg->cond == NULL) continue;
+
+	  if(cnd->variable.cfg->flags & CFG_DUP) continue; 
+	  /*
+	   * OK, we have some conditions to append to cfg.  Make  a clone
+	   * of the conditions,
+	   */
+	  newcond = get_token_cond_frag(cnd->variable.cfg->cond, &last);
+
+	  /*
+	   * Finally, we splice it into our list.
+	   */
+	  last->next = cfg->cond;
+	  cfg->cond = newcond;
+
+	}
+    }
+
+  /*
+   * There is a strong possibility that we have duplicate conditions
+   * in here.  It would make the script more efficient and readable to
+   * remove these.  Here is where we assume here that there are no
+   * parenthesis in the input script.
+   */
+  for(cfg=scfg;cfg != NULL; cfg = cfg->next)
+    {
+      /*
+       * Search for configuration options that have conditions.
+       */
+      if(cfg->cond == NULL) continue;
+      for(cnd = cfg->cond; cnd; cnd=cnd->next)
+	{
+	  /*
+	   * Search for a left parenthesis.
+	   */
+	  if(cnd->op != op_lparen) continue;
+	  for(cnd1 = cnd->next; cnd1; cnd1=cnd1->next)
+	    {
+	      /*
+	       * Search after the previous left parenthesis, and try
+	       * and find a second left parenthesis.
+	       */
+	      if(cnd1->op != op_lparen) continue;
+
+	      /*
+	       * Now compare the next 5 tokens to see if they are
+	       * identical.  We are looking for two chains that
+	       * are like: '(' $VARIABLE operator constant ')'.
+	       */
+	      cnd2 = cnd;
+	      cnd3 = cnd1;
+	      for(i=0; i<5; i++, cnd2=cnd2->next, cnd3=cnd3->next)
+		{
+		  if(!cnd2 || !cnd3) break;
+		  if(cnd2->op != cnd3->op) break;
+		  if(i == 1 && (cnd2->op != op_kvariable 
+		     || cnd2->variable.cfg != cnd3->variable.cfg) ) break;
+		  if(i==2 && cnd2->op != op_eq && cnd2->op != op_neq) break;
+		  if(i == 3 && cnd2->op != op_constant &&
+		     strcmp(cnd2->variable.str, cnd3->variable.str) != 0)
+		    break;
+		  if(i==4 && cnd2->op != op_rparen) break;
+		}
+	      /*
+	       * If these match, and there is an and gluing these together,
+	       * then we can nuke the second one.
+	       */
+	      if(i==5 && ((cnd3 && cnd3->op == op_and)
+			  ||(cnd2 && cnd2->op == op_and)))
+		{
+		  /*
+		   * We have a duplicate.  Nuke 5 ops.
+		   */
+		  cnd3 = cnd1;
+		  for(i=0; i<5; i++, cnd3=cnd3->next)
+		    {
+		      cnd3->op = op_nuked;
+		    }
+		  /*
+		   * Nuke the and that glues the conditions together.
+		   */
+		  if(cnd3 && cnd3->op == op_and) cnd3->op = op_nuked;
+		  else if(cnd2 && cnd2->op == op_and) cnd2->op = op_nuked;
+		}
+	    }
+	}
+    }
+}
Index: trunk/NEMOGCM/EXTERNAL/IOIPSL/tools/tkgen.c
===================================================================
--- trunk/NEMOGCM/EXTERNAL/IOIPSL/tools/tkgen.c	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/IOIPSL/tools/tkgen.c	(revision 2528)
@@ -0,0 +1,1136 @@
+/* Generate tk script based upon config.in
+ * $Id$
+ *
+ * This software is governed by the CeCILL license
+ * See IOIPSL/IOIPSL_License_CeCILL.txt
+ *
+ * Version 1.0
+ * Eric Youngdale
+ * 10/95
+ *
+ * 1996 01 04
+ * Avery Pennarun - Aesthetic improvements.
+ *
+ * 1996 01 24
+ * Avery Pennarun - Bugfixes and more aesthetics.
+ *
+ * 1996 03 08
+ * Avery Pennarun - The int and hex config.in commands work right.
+ *                - Choice buttons are more user-friendly.
+ *                - Disabling a text entry line greys it out properly.
+ *                - dep_tristate now works like in Configure. (not pretty)
+ *                - No warnings in gcc -Wall. (Fixed some "interesting" bugs.)
+ *                - Faster/prettier "Help" lookups.
+ *
+ * 1996 03 15
+ * Avery Pennarun - Added new sed script from Axel Boldt to make help even
+ *                  faster. (Actually awk is downright slow on some machines.)
+ *                - Fixed a bug I introduced into Choice dependencies.  Thanks
+ *                  to Robert Krawitz for pointing this out.
+ *
+ * 1996 03 16
+ * Avery Pennarun - basic "do_make" support added to let sound config work.
+ *
+ * 1996 03 25
+ *     Axel Boldt - Help now works on "choice" buttons.
+ *
+ * 1996 04 06
+ * Avery Pennarun - Improved sound config stuff. (I think it actually works
+ *                  now!)
+ *                - Window-resize-limits don't use ugly /usr/lib/tk4.0 hack.
+ *                - int/hex work with tk3 again. (The "cget" error.)
+ *                - Next/Prev buttons switch between menus.  I can't take
+ *                  much credit for this; the code was already there, but
+ *                  ifdef'd out for some reason.  It flickers a lot, but
+ *                  I suspect there's no "easy" fix for that.
+ *                - Labels no longer highlight as you move the mouse over
+ *                  them (although you can still press them... oh well.)
+ *                - Got rid of the last of the literal color settings, to
+ *                  help out people with mono X-Windows systems. 
+ *                  (Apparently there still are some out there!)
+ *                - Tabstops seem sensible now.
+ *
+ * 1996 04 14
+ * Avery Pennarun - Reduced flicker when creating windows, even with "update
+ *                  idletasks" hack.
+ *
+ * TO DO:
+ *   - clean up - there are useless ifdef's everywhere.
+ *   - better comments throughout - C code generating tcl is really cryptic.
+ *   - eliminate silly "update idletasks" hack to improve display speed and
+ *     reduce flicker.  But how?
+ *   - make canvas contents resize with the window (good luck).
+ *   - some way to make submenus inside of submenus (ie. Main->Networking->IP)
+ *           (perhaps a button where the description would be)
+ *   - make the main menu use the same tcl code as the submenus.
+ *   - make choice and int/hex input types line up vertically with
+ *           bool/tristate.
+ *   - general speedups - how?  The canvas seems to slow it down a lot.
+ *   - choice buttons should default to the first menu option, rather than a
+ *           blank.  Also look up the right variable when the help button
+ *           is pressed.
+ *   - clean up +/- 16 confusion for enabling/disabling variables; causes
+ *           (theoretical, at the moment) problems with dependencies.
+ *   
+ */
+#include <stdio.h>
+#include <unistd.h>
+#include "tkparse.h"
+
+#ifndef TRUE
+#define TRUE (1)
+#endif
+
+#ifndef FALSE
+#define FALSE (0)
+#endif
+
+/*
+ * This is the total number of submenus that we have.
+ */
+static int tot_menu_num =0;
+
+/*
+ * Generate portion of wish script for the beginning of a submenu.
+ * The guts get filled in with the various options.
+ */
+static void start_proc(char * label, int menu_num, int flag)
+{
+  if( flag )
+    printf("menu_option menu%d %d \"%s\"\n", menu_num, menu_num, label);
+  printf("proc menu%d {w title} {\n", menu_num);
+  printf("\tcatch {destroy $w}\n");
+  printf("\ttoplevel $w -class Dialog\n");
+  printf("\twm withdraw $w\n");
+  printf("\tmessage $w.m -width 400 -aspect 300 -text \\\n");
+  printf("\t\t\"%s\"  -relief raised\n",label);
+  printf("\tpack $w.m -pady 10 -side top -padx 10\n");
+  printf("\twm title $w \"%s\" \n\n", label);
+  
+  /*
+   * Attach the "Prev", "Next" and "OK" buttons at the end of the window.
+   */
+  printf("\tset oldFocus [focus]\n");
+  printf("\tframe $w.f\n");
+  printf("\tbutton $w.f.back -text \"Main Menu\" \\\n"
+         "\t\t-width 15 -command \"destroy $w; focus $oldFocus; update_mainmenu $w\"\n");
+  printf("\tbutton $w.f.next -text \"Next\" \\\n"
+         "\t\t-width 15 -command \" destroy $w; focus $oldFocus;  menu%d .menu%d \\\"$title\\\"\"\n",
+         	menu_num+1, menu_num+1);
+  if (menu_num == tot_menu_num)
+  	printf("\t$w.f.next configure -state disabled\n");
+  printf("\tbutton $w.f.prev -text \"Prev\" \\\n"
+         "\t\t-width 15 -command \" destroy $w; focus $oldFocus; menu%d .menu%d \\\"$title\\\"\"\n",
+       		menu_num-1, menu_num-1);
+  if (1 == menu_num)
+  	printf("\t$w.f.prev configure -state disabled\n");
+  printf("\tpack $w.f.back $w.f.next $w.f.prev -side left -expand on\n");
+  printf("\tpack $w.f -pady 10 -side bottom -anchor w -fill x\n");
+
+  /*
+   * Lines between canvas and other areas of the window.
+   */
+  printf("\tframe $w.topline -relief ridge -borderwidth 2 -height 2\n");
+  printf("\tpack $w.topline -side top -fill x\n\n");
+  printf("\tframe $w.botline -relief ridge -borderwidth 2 -height 2\n");
+  printf("\tpack $w.botline -side bottom -fill x\n\n");
+  
+  /*
+   * The "config" frame contains the canvas and a scrollbar.
+   */
+  printf("\tframe $w.config\n");
+  printf("\tpack $w.config -fill y -expand on\n\n");
+  printf("\tscrollbar $w.config.vscroll -command \"$w.config.canvas yview\"\n");
+  printf("\tpack $w.config.vscroll -side right -fill y\n\n");
+  
+  /*
+   * The scrollable canvas itself, where the real work (and mess) gets done.
+   */
+  printf("\tcanvas $w.config.canvas -height 1\\\n"
+  	 "\t\t-relief flat -borderwidth 0 -yscrollcommand \"$w.config.vscroll set\" \\\n"
+  	 "\t\t-width [expr [winfo screenwidth .] * 1 / 2] \n");
+  printf("\tframe $w.config.f\n");
+  printf("\tpack $w.config.canvas -side right -fill y\n");
+  
+  printf("\n\n");
+}
+
+/*
+ * Each proc we create needs a global declaration for any global variables we
+ * use.  To minimize the size of the file, we set a flag each time we output
+ * a global declaration so we know whether we need to insert one for a
+ * given function or not.
+ */
+void clear_globalflags(struct kconfig * cfg)
+{
+  for(; cfg != NULL; cfg = cfg->next)
+  {
+    cfg->flags &= ~GLOBAL_WRITTEN;
+  }
+}
+
+/*
+ * Output a "global" line for a given variable.  Also include the
+ * call to "vfix".  (If vfix is not needed, then it's fine to just printf
+ * a "global" line).
+ */
+void global(char *var)
+{
+  printf("\tglobal %s; vfix %s\n", var, var);
+}
+
+/*
+ * This function walks the chain of conditions that we got from cond.c,
+ * and creates a wish conditional to enable/disable a given widget.
+ */
+void generate_if(struct kconfig * item,
+	    struct condition * cond,
+	    int menu_num,
+	    int line_num)
+{
+  struct condition * ocond;
+
+  ocond = cond;
+
+  /*
+   * First write any global declarations we need for this conditional.
+   */
+  while(cond != NULL )
+    {
+      switch(cond->op){
+      case op_variable:
+      	global(cond->variable.str);
+	break;
+      case op_kvariable:
+	if(cond->variable.cfg->flags & GLOBAL_WRITTEN) break;
+	cond->variable.cfg->flags |= GLOBAL_WRITTEN;
+	global(cond->variable.cfg->optionname);
+	break;
+      default:
+	break;
+      }
+      cond = cond->next;
+    }
+  
+  /*
+   * Now write this option.
+   */
+  if(   (item->flags & GLOBAL_WRITTEN) == 0
+     && (item->optionname != NULL) )
+    {
+      global(item->optionname);
+      item->flags |= GLOBAL_WRITTEN;
+    }
+  /*
+   * Now generate the body of the conditional.
+   */
+  printf("\tif {");
+  cond = ocond;
+  while(cond != NULL )
+    {
+      switch(cond->op){
+      case op_bang:
+	printf(" ! ");
+	break;
+      case op_eq:
+	printf(" == ");
+	break;
+      case op_neq:
+	printf(" != ");
+	break;
+      case op_and:
+      case op_and1:
+	printf(" && ");
+	break;
+      case op_or:
+	printf(" || ");
+	break;
+      case op_lparen:
+	printf("(");
+	break;
+      case op_rparen:
+	printf(")");
+	break;
+      case op_variable:
+	printf("$%s", cond->variable.str);
+	break;
+      case op_kvariable:
+	printf("$%s", cond->variable.cfg->optionname);
+	break;
+      case op_shellcmd:
+	printf("[exec %s]", cond->variable.str);
+	break;
+      case op_constant:
+	if( strcmp(cond->variable.str, "y") == 0 )
+	  printf("1");
+	else if( strcmp(cond->variable.str, "n") == 0 )
+	  printf("0");
+	else if( strcmp(cond->variable.str, "m") == 0 )
+	  printf("2");
+	else
+	  printf("\"%s\"", cond->variable.str);
+	break;
+      default:
+        break;
+      }
+      cond = cond->next;
+    }
+
+  /*
+   * Now we generate what we do depending upon the value of the conditional.
+   * Depending upon what the token type is, there are different things
+   * we must do to enable/disable the given widget - this code needs to
+   * be closely coordinated with the widget creation procedures in header.tk.
+   */
+  switch(item->tok)
+    {
+    case tok_define:
+      printf("} then { set %s %s } \n",  item->optionname, item->value);
+      break;
+    case tok_menuoption:
+      printf("} then { .f0.x%d configure -state normal } else { .f0.x%d configure -state disabled }\n",
+	     menu_num, menu_num);
+      break;
+    case tok_int:
+    case tok_hex:
+      printf("} then { ");
+      printf(".menu%d.config.f.x%d.x configure -state normal -fore [ cget .ref -foreground ]; ", menu_num, line_num);
+      printf(".menu%d.config.f.x%d.l configure -state normal; ", menu_num, line_num);
+      printf("} else { ");
+      printf(".menu%d.config.f.x%d.x configure -state disabled -fore [ cget .ref -disabledforeground ];", menu_num, line_num );
+      printf(".menu%d.config.f.x%d.l configure -state disabled;", menu_num, line_num );
+      printf("}\n");
+      break;
+    case tok_bool:
+#ifdef BOOL_IS_BUTTON
+      /*
+       * If a bool is just a button, then use this definition.
+       */
+      printf("} then { .menu%d.config.f.x%d configure -state normal } else { .menu%d.config.f.x%d configure -state disabled }\n",
+	     menu_num, line_num,
+	     menu_num, line_num );
+#else
+      /*
+       * If a bool is a radiobutton, then use this instead.
+       */
+      printf("} then { ");
+      printf(".menu%d.config.f.x%d.y configure -state normal;",menu_num, line_num);
+      printf(".menu%d.config.f.x%d.n configure -state normal;",menu_num, line_num);
+      printf(".menu%d.config.f.x%d.l configure -state normal;",menu_num, line_num);
+      printf("set %s [expr $%s&15];", item->optionname, item->optionname);
+      printf("} else { ");
+      printf(".menu%d.config.f.x%d.y configure -state disabled;",menu_num, line_num);
+      printf(".menu%d.config.f.x%d.n configure -state disabled;",menu_num, line_num);
+      printf(".menu%d.config.f.x%d.l configure -state disabled;",menu_num, line_num);
+      printf("set %s [expr $%s|16];", item->optionname, item->optionname);
+      printf("}\n");
+#endif
+      break;
+    case tok_tristate:
+    case tok_dep_tristate:
+      printf("} then { ");
+      if( item->tok == tok_dep_tristate )
+	{
+	  global(item->depend.str);
+	  printf("if { $%s != 1 && $%s != 0 } then {", 
+	  	item->depend.str,item->depend.str);
+	  printf(".menu%d.config.f.x%d.y configure -state disabled;",menu_num, line_num);
+	  printf("} else {");
+	  printf(".menu%d.config.f.x%d.y configure -state normal;",menu_num, line_num);
+	  printf("}; ");
+	}
+      else
+	{
+	  printf(".menu%d.config.f.x%d.y configure -state normal;",menu_num, line_num);
+	}
+      
+      printf(".menu%d.config.f.x%d.n configure -state normal;",menu_num, line_num);
+      printf(".menu%d.config.f.x%d.m configure -state normal;",menu_num, line_num);
+      printf(".menu%d.config.f.x%d.l configure -state normal;",menu_num, line_num);
+      /*
+       * Or in a bit to the variable - this causes all of the radiobuttons
+       * to be deselected (i.e. not be red).
+       */
+      printf("set %s [expr $%s&15];", item->optionname, item->optionname);
+      printf("} else { ");
+      printf(".menu%d.config.f.x%d.y configure -state disabled;",menu_num, line_num);
+      printf(".menu%d.config.f.x%d.n configure -state disabled;",menu_num, line_num);
+      printf(".menu%d.config.f.x%d.m configure -state disabled;",menu_num, line_num);
+      printf(".menu%d.config.f.x%d.l configure -state disabled;",menu_num, line_num);
+      /*
+       * Clear the disable bit - this causes the correct radiobutton
+       * to appear selected (i.e. turn red).
+       */
+      printf("set %s [expr $%s|16];", item->optionname, item->optionname);
+      printf("}\n");
+      break;
+    case tok_choose:
+    case tok_choice:
+      fprintf(stderr,"Fixme\n");
+      exit(0);
+    default:
+      break;
+    }
+}
+
+/*
+ * Similar to generate_if, except we come here when generating an
+ * output file.  Thus instead of enabling/disabling a widget, we
+ * need to decide whether to write out a given configuration variable
+ * to the output file.
+ */
+void generate_if_for_outfile(struct kconfig * item,
+	    struct condition * cond)
+{
+  struct condition * ocond;
+
+  /*
+   * First write any global declarations we need for this conditional.
+   */
+  ocond = cond;
+  for(; cond != NULL; cond = cond->next )
+    {
+      switch(cond->op){
+      case op_variable:
+        global(cond->variable.str);
+	break;
+      case op_kvariable:
+	if(cond->variable.cfg->flags & GLOBAL_WRITTEN) break;
+	cond->variable.cfg->flags |= GLOBAL_WRITTEN;
+	global(cond->variable.cfg->optionname);
+	break;
+      default:
+	break;
+      }
+    }
+
+  /*
+   * Now generate the body of the conditional.
+   */
+  printf("\tif {");
+  cond = ocond;
+  while(cond != NULL )
+    {
+      switch(cond->op){
+      case op_bang:
+	printf(" ! ");
+	break;
+      case op_eq:
+	printf(" == ");
+	break;
+      case op_neq:
+	printf(" != ");
+	break;
+      case op_and:
+      case op_and1:
+	printf(" && ");
+	break;
+      case op_or:
+	printf(" || ");
+	break;
+      case op_lparen:
+	printf("(");
+	break;
+      case op_rparen:
+	printf(")");
+	break;
+      case op_variable:
+	printf("$%s", cond->variable.str);
+	break;
+      case op_shellcmd:
+	printf("[exec %s]", cond->variable.str);
+	break;
+      case op_kvariable:
+	printf("$%s", cond->variable.cfg->optionname);
+	break;
+      case op_constant:
+	if( strcmp(cond->variable.str, "y") == 0 )
+	  printf("1");
+	else if( strcmp(cond->variable.str, "n") == 0 )
+	  printf("0");
+	else if( strcmp(cond->variable.str, "m") == 0 )
+	  printf("2");
+	else
+	  printf("\"%s\"", cond->variable.str);
+	break;
+      default:
+        break;
+      }
+      cond = cond->next;
+    }
+
+  /*
+   * Now we generate what we do depending upon the value of the
+   * conditional.  Depending upon what the token type is, there are
+   * different things we must do write the value the given widget -
+   * this code needs to be closely coordinated with the widget
+   * creation procedures in header.tk.  
+   */
+  switch(item->tok)
+    {
+    case tok_define:
+      printf("} then {write_tristate $cfg $autocfg %s %s $notmod }\n", item->optionname, item->value);
+      break;
+    case tok_comment:
+      printf("} then {write_comment $cfg $autocfg \"%s\"}\n", item->label);
+      break;
+    case tok_dep_tristate:
+      printf("} then { write_tristate $cfg $autocfg %s $%s $%s } \n", 
+	     item->optionname, item->optionname, item->depend.str);
+      break;
+    case tok_tristate:
+    case tok_bool:
+      printf("} then { write_tristate $cfg $autocfg %s $%s $notmod }\n", 
+	     item->optionname, item->optionname);
+      break;
+    case tok_int:
+      printf("} then { write_int $cfg $autocfg %s $%s $notmod }\n",
+             item->optionname, item->optionname);
+      break;
+    case tok_hex:
+      printf("} then { write_hex $cfg $autocfg %s $%s $notmod }\n",
+             item->optionname, item->optionname);
+      break;
+    case tok_make:
+      printf("} then { do_make {%s} }\n",item->value);
+      break;
+    case tok_choose:
+    case tok_choice:
+      fprintf(stderr,"Fixme\n");
+      exit(0);
+    default:
+      break;
+    }
+}
+
+/*
+ * Generates a fragment of wish script that closes out a submenu procedure.
+ */
+static void end_proc(int menu_num)
+{
+  struct kconfig * cfg;
+
+  printf("\n\n\n");
+  printf("\tfocus $w\n");
+  printf("\tupdate_menu%d $w.config.f\n", menu_num);
+  printf("\tglobal winx; global winy\n");
+  printf("\tset winx [expr [winfo x .]+30]; set winy [expr [winfo y .]+30]\n");
+  printf("\twm geometry $w +$winx+$winy\n");
+  
+  /*
+   * Now that the whole window is in place, we need to wait for an "update"
+   * so we can tell the canvas what its virtual size should be.
+   *
+   * Unfortunately, this causes some ugly screen-flashing because the whole
+   * window is drawn, and then it is immediately resized.  It seems
+   * unavoidable, though, since "frame" objects won't tell us their size
+   * until after an update, and "canvas" objects can't automatically pack
+   * around frames.  Sigh.
+   */
+  printf("\tupdate idletasks\n");
+  printf("\t$w.config.canvas create window 0 0 -anchor nw -window $w.config.f\n\n");
+  printf("\t$w.config.canvas configure \\\n"
+  	 "\t\t-width [expr [winfo reqwidth $w.config.f] + 1]\\\n"
+  	 "\t\t-scrollregion \"-1 -1 [expr [winfo reqwidth $w.config.f] + 1] \\\n"
+  	 "\t\t\t [expr [winfo reqheight $w.config.f] + 1]\"\n\n");
+  	 
+  /*
+   * If the whole canvas will fit in 3/4 of the screen height, do it;
+   * otherwise, resize to around 1/2 the screen and let us scroll.
+   */
+  printf("\tset winy [expr [winfo reqh $w] - [winfo reqh $w.config.canvas]]\n");
+  printf("\tset scry [expr [winfo screenh $w] / 2]\n");
+  printf("\tset maxy [expr [winfo screenh $w] * 3 / 4]\n");
+  printf("\tset canvtotal [expr [winfo reqh $w.config.f] + 2]\n");
+  printf("\tif [expr $winy + $canvtotal < $maxy] {\n"
+  	 "\t\t$w.config.canvas configure -height $canvtotal\n"
+  	 "\t} else {\n"
+  	 "\t\t$w.config.canvas configure -height [expr $scry - $winy]\n"
+  	 "\t}\n");
+  
+  /*
+   * Limit the min/max window size.  Height can vary, but not width,
+   * because of the limitations of canvas and our laziness.
+   */
+  printf("\tupdate idletasks\n");
+  printf("\twm maxsize $w [winfo width $w] [winfo screenheight $w]\n");
+  printf("\twm minsize $w [winfo width $w] 100\n\n");
+  printf("\twm deiconify $w\n");
+    
+  printf("}\n\n\n");
+
+  /*
+   * Now we generate the companion procedure for the menu we just
+   * generated.  This procedure contains all of the code to
+   * disable/enable widgets based upon the settings of the other
+   * widgets, and will be called first when the window is mapped,
+   * and each time one of the buttons in the window are clicked.
+   */
+  printf("proc update_menu%d {w}  {\n", menu_num);
+
+  printf("\tupdate_define\n");
+  clear_globalflags(config);
+  for(cfg = config;cfg != NULL; cfg = cfg->next)
+    {
+      /*
+       * Skip items not for this menu, or ones having no conditions.
+       */
+      if (cfg->menu_number != menu_num ) continue;
+      if (cfg->tok != tok_define) continue;
+      /*
+       * Clear all of the booleans that are defined in this menu.
+       */
+      if(   (cfg->flags & GLOBAL_WRITTEN) == 0
+	 && (cfg->optionname != NULL) )
+	{
+	  printf("\tglobal %s\n", cfg->optionname);
+	  cfg->flags |= GLOBAL_WRITTEN;
+	  printf("\tset %s 0\n", cfg->optionname);
+	}
+
+    }
+  for(cfg = config;cfg != NULL; cfg = cfg->next)
+    {
+      /*
+       * Skip items not for this menu, or ones having no conditions.
+       */
+      if (cfg->menu_number != menu_num ) continue;
+      if (cfg->tok == tok_menuoption) continue;
+      if (cfg->cond != NULL ) 
+	generate_if(cfg, cfg->cond, menu_num, cfg->menu_line);
+      else
+	{
+	  /*
+	   * If this token has no conditionals, check to see whether
+	   * it is a tristate - if so, then generate the conditional
+	   * to enable/disable the "y" button based upon the setting
+	   * of the option it depends upon.
+	   */
+	  if(cfg->tok == tok_dep_tristate)
+	    {
+	      global(cfg->depend.str);
+	      printf("\tif {$%s != 1 && $%s != 0 } then { .menu%d.config.f.x%d.y configure -state disabled } else { .menu%d.config.f.x%d.y configure -state normal}\n",
+		     cfg->depend.str,cfg->depend.str,
+		     menu_num, cfg->menu_line,
+		     menu_num, cfg->menu_line);
+	    }
+	}
+
+    }
+
+
+  printf("}\n\n\n");
+}
+
+/*
+ * This function goes through and counts up the number of items in
+ * each submenu. If there are too many options, we need to split it
+ * into submenus.  This function just calculates how many submenus,
+ * and how many items go in each submenu.
+ */
+static void find_menu_size(struct kconfig *cfg,
+			  int *menu_max, 
+			  int *menu_maxlines)
+
+{
+  struct kconfig * pnt;
+  int tot;
+  
+  /*
+   * First count up the number of options in this menu.
+   */
+  tot = 0;
+  for(pnt = cfg->next; pnt; pnt = pnt->next)
+  {
+    if( pnt->tok == tok_menuoption) break;
+    switch (pnt->tok)
+      {
+      case tok_bool:
+      case tok_tristate:
+      case tok_dep_tristate:
+      case tok_int:
+      case tok_hex:
+      case tok_choose:
+	tot++;
+	break;
+      case tok_choice:
+      default:
+	break;
+      }
+  }
+
+  *menu_max = cfg->menu_number;
+  *menu_maxlines = tot;
+}
+
+/*
+ * This is the top level function for generating the tk script.
+ */
+void dump_tk_script(struct kconfig *scfg)
+{
+  int menu_num =0;
+  int menu_max =0;
+  int menu_min =0;
+  int menu_line = 0;
+  int menu_maxlines = 0;
+  struct kconfig * cfg;
+  struct kconfig * cfg1 = NULL;
+  char * menulabel;
+
+  /*
+   * Start by assigning menu numbers, and submenu numbers.
+   */
+  for(cfg = scfg;cfg != NULL; cfg = cfg->next)
+    {
+      switch (cfg->tok)
+	{
+	case tok_menuname:
+	  break;
+	case tok_menuoption:
+	  /*
+	   * At the start of a new menu, calculate the number of items
+	   * we will put into each submenu so we know when to bump the
+	   * menu number. The submenus are really no different from a
+	   * normal menu, but the top level buttons only access the first
+	   * of the chain of menus, and the prev/next buttons are used
+	   * access the submenus.
+	   */
+	  cfg->menu_number = ++menu_num;
+	  find_menu_size(cfg, &menu_max, &menu_maxlines);
+	  cfg->submenu_start = menu_num;
+	  cfg->submenu_end = menu_max;
+	  menu_line = 0;
+	  break;
+	case tok_bool:
+	case tok_tristate:
+	case tok_dep_tristate:
+	case tok_int:
+	case tok_hex:
+	case tok_choose:
+	  /*
+	   * If we have overfilled the menu, then go to the next one.
+	   */
+	  if( menu_line == menu_maxlines )
+	    {
+	      menu_line = 0;
+	      menu_num++;
+	    }
+	  cfg->menu_number = menu_num;
+	  cfg->submenu_start = menu_min;
+	  cfg->submenu_end = menu_max;
+	  cfg->menu_line = menu_line++;
+	  break;
+	case tok_define:
+	  cfg->menu_number = -1;
+	case tok_choice:
+	default:
+	  break;
+	};
+    }
+
+  /*
+   * Record this so we can set up the prev/next buttons correctly.
+   */
+  tot_menu_num = menu_num;
+
+  /*
+   * Now start generating the actual wish script that we will use.
+   * We need to keep track of the menu numbers of the min/max menu
+   * for a range of submenus so that we can correctly limit the
+   * prev and next buttons so that they don't go over into some other
+   * category.
+   */
+  for(cfg = scfg; cfg != NULL; cfg = cfg->next)
+    {
+      switch (cfg->tok)
+	{
+	case tok_menuname:
+	  printf("mainmenu_name \"%s\"\n", cfg->label);
+	  break;
+	case tok_menuoption:
+	  /*
+	   * We are at the start of a new menu. If we had one that
+	   * we were working on before, close it out, and then generate
+	   * the script to start the new one.
+	   */
+	  if( cfg->menu_number > 1 )
+	    {
+	      end_proc(menu_num);
+	    }
+	  menulabel = cfg->label;
+	  start_proc(cfg->label, cfg->menu_number, TRUE);
+	  menu_num = cfg->menu_number;
+	  menu_max = cfg->submenu_end;
+	  menu_min = cfg->submenu_start;
+	  break;
+	case tok_bool:
+	  /*
+	   * If we reached the point where we need to switch over
+	   * to the next submenu, then bump the menu number and generate
+	   * the code to close out the old menu and start the new one.
+	   */
+	  if( cfg->menu_number != menu_num )
+	    {
+	      end_proc(menu_num);
+	      start_proc(menulabel, cfg->menu_number, FALSE);
+	      menu_num = cfg->menu_number;
+	    }
+	  printf("\tbool $w.config.f %d %d \"%s\" %s\n",
+		 cfg->menu_number,
+		 cfg->menu_line,
+		 cfg->label,
+		 cfg->optionname);
+	  break;
+
+	case tok_choice:
+	  printf("\t$w.config.f.x%d.x.menu add radiobutton -label \"%s\" -variable %s -value \"%s\" -command \"update_menu%d .menu%d.config.f\"\n",
+		 cfg1->menu_line,
+		 cfg->label,
+		 cfg1->optionname,
+		 cfg->label,
+		 cfg1->menu_number, cfg1->menu_number);
+	  break;
+	case tok_choose:
+	  if( cfg->menu_number != menu_num )
+	    {
+	      end_proc(menu_num);
+	      start_proc(menulabel, cfg->menu_number, FALSE);
+	      menu_num = cfg->menu_number;
+	    }
+	  printf("\tglobal %s\n",cfg->optionname);
+	  printf("\tminimenu $w.config.f %d %d \"%s\" %s %s\n",
+	  	cfg->menu_number,
+	  	cfg->menu_line,
+	  	cfg->label,
+	  	cfg->optionname,
+	  	/*
+	  	 * We rely on the fact that the first tok_choice corresponding
+	  	 * to the current tok_choose is cfg->next (compare parse() in
+	  	 * tkparse.c).  We need its name to pick out the right help
+	  	 * text from Configure.help.
+	  	 */
+	  	cfg->next->optionname);
+	  printf("\tmenu $w.config.f.x%d.x.menu\n", cfg->menu_line);
+	  cfg1 = cfg;
+	  break;
+	case tok_tristate:
+	  if( cfg->menu_number != menu_num )
+	    {
+	      end_proc(menu_num);
+	      start_proc(menulabel, cfg->menu_number, FALSE);
+	      menu_num = cfg->menu_number;
+	    }
+	  printf("\ttristate $w.config.f %d %d \"%s\" %s\n",
+		 cfg->menu_number,
+		 cfg->menu_line,
+		 cfg->label,
+		 cfg->optionname);
+	  break;
+	case tok_dep_tristate:
+	  if( cfg->menu_number != menu_num )
+	    {
+	      end_proc(menu_num);
+	      start_proc(menulabel, cfg->menu_number, FALSE);
+	      menu_num = cfg->menu_number;
+	    }
+	  printf("\tdep_tristate $w.config.f %d %d \"%s\" %s %s\n",
+		 cfg->menu_number,
+		 cfg->menu_line,
+		 cfg->label,
+		 cfg->optionname,
+		 cfg->depend.str);
+	  break;
+	case tok_int:
+	  if( cfg->menu_number != menu_num )
+	    {
+	      end_proc(menu_num);
+	      start_proc(menulabel, cfg->menu_number, FALSE);
+	      menu_num = cfg->menu_number;
+	    }
+	  printf("\tint $w.config.f %d %d \"%s\" %s\n",
+		 cfg->menu_number,
+		 cfg->menu_line,
+		 cfg->label,
+		 cfg->optionname);
+	  break;
+	case tok_hex:
+	  if( cfg->menu_number != menu_num )
+	    {
+	      end_proc(menu_num);
+	      start_proc(menulabel, cfg->menu_number, FALSE);
+	      menu_num = cfg->menu_number;
+	    }
+	  printf("\thex $w.config.f %d %d \"%s\" %s\n",
+		 cfg->menu_number,
+		 cfg->menu_line,
+		 cfg->label,
+		 cfg->optionname);
+	  break;
+	default:
+	  break;
+	}
+
+    }
+
+  /*
+   * Generate the code to close out the last menu.
+   */
+  end_proc(menu_num);
+
+#ifdef ERIC_DONT_DEF
+  /*
+   * Generate the code for configuring the sound driver.  Right now this
+   * cannot be done from the X script, but we insert the menu anyways.
+   */
+  start_proc("Configure sound driver", ++menu_num, TRUE);
+#if 0
+  printf("\tdo_make -C drivers/sound config\n");
+  printf("\techo check_sound_config %d\n",menu_num);
+#endif
+  printf("\tlabel $w.config.f.m0 -bitmap error\n");
+  printf("\tmessage $w.config.f.m1 -width 400 -aspect 300 -text \"The sound drivers cannot as of yet be configured via the X-based interface\" -relief raised\n");
+  printf("\tpack $w.config.f.m0 $w.config.f.m1 -side top -pady 10 -expand on\n");
+  /*
+   * Close out the last menu.
+   */
+  end_proc(menu_num);
+#endif
+
+  /*
+   * The top level menu also needs an update function.  When we exit a
+   * submenu, we may need to disable one or more of the submenus on
+   * the top level menu, and this procedure will ensure that things are
+   * correct.
+   */
+  printf("proc update_mainmenu {w}  {\n");
+  for(cfg = scfg; cfg != NULL; cfg = cfg->next)
+    {
+      switch (cfg->tok)
+	{
+	case tok_menuoption:
+	  if (cfg->cond != NULL ) 
+	    generate_if(cfg, cfg->cond, cfg->menu_number, cfg->menu_line);
+	  break;
+	default:
+	  break;
+	}
+    }
+
+  printf("}\n\n\n");
+
+#if 0
+  /*
+   * Generate some code to set the variables that are "defined".
+   */
+  for(cfg = config;cfg != NULL; cfg = cfg->next)
+    {
+      /*
+       * Skip items not for this menu, or ones having no conditions.
+       */
+      if( cfg->tok != tok_define) continue;
+      if (cfg->cond != NULL ) 
+	generate_if(cfg, cfg->cond, menu_num, cfg->menu_line);
+      else
+	{
+	  printf("\twrite_define %s %s\n", cfg->optionname, cfg->value);
+	}
+
+    }
+#endif
+
+  /*
+   * Now generate code to load the default settings into the variables.
+   * Note that the script in tail.tk will attempt to load .config,
+   * which may override these settings, but that's OK.
+   */
+  for(cfg = scfg; cfg != NULL; cfg = cfg->next)
+    {
+      switch (cfg->tok)
+	{
+	case tok_bool:
+	case tok_tristate:
+	case tok_dep_tristate:
+	case tok_choice:
+	  printf("set %s 0\n", cfg->optionname);
+	  break;
+	case tok_int:
+	case tok_hex:
+	  printf("set %s %s\n", cfg->optionname, cfg->value);
+	  break;
+	case tok_choose:
+	  printf("set %s \"(not set)\"\n",cfg->optionname);
+	default:
+	  break;
+	}
+    }
+
+  /*
+   * Next generate a function that can be called from the main menu that will
+   * write all of the variables out.  This also serves double duty - we can
+   * save configuration to a file using this.
+   */
+  printf("proc writeconfig {file1 file2} {\n");
+  printf("\tset cfg [open $file1 w]\n");
+  printf("\tset autocfg [open $file2 w]\n");
+  printf("\tset notmod 1\n");
+  printf("\tset notset 0\n");
+  clear_globalflags(config);
+  printf("\tputs $cfg \"#\"\n");
+  printf("\tputs $cfg \"# Automatically generated make config: don't edit\"\n");
+  printf("\tputs $cfg \"#\"\n");
+
+  printf("\tputs $autocfg \"/*\"\n");
+  printf("\tputs $autocfg \" * Automatically generated C config: don't edit\"\n");
+  printf("\tputs $autocfg \" */\"\n");
+  for(cfg = scfg; cfg != NULL; cfg = cfg->next)
+    {
+      switch (cfg->tok)
+	{
+	case tok_int:
+	case tok_hex:
+	case tok_bool:
+	case tok_tristate:
+	case tok_dep_tristate:
+	case tok_define:
+	case tok_choose:
+	  if(!(cfg->flags & GLOBAL_WRITTEN))
+	    {
+	      cfg->flags |= GLOBAL_WRITTEN;
+	      printf("\tglobal %s\n", cfg->optionname);
+	    }
+	  /* fall through */
+	case tok_make:
+	case tok_comment:
+	  if (cfg->cond != NULL ) 
+	    generate_if_for_outfile(cfg, cfg->cond);
+	  else
+	    {
+	      if(cfg->tok == tok_dep_tristate)
+		{
+		  printf("\tif {$%s == 0 } then {\n"
+		  	 "\t\twrite_tristate $cfg $autocfg %s $notset $notmod\n"
+		  	 "\t} else {\n"
+		  	 "\t\twrite_tristate $cfg $autocfg %s $%s $%s\n"
+		  	 "\t}\n",
+		  	 cfg->depend.str,
+			 cfg->optionname,
+			 cfg->optionname,
+			 cfg->optionname,
+			 cfg->depend.str);
+		}
+	      else if(cfg->tok == tok_comment)
+		{
+		  printf("\twrite_comment $cfg $autocfg \"%s\"\n", cfg->label);
+		}
+#if 0
+	      else if(cfg->tok == tok_define)
+		{
+		  printf("\twrite_define %s %s\n", cfg->optionname,
+			 cfg->value);
+		}
+#endif
+	      else if (cfg->tok == tok_choose )
+		{
+		  for(cfg1 = cfg->next; 
+		      cfg1 != NULL && cfg1->tok == tok_choice;
+		      cfg1 = cfg1->next)
+		    {
+		      printf("\tif { $%s == \"%s\" } then { write_tristate $cfg $autocfg %s 1 $notmod }\n",
+			     cfg->optionname,
+			     cfg1->label,
+			     cfg1->optionname);
+		    }
+		}
+	      else if (cfg->tok == tok_int )
+	        {
+		  printf("\twrite_int $cfg $autocfg %s $%s $notmod\n",
+			 cfg->optionname,
+			 cfg->optionname);
+	        }
+	      else if (cfg->tok == tok_hex )
+	        {
+		  printf("\twrite_hex $cfg $autocfg %s $%s $notmod\n",
+			 cfg->optionname,
+			 cfg->optionname);
+	        }
+	      else if (cfg->tok == tok_make )
+	        {
+	          printf("\tdo_make {%s}\n",cfg->value);
+	        }
+	      else
+		{
+		  printf("\twrite_tristate $cfg $autocfg %s $%s $notmod\n",
+			 cfg->optionname,
+			 cfg->optionname);
+		}
+	    }
+	  break;
+	default:
+	  break;
+	}
+    }
+  printf("\tclose $cfg\n");
+  printf("\tclose $autocfg\n");
+  printf("}\n\n\n");
+
+  /*
+   * Finally write a simple function that updates the master choice
+   * variable depending upon what values were loaded from a .config
+   * file.  
+   */
+  printf("proc clear_choices { } {\n");
+  for(cfg = scfg; cfg != NULL; cfg = cfg->next)
+    {
+      if( cfg->tok != tok_choose ) continue;
+      for(cfg1 = cfg->next; 
+	  cfg1 != NULL && cfg1->tok == tok_choice;
+	  cfg1 = cfg1->next)
+	{
+	  printf("\tglobal %s; set %s 0\n",cfg1->optionname,cfg1->optionname);
+	}
+    }
+  printf("}\n\n\n");
+
+  printf("proc update_choices { } {\n");
+  for(cfg = scfg; cfg != NULL; cfg = cfg->next)
+    {
+      if( cfg->tok != tok_choose ) continue;
+      printf("\tglobal %s\n", cfg->optionname);
+      for(cfg1 = cfg->next; 
+	  cfg1 != NULL && cfg1->tok == tok_choice;
+	  cfg1 = cfg1->next)
+	{
+	  printf("\tglobal %s\n", cfg1->optionname);
+	  printf("\tif { $%s == 1 } then { set %s \"%s\" }\n",
+		 cfg1->optionname,
+		 cfg->optionname,
+		 cfg1->label);
+	}
+    }
+  printf("}\n\n\n");
+
+  printf("proc update_define { } {\n");
+  clear_globalflags(config);
+  for(cfg = scfg; cfg != NULL; cfg = cfg->next)
+    {
+      if( cfg->tok != tok_define ) continue;
+      printf("\tglobal %s; set %s 0\n",  cfg->optionname,  cfg->optionname);
+      cfg->flags |= GLOBAL_WRITTEN;
+    }
+  for(cfg = scfg; cfg != NULL; cfg = cfg->next)
+    {
+      if( cfg->tok != tok_define ) continue;
+      if (cfg->cond != NULL ) 
+	generate_if(cfg, cfg->cond, -1, 0);
+      else
+	{
+	  printf("\tset %s %s\n",
+		 cfg->optionname, cfg->value);
+	}
+    }
+  printf("}\n\n\n");
+  /*
+   * That's it.  We are done.  The output of this file will have header.tk
+   * prepended and tail.tk appended to create an executable wish script.
+   */
+}
Index: trunk/NEMOGCM/EXTERNAL/IOIPSL/tools/tkparse.c
===================================================================
--- trunk/NEMOGCM/EXTERNAL/IOIPSL/tools/tkparse.c	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/IOIPSL/tools/tkparse.c	(revision 2528)
@@ -0,0 +1,755 @@
+/* parser config.in
+ * $Id$
+ *
+ * This software is governed by the CeCILL license
+ * See IOIPSL/IOIPSL_License_CeCILL.txt
+ *
+ * Version 1.0
+ * Eric Youngdale
+ * 10/95
+ *
+ * The general idea here is that we want to parse a config.in file and 
+ * from this, we generate a wish script which gives us effectively the
+ * same functionality that the original config.in script provided.
+ *
+ * This task is split roughly into 3 parts.  The first parse is the parse
+ * of the input file itself.  The second part is where we analyze the 
+ * #ifdef clauses, and attach a linked list of tokens to each of the
+ * menu items.  In this way, each menu item has a complete list of
+ * dependencies that are used to enable/disable the options.
+ * The third part is to take the configuration database we have build,
+ * and build the actual wish script.
+ *
+ * This file contains the code to do the first parse of config.in.
+ */
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include "tkparse.h"
+
+struct kconfig * config = NULL;
+struct kconfig * clast = NULL;
+struct kconfig * koption = NULL;
+static int lineno = 0;
+static int menus_seen = 0;
+static char * current_file = NULL;
+static int do_source(char * filename);
+static char * get_string(char *pnt, char ** labl);
+static int choose_number = 0;
+
+
+/*
+ * Simple function just to skip over spaces and tabs in config.in.
+ */
+static char * skip_whitespace(char * pnt)
+{
+  while( *pnt && (*pnt == ' ' || *pnt == '\t')) pnt++;
+  return pnt;
+}
+
+/*
+ * This function parses a conditional from a config.in (i.e. from an ifdef)
+ * and generates a linked list of tokens that describes the conditional.
+ */
+static struct condition * parse_if(char * pnt)
+{
+  char * opnt;
+  struct condition *list;
+  struct condition *last;
+  struct condition *cpnt;
+  char varname[64];
+  char * pnt1;
+
+  opnt = pnt;
+
+  /*
+   * We need to find the various tokens, and build the linked list.
+   */
+  pnt = skip_whitespace(pnt);
+  if( *pnt != '[' ) return NULL;
+  pnt++;
+  pnt = skip_whitespace(pnt);
+
+  list = last = NULL;
+  while(*pnt && *pnt != ']') {
+
+    pnt = skip_whitespace(pnt);
+    if(*pnt== '\0' || *pnt == ']') break;
+
+    /*
+     * Allocate memory for the token we are about to parse, and insert
+     * it in the linked list.
+     */
+    cpnt = (struct condition *) malloc(sizeof(struct condition));
+    memset(cpnt, 0, sizeof(struct condition));
+    if( last == NULL )
+      {
+	list = last = cpnt;
+      }
+    else
+      {
+	last->next = cpnt;
+	last = cpnt;
+      }
+
+    /*
+     * Determine what type of operation this token represents.
+     */
+    if( *pnt == '-' && pnt[1] == 'a' )
+      {
+	cpnt->op = op_and;
+	pnt += 2;
+	continue;
+      }
+
+    if( *pnt == '-' && pnt[1] == 'o' )
+      {
+	cpnt->op = op_or;
+	pnt += 2;
+	continue;
+      }
+
+    if( *pnt == '!' && pnt[1] == '=' )
+      {
+	cpnt->op = op_neq;
+	pnt += 2;
+	continue;
+      }
+
+    if( *pnt == '=')
+      {
+	cpnt->op = op_eq;
+	pnt += 1;
+	continue;
+      }
+
+    if( *pnt == '!')
+      {
+	cpnt->op = op_bang;
+	pnt += 1;
+	continue;
+      }
+
+    if( *pnt != '"' ) goto error;  /* This cannot be right. */
+    pnt++;
+    if( *pnt == '`' )
+      {
+	cpnt->op = op_shellcmd;
+	pnt1 = varname;
+	pnt++;
+	while(*pnt && *pnt != '`') *pnt1++ = *pnt++;
+	*pnt1++ = '\0';
+	cpnt->variable.str = strdup(varname);
+	if( *pnt == '`' ) pnt++;
+	if( *pnt == '"' ) pnt++;
+	continue;
+      }
+    if( *pnt == '$' )
+      {
+	cpnt->op = op_variable;
+	pnt1 = varname;
+	pnt++;
+	while(*pnt && *pnt != '"') *pnt1++ = *pnt++;
+	*pnt1++ = '\0';
+	cpnt->variable.str = strdup(varname);
+	if( *pnt == '"' ) pnt++;
+	continue;
+      }
+
+    cpnt->op = op_constant;
+    pnt1 = varname;
+    while(*pnt && *pnt != '"') *pnt1++ = *pnt++;
+    *pnt1++ = '\0';
+    cpnt->variable.str = strdup(varname);
+    if( *pnt == '"' ) pnt++;
+    continue;
+  }
+
+  return list;
+
+ error:
+  if(current_file != NULL) 
+    fprintf(stderr, 
+	    "Bad if clause at line %d(%s):%s\n", lineno, current_file, opnt);
+  else
+    fprintf(stderr,
+	    "Bad if clause at line %d:%s\n", lineno, opnt);
+  return NULL;
+}
+
+/*
+ * This function looks for a quoted string, from the input buffer, and
+ * returns a pointer to a copy of this string.  Any characters in
+ * the string that need to be "quoted" have a '\' character inserted
+ * in front - this way we can directly write these strings into
+ * wish scripts.
+ */
+static char * get_qstring(char *pnt, char ** labl)
+{
+  char quotechar;
+  char newlabel[1024];
+  char * pnt1;
+  char * pnt2;
+
+  while( *pnt && *pnt != '"' && *pnt != '\'') pnt++;
+  if (*pnt == '\0') return pnt;
+
+  quotechar = *pnt++;
+  pnt1 = newlabel;
+  while(*pnt && *pnt != quotechar && pnt[-1] != '\\')
+    {
+      /*
+       * Quote the character if we need to.
+       */
+      if( *pnt == '"' || *pnt == '\'' || *pnt == '[' || *pnt == ']')
+	*pnt1++ = '\\';
+
+      *pnt1++ = *pnt++;
+    }
+  *pnt1++ = '\0';
+
+  pnt2 = (char *) malloc(strlen(newlabel) + 1);
+  strcpy(pnt2, newlabel);
+  *labl = pnt2;
+
+  /*
+   * Skip over last quote, and whitespace.
+   */
+  pnt++;
+  pnt = skip_whitespace(pnt);
+  return pnt;
+}
+
+static char * parse_choices(struct kconfig * choice_kcfg, char * pnt)
+{
+  struct kconfig * kcfg;
+  int index = 1;
+
+  /*
+   * Choices appear in pairs of strings.  The parse is fairly trivial.
+   */
+  while(1)
+    {
+      pnt = skip_whitespace(pnt);
+      if(*pnt == '\0') break;
+
+      kcfg = (struct kconfig *) malloc(sizeof(struct kconfig));
+      memset(kcfg, 0, sizeof(struct kconfig));
+      kcfg->tok = tok_choice;
+      if( clast != NULL )
+	{
+	  clast->next = kcfg;
+	  clast = kcfg;
+	}
+      else
+	{
+	  clast = config = kcfg;
+	}
+
+      pnt = get_string(pnt, &kcfg->label);
+      pnt = skip_whitespace(pnt);
+      pnt = get_string(pnt, &kcfg->optionname);
+      kcfg->choice_label = choice_kcfg;
+      kcfg->choice_value = index++;
+      if( strcmp(kcfg->label, choice_kcfg->value) == 0 )
+	choice_kcfg->choice_value = kcfg->choice_value;
+    }
+    
+    return pnt;
+}
+
+
+/*
+ * This function grabs one text token from the input buffer
+ * and returns a pointer to a copy of just the identifier.
+ * This can be either a variable name (i.e. CONFIG_NET),
+ * or it could be the default value for the option.
+ */
+static char * get_string(char *pnt, char ** labl)
+{
+  char newlabel[1024];
+  char * pnt1;
+  char * pnt2;
+
+  if (*pnt == '\0') return pnt;
+
+  pnt1 = newlabel;
+  while(*pnt && *pnt != ' ' && *pnt != '\t')
+    {
+      *pnt1++ = *pnt++;
+    }
+  *pnt1++ = '\0';
+
+  pnt2 = (char *) malloc(strlen(newlabel) + 1);
+  strcpy(pnt2, newlabel);
+  *labl = pnt2;
+
+  if( *pnt ) pnt++;
+  return pnt;
+}
+
+
+/*
+ * Top level parse function.  Input pointer is one complete line from config.in
+ * and the result is that we create a token that describes this line
+ * and insert it into our linked list.
+ */
+void parse(char * pnt) {
+  enum token tok;
+  struct kconfig * kcfg;
+  char tmpbuf[24],fake_if[1024];
+
+  /*
+   * Ignore comments and leading whitespace.
+   */
+
+  pnt = skip_whitespace(pnt);
+  while( *pnt && (*pnt == ' ' || *pnt == '\t')) pnt++;
+  if(! *pnt ) return;
+  if( *pnt == '#' ) return;
+
+  /*
+   * Now categorize the next token.
+   */
+  tok = tok_unknown;
+  if      (strncmp(pnt, "mainmenu_name", 13) == 0) 
+    {
+      tok = tok_menuname;
+      pnt += 13;
+    }
+  else if      (strncmp(pnt, "source", 6) == 0) 
+    {
+      pnt += 7;
+      pnt = skip_whitespace(pnt);
+      do_source(pnt);
+      return;
+    }
+  else if (strncmp(pnt, "mainmenu_option", 15) == 0) 
+    {
+      menus_seen++;
+      tok = tok_menuoption;
+      pnt += 15;
+    }
+  else if (strncmp(pnt, "$MAKE ", 6) == 0) 
+    {
+      tok = tok_make;
+    }
+  else if (strncmp(pnt, "comment", 7) == 0) 
+    {
+      tok = tok_comment;
+      pnt += 7;
+    }
+  else if (strncmp(pnt, "choice", 6) == 0) 
+    {
+      tok = tok_choose;
+      pnt += 6;
+    }
+  else if (strncmp(pnt, "define_bool", 11) == 0) 
+    {
+      tok = tok_define;
+      pnt += 11;
+    }
+  else if (strncmp(pnt, "bool", 4) == 0) 
+    {
+      tok = tok_bool;
+      pnt += 4;
+    }
+  else if (strncmp(pnt, "tristate", 8) == 0) 
+    {
+      tok = tok_tristate;
+      pnt += 8;
+    }
+  else if (strncmp(pnt, "dep_tristate", 12) == 0) 
+    {
+      tok = tok_dep_tristate;
+      pnt += 12;
+    }
+  else if (strncmp(pnt, "int", 3) == 0) 
+    {
+      tok = tok_int;
+      pnt += 3;
+    }
+  else if (strncmp(pnt, "hex", 3) == 0) 
+    {
+      tok = tok_hex;
+      pnt += 3;
+    }
+  else if (strncmp(pnt, "if", 2) == 0) 
+    {
+      tok = tok_if;
+      pnt += 2;
+    }
+  else if (strncmp(pnt, "else", 4) == 0) 
+    {
+      tok = tok_else;
+      pnt += 4;
+    }
+  else if (strncmp(pnt, "fi", 2) == 0) 
+    {
+      tok = tok_fi;
+      pnt += 2;
+    }
+  else if (strncmp(pnt, "endmenu", 7) == 0) 
+    {
+      tok = tok_endmenu;
+      pnt += 7;
+    }
+
+  if( tok == tok_unknown)
+    {
+      if( clast != NULL && clast->tok == tok_if 
+	  && strcmp(pnt,"then") == 0) return;
+      if( current_file != NULL )
+	fprintf(stderr, "unknown command=%s(%s %d)\n", pnt,
+		current_file, lineno);
+      else
+	fprintf(stderr, "unknown command=%s(%d)\n", pnt,lineno);
+      return;
+    }
+
+  /*
+   * Allocate memory for this item, and attach it to the end of the linked
+   * list.
+   */
+  kcfg = (struct kconfig *) malloc(sizeof(struct kconfig));
+  memset(kcfg, 0, sizeof(struct kconfig));
+  kcfg->tok = tok;
+  if( clast != NULL )
+    {
+      clast->next = kcfg;
+      clast = kcfg;
+    }
+  else
+    {
+      clast = config = kcfg;
+    }
+
+  pnt = skip_whitespace(pnt);
+
+  /*
+   * Now parse the remaining parts of the option, and attach the results
+   * to the structure.
+   */
+  switch (tok)
+    {
+    case tok_choose:
+      pnt = get_qstring(pnt, &kcfg->label);
+      pnt = get_qstring(pnt, &kcfg->optionname);
+      pnt = get_string(pnt, &kcfg->value);
+      /*
+       * Now we need to break apart the individual options into their
+       * own configuration structures.
+       */
+      parse_choices(kcfg, kcfg->optionname);
+      free(kcfg->optionname);
+      sprintf(tmpbuf, "tmpvar_%d", choose_number++);
+      kcfg->optionname = strdup(tmpbuf);
+      break;
+    case tok_define:
+      pnt = get_string(pnt, &kcfg->optionname);
+      if(*pnt == 'y' || *pnt == 'Y' ) kcfg->value = "1";
+      if(*pnt == 'n' || *pnt == 'N' ) kcfg->value = "0";
+      if(*pnt == 'm' || *pnt == 'M' ) kcfg->value = "2";
+      break;
+    case tok_menuname:
+      pnt = get_qstring(pnt, &kcfg->label);
+      break;
+    case tok_bool:
+    case tok_tristate:
+      pnt = get_qstring(pnt, &kcfg->label);
+      pnt = get_string(pnt, &kcfg->optionname);
+      break;
+    case tok_int:
+    case tok_hex:
+      pnt = get_qstring(pnt, &kcfg->label);
+      pnt = get_string(pnt, &kcfg->optionname);
+      pnt = get_string(pnt, &kcfg->value);
+      break;
+    case tok_dep_tristate:
+      pnt = get_qstring(pnt, &kcfg->label);
+      pnt = get_string(pnt, &kcfg->optionname);
+      pnt = skip_whitespace(pnt);
+      if( *pnt == '$') pnt++;
+      pnt = get_string(pnt, &kcfg->depend.str);
+
+      /*
+       * Create a conditional for this object's dependency.
+       *
+       * We can't use "!= n" because this is internally converted to "!= 0"
+       * and if UMSDOS depends on MSDOS which depends on FAT, then when FAT
+       * is disabled MSDOS has 16 added to its value, making UMSDOS fully
+       * available.  Whew.
+       *
+       * This is more of a hack than a fix.  Nested "if" conditionals are
+       * probably affected too - that +/- 16 affects things in too many
+       * places.  But this should do for now.
+       */
+      sprintf(fake_if,"[ \"$%s\" = \"y\" -o \"$%s\" = \"m\" ]; then",
+	      	kcfg->depend.str,kcfg->depend.str);
+      kcfg->cond = parse_if(fake_if);
+      if(kcfg->cond == NULL )
+	{
+	  exit(1);
+	}
+      break;
+    case tok_comment:
+      pnt = get_qstring(pnt, &kcfg->label);
+      if( koption != NULL )
+	{
+	  pnt = get_qstring(pnt, &kcfg->label);
+	  koption->label = kcfg->label;
+	  koption = NULL;
+	}
+      break;
+    case tok_menuoption:
+      if( strncmp(pnt, "next_comment", 12) == 0)
+	{
+	  koption = kcfg;
+	}
+      else
+	{
+	  pnt = get_qstring(pnt, &kcfg->label);
+	}
+      break;
+    case tok_make:
+      kcfg->value=strdup(pnt);
+      break;
+    case tok_else:
+    case tok_fi:
+    case tok_endmenu:
+      break;
+    case tok_if:
+      /*
+       * Conditionals are different.  For the first level parse, only
+       * tok_if and tok_dep_tristate items have a ->cond chain attached.
+       */
+      kcfg->cond = parse_if(pnt);
+      if(kcfg->cond == NULL )
+	{
+	  exit(1);
+	}
+      break;
+    default:
+      exit(0);
+    }
+    
+    return;
+}
+
+/*
+ * Simple function to dump to the screen what the condition chain looks like.
+ */
+void dump_if(struct condition * cond)
+{
+  printf(" ");
+  while(cond != NULL )
+    {
+      switch(cond->op){
+      case op_eq:
+	printf(" = ");
+	break;
+      case op_bang:
+	printf(" ! ");
+	break;
+      case op_neq:
+	printf(" != ");
+	break;
+      case op_and:
+	printf(" -a ");
+	break;
+      case op_lparen:
+	printf("(");
+	break;
+      case op_rparen:
+	printf(")");
+	break;
+      case op_variable:
+	printf("$%s", cond->variable.str);
+	break;
+      case op_constant:
+	printf("'%s'", cond->variable.str);
+	break;
+      default:
+        break;
+      }
+      cond = cond->next;
+    }
+
+  printf("\n");
+}
+
+static int do_source(char * filename)
+{
+  char buffer[1024];
+  int  offset;
+  int old_lineno;
+  char * old_file;
+  char * pnt;
+  FILE * infile;
+
+  if( strcmp(filename, "-") == 0 )
+    infile = stdin;
+  else
+    infile = fopen(filename,"r");
+
+  /*
+   * If our cwd was in the scripts directory, we might have to go up one
+   * to find the sourced file.
+   */
+  if(!infile) {
+    strcpy (buffer, "../");
+    strcat (buffer, filename);
+    infile = fopen(buffer,"r");
+  }
+
+  if(!infile) {
+    fprintf(stderr,"Unable to open file %s\n", filename);
+    return 1;
+  }
+  old_lineno = lineno;
+  lineno = 0;
+  if( infile != stdin ) {
+    old_file = current_file;
+    current_file = filename;
+  }
+  offset = 0;
+  while(1)
+    {
+      fgets(&buffer[offset], sizeof(buffer) - offset, infile);
+      if(feof(infile)) break;
+
+      /*
+       * Strip the trailing return character.
+       */
+      pnt = buffer + strlen(buffer) - 1;
+      if( *pnt == '\n') *pnt-- = 0;
+      lineno++;
+      if( *pnt == '\\' )
+	{
+	  offset = pnt - buffer;
+	}
+      else
+	{
+	  parse(buffer);
+	  offset = 0;
+	}
+    }
+  fclose(infile);
+  if( infile != stdin ) {
+    current_file = old_file;
+  }
+  lineno = old_lineno;
+  return 0;
+}
+
+int main(int argc, char * argv[])
+{
+#if 0
+  char buffer[1024];
+  char * pnt;
+  struct kconfig * cfg;
+  int    i;
+#endif
+
+  /*
+   * Read stdin to get the top level script.
+   */
+  do_source("-");
+
+  if( menus_seen == 0 )
+    {
+      fprintf(stderr,"The config.in file for this platform does not support\n");
+      fprintf(stderr,"menus.\n");
+      exit(1);
+    }
+  /*
+   * Input file is now parsed.  Next we need to go through and attach
+   * the correct conditions to each of the actual menu items and kill
+   * the if/else/endif tokens from the list.  We also flag the menu items
+   * that have other things that depend upon its setting.
+   */
+  fix_conditionals(config);
+
+  /*
+   * Finally, we generate the wish script.
+   */
+  dump_tk_script(config);
+
+#if 0
+  /*
+   * Now dump what we have so far.  This is only for debugging so that
+   * we can display what we think we have in the list.
+   */
+  for(cfg = config; cfg; cfg = cfg->next)
+    {
+
+      if(cfg->cond != NULL && cfg->tok != tok_if)
+	dump_if(cfg->cond);
+
+      switch(cfg->tok)
+	{
+	case tok_menuname:
+	  printf("main_menuname ");
+	  break;
+	case tok_bool:
+	  printf("bool ");
+	  break;
+	case tok_tristate:
+	  printf("tristate ");
+	  break;
+	case tok_dep_tristate:
+	  printf("dep_tristate ");
+	  break;
+	case tok_int:
+	  printf("int ");
+	  break;
+	case tok_hex:
+	  printf("hex ");
+	  break;
+	case tok_comment:
+	  printf("comment ");
+	  break;
+	case tok_menuoption:
+	  printf("menuoption ");
+	  break;
+	case tok_else:
+	  printf("else");
+	  break;
+	case tok_fi:
+	  printf("fi");
+	  break;
+	case tok_if:
+	  printf("if");
+	  break;
+	default:
+	}
+
+      switch(cfg->tok)
+	{
+	case tok_menuoption:
+	case tok_comment:
+	case tok_menuname:
+	  printf("%s\n", cfg->label);
+	  break;
+	case tok_bool:
+	case tok_tristate:
+	case tok_dep_tristate:
+	case tok_int:
+	case tok_hex:
+	  printf("%s %s\n", cfg->label, cfg->optionname);
+	  break;
+	case tok_if:
+	  dump_if(cfg->cond);
+	  break;
+	case tok_nop:
+	case tok_endmenu:
+	  break;
+	default:
+	  printf("\n");
+	}
+    }
+#endif
+
+  return 0;
+
+}
Index: trunk/NEMOGCM/EXTERNAL/IOIPSL/tools/tkparse.h
===================================================================
--- trunk/NEMOGCM/EXTERNAL/IOIPSL/tools/tkparse.h	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/IOIPSL/tools/tkparse.h	(revision 2528)
@@ -0,0 +1,82 @@
+
+enum token {
+  tok_menuname, 
+  tok_menuoption, 
+  tok_comment, 
+  tok_bool, 
+  tok_tristate, 
+  tok_dep_tristate,
+  tok_nop,
+  tok_if, 
+  tok_else, 
+  tok_fi, 
+  tok_int,
+  tok_hex,
+  tok_make,
+  tok_define,
+  tok_choose,
+  tok_choice,
+  tok_endmenu,
+  tok_unknown
+};
+
+enum operator {
+  op_eq,
+  op_neq,
+  op_and,
+  op_and1,
+  op_or,
+  op_bang,
+  op_lparen,
+  op_rparen,
+  op_variable,
+  op_kvariable,
+  op_shellcmd,
+  op_constant,
+  op_nuked
+};
+
+union var
+{
+  char * str;
+  struct kconfig * cfg;
+};
+
+struct condition
+{
+  struct condition * next;
+  enum operator op;
+  union var variable;
+};
+
+#define GLOBAL_WRITTEN  1
+#define CFG_DUP 	2
+#define UNSAFE		4
+
+struct kconfig
+{
+  struct kconfig 	* next;
+  int 			  flags;
+  enum 			  token tok;
+  char   		  menu_number;
+  char   		  menu_line;
+  char   		  submenu_start;
+  char   		  submenu_end;
+  char 			* optionname;
+  char 			* label;
+  char 			* value;
+  int   		  choice_value;
+  struct kconfig        * choice_label;
+  union var 		  depend;
+  struct condition 	* cond;
+};
+
+extern struct kconfig * config;
+extern struct kconfig * clast;
+extern struct kconfig * koption;
+
+/*
+ * Prototypes
+ */
+void fix_conditionals(struct kconfig * scfg);	/* tkcond.c */
+void dump_tk_script(struct kconfig *scfg);	/* tkgen.c  */
Index: trunk/NEMOGCM/EXTERNAL/README
===================================================================
--- trunk/NEMOGCM/EXTERNAL/README	(revision 2527)
+++ 	(revision )
@@ -1,4 +1,0 @@
-07/28/2009: rblod
-
-Directory to store external elements coupled with NEMO under the name of the component_N.
-Directory MISC is a clever name for garbage.
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/AA_make
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/AA_make	(revision 2527)
+++ 	(revision )
@@ -1,144 +1,0 @@
-VPATH=../src/cml:../src/dom:../src/sax:../src/strings:../src/xpath:../src/wxml
-MAKE_NAM = $(MAKE)
-ifneq ($(MAKE_NAM),$(M_K))
- @$(error You must invoke this Makefile with the $(M_K) command)
-endif
-USER_DIR = $(shell /bin/pwd)
-MAKE_DIR = '??'
-ifneq ($(USER_DIR),$(MAKE_DIR))
- @$(error You must invoke this Makefile from its directory)
-endif
-#-
-#-Q- sxdkrz F_O = $(F_D) $(F_P) -C vsafe -size_t64 -I $(MODDIR)
-#-Q- es2 F_O = $(F_D) $(F_P) -C vsafe -I $(MODDIR)
-#-Q- sx8brodie F_O = $(F_D) $(F_P) -I $(MODDIR)
-#-Q- sx6nec F_O = $(F_D) $(F_P) -size_t64 -Wf,"-pvctl loopcnt=999999" -I $(MODDIR)
-#-Q- sx8mercure F_O = $(F_D) $(F_P) -size_t64 -Wf,"-pvctl loopcnt=999999" -I $(MODDIR)
-#-Q- sx9mercure F_O = $(F_D) $(F_P) -size_t64 -Wf,"-pvctl loopcnt=999999" -I $(MODDIR)
-#-Q- aix6 F_O = $(F_P) -O3 -qextname -qsuffix=f=f90  -qmoddir=$(MODDIR) -I $(MODDIR)
-#-Q- aix F_O = $(F_P) -O3 -qextname -qsuffix=f=f90  -qmoddir=$(MODDIR) -I $(MODDIR)
-#-Q- osxxlf = $(F_P) -O3 -qextname -qsuffix=f=f90  -qmoddir=$(MODDIR) -I $(MODDIR)
-#---------------------------------------------------------------------
-#- Create libxmlf90
-#---------------------------------------------------------------------
-
-.PRECIOUS : $(MODEL_LIB)
-SXMODEL_LIB = $(MODEL_LIB)
-ifeq ($(L_X),1)
-SXMODEL_LIB = $(LIBDIR)/libsxxmlf90.a
-.PRECIOUS : $(SXMODEL_LIB)
-endif
-
-MODS1 =	../src/cml/flib_cml.f90 ../src/cml/m_cmlw.f90 ../src/cml/m_stmw.f90 \
-	../src/dom/flib_dom.f90 ../src/dom/m_dom_attribute.f90 \
-	../src/dom/m_dom_debug.f90 ../src/dom/m_dom_document.f90 \
-	../src/dom/m_dom_element.f90 ../src/dom/m_dom_error.f90 \
-	../src/dom/m_dom_namednodemap.f90 ../src/dom/m_dom_node.f90 \
-	../src/dom/m_dom_nodelist.f90 ../src/dom/m_dom_parse.f90 \
-	../src/dom/m_dom_types.f90 ../src/dom/m_dom_utils.f90 \
-	../src/sax/flib_sax.f90 ../src/sax/m_buffer.f90 \
-	../src/sax/m_charset.f90 ../src/sax/m_converters.f90 \
-	../src/sax/m_debug.f90 ../src/sax/m_dictionary.f90 \
-	../src/sax/m_elstack.f90 ../src/sax/m_entities.f90 \
-	../src/sax/m_fsm.f90 ../src/sax/m_io.f90 ../src/sax/m_reader.f90 \
-	../src/sax/m_xml_error.f90 ../src/sax/m_xml_parser.f90 \
-	../src/strings/m_strings.f90 ../src/wxml/flib_wxml.f90 \
-	../src/wxml/m_wxml_buffer.f90 ../src/wxml/m_wxml_core.f90 \
-	../src/wxml/m_wxml_dictionary.f90 ../src/wxml/m_wxml_elstack.f90 \
-	../src/wxml/m_wxml_text.f90 ../src/xpath/flib_xpath.f90 \
-	../src/xpath/m_path.f90 ../src/xpath/m_path_orig.f90 \
-	../src/xpath/match_tester.f90
-
-OBJSMODS1 =	flib_cml.o m_cmlw.o m_stmw.o flib_dom.o m_dom_attribute.o \
-	m_dom_debug.o m_dom_document.o m_dom_element.o m_dom_error.o \
-	m_dom_namednodemap.o m_dom_node.o m_dom_nodelist.o m_dom_parse.o \
-	m_dom_types.o m_dom_utils.o flib_sax.o m_buffer.o m_charset.o \
-	m_converters.o m_debug.o m_dictionary.o m_elstack.o m_entities.o \
-	m_fsm.o m_io.o m_reader.o m_xml_error.o m_xml_parser.o m_strings.o \
-	flib_wxml.o m_wxml_buffer.o m_wxml_core.o m_wxml_dictionary.o \
-	m_wxml_elstack.o m_wxml_text.o flib_xpath.o m_path.o m_path_orig.o \
-	match_tester.o
-
-all: dirxml $(MODEL_LIB)($(OBJSMODS1))
-	@echo XMLF90 is OK
-
-#---USE VPATH--- $(MODEL_LIB)(%.o): ../*/*/%.f90
-$(MODEL_LIB)(%.o): %.f90
-	$(F_C) $(F_O) -I$(NCDF_INC) $<
-	$(A_C) $(MODEL_LIB) $*.o
-ifeq ($(L_X),1)
-	$(A_X) $(SXMODEL_LIB) $*.o
-endif
-#-Q- sgi6       mv $(shell echo $* | tr '[:lower:]' '[:upper:]').mod $(MODDIR)
-ifeq ($(M_M),1)
-	@mv -f *.mod $(MODDIR)  2> /dev/null || true
-endif
-	$(RM) $*.o
-
-dirxml: 
-	@if [ ! -d ../../../lib/libxmlio_server ] ; then mkdir ../../../lib/libxmlio_server ; fi
-
-clean:
-	$(RM) *.*~ Makefile~ core *.o *.mod i.*.L *.L
-	$(RM)  $(MODEL_LIB) 
-
-$(MODEL_LIB)(flib_cml.o): $(MODEL_LIB)(m_cmlw.o) $(MODEL_LIB)(m_stmw.o)
-$(MODEL_LIB)(m_cmlw.o): $(MODEL_LIB)(m_stmw.o) $(MODEL_LIB)(flib_wxml.o)
-$(MODEL_LIB)(m_stmw.o): $(MODEL_LIB)(flib_wxml.o)
-$(MODEL_LIB)(flib_dom.o): $(MODEL_LIB)(m_dom_attribute.o) \
-	$(MODEL_LIB)(m_dom_document.o) $(MODEL_LIB)(m_dom_element.o) \
-	$(MODEL_LIB)(m_dom_namednodemap.o) $(MODEL_LIB)(m_dom_node.o) \
-	$(MODEL_LIB)(m_dom_nodelist.o) $(MODEL_LIB)(m_dom_parse.o) \
-	$(MODEL_LIB)(m_dom_types.o) $(MODEL_LIB)(m_dom_utils.o) \
-	$(MODEL_LIB)(m_strings.o)
-$(MODEL_LIB)(m_dom_attribute.o): $(MODEL_LIB)(m_dom_node.o) \
-	$(MODEL_LIB)(m_dom_types.o) $(MODEL_LIB)(m_strings.o)
-$(MODEL_LIB)(m_dom_document.o): $(MODEL_LIB)(m_dom_types.o) \
-	$(MODEL_LIB)(m_strings.o)
-$(MODEL_LIB)(m_dom_element.o): $(MODEL_LIB)(m_dom_attribute.o) \
-	$(MODEL_LIB)(m_dom_debug.o) $(MODEL_LIB)(m_dom_document.o) \
-	$(MODEL_LIB)(m_dom_namednodemap.o) $(MODEL_LIB)(m_dom_node.o) \
-	$(MODEL_LIB)(m_dom_nodelist.o) $(MODEL_LIB)(m_dom_types.o) \
-	$(MODEL_LIB)(m_strings.o)
-$(MODEL_LIB)(m_dom_namednodemap.o): $(MODEL_LIB)(m_dom_types.o) \
-	$(MODEL_LIB)(m_strings.o)
-$(MODEL_LIB)(m_dom_node.o): $(MODEL_LIB)(m_dom_debug.o) \
-	$(MODEL_LIB)(m_dom_error.o) $(MODEL_LIB)(m_dom_namednodemap.o) \
-	$(MODEL_LIB)(m_dom_nodelist.o) $(MODEL_LIB)(m_dom_types.o) \
-	$(MODEL_LIB)(m_strings.o)
-$(MODEL_LIB)(m_dom_nodelist.o): $(MODEL_LIB)(m_dom_types.o)
-$(MODEL_LIB)(m_dom_parse.o): $(MODEL_LIB)(m_dom_debug.o) \
-	$(MODEL_LIB)(m_dom_document.o) $(MODEL_LIB)(m_dom_element.o) \
-	$(MODEL_LIB)(m_dom_node.o) $(MODEL_LIB)(m_dom_types.o) \
-	$(MODEL_LIB)(flib_sax.o)
-$(MODEL_LIB)(m_dom_types.o): $(MODEL_LIB)(m_strings.o)
-$(MODEL_LIB)(m_dom_utils.o): $(MODEL_LIB)(m_dom_debug.o) \
-	$(MODEL_LIB)(m_dom_document.o) $(MODEL_LIB)(m_dom_element.o) \
-	$(MODEL_LIB)(m_dom_namednodemap.o) $(MODEL_LIB)(m_dom_node.o) \
-	$(MODEL_LIB)(m_dom_types.o) $(MODEL_LIB)(m_strings.o) \
-	$(MODEL_LIB)(flib_wxml.o)
-$(MODEL_LIB)(flib_sax.o): $(MODEL_LIB)(m_converters.o) \
-	$(MODEL_LIB)(m_dictionary.o) $(MODEL_LIB)(m_xml_error.o) \
-	$(MODEL_LIB)(m_xml_parser.o)
-$(MODEL_LIB)(m_converters.o): $(MODEL_LIB)(m_debug.o)
-$(MODEL_LIB)(m_dictionary.o): $(MODEL_LIB)(m_buffer.o)
-$(MODEL_LIB)(m_elstack.o): $(MODEL_LIB)(m_buffer.o)
-$(MODEL_LIB)(m_entities.o): $(MODEL_LIB)(m_buffer.o)
-$(MODEL_LIB)(m_fsm.o): $(MODEL_LIB)(m_buffer.o) $(MODEL_LIB)(m_charset.o) \
-	$(MODEL_LIB)(m_dictionary.o) $(MODEL_LIB)(m_elstack.o) \
-	$(MODEL_LIB)(m_entities.o)
-$(MODEL_LIB)(m_reader.o): $(MODEL_LIB)(m_io.o)
-$(MODEL_LIB)(m_xml_error.o): $(MODEL_LIB)(m_elstack.o)
-$(MODEL_LIB)(m_xml_parser.o): $(MODEL_LIB)(m_buffer.o) \
-	$(MODEL_LIB)(m_debug.o) $(MODEL_LIB)(m_dictionary.o) \
-	$(MODEL_LIB)(m_elstack.o) $(MODEL_LIB)(m_entities.o) \
-	$(MODEL_LIB)(m_fsm.o) $(MODEL_LIB)(m_reader.o) \
-	$(MODEL_LIB)(m_xml_error.o)
-$(MODEL_LIB)(flib_wxml.o): $(MODEL_LIB)(m_wxml_core.o) \
-	$(MODEL_LIB)(m_wxml_text.o)
-$(MODEL_LIB)(m_wxml_core.o): $(MODEL_LIB)(m_wxml_buffer.o) \
-	$(MODEL_LIB)(m_wxml_dictionary.o) $(MODEL_LIB)(m_wxml_elstack.o)
-$(MODEL_LIB)(flib_xpath.o): $(MODEL_LIB)(flib_sax.o) \
-	$(MODEL_LIB)(m_path_orig.o)
-$(MODEL_LIB)(m_path.o): $(MODEL_LIB)(flib_sax.o)
-$(MODEL_LIB)(m_path_orig.o): $(MODEL_LIB)(flib_sax.o)
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/AA_make.ldef
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/AA_make.ldef	(revision 2527)
+++ 	(revision )
@@ -1,12 +1,0 @@
-#-
-#- $Id: $
-#-
-#---------------------------------------------------------------------
-#- Local parameters for "libxml90"
-#---------------------------------------------------------------------
-SHELL = /bin/ksh
-#---------------------------------------------------------------------
-LIBDIR = ../../../lib/libxmlio_server
-MODDIR = $(LIBDIR)
-#---------------------------------------------------------------------
-MODEL_LIB = $(LIBDIR)/libxmlf90.a
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/LICENSE
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/LICENSE	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/LICENSE	(revision 2528)
@@ -0,0 +1,35 @@
+Copyright (c) 2003, 2004, Alberto Garcia (SAX, XPATH, WXML, Overall design)
+(c) 2003, 2004, Jon Wakelin, Alberto Garcia (DOM subsystem)
+(c) 2003, 2004, Jon Wakelin (CML writing subsystem)
+STRINGS module contributed by Mart Reentmeester. (See strings/m_strings.f90)
+
+All rights reserved.
+
+* Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+        
+* Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+        
+* Redistributions in binary form must reproduce the above copyright
+notice, this list of conditions and the following disclaimer in the
+documentation and/or other materials provided with the distribution.
+        
+* Neither the name of the copyright holder nor the names of its
+contributors may be used to endorse or promote products derived from
+this software without specific prior written permission.
+
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/makemake_XMLF90.perl
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/makemake_XMLF90.perl	(revision 2527)
+++ 	(revision )
@@ -1,286 +1,0 @@
-#!/usr/bin/perl
-#
-# Usage: makemake {<program name> {<F90 compiler or fc or f77 or cc or c>}}
-#
-# Generate a Makefile from the sources in the current directory.  The source
-# files may be in either C, FORTRAN 77, Fortran 90 or some combination of
-# these languages.  If the F90 compiler specified is cray or parasoft, then
-# the Makefile generated will conform to the conventions of these compilers.
-# To run makemake, it will be necessary to modify the first line of this script
-# to point to the actual location of Perl on your system.
-#
-# Written by Michael Wester <wester@math.unm.edu> February 16, 1995
-# Cotopaxi (Consulting), Albuquerque, New Mexico
-#
-open(MAKEFILE, "> AA_make");
-#
-#print MAKEFILE "PROG =\t$ARGV[0]\n\n";
-#
-# Misc
-
-print MAKEFILE "VPATH=../src/cml:../src/dom:../src/sax:../src/strings:../src/xpath:../src/wxml\n";
-print MAKEFILE "MAKE_NAM = \$(MAKE)\n";
-print MAKEFILE "ifneq (\$(MAKE_NAM),\$(M_K))\n";
-print MAKEFILE " \@\$(error You must invoke this Makefile with the \$(M_K) command)\n";
-print MAKEFILE "endif\n";
-print MAKEFILE "USER_DIR = \$(shell /bin/pwd)\n";
-print MAKEFILE "MAKE_DIR = '??'\n";
-print MAKEFILE "ifneq (\$(USER_DIR),\$(MAKE_DIR))\n";
-print MAKEFILE " \@\$(error You must invoke this Makefile from its directory)\n";
-print MAKEFILE "endif\n";
-print MAKEFILE "#-\n";
-print MAKEFILE "#-Q- sxdkrz F_O = \$(F_D) \$(F_P) -C vsafe -size_t64 -I \$(MODDIR)\n";
-print MAKEFILE "#-Q- es2 F_O = \$(F_D) \$(F_P) -C vsafe -I \$(MODDIR)\n";
-print MAKEFILE "#-Q- sx8brodie F_O = \$(F_D) \$(F_P) -I \$(MODDIR)\n";
-print MAKEFILE "#-Q- sx6nec F_O = \$(F_D) \$(F_P) -size_t64 -Wf\,\"-pvctl loopcnt=999999\" -I \$(MODDIR)\n";
-print MAKEFILE "#-Q- sx8mercure F_O = \$(F_D) \$(F_P) -size_t64 -Wf\,\"-pvctl loopcnt=999999\" -I \$(MODDIR)\n";
-print MAKEFILE "#-Q- sx9mercure F_O = \$(F_D) \$(F_P) -size_t64 -Wf\,\"-pvctl loopcnt=999999\" -I \$(MODDIR)\n";
-print MAKEFILE "#-Q- aix6 F_O = \$(F_P) -O3 -qextname -qsuffix=f=f90  -qmoddir=\$(MODDIR) -I \$(MODDIR)\n";
-print MAKEFILE "#-Q- aix F_O = \$(F_P) -O3 -qextname -qsuffix=f=f90  -qmoddir=\$(MODDIR) -I \$(MODDIR)\n";
-print MAKEFILE "#-Q- osxxlf = \$(F_P) -O3 -qextname -qsuffix=f=f90  -qmoddir=\$(MODDIR) -I \$(MODDIR)\n";
-print MAKEFILE "#---------------------------------------------------------------------\n";
-print MAKEFILE "#- Create libxmlf90\n";
-print MAKEFILE "#---------------------------------------------------------------------\n\n";
-
-print MAKEFILE ".PRECIOUS : \$(MODEL_LIB)\n";
-print MAKEFILE "SXMODEL_LIB = \$(MODEL_LIB)\n";
-print MAKEFILE "ifeq (\$(L_X),1)\n";
-print MAKEFILE "SXMODEL_LIB = \$(LIBDIR)/libsxxmlf90.a\n";
-print MAKEFILE ".PRECIOUS : \$(SXMODEL_LIB)\n";
-print MAKEFILE "endif\n\n";
-
-# Source listing
-#
-print MAKEFILE "MODS1 =\t";
-@srcs = < ../*/*/*.f90 >;
-&PrintWords(8, 0, @srcs);
-print MAKEFILE "\n\n";
-#
-# Object listing
-#
-print MAKEFILE "OBJSMODS1 =\t";
-@objs =  @srcs;
-foreach (@objs) { s/\.[^.]+$/.o/ };
-         foreach $objs (@objs) {
-         @tab = split('/', $objs);
-         $objs = $tab[$#tab] ;
-         };
-
-&PrintWords(8, 0, @objs);
-print MAKEFILE "\n\n";
-#
-# Define common macros
-#
-#print MAKEFILE "LIBS =\t\n\n";
-#print MAKEFILE "CC = cc\n";
-#print MAKEFILE "CFLAGS = -O\n";
-#print MAKEFILE "FC = f77\n";
-#print MAKEFILE "FFLAGS = -O\n";
-#print MAKEFILE "F90 = f90\n";
-#print MAKEFILE "F90FLAGS = -O\n";
-#print MAKEFILE "LDFLAGS = -s\n\n";
-#
-# make
-#
-print MAKEFILE "all: dirxml \$(MODEL_LIB)(\$(OBJSMODS1))\n";
-print MAKEFILE "\t\@echo XMLF90 is OK\n\n";
-
-# .f90 -> .o
-#
-
-print MAKEFILE "#---USE VPATH--- \$(MODEL_LIB)(%.o): ../*/*/%.f90\n";
-print MAKEFILE "\$(MODEL_LIB)(%.o): %.f90\n";
-print MAKEFILE "\t\$(F_C) \$(F_O) -I\$(NCDF_INC) \$<\n";
-print MAKEFILE "\t\$(A_C) \$(MODEL_LIB) \$*.o\n";
-print MAKEFILE "ifeq (\$(L_X),1)\n";
-print MAKEFILE "\t\$(A_X) \$(SXMODEL_LIB) \$*.o\n";
-print MAKEFILE "endif\n";
-print MAKEFILE "#-Q- sgi6       mv \$(shell echo \$* | tr '[:lower:]' '[:upper:]').mod \$(MODDIR)\n";
-print MAKEFILE "ifeq (\$(M_M),1)\n";
-print MAKEFILE "\t\@mv -f *.mod \$(MODDIR)  2> /dev/null || true\n";
-print MAKEFILE "endif\n";
-print MAKEFILE "\t\$(RM) \$*.o\n\n";;
-
-
-print MAKEFILE "dirxml: \n";
-print MAKEFILE "\t\@if [ ! -d ../../../lib/libxmlio_server ] ; then mkdir ../../../lib/libxmlio_server ; fi\n\n";
-#
-# make clean
-#
-print MAKEFILE "clean:\n";
-print MAKEFILE "\t\$(RM) *.*~ Makefile~ core *.o *.mod i.*.L *.L\n";
-print MAKEFILE "\t\$(RM)  \$(MODEL_LIB) \n\n";
-#
-#
-# Dependency listings
-#
-&MakeDependsf90($ARGV[1]);
-&MakeDepends("*.f *.F", '^\s*include\s+["\']([^"\']+)["\']');
-&MakeDepends("*.c",     '^\s*#\s*include\s+["\']([^"\']+)["\']');
-
-#
-# &PrintWords(current output column, extra tab?, word list); --- print words
-#    nicely
-#
-sub PrintWords {
-   local($columns) = 78 - shift(@_);
-   local($extratab) = shift(@_);
-   local($wordlength);
-   #
-   print MAKEFILE @_[0];
-   $columns -= length(shift(@_));
-   foreach $word (@_) {
-      $wordlength = length($word);
-      if ($wordlength + 1 < $columns) {
-         print MAKEFILE " $word";
-         $columns -= $wordlength + 1;
-         }
-      else {
-         #
-         # Continue onto a new line
-         #
-         if ($extratab) {
-            print MAKEFILE " \\\n\t\t$word";
-            $columns = 62 - $wordlength;
-            }
-         else {
-            print MAKEFILE " \\\n\t$word";
-            $columns = 70 - $wordlength;
-            }
-         }
-      }
-   }
-
-#
-# &LanguageCompiler(compiler, sources); --- determine the correct language
-#    compiler
-#
-sub LanguageCompiler {
-   local($compiler) = &toLower(shift(@_));
-   local(@srcs) = @_;
-   #
-   if (length($compiler) > 0) {
-      CASE: {
-         grep(/^$compiler$/, ("fc", "f77")) &&
-            do { $compiler = "FC"; last CASE; };
-         grep(/^$compiler$/, ("cc", "c"))   &&
-            do { $compiler = "CC"; last CASE; };
-         $compiler = "F90";
-         }
-      }
-   else {
-      CASE: {
-         grep(/\.f90$/, @srcs)   && do { $compiler = "F90"; last CASE; };
-         grep(/\.(f|F)$/, @srcs) && do { $compiler = "FC";  last CASE; };
-         grep(/\.c$/, @srcs)     && do { $compiler = "CC";  last CASE; };
-         $compiler = "???";
-         }
-      }
-   $compiler;
-   }
-
-#
-# &toLower(string); --- convert string into lower case
-#
-sub toLower {
-   local($string) = @_[0];
-   $string =~ tr/A-Z/a-z/;
-   $string;
-   }
-
-#
-# &uniq(sorted word list); --- remove adjacent duplicate words
-#
-sub uniq {
-   local(@words);
-   foreach $word (@_) {
-      if ($word ne $words[$#words]) {
-         push(@words, $word);
-         }
-      }
-   @words;
-   }
-
-#
-# &MakeDepends(language pattern, include file sed pattern); --- dependency
-#    maker
-#
-sub MakeDepends {
-   local(@incs);
-   local($lang) = @_[0];
-   local($pattern) = @_[1];
-   #
-   foreach $file (<${lang}>) {
-      open(FILE, $file) || warn "Cannot open $file: $!\n";
-      while (<FILE>) {
-         /$pattern/i && push(@incs, $1);
-         }
-      if (defined @incs) {
-         $file =~ s/\.[^.]+$/.o/;
-         @tab = split('/', $file);
-         $file = '$(MODEL_LIB)(' . $tab[$#tab] . ')' ;
-         print MAKEFILE "$file: ";
-         &PrintWords(length($file) + 2, 0, @incs);
-         print MAKEFILE "\n";
-         undef @incs;
-         }
-      }
-   }
-
-#
-# &MakeDependsf90(f90 compiler); --- FORTRAN 90 dependency maker
-#
-sub MakeDependsf90 {
-   local($compiler) = &toLower(@_[0]);
-   local(@dependencies);
-   local(%filename);
-   local(@incs);
-   local(@modules);
-   local($objfile);
-   #
-   # Associate each module with the name of the file that contains it
-   #
-   foreach $file (<../*/*/*.f90>) {
-      open(FILE, $file) || warn "Cannot open $file: $!\n";
-      while (<FILE>) {
-         /^\s*module\s+([^\s!]+)/i &&
-            ($filename{&toLower($1)} = $file) =~ s/\.f90$/.o/;
-         }
-      }
-   #
-   # Print the dependencies of each file that has one or more include's or
-   # references one or more modules
-   #
-   foreach $file (<../*/*/*.f90>) {
-      open(FILE, $file);
-      while (<FILE>) {
-         /^\s*include\s+["\']([^"\']+)["\']/i && push(@incs, $1);
-         /^\s*use\s+([^\s,!]+)/i && push(@modules, &toLower($1));
-         }
-      if (defined @incs || defined @modules) {
-         ($objfile = $file) =~ s/\.f90$/.o/;
-         @tab = split('/', $objfile);
-         $objfile = '$(MODEL_LIB)(' . $tab[$#tab] . ')' ;
-
-         print MAKEFILE "$objfile: ";
-         undef @dependencies;
-         foreach $module (@modules) {
-            push(@dependencies, $filename{$module});
-            }
-         @dependencies = &uniq(sort(@dependencies));
-
-         foreach $dependencies (@dependencies) {
-         @tab = split('/', $dependencies);
-         $dependencies = '$(MODEL_LIB)(' . $tab[$#tab] . ')';
-         }
-
-         &PrintWords(length($objfile) + 2, 0,
-                     @dependencies, &uniq(sort(@incs)));
-         print MAKEFILE "\n";
-         undef @incs;
-         undef @modules;
-         #
-         #
-         }
-      }
-   }
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/cml/flib_cml.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/cml/flib_cml.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/cml/flib_cml.f90	(revision 2528)
@@ -0,0 +1,7 @@
+module flib_cml
+  use m_stmw
+  use m_cmlw
+ 
+  public
+
+end module flib_cml
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/cml/m_cmlw.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/cml/m_cmlw.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/cml/m_cmlw.f90	(revision 2528)
@@ -0,0 +1,1846 @@
+module m_cmlw
+
+  use flib_wxml
+  use m_stmw
+
+  private
+
+  integer, private, parameter ::  sp = selected_real_kind(6,30)
+  integer, private, parameter ::  dp = selected_real_kind(14,100)
+
+
+! CMLUnits
+  character(len=40), parameter :: U_ANGSTR = 'units:angstrom'
+  character(len=40), parameter :: U_PMETER = 'units:pm'
+  character(len=40), parameter :: U_DEGREE = 'units:degree'
+  character(len=40), parameter :: U_RADIAN = 'units:radian'
+  character(len=40), parameter :: U_INVCM  = 'units:cm-1'
+  character(len=40), parameter :: U_KCALMO = 'units:kcal-mole'
+  character(len=40), parameter :: U_EVOLT  = 'units:ev'
+  character(len=40), parameter :: U_SECOND = 'units:second'
+  character(len=40), parameter :: U_VOLT   = 'units:volt'
+
+! CMLCore
+  PUBLIC :: cmlAddCoordinates
+  PUBLIC :: cmlAddCrystal
+  PUBLIC :: cmlAddAngle
+  PUBLIC :: cmlAddLength
+  PUBLIC :: cmlAddEigenvalue
+  PUBLIC :: cmlAddProperty
+  PUBLIC :: cmlAddPropertyList
+  PUBLIC :: cmlAddMolecule
+  PUBLIC :: cmlAddMetadata
+
+! CMLComp
+  PUBLIC :: cmlAddLattice
+  PUBLIC :: cmlAddLatticeVector
+  PUBLIC :: cmlAddParameter
+
+! CMLCore
+  INTERFACE cmlAddCoordinates
+     MODULE PROCEDURE cmlAddCoordinatesSP, cmlAddCoordinatesDP
+  END INTERFACE
+
+  INTERFACE cmlAddCrystal
+     MODULE PROCEDURE cmlAddCrystalSP, cmlAddCrystalDP
+  END INTERFACE
+
+  INTERFACE cmlAddAngle
+     MODULE PROCEDURE cmlAddAngleSP, cmlAddAngleDP
+  END INTERFACE
+
+  INTERFACE cmlAddLength
+     MODULE PROCEDURE cmlAddLengthSP, cmlAddLengthDP
+  END INTERFACE
+
+  INTERFACE cmlAddEigenvalue
+     MODULE PROCEDURE cmlAddEigenvalueSP, cmlAddEigenvalueDP
+  END INTERFACE
+
+  INTERFACE cmlAddMolecule
+     MODULE PROCEDURE cmlAddMoleculeSP, cmlAddMoleculeDP, cmlAddMolecule3SP, &
+                      cmlAddMolecule3DP
+  END INTERFACE
+
+! CMLComa
+  INTERFACE cmlAddLattice
+     MODULE PROCEDURE cmlAddLatticeSP, cmlAddLatticeDP
+  END INTERFACE
+
+  INTERFACE cmlAddLatticeVector
+     MODULE PROCEDURE cmlAddLatticeVectorSP, cmlAddLatticeVectorDP
+  END INTERFACE
+
+  INTERFACE cmlAddProperty
+     MODULE PROCEDURE &
+          cmlAddPropScalarDP, cmlAddPropScalarSP, cmlAddPropScalarI, & 
+          cmlAddPropMatrixDP, cmlAddPropMatrixSP, cmlAddPropMatrixI, &
+          cmlAddPropArrayDP,  cmlAddPropArraySP,  cmlAddPropArrayI
+  END INTERFACE
+
+  INTERFACE cmlAddParameter
+     MODULE PROCEDURE &
+        cmlAddParameterCH, cmlAddParameterI, &
+        cmlAddParameterSP, cmlAddParameterDP, &
+        cmlAddParameterLG
+  END INTERFACE
+
+
+CONTAINS
+
+  ! =================================================
+  ! convenience CML routines
+  ! =================================================
+  
+  ! -------------------------------------------------
+  ! writes a propertyList start Tag to xml channel
+  ! -------------------------------------------------
+  
+  SUBROUTINE cmlAddPropertyList(xf, id, title, conv, dictref, ref, role)
+
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*), intent(in), optional :: id
+    character(len=*), intent(in), optional :: title
+    character(len=*), intent(in), optional :: conv
+    character(len=*), intent(in), optional :: dictref
+    character(len=*), intent(in), optional :: ref
+    character(len=*), intent(in), optional :: role
+    
+    call xml_NewElement(xf, 'propertyList')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+    if (present(role)) call xml_AddAttribute(xf, 'role', role)
+    
+  END SUBROUTINE cmlAddPropertyList
+  
+  
+  ! -------------------------------------------------
+  ! 1. writes a DP property to xml channel
+  ! -------------------------------------------------
+  
+  SUBROUTINE cmlAddPropScalarDP(xf, property, id, title, conv, dictref, ref, units, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp), intent(in)               :: property
+    character(len=*), intent(in), optional :: id
+    character(len=*), intent(in), optional :: title
+    character(len=*), intent(in), optional :: dictref
+    character(len=*), intent(in), optional :: conv
+    character(len=*), intent(in), optional :: ref
+    character(len=*), intent(in), optional :: fmt
+    character(len=*), intent(in), optional :: units
+
+    call xml_NewElement(xf, 'property')
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(title))   call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(conv))    call xml_AddAttribute(xf, 'convention', conv)
+    if (present(ref))    call xml_AddAttribute(xf, 'ref', ref)
+    call stmAddScalar(xf=xf, value=property, units=units, fmt=fmt)
+    call xml_EndElement(xf, 'property')
+
+  END SUBROUTINE cmlAddPropScalarDP
+
+  ! -------------------------------------------------
+  ! 2. writes a Scalar SP property to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddPropScalarSP(xf, property, id, title, conv, dictref, ref, units, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp), intent(in) :: property
+    character(len=*), intent(in), optional :: id
+    character(len=*), intent(in), optional :: title
+    character(len=*), intent(in), optional :: dictref
+    character(len=*), intent(in), optional :: conv
+    character(len=*), intent(in), optional :: ref
+    character(len=*), intent(in), optional :: fmt
+    character(len=*), intent(in), optional :: units
+
+    call xml_NewElement(xf, 'property')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+    call stmAddScalar(xf=xf, value=property, units=units, fmt=fmt)
+    call xml_EndElement(xf, 'property')
+  END SUBROUTINE cmlAddPropScalarSP
+  
+  ! -------------------------------------------------
+  ! 3. writes a Scalar integer property to xml channel
+  ! -------------------------------------------------
+  
+  SUBROUTINE cmlAddPropScalarI(xf, property, id, title, conv, dictref, ref, units)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in) :: property
+    character(len=*), intent(in), optional :: id
+    character(len=*), intent(in), optional :: title
+    character(len=*), intent(in), optional :: dictref
+    character(len=*), intent(in), optional :: conv
+    character(len=*), intent(in), optional :: ref
+    character(len=*), intent(in), optional :: units
+
+    call xml_NewElement(xf, 'property')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+    call stmAddScalar(xf=xf, value=property, units=units)
+    call xml_EndElement(xf, 'property')
+  END SUBROUTINE cmlAddPropScalarI
+
+  ! -------------------------------------------------
+  ! 4. writes an Float matrix property to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddPropMatrixDP(xf, property, nrows, ncols, dim, id, title, conv, dictref, ref, units, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)      :: nrows
+    integer, intent(in)      :: ncols
+    integer, intent(in)      :: dim
+    real(kind=dp), intent(in) :: property(nrows,ncols)
+    character(len=*), intent(in), optional :: id
+    character(len=*), intent(in), optional :: title
+    character(len=*), intent(in), optional :: dictref
+    character(len=*), intent(in), optional :: conv
+    character(len=*), intent(in), optional :: ref
+    character(len=*), intent(in), optional :: fmt
+    character(len=*), intent(in), optional :: units
+
+    call xml_NewElement(xf, 'property')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+    call stmAddMatrix(xf=xf, matrix=property, dim=dim, ncols=ncols, nrows=nrows, units=units, fmt=fmt)
+    call xml_EndElement(xf, 'property')
+  END SUBROUTINE cmlAddPropMatrixDP
+
+  ! -------------------------------------------------
+  ! 5. writes an SP Float matrix property to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddPropMatrixSP(xf, property, nrows, ncols, dim, id, title, conv, dictref, ref, units, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)      :: nrows
+    integer, intent(in)      :: ncols
+    integer, intent(in)      :: dim
+    real(kind=sp), intent(in) :: property(nrows,ncols)
+    character(len=*), intent(in), optional :: id
+    character(len=*), intent(in), optional :: title
+    character(len=*), intent(in), optional :: dictref
+    character(len=*), intent(in), optional :: conv
+    character(len=*), intent(in), optional :: ref
+    character(len=*), intent(in), optional :: fmt
+    character(len=*), intent(in), optional :: units
+
+    call xml_NewElement(xf, 'property')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+    call stmAddMatrix(xf=xf,matrix=property, dim=dim, ncols=ncols, nrows=nrows, units=units, fmt=fmt)
+    call xml_EndElement(xf, 'property')
+  END SUBROUTINE cmlAddPropMatrixSP
+
+
+  ! -------------------------------------------------
+  ! 6. writes an Integer matrix property to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddPropMatrixI(xf, property, nrows, ncols, dim, id, title, conv, dictref, ref, units, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+
+    integer, intent(in)                    :: nrows
+    integer, intent(in)                    :: ncols
+    integer, intent(in), optional          :: dim
+    integer, intent(in)                    :: property(nrows,ncols)
+    character(len=*), intent(in), optional :: id
+    character(len=*), intent(in), optional :: title
+    character(len=*), intent(in), optional :: dictref
+    character(len=*), intent(in), optional :: conv
+    character(len=*), intent(in), optional :: ref
+    character(len=*), intent(in), optional :: fmt
+    character(len=*), intent(in), optional :: units
+
+    call xml_NewElement(xf, 'property')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(conv)) call xml_AddAttribute(xf, 'ref', ref)
+    call stmAddMatrix(xf=xf, matrix=property, dim=dim, ncols=ncols, nrows=nrows, units=units)
+    call xml_EndElement(xf, 'property')
+  END SUBROUTINE cmlAddPropMatrixI
+
+
+  ! -------------------------------------------------
+  ! 7. writes an Array DP property to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddPropArrayDP(xf, property, nvalue, id, title, conv, dictref, ref, units, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp), intent(in)               :: property(*)
+    integer, intent(in)                    :: nvalue
+    character(len=*), intent(in), optional :: id
+    character(len=*), intent(in), optional :: title
+    character(len=*), intent(in), optional :: dictref
+    character(len=*), intent(in), optional :: conv
+    character(len=*), intent(in), optional :: ref
+    character(len=*), intent(in), optional :: fmt
+    character(len=*), intent(in), optional :: units
+
+    call xml_NewElement(xf, 'property')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+    call stmAddArray(xf=xf, array=property, nvalue=nvalue, units=units, fmt=fmt)
+    call xml_EndElement(xf, 'property')
+  END SUBROUTINE cmlAddPropArrayDP
+
+  ! -------------------------------------------------
+  ! 8. writes an Array SP property to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddPropArraySP(xf, property, nvalue, id, title, conv, dictref, ref, units, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp), intent(in)               :: property(*)
+    integer, intent(in)                    :: nvalue
+    character(len=*), intent(in), optional :: id
+    character(len=*), intent(in), optional :: title
+    character(len=*), intent(in), optional :: dictref
+    character(len=*), intent(in), optional :: conv
+    character(len=*), intent(in), optional :: ref
+    character(len=*), intent(in), optional :: fmt
+    character(len=*), intent(in), optional :: units
+
+    call xml_NewElement(xf, 'property')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+    call stmAddArray(xf=xf, array=property, nvalue=nvalue, units=units, fmt=fmt)
+    call xml_EndElement(xf, 'property')
+  END SUBROUTINE cmlAddPropArraySP
+
+  ! -------------------------------------------------
+  ! 9. writes an Array integer property to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddPropArrayI(xf, property, nvalue, id, title, conv, dictref, ref, units)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: property(*)
+    integer, intent(in)                    :: nvalue
+    character(len=*), intent(in), optional :: id
+    character(len=*), intent(in), optional :: title
+    character(len=*), intent(in), optional :: dictref
+    character(len=*), intent(in), optional :: conv
+    character(len=*), intent(in), optional :: ref
+    character(len=*), intent(in), optional :: units
+
+    call xml_NewElement(xf, 'property')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+    call stmAddArray(xf, array=property, nvalue=nvalue, units=units)
+    call xml_EndElement(xf, 'property')
+  END SUBROUTINE cmlAddPropArrayI
+
+  !------------------------------------------------------------
+  ! END OF PROPERTIES 
+  !------------------------------------------------------------
+
+
+  ! -------------------------------------------------
+  ! 1. writes complete DP molecule to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddMoleculeDP(xf, natoms, elements, coords, style, id, title, dictref, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: natoms             ! number of atoms
+    real(kind=dp), intent(in)               :: coords(3, natoms)  ! atomic coordinates
+    character(len=*), intent(in)           :: elements(natoms)   ! chemical element types
+    character(len=*), intent(in), optional :: id                 ! id
+    character(len=*), intent(in), optional :: title              ! the title
+    character(len=*), intent(in), optional :: dictref            ! the dictionary reference
+    character(len=*), intent(in), optional :: fmt                ! format for coords
+    character(len=*), intent(in), optional :: style              ! type of coordinates 
+
+    ! 'x3' for Cartesians, 
+    ! 'xFrac' for fractionals
+    ! default => cartesians
+
+    ! Internal Variables
+    character(len=6) :: id1, id0
+    character(len=10):: formt, stylei
+    integer          :: i
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+    if (present(style)) then
+       stylei = style
+    else
+       stylei = 'x3'
+    endif
+
+    call stmAddStartTag(xf, 'molecule', id, title, dictref)
+    call xml_NewElement(xf, 'atomArray')
+    do i = 1, natoms
+       write(id0, '(i4)') i
+       id0 = adjustl(id0)
+       id1 = 'a'
+       id1(2:) = id0
+       call cmlAddAtom(xf=xf, elem=elements(i), id=id1)
+       if (stylei .eq. 'x3') then
+          call CMLATX39DP(xf, coords(1, i), coords(2, i), coords(3, i), formt)
+       elseif (stylei .eq. 'xFrac') then
+          call CMLATXF9DP(xf, coords(1, i), coords(2, i), coords(3, i), formt)
+       elseif (stylei .eq. 'xyz3') then
+          call CMLATXYZ39DP(xf, coords(1, i), coords (2, i), coords(3, i), formt)
+       elseif (stylei .eq. 'xyzFrac') then
+          call CMLATXYZFRACT9DP(xf, coords(1, i), coords(2, i), coords(3, i), formt)
+       endif
+       call xml_EndElement(xf, 'atom')
+    enddo
+
+    call xml_EndElement(xf, 'atomArray')
+    call xml_EndElement(xf, 'molecule')
+    
+  END SUBROUTINE cmlAddMoleculeDP
+
+  
+  ! -------------------------------------------------
+  ! 2. writes complete SP molecule to xml channel
+  ! -------------------------------------------------
+  
+  SUBROUTINE cmlAddMoleculeSP(xf, natoms, elements, coords, style, id, title, dictref, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: natoms          ! number of atoms
+    character(len=*), intent(in)           :: elements(*)     ! chemical element types
+    real(kind=sp), intent(in)               :: coords(3, *)    ! atomic coordinates
+    character(len=*), intent(in), optional :: id              ! id
+    character(len=*), intent(in), optional :: title           ! the title
+    character(len=*), intent(in), optional :: dictref         ! the dictionary reference
+    character(len=*), intent(in), optional :: fmt             ! format for coords
+    character(len=*), intent(in), optional :: style           ! type of coordinates ('x3'for Cartesians, 'xFrac' 
+    ! for fractionals; ' ' = default => cartesians)
+    ! Flush on entry and exit
+    character(len=6) :: id1, id0
+    integer          :: i
+    character(len=10):: formt, stylei
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+    if (present(style)) then
+       stylei = style
+    else
+       stylei = 'x3'
+    endif
+
+    call stmAddStartTag(xf, 'molecule', id, title, dictref)
+    call xml_NewElement(xf, 'atomArray')
+    do i = 1, natoms
+       write(id0, '(i4)') i
+       id0 = adjustl(id0)
+       id1 = 'a'
+       id1(2:) = id0
+       call cmlAddAtom(xf=xf, elem=elements(i), id=id1)
+       if (stylei .eq. 'x3') then
+          call CMLATX39SP(xf, coords(1, i), coords(2, i), coords(3, i), formt)
+       elseif (stylei .eq. 'xFrac') then
+          call CMLATXF9SP(xf, coords(1, i), coords(2, i), coords(3, i), formt)
+       elseif (stylei .eq. 'xyz3') then
+          call CMLATXYZ39SP(xf, coords(1, i), coords(2, i), coords(3, i), formt)
+       elseif (stylei .eq. 'xyzFrac') then
+          call CMLATXYZFRACT9SP(xf, coords(1, i), coords(2, i), coords(3, i), formt)
+       endif
+       call xml_EndElement(xf, 'atom')
+    enddo
+
+    call xml_EndElement(xf, 'atomArray')
+    call xml_EndElement(xf, 'molecule')
+    
+    
+  END SUBROUTINE cmlAddMoleculeSP
+  
+  
+  ! -------------------------------------------------
+  ! 1. writes complete DP molecule to xml channel (No. 2)
+  ! -------------------------------------------------
+  
+  SUBROUTINE cmlAddMolecule3DP(xf, natoms, elements, x, y, z, style, id, title, dictref, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: natoms          ! number of atoms
+    real(kind=dp), intent(in)               :: x(*)
+    real(kind=dp), intent(in)               :: y(*)
+    real(kind=dp), intent(in)               :: z(*)
+    character(len=*), intent(in)           :: elements(*)     ! chemical element types
+    character(len=*), intent(in), optional :: id              ! id
+    character(len=*), intent(in), optional :: title           ! the title
+    character(len=*), intent(in), optional :: dictref         ! the dictionary reference
+    character(len=*), intent(in), optional :: fmt             ! format for coords
+    character(len=*), intent(in), optional :: style           ! type of coordinates ('x3'for Cartesians, 'xFrac' 
+    ! for fractionals; ' ' = default => cartesians)
+    character(len=6)  :: id1, id0
+    integer           :: i, l
+    character(len=10) :: formt, stylei
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+    if (present(style)) then
+       stylei = trim(style)
+    else
+       stylei = 'x3'
+    endif
+
+    call stmAddStartTag(xf=xf, name='molecule', id=id, title=title, dictref=dictref)
+    call xml_NewElement(xf, 'atomArray')
+
+    do i = 1, natoms
+       write(id0, '(i4)') i
+       id0 = adjustl(id0)
+       id1 = 'a'
+       id1(2:) = id0
+       call cmlAddAtom(xf=xf, elem=elements(i), id=id1)
+       if (trim(stylei) .eq. 'x3') then
+          call CMLATX39DP(xf, x(i), y(i), z(i), formt)
+       elseif (stylei .eq. 'xFrac') then
+          call CMLATXF9DP(xf, x(i), y(i), z(i), formt)
+       elseif (stylei .eq. 'xyz3') then
+          call CMLATXYZ39DP(xf, x(i), y(i), z(i), formt)
+       elseif (stylei .eq. 'xyzFrac') then
+          call CMLATXYZFRACT9DP(xf, x(i), y(i), z(i), formt)
+       endif
+       call xml_EndElement(xf, 'atom')
+    enddo
+
+    call xml_EndElement(xf, 'atomArray')
+    call xml_EndElement(xf, 'molecule')
+    
+  END SUBROUTINE cmlAddMolecule3DP
+  
+  
+  ! -------------------------------------------------
+  ! 2. writes complete SP molecule to xml channel (No. 2)
+  ! -------------------------------------------------
+  
+  SUBROUTINE cmlAddMolecule3SP(xf, natoms, elements, x, y, z, style, id, title, dictref, fmt)
+
+
+    implicit none
+    type(xmlf_t) :: xf
+    ! 10 Arguments
+    integer, intent(in)                    :: natoms          ! number of atoms
+    real(kind=sp), intent(in)               :: x(*)
+    real(kind=sp), intent(in)               :: y(*)
+    real(kind=sp), intent(in)               :: z(*)
+    character(len=*), intent(in)           :: elements(*)      ! chemical element types
+    character(len=*), intent(in), optional :: id               ! id
+    character(len=*), intent(in), optional :: title            ! the title
+    character(len=*), intent(in), optional :: dictref          ! the dictionary reference
+    character(len=*), intent(in), optional :: fmt              ! format for coords
+    character(len=*), intent(in), optional :: style            ! type of coordinates ('x3' for Cartesians, 'xFrac' 
+    ! for fractionals; ' ' = default => cartesians)
+    ! Internal variables
+    character(len=6)  :: id1, id0
+    integer           :: i, l
+    character(len=10) :: formt, stylei
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+    if (present(style)) then
+       stylei = style
+    else
+       stylei = 'x3'
+    endif
+
+    call xml_NewElement(xf, 'molecule')
+    call xml_AddAttribute(xf, 'id', id)
+    call xml_AddAttribute(xf, 'title', title)
+    call xml_AddAttribute(xf, 'dictref', dictref)
+    call xml_NewElement(xf, 'atomArray')
+    do i = 1, natoms
+       write(id0, '(i4)') i
+       id0 = adjustl(id0)
+       id1 = 'a'
+       id1(2:) = id0
+       call cmlAddAtom(xf=xf, elem=elements(i), id=id1)
+       if (stylei .eq. 'x3') then
+          call CMLATX39SP(xf, x(i), y(i), z(i), formt)
+       else if (stylei .eq. 'xFrac') then
+          call CMLATXF9SP(xf, x(i), y(i), z(i), formt)
+       else if (stylei .eq. 'xyz3') then
+          call CMLATXYZ39SP(xf, x(i), y(i), z(i), formt)
+       else if (stylei .eq. 'xyzFrac') then
+          call CMLATXYZFRACT9SP(xf, x(i), y(i), z(i), formt)
+       endif
+           call xml_EndElement(xf, 'atom')
+    enddo
+
+    call xml_EndElement(xf, 'atomArray')
+    call xml_EndElement(xf, 'molecule')
+
+  END SUBROUTINE cmlAddMolecule3SP
+  
+  ! -------------------------------------------------
+  ! writes an <atom> start tag
+  ! -------------------------------------------------
+  
+  SUBROUTINE cmlAddAtom(xf, elem, id, charge, hCount, occupancy, fmt)
+
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in), optional           :: charge     ! formalCharge
+    integer, intent(in), optional           :: hCount     ! hydrogenCount
+    real(kind=sp), intent(in), optional      :: occupancy  ! hydrogenCount
+    character(len=*), intent(in), optional  :: elem       ! chemical element name
+    character(len=*), intent(in), optional  :: id         ! atom id
+    character(len=*), intent(in), optional  :: fmt        ! format
+
+    ! internal Variable
+    character(len=10):: formt
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    call xml_NewElement(xf, 'atom')
+    if (present(elem))      call xml_AddAttribute(xf, 'elementType', elem)
+    if (present(id))        call xml_AddAttribute(xf, 'id', id)
+    if (present(charge))    call xml_AddAttribute(xf, 'formalCharge', str(charge))
+    if (present(hCount))    call xml_AddAttribute(xf, 'hydrogenCount', str(hCount))
+    if (present(occupancy)) call xml_AddAttribute(xf, 'occupancy', str(occupancy,formt))
+
+  END SUBROUTINE cmlAddAtom
+  
+  
+  ! -------------------------------------------------
+  ! 1. append SP coordinates to atom tag
+  ! -------------------------------------------------
+  
+  SUBROUTINE cmlAddCoordinatesSP(xf, x, y, z, style, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp), intent(in)               :: x, y
+    real(kind=sp), intent(in), optional     :: z
+    character(len=*), intent(in), optional :: style
+    character(len=*), intent(in), optional :: fmt
+
+    ! Internal variable
+    character(len=10):: formt
+    character(len=10):: stylei
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+    if (present(style)) then
+       stylei = style
+    else
+       stylei = 'x3'
+    endif
+
+    if (present(z) .and. stylei .eq. 'x3') then
+       call CMLATX39SP(xf, x, y, z, formt)
+    else if (present(z) .and. stylei .eq. 'xFrac') then
+       call CMLATXF9SP(xf, x, y, z, formt)
+    else if (present(z) .and. stylei .eq. 'xyz3') then
+       call CMLATXYZ39SP(xf, x, y, z, formt)
+    else if (present(z) .and. stylei .eq. 'xyzFrac') then
+       call CMLATXYZFRACT9SP(xf, x, y, z, formt)
+    elseif (.not. present(z) .and. stylei .eq. 'xy2') then
+       call CMLATXY9SP(xf, x, y, formt)           
+    endif
+
+  END SUBROUTINE cmlAddCoordinatesSP
+
+  ! -------------------------------------------------
+  ! 2. append DP coordinates to atom tag
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddCoordinatesDP(xf, x, y, z, style, fmt)
+    implicit none
+    type(xmlf_t) :: xf 
+    real(kind=dp), intent(in)               :: x, y
+    real(kind=dp), intent(in), optional     :: z
+    character(len=*), intent(in), optional :: style
+    character(len=*), intent(in), optional :: fmt
+    
+    ! Internal variable
+    character(len=10):: formt
+    character(len=10):: stylei
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+    if (present(style)) then
+       stylei = style
+    else
+       stylei = 'x3'
+    endif
+    
+    if (present(z) .and. stylei .eq. 'x3') then
+       call CMLATX39DP(xf, x, y, z, formt)
+    else if (present(z) .and. stylei .eq. 'xFrac') then
+       call CMLATXF9DP(xf, x, y, z, formt)
+    else if (present(z) .and. stylei .eq. 'xyz3') then
+       call CMLATXYZ39DP(xf, x, y, z, formt)
+    else if (present(z) .and. stylei .eq. 'xyzFrac') then
+       call CMLATXYZFRACT9DP(xf, x, y, z, formt)
+    else if (.not. present(z) .and. stylei .eq. 'xy2') then
+       call CMLATXY9DP(xf, x, y, formt)           
+    endif
+    
+  END SUBROUTINE cmlAddCoordinatesDP
+
+  
+  ! -------------------------------------------------
+  ! 1. writes a DP <length> element to output channel
+  ! -------------------------------------------------
+  
+  SUBROUTINE cmlAddLengthDP(xf, length, id, atomRef1, atomRef2, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp), intent(in)     :: length     ! length
+    character(len=*), intent(in) :: id         ! length id
+    character(len=*), intent(in) :: atomRef1   ! ref to first atom
+    character(len=*), intent(in) :: atomRef2   ! ref to second atom
+    character(len=*), intent(in) :: fmt        ! format
+
+    optional         :: fmt
+    character(len=10):: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    ! Flush on entry and exit
+    call CMLLEN9DP(xf, id, atomRef1, atomRef2, length, formt)
+  END SUBROUTINE cmlAddLengthDP
+
+  ! -------------------------------------------------
+  ! 2. writes a SP <length> element to output channel
+  ! -------------------------------------------------
+  
+  SUBROUTINE cmlAddLengthSP(xf, length, id, atomRef1, atomRef2, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp), intent(in)     :: length     ! the length
+    character(len=*), intent(in) :: id         ! length id
+    character(len=*), intent(in) :: atomRef1   ! ref to first atom
+    character(len=*), intent(in) :: atomRef2   ! ref to second atom
+    character(len=*), intent(in) :: fmt        ! format
+
+    optional         :: fmt
+    character(len=10):: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    ! Flush on entry and exit
+    call CMLLEN9SP(xf, id, atomRef1, atomRef2, length, formt)
+  END SUBROUTINE cmlAddLengthSP
+
+
+  ! -------------------------------------------------
+  ! 1. writes an DP <angle> element to output channel
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddAngleDP(xf, angle, id, atomRef1, atomRef2, atomRef3, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp), intent(in)     :: angle        ! the angle
+    character(len=*), intent(in) :: id           ! angle id
+    character(len=*), intent(in) :: atomRef1     ! ref to first atom
+    character(len=*), intent(in) :: atomRef2     ! ref to second atom
+    character(len=*), intent(in) :: atomRef3     ! ref to third atom
+    character(len=*), intent(in) :: fmt          ! format
+
+    optional         :: fmt
+    character(len=10):: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    ! Flush on entry and exit
+    call CMLANG9DP(xf, id, atomRef1, atomRef2, atomRef3, angle, formt)
+  END SUBROUTINE cmlAddAngleDP
+
+  ! -------------------------------------------------
+  ! 2. writes an SP <angle> element to output channel
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddAngleSP(xf, angle, id, atomRef1, atomRef2, atomRef3, fmt)
+
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp), intent(in)     :: angle        ! the angle
+    character(len=*), intent(in) :: id           ! angle id
+    character(len=*), intent(in) :: atomRef1     ! ref to first atom
+    character(len=*), intent(in) :: atomRef2     ! ref to second atom
+    character(len=*), intent(in) :: atomRef3     ! ref to third atom
+    character(len=*), intent(in) :: fmt          ! format
+
+    optional         :: fmt
+    character(len=10):: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    ! Flush on entry and exit
+    call CMLANG9SP(xf, id, atomRef1, atomRef2, atomRef3, angle, formt)
+  END SUBROUTINE cmlAddAngleSP
+
+
+  ! -------------------------------------------------
+  ! 1. creates and writes a DP <torsion> element
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddTorsionDP(xf, torsion, id, atomRef1, atomRef2, atomRef3, atomRef4, fmt)
+
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp), intent(in)     :: torsion         ! the torsion
+    character(len=*), intent(in) :: id              ! torsion id
+    character(len=*), intent(in) :: atomRef1        ! ref to first atom
+    character(len=*), intent(in) :: atomRef2        ! ref to second atom
+    character(len=*), intent(in) :: atomRef3        ! ref to third atom
+    character(len=*), intent(in) :: atomRef4        ! ref to fourth atom
+    character(len=*), intent(in) :: fmt             ! format
+
+    optional         :: fmt
+    character(len=10):: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    ! Flush on entry and exit
+    call CMLTOR9DP(xf, id, atomRef1, atomRef2, atomRef3, atomRef4, torsion, formt)
+  END SUBROUTINE cmlAddTorsionDP
+  
+  ! -------------------------------------------------
+  ! 2. creates and writes a SP <torsion> element
+  ! -------------------------------------------------
+  
+  SUBROUTINE cmlAddTorsionSP(xf, torsion, id, atomRef1, atomRef2, atomRef3, atomRef4, fmt)
+
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp), intent(in)     :: torsion         ! the torsion
+    character(len=*), intent(in) :: id              ! torsion id
+    character(len=*), intent(in) :: atomRef1        ! ref to first atom
+    character(len=*), intent(in) :: atomRef2        ! ref to second atom
+    character(len=*), intent(in) :: atomRef3        ! ref to third atom
+    character(len=*), intent(in) :: atomRef4        ! ref to fourth atom
+    character(len=*), intent(in) :: fmt             ! format
+
+    optional         :: fmt
+    character(len=10):: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    ! Flush on entry and exit
+    call CMLTOR9SP(xf, id, atomRef1, atomRef2, atomRef3, atomRef4, torsion, formt)
+  END SUBROUTINE cmlAddTorsionSP
+
+
+  ! -------------------------------------------------
+  ! 1. creates and writes an SP Lattice element
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddLatticeSP(xf, cell, units, title, id, dictref, conv, lattType, spaceType, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp), intent(in)               :: cell(3,3)
+    character(len=*), intent(in), optional :: units       
+    character(len=*), intent(in), optional :: id           ! id
+    character(len=*), intent(in), optional :: title        ! title
+    character(len=*), intent(in), optional :: dictref      ! dictref
+    character(len=*), intent(in), optional :: conv         ! format
+    character(len=*), intent(in), optional :: lattType     ! 
+    character(len=*), intent(in), optional :: spaceType    !
+    character(len=*), intent(in), optional :: fmt         
+
+    ! Internal Variables
+    integer           :: i
+    character(len=10) :: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'   
+    endif
+
+    call xml_NewElement(xf, 'lattice')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(lattType)) call xml_AddAttribute(xf, 'latticeType', lattType)
+    if (present(spaceType)) call xml_AddAttribute(xf, 'spaceType', spaceType)
+
+    do i = 1,3
+       call xml_NewElement(xf, 'latticeVector')
+       if (present(units)) call xml_AddAttribute(xf, 'units', units)
+       call xml_AddAttribute(xf, 'dictRef', 'cml:latticeVector')
+       call xml_AddPcdata(xf, str(cell(1,i), formt))
+       call xml_AddPcdata(xf, str(cell(2,i), formt))
+       call xml_AddPcdata(xf, str(cell(3,i), formt))
+    call xml_EndElement(xf, 'latticeVector')
+    enddo
+    call xml_EndElement(xf, 'lattice')
+
+  END SUBROUTINE cmlAddLatticeSP
+
+
+  ! -------------------------------------------------
+  ! 2. creates and writes DP Lattice element
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddLatticeDP(xf, cell, units, title, id, dictref, conv, lattType, spaceType, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp), intent(in)               :: cell(3,3)
+    character(len=*), intent(in), optional :: units       
+    character(len=*), intent(in), optional :: id           ! id
+    character(len=*), intent(in), optional :: title        ! title
+    character(len=*), intent(in), optional :: dictref      ! dictref
+    character(len=*), intent(in), optional :: conv         ! format
+    character(len=*), intent(in), optional :: lattType     ! 
+    character(len=*), intent(in), optional :: spaceType    !
+    character(len=*), intent(in), optional :: fmt         
+
+    ! Internal Variables
+    integer           :: i
+    character(len=10) :: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'   
+    endif
+
+    call xml_NewElement(xf, 'lattice')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(lattType)) call xml_AddAttribute(xf, 'latticeType', lattType)
+    if (present(spaceType)) call xml_AddAttribute(xf, 'spaceType', spaceType)
+
+    do i = 1,3
+       call xml_NewElement(xf, 'latticeVector')
+       if (present(units)) call xml_AddAttribute(xf, 'units', units)
+       call xml_AddAttribute(xf, 'dictRef', 'cml:latticeVector')
+       call xml_AddPcdata(xf, str(cell(1,i), formt))
+       call xml_AddPcdata(xf, str(cell(2,i), formt))
+       call xml_AddPcdata(xf, str(cell(3,i), formt))
+       call xml_EndElement(xf, 'latticeVector')
+    enddo
+    
+    call xml_EndElement(xf, 'lattice')
+
+  END SUBROUTINE cmlAddLatticeDP
+
+
+  ! -------------------------------------------------
+  ! 1. creates a DP Lattice Vector element
+  ! -------------------------------------------------
+  
+  SUBROUTINE cmlAddLatticeVectorDP(xf, vector, title, id, dictref, conv, units, periodic, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp), intent(in) :: vector(3)
+    character(len=*), intent(in), optional :: title        
+    character(len=*), intent(in), optional :: id           
+    character(len=*), intent(in), optional :: dictref     
+    character(len=*), intent(in), optional :: conv        
+    character(len=*), intent(in), optional :: units       
+    character(len=*), intent(in), optional :: periodic    
+    character(len=*), intent(in), optional :: fmt         
+
+    ! Deal with optional things
+    ! that have defaults
+    character(len=10) :: formt
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'   
+    endif
+
+    call xml_NewElement(xf, 'latticeVector')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(units)) call xml_AddAttribute(xf, 'units', units)
+    if (present(periodic)) call xml_AddAttribute(xf, 'periodic', periodic)
+    call xml_AddPcdata(xf, str(vector(1), formt))
+    call xml_AddPcdata(xf, str(vector(2), formt))
+    call xml_AddPcdata(xf, str(vector(3), formt))
+    call xml_EndElement(xf, 'latticeVector')
+
+  END SUBROUTINE cmlAddLatticeVectorDP
+
+
+  ! -------------------------------------------------
+  ! 2. creates a SP Lattice Vector element
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddLatticeVectorSP(xf, vector, title, id, dictref, conv, units, periodic, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp), intent(in) :: vector(3)
+    character(len=*), intent(in), optional :: title        
+    character(len=*), intent(in), optional :: id           
+    character(len=*), intent(in), optional :: dictref     
+    character(len=*), intent(in), optional :: conv        
+    character(len=*), intent(in), optional :: units       ! should this be optional
+    character(len=*), intent(in), optional :: periodic    
+    character(len=*), intent(in), optional :: fmt         
+
+    ! Deal with optional things
+    ! that have defaults
+    character(len=10) :: formt
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'   
+    endif
+
+    call xml_NewElement(xf, 'latticeVector')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(units)) call xml_AddAttribute(xf, 'units', units)
+    if (present(units)) call xml_AddAttribute(xf, 'periodic', periodic)
+    call xml_AddPcdata(xf, str(vector(1), formt))
+    call xml_AddPcdata(xf, str(vector(2), formt))
+    call xml_AddPcdata(xf, str(vector(3), formt))
+    call xml_EndElement(xf, 'latticeVector')
+
+  END SUBROUTINE cmlAddLatticeVectorSP
+
+  ! -------------------------------------------------
+  ! 1. creates and writes a DP <cell> element
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddCrystalDP(xf, a, b, c, alpha, beta, gamma, id, title, dictref, lenunits, angunits, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp), intent(in)               :: a, b, c      ! cell parameters
+    real(kind=dp), intent(in)               :: alpha        ! alpha cell parameter
+    real(kind=dp), intent(in)               :: beta         ! beta cell parameter
+    real(kind=dp), intent(in)               :: gamma        ! gamma cell parameter
+    character(len=*), intent(in), optional :: id           ! id
+    character(len=*), intent(in), optional :: title        ! title
+    character(len=*), intent(in), optional :: dictref      ! dictref
+    character(len=*), intent(in), optional :: lenunits     ! units for length (default = angstrom)
+    character(len=*), intent(in), optional :: angunits     ! units for angles (default = degree)
+    character(len=*), intent(in), optional :: fmt          ! format
+
+    ! Flush on entry and exit
+    character(len=30) ::  lunits, aunits
+    character(len=10) :: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+    if (present(lenunits)) then
+       lunits = lenunits
+    else
+       lunits = 'units:angstrom'
+    endif
+    if (present(angunits)) then
+       aunits = angunits
+    else
+       aunits = 'units:degree'
+    endif
+
+    call stmAddStartTag(xf=xf, name='crystal', id=id, title=title, dictref=dictref)
+    call stmAddScalar(xf=xf, value=a, title='a', dictref='cml:a', units=lunits, fmt=formt)
+    call stmAddScalar(xf=xf, value=b, title='b', dictref='cml:b', units=lunits, fmt=formt)
+    call stmAddScalar(xf=xf, value=c, title='c', dictref='cml:c', units=lunits, fmt=formt)
+    call stmAddScalar(xf=xf, value=alpha, title='alpha', dictref='cml:alpha', units=aunits, fmt=formt)
+    call stmAddScalar(xf=xf, value=beta,  title='beta',  dictref='cml:beta',  units=aunits, fmt=formt)
+    call stmAddScalar(xf=xf, value=gamma, title='gamma', dictref='cml:gamma', units=aunits, fmt=formt)
+    call xml_EndElement(xf, 'crystal')
+
+  END SUBROUTINE cmlAddCrystalDP
+
+  ! -------------------------------------------------
+  ! 2. creates and writes a SP <cell> element
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddCrystalSP(xf, a, b, c, alpha, beta, gamma, id, title, dictref, lenunits, angunits, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp), intent(in)     :: a, b, c      ! cell parameters
+    real(kind=sp), intent(in)     :: alpha        ! alpha cell parameter
+    real(kind=sp), intent(in)     :: beta         ! beta cell parameter
+    real(kind=sp), intent(in)     :: gamma        ! gamma cell parameter
+    character(len=*), intent(in), optional :: id           ! id
+    character(len=*), intent(in), optional :: title        ! title
+    character(len=*), intent(in), optional :: dictref      ! dictref
+    character(len=*), intent(in), optional :: lenunits     ! units for length (' ' = angstrom)
+    character(len=*), intent(in), optional :: angunits     ! units for angles (' ' = degree)
+    character(len=*), intent(in), optional :: fmt          ! format
+
+    ! Flush on entry and exit
+    character(len=30) :: lunits, aunits
+    character(len=10) :: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+    if (present(lenunits)) then
+       lunits = lenunits
+    else
+       lunits = U_ANGSTR
+    endif
+    if (present(angunits)) then
+       aunits = angunits
+    else
+       aunits = U_DEGREE
+    endif
+
+    call stmAddStartTag(xf, 'crystal', id, title, dictref)
+    call stmAddScalar(xf, a, ' ', 'a', 'cml:a', lunits, formt)
+    call stmAddScalar(xf, b, ' ', 'b', 'cml:b', lunits, formt)
+    call stmAddScalar(xf, c, ' ', 'c', 'cml:c', lunits, formt)
+    call stmAddScalar(xf, alpha, ' ', 'alpha', 'cml:alpha', aunits, formt)
+    call stmAddScalar(xf, beta, ' ', 'beta', 'cml:beta', aunits, formt)
+    call stmAddScalar(xf, gamma, ' ', 'gamma', 'cml:gamma', aunits, formt)
+    call xml_EndElement(xf, 'crystal')
+
+  END SUBROUTINE cmlAddCrystalSP
+  
+  
+  ! -------------------------------------------------
+  ! 1. creates and writes an DP <eigen> element
+  ! -------------------------------------------------
+  
+  SUBROUTINE cmlAddEigenvalueDP(xf, n, dim, eigvec, eigval, id, title, dictref, fmt)
+
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)          :: n              ! number of elements
+    integer, intent(in)          :: dim            ! dimension of matrix
+    real(kind=dp), intent(in)     :: eigvec(dim, *) ! eigenvectors
+    real(kind=dp), intent(in)     :: eigval(*)      ! eigenvalues
+    character(len=*), intent(in), optional :: id             ! id
+    character(len=*), intent(in), optional :: title          ! title
+    character(len=*), intent(in), optional :: dictref        ! dictionary reference
+    character(len=*), intent(in), optional :: fmt            ! format
+    character(len=10):: formt
+    integer ::  i, j
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    ! Flush on entry and exit
+    call xml_NewElement(xf, 'eigen')
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(title))   call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(dictref)) call xml_AddAttribute(xf, 'title', title)
+    call stmAddArray(xf=xf, nvalue=n, array=eigval, title='eigenvalues', dictref=dictRef, fmt=fmt)
+    call stmAddMatrix(xf=xf, ncols=n, nrows=n, dim=dim, matrix=eigvec, title='eigenvectors', fmt=fmt)
+    call xml_EndElement(xf, 'eigen')
+
+  END SUBROUTINE cmlAddEigenvalueDP
+
+
+
+  ! -------------------------------------------------
+  ! 2. creates and writes an SP <eigen> element
+  ! -------------------------------------------------
+  
+  SUBROUTINE cmlAddEigenvalueSP(xf, n, dim, eigvec, eigval, id, title, dictref, fmt)
+
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)          :: n              ! number of elements
+    integer, intent(in)          :: dim            ! dimension of matrix
+    real(kind=sp), intent(in)     :: eigvec(dim, *) ! eigenvectors
+    real(kind=sp), intent(in)     :: eigval(*)      ! eigenvalues
+    character(len=*), intent(in), optional :: id             ! id
+    character(len=*), intent(in), optional :: title          ! title
+    character(len=*), intent(in), optional :: dictref        ! dictionary reference
+    character(len=*), intent(in), optional :: fmt            ! format
+    character(len=10):: formt
+    integer ::  i, j
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    ! Flush on entry and exit
+    call xml_NewElement(xf, 'eigen')
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(title))   call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(dictref)) call xml_AddAttribute(xf, 'title', title)
+    call stmAddArray(xf=xf, nvalue=n, array=eigval, title='eigenvalues', dictref=dictRef, fmt=fmt)
+    call stmAddMatrix(xf=xf, ncols=n, nrows=n, dim=dim, matrix=eigvec, title='eigenvectors', fmt=fmt)
+    call xml_EndElement(xf, 'eigen')
+
+  END SUBROUTINE cmlAddEigenvalueSP
+
+
+  SUBROUTINE cmlAddMetadata(xf, name, content, conv)
+    
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*) :: name
+    character(len=*) :: content
+    character(len=*), optional :: conv
+    
+    call xml_NewElement(xf, 'metadata')
+    call xml_AddAttribute(xf, 'name', name)
+    call xml_AddAttribute(xf, 'content', content)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    call xml_EndElement(xf, 'metadata')
+
+  END SUBROUTINE cmlAddMetadata
+
+
+  ! -------------------------------------------------
+  ! 1. creates and writes an Char <parameter> element
+  ! -------------------------------------------------
+
+
+  SUBROUTINE cmlAddParameterCh(xf, value, ref, id, title, conv, &
+       cons, units, name, role)
+
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*) :: value 
+    character(len=*), optional :: ref 
+    character(len=*), optional :: title
+    character(len=*), optional :: id
+    character(len=*), optional :: conv
+    character(len=*), optional :: cons
+    character(len=*), optional :: units
+    character(len=*), optional :: name
+    character(len=*), optional :: role
+
+    call xml_NewElement(xf, 'parameter')
+    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(cons)) call xml_AddAttribute(xf, 'constraint', cons)
+    if (present(name)) call xml_AddAttribute(xf, 'name', name)
+    if (present(role)) call xml_AddAttribute(xf, 'role', role)
+    if (present(units)) then
+       call xml_NewElement(xf, 'scalar')
+       call xml_AddAttribute(xf, 'units', units)
+       call xml_AddPcdata(xf, value)
+       call xml_EndElement(xf, 'scalar')
+    else
+       call xml_AddAttribute(xf, 'value', value)
+    endif
+    call xml_EndElement(xf, 'parameter')
+
+  END SUBROUTINE CMLADDPARAMETERCH
+
+
+  ! -------------------------------------------------
+  ! 2. creates and writes an SP <parameter> element
+  ! -------------------------------------------------
+
+
+  SUBROUTINE cmlAddParameterSP(xf, value, ref, title, id, conv, &
+       cons, units, name, role, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp) :: value 
+    character(len=*), optional :: ref 
+    character(len=*), optional :: title
+    character(len=*), optional :: id
+    character(len=*), optional :: conv
+    character(len=*), optional :: cons
+    character(len=*), optional :: units
+    character(len=*), optional :: name
+    character(len=*), optional :: role
+    character(len=*), optional :: fmt    
+
+    character(len=10) :: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    call xml_NewElement(xf, 'parameter')
+    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(cons)) call xml_AddAttribute(xf, 'constraint', cons)
+    if (present(name)) call xml_AddAttribute(xf, 'name', name)
+    if (present(role)) call xml_AddAttribute(xf, 'role', role)
+    if (present(units)) then
+       call xml_NewElement(xf, 'scalar')
+       call xml_AddAttribute(xf, 'units', units)
+       call xml_AddPcdata(xf, str(value))
+       call xml_EndElement(xf, 'scalar')
+    else
+       call xml_AddAttribute(xf, 'value', str(value,formt))
+    endif
+    call xml_EndElement(xf, 'parameter')
+
+  END SUBROUTINE CMLADDPARAMETERSP
+
+
+  ! -------------------------------------------------
+  ! 3. creates and writes an DP <parameter> element
+  ! -------------------------------------------------
+
+
+  SUBROUTINE cmlAddParameterDP(xf, value, ref, title, id, conv, &
+       cons, units, name, role, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp) :: value 
+    character(len=*), optional :: ref 
+    character(len=*), optional :: title
+    character(len=*), optional :: id
+    character(len=*), optional :: conv
+    character(len=*), optional :: cons
+    character(len=*), optional :: units
+    character(len=*), optional :: name
+    character(len=*), optional :: role
+    character(len=*), optional :: fmt    
+
+    character(len=10) :: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    call xml_NewElement(xf, 'parameter')
+    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(cons)) call xml_AddAttribute(xf, 'constraint', cons)
+    if (present(name)) call xml_AddAttribute(xf, 'name', name)
+    if (present(role)) call xml_AddAttribute(xf, 'role', role)
+    if (present(units)) then
+       call xml_NewElement(xf, 'scalar')
+       call xml_AddAttribute(xf, 'units', units)
+       call xml_AddPcdata(xf, str(value))
+       call xml_EndElement(xf, 'scalar')
+    else
+       call xml_AddAttribute(xf, 'value', str(value))
+    endif
+    call xml_EndElement(xf, 'parameter')
+
+  END SUBROUTINE CMLADDPARAMETERDP
+
+
+  ! -------------------------------------------------
+  ! 4. creates and writes an Integer <parameter> element
+  ! -------------------------------------------------
+
+
+  SUBROUTINE cmlAddParameterI(xf, value, ref, id, title, conv, &
+       cons, units, name, role)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer :: value 
+    character(len=*), optional :: ref 
+    character(len=*), optional :: title
+    character(len=*), optional :: id
+    character(len=*), optional :: conv
+    character(len=*), optional :: cons
+    character(len=*), optional :: units
+    character(len=*), optional :: name
+    character(len=*), optional :: role
+
+    call xml_NewElement(xf, 'parameter')
+    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(cons)) call xml_AddAttribute(xf, 'constraint', cons)
+    if (present(name)) call xml_AddAttribute(xf, 'name', name)
+    if (present(role)) call xml_AddAttribute(xf, 'role', role)
+    if (present(units)) then
+       call xml_NewElement(xf, 'scalar')
+       call xml_AddAttribute(xf, 'units', units)
+       call xml_AddPcdata(xf, str(value))
+       call xml_EndElement(xf, 'scalar')
+    else
+       call xml_AddAttribute(xf, 'value', str(value))
+    endif
+    call xml_EndElement(xf, 'parameter')
+
+  END SUBROUTINE CMLADDPARAMETERI
+
+  SUBROUTINE cmlAddParameterLG(xf, value, ref, id, title, conv, &
+       cons, units, name, role)
+
+    implicit none
+    type(xmlf_t) :: xf
+    logical      :: value 
+    character(len=*), optional :: ref 
+    character(len=*), optional :: title
+    character(len=*), optional :: id
+    character(len=*), optional :: conv
+    character(len=*), optional :: cons
+    character(len=*), optional :: units
+    character(len=*), optional :: name
+    character(len=*), optional :: role
+
+    call xml_NewElement(xf, 'parameter')
+    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(cons)) call xml_AddAttribute(xf, 'constraint', cons)
+    if (present(name)) call xml_AddAttribute(xf, 'name', name)
+    if (present(role)) call xml_AddAttribute(xf, 'role', role)
+    if (present(units)) then
+       call xml_NewElement(xf, 'scalar')
+       call xml_AddAttribute(xf, 'units', units)
+       call xml_AddPcdata(xf, str(value))
+       call xml_EndElement(xf, 'scalar')
+    else
+       call xml_AddAttribute(xf, 'value', str(value))
+    endif
+    call xml_EndElement(xf, 'parameter')
+
+  END SUBROUTINE CMLADDPARAMETERLG
+
+
+
+! =================================================
+! basic CML routines
+! =================================================
+
+  
+  ! -------------------------------------------------
+  ! 1. adds DP xyz3 to start tag
+  ! -------------------------------------------------
+  
+  SUBROUTINE CMLATXYZ39DP(xf, x3, y3, z3, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp)      :: x3, y3, z3 ! coordinates
+    character(len=*)  :: fmt        ! format (default '(f8.3)')
+    character(len=45) :: x, y, z
+
+    write(x,fmt) x3
+    write(y,fmt) y3
+    write(z,fmt) z3
+
+    call xml_AddAttribute(xf, 'xyz3', trim(x)//' '//trim(adjustl(y))//' '//trim(adjustl(z)) )
+
+  END SUBROUTINE CMLATXYZ39DP
+
+
+  ! -------------------------------------------------
+  ! 2. adds SP xyz3 to start tag
+  ! -------------------------------------------------
+
+  SUBROUTINE CMLATXYZ39SP(xf, x3, y3, z3, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp)      :: x3, y3, z3 ! coordinates
+    character(len=*)  :: fmt        ! format (default '(f8.3)')
+
+    character(len=45) :: x, y, z
+
+    write(x,fmt) x3
+    write(y,fmt) y3
+    write(z,fmt) z3
+
+    call xml_AddAttribute(xf, 'xyz3', trim(x)//' '//trim(adjustl(y))//' '//trim(adjustl(z)) )
+
+  END SUBROUTINE CMLATXYZ39SP
+  
+  ! -------------------------------------------------
+  ! 1. adds DP xyzFrac to start tag
+  ! -------------------------------------------------
+  
+  SUBROUTINE CMLATXYZFRACT9DP(xf, x3, y3, z3, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp)      :: x3, y3, z3 ! coordinates
+    character(len=*)  :: fmt        ! format (default '(f8.3)')
+
+    character(len=45) :: x, y, z
+
+    write(x,fmt) x3
+    write(y,fmt) y3
+    write(z,fmt) z3
+
+    call xml_AddAttribute(xf, 'xyzFrac', trim(x)//' '//trim(adjustl(y))//' '//trim(adjustl(z)) )
+
+  END SUBROUTINE CMLATXYZFRACT9DP
+
+  ! -------------------------------------------------
+  ! 2. adds SP xyzFrac to start tag
+  ! -------------------------------------------------
+
+  SUBROUTINE CMLATXYZFRACT9SP(xf, x3, y3, z3, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp), intent(in)     :: x3, y3, z3 ! coordinates
+    character(len=*), intent(in) :: fmt        ! format (default '(f8.3)')
+
+    character(len=45) :: x, y, z
+
+    write(x,fmt) x3
+    write(y,fmt) y3
+    write(z,fmt) z3
+
+    call xml_AddAttribute(xf, 'xyzFrac', trim(x)//' '//trim(y)//' '//trim(z))
+
+  END SUBROUTINE CMLATXYZFRACT9SP
+
+
+  ! -------------------------------------------------
+  ! 1. adds DP x3, y3, z3 to start tag
+  ! -------------------------------------------------
+
+  SUBROUTINE CMLATX39DP(xf, x3, y3, z3, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp), intent(in)     :: x3, y3, z3 ! coordinates
+    character(len=*), intent(in) :: fmt        ! format (default '(f8.3)')
+
+    call xml_AddAttribute(xf, 'x3', str(x3, fmt))
+    call xml_AddAttribute(xf, 'y3', str(y3, fmt))
+    call xml_AddAttribute(xf, 'z3', str(z3, fmt))
+
+  END SUBROUTINE CMLATX39DP
+
+  ! -------------------------------------------------
+  ! 2. adds SP x3, y3, z3 to start tag
+  ! -------------------------------------------------
+
+  SUBROUTINE CMLATX39SP(xf, x3, y3, z3, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp), intent(in)     :: x3, y3, z3 ! coordinates
+    character(len=*), intent(in) :: fmt        ! format (default '(f8.3)')
+
+    call xml_AddAttribute(xf, 'x3', str(x3, fmt))
+    call xml_AddAttribute(xf, 'y3', str(y3, fmt))
+    call xml_AddAttribute(xf, 'z3', str(z3, fmt))
+
+  END SUBROUTINE CMLATX39SP
+
+
+  ! -------------------------------------------------
+  ! 1. adds DP xFract, yFract, zFract to start tag
+  ! -------------------------------------------------
+
+  SUBROUTINE CMLATXF9DP(xf, xFract, yFract, zFract, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp), intent(in)     :: xFract, yFract, zFract ! coordinates
+    character(len=*), intent(in) :: fmt                    ! format (default '(f8.3)')
+
+    call xml_AddAttribute(xf, 'xFract', str(xFract, fmt))
+    call xml_AddAttribute(xf, 'yFract', str(yFract, fmt))
+    call xml_AddAttribute(xf, 'zFract', str(zFract, fmt))
+
+  END SUBROUTINE CMLATXF9DP
+  
+  ! -------------------------------------------------
+  ! 2. adds SP xfrac, yFractractrac, zFractrac to start tag
+  ! -------------------------------------------------
+  
+  SUBROUTINE CMLATXF9SP(xf, xFract, yFract, zFract, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp)     :: xFract, yFract, zFract   ! fractional coordinates
+    character(len=*) :: fmt                      ! format (default '(f8.3)')
+
+    call xml_AddAttribute(xf, 'xFract', str(xFract, fmt))
+    call xml_AddAttribute(xf, 'yFract', str(yFract, fmt))
+    call xml_AddAttribute(xf, 'zFract', str(zFract, fmt))
+
+  END SUBROUTINE CMLATXF9SP
+
+
+  ! -------------------------------------------------
+  ! 1. adds DP x2, y2 to start tag
+  ! -------------------------------------------------
+
+  SUBROUTINE CMLATXY9DP(xf, x2, y2, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp)     :: x2, y2   ! coordinates
+    character(len=*) :: fmt      ! format (default f8.3)
+
+    call xml_AddAttribute(xf, 'x2', str(x2, fmt))
+    call xml_AddAttribute(xf, 'y2', str(y2, fmt))
+    call xml_AddPcdata(xf, '>')                   !!! AG****
+
+  END SUBROUTINE CMLATXY9DP
+
+  ! -------------------------------------------------
+  ! 2. adds SP x2, y2 to start tag
+  ! -------------------------------------------------
+
+  SUBROUTINE CMLATXY9SP(xf, x2, y2, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp)     :: x2, y2   ! coordinates
+    character(len=*) :: fmt      ! format (default f8.3)
+
+    call xml_AddAttribute(xf, 'x2', str(x2, fmt))
+    call xml_AddAttribute(xf, 'y2', str(y2, fmt))
+    call xml_AddPcdata(xf, '>')                      !!AG***
+
+  END SUBROUTINE CMLATXY9SP
+
+
+  ! -------------------------------------------------
+  ! 1. creates a DP <length> element
+  ! -------------------------------------------------
+
+  SUBROUTINE CMLLEN9DP(xf, id, atomRef1, atomRef2, length, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*) :: id           ! length id
+    character(len=*) :: atomRef1     ! ref to first atom
+    character(len=*) :: atomRef2     ! ref to second atom
+    real(kind=dp)     :: length       ! the length
+    character(len=*) :: fmt          ! format
+    character(len=20) :: temp
+
+    temp = atomRef1//' '//adjustl(atomRef2)
+
+    call xml_NewElement(xf, 'length')
+    call xml_AddAttribute(xf, 'id', id)
+    call xml_AddAttribute(xf, 'atomRefs2', temp)
+    call xml_AddPcdata(xf, str(length, fmt))
+    call xml_EndElement(xf, 'length')
+
+  END SUBROUTINE CMLLEN9DP
+  
+  ! -------------------------------------------------
+  ! 2. creates a SP <length> element
+  ! -------------------------------------------------
+  
+  SUBROUTINE CMLLEN9SP(xf, id, atomRef1, atomRef2, length, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*) :: id           ! length id
+    character(len=*) :: atomRef1     ! ref to first atom
+    character(len=*) :: atomRef2     ! ref to second atom
+    real(kind=sp)     :: length       ! the length
+    character(len=*) :: fmt          ! format
+    character(len=20) :: temp
+
+    temp = atomRef1//' '//adjustl(atomRef2)
+
+    call xml_NewElement(xf, 'length')
+    call xml_AddAttribute(xf, 'id', id)
+    call xml_AddAttribute(xf, 'atomRefs2', temp)
+    call xml_AddPcdata(xf, str(length, fmt))
+    call xml_EndElement(xf, 'length')
+
+  END SUBROUTINE CMLLEN9SP
+
+
+  ! -------------------------------------------------
+  ! 1. creates a DP <angle> element
+  ! -------------------------------------------------
+
+  SUBROUTINE CMLANG9DP(xf, id, atomRef1, atomRef2, atomRef3, angle, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*) :: id              ! angle id
+    character(len=*) :: atomRef1        ! ref to first atom
+    character(len=*) :: atomRef2        ! ref to second atom
+    character(len=*) :: atomRef3        ! ref to third atom
+    real(kind=dp)     :: angle           ! the angle
+    character(len=*) :: fmt             ! format
+    character(len=20) :: temp
+
+    temp = atomRef1//' '//adjustl(atomRef2)//' '//adjustl(atomRef3)
+
+    call xml_NewElement(xf, 'angle')
+    call xml_AddAttribute(xf, 'id', id)
+    call xml_AddAttribute(xf, 'atomRefs3', temp)
+    call xml_AddPcdata(xf, str(angle, fmt))
+    call xml_EndElement(xf, 'angle')
+
+  END SUBROUTINE CMLANG9DP
+
+  ! -------------------------------------------------
+  ! 2. creates a SP <angle> element
+  ! -------------------------------------------------
+
+  SUBROUTINE CMLANG9SP(xf, id, atomRef1, atomRef2, atomRef3, angle, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*) :: id              ! angle id
+    character(len=*) :: atomRef1        ! ref to first atom
+    character(len=*) :: atomRef2        ! ref to second atom
+    character(len=*) :: atomRef3        ! ref to third atom
+    real(kind=sp)     :: angle           ! the angle
+    character(len=*) :: fmt             ! format
+    character(len=20) :: temp
+
+    temp = atomRef1//' '//adjustl(atomRef2)//' '//adjustl(atomRef3)
+
+    call xml_NewElement(xf, 'angle')
+    call xml_AddAttribute(xf, 'id', id)
+    call xml_AddAttribute(xf, 'atomRefs3', temp)
+    call xml_AddPcdata(xf, str(angle, fmt))
+    call xml_EndElement(xf, 'angle')
+
+  END SUBROUTINE CMLANG9SP
+
+
+  ! -------------------------------------------------
+  ! 1. creates a DP <torsion> element
+  ! -------------------------------------------------
+  
+  SUBROUTINE CMLTOR9DP(xf, id, atomRef1, atomRef2, atomRef3, atomRef4, torsion, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*) :: id              ! torsion id
+    character(len=*) :: atomRef1        ! ref to first atom
+    character(len=*) :: atomRef2        ! ref to second atom
+    character(len=*) :: atomRef3        ! ref to third atom
+    character(len=*) :: atomRef4        ! ref to fourth atom
+    real(kind=dp)     :: torsion         ! the torsion
+    character(len=*) :: fmt             ! format
+    character(len=20) :: temp
+
+    temp = atomRef1//' '//adjustl(atomRef2)//' '//adjustl(atomRef3)//' '//adjustl(atomRef4)
+
+    call xml_NewElement(xf, 'torsion')
+    call xml_AddAttribute(xf, 'id', id)
+    call xml_AddAttribute(xf, 'atomRefs4', temp)
+    call xml_AddPcdata(xf, str(torsion, fmt))
+    call xml_EndElement(xf, 'torsion')
+
+  END SUBROUTINE CMLTOR9DP
+
+  ! -------------------------------------------------
+  ! 2. creates a SP <torsion> element
+  ! -------------------------------------------------
+
+  SUBROUTINE CMLTOR9SP(xf, id, atomRef1, atomRef2, atomRef3, atomRef4, torsion, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*) :: id              ! torsion id
+    character(len=*) :: atomRef1        ! ref to first atom
+    character(len=*) :: atomRef2        ! ref to second atom
+    character(len=*) :: atomRef3        ! ref to third atom
+    character(len=*) :: atomRef4        ! ref to fourth atom
+    real(kind=sp)     :: torsion         ! the torsion
+    character(len=*) :: fmt             ! format
+    character(len=20) :: temp
+
+    temp = atomRef1//' '//adjustl(atomRef2)//' '//adjustl(atomRef3)//' '//adjustl(atomRef4)
+
+    call xml_NewElement(xf, 'torsion')
+    call xml_AddAttribute(xf, 'id', id)
+    call xml_AddAttribute(xf, 'atomRefs4', temp)
+    call xml_AddPcdata(xf, str(torsion, fmt))
+    call xml_EndElement(xf, 'torsion')
+
+  END SUBROUTINE CMLTOR9SP
+
+end module m_cmlw
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/cml/m_stmw.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/cml/m_stmw.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/cml/m_stmw.f90	(revision 2528)
@@ -0,0 +1,875 @@
+module m_stmw
+
+  use flib_wxml
+
+  private
+
+  integer, private, parameter ::  sp = selected_real_kind(6,30)
+  integer, private, parameter ::  dp = selected_real_kind(14,100)
+
+!  TYPE(xmlf_t), save,  :: xf
+
+  PUBLIC :: stmAddScalar
+  PUBLIC :: stmAddArray
+  PUBLIC :: stmAddMatrix
+  PUBLIC :: stmAddTriangle
+  PUBLIC :: stmAddStartTag
+
+  INTERFACE stmAddScalar
+     MODULE PROCEDURE stmAddString, stmAddInteger, stmAddFloatSP, stmAddFloatDP
+  END INTERFACE
+
+  INTERFACE stmAddArray
+     MODULE PROCEDURE stmAddFloatArraySP, stmAddFloatArrayDP, stmAddStringArray, &
+                      stmAddIntegerArray
+  END INTERFACE
+
+  INTERFACE stmAddMatrix
+     MODULE PROCEDURE stmAddFloatMatrixSP, stmAddFloatMatrixDP, stmAddIntegerMatrix
+  END INTERFACE
+
+  INTERFACE stmAddTriangle
+     MODULE PROCEDURE stmAddTriangleSP, stmAddTriangleDP
+  END INTERFACE
+
+ 
+CONTAINS
+  
+  
+  ! =================================================
+  ! STMML convenience routines
+  ! =================================================
+  
+  ! -------------------------------------------------
+  ! create STMML start tag in xml channel
+  ! -------------------------------------------------
+  
+  SUBROUTINE stmAddStartTag(xf, name, id, title, dictref, dataType, &
+       convention, errorValue, errorBasis, min, max, units)
+
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*), intent(in) :: name                   ! the element name
+    character(len=*), intent(in), optional :: id           ! the element id; if whitespace, is omitted
+    character(len=*), intent(in), optional :: title        ! the title; if whitespace, is omitted
+    character(len=*), intent(in), optional :: dictref      ! the dictionary reference; if whitespace, is omitted
+    character(len=*), intent(in), optional :: dataType  
+    character(len=*), intent(in), optional :: convention
+    character(len=*), intent(in), optional :: errorValue
+    character(len=*), intent(in), optional :: errorBasis
+    character(len=*), intent(in), optional :: min
+    character(len=*), intent(in), optional :: max
+    character(len=*), intent(in), optional :: units
+
+!    call XMLCHKN9(name)
+    call xml_NewElement(xf, name)
+    if (present(id))         call xml_AddAttribute(xf, 'id', id)
+    if (present(title))      call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref))    call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(dataType))   call xml_AddAttribute(xf, 'dataType', dataType)
+    if (present(convention)) call xml_AddAttribute(xf, 'convention', convention)
+    if (present(errorValue)) call xml_AddAttribute(xf, 'errorValue', errorValue)
+    if (present(errorBasis)) call xml_AddAttribute(xf, 'errorBasis', errorBasis)
+    if (present(min))        call xml_AddAttribute(xf, 'min', min)
+    if (present(max))        call xml_AddAttribute(xf, 'max', max)
+    if (present(units))      call xml_AddAttribute(xf, 'units', units)
+
+  END SUBROUTINE stmAddStartTag
+
+
+  ! -------------------------------------------------
+  ! outputs STMML scalar in xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE stmAddString(xf, value, id, title, dictref, dataType, &
+       convention, errorValue, errorBasis, min, max, units)
+
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*), intent(in)           :: value         ! the value to be output
+    character(len=*), intent(in), optional :: id            ! the id
+    character(len=*), intent(in), optional :: title         ! the title
+    character(len=*), intent(in), optional :: dictref       ! the dictionary reference
+    character(len=*), intent(in), optional :: dataType  
+    character(len=*), intent(in), optional :: convention
+    character(len=*), intent(in), optional :: errorValue
+    character(len=*), intent(in), optional :: errorBasis
+    character(len=*), intent(in), optional :: min
+    character(len=*), intent(in), optional :: max
+    character(len=*), intent(in), optional :: units
+
+    ! Internal variables
+    character(len=20) :: temp
+
+!    if (XMLCHKS9(value)) then
+    call xml_AddPcdata(xf, ' '//value)
+
+    call xml_NewElement(xf, 'scalar')
+    if (present(id))         call xml_AddAttribute(xf, 'id', id)
+    if (present(title))      call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref))    call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(dataType))   call xml_AddAttribute(xf, 'dataType', dataType)
+    if (present(convention)) call xml_AddAttribute(xf, 'convention', convention)
+    if (present(errorValue)) call xml_AddAttribute(xf, 'errorValue', errorValue)
+    if (present(errorBasis)) call xml_AddAttribute(xf, 'errorBasis', errorBasis)
+    if (present(min))        call xml_AddAttribute(xf, 'min', min)
+    if (present(max))        call xml_AddAttribute(xf, 'max', max)
+    if (present(units))      call xml_AddAttribute(xf, 'units', units)
+    call xml_EndElement(xf, 'scalar')
+
+  END SUBROUTINE stmAddString
+
+
+  ! -------------------------------------------------
+  ! outputs STMML integer in xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE stmAddInteger(xf, value, id, title, dictref, dataType, &
+       convention, errorValue, errorBasis, min, max, units)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in) :: value                           ! the value to be output
+    character(len=*), intent(in), optional :: id           ! the id
+    character(len=*), intent(in), optional :: title        ! the title
+    character(len=*), intent(in), optional :: dictref      ! the dictionary reference
+    character(len=*), intent(in), optional :: dataType  
+    character(len=*), intent(in), optional :: convention
+    character(len=*), intent(in), optional :: errorValue
+    character(len=*), intent(in), optional :: errorBasis
+    character(len=*), intent(in), optional :: min
+    character(len=*), intent(in), optional :: max
+    character(len=*), intent(in), optional :: units        ! units (default = none)
+
+
+    ! Flush on entry and exit
+    call xml_NewElement(xf, 'scalar')
+    if (present(id))         call xml_AddAttribute(xf, 'id', id)
+    if (present(title))      call xml_AddAttribute(xf, 'dictRef', title)
+    if (present(dictref))    call xml_AddAttribute(xf, 'title', dictref)
+    if (present(dataType))   call xml_AddAttribute(xf, 'dataType', dataType)
+    if (present(convention)) call xml_AddAttribute(xf, 'convention', convention)
+    if (present(errorValue)) call xml_AddAttribute(xf, 'errorValue', errorValue)
+    if (present(errorBasis)) call xml_AddAttribute(xf, 'errorBasis', errorBasis)
+    if (present(min))        call xml_AddAttribute(xf, 'min', min)
+    if (present(max))        call xml_AddAttribute(xf, 'max', max)
+    if (present(units))      call xml_AddAttribute(xf, 'units', units)
+    call xml_AddPcdata(xf, str(value))
+    call xml_EndElement(xf, 'scalar')
+
+  END SUBROUTINE stmAddInteger
+
+
+  ! -------------------------------------------------
+  ! 1. create an STMML <scalar> DP float in xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE stmAddFloatDP(xf, value, id, title, dictref, dataType, &
+       convention, errorValue, errorBasis, min, max, units, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp), intent(in)               :: value        ! the value to be output
+    character(len=*), intent(in), optional :: id           ! id
+    character(len=*), intent(in), optional :: title        ! the title
+    character(len=*), intent(in), optional :: dictref      ! the dictionary reference
+    character(len=*), intent(in), optional :: dataType  
+    character(len=*), intent(in), optional :: convention
+    character(len=*), intent(in), optional :: errorValue
+    character(len=*), intent(in), optional :: errorBasis
+    character(len=*), intent(in), optional :: min
+    character(len=*), intent(in), optional :: max
+    character(len=*), intent(in), optional :: units        ! units
+    character(len=*), intent(in), optional :: fmt          ! the format (default 'f10.4')
+
+    ! Internal Vaiable
+    character(len=10) :: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f10.4)'
+    endif
+
+
+    ! Flushes on entry and exit
+    call xml_NewElement(xf, 'scalar')
+    if (present(id))         call xml_AddAttribute(xf, 'id', id)
+    if (present(title))      call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref))    call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(dataType))   call xml_AddAttribute(xf, 'dataType', dataType)
+    if (present(convention)) call xml_AddAttribute(xf, 'convention', convention)
+    if (present(errorValue)) call xml_AddAttribute(xf, 'errorValue', errorValue)
+    if (present(errorBasis)) call xml_AddAttribute(xf, 'errorBasis', errorBasis)
+    if (present(min))        call xml_AddAttribute(xf, 'min', min)
+    if (present(max))        call xml_AddAttribute(xf, 'max', max)
+    if (present(units))      call xml_AddAttribute(xf, 'units', units)
+
+    call xml_AddPcdata(xf, str(value))
+    call xml_EndElement(xf, 'scalar')
+
+  END SUBROUTINE stmAddFloatDP
+
+  ! -------------------------------------------------
+  ! 2. create an STMML <scalar> SP float in xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE stmAddFloatSP(xf, value, id, title, dictref, dataType, &
+       convention, errorValue, errorBasis, min, max, units, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp), intent(in)               :: value        ! the value to be output
+    character(len=*), intent(in), optional :: id           ! id
+    character(len=*), intent(in), optional :: title        ! the title
+    character(len=*), intent(in), optional :: dictref      ! the dictionary reference
+    character(len=*), intent(in), optional :: units        ! units (' ' = none)
+    character(len=*), intent(in), optional :: dataType  
+    character(len=*), intent(in), optional :: convention
+    character(len=*), intent(in), optional :: errorValue
+    character(len=*), intent(in), optional :: errorBasis
+    character(len=*), intent(in), optional :: min
+    character(len=*), intent(in), optional :: max
+    character(len=*), intent(in), optional :: fmt          ! the format (default 'f10.4')
+
+    ! Internal Variable
+    character(len=10) :: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f10.4)'
+    endif
+
+    ! Flushes on entry and exit
+    call xml_NewElement(xf, 'scalar')
+    if (present(id))         call xml_AddAttribute(xf, 'id', id)
+    if (present(title))      call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(dictref))    call xml_AddAttribute(xf, 'title', title)
+    if (present(dataType))   call xml_AddAttribute(xf, 'dataType', dataType)
+    if (present(convention)) call xml_AddAttribute(xf, 'convention', convention)
+    if (present(errorValue)) call xml_AddAttribute(xf, 'errorValue', errorValue)
+    if (present(errorBasis)) call xml_AddAttribute(xf, 'errorBasis', errorBasis)
+    if (present(min))        call xml_AddAttribute(xf, 'min', min)
+    if (present(max))        call xml_AddAttribute(xf, 'max', max)
+    if (present(units))      call xml_AddAttribute(xf, 'units', units)
+    call xml_AddPcdata(xf, str(value))
+    call xml_EndElement(xf, 'scalar')
+
+  END SUBROUTINE stmAddFloatSP
+
+
+  ! -------------------------------------------------
+  ! outputs string array to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE stmAddStringArray(xf, nvalue, array, id, title, dictref, type, delim, ref)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: nvalue        ! number of values to be output
+    character(len=*), intent(in)           :: array(*)      ! the values to be output
+    character(len=*), intent(in), optional :: id            ! the id
+    character(len=*), intent(in), optional :: title         ! the title
+    character(len=*), intent(in), optional :: dictref       ! the dictionary reference
+    character(len=*), intent(in), optional :: type          ! the dataType
+    character(len=*), intent(in), optional :: delim         ! delimiter
+    character(len=*), intent(in), optional :: ref           ! delimiter
+
+    ! splits data into lines whenever it overflows workspace/linelength
+    ! Flush on entry and exit
+    character(len=1) :: delim1
+    integer          :: i
+
+
+    if (present(delim)) then
+       delim1 = delim
+    else
+       delim1 = ' '
+    endif
+
+    call xml_NewElement(xf, 'array')
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(title))   call xml_AddAttribute(xf, 'title', title)
+    if (present(type))    call xml_AddAttribute(xf, 'type', type)
+    if (present(ref))     call xml_AddAttribute(xf, 'ref', ref)
+    call xml_AddAttribute(xf, 'delimiter', delim1)
+    call xml_AddAttribute(xf, 'size', str(nvalue))
+
+    call xml_AddPcdata(xf, array(1))
+    do i = 2, nvalue
+       if (delim1 .eq. ' ') then
+          call xml_AddPcdata(xf, ' '//array(i))
+       else
+          call xml_AddPcdata(xf, delim1//array(i))
+       endif
+    enddo
+    call xml_EndElement(xf, 'array')
+
+  END SUBROUTINE stmAddStringArray
+
+
+  ! -------------------------------------------------
+  ! outputs integer array to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE stmAddIntegerArray(xf, nvalue, array, id, title, dictref, ref, units)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: nvalue        ! the number of values to be output
+    integer, intent(in)                    :: array(*)      ! the values to be output
+    character(len=*), intent(in), optional :: id            ! the id
+    character(len=*), intent(in), optional :: title         ! the title
+    character(len=*), intent(in), optional :: dictref       ! the dictionary reference
+    character(len=*), intent(in), optional :: units         ! scienitific units (default ' ')
+    character(len=*), intent(in), optional :: ref           ! scienitific units (default ' ')
+
+    ! splits data into lines wherever it overflows the workspace
+    integer          :: i
+
+    ! Flush on entry and exit
+
+    call xml_NewElement(xf, 'array')
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(title))   call xml_AddAttribute(xf, 'title', title)
+    if (present(units))   call xml_AddAttribute(xf, 'units', units)
+    if (present(ref))     call xml_AddAttribute(xf, 'ref', ref)
+    call xml_AddAttribute(xf, 'size', str(nvalue))
+
+
+    call xml_AddPcdata(xf, str(array(1)))
+    do i = 2, nvalue
+       call xml_AddPcdata(xf, str(array(i)))
+    enddo
+    call xml_EndElement(xf, 'array')
+    
+  END SUBROUTINE stmAddIntegerArray
+
+
+  ! -------------------------------------------------
+  ! 1. outputs DP float array to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE stmAddFloatArrayDP(xf, nvalue, array, id, title, dictref, units, ref, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: nvalue        ! number of values to be output
+    real(kind=dp), intent(in)               :: array(*)       ! the values to be output
+    character(len=*), intent(in), optional :: id            ! the id
+    character(len=*), intent(in), optional :: title         ! the title
+    character(len=*), intent(in), optional :: dictref       ! the dictionary reference
+    character(len=*), intent(in), optional :: units         ! scienitific units (default ' ')
+    character(len=*), intent(in), optional :: ref           ! 
+    character(len=*), intent(in), optional :: fmt           ! the output format
+
+    ! Internal Variable
+    character(len=10) :: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    ! splits data into lines whenever it overflows workspace/linelength
+    ! Flush on entry and exit
+
+    call xml_NewElement(xf, 'array')
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(title))   call xml_AddAttribute(xf, 'title', title)
+    if (present(units))   call xml_AddAttribute(xf, 'units', units)
+    if (present(ref))     call xml_AddAttribute(xf, 'ref', ref)
+    call xml_AddAttribute(xf, 'size', str(nvalue))
+    call STMARCF9DP(xf, nvalue, array, fmt)
+    call xml_EndElement(xf, 'array')
+
+  END SUBROUTINE stmAddFloatArrayDP
+
+  ! -------------------------------------------------
+  ! 2. outputs SP float array to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE stmAddFloatArraySP(xf, nvalue, array, id, title, dictref, units, ref, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: nvalue        ! number of values to be output
+    real(kind=sp), intent(in)               :: array(*)       ! the values to be output
+    character(len=*), intent(in), optional :: id            ! the id
+    character(len=*), intent(in), optional :: title         ! the title
+    character(len=*), intent(in), optional :: dictref       ! the dictionary reference
+    character(len=*), intent(in), optional :: units         ! scienitific units (default ' ')
+    character(len=*), intent(in), optional :: fmt           ! the output format
+    character(len=*), intent(in), optional :: ref           ! the output format
+
+    ! Internal Variable
+    character(len=10) :: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    ! splits data into lines whenever it overflows workspace/linelength
+    ! Flush on entry and exit
+
+    call xml_NewElement(xf, 'array')
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(title))   call xml_AddAttribute(xf, 'title', title)
+    if (present(units))   call xml_AddAttribute(xf, 'units', units)
+    if (present(ref))     call xml_AddAttribute(xf, 'ref', ref)
+    call xml_AddAttribute(xf, 'size', str(nvalue))
+    call STMARCF9SP(xf, nvalue, array, fmt)
+    call xml_EndElement(xf, 'array')
+
+  END SUBROUTINE stmAddFloatArraySP
+
+
+  ! -------------------------------------------------
+  ! outputs integer matrix to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE stmAddIntegerMatrix(xf, nrows, ncols, dim, matrix, id, title, dictref, units)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: nrows         ! the number of rows to be output
+    integer, intent(in)                    :: ncols         ! the number of rows to be output
+    integer, intent(in)                    :: dim           ! the range of the fastest index
+    integer, intent(in)                    :: matrix(nrows,ncols) ! the values to be output
+    character(len=*), intent(in), optional :: id            ! the id
+    character(len=*), intent(in), optional :: title         ! the title
+    character(len=*), intent(in), optional :: dictref       ! the dictionary reference
+    character(len=*), intent(in), optional :: units         ! scienitific units (default ' ')
+
+    ! splits data into lines wherever it overflows the workspace
+    ! Flush on entry and exit
+    integer ::  i, j
+
+
+
+    call xml_NewElement(xf, 'matrix')
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(dictref))   call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(units))   call xml_AddAttribute(xf, 'units', units)
+    call xml_AddAttribute(xf, 'cols', str(ncols))
+    call xml_AddAttribute(xf, 'rows', str(nrows))
+
+!
+!   Try addArray...
+!
+    do i = 1, ncols
+       do j = 1, nrows
+          call xml_AddPcdata(xf, str(matrix(j, i)))
+       enddo
+    enddo
+    call xml_EndElement(xf, 'matrix')
+
+  END SUBROUTINE stmAddIntegerMatrix
+
+
+  ! -------------------------------------------------
+  ! 1. outputs DP float matrix to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE stmAddFloatMatrixDP(xf, ncols, nrows, dim, matrix, id, title, dictref, units, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: ncols                ! the number of cols to be output
+    integer, intent(in)                    :: nrows                ! the number of rows to be output
+    integer, intent(in)                    :: dim                  ! the range of the fastest index
+    real(kind=dp), intent(in)               :: matrix(ncols,nrows)  ! the values to be output
+    character(len=*), intent(in), optional :: id                   ! the id
+    character(len=*), intent(in), optional :: title                ! the title
+    character(len=*), intent(in), optional :: dictref              ! the dictionary reference
+    character(len=*), intent(in), optional :: units                ! scienitific units (default ' ')
+    character(len=*), intent(in), optional :: fmt                  ! format
+
+    ! internal variable
+    character(len=10) :: formt
+    integer ::  i, j
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    ! splits data into lines wherever it overflows the workspace
+    ! Flush on entry and exit      
+    !-------------
+    call xml_NewElement(xf, 'matrix')
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(title))   call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(units))   call xml_AddAttribute(xf, 'units', units)
+    call xml_AddAttribute(xf, 'cols', str(ncols))
+    call xml_AddAttribute(xf, 'rows', str(nrows))
+    !-------------
+    do i = 1, nrows
+       do j = 1, ncols
+          !              write(*,*) ">>> 1", i, j
+          call xml_AddPcdata(xf, str(matrix(j, i)))
+       enddo
+    enddo
+    call xml_EndElement(xf, 'matrix')
+
+  END SUBROUTINE stmAddFloatMatrixDP
+
+  ! -------------------------------------------------
+  ! 2. outputs SP float matrix to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE stmAddFloatMatrixSP(xf, ncols, nrows, dim, matrix, id, title, dictref, units, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: ncols               ! the number of cols to be output
+    integer, intent(in)                    :: nrows               ! the number of rows to be output
+    integer, intent(in)                    :: dim                 ! the range of the fastest index
+    real(kind=sp), intent(in)               :: matrix(ncols,nrows) ! the values to be output
+    character(len=*), intent(in), optional :: id                  ! the id
+    character(len=*), intent(in), optional :: title               ! the title
+    character(len=*), intent(in), optional :: dictref             ! the dictionary reference
+    character(len=*), intent(in), optional :: units               ! scienitific units (default ' ')
+    character(len=*), intent(in), optional :: fmt                 ! format
+
+    ! internal variable
+    character(len=10) :: formt
+    integer ::  i, j
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    ! splits data into lines wherever it overflows the workspace
+    ! Flush on entry and exit      
+    !
+    call xml_NewElement(xf, 'matrix')
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(title))   call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(units))   call xml_AddAttribute(xf, 'units', units)
+    call xml_AddAttribute(xf, 'cols', str(ncols))
+    call xml_AddAttribute(xf, 'rows', str(nrows))
+    do i = 1, nrows
+       do j = 1, ncols
+          call xml_AddPcdata(xf, str(matrix(j, i)))
+       enddo
+    enddo
+    call xml_EndElement(xf, 'matrix')
+
+  END SUBROUTINE stmAddFloatMatrixSP
+
+
+  ! -------------------------------------------------
+  ! 1. outputs DP lower triangle array to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE stmAddTriangleDP(xf, nvalue, array, id, title, dictref, units, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: nvalue         ! number of values to be output
+    real(kind=dp), intent(in)               :: array(*)        ! the values to be output
+    character(len=*), intent(in), optional :: id             ! the id
+    character(len=*), intent(in), optional :: title          ! the title
+    character(len=*), intent(in), optional :: dictref        ! the dictionary reference
+    character(len=*), intent(in), optional :: units          ! units (' ' = none)
+    character(len=*), intent(in), optional :: fmt            ! the output format
+
+    ! splits data into lines whenever it overflows workspace/linelength
+    ! Flush on entry and exit
+    integer           :: size
+    character(len=10) :: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    size = (nvalue*(nvalue+1))/2
+    call xml_NewElement(xf, 'array')
+    call xml_AddAttribute(xf, 'size', str(size))
+    call xml_AddAttribute(xf, 'rows', str(nvalue))
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(title))   call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(units))   call xml_AddAttribute(xf, 'units', units)
+    call STMARCF9DP(xf, size, array, formt)
+    call xml_EndElement(xf, 'matrix')
+
+  END SUBROUTINE stmAddTriangleDP
+
+  ! -------------------------------------------------
+  ! 2. outputs SP lower triangle array to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE stmAddTriangleSP(xf, nvalue, array, id, title, dictref, units, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: nvalue         ! number of values to be output
+    real(kind=sp), intent(in)               :: array(*)        ! the values to be output
+    character(len=*), intent(in), optional :: id             ! the id
+    character(len=*), intent(in), optional :: title          ! the title
+    character(len=*), intent(in), optional :: dictref        ! the dictionary reference
+    character(len=*), intent(in), optional :: units          ! units (' ' = none)
+    character(len=*), intent(in), optional :: fmt            ! the output format
+
+    ! splits data into lines whenever it overflows workspace/linelength
+    ! Flush on entry and exit
+    integer           :: size
+    character(len=10) :: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    size = (nvalue*(nvalue+1))/2
+    call xml_NewElement(xf, 'array')
+    call xml_AddAttribute(xf, 'size', str(size))
+    call xml_AddAttribute(xf, 'rows', str(nvalue))
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(title))   call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(units))   call xml_AddAttribute(xf, 'units', units)
+    call STMARCF9SP(xf, size, array, formt)
+    call xml_EndElement(xf, 'matrix')
+
+  END SUBROUTINE stmAddTriangleSP
+
+
+  ! -------------------------------------------------
+  ! outputs fatal error message
+  ! -------------------------------------------------
+
+  SUBROUTINE stmErrorMessage(xf, msg, id, title, dictref)
+
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*), intent(in)           :: msg            ! the message
+    character(len=*), intent(in), optional :: id             ! the id
+    character(len=*), intent(in), optional :: title          ! the title
+    character(len=*), intent(in), optional :: dictref        ! the dictionary reference
+
+    call xml_NewElement(xf, 'message')
+    call xml_AddAttribute(xf, 'severity', 'fatal')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    call xml_AddPcdata(xf, msg)
+    call xml_EndElement(xf, 'message')
+
+  END SUBROUTINE stmErrorMessage
+
+
+  ! -------------------------------------------------
+  ! outputs informational message
+  ! -------------------------------------------------
+
+  SUBROUTINE stmInfoMessage(xf, msg, id, title, dictref)
+
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*), intent(in)           :: msg            ! the message
+    character(len=*), intent(in), optional :: id             ! the id
+    character(len=*), intent(in), optional :: title          ! the title
+    character(len=*), intent(in), optional :: dictref        ! the dictionary reference
+
+    call xml_NewElement(xf, 'message')
+    call xml_AddAttribute(xf, 'severity', 'warning')
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(title))   call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    call xml_AddPcdata(xf, msg)
+    call xml_EndElement(xf, 'message')
+
+  END SUBROUTINE stmInfoMessage
+
+
+  ! -------------------------------------------------
+  ! outputs warning message
+  ! -------------------------------------------------
+
+  SUBROUTINE stmWarningMessage(xf, msg, id, title, dictref)
+
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*), intent(in)           :: msg            ! the message
+    character(len=*), intent(in), optional :: id             ! the id
+    character(len=*), intent(in), optional :: title          ! the title
+    character(len=*), intent(in), optional :: dictref        ! the dictionary reference
+
+    call xml_NewElement(xf, 'message')
+    call xml_AddAttribute(xf, 'severity', 'info')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    call xml_AddPcdata(xf, msg)
+    call xml_EndElement(xf, 'message')
+
+  END SUBROUTINE stmWarningMessage
+
+
+
+  ! =================================================
+  ! basic STMML routines
+  ! =================================================
+
+
+  ! -------------------------------------------------
+  ! creates STMML <scalar> string
+  ! -------------------------------------------------
+
+  SUBROUTINE STMSCAS9(xf, value, id, title, dictref, type)
+
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*), intent(in) :: value                 ! the value to be output
+    character(len=*), intent(in), optional :: id          ! the id
+    character(len=*), intent(in), optional :: title       ! the title
+    character(len=*), intent(in), optional :: dictref     ! the dictionary reference
+    character(len=*), intent(in), optional :: type        ! the data type (default 'xsd:string')
+
+    ! Internal variables
+    character(len=20) :: temp
+
+    call xml_NewElement(xf, 'scalar')
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(title))   call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(dictref)) call xml_AddAttribute(xf, 'title', title)
+    if (present(type))    call xml_AddAttribute(xf, 'dataType', type)
+
+!    if (XMLCHKS9(value)) then
+    call xml_AddPcdata(xf, value)
+    call xml_EndElement(xf, 'scalar')
+
+  END SUBROUTINE STMSCAS9
+
+
+
+  ! -------------------------------------------------
+  ! output start tag for an STMML array
+  ! -------------------------------------------------
+
+  SUBROUTINE STMARST9(xf, nvalue, id, title, dictref, typunt, tuval, delim)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: nvalue      ! the number of values to be output
+    character(len=*), intent(in), optional :: id          ! the id
+    character(len=*), intent(in), optional :: title       ! the title
+    character(len=*), intent(in), optional :: dictref     ! the dictionary reference
+    character(len=*), intent(in), optional :: typunt      ! 'type' (for strings) or 'unit' (for numeric)
+    character(len=*), intent(in), optional :: tuval       ! data type (default 'xsd:string') or units (' ' = none)
+    character(len=*), intent(in), optional :: delim       ! the delimiter (default ' ')
+
+    ! Internal Variables
+    character(len=1) :: delim1
+
+    if (present(delim)) then
+       delim1 = delim
+    else
+       delim1 = ' '
+    endif
+
+    call xml_NewElement(xf, 'array')
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(title))   call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(dictref)) call xml_AddAttribute(xf, 'title', title)
+    if (present(tuval))   call xml_AddAttribute(xf, 'type', tuval)
+    call xml_AddAttribute(xf, 'delimiter', delim1)
+    call xml_AddAttribute(xf, 'size', str(nvalue))
+    call xml_EndElement(xf, 'array')
+
+  END SUBROUTINE STMARST9
+
+
+
+  ! -------------------------------------------------
+  ! 2. outputs SP float array to channel
+  ! -------------------------------------------------
+
+  SUBROUTINE STMARF9SP(xf, nvalue, arrf, id, title, dictref, units, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: nvalue      ! the number of values to be output
+    real(kind=sp), intent(in)               :: arrf(*)     ! the values to be output
+    character(len=*), intent(in), optional :: id          ! the id
+    character(len=*), intent(in), optional :: title       ! the title
+    character(len=*), intent(in), optional :: dictref     ! the dictionary reference
+    character(len=*), intent(in), optional :: units       ! units (' ' = none)
+    character(len=*)                       :: fmt         ! the output format
+
+    call xml_NewElement(xf, 'scalar')
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(title))   call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(dictref)) call xml_AddAttribute(xf, 'title', title)
+    if (present(units))   call xml_AddAttribute(xf, 'units', units)
+    call xml_AddAttribute(xf, 'size', str(nvalue))
+    call STMARCF9SP(xf, nvalue, arrf, fmt)
+    call xml_NewElement(xf, 'scalar')
+
+  END SUBROUTINE STMARF9SP
+
+
+  ! -------------------------------------------------
+  ! 1. outputs content of DP float array to channel
+  ! -------------------------------------------------
+
+  SUBROUTINE STMARCF9DP(xf, nvalue, arrf, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)          :: nvalue     ! the number of values to be output
+    real(kind=dp), intent(in)     :: arrf(*)    ! the values to be output
+    character(len=*), intent(in) :: fmt        ! the output format
+
+    ! splits data into lines whenever it overflows workspace/linelength
+    integer :: i
+
+    call xml_AddPcdata(xf, str(arrf(1)))
+    do i = 2, nvalue
+       call xml_AddPcdata(xf, str(arrf(i)))
+    enddo
+  END SUBROUTINE STMARCF9DP
+
+
+  ! -------------------------------------------------
+  ! 2. outputs content of SP float array to channel
+  ! -------------------------------------------------
+
+  SUBROUTINE STMARCF9SP(xf, nvalue, arrf, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer          :: nvalue     ! the number of values to be output
+    real(kind=sp)     :: arrf(*)    ! the values to be output
+    character(len=*) :: fmt        ! the output format
+
+    ! splits data into lines whenever it overflows workspace/linelength
+    integer :: i
+
+    call xml_AddPcdata(xf, str(arrf(1)))
+    do i = 2, nvalue
+       call xml_AddPcdata(xf, str(arrf(i)))
+    enddo
+  END SUBROUTINE STMARCF9SP
+
+end module m_stmw
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/dom/flib_dom.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/dom/flib_dom.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/dom/flib_dom.f90	(revision 2528)
@@ -0,0 +1,17 @@
+module flib_dom
+
+  use m_dom_types
+  use m_dom_namednodemap
+  use m_dom_nodelist
+  use m_dom_attribute
+  use m_dom_document
+  use m_dom_node
+  use m_dom_element
+  use m_dom_parse
+  use m_dom_utils
+
+  use m_strings
+
+  public
+
+end module flib_dom
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_attribute.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_attribute.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_attribute.f90	(revision 2528)
@@ -0,0 +1,86 @@
+module m_dom_attribute
+
+use m_dom_types
+use m_dom_node
+use m_strings
+
+private
+  !-------------------------------------------------------  
+  ! METHODS FOR ATTRIBUTE NODES
+  !------------------------------------------------------- 
+
+  public :: getName
+  public :: getValue
+  public :: setValue
+
+CONTAINS
+
+  function getName(attribute)
+
+    type(fnode), intent(in) :: attribute
+    type(string)            :: getName
+
+    if (attribute % nodeType == ATTRIBUTE_NODE) then
+       getName = attribute%nodeName
+    else
+       getName = ''
+    endif
+
+  end function getName
+
+  !-----------------------------------------------------------
+
+  function getValue(attribute)
+
+    type(fnode), intent(in) :: attribute
+    type(string)            :: getValue
+
+    if (attribute % nodeType == ATTRIBUTE_NODE) then
+       getValue = attribute%nodeValue
+    else
+       getValue = ''
+    endif
+
+  end function getValue
+
+  !-----------------------------------------------------------
+
+  subroutine setValue(attribute, value)
+
+    character(len=*), intent(in) :: value
+    type(fnode), pointer  :: attribute
+
+    if (attribute % nodeType == ATTRIBUTE_NODE) then
+       call setNodeValue(attribute,value)
+    endif
+
+  end subroutine setValue
+
+  !-----------------------------------------------------------
+
+
+!!! NB Is this a good idea?
+!!! NB pure functions have no side effects
+
+  pure function attr_name_len(attribute)
+    type(fnode), intent(in) :: attribute
+    integer :: attr_name_len
+    if (attribute % nodeType == ATTRIBUTE_NODE) then
+       attr_name_len = len_trim(attribute % nodeName)
+    else
+       attr_name_len = 0
+    end if
+  end function attr_name_len
+  
+  pure function attr_val_len(attribute)   
+    type(fnode), intent(in) :: attribute
+    integer :: attr_val_len
+    if (attribute % nodeType == ATTRIBUTE_NODE) then
+       attr_val_len = len_trim(attribute % nodeValue)
+    else
+       attr_val_len = 0
+    end if
+  end function attr_val_len
+
+
+end module m_dom_attribute
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_debug.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_debug.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_debug.f90	(revision 2528)
@@ -0,0 +1,5 @@
+module m_dom_debug
+
+  logical, save, public :: dom_debug = .false.
+
+end module m_dom_debug
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_document.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_document.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_document.f90	(revision 2528)
@@ -0,0 +1,113 @@
+module m_dom_document
+
+use m_dom_types
+use m_strings
+
+private
+
+  !-------------------------------------------------------  
+  ! METHODS FOR DOCUMENT NODES
+  !-------------------------------------------------------   
+  public :: createDocumentNode
+  public :: createDocumentFragment
+  public :: createTextNode
+  public :: createAttribute
+  public :: createElement
+  public :: createComment
+  public :: createCdataSection
+
+CONTAINS
+
+  !-----------------------------------------------------------
+  ! METHODS FOR DOCUMENT NODES
+  !-----------------------------------------------------------
+
+  function createDocumentNode()
+
+    type(fnode), pointer :: createDocumentNode
+    
+    createDocumentNode => createNode()
+    createDocumentNode % nodeType = DOCUMENT_NODE
+    createDocumentNode % nodeName = "#document"
+    
+  end function createDocumentNode
+!-------------------------------------------------------------------
+  function createDocumentFragment()
+
+    type(fnode), pointer :: createDocumentFragment
+    
+    createDocumentFragment => createNode()
+    createDocumentFragment % nodeType = DOCUMENT_FRAGMENT_NODE
+    createDocumentFragment % nodeName = "#document-fragment"
+    
+  end function createDocumentFragment
+!-------------------------------------------------------------------
+  function createTextNode(data)
+
+    character(len=*), intent(in) :: data
+    type(fnode), pointer :: createTextNode
+    
+    createTextNode => createNode()
+    createTextNode % nodeType = TEXT_NODE
+    createTextNode % nodeName = "#text"
+    createTextNode % nodeValue = data  ! NB need to split this string 
+                                       ! across several nodes 
+    
+  end function createTextNode
+
+  !-----------------------------------------------------------
+
+  function createAttribute(name)
+    
+    character(len=*), intent(in) :: name
+    type(fnode), pointer :: createAttribute
+  
+    createAttribute => createNode()
+    createAttribute % nodeName = name
+    createAttribute % nodeType = ATTRIBUTE_NODE
+  
+  end function createAttribute
+
+  !-----------------------------------------------------------
+
+  function createElement(tagName)
+    
+    character(len=*), intent(in) :: tagName
+    type(fnode), pointer :: createElement
+  
+    createElement => createNode()
+    createElement % nodeName = tagName
+    createElement % nodeType = ELEMENT_NODE
+  
+  end function createElement
+
+  !-----------------------------------------------------------
+
+  function createComment(data)
+    
+    character(len=*), intent(in) :: data
+    type(fnode), pointer :: createComment
+  
+    createComment => createNode()
+    createComment % nodeName = "#comment"
+    createComment % nodeValue = data
+    createComment % nodeType = COMMENT_NODE
+  
+  end function createComment
+
+  !-----------------------------------------------------------
+
+  function createCdataSection(data)
+    
+    character(len=*), intent(in) :: data
+    type(fnode), pointer :: createCdataSection
+  
+    createCdataSection => createNode()
+    createCdataSection % nodeName = "#cdata-section"
+    createCdataSection % nodeValue = data
+    createCdataSection % nodeType = CDATA_SECTION_NODE
+  
+  end function createCdataSection
+
+  
+end module m_dom_document
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_element.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_element.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_element.f90	(revision 2528)
@@ -0,0 +1,242 @@
+module m_dom_element
+
+use m_dom_types
+use m_dom_namednodemap
+use m_dom_nodelist
+use m_dom_attribute
+use m_dom_document
+use m_dom_debug
+use m_dom_node
+use m_strings
+
+private
+
+  !-------------------------------------------------------   
+  ! METHODS FOR ELEMENT NODES
+  !-------------------------------------------------------   
+  public :: getTagName
+  public :: getElementsByTagName
+  public :: getAttribute
+  public :: getAttributeNode
+  public :: setAttribute
+  public :: setAttributeNode
+  public :: removeAttribute
+  public :: normalize       !--- combines adjacent text nodes ---!
+
+CONTAINS
+
+  !-----------------------------------------------------------
+  !  METHODS FOR ELEMENT NODES
+  !-----------------------------------------------------------
+  function getTagName(element)
+
+    type(fnode), intent(in) :: element   
+    type(string)            :: getTagName
+
+    if (element % nodeType == ELEMENT_NODE) then
+       getTagName = element % nodeName 
+    else
+       getTagName = ''
+    endif
+
+  end function getTagName
+
+  !-----------------------------------------------------------
+  function getElementsByTagName(element, tag) result(nodelist)
+    type(fnode), pointer         :: element
+    character(len=*), intent(in) :: tag
+    type(fnodeList), pointer     :: nodelist 
+
+    type(fnode), pointer        :: np
+
+    nodelist => null()
+
+    np => element
+    if (dom_debug) print *, "Going into search for tag: ", trim(tag)
+    call search(np)
+
+    CONTAINS
+
+    recursive subroutine search(np)
+    type(fnode), pointer        :: np
+
+    type(string)                :: name
+
+    !
+    ! Could replace the calls to helper methods by direct lookups of node 
+    ! components to make it faster.
+    ! 
+    do
+       if (.not. associated(np)) exit
+       select case(np%nodeType)
+
+          case(DOCUMENT_NODE) 
+             ! special case ... search its children 
+             if (hasChildNodes(np)) call search(getFirstChild(np))
+             ! will exit for lack of siblings
+          case(ELEMENT_NODE)
+
+             name = getNodeName(np)
+             if (dom_debug) print *, "exploring node: ", char(name)
+             if ((tag == "*") .or. (tag == name)) then
+                call append(nodelist,np)
+                if (dom_debug) print *, "found match ", nodelist%length
+             endif
+             if (hasChildNodes(np)) call search(getFirstChild(np))
+
+          case default
+             
+             ! do nothing
+
+        end select
+
+        if (associated(np,element)) exit  ! no siblings of element...
+        np => getNextSibling(np)
+
+     enddo
+    
+    end subroutine search
+
+  end function getElementsByTagName
+
+  !-----------------------------------------------------------
+
+  function getAttribute(element, name)
+    
+    type(fnode), intent(in) :: element
+    character(len=*), intent(in) :: name
+    type(string)                 :: getAttribute
+
+    type(fnode), pointer :: nn
+
+    getAttribute = ""  ! as per specs, if not found
+    if (element % nodeType /= ELEMENT_NODE) RETURN
+    nn => getNamedItem(element%attributes,name)
+    if (.not. associated(nn)) RETURN
+    
+    getAttribute = nn%nodeValue
+
+        
+  end function getAttribute
+
+  !-----------------------------------------------------------
+
+  function getAttributeNode(element, name)
+    
+    type(fnode), intent(in) :: element
+    type(fnode), pointer    :: getAttributeNode
+    character(len=*), intent(in) :: name
+
+    getAttributeNode => null()     ! as per specs, if not found
+    if (element % nodeType /= ELEMENT_NODE) RETURN
+    getAttributeNode => getNamedItem(element%attributes,name)
+
+  end function getAttributeNode
+  
+  !-----------------------------------------------------------
+
+  subroutine setAttributeNode(element, newattr)
+    type(fnode), pointer :: element
+    type(fnode), pointer :: newattr
+
+    type(fnode), pointer :: dummy
+
+    if (element % nodeType /= ELEMENT_NODE) then
+       if (dom_debug) print *, "not an element node in setAttributeNode..."
+       RETURN
+    endif
+
+    dummy => setNamedItem(element%attributes,newattr)
+     
+  end subroutine setAttributeNode
+
+!-------------------------------------------------------------------
+  subroutine setAttribute(element, name, value)
+    type(fnode), pointer :: element
+    character(len=*), intent(in) :: name
+    character(len=*), intent(in) :: value
+
+    type(fnode), pointer      :: newattr
+
+    newattr => createAttribute(name)
+    call setValue(newattr,value)
+    call setAttributeNode(element,newattr)
+
+  end subroutine setAttribute
+
+  !-----------------------------------------------------------
+
+  subroutine removeAttribute(element, name)
+    type(fnode), pointer :: element
+    character(len=*), intent(in) :: name
+
+    type(fnode), pointer :: dummy
+
+    if (element % nodeType /= ELEMENT_NODE) RETURN
+    if (.not. associated(element%attributes)) RETURN
+
+    dummy => removeNamedItem(element%attributes,name)
+     
+  end subroutine removeAttribute
+
+  !-----------------------------------------------------------
+  recursive subroutine normalize(element)
+    type(fnode), pointer         :: element
+
+    type(fnode), pointer        :: np, ghost
+    logical                     :: first
+
+    type(fnode), pointer        :: head
+
+    first = .true.  ! next Text node will be first
+
+    if (dom_debug) print *, "Normalizing: ", trim(element%nodeName)
+    np => element%firstChild
+    ! 
+    do
+       if (.not. associated(np)) exit
+       select case(np%nodeType)
+
+          case(TEXT_NODE) 
+             if (first) then
+                if (dom_debug) print *, "normalize: found first in chain"
+                head => np
+                first = .false.
+                np => getNextSibling(np)
+             else                    ! a contiguous text node
+                if (dom_debug) print *, "normalize: found second in chain"
+                head%nodeValue = head%nodeValue // np%nodeValue
+                head%nextSibling => np%nextSibling
+                if (associated(np,np%parentNode%lastChild)) then
+                   np%parentNode%lastChild => head
+                   head%nextSibling => null()
+                else
+                   np%nextSibling%previousSibling => head
+                endif
+                ghost => np
+                np => getNextSibling(np)
+                call destroyNode(ghost)
+             endif
+
+          case(ELEMENT_NODE)
+
+             first = .true.
+             if (dom_debug) print *, "element sibling: ", trim(np%nodeName)
+             if (hasChildNodes(np)) call normalize(np)
+             np => getNextSibling(np)
+
+          case default
+             
+             ! do nothing, just mark that we break the chain of text nodes
+             if (dom_debug) print *, "other sibling: ", trim(np%nodeName)
+             first = .true.
+             np => getNextSibling(np)
+
+        end select
+
+     enddo
+
+    end subroutine normalize
+
+
+end module m_dom_element
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_error.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_error.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_error.f90	(revision 2528)
@@ -0,0 +1,35 @@
+module m_dom_error
+
+  !-------------------------------------------------------
+  ! EXCEPTION CODES
+  !-------------------------------------------------------
+  integer, parameter, public :: INDEX_SIZE_ERR              = 1
+  integer, parameter, public :: DOMSTRING_SIZE_ERR          = 2
+  integer, parameter, public :: HIERARCHY_REQUEST_ERR       = 3
+  integer, parameter, public :: WRONG_DOCUMENT_ERR          = 4
+  integer, parameter, public :: INVALID_CHARACTER_ERR       = 5
+  integer, parameter, public :: NO_DATA_ALLOWED_ERR         = 6
+  integer, parameter, public :: NO_MODIFICATION_ALLOWED_ERR = 7
+  integer, parameter, public :: NOT_FOUND_ERR               = 8
+  integer, parameter, public :: NOT_SUPPORTED_ERR           = 9
+  integer, parameter, public :: INUSE_ATTRIBUTE_ERR         = 10
+  integer, parameter, public :: INVALID_STATE_ERR           = 11
+  integer, parameter, public :: SYNTAX_ERR                  = 12
+  integer, parameter, public :: INVALID_MODIFICATION_ERR    = 13
+  integer, parameter, public :: NAMESPACE_ERR               = 14
+  integer, parameter, public :: INVALID_ACCESS_ERR          = 15
+  integer, parameter, public :: VALIDATION_ERR              = 16
+  integer, parameter, public :: TYPE_MISMATCH_ERR           = 17
+
+CONTAINS
+
+  subroutine dom_error(name,code,msg)
+    character(len=*), intent(in) :: name, msg
+    integer, intent(in)          :: code
+
+    print *, "***ERROR***"
+    print *, "Routine ", trim(name), ":", trim(msg)
+    print *, 1.0 / sin(3.141592654)
+  end subroutine dom_error
+
+end module m_dom_error
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_namednodemap.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_namednodemap.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_namednodemap.f90	(revision 2528)
@@ -0,0 +1,203 @@
+module m_dom_namednodemap
+!
+! This is basically a dictionary module, but written with the
+! DOM node structure in mind.
+!
+use m_dom_types
+use m_strings
+
+private
+  !-------------------------------------------------------  
+  ! METHODS FOR NAMEDNODEMAPS
+  !-------------------------------------------------------   
+  public :: getNamedItem
+  public :: setNamedItem
+  public :: removeNamedItem
+
+  public :: item
+  public :: getLength
+  public :: append
+
+  interface append
+     module procedure append_nnm
+  end interface
+
+  interface item
+     module procedure item_nnm
+  end interface 
+
+  interface getLength
+     module procedure getLength_nnm
+  end interface
+
+CONTAINS
+
+  function item_nnm(namedNodeMap, i)
+    
+    integer, intent(in)             :: i
+    type(fnamedNodeMap), pointer    :: namedNodeMap
+    type(fnode), pointer            :: item_nnm
+    
+    type(fnamedNode), pointer :: nnp
+
+    integer :: n
+
+    item_nnm => null()            ! In case there is no such item
+    if (.not. associated(namedNodeMap)) RETURN
+
+    nnp => namedNodeMap%head
+    n = -1
+    do 
+       if (.not. associated(nnp))  exit
+       n = n + 1
+       if (n == i) then
+          item_nnm => nnp%node
+          exit
+       endif
+       nnp => nnp%next
+    enddo
+
+  end function item_nnm
+
+  !----------------------------------------------------------- 
+  
+  function getLength_nnm(namedNodeMap)
+  
+    type(fnamedNodeMap), pointer :: namedNodeMap
+    integer :: getLength_nnm
+
+    getLength_nnm = 0
+    if (.not. associated(namedNodeMap)) return
+
+    getLength_nnm = namedNodeMap % length    
+    
+  end function getLength_nnm
+
+  !----------------------------------------------------------- 
+
+
+  subroutine append_nnm(nodeMap,node)
+    type(fnamednodeMap), pointer :: nodeMap
+    type(fnode), pointer :: node
+
+    if (.not. associated(nodeMap)) then
+       allocate(nodeMap)
+       nodeMap%length = 1
+       allocate(nodeMap%head)
+       nodeMap%head%name = node%nodeName
+       nodeMap%head%node => node
+       nodeMap%tail => nodeMap%head
+    else
+       allocate(nodeMap%tail%next)
+       nodeMap%tail%next%node => node
+       nodeMap%tail%next%name =  node%nodeName
+       nodeMap%tail => nodeMap%tail%next
+       nodeMap%length = nodeMap%length + 1
+    endif
+
+  end subroutine append_nnm
+
+  !----------------------------------------------------------- 
+
+  function getNamedItem(namedNodeMap, name)
+    
+    type(fnamedNodeMap), pointer    :: namedNodeMap
+    character(len=*), intent(in)    :: name
+    type(fnode), pointer            :: getNamedItem
+
+    type(fnamedNode), pointer :: nnp
+
+    getNamedItem => null()
+    if (.not. associated(namedNodeMap)) return 
+
+    nnp => namedNodeMap%head
+    do while (associated(nnp)) 
+       if (nnp%name == name) then
+          getNamedItem => nnp%node
+          exit                 ! one or zero nodes with a given name
+       endif
+       nnp => nnp%next
+    enddo
+
+  end function getNamedItem
+
+  
+  function setNamedItem(namedNodeMap, node)
+
+!!AG: Do we need to clone the node ?
+    
+    type(fnamedNodeMap), pointer    :: namedNodeMap
+    type(fnode), pointer            :: node
+    type(fnode), pointer            :: setNamedItem
+
+    type(fnamedNode), pointer :: nnp
+
+    if (.not. associated(namedNodeMap)) then
+
+       call append(namedNodeMap,node)
+       setNamedItem => node
+      
+    else
+
+       nnp => namedNodeMap%head
+       do while (associated(nnp)) 
+          if (nnp%name == node%nodeName) then
+             setNamedItem => nnp%node
+             nnp%node => node
+             setNamedItem => node
+             return
+          endif
+          nnp => nnp%next
+       enddo
+
+       !   If not found, insert it at the end of the linked list
+
+       call append(namedNodeMap,node)
+       setNamedItem => node
+    endif
+
+  end function setNamedItem
+
+!------------------------------------------------------------
+   function removeNamedItem(namedNodeMap, name)
+    
+    type(fnamedNodeMap), pointer   :: namedNodeMap
+    character(len=*), intent(in)   :: name
+    type(fnode), pointer           :: removeNamedItem
+
+    type(fnamedNode), pointer :: nnp, previous
+
+    removeNamedItem => null()
+    if (.not. associated(namedNodeMap)) return  
+
+    previous => null()
+    nnp => namedNodeMap%head
+    do while (associated(nnp)) 
+       if (nnp%name == name) then
+          removeNamedItem => nnp%node
+          if (associated(nnp,namedNodeMap%head)) then
+             ! we remove the first fnamedNode in the chain...
+             namedNodeMap%head => nnp%next
+          else if (.not. associated(nnp%next)) then
+             ! we remove the last fnamedNode in the chain
+             previous%next => null()
+             namedNodeMap%tail => previous
+          else
+             ! we remove a link in the middle of the chain
+             previous%next => nnp%next
+          endif
+          namedNodeMap%length =  namedNodeMap%length - 1
+          call unstring(nnp%name)
+          deallocate(nnp)
+          EXIT                 ! one or zero nodes with a given name
+       endif
+       previous => nnp
+       nnp => nnp%next
+    enddo
+
+  end function removeNamedItem
+
+
+
+end module m_dom_namednodemap
+
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_node.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_node.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_node.f90	(revision 2528)
@@ -0,0 +1,560 @@
+module m_dom_node
+
+use m_dom_types
+use m_dom_nodelist
+use m_dom_namednodemap
+use m_dom_debug
+use m_dom_error
+
+use m_strings
+
+private
+
+  !-------------------------------------------------------   
+  ! METHODS FOR NODES
+  !-------------------------------------------------------   
+
+  public :: getNodeName
+  public :: getNodevalue	
+  public :: getNodeType
+  public :: hasChildNodes
+  public :: hasAttributes
+  public :: getParentNode
+  public :: getFirstChild
+  public :: getLastChild
+  public :: getNextSibling
+  public :: getPreviousSibling
+  public :: getOwnerDocument
+  public :: getAttributes
+  public :: getChildNodes
+  public :: setNodeValue
+  public :: appendChild
+  public :: removeChild
+  public :: replaceChild
+  public :: cloneNode  
+  public :: isSameNode
+  public :: insertBefore
+
+  private :: name_len, value_len
+
+CONTAINS
+
+  pure function name_len(node)
+    type(fnode), pointer :: node
+    integer :: name_len
+
+    name_len = len_trim(node % nodeName)
+
+  end function name_len
+
+  pure function value_len(node)
+    type(fnode), pointer :: node
+    integer :: value_len
+
+    value_len = len_trim(node % nodeValue)
+
+  end function value_len
+
+  !-----------------------------------------------------------
+  !  METHODS FOR NODES
+  !-----------------------------------------------------------
+  function getNodeName(node)
+
+    type(fnode), pointer :: node
+!    character(len=len_trim(node%nodeName)) :: getNodeName
+    type(string)  :: getNodeName
+    if (.not. associated(node))  &
+               call dom_error("getNodeName",0,"Node not allocated")
+    getNodeName = node % nodeName
+
+  end function getNodeName
+
+  !-----------------------------------------------------------
+
+  function getNodeValue(node)
+
+    type(fnode), pointer :: node
+!    character(len=len_trim(node%nodeValue)) :: getNodeValue
+    type(string)  :: getNodeValue
+
+    if (.not. associated(node))  &
+               call dom_error("getNodeValue",0,"Node not allocated")
+    getNodeValue = node % nodeValue
+
+  end function getNodeValue
+
+  !-----------------------------------------------------------
+
+  function getNodeType(node)
+
+    type(fnode), pointer :: node
+    integer :: getNodeType
+
+    if (.not. associated(node)) call dom_error("getNodeType",0,"Node not allocated")
+    getNodeType = node % nodeType
+
+  end function getNodeTYpe
+
+  !-----------------------------------------------------------
+
+  function hasChildNodes(node)
+
+    type(fnode), pointer :: node
+    logical :: hasChildNodes
+
+    if (.not. associated(node)) call dom_error("hasChildNodes",0,"Node not allocated")
+    hasChildNodes = associated(node % firstChild)
+
+  end function hasChildNodes
+
+  !-----------------------------------------------------------
+
+  function hasAttributes(node)
+
+    type(fnode), pointer    :: node
+    logical                 :: hasAttributes
+
+    hasAttributes = .false.
+    if (.not. associated(node)) call dom_error("hasAttributes",0,"Node not allocated")
+    if (node % nodeType /= ELEMENT_NODE) RETURN
+    if ( getLength(node%attributes) > 0) hasAttributes = .true.
+
+  end function hasAttributes
+
+  !-----------------------------------------------------------
+
+  function getParentNode(node)
+
+    type(fnode), pointer    :: node
+    type(fnode), pointer    :: getParentNode
+
+    if (.not. associated(node)) call dom_error("getParentNode",0,"Node not allocated")
+    getParentNode => node % parentNode
+    
+  end function getParentNode
+  
+  !-----------------------------------------------------------
+
+  function getFirstChild(node)
+
+    type(fnode), pointer    :: node
+    type(fnode), pointer    :: getFirstChild
+
+    if (.not. associated(node)) call dom_error("getFirstChild",0,"Node not allocated")
+    getFirstChild => node % firstChild
+
+  end function getFirstChild
+
+  !-----------------------------------------------------------
+
+  function getLastChild(node)
+
+    type(fnode), pointer :: node
+    type(fnode), pointer    :: getLastChild
+
+    if (.not. associated(node)) call dom_error("getLastChild",0,"Node not allocated")
+    getLastChild => node % lastChild
+
+  end function getLastChild
+
+  !-----------------------------------------------------------
+
+  function getNextSibling(node)
+
+    type(fnode), pointer :: node
+    type(fnode), pointer    :: getNextSibling
+
+    if (.not. associated(node)) call dom_error("getNextSibling",0,"Node not allocated")
+    getNextSibling => node % nextSibling
+
+  end function getNextSibling
+
+  !-----------------------------------------------------------
+
+  function getPreviousSibling(node)
+
+    type(fnode), pointer     :: node
+    type(fnode), pointer    :: getPreviousSibling
+
+    if (.not. associated(node)) call dom_error("getPreviousSibling",0,"Node not allocated")
+    getPreviousSibling => node % previousSibling
+
+  end function getPreviousSibling
+
+  !-----------------------------------------------------------
+
+  function getOwnerDocument(node)
+
+    type(fnode), pointer    :: node
+    type(fnode), pointer    :: getOwnerDocument
+
+    if (.not. associated(node)) call dom_error("getOwnerDocument",0,"Node not allocated")
+    getOwnerDocument => node % ownerDocument
+
+  end function getOwnerDocument
+
+  !----------------------------------------------------------- 
+
+  function getChildNodes(node) result(nodelist)
+    
+    type(fnode), pointer        :: node
+    type(fnodeList), pointer    :: nodelist      !!! NB nodeList
+
+    type(fnode), pointer        :: np
+
+    if (.not. associated(node)) call dom_error("getChildNodes",0,"Node not allocated")
+    nodelist => null()
+    np => node%firstChild
+    do 
+       if (.not. associated(np)) exit
+       call append(nodelist,np)
+       np => np%nextSibling
+    enddo
+
+  end function getChildNodes
+
+  !----------------------------------------------------------- 
+
+  function getAttributes(node)
+
+    type(fnode), pointer         :: node
+    type(fnamedNodeMap), pointer :: getAttributes       !!! NB namedNodeMap
+    
+    if (.not. associated(node))  &
+               call dom_error("getAttributes",0,"Node not allocated")
+    getAttributes => node % attributes
+
+  end function getAttributes
+
+  !----------------------------------------------------------- 
+
+  subroutine setNodeValue(node, value)
+
+    type(fnode), pointer :: node
+    character(len=*), intent(in) :: value
+    
+    if (.not. associated(node))  &
+               call dom_error("setNodeValue",0,"Node not allocated")
+
+    select case(node % nodeType)
+
+    case(ATTRIBUTE_NODE)
+       node % nodeValue = trim(value)    !!AG: use just value ??
+
+    case(COMMENT_NODE)
+       node % nodeValue = value
+
+    case(TEXT_NODE)
+       node % nodeValue = value
+
+    case(PROCESSING_INSTRUCTION_NODE)
+       node % nodeValue = value
+
+    case(CDATA_SECTION_NODE)
+       node % nodeValue = value
+
+    end select
+
+  end subroutine setNodeValue
+
+  !-----------------------------------------------------------
+  
+  function appendChild(node, newChild)
+    type(fnode), pointer :: node
+    type(fnode), pointer :: newChild
+    type(fnode), pointer :: appendChild
+    
+    if (.not. associated(node))  & 
+               call dom_error("appendChild",0,"Node not allocated")
+
+    if ((node%nodeType /= ELEMENT_NODE) .and. &
+        (node%nodeType /= DOCUMENT_NODE)) &
+    call dom_error("appendChild",HIERARCHY_REQUEST_ERR, &
+           "this node cannot have children")
+
+    if (.not.(associated(node % firstChild))) then
+       node % firstChild => newChild
+    else 
+       newChild % previousSibling   => node % lastChild
+       node % lastChild % nextSibling => newChild 
+    endif
+
+    node % lastChild               => newChild
+    newChild % parentNode          => node
+    newChild % ownerDocument       => node % ownerDocument
+    node%nc  = node%nc + 1
+
+    appendChild => newChild
+
+  end function appendChild
+
+  !-----------------------------------------------------------
+  
+  function removeChild(node, oldChild)
+
+    type(fnode), pointer :: removeChild
+    type(fnode), pointer :: node
+    type(fnode), pointer :: oldChild
+    type(fnode), pointer :: np
+    
+    if (.not. associated(node)) call dom_error("removeChild",0,"Node not allocated")
+    np => node % firstChild
+
+    do while (associated(np))
+       if (associated(np, oldChild)) then   ! Two argument form 
+                                              !  of associated()
+          if (associated(np,node%firstChild)) then
+             node%firstChild => np%nextSibling
+             if (associated(np % nextSibling)) then
+                np%nextSibling % previousSibling => null()
+             else
+                node%lastChild => null()    ! there was just 1 node
+             endif
+          else if (associated(np,node%lastChild)) then
+             ! one-node-only case covered above
+             node%lastChild => np%previousSibling
+             np%previousSibling%nextSibling => null()
+          else
+             np % previousSibling % nextSibling => np % nextSibling
+             np % nextSibling % previousSibling => np % previousSibling
+          endif
+          node%nc = node%nc -1
+          np % previousSibling => null()    ! Are these necessary?
+          np % nextSibling => null()
+          np % parentNode => null()
+          removeChild => oldChild
+          RETURN
+       endif
+       np => np % nextSibling
+    enddo
+
+    call dom_error("removeChild",NOT_FOUND_ERR,"oldChild not found")
+
+  end function removeChild
+
+ !-----------------------------------------------------------
+  
+  function replaceChild(node, newChild, oldChild)
+
+    type(fnode), pointer :: replaceChild
+    type(fnode), pointer :: node
+    type(fnode), pointer :: newChild
+    type(fnode), pointer :: oldChild
+
+    type(fnode), pointer :: np
+    
+    if (.not. associated(node)) call dom_error("replaceChild",0,"Node not allocated")
+    if ((node%nodeType /= ELEMENT_NODE) .and. &
+        (node%nodeType /= DOCUMENT_NODE)) &
+    call dom_error("replaceChild",HIERARCHY_REQUEST_ERR, &
+           "this node cannot have children")
+
+    np => node % firstChild
+
+    do while (associated(np))    
+       if (associated(np, oldChild)) then
+          if (associated(np,node%firstChild)) then
+             node%firstChild => newChild
+             if (associated(np % nextSibling)) then
+                oldChild%nextSibling % previousSibling => newChild
+             else
+                node%lastChild => newChild    ! there was just 1 node
+             endif
+          else if (associated(np,node%lastChild)) then
+             ! one-node-only case covered above
+             node%lastChild => newChild
+             oldChild%previousSibling%nextSibling => newChild
+          else
+             oldChild % previousSibling % nextSibling => newChild
+             oldChild % nextSibling % previousSibling => newChild
+          endif
+
+          newChild % parentNode      => oldChild % parentNode
+          newChild % nextSibling     => oldChild % nextSibling
+          newChild % previousSibling => oldChild % previousSibling
+          replaceChild => oldChild
+          RETURN
+       endif
+       np => np % nextSibling
+    enddo
+
+    call dom_error("replaceChild",NOT_FOUND_ERR,"oldChild not found")
+
+  end function replaceChild
+
+  !-----------------------------------------------------------
+
+  function cloneNode(node, deep)             
+    type(fnode), pointer :: cloneNode
+    type(fnode), pointer :: node
+
+    logical, optional :: deep
+    logical           :: do_children
+
+    type(fnode), pointer :: original
+    type(fnode), pointer :: parent_clone
+    
+    if (.not. associated(node)) call dom_error("cloneNode",0,"Node not allocated")
+
+    do_children = .false.
+    if (present(deep)) then
+       do_children = deep
+    endif
+    
+    original => node             ! Keep node
+    cloneNode => null()
+    parent_clone => null()
+    call recursive_clone(original, cloneNode)
+    cloneNode%parentNode => null()     ! as per specs   , superfÃluous
+ 
+  Contains
+
+    recursive subroutine recursive_clone(original, cloneNode)
+      type(fnode), pointer :: original        ! node to clone
+      type(fnode), pointer :: cloneNode       ! new node
+
+      type(fnode), pointer :: np, clone
+      type(fnode), pointer :: previous_clone, attr, newattr
+      type(string)         :: name
+      logical :: first_sibling
+      integer :: i
+
+      np => original
+      previous_clone => null()
+      first_sibling = .true.
+      do 
+
+         ! Keep going across siblings
+         ! (2nd and lower levels only)
+
+         if (.not.(associated(np))) EXIT
+
+
+         !----------------------------------------------------!
+         clone => createNode()
+         if (first_sibling) then
+            cloneNode => clone       ! Rest of siblings are chained
+                                     ! automatically, but must not
+                                     ! be aliases of cloneNode !!
+            first_sibling = .false.
+         endif
+         clone % nodeName    = np % nodeName
+         name = np%nodeName
+         if (dom_debug) print *, "Cloning ", char(name)
+         clone % nodeValue   = np % nodeValue
+         clone % nodeType    = np % nodeType
+         clone % ownerDocument => np % ownerDocument
+         clone % parentNode  => parent_clone
+         !
+         ! always deep copy attributes, as per specs
+         ! Note that this will not work for "deep" attributes, with
+         ! hanging entity nodes, etc
+         if (associated(np % attributes)) then
+            do i = 0, getLength(np%attributes) - 1
+               attr => item(np%attributes,i)
+               newattr => createNode()
+               newattr%nodeName = getNodeName(attr)
+               newattr%nodeValue = getNodeValue(attr)
+               newattr%nodeType = ATTRIBUTE_NODE
+               call append(clone%attributes, newattr)
+            enddo
+         endif
+
+         ! Deal with first sibling
+         if (associated(previous_clone)) then
+            if (dom_debug) print *, "linking to previous sibling"
+            previous_clone%nextSibling => clone
+            clone%previousSibling => previous_clone
+         else
+            if (dom_debug) print *, "marking as first child of parent"
+            if (associated(parent_clone))  &
+                           parent_clone%firstChild => clone
+         endif
+
+         ! Deal with last sibling
+         if (.not. associated(np%nextSibling)) then
+            if (dom_debug) print *, "this is the last sibling"
+            if (associated(parent_clone)) then
+               if (dom_debug) print *, "marking as last child of parent"
+               parent_clone%lastChild => clone
+            endif
+         endif
+            
+         if (do_children .and. associated(np%firstChild)) then
+            parent_clone => clone
+            if (dom_debug) print *, ".... going for its children"
+            call recursive_clone(np%firstChild,clone%firstChild)
+            parent_clone => clone%parentNode
+         endif
+
+         if (associated(np,node)) then
+            if (dom_debug) print *, "No more siblings of ", char(name)
+            EXIT  ! no siblings of master node
+         endif
+         np => np % nextSibling
+         previous_clone => clone
+
+      enddo 
+
+    end subroutine recursive_clone
+
+  end function cloneNode
+
+  !-----------------------------------------------------------
+
+  function isSameNode(node1, node2)    ! DOM 3.0
+    type(fnode), pointer :: node1
+    type(fnode), pointer :: node2
+    logical :: isSameNode
+
+    isSameNode = associated(node1, node2)
+
+  end function isSameNode
+
+  !-----------------------------------------------------------
+
+  function insertBefore(node, newChild, refChild)
+    type(fnode), pointer :: insertBefore
+    type(fnode), pointer :: node
+    type(fnode), pointer :: newChild
+    type(fnode), pointer :: refChild
+    type(fnode), pointer :: np
+
+    if (.not. associated(node)) call dom_error("insertBefore",0,"Node not allocated")
+    if ((node%nodeType /= ELEMENT_NODE) .and. &
+        (node%nodeType /= DOCUMENT_NODE)) &
+    call dom_error("insertBefore",HIERARCHY_REQUEST_ERR, &
+           "cannot insert node here")
+
+    if (.not.associated(refChild)) then
+       insertBefore => appendChild(node, newChild)
+       RETURN
+    endif
+
+    np => node % firstChild
+    do while (associated(np))
+       if (associated(np, refChild)) then
+          if (associated(np,node%firstChild)) then
+             node%firstChild => newChild
+          else
+             refChild%previousSibling%nextSibling => newChild
+          endif
+
+          refChild % previousSibling => newChild
+          newChild % nextSibling => refChild
+          newChild % parentNode => node
+          newChild % ownerDocument => refChild % ownerDocument
+          insertBefore => newChild
+          RETURN
+       endif
+       np => np % nextSibling
+    enddo
+
+    call dom_error("insertBefore",NOT_FOUND_ERR,"refChild not found")
+
+  end function insertBefore
+
+!----------------------------------------------------------------------
+
+end module m_dom_node
+
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_nodelist.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_nodelist.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_nodelist.f90	(revision 2528)
@@ -0,0 +1,89 @@
+module m_dom_nodelist
+
+use m_dom_types
+
+private
+
+public :: item
+public :: getLength
+public :: append
+
+interface append
+   module procedure append_nl
+end interface
+
+interface item
+   module procedure item_nl
+end interface
+
+interface getLength
+   module procedure getLength_nl
+end interface
+
+CONTAINS
+
+  !-----------------------------------------------------------
+  ! METHODS FOR NODELISTS
+  !-----------------------------------------------------------
+  function item_nl(nodeList, i)
+    
+    integer, intent(in)             :: i
+    type(fnodeList), pointer        :: nodeList
+    type(fnode), pointer            :: item_nl
+    
+    type(flistNode), pointer :: lp
+    integer :: n
+
+    item_nl => null()            ! In case there is no such item
+    if (.not. associated(nodeList)) RETURN
+
+    lp => nodeList%head
+    n = -1
+    do 
+       if (.not. associated(lp))  exit
+       n = n + 1
+       if (n == i) then
+          item_nl => lp%node
+          exit
+       endif
+       lp => lp%next
+    enddo
+
+  end function item_nl
+
+  !----------------------------------------------------------- 
+
+  function getLength_nl(nodeList)
+    
+    type(fnodeList), pointer :: nodeList
+    integer                  :: getLength_nl
+
+    if (.not. associated(nodeList)) then
+       getLength_nl = 0
+    else
+       getLength_nl = nodeList % length
+    endif
+
+  end function getLength_nl
+
+  subroutine append_nl(nodeList,node)
+    type(fnodeList), pointer :: nodeList
+    type(fnode), pointer :: node
+
+    if (.not. associated(nodeList)) then
+       allocate(nodeList)
+       nodelist%length = 1
+       allocate(nodelist%head)
+       nodelist%head%node => node
+       nodelist%tail => nodelist%head
+    else
+       allocate(nodelist%tail%next)
+       nodelist%tail%next%node => node
+       nodelist%tail => nodelist%tail%next
+       nodelist%length = nodelist%length + 1
+    endif
+
+  end subroutine append_nl
+
+end module m_dom_nodelist
+
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_parse.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_parse.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_parse.f90	(revision 2528)
@@ -0,0 +1,152 @@
+module m_dom_parse
+
+  use m_dom_types
+  use m_dom_element
+  use m_dom_document
+  use m_dom_node
+!  use m_dom_namednodemap
+  use m_dom_debug
+
+  use flib_sax
+
+  implicit none
+  
+  private
+
+  public :: parsefile
+
+  type(fnode), pointer, private, save  :: main
+  type(fnode), pointer, private, save  :: current
+
+
+CONTAINS
+
+  subroutine begin_element_handler(name,attrs)
+
+    character(len=*),   intent(in) :: name
+    type(dictionary_t), intent(in) :: attrs
+   
+    type(fnode), pointer :: temp
+    character(len=400)   :: attr_name, attr_value
+    integer              :: status
+    integer              :: i
+
+    if (dom_debug) print *, "Adding node for element: ", name
+
+    temp => createElement(name)
+    current => appendChild(current,temp)
+!
+!   Add attributes
+!
+    do i = 1, len(attrs)
+       call get_name(attrs, i, attr_name, status)
+       call get_value(attrs, attr_name, attr_value, status)
+       if (dom_debug) print *, "Adding attribute: ", &
+                       trim(attr_name), ":",trim(attr_value)
+       call setAttribute(current,attr_name,attr_value)
+    enddo
+
+  end subroutine begin_element_handler
+
+!---------------------------------------------------------
+
+  subroutine end_element_handler(name)
+    character(len=*), intent(in)     :: name
+
+!!AG for IBM    type(fnode), pointer :: np
+
+    if (dom_debug) print *, "End of element: ", name
+!!AG for IBM    np => getParentNode(current)
+!!AG for IBM    current => np
+    current => getParentNode(current)
+  end subroutine end_element_handler
+
+!---------------------------------------------------------
+
+  subroutine pcdata_chunk_handler(chunk)
+    character(len=*), intent(in) :: chunk
+
+    type(fnode), pointer :: temp, dummy
+    
+    if (dom_debug) print *, "Got PCDATA: |", chunk, "|"
+
+    temp => createTextNode(chunk)
+    dummy => appendChild(current,temp)
+
+  end subroutine pcdata_chunk_handler
+
+!---------------------------------------------------------
+
+  subroutine comment_handler(comment)
+    character(len=*), intent(in) :: comment
+
+    type(fnode), pointer :: temp, dummy
+
+    if (dom_debug) print *, "Got COMMENT: |", comment, "|"
+
+    temp => createComment(comment)
+    dummy => appendChild(current,temp)
+
+  end subroutine comment_handler
+!---------------------------------------------------------
+  subroutine cdata_section_handler(chunk)
+    character(len=*), intent(in) :: chunk
+
+    type(fnode), pointer :: temp, dummy
+    
+    if (dom_debug) print *, "Got CDATA_SECTION: |", chunk, "|"
+
+    temp => createCdataSection(chunk)
+    dummy => appendChild(current,temp)
+
+  end subroutine cdata_section_handler
+
+!***************************************************
+!   PUBLIC PROCEDURES
+!***************************************************
+
+
+  function parsefile(filename, verbose, sax_verbose)
+
+    character(len=*), intent(in) :: filename
+    logical, intent(in), optional :: verbose
+    logical, intent(in), optional :: sax_verbose
+
+    type(fnode), pointer :: parsefile
+
+    logical :: sax_debug = .false.
+
+    type(xml_t) :: fxml
+    integer :: iostat
+
+    if (present(verbose)) then
+       dom_debug = verbose
+    endif
+
+    if (present(sax_verbose)) then
+       sax_debug = sax_verbose
+    endif
+    
+    call open_xmlfile(filename, fxml, iostat)
+
+    PRINT *,'filename : ',filename
+    if (iostat /= 0) then
+       stop "Cannot open file."
+    endif
+
+    main => createDocumentNode()
+    current => main
+
+    call xml_parse(fxml,  &
+           begin_element_handler, end_element_handler, pcdata_chunk_handler, &
+           comment_handler, cdata_section_handler=cdata_section_handler, &
+           verbose = sax_debug)    
+    call close_xmlfile(fxml)
+
+    parsefile => main
+    if (dom_debug) print *, "Number of allocated nodes: ", getNumberofAllocatedNodes()
+
+  end function parsefile
+
+
+END MODULE m_dom_parse
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_types.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_types.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_types.f90	(revision 2528)
@@ -0,0 +1,195 @@
+Module m_dom_types
+
+  use m_strings
+
+  implicit none
+
+  private
+
+  !-------------------------------------------------------   
+  ! A GENERIC NODE
+  !-------------------------------------------------------   
+  type, public :: fnode
+     type(string)         :: nodeName    
+     type(string)         :: nodeValue   
+!!!     character(len=200)    :: nodeName  = ""
+!!!     character(len=200)    :: nodeValue = ""
+     integer              :: nc              = 0 
+     integer              :: nodeType        = 0
+     type(fnode), pointer :: parentNode      => null()
+     type(fnodeList), pointer :: childNodes  => null()  ! New
+     type(fnode), pointer :: firstChild      => null()
+     type(fnode), pointer :: lastChild       => null()
+     type(fnode), pointer :: previousSibling => null()
+     type(fnode), pointer :: nextSibling     => null()
+     type(fnode), pointer :: ownerDocument   => null()
+     type(fnamedNodeMap), pointer :: attributes => null()
+  end type fnode
+
+  !-----------------------------------------------------------
+  !  ONE WAY TO IMPLEMENT A NAMEDNODEMAP  (dictionary)
+  !-----------------------------------------------------------
+
+  ! Linked list of name/node pairs, with overall length variable
+
+  type, public :: fnamedNode
+     type(string)                   :: name
+!!!     character(len=100)            :: name
+     type(fnode), pointer          :: node => null()
+     type(fnamedNode), pointer     :: next => null()
+  end type fnamedNode
+
+  type, public :: fnamedNodeMap
+     integer :: length = 0
+     type(fnamedNode), pointer  :: head => null()
+     type(fnamedNode), pointer  :: tail => null()
+  end type fnamedNodeMap
+
+  !-----------------------------------------------------------
+  !  ONE WAY TO IMPLEMENT A NODELIST 
+  !-----------------------------------------------------------
+
+  type, public :: flistNode
+     type(fnode), pointer          :: node => null()
+     type(flistNode), pointer      :: next => null()
+  end type flistNode
+
+  type, public :: fnodeList
+     integer                      :: length = 0
+     type(flistNode), pointer     :: head => null()
+     type(flistNode), pointer     :: tail => null()
+  end type fnodeList
+
+!========================================================================
+  integer, save, private          :: allocated_nodes = 0
+!========================================================================
+
+  !-------------------------------------------------------   
+  ! NODETYPES
+  !-------------------------------------------------------   
+  integer, parameter, public :: ELEMENT_NODE                = 1
+  integer, parameter, public :: ATTRIBUTE_NODE              = 2
+  integer, parameter, public :: TEXT_NODE                   = 3
+  integer, parameter, public :: CDATA_SECTION_NODE          = 4
+  integer, parameter, public :: ENTITY_REFERENCE_NODE       = 5
+  integer, parameter, public :: ENTITY_NODE                 = 6
+  integer, parameter, public :: PROCESSING_INSTRUCTION_NODE = 7
+  integer, parameter, public :: COMMENT_NODE                = 8
+  integer, parameter, public :: DOCUMENT_NODE               = 9
+  integer, parameter, public :: DOCUMENT_TYPE_NODE          = 10
+  integer, parameter, public :: DOCUMENT_FRAGMENT_NODE      = 11
+  integer, parameter, public :: NOTATION_NODE               = 12
+
+  public :: node_class
+  public :: createNode
+  public :: destroyNode
+  public :: destroyNamedNodeMap
+  public :: destroyNodeList
+  public :: getNumberofAllocatedNodes
+
+CONTAINS
+
+  function getNumberofAllocatedNodes() result(n)
+    integer   :: n
+
+    n = allocated_nodes
+  end function getNumberofAllocatedNodes
+
+!--------------------------------------------------------------
+  function createNode() result(node)
+    type(fnode), pointer  :: node
+
+    allocate(node)
+    allocated_nodes = allocated_nodes + 1
+
+  end function createNode
+!--------------------------------------------------------------
+
+  function node_class(nodetype) result(class)
+    integer, intent(in) :: nodetype
+    character(len=10)  ::     class
+
+    select case(nodetype)
+    case(ELEMENT_NODE)
+       class = "element"
+    case(ATTRIBUTE_NODE)
+       class = "attribute"
+    case(TEXT_NODE)
+       class = "text"
+    case(COMMENT_NODE)
+       class = "comment"
+    case(DOCUMENT_NODE)
+       class = "document"
+    end select
+  end function node_class
+
+  subroutine destroyNamedNodeMap(nodemap)
+    type(fnamedNodeMap), pointer :: nodemap
+
+    type(fnamednode), pointer  :: nnp
+    type(fnode), pointer       :: ghost
+    
+    if (.not. associated(nodemap)) return
+    nnp => nodemap%head
+    do while (associated(nnp))
+       call unstring(nnp%name)
+       ghost => nnp%node
+       nnp => nnp%next
+       call destroyNode(ghost)      ! We might not want to really destroy
+    enddo
+  end subroutine destroyNamedNodeMap
+
+  subroutine destroyNodeList(nodelist)
+    type(fnodeList), pointer :: nodelist
+
+    type(flistnode), pointer   :: p
+    type(fnode), pointer       :: ghost
+    
+    if (.not. associated(nodelist)) return
+    p => nodelist%head
+    do while (associated(p))
+       ghost => p%node
+       p => p%next
+       call destroyNode(ghost)      ! We might not want to really destroy
+    enddo
+  end subroutine destroyNodeList
+
+  recursive subroutine destroyNode(node)
+    type(fnode), pointer  :: node
+    
+    type(fnode), pointer  :: np, ghost
+    
+    np => node
+    do while (associated(np))
+       if (associated(np%firstChild)) then
+          call destroyNode(np%firstChild)
+       endif
+       if (associated(np%attributes)) call destroyNamedNodeMap(np%attributes)
+       call unstring(np%nodeName)
+       call unstring(np%nodeValue)
+       if (associated(np%previousSibling)) & 
+                np%previousSibling%nextSibling => np%nextSibling
+       if (associated(np%nextSibling)) & 
+                np%nextSibling%previousSibling => np%previousSibling
+       if (associated(np%parentNode)) then
+          if (associated(np%parentNode%firstChild,np)) &
+               np%parentNode%firstChild => null()
+          if (associated(np%parentNode%lastChild,np)) &
+               np%parentNode%lastChild => null()
+       endif
+       if (associated(np,node)) then    
+          deallocate(np)
+          allocated_nodes = allocated_nodes - 1
+          EXIT                           ! do not destroy siblings
+       else
+          ghost => np
+          np => np%nextSibling
+          deallocate(ghost)
+          allocated_nodes = allocated_nodes - 1
+       endif
+    enddo
+    node => null()     ! superfluous ?
+  end subroutine destroyNode
+
+end module m_dom_types
+
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_utils.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_utils.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_utils.f90	(revision 2528)
@@ -0,0 +1,131 @@
+module m_dom_utils
+
+  use m_dom_types
+  use m_dom_element
+  use m_dom_document
+  use m_dom_node
+  use m_dom_namednodemap
+  use m_dom_debug
+  use m_strings
+
+  use flib_wxml
+
+  public :: dumpTree
+  public :: xmlize
+
+  private
+
+CONTAINS
+
+  subroutine dumpTree(startNode)
+
+    type(fnode), pointer :: startNode   
+
+    character(len=50) :: indent = " "
+    integer           :: indent_level
+    type(string)      :: s
+
+    indent_level = 0
+
+    call dump2(startNode)
+
+  contains
+
+    recursive subroutine dump2(input)
+      type(fnode), pointer :: input
+      type(fnode), pointer :: temp     
+      temp => input
+      do while(associated(temp))
+         s = getNodeName(temp)
+         write(*,'(3a,i3)') indent(1:indent_level), &
+                        char(s), " of type ", &
+                        getNodeType(temp)
+         if (hasChildNodes(temp)) then
+            indent_level = indent_level + 3
+            call dump2(getFirstChild(temp))
+            indent_level = indent_level - 3
+         endif
+         temp => getNextSibling(temp)
+      enddo
+
+    end subroutine dump2
+
+  end subroutine dumpTree
+!----------------------------------------------------------------
+
+  subroutine xmlize(startNode,fname)
+
+    type(fnode), pointer :: startNode   
+    character(len=*), intent(in) :: fname
+
+    type(xmlf_t)  :: xf
+    type(string)  :: s, sv, sn       ! to avoid memory leaks
+
+    call xml_OpenFile(fname,xf)
+    call dump_xml(startNode)
+    call xml_Close(xf)
+
+  contains
+
+    recursive subroutine dump_xml(input)
+      type(fnode), pointer         :: input
+!
+!     Just this node and its descendants, no siblings. 
+!     Of course, the document node has only children...
+!
+      type(fnode), pointer         :: node, attr
+      type(fnamedNodeMap), pointer :: attr_map
+      integer  ::  i
+
+      node => input
+      do
+         if (.not. associated(node)) exit
+         select case (getNodeType(node))
+
+          case (DOCUMENT_NODE)
+
+             call xml_AddXMLDeclaration(xf)
+             if (hasChildNodes(node)) call dump_xml(getFirstChild(node))
+
+          case (ELEMENT_NODE)
+
+             s = getNodeName(node)
+             call xml_NewElement(xf,char(s))
+             attr_map => getAttributes(node)
+             do i = 0, getLength(attr_map) - 1
+                attr => item(attr_map,i)
+                sn = getNodeName(attr)
+                sv = getNodeValue(attr)
+                call xml_AddAttribute(xf, char(sn),char(sv))
+             enddo
+             if (hasChildNodes(node)) call dump_xml(getFirstChild(node))
+             s = getNodeName(node)
+             call xml_EndElement(xf,char(s))
+
+          case (TEXT_NODE)
+             
+             s = getNodeValue(node)
+             call xml_AddPcdata(xf,char(s))
+
+          case (CDATA_SECTION_NODE)
+             
+             s = getNodeValue(node)
+             call xml_AddCdataSection(xf,char(s))
+
+          case (COMMENT_NODE)
+             
+             s = getNodeValue(node)
+             call xml_AddComment(xf,char(s))
+
+        end select
+        if (associated(node,StartNode)) exit  ! In case we request the 
+                                              ! dumping of a single element,
+                                              ! do not do siblings
+        node => getNextSibling(node)
+     enddo
+
+    end subroutine dump_xml
+
+  end subroutine xmlize
+
+end module m_dom_utils
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/CHANGES
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/CHANGES	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/CHANGES	(revision 2528)
@@ -0,0 +1,28 @@
+April 28, 2004
+
+* New optional argument "record_size" in open_xmlfile. The default record 
+length is 65536, but for overly long lines it might be necessary to specify
+a larger size.
+
+* Wrote "init_" routines to avoid undefined status for the components
+of the buffer, dictionary, and elstack derived types (Fortran90 restriction). 
+They are called just once at the beginning of execution.
+
+The "reset_" routines just zero out the counters in the derived
+types. This leads to substantial savings in overhead.
+
+* Avoided when possible the allocation of temporaries (mostly strings) by
+the compilers. This was particularly acute in the "action" records. The
+typical idiom:
+
+	action =trim("Reading character in name: " // c)
+
+forced the allocation of a temporary.  The number of compiler allocations
+(at least with NAG) has dropped down to just those needed in the processing
+of entities.
+
+* Put the explicit module dependencies in the makefile.
+
+* Increased the standard size of the buffers and dictionaries.
+***** The program now stops when those sizes are not enough.
+
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/Developer.Guide
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/Developer.Guide	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/Developer.Guide	(revision 2528)
@@ -0,0 +1,61 @@
+Developer Notes:
+
+The parser is built on several levels:
+
+1. The closest to the user.
+
+   Modules:  m_xml_parser: The main module
+             m_error     : Basic error handling
+
+2. An intermediate layer.
+
+   Modules: m_fsm  (A finite-state machine to parse the input)
+
+3. A layer defining basic data structures and file interfaces:
+
+   Modules: m_reader:  File interface and character handling as per XML specs.
+	    m_buffer:  Basic homemade "variable length string", with some
+                       limitations (size, of course), but avoiding the
+                       use of dynamic structures for now.
+	    m_dictionary: Simple, not dynamic.
+            m_charset: A simple hashing method for sets of characters.
+	    m_elstack: Simple stack to check well-formedness.
+	    m_entities: Entity replacement utilities.
+
+4. Something which does not really belong in the parser but which
+   is useful to massage the data extracted from the file:
+
+	m_converters: Routines to turn pcdata chunks into numerical arrays
+
+
+There are obviously a number of hardwired limitations, which should be
+removed in a later version:
+
+* Buffer size in buffer_t definition. This is not as serious as it
+  looks. Only long unbroken pcdata sections and overly long attribute
+  names or values will be affected. Long SGML declarations and comments
+  might be truncated, but they are not relevant anyway.
+
+* Maximum number of attributes in an element tag (set in m_dictionary)
+
+While the parser does not use any variable-length strings (to keep it
+compatible with existing Fortran90 compilers) or dynamical data
+structures for attribute dictionaries, etc, such improvements could be
+incorporated almost as drop-in replacements for existing sub-modules.
+
+
+The coding style is that of the F subset of Fortran90. I strongly
+believe that it makes for better coding and fewer errors.
+Go to http://www.fortran.com/imagine1/ and get a feel for it. You can
+download free implementations for Linux and Windows, or get an
+inexpensive CD+Book combination to help support the project. Of course,
+F *is* Fortran, so you can always compile it with a Fortran compiler.
+
+
+
+
+
+
+
+
+
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/TODO
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/TODO	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/TODO	(revision 2528)
@@ -0,0 +1,7 @@
+Things to do:
+
+* Make buffer pseudo-dynamical to avoid limitations.
+* Insert code to deal with XML declarations (really processing instructions)
+  which are not of the form
+  
+ <?name  pseudo_att_name="pseudo_att_value" .... ?>
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/flib_sax.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/flib_sax.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/flib_sax.f90	(revision 2528)
@@ -0,0 +1,19 @@
+module flib_sax
+
+!
+! Stub module to gather all the functionality needed by the user
+! 
+! In future m_dictionary and m_converters could be exported by
+! other parts of a more general fortran library.
+!
+! m_xml_error is necessary in order to use a custom error handler.
+!
+use m_dictionary
+use m_xml_parser
+use m_converters
+use m_xml_error
+
+public
+
+end module flib_sax
+
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_buffer.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_buffer.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_buffer.f90	(revision 2528)
@@ -0,0 +1,200 @@
+module m_buffer
+
+!
+! At this point we use a fixed-size buffer. 
+! Note however that buffer overflows will only be
+! triggered by overly long *unbroken* pcdata values, or
+! by overly long attribute values. Hopefully
+! element or attribute names are "short enough".
+! There is code in m_fsm to avoid buffer overflows
+! caused by pcdata with whitespace.
+!
+! In a forthcoming implementation it could be made dynamical...
+!
+integer, parameter, public   :: MAX_BUFF_SIZE  = 10000
+integer, parameter, private  :: BUFF_SIZE_WARNING  = 900
+
+!
+
+type, public  :: buffer_t
+private
+      integer                       :: size
+      character(len=MAX_BUFF_SIZE)  :: str
+end type buffer_t
+
+public :: add_to_buffer
+public :: print_buffer, str, len       !! , char
+public :: operator (.equal.)
+public :: buffer_nearly_full, reset_buffer, init_buffer
+public :: buffer_to_character
+
+
+!----------------------------------------------------------------
+interface add_to_buffer
+      module procedure add_str_to_buffer
+end interface
+private :: add_char_to_buffer, add_str_to_buffer
+
+interface operator (.equal.)
+      module procedure compare_buffers, compare_buffer_str, &
+             compare_str_buffer
+end interface
+private :: compare_buffers, compare_buffer_str, compare_str_buffer
+
+interface str
+      module procedure buffer_to_str
+end interface
+interface char                 ! Experimental
+      module procedure buffer_to_str
+end interface
+private :: buffer_to_str
+
+interface len
+   module procedure buffer_length
+end interface
+private :: buffer_length
+
+CONTAINS
+!==================================================================
+
+!----------------------------------------------------------------
+function compare_buffers(a,b) result(equal)     ! .equal. generic
+type(buffer_t), intent(in)  :: a
+type(buffer_t), intent(in)  :: b
+logical                     :: equal
+
+equal = ((a%size == b%size) .and. (a%str(1:a%size) == b%str(1:b%size)))
+
+end function compare_buffers
+
+!----------------------------------------------------------------
+function compare_buffer_str(buffer,str) result(equal) ! .equal. generic
+type(buffer_t), intent(in)   :: buffer
+character(len=*), intent(in) :: str
+logical                      :: equal
+
+equal = (buffer%str(1:buffer%size) == trim(str))
+
+end function compare_buffer_str
+
+!----------------------------------------------------------------
+function compare_str_buffer(str,buffer) result(equal) ! .equal. generic
+character(len=*), intent(in) :: str
+type(buffer_t), intent(in)   :: buffer
+logical                     :: equal
+
+equal = (buffer%str(1:buffer%size) == trim(str))
+
+end function compare_str_buffer
+
+!----------------------------------------------------------------
+subroutine add_char_to_buffer(c,buffer)
+character(len=1), intent(in)   :: c
+type(buffer_t), intent(inout)  :: buffer
+
+integer   :: n
+buffer%size = buffer%size + 1
+n = buffer%size
+
+if (n> MAX_BUFF_SIZE) then
+!!  RETURN
+!
+!  It will only affect long comments and sgml declarations
+   STOP "sax 1 Buffer overflow: long unbroken string of pcdata or attribute value..."
+endif
+
+buffer%str(n:n) = c
+end subroutine add_char_to_buffer
+
+!----------------------------------------------------------------
+subroutine add_str_to_buffer(s,buffer)
+character(len=*), intent(in)   :: s
+type(buffer_t), intent(inout)  :: buffer
+
+integer   :: n, len_s, last_pos
+
+len_s = len(s)
+last_pos = buffer%size
+buffer%size = buffer%size + len_s
+n = buffer%size
+
+if (n> MAX_BUFF_SIZE) then
+!!  RETURN
+!
+!  It will only affect long comments and sgml declarations
+  STOP "sax 2 Buffer overflow: long unbroken string of pcdata or attribute value..."
+endif
+
+buffer%str(last_pos+1:n) = s
+end subroutine add_str_to_buffer
+
+!----------------------------------------------------------------
+subroutine init_buffer(buffer)
+type(buffer_t), intent(inout)  :: buffer
+
+buffer%size = 0
+buffer%str=""               ! To avoid "undefined" status
+
+end subroutine init_buffer
+!----------------------------------------------------------------
+subroutine reset_buffer(buffer)
+type(buffer_t), intent(inout)  :: buffer
+  buffer%size = 0
+end subroutine reset_buffer
+!----------------------------------------------------------------
+subroutine print_buffer(buffer)
+type(buffer_t), intent(in)  :: buffer
+
+integer :: i
+
+do i = 1, buffer%size
+      write(unit=6,fmt="(a1)",advance="no") buffer%str(i:i)
+enddo
+
+end subroutine print_buffer
+!----------------------------------------------------------------
+! This is better... but could it lead to memory leaks?
+!
+function buffer_to_str(buffer) result(str)
+type(buffer_t), intent(in)          :: buffer
+character(len=buffer%size)          :: str
+
+str = buffer%str(1:buffer%size)
+end function buffer_to_str
+
+!----------------------------------------------------------------
+!
+subroutine buffer_to_character(buffer,str)
+type(buffer_t), intent(in)          :: buffer
+character(len=*), intent(out)       :: str
+
+str = buffer%str(1:buffer%size)
+end subroutine buffer_to_character
+
+!----------------------------------------------------------------
+function buffer_nearly_full(buffer) result(warn)
+type(buffer_t), intent(in)          :: buffer
+logical                             :: warn
+
+warn = buffer%size > BUFF_SIZE_WARNING
+
+end function buffer_nearly_full
+
+!----------------------------------------------------------------
+function buffer_length(buffer) result(length)
+type(buffer_t), intent(in)          :: buffer
+integer                             :: length
+
+length = buffer%size 
+
+end function buffer_length
+
+
+end module m_buffer
+
+
+
+
+
+
+
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_charset.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_charset.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_charset.f90	(revision 2528)
@@ -0,0 +1,203 @@
+module m_charset
+!
+! One-byte only, sorry
+!
+private
+
+integer, parameter, private  :: small_int = selected_int_kind(1)
+
+!--------------------------------------------------------------------------
+type, public :: charset_t
+! private
+      integer(kind=small_int), dimension(0:255) :: mask
+end type charset_t
+
+
+public  :: operator(.in.), operator(+)
+public  :: assignment(=)
+public  :: print_charset, reset_charset
+
+interface operator(.in.)
+      module procedure belongs
+end interface
+private :: belongs
+
+interface assignment(=)
+      module procedure set_string_to_charset, set_codes_to_charset
+end interface
+private ::  set_string_to_charset, set_codes_to_charset
+
+interface operator(+)
+      module procedure add_string_to_charset, &
+                       add_code_to_charset, add_codes_to_charset
+end interface
+private :: add_string_to_charset, add_code_to_charset, add_codes_to_charset
+
+!--------------------------------------------------------------------------
+
+character(len=*), parameter, private :: &
+            lowercase = "abcdefghijklmnopqrstuvwxyz",  & 
+            uppercase = "ABCDEFGHIJKLMNOPQRSTUVWXYZ", &
+            digits    = "0123456789"
+
+integer, parameter, public   :: SPACE           = 32
+integer, parameter, public   :: NEWLINE         = 10
+integer, parameter, public   :: CARRIAGE_RETURN = 13
+integer, parameter, public   :: TAB             =  9
+
+type(charset_t), public    :: initial_name_chars
+type(charset_t), public    :: name_chars
+type(charset_t), public    :: whitespace
+type(charset_t), public    :: valid_chars
+type(charset_t), public    :: uppercase_chars
+
+public  :: setup_xml_charsets
+
+
+CONTAINS !==========================================================
+
+!--------------------------------------------------------------
+function belongs(c,charset)  result(res)
+character(len=1), intent(in)  :: c
+type(charset_t), intent(in)   :: charset
+logical                       :: res
+
+integer  :: code
+
+code = ichar(c)
+res = (charset%mask(code) == 1)
+
+end function belongs
+
+!--------------------------------------------------------------
+
+function add_string_to_charset(charset,str)  result (sum)
+type(charset_t), intent(in)      :: charset
+character(len=*), intent(in)     :: str
+type(charset_t)                  :: sum
+
+integer :: length, code, i
+
+sum%mask = charset%mask
+
+length = len_trim(str)
+do i = 1, length
+      code = ichar(str(i:i))
+      sum%mask(code) = 1
+enddo
+end function add_string_to_charset
+
+!--------------------------------------------------------------
+
+function add_code_to_charset(charset,code) result(sum)
+type(charset_t), intent(in)      :: charset
+integer, intent(in)              :: code
+type(charset_t)                  :: sum
+
+if ((code > 255) .or. (code < 0)) return
+sum%mask = charset%mask
+sum%mask(code) = 1
+
+end function add_code_to_charset
+
+!--------------------------------------------------------------
+function add_codes_to_charset(charset,codes) result(sum)
+type(charset_t), intent(in)        :: charset
+integer, dimension(:), intent(in)  :: codes
+type(charset_t)                    :: sum
+
+integer  :: i
+
+sum%mask = charset%mask
+do i = 1, size(codes)
+      if ((codes(i) > 255) .or. (codes(i) < 0)) cycle
+      sum%mask(codes(i)) = 1
+enddo
+end function add_codes_to_charset
+
+!--------------------------------------------------------------
+
+subroutine set_string_to_charset(charset,str)      
+type(charset_t), intent(out)   :: charset
+character(len=*), intent(in)   :: str
+
+
+integer :: length, code, i
+
+charset%mask = 0
+
+length = len_trim(str)
+do i = 1, length
+      code = ichar(str(i:i))
+      charset%mask(code) = 1
+enddo
+
+end subroutine set_string_to_charset
+
+!--------------------------------------------------------------
+
+subroutine set_codes_to_charset(charset,codes)      
+type(charset_t), intent(out)   :: charset
+integer, dimension(:), intent(in)  :: codes
+
+integer :: i
+
+charset%mask = 0
+
+do i = 1, size(codes)
+      charset%mask(codes(i)) = 1
+enddo
+
+end subroutine set_codes_to_charset
+
+
+!--------------------------------------------------------------
+subroutine print_charset(charset)      
+type(charset_t), intent(in)   :: charset
+
+integer :: i
+
+do i = 0, 255
+      if (charset%mask(i) == 1) print *, "Code: ", i
+enddo
+end subroutine print_charset
+
+!--------------------------------------------------------------
+
+subroutine reset_charset(charset)      
+type(charset_t), intent(inout)   :: charset
+
+integer :: i
+
+do i = 0, 255
+      charset%mask(i) = 0
+enddo
+end subroutine reset_charset
+
+!--------------------------------------------------------------
+
+!--------------------------------------------------------
+subroutine setup_xml_charsets()
+
+integer :: i
+
+uppercase_chars = uppercase
+initial_name_chars = (lowercase  // uppercase //  "_:" )
+name_chars = initial_name_chars + ( digits // ".-")
+whitespace = (/ SPACE, NEWLINE, TAB, CARRIAGE_RETURN /)
+
+valid_chars = whitespace + (/ (i, i=33,255) /)
+
+end subroutine setup_xml_charsets
+!--------------------------------------------------------
+
+end module m_charset
+
+
+
+
+
+
+
+
+
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_converters.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_converters.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_converters.f90	(revision 2528)
@@ -0,0 +1,180 @@
+module m_converters
+
+use m_debug
+
+private
+!
+! Takes a string and turns it into useful data structures,
+! such as numerical arrays.
+!
+! NOTE: The string must contain *homogeneous* data, i.e.: all real numbers,
+! all integers, etc.
+!
+public :: build_data_array
+
+interface build_data_array
+      module procedure build_data_array_real_sp,  &
+                       build_data_array_real_dp,  &
+                       build_data_array_integer
+end interface
+private :: build_data_array_real_sp
+private :: build_data_array_real_dp
+private :: build_data_array_integer
+
+private :: token_analysis, is_separator, is_CR_or_LF
+
+CONTAINS
+
+!---------------------------------------------------------------
+subroutine build_data_array_real_dp(str,x,n)
+integer, parameter  :: dp = selected_real_kind(14)
+!
+character(len=*), intent(in)                ::  str
+real(kind=dp), dimension(:), intent(inout)  ::    x
+integer, intent(inout)                      ::    n
+
+integer                            :: ntokens, status, last_pos
+character(len=len(str))  :: s
+
+s = str
+call token_analysis(s,ntokens,last_pos)
+if (debug) print *, "ntokens, last_pos ", ntokens, last_pos
+if (debug) print *, s
+if ((n + ntokens) > size(x)) STOP "data array full"
+read(unit=s(1:last_pos),fmt=*,iostat=status) x(n+1:n+ntokens)
+if (status /= 0) STOP "real conversion error"
+n = n + ntokens
+
+end subroutine build_data_array_real_dp
+!---------------------------------------------------------------
+
+subroutine build_data_array_real_sp(str,x,n)
+integer, parameter  :: sp = selected_real_kind(6)
+!
+character(len=*), intent(in)                :: str
+real(kind=sp), dimension(:), intent(inout)  ::    x
+integer, intent(inout)                      ::    n
+
+integer                            :: ntokens, status, last_pos
+character(len=len(str))  :: s
+
+s = str
+call token_analysis(s,ntokens,last_pos)
+if (debug) print *, "ntokens, last_pos ", ntokens, last_pos
+if (debug) print *, s
+if ((n + ntokens) > size(x)) STOP "data array full"
+read(unit=s(1:last_pos),fmt=*,iostat=status) x(n+1:n+ntokens)
+if (status /= 0) STOP "real conversion error"
+n = n + ntokens
+
+end subroutine build_data_array_real_sp
+
+!---------------------------------------------------------------
+subroutine build_data_array_integer(str,x,n)
+integer, parameter  :: sp = selected_real_kind(14)
+!
+character(len=*), intent(in)                :: str
+integer, dimension(:), intent(inout)        ::    x
+integer, intent(inout)                      ::    n
+
+integer                            :: ntokens, status, last_pos
+character(len=len(str))  :: s
+
+s = str
+call token_analysis(s,ntokens,last_pos)
+if (debug) print *, "ntokens, last_pos ", ntokens, last_pos
+if (debug) print *, s
+if ((n + ntokens) > size(x)) STOP "data array full"
+read(unit=s(1:last_pos),fmt=*,iostat=status) x(n+1:n+ntokens)
+if (status /= 0) STOP "integer conversion error"
+n = n + ntokens
+
+end subroutine build_data_array_integer
+
+
+!==================================================================
+
+function is_separator(c) result(sep)
+character(len=1), intent(in)          :: c
+logical                               :: sep
+
+ sep = ((c == char(32)) .or. (c == char(10))             &
+         .or. (c == char(9)) .or. (c == char(13)))
+
+end function is_separator
+!----------------------------------------------------------------
+function is_CR_or_LF(c) result(res)
+character(len=1), intent(in)          :: c
+logical                               :: res
+
+ res = ((c == char(10)) .or. (c == char(13)))
+
+end function is_CR_or_LF
+
+!==================================================================
+
+subroutine token_analysis(str,ntokens,last_pos)
+!
+character(len=*), intent(inout)          :: str
+integer, intent(out)                     :: ntokens, last_pos
+!
+!
+! Checks the contents of a string and finds the number of tokens it contains
+! The standard separator is generalized whitespace (space, tab, CR, or LF)
+! It also returns the last useful position in the string (excluding
+! separator characters which are not blanks, and thus not caught by the
+! (len_)trim fortran intrinsic). This is necessary to perform list-directed
+! I/O in the string as an internal file.
+! 
+! Also, replace on the fly CR and LF by blanks. This is necessary if
+! str spans more than one record. In that case, internal reads only 
+! look at the first record. 
+! -- ** Compiler limits on size of internal record??
+!
+integer           :: i, str_length
+logical           :: in_token
+character(len=1)  :: c
+
+in_token = .false.
+ntokens = 0
+last_pos = 0
+
+str_length = len_trim(str)
+!print *, "string length: ", str_length
+
+do i = 1, str_length
+      c = str(i:i)
+
+      if (in_token) then
+         if (is_separator(c)) then
+            in_token = .false.
+            if (is_CR_or_LF(c)) str(i:i) = " "
+         else
+            last_pos = i
+         endif
+
+      else   ! not in token
+         
+         if (is_separator(c)) then
+            if (is_CR_or_LF(c)) str(i:i) = " "
+            ! do nothing
+         else
+            in_token = .true.
+            last_pos = i
+            ntokens = ntokens + 1
+         endif
+      endif
+enddo
+!print *, "ntokens, last_pos: ", ntokens, last_pos
+
+end subroutine token_analysis
+
+
+end module m_converters
+
+
+
+
+
+
+
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_debug.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_debug.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_debug.f90	(revision 2528)
@@ -0,0 +1,5 @@
+module m_debug
+
+logical, public, save   :: debug = .false.
+
+end module m_debug
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_dictionary.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_dictionary.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_dictionary.f90	(revision 2528)
@@ -0,0 +1,183 @@
+module m_dictionary
+
+use m_buffer
+private
+!
+! A very rough implementation for now
+! It uses fixed-length buffers for key/value pairs,
+! and the maximum number of dictionary items is hardwired.
+
+integer, parameter, private    :: MAX_ITEMS = 64
+type, public :: dictionary_t
+private
+      integer                               :: number_of_items
+      type(buffer_t), dimension(MAX_ITEMS)  :: key
+      type(buffer_t), dimension(MAX_ITEMS)  :: value
+end type dictionary_t
+
+!
+! Building procedures
+!
+public  :: add_key_to_dict, add_value_to_dict, init_dict, reset_dict
+
+!
+! Query and extraction procedures
+!
+public  :: len
+interface len
+   module procedure number_of_entries
+end interface
+public  :: number_of_entries
+public  :: get_key
+public  :: get_value
+public  :: has_key
+public  :: print_dict
+!
+public  :: get_name
+
+interface get_name
+   module procedure get_key
+end interface
+
+interface get_value
+   module procedure sax_get_value
+end interface
+private :: sax_get_value
+
+CONTAINS
+
+!------------------------------------------------------
+function number_of_entries(dict) result(n)
+type(dictionary_t), intent(in)   :: dict
+integer                          :: n
+
+n = dict%number_of_items
+
+end function number_of_entries
+
+!------------------------------------------------------
+function has_key(dict,key) result(found)
+type(dictionary_t), intent(in)   :: dict
+character(len=*), intent(in)     :: key
+logical                          :: found
+
+integer  :: n, i
+found = .false.
+n = dict%number_of_items
+do  i = 1, n
+      if (dict%key(i) .EQUAL. key) then
+         found = .true.
+         exit
+      endif
+enddo
+end function has_key
+
+!------------------------------------------------------
+subroutine sax_get_value(dict,key,value,status)
+type(dictionary_t), intent(in)            :: dict
+character(len=*), intent(in)              :: key
+character(len=*), intent(out)             :: value
+integer, intent(out)                      :: status
+!
+integer  :: n, i
+
+status = -1
+n = dict%number_of_items
+do  i = 1, n
+      if (dict%key(i) .EQUAL. key) then
+         value = str(dict%value(i))
+         status = 0
+         RETURN
+      endif
+enddo
+
+end subroutine sax_get_value
+
+!------------------------------------------------------
+subroutine get_key(dict,i,key,status)
+!
+! Get the i'th key
+!
+type(dictionary_t), intent(in)            :: dict
+integer, intent(in)                       :: i
+character(len=*), intent(out)             :: key
+integer, intent(out)                      :: status
+
+if (i <= dict%number_of_items) then
+      key = str(dict%key(i))
+      status = 0
+else
+      key = ""
+      status = -1
+endif
+
+end subroutine get_key
+
+!------------------------------------------------------
+subroutine add_key_to_dict(key,dict)
+type(buffer_t), intent(in)          :: key
+type(dictionary_t), intent(inout)   :: dict
+
+integer  :: n
+
+n = dict%number_of_items
+if (n == MAX_ITEMS) then
+      write(unit=0,fmt=*) "Dictionary capacity exceeded ! size= ", max_items
+      RETURN
+endif
+
+n = n + 1
+dict%key(n) = key
+dict%number_of_items = n
+
+end subroutine add_key_to_dict
+
+!------------------------------------------------------
+! Assumes we build the dictionary in an orderly fashion,
+! so one adds first the key and then immediately afterwards the value.
+!
+subroutine add_value_to_dict(value,dict)
+type(buffer_t), intent(in)          :: value
+type(dictionary_t), intent(inout)   :: dict
+
+integer  :: n
+
+n = dict%number_of_items
+dict%value(n) = value
+
+end subroutine add_value_to_dict
+
+!------------------------------------------------------
+subroutine init_dict(dict)
+type(dictionary_t), intent(inout)   :: dict
+
+integer  :: i
+
+dict%number_of_items = 0
+do i=1, MAX_ITEMS                      ! To avoid "undefined" status
+   call init_buffer(dict%key(i))       ! (Fortran90 restriction)
+   call init_buffer(dict%value(i))
+enddo
+end subroutine init_dict
+!------------------------------------------------------
+subroutine reset_dict(dict)
+type(dictionary_t), intent(inout)   :: dict
+
+dict%number_of_items = 0
+
+end subroutine reset_dict
+
+!------------------------------------------------------
+subroutine print_dict(dict)
+type(dictionary_t), intent(in)   :: dict
+
+integer  :: i
+
+do i = 1, dict%number_of_items
+      print *, trim(str(dict%key(i))), " = ", trim(str(dict%value(i)))
+enddo
+
+end subroutine print_dict
+
+
+end module m_dictionary
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_elstack.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_elstack.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_elstack.f90	(revision 2528)
@@ -0,0 +1,153 @@
+module m_elstack
+
+use m_buffer
+
+private
+
+!
+! Simple stack to keep track of which elements have appeared so far
+!
+integer, parameter, private            :: STACK_SIZE = 40
+
+type, public :: elstack_t
+private
+      integer                                :: n_items
+      type(buffer_t), dimension(STACK_SIZE)  :: data
+end type elstack_t
+
+public  :: push_elstack, pop_elstack, reset_elstack, print_elstack
+public  :: init_elstack
+public  :: get_top_elstack, is_empty, get_elstack_signature
+
+interface is_empty
+      module procedure is_empty_elstack
+end interface
+private :: is_empty_elstack
+
+CONTAINS
+
+!-----------------------------------------------------------------
+subroutine init_elstack(elstack)
+type(elstack_t), intent(inout)  :: elstack
+
+integer :: i
+
+elstack%n_items = 0
+do i = 1, STACK_SIZE                   ! to avoid "undefined status"
+      call init_buffer(elstack%data(i))
+enddo
+end subroutine init_elstack
+
+!-----------------------------------------------------------------
+subroutine reset_elstack(elstack)
+type(elstack_t), intent(inout)  :: elstack
+
+integer :: i
+
+elstack%n_items = 0
+do i = 1, STACK_SIZE                  
+      call reset_buffer(elstack%data(i))
+enddo
+end subroutine reset_elstack
+
+!-----------------------------------------------------------------
+function is_empty_elstack(elstack) result(answer)
+type(elstack_t), intent(in)  :: elstack
+logical                    :: answer
+
+answer = (elstack%n_items == 0)
+end function is_empty_elstack
+
+!-----------------------------------------------------------------
+subroutine push_elstack(item,elstack)
+type(buffer_t), intent(in)      :: item
+type(elstack_t), intent(inout)  :: elstack
+
+integer   :: n
+
+n = elstack%n_items
+if (n == STACK_SIZE) then
+      stop "*Element stack full"
+endif
+n = n + 1
+elstack%data(n) = item
+elstack%n_items = n
+
+end subroutine push_elstack
+
+!-----------------------------------------------------------------
+subroutine pop_elstack(elstack,item)
+type(elstack_t), intent(inout)     :: elstack
+type(buffer_t), intent(out)        :: item
+
+!
+! We assume the elstack is not empty... (the user has called is_empty first)
+!
+integer   :: n
+
+n = elstack%n_items
+if (n == 0) then
+      stop "*********Element stack empty"
+endif
+item = elstack%data(n)
+elstack%n_items = n - 1
+
+end subroutine pop_elstack
+
+!-----------------------------------------------------------------
+subroutine get_top_elstack(elstack,item)
+!
+! Get the top element of the stack, *without popping it*.
+!
+type(elstack_t), intent(in)        :: elstack
+type(buffer_t), intent(out)        :: item
+
+!
+! We assume the elstack is not empty... (the user has called is_empty first)
+!
+integer   :: n
+
+n = elstack%n_items
+if (n == 0) then
+      stop "*********Element stack empty"
+endif
+item = elstack%data(n)
+
+end subroutine get_top_elstack
+
+!-----------------------------------------------------------------
+subroutine print_elstack(elstack,unit)
+type(elstack_t), intent(in)   :: elstack
+integer, intent(in)           :: unit
+integer   :: i
+
+do i = elstack%n_items, 1, -1
+      write(unit=unit,fmt=*) str(elstack%data(i))
+enddo
+
+end subroutine print_elstack
+
+!-------------------------------------------------------------
+subroutine get_elstack_signature(elstack,string)
+type(elstack_t), intent(in)   :: elstack
+character(len=*), intent(out) :: string
+integer   :: i, length, j
+
+string = ""
+j = 0
+do i = 1, elstack%n_items
+   length = len(elstack%data(i))
+   string(j+1:j+1) = "/"
+   j = j+1
+   string(j+1:j+length) = str(elstack%data(i))
+   j = j + length
+enddo
+
+end subroutine get_elstack_signature
+
+end module m_elstack
+
+
+
+
+
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_entities.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_entities.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_entities.f90	(revision 2528)
@@ -0,0 +1,134 @@
+module m_entities
+!
+! Entity management
+!
+! It deals with: 
+!    1. The five standard entities (gt,lt,amp,apos,quot)
+!    2. Character entities  (but only within the range of the char intrinsic)
+!
+use m_buffer
+private
+
+integer, parameter, private      :: MAX_REPLACEMENT_SIZE = 200
+!
+type, private :: entity_t
+ character(len=40)                     :: code
+ character(len=MAX_REPLACEMENT_SIZE)   :: replacement
+end type entity_t
+
+integer, parameter, private                          ::  N_ENTITIES  = 5
+
+type(entity_t), private, dimension(N_ENTITIES), save :: predefined_ent =  &
+      (/                  &
+      entity_t("gt",">"), &
+      entity_t("lt","<"),  &
+      entity_t("amp","&"),  &
+      entity_t("apos","'"),  &
+      entity_t("quot","""")  &
+      /)
+      
+public :: code_to_str , entity_filter
+
+CONTAINS
+
+subroutine code_to_str(code,str,status)
+character(len=*), intent(in)  :: code
+character(len=*), intent(out) :: str
+integer, intent(out)          :: status         
+integer :: i
+
+integer   :: number, ll
+character(len=4)  :: fmtstr
+
+status = -1
+do i = 1, N_ENTITIES
+      if (code == predefined_ent(i)%code) then
+         str = predefined_ent(i)%replacement
+         status = 0
+         return
+      endif
+enddo
+!
+! Replace character references  (but only within the range of the
+! char intrinsic !!)
+!
+if (code(1:1) == "#") then
+   if (code(2:2) == "x") then       ! hex character reference
+      ll = len_trim(code(3:))
+      write(unit=fmtstr,fmt="(a2,i1,a1)") "(Z", ll,")"
+      read(unit=code(3:),fmt=fmtstr) number
+      str = char(number)
+      status = 0
+      return
+   else                             ! decimal character reference
+      read(unit=code(2:),fmt=*) number
+      str = char(number)
+      status = 0
+      return
+   endif
+endif
+
+end subroutine code_to_str
+
+!----------------------------------------------------------------
+!
+! Replaces entity references in buf1 and creates a new buffer buf2.
+!
+subroutine entity_filter(buf1,buf2,status,message)
+type(buffer_t), intent(in)    :: buf1
+type(buffer_t), intent(out)   :: buf2
+integer, intent(out)          :: status
+character(len=*), intent(out) :: message
+!
+! Replaces entity references by their value
+!
+integer :: i, k, len1
+character(len=MAX_BUFF_SIZE)           :: s1
+character(len=1)                       :: c
+character(len=MAX_REPLACEMENT_SIZE)    :: repl
+
+call buffer_to_character(buf1,s1)        !! Avoid allocation of temporary
+len1 = len(buf1)
+
+i = 1
+status = 0
+
+call reset_buffer(buf2)
+
+do
+   if (i > len1) exit
+   c = s1(i:i)
+   if (c == "&") then
+      if (i+1 > len1) then
+         status = -i
+         message=  " Unmatched & in entity reference"
+         return
+      endif
+      k = index(s1(i+1:),";")
+      if (k == 0) then
+         status = -i
+         message=  " Unmatched & in entity reference"
+         return
+      endif
+      call code_to_str(s1(i+1:i+k-1),repl,status)
+      if (status /= 0) then
+         status =  i     ! Could let it continue
+         message= "Ignored unknown entity: &" // s1(i+1:i+k-1) // ";"
+      else
+         call add_to_buffer(trim(repl),buf2)
+      endif
+      i = i + k + 1
+   else
+     call add_to_buffer(c,buf2)
+     i = i + 1
+   endif
+enddo
+
+end subroutine entity_filter
+
+end module m_entities
+
+
+
+
+
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_fsm.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_fsm.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_fsm.f90	(revision 2528)
@@ -0,0 +1,745 @@
+module m_fsm
+!
+use m_buffer
+use m_dictionary
+use m_charset
+use m_entities
+use m_elstack
+
+private
+
+type, public :: fsm_t
+      !
+      ! Contains information about the "finite state machine"
+      ! Some of the components (marked *) could at this point be made into
+      ! saved module variables.
+      ! 
+      !
+      integer              :: state
+      integer              :: context
+      integer              :: nbrackets             !*
+      integer              :: nlts                  !*
+      character(len=1)     :: quote_char            !*
+      type(buffer_t)       :: buffer                !*
+      type(buffer_t)       :: element_name
+      type(dictionary_t)   :: attributes
+      type(buffer_t)       :: pcdata
+      type(elstack_t)      :: element_stack
+      logical              :: root_element_seen
+      type(buffer_t)       :: root_element_name
+      character(len=150)   :: action
+      logical              :: debug
+end type fsm_t
+
+public :: init_fsm, reset_fsm, evolve_fsm
+
+!
+! State parameters
+!
+integer, parameter, public   ::  ERROR = -1
+integer, parameter, public   ::  INIT = 1         
+integer, parameter, private  ::  START_TAG_MARKER = 2
+integer, parameter, private  ::  END_TAG_MARKER = 3
+integer, parameter, private  ::  IN_NAME = 4
+integer, parameter, private  ::  WHITESPACE_IN_TAG = 5
+integer, parameter, private  ::  IN_PCDATA = 6
+integer, parameter, private  ::  SINGLETAG_MARKER = 7
+integer, parameter, private  ::  CLOSINGTAG_MARKER = 8
+integer, parameter, private  ::  IN_COMMENT = 9
+integer, parameter, private  ::  IN_ATT_NAME = 10
+integer, parameter, private  ::  IN_ATT_VALUE = 11
+integer, parameter, private  ::  EQUAL = 12
+integer, parameter, private  ::  SPACE_AFTER_EQUAL = 13
+integer, parameter, private  ::  SPACE_BEFORE_EQUAL = 14
+integer, parameter, private  ::  START_QUOTE = 15
+integer, parameter, private  ::  END_QUOTE = 16
+integer, parameter, private  ::  BANG = 17
+integer, parameter, private  ::  BANG_HYPHEN = 18
+integer, parameter, private  ::  ONE_HYPHEN = 19
+integer, parameter, private  ::  TWO_HYPHEN = 20
+integer, parameter, private  ::  QUESTION_MARK = 21
+integer, parameter, private  ::  START_XML_DECLARATION = 22
+integer, parameter, private  ::  IN_SGML_DECLARATION = 23
+integer, parameter, private  ::  IN_CDATA_SECTION = 24
+integer, parameter, private  ::  ONE_BRACKET = 25
+integer, parameter, private  ::  TWO_BRACKET = 26
+integer, parameter, private  ::  CDATA_PREAMBLE = 27
+integer, parameter, private  ::  IN_PCDATA_AT_EOL = 30
+!
+! Context parameters
+!
+integer, parameter, public   ::  OPENING_TAG  = 100
+integer, parameter, public   ::  CLOSING_TAG  = 110
+integer, parameter, public   ::  SINGLE_TAG   = 120
+integer, parameter, public   ::  COMMENT_TAG  = 130
+integer, parameter, public   ::  XML_DECLARATION_TAG  = 140
+integer, parameter, public   ::  SGML_DECLARATION_TAG  = 150
+integer, parameter, public   ::  CDATA_SECTION_TAG  = 160
+integer, parameter, public   ::  NULL_CONTEXT          = 200
+!
+! Signal parameters
+!
+integer, parameter, public   ::  QUIET             = 1000
+integer, parameter, public   ::  END_OF_TAG        = 1100
+integer, parameter, public   ::  CHUNK_OF_PCDATA   = 1200
+integer, parameter, public   ::  EXCEPTION         = 1500
+
+CONTAINS
+
+!------------------------------------------------------------
+! Initialize once and for all the derived types (Fortran90 restriction)
+!
+subroutine init_fsm(fx) 
+type(fsm_t), intent(inout)   :: fx
+
+ fx%state = INIT
+ call setup_xml_charsets()
+ fx%context = NULL_CONTEXT
+ call init_elstack(fx%element_stack)
+ fx%root_element_seen = .false.
+ fx%debug = .false.
+ fx%action = ""
+ call init_buffer(fx%buffer)
+ call init_buffer(fx%element_name)
+ call init_buffer(fx%pcdata)
+ call init_buffer(fx%root_element_name)
+ call init_dict(fx%attributes)
+end subroutine init_fsm
+!------------------------------------------------------------
+subroutine reset_fsm(fx) 
+type(fsm_t), intent(inout)   :: fx
+
+ fx%state = INIT
+ call setup_xml_charsets()
+ fx%context = NULL_CONTEXT
+ call reset_elstack(fx%element_stack)
+ fx%action = ""
+ fx%root_element_seen = .false.
+ call reset_buffer(fx%buffer)
+ call reset_buffer(fx%element_name)
+ call reset_buffer(fx%pcdata)
+ call reset_buffer(fx%root_element_name)
+ call reset_dict(fx%attributes)
+end subroutine reset_fsm
+
+!------------------------------------------------------------
+subroutine evolve_fsm(fx,c,signal)
+!
+! Finite-state machine evolution rules for XML parsing.
+!
+type(fsm_t), intent(inout)      :: fx    ! Internal state
+character(len=1), intent(in)    :: c
+integer, intent(out)            :: signal
+
+!
+! Reset signal
+!
+signal = QUIET
+!
+
+if (.not. (c .in. valid_chars)) then
+!
+!      Let it pass (in case the underlying encoding is UTF-8)
+!      But this chars in a name will cause havoc
+!
+!      signal = EXCEPTION
+!      fx%state = ERROR
+!      fx%action = trim("Not a valid character in simple encoding: "//c)
+!      RETURN
+endif
+
+select case(fx%state)
+
+ case (INIT)
+      if (c == "<") then
+         fx%state = START_TAG_MARKER
+         if (fx%debug) fx%action = ("Starting tag")
+      else if (c == ">") then
+         fx%state = ERROR
+         fx%action = ("Ending tag without being in one!")
+      else
+         if (fx%debug) fx%action = ("Reading garbage chars")
+      endif
+
+ case (START_TAG_MARKER)
+      if (c == ">") then
+         fx%state = ERROR
+         fx%action = ("Tag empty!")
+      else if (c == "<") then
+         fx%state = ERROR
+         fx%action = ("Double opening of tag!!")
+      else if (c == "/") then
+         fx%state = CLOSINGTAG_MARKER
+         if (fx%debug) fx%action = ("Starting endtag: ")
+         fx%context = CLOSING_TAG
+      else if (c == "?") then
+         fx%state = START_XML_DECLARATION
+         if (fx%debug) fx%action = ("Starting XML declaration ")
+         fx%context = XML_DECLARATION_TAG
+      else if (c == "!") then
+         fx%state = BANG
+         if (fx%debug) fx%action = ("Saw ! -- comment or SGML declaration expected...")
+      else if (c .in. whitespace) then
+         fx%state = ERROR
+         fx%action = ("Cannot have whitespace after <")
+      else if (c .in. initial_name_chars) then
+         fx%context = OPENING_TAG
+         fx%state = IN_NAME
+         call add_to_buffer(c,fx%buffer)
+         if (fx%debug) fx%action = ("Starting to read name in tag")
+      else 
+         fx%state = ERROR
+         fx%action = ("Illegal initial character for name")
+      endif
+
+
+ case (BANG)
+      if (c == "-") then
+         fx%state = BANG_HYPHEN
+         if (fx%debug) fx%action = ("Almost ready to start comment ")
+      else if (c .in. uppercase_chars) then
+         fx%state = IN_SGML_DECLARATION
+         fx%nlts = 0
+         fx%nbrackets = 0
+         if (fx%debug) fx%action = ("SGML declaration ")
+         fx%context = SGML_DECLARATION_TAG
+         call add_to_buffer(c,fx%buffer)
+      else if (c == "[") then
+         fx%state = CDATA_PREAMBLE
+         if (fx%debug) fx%action = ("Declaration with [ ")
+         fx%context = CDATA_SECTION_TAG
+      else
+         fx%state = ERROR
+         fx%action = ("Wrong character after ! ")
+      endif
+
+ case (CDATA_PREAMBLE)
+      ! We assume a CDATA[ is forthcoming, we do not check
+      if (c == "[") then
+         fx%state = IN_CDATA_SECTION
+         if (fx%debug) fx%action = ("About to start reading CDATA contents")
+      else if (c == "]") then
+         fx%state = ERROR
+         fx%action = ("Unexpected ] in CDATA preamble")
+      else
+         if (fx%debug) fx%action = ("Reading CDATA preamble")
+      endif
+
+ case (IN_CDATA_SECTION)
+      if (c == "]") then
+         fx%state = ONE_BRACKET
+         if (fx%debug) fx%action = ("Saw a ] in CDATA section")
+      else
+         call add_to_buffer(c,fx%buffer)
+         if (fx%debug) fx%action = ("Reading contents of CDATA section")
+      endif
+
+ case (ONE_BRACKET)
+      if (c == "]") then
+         fx%state = TWO_BRACKET
+         if (fx%debug) fx%action = ("Maybe finish a CDATA section")
+      else
+         fx%state = IN_CDATA_SECTION
+         call add_to_buffer("]",fx%buffer)
+         if (fx%debug) fx%action = ("Continue reading contents of CDATA section")
+      endif
+
+ case (TWO_BRACKET)
+      if (c == ">") then
+         fx%state = END_TAG_MARKER
+         signal = END_OF_TAG
+         if (fx%debug) fx%action = ("End of CDATA section")
+         fx%pcdata = fx%buffer    ! Not quite the same behavior
+                                  ! as pcdata... (not filtered)
+         call reset_buffer(fx%buffer)
+      else
+         fx%state = IN_CDATA_SECTION
+         call add_to_buffer("]",fx%buffer)
+         if (fx%debug) fx%action = ("Continue reading contents of CDATA section")
+      endif
+
+ case (IN_SGML_DECLARATION)
+      if (c == "<") then
+         fx%nlts = fx%nlts + 1
+         call add_to_buffer("<",fx%buffer)
+         fx%action = "Read an intermediate < in SGML declaration"
+      else if (c == "[") then
+         fx%nbrackets = fx%nbrackets + 1
+         call add_to_buffer("[",fx%buffer)
+         fx%action = "Read a [ in SGML declaration"
+      else if (c == "]") then
+         fx%nbrackets = fx%nbrackets - 1
+         call add_to_buffer("]",fx%buffer)
+         fx%action = "Read a ] in SGML declaration"
+      else if (c == ">") then
+         if (fx%nlts == 0) then
+            if (fx%nbrackets == 0) then
+               fx%state = END_TAG_MARKER
+               signal  = END_OF_TAG
+               if (fx%debug) fx%action = ("Ending SGML declaration tag")
+               fx%pcdata = fx%buffer       ! Same behavior as pcdata
+               call reset_buffer(fx%buffer)
+            else
+               fx%state = ERROR
+               fx%action = ("Unmatched ] in SGML declaration")
+            endif
+         else
+            fx%nlts = fx%nlts -1
+            call add_to_buffer(">",fx%buffer)
+            fx%action = "Read an intermediate > in SGML declaration"
+         endif
+      else
+         if (fx%debug) fx%action = ("Keep reading SGML declaration")
+         call add_to_buffer(c,fx%buffer)
+      endif
+
+ case (BANG_HYPHEN)
+      if (c == "-") then
+         fx%state = IN_COMMENT
+         fx%context = COMMENT_TAG
+         if (fx%debug) fx%action = ("In comment ")
+      else
+         fx%state = ERROR
+         fx%action = ("Wrong character after <!- ")
+      endif
+
+ case (START_XML_DECLARATION)
+      if (c .in. initial_name_chars) then
+         fx%state = IN_NAME
+         call add_to_buffer(c,fx%buffer)
+         if (fx%debug) fx%action = ("Starting to read name in XML declaration")
+      else
+         fx%state = ERROR
+         fx%action = "Wrong character after ? in start of XML declaration"
+      endif
+
+ case (CLOSINGTAG_MARKER)
+      if (c == ">") then
+         fx%state = ERROR
+         fx%action = ("Closing tag empty!")
+      else if (c == "<") then
+         fx%state = ERROR
+         fx%action = ("Double opening of closing tag!!")
+      else if (c == "/") then
+         fx%state = ERROR
+         fx%action = ("Syntax error (<//)")
+      else if (c .in. whitespace) then
+         fx%state = ERROR
+         fx%action = ("Cannot have whitespace after </")
+      else if (c .in. initial_name_chars) then
+         fx%state = IN_NAME
+         if (fx%debug) fx%action = ("Starting to read name inside endtag")
+         call add_to_buffer(c,fx%buffer)
+      else 
+         fx%state = ERROR
+         fx%action = ("Illegal initial character for name")
+      endif
+
+ case (IN_NAME)
+      if (c == "<") then
+         fx%state = ERROR
+         fx%action = ("Starting tag within tag")
+      else if (c == ">") then
+         fx%state = END_TAG_MARKER
+         signal  = END_OF_TAG
+         if (fx%debug) fx%action = ("Ending tag")
+!         call set_element_name(fx%buffer,fx%element)
+         fx%element_name = fx%buffer
+         call reset_buffer(fx%buffer)
+         call reset_dict(fx%attributes)
+      else if (c == "/") then
+         if (fx%context /= OPENING_TAG) then
+            fx%state = ERROR
+            fx%action = ("Single tag did not open as start tag")
+         else 
+            fx%state = SINGLETAG_MARKER
+            fx%context = SINGLE_TAG
+            if (fx%debug) fx%action = ("Almost ending single tag")
+!            call set_element_name(fx%buffer,fx%element)
+            fx%element_name = fx%buffer
+            call reset_buffer(fx%buffer)
+            call reset_dict(fx%attributes)
+         endif
+      else if (c .in. whitespace) then
+         fx%state = WHITESPACE_IN_TAG
+         if (fx%debug) fx%action = ("Ending name chars")
+!            call set_element_name(fx%buffer,fx%element)
+         fx%element_name = fx%buffer
+         call reset_buffer(fx%buffer)
+         call reset_dict(fx%attributes)
+      else if (c .in. name_chars) then
+         if (fx%debug) fx%action = ("Reading name chars in tag")
+         call add_to_buffer(c,fx%buffer)
+      else
+         fx%state = ERROR
+         fx%action = ("Illegal character for name")
+      endif
+
+ case (IN_ATT_NAME)
+      if (c == "<") then
+         fx%state = ERROR
+         fx%action = ("Starting tag within tag")
+      else if (c == ">") then
+         fx%state = ERROR
+         fx%action = ("Ending tag in the middle of an attribute")
+      else if (c == "/") then
+         fx%state = ERROR
+         fx%action = ("Ending tag in the middle of an attribute")
+      else if (c .in. whitespace) then
+         fx%state = SPACE_BEFORE_EQUAL  
+         if (fx%debug) fx%action = ("Whitespace after attr. name (specs?)")
+         call add_key_to_dict(fx%buffer,fx%attributes)
+         call reset_buffer(fx%buffer)
+      else if ( c == "=" ) then
+         fx%state = EQUAL
+         if (fx%debug) fx%action = ("End of attr. name")
+         call add_key_to_dict(fx%buffer,fx%attributes)
+         call reset_buffer(fx%buffer)
+      else if (c .in. name_chars) then
+         if (fx%debug) fx%action = ("Reading attribute name chars")
+         call add_to_buffer(c,fx%buffer)
+      else
+         fx%state = ERROR
+         fx%action = ("Illegal character for attribute name")
+      endif
+
+ case (EQUAL)
+      if ( (c == """") .or. (c == "'") ) then
+         fx%state = START_QUOTE
+         if (fx%debug) fx%action = ("Found beginning quote")
+         fx%quote_char = c
+      else if (c .in. whitespace) then
+         fx%state = SPACE_AFTER_EQUAL
+         if (fx%debug) fx%action = ("Whitespace after equal sign...")
+      else
+         fx%state = ERROR
+         fx%action = ("Must use quotes for attribute values")
+      endif
+
+ case (SPACE_BEFORE_EQUAL)
+      if ( c == "=" ) then
+         fx%state = EQUAL
+         if (fx%debug) fx%action = ("Equal sign")
+      else if (c .in. whitespace) then
+         if (fx%debug) fx%action = ("More whitespace before equal sign...")
+      else
+         fx%state = ERROR
+         fx%action = ("Must use equal sign for attribute values")
+      endif
+
+ case (SPACE_AFTER_EQUAL)
+      if ( c == "=" ) then
+         fx%state = ERROR
+         fx%action = ("Duplicate Equal sign")
+      else if (c .in. whitespace) then
+         if (fx%debug) fx%action = ("More whitespace after equal sign...")
+      else  if ( (c == """") .or. (c == "'") ) then
+         fx%state = START_QUOTE
+         fx%quote_char = c
+         if (fx%debug) fx%action = ("Found beginning quote")
+      else
+         fx%state = ERROR
+         fx%action = ("Must use quotes for attribute values")
+      endif
+
+ case (START_QUOTE)
+      if (c == fx%quote_char) then
+         fx%state = END_QUOTE
+         if (fx%debug) fx%action = ("Emtpy attribute value...")
+         call add_value_to_dict(fx%buffer,fx%attributes)
+         call reset_buffer(fx%buffer)
+      else if (c == "<") then
+         fx%state = ERROR
+         fx%action = ("Attribute value cannot contain <")
+      else   ! actually allowed chars in att values... Specs: No "<"        
+         fx%state = IN_ATT_VALUE
+         if (fx%debug) fx%action = ("Starting to read attribute value")
+         call add_to_buffer(c,fx%buffer)
+      endif
+
+ case (IN_ATT_VALUE)
+      if (c == fx%quote_char) then
+         fx%state = END_QUOTE
+         if (fx%debug) fx%action = ("End of attribute value")
+         call add_value_to_dict(fx%buffer,fx%attributes)
+         call reset_buffer(fx%buffer)
+      else if (c == "<") then
+         fx%state = ERROR
+         fx%action = ("Attribute value cannot contain <")
+      else if ( (c == char(10)) ) then
+         fx%state = ERROR
+!
+!        Aparently other whitespace is allowed...
+!
+         fx%action = ("No newline allowed in attr. value (specs?)")
+      else        ! all other chars allowed in attr value
+         if (fx%debug) fx%action = ("Reading attribute value chars")
+         call add_to_buffer(c,fx%buffer)
+      endif
+
+ case (END_QUOTE)
+      if ((c == """") .or. (c == "'")) then
+         fx%state = ERROR
+         fx%action = ("Duplicate end quote")
+      else if (c .in. whitespace) then
+         fx%state = WHITESPACE_IN_TAG
+         if (fx%debug) fx%action = ("Space in between attributes or to end of tag")
+      else if (c == "<") then
+         fx%state = ERROR
+         fx%action = ("Starting tag within tag")
+      else if (c == ">") then
+         if (fx%context == XML_DECLARATION_TAG) then
+            fx%state = ERROR
+            fx%action = "End of XML declaration without ?"
+         else
+            fx%state = END_TAG_MARKER
+            signal  = END_OF_TAG
+            if (fx%debug) fx%action = ("Ending tag after some attributes")
+         endif
+      else if (c == "/") then
+         if (fx%context /= OPENING_TAG) then
+            fx%state = ERROR
+            fx%action = ("Single tag did not open as start tag")
+         else 
+            fx%state = SINGLETAG_MARKER
+            fx%context = SINGLE_TAG
+            if (fx%debug) fx%action = ("Almost ending single tag after some attributes")
+         endif
+      else if (c == "?") then
+         if (fx%context /= XML_DECLARATION_TAG) then
+            fx%state = ERROR
+            fx%action = "Wrong lone ? in tag"
+         else
+            fx%state = QUESTION_MARK
+            if (fx%debug) fx%action = ("About to end XML declaration")
+         endif
+      else   
+         fx%state = ERROR
+         fx%action = ("Must have some whitespace after att. value")
+      endif
+
+
+ case (WHITESPACE_IN_TAG)
+      if ( c .in. whitespace) then
+         if (fx%debug) fx%action = ("Reading whitespace in tag")
+      else if (c == "<") then
+         fx%state = ERROR
+         fx%action = ("Starting tag within tag")
+      else if (c == ">") then
+         if (fx%context == XML_DECLARATION_TAG) then
+            fx%state = ERROR
+            fx%action = "End of XML declaration without ?"
+         else
+            fx%state = END_TAG_MARKER
+            signal  = END_OF_TAG
+            if (fx%debug) fx%action = ("End whitespace in tag")
+         endif
+      else if (c == "/") then
+         if (fx%context /= OPENING_TAG) then
+            fx%state = ERROR
+            fx%action = ("Single tag did not open as start tag")
+         else 
+            fx%state = SINGLETAG_MARKER
+            fx%context = SINGLE_TAG
+            if (fx%debug) fx%action = ("End whitespace in single tag")
+         endif
+      else if (c .in. initial_name_chars) then
+         fx%state = IN_ATT_NAME
+         if (fx%debug) fx%action = ("Starting Attribute name in tag")
+         call add_to_buffer(c,fx%buffer)
+      else if (c == "?") then
+         if (fx%context /= XML_DECLARATION_TAG) then
+            fx%state = ERROR
+            fx%action = "Wrong lone ? in tag"
+         else
+            fx%state = QUESTION_MARK
+            if (fx%debug) fx%action = ("About to end XML declaration after whitespace")
+         endif
+      else
+         fx%state = ERROR
+         fx%action = ("Illegal initial character for attribute")
+      endif
+
+ case (QUESTION_MARK)
+      if (c == ">") then
+         fx%state = END_TAG_MARKER
+         signal  = END_OF_TAG
+         if (fx%debug) fx%action = ("End of XML declaration tag")
+      else
+         fx%state = ERROR
+         fx%action = "No > after ? in XML declaration tag"
+      endif
+
+ case (IN_COMMENT)
+      !
+      ! End of comment is  "-->", and  ">" can appear inside comments
+      !
+      if (c == "-") then
+         fx%state = ONE_HYPHEN
+         if (fx%debug) fx%action = ("Saw - in Comment")
+      else
+         if (fx%debug) fx%action = ("Reading comment")
+         call add_to_buffer(c,fx%buffer)
+      endif
+
+ case (ONE_HYPHEN)
+      if (c == "-") then
+         fx%state = TWO_HYPHEN
+         if (fx%debug) fx%action = ("About to end comment")
+      else
+         fx%state = IN_COMMENT
+         if (fx%debug) fx%action = ("Keep reading comment after -: ")
+         call add_to_buffer("-",fx%buffer)
+         call add_to_buffer(c,fx%buffer)
+      endif
+
+ case (TWO_HYPHEN)
+      if (c == ">") then
+         fx%state = END_TAG_MARKER
+         signal  = END_OF_TAG
+         if (fx%debug) fx%action = ("End of Comment")
+         fx%pcdata = fx%buffer                  ! Same behavior as pcdata
+         call reset_buffer(fx%buffer)
+      else
+         fx%state = ERROR
+         fx%action = ("Cannot have -- in comment")
+      endif
+
+ case (SINGLETAG_MARKER)
+
+      if (c == ">") then
+         fx%state = END_TAG_MARKER
+         signal  = END_OF_TAG
+         if (fx%debug) fx%action = ("Ending tag")
+         ! We have to call begin_element AND end_element
+      else 
+         fx%state = ERROR
+         fx%action = ("Wrong ending of single tag")
+      endif
+
+ case (IN_PCDATA)
+      if (c == "<") then
+         fx%state = START_TAG_MARKER
+         signal = CHUNK_OF_PCDATA
+         if (fx%debug) fx%action = ("End of pcdata -- Starting tag")
+         fx%pcdata = fx%buffer
+         call reset_buffer(fx%buffer)
+      else if (c == ">") then
+         fx%state = ERROR
+         fx%action = ("Ending tag without starting it!")
+      else if  (c == char(10)) then
+         fx%state = IN_PCDATA_AT_EOL
+         signal = CHUNK_OF_PCDATA
+         if (fx%debug) fx%action = ("Resetting PCDATA buffer at newline")
+         call add_to_buffer(c,fx%buffer)
+         fx%pcdata = fx%buffer
+         call reset_buffer(fx%buffer)
+      else
+         call add_to_buffer(c,fx%buffer)
+         if (fx%debug) fx%action = ("Reading chars outside tags")
+         !
+         ! Check whether we are close to the end of the buffer. 
+         ! If so, make a chunk and reset the buffer
+         if (c .in. whitespace) then
+            if (buffer_nearly_full(fx%buffer)) then
+               signal = CHUNK_OF_PCDATA
+               if (fx%debug) fx%action = ("Resetting almost full PCDATA buffer")
+               fx%pcdata = fx%buffer
+               call reset_buffer(fx%buffer)
+            endif
+         endif
+      endif
+
+ case (IN_PCDATA_AT_EOL)
+      !
+      ! Avoid triggering an extra pcdata event
+      !
+      if (c == "<") then
+         fx%state = START_TAG_MARKER
+         if (fx%debug) fx%action = ("No more pcdata after eol-- Starting tag")
+      else if (c == ">") then
+         fx%state = ERROR
+         fx%action = ("Ending tag without starting it!")
+      else if  (c == char(10)) then
+         fx%state = IN_PCDATA_AT_EOL
+         signal = CHUNK_OF_PCDATA
+         if (fx%debug) fx%action = ("Resetting PCDATA buffer at repeated newline")
+         call add_to_buffer(c,fx%buffer)
+         fx%pcdata = fx%buffer
+         call reset_buffer(fx%buffer)
+      else
+         fx%state = IN_PCDATA
+         call add_to_buffer(c,fx%buffer)
+         if (fx%debug) fx%action = ("Reading chars outside tags")
+         !
+         ! Check whether we are close to the end of the buffer. 
+         ! If so, make a chunk and reset the buffer
+         if (c .in. whitespace) then
+            if (buffer_nearly_full(fx%buffer)) then
+               signal = CHUNK_OF_PCDATA
+               if (fx%debug) fx%action = ("Resetting almost full PCDATA buffer")
+               fx%pcdata = fx%buffer
+               call reset_buffer(fx%buffer)
+            endif
+         endif
+      endif
+
+
+
+ case (END_TAG_MARKER)
+!
+      if (c == "<") then
+         fx%state = START_TAG_MARKER
+         if (fx%debug) fx%action = ("Starting tag")
+      else if (c == ">") then
+         fx%state = ERROR
+         fx%action = ("Double ending of tag!")
+!
+!     We should make this whitespace in general (maybe not?
+!     how about indentation in text chunks?)
+!     See specs.
+!
+      else if (c == char(10)) then
+        ! Ignoring LF after end of tag is probably non standard...
+
+         if (fx%debug) &
+            fx%action = ("---------Discarding newline after end of tag")
+
+        !!!  New code for full compliance
+        ! fx%state = IN_PCDATA_AT_EOL
+        ! call add_to_buffer(c,fx%buffer)
+        ! if (fx%debug) &
+        !    fx%action = ("Found LF after end of tag. Emitting PCDATA event")
+        ! signal = CHUNK_OF_PCDATA
+        ! fx%pcdata = fx%buffer
+        ! call reset_buffer(fx%buffer)
+      else
+         fx%state = IN_PCDATA
+         call add_to_buffer(c,fx%buffer)
+         if (fx%debug) fx%action = ("End of Tag. Starting to read PCDATA")
+      endif
+
+ case (ERROR)
+
+      stop "Cannot continue after parsing errors!"
+
+ end select
+
+if (fx%state == ERROR) signal  = EXCEPTION
+
+end subroutine evolve_fsm
+
+end module m_fsm
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_io.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_io.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_io.f90	(revision 2528)
@@ -0,0 +1,94 @@
+module m_io
+
+!
+! Basic  I/O tools
+!
+integer, public, save            :: io_eor, io_eof
+
+public  :: get_unit, setup_io
+private :: find_eor_eof
+
+CONTAINS
+
+! ----------------------------------------------------------------------
+subroutine setup_io()
+  call find_eor_eof(io_eor, io_eof)
+end subroutine setup_io
+
+! ----------------------------------------------------------------------
+subroutine get_unit(lun,iostat)
+
+! Get an available Fortran unit number
+
+integer, intent(out)  :: lun
+integer, intent(out)  :: iostat
+
+integer :: i
+logical :: unit_used
+
+do i = 10, 99
+   lun = i
+   inquire(unit=lun,opened=unit_used)
+   if (.not. unit_used) then
+      iostat = 0
+      return
+   endif
+enddo
+iostat = -1
+lun = -1
+end subroutine get_unit
+! ----------------------------------------------------------------------
+
+subroutine find_eor_eof(io_eor,io_eof)
+!
+! Determines the values of the iostat values for End of File and 
+! End of Record (in non-advancing I/O)
+!
+integer, intent(out)           :: io_eor
+integer, intent(out)           :: io_eof
+
+integer           :: lun, iostat
+character(len=1)  :: c
+
+call get_unit(lun,iostat)
+
+if (iostat /= 0) stop "Out of unit numbers"
+
+open(unit=lun,status="scratch",form="formatted", &
+     action="readwrite",position="rewind",iostat=iostat)
+if (iostat /= 0)   stop "Cannot open test file"
+
+write(unit=lun,fmt=*)  "a"
+write(unit=lun,fmt=*)  "b"
+
+rewind(unit=lun)
+
+io_eor = 0
+do
+  read(unit=lun,fmt="(a1)",advance="NO",iostat=io_eor) c
+  if (io_eor /= 0) exit
+enddo
+
+io_eof = 0
+do
+  read(unit=lun,fmt=*,iostat=io_eof)
+  if (io_eof /= 0) exit
+enddo
+
+!!!!!!!!print *, "IO_EOR, IO_EOF: ", io_eor, io_eof
+
+close(unit=lun,status="delete")
+
+end subroutine find_eor_eof
+
+! ----------------------------------------------------------------------
+end module m_io
+
+
+
+
+
+
+
+
+
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_reader.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_reader.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_reader.f90	(revision 2528)
@@ -0,0 +1,298 @@
+module m_reader
+
+use m_io
+
+private
+
+integer, parameter, public              :: BUFFER_NOT_CONNECTED = -2048
+integer, private, parameter             :: MAXLENGTH = 1024
+
+type, public :: file_buffer_t
+private
+      logical                           :: connected
+      logical                           :: eof
+      integer                           :: lun
+      character(len=50)                 :: filename
+      integer                           :: counter
+      character(len=MAXLENGTH)          :: buffer
+      integer                           :: line
+      integer                           :: col
+      integer                           :: pos 
+      integer                           :: nchars
+      logical                           :: debug
+end type file_buffer_t
+
+public  :: get_character, sync_file
+public  :: line, column, nchars_processed
+public  :: open_file, close_file_buffer, rewind_file, mark_eof_file
+public  :: eof_file
+
+private :: fill_buffer
+
+CONTAINS
+
+!-----------------------------------------
+!
+subroutine open_file(fname,fb,iostat,record_size,verbose)
+character(len=*), intent(in)      :: fname
+type(file_buffer_t), intent(out)  :: fb
+integer, intent(out)              :: iostat
+integer, intent(in), optional     :: record_size
+logical, intent(in), optional     :: verbose
+
+iostat = 0
+
+call setup_io()
+
+fb%connected = .false.
+
+call get_unit(fb%lun,iostat)
+if (iostat /= 0) then
+   if (fb%debug) print *, "Cannot get unit"
+   return
+endif
+
+if (present(verbose)) then
+   fb%debug = verbose
+else
+   fb%debug = .false.
+endif
+
+if (present(record_size)) then
+   open(unit=fb%lun,file=fname,form="formatted",status="old", &
+        action="read",position="rewind",recl=record_size,iostat=iostat)
+else
+   open(unit=fb%lun,file=fname,form="formatted",status="old", &
+        action="read",position="rewind",recl=65536,iostat=iostat)
+endif
+if (iostat /= 0) then
+   if (fb%debug) print *, "Cannot open file ", trim(fname), " iostat: ", iostat
+   return
+endif
+
+fb%connected = .true.
+fb%counter = 0
+fb%eof = .false.
+fb%line = 1
+fb%col = 0
+fb%filename = fname
+fb%pos = 0
+fb%nchars = 0
+fb%buffer = ""
+
+end subroutine open_file
+
+!-------------------------------------------------
+subroutine rewind_file(fb)
+type(file_buffer_t), intent(inout)  :: fb
+
+fb%eof = .false.
+fb%counter = 0
+fb%line = 1
+fb%col = 0
+fb%pos = 0
+fb%nchars = 0
+fb%buffer = ""
+
+rewind(unit=fb%lun)
+
+end subroutine rewind_file
+!-----------------------------------------
+subroutine mark_eof_file(fb)
+type(file_buffer_t), intent(inout)  :: fb
+
+fb%eof = .true.
+
+end subroutine mark_eof_file
+
+!-----------------------------------------
+subroutine close_file_buffer(fb)
+type(file_buffer_t), intent(inout)  :: fb
+
+if (fb%connected) then
+    close(unit=fb%lun)
+    fb%connected = .false.
+endif
+
+end subroutine close_file_buffer
+
+!-------------------------------------------------
+function eof_file(fb) result (res)
+type(file_buffer_t), intent(in)  :: fb
+logical                          :: res
+
+res = fb%eof
+
+end function eof_file
+!-----------------------------------------
+!-----------------------------------------
+! New version, able to cope with arbitrarily long lines 
+! (still need to specify a big enough record_size if necessary)
+!
+subroutine fill_buffer(fb,iostat)
+type(file_buffer_t), intent(inout)  :: fb
+integer, intent(out)  :: iostat
+! 
+!
+character(len=41)  :: str       ! 40 seems like a good compromise?
+                                ! (1 extra for added newline, see below)
+integer            :: len
+!
+read(unit=fb%lun,iostat=iostat,advance="no",size=len,fmt="(a40)") str
+
+if (iostat == io_eof) then
+   
+   ! End of file
+   if (fb%debug) print *, "End of file."
+   return
+
+else if (iostat > 0) then
+
+   ! Hard i/o error
+   if (fb%debug) print *, "Hard i/o error. iostat:", iostat
+   RETURN
+
+else
+!
+ if (fb%debug) then
+   print *, "Buffer: len, iostat", len, iostat
+   print *, trim(str)
+ endif
+
+   fb%pos = 0
+
+   if (iostat == 0) then
+
+      !  Normal read, with more stuff left on the line
+      !
+      fb%buffer = str(1:len) 
+      fb%nchars = len
+
+   else         ! (end of record)
+      !
+      !  End of record. We mark it with an LF, whatever it is the native marker.
+      !
+!!      fb%buffer = str(1:len) // char(10)
+      fb%buffer = str(1:len)             !! Avoid allocation of string
+      len = len + 1                      !! by compiler
+      fb%buffer(len:len) = char(10)   
+      fb%nchars = len
+      iostat = 0
+   endif
+
+endif
+
+end subroutine fill_buffer
+
+!---------------------------------------------------------------
+subroutine get_character(fb,c,iostat)
+character(len=1), intent(out) :: c
+type(file_buffer_t), intent(inout)  :: fb
+integer, intent(out)          :: iostat
+
+character(len=1)   :: c_next
+
+if (.not. fb%connected) then
+      iostat = BUFFER_NOT_CONNECTED
+      return
+endif
+
+if (fb%pos >= fb%nchars) then
+      call fill_buffer(fb,iostat)
+      if (iostat /= 0) return
+endif
+fb%pos = fb%pos + 1
+c = fb%buffer(fb%pos:fb%pos)
+fb%counter = fb%counter + 1              ! Raw counter
+fb%col = fb%col + 1
+!
+! Deal with end-of-line handling on the processor...
+!
+if (c == char(10)) then
+   ! Our own marker for end of line
+   fb%line = fb%line + 1
+   fb%col = 0
+endif
+if (c == char(13)) then
+   c_next = fb%buffer(fb%pos+1:fb%pos+1)
+   if (c_next == char(10)) then
+      !
+      ! Found CRLF. We replace it by LF, as per specs.
+      c = c_next
+      fb%pos = fb%pos + 1
+      if (fb%debug) print *, "-/-> Removed CR before LF in get_character"
+   else
+      ! Replace single CR by LF
+      c = char(10)
+      if (fb%debug) print *, "-/-> Changed CR to LF in get_character -- line++"
+      !
+   endif
+   ! In both cases we increase the line counter and reset the column
+   !
+   fb%line = fb%line + 1
+   fb%col = 0
+endif
+
+iostat = 0
+
+end subroutine get_character
+
+!----------------------------------------------------
+!----------------------------------------------------
+! Error Location functions
+!
+function line(fb) result (ll)
+type(file_buffer_t), intent(in)  :: fb
+integer                          :: ll
+
+ll = fb%line
+end function line
+
+!----------------------------------------------------
+function column(fb) result (col)
+type(file_buffer_t), intent(in)  :: fb
+integer                          :: col
+
+col = fb%col
+end function column
+!----------------------------------------------------
+!----------------------------------------------------
+function nchars_processed(fb) result (nc)
+type(file_buffer_t), intent(in)  :: fb
+integer                          :: nc
+
+nc = fb%counter
+end function nchars_processed
+!----------------------------------------------------
+
+subroutine sync_file(fb,iostat)
+type(file_buffer_t), intent(inout)  :: fb
+integer, intent(out)                :: iostat
+!
+! Repositions the file so that it matches with
+! the stored file_buffer information
+!
+integer          :: target_counter
+character(len=1) :: c
+
+target_counter = fb%counter
+call rewind_file(fb)
+iostat = 0
+do
+   if (fb%counter == target_counter) exit
+   call get_character(fb,c,iostat)
+   if (iostat /= 0) return
+enddo
+
+end subroutine sync_file
+
+end module m_reader
+
+
+
+
+
+
+
+
+
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_xml_error.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_xml_error.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_xml_error.f90	(revision 2528)
@@ -0,0 +1,84 @@
+module m_xml_error
+!
+! Error handling
+!
+use m_elstack
+private
+
+type, public  :: xml_error_t
+      character(len=100)  :: message
+      integer             :: line
+      integer             :: column
+      type(elstack_t)     :: stack
+      integer             :: severity
+end type xml_error_t
+
+integer, public             ::  xml_stderr = 0    ! Unit for error info
+integer, public, parameter  ::  SEVERE_ERROR_CODE=0, WARNING_CODE=1
+
+public  :: build_error_info, default_error_handler
+public  :: set_xml_stderr
+
+CONTAINS
+
+!-------------------------------------------------------------------------
+subroutine build_error_info(error_info,message,line,column,stack,severity)
+type(xml_error_t), intent(out)        :: error_info
+integer, intent(in)                   :: line, column
+character(len=*), intent(in)          :: message
+type(elstack_t), intent(in)           :: stack
+integer, intent(in)                   :: severity
+
+error_info%message = message
+error_info%line = line
+error_info%column = column
+error_info%stack = stack
+error_info%severity = severity
+
+end subroutine build_error_info
+
+!--------------------------------------------------
+
+subroutine default_error_handler(error_info)
+type(xml_error_t), intent(in)            :: error_info
+!
+! Default error handling
+!
+if (error_info%severity == SEVERE_ERROR_CODE)  then
+   write(unit=xml_stderr,fmt="(a)") "*** XML parsing Error:"
+else if (error_info%severity == WARNING_CODE)  then
+   write(unit=xml_stderr,fmt="(a)") "*** XML parsing Warning:"
+endif
+write(unit=xml_stderr,fmt="(a)") trim(error_info%message)
+write(unit=xml_stderr,fmt="(a,i8,a,i4)") "Line: ", &
+                                         error_info%line, &
+                                         " Column: ", &
+                                         error_info%column
+write(unit=xml_stderr,fmt="(a)") "Element traceback:"
+call print_elstack(error_info%stack,unit=xml_stderr)
+!
+!   If there is a severe error the program should stop...
+!
+if (error_info%severity == SEVERE_ERROR_CODE)  then
+      STOP
+else if (error_info%severity == WARNING_CODE)  then
+   write(unit=xml_stderr,fmt="(a)") "*** Continuing after Warning..."
+endif
+
+end subroutine default_error_handler
+
+!-------------------------------------------------------------------------
+subroutine set_xml_stderr(unit)
+integer, intent(in)  :: unit
+
+xml_stderr  = unit
+
+end subroutine set_xml_stderr
+
+end module m_xml_error
+
+
+
+
+
+
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_xml_parser.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_xml_parser.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_xml_parser.f90	(revision 2528)
@@ -0,0 +1,506 @@
+module m_xml_parser
+
+!
+! Basic module to parse XML in the SAX spirit.
+!
+
+use m_buffer
+use m_reader
+use m_fsm
+use m_dictionary
+use m_debug
+use m_xml_error
+use m_elstack          ! For element nesting checks
+use m_entities
+!
+private
+
+!
+!  XML file handle
+!
+type, public :: xml_t
+private
+      type(file_buffer_t)  :: fb
+      type(fsm_t)          :: fx
+      character(len=200)   :: path_mark
+end type xml_t
+
+!
+public :: xml_parse
+public :: open_xmlfile, close_xmlfile
+public :: endfile_xmlfile, rewind_xmlfile
+public :: eof_xmlfile, sync_xmlfile
+public :: xml_char_count
+public :: xml_path, xml_mark_path, xml_get_path_mark
+public :: xml_name, xml_attributes
+
+CONTAINS  !=============================================================
+
+subroutine open_xmlfile(fname,fxml,iostat,record_size)
+character(len=*), intent(in)      :: fname
+integer, intent(out)              :: iostat
+type(xml_t), intent(out)          :: fxml
+integer, intent(in), optional     :: record_size
+
+call open_file(fname,fxml%fb,iostat,record_size)
+call init_fsm(fxml%fx)
+fxml%path_mark = ""
+
+end subroutine open_xmlfile
+!-------------------------------------------------------------------------
+
+subroutine rewind_xmlfile(fxml)
+type(xml_t), intent(inout) :: fxml
+
+call rewind_file(fxml%fb)
+call reset_fsm(fxml%fx)
+fxml%path_mark = ""
+
+end subroutine rewind_xmlfile
+
+!-----------------------------------------
+subroutine endfile_xmlfile(fxml)
+type(xml_t), intent(inout) :: fxml
+
+call mark_eof_file(fxml%fb) 
+
+end subroutine endfile_xmlfile
+
+!-----------------------------------------
+subroutine close_xmlfile(fxml)
+type(xml_t), intent(inout) :: fxml
+
+call close_file_buffer(fxml%fb)
+call reset_fsm(fxml%fx)         ! just in case
+fxml%path_mark = ""             ! ""
+
+end subroutine close_xmlfile
+
+!-----------------------------------------
+subroutine sync_xmlfile(fxml,iostat)
+type(xml_t), intent(inout) :: fxml
+integer, intent(out)       :: iostat
+
+call sync_file(fxml%fb,iostat)
+! Do not reset fx: that's the whole point of synching.
+
+end subroutine sync_xmlfile
+
+!----------------------------------------------------
+function eof_xmlfile(fxml) result (res)
+type(xml_t), intent(in)          :: fxml
+logical                          :: res
+
+res = eof_file(fxml%fb)
+
+end function eof_xmlfile
+!
+!----------------------------------------------------
+!----------------------------------------------------
+function xml_char_count(fxml) result (nc)
+type(xml_t), intent(in)          :: fxml
+integer                          :: nc
+
+nc = nchars_processed(fxml%fb)
+
+end function xml_char_count
+!
+!----------------------------------------------------
+!
+
+subroutine xml_parse(fxml, begin_element_handler,    &
+                           end_element_handler,      &
+                           pcdata_chunk_handler,     &
+                           comment_handler,          &
+                           xml_declaration_handler,  &
+                           cdata_section_handler,     &
+                           sgml_declaration_handler, &
+                           error_handler,            &
+                           signal_handler,            &
+                           verbose,                  &
+                           empty_element_handler)
+
+type(xml_t), intent(inout), target  :: fxml
+
+optional                            :: begin_element_handler
+optional                            :: end_element_handler
+optional                            :: pcdata_chunk_handler
+optional                            :: comment_handler
+optional                            :: xml_declaration_handler
+optional                            :: sgml_declaration_handler
+optional                            :: cdata_section_handler
+optional                            :: error_handler
+optional                            :: signal_handler
+logical, intent(in), optional       :: verbose
+optional                            :: empty_element_handler
+
+interface
+   subroutine begin_element_handler(name,attributes)
+   use m_dictionary
+   character(len=*), intent(in)     :: name
+   type(dictionary_t), intent(in)   :: attributes
+   end subroutine begin_element_handler
+
+   subroutine end_element_handler(name)
+   character(len=*), intent(in)     :: name
+   end subroutine end_element_handler
+
+   subroutine pcdata_chunk_handler(chunk)
+   character(len=*), intent(in) :: chunk
+   end subroutine pcdata_chunk_handler
+
+   subroutine comment_handler(comment)
+   character(len=*), intent(in) :: comment
+   end subroutine comment_handler
+
+   subroutine xml_declaration_handler(name,attributes)
+   use m_dictionary
+   character(len=*), intent(in)     :: name
+   type(dictionary_t), intent(in)   :: attributes
+   end subroutine xml_declaration_handler
+
+   subroutine sgml_declaration_handler(sgml_declaration)
+   character(len=*), intent(in) :: sgml_declaration
+   end subroutine sgml_declaration_handler
+
+   subroutine cdata_section_handler(cdata)
+   character(len=*), intent(in) :: cdata
+   end subroutine cdata_section_handler
+
+   subroutine error_handler(error_info)
+   use m_xml_error
+   type(xml_error_t), intent(in)            :: error_info
+   end subroutine error_handler
+
+   subroutine signal_handler(code)
+   logical, intent(out) :: code
+   end subroutine signal_handler
+
+   subroutine empty_element_handler(name,attributes)
+   use m_dictionary
+   character(len=*), intent(in)     :: name
+   type(dictionary_t), intent(in)   :: attributes
+   end subroutine empty_element_handler
+
+end interface
+
+character(len=1)     :: c
+integer              :: iostat, status
+
+character(len=150)   :: message
+integer              :: signal
+
+type(buffer_t)       :: translated_pcdata
+type(buffer_t)       :: name, oldname, dummy
+
+logical              :: have_begin_handler, have_end_handler, &
+                        have_pcdata_handler, have_comment_handler, &
+                        have_xml_declaration_handler, &
+                        have_sgml_declaration_handler, &
+                        have_cdata_section_handler, have_empty_handler, &
+                        have_error_handler, have_signal_handler
+
+logical              :: pause_signal
+
+type(xml_error_t)            :: error_info
+type(file_buffer_t), pointer :: fb
+type(fsm_t), pointer         :: fx
+
+have_begin_handler = present(begin_element_handler)
+have_end_handler = present(end_element_handler)
+have_pcdata_handler = present(pcdata_chunk_handler)
+have_comment_handler = present(comment_handler)
+have_xml_declaration_handler = present(xml_declaration_handler)
+have_sgml_declaration_handler = present(sgml_declaration_handler)
+have_cdata_section_handler = present(cdata_section_handler)
+have_error_handler = present(error_handler)
+have_signal_handler = present(signal_handler)
+have_empty_handler = present(empty_element_handler)
+
+fb => fxml%fb
+fx => fxml%fx
+if (present(verbose)) then
+   debug = verbose                 ! For m_converters
+   fx%debug = verbose              ! job-specific flag
+endif
+
+if (fx%debug) print *, " Entering xml_parse..."
+
+!---------------------------------------------------------------------
+do
+      call get_character(fb,c,iostat)
+
+      if (iostat /= 0) then          ! End of file...
+         if (.not. is_empty(fx%element_stack)) then
+            call build_error_info(error_info, &
+                 "Early end of file.", &
+                 line(fb),column(fb),fx%element_stack,SEVERE_ERROR_CODE)
+            if (have_error_handler) then
+               call error_handler(error_info)
+            else
+               call default_error_handler(error_info)
+            endif
+         endif
+         call endfile_xmlfile(fxml)  ! Mark it as eof
+         EXIT
+      endif
+
+      call evolve_fsm(fx,c,signal)
+
+      if (fx%debug) print *, c, " ::: ", trim(fx%action)
+
+      if (signal == END_OF_TAG) then
+         !
+         ! We decide whether we have ended an opening tag or a closing tag
+         !
+         if (fx%context == OPENING_TAG) then
+            name = fx%element_name
+
+            if (fx%debug) print *, "We have found an opening tag"
+            if (fx%root_element_seen) then
+               if (name .equal. fx%root_element_name) then
+                  call build_error_info(error_info, &
+                  "Duplicate root element: " // str(name), &
+                  line(fb),column(fb),fx%element_stack,SEVERE_ERROR_CODE)
+                  if (have_error_handler) then
+                     call error_handler(error_info)
+                  else
+                     call default_error_handler(error_info)
+                  endif
+               endif
+               if (is_empty(fx%element_stack)) then
+                  call build_error_info(error_info, &
+                  "Opening tag beyond root context: " // str(name), &
+                  line(fb),column(fb),fx%element_stack,SEVERE_ERROR_CODE)
+                  if (have_error_handler) then
+                     call error_handler(error_info)
+                  else
+                     call default_error_handler(error_info)
+                  endif
+               endif
+            else
+               fx%root_element_name = name
+               fx%root_element_seen = .true.
+            endif
+            call push_elstack(name,fx%element_stack)
+            if (have_begin_handler) &
+                call begin_element_handler(str(name),fx%attributes)
+
+         else if (fx%context == CLOSING_TAG) then
+            name = fx%element_name
+         
+            if (fx%debug) print *, "We have found a closing tag"
+            if (is_empty(fx%element_stack)) then
+               call build_error_info(error_info, &
+                  "Nesting error: End tag: " // str(name) //  &
+                  " does not match -- too many end tags", &
+                  line(fb),column(fb),fx%element_stack,SEVERE_ERROR_CODE)
+               if (have_error_handler) then
+                  call error_handler(error_info)
+               else
+                  call default_error_handler(error_info)
+               endif
+            else
+               call get_top_elstack(fx%element_stack,oldname)
+               if (oldname .equal. name) then
+                  call pop_elstack(fx%element_stack,oldname)
+                  if (have_end_handler) call end_element_handler(str(name))
+!!                  call pop_elstack(fx%element_stack,oldname)
+               else
+                  call build_error_info(error_info, &
+                       "Nesting error: End tag: " // str(name) //  &
+                       ". Expecting end of : " // str(oldname), &
+                       line(fb),column(fb),fx%element_stack,SEVERE_ERROR_CODE)
+                  if (have_error_handler) then
+                     call error_handler(error_info)
+                  else
+                     call default_error_handler(error_info)
+                  endif
+               endif
+            endif
+         else if (fx%context == SINGLE_TAG) then
+            name = fx%element_name
+
+            if (fx%debug) print *, "We have found a single (empty) tag: ", &
+                                char(name)
+            !
+            ! Push name on to stack to reveal true xpath
+            !
+            call push_elstack(name,fx%element_stack)
+            if (have_empty_handler) then
+               if (fx%debug) print *, "--> calling empty_element_handler."
+               call empty_element_handler(str(name),fx%attributes)
+               call pop_elstack(fx%element_stack,dummy)
+            else
+               if (have_begin_handler) then
+                  if (fx%debug) print *, "--> calling begin_element_handler..."
+                  call begin_element_handler(str(name),fx%attributes)
+               endif
+               call pop_elstack(fx%element_stack,dummy)
+               if (have_end_handler) then
+                  if (fx%debug) print *, "--> ... and end_element_handler."
+                  call end_element_handler(str(name))
+               endif
+            endif
+!!            call pop_elstack(fx%element_stack,dummy)
+
+         else if (fx%context == CDATA_SECTION_TAG) then
+
+            if (fx%debug) print *, "We found a CDATA section"
+            if (is_empty(fx%element_stack)) then
+               if (fx%debug) print *, &
+                   "... Warning: CDATA section outside element context"
+            else
+               if (have_cdata_section_handler) then
+                  call cdata_section_handler(str(fx%pcdata))
+               else
+                  if (have_pcdata_handler) &
+                   call pcdata_chunk_handler(str(fx%pcdata))
+               endif
+            endif
+
+         else if (fx%context == COMMENT_TAG) then
+
+            if (fx%debug) print *, "We found a comment tag"
+            if (have_comment_handler)  &
+                 call comment_handler(str(fx%pcdata))
+
+         else if (fx%context == SGML_DECLARATION_TAG) then
+
+            if (fx%debug) print *, "We found an sgml declaration"
+            if (have_sgml_declaration_handler)  &
+                      call sgml_declaration_handler(str(fx%pcdata))
+
+         else if (fx%context == XML_DECLARATION_TAG) then
+
+            if (fx%debug) print *, "We found an XML declaration"
+            name = fx%element_name
+            if (have_xml_declaration_handler)  &
+                      call xml_declaration_handler(str(name),fx%attributes)
+
+         else
+
+            ! do nothing
+
+         endif
+
+      else if (signal == CHUNK_OF_PCDATA) then
+
+         if (fx%debug) print *, "We found a chunk of PCDATA"
+         if (is_empty(fx%element_stack)) then
+            if (fx%debug) print *, "... Warning: PCDATA outside element context"
+               ! Just a warning
+               call build_error_info(error_info, &
+                  "PCDATA outside of element context", &
+                  line(fb),column(fb),fx%element_stack,WARNING_CODE)
+               if (have_error_handler) then
+                  call error_handler(error_info)
+               else
+                  call default_error_handler(error_info)
+               endif
+         else
+            !
+            ! Replace entities by their value
+            !
+            call entity_filter(fx%pcdata,translated_pcdata,status,message)
+            if (status < 0) then
+               call build_error_info(error_info, message, &
+                  line(fb),-status,fx%element_stack,SEVERE_ERROR_CODE)
+               if (have_error_handler) then
+                  call error_handler(error_info)
+               else
+                  call default_error_handler(error_info)
+               endif
+            else if (status > 0) then
+               ! Just a warning
+               call build_error_info(error_info, message, &
+                  line(fb),status,fx%element_stack,WARNING_CODE)
+               if (have_error_handler) then
+                  call error_handler(error_info)
+               else
+                  call default_error_handler(error_info)
+               endif
+            else
+               if (have_pcdata_handler) &
+                   call pcdata_chunk_handler(str(translated_pcdata))
+            endif
+         endif
+
+      else if (signal == EXCEPTION) then
+         call build_error_info(error_info, fx%action, &
+                  line(fb),column(fb),fx%element_stack,SEVERE_ERROR_CODE)
+         if (have_error_handler) then
+            call error_handler(error_info)
+         else
+            call default_error_handler(error_info)
+         endif
+      else
+         ! QUIET, do nothing
+      endif
+      if (signal /= QUIET) then
+         if (have_signal_handler) then
+            call signal_handler(pause_signal)
+            if (pause_signal) exit
+         endif
+      endif
+
+enddo
+
+end subroutine xml_parse
+
+!-----------------------------------------
+subroutine xml_path(fxml,path)
+type(xml_t), intent(in) :: fxml
+character(len=*), intent(out)  :: path
+
+call get_elstack_signature(fxml%fx%element_stack,path)
+
+end subroutine xml_path
+
+!-----------------------------------------
+subroutine xml_mark_path(fxml,path)
+!
+! Marks the current path
+!
+type(xml_t), intent(inout) :: fxml
+character(len=*), intent(out)  :: path
+
+call get_elstack_signature(fxml%fx%element_stack,fxml%path_mark)
+path = fxml%path_mark
+
+end subroutine xml_mark_path
+
+!-----------------------------------------
+subroutine xml_get_path_mark(fxml,path)
+!
+! Returns the currently markd path (or an empty string if there are no marks)
+!
+type(xml_t), intent(in)        :: fxml
+character(len=*), intent(out)  :: path
+
+path = fxml%path_mark
+
+end subroutine xml_get_path_mark
+
+!-----------------------------------------
+subroutine xml_name(fxml,name)
+type(xml_t), intent(in) :: fxml
+character(len=*), intent(out)  :: name
+
+name = char(fxml%fx%element_name)
+
+end subroutine xml_name
+!-----------------------------------------
+subroutine xml_attributes(fxml,attributes)
+type(xml_t), intent(in) :: fxml
+type(dictionary_t), intent(out)  :: attributes
+
+attributes = fxml%fx%attributes
+
+end subroutine xml_attributes
+
+end module m_xml_parser
+
+
+
+
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/strings/m_strings.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/strings/m_strings.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/strings/m_strings.f90	(revision 2528)
@@ -0,0 +1,6323 @@
+!*******************************************************************************
+! module STRINGS
+! Mart Rentmeester, Mart.Rentmeester@sci.kun.nl
+! http://nn-online.sci.kun.nl/fortran
+! Version 1.0
+!*******************************************************************************
+
+      module m_strings
+
+      private
+
+      type string
+          private
+          integer                 :: len = 0
+          integer                 :: size = 0
+
+          character, pointer      :: chars(:) => null()
+
+      end type string
+
+      character, parameter :: blank = ' '
+
+!     GENERIC PROCEDURE INTERFACE DEFINITIONS
+
+!---- LEN interface
+      interface len
+          module procedure len_s
+      end interface
+
+!---- Conversion (to CHAR) procedure interfaces
+      interface char
+          module procedure s_to_c, &! string to character
+                           s_to_slc       ! string to specified length character
+      end interface
+
+!---- ASSIGNMENT interfaces
+      interface assignment(=)
+          module procedure assign_s_to_s, &! string = string
+                           assign_s_to_c, &! character = string
+                           assign_c_to_s        ! string = character
+      end interface
+
+!---- // operator interfaces
+      interface operator(//)
+          module procedure s_concat_s, &! string // string
+                           s_concat_c, &! string // character
+                           c_concat_s     ! character // string
+      end interface
+
+!---- INSERT_IN_STRING interface
+      interface insert_in_string
+          module procedure insert_in_string_c, insert_in_string_s
+      end interface
+
+!---- PREPEND_TO_STRING interface
+      interface prepend_to_string
+          module procedure prepend_to_string_c, prepend_to_string_s
+      end interface
+
+!---- APPEND_TO_STRING interface
+      interface append_to_string
+          module procedure append_to_string_c, append_to_string_s
+      end interface
+
+!---- REPLACE_IN_STRING interface
+      interface replace_in_string
+          module procedure replace_in_string_sc_s,   replace_in_string_ss_s,   &
+                           replace_in_string_sc_sf,  replace_in_string_ss_sf,  &
+                           replace_in_string_scc,    replace_in_string_ssc,    &
+                           replace_in_string_scs,    replace_in_string_sss,    &
+                           replace_in_string_scc_f,  replace_in_string_ssc_f,  &
+                           replace_in_string_scs_f,  replace_in_string_sss_f
+      end interface
+
+
+!---- REPEAT interface
+      interface repeat
+          module procedure repeat_s
+      end interface
+
+!---- ==  .eq. comparison operator interfaces
+      interface operator(==)
+          module procedure s_eq_s, &! string == string
+                           s_eq_c, &! string == character
+                           c_eq_s         ! character == string
+      end interface
+
+!---- /=  .ne. comparison operator interfaces
+      interface operator(/=)
+          module procedure s_ne_s, &! string /= string
+                           s_ne_c, &! string /= character
+                           c_ne_s         ! character /= string
+      end interface
+
+!---- <  .lt. comparison operator interfaces
+      interface operator(<)
+          module procedure s_lt_s, &! string < string
+                           s_lt_c, &! string < character
+                           c_lt_s         ! character < string
+      end interface
+
+!---- <=  .le. comparison operator interfaces
+      interface operator(<=)
+          module procedure s_le_s, &! string <= string
+                           s_le_c, &! string <= character
+                           c_le_s         ! character <= string
+      end interface
+
+!---- >=  .ge. comparison operator interfaces
+      interface operator(>=)
+          module procedure s_ge_s, &! string >= string
+                           s_ge_c, &! string >= character
+                           c_ge_s         ! character >= string
+      end interface
+
+!---- >  .gt. comparison operator interfaces
+      interface operator(>)
+          module procedure s_gt_s, &! string > string
+                           s_gt_c, &! string > character
+                           c_gt_s         ! character > string
+      end interface
+
+!---- .aeq. comparison operator interfaces
+      interface operator(.aeq.)
+          module procedure a_eq_a, &! array == array
+                           a_eq_c, &! array == character
+                           c_eq_a         ! character == array
+      end interface
+
+!---- .ane. comparison operator interfaces
+      interface operator(.ane.)
+          module procedure a_ne_a, &! array /= array
+                           a_ne_c, &! array /= character
+                           c_ne_a         ! character /= array
+      end interface
+
+!---- .alt. comparison operator interfaces
+      interface operator(.alt.)
+          module procedure a_lt_a, &! array < array
+                           a_lt_c, &! array < character
+                           c_lt_a         ! character < array
+      end interface
+
+!---- .ale. comparison operator interfaces
+      interface operator(.ale.)
+          module procedure a_le_a, &! array <= array
+                           a_le_c, &! array <= character
+                           c_le_a         ! character <= array
+      end interface
+
+!---- .age. comparison operator interfaces
+      interface operator(.age.)
+          module procedure a_ge_a, &! array >= array
+                           a_ge_c, &! array >= character
+                           c_ge_a         ! character >= array
+      end interface
+
+!---- .agt. comparison operator interfaces
+      interface operator(.agt.)
+          module procedure a_gt_a, &! array > array
+                           a_gt_c, &! array > character
+                           c_gt_a         ! character > array
+      end interface
+
+!---- LLT comparison function interfaces
+      interface llt
+          module procedure s_llt_s, &! llt(string,string)
+                           s_llt_c, &! llt(string,character)
+                           c_llt_s        ! llt(character,string)
+      end interface
+
+!---- LLE comparison function interfaces
+      interface lle
+          module procedure s_lle_s, &! lle(string,string)
+                           s_lle_c, &! lle(string,character)
+                           c_lle_s        ! lle(character,string)
+      end interface
+
+!---- LGE comparison function interfaces
+      interface lge
+          module procedure s_lge_s, &! lge(string,string)
+                           s_lge_c, &! lge(string,character)
+                           c_lge_s        ! lge(character,string)
+      end interface
+
+!---- LGT comparison function interfaces
+      interface lgt
+          module procedure s_lgt_s, &! lgt(string,string)
+                           s_lgt_c, &! lgt(string,character)
+                           c_lgt_s        ! lgt(character,string)
+      end interface
+
+!---- ALLT comparison function interfaces
+      interface allt
+          module procedure a_allt_a, &! allt(array,array)
+                           a_allt_c, &! allt(array,character)
+                           c_allt_a        ! allt(character,array)
+      end interface
+
+!---- ALLE comparison function interfaces
+      interface alle
+          module procedure a_alle_a, &! alle(array,array)
+                           a_alle_c, &! alle(array,character)
+                           c_alle_a        ! alle(character,array)
+      end interface
+
+!---- ALGE comparison function interfaces
+      interface alge
+          module procedure a_alge_a, &! alge(array,array)
+                           a_alge_c, &! alge(array,character)
+                           c_alge_a        ! alge(character,array)
+      end interface
+
+!---- ALGT comparison function interfaces
+      interface algt
+          module procedure a_algt_a, &! algt(array,array)
+                           a_algt_c, &! algt(array,character)
+                           c_algt_a        ! algt(character,array)
+      end interface
+
+!---- INDEX procedure
+      interface index
+          module procedure index_ss, index_sc, index_cs
+      end interface
+
+!---- AINDEX procedure
+      interface aindex
+          module procedure aindex_aa, aindex_ac, aindex_ca
+      end interface
+
+!---- SCAN procedure
+      interface scan
+          module procedure scan_ss, scan_sc, scan_cs
+      end interface
+
+!---- ASCAN procedure
+      interface ascan
+          module procedure ascan_aa, ascan_ac, ascan_ca
+      end interface
+
+!---- VERIFY procedure
+      interface verify
+          module procedure verify_ss, verify_sc, verify_cs
+      end interface
+
+!---- AVERIFY procedure
+      interface averify
+          module procedure averify_aa, averify_ac, averify_ca
+      end interface
+
+!---- TRIM interface
+      interface len_trim
+          module procedure len_trim_s
+      end interface
+
+!---- LEN_TRIM interface
+      interface trim
+          module procedure trim_s
+      end interface
+
+!---- IACHAR interface
+      interface iachar
+          module procedure iachar_s
+      end interface
+
+!---- ICHAR interface
+      interface ichar
+          module procedure ichar_s
+      end interface
+
+!---- ADJUSTL interface
+      interface adjustl
+          module procedure adjustl_s
+      end interface
+
+!---- ADJUSTR interface
+      interface adjustr
+          module procedure adjustr_s
+      end interface
+
+!---- LEN_STRIP interface
+      interface len_strip
+          module procedure len_strip_c, len_strip_s
+      end interface
+
+!---- STRIP interface
+      interface strip
+          module procedure strip_c, strip_s
+      end interface
+
+!---- UPPERCASE interface
+      interface uppercase
+          module procedure uppercase_s, uppercase_c
+      end interface
+
+!---- TO_UPPERCASE interface
+      interface to_uppercase
+          module procedure to_uppercase_s, to_uppercase_c
+      end interface
+
+!---- LOWERCASE interface
+      interface lowercase
+          module procedure lowercase_s, lowercase_c
+      end interface
+
+!---- TO_LOWERCASE interface
+      interface to_lowercase
+          module procedure to_lowercase_s, to_lowercase_c
+      end interface
+
+!---- EXTRACT interface
+      interface extract
+          module procedure extract_s, extract_c
+      end interface
+
+!---- SUBSTRING interface
+      interface substring
+          module procedure extract_s, extract_c
+      end interface
+
+!---- REMOVE interface
+      interface remove
+          module procedure remove_s, remove_c
+      end interface
+
+!---- INSERT interface
+      interface insert
+          module procedure insert_ss, insert_cs, insert_sc, insert_cc
+      end interface
+
+!---- REPLACE interface
+      interface replace
+          module procedure replace_cc_s,   replace_cs_s,   &
+                           replace_sc_s,   replace_ss_s,   &
+                           replace_cc_sf,  replace_cs_sf,  &
+                           replace_sc_sf,  replace_ss_sf,  &
+                           replace_ccc,    replace_csc,    &
+                           replace_ccs,    replace_css,    &
+                           replace_scc,    replace_ssc,    &
+                           replace_scs,    replace_sss,    &
+                           replace_ccc_f,  replace_csc_f,  &
+                           replace_ccs_f,  replace_css_f,  &
+                           replace_scc_f,  replace_ssc_f,  &
+                           replace_scs_f,  replace_sss_f
+      end interface
+
+!---- SORT interface
+      interface sort
+          module procedure sort_c, sort_s
+      end interface
+
+!---- LSORT interface
+      interface lsort
+          module procedure lsort_c, lsort_s
+      end interface
+
+!---- RANK interface
+      interface rank
+          module procedure rank_c, rank_s
+      end interface
+
+!---- LRANK interface
+      interface lrank
+          module procedure lrank_c, lrank_s
+      end interface
+
+
+
+!---- Publically accessible entities
+      public :: string
+      public :: assignment(=),unstring
+      public :: insert,replace,remove,extract,substring
+      public :: repeat,index,scan,verify
+      public :: operator(//)
+      public :: operator(==),operator(/=)
+      public :: operator(<),operator(<=)
+      public :: operator(>),operator(>=)
+      public :: llt,lle,lge,lgt
+      public :: char,len,len_trim,trim,iachar,ichar,adjustl,adjustr
+      public :: lowercase,to_lowercase,uppercase,to_uppercase
+      public :: strip,len_strip
+      public :: sort,rank,lsort,lrank
+
+      public :: resize_string,string_size,swap_strings
+      public :: trim_string,strip_string
+      public :: adjustl_string,adjustr_string
+      public :: insert_in_string,remove_from_string
+      public :: prepend_to_string,append_to_string
+      public :: replace_in_string
+
+
+
+
+      contains
+
+!*******************************************************************************
+!     LEN
+!*******************************************************************************
+
+      elemental function len_s(s)
+
+      implicit none
+      type(string), intent(in)  :: s
+      integer                   :: len_s
+
+
+      len_s = s%len
+
+      end function len_s
+
+!*******************************************************************************
+!     STRING_SIZE
+!*******************************************************************************
+
+      elemental function string_size(s)
+
+      implicit none
+      type(string), intent(in)  :: s
+      integer                   :: string_size
+
+
+      string_size = s%size
+
+      end function string_size
+
+!*******************************************************************************
+!     CHAR
+!*******************************************************************************
+!     Returns the characters of string as an automatically sized character
+
+      pure function s_to_c(s)
+
+      implicit none
+      type(string),intent(in)   :: s
+      character(len(s))         :: s_to_c
+
+
+      s_to_c = transfer(s%chars(1:len(s)),s_to_c)
+
+      end function s_to_c
+
+!*******************************************************************************
+!     Returns the character of fixed length, length, containing the characters
+!     of string either padded with blanks or truncated on the right to fit
+
+      pure function s_to_slc(s,length)
+
+      implicit none
+      type(string),intent(in)  :: s
+      integer, intent(in)      :: length
+      character(length)        :: s_to_slc
+      integer                  :: i,lc
+
+
+      lc = min(len(s),length)
+      s_to_slc(1:lc) = transfer(s%chars(1:lc),s_to_slc)
+
+!     Result longer than string: padding needed
+      if (lc < length) s_to_slc(lc+1:length) = blank
+
+      end function s_to_slc
+
+!*******************************************************************************
+! Assign a string value to a string variable overriding default assignement.
+! Reallocates string variable to size of string value and copies characters.
+
+      elemental subroutine assign_s_to_s(var,expr)
+
+      implicit none
+      type(string), intent(out)  :: var
+      type(string), intent(in)   :: expr
+
+
+
+      if (associated(var%chars,expr%chars)) then
+!         Identity assignment: nothing to be done
+          continue
+      else
+          if (associated(var%chars)) deallocate(var%chars)
+
+          var%size = expr%size
+          var%len = expr%len
+!AG
+          if (associated(expr%chars)) then
+             allocate(var%chars(1:var%size))
+             var%chars(1:var%len) = expr%chars(1:var%len)
+          endif
+      endif
+
+
+      end subroutine assign_s_to_s
+
+!*******************************************************************************
+! Assign a string value to a character variable.
+! If the string is longer than the character truncate the string on the right.
+! If the string is shorter the character is blank padded on the right.
+
+      elemental subroutine assign_s_to_c(var,expr)
+
+      implicit none
+      character(*), intent(out)  :: var
+      type(string), intent(in)   :: expr
+      integer                    :: i,lc,ls
+
+
+      lc = len(var);
+      ls = min(len(expr),lc)
+
+      var(1:ls) = transfer(expr%chars(1:ls),var(1:ls))
+
+      do i=ls+1,lc
+          var(i:i) = blank
+      enddo
+
+      end subroutine assign_s_to_c
+
+!*******************************************************************************
+!     Assign a character value to a string variable.
+!     Disassociates the string variable from its current value, allocates new
+!     space to hold the characters and copies them from the character value
+!     into this space.
+
+      elemental subroutine assign_c_to_s(var,expr)
+
+      implicit none
+      type(string), intent(out)  :: var
+      character(*), intent(in)   :: expr
+      integer                    :: i,lc
+
+
+
+      if (associated(var%chars)) deallocate(var%chars)
+
+
+      lc = len(expr)
+      var%len = lc
+      var%size = lc
+      allocate(var%chars(1:lc))
+!!AG: NAG compiler uses temporaries here:
+      var%chars(:) = (/ (expr(i:i), i=1,lc) /)
+
+      endsubroutine assign_c_to_s
+
+!*******************************************************************************
+!     RESIZE_STRING procedure
+!*******************************************************************************
+
+!*** return code
+!*** n < 0  --> deallocate?
+
+!     pure subroutine resize_string(s,newsize,status)
+      pure subroutine resize_string(s,newsize)
+
+      implicit none
+      type(string), intent(inout)     :: s
+      integer, intent(in)             :: newsize
+!     integer, intent(out), optional  :: status
+
+      character, pointer              :: c(:)
+
+      integer                         :: i
+
+
+      if (newsize <= 0) return
+
+
+      if (associated(s%chars)) then
+
+          i = min(newsize,s%len)
+          allocate(c(i))
+          c(:) = s%chars(1:i)
+          deallocate(s%chars)
+
+          s%chars => c
+
+          s%len = i
+          s%size = newsize
+      else
+          s%size = newsize
+          s%len = 0
+          allocate(s%chars(s%size))
+      endif
+
+      end subroutine resize_string
+
+!*******************************************************************************
+!     SWAP_STRINGS
+!*******************************************************************************
+      subroutine swap_strings(s1,s2)
+
+
+      implicit none
+      type(string), intent(inout)  :: s1,s2
+      integer                      :: l,s
+      character, pointer           :: c(:)
+
+
+      l = s1%len
+      s = s1%size
+      c => s1%chars
+      s1%len = s2%len
+      s1%size = s2%size
+      s1%chars => s2%chars
+      s2%len = l
+      s2%size = s
+      s2%chars => c
+
+      end subroutine swap_strings
+
+!*******************************************************************************
+!     TRIM_STRINGSIZE
+!*******************************************************************************
+
+      subroutine trim_stringsize(s)
+
+      implicit none
+      type(string), intent(inout)  :: s
+
+
+      call resize_string(s,len(s))
+
+      end subroutine trim_stringsize
+
+!*******************************************************************************
+!     TRIM_STRING
+!*******************************************************************************
+
+      subroutine trim_string(s)
+
+      implicit none
+      type(string), intent(inout)  :: s
+
+
+      s%len = len_trim(s)
+
+      end subroutine trim_string
+
+!*******************************************************************************
+!    STRIP
+!*******************************************************************************
+
+     pure subroutine strip_string(s)
+
+     implicit none
+     type(string), intent(inout)  :: s
+     integer                      :: i,i1,i2
+
+
+     do i1=1,len(s)
+         if (s%chars(i1) /= blank) exit
+     enddo
+     do i2=len(s),1,-1
+         if (s%chars(i2) /= blank) exit
+     enddo
+     do i=i1,i2
+         s%chars(i-i1+1) = s%chars(i)
+     enddo
+     s%len = i2 - i1 + 1
+
+     end subroutine strip_string
+
+!*******************************************************************************
+!     ADJUSTL_STRING
+!*******************************************************************************
+! Returns as a character variable the string adjusted to the left,
+! removing leading blanks and inserting trailing blanks.
+
+      pure subroutine adjustl_string(s)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      integer                      :: i,j
+
+
+      do i=1,len(s)
+          if (s%chars(i) /= blank) exit
+      enddo
+      do j=i,len(s)
+          s%chars(j-i:j-i) = s%chars(j)
+      enddo
+      s%chars(j+1:) = blank
+
+      end subroutine adjustl_string
+
+!*******************************************************************************
+!     ADJUSTR_STRING
+!*******************************************************************************
+! Returns as a character variable the string adjusted to the right,
+! removing trailing blanks and inserting leading blanks.
+
+      pure subroutine adjustr_string(s)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      integer                      :: i,j,l,lt
+
+
+      l = len(s)
+      lt = len_trim(s)
+
+      i = l - lt
+
+      do j=1,lt
+          s%chars(j+i:j+i) = s%chars(j)
+      enddo
+      s%chars(1:i) = blank
+
+
+      end subroutine adjustr_string
+
+!*******************************************************************************
+!     PREPEND_TO_STRING
+!*******************************************************************************
+
+      pure subroutine prepend_to_string_s(s1,s2)
+
+      implicit none
+      type(string), intent(inout)  :: s1
+      type(string), intent(in)     :: s2
+      integer                      :: i,ls1,ls2
+
+      character, pointer           :: ss(:)
+
+
+      ls1 = len(s1)
+      ls2 = len(s2)
+      if (ls2 == 0) return
+      if (ls1+ls2 > string_size(s1)) then
+          allocate(ss(ls1+ls2))
+          do i=1,ls2
+              ss(i) = s2%chars(i)
+          enddo
+          do i=1,ls1
+              ss(ls2+i) = s1%chars(i)
+          enddo
+          deallocate(s1%chars)
+
+          s1%chars => ss
+
+          s1%len = ls1 + ls2
+          s1%size = s1%len
+      else
+          do i=ls1,1,-1
+              s1%chars(ls2+i) = s1%chars(i)
+          enddo
+          do i=1,ls2
+              s1%chars(i) = s2%chars(i)
+          enddo
+          s1%len = ls1 + ls2
+      endif
+
+      end subroutine prepend_to_string_s
+
+!*******************************************************************************
+
+      pure subroutine prepend_to_string_c(s,c)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      character(*), intent(in)     :: c
+      integer                      :: i,ls,lc
+
+      character, pointer           :: ss(:)
+
+
+
+      ls = len(s)
+      lc = len(c)
+      if (lc == 0) return
+      if (ls+lc > string_size(s)) then
+          allocate(ss(ls+lc))
+          do i=1,lc
+              ss(i) = c(i:i)
+          enddo
+          do i=1,ls
+              ss(lc+i) = s%chars(i)
+          enddo
+          deallocate(s%chars)
+
+          s%chars => ss
+
+          s%len = ls + lc
+          s%size = s%len
+      else
+          do i=ls,1,-1
+              s%chars(lc+i) = s%chars(i)
+          enddo
+          do i=1,lc
+              s%chars(i) = c(i:i)
+          enddo
+          s%len = ls + lc
+      endif
+
+      end subroutine prepend_to_string_c
+
+!*******************************************************************************
+!     APPEND_TO_STRING
+!*******************************************************************************
+
+      pure subroutine append_to_string_s(s1,s2)
+
+      implicit none
+      type(string), intent(inout)  :: s1
+      type(string), intent(in)     :: s2
+      integer                      :: i,ls1,ls2
+
+      character, pointer           :: ss(:)
+
+
+      ls1 = len(s1)
+      ls2 = len(s2)
+      if (ls2 == 0) return
+      if (ls1+ls2 > string_size(s1)) then
+          allocate(ss(ls1+ls2))
+          do i=1,ls1
+              ss(i) = s1%chars(i)
+          enddo
+          do i=ls1+1,ls1+ls2
+              ss(i) = s2%chars(i-ls1)
+          enddo
+          deallocate(s1%chars)
+
+          s1%chars => ss
+
+          s1%len = ls1 + ls2
+          s1%size = s1%len
+      else
+          do i=ls1+1,ls1+ls2
+              s1%chars(i) = s2%chars(i-ls1)
+          enddo
+          s1%len = ls1 + ls2
+      endif
+
+      end subroutine append_to_string_s
+
+!*******************************************************************************
+
+      pure subroutine append_to_string_c(s,c)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      character(*), intent(in)     :: c
+      integer                      :: i,ls,lc
+
+      character, pointer           :: ss(:)
+
+
+
+      ls = len(s)
+      lc = len(c)
+      if (lc == 0) return
+      if (ls+lc > string_size(s)) then
+          allocate(ss(ls+lc))
+          do i=1,ls
+              ss(i) = s%chars(i)
+          enddo
+          do i=ls+1,ls+lc
+              ss(i) = c(i-ls:i-ls)
+          enddo
+          deallocate(s%chars)
+
+          s%chars => ss
+
+          s%len = ls + lc
+          s%size = s%len
+      else
+          do i=ls+1,ls+lc
+              s%chars(i) = c(i-ls:i-ls)
+          enddo
+          s%len = ls + lc
+      endif
+
+      end subroutine append_to_string_c
+
+!*******************************************************************************
+!     INSERT_IN_STRING
+!*******************************************************************************
+
+      pure subroutine insert_in_string_s(s1,start,s2)
+
+      implicit none
+      type(string), intent(inout)  :: s1
+      type(string), intent(in)     :: s2
+      integer, intent(in)          :: start
+      integer                      :: i,ip,is,ls1,ls2
+
+      character, pointer           :: ss(:)
+
+
+      ls1 = len(s1)
+      ls2 = len(s2)
+      if (ls2 == 0) return
+      if (ls1+ls2 > string_size(s1)) then
+          allocate(ss(ls1+ls2))
+          is = max(start,1)
+          ip = min(ls1+1,is)
+          do i=1,ip-1
+              ss(i) = s1%chars(i)
+          enddo
+          do i=ip,ip+ls2-1
+              ss(i) = s2%chars(i-ip+1)
+          enddo
+          do i=ip+ls2,ls1+ls2
+              ss(i) = s1%chars(i-ls2)
+          enddo
+          deallocate(s1%chars)
+
+          s1%chars => ss
+
+          s1%len = ls1 + ls2
+          s1%size = s1%len
+      else
+          is = max(start,1)
+          ip = min(ls1+1,is)
+          do i=ls1+ls2,ip+ls2,-1
+              s1%chars(i) = s1%chars(i-ls2)
+          enddo
+          do i=ip,ip+ls2-1
+              s1%chars(i) = s2%chars(i-ip+1)
+          enddo
+          s1%len = ls1 + ls2
+      endif
+
+      end subroutine insert_in_string_s
+
+!*******************************************************************************
+
+      pure subroutine insert_in_string_c(s,start,c)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      character(*), intent(in)     :: c
+      integer, intent(in)          :: start
+      integer                      :: i,ip,is,ls,lc
+
+      character, pointer           :: ss(:)
+
+
+
+      ls = len(s)
+      lc = len(c)
+      if (lc == 0) return
+      if (ls+lc > string_size(s)) then
+          allocate(ss(ls+lc))
+          is = max(start,1)
+          ip = min(ls+1,is)
+          do i=1,ip-1
+              ss(i) = s%chars(i)
+          enddo
+          do i=ip,ip+lc-1
+              ss(i) = c(i-ip+1:i-ip+1)
+          enddo
+          do i=ip+lc,ls+lc
+              ss(i) = s%chars(i-lc)
+          enddo
+          deallocate(s%chars)
+
+          s%chars => ss
+
+          s%len = ls + lc
+          s%size = s%len
+      else
+          is = max(start,1)
+          ip = min(ls+1,is)
+          do i=ls+lc,ip+lc,-1
+              s%chars(i) = s%chars(i-lc)
+          enddo
+          do i=ip,ip+lc-1
+              s%chars(i) = c(i-ip+1:i-ip+1)
+          enddo
+          s%len = ls + lc
+      endif
+
+      end subroutine insert_in_string_c
+
+!*******************************************************************************
+!     REPLACE_IN_STRING
+!*******************************************************************************
+!     pure subroutine replace_in_string_ss_s(s,start,ss)
+!
+!     implicit none
+!     type(string), intent(inout)  :: s
+!     type(string), intent(in)     :: ss
+!     integer, intent(in)          :: start
+!
+!
+!     call replace_in_string_sc_s(s,start,char(ss))
+!
+!     end subroutine replace_in_string_ss_s
+!*******************************************************************************
+
+!*******************************************************************************
+
+      pure subroutine replace_in_string_ss_s(s,start,ss)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      type(string), intent(in)     :: ss
+      integer, intent(in)          :: start
+      integer                      :: i,ip,is,lr,lss,ls
+      character, pointer           :: rs(:)
+      logical                      :: new
+
+
+      lr = lr_ss_s(s,start,ss)
+      lss = len(ss)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+
+      new = lr > string_size(s)
+
+      if (new) then
+          allocate(rs(lr))
+      else
+          rs => s%chars
+      endif
+
+      do i=lr,ip+lss,-1
+          rs(i) = s%chars(i)
+      enddo
+      do i=lss,1,-1
+          rs(ip-1+i) = ss%chars(i)
+      enddo
+      if (new) then
+          do i=1,ip-1
+              rs(i) = s%chars(i)
+          enddo
+      endif
+
+      if (new) then
+          deallocate(s%chars)
+          s%chars => rs
+          s%size = lr
+      else
+          nullify(rs)
+      endif
+      s%len = lr
+
+      end subroutine replace_in_string_ss_s
+
+!*******************************************************************************
+!     pure subroutine replace_in_string_ss_sf(s,start,finish,ss)
+!
+!     implicit none
+!     type(string), intent(inout)  :: s
+!     type(string), intent(in)     :: ss
+!     integer, intent(in)          :: start,finish
+!
+!
+!     call replace_in_string_sc_sf(s,start,finish,char(ss))
+!
+!     end subroutine replace_in_string_ss_sf
+!*******************************************************************************
+
+!*******************************************************************************
+
+      pure subroutine replace_in_string_ss_sf(s,start,finish,ss)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      type(string), intent(in)     :: ss
+      integer, intent(in)          :: start,finish
+      integer                      :: i,if,ip,is,lr,ls,lss
+      character, pointer           :: rs(:)
+      logical                      :: new
+
+
+      lr = lr_ss_sf(s,start,finish,ss)
+      lss = len(ss)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+      if = max(ip-1,min(finish,ls))
+
+      new = lr > string_size(s)
+
+      if (new) then
+          allocate(rs(lr))
+      else
+          rs => s%chars
+      endif
+
+      do i=1,lr-ip-lss+1
+          rs(i+ip+lss-1) = s%chars(if+i)
+      enddo
+      do i=lss,1,-1
+          rs(i+ip-1) = ss%chars(i)
+      enddo
+      if (new) then
+          do i=1,ip-1
+              rs(i) = s%chars(i)
+          enddo
+      endif
+
+      if (new) then
+          deallocate(s%chars)
+          s%chars => rs
+          s%size = lr
+      else
+          nullify(rs)
+      endif
+      s%len = lr
+
+      end subroutine replace_in_string_ss_sf
+
+!*******************************************************************************
+
+!*******************************************************************************
+
+      pure subroutine replace_in_string_sc_s(s,start,c)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      character(*), intent(in)     :: c
+      integer, intent(in)          :: start
+      integer                      :: i,ip,is,lc,lr,ls
+      character, pointer           :: rs(:)
+      logical                      :: new
+
+
+      lr = lr_sc_s(s,start,c)
+      lc = len(c)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+
+      new = lr > string_size(s)
+
+      if (new) then
+          allocate(rs(lr))
+      else
+          rs => s%chars
+      endif
+
+      do i=lr,ip+lc,-1
+          rs(i) = s%chars(i)
+      enddo
+      do i=lc,1,-1
+          rs(ip-1+i) = c(i:i)
+      enddo
+      if (new) then
+          do i=1,ip-1
+              rs(i) = s%chars(i)
+          enddo
+      endif
+
+      if (new) then
+          deallocate(s%chars)
+          s%chars => rs
+          s%size = lr
+      else
+          nullify(rs)
+      endif
+      s%len = lr
+
+      end subroutine replace_in_string_sc_s
+
+!*******************************************************************************
+
+!*******************************************************************************
+
+      pure subroutine replace_in_string_sc_sf(s,start,finish,c)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      character(*), intent(in)     :: c
+      integer, intent(in)          :: start,finish
+      integer                      :: i,if,ip,is,lc,lr,ls
+      character, pointer           :: rs(:)
+      logical                      :: new
+
+
+      lr = lr_sc_sf(s,start,finish,c)
+      lc = len(c)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+      if = max(ip-1,min(finish,ls))
+
+      new = lr > string_size(s)
+
+      if (new) then
+          allocate(rs(lr))
+      else
+          rs => s%chars
+      endif
+
+      do i=1,lr-ip-lc+1
+          rs(i+ip+lc-1) = s%chars(if+i)
+      enddo
+      do i=lc,1,-1
+          rs(i+ip-1) = c(i:i)
+      enddo
+      if (new) then
+          do i=1,ip-1
+              rs(i) = s%chars(i)
+          enddo
+      endif
+
+      if (new) then
+          deallocate(s%chars)
+          s%chars => rs
+          s%size = lr
+      else
+          nullify(rs)
+      endif
+      s%len = lr
+
+      end subroutine replace_in_string_sc_sf
+
+!*******************************************************************************
+!*******************************************************************************
+!*******************************************************************************
+
+      pure subroutine replace_in_string_scc(s,target,ss)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      character(*), intent(in)     :: target,ss
+
+
+      call x_replace_in_string_scc(s,target,ss,'first')
+
+
+      end subroutine replace_in_string_scc
+
+!*******************************************************************************
+
+      pure subroutine replace_in_string_scc_f(s,target,ss,action)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      character(*), intent(in)     :: target,ss,action
+
+
+      call x_replace_in_string_scc(s,target,ss,action)
+
+      end subroutine replace_in_string_scc_f
+
+!*******************************************************************************
+
+      pure subroutine x_replace_in_string_scc(s,target,ss,action)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      character(*), intent(in)     :: target,ss,action
+      logical                      :: every,back
+      integer                      :: lr,ls,lt,lss
+      integer                      :: i,i1,i2,k1,k2,m1,m2
+
+      character, pointer           :: rs(:)
+
+
+
+      lr = lr_scc(s,target,ss,action)
+      ls = len(s)
+      lt = len(target)
+      lss = len(ss)
+
+      if (lt == 0) then
+          if (ls == 0) then
+              do i=1,lss
+                  s%chars(i) = ss(i:i)
+              enddo
+              s%len = lss
+          endif
+          return
+      endif
+
+      select case(uppercase(action))
+      case('FIRST')
+          back = .false.
+          every = .false.
+      case('LAST')
+          back = .true.
+          every = .false.
+      case('ALL')
+          back = .false.
+          every = .true.
+      case default
+          back = .false.
+          every = .false.
+      end select
+
+      allocate(rs(lr))
+
+      if (back) then
+!         Backwards search
+
+!         k2 points to the absolute position one before the target in string
+          k2 = ls
+          m2 = lr
+          do
+!             find the next occurrence of target
+              i1 = aindex(s%chars(:k2),target,back)
+              if (i1 == 0) then
+!                 fill up to the end
+                  rs(:m2) = s%chars(:k2)
+                  exit
+              endif
+!             i1 points to the absolute position of the first
+!             letter of target in string
+!             i2 points to the absolute position of the last
+!             letter of target in string
+              i2 = i1 + lt - 1
+
+!             copy the unaffected text string chunk after it
+!             k1 points to the absolute position one after target in string
+              k1 = i2 + 1
+              m1 = m2 + k1 - k2
+              rs(m1:m2) = s%chars(k1:k2)
+              m2 = m1 - 1
+              m1 = m2 - lss + 1
+!             copy the replacement substring for target
+              do i=1,lss
+                  rs(m1+i-1) = ss(i:i)
+              enddo
+
+!             k2 points to the absolute position one before the target in string
+              k2 = i1 - 1
+              m2 = m1 - 1
+              if (.not.every) then
+                  rs(:m2) = s%chars(:k2)
+                  exit
+              endif
+          enddo
+      else
+!         Forward search
+
+!         k1 points to the absolute position one after target in string
+          k1 = 1
+          m1 = 1
+          do
+!             find the next occurrence of target
+              i1 = aindex(s%chars(k1:),target)
+              if (i1 == 0) then
+!                 fill up to the end
+                  rs(m1:lr) = s%chars(k1:ls)
+                  exit
+              endif
+!             i1 points to the absolute position of the first
+!             letter of target in string
+              i1 = k1 + (i1 - 1)
+!             i2 points to the absolute position of the last
+!             letter of target in string
+              i2 = i1 + lt - 1
+
+!             copy the unaffected text string chunk before it
+!             k2 points to the absolute position one before the target in string
+              k2 = i1 - 1
+              m2 = m1 + k2 - k1
+              rs(m1:m2) = s%chars(k1:k2)
+              m1 = m2 + 1
+              m2 = m1 + lss - 1
+!             copy the replacement substring for target
+              do i=1,lss
+                  rs(m1+i-1) = ss(i:i)
+              enddo
+
+!             k1 points to the absolute position one after target in string
+              k1 = i2 + 1
+              m1 = m2 + 1
+              if (.not.every) then
+                  rs(m1:lr) = s%chars(k1:ls)
+                  exit
+              endif
+          enddo
+      endif
+
+
+      if (associated(s%chars)) deallocate(s%chars)
+      s%chars => rs
+
+      s%len = lr
+      s%size = size(s%chars)
+
+      end subroutine x_replace_in_string_scc
+
+!*******************************************************************************
+
+      pure subroutine replace_in_string_ssc(s,target,ss)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      type(string), intent(in)     :: target
+      character(*), intent(in)     :: ss
+
+
+      call x_replace_in_string_scc(s,char(target),ss,'first')
+
+      end subroutine replace_in_string_ssc
+
+!*******************************************************************************
+
+      pure subroutine replace_in_string_ssc_f(s,target,ss,action)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      type(string), intent(in)     :: target
+      character(*), intent(in)     :: ss,action
+
+
+      call x_replace_in_string_scc(s,char(target),ss,action)
+
+      end subroutine replace_in_string_ssc_f
+
+!*******************************************************************************
+
+      pure subroutine replace_in_string_scs(s,target,ss)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      type(string), intent(in)     :: ss
+      character(*), intent(in)     :: target
+
+
+      call x_replace_in_string_scc(s,target,char(ss),'first')
+
+      end subroutine replace_in_string_scs
+
+!*******************************************************************************
+
+      pure subroutine replace_in_string_scs_f(s,target,ss,action)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      type(string), intent(in)     :: ss
+      character(*), intent(in)     :: target,action
+
+
+      call x_replace_in_string_scc(s,target,char(ss),action)
+
+      end subroutine replace_in_string_scs_f
+
+!*******************************************************************************
+
+      pure subroutine replace_in_string_sss(s,target,ss)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      type(string), intent(in)     :: ss,target
+
+
+      call x_replace_in_string_scc(s,char(target),char(ss),'first')
+
+      end subroutine replace_in_string_sss
+
+!*******************************************************************************
+
+      pure subroutine replace_in_string_sss_f(s,target,ss,action)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      type(string), intent(in)     :: ss,target
+      character(*), intent(in)     :: action
+
+
+      call x_replace_in_string_scc(s,char(target),char(ss),action)
+
+      end subroutine replace_in_string_sss_f
+
+!*******************************************************************************
+!     REMOVE_FROM_STRING
+!*******************************************************************************
+
+      pure subroutine remove_from_string(s,start,finish)
+
+      implicit none
+      type(string), intent(inout)                      :: s
+      integer, intent(in)                              :: start,finish
+      integer                                          :: i,if,is,le,ls
+
+
+      is = max(1,start)
+      ls = len(s)
+      if = min(ls,finish)
+      if (if < is) return
+
+      le = if - is + 1            ! = len_extract
+      do i=if+1,ls
+          s%chars(i-le) = s%chars(i)
+      enddo
+      s%len = s%len - le
+
+      end subroutine remove_from_string
+
+!*******************************************************************************
+!     UNSTRING procedure
+!*******************************************************************************
+!     Deallocate the chars in the string to avoid leaking of memory
+!     Use this in functions and subroutines on locally declared variables
+!     of type string after their use. (I.e. garbage collecting).
+
+      elemental subroutine unstring(s)
+
+      implicit none
+      type(string), intent(inout)  :: s
+
+
+
+      if (associated(s%chars)) deallocate(s%chars)
+      nullify(s%chars)
+
+      s%size = 0
+      s%len = 0
+
+      end subroutine unstring
+
+!*******************************************************************************
+!     //
+!*******************************************************************************
+!     string // string
+
+      pure function s_concat_s(s1,s2)
+
+      implicit none
+      type(string), intent(in)    :: s1,s2
+      character(len(s1)+len(s2))  :: s_concat_s
+      integer                     :: l1,l2
+
+
+      l1 = len(s1)
+      l2 = len(s2)
+      s_concat_s(1:l1) = s1
+      s_concat_s(1+l1:l1+l2) = s2
+
+      end function s_concat_s
+
+!*******************************************************************************
+!     string // character
+
+      pure function s_concat_c(s,c)
+
+      implicit none
+      type(string), intent(in)  :: s
+      character(*), intent(in)  :: c
+      character(len(s)+len(c))  :: s_concat_c
+      integer                   :: ls,lc
+
+
+      ls = len(s)
+      lc = len(c)
+      s_concat_c(1:ls) = s
+      s_concat_c(1+ls:ls+lc) = c
+
+      end function s_concat_c
+
+!*******************************************************************************
+!     character // string
+
+      pure function c_concat_s(c,s)
+
+      implicit none
+      character(*), intent(in)  :: c
+      type(string), intent(in)  :: s
+      character(len(s)+len(c))  :: c_concat_s
+      integer                   :: lc,ls
+
+
+      lc = len(c)
+      ls = len(s)
+      c_concat_s(1:lc) = c
+      c_concat_s(1+lc:lc+ls) = s
+
+      end function c_concat_s
+
+!*******************************************************************************
+!     REPEAT
+!*******************************************************************************
+
+      function repeat_s(s,ncopies)
+
+      implicit none
+      type(string), intent(in)   :: s
+      integer, intent(in)        :: ncopies
+      character(ncopies*len(s))  :: repeat_s
+
+
+      if (ncopies < 0) stop 'Negative ncopies requested in REPEAT'
+      repeat_s = repeat(char(s),ncopies)
+
+      end function repeat_s
+
+!*******************************************************************************
+!     LEN_TRIM
+!*******************************************************************************
+
+      elemental function len_trim_s(s)
+
+      implicit none
+      type(string), intent(in)  :: s
+      integer                   :: len_trim_s
+
+      if (len(s) == 0) then
+        len_trim_s = 0
+        return
+      endif
+      do len_trim_s = len(s),1,-1
+          if (s%chars(len_trim_s) /= blank) return
+      end do
+
+      end function len_trim_s
+
+!*******************************************************************************
+!     TRIM
+!*******************************************************************************
+
+      pure function trim_s(s)
+
+      implicit none
+      type(string), intent(in)  :: s
+      character(len_trim(s))    :: trim_s
+      integer                   :: i
+
+
+      do i=1,len(trim_s)
+          trim_s(i:i) = s%chars(i)
+      enddo
+
+      end function trim_s
+
+!*******************************************************************************
+!     IACHAR
+!*******************************************************************************
+! Returns the position of the character string in the ISO 646 collating
+! sequence. String must be of length one, otherwise result is as for
+! intrinsic iachar.
+
+      elemental function iachar_s(s)
+
+      implicit none
+      type(string), intent(in) :: s
+      integer                  :: iachar_s
+
+
+      iachar_s = iachar(char(s))
+
+      end function iachar_s
+
+!*******************************************************************************
+!     ICHAR
+!*******************************************************************************
+! Returns the position of character from string in the processor collating
+! sequence. String must be of length one, otherwise it will behave as the
+! intrinsic ichar with the equivalent character string.
+
+      elemental function ichar_s(s)
+
+      implicit none
+      type(string), intent(in) ::  s
+      integer                  ::  ichar_s
+
+
+      ichar_s = ichar(char(s))
+
+      end function ichar_s
+
+!*******************************************************************************
+!     ADJUSTL
+!*******************************************************************************
+! Returns as a character variable the string adjusted to the left,
+! removing leading blanks and inserting trailing blanks.
+
+      pure function adjustl_s(s)
+
+      implicit none
+      type(string), intent(in)  :: s
+      character(len(s))         :: adjustl_s
+
+
+      adjustl_s = adjustl(char(s))
+
+      end function adjustl_s
+
+!*******************************************************************************
+!     ADJUSTR
+!*******************************************************************************
+! Returns as a character variable the string adjusted to the right,
+! removing trailing blanks and inserting leading blanks.
+
+      pure function adjustr_s(s)
+
+      implicit none
+      type(string), intent(in)  :: s
+      character(len(s))         :: adjustr_s
+
+
+      adjustr_s = adjustr(char(s))
+
+      end function adjustr_s
+
+!*******************************************************************************
+!    LEN_STRIP
+!*******************************************************************************
+
+     elemental function len_strip_s(s)
+
+     implicit none
+     type(string), intent(in) :: s
+     integer                  :: len_strip_s
+     integer                  :: i1,i2
+
+
+     do i1=1,len(s)
+         if (s%chars(i1) /= blank) exit
+     enddo
+     do i2=len(s),1,-1
+         if (s%chars(i2) /= blank) exit
+     enddo
+     len_strip_s = max(0,i2-i1+1)
+
+     end function len_strip_s
+
+!*******************************************************************************
+!    STRIP
+!*******************************************************************************
+
+     pure function strip_s(s)
+
+     implicit none
+     type(string), intent(in)  :: s
+     character(len_strip(s))   :: strip_s
+     integer                   :: i,j
+
+
+     do i=1,len(s)
+         if (s%chars(i) /= blank) exit
+     enddo
+     do j=1,len(strip_s)
+         strip_s(j:j) = s%chars(i+j-1)
+     enddo
+
+     end function strip_s
+
+!*******************************************************************************
+
+     elemental function len_strip_c(c)
+
+     implicit none
+     character(*), intent(in) :: c
+     integer                  :: len_strip_c
+     integer                  :: i1,i2
+
+
+     do i1=1,len(c)
+         if (c(i1:i1) /= blank) exit
+     enddo
+     i2 = len_trim(c)
+     len_strip_c = max(0,i2-i1+1)
+
+     end function len_strip_c
+
+!*******************************************************************************
+
+     pure function strip_c(c)
+
+     implicit none
+     character(*), intent(in)  :: c
+     character(len_strip(c))   :: strip_c
+     integer                   :: i
+
+
+     do i=1,len(c)
+         if (c(i:i) /= blank) exit
+     enddo
+     strip_c(1:) = c(i:)
+
+     end function strip_c
+
+!*******************************************************************************
+!     EXTRACT
+!*******************************************************************************
+      elemental FUNCTION len_extract_s(s,start,finish)
+
+      implicit none
+      type(string), intent(in)  :: s
+      integer, intent(in)       :: start,finish
+      integer                   :: len_extract_s
+      integer                   :: is,if
+
+
+      is = max(1,start)
+      if = min(len(s),finish)
+      if (if < is) then
+          len_extract_s = 0
+      else
+          len_extract_s = max(0,if-is) + 1
+      endif
+
+      end function len_extract_s
+
+!*****************************************************
+      pure function extract_s(s,start,finish)
+
+      implicit none
+      type(string), intent(in)                  :: s
+      integer, intent(in)                       :: start,finish
+      character(len_extract_s(s,start,finish))  :: extract_s
+      integer                                   :: i,is,if
+
+
+      is = max(1,start)
+      if = min(len(s),finish)
+      if (if < is) then
+          extract_s = ''
+      else
+          do i=1,max(0,if-is+1)
+              extract_s(i:i) = s%chars(is+i-1)
+          enddo
+      endif
+
+      end function extract_s
+
+!*******************************************************************************
+
+!      elemental FUNCTION len_extract_s(s,start,finish)
+
+!      implicit none
+!      type(string), intent(in)  :: s
+!      integer, intent(in)       :: start,finish
+!      integer                   :: len_extract_s
+!      integer                   :: is,if
+
+
+!      is = max(1,start)
+!      if = min(len(s),finish)
+!      if (if < is) then
+!          len_extract_s = 0
+!      else
+!          len_extract_s = max(0,if-is) + 1
+!      endif
+
+!      end function len_extract_s
+
+!*******************************************************************************
+
+      elemental function len_extract_c(c,start,finish)
+
+      implicit none
+      character(*), intent(in)  :: c
+      integer, intent(in)       :: start,finish
+      integer                   :: len_extract_c
+      integer                   :: is,if
+
+
+      is = max(1,start)
+      if = min(len(c),finish)
+      if (if < is) then
+          len_extract_c = 0
+      else
+          len_extract_c = max(0,if-is) + 1
+      endif
+
+      end function len_extract_c
+
+!*******************************************************************************
+
+      pure function extract_c(c,start,finish)
+
+      implicit none
+      character(*), intent(in)                  :: c
+      integer, intent(in)                       :: start,finish
+      character(len_extract_c(c,start,finish))  :: extract_c
+      integer                                   :: is,if
+
+
+      is = max(1,start)
+      if = min(len(c),finish)
+      if (if < is) then
+          extract_c = ''
+      else
+          extract_c(1:if-is+1) = c(is:if)
+      endif
+
+      end function extract_c
+
+!*******************************************************************************
+
+!      elemental function len_extract_c(c,start,finish)
+
+!      implicit none
+!      character(*), intent(in)  :: c
+!      integer, intent(in)       :: start,finish
+!      integer                   :: len_extract_c
+!      integer                   :: is,if
+
+
+!      is = max(1,start)
+!      if = min(len(c),finish)
+!      if (if < is) then
+!          len_extract_c = 0
+!      else
+!          len_extract_c = max(0,if-is) + 1
+!      endif
+
+!      end function len_extract_c
+
+!*******************************************************************************
+!     INSERT
+!*******************************************************************************
+
+      pure function insert_ss(s1,start,s2)
+
+      implicit none
+      type(string), intent(in)    :: s1,s2
+      integer, intent(in)         :: start
+      character(len(s1)+len(s2))  :: insert_ss
+      integer                     :: i,ip,is,ls1,ls2
+
+
+      ls1 = len(s1)
+      ls2 = len(s2)
+      is = max(start,1)
+      ip = min(ls1+1,is)
+      do i=1,ip-1
+          insert_ss(i:i) = s1%chars(i)
+      enddo
+      do i=ip,ip+ls2-1
+          insert_ss(i:i) = s2%chars(i-ip+1)
+      enddo
+      do i=ip+ls2,ls1+ls2
+          insert_ss(i:i) = s1%chars(i-ls2)
+      enddo
+
+      end function insert_ss
+
+!*******************************************************************************
+
+      pure function insert_sc(s1,start,c2)
+
+      implicit none
+      type(string), intent(in)    :: s1
+      character(*), intent(in)    :: c2
+      integer, intent(in)         :: start
+      character(len(s1)+len(c2))  :: insert_sc
+      integer                     :: i,ip,is,ls1,ls2
+
+
+      ls1 = len(s1)
+      ls2 = len(c2)
+      is = max(start,1)
+      ip = min(ls1+1,is)
+      do i=1,ip-1
+          insert_sc(i:i) = s1%chars(i)
+      enddo
+      insert_sc(ip:ip+ls2-1) = c2
+      do i=ip+ls2,ls1+ls2
+          insert_sc(i:i) = s1%chars(i-ls2)
+      enddo
+
+      end function insert_sc
+
+!*******************************************************************************
+
+      pure function insert_cs(c1,start,s2)
+
+      implicit none
+      character(*), intent(in)    :: c1
+      type(string), intent(in)    :: s2
+      integer, intent(in)         :: start
+      character(len(c1)+len(s2))  :: insert_cs
+      integer                     :: i,ip,is,ls1,ls2
+
+
+      ls1 = len(c1)
+      ls2 = len(s2)
+      is = max(start,1)
+      ip = min(ls1+1,is)
+      insert_cs(1:ip-1) = c1(1:ip-1)
+      do i=ip,ip+ls2-1
+          insert_cs(i:i) = s2%chars(i-ip+1)
+      enddo
+      insert_cs(ip+ls2:ls1+ls2) = c1(ip:ls1)
+
+      end function insert_cs
+
+!*******************************************************************************
+
+      pure function insert_cc(c1,start,c2)
+
+      implicit none
+      character(*), intent(in)    :: c1,c2
+      integer, intent(in)         :: start
+      character(len(c1)+len(c2))  :: insert_cc
+      integer                     :: ip,is,ls1,ls2
+
+
+      ls1 = len(c1)
+      ls2 = len(c2)
+      is = max(start,1)
+      ip = min(ls1+1,is)
+      insert_cc(1:ip-1) = c1(1:ip-1)
+      insert_cc(ip:ip+ls2-1) = c2
+      insert_cc(ip+ls2:ls1+ls2) = c1(ip:ls1)
+
+      end function insert_cc
+
+!*******************************************************************************
+!     REMOVE
+!*******************************************************************************
+
+      pure function remove_c(c,start,finish)
+
+      implicit none
+      character(*), intent(in)                         :: c
+      integer, intent(in)                              :: start,finish
+      character(len(c)-len_extract_c(c,start,finish))  :: remove_c
+      integer                                          :: if,is,ls
+
+
+      is = max(1,start)
+      ls = len(c)
+      if = min(ls,finish)
+      if (if < is) then
+          remove_c = c
+      else
+          remove_c = c(1:is-1) // c(if+1:)
+      endif
+
+      end function remove_c
+
+!*******************************************************************************
+
+      pure function remove_s(s,start,finish)
+
+      implicit none
+      type(string), intent(in)                         :: s
+      integer, intent(in)                              :: start,finish
+      character(len(s)-len_extract_s(s,start,finish))  :: remove_s
+      integer                                          :: i,if,is,le,ls
+
+
+      is = max(1,start)
+      ls = len(s)
+      if = min(ls,finish)
+      if (if < is) then
+           remove_s = s
+      else
+          le = if - is + 1
+          do i=1,is-1
+              remove_s(i:i) = s%chars(i)
+          enddo
+          do i=if+1,ls
+              remove_s(i-le:i-le) = s%chars(i)
+          enddo
+      endif
+
+      end function remove_s
+
+!*******************************************************************************
+!     REPLACE
+!*******************************************************************************
+
+      pure function lr_cc_s(s,start,ss) result(l)
+
+      implicit none
+      character(*), intent(in)  :: s,ss
+      integer, intent(in)       :: start
+      integer                   :: l
+      integer                   :: ip,is,ls,lss
+
+
+      l = max(len(s),min(len(s)+1,max(start,1)+len(ss)-1))
+
+      end function lr_cc_s
+
+!*******************************************************************************
+!  Calculate the result string by the following actions:
+!  Insert the characters from substring SS into string STR beginning
+!  at position START replacing the following LEN(SUBSTRING) characters of
+!  the string and enlarging string if necessary. If START is greater than
+!  LEN(STRING) substring is simply appended to string by concatenation.
+!  If START is less than 1, substring replaces characters in string
+!  starting at 1
+
+      function replace_cc_s(s,start,ss) result(r)
+
+      implicit none
+      character(*), intent(in)        :: s,ss
+      integer, intent(in)             :: start
+      character(lr_cc_s(s,start,ss))  :: r
+      integer                         :: ip,is,l,lss,ls
+
+
+      lss = len(ss)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+      l = len(r)
+
+      r(1:ip-1) = s(1:ip-1)
+      r(ip:ip+lss-1) = ss
+      r(ip+lss:l) = s(ip+lss:ls)
+
+      end function replace_cc_s
+
+!*******************************************************************************
+
+      pure function lr_cc_sf(s,start,finish,ss) result(l)
+
+      implicit none
+      character(*), intent(in)  :: s,ss
+      integer, intent(in)       :: start,finish
+      integer                   :: l
+      integer                   :: if,ip,is,ls,lss
+
+
+      lss = len(ss)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+      if = max(ip-1,min(finish,ls))
+      l = lss + ls - if+ip-1
+
+      end function lr_cc_sf
+
+!*******************************************************************************
+!  Calculates the result string by the following actions:
+!  Insert the substring SS into string STR beginning at position
+!  START replacing the following FINISH-START+1 characters of the string
+!  and enlarging or shrinking the string if necessary.
+!  If start is greater than LEN(STRING) substring is simply appended to
+!  string by concatenation. If START is less than 1, START = 1 is used.
+!  If FINISH is greater than LEN(STRING), FINISH = LEN(STRING) is used.
+!  If FINISH is less than START, substring is inserted before START.
+
+      function replace_cc_sf(s,start,finish,ss) result(r)
+
+      implicit none
+      character(*), intent(in)                :: s,ss
+      integer, intent(in)                     :: start,finish
+      character(lr_cc_sf(s,start,finish,ss))  :: r
+      integer                                 :: i,if,ip,is,l,ls,lss
+
+
+      lss = len(ss)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+      if = max(ip-1,min(finish,ls))
+      l = len(r)
+
+      r(1:ip-1) = s(1:ip-1)
+      do i=1,lss
+          r(i+ip-1:i+ip-1) = ss(i:i)
+      enddo
+      do i=1,l-ip-lss+1
+          r(i+ip+lss-1:i+ip+lss-1) = s(if+i:if+i)
+      enddo
+
+      end function replace_cc_sf
+
+!*******************************************************************************
+
+      pure function lr_cs_s(s,start,ss) result(l)
+
+      implicit none
+      character(*), intent(in)  :: s
+      type(string), intent(in)  :: ss
+      integer, intent(in)       :: start
+      integer                   :: l
+      integer                   :: ip,is,ls,lss
+
+
+      l = max(len(s),min(len(s)+1,max(start,1)+len(ss)-1))
+
+      end function lr_cs_s
+
+!*******************************************************************************
+!  Calculate the result string by the following actions:
+!  Insert the characters from substring SS into string STR beginning
+!  at position START replacing the following LEN(SUBSTRING) characters of
+!  the string and enlarging string if necessary. If START is greater than
+!  LEN(STRING) substring is simply appended to string by concatenation.
+!  If START is less than 1, substring replaces characters in string
+!  starting at 1
+
+      function replace_cs_s(s,start,ss) result(r)
+
+      implicit none
+      character(*), intent(in)        :: s
+      type(string), intent(in)        :: ss
+      integer, intent(in)             :: start
+      character(lr_cs_s(s,start,ss))  :: r
+      integer                         :: i,ip,is,l,lss,ls
+
+
+      lss = len(ss)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+      l = len(r)
+
+      r(1:ip-1) = s(1:ip-1)
+      r(ip:ip+lss-1) = transfer(ss%chars(1:lss),r(1:lss))
+      r(ip+lss:l) = s(ip+lss:ls)
+
+      end function replace_cs_s
+
+!*******************************************************************************
+
+      pure function lr_cs_sf(s,start,finish,ss) result(l)
+
+      implicit none
+      character(*), intent(in)  :: s
+      type(string), intent(in)  :: ss
+      integer, intent(in)       :: start,finish
+      integer                   :: l
+      integer                   :: if,ip,is,ls,lss
+
+
+      lss = len(ss)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+      if = max(ip-1,min(finish,ls))
+      l = lss + ls - if+ip-1
+
+      end function lr_cs_sf
+
+!*******************************************************************************
+!  Calculates the result string by the following actions:
+!  Insert the substring SS into string STR beginning at position
+!  START replacing the following FINISH-START+1 characters of the string
+!  and enlarging or shrinking the string if necessary.
+!  If start is greater than LEN(STRING) substring is simply appended to
+!  string by concatenation. If START is less than 1, START = 1 is used.
+!  If FINISH is greater than LEN(STRING), FINISH = LEN(STRING) is used.
+!  If FINISH is less than START, substring is inserted before START.
+
+      function replace_cs_sf(s,start,finish,ss) result(r)
+
+      implicit none
+      character(*), intent(in)                :: s
+      type(string), intent(in)                :: ss
+      integer, intent(in)                     :: start,finish
+      character(lr_cs_sf(s,start,finish,ss))  :: r
+      integer                                 :: i,if,ip,is,l,ls,lss
+
+
+      lss = len(ss)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+      if = max(ip-1,min(finish,ls))
+      l = len(r)
+
+      r(1:ip-1) = s(1:ip-1)
+
+      r(i+ip:i+ip+lss-1) = transfer(ss%chars(1:lss),r(1:lss))
+
+      do i=1,lss
+          r(i+ip-1:i+ip-1) = ss%chars(i)
+      enddo
+
+      do i=1,l-ip-lss+1
+          r(i+ip+lss-1:i+ip+lss-1) = s(if+i:if+i)
+      enddo
+
+      end function replace_cs_sf
+
+!*******************************************************************************
+
+      pure function lr_sc_s(s,start,ss) result(l)
+
+      implicit none
+      type(string), intent(in)  :: s
+      character(*), intent(in)  :: ss
+      integer, intent(in)       :: start
+      integer                   :: l
+      integer                   :: ip,is,ls,lss
+
+
+      l = max(len(s),min(len(s)+1,max(start,1)+len(ss)-1))
+
+      end function lr_sc_s
+
+!*******************************************************************************
+!  Calculate the result string by the following actions:
+!  Insert the characters from substring SS into string STR beginning
+!  at position START replacing the following LEN(SUBSTRING) characters of
+!  the string and enlarging string if necessary. If START is greater than
+!  LEN(STRING) substring is simply appended to string by concatenation.
+!  If START is less than 1, substring replaces characters in string
+!  starting at 1
+
+      function replace_sc_s(s,start,ss) result(r)
+
+      implicit none
+      type(string), intent(in)        :: s
+      character(*), intent(in)        :: ss
+      integer, intent(in)             :: start
+      character(lr_sc_s(s,start,ss))  :: r
+      integer                         :: i,ip,is,l,lss,ls
+
+
+      lss = len(ss)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+      l = len(r)
+
+      do i=1,ip-1
+          r(i:i) = s%chars(i)
+      enddo
+
+      do i=1,lss
+          r(i+ip-1:i+ip-1) = ss(i:i)
+      enddo
+
+      do i=ip+lss,l
+          r(i:i) = s%chars(i)
+      enddo
+
+      end function replace_sc_s
+
+!*******************************************************************************
+
+      pure function lr_sc_sf(s,start,finish,ss) result(l)
+
+      implicit none
+      type(string), intent(in)  :: s
+      character(*), intent(in)  :: ss
+      integer, intent(in)       :: start,finish
+      integer                   :: l
+      integer                   :: if,ip,is,ls,lss
+
+
+      lss = len(ss)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+      if = max(ip-1,min(finish,ls))
+      l = lss + ls - if+ip-1
+
+      end function lr_sc_sf
+
+!*******************************************************************************
+!  Calculates the result string by the following actions:
+!  Insert the substring SS into string STR beginning at position
+!  START replacing the following FINISH-START+1 characters of the string
+!  and enlarging or shrinking the string if necessary.
+!  If start is greater than LEN(STRING) substring is simply appended to
+!  string by concatenation. If START is less than 1, START = 1 is used.
+!  If FINISH is greater than LEN(STRING), FINISH = LEN(STRING) is used.
+!  If FINISH is less than START, substring is inserted before START.
+
+      function replace_sc_sf(s,start,finish,ss) result(r)
+
+      implicit none
+      type(string), intent(in)                :: s
+      character(*), intent(in)                :: ss
+      integer, intent(in)                     :: start,finish
+      character(lr_sc_sf(s,start,finish,ss))  :: r
+      integer                                 :: i,if,ip,is,l,ls,lss
+
+
+      lss = len(ss)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+      if = max(ip-1,min(finish,ls))
+      l = len(r)
+
+      do i=1,ip-1
+          r(i:i) = s%chars(i)
+      enddo
+
+      r(ip:ip+lss-1) = ss
+
+      do i=1,l-ip-lss+1
+          r(i+ip+lss-1:i+ip+lss-1) = s%chars(if+i)
+      enddo
+
+      end function replace_sc_sf
+
+!*******************************************************************************
+
+      pure function lr_ss_s(s,start,ss) result(l)
+
+      implicit none
+      type(string), intent(in)  :: s,ss
+      integer, intent(in)       :: start
+      integer                   :: l
+      integer                   :: ip,is,ls,lss
+
+
+      l = max(len(s),min(len(s)+1,max(start,1)+len(ss)-1))
+
+      end function lr_ss_s
+
+!*******************************************************************************
+!  Calculate the result string by the following actions:
+!  Insert the characters from substring SS into string STR beginning
+!  at position START replacing the following LEN(SUBSTRING) characters of
+!  the string and enlarging string if necessary. If START is greater than
+!  LEN(STRING) substring is simply appended to string by concatenation.
+!  If START is less than 1, substring replaces characters in string
+!  starting at 1
+
+      function replace_ss_s(s,start,ss) result(r)
+
+      implicit none
+      type(string), intent(in)        :: s,ss
+      integer, intent(in)             :: start
+      character(lr_ss_s(s,start,ss))  :: r
+      integer                         :: i,ip,is,l,lss,ls
+
+
+      lss = len(ss)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+      l = len(r)
+
+      do i=1,ip-1
+          r(i:i) = s%chars(i)
+      enddo
+
+      do i=1,lss
+          r(ip-1+i:ip-1+i) = ss%chars(i)
+      enddo
+
+      do i=ip+lss,l
+          r(i:i) = s%chars(i)
+      enddo
+
+      end function replace_ss_s
+
+!*******************************************************************************
+
+      pure function lr_ss_sf(s,start,finish,ss) result(l)
+
+      implicit none
+      type(string), intent(in)  :: s,ss
+      integer, intent(in)       :: start,finish
+      integer                   :: l
+      integer                   :: if,ip,is,ls,lss
+
+
+      lss = len(ss)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+      if = max(ip-1,min(finish,ls))
+      l = lss + ls - if+ip-1
+
+      end function lr_ss_sf
+
+!*******************************************************************************
+!  Calculates the result string by the following actions:
+!  Insert the substring SS into string STR beginning at position
+!  START replacing the following FINISH-START+1 characters of the string
+!  and enlarging or shrinking the string if necessary.
+!  If start is greater than LEN(STRING) substring is simply appended to
+!  string by concatenation. If START is less than 1, START = 1 is used.
+!  If FINISH is greater than LEN(STRING), FINISH = LEN(STRING) is used.
+!  If FINISH is less than START, substring is inserted before START.
+
+      function replace_ss_sf(s,start,finish,ss) result(r)
+
+      implicit none
+      type(string), intent(in)                :: s,ss
+      integer, intent(in)                     :: start,finish
+      character(lr_ss_sf(s,start,finish,ss))  :: r
+      integer                                 :: i,if,ip,is,l,ls,lss
+
+
+      lss = len(ss)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+      if = max(ip-1,min(finish,ls))
+      l = len(r)
+
+      do i=1,ip-1
+          r(i:i) = s%chars(i)
+      enddo
+
+      do i=1,lss
+          r(i+ip-1:i+ip-1) = ss%chars(i)
+      enddo
+
+      do i=1,l-ip-lss+1
+          r(i+ip+lss-1:i+ip+lss-1) = s%chars(if+i)
+      enddo
+
+      end function replace_ss_sf
+
+!*******************************************************************************
+
+      pure function lr_ccc(s,target,ss,action) result(l)
+
+      implicit none
+      character(*), intent(in)       :: s,target,ss,action
+      integer                        :: l
+      logical                        :: every,back
+      integer                        :: ls,lt,lss,ipos,nr
+
+
+      ls = len(s)
+      lt = len(target)
+      lss = len(ss)
+
+      if (lt == 0) then
+          if (ls == 0) then
+              l = lss
+          else
+              l = ls
+          endif
+          return
+      endif
+
+      if (lt == lss) then
+          l = ls
+          return
+      endif
+
+      select case(uppercase(action))
+      case('FIRST')
+          back = .false.
+          every = .false.
+      case('LAST')
+          back = .true.
+          every = .false.
+      case('ALL')
+          back = .false.
+          every = .true.
+      case default
+          back = .false.
+          every = .false.
+      end select
+
+      nr = 0
+      if (back) then
+          ipos = ls
+          do while (ipos > 0)
+              ipos = index(s(:ipos),target,back)
+              if (ipos == 0) exit
+              nr = nr + 1
+              if (.not. every) exit
+              ipos = ipos - 1
+          enddo
+      else
+          ipos = 1
+          do while (ipos <= ls-lt+1)
+              l = index(s(ipos:),target)
+              if (l == 0) exit
+              nr = nr + 1
+              if (.not. every) exit
+              ipos = ipos + l + 1
+              ipos = ipos + 1
+          enddo
+      endif
+      l = ls + nr*(lss-lt)
+
+      end function lr_ccc
+
+!*******************************************************************************
+
+      function replace_ccc(s,target,ss) result(r)
+
+      implicit none
+      character(*), intent(in)                :: s,target,ss
+      character(lr_ccc(s,target,ss,'first'))  :: r
+
+
+      call x_replace_ccc(s,target,ss,'first',r)
+
+      end function replace_ccc
+
+!*******************************************************************************
+
+      function replace_ccc_f(s,target,ss,action) result(r)
+
+      implicit none
+      character(*), intent(in)               :: s,target,ss,action
+      character(lr_ccc(s,target,ss,action))  :: r
+
+
+      call x_replace_ccc(s,target,ss,action,r)
+
+      end function replace_ccc_f
+
+!*******************************************************************************
+!  Calculate the result string by the following actions:
+!  Search for occurences of TARGET in string S, and replaces these with
+!  substring SS.  If BACK present with value true search is backward otherwise
+!  search is done forward.  If EVERY present with value true all accurences
+!  of TARGET in S are replaced, otherwise only the first found is
+!  replaced.  If TARGET is not found the result is the same as S.
+
+      subroutine x_replace_ccc(s,target,ss,action,r)
+
+      implicit none
+      character(*), intent(in)               :: s,target,ss,action
+      character(*), intent(inout)            :: r
+      logical                                :: every,back
+      integer                                :: lr,ls,lt,lss
+      integer                                :: i1,i2,k1,k2,m1,m2
+
+
+      lr = len(r)
+      ls = len(s)
+      lt = len(target)
+      lss = len(ss)
+
+      if (lt == 0) then
+          if (ls == 0) then
+              r = ss
+          else
+              r = s
+          endif
+          return
+      endif
+
+      select case(uppercase(action))
+      case('FIRST')
+          back = .false.
+          every = .false.
+      case('LAST')
+          back = .true.
+          every = .false.
+      case('ALL')
+          back = .false.
+          every = .true.
+      case default
+          back = .false.
+          every = .false.
+      end select
+
+      if (back) then
+          k2 = ls
+          m2 = lr
+          do
+              i1 = index(s(:k2),target,back)
+              if (i1 == 0) then
+                  r(:m2) = s(:k2)
+                  return
+              endif
+              i2 = i1 + lt - 1
+              k1 = i2 + 1
+              m1 = m2 + k1 - k2
+              r(m1:m2) = s(k1:k2)
+              m2 = m1 - 1
+              m1 = m2 - lss + 1
+              r(m1:m2) = ss
+              k2 = i1 - 1
+              m2 = m1 - 1
+              if (.not. every) then
+                  r(:m2) = s(:k2)
+                  return
+              endif
+          enddo
+      else
+          k1 = 1
+          m1 = 1
+          do
+              i1 = index(s(k1:),target)
+              if (i1 == 0) then
+                  r(m1:) = s(k1:)
+                  return
+              endif
+              i1 = k1 + (i1 - 1)
+              i2 = i1 + lt - 1
+              k2 = i1 - 1
+              m2 = m1 + k2 - k1
+              r(m1:m2) = s(k1:k2)
+              m1 = m2 + 1
+              m2 = m1 + lss - 1
+              r(m1:m2) = ss
+              k1 = i2 + 1
+              m1 = m2 + 1
+              if (.not. every) then
+                  r(m1:) = s(k1:)
+                  return
+              endif
+          enddo
+      endif
+
+      end subroutine x_replace_ccc
+
+!*******************************************************************************
+
+      function replace_csc(s,target,ss) result(r)
+
+      implicit none
+      character(*), intent(in)                      :: s,ss
+      type(string), intent(in)                      :: target
+      character(lr_ccc(s,char(target),ss,'first'))  :: r
+
+
+      call x_replace_ccc(s,char(target),ss,'first',r)
+
+      end function replace_csc
+
+!*******************************************************************************
+
+      function replace_csc_f(s,target,ss,action) result(r)
+
+      implicit none
+      character(*), intent(in)                     :: s,ss,action
+      type(string), intent(in)                     :: target
+      character(lr_ccc(s,char(target),ss,action))  :: r
+
+
+      call x_replace_ccc(s,char(target),ss,action,r)
+
+      end function replace_csc_f
+
+!*******************************************************************************
+!*******************************************************************************
+
+      function replace_ccs(s,target,ss) result(r)
+
+      implicit none
+      character(*), intent(in)                      :: s,target
+      type(string), intent(in)                      :: ss
+      character(lr_ccc(s,target,char(ss),'first'))  :: r
+
+
+      call x_replace_ccc(s,target,char(ss),'first',r)
+
+      end function replace_ccs
+
+!*******************************************************************************
+
+      function replace_ccs_f(s,target,ss,action) result(r)
+
+      implicit none
+      character(*), intent(in)                     :: s,target,action
+      type(string), intent(in)                     :: ss
+      character(lr_ccc(s,target,char(ss),action))  :: r
+
+
+      call x_replace_ccc(s,target,char(ss),action,r)
+
+      end function replace_ccs_f
+
+!*******************************************************************************
+!*******************************************************************************
+
+      function replace_css(s,target,ss) result(r)
+
+      implicit none
+      character(*), intent(in)                            :: s
+      type(string), intent(in)                            :: ss,target
+      character(lr_ccc(s,char(target),char(ss),'first'))  :: r
+
+
+      call x_replace_ccc(s,char(target),char(ss),'first',r)
+
+      end function replace_css
+
+!*******************************************************************************
+
+      function replace_css_f(s,target,ss,action) result(r)
+
+      implicit none
+      character(*), intent(in)                           :: s,action
+      type(string), intent(in)                           :: ss,target
+      character(lr_ccc(s,char(target),char(ss),action))  :: r
+
+
+      call x_replace_ccc(s,char(target),char(ss),action,r)
+
+      end function replace_css_f
+
+!*******************************************************************************
+!*******************************************************************************
+      pure function lr_scc(s,target,ss,action) result(l)
+
+      implicit none
+      type(string), intent(in)       :: s
+      character(*), intent(in)       :: target,ss,action
+      integer                        :: l
+      logical                        :: every,back
+      integer                        :: ls,lt,lss,ipos,nr
+
+
+      ls = len(s)
+      lt = len(target)
+      lss = len(ss)
+
+      if (lt == 0) then
+          if (ls == 0) then
+              l = lss
+          else
+              l = ls
+          endif
+          return
+      endif
+      if (lt == lss) then
+          l = ls
+          return
+      endif
+
+      select case(uppercase(action))
+      case('FIRST')
+          back = .false.
+          every = .false.
+      case('LAST')
+          back = .true.
+          every = .false.
+      case('ALL')
+          back = .false.
+          every = .true.
+      case default
+          back = .false.
+          every = .false.
+      end select
+
+      nr = 0
+      if (back) then
+          ipos = ls
+          do while (ipos > 0)
+              ipos = aindex(s%chars(:ipos),target,back)
+              if (ipos == 0) exit
+              nr = nr + 1
+              if (.not. every) exit
+              ipos = ipos - 1
+          enddo
+
+      else
+          ipos = 1
+          do while (ipos <= ls-lt+1)
+              l = aindex(s%chars(ipos:),target)
+              if (l == 0) exit
+              nr = nr + 1
+              if (.not. every) exit
+              ipos = ipos + l + 1
+          enddo
+      endif
+      l = ls + nr*(lss-lt)
+
+      end function lr_scc
+
+!*******************************************************************************
+
+      function replace_scc(s,target,ss) result(r)
+
+      implicit none
+      type(string), intent(in)                :: s
+      character(*), intent(in)                :: target,ss
+      character(lr_scc(s,target,ss,'first'))  :: r
+
+
+      call x_replace_scc(s,target,ss,'first',r)
+
+
+      end function replace_scc
+
+!*******************************************************************************
+
+      function replace_scc_f(s,target,ss,action) result(r)
+
+      implicit none
+      type(string), intent(in)               :: s
+      character(*), intent(in)               :: target,ss,action
+      character(lr_scc(s,target,ss,action))  :: r
+
+
+      call x_replace_scc(s,target,ss,action,r)
+
+      end function replace_scc_f
+
+!*******************************************************************************
+!  Calculate the result string by the following actions:
+!  Search for occurences of TARGET in string S, and replaces these with
+!  substring SS.  If BACK present with value true search is backward otherwise
+!  search is done forward.  If EVERY present with value true all accurences
+!  of TARGET in S are replaced, otherwise only the first found is
+!  replaced.  If TARGET is not found the result is the same as S.
+
+      subroutine x_replace_scc(s,target,ss,action,r)
+
+      implicit none
+      type(string), intent(in)               :: s
+      character(*), intent(in)               :: target,ss,action
+      character(*), intent(inout)            :: r
+      logical                                :: every,back
+      integer                                :: lr,ls,lt,lss
+      integer                                :: i1,i2,k1,k2,m1,m2
+
+
+      lr = len(r)
+      ls = len(s)
+      lt = len(target)
+      lss = len(ss)
+
+      if (lt == 0) then
+          if (ls == 0) then
+              r = ss
+          else
+              r = s
+          endif
+          return
+      endif
+
+      select case(uppercase(action))
+      case('FIRST')
+          back = .false.
+          every = .false.
+      case('LAST')
+          back = .true.
+          every = .false.
+      case('ALL')
+          back = .false.
+          every = .true.
+      case default
+          back = .false.
+          every = .false.
+      end select
+
+      if (back) then
+          k2 = ls
+          m2 = lr
+          do
+              i1 = aindex(s%chars(:k2),target,back)
+              if (i1 == 0) then
+                  r(:m2) = transfer(s%chars(:k2),r(:m2))
+                  return
+              endif
+              i2 = i1 + lt - 1
+              k1 = i2 + 1
+              m1 = m2 + k1 - k2
+              r(m1:m2) = transfer(s%chars(k1:k2),r(m1:m2))
+              m2 = m1 - 1
+              m1 = m2 - lss + 1
+              r(m1:m2) = ss
+              k2 = i1 - 1
+              m2 = m1 - 1
+              if (.not.every) then
+                  r(:m2) = transfer(s%chars(:k2),r(:m2))
+                  return
+              endif
+          enddo
+      else
+          k1 = 1
+          m1 = 1
+          do
+              i1 = aindex(s%chars(k1:),target)
+              if (i1 == 0) then
+                  r(m1:) = transfer(s%chars(k1:),r(m1:))
+                  return
+              endif
+              i1 = k1 + (i1 - 1)
+              i2 = i1 + lt - 1
+              k2 = i1 - 1
+              m2 = m1 + k2 - k1
+              r(m1:m2) = transfer(s%chars(k1:k2),r(m1:m2))
+              m1 = m2 + 1
+              m2 = m1 + lss - 1
+              r(m1:m2) = ss
+              k1 = i2 + 1
+              m1 = m2 + 1
+              if (.not.every) then
+                  r(m1:) = transfer(s%chars(k1:),r(m1:))
+                  return
+              endif
+          enddo
+      endif
+
+      end subroutine x_replace_scc
+
+!*******************************************************************************
+
+      function replace_ssc(s,target,ss) result(r)
+
+      implicit none
+      type(string), intent(in)                      :: s,target
+      character(*), intent(in)                      :: ss
+      character(lr_scc(s,char(target),ss,'first'))  :: r
+
+
+      call x_replace_scc(s,char(target),ss,'first',r)
+
+
+      end function replace_ssc
+
+!*******************************************************************************
+
+      function replace_ssc_f(s,target,ss,action) result(r)
+
+      implicit none
+      type(string), intent(in)                     :: s,target
+      character(*), intent(in)                     :: ss,action
+      character(lr_scc(s,char(target),ss,action))  :: r
+
+
+      call x_replace_scc(s,char(target),ss,action,r)
+
+      end function replace_ssc_f
+
+!*******************************************************************************
+
+      function replace_scs(s,target,ss) result(r)
+
+      implicit none
+      type(string), intent(in)                      :: s,ss
+      character(*), intent(in)                      :: target
+      character(lr_scc(s,target,char(ss),'first'))  :: r
+
+
+      call x_replace_scc(s,target,char(ss),'first',r)
+
+      end function replace_scs
+
+!*******************************************************************************
+
+      function replace_scs_f(s,target,ss,action) result(r)
+
+      implicit none
+      type(string), intent(in)                     :: s,ss
+      character(*), intent(in)                     :: target,action
+      character(lr_scc(s,target,char(ss),action))  :: r
+
+
+      call x_replace_scc(s,target,char(ss),action,r)
+
+      end function replace_scs_f
+
+!*******************************************************************************
+
+      function replace_sss(s,target,ss) result(r)
+
+      implicit none
+      type(string), intent(in)                            :: s,ss,target
+      character(lr_scc(s,char(target),char(ss),'first'))  :: r
+
+
+      call x_replace_scc(s,char(target),char(ss),'first',r)
+
+      end function replace_sss
+
+!*******************************************************************************
+
+      function replace_sss_f(s,target,ss,action) result(r)
+
+      implicit none
+      type(string), intent(in)                           :: s,ss,target
+      character(*), intent(in)                           :: action
+      character(lr_scc(s,char(target),char(ss),action))  :: r
+
+
+      call x_replace_scc(s,char(target),char(ss),action,r)
+
+      end function replace_sss_f
+
+!*******************************************************************************
+!     SORT, LSORT
+!*******************************************************************************
+!*******************************************************************************
+! Sorts A into ascending order, from A(1) to A(N).
+! Reference: Richard C. Singleton, Algorithm 347, SORT.
+! Comm. ACM 3, 321 (March 1969).
+! Algorithm is Copyright 1969 Association of Computing Machinery,
+!*******************************************************************************
+
+      subroutine sort_c(a)
+
+      implicit none
+      character(*), intent(inout)  :: a(:)
+      character(len(a))            :: t,s
+      integer                      :: p,i,j,k,l,m
+      integer                      :: is(0:63)
+
+
+      m = 0
+      i = 1
+      j = size(a)
+
+    5 continue
+      if (i >= j) goto 70
+
+   10 continue
+      p = (i + j)/2
+      t = a(p)
+      if (a(i) > t) then
+          a(p) = a(i)
+          a(i) = t
+          t = a(p)
+      endif
+      if (a(j) < t) then
+          a(p) = a(j)
+          a(j) = t
+          t = a(p)
+          if (a(i) > t) then
+              a(p) = a(i)
+              a(i) = t
+              t = a(p)
+          endif
+      endif
+
+      k = i
+      l = j
+      do
+          do
+              l = l - 1
+              if (a(l) <= t) exit
+          enddo
+          s = a(l)
+          do
+              k = k + 1
+              if (a(k) >= t) exit
+          enddo
+          if (k > l) exit
+          a(l) = a(k)
+          a(k) = s
+      enddo
+
+      if (l-i > j-k) then
+          is(m) = i
+          m = m + 1
+          is(m) = l
+          m = m + 1
+          i = k
+      else
+          is(m) = k
+          m = m + 1
+          is(m) = j
+          m = m + 1
+          j = l
+      endif
+      goto 80
+
+   70 continue
+      if (m == 0) return
+      m = m - 1
+      j = is(m)
+      m = m - 1
+      i = is(m)
+
+   80 continue
+      if (j-i >= 11) goto 10
+      if (i == 1) goto 5
+      i = i - 1
+
+      do
+          i = i + 1
+          if (i == j) goto 70
+          t = a(i+1)
+          if (a(i) <= t) cycle
+          k = i
+          do
+              a(k+1) = a(k)
+              k = k - 1
+              if (t >= a(k)) exit
+          enddo
+          a(k+1) = t
+      enddo
+
+      end subroutine sort_c
+
+!*******************************************************************************
+! Sorts A into ascending order, from A(1) to A(N).
+! Reference: Richard C. Singleton, Algorithm 347, SORT.
+! Comm. ACM 3, 321 (March 1969).
+! Algorithm is Copyright 1969 Association of Computing Machinery,
+!*******************************************************************************
+
+      subroutine sort_s(a)
+
+      implicit none
+      type(string), intent(inout)  :: a(:)
+      type(string)                 :: s,t
+      integer                      :: p,i,j,k,l,m
+      integer                      :: is(0:63)
+
+
+      m = 0
+      i = 1
+      j = size(a)
+
+    5 continue
+      if (i >= j) goto 70
+
+   10 continue
+      p = (i + j)/2
+      call pstring(t,a(p))
+      if (a(i) > t) then
+          call pstring(a(p),a(i))
+          call pstring(a(i),t)
+          call pstring(t,a(p))
+      endif
+      if (a(j) < t) then
+          call pstring(a(p),a(j))
+          call pstring(a(j),t)
+          call pstring(t,a(p))
+          if (a(i) > t) then
+              call pstring(a(p),a(i))
+              call pstring(a(i),t)
+              call pstring(t,a(p))
+          endif
+      endif
+
+      k = i
+      l = j
+      do
+          do
+              l = l - 1
+              if (a(l) <= t) exit
+          enddo
+          call pstring(s,a(l))
+          do
+              k = k + 1
+              if (a(k) >= t) exit
+          enddo
+          if (k > l) exit
+          call pstring(a(l),a(k))
+          call pstring(a(k),s)
+      enddo
+
+      if (l-i > j-k) then
+          is(m) = i
+          m = m + 1
+          is(m) = l
+          m = m + 1
+          i = k
+      else
+          is(m) = k
+          m = m + 1
+          is(m) = j
+          m = m + 1
+          j = l
+      endif
+      goto 80
+
+   70 continue
+      if (m == 0) return
+      m = m - 1
+      j = is(m)
+      m = m - 1
+      i = is(m)
+
+   80 continue
+      if (j-i >= 11) goto 10
+      if (i == 1) goto 5
+      i = i - 1
+
+      do
+          i = i + 1
+          if (i == j) goto 70
+          call pstring(t,a(i+1))
+          if (a(i) <= t) cycle
+          k = i
+          do
+              call pstring(a(k+1),a(k))
+              k = k - 1
+              if (t >= a(k)) exit
+          enddo
+          call pstring(a(k+1),t)
+      enddo
+
+      contains
+
+!-------------------------------------------------------------------------------
+      subroutine pstring(p,t)
+
+      implicit none
+      type(string), intent(inout)  :: p
+      type(string), intent(in)     :: t
+
+
+      p%len = t%len
+      p%size = t%size
+      p%chars => t%chars
+
+
+      end subroutine pstring
+!-------------------------------------------------------------------------------
+
+      end subroutine sort_s
+
+!*******************************************************************************
+! Sorts A into ascending order, from A(1) to A(N).
+! Reference: Richard C. Singleton, Algorithm 347, SORT.
+! Comm. ACM 3, 321 (March 1969).
+! Algorithm is Copyright 1969 Association of Computing Machinery,
+! reproduced with permission.
+!*******************************************************************************
+
+      subroutine lsort_c(a)
+
+      implicit none
+      character(*), intent(inout)  :: a(:)
+      character(len(a))            :: t,s
+      integer                      :: p,i,j,k,l,m
+      integer                      :: is(0:63)
+
+
+      m = 0
+      i = 1
+      j = size(a)
+
+    5 continue
+      if (i >= j) goto 70
+
+   10 continue
+      p = (i + j)/2
+      t = a(p)
+      if (lgt(a(i),t)) then
+          a(p) = a(i)
+          a(i) = t
+          t = a(p)
+      endif
+      if (llt(a(j),t)) then
+          a(p) = a(j)
+          a(j) = t
+          t = a(p)
+          if (lgt(a(i),t)) then
+              a(p) = a(i)
+              a(i) = t
+              t = a(p)
+          endif
+      endif
+
+      k = i
+      l = j
+      do
+          do
+              l = l - 1
+              if (lle(a(l),t)) exit
+          enddo
+          s = a(l)
+          do
+              k = k + 1
+              if (lge(a(k),t)) exit
+          enddo
+          if (k > l) exit
+          a(l) = a(k)
+          a(k) = s
+      enddo
+
+      if (l-i > j-k) then
+          is(m) = i
+          m = m + 1
+          is(m) = l
+          m = m + 1
+          i = k
+      else
+          is(m) = k
+          m = m + 1
+          is(m) = j
+          m = m + 1
+          j = l
+      endif
+      goto 80
+
+   70 continue
+      if (m == 0) return
+      m = m - 1
+      j = is(m)
+      m = m - 1
+      i = is(m)
+
+   80 continue
+      if (j-i >= 11) goto 10
+      if (i == 1) goto 5
+      i = i - 1
+
+      do
+          i = i + 1
+          if (i == j) goto 70
+          t = a(i+1)
+          if (lle(a(i),t)) cycle
+          k = i
+          do
+              a(k+1) = a(k)
+              k = k - 1
+              if (lge(t,a(k))) exit
+          enddo
+          a(k+1) = t
+      enddo
+
+      end subroutine lsort_c
+
+!*******************************************************************************
+! Sorts A into ascending order, from A(1) to A(N).
+! Reference: Richard C. Singleton, Algorithm 347, SORT.
+! Comm. ACM 3, 321 (March 1969).
+! Algorithm is Copyright 1969 Association of Computing Machinery,
+!*******************************************************************************
+
+      subroutine lsort_s(a)
+
+      implicit none
+      type(string), intent(inout)  :: a(:)
+      type(string)                 :: s,t
+      integer                      :: p,i,j,k,l,m
+      integer                      :: is(0:63)
+
+
+      m = 0
+      i = 1
+      j = size(a)
+
+    5 continue
+      if (i >= j) goto 70
+
+   10 continue
+      p = (i + j)/2
+      call pstring(t,a(p))
+      if (lgt(a(i),t)) then
+          call pstring(a(p),a(i))
+          call pstring(a(i),t)
+          call pstring(t,a(p))
+      endif
+      if (llt(a(j),t)) then
+          call pstring(a(p),a(j))
+          call pstring(a(j),t)
+          call pstring(t,a(p))
+          if (lgt(a(i),t)) then
+              call pstring(a(p),a(i))
+              call pstring(a(i),t)
+              call pstring(t,a(p))
+          endif
+      endif
+
+      k = i
+      l = j
+      do
+          do
+              l = l - 1
+              if (lle(a(l),t)) exit
+          enddo
+          call pstring(s,a(l))
+          do
+              k = k + 1
+              if (lge(a(k),t)) exit
+          enddo
+          if (k > l) exit
+          call pstring(a(l),a(k))
+          call pstring(a(k),s)
+      enddo
+
+      if (l-i > j-k) then
+          is(m) = i
+          m = m + 1
+          is(m) = l
+          m = m + 1
+          i = k
+      else
+          is(m) = k
+          m = m + 1
+          is(m) = j
+          m = m + 1
+          j = l
+      endif
+      goto 80
+
+   70 continue
+      if (m == 0) return
+      m = m - 1
+      j = is(m)
+      m = m - 1
+      i = is(m)
+
+   80 continue
+      if (j-i >= 11) goto 10
+      if (i == 1) goto 5
+      i = i - 1
+
+      do
+          i = i + 1
+          if (i == j) goto 70
+          call pstring(t,a(i+1))
+          if (lle(a(i),t)) cycle
+          k = i
+          do
+              call pstring(a(k+1),a(k))
+              k = k - 1
+              if (lge(t,a(k))) exit
+          enddo
+          call pstring(a(k+1),t)
+      enddo
+
+      contains
+
+!-------------------------------------------------------------------------------
+      subroutine pstring(p,t)
+
+      implicit none
+      type(string), intent(inout)  :: p
+      type(string), intent(in)     :: t
+
+
+      p%len = t%len
+      p%size = t%size
+      p%chars => t%chars
+
+
+      end subroutine pstring
+!-------------------------------------------------------------------------------
+
+      end subroutine lsort_s
+
+!*******************************************************************************
+!     RANK, LRANK
+!*******************************************************************************
+!*******************************************************************************
+! Sorts A into ascending order, from A(1) to A(N).
+! Reference: Richard C. Singleton, Algorithm 347, SORT.
+! Comm. ACM 3, 321 (March 1969).
+! Algorithm is Copyright 1969 Association of Computing Machinery,
+! reproduced with permission.
+!*******************************************************************************
+
+      subroutine rank_c(a,r)
+
+      implicit none
+      character(*), intent(in)  :: a(:)
+      integer, intent(out)      :: r(size(a))
+      character(len(a))         :: t
+      integer                   :: i,j,k,l,m,n,p,rs,rt
+      integer                   :: is(0:63)
+
+
+      n = size(a)
+      r(:) = (/ (i, i=1,n) /)
+      m = 0
+      i = 1
+      j = n
+
+    5 continue
+      if (i >= j) goto 70
+
+   10 continue
+      p = (j+i)/2
+      rt = r(p)
+      t = a(rt)
+      if (a(r(i)) > t) then
+          r(p) = r(i)
+          r(i) = rt
+          rt = r(p)
+          t = a(rt)
+      endif
+      if (a(r(j)) < t) then
+          r(p) = r(j)
+          r(j) = rt
+          rt = r(p)
+          t = a(rt)
+          if (a(r(i)) > t) then
+              r(p) = r(i)
+              r(i) = rt
+              rt = r(p)
+              t = a(rt)
+          endif
+      endif
+
+      k = i
+      l = j
+      do
+          do
+              l = l - 1
+              if (a(r(l)) <= t) exit
+          enddo
+          rs = r(l)
+          do
+              k = k + 1
+              if (a(r(k)) >= t) exit
+          enddo
+          if (k > l) exit
+          r(l) = r(k)
+          r(k) = rs
+      enddo
+
+      if (l-i > j-k) then
+          is(m) = i
+          m = m + 1
+          is(m) = l
+          m = m + 1
+          i = k
+      else
+          is(m) = k
+          m = m + 1
+          is(m) = j
+          m = m + 1
+          j = l
+      endif
+      goto 80
+
+   70 continue
+      if (m == 0) return
+      m = m - 1
+      j = is(m)
+      m = m - 1
+      i = is(m)
+
+   80 continue
+      if (j-i >= 11) goto 10
+      if (i == 1) goto 5
+      i = i - 1
+
+      do
+          i = i + 1
+          if (i == j) goto 70
+          rt = r(i+1)
+          t = a(rt)
+          if (a(r(i)) <= t) cycle
+          k = i
+          do
+              r(k+1) = r(k)
+              k = k - 1
+              if (t >= a(r(k))) exit
+          enddo
+          r(k+1) = rt
+      enddo
+
+      end subroutine rank_c
+
+!*******************************************************************************
+! Sorts A into ascending order, from A(1) to A(N).
+! Reference: Richard C. Singleton, Algorithm 347, SORT.
+! Comm. ACM 3, 321 (March 1969).
+! Algorithm is Copyright 1969 Association of Computing Machinery,
+!*******************************************************************************
+
+      subroutine rank_s(a,r)
+
+      implicit none
+      type(string), intent(in)  :: a(:)
+      integer, intent(out)      :: r(size(a))
+      type(string)              :: t
+      integer                   :: i,j,k,l,m,n,p,rs,rt
+      integer                   :: is(0:63)
+
+
+      n = size(a)
+      r(:) = (/ (i, i=1,n) /)
+      m = 0
+      i = 1
+      j = n
+
+    5 continue
+      if (i >= j) goto 70
+
+   10 continue
+      p = (j+i)/2
+      rt = r(p)
+      call pstring(t,a(rt))
+      if (a(r(i)) > t) then
+          r(p) = r(i)
+          r(i) = rt
+          rt = r(p)
+          call pstring(t,a(rt))
+      endif
+      if (a(r(j)) < t) then
+          r(p) = r(j)
+          r(j) = rt
+          rt = r(p)
+          call pstring(t,a(rt))
+          if (a(r(i)) > t) then
+              r(p) = r(i)
+              r(i) = rt
+              rt = r(p)
+              call pstring(t,a(rt))
+          endif
+      endif
+
+      k = i
+      l = j
+      do
+          do
+              l = l - 1
+              if (a(r(l)) <= t) exit
+          enddo
+          rs = r(l)
+          do
+              k = k + 1
+              if (a(r(k)) >= t) exit
+          enddo
+          if (k > l) exit
+          r(l) = r(k)
+          r(k) = rs
+      enddo
+
+      if (l-i > j-k) then
+          is(m) = i
+          m = m + 1
+          is(m) = l
+          m = m + 1
+          i = k
+      else
+          is(m) = k
+          m = m + 1
+          is(m) = j
+          m = m + 1
+          j = l
+      endif
+      goto 80
+
+   70 continue
+      if (m == 0) return
+      m = m - 1
+      j = is(m)
+      m = m - 1
+      i = is(m)
+
+   80 continue
+      if (j-i >= 11) goto 10
+      if (i == 1) goto 5
+      i = i - 1
+
+      do
+          i = i + 1
+          if (i == j) goto 70
+          rt = r(i+1)
+          call pstring(t,a(rt))
+          if (a(r(i)) <= t) cycle
+          k = i
+          do
+              r(k+1) = r(k)
+              k = k - 1
+              if (t >= a(r(k))) exit
+          enddo
+          r(k+1) = rt
+      enddo
+
+      contains
+
+!-------------------------------------------------------------------------------
+      subroutine pstring(p,t)
+
+      implicit none
+      type(string), intent(inout)  :: p
+      type(string), intent(in)     :: t
+
+
+      p%len = t%len
+      p%size = t%size
+      p%chars => t%chars
+
+
+      end subroutine pstring
+!-------------------------------------------------------------------------------
+
+      end subroutine rank_s
+
+!*******************************************************************************
+! Sorts A into ascending order, from A(1) to A(N).
+! Reference: Richard C. Singleton, Algorithm 347, SORT.
+! Comm. ACM 3, 321 (March 1969).
+! Algorithm is Copyright 1969 Association of Computing Machinery,
+!*******************************************************************************
+
+      subroutine lrank_c(a,r)
+
+      implicit none
+      character(*), intent(in)  :: a(:)
+      integer, intent(out)      :: r(size(a))
+      character(len(a))         :: t
+      integer                   :: i,j,k,l,m,n,p,rs,rt
+      integer                   :: is(0:63)
+
+
+      n = size(a)
+      r(:) = (/ (i, i=1,n) /)
+      m = 0
+      i = 1
+      j = n
+
+    5 continue
+      if (i >= j) goto 70
+
+   10 continue
+      p = (j+i)/2
+      rt = r(p)
+      t = a(rt)
+      if (lgt(a(r(i)),t)) then
+          r(p) = r(i)
+          r(i) = rt
+          rt = r(p)
+          t = a(rt)
+      endif
+      if (llt(a(r(j)),t)) then
+          r(p) = r(j)
+          r(j) = rt
+          rt = r(p)
+          t = a(rt)
+          if (llt(a(r(i)),t)) then
+              r(p) = r(i)
+              r(i) = rt
+              rt = r(p)
+              t = a(rt)
+          endif
+      endif
+
+      k = i
+      l = j
+      do
+          do
+              l = l - 1
+              if (lle(a(r(l)),t)) exit
+          enddo
+          rs = r(l)
+          do
+              k = k + 1
+              if (lge(a(r(k)),t)) exit
+          enddo
+          if (k > l) exit
+          r(l) = r(k)
+          r(k) = rs
+      enddo
+
+      if (l-i > j-k) then
+          is(m) = i
+          m = m + 1
+          is(m) = l
+          m = m + 1
+          i = k
+      else
+          is(m) = k
+          m = m + 1
+          is(m) = j
+          m = m + 1
+          j = l
+      endif
+      goto 80
+
+   70 continue
+      if (m == 0) return
+      m = m - 1
+      j = is(m)
+      m = m - 1
+      i = is(m)
+
+   80 continue
+      if (j-i >= 11) goto 10
+      if (i == 1) goto 5
+      i = i - 1
+
+      do
+          i = i + 1
+          if (i == j) goto 70
+          rt = r(i+1)
+          t = a(rt)
+          if (lle(a(r(i)),t)) cycle
+          k = i
+          do
+              r(k+1) = r(k)
+              k = k - 1
+              if (lge(t,a(r(k)))) exit
+          enddo
+          r(k+1) = rt
+      enddo
+
+      end subroutine lrank_c
+
+!*******************************************************************************
+! Sorts A into ascending order, from A(1) to A(N).
+! Reference: Richard C. Singleton, Algorithm 347, SORT.
+! Comm. ACM 3, 321 (March 1969).
+! Algorithm is Copyright 1969 Association of Computing Machinery,
+!*******************************************************************************
+
+      subroutine lrank_s(a,r)
+
+      implicit none
+      type(string), intent(in)  :: a(:)
+      integer, intent(out)      :: r(size(a))
+      type(string)              :: t
+      integer                   :: i,j,k,l,m,n,p,rs,rt
+      integer                   :: is(0:63)
+
+
+      n = size(a)
+      r(:) = (/ (i, i=1,n) /)
+      m = 0
+      i = 1
+      j = n
+
+    5 continue
+      if (i >= j) goto 70
+
+   10 continue
+      p = (j+i)/2
+      rt = r(p)
+      call pstring(t,a(rt))
+      if (lgt(a(r(i)),t)) then
+          r(p) = r(i)
+          r(i) = rt
+          rt = r(p)
+          call pstring(t,a(rt))
+      endif
+      if (llt(a(r(j)),t)) then
+          r(p) = r(j)
+          r(j) = rt
+          rt = r(p)
+          call pstring(t,a(rt))
+          if (lgt(a(r(i)),t)) then
+              r(p) = r(i)
+              r(i) = rt
+              rt = r(p)
+              call pstring(t,a(rt))
+          endif
+      endif
+
+      k = i
+      l = j
+      do
+          do
+              l = l - 1
+              if (lle(a(r(l)),t)) exit
+          enddo
+          rs = r(l)
+          do
+              k = k + 1
+              if (lge(a(r(k)),t)) exit
+          enddo
+          if (k > l) exit
+          r(l) = r(k)
+          r(k) = rs
+      enddo
+
+      if (l-i > j-k) then
+          is(m) = i
+          m = m + 1
+          is(m) = l
+          m = m + 1
+          i = k
+      else
+          is(m) = k
+          m = m + 1
+          is(m) = j
+          m = m + 1
+          j = l
+      endif
+      goto 80
+
+   70 continue
+      if (m == 0) return
+      m = m - 1
+      j = is(m)
+      m = m - 1
+      i = is(m)
+
+   80 continue
+      if (j-i >= 11) goto 10
+      if (i == 1) goto 5
+      i = i - 1
+
+      do
+          i = i + 1
+          if (i == j) goto 70
+          rt = r(i+1)
+          call pstring(t,a(rt))
+          if (lle(a(r(i)),t)) cycle
+          k = i
+          do
+              r(k+1) = r(k)
+              k = k - 1
+              if (lge(t,a(r(k)))) exit
+          enddo
+          r(k+1) = rt
+      enddo
+
+      contains
+
+!-------------------------------------------------------------------------------
+      subroutine pstring(p,t)
+
+      implicit none
+      type(string), intent(inout)  :: p
+      type(string), intent(in)     :: t
+
+
+      p%len = t%len
+      p%size = t%size
+      p%chars => t%chars
+
+
+      end subroutine pstring
+!-------------------------------------------------------------------------------
+
+      end subroutine lrank_s
+
+!*******************************************************************************
+!     COMPARE, LCOMPARE, ACOMPARE, ALCOMPARE
+!*******************************************************************************
+!*******************************************************************************
+
+      elemental function compare_ss(s1,s2) result(css)
+
+      implicit none
+      type(string), intent(in)  :: s1,s2
+      character(2)              :: css
+      integer                   :: i,l1,l2
+
+
+      l1 = len(s1)
+      l2 = len(s2)
+      do i=1,min(l1,l2)
+          if (s1%chars(i) < s2%chars(i)) then
+              css = 'LT'
+              return
+          elseif (s1%chars(i) > s2%chars(i)) then
+              css = 'GT'
+              return
+          endif
+      enddo
+      if (l1 < l2) then
+          do i=l1+1,l2
+              if (blank < s2%chars(i)) then
+                  css = 'LT'
+                  return
+              elseif (blank > s2%chars(i)) then
+                  css = 'GT'
+                  return
+              endif
+          enddo
+      elseif (l1 > l2) then
+          do i=l2+1,l1
+              if (s1%chars(i) < blank) then
+                  css = 'LT'
+                  return
+              elseif (s1%chars(i) > blank) then
+                  css = 'GT'
+                  return
+              endif
+          enddo
+      endif
+      css = 'EQ'
+
+      end function compare_ss
+
+!*******************************************************************************
+
+      elemental function compare_cs(c,s) result(css)
+
+      implicit none
+      character(*), intent(in)  :: c
+      type(string), intent(in)  :: s
+      character(2)              :: css
+      integer                   :: i,lc,ls
+
+
+      lc = len(c)
+      ls = len(s)
+      do i=1,min(lc,ls)
+          if (c(i:i) < s%chars(i)) then
+              css = 'LT'
+              return
+          elseif (c(i:i) > s%chars(i)) then
+              css = 'GT'
+              return
+          endif
+      enddo
+      if (lc < ls) then
+          do i=lc+1,ls
+              if (blank < s%chars(i)) then
+                  css = 'LT'
+                  return
+              elseif (blank > s%chars(i)) then
+                  css = 'GT'
+                  return
+              endif
+          enddo
+      elseif (lc > ls) then
+          do i=ls+1,lc
+              if (c(i:i) < blank) then
+                  css = 'LT'
+                  return
+              elseif (c(i:i) > blank) then
+                  css = 'GT'
+                  return
+              endif
+          enddo
+      endif
+      css = 'EQ'
+
+      end function compare_cs
+
+!*******************************************************************************
+!     ==
+!*******************************************************************************
+! string == string
+
+      elemental function s_eq_s(s1,s2)
+
+      implicit none
+      type(string), intent(in)  :: s1,s2
+      logical                   :: s_eq_s
+      integer                   :: l1,l2
+
+
+      l1 = len(s1)
+      l2 = len(s2)
+      if (l1 > l2) then
+          s_eq_s = all(s1%chars(1:l2) == s2%chars) .and.  &
+                   all(s1%chars(l2+1:l1) == blank)
+      elseif (l1 < l2) then
+          s_eq_s = all(s1%chars == s2%chars(1:l1)) .and.  &
+                   all(blank == s2%chars(l1+1:l2))
+      else
+          s_eq_s = all(s1%chars == s2%chars)
+      endif
+
+      end function s_eq_s
+
+!*******************************************************************************
+! string == character
+
+      elemental function s_eq_c(s,c)
+
+      implicit none
+      type(string), intent(in)  :: s
+      character(*), intent(in)  :: c
+      logical                   :: s_eq_c
+      integer                   :: i,ls,lc
+
+
+      ls = len(s)
+      lc = len(c)
+      do i=1,min(ls,lc)
+          if (s%chars(i) /= c(i:i)) then
+              s_eq_c = .false.
+              return
+          endif
+      enddo
+      if ((ls > lc) .and. any(s%chars(lc+1:ls) /= blank)) then
+          s_eq_c = .false.
+      elseif ((ls < lc) .and. (blank /= c(ls+1:lc))) then
+          s_eq_c = .false.
+      else
+          s_eq_c = .true.
+      endif
+
+      end function s_eq_c
+
+!*******************************************************************************
+! character == string
+
+      elemental function c_eq_s(c,s)
+
+      implicit none
+      character(*), intent(in)  :: c
+      type(string), intent(in)  :: s
+      logical                   :: c_eq_s
+      integer                   :: i,lc,ls
+
+
+      lc = len(c)
+      ls = len(s)
+      do i=1,min(lc,ls)
+          if (c(i:i) /= s%chars(i)) then
+              c_eq_s = .false.
+              return
+          endif
+      enddo
+      if ((lc > ls) .and. (c(ls+1:lc) /= blank)) then
+          c_eq_s = .false.
+      elseif ((lc < ls) .and. any(blank /= s%chars(lc+1:ls) ) )then
+          c_eq_s = .false.
+      else
+          c_eq_s = .true.
+      endif
+
+      end function c_eq_s
+
+!*******************************************************************************
+!     /=
+!*******************************************************************************
+! string /= string
+
+      elemental function s_ne_s(s1,s2)
+
+      implicit none
+      type(string), intent(in)  :: s1,s2
+      logical                   :: s_ne_s
+      integer                   :: l1,l2
+
+
+      l1 = len(s1)
+      l2 = len(s2)
+      if (l1 > l2) then
+          s_ne_s = any(s1%chars(1:l2) /= s2%chars) .or.  &
+                   any(s1%chars(l2+1:l1) /= blank)
+      elseif (l1 < l2) then
+          s_ne_s = any(s1%chars /= s2%chars(1:l1)) .or. &
+                   any(blank /= s2%chars(l1+1:l2))
+      else
+          s_ne_s = any(s1%chars /= s2%chars)
+      endif
+
+      end function s_ne_s
+
+!*******************************************************************************
+! string /= character
+
+      elemental function s_ne_c(s,c)
+
+      implicit none
+      type(string), intent(in)  :: s
+      character(*), intent(in)  :: c
+      logical                   :: s_ne_c
+      integer                   :: i,ls,lc
+
+
+      ls = len(s)
+      lc = len(c)
+      do i=1,min(ls,lc)
+          if (s%chars(i) /= c(i:i) )then
+              s_ne_c = .true.
+              return
+          endif
+      enddo
+      if ((ls > lc) .and. any(s%chars(ls+1:lc) /= blank)) then
+          s_ne_c = .true.
+      elseif ((ls < lc) .and. blank /= c(ls+1:lc)) then
+          s_ne_c = .true.
+      else
+          s_ne_c = .false.
+      endif
+
+      end function s_ne_c
+
+!*******************************************************************************
+! character /= string
+
+      elemental function c_ne_s(c,s)
+
+      implicit none
+      character(*), intent(in)  :: c
+      type(string), intent(in)  :: s
+      logical                   :: c_ne_s
+      integer                   :: i,lc,ls
+
+
+      lc = len(c)
+      ls = len(s)
+      do i=1,min(lc,ls)
+          if (c(i:i) /= s%chars(i)) then
+              c_ne_s = .true.
+              return
+          endif
+      enddo
+      if ((lc > ls) .and. c(ls+1:lc) /= blank) then
+          c_ne_s = .true.
+      elseif ((lc < ls) .and. any(blank /= s%chars(lc+1:ls))) then
+          c_ne_s = .true.
+      else
+          c_ne_s = .false.
+      endif
+
+      end function c_ne_s
+
+!*******************************************************************************
+!     < operators
+!*******************************************************************************
+! string < string
+
+      elemental function s_lt_s(s1,s2)
+
+      implicit none
+      type(string), intent(in)  :: s1,s2
+      logical                   :: s_lt_s
+
+
+      s_lt_s = compare_ss(s1,s2) == 'LT'
+
+      end function s_lt_s
+
+!*******************************************************************************
+! string < character
+
+      elemental function s_lt_c(s,c)
+
+      implicit none
+      type(string), intent(in)  :: s
+      character(*), intent(in)  :: c
+      logical                   :: s_lt_c
+
+
+      s_lt_c = compare_cs(c,s) == 'GT'
+
+      end function s_lt_c
+
+!*******************************************************************************
+! character < string
+
+      elemental function c_lt_s(c,s)
+
+      implicit none
+      character(*), intent(in)  :: c
+      type(string), intent(in)  :: s
+      logical                   :: c_lt_s
+
+
+      c_lt_s = compare_cs(c,s) == 'LT'
+
+      end function c_lt_s
+
+!*******************************************************************************
+!     <=  operators
+!*******************************************************************************
+! string <= string
+
+      elemental function s_le_s(s1,s2)
+
+      implicit none
+      type(string), intent(in)  :: s1,s2
+      logical                   :: s_le_s
+
+
+      s_le_s = compare_ss(s1,s2) /= 'GT'
+
+      end function s_le_s
+
+!*******************************************************************************
+! string <= character
+
+      elemental function s_le_c(s,c)
+
+      implicit none
+      type(string), intent(in)  :: s
+      character(*), intent(in)  :: c
+      logical                   :: s_le_c
+
+
+      s_le_c = compare_cs(c,s) /= 'LT'
+
+      end function s_le_c
+
+!*******************************************************************************
+! character <= string
+
+      elemental function c_le_s(c,s)
+
+      implicit none
+      character(*), intent(in)  :: c
+      type(string), intent(in)  :: s
+      logical                   :: c_le_s
+
+
+      c_le_s = compare_cs(c,s) /= 'GT'
+
+      end function c_le_s
+
+!*******************************************************************************
+!     >=  operators
+!*******************************************************************************
+! string >= string
+
+      elemental function s_ge_s(s1,s2)
+
+      implicit none
+      type(string), intent(in) :: s1,s2
+      logical                  :: s_ge_s
+
+
+      s_ge_s = compare_ss(s1,s2) /= 'LT'
+
+      end function s_ge_s
+
+!*******************************************************************************
+! string >= character
+
+      elemental function s_ge_c(s,c)
+
+      implicit none
+      type(string), intent(in)  :: s
+      character(*), intent(in)  :: c
+      logical                   :: s_ge_c
+
+
+      s_ge_c = compare_cs(c,s) /= 'GT'
+
+      end function s_ge_c
+
+!*******************************************************************************
+! character >= string
+
+      elemental function c_ge_s(c,s)
+
+      implicit none
+      character(*), intent(in)  :: c
+      type(string), intent(in)  :: s
+      logical                   :: c_ge_s
+
+
+      c_ge_s = compare_cs(c,s) /= 'LT'
+
+      end function c_ge_s
+
+!*******************************************************************************
+!     >  operators
+!*******************************************************************************
+! string > string
+
+      elemental function s_gt_s(s1,s2)
+
+      implicit none
+      type(string), intent(in) :: s1,s2
+      logical                  :: s_gt_s
+
+
+      s_gt_s = compare_ss(s1,s2) == 'GT'
+
+      end function s_gt_s
+
+!*******************************************************************************
+! string > character
+
+      elemental function s_gt_c(s,c)
+
+      implicit none
+      type(string), intent(in)  :: s
+      character(*), intent(in)  :: c
+      logical                   :: s_gt_c
+
+
+      s_gt_c = compare_cs(c,s) == 'LT'
+
+      end function s_gt_c
+
+!*******************************************************************************
+! character > string
+
+      elemental function c_gt_s(c,s)
+
+      implicit none
+      character(*), intent(in)  :: c
+      type(string), intent(in)  :: s
+      logical                   :: c_gt_s
+
+
+      c_gt_s = compare_cs(c,s) == 'GT'
+
+      end function c_gt_s
+
+!*******************************************************************************
+
+      elemental function lcompare_ss(s1,s2) result(css)
+
+      implicit none
+      type(string), intent(in)  :: s1,s2
+      character(2)              :: css
+      integer                   :: i,l1,l2
+
+
+      l1 = len(s1)
+      l2 = len(s2)
+      do i=1,min(l1,l2)
+          if (llt(s1%chars(i),s2%chars(i))) then
+              css = 'LT'
+              return
+          elseif (lgt(s1%chars(i),s2%chars(i))) then
+              css = 'GT'
+              return
+          endif
+      enddo
+      if (l1 < l2) then
+          do i=l1+1,l2
+              if (llt(blank,s2%chars(i))) then
+                  css = 'LT'
+                  return
+              elseif (lgt(blank,s2%chars(i))) then
+                  css = 'GT'
+                  return
+              endif
+          enddo
+      elseif (l1 > l2) then
+          do i=l2+1,l1
+              if (llt(s1%chars(i),blank)) then
+                  css = 'LT'
+                  return
+              elseif (lgt(s1%chars(i),blank)) then
+                  css = 'GT'
+                  return
+              endif
+          enddo
+      endif
+      css = 'EQ'
+
+      end function lcompare_ss
+
+!*******************************************************************************
+
+      elemental function lcompare_cs(c,s) result(css)
+
+      implicit none
+      character(*), intent(in)  :: c
+      type(string), intent(in)  :: s
+      character(2)              :: css
+      integer                   :: i,lc,ls
+
+
+      lc = len(c)
+      ls = len(s)
+      do i=1,min(lc,ls)
+          if (llt(c(i:i),s%chars(i))) then
+              css = 'LT'
+              return
+          elseif (lgt(c(i:i),s%chars(i))) then
+              css = 'GT'
+              return
+          endif
+      enddo
+      if (lc < ls) then
+          do i=lc+1,ls
+              if (llt(blank,s%chars(i))) then
+                  css = 'LT'
+                  return
+              elseif (lgt(blank,s%chars(i))) then
+                  css = 'GT'
+                  return
+              endif
+          enddo
+      elseif (lc > ls) then
+          do i=ls+1,lc
+              if (llt(c(i:i),blank)) then
+                  css = 'LT'
+                  return
+              elseif (lgt(c(i:i),blank)) then
+                  css = 'GT'
+                  return
+              endif
+          enddo
+      endif
+      css = 'EQ'
+
+      end function lcompare_cs
+
+!*******************************************************************************
+!     LLT function
+!*******************************************************************************
+!     llt(string,string)
+
+      elemental function s_llt_s(s1,s2)
+
+      implicit none
+      type(string), intent(in)  :: s1,s2
+      logical                   :: s_llt_s
+
+      s_llt_s = (lcompare_ss(s1,s2) == 'LT')
+
+      end function s_llt_s
+
+!*******************************************************************************
+!     llt(string,character)
+
+      elemental function s_llt_c(s1,c2)
+
+      implicit none
+      type(string), intent(in)  :: s1
+      character(*), intent(in)  :: c2
+      logical                   :: s_llt_c
+
+      s_llt_c = (lcompare_cs(c2,s1) == 'GT')
+
+      end function s_llt_c
+
+!*******************************************************************************
+!     llt(character,string)
+
+      elemental function c_llt_s(c1,s2)
+
+      implicit none
+      type(string), intent(in)  :: s2
+      character(*), intent(in)  :: c1
+      logical                   :: c_llt_s
+
+      c_llt_s = (lcompare_cs(c1,s2) == 'LT')
+
+      end function c_llt_s
+
+!*******************************************************************************
+!     LGT function
+!*******************************************************************************
+!     lgt(string,string)
+
+      elemental function s_lgt_s(s1,s2)
+
+      implicit none
+      type(string), intent(in)  :: s1,s2
+      logical                   :: s_lgt_s
+
+      s_lgt_s = (lcompare_ss(s1,s2) == 'GT')
+
+      end function s_lgt_s
+
+!*******************************************************************************
+!     lgt(string,character)
+
+      elemental function s_lgt_c(s1,c2)
+
+      implicit none
+      type(string), intent(in)  :: s1
+      character(*), intent(in)  :: c2
+      logical                   :: s_lgt_c
+
+      s_lgt_c = (lcompare_cs(c2,s1) == 'LT')
+
+      end function s_lgt_c
+
+!*******************************************************************************
+!     lgt(character,string)
+
+      elemental function c_lgt_s(c1,s2)
+
+      implicit none
+      type(string), intent(in)  :: s2
+      character(*), intent(in)  :: c1
+      logical                   :: c_lgt_s
+
+      c_lgt_s = (lcompare_cs(c1,s2) == 'GT')
+
+      end function c_lgt_s
+
+!*******************************************************************************
+!     LGE function
+!*******************************************************************************
+!     lge(string,string)
+
+      elemental function s_lge_s(s1,s2)
+
+      implicit none
+      type(string), intent(in)  :: s1,s2
+      logical                   :: s_lge_s
+
+      s_lge_s = (lcompare_ss(s1,s2) /= 'LT')
+
+      end function s_lge_s
+
+!*******************************************************************************
+!     lge(string,character)
+
+      elemental function s_lge_c(s1,c2)
+
+      implicit none
+      type(string), intent(in)  :: s1
+      character(*), intent(in)  :: c2
+      logical                   :: s_lge_c
+
+      s_lge_c = (lcompare_cs(c2,s1) /= 'GT')
+
+      end function s_lge_c
+
+!*******************************************************************************
+!     lge(character,string)
+
+      elemental function c_lge_s(c1,s2)
+
+      implicit none
+      type(string), intent(in)  :: s2
+      character(*), intent(in)  :: c1
+      logical                   :: c_lge_s
+
+      c_lge_s = (lcompare_cs(c1,s2) /= 'LT')
+
+      end function c_lge_s
+
+!*******************************************************************************
+!     LLE function
+!*******************************************************************************
+!     lle(string,string)
+
+      elemental function s_lle_s(s1,s2)
+
+      implicit none
+      type(string), intent(in)  :: s1,s2
+      logical                   :: s_lle_s
+
+      s_lle_s = (lcompare_ss(s1,s2) /= 'GT')
+
+      end function s_lle_s
+
+!*******************************************************************************
+!     lle(string,character)
+
+      elemental function s_lle_c(s1,c2)
+
+      implicit none
+      type(string), intent(in)  :: s1
+      character(*), intent(in)  :: c2
+      logical                   :: s_lle_c
+
+      s_lle_c = (lcompare_cs(c2,s1) /= 'LT')
+
+      end function s_lle_c
+
+!*******************************************************************************
+!     lle(character,string)
+
+      elemental function c_lle_s(c1,s2)
+
+      implicit none
+      type(string), intent(in)  :: s2
+      character(*), intent(in)  :: c1
+      logical                   :: c_lle_s
+
+      c_lle_s = (lcompare_cs(c1,s2) /= 'GT')
+
+      end function c_lle_s
+
+!*******************************************************************************
+
+      pure function acompare_aa(a1,a2) result(caa)
+
+      implicit none
+      character, intent(in)  :: a1(:),a2(:)
+      character(2)           :: caa
+      integer                :: i,l1,l2
+
+
+      l1 = size(a1)
+      l2 = size(a2)
+      do i=1,min(l1,l2)
+          if (a1(i) < a2(i)) then
+              caa = 'LT'
+              return
+          elseif (a1(i) > a2(i)) then
+              caa = 'GT'
+              return
+          endif
+      enddo
+      if (l1 < l2) then
+          do i=l1+1,l2
+              if (blank < a2(i)) then
+                  caa = 'LT'
+                  return
+              elseif (blank > a2(i)) then
+                  caa = 'GT'
+                  return
+              endif
+          enddo
+      elseif (l1 > l2) then
+          do i=l2+1,l1
+              if (a1(i) < blank) then
+                  caa = 'LT'
+                  return
+              elseif (a1(i) > blank) then
+                  caa = 'GT'
+                  return
+              endif
+          enddo
+      endif
+      caa = 'EQ'
+
+      end function acompare_aa
+
+!*******************************************************************************
+
+      pure function acompare_ca(c,a) result(cca)
+
+      implicit none
+      character(*), intent(in)  :: c
+      character, intent(in)     :: a(:)
+      character(2)              :: cca
+      integer                   :: i,lc,la
+
+
+      lc = len(c)
+      la = size(a)
+      do i=1,min(lc,la)
+          if (c(i:i) < a(i)) then
+              cca = 'LT'
+              return
+          elseif (c(i:i) > a(i)) then
+              cca = 'GT'
+              return
+          endif
+      enddo
+      if (lc < la) then
+          do i=lc+1,la
+              if (blank < a(i)) then
+                  cca = 'LT'
+                  return
+              elseif (blank > a(i)) then
+                  cca = 'GT'
+                  return
+              endif
+          enddo
+      elseif (lc > la) then
+          do i=la+1,lc
+              if (c(i:i) < blank) then
+                  cca = 'LT'
+                  return
+              elseif (c(i:i) > blank) then
+                  cca = 'GT'
+                  return
+              endif
+          enddo
+      endif
+      cca = 'EQ'
+
+      end function acompare_ca
+
+!*******************************************************************************
+!     ==
+!*******************************************************************************
+! array == array
+
+      pure function a_eq_a(a1,a2)
+
+      implicit none
+      character, intent(in)  :: a1(:),a2(:)
+      logical                :: a_eq_a
+      integer                :: l1,l2
+
+
+      l1 = size(a1)
+      l2 = size(a2)
+      if (l1 > l2) then
+          a_eq_a = all(a1(1:l2) == a2) .and.  &
+                   all(a1(l2+1:l1) == blank)
+      elseif (l1 < l2) then
+          a_eq_a = all(a1 == a2(1:l1)) .and.  &
+                   all(blank == a2(l1+1:l2))
+      else
+          a_eq_a = all(a1 == a2)
+      endif
+
+      end function a_eq_a
+
+!*******************************************************************************
+! array == character
+
+      pure function a_eq_c(a,c)
+
+      implicit none
+      character, intent(in)     :: a(:)
+      character(*), intent(in)  :: c
+      logical                   :: a_eq_c
+      integer                   :: i,la,lc
+
+
+      la = len(a)
+      lc = len(c)
+      do i=1,min(la,lc)
+          if (a(i) /= c(i:i)) then
+              a_eq_c = .false.
+              return
+          endif
+      enddo
+      if ((la > lc) .and. any(a(lc+1:la) /= blank)) then
+          a_eq_c = .false.
+      elseif ((la < lc) .and. (blank /= c(la+1:lc))) then
+          a_eq_c = .false.
+      else
+          a_eq_c = .true.
+      endif
+
+      end function a_eq_c
+
+!*******************************************************************************
+! character == array
+
+      pure function c_eq_a(c,a)
+
+      implicit none
+      character(*), intent(in)  :: c
+      character, intent(in)     :: a(:)
+      logical                   :: c_eq_a
+
+
+      c_eq_a = a_eq_c(a,c)
+
+      end function c_eq_a
+
+!*******************************************************************************
+!     /=
+!*******************************************************************************
+! array /= array
+
+      pure function a_ne_a(a1,a2)
+
+      implicit none
+      character, intent(in)  :: a1(:),a2(:)
+      logical                :: a_ne_a
+      integer                :: l1,l2
+
+
+      l1 = size(a1)
+      l2 = size(a2)
+      if (l1 > l2) then
+          a_ne_a = any(a1(1:l2) /= a2) .or.  &
+                   any(a1(l2+1:l1) /= blank)
+      elseif (l1 < l2) then
+          a_ne_a = any(a1 /= a2(1:l1)) .or. &
+                   any(blank /= a2(l1+1:l2))
+      else
+          a_ne_a = any(a1 /= a2)
+      endif
+
+      end function a_ne_a
+
+!*******************************************************************************
+! array /= character
+
+      pure function a_ne_c(a,c)
+
+      implicit none
+      character, intent(in)     :: a(:)
+      character(*), intent(in)  :: c
+      logical                   :: a_ne_c
+      integer                   :: i,la,lc
+
+
+      la = size(a)
+      lc = len(c)
+      do i=1,min(la,lc)
+          if (a(i) /= c(i:i) )then
+              a_ne_c = .true.
+              return
+          endif
+      enddo
+      if ((la > lc) .and. any(a(la+1:lc) /= blank)) then
+          a_ne_c = .true.
+      elseif ((la < lc) .and. blank /= c(la+1:lc)) then
+          a_ne_c = .true.
+      else
+          a_ne_c = .false.
+      endif
+
+      end function a_ne_c
+
+!*******************************************************************************
+! character /= array
+
+      pure function c_ne_a(c,a)
+
+      implicit none
+      character(*), intent(in)  :: c
+      character, intent(in)     :: a(:)
+      logical                   :: c_ne_a
+
+
+      c_ne_a = acompare_ca(c,a) /= 'EQ'
+
+      end function c_ne_a
+
+!*******************************************************************************
+!     < operators
+!*******************************************************************************
+! array < array
+
+      pure function a_lt_a(a1,a2)
+
+      implicit none
+      character, intent(in)  :: a1(:),a2(:)
+      logical                :: a_lt_a
+
+
+      a_lt_a = acompare_aa(a1,a2) == 'LT'
+
+      end function a_lt_a
+
+!*******************************************************************************
+! array < character
+
+      pure function a_lt_c(a,c)
+
+      implicit none
+      character, intent(in)     :: a(:)
+      character(*), intent(in)  :: c
+      logical                   :: a_lt_c
+
+
+      a_lt_c = acompare_ca(c,a) == 'GT'
+
+      end function a_lt_c
+
+!*******************************************************************************
+! character < array
+
+      pure function c_lt_a(c,a)
+
+      implicit none
+      character(*), intent(in)  :: c
+      character, intent(in)     :: a(:)
+      logical                   :: c_lt_a
+
+
+      c_lt_a = acompare_ca(c,a) == 'LT'
+
+      end function c_lt_a
+
+!*******************************************************************************
+!     <=  operators
+!*******************************************************************************
+! array <= array
+
+      pure function a_le_a(a1,a2)
+
+      implicit none
+      character, intent(in)  :: a1(:),a2(:)
+      logical                :: a_le_a
+
+
+      a_le_a = acompare_aa(a1,a2) /= 'GT'
+
+      end function a_le_a
+
+!*******************************************************************************
+! array <= character
+
+      pure function a_le_c(a,c)
+
+      implicit none
+      character, intent(in)     :: a(:)
+      character(*), intent(in)  :: c
+      logical                   :: a_le_c
+
+
+      a_le_c = acompare_ca(c,a) /= 'LT'
+
+      end function a_le_c
+
+!*******************************************************************************
+! character <= array
+
+      pure function c_le_a(c,a)
+
+      implicit none
+      character(*), intent(in)  :: c
+      character, intent(in)     :: a(:)
+      logical                   :: c_le_a
+
+
+      c_le_a = acompare_ca(c,a) /= 'GT'
+
+      end function c_le_a
+
+!*******************************************************************************
+!     >=  operators
+!*******************************************************************************
+! array >= array
+
+      pure function a_ge_a(a1,a2)
+
+      implicit none
+      character, intent(in)  :: a1(:),a2(:)
+      logical                :: a_ge_a
+
+
+      a_ge_a = acompare_aa(a1,a2) /= 'LT'
+
+      end function a_ge_a
+
+!*******************************************************************************
+! array >= character
+
+      pure function a_ge_c(a,c)
+
+      implicit none
+      character, intent(in)     :: a(:)
+      character(*), intent(in)  :: c
+      logical                   :: a_ge_c
+
+
+      a_ge_c = acompare_ca(c,a) /= 'GT'
+
+      end function a_ge_c
+
+!*******************************************************************************
+! character >= array
+
+      pure function c_ge_a(c,a)
+
+      implicit none
+      character(*), intent(in)  :: c
+      character, intent(in)     :: a(:)
+      logical                   :: c_ge_a
+
+
+      c_ge_a = acompare_ca(c,a) /= 'LT'
+
+      end function c_ge_a
+
+!*******************************************************************************
+!     >  operators
+!*******************************************************************************
+! array > array
+
+      pure function a_gt_a(a1,a2)
+
+      implicit none
+      character, intent(in)  :: a1(:),a2(:)
+      logical                :: a_gt_a
+
+
+      a_gt_a = acompare_aa(a1,a2) == 'GT'
+
+      end function a_gt_a
+
+!*******************************************************************************
+! array > character
+
+      pure function a_gt_c(a,c)
+
+      implicit none
+      character, intent(in)     :: a(:)
+      character(*), intent(in)  :: c
+      logical                   :: a_gt_c
+
+
+      a_gt_c = acompare_ca(c,a) == 'LT'
+
+      end function a_gt_c
+
+!*******************************************************************************
+! character > array
+
+      pure function c_gt_a(c,a)
+
+      implicit none
+      character(*), intent(in)  :: c
+      character, intent(in)     :: a(:)
+      logical                   :: c_gt_a
+
+
+      c_gt_a = acompare_ca(c,a) == 'GT'
+
+      end function c_gt_a
+
+!*******************************************************************************
+
+      pure function alcompare_aa(a1,a2) result(caa)
+
+      implicit none
+      character, intent(in)  :: a1(:),a2(:)
+      character(2)           :: caa
+      integer                :: i,l1,l2
+
+
+      l1 = size(a1)
+      l2 = size(a2)
+      do i=1,min(l1,l2)
+          if (llt(a1(i),a2(i))) then
+              caa = 'LT'
+              return
+          elseif (lgt(a1(i),a2(i))) then
+              caa = 'GT'
+              return
+          endif
+      enddo
+      if (l1 < l2) then
+          do i=l1+1,l2
+              if (llt(blank,a2(i))) then
+                  caa = 'LT'
+                  return
+              elseif (lgt(blank,a2(i))) then
+                  caa = 'GT'
+                  return
+              endif
+          enddo
+      elseif (l1 > l2) then
+          do i=l2+1,l1
+              if (llt(a1(i),blank)) then
+                  caa = 'LT'
+                  return
+              elseif (lgt(a1(i),blank)) then
+                  caa = 'GT'
+                  return
+              endif
+          enddo
+      endif
+      caa = 'EQ'
+
+      end function alcompare_aa
+
+!*******************************************************************************
+
+      pure function alcompare_ca(c,a) result(cca)
+
+      implicit none
+      character(*), intent(in)  :: c
+      character, intent(in)     :: a(:)
+      character(2)              :: cca
+      integer                   :: i,lc,la
+
+
+      lc = len(c)
+      la = size(a)
+      do i=1,min(lc,la)
+          if (llt(c(i:i),a(i))) then
+              cca = 'LT'
+              return
+          elseif (lgt(c(i:i),a(i))) then
+              cca = 'GT'
+              return
+          endif
+      enddo
+      if (lc < la) then
+          do i=lc+1,la
+              if (llt(blank,a(i))) then
+                  cca = 'LT'
+                  return
+              elseif (lgt(blank,a(i))) then
+                  cca = 'GT'
+                  return
+              endif
+          enddo
+      elseif (lc > la) then
+          do i=la+1,lc
+              if (llt(c(i:i),blank)) then
+                  cca = 'LT'
+                  return
+              elseif (lgt(c(i:i),blank)) then
+                  cca = 'GT'
+                  return
+              endif
+          enddo
+      endif
+      cca = 'EQ'
+
+      end function alcompare_ca
+
+!*******************************************************************************
+!     LLT operators
+!*******************************************************************************
+! array < array
+
+      pure function a_allt_a(a1,a2)
+
+      implicit none
+      character, intent(in)  :: a1(:),a2(:)
+      logical                :: a_allt_a
+
+
+      a_allt_a = alcompare_aa(a1,a2) == 'LT'
+
+      end function a_allt_a
+
+!*******************************************************************************
+! array < character
+
+      pure function a_allt_c(a1,c2)
+
+      implicit none
+      character, intent(in)     :: a1(:)
+      character(*), intent(in)  :: c2
+      logical                   :: a_allt_c
+
+
+      a_allt_c = alcompare_ca(c2,a1) == 'GT'
+
+      end function a_allt_c
+
+!*******************************************************************************
+! character < array
+
+      pure function c_allt_a(c1,a2)
+
+      implicit none
+      character(*), intent(in)  :: c1
+      character, intent(in)     :: a2(:)
+      logical                   :: c_allt_a
+
+
+      c_allt_a = alcompare_ca(c1,a2) == 'LT'
+
+      end function c_allt_a
+
+!*******************************************************************************
+!     LLE  operators
+!*******************************************************************************
+! array <= array
+
+      pure function a_alle_a(a1,a2)
+
+      implicit none
+      character, intent(in)  :: a1(:),a2(:)
+      logical                :: a_alle_a
+
+
+      a_alle_a = alcompare_aa(a1,a2) /= 'GT'
+
+      end function a_alle_a
+
+!*******************************************************************************
+! array <= character
+
+      pure function a_alle_c(a1,c2)
+
+      implicit none
+      character, intent(in)     :: a1(:)
+      character(*), intent(in)  :: c2
+      logical                   :: a_alle_c
+
+
+      a_alle_c = alcompare_ca(c2,a1) /= 'LT'
+
+      end function a_alle_c
+
+!*******************************************************************************
+! character <= array
+
+      pure function c_alle_a(c1,a2)
+
+      implicit none
+      character(*), intent(in)  :: c1
+      character, intent(in)     :: a2(:)
+      logical                   :: c_alle_a
+
+
+      c_alle_a = alcompare_ca(c1,a2) /= 'GT'
+
+      end function c_alle_a
+
+!*******************************************************************************
+!     LGE  operators
+!*******************************************************************************
+! array >= array
+
+      pure function a_alge_a(a1,a2)
+
+      implicit none
+      character, intent(in)  :: a1(:),a2(:)
+      logical                :: a_alge_a
+
+
+      a_alge_a = alcompare_aa(a1,a2) /= 'LT'
+
+      end function a_alge_a
+
+!*******************************************************************************
+! array >= character
+
+      pure function a_alge_c(a1,c2)
+
+      implicit none
+      character, intent(in)     :: a1(:)
+      character(*), intent(in)  :: c2
+      logical                   :: a_alge_c
+
+
+      a_alge_c = alcompare_ca(c2,a1) /= 'GT'
+
+      end function a_alge_c
+
+!*******************************************************************************
+! character >= array
+
+      pure function c_alge_a(c1,a2)
+
+      implicit none
+      character(*), intent(in)  :: c1
+      character, intent(in)     :: a2(:)
+      logical                   :: c_alge_a
+
+
+      c_alge_a = alcompare_ca(c1,a2) /= 'LT'
+
+      end function c_alge_a
+
+!*******************************************************************************
+!     LGT  operators
+!*******************************************************************************
+! array > array
+
+      pure function a_algt_a(a1,a2)
+
+      implicit none
+      character, intent(in)  :: a1(:),a2(:)
+      logical                :: a_algt_a
+
+
+      a_algt_a = alcompare_aa(a1,a2) == 'GT'
+
+      end function a_algt_a
+
+!*******************************************************************************
+! array > character
+
+      pure function a_algt_c(a1,c2)
+
+      implicit none
+      character, intent(in)     :: a1(:)
+      character(*), intent(in)  :: c2
+      logical                   :: a_algt_c
+
+
+      a_algt_c = alcompare_ca(c2,a1) == 'LT'
+
+      end function a_algt_c
+
+!*******************************************************************************
+! character > array
+
+      pure function c_algt_a(c1,a2)
+
+      implicit none
+      character(*), intent(in)  :: c1
+      character, intent(in)     :: a2(:)
+      logical                   :: c_algt_a
+
+
+      c_algt_a = alcompare_ca(c1,a2) == 'GT'
+
+      end function c_algt_a
+
+!*******************************************************************************
+!     INDEX
+!*******************************************************************************
+
+      elemental function index_ss(s,sub,back)
+
+      implicit none
+      type(string), intent(in)       :: s,sub
+      logical, intent(in), optional  :: back
+      integer                        :: index_ss
+      logical                        :: dir_switch
+      integer                        :: ls,lsub
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = len(s)
+      lsub = len(sub)
+      index_ss = aindex(s%chars(:ls),sub%chars(:lsub),dir_switch)
+
+      end function index_ss
+
+!*******************************************************************************
+
+      elemental function index_sc(s,sub,back)
+
+      implicit none
+      type(string), intent(in)       :: s
+      character(*), intent(in)       :: sub
+      logical, intent(in), optional  :: back
+      integer                        :: index_sc
+      logical                        :: dir_switch
+      integer                        :: ls
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = len(s)
+      index_sc = aindex(s%chars(:ls),sub,dir_switch)
+
+      end function index_sc
+
+!*******************************************************************************
+
+      elemental function index_cs(s,sub,back)
+
+      implicit none
+      character(*), intent(in)       :: s
+      type(string), intent(in)       :: sub
+      logical, intent(in), optional  :: back
+      integer                        :: index_cs
+      logical                        :: dir_switch
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      index_cs = index(s,char(sub),dir_switch)
+
+      end function index_cs
+
+!*******************************************************************************
+!     AINDEX
+!*******************************************************************************
+
+      pure function aindex_aa(s,sub,back) result(index_aa)
+
+      implicit none
+      character, intent(in)          :: s(:),sub(:)
+      logical, intent(in), optional  :: back
+      integer                        :: index_aa
+      logical                        :: dir_switch
+      integer                        :: i,ls,lss
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = size(s)
+      lss = size(sub)
+
+      if (lss == 0) then
+          if (dir_switch) then
+              index_aa = ls + 1
+          else
+              index_aa = 1
+          endif
+          return
+      endif
+
+      if (dir_switch) then
+!         backwards search
+          do i=ls-lss+1,1,-1
+              if (all(s(i:i+lss-1) == sub(1:lss))) then
+                  index_aa = i
+                  return
+              endif
+          enddo
+          index_aa = 0
+      else
+!         forward search
+          do i=1,ls-lss+1
+              if (all(s(i:i+lss-1) == sub(1:lss))) then
+                  index_aa = i
+                  return
+              endif
+          enddo
+          index_aa = 0
+      endif
+
+      end function aindex_aa
+
+!*******************************************************************************
+
+      pure function aindex_ac(s,sub,back) result(index_ac)
+
+      implicit none
+      character, intent(in)          :: s(:)
+      character(*), intent(in)       :: sub
+      logical, intent(in), optional  :: back
+      integer                        :: index_ac
+      logical                        :: dir_switch,matched
+      integer                        :: i,j,ls,lss
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = size(s)
+      lss = len(sub)
+
+      if (lss == 0) then
+          if (dir_switch) then
+              index_ac = ls + 1
+          else
+              index_ac = 1
+          endif
+          return
+      endif
+
+      if (dir_switch) then
+          index_ac = 0
+          do i=ls-lss+1,1,-1
+              matched = all(s(i:i+lss-1) == (/ (sub(j:j), j=1,lss) /))
+              if (matched) then
+                  index_ac = i
+                  return
+              endif
+          enddo
+      else
+          index_ac = 0
+          do i=1,ls-lss+1
+              matched = all(s(i:i+lss-1) == (/ (sub(j:j), j=1,lss) /))
+              if (matched) then
+                  index_ac = i
+                  return
+              endif
+          enddo
+      endif
+
+      end function aindex_ac
+
+!*******************************************************************************
+
+      pure function aindex_ca(s,sub,back) result(index_ca)
+
+      implicit none
+      character(*), intent(in)       :: s
+      character, intent(in)          :: sub(:)
+      logical, intent(in), optional  :: back
+      integer                        :: index_ca
+      logical                        :: dir_switch,matched
+      integer                        :: i,j,ls,lss
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = len(s)
+      lss = size(sub)
+
+      if (lss == 0) then
+          if (dir_switch) then
+              index_ca = ls + 1
+          else
+              index_ca = 1
+          endif
+          return
+      endif
+
+      if (dir_switch) then
+          do i=ls-lss+1,1,-1
+              matched = .true.
+              do j=1,lss
+                  if (s(i+j-1:i+j-1) /= sub(j)) then
+                      matched = .false.
+                      exit
+                  endif
+              enddo
+              if (matched) then
+                  index_ca = i
+                  return
+              endif
+          enddo
+          index_ca = 0
+      else
+          do i=1,ls-lss+1
+              matched = .true.
+              do j=1,lss
+                  if (s(i+j-1:i+j-1) /= sub(j)) then
+                      matched = .false.
+                      exit
+                  endif
+              enddo
+              if (matched) then
+                  index_ca = i
+                  return
+              endif
+          enddo
+          index_ca = 0
+      endif
+
+      end function aindex_ca
+
+!*******************************************************************************
+!     SCAN
+!*******************************************************************************
+
+      elemental function scan_ss(s,set,back)
+
+      implicit none
+      type(string), intent(in)       :: s,set
+      logical, intent(in), optional  :: back
+      integer                        :: scan_ss
+      logical                        :: dir_switch
+      integer                        :: ls,lset
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = len(s)
+      lset = len(set)
+      scan_ss = ascan_aa(s%chars(1:ls),set%chars(1:lset),dir_switch)
+
+      end function scan_ss
+
+!*******************************************************************************
+
+      elemental function scan_sc(s,set,back)
+
+      implicit none
+      type(string), intent(in)       :: s
+      character(*), intent(in)       :: set
+      logical, intent(in), optional  :: back
+      integer                        :: scan_sc
+      logical                        :: dir_switch
+      integer                        :: ls
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = len(s)
+      scan_sc = ascan_ac(s%chars(1:ls),set,dir_switch)
+
+      end function scan_sc
+
+!*******************************************************************************
+
+      elemental function scan_cs(s,set,back)
+
+      implicit none
+      character(*), intent(in)       :: s
+      type(string), intent(in)       :: set
+      logical, intent(in), optional  :: back
+      integer                        :: scan_cs
+      logical                        :: dir_switch
+      integer                        :: lset
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      lset = len(set)
+      scan_cs = ascan_ca(s,set%chars(1:lset),dir_switch)
+
+      end function scan_cs
+!*******************************************************************************
+!     ASCAN
+!*******************************************************************************
+
+      pure function ascan_aa(s,set,back)
+
+      implicit none
+      character, intent(in)          :: s(:),set(:)
+      logical, intent(in), optional  :: back
+      integer                        :: ascan_aa
+      logical                        :: dir_switch
+      integer                        :: i,ls,lset
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = size(s)
+      lset = size(set)
+      if (dir_switch) then
+!         backwards search
+          do i=ls,1,-1
+              if (any(set(1:lset) == s(i))) then
+                  ascan_aa = i
+                  return
+              endif
+          enddo
+          ascan_aa = 0
+      else
+!         forward search
+          do i=1,ls
+              if (any(set(1:lset) == s(i))) then
+                  ascan_aa = i
+                  return
+              endif
+          enddo
+          ascan_aa = 0
+      endif
+
+      end function ascan_aa
+
+!*******************************************************************************
+
+      pure function ascan_ac(s,set,back)
+
+      implicit none
+      character, intent(in)          :: s(:)
+      character(*), intent(in)       :: set
+      logical, intent(in), optional  :: back
+      integer                        :: ascan_ac
+      logical                        :: dir_switch,matched
+      integer                        :: i,j,ls,lset
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = size(s)
+      lset = len(set)
+      if (dir_switch) then
+!         backwards search
+          do i=ls,1,-1
+              matched = .false.
+              do j=1,lset
+                  if (s(i) == set(j:j)) then
+                      matched = .true.
+                      exit
+                  endif
+              enddo
+              if (matched) then
+                  ascan_ac = i
+                  return
+              endif
+          enddo
+          ascan_ac = 0
+      else
+!         forward search
+          do i=1,ls
+              matched = .false.
+              do j=1,lset
+                  if (s(i) == set(j:j)) then
+                      matched = .true.
+                      exit
+                  endif
+              enddo
+              if (matched) then
+                  ascan_ac = i
+                  return
+              endif
+          enddo
+          ascan_ac = 0
+      endif
+
+      end function ascan_ac
+
+!*******************************************************************************
+
+      pure function ascan_ca(s,set,back)
+
+      implicit none
+      character(*), intent(in)       :: s
+      character, intent(in)          :: set(:)
+      logical, intent(in), optional  :: back
+      integer                        :: ascan_ca
+      logical                        :: dir_switch,matched
+      integer                        :: i,j,ls,lset
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = len(s)
+      lset = size(set)
+      if (dir_switch) then
+!         backwards search
+          do i=ls,1,-1
+              matched = .false.
+              do j=1,lset
+                  if (s(i:i) == set(j)) then
+                      matched = .true.
+                      exit
+                  endif
+              enddo
+              if (matched) then
+                  ascan_ca = i
+                  return
+              endif
+          enddo
+          ascan_ca = 0
+      else
+!         forward search
+          do i=1,ls
+              matched = .false.
+              do j=1,lset
+                  if (s(i:i) == set(j)) then
+                      matched = .true.
+                      exit
+                  endif
+              enddo
+              if (matched) then
+                  ascan_ca = i
+                  return
+              endif
+          enddo
+          ascan_ca = 0
+      endif
+
+      end function ascan_ca
+
+!*******************************************************************************
+!     VERIFY
+!*******************************************************************************
+
+      elemental function verify_ss(s,set,back)
+
+      implicit none
+      type(string), intent(in)       :: s,set
+      logical, intent(in), optional  :: back
+      integer                        :: verify_ss
+      logical                        :: dir_switch
+      integer                        :: ls,lset
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = len(s)
+      lset = len(set)
+      verify_ss = averify_aa(s%chars(1:ls),set%chars(1:lset),dir_switch)
+
+      end function verify_ss
+
+!*******************************************************************************
+
+      elemental function verify_sc(s,set,back)
+
+      implicit none
+      type(string), intent(in)       :: s
+      character(*), intent(in)       :: set
+      logical, intent(in), optional  :: back
+      integer                        :: verify_sc
+      logical                        :: dir_switch
+      integer                        :: ls
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = len(s)
+      verify_sc = averify_ac(s%chars(1:ls),set,dir_switch)
+
+      end function verify_sc
+
+!*******************************************************************************
+
+      elemental function verify_cs(s,set,back)
+
+      implicit none
+      character(*), intent(in)       :: s
+      type(string), intent(in)       :: set
+      logical, intent(in), optional  :: back
+      integer                        :: verify_cs
+      logical                        :: dir_switch
+      integer                        :: lset
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      lset = len(set)
+      verify_cs = averify_ca(s,set%chars(1:lset),dir_switch)
+
+      end function verify_cs
+
+!*******************************************************************************
+!     AVERIFY
+!*******************************************************************************
+
+      pure function averify_aa(s,set,back)
+
+      implicit none
+      character, intent(in)          :: s(:),set(:)
+      logical, intent(in), optional  :: back
+      integer                        :: averify_aa
+      logical                        :: dir_switch
+      integer                        :: i,ls,lset
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = size(s)
+      lset = size(set)
+      if (dir_switch) then
+!         backwards search
+          do i=ls,1,-1
+              if (.not.(any(set(1:lset) == s(i)))) then
+                  averify_aa = i
+                  return
+              endif
+          enddo
+          averify_aa = 0
+      else
+!         forward search
+          do i=1,ls
+              if (.not.(any(set(1:lset) == s(i)))) then
+                  averify_aa = i
+                  return
+              endif
+          enddo
+          averify_aa = 0
+      endif
+
+      end function averify_aa
+
+!*******************************************************************************
+
+      pure function averify_ac(s,set,back)
+
+      implicit none
+      character, intent(in)          :: s(:)
+      character(*), intent(in)       :: set
+      logical, intent(in), optional  :: back
+      integer                        :: averify_ac
+      logical                        :: dir_switch
+      integer                        :: i,j,ls,lset
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = size(s)
+      lset = len(set)
+      if (dir_switch) then
+!         backwards search
+b:        do i=ls,1,-1
+              do j=1,lset
+                  if (s(i) == set(j:j)) cycle b
+              enddo
+              averify_ac = i
+              return
+          enddo b
+          averify_ac = 0
+      else
+!         forward search
+f:        do i=1,ls
+              do j=1,lset
+                  if (s(i) == set(j:j)) cycle f
+              enddo
+              averify_ac = i
+              return
+          enddo f
+          averify_ac = 0
+      endif
+
+      end function averify_ac
+
+!*******************************************************************************
+
+      pure function averify_ca(s,set,back)
+
+      implicit none
+      character(*), intent(in)       :: s
+      character, intent(in)          :: set(:)
+      logical, intent(in), optional  :: back
+      integer                        :: averify_ca
+      logical                        :: dir_switch
+      integer                        :: i,j,ls,lset
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = len(s)
+      lset = size(set)
+      if (dir_switch) then
+!         backwards search
+b:        do i=ls,1,-1
+              do j=1,lset
+                  if (s(i:i) == set(j)) cycle b
+              enddo
+              averify_ca = i
+              return
+          enddo b
+          averify_ca = 0
+      else
+!         forward search
+f:        do i=1,ls
+              do j=1,lset
+                  if (s(i:i) == set(j)) cycle f
+              enddo
+              averify_ca = i
+              return
+          enddo f
+          averify_ca = 0
+      endif
+
+      end function averify_ca
+
+!*******************************************************************************
+!     UPPERCASE
+!*******************************************************************************
+
+      pure function uppercase_s(s,begin,end)
+
+      implicit none
+      type(string), intent(in)       :: s
+      integer, intent(in), optional  :: begin,end
+      character(len(s))              :: uppercase_s
+      integer                        :: i,i1,i2,j
+
+
+      i1 = 1
+      if (present(begin)) i1 = max(i1,begin)
+      i2 = len(s)
+      if (present(end)) i2 = min(i2,end)
+
+      do i=1,i1-1
+          uppercase_s(i:i) = s%chars(i)
+      enddo
+      do i=i1,i2
+          j = iachar(s%chars(i))
+          select case(j)
+          case(97:122)
+              uppercase_s(i:i) = achar(j-32)
+          case default
+              uppercase_s(1:i) = s%chars(i)
+          end select
+      enddo
+      do i=i2+1,len(s)
+          uppercase_s(i:i) = s%chars(i)
+      enddo
+
+      end function uppercase_s
+
+!*******************************************************************************
+
+      pure function uppercase_c(c,begin,end)
+
+      implicit none
+      character(*), intent(in)       :: c
+      integer, intent(in), optional  :: begin,end
+      character(len(c))              :: uppercase_c
+      integer                        :: i,i1,i2,j
+
+
+      i1 = 1
+      if (present(begin)) i1 = max(i1,begin)
+      i2 = len(c)
+      if (present(end)) i2 = min(i2,end)
+
+      uppercase_c(:i1-1) = c(:i1-1)
+      do i=i1,i2
+          j = iachar(c(i:i))
+          select case(j)
+          case(97:122)
+              uppercase_c(i:i) = achar(j-32)
+          case default
+              uppercase_c(i:i) = c(i:i)
+          end select
+      enddo
+      uppercase_c(i2+1:) = c(i2+1:)
+
+      end function uppercase_c
+
+!*******************************************************************************
+
+      elemental subroutine to_uppercase_s(s,begin,end)
+
+      implicit none
+      type(string), intent(inout)    :: s
+      integer, intent(in), optional  :: begin,end
+      integer                        :: i,i1,i2,j
+
+
+      i1 = 1
+      if (present(begin)) i1 = max(i1,begin)
+      i2 = len(s)
+      if (present(end)) i2 = min(i2,end)
+
+      do i=i1,i2
+          j = iachar(s%chars(i))
+          select case(j)
+          case(97:122)
+              s%chars(i) = achar(j-32)
+          case default
+              continue
+          end select
+      enddo
+
+      end subroutine to_uppercase_s
+
+!*******************************************************************************
+
+      elemental subroutine to_uppercase_c(c,begin,end)
+
+      implicit none
+      character(*), intent(inout)    :: c
+      integer, intent(in), optional  :: begin,end
+      integer                        :: i,i1,i2,j
+
+
+      i1 = 1
+      if (present(begin)) i1 = max(i1,begin)
+      i2 = len(c)
+      if (present(end)) i2 = min(i2,end)
+
+      do i=i1,i2
+          j = iachar(c(i:i))
+          select case(j)
+          case(97:122)
+              c(i:i) = achar(j-32)
+          case default
+              continue
+          end select
+      enddo
+
+      end subroutine to_uppercase_c
+
+!*******************************************************************************
+!     LOWERCASE
+!*******************************************************************************
+
+      pure function lowercase_s(s,begin,end)
+
+      implicit none
+      type(string), intent(in)       :: s
+      integer, intent(in), optional  :: begin,end
+      character(len(s))              :: lowercase_s
+      integer                        :: i,i1,i2,j
+
+
+      i1 = 1
+      if (present(begin)) i1 = max(i1,begin)
+      i2 = len(s)
+      if (present(end)) i2 = min(i2,end)
+
+      do i=1,i1-1
+          lowercase_s(i:i) = s%chars(i)
+      enddo
+      do i=i1,i2
+          j = iachar(s%chars(i))
+          select case(j)
+          case(65:90)
+              lowercase_s(i:i) = achar(j+32)
+          case default
+              lowercase_s(i:i) = s%chars(i)
+          end select
+      enddo
+      do i=i2+1,len(s)
+          lowercase_s(i:i) = s%chars(i)
+      enddo
+
+      end function lowercase_s
+
+!*******************************************************************************
+
+      pure function lowercase_c(c,begin,end)
+
+      implicit none
+      character(*), intent(in)       :: c
+      integer, intent(in), optional  :: begin,end
+      character(len(c))              :: lowercase_c
+      integer                        :: i,i1,i2,j
+
+
+      i1 = 1
+      if (present(begin)) i1 = max(i1,begin)
+      i2 = len(c)
+      if (present(end)) i2 = min(i2,end)
+
+      lowercase_c(:i1-1) = c(:i1-1)
+      do i=i1,i2
+          j = iachar(c(i:i))
+          select case(j)
+          case(65:90)
+              lowercase_c(i:i) = achar(j+32)
+          case default
+              lowercase_c(i:i) = c(i:i)
+          end select
+      enddo
+      lowercase_c(i2+1:) = c(i2+1:)
+
+      end function lowercase_c
+
+!*******************************************************************************
+
+      elemental subroutine to_lowercase_s(s,begin,end)
+
+      implicit none
+      type(string), intent(inout)    :: s
+      integer, intent(in), optional  :: begin,end
+      integer                        :: i,i1,i2,j
+
+
+      i1 = 1
+      if (present(begin)) i1 = max(i1,begin)
+      i2 = len(s)
+      if (present(end)) i2 = min(i2,end)
+
+      do i=i1,i2
+          j = iachar(s%chars(i))
+          select case(j)
+          case(65:90)
+              s%chars(i) = achar(j+32)
+          case default
+              continue
+          end select
+      enddo
+
+      end subroutine to_lowercase_s
+
+!*******************************************************************************
+
+      elemental subroutine to_lowercase_c(c,begin,end)
+
+      implicit none
+      character(*), intent(inout)    :: c
+      integer, intent(in), optional  :: begin,end
+      integer                        :: i,i1,i2,j
+
+
+      i1 = 1
+      if (present(begin)) i1 = max(i1,begin)
+      i2 = len(c)
+      if (present(end)) i2 = min(i2,end)
+
+      do i=i1,i2
+          j = iachar(c(i:i))
+          select case(j)
+          case(65:90)
+              c(i:i) = achar(j+32)
+          case default
+              continue
+          end select
+      enddo
+
+      end subroutine to_lowercase_c
+
+!*******************************************************************************
+
+!*******************************************************************************
+
+      end module m_strings
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/wxml/flib_wxml.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/wxml/flib_wxml.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/wxml/flib_wxml.f90	(revision 2528)
@@ -0,0 +1,11 @@
+module flib_wxml
+
+!use m_wxml_buffer
+!use m_wxml_dictionary
+!use m_wxml_elstack
+use m_wxml_text
+use m_wxml_core
+
+public
+
+end module flib_wxml
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/wxml/m_wxml_buffer.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/wxml/m_wxml_buffer.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/wxml/m_wxml_buffer.f90	(revision 2528)
@@ -0,0 +1,176 @@
+module m_wxml_buffer
+
+!
+! At this point we use a fixed-size buffer. 
+! Note however that buffer overflows will only be
+! triggered by overly long *unbroken* pcdata values, or
+! by overly long attribute values. Hopefully
+! element or attribute names are "short enough".
+! There is code in the parser module  m_fsm to avoid buffer overflows
+! caused by pcdata values.
+!
+! This module is re-used from the parser package.
+! Most of the routines are superfluous at this point.
+!
+! In a forthcoming implementation it could be made dynamical...
+!
+integer, parameter, public   :: MAX_BUFF_SIZE  = 2000
+integer, parameter, private  :: BUFF_SIZE_WARNING  = 1750
+!
+type, public  :: buffer_t
+private
+      integer                       :: size
+      character(len=MAX_BUFF_SIZE)  :: str
+end type buffer_t
+
+public :: add_to_buffer
+public :: print_buffer, str, char, len
+public :: operator (.equal.)
+public :: buffer_nearly_full, reset_buffer
+
+
+!----------------------------------------------------------------
+interface add_to_buffer
+      module procedure add_str_to_buffer
+end interface
+private :: add_char_to_buffer, add_str_to_buffer
+
+interface operator (.equal.)
+      module procedure compare_buffers, compare_buffer_str, &
+             compare_str_buffer
+end interface
+private :: compare_buffers, compare_buffer_str, compare_str_buffer
+
+interface str
+      module procedure buffer_to_str
+end interface
+interface char                 ! Experimental
+      module procedure buffer_to_str
+end interface
+private :: buffer_to_str
+
+interface len
+   module procedure buffer_length
+end interface
+private :: buffer_length
+
+CONTAINS
+!==================================================================
+
+!----------------------------------------------------------------
+function compare_buffers(a,b) result(equal)     ! .equal. generic
+type(buffer_t), intent(in)  :: a
+type(buffer_t), intent(in)  :: b
+logical                     :: equal
+
+equal = ((a%size == b%size) .and. (a%str(1:a%size) == b%str(1:b%size)))
+
+end function compare_buffers
+
+!----------------------------------------------------------------
+function compare_buffer_str(buffer,str) result(equal) ! .equal. generic
+type(buffer_t), intent(in)   :: buffer
+character(len=*), intent(in) :: str
+logical                      :: equal
+
+equal = (buffer%str(1:buffer%size) == trim(str))
+
+end function compare_buffer_str
+
+!----------------------------------------------------------------
+function compare_str_buffer(str,buffer) result(equal) ! .equal. generic
+character(len=*), intent(in) :: str
+type(buffer_t), intent(in)   :: buffer
+logical                     :: equal
+
+equal = (buffer%str(1:buffer%size) == trim(str))
+
+end function compare_str_buffer
+
+!----------------------------------------------------------------
+subroutine add_char_to_buffer(c,buffer)
+character(len=1), intent(in)   :: c
+type(buffer_t), intent(inout)  :: buffer
+
+integer   :: n
+buffer%size = buffer%size + 1
+n = buffer%size
+
+if (n> MAX_BUFF_SIZE) then
+  stop "wxml Buffer overflow: long unbroken string of pcdata or attribute value..."
+!  RETURN
+!
+endif
+
+buffer%str(n:n) = c
+end subroutine add_char_to_buffer
+
+!----------------------------------------------------------------
+subroutine add_str_to_buffer(s,buffer)
+character(len=*), intent(in)   :: s
+type(buffer_t), intent(inout)  :: buffer
+
+integer   :: n, len_s, last_pos
+
+len_s = len(s)
+last_pos = buffer%size
+buffer%size = buffer%size + len_s
+n = buffer%size
+
+if (n> MAX_BUFF_SIZE) then
+  stop "wxml Buffer overflow: long unbroken string of pcdata or attribute value..."
+!  RETURN
+endif
+
+buffer%str(last_pos+1:n) = s
+end subroutine add_str_to_buffer
+
+!----------------------------------------------------------------
+subroutine reset_buffer(buffer)
+type(buffer_t), intent(inout)  :: buffer
+
+buffer%size = 0
+
+end subroutine reset_buffer
+
+!----------------------------------------------------------------
+subroutine print_buffer(buffer)
+type(buffer_t), intent(in)  :: buffer
+
+integer :: i
+
+do i = 1, buffer%size
+      write(unit=6,fmt="(a1)",advance="no") buffer%str(i:i)
+enddo
+
+end subroutine print_buffer
+!----------------------------------------------------------------
+! This is better... but could it lead to memory leaks?
+!
+function buffer_to_str(buffer) result(str)
+type(buffer_t), intent(in)          :: buffer
+character(len=buffer%size)          :: str
+
+str = buffer%str(1:buffer%size)
+end function buffer_to_str
+
+!----------------------------------------------------------------
+function buffer_nearly_full(buffer) result(warn)
+type(buffer_t), intent(in)          :: buffer
+logical                             :: warn
+
+warn = buffer%size > BUFF_SIZE_WARNING
+
+end function buffer_nearly_full
+
+!----------------------------------------------------------------
+function buffer_length(buffer) result(length)
+type(buffer_t), intent(in)          :: buffer
+integer                             :: length
+
+length = buffer%size 
+
+end function buffer_length
+
+
+end module m_wxml_buffer
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/wxml/m_wxml_core.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/wxml/m_wxml_core.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/wxml/m_wxml_core.f90	(revision 2528)
@@ -0,0 +1,380 @@
+module m_wxml_core
+
+use m_wxml_buffer
+use m_wxml_elstack
+use m_wxml_dictionary
+
+logical, private, save  :: pcdata_advance_line_default = .false.
+logical, private, save  :: pcdata_advance_space_default = .false.
+
+integer, private, parameter ::  sp = selected_real_kind(6,30)
+integer, private, parameter ::  dp = selected_real_kind(14,100)
+
+private
+
+type, public :: xmlf_t
+   integer            :: lun
+   type(buffer_t)     :: buffer
+   type(elstack_t)    :: stack
+   type(wxml_dictionary_t) :: dict
+   logical            :: start_tag_closed
+   logical            :: root_element_output
+   logical            :: indenting_requested
+end type xmlf_t
+
+public :: xml_OpenFile, xml_NewElement, xml_EndElement, xml_Close
+public :: xml_AddPcdata, xml_AddAttribute, xml_AddXMLDeclaration
+public :: xml_AddComment, xml_AddCdataSection
+
+public :: xml_AddArray
+interface xml_AddArray
+   module procedure  xml_AddArray_integer,  &
+                xml_AddArray_real_dp, xml_AddArray_real_sp
+end interface
+private :: xml_AddArray_integer,  xml_AddArray_real_dp, xml_AddArray_real_sp
+
+private :: get_unit
+private :: add_eol
+private :: write_attributes
+
+
+integer, private, parameter  :: COLUMNS = 80
+
+CONTAINS
+
+!-------------------------------------------------------------------
+subroutine xml_OpenFile(filename, xf, indent)
+character(len=*), intent(in)  :: filename
+type(xmlf_t), intent(inout)   :: xf
+logical, intent(in), optional :: indent
+
+integer :: iostat
+
+call get_unit(xf%lun,iostat)
+if (iostat /= 0) stop "cannot open file"
+open(unit=xf%lun, file=filename, form="formatted", status="replace", &
+     action="write", position="rewind") ! , recl=65536)
+
+call reset_elstack(xf%stack)
+call reset_dict(xf%dict)
+call reset_buffer(xf%buffer)
+
+xf%start_tag_closed = .true.
+xf%root_element_output = .false.
+
+xf%indenting_requested = .false.
+if (present(indent)) then
+   xf%indenting_requested = indent
+endif
+end subroutine xml_OpenFile
+
+!-------------------------------------------------------------------
+subroutine xml_AddXMLDeclaration(xf,encoding)
+type(xmlf_t), intent(inout)   :: xf
+character(len=*), intent(in), optional :: encoding
+
+if (present(encoding)) then
+   call add_to_buffer("<?xml version=""1.0"" encoding=""" &
+                     // trim(encoding) // """ ?>", xf%buffer)
+else
+   call add_to_buffer("<?xml version=""1.0"" ?>", xf%buffer)
+endif
+end subroutine xml_AddXMLDeclaration
+
+!-------------------------------------------------------------------
+subroutine xml_AddComment(xf,comment)
+type(xmlf_t), intent(inout)   :: xf
+character(len=*), intent(in)  :: comment
+
+call close_start_tag(xf,">")
+call add_eol(xf)
+call add_to_buffer("<!--", xf%buffer)
+call add_to_buffer(comment, xf%buffer)
+call add_to_buffer("-->", xf%buffer)
+end subroutine xml_AddComment
+
+!-------------------------------------------------------------------
+subroutine xml_AddCdataSection(xf,cdata)
+type(xmlf_t), intent(inout)   :: xf
+character(len=*), intent(in)  :: cdata
+
+call close_start_tag(xf,">")
+call add_to_buffer("<![CDATA[", xf%buffer)
+call add_to_buffer(cdata, xf%buffer)
+call add_to_buffer("]]>", xf%buffer)
+end subroutine xml_AddCdataSection
+
+!-------------------------------------------------------------------
+subroutine xml_NewElement(xf,name)
+type(xmlf_t), intent(inout)   :: xf
+character(len=*), intent(in)  :: name
+
+if (is_empty(xf%stack)) then
+   if (xf%root_element_output) stop "two root elements"
+   xf%root_element_output = .true.
+endif
+
+call close_start_tag(xf,">")
+call push_elstack(name,xf%stack)
+call add_eol(xf)
+call add_to_buffer("<" // trim(name),xf%buffer)
+xf%start_tag_closed = .false.
+call reset_dict(xf%dict)
+
+end subroutine xml_NewElement
+!-------------------------------------------------------------------
+subroutine xml_AddPcdata(xf,pcdata,space,line_feed)
+type(xmlf_t), intent(inout)   :: xf
+character(len=*), intent(in)  :: pcdata
+logical, intent(in), optional  :: space
+logical, intent(in), optional  :: line_feed
+
+logical :: advance_line , advance_space
+integer :: n, i, jmax
+integer, parameter   :: chunk_size = 128
+
+advance_line = pcdata_advance_line_default 
+if (present(line_feed)) then
+   advance_line = line_feed
+endif
+
+advance_space = pcdata_advance_space_default 
+if (present(space)) then
+   advance_space = space
+endif
+
+if (is_empty(xf%stack)) then
+   stop "pcdata outside element content"
+endif
+
+call close_start_tag(xf,">")
+
+if (advance_line) then
+   call add_eol(xf)
+   advance_space = .false.
+else
+   if (xf%indenting_requested) then
+      if ((len(xf%buffer) + len_trim(pcdata) + 1) > COLUMNS ) then
+         call add_eol(xf)
+         advance_space = .false.
+      endif
+   endif
+endif
+if (advance_space) call add_to_buffer(" ",xf%buffer)
+if (len(xf%buffer) > 0) call dump_buffer(xf,lf=.false.)
+!
+! We bypass the buffer for the bulk of the dump
+!
+n = len(pcdata)
+!print *, "writing pcdata of length: ", n
+i = 1
+do
+   jmax = min(i+chunk_size-1,n)
+!   print *, "writing chunk: ", i, jmax
+   write(unit=xf%lun,fmt="(a)",advance="no") pcdata(i:jmax)
+   if (jmax == n) exit
+   i = jmax + 1
+enddo
+end subroutine xml_AddPcdata
+
+!-------------------------------------------------------------------
+subroutine xml_AddAttribute(xf,name,value)
+type(xmlf_t), intent(inout)   :: xf
+character(len=*), intent(in)  :: name
+character(len=*), intent(in)  :: value
+
+if (is_empty(xf%stack)) then
+   stop "attributes outside element content"
+endif
+
+if (xf%start_tag_closed)  then
+   stop "attributes outside start tag"
+endif
+if (has_key(xf%dict,name)) then
+   stop "duplicate att name"
+endif
+
+call add_key_to_dict(trim(name),xf%dict)
+call add_value_to_dict(trim(value),xf%dict)
+
+end subroutine xml_AddAttribute
+
+!-----------------------------------------------------------
+subroutine xml_EndElement(xf,name)
+type(xmlf_t), intent(inout)   :: xf
+character(len=*), intent(in)  :: name
+
+character(len=100)  :: current
+
+if (is_empty(xf%stack)) then
+   stop "Out of elements to close"
+endif
+
+call get_top_elstack(xf%stack,current)
+if (current /= name) then
+   print *, "current, name: ", trim(current), " ", trim(name)
+   stop
+endif
+if (.not. xf%start_tag_closed)  then                ! Empty element
+   if (len(xf%dict) > 0) call write_attributes(xf)
+   call add_to_buffer(" />",xf%buffer)
+   xf%start_tag_closed = .true.
+else
+   call add_eol(xf)
+   call add_to_buffer("</" // trim(name) // ">", xf%buffer)
+endif
+call pop_elstack(xf%stack,current)
+
+end subroutine xml_EndElement
+
+!----------------------------------------------------------------
+
+subroutine xml_Close(xf)
+type(xmlf_t), intent(in)   :: xf
+
+write(unit=xf%lun,fmt="(a)") char(xf%buffer)
+close(unit=xf%lun)
+
+end subroutine xml_Close
+
+!==================================================================
+!-------------------------------------------------------------------
+subroutine get_unit(lun,iostat)
+
+! Get an available Fortran unit number
+
+integer, intent(out)  :: lun
+integer, intent(out)  :: iostat
+
+integer :: i
+logical :: unit_used
+
+do i = 10, 99
+   lun = i
+   inquire(unit=lun,opened=unit_used)
+   if (.not. unit_used) then
+      iostat = 0
+      return
+   endif
+enddo
+iostat = -1
+lun = -1
+end subroutine get_unit
+
+!----------------------------------------------------------
+subroutine add_eol(xf)
+type(xmlf_t), intent(inout)   :: xf
+
+integer :: indent_level
+character(len=100), parameter  ::  blanks =  ""
+
+indent_level = len(xf%stack) - 1
+write(unit=xf%lun,fmt="(a)") char(xf%buffer)
+call reset_buffer(xf%buffer)
+
+if (xf%indenting_requested) &
+   call add_to_buffer(blanks(1:indent_level),xf%buffer)
+
+end subroutine add_eol
+!------------------------------------------------------------
+subroutine dump_buffer(xf,lf)
+type(xmlf_t), intent(inout)   :: xf
+logical, intent(in), optional :: lf
+
+if (present(lf)) then
+   if (lf) then
+      write(unit=xf%lun,fmt="(a)",advance="yes") char(xf%buffer)
+   else
+      write(unit=xf%lun,fmt="(a)",advance="no") char(xf%buffer)
+   endif
+else
+   write(unit=xf%lun,fmt="(a)",advance="no") char(xf%buffer)
+endif
+call reset_buffer(xf%buffer)
+
+end subroutine dump_buffer
+
+!------------------------------------------------------------
+subroutine close_start_tag(xf,s)
+type(xmlf_t), intent(inout)   :: xf
+character(len=*), intent(in)  :: s
+
+if (.not. xf%start_tag_closed)  then
+   if (len(xf%dict) > 0)  call write_attributes(xf)
+   call add_to_buffer(s, xf%buffer)
+   xf%start_tag_closed = .true.
+endif
+
+end subroutine close_start_tag
+
+!-------------------------------------------------------------
+subroutine write_attributes(xf)
+type(xmlf_t), intent(inout)   :: xf
+
+integer  :: i, status, size
+character(len=100)  :: key, value
+
+do i = 1, len(xf%dict)
+   call get_key(xf%dict,i,key,status)
+   call get_value(xf%dict,key,value,status)
+   key = adjustl(key)
+   value = adjustl(value)
+   size = len_trim(key) + len_trim(value) + 4
+   if ((len(xf%buffer) + size) > COLUMNS) call add_eol(xf)
+   call add_to_buffer(" ", xf%buffer)
+   call add_to_buffer(trim(key), xf%buffer)
+   call add_to_buffer("=", xf%buffer)
+   call add_to_buffer("""",xf%buffer)
+   call add_to_buffer(trim(value), xf%buffer)
+   call add_to_buffer("""", xf%buffer)
+enddo
+
+end subroutine write_attributes
+
+!---------------------------------------------------------------
+    subroutine xml_AddArray_integer(xf,a,format)
+      type(xmlf_t), intent(inout)         :: xf
+      integer, intent(in), dimension(:)   :: a
+      character(len=*), intent(in), optional  :: format
+
+      call close_start_tag(xf,">")
+      if (len(xf%buffer) > 0) call dump_buffer(xf,lf=.true.)
+      if (present(format)) then
+         write(xf%lun,format) a
+      else
+         write(xf%lun,"(6(i12))") a
+      endif
+    end subroutine xml_AddArray_integer
+
+!-------------------------------------------------------------------
+    subroutine xml_AddArray_real_dp(xf,a,format)
+      type(xmlf_t), intent(inout)         :: xf
+      real(kind=dp), intent(in), dimension(:)   :: a
+      character(len=*), intent(in), optional  :: format
+
+      call close_start_tag(xf,">")
+      if (len(xf%buffer) > 0) call dump_buffer(xf,lf=.true.)
+      if (present(format)) then
+         write(xf%lun,format) a
+      else
+         write(xf%lun,"(4(es20.12))") a
+      endif
+    end subroutine xml_AddArray_real_dp
+
+!------------------------------------------------------------------
+    subroutine xml_AddArray_real_sp(xf,a,format)
+      type(xmlf_t), intent(inout)         :: xf
+      real(kind=sp), intent(in), dimension(:)   :: a
+      character(len=*), intent(in), optional  :: format
+
+      call close_start_tag(xf,">")
+      if (len(xf%buffer) > 0) call dump_buffer(xf,lf=.true.)
+      if (present(format)) then
+         write(xf%lun,format) a
+      else
+         write(xf%lun,"(4(es20.12))") a
+      endif
+    end subroutine xml_AddArray_real_sp
+
+end module m_wxml_core
+
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/wxml/m_wxml_dictionary.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/wxml/m_wxml_dictionary.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/wxml/m_wxml_dictionary.f90	(revision 2528)
@@ -0,0 +1,162 @@
+module m_wxml_dictionary
+
+private
+!
+! A very rough implementation for now
+! It uses fixed-length buffers for key/value pairs,
+! and the maximum number of dictionary items is hardwired.
+
+integer, parameter, private    :: MAX_ITEMS = 30
+type, public :: wxml_dictionary_t
+private
+      integer                               :: number_of_items ! = 0
+      character(len=100), dimension(MAX_ITEMS)  :: key
+      character(len=100), dimension(MAX_ITEMS)  :: value
+end type wxml_dictionary_t
+
+!
+! Building procedures
+!
+public  :: add_key_to_dict, add_value_to_dict, reset_dict
+
+!
+! Query and extraction procedures
+!
+public  :: len
+interface len
+   module procedure number_of_entries
+end interface
+public  :: number_of_entries
+public  :: get_key
+public  :: get_value
+public  :: has_key
+public  :: print_dict
+!
+interface get_value
+   module procedure wxml_get_value
+end interface
+
+CONTAINS
+
+!------------------------------------------------------
+function number_of_entries(dict) result(n)
+type(wxml_dictionary_t), intent(in)   :: dict
+integer                          :: n
+
+n = dict%number_of_items
+
+end function number_of_entries
+
+!------------------------------------------------------
+function has_key(dict,key) result(found)
+type(wxml_dictionary_t), intent(in)   :: dict
+character(len=*), intent(in)     :: key
+logical                          :: found
+
+integer  :: n, i
+found = .false.
+n = dict%number_of_items
+do  i = 1, n
+      if (dict%key(i) == key) then
+         found = .true.
+         exit
+      endif
+enddo
+end function has_key
+
+!------------------------------------------------------
+subroutine wxml_get_value(dict,key,value,status)
+type(wxml_dictionary_t), intent(in)            :: dict
+character(len=*), intent(in)              :: key
+character(len=*), intent(out)             :: value
+integer, intent(out)                      :: status
+!
+integer  :: n, i
+
+status = -1
+n = dict%number_of_items
+do  i = 1, n
+      if (dict%key(i) == key) then
+         value = dict%value(i)
+         status = 0
+         RETURN
+      endif
+enddo
+
+end subroutine wxml_get_value
+
+!------------------------------------------------------
+subroutine get_key(dict,i,key,status)
+!
+! Get the i'th key
+!
+type(wxml_dictionary_t), intent(in)            :: dict
+integer, intent(in)                       :: i
+character(len=*), intent(out)             :: key
+integer, intent(out)                      :: status
+
+if (i <= dict%number_of_items) then
+      key = dict%key(i)
+      status = 0
+else
+      key = ""
+      status = -1
+endif
+
+end subroutine get_key
+
+!------------------------------------------------------
+subroutine add_key_to_dict(key,dict)
+character(len=*), intent(in)          :: key
+type(wxml_dictionary_t), intent(inout)   :: dict
+
+integer  :: n
+
+n = dict%number_of_items
+if (n == MAX_ITEMS) then
+      write(unit=0,fmt=*) "Dictionary capacity exceeded !"
+      RETURN
+endif
+
+n = n + 1
+dict%key(n) = key
+dict%number_of_items = n
+
+end subroutine add_key_to_dict
+
+!------------------------------------------------------
+! Assumes we build the dictionary in an orderly fashion,
+! so one adds first the key and then immediately afterwards the value.
+!
+subroutine add_value_to_dict(value,dict)
+character(len=*), intent(in)          :: value
+type(wxml_dictionary_t), intent(inout)   :: dict
+
+integer  :: n
+
+n = dict%number_of_items
+dict%value(n) = value
+
+end subroutine add_value_to_dict
+
+!------------------------------------------------------
+subroutine reset_dict(dict)
+type(wxml_dictionary_t), intent(inout)   :: dict
+
+dict%number_of_items = 0
+
+end subroutine reset_dict
+
+!------------------------------------------------------
+subroutine print_dict(dict)
+type(wxml_dictionary_t), intent(in)   :: dict
+
+integer  :: i
+
+do i = 1, dict%number_of_items
+      print *, trim(dict%key(i)), " = ", trim(dict%value(i))
+enddo
+
+end subroutine print_dict
+
+end module m_wxml_dictionary
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/wxml/m_wxml_elstack.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/wxml/m_wxml_elstack.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/wxml/m_wxml_elstack.f90	(revision 2528)
@@ -0,0 +1,143 @@
+module m_wxml_elstack
+
+private
+
+!
+! Simple stack to keep track of which elements have appeared so far
+!
+integer, parameter, private            :: STACK_SIZE = 20
+
+type, public :: elstack_t
+private
+      integer                                    :: n_items
+      character(len=100), dimension(STACK_SIZE)  :: data
+end type elstack_t
+
+public  :: push_elstack, pop_elstack, reset_elstack, print_elstack
+public  :: get_top_elstack, is_empty, get_elstack_signature
+public  :: len
+
+interface len
+   module procedure number_of_items
+end interface
+private :: number_of_items
+
+interface is_empty
+      module procedure is_empty_elstack
+end interface
+private :: is_empty_elstack
+
+CONTAINS
+
+!-----------------------------------------------------------------
+subroutine reset_elstack(elstack)
+type(elstack_t), intent(inout)  :: elstack
+
+elstack%n_items = 0
+
+end subroutine reset_elstack
+
+!-----------------------------------------------------------------
+function is_empty_elstack(elstack) result(answer)
+type(elstack_t), intent(in)  :: elstack
+logical                    :: answer
+
+answer = (elstack%n_items == 0)
+end function is_empty_elstack
+
+!-----------------------------------------------------------------
+function number_of_items(elstack) result(n)
+type(elstack_t), intent(in)  :: elstack
+integer                      :: n
+
+n = elstack%n_items
+end function number_of_items
+
+!-----------------------------------------------------------------
+subroutine push_elstack(item,elstack)
+character(len=*), intent(in)      :: item
+type(elstack_t), intent(inout)  :: elstack
+
+integer   :: n
+
+n = elstack%n_items
+if (n == STACK_SIZE) then
+      stop "*Element stack full"
+endif
+n = n + 1
+elstack%data(n) = item
+elstack%n_items = n
+
+end subroutine push_elstack
+
+!-----------------------------------------------------------------
+subroutine pop_elstack(elstack,item)
+type(elstack_t), intent(inout)     :: elstack
+character(len=*), intent(out)        :: item
+
+!
+! We assume the elstack is not empty... (the user has called is_empty first)
+!
+integer   :: n
+
+n = elstack%n_items
+if (n == 0) then
+      stop "*********Element stack empty"
+endif
+item = elstack%data(n)
+elstack%n_items = n - 1
+
+end subroutine pop_elstack
+
+!-----------------------------------------------------------------
+subroutine get_top_elstack(elstack,item)
+!
+! Get the top element of the stack, *without popping it*.
+!
+type(elstack_t), intent(in)        :: elstack
+character(len=*), intent(out)        :: item
+
+!
+! We assume the elstack is not empty... (the user has called is_empty first)
+!
+integer   :: n
+
+n = elstack%n_items
+if (n == 0) then
+      stop "*********Element stack empty"
+endif
+item = elstack%data(n)
+
+end subroutine get_top_elstack
+
+!-----------------------------------------------------------------
+subroutine print_elstack(elstack,unit)
+type(elstack_t), intent(in)   :: elstack
+integer, intent(in)           :: unit
+integer   :: i
+
+do i = elstack%n_items, 1, -1
+      write(unit=unit,fmt=*) trim(elstack%data(i))
+enddo
+
+end subroutine print_elstack
+
+!-------------------------------------------------------------
+subroutine get_elstack_signature(elstack,string)
+type(elstack_t), intent(in)   :: elstack
+character(len=*), intent(out) :: string
+integer   :: i, length, j
+
+string = ""
+j = 0
+do i = 1, elstack%n_items
+   length = len_trim(elstack%data(i))
+   string(j+1:j+1) = "/"
+   j = j+1
+   string(j+1:j+length) = trim(elstack%data(i))
+   j = j + length
+enddo
+
+end subroutine get_elstack_signature
+
+end module m_wxml_elstack
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/wxml/m_wxml_text.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/wxml/m_wxml_text.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/wxml/m_wxml_text.f90	(revision 2528)
@@ -0,0 +1,73 @@
+module m_wxml_text
+!
+integer, private, parameter ::  sp = selected_real_kind(6,30)
+integer, private, parameter ::  dp = selected_real_kind(14,100)
+!
+! TODO : Add optional format parameter
+!
+private
+
+public :: str
+
+interface str
+   module procedure  str_integer,  str_real_dp, str_real_sp, &
+                     str_logical
+end interface
+private :: str_integer,  str_real_dp, str_real_sp, str_logical
+
+CONTAINS
+
+      function str_integer(int,format) result(s)
+      integer, intent(in)   :: int
+      character(len=*), intent(in), optional  :: format
+      character(len=100)    :: s
+
+      if (present(format)) then
+         write(s,format) int
+      else
+         write(s,"(i25)") int
+      endif
+      s = adjustl(s)
+      end function str_integer
+
+      function str_logical(log,format) result(s)
+      logical, intent(in)   :: log
+      character(len=*), intent(in), optional  :: format
+      character(len=100)    :: s
+
+      if (present(format)) then
+         write(s,format) log
+      else
+         write(s,"(l1)") log
+      endif
+      s = adjustl(s)
+      end function str_logical
+
+      function str_real_dp(x,format) result(s)
+      real(kind=dp), intent(in)   :: x
+      character(len=*), intent(in), optional  :: format
+      character(len=100)    :: s
+
+      if (present(format)) then
+         write(s,format) x
+      else
+         write(s,"(g22.12)") x
+      endif
+      s = adjustl(s)
+      end function str_real_dp
+
+      function str_real_sp(x,format) result(s)
+      real(kind=sp), intent(in)   :: x
+      character(len=*), intent(in), optional  :: format
+      character(len=100)    :: s
+
+      if (present(format)) then
+         write(s,format) x
+      else
+         write(s,"(g22.12)") x
+      endif
+      s = adjustl(s)
+      end function str_real_sp
+
+
+end module m_wxml_text
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/xpath/Ba.xml
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/xpath/Ba.xml	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/xpath/Ba.xml	(revision 2528)
@@ -0,0 +1,34 @@
+<?xml version="1.0"?>
+<atom version="0.1">
+
+  <job type="pseudopotential-generation">
+
+  <!-- Note that this configuration is ionic (+2) -->
+  <title>pg Ba with 5s as semicore, 5p in valence -- soft Vf </title>
+  <symbol>Ba</symbol>
+  <pseudo flavor="tm2" core-corrections="no" />
+  <calculation relativistic="yes" spin-polarized="no" xc="ca" />
+  <configuration ncore="9" nvalence="4" >
+     <shell n="5" l="0" occupation="2.00" rc="1.75" />
+     <shell n="5" l="1" occupation="6.00" rc="2.00" />
+     <shell n="5" l="2" occupation="0.00" rc="2.50" />
+     <shell n="4" l="3" occupation="0.00" rc="2.50" />
+  </configuration>
+  <analysis logder="3.0" />
+
+  </job>
+  <job type="pseudopotential-test">
+
+  <!-- Note that this configuration is ionic (+2) -->
+  <title>test Ba </title>
+  <symbol>Ba</symbol>
+  <calculation relativistic="yes" spin-polarized="no" xc="ca" />
+  <configuration ncore="9" nvalence="4" >
+     <shell n="5" l="0" occupation="2.00"  />
+     <shell n="5" l="1" occupation="5.00"  />
+     <shell n="5" l="2" occupation="1.00"  />
+     <shell n="4" l="3" occupation="0.00"  />
+  </configuration>
+
+  </job>
+</atom>
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/xpath/Developer.Guide
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/xpath/Developer.Guide	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/xpath/Developer.Guide	(revision 2528)
@@ -0,0 +1,63 @@
+Developer Notes for the XPATH-lite API
+
+This API is built on top of the more fundamental SAX one. The basic
+idea is to have a set of programable handlers that communicate among
+themselves and with the parser via module variables.
+
+A new pseudo-handler, "signal_handler", has been added to the optional
+argument list of xml_parse(). In the current implementation it just
+checks whether a stop signal has been raised by the user side of the
+program (for example, after a "begin tag" event, or after going out
+of the scope of a parent element).
+
+Since the SAX parser is stream-oriented, and XPATH searches can be
+done in any order, there are new routines to rewind the XML file and
+to synchronize the physical file reader with a previously saved point
+in the XML tree. 
+
+These tools, and the rather sophisticated path-matching routine
+provided (which allows for wildcards and the "//" construction) would
+be enough for standard use, as implemented in the routine
+"get_node". However, there is also the possibility of performing
+searches constrained to a given ancestor element ("context" searches)
+so that blocks of logically related information can be processed
+together. A context is implicitly created by a call to
+"mark_node". Contexts can be saved and "synched" to, allowing for
+repeated constrained searches (calls with relative paths). Contexts
+can even be passed to subroutines to package the parsing of common
+elements once and for all. (See for example Examples/xpath/pseudo.f90).
+This feature is nevertheless in need of a more rigorous specification:
+
+* What should be the behavior if a "mark_node" is followed by a
+  call to "get_node" with an absolute path?
+* Should there always be an "automatic rewind" to the beginning of the
+  context before any successive calls to "get_node"?
+
+
+LIMITATIONS
+
+The pcdata buffer provided by the user as a character variable could
+overflow.  Note that the parser itself uses a string of length
+MAX_PCDATA_SIZE (currently 65536) as a buffer to hold PCDATA. A
+warning is issued if there is not enough space (in the user or in the
+system buffer) to hold the data.
+
+Support for converting PCDATA characters to numerical arrays "on the
+fly" is planned for a forthcoming version.
+
+
+The coding style is that of the F subset of Fortran90. I strongly
+believe that it makes for better coding and fewer errors.
+Go to http://www.fortran.com/imagine1/ and get a feel for it. You can
+download free implementations for Linux and Windows, or get an
+inexpensive CD+Book combination to help support the project. Of course,
+F *is* Fortran, so you can always compile it with a Fortran compiler.
+
+
+
+
+
+
+
+
+
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/xpath/flib_xpath.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/xpath/flib_xpath.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/xpath/flib_xpath.f90	(revision 2528)
@@ -0,0 +1,12 @@
+module flib_xpath
+
+!
+! Stub module to gather all the XML functionality needed by the user
+! 
+use flib_sax
+use m_path
+
+public
+
+end module flib_xpath
+
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/xpath/m_path.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/xpath/m_path.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/xpath/m_path.f90	(revision 2528)
@@ -0,0 +1,617 @@
+module m_path
+!
+! XPATH-like API for XML Parsing
+! Copyright Alberto Garcia <wdpgaara@lg.ehu.es>, August 2003
+!
+use flib_sax
+
+private
+!
+public :: get_node, mark_node, enable_debug, disable_debug
+
+private :: match, process_node, get_path
+private :: begin_element, end_element, pcdata_handler, empty_element
+private :: pause_parsing
+
+!
+integer, private, save :: global_status
+integer, public, parameter :: END_OF_FILE = -1
+integer, public, parameter :: END_OF_ANCESTOR_ELEMENT = -2
+integer, public, parameter :: PCDATA_OVERFLOW = 7
+
+logical, private, save :: debug_xpath = .false.
+logical, private, save :: debug_sax = .false.
+character(len=500), private, save :: path_required
+character(len=100), private, save :: target_path ! *** Hard limit
+
+
+logical, private, save :: in_target_element = .false.
+logical, private, save :: in_pcdata_level = .false.
+
+logical, private, save :: stop_parsing = .false.
+!
+! This global variable determines whether we stop after
+! getting the initial element tag, or after digesting the full node.
+!
+logical, private, save :: full_node = .true.
+
+logical, private, save :: relative_path = .false.
+logical, private, save :: looking_for_current_element
+
+logical, private, save :: attributes_requested
+type(dictionary_t), private, save, pointer :: attributes_recovered
+
+integer, parameter, private :: MAX_PCDATA_SIZE = 65536
+logical, private, save :: pcdata_requested
+character(len=MAX_PCDATA_SIZE), private, &
+                                save :: pcdata_recovered !*** Hard
+integer, private, save :: len_pcdata
+integer, private, save :: max_len_pcdata
+
+type(xml_t), pointer, save, private :: xp
+
+CONTAINS !===========================================================
+
+!----------------------------------------------------
+! Debugging control
+!
+subroutine enable_debug(sax)
+logical, intent(in), optional :: sax
+  debug_xpath = .true.
+  debug_sax = .false.
+  if (present(sax)) then
+     debug_sax = sax
+  endif
+end subroutine enable_debug
+
+subroutine disable_debug()
+  debug_xpath = .false.
+end subroutine disable_debug
+
+!----------------------------------------------------
+! Main routines
+!---------------------------------------------------------------------
+subroutine mark_node(fxml,path,att_name,att_value,attributes,status)
+!
+! Performs a search of a given element (by path, and/or presence of
+! a given attribute and/or value of that attribute), returning optionally
+! the element's attribute dictionary, and leaving the file handle fxml'
+! ready to process the rest of the element's contents (child elements'
+! and/or pcdata).
+!
+! Side effects: it sets "ancestor_path" to the element's path'
+!
+! If the argument "path" is present and evaluates to a relative path (a
+! string not beginning with "/"), the search is interrupted after the end
+! of the "ancestor_element" set by a previous call to "mark_node".
+! If not earlier, the search ends at the end of the file.
+!
+! The status argument, if present, will hold a return value,
+! which will be:
+!
+! 0 on success,
+! negative in case of end-of-file or end-of-ancestor-element, or
+! positive in case of a malfunction
+!
+type(xml_t), intent(inout), target :: fxml
+character(len=*), intent(in), optional :: path
+character(len=*), intent(in), optional :: att_name
+character(len=*), intent(in), optional :: att_value
+type(dictionary_t), intent(out), optional :: attributes
+integer, intent(out), optional :: status
+
+
+character(len=200) :: ancestor_path ! local variable
+
+     full_node = .false.
+     call process_node(fxml, &
+                       path,att_name,att_value, &
+                       attributes, &
+                       status=status)
+     if (status == 0) then
+        call xml_mark_path(fxml,ancestor_path)
+        if (debug_xpath) print *, "Setting ancestor_path to: ", trim(ancestor_path)
+     endif
+
+end subroutine mark_node
+
+!--------------------------------------------------------------------
+subroutine get_node(fxml,path,att_name,att_value,attributes,pcdata,status)
+!
+! Performs a search of a given element (by path, and/or presence of
+! a given attribute and/or value of that attribute), returning optionally
+! the element's attribute dictionary and any PCDATA characters contained'
+! in the element's scope (but not child elements). It leaves the file handle'
+! physically and logically positioned:
+!
+! after the end of the element's start tag if 'pcdata' is not present'
+! after the end of the element's end tag if 'pcdata' is present'
+!
+! If the argument "path" is present and evaluates to a relative path (a
+! string not beginning with "/"), the search is interrupted after the end
+! of the "ancestor_element" set by a previous call to "mark_node".
+! If not earlier, the search ends at the end of the file.
+!
+! The status argument, if present, will hold a return value,
+! which will be:
+!
+! 0 on success,
+! negative in case of end-of-file or end-of-ancestor-element, or
+! positive in case of a malfunction (such as the overflow of the
+! user's pcdata buffer).'
+!
+type(xml_t), intent(inout), target :: fxml
+character(len=*), intent(in), optional :: path
+character(len=*), intent(in), optional :: att_name
+character(len=*), intent(in), optional :: att_value
+type(dictionary_t), intent(out), optional :: attributes
+character(len=*), intent(out), optional, target :: pcdata
+integer, intent(out), optional :: status
+
+     full_node = present(pcdata)
+     call process_node(fxml, &
+                       path,att_name,att_value, &
+                       attributes,pcdata, &
+                       status=status)
+
+end subroutine get_node
+!
+!--------------------------------------------------------------------
+! Workhorse routines follow
+!--------------------------------------------------------------------
+subroutine process_node(fxml,path,att_name,att_value, &
+                        attributes,pcdata,&
+                        status)
+type(xml_t), intent(inout), target :: fxml
+character(len=*), intent(in), optional :: path
+character(len=*), intent(in), optional :: att_name
+character(len=*), intent(in), optional :: att_value
+type(dictionary_t), intent(out), optional :: attributes
+character(len=*), intent(out), optional, target :: pcdata
+integer, intent(out), optional :: status
+
+logical :: path_present, att_name_present, att_value_present
+logical :: attributes_present
+
+character(len=3) :: any_path = "//*"
+character(len=200) :: local_path, ancestor_path ! *** Hard limit
+character(len=500) :: value ! *** Hard limit
+integer :: local_status
+
+type(dictionary_t) :: local_attributes
+
+global_status = 0 ! reset
+
+path_present = present(path)
+attributes_present = present(attributes)
+att_name_present = present(att_name)
+att_value_present = present(att_value)
+
+relative_path = .false.
+
+if (path_present) then
+   if (debug_xpath) print *, "SEARCHING for: ", trim(path)
+   if (path(1:1) /= "/") then
+      !
+      ! Relative path search
+      !
+      call xml_path(fxml,local_path)
+      call xml_get_path_mark(fxml,ancestor_path)
+      if (ancestor_path == "") then
+        if (debug_xpath) print *, "Relative search with null ancestor..."
+      endif
+      relative_path = .true.
+      if (debug_xpath) print *, "Relative search. ANCESTOR ELEMENT: ", &
+                             trim(ancestor_path)
+      !
+      ! Convert to absolute path
+      local_path = trim(local_path) // "/" // trim(path)
+      if (debug_xpath) print *, "Converting ", trim(path), &
+               " to absolute path: ", trim(local_path)
+   else
+      local_path = path
+   endif
+else
+   local_path = any_path
+endif
+
+looking_for_current_element = (path == ".")
+!
+! Use local_attributes, since it is in principle possible that
+! the user does not need to get back the attribute list.
+!
+do ! Loop until we satisfy the constraints
+
+   if (debug_xpath) print *, "--> Calling get_path ..."
+   call get_path(fxml,local_path,local_attributes,pcdata,local_status)
+   if (debug_xpath) print *, "-->Status after get_path: ", local_status
+   if (local_status /= 0) EXIT
+
+   if (debug_xpath) print *, "FOUND path matching: ", trim(local_path)
+
+   if (att_name_present) then
+      if (debug_xpath) print *, "Checking ", trim(att_name), " among ", &
+                          number_of_entries(local_attributes), " entries:"
+      if (debug_xpath) call print_dict(local_attributes)
+
+      if (has_key(local_attributes,att_name)) then
+
+         if (att_value_present) then
+            call get_value(local_attributes,att_name,value,local_status)
+            if (local_status /= 0) then
+               if (debug_xpath) print *, "Failed to get value of att: ", &
+                                    trim(att_name)
+               EXIT
+            endif
+
+            if (att_value == value) then
+               local_status = 0
+               if (debug_xpath) print *, "Got correct att name and value "
+               EXIT
+            else
+               if (debug_xpath) print *, "att value: ", trim(value), &
+                                   " does not match"
+               cycle ! We keep searching
+            endif
+         else ! Found att_name, and no value required
+            local_status = 0
+            if (debug_xpath) print *, "Got correct att name"
+            EXIT
+         endif
+      else ! Did not find that attribute name
+         if (debug_xpath) print *, "Att name not present"
+         cycle ! keep searching
+      endif
+   else ! Found path, and no att info required
+      local_status = 0
+      if (debug_xpath) print *, "Found correct path. No other reqs."
+      EXIT
+   endif
+
+enddo
+
+if (present(status)) then
+   status = local_status
+   if (debug_xpath) print *, "--Returning status: ", status
+endif
+
+if (attributes_present) then
+   attributes = local_attributes
+endif
+
+end subroutine process_node
+
+!--------------------------------------------------------------------
+subroutine get_path(fxml,path,attributes,pcdata,status)
+type(xml_t), intent(inout), target :: fxml
+character(len=*), intent(in) :: path
+type(dictionary_t), intent(out), optional, target :: attributes
+character(len=*), intent(out), optional, target :: pcdata
+integer, intent(out), optional :: status
+
+logical :: status_present
+
+xp => fxml
+
+path_required = path
+status_present = present(status)
+pcdata_requested = (present(pcdata))
+
+attributes_requested = (present(attributes))
+if (attributes_requested) then
+      call reset_dict(attributes)
+      attributes_recovered => attributes
+endif
+
+if (pcdata_requested) then
+!
+! Make sure we do not overstep the bounds of the supplied argument
+!
+   max_len_pcdata = min(len(pcdata),MAX_PCDATA_SIZE)
+   len_pcdata = 0
+   pcdata_recovered(1:max_len_pcdata) = ""
+   if (debug_xpath) print *, "Max length of pcdata store: ", max_len_pcdata
+endif
+
+if (looking_for_current_element) then
+   if (debug_xpath) print *, "Returning info about current element"
+
+   ! We are now in the desired element, and we have the name and
+   ! attribute list saved in xp.
+   !
+   if (attributes_requested) call xml_attributes(xp,attributes_recovered)
+   !
+   if (pcdata_requested) then
+   !
+   ! Set things up so that we can get the pcdata
+   !
+      call xml_path(xp,target_path)
+      in_target_element = .true.
+      in_pcdata_level = .true.
+   else
+      if (status_present) status = 0
+      RETURN ! We are done
+   endif
+else
+   target_path = ""
+   in_target_element = .false.
+   in_pcdata_level = .false.
+endif
+
+stop_parsing = .false.
+
+call xml_parse(fxml, &
+               begin_element_handler = begin_element , &
+               end_element_handler = end_element, &
+               pcdata_chunk_handler = pcdata_handler, &
+               verbose = debug_sax, signal_handler=pause_parsing, &
+               empty_element_handler = empty_element)
+
+if (eof_xmlfile(fxml)) then
+   global_status = END_OF_FILE
+   if (debug_xpath) print *, "Found end of file"
+   if (pcdata_requested) pcdata = ""
+else if (global_status == END_OF_ANCESTOR_ELEMENT) then
+   if (debug_xpath) print *, "Found end of ancestor element"
+   if (pcdata_requested) pcdata = ""
+else
+   if (debug_xpath) print *, "Parser found candidate element"
+   if (pcdata_requested) then
+      pcdata = pcdata_recovered(1:len_pcdata)
+      if (debug_xpath) print *, "PCDATA recovered: ", pcdata_recovered(1:len_pcdata)
+   endif
+endif
+if (global_status > 0) then
+   if (debug_xpath) print *, "Something went slightly wrong. Status > 0"
+endif
+!
+if (present(status)) status = global_status
+
+
+end subroutine get_path
+
+!==================================================================
+subroutine begin_element(name,attributes)
+character(len=*), intent(in) :: name
+type(dictionary_t), intent(in) :: attributes
+
+character(len=1000) :: path ! *** Hard limit
+
+call xml_path(xp,path)
+if (debug_xpath) print *, " begin_element ::: PATH: " , trim(path)
+if (debug_xpath) print *, "path: ", trim(path), " req: ", trim(path_required)
+if (match(path,path_required)) then
+      if (debug_xpath) print *, " Match path: " , trim(path)
+      in_target_element = .true.
+      target_path = path
+      in_pcdata_level = .true.
+      if (debug_xpath) print *, "In element name: " , name
+      if (attributes_requested) attributes_recovered = attributes
+      ! stop parsing
+      if (debug_xpath) print *, "full_node: ", full_node
+      if (.not. full_node) then
+         if (debug_xpath) print *, "Stopping parsing after initial tag"
+         stop_parsing = .true.
+      endif
+else
+   !
+   ! If we are at the pcdata level and we enter another element,
+   ! we must not read pcdata
+   !
+   if (in_pcdata_level) in_pcdata_level = .false.
+endif
+
+end subroutine begin_element
+!------------------------------------------------------------
+subroutine end_element(name)
+character(len=*), intent(in) :: name
+
+character(len=300) :: path ! *** Hard limit
+character(len=300) :: left_path ! *** Hard limit
+character(len=300) :: ancestor_path ! *** Hard limit
+!
+
+call xml_path(xp,path) ! path *after* leaving element
+left_path = trim(path) // "/" // trim(name)
+
+if (in_target_element) then
+   if (path == target_path) then
+      !
+      ! We are back to pcdata level after visiting child elements
+      !
+      in_pcdata_level = .true.
+
+   else if (left_path == target_path) then
+
+      ! We stop the parsing at the end of the element
+      !
+      if (debug_xpath) print *, "Exiting target element: ", trim(target_path)
+      in_target_element = .false.
+      in_pcdata_level = .false.
+      if (debug_xpath) print *, "Stopping parsing after end of target element"
+      stop_parsing = .true.
+   endif
+
+else if (relative_path) then
+   !
+   ! Check in case we go out of ancestor element
+   !
+   call xml_get_path_mark(xp,ancestor_path)
+   if (match(left_path,ancestor_path)) then
+      !
+      ! We are leaving the ancestor element
+      !
+      if (debug_xpath) print *, "Relative search. End of element: ", name
+      if (debug_xpath) print *, "Leaving Path: ", trim(left_path)
+      if (debug_xpath) print *, "Ancestor Path: ", trim(ancestor_path)
+      if (debug_xpath) print *, "Stopping parsing after end of ancestor element"
+
+      stop_parsing = .true.
+      global_status = END_OF_ANCESTOR_ELEMENT
+   endif
+endif
+
+end subroutine end_element
+
+!------------------------------------------------------------
+subroutine empty_element(name,attributes)
+character(len=*), intent(in) :: name
+type(dictionary_t), intent(in) :: attributes
+
+character(len=300) :: path ! *** Hard limit
+
+call xml_path(xp,path)
+if (debug_xpath) print *, " empty_element ::: PATH: " , trim(path)
+if (debug_xpath) print *, "path: ", trim(path), " req: ", trim(path_required)
+if (match(path,path_required)) then
+      if (debug_xpath) print *, " Match path: " , trim(path)
+      if (debug_xpath) print *, "In (empty) element name: " , name
+      if (attributes_requested) attributes_recovered = attributes
+      ! stop parsing
+      stop_parsing = .true.
+      if (debug_xpath) print *, "Stopping parsing after empty tag"
+      if (debug_xpath) print *, "full_node: ", full_node
+      if (full_node) then
+         if (debug_xpath) print *, "*Warning: full_node requested, empty tag found"
+      endif
+endif
+!
+! There is no logic for ancestor element handling, as by definition
+! an emtpy element cannot have children.
+!
+end subroutine empty_element
+
+!-----------------------------------------------------------
+subroutine pcdata_handler(chunk)
+character(len=*), intent(in) :: chunk
+
+integer :: len_chunk
+
+if (in_pcdata_level) then
+   !
+   ! Build pcdata_recovered chunk by chunk, until it overflows
+   !
+   if (pcdata_requested) then
+      if (debug_xpath) print *, "Found chunk of pcdata: ", chunk
+      len_chunk = len(chunk)
+      if ((len_pcdata + len_chunk) > max_len_pcdata) then
+         !
+         if (debug_xpath) print *, "***Pcdata Overflow "
+         global_status = PCDATA_OVERFLOW
+         stop_parsing = .true.
+         return
+      endif
+      pcdata_recovered(len_pcdata+1:len_pcdata+len_chunk) = chunk
+      len_pcdata = len_pcdata + len_chunk
+   endif
+endif
+
+end subroutine pcdata_handler
+!--------------------------------------------------------------------
+
+subroutine pause_parsing(res)
+logical, intent(out) :: res
+
+res = stop_parsing
+
+end subroutine pause_parsing
+!--------------------------------------------------------------------
+
+recursive function match(p,ptarget) result(res_match)
+character(len=*), intent(in) :: p
+character(len=*), intent(in) :: ptarget
+logical :: res_match
+
+!
+! Checks whether a given XML path matches the target path ptarget
+! Only absolute paths are considered.
+!
+! Examples of target paths:
+!
+! /pseudo/vps/radfunc [1]
+! //radfunc/data
+! //data
+! //*/vps/data
+! //job//data      
+! //*
+!
+integer :: len_target, len_path, pos_target, pos_path
+character(len=100) :: anchor_leaf ! *** Hard limit
+
+res_match = .false.
+
+if (trim(p) == trim(ptarget)) then
+   res_match = .true.
+   return
+
+else if (ptarget == "/") then
+   ! We process // in the middle below
+
+   res_match = .true.
+   return
+
+else ! We get the extreme elements
+
+   len_target = len_trim(ptarget)
+   len_path = len_trim(p)
+   pos_target = index(ptarget,"/",back=.true.)
+   pos_path = index(p,"/",back=.true.)
+
+   if (pos_target == len_target) then ! // in the middle...
+      ! Get leaf further up
+      search_anchor : do
+         pos_target = index(ptarget(1:len_target-1),"/",back=.true.)
+         if (pos_target == 1) then ! Target begins by /.// 
+            res_match = .true.
+            return
+         endif
+         anchor_leaf = ptarget(pos_target:len_target-1)
+         if (anchor_leaf == "/.") then ! keep searching
+            len_target = pos_target
+            cycle search_anchor
+         else
+            exit search_anchor
+         endif
+      enddo search_anchor
+
+      ! Note that the anchor includes the leading /
+      ! Now we search for that anchor in the candidate path
+      !
+      pos_path = index(p(1:len_path),trim(anchor_leaf),back=.true.)
+      if (pos_path /= 0) then
+
+         ! Found anchor. Continue further up.
+         !
+         res_match = match(p(1:pos_path-1),ptarget(1:pos_target-1))
+      endif
+
+   else if (ptarget(pos_target+1:len_target) == ".") then
+
+      ! A dot is a dummy. Continue further up in target path.
+      !
+      res_match = match(p(1:len_path),ptarget(1:pos_target-1))
+
+   else if (ptarget(pos_target+1:len_target) == "*") then
+
+      if (len_path == pos_path) then
+         RETURN ! empty path element
+      endif
+
+      ! A star matches any non-empty leaf. Continue further up.
+      !
+      res_match = match(p(1:pos_path-1),ptarget(1:pos_target-1))
+
+   else if (p(pos_path+1:len_path) == &
+             ptarget(pos_target+1:len_target)) then
+
+      ! Leafs are equal. Continue further up.
+      !
+      res_match = match(p(1:pos_path-1),ptarget(1:pos_target-1))
+
+   endif
+
+endif
+
+end function match
+
+end module m_path
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/xpath/m_path_orig.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/xpath/m_path_orig.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/xpath/m_path_orig.f90	(revision 2528)
@@ -0,0 +1,629 @@
+module m_path
+!
+! XPATH-like API for XML Parsing
+! Copyright Alberto Garcia <wdpgaara@lg.ehu.es>, August 2003
+!
+use flib_sax
+
+private
+!
+public :: get_node, mark_node, enable_debug, disable_debug
+
+private :: match, process_node, get_path
+private :: begin_element, end_element, pcdata_handler, empty_element
+private :: pause_parsing
+
+!
+integer, private, save                   :: global_status
+integer, public, parameter               :: END_OF_FILE  = -1
+integer, public, parameter               :: END_OF_ANCESTOR_ELEMENT = -2
+integer, public, parameter               :: PCDATA_OVERFLOW = 7
+
+logical, private, save                   :: debug_xpath = .false.
+logical, private, save                   :: debug_sax = .false.
+character(len=500), private, save        :: path_required
+character(len=100), private, save        :: target_path      ! *** Hard limit
+
+
+logical, private, save                   :: in_target_element = .false.
+logical, private, save                   :: in_pcdata_level = .false.
+
+logical, private, save                   :: stop_parsing = .false.
+!
+! This global variable determines whether we stop after
+! getting the initial element tag, or after digesting the full node.
+!
+logical, private, save                   :: full_node = .true.
+
+logical, private, save                   :: relative_path = .false.
+logical, private, save                   :: looking_for_current_element
+                             
+logical, private, save                        :: attributes_requested
+type(dictionary_t), private, save, pointer    :: attributes_recovered
+
+integer, parameter, private                   :: MAX_PCDATA_SIZE = 65536
+logical, private, save                        :: pcdata_requested 
+character(len=MAX_PCDATA_SIZE), private, &
+                                save          :: pcdata_recovered !*** Hard 
+integer, private, save                        :: len_pcdata
+integer, private, save                        :: max_len_pcdata
+
+type(xml_t), pointer, save, private           :: xp
+
+CONTAINS !===========================================================
+
+!----------------------------------------------------
+! Debugging control
+!
+subroutine enable_debug(sax)
+logical, intent(in), optional  :: sax
+  debug_xpath = .true.
+  debug_sax = .false.
+  if (present(sax)) then
+     debug_sax = sax
+  endif
+end subroutine enable_debug
+
+subroutine disable_debug()
+  debug_xpath = .false.
+end subroutine disable_debug
+
+!----------------------------------------------------
+! Main routines
+!---------------------------------------------------------------------
+subroutine mark_node(fxml,path,att_name,att_value,attributes,status)
+!
+! Performs a search of a given element (by path, and/or presence of
+! a given attribute and/or value of that attribute), returning optionally
+! the element's attribute dictionary, and leaving the file handle fxml
+! ready to process the rest of the element's contents (child elements
+! and/or pcdata).
+!
+! Side effects: it sets "ancestor_path" to the element's path
+!
+! If the argument "path" is present and evaluates to a relative path (a
+! string not beginning with "/"), the search is interrupted after the end
+! of the "ancestor_element" set by a previous call to "mark_node".
+! If not earlier, the search ends at the end of the file.
+!
+! The status argument, if present, will hold a return value, 
+! which will be:
+!
+!   0 on success,
+!   negative in case of end-of-file or end-of-ancestor-element, or 
+!   positive in case of a malfunction 
+!
+type(xml_t), intent(inout), target           :: fxml
+character(len=*), intent(in), optional       :: path
+character(len=*), intent(in), optional       :: att_name
+character(len=*), intent(in), optional       :: att_value
+type(dictionary_t), intent(out), optional    :: attributes
+integer, intent(out), optional               :: status
+
+
+character(len=200)         :: ancestor_path           ! local variable
+
+     full_node = .false.
+     call process_node(fxml,                    &
+                       path,att_name,att_value, &
+                       attributes,              &
+                       status=status)
+     if (status == 0) then
+        call xml_mark_path(fxml,ancestor_path)
+        if (debug_xpath) print *, "Setting ancestor_path to: ", trim(ancestor_path)
+     endif
+
+end subroutine mark_node
+
+!--------------------------------------------------------------------
+subroutine get_node(fxml,path,att_name,att_value,attributes,pcdata,status)
+!
+! Performs a search of a given element (by path, and/or presence of
+! a given attribute and/or value of that attribute), returning optionally
+! the element's attribute dictionary and any PCDATA characters contained
+! in the element's scope (but not child elements). It leaves the file handle
+! physically and logically positioned:
+!
+!     after the end of the element's start tag if 'pcdata' is not present
+!     after the end of the element's end tag if 'pcdata' is present
+!
+! If the argument "path" is present and evaluates to a relative path (a
+! string not beginning with "/"), the search is interrupted after the end
+! of the "ancestor_element" set by a previous call to "mark_node".
+! If not earlier, the search ends at the end of the file.
+!
+! The status argument, if present, will hold a return value, 
+! which will be:
+!
+!   0 on success,
+!   negative in case of end-of-file or end-of-ancestor-element, or 
+!   positive in case of a malfunction (such as the overflow of the 
+!   user's pcdata buffer).
+!
+type(xml_t), intent(inout), target           :: fxml
+character(len=*), intent(in), optional       :: path
+character(len=*), intent(in), optional       :: att_name
+character(len=*), intent(in), optional       :: att_value
+type(dictionary_t), intent(out), optional    :: attributes
+character(len=*), intent(out), optional, target      :: pcdata
+integer, intent(out), optional               :: status
+
+     full_node = present(pcdata)
+     call process_node(fxml,                    &
+                       path,att_name,att_value, &
+                       attributes,pcdata,       &
+                       status=status)
+
+end subroutine get_node
+!
+!--------------------------------------------------------------------
+! Workhorse routines follow
+!--------------------------------------------------------------------
+subroutine process_node(fxml,path,att_name,att_value, &
+                        attributes,pcdata,&
+                        status)
+type(xml_t), intent(inout), target           :: fxml
+character(len=*), intent(in), optional       :: path
+character(len=*), intent(in), optional       :: att_name
+character(len=*), intent(in), optional       :: att_value
+type(dictionary_t), intent(out), optional    :: attributes
+character(len=*), intent(out), optional, target      :: pcdata
+integer, intent(out), optional               :: status
+
+logical :: path_present, att_name_present, att_value_present
+logical :: attributes_present
+
+character(len=3)   :: any_path  = "//*"
+character(len=200) :: local_path, ancestor_path      ! *** Hard limit
+character(len=500) :: value                          ! *** Hard limit
+integer            :: local_status
+
+type(dictionary_t) :: local_attributes
+
+global_status = 0           ! reset
+
+path_present = present(path)
+attributes_present = present(attributes)
+att_name_present = present(att_name)
+att_value_present = present(att_value)
+
+relative_path = .false.
+
+if (path_present) then
+   if (debug_xpath) print *, "SEARCHING for: ", trim(path)
+   if (path(1:1) /= "/") then
+      !
+      ! Relative path search
+      !
+      call xml_path(fxml,local_path)
+      call xml_get_path_mark(fxml,ancestor_path)
+      if (ancestor_path == "") then
+        if (debug_xpath) print *, "Relative search with null ancestor..."
+      endif
+      relative_path = .true.    
+      if (debug_xpath) print *, "Relative search. ANCESTOR ELEMENT: ", &
+                             trim(ancestor_path)
+      !
+      ! Convert to absolute path
+      local_path = trim(local_path) // "/" // trim(path)
+      if (debug_xpath) print *, "Converting ", trim(path), &
+               " to absolute path: ", trim(local_path)
+   else
+      local_path = path
+   endif
+else
+   local_path = any_path
+endif
+
+looking_for_current_element = (path == ".")
+!
+! Use local_attributes, since it is in principle possible that
+! the user does not need to get back the attribute list.
+!
+do ! Loop until we satisfy the constraints 
+   
+   if (debug_xpath) print *, "--> Calling get_path ..."
+   call get_path(fxml,local_path,local_attributes,pcdata,local_status)
+   if (debug_xpath) print *, "-->Status after get_path: ", local_status
+   if (local_status /= 0)  EXIT
+
+   if (debug_xpath) print *, "FOUND path matching: ", trim(local_path)
+
+   if (att_name_present) then
+      if (debug_xpath) print *, "Checking ", trim(att_name), " among ", &
+                          number_of_entries(local_attributes), " entries:"
+      if (debug_xpath) call print_dict(local_attributes)
+
+      if (has_key(local_attributes,att_name)) then
+
+         if (att_value_present) then
+            call get_value(local_attributes,att_name,value,local_status)
+            if (local_status /= 0) then
+               if (debug_xpath) print *, "Failed to get value of att: ", &
+                                    trim(att_name)
+               EXIT
+            endif
+
+            if (att_value == value)  then
+               local_status = 0
+               if (debug_xpath) print *, "Got correct att name and value "
+               EXIT
+            else
+               if (debug_xpath) print *, "att value: ", trim(value), &
+                                   " does not match"
+               cycle        ! We keep searching
+            endif
+         else           ! Found att_name, and no value required
+            local_status = 0
+            if (debug_xpath) print *, "Got correct att name"
+            EXIT
+         endif
+      else              ! Did not find that attribute name
+         if (debug_xpath) print *, "Att name not present"
+         cycle          ! keep searching
+      endif
+   else                 ! Found path, and no att info required
+      local_status = 0
+      if (debug_xpath) print *, "Found correct path. No other reqs."
+      EXIT
+   endif
+   
+enddo
+
+if (present(status)) then
+   status = local_status
+   if (debug_xpath) print *, "--Returning status: ", status
+endif
+
+if (attributes_present) then
+   attributes = local_attributes
+endif
+
+end subroutine process_node
+
+!--------------------------------------------------------------------
+subroutine get_path(fxml,path,attributes,pcdata,status)
+type(xml_t), intent(inout), target           :: fxml
+character(len=*), intent(in)                 :: path
+type(dictionary_t), intent(out), optional, target    :: attributes
+character(len=*), intent(out), optional, target      :: pcdata
+integer, intent(out), optional                       :: status  
+
+logical            :: status_present
+
+xp => fxml
+
+path_required = path
+status_present = present(status)
+pcdata_requested = (present(pcdata))
+
+attributes_requested = (present(attributes))
+if (attributes_requested) then
+      call reset_dict(attributes)
+      attributes_recovered => attributes
+endif
+
+if (pcdata_requested) then
+!
+!  Make sure we do not overstep the bounds of the supplied argument
+!
+   max_len_pcdata = min(len(pcdata),MAX_PCDATA_SIZE)
+   len_pcdata = 0
+   pcdata_recovered(1:max_len_pcdata) = ""
+   if (debug_xpath) print *, "Max length of pcdata store: ", max_len_pcdata
+endif
+
+if (looking_for_current_element) then
+   if (debug_xpath) print *, "Returning info about current element"
+
+   ! We are now in the desired element, and we have the name and
+   ! attribute list saved in xp.
+   !
+   if (attributes_requested) call xml_attributes(xp,attributes_recovered)
+   !
+   if (pcdata_requested) then
+   !
+   ! Set things up so that we can get the pcdata
+   !
+      call xml_path(xp,target_path)
+      in_target_element = .true.
+      in_pcdata_level = .true.
+   else
+      if (status_present) status = 0
+      RETURN              ! We are done
+   endif
+else
+   target_path = ""
+   in_target_element = .false.
+   in_pcdata_level = .false.
+endif
+
+stop_parsing = .false.
+
+call xml_parse(fxml,  &
+               begin_element_handler = begin_element , &
+               end_element_handler = end_element,  &
+               pcdata_chunk_handler = pcdata_handler, &
+               verbose = debug_sax, signal_handler=pause_parsing, &
+               empty_element_handler = empty_element)
+
+if (eof_xmlfile(fxml)) then
+   global_status = END_OF_FILE
+   if (debug_xpath) print *, "Found end of file"
+   if (pcdata_requested) pcdata = ""
+else if (global_status == END_OF_ANCESTOR_ELEMENT) then
+   if (debug_xpath) print *, "Found end of ancestor element"
+   if (pcdata_requested) pcdata = ""
+else
+   if (debug_xpath) print *, "Parser found candidate element"
+   if (pcdata_requested) then
+      pcdata = pcdata_recovered(1:len_pcdata)
+      if (debug_xpath) print *, "PCDATA recovered: ", pcdata_recovered(1:len_pcdata)
+   endif
+endif
+if (global_status > 0) then
+   if (debug_xpath) print *, "Something went slightly wrong. Status > 0"
+endif
+!
+if (present(status)) status = global_status  
+
+
+end subroutine get_path
+
+!==================================================================
+subroutine begin_element(name,attributes)
+character(len=*), intent(in)   :: name
+type(dictionary_t), intent(in) :: attributes
+
+character(len=1000)   :: path              ! *** Hard limit
+
+call xml_path(xp,path)
+if (debug_xpath) print *, " begin_element ::: PATH: " ,  trim(path)
+if (debug_xpath) print *, "path: ", trim(path), " req: ", trim(path_required)
+if (match(path,path_required)) then
+      if (debug_xpath) print *, " Match path: " ,  trim(path)
+      in_target_element = .true.
+      target_path = path
+      in_pcdata_level = .true.
+      if (debug_xpath) print *, "In element name: " , name
+      if (attributes_requested) attributes_recovered = attributes
+      ! stop parsing
+      if (debug_xpath) print *, "full_node: ", full_node
+      if (.not. full_node)  then
+         if (debug_xpath) print *, "Stopping parsing after initial tag"
+         stop_parsing = .true.
+      endif
+else 
+   !
+   ! If we are at the pcdata level and we enter another element, 
+   ! we must not read pcdata
+   !
+   if (in_pcdata_level)   in_pcdata_level = .false.
+endif
+
+end subroutine begin_element
+!------------------------------------------------------------
+subroutine end_element(name)
+character(len=*), intent(in)   :: name
+
+character(len=300)   :: path             ! *** Hard limit
+character(len=300)   :: left_path        ! *** Hard limit
+character(len=300)   :: ancestor_path    ! *** Hard limit
+!
+
+call xml_path(xp,path)   ! path *after* leaving element
+left_path = trim(path) // "/" // trim(name)
+
+if (in_target_element) then
+   if (path == target_path) then
+      ! 
+      ! We are back to pcdata level after visiting child elements
+      !
+      in_pcdata_level = .true.
+
+   else  if (left_path == target_path) then
+
+      ! We stop the parsing at the end of the element
+      !
+      if (debug_xpath) print *, "Exiting target element: ", trim(target_path)
+      in_target_element = .false.
+      in_pcdata_level = .false.
+      if (debug_xpath) print *, "Stopping parsing after end of target element"
+      stop_parsing = .true.
+   endif
+   
+else if (relative_path) then
+   !
+   ! Check in case we go out of ancestor element
+   !
+   call xml_get_path_mark(xp,ancestor_path)
+   if (match(left_path,ancestor_path)) then
+      !
+      ! We are leaving the ancestor element
+      !
+      if (debug_xpath) print *, "Relative search. End of element: ", name
+      if (debug_xpath) print *, "Leaving Path: ", trim(left_path)
+      if (debug_xpath) print *, "Ancestor Path: ", trim(ancestor_path)
+      if (debug_xpath) print *, "Stopping parsing after end of ancestor element"
+    
+      stop_parsing = .true.
+      global_status = END_OF_ANCESTOR_ELEMENT
+   endif
+endif
+  
+end subroutine end_element
+
+!------------------------------------------------------------
+subroutine empty_element(name,attributes)
+character(len=*), intent(in)   :: name
+type(dictionary_t), intent(in) :: attributes
+
+character(len=300)   :: path              ! *** Hard limit
+
+call xml_path(xp,path)
+if (debug_xpath) print *, " empty_element ::: PATH: " ,  trim(path)
+if (debug_xpath) print *, "path: ", trim(path), " req: ", trim(path_required)
+if (match(path,path_required)) then
+      if (debug_xpath) print *, " Match path: " ,  trim(path)
+      if (debug_xpath) print *, "In (empty) element name: " , name
+      if (attributes_requested) attributes_recovered = attributes
+      ! stop parsing
+      stop_parsing = .true.
+      if (debug_xpath) print *, "Stopping parsing after empty tag"
+      if (debug_xpath) print *, "full_node: ", full_node
+      if (full_node)  then
+         if (debug_xpath) print *, "*Warning: full_node requested, empty tag found"
+      endif
+endif
+!
+! There is no logic for ancestor element handling, as by definition
+! an emtpy element cannot have children.
+!
+end subroutine empty_element
+
+!-----------------------------------------------------------
+subroutine pcdata_handler(chunk)
+character(len=*), intent(in)   :: chunk
+
+integer  :: len_chunk
+
+if (in_pcdata_level) then
+   ! 
+   ! Build pcdata_recovered chunk by chunk, until it overflows
+   !
+   if (pcdata_requested) then
+      if (debug_xpath) print *, "Found chunk of pcdata: ", chunk
+      len_chunk = len(chunk)
+      if ((len_pcdata + len_chunk) > max_len_pcdata) then
+         !
+         if (debug_xpath) print *, "***Pcdata Overflow "
+         global_status = PCDATA_OVERFLOW
+         stop_parsing = .true.
+         return
+      endif
+      pcdata_recovered(len_pcdata+1:len_pcdata+len_chunk) = chunk
+      len_pcdata = len_pcdata + len_chunk
+   endif
+endif
+
+end subroutine pcdata_handler
+!--------------------------------------------------------------------
+
+subroutine pause_parsing(res)
+logical, intent(out)  :: res
+
+res =  stop_parsing
+
+end subroutine pause_parsing
+!--------------------------------------------------------------------
+
+recursive function match(p,ptarget) result(res_match)
+character(len=*), intent(in)  :: p
+character(len=*), intent(in)  :: ptarget
+logical                       :: res_match
+
+!
+! Checks whether a given XML path matches the target path ptarget
+! Only absolute paths are considered.
+!
+! Examples of target paths:
+!
+!           /pseudo/vps/radfunc      [1]
+!           //radfunc/data
+!           //data
+!           //*/vps/data
+!           //job//data      
+!           //*
+!
+integer  :: len_target, len_path, pos_target, pos_path
+character(len=100)   :: anchor_leaf                     ! *** Hard limit
+
+res_match = .false.       
+
+if (trim(p) == trim(ptarget)) then
+   res_match = .true.
+   return
+
+else if (ptarget == "/") then
+   ! We  process // in the middle below
+
+   res_match = .true.
+   return
+
+else              ! We get the extreme elements
+
+   len_target = len_trim(ptarget)
+   len_path = len_trim(p)
+   pos_target = index(ptarget,"/",back=.true.)
+   pos_path = index(p,"/",back=.true.)
+
+   if (pos_target == len_target) then   ! // in the middle...
+      ! Get leaf further up
+      search_anchor : do 
+         pos_target = index(ptarget(1:len_target-1),"/",back=.true.)
+         if (pos_target == 1) then  ! Target begins by /.// 
+            res_match = .true.
+            return
+         endif
+         anchor_leaf = ptarget(pos_target:len_target-1)
+         if (anchor_leaf == "/.") then  ! keep searching
+            len_target = pos_target 
+            cycle search_anchor
+         else
+            exit search_anchor
+         endif
+      enddo search_anchor
+
+      ! Note that the anchor includes the leading /
+      ! Now we search for that anchor in the candidate path
+      !
+      pos_path = index(p(1:len_path),trim(anchor_leaf),back=.true.)
+      if (pos_path /= 0) then
+
+         ! Found anchor. Continue further up.
+         !
+         res_match = match(p(1:pos_path-1),ptarget(1:pos_target-1))
+      endif
+
+   else if  (ptarget(pos_target+1:len_target) == ".") then
+
+      ! A dot is a dummy. Continue further up in target path.
+      !
+      res_match = match(p(1:len_path),ptarget(1:pos_target-1))
+
+   else if  (ptarget(pos_target+1:len_target) == "*") then
+
+      if (len_path == pos_path) then
+         RETURN   ! empty path element
+      endif
+
+      ! A star matches any non-empty leaf. Continue further up.
+      !
+      res_match = match(p(1:pos_path-1),ptarget(1:pos_target-1))
+
+   else  if (p(pos_path+1:len_path) ==  &
+             ptarget(pos_target+1:len_target)) then 
+
+      ! Leafs are equal. Continue further up.
+      !
+      res_match = match(p(1:pos_path-1),ptarget(1:pos_target-1))
+
+   endif
+
+endif
+
+end function match
+
+end module m_path
+
+
+
+
+
+
+
+
+
+
+
+
Index: trunk/NEMOGCM/EXTERNAL/XMLF90/src/xpath/match_tester.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLF90/src/xpath/match_tester.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLF90/src/xpath/match_tester.f90	(revision 2528)
@@ -0,0 +1,148 @@
+program m
+
+character(len=100) :: p, t
+logical            :: result
+
+do
+   write(unit=*,fmt="(a)",advance="no")  "Target path: "
+   read(unit=*,fmt="(a)") t
+   write(unit=*,fmt="(a)",advance="no")  "Path: "
+   read(unit=*,fmt="(a)") p
+
+   result = match(p,t)
+   print *, "Result: ", result
+
+enddo
+
+
+CONTAINS
+
+recursive function match(p,ptarget) result(res_match)
+character(len=*), intent(in)  :: p
+character(len=*), intent(in)  :: ptarget
+logical                       :: res_match
+
+!
+! Checks whether a given XML path matches the target path ptarget
+! Only absolute paths are considered.
+!
+! Examples of target paths:
+!
+!           /pseudo/vps/radfunc      [1]
+!           //radfunc/data
+!           //data
+!           //*/vps/data
+!           //job//data      
+!           //*
+!
+integer  :: len_target, len_path, pos_target, pos_path
+character(len=100)   :: anchor_leaf
+
+res_match = .false.       
+
+ print *, ":testing: "
+ print *, "          ", trim(p)
+ print *, " against: ", trim(ptarget)
+ print *, "-----------------------------------------"
+
+if (trim(p) == trim(ptarget)) then
+   res_match = .true.
+   print *, "outright equality"
+   return
+
+else if (ptarget == "/") then
+   ! We  process // in the middle below
+
+   res_match = .true.
+   print *, "target begins by //"
+   return
+
+else              ! We get the extreme elements
+
+   len_target = len_trim(ptarget)
+   len_path = len_trim(p)
+   pos_target = index(ptarget,"/",back=.true.)
+   pos_path = index(p,"/",back=.true.)
+
+   print *, " Path leaf: ", p(pos_path+1:len_path) 
+   print *, " Target leaf: ", ptarget(pos_target+1:len_target)
+
+   if (pos_target == len_target) then   ! // in the middle...
+      ! Get leaf further up
+      search_anchor : do 
+         print *, "looking for anchor in: ", ptarget(1:len_target-1)
+         print *, "press enter"
+         read *
+         pos_target = index(ptarget(1:len_target-1),"/",back=.true.)
+         print *, "pos_target in anchor search: ", pos_target
+         if (pos_target == 1) then  ! Target begins by /.// 
+            res_match = .true.
+            print *, "reached initial /.// in target"
+            return
+         endif
+         anchor_leaf = ptarget(pos_target:len_target-1)
+         print *, " Anchor leaf: ", trim(anchor_leaf)
+         if (anchor_leaf == "/.") then  ! keep searching
+            len_target = pos_target 
+            cycle search_anchor
+         else
+            exit search_anchor
+         endif
+      enddo search_anchor
+
+      ! Note that the anchor includes the leading /
+      ! Now we search for that anchor in the candidate path
+      !
+      print *, " Searching anchor in : ", trim(p(1:len_path))
+      pos_path = index(p(1:len_path),trim(anchor_leaf),back=.true.)
+      if (pos_path /= 0) then
+
+         ! Found anchor. Continue further up.
+         !
+         res_match = match(p(1:pos_path-1),ptarget(1:pos_target-1))
+      endif
+
+   else if  (ptarget(pos_target+1:len_target) == ".") then
+
+      ! A dot is a dummy. Continue further up.
+      !
+      res_match = match(p(1:len_path),ptarget(1:pos_target-1))
+
+   else if  (ptarget(pos_target+1:len_target) == "*") then
+
+      if (len_path == pos_path) then
+         print *, "empty element. len_path, pos_path: ", len_path, pos_path
+         RETURN   ! empty path element
+      endif
+
+      ! A star matches any non-empty leaf. Continue further up.
+      !
+      res_match = match(p(1:pos_path-1),ptarget(1:pos_target-1))
+
+   else  if (p(pos_path+1:len_path) ==  &
+             ptarget(pos_target+1:len_target)) then 
+
+      ! Leafs are equal. Continue further up.
+      !
+      res_match = match(p(1:pos_path-1),ptarget(1:pos_target-1))
+
+   endif
+
+endif
+
+end function match
+
+end program m
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/AA_make
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/AA_make	(revision 2527)
+++ 	(revision )
@@ -1,332 +1,0 @@
-VPATH=../src/IOSERVER:../src/XMLIO
-MAKE_NAM = $(MAKE)
-ifneq ($(MAKE_NAM),$(M_K))
- @$(error You must invoke this Makefile with the $(M_K) command)
-endif
-USER_DIR = $(shell /bin/pwd)
-MAKE_DIR = '??'
-ifneq ($(USER_DIR),$(MAKE_DIR))
- @$(error You must invoke this Makefile from its directory)
-endif
-#-
-#-Q- sx6nec F_O := $(F_O) -Wf,-ptr byte
-#-Q- sx8brodie F_O := $(F_O) -Wf,-ptr byte
-#-Q- sx8mercure F_O := $(F_O) -Wf,-ptr byte
-#-Q- sx9mercure F_O := $(F_O) -Wf,-ptr byte
-#-Q- sxdkrz F_O := $(F_O) -Wf,-ptr byte
-#-Q- es2 F_O := $(F_O) -Wf,-ptr byte
-#-Q- aix6 F_O = $(F_P) -O3 -qextname -qsuffix=cpp=F90 -qsuffix=f=f90  -qmoddir=$(MODDIR) -I $(MODDIR)
-#-Q- aix F_O = $(F_P) -O3 -qextname -qsuffix=cpp=F90 -qsuffix=f=f90  -qmoddir=$(MODDIR) -I $(MODDIR)
-#-Q- osxxlf F_O = $(F_P) -O3 -qextname -qsuffix=cpp=F90 -qsuffix=f=f90  -qmoddir=$(MODDIR) -I $(MODDIR)
-F_O := $(F_O) -I../../../lib
-P_O := $(P_O) -traditional
-#-Q- aix6 L_O = $(F_P) -q64 -O3
-#-Q- aix L_O = $(F_P) -q64 -O3
-prefix=''
-#-Q- aix6 prefix='-WF,'
-#-Q- aix prefix='-WF,'
-override P_P := $(P_P:%=$(prefix)%)
-
-#---------------------------------------------------------------------
-#- Create libioserver and libxmlio
-#---------------------------------------------------------------------
-
-.PRECIOUS : $(MODEL_LIB1) $(MODEL_LIB2)
-SXMODEL_LIB1 = $(MODEL_LIB1)
-SXMODEL_LIB2 = $(MODEL_LIB2)
-ifeq ($(L_X),1)
-SXMODEL_LIB1 = $(LIBDIR)/libsxioserver.a
-SXMODEL_LIB2 = $(LIBDIR)/libsxxmlio.a
-.PRECIOUS : $(SXMODEL_LIB1) $(SXMODEL_LIB2)
-endif
-
-MODS1 =	../src/IOSERVER/mod_ioclient_para.F90 \
-	../src/IOSERVER/mod_ioserver_para.F90 ../src/IOSERVER/mpi_mod.F90 \
-	../src/IOSERVER/mpi_wrapper.F90 ../src/IOSERVER/mpitrace.F90 \
-	../src/IOSERVER/init_vampir.f90 ../src/IOSERVER/main.f90 \
-	../src/IOSERVER/mod_box_grid.f90 ../src/IOSERVER/mod_boxed_domain.f90 \
-	../src/IOSERVER/mod_event_client.f90 \
-	../src/IOSERVER/mod_event_parameters.f90 \
-	../src/IOSERVER/mod_event_server.f90 \
-	../src/IOSERVER/mod_field_bufferize.f90 \
-	../src/IOSERVER/mod_global_memory.f90 \
-	../src/IOSERVER/mod_interface_ioipsl.f90 \
-	../src/IOSERVER/mod_ioclient.f90 ../src/IOSERVER/mod_iomanager.f90 \
-	../src/IOSERVER/mod_ioserver_namelist.f90 \
-	../src/IOSERVER/mod_mpi_buffer_client.f90 \
-	../src/IOSERVER/mod_mpi_buffer_parameters.f90 \
-	../src/IOSERVER/mod_mpi_buffer_server.f90 \
-	../src/IOSERVER/mod_pack.f90 ../src/IOSERVER/mod_prec.f90 \
-	../src/IOSERVER/mod_wait.f90 ../src/IOSERVER/pack_f.f90 \
-	../src/IOSERVER/server.f90
-
-OBJSMODS1 =	mod_ioclient_para.o mod_ioserver_para.o mpi_mod.o mpi_wrapper.o \
-	mpitrace.o init_vampir.o main.o mod_box_grid.o mod_boxed_domain.o \
-	mod_event_client.o mod_event_parameters.o mod_event_server.o \
-	mod_field_bufferize.o mod_global_memory.o mod_interface_ioipsl.o \
-	mod_ioclient.o mod_iomanager.o mod_ioserver_namelist.o \
-	mod_mpi_buffer_client.o mod_mpi_buffer_parameters.o \
-	mod_mpi_buffer_server.o mod_pack.o mod_prec.o mod_wait.o pack_f.o 
-
-MODS2 =	../src/XMLIO/mod_attribut.f90 ../src/XMLIO/mod_attribut_list.f90 \
-	../src/XMLIO/mod_axis.f90 ../src/XMLIO/mod_axis_attribut.f90 \
-	../src/XMLIO/mod_axis_definition.f90 ../src/XMLIO/mod_axis_group.f90 \
-	../src/XMLIO/mod_context.f90 ../src/XMLIO/mod_dependency.f90 \
-	../src/XMLIO/mod_domain.f90 ../src/XMLIO/mod_error_msg.f90 \
-	../src/XMLIO/mod_field.f90 ../src/XMLIO/mod_field_attribute.f90 \
-	../src/XMLIO/mod_field_definition.f90 \
-	../src/XMLIO/mod_field_group.f90 ../src/XMLIO/mod_file.f90 \
-	../src/XMLIO/mod_file_attribut.f90 \
-	../src/XMLIO/mod_file_definition.f90 ../src/XMLIO/mod_file_group.f90 \
-	../src/XMLIO/mod_grid.f90 ../src/XMLIO/mod_grid_attribut.f90 \
-	../src/XMLIO/mod_grid_definition.f90 ../src/XMLIO/mod_grid_group.f90 \
-	../src/XMLIO/mod_object.f90 ../src/XMLIO/mod_parse_xml.f90 \
-	../src/XMLIO/mod_sorted_list.f90 ../src/XMLIO/mod_stdtype.f90 \
-	../src/XMLIO/mod_time_parameters.f90 \
-	../src/XMLIO/mod_xmlio_parameters.f90 ../src/XMLIO/mod_zoom.f90 \
-	../src/XMLIO/mod_zoom_attribut.f90 ../src/XMLIO/string_function.f90 \
-	../src/XMLIO/test_xmlio.f90 ../src/XMLIO/xmlio.f90
-
-OBJSMODS2 =	mod_attribut.o mod_attribut_list.o mod_axis.o mod_axis_attribut.o \
-	mod_axis_definition.o mod_axis_group.o mod_context.o mod_dependency.o \
-	mod_domain.o mod_error_msg.o mod_field.o mod_field_attribute.o \
-	mod_field_definition.o mod_field_group.o mod_file.o \
-	mod_file_attribut.o mod_file_definition.o mod_file_group.o mod_grid.o \
-	mod_grid_attribut.o mod_grid_definition.o mod_grid_group.o \
-	mod_object.o mod_parse_xml.o mod_sorted_list.o mod_stdtype.o \
-	mod_time_parameters.o mod_xmlio_parameters.o mod_zoom.o \
-	mod_zoom_attribut.o string_function.o  xmlio.o
-
-.SUFFIXES: .f90 .F90
-
-all: libioipsl libxmlf90 dirxml $(MODEL_LIB2)($(OBJSMODS2)) key $(MODEL_LIB1)($(OBJSMODS1)) server.o EXEC_BIN
-	@echo IOSERVER is OK
-
-key :
-	-@if [ "`cat KEY_CPP`" != "$(P_P)" ] ; then \
-	echo "$(P_P)" > KEY_CPP ; fi
-
-ifneq  (,$(findstring NO_MPI,$(P_P)))
-EXEC_BIN :
-server.o :
-else
-EXEC_BIN : server.o
-	$(F_L) $(L_O) -o ../../../bin/ioserver server.o $(MODEL_LIB1) $(MODEL_LIB2) ../../../lib/libioipsl.a $(NCDF_LIB) ../../../lib/libxmlio_server/libxmlf90.a
-server.o :       ../src/IOSERVER/server.f90
-	@$(F_C) $(F_O) -c ../src/IOSERVER/server.f90
-endif
-
-#Rules for ioserver
-#---- Using VPATH instead $(MODEL_LIB1)(%.o): ../src/IOSERVER/%.f90
-$(MODEL_LIB1)(%.o): %.f90
-	$(F_C) $(F_O)  -I../src/XMLIO -I../src/IOSERVER -I$(NCDF_INC) $<
-	$(A_C) $(MODEL_LIB1) $*.o
-ifeq ($(L_X),1)
-	$(A_X) $(SXMODEL_LIB1) $*.o
-endif
-#-Q- sgi6       mv $(shell echo $* | tr '[:lower:]' '[:upper:]').mod $(MODDIR)
-ifeq ($(M_M),1)
-	@mv -f *.mod $(MODDIR)  2> /dev/null || true
-endif
-	$(RM) $*.o
-
-#Rules for ioserver
-#---- Using VPATH instead $(MODEL_LIB1)(%.o): ../src/IOSERVER/%.F90
-$(MODEL_LIB1)(%.o): %.F90 KEY_CPP
-	$(F_C) $(F_O) $(P_P) -I$(NCDF_INC) -I../src/XMLIO -I../src/IOSERVER $<
-	$(A_C) $(MODEL_LIB1) $*.o
-ifeq ($(L_X),1)
-	$(A_X) $(SXMODEL_LIB1) $*.o
-endif
-#-Q- sgi6       mv $(shell echo $* | tr '[:lower:]' '[:upper:]').mod $(MODDIR)
-ifeq ($(M_M),1)
-	@mv -f *.mod $(MODDIR)  2> /dev/null || true
-endif
-	$(RM) $*.o
-
-#Rules for xmlio
-#---- Using VPATH instead $(MODEL_LIB1)(%.o): ../src/XMLIO/%.F90
-$(MODEL_LIB2)(%.o): %.f90
-	$(F_C) $(F_O) -I$(NCDF_INC) -I../src/XMLIO $<
-	$(A_C) $(MODEL_LIB2) $*.o
-ifeq ($(L_X),1)
-	$(A_X) $(SXMODEL_LIB2) $*.o
-endif
-#-Q- sgi6       mv $(shell echo $* | tr '[:lower:]' '[:upper:]').mod $(MODDIR)
-ifeq ($(M_M),1)
-	@mv -f *.mod $(MODDIR)  2> /dev/null || true
-endif
-	$(RM) $*.o
-
-dirxml: 
-	@if [ ! -d ../../../lib/libxmlio_server ] ; then mkdir ../../../lib/libxmlio_server ; fi
-
-# IOIPSL library
-libioipsl :
-	(cd ../../IOIPSL/src ; $(M_K) -f Makefile )
-
-# XMLF90 library
-libxmlf90 :
-	(cd ../../XMLF90/external ; $(M_K) -f Makefile )
-
-clean:
-	$(RM) *.*~ Makefile~ core *.o *.mod i.*.L *.L
-	$(RM) server.o $(MODEL_LIB1) $(MODEL_LIB2)
-
-$(MODEL_LIB1)(init_vampir.o): $(MODEL_LIB1)(mpitrace.o)
-$(MODEL_LIB1)(main.o): $(MODEL_LIB1)(mod_pack.o) $(MODEL_LIB1)(mod_wait.o)
-$(MODEL_LIB1)(mod_event_client.o): $(MODEL_LIB1)(mod_event_parameters.o) \
-	$(MODEL_LIB1)(mod_iomanager.o) $(MODEL_LIB1)(mod_ioserver_namelist.o) \
-	$(MODEL_LIB1)(mod_mpi_buffer_client.o) $(MODEL_LIB1)(mod_pack.o) \
-	$(MODEL_LIB1)(mod_attribut.o)
-$(MODEL_LIB1)(mod_event_server.o): $(MODEL_LIB1)(mod_event_parameters.o) \
-	$(MODEL_LIB1)(mod_iomanager.o) $(MODEL_LIB1)(mod_pack.o) \
-	$(MODEL_LIB1)(mod_attribut.o)
-$(MODEL_LIB1)(mod_global_memory.o): $(MODEL_LIB1)(mpi_mod.o)
-$(MODEL_LIB1)(mod_interface_ioipsl.o): $(MODEL_LIB1)(mod_ioserver_para.o) \
-	$(MODEL_LIB2)
-$(MODEL_LIB1)(mod_ioclient.o): $(MODEL_LIB1)(mod_event_client.o) \
-	$(MODEL_LIB1)(mod_ioclient_para.o) $(MODEL_LIB1)(mod_iomanager.o) \
-	$(MODEL_LIB1)(mod_ioserver_namelist.o) \
-	$(MODEL_LIB1)(mod_mpi_buffer_client.o) $(MODEL_LIB1)(mod_wait.o) \
-	$(MODEL_LIB1)(mpi_mod.o)
-$(MODEL_LIB1)(mod_iomanager.o): $(MODEL_LIB1)(mod_field_bufferize.o) \
-	$(MODEL_LIB1)(mod_interface_ioipsl.o) $(MODEL_LIB1)(mod_attribut.o) \
-	$(MODEL_LIB1)(mod_axis.o) $(MODEL_LIB1)(mod_axis_group.o) \
-	$(MODEL_LIB1)(mod_field.o) $(MODEL_LIB1)(mod_field_group.o) \
-	$(MODEL_LIB1)(mod_file.o) $(MODEL_LIB1)(mod_file_group.o) \
-	$(MODEL_LIB1)(mod_grid.o) $(MODEL_LIB1)(mod_grid_group.o) \
-	$(MODEL_LIB1)(mod_object.o) $(MODEL_LIB1)(mod_zoom.o) $(MODEL_LIB2)
-$(MODEL_LIB1)(mod_mpi_buffer_client.o): $(MODEL_LIB1)(mod_global_memory.o) \
-	$(MODEL_LIB1)(mod_ioclient_para.o) \
-	$(MODEL_LIB1)(mod_mpi_buffer_parameters.o) $(MODEL_LIB1)(mod_pack.o) \
-	$(MODEL_LIB1)(mod_wait.o) $(MODEL_LIB1)(mpi_mod.o) \
-	$(MODEL_LIB1)(mpitrace.o)
-$(MODEL_LIB1)(mod_mpi_buffer_parameters.o): $(MODEL_LIB1)(mod_ioserver_namelist.o)
-$(MODEL_LIB1)(mod_mpi_buffer_server.o): $(MODEL_LIB1)(mod_event_server.o) \
-	$(MODEL_LIB1)(mod_global_memory.o) $(MODEL_LIB1)(mod_ioserver_para.o) \
-	$(MODEL_LIB1)(mod_mpi_buffer_parameters.o) $(MODEL_LIB1)(mod_pack.o) \
-	$(MODEL_LIB1)(mod_wait.o) $(MODEL_LIB1)(mpi_mod.o) \
-	$(MODEL_LIB1)(mpitrace.o)
-$(MODEL_LIB1)(mod_pack.o): $(MODEL_LIB1)(mod_attribut.o) \
-	$(MODEL_LIB1)(mod_stdtype.o)
-$(MODEL_LIB1)(pack_f.o): $(MODEL_LIB1)(mod_prec.o)
-$(MODEL_LIB1)(server.o): $(MODEL_LIB1)(mod_global_memory.o) \
-	$(MODEL_LIB1)(mod_interface_ioipsl.o) $(MODEL_LIB1)(mod_iomanager.o) \
-	$(MODEL_LIB1)(mod_ioserver_namelist.o) \
-	$(MODEL_LIB1)(mod_ioserver_para.o) \
-	$(MODEL_LIB1)(mod_mpi_buffer_server.o) $(MODEL_LIB1)(mod_wait.o)
-$(MODEL_LIB1)(mod_ioclient_para.o): $(MODEL_LIB1)(mod_ioserver_namelist.o) \
-	$(MODEL_LIB1)(mpi_mod.o) $(MODEL_LIB1)(mpitrace.o)
-$(MODEL_LIB1)(mod_ioserver_para.o): $(MODEL_LIB1)(mod_ioserver_namelist.o) \
-	$(MODEL_LIB1)(mpi_mod.o) $(MODEL_LIB1)(mpitrace.o)
-$(MODEL_LIB1)(mpi_mod.o): 
-$(MODEL_LIB1)(mpitrace.o): 
-$(MODEL_LIB2)(mod_attribut.o): $(MODEL_LIB2)(mod_attribut_list.o) \
-	$(MODEL_LIB2)(mod_error_msg.o) $(MODEL_LIB2)(mod_object.o) \
-	$(MODEL_LIB2)(mod_stdtype.o) $(MODEL_LIB2)(mod_xmlio_parameters.o) \
-	$(MODEL_LIB2)(string_function.o)
-$(MODEL_LIB2)(mod_attribut_list.o): $(MODEL_LIB2)(mod_axis_attribut.o) \
-	$(MODEL_LIB2)(mod_field_attribute.o) \
-	$(MODEL_LIB2)(mod_file_attribut.o) $(MODEL_LIB2)(mod_grid_attribut.o) \
-	$(MODEL_LIB2)(mod_zoom_attribut.o)
-$(MODEL_LIB2)(mod_axis.o): $(MODEL_LIB2)(mod_attribut.o) \
-	$(MODEL_LIB2)(mod_axis_attribut.o) $(MODEL_LIB2)(mod_error_msg.o) \
-	$(MODEL_LIB2)(mod_sorted_list.o) \
-	$(MODEL_LIB2)(mod_xmlio_parameters.o) \
-	$(MODEL_LIB2)(string_function.o) ../src/XMLIO/vector_axis_def.inc
-$(MODEL_LIB2)(mod_axis_attribut.o): $(MODEL_LIB2)(mod_object.o)
-$(MODEL_LIB2)(mod_axis_definition.o): $(MODEL_LIB2)(mod_axis_group.o)
-$(MODEL_LIB2)(mod_axis_group.o): $(MODEL_LIB2)(mod_attribut.o) \
-	$(MODEL_LIB2)(mod_axis.o) $(MODEL_LIB2)(mod_error_msg.o) \
-	$(MODEL_LIB2)(mod_object.o) $(MODEL_LIB2)(mod_xmlio_parameters.o) \
-	$(MODEL_LIB2)(string_function.o) \
-	../src/XMLIO/vector_axis_group_def.inc
-$(MODEL_LIB2)(mod_context.o): $(MODEL_LIB2)(mod_axis.o) \
-	$(MODEL_LIB2)(mod_axis_definition.o) $(MODEL_LIB2)(mod_axis_group.o) \
-	$(MODEL_LIB2)(mod_dependency.o) $(MODEL_LIB2)(mod_field.o) \
-	$(MODEL_LIB2)(mod_field_definition.o) \
-	$(MODEL_LIB2)(mod_field_group.o) $(MODEL_LIB2)(mod_file.o) \
-	$(MODEL_LIB2)(mod_file_definition.o) $(MODEL_LIB2)(mod_file_group.o) \
-	$(MODEL_LIB2)(mod_grid.o) $(MODEL_LIB2)(mod_grid_definition.o) \
-	$(MODEL_LIB2)(mod_grid_group.o) $(MODEL_LIB2)(mod_sorted_list.o) \
-	$(MODEL_LIB2)(mod_time_parameters.o) \
-	$(MODEL_LIB2)(mod_xmlio_parameters.o) $(MODEL_LIB2)(mod_zoom.o) \
-	$(MODEL_LIB2)(string_function.o) ../src/XMLIO/vector_context_def.inc
-$(MODEL_LIB2)(mod_dependency.o): $(MODEL_LIB2)(mod_axis.o) \
-	$(MODEL_LIB2)(mod_field.o) $(MODEL_LIB2)(mod_file.o) \
-	$(MODEL_LIB2)(mod_file_definition.o) $(MODEL_LIB2)(mod_file_group.o) \
-	$(MODEL_LIB2)(mod_grid.o) $(MODEL_LIB2)(mod_sorted_list.o) \
-	$(MODEL_LIB2)(mod_zoom.o) $(MODEL_LIB2)(string_function.o) \
-	../src/XMLIO/vector_field_dep_def.inc
-$(MODEL_LIB2)(mod_domain.o): $(MODEL_LIB2)(mod_error_msg.o) \
-	$(MODEL_LIB2)(mod_xmlio_parameters.o) \
-	../src/XMLIO/vector_domain_def.inc
-$(MODEL_LIB2)(mod_error_msg.o): $(MODEL_LIB2)(mod_xmlio_parameters.o)
-$(MODEL_LIB2)(mod_field.o): $(MODEL_LIB2)(mod_attribut.o) \
-	$(MODEL_LIB2)(mod_axis.o) $(MODEL_LIB2)(mod_error_msg.o) \
-	$(MODEL_LIB2)(mod_field_attribute.o) $(MODEL_LIB2)(mod_grid.o) \
-	$(MODEL_LIB2)(mod_sorted_list.o) \
-	$(MODEL_LIB2)(mod_xmlio_parameters.o) $(MODEL_LIB2)(mod_zoom.o) \
-	$(MODEL_LIB2)(string_function.o) ../src/XMLIO/vector_field_def.inc
-$(MODEL_LIB2)(mod_field_attribute.o): $(MODEL_LIB2)(mod_object.o)
-$(MODEL_LIB2)(mod_field_definition.o): $(MODEL_LIB2)(mod_field_group.o)
-$(MODEL_LIB2)(mod_field_group.o): $(MODEL_LIB2)(mod_attribut.o) \
-	$(MODEL_LIB2)(mod_error_msg.o) $(MODEL_LIB2)(mod_field.o) \
-	$(MODEL_LIB2)(mod_object.o) $(MODEL_LIB2)(mod_xmlio_parameters.o) \
-	$(MODEL_LIB2)(string_function.o) \
-	../src/XMLIO/vector_field_group_def.inc
-$(MODEL_LIB2)(mod_file.o): $(MODEL_LIB2)(mod_attribut.o) \
-	$(MODEL_LIB2)(mod_error_msg.o) $(MODEL_LIB2)(mod_field_group.o) \
-	$(MODEL_LIB2)(mod_file_attribut.o) $(MODEL_LIB2)(mod_sorted_list.o) \
-	$(MODEL_LIB2)(mod_xmlio_parameters.o) \
-	$(MODEL_LIB2)(string_function.o) ../src/XMLIO/vector_file_def.inc
-$(MODEL_LIB2)(mod_file_attribut.o): $(MODEL_LIB2)(mod_object.o)
-$(MODEL_LIB2)(mod_file_definition.o): $(MODEL_LIB2)(mod_file_group.o)
-$(MODEL_LIB2)(mod_file_group.o): $(MODEL_LIB2)(mod_attribut.o) \
-	$(MODEL_LIB2)(mod_error_msg.o) $(MODEL_LIB2)(mod_file.o) \
-	$(MODEL_LIB2)(mod_object.o) $(MODEL_LIB2)(mod_xmlio_parameters.o) \
-	$(MODEL_LIB2)(string_function.o) \
-	../src/XMLIO/vector_file_group_def.inc
-$(MODEL_LIB2)(mod_grid.o): $(MODEL_LIB2)(mod_attribut.o) \
-	$(MODEL_LIB2)(mod_domain.o) $(MODEL_LIB2)(mod_error_msg.o) \
-	$(MODEL_LIB2)(mod_grid_attribut.o) $(MODEL_LIB2)(mod_sorted_list.o) \
-	$(MODEL_LIB2)(mod_xmlio_parameters.o) $(MODEL_LIB2)(mod_zoom.o) \
-	$(MODEL_LIB2)(string_function.o) ../src/XMLIO/vector_grid_def.inc
-$(MODEL_LIB2)(mod_grid_attribut.o): $(MODEL_LIB2)(mod_object.o)
-$(MODEL_LIB2)(mod_grid_definition.o): $(MODEL_LIB2)(mod_grid_group.o)
-$(MODEL_LIB2)(mod_grid_group.o): $(MODEL_LIB2)(mod_attribut.o) \
-	$(MODEL_LIB2)(mod_error_msg.o) $(MODEL_LIB2)(mod_grid.o) \
-	$(MODEL_LIB2)(mod_object.o) $(MODEL_LIB2)(mod_xmlio_parameters.o) \
-	$(MODEL_LIB2)(string_function.o) \
-	../src/XMLIO/vector_grid_group_def.inc
-$(MODEL_LIB2)(mod_parse_xml.o): $(MODEL_LIB2)(mod_axis.o) \
-	$(MODEL_LIB2)(mod_axis_definition.o) $(MODEL_LIB2)(mod_axis_group.o) \
-	$(MODEL_LIB2)(mod_context.o) $(MODEL_LIB2)(mod_error_msg.o) \
-	$(MODEL_LIB2)(mod_field.o) $(MODEL_LIB2)(mod_field_definition.o) \
-	$(MODEL_LIB2)(mod_field_group.o) $(MODEL_LIB2)(mod_file.o) \
-	$(MODEL_LIB2)(mod_file_definition.o) $(MODEL_LIB2)(mod_file_group.o) \
-	$(MODEL_LIB2)(mod_grid.o) $(MODEL_LIB2)(mod_grid_definition.o) \
-	$(MODEL_LIB2)(mod_grid_group.o) $(MODEL_LIB2)(mod_zoom.o) \
-	$(MODEL_LIB2)(string_function.o)
-$(MODEL_LIB2)(mod_sorted_list.o): ../src/XMLIO/vector_node_def.inc
-$(MODEL_LIB2)(mod_zoom.o): $(MODEL_LIB2)(mod_attribut.o) \
-	$(MODEL_LIB2)(mod_error_msg.o) $(MODEL_LIB2)(mod_sorted_list.o) \
-	$(MODEL_LIB2)(mod_xmlio_parameters.o) \
-	$(MODEL_LIB2)(mod_zoom_attribut.o) $(MODEL_LIB2)(string_function.o) \
-	../src/XMLIO/vector_zoom_def.inc
-$(MODEL_LIB2)(mod_zoom_attribut.o): $(MODEL_LIB2)(mod_object.o)
-$(MODEL_LIB2)(string_function.o): $(MODEL_LIB2)(mod_error_msg.o) \
-	$(MODEL_LIB2)(mod_xmlio_parameters.o)
-$(MODEL_LIB2)(test_xmlio.o): $(MODEL_LIB2)(mod_interface_ioipsl.o) \
-	$(MODEL_LIB2)(xmlio.o)
-$(MODEL_LIB2)(xmlio.o): $(MODEL_LIB2)(mod_axis.o) \
-	$(MODEL_LIB2)(mod_axis_definition.o) $(MODEL_LIB2)(mod_axis_group.o) \
-	$(MODEL_LIB2)(mod_context.o) $(MODEL_LIB2)(mod_dependency.o) \
-	$(MODEL_LIB2)(mod_error_msg.o) $(MODEL_LIB2)(mod_field.o) \
-	$(MODEL_LIB2)(mod_field_definition.o) \
-	$(MODEL_LIB2)(mod_field_group.o) $(MODEL_LIB2)(mod_file.o) \
-	$(MODEL_LIB2)(mod_file_definition.o) $(MODEL_LIB2)(mod_file_group.o) \
-	$(MODEL_LIB2)(mod_grid.o) $(MODEL_LIB2)(mod_grid_definition.o) \
-	$(MODEL_LIB2)(mod_grid_group.o) $(MODEL_LIB2)(mod_parse_xml.o) \
-	$(MODEL_LIB2)(mod_time_parameters.o) $(MODEL_LIB2)(string_function.o)
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/AA_make.ldef
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/AA_make.ldef	(revision 2527)
+++ 	(revision )
@@ -1,13 +1,0 @@
-#-
-#- $Id: $
-#-
-#---------------------------------------------------------------------
-#- Local parameters for "libxml90"
-#---------------------------------------------------------------------
-SHELL = /bin/ksh
-#---------------------------------------------------------------------
-LIBDIR = ../../../lib/libxmlio_server
-MODDIR = $(LIBDIR)
-#---------------------------------------------------------------------
-MODEL_LIB1 = $(LIBDIR)/libioserver.a
-MODEL_LIB2 = $(LIBDIR)/libxmlio.a
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/makemake_XMLIO.perl
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/makemake_XMLIO.perl	(revision 2527)
+++ 	(revision )
@@ -1,403 +1,0 @@
-#!/usr/bin/perl
-#
-# Usage: makemake {<program name> {<F90 compiler or fc or f77 or cc or c>}}
-#
-# Generate a Makefile from the sources in the current directory.  The source
-# files may be in either C, FORTRAN 77, Fortran 90 or some combination of
-# these languages.  If the F90 compiler specified is cray or parasoft, then
-# the Makefile generated will conform to the conventions of these compilers.
-# To run makemake, it will be necessary to modify the first line of this script
-# to point to the actual location of Perl on your system.
-#
-# Written by Michael Wester <wester@math.unm.edu> February 16, 1995
-# Cotopaxi (Consulting), Albuquerque, New Mexico
-#
-open(MAKEFILE, "> AA_make");
-#
-#print MAKEFILE "PROG =\t$ARGV[0]\n\n";
-#
-# Misc
-
-print MAKEFILE "VPATH=../src/IOSERVER:../src/XMLIO\n";
-print MAKEFILE "MAKE_NAM = \$(MAKE)\n";
-print MAKEFILE "ifneq (\$(MAKE_NAM),\$(M_K))\n";
-print MAKEFILE " \@\$(error You must invoke this Makefile with the \$(M_K) command)\n";
-print MAKEFILE "endif\n";
-print MAKEFILE "USER_DIR = \$(shell /bin/pwd)\n";
-print MAKEFILE "MAKE_DIR = '??'\n";
-print MAKEFILE "ifneq (\$(USER_DIR),\$(MAKE_DIR))\n";
-print MAKEFILE " \@\$(error You must invoke this Makefile from its directory)\n";
-print MAKEFILE "endif\n";
-print MAKEFILE "#-\n";
-print MAKEFILE "#-Q- sx6nec F_O := \$(F_O) -Wf,-ptr byte\n";
-print MAKEFILE "#-Q- sx8brodie F_O := \$(F_O) -Wf,-ptr byte\n";
-print MAKEFILE "#-Q- sx8mercure F_O := \$(F_O) -Wf,-ptr byte\n";
-print MAKEFILE "#-Q- sx9mercure F_O := \$(F_O) -Wf,-ptr byte\n";
-print MAKEFILE "#-Q- sxdkrz F_O := \$(F_O) -Wf,-ptr byte\n";
-print MAKEFILE "#-Q- es2 F_O := \$(F_O) -Wf,-ptr byte\n";
-print MAKEFILE "#-Q- aix6 F_O = \$(F_P) -O3 -qextname -qsuffix=cpp=F90 -qsuffix=f=f90  -qmoddir=\$(MODDIR) -I \$(MODDIR)\n";
-print MAKEFILE "#-Q- aix F_O = \$(F_P) -O3 -qextname -qsuffix=cpp=F90 -qsuffix=f=f90  -qmoddir=\$(MODDIR) -I \$(MODDIR)\n";
-print MAKEFILE "#-Q- osxxlf F_O = \$(F_P) -O3 -qextname -qsuffix=cpp=F90 -qsuffix=f=f90  -qmoddir=\$(MODDIR) -I \$(MODDIR)\n";
-print MAKEFILE "F_O := \$(F_O) -I../../../lib\n";
-print MAKEFILE "P_O := \$(P_O) -traditional\n";
-print MAKEFILE "#-Q- aix6 L_O = \$(F_P) -q64 -O3\n"; 
-print MAKEFILE "#-Q- aix L_O = \$(F_P) -q64 -O3\n"; 
-print MAKEFILE "prefix=''\n";
-print MAKEFILE "#-Q- aix6 prefix='-WF,'\n";
-print MAKEFILE "#-Q- aix prefix='-WF,'\n";
-print MAKEFILE "override P_P := \$(P_P:\%=\$(prefix)\%)\n\n";
-print MAKEFILE "#---------------------------------------------------------------------\n";
-print MAKEFILE "#- Create libioserver and libxmlio\n";
-print MAKEFILE "#---------------------------------------------------------------------\n\n";
-
-print MAKEFILE ".PRECIOUS : \$(MODEL_LIB1) \$(MODEL_LIB2)\n";
-print MAKEFILE "SXMODEL_LIB1 = \$(MODEL_LIB1)\n";
-print MAKEFILE "SXMODEL_LIB2 = \$(MODEL_LIB2)\n";
-print MAKEFILE "ifeq (\$(L_X),1)\n";
-print MAKEFILE "SXMODEL_LIB1 = \$(LIBDIR)/libsxioserver.a\n";
-print MAKEFILE "SXMODEL_LIB2 = \$(LIBDIR)/libsxxmlio.a\n";
-print MAKEFILE ".PRECIOUS : \$(SXMODEL_LIB1) \$(SXMODEL_LIB2)\n";
-print MAKEFILE "endif\n\n";
-
-# Source listing
-#IOSERVER
-print MAKEFILE "MODS1 =\t";
-@srcs = < ../src/IOSERVER/*.F90 ../src/IOSERVER/*.f90>;
-&PrintWords(8, 0, @srcs);
-print MAKEFILE "\n\n";
-#
-# Object listing
-#
-print MAKEFILE "OBJSMODS1 =\t";
-@objs =  @srcs;
-foreach (@objs) { s/\.[^.]+$/.o/ };
-         foreach $objs (@objs) {
-         @tab = split('/', $objs);
-         $objs = $tab[$#tab] ;
-         if( "$objs" eq 'server.o' ){
-         $objs = ''};
-         };
-         
-&PrintWords(8, 0, @objs);
-print MAKEFILE "\n\n";
-
-# Source listing
-#XMLIO
-print MAKEFILE "MODS2 =\t";
-@srcs = < ../src/XMLIO/*.F90 ../src/XMLIO/*.f90>;
-&PrintWords(8, 0, @srcs);
-print MAKEFILE "\n\n";
-#
-# Object listing
-#
-print MAKEFILE "OBJSMODS2 =\t";
-@objs =  @srcs;
-foreach (@objs) { s/\.[^.]+$/.o/ };
-         foreach $objs (@objs) {
-         @tab = split('/', $objs);
-         $objs = $tab[$#tab] ;
-         if( "$objs" eq 'test_xmlio.o' ){
-         $objs = ''};
-         };
-
-&PrintWords(8, 0, @objs);
-print MAKEFILE "\n\n";
-
-#
-# make
-#
-print MAKEFILE ".SUFFIXES: .f90 .F90\n\n";
-
-print MAKEFILE "all: libioipsl libxmlf90 dirxml \$(MODEL_LIB2)(\$(OBJSMODS2)) key \$(MODEL_LIB1)(\$(OBJSMODS1)) server.o EXEC_BIN\n";
-print MAKEFILE "\t\@echo IOSERVER is OK\n\n";
-
-# mpi or not
-print MAKEFILE "key :\n";
-print MAKEFILE "\t\-\@if [ \"`cat KEY_CPP`\" \!= \"\$(P_P)\" ] \; then \\\n";
-print MAKEFILE "\techo \"\$(P_P)\" > KEY_CPP \; fi\n\n";
-
-
-# Main program
-print MAKEFILE "ifneq  (,\$(findstring NO_MPI,\$(P_P)))\n";
-print MAKEFILE "EXEC_BIN :\n";
-print MAKEFILE "server.o :\n";
-print MAKEFILE "else\n";
-print MAKEFILE "EXEC_BIN : server.o\n";
-print MAKEFILE "\t\$(F_L) \$(L_O) -o ../../../bin/ioserver server.o \$(MODEL_LIB1) \$(MODEL_LIB2) ../../../lib/libioipsl.a \$(NCDF_LIB) ../../../lib/libxmlio_server/libxmlf90.a\n";
-print MAKEFILE "server.o :       ../src/IOSERVER/server.f90\n";
-print MAKEFILE "\t\@\$(F_C) \$(F_O) -c ../src/IOSERVER/server.f90\n";
-print MAKEFILE "endif\n\n";
-
-
-# .f90 -> .o
-#
-
-print MAKEFILE "#Rules for ioserver\n";
-print MAKEFILE "#---- Using VPATH instead \$(MODEL_LIB1)(%.o): ../src/IOSERVER/%.f90\n";
-print MAKEFILE "\$(MODEL_LIB1)(%.o): %.f90\n";
-print MAKEFILE "\t\$(F_C) \$(F_O)  -I../src/XMLIO -I../src/IOSERVER -I\$(NCDF_INC) \$<\n";
-print MAKEFILE "\t\$(A_C) \$(MODEL_LIB1) \$*.o\n";
-print MAKEFILE "ifeq (\$(L_X),1)\n";
-print MAKEFILE "\t\$(A_X) \$(SXMODEL_LIB1) \$*.o\n";
-print MAKEFILE "endif\n";
-print MAKEFILE "#-Q- sgi6       mv \$(shell echo \$* | tr '[:lower:]' '[:upper:]').mod \$(MODDIR)\n";
-print MAKEFILE "ifeq (\$(M_M),1)\n";
-print MAKEFILE "\t\@mv -f *.mod \$(MODDIR)  2> /dev/null || true\n";
-print MAKEFILE "endif\n";
-print MAKEFILE "\t\$(RM) \$*.o\n\n";
-
-print MAKEFILE "#Rules for ioserver\n";
-#print MAKEFILE "\$src/IOSERVER/%.f90: ../src/IOSERVER/%.F90\n";
-#print MAKEFILE "\t@\$(P_C) \$(P_O) \$(P_P) src/IOSERVER/\$(*F).F90 > src/IOSERVER/\$(*F).f90\n\n";
-print MAKEFILE "#---- Using VPATH instead \$(MODEL_LIB1)(%.o): ../src/IOSERVER/%.F90\n";
-print MAKEFILE "\$(MODEL_LIB1)(%.o): %.F90 KEY_CPP\n";
-print MAKEFILE "\t\$(F_C) \$(F_O) \$(P_P) -I\$(NCDF_INC) -I../src/XMLIO -I../src/IOSERVER \$<\n";
-print MAKEFILE "\t\$(A_C) \$(MODEL_LIB1) \$*.o\n";
-print MAKEFILE "ifeq (\$(L_X),1)\n";
-print MAKEFILE "\t\$(A_X) \$(SXMODEL_LIB1) \$*.o\n";
-print MAKEFILE "endif\n";
-print MAKEFILE "#-Q- sgi6       mv \$(shell echo \$* | tr '[:lower:]' '[:upper:]').mod \$(MODDIR)\n";
-print MAKEFILE "ifeq (\$(M_M),1)\n";
-print MAKEFILE "\t\@mv -f *.mod \$(MODDIR)  2> /dev/null || true\n";
-print MAKEFILE "endif\n";
-print MAKEFILE "\t\$(RM) \$*.o\n\n";
-
-print MAKEFILE "#Rules for xmlio\n";
-print MAKEFILE "#---- Using VPATH instead \$(MODEL_LIB1)(%.o): ../src/XMLIO/%.F90\n";
-print MAKEFILE "\$(MODEL_LIB2)(%.o): %.f90\n";
-print MAKEFILE "\t\$(F_C) \$(F_O) -I\$(NCDF_INC) -I../src/XMLIO \$<\n";
-print MAKEFILE "\t\$(A_C) \$(MODEL_LIB2) \$*.o\n";
-print MAKEFILE "ifeq (\$(L_X),1)\n";
-print MAKEFILE "\t\$(A_X) \$(SXMODEL_LIB2) \$*.o\n";
-print MAKEFILE "endif\n";
-print MAKEFILE "#-Q- sgi6       mv \$(shell echo \$* | tr '[:lower:]' '[:upper:]').mod \$(MODDIR)\n";
-print MAKEFILE "ifeq (\$(M_M),1)\n";
-print MAKEFILE "\t\@mv -f *.mod \$(MODDIR)  2> /dev/null || true\n";
-print MAKEFILE "endif\n";
-print MAKEFILE "\t\$(RM) \$*.o\n\n";
-
-
-
-
-print MAKEFILE "dirxml: \n";
-print MAKEFILE "\t\@if [ ! -d ../../../lib/libxmlio_server ] ; then mkdir ../../../lib/libxmlio_server ; fi\n\n";
-
-print MAKEFILE "# IOIPSL library\n";
-print MAKEFILE "libioipsl :\n";
-print MAKEFILE "\t(cd ../../IOIPSL/src ; \$(M_K) -f Makefile )\n\n";
-
-print MAKEFILE "# XMLF90 library\n";
-print MAKEFILE "libxmlf90 :\n";
-print MAKEFILE "\t(cd ../../XMLF90/external ; \$(M_K) -f Makefile )\n\n";
-
-#
-# make clean
-#
-print MAKEFILE "clean:\n";
-print MAKEFILE "\t\$(RM) *.*~ Makefile~ core *.o *.mod i.*.L *.L\n";
-print MAKEFILE "\t\$(RM) server.o \$(MODEL_LIB1) \$(MODEL_LIB2)\n\n";
-#
-#
-# Dependency listings
-#
-&MakeDependsf90($ARGV[1],IOSERVER,MODEL_LIB1);
-&MakeDependsf90($ARGV[1],XMLIO,MODEL_LIB2);
-&MakeDepends("*.f *.F", '^\s*include\s+["\']([^"\']+)["\']');
-&MakeDepends("*.c",     '^\s*#\s*include\s+["\']([^"\']+)["\']');
-
-#
-# &PrintWords(current output column, extra tab?, word list); --- print words
-#    nicely
-#
-sub PrintWords {
-   local($columns) = 78 - shift(@_);
-   local($extratab) = shift(@_);
-   local($wordlength);
-   #
-   print MAKEFILE @_[0];
-   $columns -= length(shift(@_));
-   foreach $word (@_) {
-      $wordlength = length($word);
-      if ($wordlength + 1 < $columns) {
-         print MAKEFILE " $word";
-         $columns -= $wordlength + 1;
-         }
-      else {
-         #
-         # Continue onto a new line
-         #
-         if ($extratab) {
-            print MAKEFILE " \\\n\t\t$word";
-            $columns = 62 - $wordlength;
-            }
-         else {
-            print MAKEFILE " \\\n\t$word";
-            $columns = 70 - $wordlength;
-            }
-         }
-      }
-   }
-
-#
-# &LanguageCompiler(compiler, sources); --- determine the correct language
-#    compiler
-#
-sub LanguageCompiler {
-   local($compiler) = &toLower(shift(@_));
-   local(@srcs) = @_;
-   #
-   if (length($compiler) > 0) {
-      CASE: {
-         grep(/^$compiler$/, ("fc", "f77")) &&
-            do { $compiler = "FC"; last CASE; };
-         grep(/^$compiler$/, ("cc", "c"))   &&
-            do { $compiler = "CC"; last CASE; };
-         $compiler = "F90";
-         }
-      }
-   else {
-      CASE: {
-         grep(/\.f90$/, @srcs)   && do { $compiler = "F90"; last CASE; };
-         grep(/\.(f|F)$/, @srcs) && do { $compiler = "FC";  last CASE; };
-         grep(/\.c$/, @srcs)     && do { $compiler = "CC";  last CASE; };
-         $compiler = "???";
-         }
-      }
-   $compiler;
-   }
-
-#
-# &toLower(string); --- convert string into lower case
-#
-sub toLower {
-   local($string) = @_[0];
-   $string =~ tr/A-Z/a-z/;
-   $string;
-   }
-
-#
-# &uniq(sorted word list); --- remove adjacent duplicate words
-#
-sub uniq {
-   local(@words);
-   foreach $word (@_) {
-      if ($word ne $words[$#words]) {
-         push(@words, $word);
-         }
-      }
-   @words;
-   }
-
-#
-# &MakeDepends(language pattern, include file sed pattern); --- dependency
-#    maker
-#
-sub MakeDepends {
-   local(@incs);
-   local($lang) = @_[0];
-   local($pattern) = @_[1];
-   #
-   foreach $file (<${lang}>) {
-      open(FILE, $file) || warn "Cannot open $file: $!\n";
-      while (<FILE>) {
-         /$pattern/i && push(@incs, $1);
-         }
-      if (defined @incs) {
-         $file =~ s/\.[^.]+$/.o/;
-         @tab = split('/', $file);
-         $file = '$(MODEL_LIB)(' . $tab[$#tab] . ')' ;
-         print MAKEFILE "$file: ";
-         &PrintWords(length($file) + 2, 0, @incs);
-         print MAKEFILE "\n";
-         undef @incs;
-         }
-      }
-   }
-
-#
-# &MakeDependsf90(f90 compiler); --- FORTRAN 90 dependency maker
-#
-sub MakeDependsf90 {
-   local($compiler) = &toLower(@_[0]);
-   local(@dependencies);
-   local(%filename);
-   local(@incs);
-   local(@modules);
-   local($objfile);
-   local($DIR) = @_[1];
-   local($MODEL_LIB) = @_[2];
-   #
-   # Associate each module with the name of the file that contains it
-   #
-   foreach $file (<../*/*/*.f90>) {
-      open(FILE, $file) || warn "Cannot open $file: $!\n";
-      while (<FILE>) {
-         /^\s*module\s+([^\s!]+)/i &&
-            ($filename{&toLower($1)} = $file) =~ s/\.f90$/.o/;
-         }
-      }
-   foreach $file (<../*/*/*.F90>) {
-      open(FILE, $file) || warn "Cannot open $file: $!\n";
-      while (<FILE>) {
-         /^\s*module\s+([^\s!]+)/i &&
-            ($filename{&toLower($1)} = $file) =~ s/\.F90$/.o/;
-         }
-      }
-
-   #
-   # Print the dependencies of each file that has one or more include's or
-   # references one or more modules
-   #
-   foreach $file (<../src/$DIR/*.f90 ../src/$DIR/*.F90>) {
-      open(FILE, $file);
-      while (<FILE>) {
-         /^\s*include\s+["\']([^"\']+)["\']/i && push(@incs, $1);
-         /^\s*use\s+([^\s,!]+)/i && push(@modules, &toLower($1));
-         }
-      if (defined @incs || defined @modules) {
-#         ($objfile = $file) =~ s/\.F90$/.o/;
-         ($objfile = $file) =~ s/\.[fF]90$/.o/;
-         @tab = split('/', $objfile);
-         $objfile = '$(' . $MODEL_LIB . ')(' . $tab[$#tab] . ')' ;
-
-         print MAKEFILE "$objfile: ";
-         undef @dependencies;
-         foreach $module (@modules) {
-            push(@dependencies, $filename{$module});
-            }
-         @dependencies = &uniq(sort(@dependencies));
-
-         foreach $dependencies (@dependencies) {
-         	
-         @tab = split('/', $dependencies);
-         $dependencies = '$(' . $MODEL_LIB . ')(' . $tab[$#tab] . ')';
-
-             if( "$DIR" eq 'IOSERVER'  && "$dependencies" eq '$(MODEL_LIB1)(xmlio.o)' ) {
-             	$dependencies = '$(MODEL_LIB2)'
-#                $dependencies = ''
-
-             }          
-         }
-
-         foreach $incs (@incs) {
-         @tab = split('/', $incs);
-         @incs = '../src' . '/' . $DIR. '/' . $tab[$#tab] ;
-         }
-        foreach $incs (@incs) {
-             if( "$incs" eq '../src/IOSERVER/mpif.h' ||  "$incs" eq '../src/IOSERVER/VT.inc' ||  "$incs" eq  '../src/IOSERVER/ios_mpif.h' ) {
-                $incs = '';
-       }
-       }
-
- 
-
-         &PrintWords(length($objfile) + 2, 0,
-                     @dependencies, &uniq(sort(@incs)));
-         print MAKEFILE "\n";
-         undef @incs;
-         undef @modules;
-         #
-         #
-         }
-      }
-   }
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/init_vampir.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/init_vampir.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/init_vampir.f90	(revision 2528)
@@ -0,0 +1,5 @@
+SUBROUTINE init_vampir
+USE mpitrace
+
+  CALL InitVampir
+END SUBROUTINE init_vampir
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/ios_mpif.h
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/ios_mpif.h	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/ios_mpif.h	(revision 2528)
@@ -0,0 +1,405 @@
+       INTEGER MPI_SOURCE, MPI_TAG, MPI_ERROR
+       PARAMETER (MPI_SOURCE=3,MPI_TAG=4,MPI_ERROR=5)
+       INTEGER MPI_STATUS_SIZE
+       PARAMETER (MPI_STATUS_SIZE=5)
+       INTEGER MPI_STATUS_IGNORE(MPI_STATUS_SIZE)
+       INTEGER MPI_STATUSES_IGNORE(MPI_STATUS_SIZE,1)
+       INTEGER MPI_ERRCODES_IGNORE(1)
+       CHARACTER*1 MPI_ARGVS_NULL(1,1)
+       CHARACTER*1 MPI_ARGV_NULL(1)
+       INTEGER MPI_SUCCESS
+       PARAMETER (MPI_SUCCESS=0)
+       INTEGER MPI_ERR_OTHER
+       PARAMETER (MPI_ERR_OTHER=15)
+       INTEGER MPI_ERR_WIN
+       PARAMETER (MPI_ERR_WIN=45)
+       INTEGER MPI_ERR_FILE
+       PARAMETER (MPI_ERR_FILE=27)
+       INTEGER MPI_ERR_COUNT
+       PARAMETER (MPI_ERR_COUNT=2)
+       INTEGER MPI_ERR_SPAWN
+       PARAMETER (MPI_ERR_SPAWN=42)
+       INTEGER MPI_ERR_BASE
+       PARAMETER (MPI_ERR_BASE=46)
+       INTEGER MPI_ERR_RMA_CONFLICT
+       PARAMETER (MPI_ERR_RMA_CONFLICT=49)
+       INTEGER MPI_ERR_IN_STATUS
+       PARAMETER (MPI_ERR_IN_STATUS=17)
+       INTEGER MPI_ERR_INFO_KEY
+       PARAMETER (MPI_ERR_INFO_KEY=29)
+       INTEGER MPI_ERR_LOCKTYPE
+       PARAMETER (MPI_ERR_LOCKTYPE=47)
+       INTEGER MPI_ERR_OP
+       PARAMETER (MPI_ERR_OP=9)
+       INTEGER MPI_ERR_ARG
+       PARAMETER (MPI_ERR_ARG=12)
+       INTEGER MPI_ERR_READ_ONLY
+       PARAMETER (MPI_ERR_READ_ONLY=40)
+       INTEGER MPI_ERR_SIZE
+       PARAMETER (MPI_ERR_SIZE=51)
+       INTEGER MPI_ERR_BUFFER
+       PARAMETER (MPI_ERR_BUFFER=1)
+       INTEGER MPI_ERR_DUP_DATAREP
+       PARAMETER (MPI_ERR_DUP_DATAREP=24)
+       INTEGER MPI_ERR_UNSUPPORTED_DATAREP
+       PARAMETER (MPI_ERR_UNSUPPORTED_DATAREP=43)
+       INTEGER MPI_ERR_LASTCODE
+       PARAMETER (MPI_ERR_LASTCODE=1073741823)
+       INTEGER MPI_ERR_TRUNCATE
+       PARAMETER (MPI_ERR_TRUNCATE=14)
+       INTEGER MPI_ERR_DISP
+       PARAMETER (MPI_ERR_DISP=52)
+       INTEGER MPI_ERR_PORT
+       PARAMETER (MPI_ERR_PORT=38)
+       INTEGER MPI_ERR_INFO_NOKEY
+       PARAMETER (MPI_ERR_INFO_NOKEY=31)
+       INTEGER MPI_ERR_ASSERT
+       PARAMETER (MPI_ERR_ASSERT=53)
+       INTEGER MPI_ERR_FILE_EXISTS
+       PARAMETER (MPI_ERR_FILE_EXISTS=25)
+       INTEGER MPI_ERR_PENDING
+       PARAMETER (MPI_ERR_PENDING=18)
+       INTEGER MPI_ERR_COMM
+       PARAMETER (MPI_ERR_COMM=5)
+       INTEGER MPI_ERR_KEYVAL
+       PARAMETER (MPI_ERR_KEYVAL=48)
+       INTEGER MPI_ERR_NAME
+       PARAMETER (MPI_ERR_NAME=33)
+       INTEGER MPI_ERR_REQUEST
+       PARAMETER (MPI_ERR_REQUEST=19)
+       INTEGER MPI_ERR_GROUP
+       PARAMETER (MPI_ERR_GROUP=8)
+       INTEGER MPI_ERR_TOPOLOGY
+       PARAMETER (MPI_ERR_TOPOLOGY=10)
+       INTEGER MPI_ERR_TYPE
+       PARAMETER (MPI_ERR_TYPE=3)
+       INTEGER MPI_ERR_TAG
+       PARAMETER (MPI_ERR_TAG=4)
+       INTEGER MPI_ERR_INFO_VALUE
+       PARAMETER (MPI_ERR_INFO_VALUE=30)
+       INTEGER MPI_ERR_NOT_SAME
+       PARAMETER (MPI_ERR_NOT_SAME=35)
+       INTEGER MPI_ERR_RMA_SYNC
+       PARAMETER (MPI_ERR_RMA_SYNC=50)
+       INTEGER MPI_ERR_INFO
+       PARAMETER (MPI_ERR_INFO=28)
+       INTEGER MPI_ERR_NO_MEM
+       PARAMETER (MPI_ERR_NO_MEM=34)
+       INTEGER MPI_ERR_BAD_FILE
+       PARAMETER (MPI_ERR_BAD_FILE=22)
+       INTEGER MPI_ERR_FILE_IN_USE
+       PARAMETER (MPI_ERR_FILE_IN_USE=26)
+       INTEGER MPI_ERR_UNKNOWN
+       PARAMETER (MPI_ERR_UNKNOWN=13)
+       INTEGER MPI_ERR_UNSUPPORTED_OPERATION
+       PARAMETER (MPI_ERR_UNSUPPORTED_OPERATION=44)
+       INTEGER MPI_ERR_QUOTA
+       PARAMETER (MPI_ERR_QUOTA=39)
+       INTEGER MPI_ERR_AMODE
+       PARAMETER (MPI_ERR_AMODE=21)
+       INTEGER MPI_ERR_ROOT
+       PARAMETER (MPI_ERR_ROOT=7)
+       INTEGER MPI_ERR_RANK
+       PARAMETER (MPI_ERR_RANK=6)
+       INTEGER MPI_ERR_DIMS
+       PARAMETER (MPI_ERR_DIMS=11)
+       INTEGER MPI_ERR_NO_SUCH_FILE
+       PARAMETER (MPI_ERR_NO_SUCH_FILE=37)
+       INTEGER MPI_ERR_SERVICE
+       PARAMETER (MPI_ERR_SERVICE=41)
+       INTEGER MPI_ERR_INTERN
+       PARAMETER (MPI_ERR_INTERN=16)
+       INTEGER MPI_ERR_IO
+       PARAMETER (MPI_ERR_IO=32)
+       INTEGER MPI_ERR_ACCESS
+       PARAMETER (MPI_ERR_ACCESS=20)
+       INTEGER MPI_ERR_NO_SPACE
+       PARAMETER (MPI_ERR_NO_SPACE=36)
+       INTEGER MPI_ERR_CONVERSION
+       PARAMETER (MPI_ERR_CONVERSION=23)
+       INTEGER MPI_ERRORS_ARE_FATAL
+       PARAMETER (MPI_ERRORS_ARE_FATAL=1409286144)
+       INTEGER MPI_ERRORS_RETURN
+       PARAMETER (MPI_ERRORS_RETURN=1409286145)
+       INTEGER MPI_IDENT
+       PARAMETER (MPI_IDENT=0)
+       INTEGER MPI_CONGRUENT
+       PARAMETER (MPI_CONGRUENT=1)
+       INTEGER MPI_SIMILAR
+       PARAMETER (MPI_SIMILAR=2)
+       INTEGER MPI_UNEQUAL
+       PARAMETER (MPI_UNEQUAL=3)
+       INTEGER MPI_MAX
+       PARAMETER (MPI_MAX=1476395009)
+       INTEGER MPI_MIN
+       PARAMETER (MPI_MIN=1476395010)
+       INTEGER MPI_SUM
+       PARAMETER (MPI_SUM=1476395011)
+       INTEGER MPI_PROD
+       PARAMETER (MPI_PROD=1476395012)
+       INTEGER MPI_LAND
+       PARAMETER (MPI_LAND=1476395013)
+       INTEGER MPI_BAND
+       PARAMETER (MPI_BAND=1476395014)
+       INTEGER MPI_LOR
+       PARAMETER (MPI_LOR=1476395015)
+       INTEGER MPI_BOR
+       PARAMETER (MPI_BOR=1476395016)
+       INTEGER MPI_LXOR
+       PARAMETER (MPI_LXOR=1476395017)
+       INTEGER MPI_BXOR
+       PARAMETER (MPI_BXOR=1476395018)
+       INTEGER MPI_MINLOC
+       PARAMETER (MPI_MINLOC=1476395019)
+       INTEGER MPI_MAXLOC
+       PARAMETER (MPI_MAXLOC=1476395020)
+       INTEGER MPI_REPLACE
+       PARAMETER (MPI_REPLACE=1476395021)
+       INTEGER MPI_COMM_WORLD
+       PARAMETER (MPI_COMM_WORLD=1140850688)
+       INTEGER MPI_COMM_SELF
+       PARAMETER (MPI_COMM_SELF=1140850689)
+       INTEGER MPI_GROUP_EMPTY
+       PARAMETER (MPI_GROUP_EMPTY=1207959552)
+       INTEGER MPI_COMM_NULL
+       PARAMETER (MPI_COMM_NULL=67108864)
+       INTEGER MPI_WIN_NULL
+       PARAMETER (MPI_WIN_NULL=536870912)
+       INTEGER MPI_FILE_NULL
+       PARAMETER (MPI_FILE_NULL=0)
+       INTEGER MPI_GROUP_NULL
+       PARAMETER (MPI_GROUP_NULL=134217728)
+       INTEGER MPI_OP_NULL
+       PARAMETER (MPI_OP_NULL=402653184)
+       INTEGER MPI_DATATYPE_NULL
+       PARAMETER (MPI_DATATYPE_NULL=201326592)
+       INTEGER MPI_REQUEST_NULL
+       PARAMETER (MPI_REQUEST_NULL=738197504)
+       INTEGER MPI_ERRHANDLER_NULL
+       PARAMETER (MPI_ERRHANDLER_NULL=335544320)
+       INTEGER MPI_INFO_NULL
+       PARAMETER (MPI_INFO_NULL=469762048)
+       INTEGER MPI_TAG_UB
+       PARAMETER (MPI_TAG_UB=1681915906)
+       INTEGER MPI_HOST
+       PARAMETER (MPI_HOST=1681915908)
+       INTEGER MPI_IO
+       PARAMETER (MPI_IO=1681915910)
+       INTEGER MPI_WTIME_IS_GLOBAL
+       PARAMETER (MPI_WTIME_IS_GLOBAL=1681915912)
+       INTEGER MPI_UNIVERSE_SIZE
+       PARAMETER (MPI_UNIVERSE_SIZE=1681915914)
+       INTEGER MPI_LASTUSEDCODE
+       PARAMETER (MPI_LASTUSEDCODE=1681915916)
+       INTEGER MPI_APPNUM
+       PARAMETER (MPI_APPNUM=1681915918)
+       INTEGER MPI_WIN_BASE
+       PARAMETER (MPI_WIN_BASE=1711276034)
+       INTEGER MPI_WIN_SIZE
+       PARAMETER (MPI_WIN_SIZE=1711276036)
+       INTEGER MPI_WIN_DISP_UNIT
+       PARAMETER (MPI_WIN_DISP_UNIT=1711276038)
+       INTEGER MPI_MAX_ERROR_STRING
+       PARAMETER (MPI_MAX_ERROR_STRING=512)
+       INTEGER MPI_MAX_NAME_STRING
+       PARAMETER (MPI_MAX_NAME_STRING=63)
+       INTEGER MPI_MAX_PORT_NAME
+       PARAMETER (MPI_MAX_PORT_NAME=256)
+       INTEGER MPI_MAX_OBJECT_NAME
+       PARAMETER (MPI_MAX_OBJECT_NAME=128)
+       INTEGER MPI_MAX_INFO_KEY
+       PARAMETER (MPI_MAX_INFO_KEY=255)
+       INTEGER MPI_MAX_INFO_VAL
+       PARAMETER (MPI_MAX_INFO_VAL=1024)
+       INTEGER MPI_MAX_PROCESSOR_NAME
+       PARAMETER (MPI_MAX_PROCESSOR_NAME=128)
+       INTEGER MPI_MAX_DATAREP_STRING
+       PARAMETER (MPI_MAX_DATAREP_STRING=128)
+       INTEGER MPI_UNDEFINED, MPI_UNDEFINED_RANK
+       PARAMETER (MPI_UNDEFINED=(-32766))
+       PARAMETER (MPI_UNDEFINED_RANK=(-32766))
+       INTEGER MPI_KEYVAL_INVALID
+       PARAMETER (MPI_KEYVAL_INVALID=603979776)
+       INTEGER MPI_BSEND_OVERHEAD
+       PARAMETER (MPI_BSEND_OVERHEAD=95)
+       INTEGER MPI_PROC_NULL
+       PARAMETER (MPI_PROC_NULL=-1)
+       INTEGER MPI_ANY_SOURCE
+       PARAMETER (MPI_ANY_SOURCE=-2)
+       INTEGER MPI_ANY_TAG
+       PARAMETER (MPI_ANY_TAG=-1)
+       INTEGER MPI_ROOT
+       PARAMETER (MPI_ROOT=-3)
+       INTEGER MPI_GRAPH
+       PARAMETER (MPI_GRAPH=1)
+       INTEGER MPI_CART
+       PARAMETER (MPI_CART=2)
+       INTEGER MPI_VERSION
+       PARAMETER (MPI_VERSION=2)
+       INTEGER MPI_SUBVERSION
+       PARAMETER (MPI_SUBVERSION=0)
+       INTEGER MPI_LOCK_EXCLUSIVE
+       PARAMETER (MPI_LOCK_EXCLUSIVE=234)
+       INTEGER MPI_LOCK_SHARED
+       PARAMETER (MPI_LOCK_SHARED=235)
+       INTEGER MPI_COMPLEX
+       PARAMETER (MPI_COMPLEX=1275072554)
+       INTEGER MPI_DOUBLE_COMPLEX
+       PARAMETER (MPI_DOUBLE_COMPLEX=1275072546)
+       INTEGER MPI_LOGICAL
+       PARAMETER (MPI_LOGICAL=1275069469)
+       INTEGER MPI_REAL
+       PARAMETER (MPI_REAL=1275070505)
+       INTEGER MPI_DOUBLE_PRECISION
+       PARAMETER (MPI_DOUBLE_PRECISION=1275070495)
+       INTEGER MPI_INTEGER
+       PARAMETER (MPI_INTEGER=1275069467)
+       INTEGER MPI_2INTEGER
+       PARAMETER (MPI_2INTEGER=1275070496)
+       INTEGER MPI_2COMPLEX
+       PARAMETER (MPI_2COMPLEX=1275072548)
+       INTEGER MPI_2DOUBLE_PRECISION
+       PARAMETER (MPI_2DOUBLE_PRECISION=1275072547)
+       INTEGER MPI_2REAL
+       PARAMETER (MPI_2REAL=1275070497)
+       INTEGER MPI_2DOUBLE_COMPLEX
+       PARAMETER (MPI_2DOUBLE_COMPLEX=1275076645)
+       INTEGER MPI_CHARACTER
+       PARAMETER (MPI_CHARACTER=1275068698)
+       INTEGER MPI_BYTE
+       PARAMETER (MPI_BYTE=1275068685)
+       INTEGER MPI_UB
+       PARAMETER (MPI_UB=(1275068433))
+       INTEGER MPI_LB
+       PARAMETER (MPI_LB=(1275068432))
+       INTEGER MPI_PACKED
+       PARAMETER (MPI_PACKED=(1275068687))
+       INTEGER MPI_INTEGER1
+       PARAMETER (MPI_INTEGER1=1275068717)
+       INTEGER MPI_INTEGER2
+       PARAMETER (MPI_INTEGER2=1275068975)
+       INTEGER MPI_INTEGER4
+       PARAMETER (MPI_INTEGER4=1275069488)
+       INTEGER MPI_INTEGER8
+       PARAMETER (MPI_INTEGER8=1275070513)
+       INTEGER MPI_INTEGER16
+       PARAMETER (MPI_INTEGER16=MPI_DATATYPE_NULL)
+       INTEGER MPI_REAL4
+       PARAMETER (MPI_REAL4=1275069479)
+       INTEGER MPI_REAL8
+       PARAMETER (MPI_REAL8=1275070505)
+       INTEGER MPI_REAL16
+       PARAMETER (MPI_REAL16=1275072555)
+       INTEGER MPI_COMPLEX8
+       PARAMETER (MPI_COMPLEX8=1275070504)
+       INTEGER MPI_COMPLEX16
+       PARAMETER (MPI_COMPLEX16=1275072554)
+       INTEGER MPI_COMPLEX32
+       PARAMETER (MPI_COMPLEX32=1275076652)
+       INTEGER MPI_ADDRESS_KIND, MPI_OFFSET_KIND
+       PARAMETER (MPI_ADDRESS_KIND=8)
+       PARAMETER (MPI_OFFSET_KIND=8)
+       INTEGER MPI_COMBINER_NAMED
+       PARAMETER (MPI_COMBINER_NAMED=1)
+       INTEGER MPI_COMBINER_DUP
+       PARAMETER (MPI_COMBINER_DUP=2)
+       INTEGER MPI_COMBINER_CONTIGUOUS
+       PARAMETER (MPI_COMBINER_CONTIGUOUS=3)
+       INTEGER MPI_COMBINER_VECTOR
+       PARAMETER (MPI_COMBINER_VECTOR=4)
+       INTEGER MPI_COMBINER_HVECTOR_INTEGER
+       PARAMETER (MPI_COMBINER_HVECTOR_INTEGER=5)
+       INTEGER MPI_COMBINER_HVECTOR
+       PARAMETER (MPI_COMBINER_HVECTOR=6)
+       INTEGER MPI_COMBINER_INDEXED
+       PARAMETER (MPI_COMBINER_INDEXED=7)
+       INTEGER MPI_COMBINER_HINDEXED_INTEGER
+       PARAMETER (MPI_COMBINER_HINDEXED_INTEGER=8)
+       INTEGER MPI_COMBINER_HINDEXED
+       PARAMETER (MPI_COMBINER_HINDEXED=9)
+       INTEGER MPI_COMBINER_INDEXED_BLOCK
+       PARAMETER (MPI_COMBINER_INDEXED_BLOCK=10)
+       INTEGER MPI_COMBINER_STRUCT_INTEGER
+       PARAMETER (MPI_COMBINER_STRUCT_INTEGER=11)
+       INTEGER MPI_COMBINER_STRUCT
+       PARAMETER (MPI_COMBINER_STRUCT=12)
+       INTEGER MPI_COMBINER_SUBARRAY
+       PARAMETER (MPI_COMBINER_SUBARRAY=13)
+       INTEGER MPI_COMBINER_DARRAY
+       PARAMETER (MPI_COMBINER_DARRAY=14)
+       INTEGER MPI_COMBINER_F90_REAL
+       PARAMETER (MPI_COMBINER_F90_REAL=15)
+       INTEGER MPI_COMBINER_F90_COMPLEX
+       PARAMETER (MPI_COMBINER_F90_COMPLEX=16)
+       INTEGER MPI_COMBINER_F90_INTEGER
+       PARAMETER (MPI_COMBINER_F90_INTEGER=17)
+       INTEGER MPI_COMBINER_RESIZED
+       PARAMETER (MPI_COMBINER_RESIZED=18)
+       INTEGER MPI_MODE_NOCHECK
+       PARAMETER (MPI_MODE_NOCHECK=1024)
+       INTEGER MPI_MODE_NOSTORE
+       PARAMETER (MPI_MODE_NOSTORE=2048)
+       INTEGER MPI_MODE_NOPUT
+       PARAMETER (MPI_MODE_NOPUT=4096)
+       INTEGER MPI_MODE_NOPRECEDE
+       PARAMETER (MPI_MODE_NOPRECEDE=8192)
+       INTEGER MPI_MODE_NOSUCCEED
+       PARAMETER (MPI_MODE_NOSUCCEED=16384)
+       INTEGER MPI_THREAD_SINGLE
+       PARAMETER (MPI_THREAD_SINGLE=0)
+       INTEGER MPI_THREAD_FUNNELED
+       PARAMETER (MPI_THREAD_FUNNELED=1)
+       INTEGER MPI_THREAD_SERIALIZED
+       PARAMETER (MPI_THREAD_SERIALIZED=2)
+       INTEGER MPI_THREAD_MULTIPLE
+       PARAMETER (MPI_THREAD_MULTIPLE=3)
+       INTEGER MPI_MODE_RDONLY
+       PARAMETER (MPI_MODE_RDONLY=2)
+       INTEGER MPI_MODE_RDWR
+       PARAMETER (MPI_MODE_RDWR=8)
+       INTEGER MPI_MODE_WRONLY
+       PARAMETER (MPI_MODE_WRONLY=4)
+       INTEGER MPI_MODE_DELETE_ON_CLOSE
+       PARAMETER (MPI_MODE_DELETE_ON_CLOSE=16)
+       INTEGER MPI_MODE_UNIQUE_OPEN
+       PARAMETER (MPI_MODE_UNIQUE_OPEN=32)
+       INTEGER MPI_MODE_CREATE
+       PARAMETER (MPI_MODE_CREATE=1)
+       INTEGER MPI_MODE_EXCL
+       PARAMETER (MPI_MODE_EXCL=64)
+       INTEGER MPI_MODE_APPEND
+       PARAMETER (MPI_MODE_APPEND=128)
+       INTEGER MPI_MODE_SEQUENTIAL
+       PARAMETER (MPI_MODE_SEQUENTIAL=256)
+       INTEGER MPI_SEEK_SET
+       PARAMETER (MPI_SEEK_SET=600)
+       INTEGER MPI_SEEK_CUR
+       PARAMETER (MPI_SEEK_CUR=602)
+       INTEGER MPI_SEEK_END
+       PARAMETER (MPI_SEEK_END=604)
+       INTEGER MPI_ORDER_C
+       PARAMETER (MPI_ORDER_C=56)
+       INTEGER MPI_ORDER_FORTRAN
+       PARAMETER (MPI_ORDER_FORTRAN=57)
+       INTEGER MPI_DISTRIBUTE_BLOCK
+       PARAMETER (MPI_DISTRIBUTE_BLOCK=121)
+       INTEGER MPI_DISTRIBUTE_CYCLIC
+       PARAMETER (MPI_DISTRIBUTE_CYCLIC=122)
+       INTEGER MPI_DISTRIBUTE_NONE
+       PARAMETER (MPI_DISTRIBUTE_NONE=123)
+       INTEGER MPI_DISTRIBUTE_DFLT_DARG
+       PARAMETER (MPI_DISTRIBUTE_DFLT_DARG=-49767)
+       INTEGER MPI_DISPLACEMENT_CURRENT
+       PARAMETER (MPI_DISPLACEMENT_CURRENT=-54278278)
+       INTEGER MPI_BOTTOM, MPI_IN_PLACE
+       EXTERNAL MPI_DUP_FN, MPI_NULL_DELETE_FN, MPI_NULL_COPY_FN
+       EXTERNAL MPI_WTIME, MPI_WTICK
+       EXTERNAL PMPI_WTIME, PMPI_WTICK
+       EXTERNAL MPI_COMM_DUP_FN, MPI_COMM_NULL_DELETE_FN
+       EXTERNAL MPI_COMM_NULL_COPY_FN
+       EXTERNAL MPI_WIN_DUP_FN, MPI_WIN_NULL_DELETE_FN
+       EXTERNAL MPI_WIN_NULL_COPY_FN
+       EXTERNAL MPI_TYPE_DUP_FN, MPI_TYPE_NULL_DELETE_FN
+       EXTERNAL MPI_TYPE_NULL_COPY_FN
+       DOUBLE PRECISION MPI_WTIME, MPI_WTICK
+       DOUBLE PRECISION PMPI_WTIME, PMPI_WTICK
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/main.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/main.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/main.f90	(revision 2528)
@@ -0,0 +1,70 @@
+PROGRAM ioslave
+USE mod_pack, ONLY : set_pack_buffer,pack,unpack
+USE mod_wait
+IMPLICIT NONE
+
+  INTEGER,DIMENSION(3) :: a=(/1,2,3/)
+  REAL                 :: b = 4.5
+  REAL                 :: c = 6.7
+  INTEGER,DIMENSION(3) :: aout
+  REAL                 :: bout,cout
+  LOGICAL,DIMENSION(5) :: d=(/.TRUE.,.FALSE.,.FALSE.,.TRUE.,.TRUE./)
+  LOGICAL,DIMENSION(5) :: dout
+  CHARACTER            :: e='C'
+  CHARACTER            :: eout
+  CHARACTER(len=11)    :: f(3)
+  CHARACTER(len=11)    :: fout(3)
+  INTEGER(kind=8),dimension(:),POINTER :: buffer
+  REAL,dimension(:),POINTER :: buffer_field
+  DOUBLE PRECISION :: t
+  
+  ALLOCATE(buffer(1024))
+  ALLOCATE(buffer_field(1024))
+  
+  CALL set_pack_buffer(buffer,1)
+  
+  f(1)="COUCOU1"
+  f(2)="COUCOU2"
+  f(3)="COUCOU3"
+  
+  CALL pack(b)
+  CALL pack(f)
+  CALL pack(a)
+  CALL pack(d)
+  CALL pack(e)
+  CALL pack(c)
+  
+  CALL set_pack_buffer(buffer,1)
+  CALL unpack(bout)
+  CALL unpack(fout)
+  CALL unpack(aout)
+  CALL unpack(dout)
+  CALL unpack(eout)
+  CALL unpack(cout)
+  
+  PRINT *,a,b,c,d,e,"  ",f
+  PRINT *,aout,bout,cout,dout,eout,"  ",fout
+
+  CALL Init_wait
+  
+  t=top()
+  CALL wait_us(10)
+  t=top()
+  
+  PRINT *,"ATTENTE 10 us",t
+
+  t=top()
+  CALL wait_us(250)
+  t=top()
+  
+  PRINT *,"ATTENTE 250 us",t
+
+  t=top()
+  CALL wait_us(1235)
+  t=top()
+  
+  PRINT *,"ATTENTE 1235 us",t
+
+
+END PROGRAM ioslave
+
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_box_grid.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_box_grid.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_box_grid.f90	(revision 2528)
@@ -0,0 +1,170 @@
+MODULE box_grid
+  
+  INTEGER, PARAMETER :: nb_grid_max=100
+  INTEGER            :: nb_grid=0
+
+  TYPE domain
+    INTEGER :: ni
+    INTEGER :: nj
+    INTEGER :: ibegin
+    INTEGER :: iend
+    INTEGER :: jbegin
+    INTEGER :: jend
+    REAL,POINTER :: lon(:,:)
+    REAL,POINTER :: lat(:,:)
+  END TYPE domain
+  
+  TYPE grid
+    TYPE(domain)         :: local_domain
+    TYPE(domain),POINTER :: task_domain(:)
+    INTEGER                          :: ni
+    INTEGER                          :: nj
+    INTEGER                          :: nb_task
+  END TYPE grid
+  
+  TYPE(grid),SAVE,TARGET :: grids(nb_grid_max)
+  
+  INTEGER,SAVE :: max_ni
+  INTEGER,SAVE :: max_nj
+  INTEGER,SAVE :: max_vert_size = 100
+  REAL,SAVE,ALLOCATABLE :: Field_buffer(:,:,:) 
+  
+CONTAINS
+
+  SUBROUTINE create_new_grid(ni_glo,nj_glo,nb_task,id)
+  IMPLICIT NONE
+    INTEGER,INTENT(IN)  :: ni_glo
+    INTEGER,INTENT(IN)  :: nj_glo
+    INTEGER,INTENT(IN)  :: nb_task
+    INTEGER,INTENT(OUT) :: id
+  
+    nb_grid=nb_grid+1
+    id=nb_grid
+    
+    grids(id)%ni=ni_glo
+    grids(id)%nj=nj_glo
+    grids(id)%nb_task=nb_task
+   
+    ALLOCATE(grids(id)%task_domain(nb_task))
+ 
+  END SUBROUTINE create_new_grid
+ 
+  SUBROUTINE Init_task_domain(id,task,ni,nj,ibegin,jbegin,lon,lat)
+  IMPLICIT NONE
+    INTEGER, INTENT(IN) :: id
+    INTEGER, INTENT(IN) :: task
+    INTEGER, INTENT(IN) :: ni
+    INTEGER, INTENT(IN) :: nj
+    INTEGER, INTENT(IN) :: ibegin
+    INTEGER, INTENT(IN) :: jbegin
+    REAL,    INTENT(IN) :: lon(ni,nj)
+    REAL,    INTENT(IN) :: lat(ni,nj)
+ 
+    TYPE(domain), POINTER :: Pt_dom
+    
+    Pt_dom=>grids(id)%task_domain(task)
+    
+    Pt_dom%ni=ni
+    Pt_dom%nj=nj
+    Pt_dom%ibegin=ibegin
+    Pt_dom%jbegin=jbegin   
+    Pt_dom%iend=ibegin+ni-1
+    Pt_dom%jend=jbegin+nj-1
+    ALLOCATE(Pt_dom%lon(ni,nj))
+    ALLOCATE(Pt_dom%lat(ni,nj))
+    Pt_dom%lon(:,:)=lon(:,:)
+    Pt_dom%lat(:,:)=lat(:,:)
+  
+  END SUBROUTINE Init_task_domain
+
+  
+  SUBROUTINE Init_grids
+  IMPLICIT NONE
+    INTEGER :: rank
+    INTEGER :: ib,ie,jb,je
+    TYPE(grid),POINTER :: Pt_grid
+    TYPE(domain),POINTER :: local_domain
+    TYPE(domain),POINTER :: task_domain(:)
+    INTEGER :: id
+    
+      max_ni=0
+      max_nj=0
+    
+      DO id=1,nb_grid
+        pt_grid=>grids(id)
+        local_domain=>pt_grid%local_domain
+        task_domain=>pt_grid%task_domain
+        
+        local_domain%ibegin=task_domain(1)%ibegin
+        local_domain%iend=task_domain(1)%iend
+        local_domain%jbegin=task_domain(1)%jbegin
+        local_domain%jend=task_domain(1)%jend
+      
+      DO rank=1,pt_grid%nb_task
+        IF (task_domain(rank)%ibegin < local_domain%ibegin)   local_domain%ibegin = task_domain(rank)%ibegin
+        IF (task_domain(rank)%iend   > local_domain%iend  )   local_domain%iend   = task_domain(rank)%iend
+        IF (task_domain(rank)%jbegin < local_domain%jbegin)   local_domain%jbegin = task_domain(rank)%jbegin
+        IF (task_domain(rank)%jend   > local_domain%jend  )   local_domain%jend   = task_domain(rank)%jend
+      ENDDO
+    
+      local_domain%ni = local_domain%iend-local_domain%ibegin+1
+      local_domain%nj = local_domain%jend-local_domain%jbegin+1
+      ALLOCATE(local_domain%lon(local_domain%ni,local_domain%nj))
+      ALLOCATE(local_domain%lat(local_domain%ni,local_domain%nj))
+      
+      DO rank=1,pt_grid%nb_task
+        ib=task_domain(rank)%ibegin-local_domain%ibegin+1
+        ie=task_domain(rank)%iend-local_domain%ibegin+1
+        jb=task_domain(rank)%jbegin-local_domain%jbegin+1
+        je=task_domain(rank)%jend-local_domain%jbegin+1
+
+        task_domain(rank)%ibegin=ib
+        task_domain(rank)%iend=ie
+        task_domain(rank)%jbegin=jb
+        task_domain(rank)%jend=je
+      
+        local_domain%lon(ib:ie,jb:je)=task_domain(rank)%lon(:,:)
+        local_domain%lat(ib:ie,jb:je)=task_domain(rank)%lat(:,:)
+      ENDDO
+  
+      IF (local_domain%ni > max_ni) max_ni=local_domain%ni
+      IF (local_domain%nj > max_nj) max_nj=local_domain%nj
+    ENDDO
+  
+    ALLOCATE(field_buffer(max_ni,max_nj,max_vert_size))
+    
+  END SUBROUTINE Init_grids
+  
+  SUBROUTINE bufferize_field2d(field,id,task)
+  IMPLICIT NONE
+    REAL,INTENT(IN) :: field(:,:)
+    INTEGER,INTENT(IN) :: id
+    INTEGER,INTENT(IN) :: task
+    TYPE(domain), POINTER :: Pt
+
+    Pt=>grids(id)%task_domain(task)
+    field_buffer(Pt%ibegin:Pt%iend,Pt%jbegin:Pt%jend,1)=field(:,:)
+      
+  END SUBROUTINE bufferize_field2d
+  
+  
+  SUBROUTINE bufferize_field3d(field,id,task)
+  IMPLICIT NONE
+    REAL,INTENT(IN) :: field(:,:,:)
+    INTEGER,INTENT(IN) :: id
+    INTEGER,INTENT(IN) :: task
+    TYPE(domain), POINTER :: Pt
+   
+    Pt=>grids(id)%task_domain(task)
+
+    IF (size(field,3)>max_vert_size) THEN
+      DEALLOCATE(field_buffer)
+      max_vert_size=max_vert_size*2
+      ALLOCATE(field_buffer(max_ni,max_nj,max_vert_size))
+    ENDIF
+    
+    field_buffer(Pt%ibegin:Pt%iend,Pt%jbegin:Pt%jend,1:size(field,3))=field(:,:,:)
+      
+  END SUBROUTINE bufferize_field3d
+    
+END MODULE box_grid
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_boxed_domain.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_boxed_domain.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_boxed_domain.f90	(revision 2528)
@@ -0,0 +1,145 @@
+MODULE boxed_domain
+
+  INTEGER,SAVE :: ni_glo
+  INTEGER,SAVE :: nj_glo
+  INTEGER,SAVE :: nb_proc
+  
+  TYPE local_domain
+    INTEGER :: ni
+    INTEGER :: nj
+    INTEGER :: ibegin
+    INTEGER :: iend
+    INTEGER :: jbegin
+    INTEGER :: jend
+    REAL,POINTER :: lon(:,:)
+    REAL,POINTER :: lat(:,:)
+  END TYPE local_domain
+  
+  TYPE(local_domain),ALLOCATABLE,SAVE,TARGET :: domains(:)
+  
+  
+  INTEGER,SAVE :: ni
+  INTEGER,SAVE :: nj
+  INTEGER,SAVE :: ibegin
+  INTEGER,SAVE :: iend
+  INTEGER,SAVE :: jbegin
+  INTEGER,SAVE :: jend
+  
+  REAL,SAVE,ALLOCATABLE :: lon(:,:)
+  REAL,SAVE,ALLOCATABLE :: lat(:,:)
+  
+  INTEGER,SAVE :: max_vert_size = 100
+  REAL,SAVE,ALLOCATABLE :: Field_buffer(:,:,:)  
+  
+CONTAINS
+
+  SUBROUTINE Init_global_domain(ni_glo_,nj_glo_,nb_proc_)
+  IMPLICIT NONE
+  INTEGER, INTENT(IN) :: ni_glo_
+  INTEGER, INTENT(IN) :: nj_glo_
+  INTEGER, INTENT(IN) :: nb_proc_
+  
+    ni_glo=ni_glo_
+    nj_glo=nj_glo_
+    nb_proc=nb_proc_
+    
+    ALLOCATE(domains(nb_proc))
+ 
+  END SUBROUTINE Init_global_domain
+
+
+  SUBROUTINE Init_local_domain(rank,ni,nj,ibegin,jbegin,lon,lat)
+  IMPLICIT NONE
+    INTEGER, INTENT(IN) :: rank
+    INTEGER, INTENT(IN) :: ni
+    INTEGER, INTENT(IN) :: nj
+    INTEGER, INTENT(IN) :: ibegin    
+    INTEGER, INTENT(IN) :: jbegin
+    REAL, INTENT(IN)    :: lon(ni,nj)
+    REAL, INTENT(IN)    :: lat(ni,nj)
+    
+    domains(rank)%ni=ni
+    domains(rank)%nj=nj
+    domains(rank)%ibegin=ibegin
+    domains(rank)%jbegin=jbegin   
+    domains(rank)%iend=ibegin+ni-1
+    domains(rank)%jend=jbegin+nj-1
+    ALLOCATE(domains(rank)%lon(ni,nj))
+    ALLOCATE(domains(rank)%lat(ni,nj))
+    domains(rank)%lon(:,:)=lon(:,:)
+    domains(rank)%lat(:,:)=lat(:,:)
+  
+  END SUBROUTINE Init_local_domain
+  
+  
+  SUBROUTINE Init_domain
+  IMPLICIT NONE
+    INTEGER :: rank
+    INTEGER :: ib,ie,jb,je
+    ibegin=domains(1)%ibegin
+    iend=domains(1)%iend
+    jbegin=domains(1)%jbegin
+    jend=domains(1)%jend
+    
+    DO rank=1,nb_proc
+      IF (domains(rank)%ibegin<ibegin) ibegin=domains(rank)%ibegin
+      IF (domains(rank)%iend>iend) iend=domains(rank)%iend
+      IF (domains(rank)%jbegin<jbegin) jbegin=domains(rank)%jbegin
+      IF (domains(rank)%jend>jend) jend=domains(rank)%jend
+    ENDDO
+    
+    ni=iend-ibegin+1
+    nj=jend-jbegin+1
+    ALLOCATE(lon(ni,nj))
+    ALLOCATE(lat(ni,nj))
+    
+    DO rank=1,nb_proc
+      ib=domains(rank)%ibegin-ibegin+1
+      ie=domains(rank)%iend-ibegin+1
+      jb=domains(rank)%jbegin-jbegin+1
+      je=domains(rank)%jend-jbegin+1
+
+      domains(rank)%ibegin=ib
+      domains(rank)%iend=ie
+      domains(rank)%jbegin=jb
+      domains(rank)%jend=je
+      
+      lon(ib:ie,jb:je)=domains(rank)%lon(:,:)
+      lat(ib:ie,jb:je)=domains(rank)%lat(:,:)
+    ENDDO
+  
+    ALLOCATE(field_buffer(ni,nj,max_vert_size))
+    
+  END SUBROUTINE 
+  
+  SUBROUTINE bufferize_field2d(field,rank)
+  IMPLICIT NONE
+    REAL,INTENT(IN) :: field(:,:)
+    INTEGER,INTENT(IN) :: rank
+    TYPE(local_domain), POINTER :: Pt
+
+    Pt=>domains(rank)
+    field_buffer(Pt%ibegin:Pt%iend,Pt%jbegin:Pt%jend,1)=field(:,:)
+      
+  END SUBROUTINE bufferize_field2d
+  
+  
+  SUBROUTINE bufferize_field3d(field,rank)
+  IMPLICIT NONE
+    REAL,INTENT(IN) :: field(:,:,:)
+    INTEGER,INTENT(IN) :: rank
+    TYPE(local_domain), POINTER :: Pt
+   
+    Pt=>domains(rank)
+    IF (size(field,3)>max_vert_size) THEN
+      DEALLOCATE(field_buffer)
+      max_vert_size=max_vert_size*2
+      ALLOCATE(field_buffer(ni,nj,max_vert_size))
+    ENDIF
+    
+    field_buffer(Pt%ibegin:Pt%iend,Pt%jbegin:Pt%jend,1:size(field,3))=field(:,:,:)
+      
+  END SUBROUTINE bufferize_field3d
+
+    
+END MODULE boxed_domain
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_event_client.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_event_client.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_event_client.f90	(revision 2528)
@@ -0,0 +1,340 @@
+MODULE mod_event_client
+  USE mod_pack, ONLY : pack, pack_field
+  USE mod_mpi_buffer_client, ONLY : create_request, finalize_request,is_last_request
+  USE mod_event_parameters 
+  USE mod_ioserver_namelist
+      
+CONTAINS
+
+  SUBROUTINE event__swap_context(id)
+  USE iomanager
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: id
+    
+    IF (using_server) THEN
+      CALL create_request(event_id_swap_context)
+      CALL pack(LEN(TRIM(id)))
+      CALL pack(TRIM(id))
+      CALL Finalize_request
+    ELSE
+      CALL iom__swap_context(TRIM(id))
+    ENDIF
+    
+  END SUBROUTINE  event__swap_context
+  
+  
+  SUBROUTINE event__parse_xml_file(filename)
+  USE iomanager
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: filename
+    
+    IF (using_server) THEN
+      CALL create_request(event_id_parse_xml_file)
+      CALL pack(LEN(TRIM(filename)))
+      CALL pack(TRIM(filename))
+      CALL Finalize_request
+    ELSE
+      CALL iom__parse_xml_file(filename)
+    ENDIF
+    
+  END SUBROUTINE  event__parse_xml_file
+
+  SUBROUTINE event__set_vert_axis(vert_name,vert_value)
+  USE iomanager
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: vert_name
+    REAL,INTENT(IN)             :: vert_value(:)
+    
+    
+    IF (using_server) THEN
+      CALL create_request(event_id_set_vert_axis)
+      CALL pack(LEN(TRIM(vert_name)))
+      CALL pack(TRIM(vert_name))
+      CALL pack(SIZE(vert_value))
+      CALL pack(vert_value)
+      CALL Finalize_request
+    ELSE
+      CALL iom__set_vert_axis(vert_name,vert_value)
+    ENDIF
+    
+  END SUBROUTINE  event__set_vert_axis
+
+  SUBROUTINE event__set_grid_dimension(name,ni_glo,nj_glo)
+  USE iomanager
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: name
+    INTEGER,INTENT(IN) :: ni_glo
+    INTEGER,INTENT(IN) :: nj_glo
+    
+    IF (using_server) THEN
+      CALL create_request(event_id_set_grid_dimension)
+      CALL pack(LEN(TRIM(name)))
+      CALL pack(TRIM(name))
+      CALL pack(ni_glo)
+      CALL pack(nj_glo)
+      CALL Finalize_request
+    ELSE
+      CALL iom__set_grid_dimension(name,ni_glo,nj_glo)
+    ENDIF
+    
+  END SUBROUTINE event__set_grid_dimension
+
+  
+  SUBROUTINE event__set_grid_domain(name,ni,nj,ibegin,jbegin,lon,lat)
+  USE iomanager
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: name
+    INTEGER,INTENT(IN) :: ni
+    INTEGER,INTENT(IN) :: nj
+    INTEGER,INTENT(IN) :: ibegin
+    INTEGER,INTENT(IN) :: jbegin
+    REAL,INTENT(IN)    :: lon(ni,nj)
+    REAL,INTENT(IN)    :: lat(ni,nj)
+    
+    IF (using_server) THEN
+      CALL create_request(event_id_set_grid_domain)
+      CALL pack(LEN(TRIM(name)))
+      CALL pack(TRIM(name))
+      CALL pack(ni)
+      CALL pack(nj)
+      CALL pack(ibegin)
+      CALL pack(jbegin)
+      CALL pack(lon)
+      CALL pack(lat)
+      CALL Finalize_request
+    ELSE
+     CALL iom__set_grid_domain(name,ni,nj,ibegin,jbegin,lon,lat)
+    ENDIF
+      
+  END SUBROUTINE event__set_grid_domain
+
+  SUBROUTINE event__set_grid_type_nemo(name)
+  USE iomanager
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: name
+    
+    IF (using_server) THEN
+      CALL create_request(event_id_set_grid_type_nemo)
+      CALL pack(LEN(TRIM(name)))
+      CALL pack(TRIM(name))
+      CALL Finalize_request
+    ELSE
+     CALL iom__set_grid_type_nemo(name)
+    ENDIF
+      
+  END SUBROUTINE event__set_grid_type_nemo
+  
+  SUBROUTINE event__set_grid_type_lmdz(name,nbp,offset)
+  USE iomanager
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: name
+    INTEGER,INTENT(IN)          :: nbp
+    INTEGER,INTENT(IN)          :: offset
+        
+    IF (using_server) THEN
+      CALL create_request(event_id_set_grid_type_lmdz)
+      CALL pack(LEN(TRIM(name)))
+      CALL pack(TRIM(name))
+      CALL pack(nbp)
+      CALL pack(offset)
+      CALL Finalize_request
+    ELSE
+     CALL iom__set_grid_type_lmdz(name,nbp,offset)
+    ENDIF
+      
+  END SUBROUTINE event__set_grid_type_lmdz
+  
+  SUBROUTINE event__set_time_parameters(itau0,zjulian,zdt)
+  USE iomanager
+  IMPLICIT NONE
+    INTEGER,INTENT(IN)  :: itau0
+    REAL,   INTENT(IN)  :: zjulian
+    REAL,   INTENT(IN)  :: zdt
+        
+    IF (using_server) THEN
+      CALL create_request(event_id_set_time_parameters)
+      CALL pack(itau0)
+      CALL pack(zjulian)
+      CALL pack(zdt)
+      CALL Finalize_request
+    ELSE
+      CALL iom__set_time_parameters(itau0,zjulian,zdt)
+    ENDIF
+    
+  END SUBROUTINE event__set_time_parameters
+
+
+  SUBROUTINE event__set_calendar(str_calendar)
+  USE iomanager
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: str_calendar
+        
+    IF (using_server) THEN
+      CALL create_request(event_id_set_calendar)
+      CALL pack(LEN(TRIM(str_calendar)))
+      CALL pack(TRIM(str_calendar))
+      CALL Finalize_request
+    ELSE
+     CALL iom__set_calendar(str_calendar)
+    ENDIF
+      
+  END SUBROUTINE event__set_calendar
+  
+  
+  SUBROUTINE event__enable_field(varname)
+  USE iomanager
+  IMPLICIT NONE
+    CHARACTER(len=*),INTENT(IN)     :: varname
+
+    IF (using_server) THEN
+      CALL create_request(event_id_enable_field)
+      CALL pack(len(varname))
+      CALL pack(varname)
+      CALL Finalize_request 
+    ELSE
+      CALL iom__enable_field(varname)
+    ENDIF
+    
+  END SUBROUTINE event__enable_field
+
+  SUBROUTINE event__disable_field(varname)
+  USE iomanager
+  IMPLICIT NONE
+    CHARACTER(len=*),INTENT(IN)     :: varname
+
+    IF (using_server) THEN
+      CALL create_request(event_id_disable_field)
+      CALL pack(len(varname))
+      CALL pack(varname)
+      CALL Finalize_request 
+    ELSE
+      CALL iom__disable_field(varname)
+    ENDIF
+    
+  END SUBROUTINE event__disable_field
+  
+  SUBROUTINE event__write_field1d(varname,var)
+  USE iomanager
+  IMPLICIT NONE
+    CHARACTER(len=*),INTENT(IN)     :: varname
+    REAL, DIMENSION(:),INTENT(IN) :: var
+
+    IF (using_server) THEN
+      CALL create_request(event_id_write_field1d)
+      CALL pack(len(varname))
+      CALL pack(size(var,1))
+      CALL pack(varname)
+      CALL pack_field(var)
+      CALL Finalize_request 
+    ELSE
+      CALL iom__write_field1d(varname,var)
+    ENDIF
+    
+  END SUBROUTINE event__write_field1d
+
+  SUBROUTINE event__write_field2d(varname,var)
+  USE iomanager
+  IMPLICIT NONE
+    CHARACTER(len=*),INTENT(IN)     :: varname
+    REAL, DIMENSION(:,:),INTENT(IN) :: var
+
+    IF (using_server) THEN
+      CALL create_request(event_id_write_field2d)
+      CALL pack(len(varname))
+      CALL pack(size(var,1))
+      CALL pack(size(var,2))
+      CALL pack(varname)
+      CALL pack_field(var)
+      CALL Finalize_request 
+    ELSE
+      CALL iom__write_field2d(varname,var)
+    ENDIF
+    
+  END SUBROUTINE event__write_field2d
+  
+  SUBROUTINE event__write_field3d(varname,var)
+  USE iomanager
+  IMPLICIT NONE
+    CHARACTER(len=*),INTENT(IN)     :: varname
+    REAL, DIMENSION(:,:,:),INTENT(IN) :: var
+
+    IF (using_server) THEN
+      CALL create_request(event_id_write_field3d)
+      CALL pack(len(varname))
+      CALL pack(size(var,1))
+      CALL pack(size(var,2))
+      CALL pack(size(var,3))
+      CALL pack(varname)
+      CALL pack_field(var)
+      CALL Finalize_request 
+    ELSE
+      CALL iom__write_field3d(varname,var)
+    ENDIF
+  END SUBROUTINE event__write_field3d
+  
+
+  SUBROUTINE event__set_timestep(timestep)
+  USE iomanager
+  IMPLICIT NONE
+    INTEGER,INTENT(IN) :: timestep
+    
+    IF (using_server) THEN
+      CALL create_request(event_id_set_timestep)
+      CALL pack(timestep)
+      CALL Finalize_request
+    ELSE
+      CALL iom__set_timestep(timestep)
+    ENDIF
+
+  END SUBROUTINE event__set_timestep
+    
+    
+  SUBROUTINE event__close_io_definition
+  USE iomanager
+  IMPLICIT NONE
+    
+    IF (using_server) THEN
+      CALL create_request(event_id_close_io_definition)
+      CALL Finalize_request
+    ELSE
+      CALL iom__close_io_definition
+    ENDIF
+
+  END SUBROUTINE event__close_io_definition
+
+  
+  SUBROUTINE event__set_attribut(id,attrib)
+  USE iomanager
+  USE mod_attribut
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: id
+    TYPE(attribut),INTENT(IN)   :: attrib
+ 
+    IF (using_server) THEN
+      CALL create_request(event_id_set_attribut)
+      CALL pack(len(id))
+      CALL pack(id)
+      CALL pack(attrib)
+      CALL Finalize_request
+    ELSE
+      CALL iom__set_attribut(id,attrib)
+    ENDIF
+ 
+  END SUBROUTINE event__set_attribut  
+
+  SUBROUTINE event__stop_ioserver
+  USE iomanager
+  IMPLICIT NONE
+ 
+    IF (using_server) THEN
+      CALL create_request(event_id_stop_ioserver)
+      is_last_request=.TRUE.
+      CALL Finalize_request
+    ELSE
+      CALL iom__finalize
+    ENDIF
+
+  END SUBROUTINE event__stop_ioserver
+    
+  
+END MODULE mod_event_client
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_event_parameters.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_event_parameters.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_event_parameters.f90	(revision 2528)
@@ -0,0 +1,21 @@
+MODULE mod_event_parameters
+  INTEGER, PARAMETER :: event_id_parse_xml_file        = 100
+  INTEGER, PARAMETER :: event_id_set_local_domain      = 101
+  INTEGER, PARAMETER :: event_id_set_vert_axis         = 102
+  INTEGER, PARAMETER :: event_id_set_time_parameters   = 103
+  INTEGER, PARAMETER :: event_id_set_timestep          = 104
+  INTEGER, PARAMETER :: event_id_write_field2d         = 105
+  INTEGER, PARAMETER :: event_id_write_field3d         = 106
+  INTEGER, PARAMETER :: event_id_close_io_definition   = 107
+  INTEGER, PARAMETER :: event_id_set_grid_dimension    = 108
+  INTEGER, PARAMETER :: event_id_set_grid_domain       = 109
+  INTEGER, PARAMETER :: event_id_set_grid_type_nemo    = 110
+  INTEGER, PARAMETER :: event_id_enable_field          = 111
+  INTEGER, PARAMETER :: event_id_disable_field         = 112
+  INTEGER, PARAMETER :: event_id_swap_context          = 113
+  INTEGER, PARAMETER :: event_id_set_grid_type_lmdz    = 114
+  INTEGER, PARAMETER :: event_id_write_field1d         = 115
+  INTEGER, PARAMETER :: event_id_set_attribut          = 116
+  INTEGER, PARAMETER :: event_id_set_calendar          = 117
+  INTEGER, PARAMETER :: event_id_stop_ioserver         = 999
+END MODULE mod_event_parameters
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_event_server.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_event_server.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_event_server.f90	(revision 2528)
@@ -0,0 +1,465 @@
+MODULE mod_event_server
+  USE mod_pack, ONLY : unpack, unpack_field
+  USE mod_event_parameters
+  USE iomanager
+  
+CONTAINS
+
+  SUBROUTINE Process_event(current_rank,is_terminated)
+  IMPLICIT NONE
+    INTEGER :: event_id
+    INTEGER, INTENT(IN) :: current_rank
+    LOGICAL,INTENT(OUT) :: is_terminated
+     
+    CALL iom__set_current_rank(current_rank)
+     
+    is_terminated=.FALSE.
+    
+    CALL unpack(event_id)
+    
+    SELECT CASE (event_id)
+    
+      CASE (event_id_swap_context)
+        CALL event__swap_context
+        
+      CASE (event_id_parse_xml_file)
+        CALL event__parse_xml_file 
+
+      CASE (event_id_set_vert_axis)
+        CALL event__set_vert_axis 
+     
+      CASE (event_id_set_grid_dimension)
+        CALL event__set_grid_dimension
+      
+      CASE (event_id_set_grid_domain)
+        CALL event__set_grid_domain
+
+      CASE (event_id_set_grid_type_nemo)
+        CALL event__set_grid_type_nemo
+
+      CASE (event_id_set_grid_type_lmdz)
+        CALL event__set_grid_type_lmdz
+
+      CASE (event_id_set_time_parameters)
+        CALL event__set_time_parameters
+
+      CASE (event_id_close_io_definition)
+        CALL event__close_io_definition  
+
+      CASE (event_id_set_timestep)
+        CALL event__set_timestep
+
+      CASE (event_id_set_calendar)
+        CALL event__set_calendar
+
+      CASE (event_id_enable_field)
+        CALL event__enable_field
+      
+      CASE (event_id_disable_field)
+        CALL event__disable_field
+
+      CASE (event_id_write_Field1d)
+        CALL event__write_Field1d
+
+      CASE (event_id_write_Field2d)
+        CALL event__write_Field2d
+
+      CASE (event_id_write_Field3d)
+        CALL event__write_Field3d
+
+      CASE (event_id_set_attribut)
+        CALL event__set_attribut
+
+      CASE (event_id_stop_ioserver)
+        is_terminated=.TRUE.  
+        PRINT *,"TERMINATE_EVENT RECEIVED"
+        
+
+      CASE DEFAULT 
+        STOP 'UNDEFINED EVENT'
+      
+     END SELECT
+     
+   END SUBROUTINE Process_event
+   
+  SUBROUTINE event__swap_context
+  IMPLICIT NONE
+    INTEGER :: id_size
+   
+    CALL unpack(id_size)
+    CALL sub_internal(id_size)
+     
+  CONTAINS
+    
+    SUBROUTINE sub_internal(id_size)
+      INTEGER :: id_size
+      CHARACTER(LEN=id_size) :: id     
+     
+       CALL unpack(id)
+     
+       CALL iom__swap_context(id)
+       
+     END SUBROUTINE sub_internal
+  
+  END SUBROUTINE event__swap_context
+  
+
+  SUBROUTINE event__parse_xml_file
+  IMPLICIT NONE
+    INTEGER :: name_size
+   
+    CALL unpack(name_size)
+    CALL sub_internal(name_size)
+     
+  CONTAINS
+    
+    SUBROUTINE sub_internal(name_size)
+      INTEGER :: name_size
+      CHARACTER(LEN=name_size) :: filename     
+     
+       CALL unpack(filename)
+     
+       CALL iom__parse_xml_file(filename)
+     END SUBROUTINE sub_internal
+  
+  END SUBROUTINE event__parse_xml_file
+  
+  
+  SUBROUTINE event__set_grid_dimension
+  IMPLICIT NONE    
+    INTEGER :: name_size
+    INTEGER :: ni_glo
+    INTEGER :: nj_glo
+   
+    CALL unpack(name_size)
+    CALL sub_internal(name_size)
+     
+  CONTAINS
+    
+    SUBROUTINE sub_internal(name_size)
+      INTEGER :: name_size
+      CHARACTER(LEN=name_size) :: name     
+     
+       CALL unpack(name)
+       CALL unpack(ni_glo)
+       CALL unpack(nj_glo)
+     
+       CALL iom__set_grid_dimension(name,ni_glo,nj_glo)
+     END SUBROUTINE sub_internal
+   
+   END SUBROUTINE event__set_grid_dimension
+
+
+  SUBROUTINE event__set_grid_domain 
+  IMPLICIT NONE    
+    INTEGER :: name_size
+    INTEGER :: ni
+    INTEGER :: nj
+    INTEGER :: ibegin
+    INTEGER :: jbegin
+    REAL,ALLOCATABLE :: lon(:,:)
+    REAL,ALLOCATABLE :: lat(:,:)
+
+    CALL unpack(name_size)
+    CALL sub_internal(name_size)
+     
+  CONTAINS
+    
+    SUBROUTINE sub_internal(name_size)
+      INTEGER :: name_size
+      CHARACTER(LEN=name_size) :: name     
+     
+       CALL unpack(name)
+    
+       CALL unpack(ni)
+       CALL unpack(nj)
+       CALL unpack(ibegin)
+       CALL unpack(jbegin)
+    
+       ALLOCATE(lon(ni,nj))
+       ALLOCATE(lat(ni,nj))
+       CALL unpack(lon)
+       CALL unpack(lat)
+    
+       CALL iom__set_grid_domain(name,ni,nj,ibegin,jbegin,lon,lat)
+
+     END SUBROUTINE sub_internal
+   
+  END SUBROUTINE event__set_grid_domain   
+
+
+  SUBROUTINE event__set_grid_type_nemo 
+  IMPLICIT NONE    
+    INTEGER :: name_size
+
+    CALL unpack(name_size)
+    CALL sub_internal(name_size)
+     
+  CONTAINS
+    
+    SUBROUTINE sub_internal(name_size)
+      INTEGER :: name_size
+      CHARACTER(LEN=name_size) :: name     
+     
+       CALL unpack(name)
+       CALL iom__set_grid_type_nemo(name)
+
+     END SUBROUTINE sub_internal
+   
+  END SUBROUTINE event__set_grid_type_nemo   
+
+  SUBROUTINE event__set_grid_type_lmdz 
+  IMPLICIT NONE    
+    INTEGER :: name_size
+
+    CALL unpack(name_size)
+    CALL sub_internal(name_size)
+     
+  CONTAINS
+    
+    SUBROUTINE sub_internal(name_size)
+      INTEGER :: name_size
+      CHARACTER(LEN=name_size) :: name     
+      INTEGER                  :: nbp
+      INTEGER                  :: offset
+      
+       CALL unpack(name)
+       CALL unpack(nbp)
+       CALL unpack(offset)
+       CALL iom__set_grid_type_lmdz(name,nbp,offset)
+
+     END SUBROUTINE sub_internal
+   
+  END SUBROUTINE event__set_grid_type_lmdz   
+
+  SUBROUTINE event__set_vert_axis
+  IMPLICIT NONE
+    INTEGER :: name_size
+    INTEGER :: vert_size 
+    REAL,ALLOCATABLE :: vert_value(:)
+    
+    CALL unpack(name_size)
+    CALL sub_internal(name_size)
+
+  CONTAINS
+    
+    SUBROUTINE sub_internal(name_size)
+      INTEGER :: name_size
+      CHARACTER(LEN=name_size) :: name
+    
+      CALL unpack(name)
+      CALL unpack(vert_size)
+      ALLOCATE(vert_value(vert_size))
+      CALL unpack(vert_value) 
+      
+      CALL iom__set_vert_axis(name,vert_value)
+      
+    END SUBROUTINE sub_internal
+  END SUBROUTINE event__set_vert_axis
+
+  SUBROUTINE event__set_time_parameters
+  IMPLICIT NONE
+    INTEGER   :: itau0
+    REAL      :: zjulian
+    REAL      :: zdt
+      
+    CALL unpack(itau0)
+    CALL unpack(zjulian)
+    CALL unpack(zdt)
+    
+    CALL iom__set_time_parameters(itau0,zjulian,zdt)
+     
+  END SUBROUTINE event__set_time_parameters
+  
+
+  SUBROUTINE event__enable_field
+  IMPLICIT NONE
+    INTEGER :: lenc
+      
+    CALL unpack(lenc)
+    CALL sub_internal(lenc)
+  
+  CONTAINS
+    SUBROUTINE sub_internal(lenc)
+    IMPLICIT NONE
+      INTEGER :: lenc
+      CHARACTER(len=lenc) :: varname
+      
+      CALL unpack(varname)
+      
+      CALL iom__enable_field(varname)
+
+    END SUBROUTINE sub_internal
+  END SUBROUTINE event__enable_field
+  
+
+  SUBROUTINE event__disable_field
+  IMPLICIT NONE
+    INTEGER :: lenc
+      
+    CALL unpack(lenc)
+    CALL sub_internal(lenc)
+  
+  CONTAINS
+    SUBROUTINE sub_internal(lenc)
+    IMPLICIT NONE
+      INTEGER :: lenc
+      CHARACTER(len=lenc) :: varname
+      
+      CALL unpack(varname)
+      
+      CALL iom__disable_field(varname)
+
+    END SUBROUTINE sub_internal
+    
+  END SUBROUTINE event__disable_field
+  
+      
+  SUBROUTINE event__write_field1D
+  IMPLICIT NONE
+    INTEGER :: lenc
+    INTEGER :: dim1
+      
+    CALL unpack(lenc)
+    CALL unpack(dim1)
+    CALL sub_internal(lenc,dim1)
+  
+  CONTAINS
+    SUBROUTINE sub_internal(lenc,dim1)
+    IMPLICIT NONE
+      INTEGER :: lenc
+      INTEGER :: dim1
+      CHARACTER(len=lenc) :: varname
+      REAL                :: var(dim1)
+      
+      CALL unpack(varname)
+      CALL unpack_field(var)
+      
+      CALL iom__write_Field1d(varname,var)
+
+    END SUBROUTINE sub_internal
+  END SUBROUTINE event__write_field1d
+
+  SUBROUTINE event__write_field2D
+  IMPLICIT NONE
+    INTEGER :: lenc
+    INTEGER :: dim1
+    INTEGER :: dim2
+      
+    CALL unpack(lenc)
+    CALL unpack(dim1)
+    CALL unpack(dim2)
+    CALL sub_internal(lenc,dim1,dim2)
+  
+  CONTAINS
+    SUBROUTINE sub_internal(lenc,dim1,dim2)
+    IMPLICIT NONE
+      INTEGER :: lenc
+      INTEGER :: dim1
+      INTEGER :: dim2
+      CHARACTER(len=lenc) :: varname
+      REAL                :: var(dim1,dim2)
+      
+      CALL unpack(varname)
+      CALL unpack_field(var)
+      
+      CALL iom__write_Field2d(varname,var)
+
+    END SUBROUTINE sub_internal
+  END SUBROUTINE event__write_field2d
+    
+    
+  SUBROUTINE event__write_field3d
+  IMPLICIT NONE
+    INTEGER :: lenc
+    INTEGER :: dim1
+    INTEGER :: dim2
+    INTEGER :: dim3
+    
+    CALL unpack(lenc)
+    CALL unpack(dim1)
+    CALL unpack(dim2)
+    CALL unpack(dim3)
+    CALL sub_internal(lenc,dim1,dim2,dim3)
+ 
+  CONTAINS
+ 
+    SUBROUTINE sub_internal(lenc,dim1,dim2,dim3)
+    IMPLICIT NONE
+      INTEGER :: lenc
+      INTEGER :: dim1
+      INTEGER :: dim2
+      INTEGER :: dim3
+ 
+      CHARACTER(len=lenc) :: varname
+      REAL                :: var(dim1,dim2,dim3)
+        
+      CALL unpack(varname)
+      CALL unpack_field(var)
+       
+      CALL iom__write_field3d(varname,var)
+         
+    END SUBROUTINE sub_internal
+
+  END SUBROUTINE event__write_field3d
+    
+    
+  SUBROUTINE event__set_timestep
+  IMPLICIT NONE
+    INTEGER :: timestep
+     
+    CALL unpack(timestep)
+    CALL iom__set_timestep(timestep)
+    
+  END SUBROUTINE event__set_timestep
+    
+
+  SUBROUTINE event__set_calendar
+  IMPLICIT NONE
+    INTEGER :: lenc
+      
+    CALL unpack(lenc)
+    CALL sub_internal(lenc)
+  
+  CONTAINS
+    SUBROUTINE sub_internal(lenc)
+    IMPLICIT NONE
+      INTEGER :: lenc
+      CHARACTER(len=lenc) :: str_calendar
+      
+      CALL unpack(str_calendar)
+      
+      CALL iom__set_calendar(str_calendar)
+
+    END SUBROUTINE sub_internal
+  END SUBROUTINE event__set_calendar
+  
+    
+  SUBROUTINE event__close_io_definition
+  IMPLICIT NONE
+    
+    CALL iom__close_io_definition
+    
+  END SUBROUTINE event__close_io_definition
+  
+  SUBROUTINE event__set_attribut
+   USE mod_attribut
+   IMPLICIT NONE
+     TYPE(attribut) :: attrib
+     INTEGER        :: len_id
+     
+     CALL unpack(len_id)
+     CALL sub_internal
+   CONTAINS
+      
+     SUBROUTINE sub_internal
+       CHARACTER(LEN=len_id) :: id
+       
+       CALL unpack(id)
+       CALL unpack(attrib)
+       CALL iom__set_attribut(id,attrib)
+       CALL attr_deallocate(attrib)
+     END SUBROUTINE sub_internal
+  END SUBROUTINE event__set_attribut    
+
+END MODULE mod_event_server   
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_field_bufferize.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_field_bufferize.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_field_bufferize.f90	(revision 2528)
@@ -0,0 +1,94 @@
+MODULE field_bufferize
+  
+  INTEGER,SAVE      :: nx=0
+  INTEGER,SAVE      :: ny=0
+  INTEGER,SAVE      :: nz=0
+    
+  REAL,POINTER,SAVE :: field_buffer(:,:,:)
+  
+
+  
+CONTAINS
+
+  SUBROUTINE bufferize_field(ni,ibegin,nj,jbegin,nk,kbegin,nbp,field,i_index,j_index,mask)
+  IMPLICIT NONE
+    INTEGER,INTENT(IN) :: ni
+    INTEGER,INTENT(IN) :: ibegin
+    INTEGER,INTENT(IN) :: nj
+    INTEGER,INTENT(IN) :: jbegin
+    INTEGER,INTENT(IN) :: nk
+    INTEGER,INTENT(IN) :: kbegin
+    INTEGER,INTENT(IN) :: nbp
+    REAL,INTENT(IN)    :: field(nbp,nk)
+    INTEGER,INTENT(IN) :: i_index(nbp)
+    INTEGER,INTENT(IN) :: j_index(nbp)
+    LOGICAL,INTENT(IN),OPTIONAL :: mask(nbp)  
+    
+    INTEGER :: iend
+    INTEGER :: jend
+    INTEGER :: kend 
+
+    LOGICAL      :: need_reallocate
+    REAL,POINTER :: tmp_buffer(:,:,:)
+    INTEGER      :: i,j,k,n
+    
+    iend=ibegin+ni-1
+    jend=jbegin+nj-1
+    kend=kbegin+nk-1
+    
+    IF (PRESENT(mask)) THEN
+      DO k=kbegin,kend
+        DO n=1,nbp
+          i=i_index(n)+ibegin-1
+          j=j_index(n)+jbegin-1
+          IF (mask(n)) field_buffer(i,j,k)=field(n,k)
+        ENDDO
+      ENDDO
+    ELSE
+      DO k=kbegin,kend
+        DO n=1,nbp
+          i=i_index(n)+ibegin-1
+          j=j_index(n)+jbegin-1
+          field_buffer(i,j,k)=field(n,k)
+        ENDDO
+      ENDDO
+    ENDIF
+    
+  END SUBROUTINE bufferize_field
+
+  SUBROUTINE Init_field_Bufferize(ni,nj,nk)
+  IMPLICIT NONE
+  INTEGER,INTENT(IN) :: ni
+  INTEGER,INTENT(IN) :: nj
+  INTEGER,INTENT(IN) :: nk
+     
+    LOGICAL :: need_reallocate
+    
+    
+    need_reallocate=.FALSE.
+    
+    IF ( ni > nx) THEN
+      nx=ni
+      need_reallocate=.TRUE.
+    ENDIF
+    
+    IF ( nj > ny) THEN
+      ny=nj
+      need_reallocate=.TRUE.
+    ENDIF
+
+    IF ( nk > nz) THEN
+      nz=nk
+      need_reallocate=.TRUE.
+    ENDIF
+    
+    IF (need_reallocate) THEN
+      IF (ASSOCIATED(field_buffer)) DEALLOCATE(field_buffer)
+      ALLOCATE(field_buffer(nx,ny,nz))
+    ENDIF
+
+    field_buffer(1:nx,1:ny,1:nz)=0.
+
+  END SUBROUTINE  init_field_bufferize         
+
+END MODULE field_bufferize
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_global_memory.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_global_memory.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_global_memory.f90	(revision 2528)
@@ -0,0 +1,123 @@
+MODULE mod_global_memory
+
+  INTERFACE allocate_global_memory
+    MODULE PROCEDURE Allocate_global_memory_r8,    &
+                     Allocate_global_memory_i8,    &
+!                     Allocate_global_memory_r4,    &
+                     Allocate_global_memory_i4
+  END INTERFACE Allocate_global_memory
+  
+CONTAINS
+
+  SUBROUTINE Allocate_global_memory_r8(size,Pt)
+  USE mpi_mod
+  IMPLICIT NONE
+    REAL(kind=8),POINTER :: Pt(:)
+    INTEGER              :: size
+
+    POINTER (Pbuffer,MPI_Buffer(size))
+    REAL(kind=8) :: MPI_Buffer
+    INTEGER(KIND=MPI_ADDRESS_KIND) :: BS 
+    INTEGER :: ierr
+    
+    BS=8*size
+    CALL MPI_ALLOC_MEM(BS,MPI_INFO_NULL,Pbuffer,ierr)
+    CALL associate_buffer(MPI_Buffer,Pt)
+  
+  CONTAINS
+  
+    SUBROUTINE associate_buffer(MPI_buffer,Pt)
+    IMPLICIT NONE
+      REAL(kind=8),DIMENSION(:),target :: MPI_Buffer
+      REAL(kind=8),POINTER             :: Pt(:)
+      Pt=>MPI_buffer
+    END SUBROUTINE associate_buffer
+  
+  END SUBROUTINE Allocate_global_memory_r8
+
+
+
+  SUBROUTINE Allocate_global_memory_i8(size,Pt)
+  USE mpi_mod
+  IMPLICIT NONE
+    INTEGER(kind=8),POINTER :: Pt(:)
+    INTEGER              :: size
+
+    POINTER (Pbuffer,MPI_Buffer(size))
+    INTEGER(kind=8) :: MPI_Buffer
+    INTEGER(KIND=MPI_ADDRESS_KIND) :: BS 
+    INTEGER :: ierr
+    
+    BS=8*size
+    CALL MPI_ALLOC_MEM(BS,MPI_INFO_NULL,Pbuffer,ierr)
+    CALL associate_buffer(MPI_Buffer,Pt)
+  
+  CONTAINS
+  
+    SUBROUTINE associate_buffer(MPI_buffer,Pt)
+    IMPLICIT NONE
+      INTEGER(kind=8),DIMENSION(:),target :: MPI_Buffer
+      INTEGER(kind=8),POINTER             :: Pt(:)
+      Pt=>MPI_buffer
+    END SUBROUTINE associate_buffer
+  
+  END SUBROUTINE Allocate_global_memory_i8
+  
+  
+!  SUBROUTINE Allocate_global_memory_r4(size,Pt)
+!  USE mpi_mod
+!  IMPLICIT NONE
+!    REAL(kind=4),POINTER :: Pt(:)
+!    INTEGER              :: size
+!
+!    POINTER (Pbuffer,MPI_Buffer(size))
+!    REAL(kind=4) :: MPI_Buffer
+!    INTEGER(KIND=MPI_ADDRESS_KIND) :: BS 
+!    INTEGER :: ierr
+!    
+!    BS=4*size
+!    CALL MPI_ALLOC_MEM(BS,MPI_INFO_NULL,Pbuffer,ierr)
+!    CALL associate_buffer(MPI_Buffer,Pt)
+!  
+!  CONTAINS
+!  
+!    SUBROUTINE associate_buffer(MPI_buffer,Pt)
+!    IMPLICIT NONE
+!      REAL(kind=4),DIMENSION(:),target :: MPI_Buffer
+!      REAL(kind=4),POINTER             :: Pt(:)
+!      Pt=>MPI_buffer
+!    END SUBROUTINE associate_buffer
+!  
+!  END SUBROUTINE Allocate_global_memory_r4
+
+
+
+
+  SUBROUTINE Allocate_global_memory_i4(size,Pt)
+  USE mpi_mod
+  IMPLICIT NONE
+    INTEGER(kind=4),POINTER :: Pt(:)
+    INTEGER              :: size
+
+    POINTER (Pbuffer,MPI_Buffer(size))
+    INTEGER(kind=4) :: MPI_Buffer
+    INTEGER(KIND=MPI_ADDRESS_KIND) :: BS 
+    INTEGER :: ierr
+    
+    BS=4*size
+    CALL MPI_ALLOC_MEM(BS,MPI_INFO_NULL,Pbuffer,ierr)
+    CALL associate_buffer(MPI_Buffer,Pt)
+  
+  CONTAINS
+  
+    SUBROUTINE associate_buffer(MPI_buffer,Pt)
+    IMPLICIT NONE
+      INTEGER(kind=4),DIMENSION(:),target :: MPI_Buffer
+      INTEGER(kind=4),POINTER             :: Pt(:)
+      Pt=>MPI_buffer
+    END SUBROUTINE associate_buffer
+  
+  END SUBROUTINE Allocate_global_memory_i4
+  
+  
+END MODULE mod_global_memory
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_interface_ioipsl.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_interface_ioipsl.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_interface_ioipsl.f90	(revision 2528)
@@ -0,0 +1,272 @@
+MODULE mod_interface_ioipsl
+
+ 
+  INTEGER,PARAMETER     :: id_file=1
+
+
+CONTAINS
+
+  SUBROUTINE init_interface_ioipsl
+  USE xmlio
+  IMPLICIT NONE
+  
+    
+  END SUBROUTINE init_interface_ioipsl
+
+  SUBROUTINE set_calendar(str_calendar)
+  USE ioipsl
+    CHARACTER(LEN=*) :: str_calendar
+    
+    CALL ioconf_calendar(str_calendar)
+    
+  END SUBROUTINE set_calendar
+  
+  
+  SUBROUTINE set_time_parameters(ini_timestep0,zjulian0,timestep0)
+  USE xmlio
+  IMPLICIT NONE
+    INTEGER :: ini_timestep0
+    REAL :: zjulian0, timestep0
+
+    timestep_value=timestep0
+    initial_timestep=ini_timestep0
+    initial_date=zjulian0
+
+  END SUBROUTINE set_time_parameters
+
+  SUBROUTINE Create_file_definition(nb_server,server_rank)
+  USE ioipsl
+  USE xmlio
+  IMPLICIT NONE
+    INTEGER,INTENT(IN)  :: nb_server
+    INTEGER,INTENT(IN)  :: server_rank
+    
+    TYPE(file_dep),POINTER :: pt_file_dep
+    TYPE(file),POINTER     :: pt_file
+    TYPE(field),POINTER    :: pt_field
+    TYPE(grid),POINTER     :: pt_grid
+    TYPE(zoom),POINTER     :: pt_zoom
+    TYPE(axis),POINTER     :: pt_axis
+    TYPE(domain),POINTER   :: pt_domain
+
+    TYPE(sorted_list),POINTER :: axis_id
+    LOGICAL :: found                  
+    INTEGER :: ioipsl_axis_id
+    INTEGER :: ioipsl_file_id
+    INTEGER :: ioipsl_hori_id
+    INTEGER :: ioipsl_domain_id
+    INTEGER :: i,j
+    CHARACTER(LEN=20) :: direction
+    CHARACTER(LEN=255) :: full_name
+    CALL xmlio__close_definition 
+    
+    ALLOCATE(axis_id)
+    
+    DO i=1,file_enabled%size
+      
+      pt_file_dep=>file_enabled%at(i)%pt
+
+      IF (pt_file_dep%fields%size>0) THEN
+        CALL sorted_list__new(axis_id)
+
+        pt_file=>pt_file_dep%file
+      
+        pt_grid=>pt_file_dep%grids%at(1)%pt
+        pt_domain=>pt_grid%domain
+        pt_zoom=>pt_file_dep%zooms%at(1)%pt
+!        print *,TRIM(pt_file%name),' ',TRIM(pt_zoom%id)
+!        print*,'Global --->',pt_zoom%ni_glo,pt_zoom%nj_glo,pt_zoom%ibegin_glo,pt_zoom%jbegin_glo
+!        print*,'Local  --->',pt_zoom%ni_loc,pt_zoom%nj_loc,pt_zoom%ibegin_loc,pt_zoom%jbegin_loc
+      
+        IF (pt_zoom%ni_loc*pt_zoom%nj_loc > 0) THEN
+        
+          full_name=TRIM(pt_file%name)
+          IF (pt_file%has_name_suffix) full_name=TRIM(full_name)//TRIM(pt_file%name_suffix) 
+          IF ( (pt_zoom%ni_loc == pt_zoom%ni_glo) .AND. (pt_zoom%nj_loc == pt_zoom%nj_glo) ) THEN 
+
+            CALL histbeg(TRIM(full_name),pt_domain%ni,pt_domain%lon, pt_domain%nj, pt_domain%lat, & 
+                       pt_zoom%ibegin_loc, pt_zoom%ni_loc,pt_zoom%jbegin_loc,pt_zoom%nj_loc,         &
+                       initial_timestep, initial_date, timestep_value,                               &
+                       ioipsl_hori_id, ioipsl_file_id)
+           ELSE                                              
+
+            CALL set_ioipsl_domain_id(pt_grid,nb_server,server_rank,ioipsl_domain_id)
+            CALL histbeg(TRIM(full_name),pt_domain%ni,pt_domain%lon, pt_domain%nj, pt_domain%lat,  &
+                       pt_zoom%ibegin_loc, pt_zoom%ni_loc,pt_zoom%jbegin_loc,pt_zoom%nj_loc,          &
+                       initial_timestep, initial_date, timestep_value,                                &
+                       ioipsl_hori_id, ioipsl_file_id,domain_id=ioipsl_domain_id)                                              
+          
+           ENDIF
+        
+      
+          DO j=1,pt_file_dep%axis%size
+            pt_axis=>pt_file_dep%axis%at(j)%pt
+            CALL sorted_list__find(axis_id,hash(Pt_axis%name),ioipsl_axis_id,found)
+            IF (.NOT. found) THEN
+              IF (TRIM(pt_axis%name) /= "none") THEN
+              
+                IF (pt_axis%has_positive) THEN 
+                  IF (pt_axis%positive) THEN
+                    direction="up"
+                  ELSE
+                    direction="down"
+                  ENDIF
+                ELSE
+                  direction='unknown'
+                ENDIF
+
+                CALL histvert(ioipsl_file_id, TRIM(pt_axis%name),TRIM(pt_axis%description),    &
+                             TRIM(pt_axis%unit), pt_axis%size,pt_axis%values, ioipsl_axis_id,  &
+                           pdirect=direction)
+                CALL sorted_list__add(axis_id,hash(Pt_axis%name),ioipsl_axis_id)
+              ENDIF
+            ENDIF
+         ENDDO
+        
+          DO j=1,pt_file_dep%fields%size
+            pt_field=>pt_file_dep%fields%at(j)%pt
+            IF (pt_field%axis%name=="none") THEN
+              pt_field%internal(id_file)=ioipsl_file_id
+              CALL histdef(ioipsl_file_id, TRIM(pt_field%name), pt_field%description,            &
+                        &  pt_field%unit, pt_field%grid%domain%ni, pt_field%grid%domain%nj,      &
+                        &  ioipsl_hori_id, 1, 1, 1, -99, 32, pt_field%operation,                 &
+                        &  real(pt_field%freq_op), real(pt_file%output_freq) )
+            ELSE
+              pt_field%internal(id_file)=ioipsl_file_id
+              CALL sorted_list__find(axis_id,hash(Pt_field%axis%name),ioipsl_axis_id,found)
+              CALL histdef(ioipsl_file_id, TRIM(pt_field%name), pt_field%description,          &
+                         & pt_field%unit, pt_field%grid%domain%ni, pt_field%grid%domain%nj,    &
+                         & ioipsl_hori_id, pt_field%axis%size, 1, pt_field%axis%size,          &
+                         & ioipsl_axis_id, 32, pt_field%operation, real(pt_field%freq_op),     &
+                         & real(pt_file%output_freq) )
+            ENDIF
+          ENDDO
+          CALL histend(ioipsl_file_id)
+        ENDIF
+        CALL sorted_list__delete(axis_id)
+      ENDIF
+    ENDDO
+    
+    DEALLOCATE(axis_id)
+     
+  END SUBROUTINE Create_file_definition  
+
+
+
+   SUBROUTINE write_ioipsl_2d(varname,var)
+   USE ioipsl
+   USE xmlio
+   IMPLICIT NONE
+     CHARACTER(len=*),INTENT(IN) :: varname
+     REAL            ,INTENT(IN) :: var(:,:)
+     
+     TYPE(field_dep),POINTER :: pt_field_base
+     TYPE(field)    ,POINTER :: pt_field
+     INTEGER :: nindex(size(var))
+     INTEGER :: ioipsl_file_id
+     INTEGER :: pos
+     LOGICAL :: found
+     INTEGER :: i
+      
+     CALL sorted_list__find(sorted_id,hash(varname),pos,found)
+
+     IF (found) THEN
+       pt_field_base=>field_id%at(pos)%pt
+     
+       DO i=1,pt_field_base%field_out%size
+         pt_field=>pt_field_base%field_out%at(i)%pt%field
+         IF ( pt_field%zoom%ni_loc * pt_field%zoom%nj_loc > 0) THEN           
+           ioipsl_file_id=pt_field%internal(id_file)
+           CALL histwrite(ioipsl_file_id, TRIM(pt_field%name), timestep_number, var, size(var), nindex)
+         ENDIF
+       ENDDO
+     ENDIF
+     
+   END SUBROUTINE write_ioipsl_2d
+       
+     
+   SUBROUTINE write_ioipsl_3d(varname,var)
+   USE ioipsl
+   USE xmlio
+   IMPLICIT NONE
+     CHARACTER(len=*),INTENT(IN) :: varname
+     REAL            ,INTENT(IN) :: var(:,:,:)
+     
+     TYPE(field_dep),POINTER :: pt_field_base
+     TYPE(field)    ,POINTER :: pt_field
+     INTEGER :: nindex(size(var))
+     INTEGER :: ioipsl_file_id
+     INTEGER :: pos
+     LOGICAL :: found
+     INTEGER :: i
+        
+     CALL sorted_list__find(sorted_id,hash(varname),pos,found)
+
+     IF (found) THEN
+       pt_field_base=>field_id%at(pos)%pt
+     
+       DO i=1,pt_field_base%field_out%size
+         pt_field=>pt_field_base%field_out%at(i)%pt%field
+         IF ( pt_field%zoom%ni_loc * pt_field%zoom%nj_loc > 0) THEN           
+           ioipsl_file_id=pt_field%internal(id_file)
+           CALL histwrite(ioipsl_file_id, TRIM(pt_field%name), timestep_number, var, size(var), nindex)
+         ENDIF
+       ENDDO
+     ENDIF
+   END SUBROUTINE write_ioipsl_3d
+           
+
+  SUBROUTINE set_timestep(timestep_nb0)
+  USE xmlio
+  IMPLICIT NONE
+    INTEGER,INTENT(IN) :: timestep_nb0
+     
+    timestep_number=timestep_nb0
+
+  END SUBROUTINE set_timestep
+
+
+  SUBROUTINE set_ioipsl_domain_id(pt_grid, nb_server,server_rank,domain_id)
+  USE xmlio
+  USE mod_ioserver_para
+  USE ioipsl
+  IMPLICIT NONE
+    TYPE(grid), POINTER :: pt_grid
+    INTEGER,INTENT(IN)  :: nb_server
+    INTEGER,INTENT(IN)  :: server_rank
+    INTEGER,INTENT(OUT) :: domain_id
+    TYPE(domain), POINTER :: pt_domain
+               
+    INTEGER,DIMENSION(2) :: ddid
+    INTEGER,DIMENSION(2) :: dsg
+    INTEGER,DIMENSION(2) :: dsl
+    INTEGER,DIMENSION(2) :: dpf
+    INTEGER,DIMENSION(2) :: dpl
+    INTEGER,DIMENSION(2) :: dhs
+    INTEGER,DIMENSION(2) :: dhe 
+    
+    pt_domain=>pt_grid%domain
+
+    ddid = (/ 1,2 /)
+    dsg  = (/ pt_grid%ni, pt_grid%nj /)
+    dsl  = (/ pt_domain%ni, pt_domain%nj /)
+    dpf  = (/ pt_domain%ibegin,pt_domain%jbegin /)
+    dpl  = (/ pt_domain%iend, pt_domain%jend /)
+    dhs  = (/ 0,0 /)
+    dhe  = (/ 0,0 /)
+    
+    call flio_dom_set(nb_server,server_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, &
+                      'BOX',domain_id)
+  
+  END SUBROUTINE set_ioipsl_domain_id
+
+
+  SUBROUTINE ioipsl_finalize
+  USE ioipsl
+  IMPLICIT NONE
+
+    CALL histclo
+    
+  END SUBROUTINE ioipsl_finalize
+  
+END MODULE mod_interface_ioipsl
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_ioclient.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_ioclient.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_ioclient.f90	(revision 2528)
@@ -0,0 +1,61 @@
+MODULE mod_ioclient
+
+
+CONTAINS
+
+  SUBROUTINE init_ioclient(NEW_COMM)
+  USE mod_ioclient_para
+  USE mod_mpi_buffer_client
+  USE mod_wait
+  USE mod_ioserver_namelist
+  USE mod_event_client
+  USE iomanager
+  USE mpi_mod
+  IMPLICIT NONE
+    INTEGER, INTENT(INOUT),OPTIONAL :: NEW_COMM
+
+    INTEGER :: Comm
+    INTEGER :: nb_server
+    INTEGER :: rank
+    INTEGER :: ierr
+    LOGICAL :: init
+ 
+    CALL read_namelist
+
+    IF (using_mpi) THEN
+      IF (using_server) THEN
+        CALL Init_parallel
+        CALL Init_mpi_buffer
+        CALL Init_wait
+        IF (PRESENT(NEW_COMM)) THEN
+          NEW_COMM=intracomm
+        ENDIF
+      ELSE
+        CALL MPI_INITIALIZED(init,ierr)
+        IF (init) THEN
+          IF (.NOT. PRESENT(NEW_COMM)) THEN
+             Comm=MPI_COMM_WORLD
+          ELSE
+            Comm=New_Comm
+          ENDIF
+        ELSE
+          CALL MPI_INIT(ierr)
+          Comm=MPI_COMM_WORLD
+          
+          IF (PRESENT(NEW_COMM)) THEN
+            New_Comm=MPI_COMM_WORLD
+          ENDIF
+        ENDIF  
+        CALL MPI_COMM_SIZE(Comm,nb_server,ierr)     
+        CALL MPI_COMM_RANK(Comm,rank,ierr)
+        CALL iom__init(1,nb_server,rank)
+        CALL iom__set_current_rank(1)
+      ENDIF
+    ELSE
+      CALL iom__init(1,1,0)
+      CALL iom__set_current_rank(1)
+    ENDIF
+    
+  END SUBROUTINE init_ioclient
+
+END MODULE mod_ioclient
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_ioclient_para.F90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_ioclient_para.F90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_ioclient_para.F90	(revision 2528)
@@ -0,0 +1,89 @@
+  MODULE mod_ioclient_para
+    INTEGER,PARAMETER :: color_client=1
+    INTEGER,PARAMETER :: color_server=2 
+    INTEGER,SAVE      :: iocomm
+    INTEGER,SAVE      :: iosize
+    INTEGER,SAVE      :: iorank
+    INTEGER,SAVE      :: server_rank
+    INTEGER,SAVE      :: intracomm 
+  CONTAINS
+  
+  
+  SUBROUTINE Init_parallel
+  USE mpitrace
+  USE mod_ioserver_namelist
+#if defined key_oasis3 || defined key_oasis4
+  USE mod_prism_get_comm  
+#endif
+  USE mpi_mod
+  IMPLICIT NONE
+    INTEGER :: NEW_COMM
+    INTEGER :: ierr
+    INTEGER :: global_rank
+    INTEGER :: global_size
+    INTEGER :: mpi_rank
+    INTEGER :: mpi_size
+    INTEGER :: nb_server_io  
+    INTEGER,ALLOCATABLE :: proc_color(:) 
+    INTEGER :: i
+    INTEGER :: div,remain
+    INTEGER :: group_color
+    INTEGER :: Comm_client_server
+    CHARACTER(LEN=6) :: oasis_server_id
+    
+    IF (using_oasis) THEN
+      oasis_server_id=server_id
+      PRINT *,'prism_get_intracomm'
+#if defined key_oasis3 || defined key_oasis4
+      CALL prism_get_intracomm(Comm_client_server,oasis_server_id,ierr)
+#endif
+    ELSE
+      CALL MPI_INIT(ierr)
+      Comm_client_server=MPI_COMM_WORLD
+    ENDIF
+
+    CALL MPI_COMM_RANK(Comm_client_server,global_rank,ierr)
+    CALL MPI_COMM_SIZE(Comm_client_server,global_size,ierr)
+
+    CALL MPI_COMM_SPLIT(Comm_client_server,color_client,global_rank,intracomm,ierr)
+    CALL MPI_COMM_SIZE(intracomm,mpi_size,ierr)
+    CALL MPI_COMM_RANK(intracomm,mpi_rank,ierr)
+
+    nb_server_io=global_size-mpi_size
+    div=mpi_size/nb_server_io
+    remain=MOD(mpi_size,nb_server_io)
+    
+    IF (mpi_rank<remain*(div+1)) THEN
+      group_color=mpi_rank/(div+1)
+    ELSE
+      group_color=(nb_server_io-1)-(mpi_size-1-mpi_rank)/div
+    ENDIF
+
+    CALL MPI_COMM_SPLIT(Comm_client_server,group_color,global_rank,iocomm,ierr)
+    
+    CALL MPI_COMM_SIZE(iocomm,iosize,ierr)
+    CALL MPI_COMM_RANK(iocomm,iorank,ierr)
+
+    ALLOCATE(proc_color(0:iosize-1))
+    CALL MPI_ALLGATHER(color_client,1,MPI_INTEGER,proc_color,1,MPI_INTEGER,iocomm,ierr)
+    
+    DO i=0,iosize-1
+      IF (proc_color(i)==color_server) THEN
+        server_rank=i
+        EXIT
+      ENDIF
+    ENDDO
+    
+    PRINT *,"Proces No",mpi_rank,"--> server",server_rank
+  END SUBROUTINE Init_parallel
+  
+  SUBROUTINE Finalize_parallel
+  USE mpi_mod
+  IMPLICIT NONE
+    INTEGER :: ierr
+    
+    CALL MPI_FINALIZE(ierr)
+
+  END SUBROUTINE Finalize_parallel
+  
+  END MODULE mod_ioclient_para
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_iomanager.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_iomanager.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_iomanager.f90	(revision 2528)
@@ -0,0 +1,435 @@
+MODULE iomanager
+  INTEGER,PRIVATE,SAVE :: nb_client
+  INTEGER,PRIVATE,SAVE :: nb_server
+  INTEGER,PRIVATE,SAVE :: server_rank
+  INTEGER,PRIVATE,SAVE :: current_rank
+  
+CONTAINS
+
+  SUBROUTINE iom__init(nb_client_,nb_server_,server_rank_)
+  IMPLICIT NONE
+   INTEGER,INTENT(IN) :: nb_client_
+   INTEGER,INTENT(IN) :: nb_server_
+   INTEGER,INTENT(IN) :: server_rank_
+   
+     nb_client=nb_client_ 
+     nb_server=nb_server_
+     server_rank=server_rank_
+     
+  END SUBROUTINE iom__init
+ 
+  SUBROUTINE iom__parse_xml_file(filename)
+  USE xmlio
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: filename
+    
+    IF (current_rank==nb_client) CALL xmlio__init(filename)
+     
+  END SUBROUTINE iom__parse_xml_file
+   
+  SUBROUTINE iom__swap_context(id)
+  USE xmlio
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: id
+    
+    IF (current_rank==nb_client) CALL context__swap(id)
+     
+  END SUBROUTINE iom__swap_context
+
+  SUBROUTINE iom__set_current_rank(rank)
+  IMPLICIT NONE
+    INTEGER,INTENT(IN) :: rank
+    
+    current_rank=rank
+  
+  END SUBROUTINE iom__set_current_rank
+  
+  SUBROUTINE iom__set_vert_axis(name,vert_value)
+  USE xmlio
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: name
+    REAL,INTENT(IN)             :: vert_value(:)
+    TYPE(axis), POINTER :: pt_axis
+    
+    IF (current_rank==nb_client) THEN
+      CALL axis__get(name, pt_axis)
+      CALL axis__set(pt_axis, a_size=size(vert_value), values=vert_value)
+    ENDIF
+ 
+  END SUBROUTINE iom__set_vert_axis
+
+ 
+  SUBROUTINE iom__set_grid_dimension(name,ni_glo,nj_glo)
+  USE xmlio
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: name
+    INTEGER,INTENT(IN) :: ni_glo
+    INTEGER,INTENT(IN) :: nj_glo
+    TYPE(grid), POINTER :: pt_grid
+  
+    IF (current_rank==nb_client) THEN
+      CALL grid__get(name,pt_grid)
+      CALL grid__set_dimension(pt_grid,ni_glo,nj_glo)
+    ENDIF
+
+  END SUBROUTINE iom__set_grid_dimension
+  
+  SUBROUTINE iom__set_grid_domain(name,ni,nj,ibegin,jbegin,lon,lat)
+  USE xmlio
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: name
+    INTEGER,INTENT(IN) :: ni
+    INTEGER,INTENT(IN) :: nj
+    INTEGER,INTENT(IN) :: ibegin
+    INTEGER,INTENT(IN) :: jbegin
+    REAL,INTENT(IN)    :: lon(ni,nj)
+    REAL,INTENT(IN)    :: lat(ni,nj)
+
+    TYPE(grid),   POINTER :: pt_grid
+    TYPE(domain), POINTER :: pt_domain
+
+      CALL grid__get(name,pt_grid)
+      CALL grid__get_new_subdomain(pt_grid,current_rank,pt_domain)
+      CALL domain__set(pt_domain,current_rank,ni,nj,ibegin,jbegin,lon,lat)
+
+  END SUBROUTINE iom__set_grid_domain
+
+  SUBROUTINE iom__set_grid_type_nemo(name)
+  USE xmlio
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: name
+
+    TYPE(grid),   POINTER :: pt_grid
+    TYPE(domain), POINTER :: pt_domain
+      
+      CALL grid__get(name,pt_grid)
+      CALL grid__get_subdomain(pt_grid,current_rank,pt_domain)
+      CALL domain__set_type_box(pt_domain)
+
+  END SUBROUTINE iom__set_grid_type_nemo
+
+  SUBROUTINE iom__set_grid_type_lmdz(name,nbp,offset)
+  USE xmlio
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: name
+    INTEGER,INTENT(IN)          :: nbp
+    INTEGER,INTENT(IN)          :: offset
+
+    TYPE(grid),   POINTER :: pt_grid
+    TYPE(domain), POINTER :: pt_domain
+    LOGICAL,ALLOCATABLE   :: mask(:,:)
+      
+      CALL grid__get(name,pt_grid)
+      CALL grid__get_subdomain(pt_grid,current_rank,pt_domain)
+      ALLOCATE(mask(pt_domain%ni,pt_domain%nj))
+      mask(:,:)=.TRUE.
+      mask(1:offset,1)=.FALSE.
+      mask(MOD(offset+nbp-1,pt_domain%ni)+2:pt_domain%ni,pt_domain%nj)=.FALSE.
+      CALL domain__set_type_box(pt_domain,mask)
+
+  END SUBROUTINE iom__set_grid_type_lmdz
+      
+  SUBROUTINE iom__set_time_parameters(itau0,zjulian,zdt)
+  USE mod_interface_ioipsl
+  IMPLICIT NONE
+    INTEGER, INTENT(IN) :: itau0
+    REAL,INTENT(IN)     :: zjulian
+    REAL,INTENT(IN)     :: zdt
+      
+    IF (current_rank==nb_client) THEN
+      CALL set_time_parameters(itau0, zjulian, zdt)
+    ENDIF
+  END SUBROUTINE iom__set_time_parameters
+  
+  SUBROUTINE iom__close_io_definition
+  USE mod_interface_ioipsl
+  IMPLICIT NONE
+  
+    IF (current_rank==nb_client) CALL Create_file_definition(nb_server,server_rank)
+  
+  END SUBROUTINE iom__close_io_definition
+      
+
+  SUBROUTINE iom__set_timestep(timestep)
+  USE mod_interface_ioipsl
+  IMPLICIT NONE
+    INTEGER, INTENT(IN) :: timestep
+    
+    IF (current_rank==nb_client) CALL set_timestep(timestep)
+    
+  END SUBROUTINE iom__set_timestep
+
+  SUBROUTINE iom__set_calendar(str_calendar)
+  USE mod_interface_ioipsl
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: str_calendar
+    
+    IF (current_rank==nb_client) CALL set_calendar(str_calendar)
+    
+  END SUBROUTINE iom__set_calendar
+
+  SUBROUTINE iom__enable_field(varname)
+  USE xmlio
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: varname
+    TYPE(field),POINTER :: pt_field
+    
+    CALL field__get(TRIM(varname), pt_field)
+    CALL field__set(pt_field,enabled=.TRUE.)
+    
+  END SUBROUTINE iom__enable_field
+  
+  SUBROUTINE iom__disable_field(varname)
+  USE xmlio
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: varname
+    TYPE(field),POINTER :: pt_field
+    
+    CALL field__get(TRIM(varname), pt_field)
+    CALL field__set(pt_field,enabled=.FALSE.)
+    
+  END SUBROUTINE iom__disable_field
+   
+
+  SUBROUTINE iom__write_field1d(varname,var)
+  USE xmlio
+  USE field_bufferize
+  USE mod_interface_ioipsl
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: varname
+    REAL             :: var(:)
+
+    TYPE(field),POINTER  :: pt_field
+    TYPE(domain),POINTER :: subdomain
+    TYPE(domain),POINTER :: local_domain
+    INTEGER :: ni,nj,ibegin,jbegin
+    INTEGER :: id_rank
+    
+    CALL field__get(varname,pt_field)
+    id_rank=pt_field%grid%ranks(current_rank)
+    local_domain=>pt_field%grid%domain
+    
+    subdomain=>pt_field%grid%subdomain%at(id_rank)%pt
+    ni=subdomain%ni
+    nj=subdomain%nj
+    ibegin=subdomain%ibegin-local_domain%ibegin+1
+    jbegin=subdomain%jbegin-local_domain%jbegin+1 
+
+    IF (subdomain%type==box) THEN
+
+      WRITE(message,*) 'Field must have 2 or 3 dimensions for box domain. There, it have only one.' 
+      CALL error("iom__write_field2d")
+
+    ELSE IF (subdomain%type==orange) THEN
+      IF (size(var,1)/=subdomain%nbp) THEN 
+         WRITE(message,*) 'Field dimensions are not compliant with the associated grid ',  &
+                          'field nbp :',size(var,1),'   grid nbp :',subdomain%nbp
+         CALL error("iom__write_field2d")
+      ENDIF
+      IF (pt_field%axis%name /= 'none') THEN
+        WRITE(message,*) "Missing axis dimension for this field"
+        CALL error("iom__write_field2d")
+      ENDIF
+    ENDIF
+    
+    
+    IF (current_rank==1) THEN
+      CALL init_field_bufferize(local_domain%ni,local_domain%nj,1)
+    ENDIF
+    
+    CALL bufferize_field(ni,ibegin,nj,jbegin,1,1,subdomain%nbp,var,         &
+                         subdomain%i_index,subdomain%j_index,subdomain%mask)
+    
+    IF (current_rank==nb_client) THEN
+      ni=local_domain%ni
+      nj=local_domain%nj
+      CALL write_ioipsl_2d(varname,Field_buffer(1:ni,1:nj,1))
+    ENDIF
+    
+  END SUBROUTINE iom__write_field1d
+
+   
+  SUBROUTINE iom__write_field2d(varname,var)
+  USE xmlio
+  USE field_bufferize
+  USE mod_interface_ioipsl
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: varname
+    REAL             :: var(:,:)
+
+    TYPE(field),POINTER  :: pt_field
+    TYPE(domain),POINTER :: subdomain
+    TYPE(domain),POINTER :: local_domain
+    INTEGER :: ni,nj,nk,ibegin,jbegin
+    INTEGER :: id_rank
+    
+    CALL field__get(varname,pt_field)
+    id_rank=pt_field%grid%ranks(current_rank)
+    local_domain=>pt_field%grid%domain
+    
+    subdomain=>pt_field%grid%subdomain%at(id_rank)%pt
+    ni=subdomain%ni
+    nj=subdomain%nj
+    ibegin=subdomain%ibegin-local_domain%ibegin+1
+    jbegin=subdomain%jbegin-local_domain%jbegin+1 
+    nk=pt_field%axis%size
+
+    IF (subdomain%type==box) THEN
+      IF (size(var,1)/=ni .OR. size(var,2)/=nj) THEN
+        WRITE(message,*) 'Field dimensions are not compliant with the associated grid ',  &
+                          'field dim :',size(var,1),',',size(var,2),'   grid dim',ni,',',nj
+        CALL error("iom__write_field2d")
+      ENDIF
+      
+      IF (pt_field%axis%name/="none") THEN
+        WRITE(message,*) "Missing axis dimension for this field"
+        CALL error("iom__write_field2d")
+      ENDIF
+    
+    ELSE IF (subdomain%type==orange) THEN
+      IF (size(var,1)/=subdomain%nbp) THEN 
+         WRITE(message,*) 'Field dimensions are not compliant with the associated grid ',  &
+                          'field nbp :',size(var,1),'   grid nbp : ',subdomain%nbp
+         CALL error("iom__write_field2d")
+      ENDIF
+      IF (nk /= size(var,2)) THEN
+         WRITE(message,*) 'Field dimensions are not compliant with the associated axis', &
+                          'field dim :',size(var,2),'   axis dim :', nk
+         CALL error("iom__write_field2d")
+      ENDIF
+    ENDIF
+    
+    
+    IF (current_rank==1) THEN
+      CALL init_field_bufferize(local_domain%ni,local_domain%nj,nk)
+    ENDIF
+    
+    CALL bufferize_field(ni,ibegin,nj,jbegin,nk,1,subdomain%nbp,var,         &
+                         subdomain%i_index,subdomain%j_index,subdomain%mask)
+    
+    IF (current_rank==nb_client) THEN
+      ni=local_domain%ni
+      nj=local_domain%nj
+      
+      IF (pt_field%axis%name=="none") THEN
+        CALL write_ioipsl_3d(varname,Field_buffer(1:ni,1:nj,1:nk))
+      ELSE 
+        CALL write_ioipsl_2d(varname,Field_buffer(1:ni,1:nj,1))
+      ENDIF
+    
+    ENDIF
+    
+  END SUBROUTINE iom__write_field2d
+
+  SUBROUTINE iom__write_field3d(varname,var)
+  USE xmlio
+  USE field_bufferize
+  USE mod_interface_ioipsl
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: varname
+    REAL             :: var(:,:,:)
+
+    TYPE(field),POINTER  :: pt_field
+    TYPE(domain),POINTER :: subdomain
+    TYPE(domain),POINTER :: local_domain
+    INTEGER :: ni,nj,nk,ibegin,jbegin
+    INTEGER :: id_rank
+
+    CALL field__get(varname,pt_field)
+    id_rank=pt_field%grid%ranks(current_rank)
+    local_domain=>pt_field%grid%domain
+    
+    subdomain=>pt_field%grid%subdomain%at(id_rank)%pt
+    ni=subdomain%ni
+    nj=subdomain%nj
+    ibegin=subdomain%ibegin-local_domain%ibegin+1
+    jbegin=subdomain%jbegin-local_domain%jbegin+1 
+    nk=pt_field%axis%size
+
+    IF (subdomain%type==box) THEN
+      IF (size(var,1)/=ni .OR. size(var,2)/=nj) THEN
+        WRITE(message,*) 'Field dimensions are not compliant with the associated grid ',  &
+                          'field dim :',size(var,1),',',size(var,2),'   grid dim',ni,',',nj
+        CALL error("iom__write_field3d")
+      ENDIF
+      
+      IF (pt_field%axis%name=='none' .OR. nk/=size(var,3)) THEN
+        WRITE(message,*) 'Field dimension is not compliant with the associated axis : ', &
+                         'field dim : ',size(var,3),'  axis dim : ',nk
+        CALL error("iom__write_field3d")
+      ENDIF
+
+    ELSE IF (subdomain%type==orange) THEN
+
+      WRITE(message,*) 'Field have too much dimensions for box domain. There, it has 3.' 
+      CALL error("iom__write_field3d")
+      
+    ENDIF
+    
+    
+    IF (current_rank==1) THEN
+      CALL init_field_bufferize(local_domain%ni,local_domain%nj,nk)
+    ENDIF
+    
+    CALL bufferize_field(ni,ibegin,nj,jbegin,nk,1,subdomain%nbp,var,         &
+                         subdomain%i_index,subdomain%j_index,subdomain%mask)
+    
+    IF (current_rank==nb_client) THEN
+      ni=local_domain%ni
+      nj=local_domain%nj
+      
+      CALL write_ioipsl_3d(varname,Field_buffer(1:ni,1:nj,1:nk))
+    
+    ENDIF
+    
+  END SUBROUTINE iom__write_field3d
+ 
+  SUBROUTINE iom__Finalize
+  USE mod_interface_ioipsl
+  IMPLICIT NONE
+  
+    IF (current_rank==nb_client) CALL ioipsl_finalize
+    
+  END SUBROUTINE iom__Finalize
+
+
+  SUBROUTINE iom__set_attribut(id,attrib)
+  USE mod_attribut
+  USE mod_object
+  USE mod_field
+  USE mod_field_group
+  USE mod_file
+  USE mod_file_group
+  USE mod_axis
+  USE mod_axis_group
+  USE mod_grid
+  USE mod_grid_group
+  USE mod_zoom
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: id
+    TYPE(attribut)   :: attrib  
+    LOGICAL          :: success
+    IF (current_rank==nb_client) THEN
+    
+      SELECT CASE(attrib%object)
+        CASE(field_object)
+          CALL field_group__set_attribut(id,attrib,success)
+          IF (.NOT. success) CALL field__set_attribut(id,attrib,success)         
+        CASE(file_object)
+          CALL file_group__set_attribut(id,attrib,success)
+          IF (.NOT. success) CALL file__set_attribut(id,attrib,success)         
+        CASE(axis_object)
+          CALL axis_group__set_attribut(id,attrib,success)
+          IF (.NOT. success) CALL axis__set_attribut(id,attrib,success)         
+        CASE(grid_object)
+          CALL grid_group__set_attribut(id,attrib,success)
+          IF (.NOT. success) CALL grid__set_attribut(id,attrib,success)         
+        CASE(zoom_object)
+          CALL zoom__set_attribut(id,attrib,success)
+      END SELECT
+    ENDIF
+    
+  END SUBROUTINE iom__set_attribut
+   
+END MODULE iomanager 
+ 
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_ioserver_namelist.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_ioserver_namelist.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_ioserver_namelist.f90	(revision 2528)
@@ -0,0 +1,74 @@
+MODULE mod_ioserver_namelist
+
+  USE nc4interface
+  LOGICAL,SAVE :: using_server
+  LOGICAL,SAVE :: using_oasis
+  CHARACTER(LEN=100),SAVE :: client_id
+  CHARACTER(LEN=100),SAVE :: server_id
+  NAMELIST /coupling_param/ using_server,using_oasis,client_id,server_id  
+
+  INTEGER,SAVE :: global_mpi_buffer_size            
+  NAMELIST /mpi_param/ global_mpi_buffer_size  
+
+  INTEGER,PARAMETER,PRIVATE :: starting_unit=356
+  TYPE(snc4_ctl), SAVE :: snc4ioset
+  INTEGER :: nn_nchunks_i, nn_nchunks_j, nn_nchunks_k
+  LOGICAL :: ln_nc4zip=.false.
+  NAMELIST /namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
+  
+CONTAINS
+
+  SUBROUTINE set_default_namelist
+  IMPLICIT NONE
+  
+    using_server=.FALSE.
+    using_oasis=.FALSE.
+    client_id='unknown'
+    server_id='unknown'
+    global_mpi_buffer_size=512
+    snc4ioset%luse = .false.
+    
+  END SUBROUTINE set_default_namelist
+  
+    
+  SUBROUTINE read_namelist
+  IMPLICIT NONE
+    LOGICAL :: opened
+    INTEGER :: unit
+    INTEGER :: ierr
+
+    CALL set_default_namelist   
+    unit=starting_unit
+    opened=.TRUE.
+    DO WHILE (opened) 
+      unit=unit+1
+      INQUIRE(unit,OPENED=opened)
+    ENDDO
+      
+    OPEN(UNIT=unit,FILE='xmlio_server.def',STATUS='old',IOSTAT=ierr)
+    
+    
+    IF (ierr==0) THEN
+      READ(unit,nml=coupling_param)
+      READ(unit,nml=mpi_param)
+      READ(unit,nml=namnc4,ERR=666,END=666)
+ 666  global_mpi_buffer_size=global_mpi_buffer_size*1024*128  
+      CLOSE(unit)
+      IF (ln_nc4zip) THEN
+        snc4ioset%ni  = nn_nchunks_i
+        snc4ioset%nj  = nn_nchunks_j
+        snc4ioset%nk  = nn_nchunks_k
+        snc4ioset%luse = ln_nc4zip
+      ENDIF
+    ELSE
+      PRINT *,'WARNING : mod_ioserver::read_namelist : file xmlio_server.def is absent', &
+              ' ---> using default parameter'
+    ENDIF 
+    
+    
+    PRINT *,'namelist read --> ',using_server,using_oasis,client_id,server_id
+    
+  END SUBROUTINE read_namelist
+
+
+END MODULE mod_ioserver_namelist 
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_ioserver_para.F90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_ioserver_para.F90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_ioserver_para.F90	(revision 2528)
@@ -0,0 +1,102 @@
+  MODULE mod_ioserver_para
+    INTEGER,PARAMETER :: color_client=1
+    INTEGER,PARAMETER :: color_server=2 
+
+    INTEGER,SAVE      :: iocomm
+    INTEGER,SAVE      :: iosize
+    INTEGER,SAVE      :: iorank
+    
+    INTEGER,SAVE      :: mpi_rank
+    INTEGER,SAVE      :: mpi_size
+    INTEGER,SAVE      :: mpi_master
+    LOGICAL,SAVE      :: is_mpi_master
+  
+    INTEGER,SAVE      :: nb_client
+    INTEGER,ALLOCATABLE,SAVE      :: client_rank(:)
+    INTEGER,SAVE      :: intracomm 
+  CONTAINS
+  
+  
+  SUBROUTINE Init_parallel
+  USE mpitrace
+  USE mod_ioserver_namelist
+#if defined key_oasis3 || defined key_oasis4
+  USE mod_prism_get_comm 
+#endif 
+  USE mpi_mod
+  IMPLICIT NONE
+    INTEGER :: ierr
+    INTEGER :: global_rank
+    INTEGER :: global_size
+    INTEGER,ALLOCATABLE :: proc_color(:)
+    INTEGER :: i
+    INTEGER :: group_color
+    INTEGER :: Comm_client_server
+    INTEGER :: comp_id
+    CHARACTER(LEN=6) :: oasis_server_id, oasis_client_id
+
+    IF (using_oasis) THEN
+       oasis_server_id=server_id
+       oasis_client_id=client_id
+#if defined key_oasis3 || defined key_oasis4
+       CALL prism_init_comp_proto (comp_id, oasis_server_id, ierr)
+       CALL prism_get_intracomm(Comm_client_server,oasis_client_id,ierr)
+#endif
+    ELSE
+      CALL MPI_INIT(ierr)
+      Comm_client_server=MPI_COMM_WORLD
+    ENDIF
+        
+    CALL MPI_COMM_RANK(Comm_client_server,global_rank,ierr)
+    CALL MPI_COMM_SIZE(Comm_client_server,global_size,ierr)
+       
+    CALL MPI_COMM_SPLIT(Comm_client_server,color_server,global_rank,intracomm,ierr)
+    CALL MPI_COMM_SIZE(intracomm,mpi_size,ierr)
+    CALL MPI_COMM_RANK(intracomm,mpi_rank,ierr)
+    
+    group_color=mpi_rank
+    PRINT *,'group_color',group_color
+
+    CALL MPI_COMM_SPLIT(Comm_client_server,group_color,global_rank,iocomm,ierr)    
+    
+    CALL MPI_COMM_SIZE(iocomm,iosize,ierr)
+    CALL MPI_COMM_RANK(iocomm,iorank,ierr)
+
+    PRINT *,"io_size-> ",iosize,"iorank-> ",iorank
+    
+    ALLOCATE(proc_color(0:iosize-1))
+    CALL MPI_ALLGATHER(color_server,1,MPI_INTEGER,proc_color,1,MPI_INTEGER,iocomm,ierr)
+    print *,"proc_color -> ",proc_color
+    
+    ALLOCATE(client_rank(iosize-1))
+    nb_client=0
+    DO i=0,iosize-1
+      IF (proc_color(i)==color_client) THEN
+        nb_client=nb_client+1
+        client_rank(nb_client)=i
+      ENDIF
+    ENDDO
+
+    PRINT *,"Proces No",mpi_rank,"--> client ",client_rank
+  END SUBROUTINE Init_parallel
+  
+  SUBROUTINE Finalize_parallel
+  USE mod_ioserver_namelist
+#if defined key_oasis3 || defined key_oasis4
+  USE mod_prism_proto
+#endif
+  USE mpi_mod
+  IMPLICIT NONE
+    INTEGER :: ierr
+    
+    IF (using_oasis) THEN
+#if defined key_oasis3 || defined key_oasis4
+      CALL prism_terminate_proto(ierr)
+#endif
+    ELSE
+      CALL MPI_FINALIZE(ierr)
+    ENDIF
+    
+  END SUBROUTINE Finalize_parallel
+
+END MODULE mod_ioserver_para
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_mpi_buffer_client.F90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_mpi_buffer_client.F90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_mpi_buffer_client.F90	(revision 2528)
@@ -0,0 +1,207 @@
+MODULE mod_mpi_buffer_client
+  USE mod_mpi_buffer_parameters
+#if defined key_mpp_mpi
+  USE mpi, ONLY : status_size=>MPI_STATUS_SIZE
+#else
+  INTEGER, PARAMETER :: status_size = 1
+#endif
+
+  
+  INTEGER(KIND=8),POINTER :: MPI_Buffer(:)
+  
+  TYPE mpi_requests
+    INTEGER :: request
+    INTEGER :: status(status_size)
+    INTEGER :: Pos
+  END TYPE mpi_requests
+  
+  TYPE(mpi_requests),DIMENSION(max_request) :: pending_request
+  
+  INTEGER :: Buffer_pos
+  INTEGER :: request_pos
+  INTEGER :: buffer_begin
+  INTEGER :: request_begin
+  INTEGER :: nb_request_pending
+  INTEGER,SAVE :: start_pos
+  LOGICAL,SAVE :: ok_new_request
+  LOGICAL,SAVE :: is_last_request
+
+  INTEGER,SAVE      :: mpi_buffer_size
+  INTEGER,SAVE      :: aggregated_request
+
+CONTAINS
+
+  SUBROUTINE Init_mpi_buffer
+  USE mod_global_memory
+  USE mod_pack
+  USE mod_ioclient_para
+  IMPLICIT NONE
+
+  INTEGER  :: nb_client
+  
+    nb_client=iosize-1  
+    mpi_buffer_size=global_mpi_buffer_size/nb_client
+    
+    CALL allocate_global_memory(mpi_buffer_size,MPI_Buffer)
+    buffer_begin=1
+    request_begin=1
+    Buffer_pos=1
+    nb_request_pending=0
+    Request_pos=1
+    ok_new_request=.TRUE.
+    is_last_request=.FALSE.
+    aggregated_request=0
+    
+    CALL set_pack_buffer(MPI_Buffer,buffer_begin)
+    
+  END SUBROUTINE Init_mpi_buffer
+  
+
+  SUBROUTINE create_request(request_id)
+  USE mod_pack
+  USE mod_ioclient_para
+  USE mpitrace
+  USE mpi_mod
+  IMPLICIT NONE
+    INTEGER :: request_id
+    
+    CALL VTb(VTprocess_event)
+    IF (ok_new_request) THEN  
+      Pending_request(Request_pos)%Pos = pack_pos
+      ok_new_request=.FALSE.
+    ENDIF
+    start_pos=pack_pos
+    pack_pos=pack_pos+1
+!    PRINT *,"Pos in Buffer",Pending_request(Request_pos)%Pos,"pack_pos",pack_pos
+    CALL pack(request_id)
+  END SUBROUTINE create_request
+  
+  
+  SUBROUTINE Finalize_request
+  USE mod_pack
+  USE mod_ioclient_para
+  USE mpitrace
+  use mod_wait
+  USE mpi_mod
+  IMPLICIT NONE
+    INTEGER :: ierr
+    INTEGER :: message_size
+    INTEGER(KIND=8) :: request_size
+    INTEGER :: buffer_free
+    LOGICAL :: ok_out
+    LOGICAL :: is_Buffer_full
+    request_size=pack_pos-start_pos    
+    pack_buffer(start_pos)=request_size
+    message_size=pack_pos-Pending_request(Request_pos)%Pos
+    aggregated_request=aggregated_request+1
+
+
+!! ICI verifier que le buffer ne se recouvre pas ainsi que les requetes
+    
+    ok_out=.FALSE.
+    is_buffer_full=.FALSE.
+    DO WHILE (.NOT. ok_out)
+      CALL check_request
+    
+      IF ( buffer_begin <= pack_pos) THEN
+        Buffer_free=mpi_buffer_size-pack_pos+1
+      ELSE
+        Buffer_free=buffer_begin-pack_pos
+      ENDIF
+      
+!      Print *,"message_size",message_size,"buffer_free",buffer_free
+!      PRINT *,"Request_pos",request_pos
+!      PRINT *,"Pos in Buffer",Pending_request(Request_pos)%Pos,"pack_pos",pack_pos
+      IF ( nb_request_pending==1 .AND. ( (buffer_free < MPI_buffer_size * 0.4) .OR. is_last_request .OR.  &
+                                         (aggregated_request>=max_request/2) )) THEN
+        ok_out=.FALSE.
+        CALL Wait_us(10)
+        IF (.NOT. is_buffer_full) THEN
+          CALL VTb(VTbuffer_full)
+        ENDIF      
+        is_Buffer_full=.TRUE.
+        
+      ELSE
+        ok_out=.TRUE.
+        IF (is_buffer_full) THEN
+          CALL VTe(VTbuffer_full)
+        ENDIF
+        is_buffer_full=.FALSE.
+      
+      ENDIF
+      
+   ENDDO
+   
+   IF (nb_request_pending==0 .OR. (buffer_free < MPI_buffer_size* 0.4 ) .OR. (aggregated_request> max_request/2) ) THEN
+      
+     CALL MPI_ISSEND(MPI_Buffer(Pending_request(Request_pos)%Pos),message_size,MPI_INTEGER8,     &
+                    server_rank,tag_iocomm,iocomm,Pending_request(Request_pos)%request,ierr )
+    
+!    PRINT *,"Requete envoy�e !!!!" 
+!    PRINT *,"Message : ",MPI_Buffer(Pending_request(Request_pos)%Pos:Pending_request(Request_pos)%Pos+message_size-1)              
+      IF ( Pack_Pos > MPI_buffer_size*0.6 ) THEN
+        Pack_Pos=1
+      ENDIF
+    
+      IF (Request_Pos==max_request) THEN
+        Request_Pos=1
+      ELSE 
+        Request_Pos=Request_Pos+1
+      ENDIF
+      nb_request_pending=nb_request_pending+1
+    
+      ok_new_request=.TRUE.
+      aggregated_request=0
+    ENDIF
+    CALL VTe(VTprocess_event)    
+  END SUBROUTINE Finalize_request
+
+
+  SUBROUTINE Check_request
+  USE mpi_mod
+  IMPLICIT NONE
+  LOGICAL :: ok_out
+  LOGICAL :: OK_complete
+  INTEGER :: ierr
+  
+!    PRINT *, 'on entre dans Check_request'
+!    PRINT *, 'nb_request_pending',nb_request_pending
+    
+    IF (nb_request_pending>0) THEN
+      ok_out=.FALSE.
+    ELSE
+      ok_out=.TRUE.
+    ENDIF
+    
+    DO WHILE (.NOT. ok_out)
+    
+!      PRINT *,'Testing_request...'
+!      PRINT *,'request_begin',request_begin
+      CALL MPI_TEST(Pending_request(request_begin)%request,ok_complete,Pending_request(request_begin)%status,ierr)
+!      PRINT *,'Request has been tested...'
+      IF (ok_complete) THEN
+!        PRINT *,"Request_completed"
+        IF (Request_begin==max_request) THEN
+          Request_begin=1
+        ELSE
+          request_begin=request_begin+1
+        ENDIF
+        
+        buffer_begin=Pending_request(request_begin)%Pos
+        
+        nb_request_pending=nb_request_pending-1
+        
+        IF (nb_request_pending==0) THEN 
+          ok_out=.TRUE.
+        ELSE
+          ok_out=.FALSE.
+        ENDIF
+      ELSE
+        ok_out=.TRUE.
+      ENDIF
+    
+    ENDDO
+!    PRINT *, 'on sort de Check_request'  
+  END SUBROUTINE Check_Request
+
+END MODULE mod_mpi_buffer_client
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_mpi_buffer_parameters.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_mpi_buffer_parameters.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_mpi_buffer_parameters.f90	(revision 2528)
@@ -0,0 +1,7 @@
+MODULE mod_mpi_buffer_parameters
+  USE mod_ioserver_namelist, ONLY : global_mpi_buffer_size
+  INTEGER,PARAMETER :: max_request = 10000
+  REAL, PARAMETER   :: frac_alert  = 0.9
+  INTEGER           :: tag_iocomm  = 4000
+  INTEGER           :: tag_terminate = 4001
+END MODULE mod_mpi_buffer_parameters
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_mpi_buffer_server.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_mpi_buffer_server.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_mpi_buffer_server.f90	(revision 2528)
@@ -0,0 +1,262 @@
+MODULE mod_mpi_buffer_server
+  USE mod_mpi_buffer_parameters
+
+  TYPE mpi_requests
+    INTEGER :: Pos
+    INTEGER :: size
+  END TYPE mpi_requests
+  
+  TYPE buffer
+    INTEGER(KIND=8),POINTER  :: mpi_buffer(:)
+    INTEGER :: pos
+    INTEGER :: begin
+    TYPE(mpi_requests),POINTER :: request(:)
+    INTEGER :: request_pos
+    INTEGER :: nb_request
+    INTEGER :: request_begin
+    INTEGER :: request_free
+    LOGICAL :: is_posted
+    LOGICAL :: is_terminated
+    INTEGER :: last_request
+  END TYPE buffer
+
+  TYPE(buffer),ALLOCATABLE,SAVE :: buffers(:)
+  
+  INTEGER,SAVE :: current_rank
+  INTEGER,SAVE :: mpi_buffer_size
+  
+CONTAINS
+  
+  SUBROUTINE Init_mpi_buffer
+  USE mod_ioserver_para
+  USE mod_global_memory
+  IMPLICIT NONE
+    INTEGER :: n
+    
+    ALLOCATE(buffers(nb_client))
+    mpi_buffer_size=global_mpi_buffer_size/nb_client 
+    DO n=1,nb_client
+      CALL allocate_global_memory(mpi_buffer_size,buffers(n)%MPI_Buffer)
+      buffers(n)%pos=1
+      buffers(n)%begin=1
+      ALLOCATE(buffers(n)%request(max_request))
+      buffers(n)%nb_request=0
+      buffers(n)%request_free=max_request
+      buffers(n)%request_pos=1
+      buffers(n)%request_begin=1
+      buffers(n)%is_posted=.FALSE.
+      buffers(n)%is_terminated=.FALSE.
+    ENDDO
+
+  END SUBROUTINE Init_mpi_buffer
+
+  SUBROUTINE Check_buffer
+  USE mod_ioserver_para
+  USE mpitrace
+  USE mpi_mod
+  IMPLICIT NONE
+    INTEGER :: n
+    INTEGER :: status(MPI_STATUS_SIZE)
+    LOGICAL :: ok_complete
+    LOGICAL :: ok_out
+    INTEGER :: ierr
+    INTEGER :: message_size
+    INTEGER :: Buffer_space 
+    INTEGER :: request
+    
+    CALL VTb(VTcheck_buffer)
+    DO n=1,nb_client
+      ok_out=.FALSE.
+      
+      DO WHILE (.NOT. ok_out)
+        
+        IF (buffers(n)%is_posted) THEN
+!          PRINT*,"MPI_TEST"
+!          PRINT *,"MPI_TEST LAST_REQUEST (avant)",buffers(n)%last_request,"ok_complete ?",ok_complete
+          CALL MPI_TEST(buffers(n)%last_request,ok_complete,status,ierr)
+!          PRINT *,"MPI_TEST LAST_REQUEST (apres)",buffers(n)%last_request,"ok_complete ?",ok_complete
+
+          IF (ok_complete) THEN
+            CALL MPI_GET_COUNT(status,MPI_INTEGER8,message_size,ierr)
+            CALL Fill_request(n,Buffers(n)%pos,message_size)
+            buffers(n)%is_posted=.FALSE.
+            buffers(n)%pos=buffers(n)%pos+message_size
+         
+!            PRINT *,"buffer_pos",buffers(n)%pos
+!            PRINT *,"Message recu de taille", message_size
+!              PRINT *,"Message : ",buffers(n)%mpi_buffer(buffers(n)%pos:buffers(n)%pos+message_size-1)
+!              PRINT *,"Nouvelle taille buffer_pos",buffers(n)%pos
+              ok_out=.FALSE.
+          ELSE
+              ok_out=.TRUE.
+          ENDIF
+       
+        ELSE  ! (.NOT. is_posted)        
+!          PRINT *,"MPI_IPROBE"
+     
+          CALL MPI_IPROBE(client_rank(n),tag_iocomm,iocomm,ok_complete,status,ierr)
+!          PRINT *,"Ok_complete.. ?",ok_complete
+          IF (ok_complete) THEN
+            CALL MPI_GET_COUNT(status,MPI_INTEGER8,message_size,ierr)
+!            PRINT *,"message_size",message_size
+            IF (buffers(n)%pos >= buffers(n)%begin) THEN
+              IF (buffers(n)%pos+message_size>mpi_buffer_size) THEN
+                buffer_space=buffers(n)%begin-1
+              ELSE
+                buffer_space=mpi_buffer_size-buffers(n)%begin+1
+              ENDIF
+            ELSE
+              buffer_space=buffers(n)%begin-buffers(n)%pos
+            ENDIF
+            
+            IF (buffer_space < message_size .OR. buffers(n)%request_free<=max_request/2) THEN
+              ok_out=.TRUE.
+!              PRINT *,"BUFFER FULL !!!!"
+!              PRINT *,"buffer_space",buffer_space,"request_free",buffers(n)%request_free
+!              PRINT *,"buffer_pos",buffers(n)%pos,"buffer_begin",buffers(n)%begin
+            ELSE
+              
+              IF (buffers(n)%pos+message_size>mpi_buffer_size) buffers(n)%pos=1
+          
+!              PRINT *,'reception du message'
+              CALL MPI_IRECV(buffers(n)%mpi_buffer(buffers(n)%pos),message_size,MPI_INTEGER8,          &
+                          client_rank(n),tag_iocomm,iocomm,buffers(n)%last_request,ierr)
+                          
+              buffers(n)%is_posted=.TRUE.
+!              PRINT *,"MPI_IRECV LAST_REQUEST",buffers(n)%last_request
+              CALL MPI_TEST(buffers(n)%last_request,ok_complete,status,ierr)
+!              PRINT *,"MPI_TEST LAST_REQUEST",buffers(n)%last_request,"ok_complete ?",ok_complete
+              
+              IF (ok_complete) THEN
+                buffers(n)%is_posted=.FALSE.
+                CALL Fill_request(n,Buffers(n)%pos,message_size)
+
+                buffers(n)%pos=buffers(n)%pos+message_size
+                 
+!                PRINT *,"buffer_pos",buffers(n)%pos
+!                PRINT *,"Message recu de taille", message_size
+!                PRINT *,"Message : ",buffers(n)%mpi_buffer(buffers(n)%pos:buffers(n)%pos+message_size-1)
+!                PRINT *,"Nouvelle taille buffer_pos",buffers(n)%pos
+                ok_out=.FALSE.
+              ELSE
+                ok_out=.TRUE.
+              ENDIF
+         
+            ENDIF
+          ELSE
+            ok_out=.TRUE.
+          ENDIF
+        ENDIF  ! (is_posted)
+        ok_out=.TRUE.
+      ENDDO
+    ENDDO
+
+    CALL VTe(VTcheck_buffer)
+
+  END SUBROUTINE Check_buffer
+  
+  SUBROUTINE Fill_request(n,pos,message_size)
+  USE mpi_mod
+  IMPLICIT NONE
+    INTEGER :: n
+    INTEGER :: pos
+    INTEGER :: message_size
+    INTEGER :: current_size
+    INTEGER :: current_pos
+    INTEGER :: total_size
+    LOGICAL :: ok_out
+    INTEGER :: ierr
+!    PRINT *,'Fill_request!!!'
+!    PRINT *,'Buffer_pos',pos
+!    PRINT *,"First integer",Buffers(n)%mpi_buffer(pos)
+    total_size=0
+    current_pos=pos
+    
+    ok_out=.FALSE.
+    DO WHILE (.NOT. ok_out)
+      
+      IF (Buffers(n)%request_free==0) THEN
+        PRINT *,'Plus de requete disponible !!!!'
+        CALL MPI_ABORT(MPI_COMM_WORLD,-1,ierr)
+      ENDIF
+      
+      current_size=buffers(n)%mpi_buffer(current_pos)
+      Buffers(n)%request(Buffers(n)%request_pos)%pos=current_pos+1
+      Buffers(n)%request(Buffers(n)%request_pos)%size=current_size
+      total_size=total_size+current_size
+      
+      IF (Buffers(n)%request_pos==max_request) THEN 
+        Buffers(n)%request_pos=1
+      ELSE
+        Buffers(n)%request_pos=Buffers(n)%request_pos+1
+      ENDIF
+      Buffers(n)%request_free=Buffers(n)%request_free-1
+      Buffers(n)%nb_request=Buffers(n)%nb_request+1
+      
+      IF (total_size==message_size) ok_out=.TRUE.
+      IF (total_size>message_size) THEN
+        PRINT *,"Probleme : la taille du message ne coincide pas avec la taille de l'enveloppe"
+        CALL MPI_ABORT(MPI_COMM_WORLD,-1,ierr)
+      ENDIF
+      
+      current_pos=current_pos+current_size
+    ENDDO
+  
+  END SUBROUTINE Fill_request 
+    
+  
+  SUBROUTINE Process_request(is_terminated)
+  USE mod_event_server
+  USE mod_ioserver_para
+  USE mod_pack
+  USE mpitrace
+  USE mod_wait
+  IMPLICIT NONE
+    LOGICAL  :: is_terminated
+    INTEGER  :: n
+    
+    is_terminated=.FALSE.
+    
+    IF (ALL(buffers(:)%nb_request>0)) THEN
+      DO n=1,nb_client
+!        PRINT *,"nb_request ?",buffers(n)%nb_request
+        IF ( (buffers(n)%nb_request > 0) .AND. (.NOT. buffers(n)%is_terminated)) THEN
+!          PRINT *,"request_pos",buffers(n)%request_begin
+!          PRINT *,"buffer_pos",buffers(n)%request(buffers(n)%request_begin)%pos
+          CALL set_pack_buffer(buffers(n)%mpi_buffer,buffers(n)%request(buffers(n)%request_begin)%pos)
+          CALL VTb(VTprocess_event)
+          current_rank=n
+          CALL process_event(n,buffers(n)%is_terminated)
+          CALL VTe(VTprocess_event)
+          buffers(n)%nb_request=buffers(n)%nb_request-1
+          buffers(n)%request_free=buffers(n)%request_free+1
+        
+       
+          IF (Buffers(n)%request_begin==max_request) THEN
+            Buffers(n)%request_begin=1
+          ELSE
+            buffers(n)%request_begin=Buffers(n)%request_begin+1
+          ENDIF
+          
+          IF (buffers(n)%nb_request > 0) THEN 
+            buffers(n)%begin=buffers(n)%request(buffers(n)%request_begin)%pos
+          ELSE
+            buffers(n)%begin=buffers(n)%pos
+          ENDIF
+        ENDIF
+      ENDDO 
+    
+!      PRINT *,"buffers_is_terminated",buffers(1:nb_client)%is_terminated
+!      PRINT *,"buffers_nb_request",buffers(1:nb_client)%nb_request
+      IF (ALL(buffers(1:nb_client)%is_terminated)) THEN
+        IF (ALL(buffers(1:nb_client)%nb_request==0)) THEN
+          is_terminated=.TRUE.
+        ENDIF
+      ENDIF
+    ELSE
+      CALL Wait_us(5)
+    ENDIF     
+  END SUBROUTINE process_request  
+  
+    
+END MODULE mod_mpi_buffer_server
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_pack.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_pack.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_pack.f90	(revision 2528)
@@ -0,0 +1,603 @@
+  MODULE mod_pack
+    INTEGER,PARAMETER :: integer_size=4
+    INTEGER,PARAMETER :: pack_buffer_max_size=integer_size*1024*1024
+    INTEGER(kind=8),POINTER,SAVE      :: pack_buffer(:)
+    INTEGER,SAVE      :: pack_pos
+    
+    INTERFACE pack
+      MODULE PROCEDURE pack_r,pack_r1,pack_r2,pack_r3,pack_r4,                 &
+                       pack_i,pack_i1,pack_i2,pack_i3,pack_i4,                 &
+                       pack_l,pack_l1,pack_l2,pack_l3,pack_l4,                 &
+                       pack_c,pack_c1,pack_c2,pack_c3,pack_c4,                 &
+                       pack_attr
+    END INTERFACE pack
+
+    INTERFACE unpack
+      MODULE PROCEDURE unpack_r,unpack_r1,unpack_r2,unpack_r3,unpack_r4,       &
+                       unpack_i,unpack_i1,unpack_i2,unpack_i3,unpack_i4,       &
+                       unpack_l,unpack_l1,unpack_l2,unpack_l3,unpack_l4,       &
+                       unpack_c,unpack_c1,unpack_c2,unpack_c3,unpack_c4,       &
+                       unpack_attr
+    END INTERFACE unpack
+
+    INTERFACE pack_field
+      MODULE PROCEDURE pack_field1,pack_field2,pack_field3,pack_field4        
+    END INTERFACE pack_field
+
+    INTERFACE unpack_field
+      MODULE PROCEDURE unpack_field1,unpack_field2,unpack_field3,unpack_field4 
+    END INTERFACE unpack_field
+           
+  CONTAINS
+  
+    SUBROUTINE set_pack_buffer(pack_buffer0,pack_pos0)
+    IMPLICIT NONE
+    INTEGER(kind=8),POINTER  :: pack_buffer0(:)
+    INTEGER                  :: pack_pos0
+    
+      pack_buffer=>pack_buffer0
+      pack_pos=pack_pos0
+
+    END SUBROUTINE set_pack_buffer
+    
+    
+    SUBROUTINE pack_r(arg)
+      IMPLICIT NONE
+        REAL :: arg
+         
+        CALL packf_r(pack_buffer(pack_pos),pack_pos,arg,1)
+     
+     END SUBROUTINE pack_r
+     
+     SUBROUTINE pack_r1(arg)
+      IMPLICIT NONE
+        REAL :: arg(:)
+        
+        CALL packf_r(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE pack_r1
+
+    
+     SUBROUTINE pack_r2(arg)
+      IMPLICIT NONE
+        REAL :: arg(:,:)
+        
+        CALL packf_r(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE pack_r2
+     
+     
+     SUBROUTINE pack_r3(arg)
+      IMPLICIT NONE
+        REAL :: arg(:,:,:)
+        
+        CALL packf_r(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE pack_r3
+
+     
+     SUBROUTINE pack_r4(arg)
+      IMPLICIT NONE
+        REAL :: arg(:,:,:,:)
+        
+        CALL packf_r(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE pack_r4
+
+
+    SUBROUTINE unpack_r(arg)
+      IMPLICIT NONE
+        REAL :: arg
+         
+        CALL unpackf_r(pack_buffer(pack_pos),pack_pos,arg,1)
+     
+     END SUBROUTINE unpack_r
+     
+     SUBROUTINE unpack_r1(arg)
+      IMPLICIT NONE
+        REAL :: arg(:)
+        
+        CALL unpackf_r(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE unpack_r1
+
+    
+     SUBROUTINE unpack_r2(arg)
+      IMPLICIT NONE
+        REAL :: arg(:,:)
+        
+        CALL unpackf_r(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE unpack_r2
+     
+     
+     SUBROUTINE unpack_r3(arg)
+      IMPLICIT NONE
+        REAL :: arg(:,:,:)
+        
+        CALL unpackf_r(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE unpack_r3
+
+     
+     SUBROUTINE unpack_r4(arg)
+      IMPLICIT NONE
+        REAL :: arg(:,:,:,:)
+        
+        CALL unpackf_r(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE unpack_r4
+
+
+
+
+    SUBROUTINE pack_i(arg)
+      IMPLICIT NONE
+        INTEGER :: arg
+         
+        CALL packf_i(pack_buffer(pack_pos),pack_pos,arg,1)
+     
+     END SUBROUTINE pack_i
+     
+     SUBROUTINE pack_i1(arg)
+      IMPLICIT NONE
+        INTEGER :: arg(:)
+        
+        CALL packf_i(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE pack_i1
+
+    
+     SUBROUTINE pack_i2(arg)
+      IMPLICIT NONE
+        INTEGER :: arg(:,:)
+        
+        CALL packf_i(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE pack_i2
+     
+     
+     SUBROUTINE pack_i3(arg)
+      IMPLICIT NONE
+        INTEGER :: arg(:,:,:)
+        
+        CALL packf_i(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE pack_i3
+
+     
+     SUBROUTINE pack_i4(arg)
+      IMPLICIT NONE
+        INTEGER :: arg(:,:,:,:)
+        
+        CALL packf_i(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE pack_i4
+     
+
+    SUBROUTINE unpack_i(arg)
+      IMPLICIT NONE
+        INTEGER :: arg
+         
+        CALL unpackf_i(pack_buffer(pack_pos),pack_pos,arg,1)
+     
+     END SUBROUTINE unpack_i
+     
+     SUBROUTINE unpack_i1(arg)
+      IMPLICIT NONE
+        INTEGER :: arg(:)
+        
+        CALL unpackf_i(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE unpack_i1
+
+    
+     SUBROUTINE unpack_i2(arg)
+      IMPLICIT NONE
+        INTEGER :: arg(:,:)
+        
+        CALL unpackf_i(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE unpack_i2
+     
+     
+     SUBROUTINE unpack_i3(arg)
+      IMPLICIT NONE
+        INTEGER :: arg(:,:,:)
+        
+        CALL unpackf_i(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE unpack_i3
+
+     
+     SUBROUTINE unpack_i4(arg)
+      IMPLICIT NONE
+        INTEGER :: arg(:,:,:,:)
+        
+        CALL unpackf_i(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE unpack_i4     
+
+
+
+
+
+
+
+    SUBROUTINE pack_l(arg)
+      IMPLICIT NONE
+        LOGICAL :: arg
+         
+        CALL packf_l(pack_buffer(pack_pos),pack_pos,arg,1)
+     
+     END SUBROUTINE pack_l
+     
+     SUBROUTINE pack_l1(arg)
+      IMPLICIT NONE
+        LOGICAL :: arg(:)
+        
+        CALL packf_l(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE pack_l1
+
+    
+     SUBROUTINE pack_l2(arg)
+      IMPLICIT NONE
+        LOGICAL :: arg(:,:)
+        
+        CALL packf_l(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE pack_l2
+     
+     
+     SUBROUTINE pack_l3(arg)
+      IMPLICIT NONE
+        LOGICAL :: arg(:,:,:)
+        
+        CALL packf_l(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE pack_l3
+
+     
+     SUBROUTINE pack_l4(arg)
+      IMPLICIT NONE
+        LOGICAL :: arg(:,:,:,:)
+        
+        CALL packf_l(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE pack_l4
+     
+
+    SUBROUTINE unpack_l(arg)
+      IMPLICIT NONE
+        LOGICAL :: arg
+         
+        CALL unpackf_l(pack_buffer(pack_pos),pack_pos,arg,1)
+     
+     END SUBROUTINE unpack_l
+     
+     SUBROUTINE unpack_l1(arg)
+      IMPLICIT NONE
+        LOGICAL :: arg(:)
+        
+        CALL unpackf_l(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE unpack_l1
+
+    
+     SUBROUTINE unpack_l2(arg)
+      IMPLICIT NONE
+        LOGICAL :: arg(:,:)
+        
+        CALL unpackf_l(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE unpack_l2
+     
+     
+     SUBROUTINE unpack_l3(arg)
+      IMPLICIT NONE
+        LOGICAL :: arg(:,:,:)
+        
+        CALL unpackf_l(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE unpack_l3
+
+     
+     SUBROUTINE unpack_l4(arg)
+      IMPLICIT NONE
+        LOGICAL :: arg(:,:,:,:)
+        
+        CALL unpackf_l(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE unpack_l4     
+
+
+
+
+   
+     
+   SUBROUTINE pack_c(arg)
+      IMPLICIT NONE
+        CHARACTER(len=*) :: arg
+         
+        CALL packf_c(pack_buffer(pack_pos),pack_pos,arg,len(arg))
+     
+     END SUBROUTINE pack_c
+     
+     SUBROUTINE pack_c1(arg)
+      IMPLICIT NONE
+        CHARACTER(len=*) :: arg(:)
+        
+        CALL packf_c(pack_buffer(pack_pos),pack_pos,arg,size(arg)*len(arg(1)))
+        
+     END SUBROUTINE pack_c1
+
+    
+     SUBROUTINE pack_c2(arg)
+      IMPLICIT NONE
+        CHARACTER(len=*) :: arg(:,:)
+        
+        CALL packf_c(pack_buffer(pack_pos),pack_pos,arg,size(arg)*len(arg(1,1)))
+        
+     END SUBROUTINE pack_c2
+     
+     
+     SUBROUTINE pack_c3(arg)
+      IMPLICIT NONE
+        CHARACTER(len=*) :: arg(:,:,:)
+        
+        CALL packf_c(pack_buffer(pack_pos),pack_pos,arg,size(arg)*len(arg(1,1,1)))
+        
+     END SUBROUTINE pack_c3
+
+     
+     SUBROUTINE pack_c4(arg)
+      IMPLICIT NONE
+        CHARACTER(len=*) :: arg(:,:,:,:)
+        
+        CALL packf_c(pack_buffer(pack_pos),pack_pos,arg,size(arg)*len(arg(1,1,1,1)))
+        
+     END SUBROUTINE pack_c4
+     
+
+    SUBROUTINE unpack_c(arg)
+      IMPLICIT NONE
+        CHARACTER(len=*) :: arg
+         
+        CALL unpackf_c(pack_buffer(pack_pos),pack_pos,arg,len(arg))
+     
+     END SUBROUTINE unpack_c
+     
+     SUBROUTINE unpack_c1(arg)
+      IMPLICIT NONE
+        CHARACTER(len=*) :: arg(:)
+        
+        CALL unpackf_c(pack_buffer(pack_pos),pack_pos,arg,size(arg)*len(arg(1)))
+        
+     END SUBROUTINE unpack_c1
+
+    
+     SUBROUTINE unpack_c2(arg)
+      IMPLICIT NONE
+        CHARACTER(len=*) :: arg(:,:)
+        
+        CALL unpackf_c(pack_buffer(pack_pos),pack_pos,arg,size(arg)*len(arg(1,1)))
+        
+     END SUBROUTINE unpack_c2
+     
+     
+     SUBROUTINE unpack_c3(arg)
+      IMPLICIT NONE
+        CHARACTER(len=*) :: arg(:,:,:)
+        
+        CALL unpackf_c(pack_buffer(pack_pos),pack_pos,arg,size(arg)*len(arg(1,1,1)))
+        
+     END SUBROUTINE unpack_c3
+
+     
+     SUBROUTINE unpack_c4(arg)
+      IMPLICIT NONE
+        CHARACTER(len=*) :: arg(:,:,:,:)
+        
+        CALL unpackf_c(pack_buffer(pack_pos),pack_pos,arg,size(arg)*len(arg(1,1,1,1)))
+        
+     END SUBROUTINE unpack_c4     
+     
+
+
+
+
+     SUBROUTINE pack_field1(arg)
+     IMPLICIT NONE
+       REAL :: arg(:)
+     
+       CALL packf_field(pack_buffer(pack_pos),pack_pos,arg,size(arg)) 
+     END SUBROUTINE pack_field1
+
+
+     SUBROUTINE pack_field2(arg)
+     IMPLICIT NONE
+       REAL :: arg(:,:)
+       
+       CALL packf_field(pack_buffer(pack_pos),pack_pos,arg,size(arg)) 
+     END SUBROUTINE pack_field2
+     
+     SUBROUTINE pack_field3(arg)
+     IMPLICIT NONE
+       REAL :: arg(:,:,:)
+     
+       CALL packf_field(pack_buffer(pack_pos),pack_pos,arg,size(arg)) 
+     END SUBROUTINE pack_field3
+
+     SUBROUTINE pack_field4(arg)
+     IMPLICIT NONE
+       REAL :: arg(:,:,:,:)
+     
+       CALL packf_field(pack_buffer(pack_pos),pack_pos,arg,size(arg)) 
+     END SUBROUTINE pack_field4
+
+
+
+     SUBROUTINE unpack_field1(arg)
+     IMPLICIT NONE
+       REAL :: arg(:)
+     
+       CALL unpackf_field(pack_buffer(pack_pos),pack_pos,arg,size(arg)) 
+     END SUBROUTINE unpack_field1
+
+
+     SUBROUTINE unpack_field2(arg)
+     IMPLICIT NONE
+       REAL :: arg(:,:)
+     
+       CALL unpackf_field(pack_buffer(pack_pos),pack_pos,arg,size(arg)) 
+     END SUBROUTINE unpack_field2
+     
+     SUBROUTINE unpack_field3(arg)
+     IMPLICIT NONE
+       REAL :: arg(:,:,:)
+     
+       CALL unpackf_field(pack_buffer(pack_pos),pack_pos,arg,size(arg)) 
+     END SUBROUTINE unpack_field3
+
+     SUBROUTINE unpack_field4(arg)
+     IMPLICIT NONE
+       REAL :: arg(:,:,:,:)
+     
+       CALL unpackf_field(pack_buffer(pack_pos),pack_pos,arg,size(arg)) 
+     END SUBROUTINE unpack_field4
+      
+     SUBROUTINE pack_attr(attrib)
+     USE mod_attribut
+     USE mod_stdtype
+     IMPLICIT NONE
+       TYPE(attribut) :: attrib
+
+       CALL pack(attrib%object)
+       CALL pack(attrib%name)
+       CALL pack(attrib%type)
+       CALL pack(attrib%dim)
+       CALL pack(attrib%ndim)
+       CALL pack(attrib%string_len)
+              
+       SELECT CASE(attrib%type)
+         CASE (integer0)
+           CALL pack(attrib%integer0_ptr)
+         CASE (integer1)
+           CALL pack(attrib%integer1_ptr)
+         CASE (integer2)
+           CALL pack(attrib%integer2_ptr)
+         CASE (real0)
+           CALL pack(attrib%real0_ptr)
+         CASE (real1)
+           CALL pack(attrib%real1_ptr)
+         CASE (real2)
+           CALL pack(attrib%real2_ptr)
+         CASE (logical0)
+           CALL pack(attrib%logical0_ptr)
+         CASE (logical1)
+           CALL pack(attrib%logical1_ptr)
+         CASE (logical2)
+           CALL pack(attrib%logical2_ptr)
+         CASE (string0)
+           CALL pack_string0(attrib%string0_ptr)
+         CASE (string1)
+           CALL pack_string1(attrib%string1_ptr)
+         CASE (string2)
+           CALL pack(attrib%string2_ptr)
+       END SELECT
+
+     CONTAINS
+
+       SUBROUTINE pack_string0(str)
+         CHARACTER(LEN=attrib%string_len) ::str
+           CALL pack(str)
+       END SUBROUTINE
+
+       SUBROUTINE pack_string1(str)
+         CHARACTER(LEN=attrib%string_len) ::str(:)
+           CALL pack(str)
+       END SUBROUTINE
+       
+       SUBROUTINE pack_string2(str)
+         CHARACTER(LEN=attrib%string_len) ::str(:,:)
+           CALL pack(str)
+       END SUBROUTINE
+
+     END SUBROUTINE pack_attr  
+
+     SUBROUTINE unpack_attr(attrib)
+     USE mod_attribut
+     USE mod_stdtype
+     IMPLICIT NONE
+       TYPE(attribut) :: attrib
+
+       CALL unpack(attrib%object)
+       CALL unpack(attrib%name)
+       CALL unpack(attrib%type)
+       CALL unpack(attrib%dim)
+       CALL unpack(attrib%ndim)
+       CALL unpack(attrib%string_len)
+              
+       SELECT CASE(attrib%type)
+         CASE (integer0)
+           ALLOCATE(attrib%integer0_ptr)
+           CALL unpack(attrib%integer0_ptr)
+         CASE (integer1)
+           ALLOCATE(attrib%integer1_ptr(attrib%dim(1)))
+           CALL unpack(attrib%integer1_ptr)
+         CASE (integer2)
+           ALLOCATE(attrib%integer2_ptr(attrib%dim(1),attrib%dim(2)))
+           CALL unpack(attrib%integer2_ptr)
+         CASE (real0)
+           ALLOCATE(attrib%real0_ptr)
+           CALL unpack(attrib%real0_ptr)
+         CASE (real1)
+           ALLOCATE(attrib%real1_ptr(attrib%dim(1)))
+           CALL unpack(attrib%real1_ptr)
+         CASE (real2)
+           ALLOCATE(attrib%real2_ptr(attrib%dim(1),attrib%dim(2)))
+         CASE (logical0)
+           ALLOCATE(attrib%logical0_ptr)
+           CALL unpack(attrib%logical0_ptr)
+         CASE (logical1)
+           ALLOCATE(attrib%logical1_ptr(attrib%dim(1)))
+           CALL unpack(attrib%logical1_ptr)
+         CASE (logical2)
+           ALLOCATE(attrib%logical2_ptr(attrib%dim(1),attrib%dim(2)))
+           CALL unpack(attrib%logical2_ptr)
+         CASE (string0)
+           ALLOCATE(attrib%string0_ptr)
+           CALL unpack_string0
+         CASE (string1)
+           ALLOCATE(attrib%string1_ptr(attrib%dim(1)))
+           CALL unpack_string1
+         CASE (string2)
+           ALLOCATE(attrib%string2_ptr(attrib%dim(1),attrib%dim(2)))
+           CALL unpack_string2
+       END SELECT
+
+     CONTAINS
+
+       SUBROUTINE unpack_string0
+         CHARACTER(LEN=attrib%string_len) ::str
+           CALL unpack(str)
+           attrib%string0_ptr=str
+       END SUBROUTINE
+
+       SUBROUTINE unpack_string1
+         CHARACTER(LEN=attrib%string_len) ::str(attrib%dim(1))
+           CALL unpack(str)
+           attrib%string1_ptr=str
+       END SUBROUTINE
+       
+       SUBROUTINE unpack_string2
+         CHARACTER(LEN=attrib%string_len) ::str(attrib%dim(1),attrib%dim(2))
+           CALL unpack(str)
+           attrib%string2_ptr=str
+       END SUBROUTINE
+
+     END SUBROUTINE unpack_attr              
+
+     
+  END MODULE mod_pack
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_prec.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_prec.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_prec.f90	(revision 2528)
@@ -0,0 +1,7 @@
+MODULE mod_prec
+  INTEGER,PARAMETER :: INTEGER_SIZE   = 4 
+  INTEGER,PARAMETER :: REAL_SIZE      = 8 
+  INTEGER,PARAMETER :: LOGICAL_SIZE   = 4 
+  INTEGER,PARAMETER :: CHARACTER_SIZE = 1
+  INTEGER,PARAMETER :: BLOCK_SIZE     = 8
+END MODULE mod_prec
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_wait.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_wait.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_wait.f90	(revision 2528)
@@ -0,0 +1,68 @@
+MODULE mod_wait
+  INTEGER, SAVE :: wait_param=10
+  REAL, SAVE    :: opt_param
+
+
+  INTEGER, SAVE :: last_count
+
+CONTAINS
+
+  
+  FUNCTION Top()
+  IMPLICIT NONE
+    DOUBLE PRECISION :: Top
+    INTEGER :: count,count_rate,count_max
+    LOGICAL, SAVE :: first=.TRUE.
+    
+      
+    CALL system_clock(count,count_rate,count_max)
+    IF (first) THEN
+      Top=0.
+    ELSE
+      IF (Count>=Last_Count) THEN
+        Top=(1.*(Count-last_Count))/count_rate
+      ELSE
+        Top=(1.*(Count-last_Count+Count_max))/count_rate
+      ENDIF
+    ENDIF
+    Last_Count=Count
+    first=.FALSE. 
+  END FUNCTION Top
+  
+  SUBROUTINE Init_wait
+  IMPLICIT NONE
+    INTEGER :: i,j
+    LOGICAL :: out_ok
+    DOUBLE PRECISION :: time 
+    INTEGER :: last_param
+  
+    out_ok=.FALSE.
+    
+    DO WHILE (.NOT. out_ok)
+      opt_param=0.
+    
+      time=top()
+!CDIR NOVECTOR
+      DO i=1,1000000*wait_param
+         opt_param=opt_param+(i/(i+opt_param))
+      ENDDO
+      time=top()
+      last_param=wait_param
+      wait_param=wait_param*(1./time)
+      IF (ABS(wait_param-last_param)/(0.5*(wait_param+last_param)) <0.01) out_ok=.TRUE.
+    END DO
+  END SUBROUTINE Init_wait
+
+  SUBROUTINE Wait_us(n)
+  IMPLICIT NONE
+  INTEGER :: n
+  INTEGER :: i
+
+!CDIR NOVECTOR  
+    DO i=1,n*wait_param
+         opt_param=opt_param+(i/(i+opt_param))
+    ENDDO
+      
+  END SUBROUTINE Wait_us   
+
+END MODULE mod_wait  
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mpi_mod.F90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mpi_mod.F90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mpi_mod.F90	(revision 2528)
@@ -0,0 +1,11 @@
+MODULE mpi_mod
+
+#if ! defined key_mpp_mpi
+    LOGICAL, PARAMETER :: using_mpi=.FALSE.
+    INCLUDE 'ios_mpif.h'
+#else
+    LOGICAL, PARAMETER :: using_mpi=.TRUE.
+    INCLUDE 'mpif.h'
+#endif
+
+END MODULE mpi_mod
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mpi_wrapper.F90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mpi_wrapper.F90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mpi_wrapper.F90	(revision 2528)
@@ -0,0 +1,80 @@
+SUBROUTINE void
+
+END SUBROUTINE void
+
+#if ! defined key_mpp_mpi
+
+SUBROUTINE MPI_ALLOC_MEM
+
+END SUBROUTINE MPI_ALLOC_MEM
+
+
+SUBROUTINE MPI_INITIALIZED
+
+END SUBROUTINE MPI_INITIALIZED
+
+
+SUBROUTINE MPI_INIT
+
+END SUBROUTINE MPI_INIT
+
+
+SUBROUTINE MPI_COMM_SIZE
+
+END SUBROUTINE MPI_COMM_SIZE
+
+
+SUBROUTINE MPI_COMM_RANK
+
+END SUBROUTINE MPI_COMM_RANK 
+
+
+SUBROUTINE MPI_COMM_SPLIT
+
+END SUBROUTINE MPI_COMM_SPLIT
+
+
+SUBROUTINE MPI_ALLGATHER
+
+END SUBROUTINE MPI_ALLGATHER
+
+
+SUBROUTINE MPI_FINALIZE
+
+END SUBROUTINE MPI_FINALIZE
+
+
+SUBROUTINE MPI_ISSEND
+
+END SUBROUTINE MPI_ISSEND
+
+
+SUBROUTINE MPI_TEST
+
+END SUBROUTINE MPI_TEST
+
+
+SUBROUTINE MPI_GET_COUNT
+
+END SUBROUTINE MPI_GET_COUNT
+
+
+SUBROUTINE MPI_IPROBE 
+
+END SUBROUTINE MPI_IPROBE 
+
+
+SUBROUTINE MPI_IRECV
+
+END SUBROUTINE MPI_IRECV
+
+
+SUBROUTINE MPI_ABORT
+
+END SUBROUTINE MPI_ABORT
+
+SUBROUTINE MPI_BARRIER
+
+END SUBROUTINE MPI_BARRIER
+
+#endif
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mpitrace.F90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mpitrace.F90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mpitrace.F90	(revision 2528)
@@ -0,0 +1,78 @@
+module mpitrace
+  INTEGER,parameter :: VTcheck_buffer=91
+  INTEGER,parameter :: VTprocess_event=92
+  INTEGER,parameter :: VTbuffer_full=93
+  
+  INTEGER,parameter :: nb_inst=7
+  INTEGER :: MPE_begin(nb_inst)
+  INTEGER :: MPE_end(nb_inst)
+  
+contains
+
+  subroutine InitVampir
+    implicit none
+
+#ifdef USE_VT
+    include 'VT.inc'
+    integer :: ierr
+    
+    call VTSYMDEF(VTcheck_buffer,"check_buffer","check_buffer",ierr)
+    call VTSYMDEF(VTprocess_event,"process_event","process_event",ierr)
+    call VTSYMDEF(VTbuffer_full,"buffer_full","buffer_full",ierr)
+    PRINT *,'definition des symbole VT'
+#endif
+
+#ifdef USE_MPE
+    include 'mpe_logf.h' 
+    integer :: ierr,i
+    
+    DO i=1,nb_inst
+      ierr = MPE_Log_get_state_eventIDs( MPE_begin(i), MPE_end(i) )
+    ENDDO
+    
+    ierr = MPE_Describe_state( MPE_begin(VTcaldyn), MPE_end(VTcaldyn),"caldyn", "yellow" )
+    ierr = MPE_Describe_state( MPE_begin(VTintegre), MPE_end(VTintegre),"integre", "blue" )
+    ierr = MPE_Describe_state( MPE_begin(VTadvection), MPE_end(VTadvection),"advection", "green" )
+    ierr = MPE_Describe_state( MPE_begin(VTdissipation), MPE_end(VTdissipation),"dissipation", "ivory" )
+    ierr = MPE_Describe_state( MPE_begin(VThallo), MPE_end(VThallo),"hallo", "orange" )
+    ierr = MPE_Describe_state( MPE_begin(VTphysiq), MPE_end(VTphysiq),"physiq", "purple" )
+    ierr = MPE_Describe_state( MPE_begin(VTinca), MPE_end(VTinca),"inca", "LightBlue" )
+#endif     
+  end subroutine InitVampir
+
+  subroutine VTb(number)
+    implicit none
+    INTEGER :: number
+#ifdef USE_VT    
+    include 'VT.inc'
+    integer :: ierr
+    
+    call VTBEGIN(number,ierr)
+#endif 
+#ifdef USE_MPE
+    include 'mpe_logf.h' 
+    integer :: ierr,i
+    ierr = MPE_Log_event( MPE_begin(number), 0, '' )
+#endif
+
+  end subroutine VTb
+
+  subroutine VTe(number)
+    implicit none
+    INTEGER :: Number
+#ifdef USE_VT    
+    include 'VT.inc'
+    integer :: ierr
+   
+    call VTEND(number,ierr)
+#endif    
+
+#ifdef USE_MPE
+    include 'mpe_logf.h' 
+    integer :: ierr,i
+    ierr = MPE_Log_event( MPE_end(number), 0, '' )
+#endif
+
+  end subroutine VTe
+  
+end module mpitrace
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/pack_c.c.old
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/pack_c.c.old	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/pack_c.c.old	(revision 2528)
@@ -0,0 +1,101 @@
+
+
+
+typedef int     INTEGER ;
+typedef double  REAL    ;
+typedef int     LOGICAL ; 
+typedef char    CHARACTER ;
+
+int INTEGER_SIZE   = 4 ;
+int REAL_SIZE      = 8 ;
+int LOGICAL_SIZE   = 4 ;
+int CHARACTER_SIZE = 1 ;
+
+
+
+
+
+
+
+void packc_r_(unsigned char * buffer, INTEGER * position, unsigned char * var, INTEGER * size)
+{
+  int i ;
+  
+  for(i=0;i<(*size)*REAL_SIZE;i++,(*position)++) buffer[*position]=var[i] ;
+}
+    
+void packc_i_(unsigned char * buffer, INTEGER * position, unsigned char * var, INTEGER * size)
+{
+  int i ;
+  
+  for(i=0;i<(*size)*INTEGER_SIZE;i++,(*position)++) buffer[*position]=var[i] ;
+
+}
+
+void packc_l_(unsigned char * buffer, INTEGER * position, unsigned char * var, INTEGER * size)
+{
+  int i ;
+  
+  for(i=0;i<(*size)*LOGICAL_SIZE;i++,(*position)++) buffer[*position]=var[i] ;
+}
+
+void packc_c_(unsigned char * buffer, INTEGER * position, unsigned char * var, INTEGER * size, int strsize)
+{
+  int i ;
+   printf("longueur de la chaine %i \n",strsize) ;
+  for(i=0;i<(*size)*CHARACTER_SIZE;i++,(*position)++) buffer[*position]=var[i] ;
+}
+
+
+void unpackc_r_(unsigned char * buffer, INTEGER * position, unsigned char * var, INTEGER * size)
+{
+  int i ;
+
+  for(i=0;i<(*size)*REAL_SIZE;i++,(*position)++) var[i]=buffer[*position] ;
+}
+    
+void unpackc_i_(unsigned char * buffer, INTEGER * position, unsigned char * var, INTEGER * size)
+{
+  int i ;
+  
+  for(i=0;i<(*size)*INTEGER_SIZE;i++,(*position)++) var[i]=buffer[*position] ;
+
+}
+
+void unpackc_l_(unsigned char * buffer, INTEGER * position, unsigned char * var, INTEGER * size)
+{
+  int i ;
+  
+  for(i=0;i<(*size)*LOGICAL_SIZE;i++,(*position)++) var[i]=buffer[*position] ;
+}
+
+void unpackc_c_(unsigned char * buffer, INTEGER * position, unsigned char * var, INTEGER * size,int strsize)
+{
+  int i ;
+  
+  for(i=0;i<(*size)*CHARACTER_SIZE;i++,(*position)++) var[i]=buffer[*position] ;
+}
+
+void packc_field_(REAL* buffer, INTEGER* position, REAL* var,INTEGER * size)
+{
+  int i;
+  int s ;
+  
+  s=*size ;
+  buffer+=(*position) ;
+#pragma vdir nooverlap
+  for(i=0;i<s;i++) buffer[i]=var[i] ;
+  position+=s ;
+}
+
+void unpackc_field_(REAL* buffer, INTEGER* position, REAL* var,INTEGER* size)
+{
+  int i;
+  int s ;
+  
+  s=*size ;
+  buffer+=(*position) ;
+#pragma vdir nooverlap
+  for(i=0;i<s;i++) var[i]=buffer[i] ;
+  position+=s ;
+}
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/pack_f.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/pack_f.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/pack_f.f90	(revision 2528)
@@ -0,0 +1,220 @@
+SUBROUTINE packf_r(buffer,position,var,var_size)
+  USE mod_prec
+  IMPLICIT NONE
+    INTEGER           :: var_size
+    REAL,DIMENSION(var_size) :: buffer
+    INTEGER           :: position
+    REAL,DIMENSION(var_size) :: var
+   
+    INTEGER :: i
+    INTEGER :: tot_size
+
+    tot_size=var_size*REAL_SIZE
+
+    DO i=1,var_size
+      buffer(i)=var(i)
+    ENDDO
+
+    position=position+tot_size/BLOCK_SIZE
+    IF (MOD(tot_size,BLOCK_SIZE)/=0) position=position+1
+
+END SUBROUTINE packf_r
+
+
+SUBROUTINE packf_field(buffer,position,var,var_size)
+  USE mod_prec
+  IMPLICIT NONE
+    INTEGER           :: var_size
+    REAL,DIMENSION(var_size) :: buffer
+    INTEGER           :: position
+    REAL,DIMENSION(var_size) :: var
+   
+    INTEGER :: i
+    INTEGER :: tot_size
+    
+    tot_size=var_size*REAL_SIZE
+        
+    DO i=1,var_size
+      buffer(i)=var(i)
+    ENDDO
+          
+    position=position+tot_size/BLOCK_SIZE
+    IF (MOD(tot_size,BLOCK_SIZE)/=0) position=position+1
+    
+END SUBROUTINE packf_field
+
+SUBROUTINE packf_i(buffer,position,var,var_size)
+  USE mod_prec
+  IMPLICIT NONE
+    INTEGER           :: var_size
+    INTEGER,DIMENSION(var_size) :: buffer
+    INTEGER           :: position
+    INTEGER,DIMENSION(var_size) :: var
+   
+    INTEGER :: i
+    INTEGER :: tot_size
+    
+    tot_size=var_size*INTEGER_SIZE
+        
+    DO i=1,var_size
+      buffer(i)=var(i)
+    ENDDO
+          
+    position=position+tot_size/BLOCK_SIZE
+    IF (MOD(tot_size,BLOCK_SIZE)/=0) position=position+1
+    
+END SUBROUTINE packf_i
+
+SUBROUTINE packf_l(buffer,position,var,var_size)
+  USE mod_prec
+  IMPLICIT NONE
+    INTEGER           :: var_size
+    LOGICAL,DIMENSION(var_size) :: buffer
+    INTEGER           :: position
+    LOGICAL,DIMENSION(var_size) :: var
+   
+    INTEGER :: i
+    INTEGER :: tot_size
+    
+    tot_size=var_size*LOGICAL_SIZE
+        
+    DO i=1,var_size
+      buffer(i)=var(i)
+    ENDDO
+          
+    position=position+tot_size/BLOCK_SIZE
+    IF (MOD(tot_size,BLOCK_SIZE)/=0) position=position+1
+    
+END SUBROUTINE packf_l
+
+SUBROUTINE packf_c(buffer,position,var,var_size)
+  USE mod_prec
+  IMPLICIT NONE
+    INTEGER                  :: var_size
+    CHARACTER(LEN=var_size)  :: buffer
+    INTEGER                  :: position
+    CHARACTER(LEN=var_size)  :: var
+   
+    INTEGER :: tot_size
+    
+    tot_size=var_size*CHARACTER_SIZE
+        
+    buffer(1:var_size)=var(1:var_size)
+          
+    position=position+tot_size/BLOCK_SIZE
+    IF (MOD(tot_size,BLOCK_SIZE)/=0) position=position+1
+    
+END SUBROUTINE packf_c
+
+
+
+
+
+
+SUBROUTINE unpackf_r(buffer,position,var,var_size)
+  USE mod_prec
+  IMPLICIT NONE
+    INTEGER           :: var_size
+    REAL,DIMENSION(var_size) :: buffer
+    INTEGER           :: position
+    REAL,DIMENSION(var_size) :: var
+   
+    INTEGER :: i
+    INTEGER :: tot_size
+    
+    tot_size=var_size*REAL_SIZE
+        
+    DO i=1,var_size
+      var(i)=buffer(i)
+    ENDDO
+          
+    position=position+tot_size/BLOCK_SIZE
+    IF (MOD(tot_size,BLOCK_SIZE)/=0) position=position+1
+    
+END SUBROUTINE unpackf_r
+
+
+SUBROUTINE unpackf_field(buffer,position,var,var_size)
+  USE mod_prec
+  IMPLICIT NONE
+    INTEGER           :: var_size
+    REAL,DIMENSION(var_size) :: buffer
+    INTEGER           :: position
+    REAL,DIMENSION(var_size) :: var
+   
+    INTEGER :: i
+    INTEGER :: tot_size
+    
+    tot_size=var_size*REAL_SIZE
+        
+    DO i=1,var_size
+      var(i)=buffer(i)
+    ENDDO
+          
+    position=position+tot_size/BLOCK_SIZE
+    IF (MOD(tot_size,BLOCK_SIZE)/=0) position=position+1
+    
+END SUBROUTINE unpackf_field
+
+SUBROUTINE unpackf_i(buffer,position,var,var_size)
+  USE mod_prec
+  IMPLICIT NONE
+    INTEGER           :: var_size
+    INTEGER,DIMENSION(var_size) :: buffer
+    INTEGER           :: position
+    INTEGER,DIMENSION(var_size) :: var
+   
+    INTEGER :: i
+    INTEGER :: tot_size
+    
+    tot_size=var_size*INTEGER_SIZE
+        
+    DO i=1,var_size
+      var(i)=buffer(i)
+    ENDDO
+          
+    position=position+tot_size/BLOCK_SIZE
+    IF (MOD(tot_size,BLOCK_SIZE)/=0) position=position+1
+    
+END SUBROUTINE unpackf_i
+
+SUBROUTINE unpackf_l(buffer,position,var,var_size)
+  USE mod_prec
+  IMPLICIT NONE
+    INTEGER           :: var_size
+    LOGICAL,DIMENSION(var_size) :: buffer
+    INTEGER           :: position
+    LOGICAL,DIMENSION(var_size) :: var
+   
+    INTEGER :: i
+    INTEGER :: tot_size
+    
+    tot_size=var_size*LOGICAL_SIZE
+        
+    DO i=1,var_size
+      var(i)=buffer(i)
+    ENDDO
+          
+    position=position+tot_size/BLOCK_SIZE
+    IF (MOD(tot_size,BLOCK_SIZE)/=0) position=position+1
+    
+END SUBROUTINE unpackf_l
+
+SUBROUTINE unpackf_c(buffer,position,var,var_size)
+  USE mod_prec
+  IMPLICIT NONE
+    INTEGER                  :: var_size
+    CHARACTER(LEN=var_size)  :: buffer
+    INTEGER                  :: position
+    CHARACTER(LEN=var_size)  :: var
+    
+    INTEGER :: tot_size
+    
+    tot_size=var_size*CHARACTER_SIZE
+        
+    var(1:var_size)=buffer(1:var_size)
+          
+    position=position+tot_size/BLOCK_SIZE
+    IF (MOD(tot_size,BLOCK_SIZE)/=0) position=position+1
+    
+END SUBROUTINE unpackf_c
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/server.F90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/server.F90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/server.F90	(revision 2528)
@@ -0,0 +1,48 @@
+PROGRAM server
+  USE mod_ioserver_para
+  USE mod_mpi_buffer_server
+  USE mod_wait
+  USE mod_global_memory
+  USE ioipsl
+  USE iomanager
+  USE mod_interface_ioipsl
+  USE mod_ioserver_namelist
+  
+  IMPLICIT NONE
+#if defined key_mpp_mpi
+  INCLUDE 'mpif.h'
+  
+  INTEGER :: i,j,ierr
+  LOGICAL :: is_terminated
+  
+!  CALL SLEEP(60)
+  PRINT *,'je suis un serveur'
+  CALL read_namelist
+  CALL init_parallel
+  CALL init_mpi_buffer
+  CALL init_wait
+  CALL init_interface_ioipsl
+  
+  CALL iom__init(nb_client,mpi_size,mpi_rank)
+  PRINT *,'je suis un serveur'
+  
+
+!  CALL MPI_BARRIER(iocomm,ierr)
+  
+  is_terminated=.FALSE.
+  
+  DO WHILE (.NOT. is_terminated)
+    CALL Check_buffer
+    CALL process_request(is_terminated)
+!    CALL wait_us(10)
+  ENDDO
+
+!  CALL MPI_BARRIER(MPI_COMM_WORLD,ierr)
+  CALL histclo
+  
+  CALL Finalize_parallel
+
+  PRINT *,"THAT'S ALL FOLK"
+#endif
+  
+END PROGRAM server
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/create_template
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/create_template	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/create_template	(revision 2528)
@@ -0,0 +1,25 @@
+#! /bin/bash
+
+function template() 
+{
+  echo ${1}
+  sed "s/#TYPE#/${1}/g" vector_def.template > vector_${1}_def.inc
+  sed "s/#TYPE#/${1}/g" vector_contains.template > vector_${1}_contains.inc
+}
+
+
+template field
+template field_group
+template axis
+template axis_group
+template node
+template domain
+template grid
+template grid_group
+template file
+template file_group
+template field_dep
+template file_dep
+template field_out
+template context
+template zoom
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_attribut.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_attribut.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_attribut.f90	(revision 2528)
@@ -0,0 +1,283 @@
+MODULE mod_attribut
+  USE mod_xmlio_parameters
+  USE mod_attribut_list
+  USE mod_stdtype
+  USE string_function  
+  
+  TYPE, PUBLIC :: attribut
+    INTEGER :: object
+    INTEGER :: name
+    INTEGER :: type
+    INTEGER :: dim(7)
+    INTEGER :: ndim
+    INTEGER,POINTER :: integer0_ptr
+    INTEGER,POINTER :: integer1_ptr(:)
+    INTEGER,POINTER :: integer2_ptr(:,:)
+    REAL,POINTER    :: real0_ptr
+    REAL,POINTER    :: real1_ptr(:)
+    REAL,POINTER    :: real2_ptr(:,:)
+    LOGICAL,POINTER :: logical0_ptr
+    LOGICAL,POINTER :: logical1_ptr(:)
+    LOGICAL,POINTER :: logical2_ptr(:,:)
+    
+    CHARACTER(LEN=str_len),POINTER :: string0_ptr
+    CHARACTER(LEN=str_len),POINTER :: string1_ptr(:)
+    CHARACTER(LEN=str_len),POINTER :: string2_ptr(:,:)
+    INTEGER                        :: string_len
+    
+  END TYPE attribut
+  
+  INTERFACE attr
+    MODULE PROCEDURE attr_int0,attr_int1,attr_int2,              &
+                     attr_real0,attr_real1,attr_real2,           &
+                     attr_logical0,attr_logical1,attr_logical2,  &
+                     attr_string0,attr_string1,attr_string2
+  END INTERFACE
+                     
+CONTAINS
+  
+  FUNCTION attr_get_object(attr_name)
+  USE mod_attribut_list
+  USE mod_object
+  USE error_msg
+  IMPLICIT NONE
+    INTEGER, INTENT(IN) :: attr_name
+    INTEGER             :: attr_get_object
+    
+    IF (attr_name > field__begin .AND. attr_name < field__end) THEN
+      attr_get_object=field_object
+      RETURN
+    ENDIF
+    
+    IF (attr_name > file__begin .AND. attr_name < file__end) THEN
+      attr_get_object=file_object
+      RETURN
+    ENDIF
+
+    IF (attr_name > grid__begin .AND. attr_name < grid__end) THEN
+      attr_get_object=grid_object
+      RETURN
+    ENDIF
+
+    IF (attr_name > axis__begin .AND. attr_name < axis__end) THEN
+      attr_get_object=axis_object
+      RETURN
+    ENDIF
+    
+    IF (attr_name > zoom__begin .AND. attr_name < zoom__end) THEN
+      attr_get_object=zoom_object
+      RETURN
+    ENDIF
+
+    WRITE (message,*) 'Attribut name value :',attr_name,'is undefined'
+    CALL error("mod_attributd::attr_get_object") 
+   
+  END FUNCTION attr_get_object 
+
+  SUBROUTINE attr_deallocate(attrib)
+  IMPLICIT NONE
+  TYPE(attribut) :: attrib
+
+    SELECT CASE(attrib%type)
+       CASE (integer0)
+         DEALLOCATE(attrib%integer0_ptr)
+       CASE (integer1)
+         DEALLOCATE(attrib%integer1_ptr)
+       CASE (integer2)
+         DEALLOCATE(attrib%integer2_ptr)
+       CASE (real0)
+         DEALLOCATE(attrib%real0_ptr)
+       CASE (real1)
+         DEALLOCATE(attrib%real1_ptr)
+       CASE (real2)
+         DEALLOCATE(attrib%real2_ptr)
+       CASE (logical0)
+         DEALLOCATE(attrib%logical0_ptr)
+       CASE (logical1)
+         DEALLOCATE(attrib%logical1_ptr)
+       CASE (logical2)
+         DEALLOCATE(attrib%logical2_ptr)
+       CASE (string0)
+         DEALLOCATE(attrib%string0_ptr)
+       CASE (string1)
+         DEALLOCATE(attrib%string1_ptr)
+       CASE (string2)
+         DEALLOCATE(attrib%string2_ptr)
+    END SELECT         
+  
+  END SUBROUTINE attr_deallocate
+
+  FUNCTION attr_int0(attr_name,value) 
+  USE mod_stdtype
+    IMPLICIT NONE
+    INTEGER :: attr_name
+    INTEGER,TARGET :: value
+    
+    TYPE(attribut) :: attr_int0
+    attr_int0%object=attr_get_object(attr_name) 
+    attr_int0%name=attr_name
+    attr_int0%type=integer0
+    attr_int0%integer0_ptr=>value
+    
+  END FUNCTION attr_int0
+
+  FUNCTION attr_int1(attr_name,value) 
+  USE mod_stdtype
+    IMPLICIT NONE
+    INTEGER :: attr_name
+    INTEGER,TARGET :: value(:)
+    
+    TYPE(attribut) :: attr_int1
+    attr_int1%object=attr_get_object(attr_name) 
+    attr_int1%name=attr_name
+    attr_int1%type=integer1
+    attr_int1%integer1_ptr=>value
+    
+  END FUNCTION attr_int1    
+
+  FUNCTION attr_int2(attr_name,value) 
+  USE mod_stdtype
+    IMPLICIT NONE
+    INTEGER :: attr_name
+    INTEGER,TARGET :: value(:,:)
+    
+    TYPE(attribut) :: attr_int2
+    attr_int2%object=attr_get_object(attr_name) 
+    attr_int2%name=attr_name
+    attr_int2%type=integer2
+    attr_int2%integer2_ptr=>value
+    
+  END FUNCTION attr_int2
+          
+
+  FUNCTION attr_real0(attr_name,value) 
+  USE mod_stdtype
+    IMPLICIT NONE
+    INTEGER :: attr_name
+    REAL,TARGET :: value
+    
+    TYPE(attribut) :: attr_real0
+    attr_real0%object=attr_get_object(attr_name) 
+    attr_real0%name=attr_name
+    attr_real0%type=real0
+    attr_real0%real0_ptr=>value
+    
+  END FUNCTION attr_real0
+
+  FUNCTION attr_real1(attr_name,value) 
+  USE mod_stdtype
+    IMPLICIT NONE
+    INTEGER :: attr_name
+    REAL,TARGET :: value(:)
+    
+    TYPE(attribut) :: attr_real1
+    attr_real1%object=attr_get_object(attr_name) 
+    attr_real1%name=attr_name
+    attr_real1%type=real1
+    attr_real1%real1_ptr=>value
+    
+  END FUNCTION attr_real1    
+
+  FUNCTION attr_real2(attr_name,value) 
+  USE mod_stdtype
+    IMPLICIT NONE
+    INTEGER :: attr_name
+    REAL,TARGET :: value(:,:)
+    
+    TYPE(attribut) :: attr_real2
+    attr_real2%object=attr_get_object(attr_name) 
+    attr_real2%name=attr_name
+    attr_real2%type=REAL2
+    attr_real2%real2_ptr=>value
+    
+  END FUNCTION attr_real2
+  
+    FUNCTION attr_logical0(attr_name,value) 
+  USE mod_stdtype
+    IMPLICIT NONE
+    INTEGER :: attr_name
+    LOGICAL,TARGET :: value
+    
+    TYPE(attribut) :: attr_logical0
+    attr_logical0%object=attr_get_object(attr_name) 
+    attr_logical0%name=attr_name
+    attr_logical0%type=logical0
+    attr_logical0%logical0_ptr=>value
+    
+  END FUNCTION attr_logical0
+
+  FUNCTION attr_logical1(attr_name,value) 
+  USE mod_stdtype
+    IMPLICIT NONE
+    INTEGER :: attr_name
+    LOGICAL,TARGET :: value(:)
+    
+    TYPE(attribut) :: attr_logical1
+    attr_logical1%object=attr_get_object(attr_name) 
+    attr_logical1%name=attr_name
+    attr_logical1%type=logical1
+    attr_logical1%logical1_ptr=>value
+    
+  END FUNCTION attr_logical1    
+
+  FUNCTION attr_logical2(attr_name,value) 
+  USE mod_stdtype
+    IMPLICIT NONE
+    INTEGER :: attr_name
+    LOGICAL,TARGET :: value(:,:)
+    
+    TYPE(attribut) :: attr_logical2
+    attr_logical2%object=attr_get_object(attr_name) 
+    attr_logical2%name=attr_name
+    attr_logical2%type=logical2
+    attr_logical2%logical2_ptr=>value
+    
+  END FUNCTION attr_logical2
+  
+
+  FUNCTION attr_string0(attr_name,value) 
+  USE mod_stdtype
+    IMPLICIT NONE
+    INTEGER :: attr_name
+    CHARACTER(LEN=*),TARGET :: value
+    TYPE(attribut) :: attr_string0
+
+      attr_string0%object=attr_get_object(attr_name) 
+      attr_string0%name=attr_name
+      attr_string0%type=string0
+      attr_string0%string_len=LEN(value)
+      attr_string0%string0_ptr=>value
+    
+  END FUNCTION attr_string0
+
+  FUNCTION attr_string1(attr_name,value) 
+  USE mod_stdtype
+    IMPLICIT NONE
+    INTEGER :: attr_name
+    CHARACTER(LEN=*),TARGET :: value(:)
+    
+    TYPE(attribut) :: attr_string1
+    attr_string1%object=attr_get_object(attr_name) 
+    attr_string1%name=attr_name
+    attr_string1%type=string1
+    attr_string1%string_len=LEN(value)
+    attr_string1%string1_ptr=>value
+    
+  END FUNCTION attr_string1    
+
+  FUNCTION attr_string2(attr_name,value) 
+  USE mod_stdtype
+    IMPLICIT NONE
+    INTEGER :: attr_name
+    CHARACTER(LEN=*),TARGET :: value(:,:)
+    
+    TYPE(attribut) :: attr_string2
+    attr_string2%object=attr_get_object(attr_name) 
+    attr_string2%name=attr_name
+    attr_string2%type=string2
+    attr_string2%string_len=LEN(value)
+    attr_string2%string2_ptr=>value
+    
+  END FUNCTION attr_string2
+ 
+END MODULE mod_attribut
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_attribut_list.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_attribut_list.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_attribut_list.f90	(revision 2528)
@@ -0,0 +1,7 @@
+MODULE mod_attribut_list
+  USE mod_field_attribut
+  USE mod_file_attribut
+  USE mod_axis_attribut
+  USE mod_grid_attribut
+  USE mod_zoom_attribut
+END MODULE mod_attribut_list
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_axis.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_axis.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_axis.f90	(revision 2528)
@@ -0,0 +1,332 @@
+MODULE mod_axis
+
+  USE mod_xmlio_parameters
+  USE mod_sorted_list
+
+  
+  IMPLICIT NONE
+
+  TYPE, PUBLIC :: axis
+    CHARACTER(len=str_len)      :: id
+    LOGICAL                     :: has_id
+    CHARACTER(len=str_len)      :: name
+    LOGICAL                     :: has_name
+    INTEGER                     :: size
+    LOGICAL                     :: has_size
+    CHARACTER(len=str_len)      :: description
+    LOGICAL                     :: has_description
+    CHARACTER(len=str_len)      :: unit
+    LOGICAL                     :: has_unit
+    LOGICAL                     :: positive
+    LOGICAL                     :: has_positive
+    REAL, DIMENSION(:), POINTER :: values
+    LOGICAL                     :: has_values
+
+  END TYPE axis
+
+  INCLUDE 'vector_axis_def.inc'
+  
+  TYPE(vector_axis),POINTER,SAVE             :: axis_Ids
+  TYPE(sorted_list),POINTER,SAVE,PRIVATE     :: Ids 
+
+  INTERFACE axis__set_attribut
+    MODULE PROCEDURE axis__set_attribut_id,axis__set_attribut_pt
+  END INTERFACE
+
+CONTAINS
+  INCLUDE 'vector_axis_contains.inc'
+
+  SUBROUTINE axis__swap_context(saved_axis_Ids,saved_Ids)
+  IMPLICIT NONE
+    TYPE(vector_axis),POINTER          :: saved_axis_Ids
+    TYPE(sorted_list),POINTER          :: saved_Ids 
+    
+    axis_ids=>saved_axis_ids
+    ids=>saved_ids
+    
+  END SUBROUTINE axis__swap_context
+
+  SUBROUTINE axis__init
+  IMPLICIT NONE
+    
+    CALL vector_axis__new(axis_Ids)
+    CALL sorted_list__new(Ids)
+   
+  END SUBROUTINE axis__init
+  
+  SUBROUTINE axis__get(Id,Pt_axis)
+  USE string_function
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)     :: Id
+    TYPE(axis),POINTER              :: Pt_axis
+
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_axis=>axis_ids%at(Pos)%Pt
+    ELSE
+      Pt_axis=>NULL()
+    ENDIF
+    
+  END SUBROUTINE axis__get
+  
+  SUBROUTINE axis__new(pt_axis,Id)
+  USE string_function
+  IMPLICIT NONE
+   TYPE(axis), POINTER           :: pt_axis
+   CHARACTER(LEN=*),OPTIONAL     :: Id
+   INTEGER                       :: Pos
+   
+   pt_axis%has_id          = .FALSE.
+   pt_axis%has_name        = .FALSE.
+   pt_axis%has_size        = .FALSE.
+   pt_axis%has_description = .FALSE.
+   pt_axis%has_unit        = .FALSE.
+   pt_axis%has_values      = .FALSE.
+   pt_axis%has_positive    = .FALSE. 
+     
+   IF (PRESENT(Id)) THEN
+     Pt_axis%id=TRIM(ADJUSTL(Id))
+     Pt_axis%has_id=.TRUE.
+     CALL vector_axis__set_new(axis_Ids,Pt_axis,Pos)
+     CALL sorted_list__Add(Ids,hash(id),Pos)
+   ENDIF
+
+ END SUBROUTINE axis__new
+
+  SUBROUTINE axis__set(pt_axis, name, description, unit, a_size, values, positive)
+  IMPLICIT NONE
+    TYPE(axis), POINTER         :: pt_axis
+    CHARACTER(len=*)  ,OPTIONAL :: name
+    CHARACTER(len=*)  ,OPTIONAL :: description
+    CHARACTER(len=*)  ,OPTIONAL :: unit
+    INTEGER           ,OPTIONAL :: a_size
+    REAL, DIMENSION(:),OPTIONAL :: values
+    LOGICAL           ,OPTIONAL :: positive
+
+    IF (PRESENT(name)) THEN
+        pt_axis%name=TRIM(ADJUSTL(name))
+        pt_axis%has_name = .TRUE.
+    ENDIF
+
+    IF (PRESENT(description)) THEN
+        pt_axis%description=TRIM(ADJUSTL(description))
+        pt_axis%has_description = .TRUE.
+    ENDIF
+ 
+    IF (PRESENT(unit)) then
+        pt_axis%unit=TRIM(ADJUSTL(unit))
+        pt_axis%has_unit = .TRUE.
+    ENDIF
+
+    IF (PRESENT(a_size)) then
+        pt_axis%size=a_size
+        pt_axis%has_size = .TRUE.
+    ENDIF
+    
+    IF (PRESENT(values)) then
+        IF (pt_axis%has_values) DEALLOCATE(pt_axis%values)  
+        ALLOCATE(pt_axis%values(size(values)))
+        pt_axis%values(:)=values(:)
+        pt_axis%has_values = .TRUE.
+    ENDIF
+
+    IF (PRESENT(positive)) then
+        pt_axis%positive=positive
+        pt_axis%has_positive = .TRUE.
+    ENDIF
+
+  END SUBROUTINE axis__set
+
+  SUBROUTINE axis__set_attribut_id(id,attrib,ok)
+  USE mod_attribut
+  USE error_msg
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)   :: id
+    TYPE(attribut),INTENT(IN)     :: attrib
+    LOGICAL,OPTIONAL,INTENT(OUT)  :: ok
+    
+    TYPE(axis),POINTER              :: Pt_axis
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_axis=>axis_ids%at(Pos)%Pt
+      CALL axis__set_attribut_pt(Pt_axis,attrib)
+      IF (PRESENT(OK)) OK=.TRUE.
+    ELSE
+      IF (.NOT.PRESENT(OK)) THEN
+        WRITE(message,*) 'axis id :',id,'is undefined'
+        CALL error('mod_axis::axis__set_attribut')
+      ELSE
+        OK=.FALSE.
+      ENDIF
+    ENDIF  
+  
+  END SUBROUTINE axis__set_attribut_id
+      
+  SUBROUTINE axis__set_attribut_pt(Pt_axis,attrib)
+  USE mod_attribut
+  USE mod_axis_attribut
+  USE error_msg
+  IMPLICIT NONE
+    TYPE(axis),POINTER        :: Pt_axis
+    TYPE(attribut),INTENT(IN) :: attrib
+    
+    SELECT CASE(attrib%name)
+      CASE (axis__name)
+        IF (attrib%type==string0) CALL  axis__set(pt_axis,name=attrib%string0_ptr) ; RETURN
+      CASE (axis__description)
+        IF (attrib%type==string0) CALL  axis__set(pt_axis,description=attrib%string0_ptr) ; RETURN
+      CASE (axis__unit)
+        IF (attrib%type==string0) CALL  axis__set(pt_axis,unit=attrib%string0_ptr) ; RETURN
+      CASE (axis__size)
+        IF (attrib%type==integer0) CALL  axis__set(pt_axis,a_size=attrib%integer0_ptr) ; RETURN
+      CASE (axis__values)
+        IF (attrib%type==real1) CALL  axis__set(pt_axis,values=attrib%real1_ptr) ; RETURN
+      CASE (axis__positive)
+        IF (attrib%type==logical0) CALL  axis__set(pt_axis,positive=attrib%logical0_ptr) ; RETURN
+       END SELECT
+
+     WRITE(message,*) 'axis attribut ',attrib%name,' : type :',attrib%type,   &
+                      ' : Attribute type is incompatible with the provided value'
+     CALL error('mod_axis::axis__set_attribut')
+    
+  END SUBROUTINE axis__set_attribut_pt
+  
+  SUBROUTINE axis__print(pt_axis)
+  IMPLICIT NONE
+    TYPE(axis), POINTER         :: pt_axis
+
+    PRINT *,"---- AXIS ----"
+    IF (pt_axis%has_id) THEN
+      PRINT *,"id = ",TRIM(pt_axis%id)
+    ELSE
+      PRINT *,"id undefined"
+    ENDIF
+    
+    IF (pt_axis%has_name) THEN
+      PRINT *,"name = ",TRIM(pt_axis%name)
+    ELSE
+      PRINT *,"name undefined"
+    ENDIF
+    
+    IF (pt_axis%has_description) THEN
+      PRINT *,"description = ",TRIM(pt_axis%description)
+    ELSE
+      PRINT *,"description undefined"
+    ENDIF
+ 
+    IF (pt_axis%has_unit) THEN
+      PRINT *,"unit = ",TRIM(pt_axis%unit)
+    ELSE
+      PRINT *,"unit undefined"
+    ENDIF
+
+    IF (pt_axis%has_size) THEN
+      PRINT *,"size = ",pt_axis%size
+    ELSE
+      PRINT *,"size undefined"
+    ENDIF
+
+    IF (pt_axis%has_values) THEN
+      PRINT *,"values = ",pt_axis%values
+    ELSE
+      PRINT *,"values undefined"
+    ENDIF
+
+    IF (pt_axis%has_positive) THEN
+      PRINT *,"positive = ",pt_axis%positive
+    ELSE
+      PRINT *,"positive undefined"
+    ENDIF
+
+  END SUBROUTINE axis__print
+
+
+  SUBROUTINE axis__apply_default(pt_axis_default, pt_axis_in, pt_axis_out)
+
+    TYPE(axis), POINTER :: pt_axis_default, pt_axis_in, pt_axis_out
+
+    IF (pt_axis_in%has_name) THEN
+        pt_axis_out%name=pt_axis_in%name
+        pt_axis_out%has_name=.TRUE.
+    ELSE IF ( pt_axis_default%has_name) THEN
+        pt_axis_out%name=pt_axis_default%name
+        pt_axis_out%has_name=.TRUE.
+    ELSE
+        pt_axis_out%has_name=.FALSE.
+    ENDIF
+        
+    IF (pt_axis_in%has_description) THEN
+        pt_axis_out%description=pt_axis_in%description
+        pt_axis_out%has_description=.TRUE.
+    ELSE IF ( pt_axis_default%has_description ) THEN
+        pt_axis_out%description=pt_axis_default%description
+        pt_axis_out%has_description=.TRUE.
+    ELSE
+        pt_axis_out%has_description=.FALSE.
+    ENDIF
+
+    IF (pt_axis_in%has_unit) THEN
+        pt_axis_out%unit=pt_axis_in%unit
+        pt_axis_out%has_unit=.TRUE.
+    ELSE IF ( pt_axis_default%has_unit ) THEN
+        pt_axis_out%unit=pt_axis_default%unit
+        pt_axis_out%has_unit=.TRUE.
+    ELSE
+        pt_axis_out%has_unit=.FALSE.
+    ENDIF
+
+    IF (pt_axis_in%has_size) THEN
+        pt_axis_out%size=pt_axis_in%size
+        pt_axis_out%has_size=.TRUE.
+    ELSE IF ( pt_axis_default%has_size ) THEN
+        pt_axis_out%size=pt_axis_default%size
+        pt_axis_out%has_size=.TRUE.
+    ELSE
+        pt_axis_out%has_size=.FALSE.
+    ENDIF
+
+    IF (pt_axis_in%has_values) THEN
+        pt_axis_out%values(:)=pt_axis_in%values(:)
+        pt_axis_out%has_values=.TRUE.
+    ELSE IF ( pt_axis_default%has_values ) THEN
+        pt_axis_out%values(:)=pt_axis_default%values(:)
+        pt_axis_out%has_values=.TRUE.
+    ELSE
+        pt_axis_out%has_values=.FALSE.
+    ENDIF
+
+    IF (pt_axis_in%has_positive) THEN
+        pt_axis_out%positive=pt_axis_in%positive
+        pt_axis_out%has_positive=.TRUE.
+    ELSE IF ( pt_axis_default%has_positive ) THEN
+        pt_axis_out%positive=pt_axis_default%positive
+        pt_axis_out%has_positive=.TRUE.
+    ELSE
+        pt_axis_out%has_positive=.FALSE.
+    ENDIF
+    
+  END SUBROUTINE axis__apply_default
+
+  SUBROUTINE axis__check(pt_axis)
+  USE error_msg
+  IMPLICIT NONE
+    TYPE(axis), POINTER :: pt_axis
+      
+    IF (.NOT. pt_axis%has_name) THEN
+      IF (pt_axis%has_id) THEN
+        pt_axis%name=TRIM(pt_axis%id)
+      ELSE
+        WRITE(message,*) "Axis has no name and no id" 
+        CALL error("mod_axis::axis__check")
+      ENDIF 
+    ENDIF
+ 
+ END SUBROUTINE axis__Check
+
+END MODULE mod_axis
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_axis_attribut.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_axis_attribut.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_axis_attribut.f90	(revision 2528)
@@ -0,0 +1,15 @@
+MODULE mod_axis_attribut
+  USE mod_object
+  
+  INTEGER,PARAMETER :: axis__begin = axis_object + 10
+  
+  INTEGER,PARAMETER :: axis__name = axis_object + 11
+  INTEGER,PARAMETER :: axis__description = axis_object + 12
+  INTEGER,PARAMETER :: axis__unit = axis_object + 13
+  INTEGER,PARAMETER :: axis__size = axis_object + 14
+  INTEGER,PARAMETER :: axis__positive = axis_object + 15
+  INTEGER,PARAMETER :: axis__values = axis_object + 16
+
+  INTEGER,PARAMETER :: axis__end = axis_object + 17
+  
+END MODULE mod_axis_attribut
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_axis_definition.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_axis_definition.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_axis_definition.f90	(revision 2528)
@@ -0,0 +1,24 @@
+MODULE mod_axis_definition
+  USE mod_axis_group
+  
+  TYPE(axis_group),SAVE,POINTER :: axis_definition
+  
+CONTAINS
+
+  SUBROUTINE axis_definition__swap_context(saved_axis_definition)      
+  IMPLICIT NONE
+    TYPE(axis_group),POINTER :: saved_axis_definition
+    
+    axis_definition=>saved_axis_definition
+    
+  END SUBROUTINE axis_definition__swap_context 
+
+  SUBROUTINE axis_definition__Init
+  USE mod_axis_group
+  IMPLICIT NONE
+  
+    CALL axis_group__new(axis_definition,"axis_definition")
+    
+  END SUBROUTINE axis_definition__Init
+        
+END MODULE mod_axis_definition
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_axis_group.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_axis_group.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_axis_group.f90	(revision 2528)
@@ -0,0 +1,242 @@
+MODULE mod_axis_group
+  USE mod_axis
+  USE mod_xmlio_parameters
+
+  IMPLICIT NONE
+
+  TYPE axis_group
+    CHARACTER(LEN=str_len)                    :: id
+    LOGICAL                                   :: has_id
+    TYPE(vector_axis_group), POINTER          :: groups
+    TYPE(vector_axis),POINTER                 :: axis     
+    TYPE(axis), POINTER                       :: default_attribut
+  END TYPE axis_group
+
+  INCLUDE "vector_axis_group_def.inc"  
+
+  TYPE(vector_axis_group),POINTER       :: axis_group_Ids
+  TYPE(sorted_list),POINTER,PRIVATE     :: Ids 
+
+  INTERFACE axis_group__set_attribut
+    MODULE PROCEDURE axis_group__set_attribut_id,axis_group__set_attribut_pt
+  END INTERFACE
+
+CONTAINS
+
+  INCLUDE "vector_axis_group_contains.inc"
+
+  SUBROUTINE axis_group__swap_context(saved_axis_group_Ids,saved_ids)
+  IMPLICIT NONE
+  TYPE(vector_axis_group),POINTER       :: saved_axis_group_Ids
+  TYPE(sorted_list),POINTER             :: saved_Ids 
+   
+   axis_group_ids=>saved_axis_group_ids
+   ids=>saved_ids
+   
+  END SUBROUTINE axis_group__swap_context
+
+  SUBROUTINE axis_group__init
+  IMPLICIT NONE
+    
+    CALL vector_axis_group__new(axis_group_Ids)
+    CALL sorted_list__new(Ids)
+   
+  END SUBROUTINE axis_group__init
+
+  SUBROUTINE axis_group__get(Id,Pt_ag)
+  USE string_function
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)     :: Id
+    TYPE(axis_group),POINTER        :: Pt_ag
+
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_ag=>axis_group_ids%at(Pos)%Pt
+    ELSE
+      Pt_ag=>NULL()
+    ENDIF
+    
+  END SUBROUTINE axis_group__get
+
+
+  SUBROUTINE axis_group__set_attribut_id(id,attrib,Ok)
+  USE mod_attribut
+  USE error_msg
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: id
+    TYPE(attribut),INTENT(IN) :: attrib
+    LOGICAL,OPTIONAL,INTENT(out)  :: Ok
+    
+    TYPE(axis_group),POINTER             :: Pt_ag
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_ag=>axis_group_ids%at(Pos)%Pt
+      CALL axis_group__set_attribut(Pt_ag,attrib)
+      IF (PRESENT(OK)) ok=.TRUE.
+    ELSE
+      IF (.NOT.PRESENT(OK)) THEN
+        WRITE(message,*) 'axis group id :',id,'is undefined'
+        CALL error('mod_axis_group::axis_group__set_attribut')
+      ELSE
+        OK=.FALSE.
+      ENDIF
+    ENDIF 
+    
+  END SUBROUTINE axis_group__set_attribut_id
+  
+  SUBROUTINE axis_group__set_attribut_pt(pt_ag,attrib)
+  USE mod_attribut
+  USE mod_object
+  IMPLICIT NONE
+    TYPE(axis_group),POINTER :: Pt_ag
+    TYPE(attribut),INTENT(IN) :: attrib
+     
+    IF (attrib%object==axis_object) THEN
+      CALL axis__set_attribut(pt_ag%default_attribut,attrib)
+    ENDIF
+    
+  END SUBROUTINE axis_group__set_attribut_pt
+      
+  RECURSIVE SUBROUTINE axis_group__new(Pt_ag,Id)
+  USE string_function
+  IMPLICIT NONE
+    TYPE(axis_group),POINTER                :: Pt_ag
+    CHARACTER(LEN=*),OPTIONAL,INTENT(IN)     :: Id
+    
+    INTEGER :: Pos
+    
+    ALLOCATE(Pt_ag%groups)
+    ALLOCATE(Pt_ag%axis)
+    ALLOCATE(Pt_ag%default_attribut)
+    
+    CALL vector_axis_group__new(Pt_ag%groups)
+    CALL vector_axis__new(Pt_ag%axis)
+    CALL axis__new(Pt_ag%default_attribut)
+    Pt_ag%has_id=.FALSE.
+      
+    IF (PRESENT(Id)) THEN
+      Pt_ag%id=TRIM(Id)
+      Pt_ag%has_id=.TRUE.
+      CALL vector_axis_group__set_new(axis_group_Ids,Pt_ag,Pos)
+      CALL sorted_list__Add(Ids,hash(id),Pos)
+    ENDIF
+
+  END SUBROUTINE axis_group__new
+
+      
+  SUBROUTINE axis_group__get_new_group(Pt_ag,Pt_ag_out,Id)
+  IMPLICIT NONE
+    TYPE(axis_group),POINTER             :: Pt_ag
+    TYPE(axis_group),POINTER             :: Pt_ag_out
+    CHARACTER(LEN=*),OPTIONAL      :: Id
+    
+    CALL vector_axis_group__get_new(Pt_ag%groups,Pt_ag_out)
+    CALL axis_group__new(Pt_ag_out)
+
+    IF (PRESENT(id)) THEN
+      CALL axis_group__new(Pt_ag_out,Id)
+    ELSE
+      CALL axis_group__new(Pt_ag_out)
+    ENDIF
+    
+  END SUBROUTINE axis_group__get_new_group
+
+  
+  SUBROUTINE axis_group__get_new_axis(Pt_ag,Pt_a_out,Id)
+  IMPLICIT NONE
+    TYPE(axis_group),POINTER            :: Pt_ag
+    TYPE(axis),POINTER                  :: Pt_a_out
+    CHARACTER(LEN=*),OPTIONAL      :: Id
+    
+    CALL vector_axis__get_new(Pt_ag%axis,Pt_a_out)
+    
+    IF (PRESENT(id)) THEN
+      CALL axis__new(Pt_a_out,Id)
+    ELSE
+      CALL axis__new(Pt_a_out)
+    ENDIF
+    
+  END SUBROUTINE axis_group__get_new_axis
+  
+  
+  SUBROUTINE axis_group__get_default_attrib(Pt_ag,Pt_a)
+  IMPLICIT NONE
+    TYPE(axis_group),POINTER  :: Pt_ag
+    TYPE(axis),POINTER        :: Pt_a
+    
+    Pt_a=>Pt_ag%default_attribut
+  END SUBROUTINE axis_group__get_default_attrib
+  
+  RECURSIVE SUBROUTINE axis_group__apply_default(Pt_ag,default)
+  IMPLICIT NONE
+    TYPE(axis_group),POINTER           :: Pt_ag
+    TYPE(axis),POINTER,OPTIONAL        :: default
+    INTEGER :: i
+    
+    IF (PRESENT(default)) THEN
+      CALL axis__apply_default(default,Pt_ag%default_attribut,Pt_ag%default_attribut)
+    ENDIF
+      
+    DO i=1,Pt_ag%groups%size
+      CALL axis_group__apply_default(Pt_ag%groups%at(i)%pt,Pt_ag%default_attribut)
+    ENDDO
+    
+    DO i=1,Pt_ag%axis%size
+      CALL axis__apply_default(Pt_ag%default_attribut,Pt_ag%axis%at(i)%pt,Pt_ag%axis%at(i)%pt)
+    ENDDO
+  
+  END SUBROUTINE axis_group__apply_default
+
+  RECURSIVE SUBROUTINE axis_group__print(Pt_ag)
+  IMPLICIT NONE
+    TYPE(axis_group),POINTER  :: Pt_ag
+   
+    INTEGER :: i
+    
+    PRINT *,"--- AXIS GROUP ---"
+    IF (pt_ag%has_id) THEN
+      PRINT *,"id = ",TRIM(pt_ag%id)
+    ELSE
+      PRINT *,"id undefined"
+    ENDIF
+    
+    PRINT *,"axis default attribut :"
+    CALL axis__print(Pt_ag%default_attribut)    
+
+    PRINT *,"owned axis groups :",Pt_ag%groups%size      
+    DO i=1,Pt_ag%groups%size
+      CALL axis_group__print(Pt_ag%groups%at(i)%pt)
+    ENDDO
+
+    PRINT *,"owned axis :",Pt_ag%axis%size      
+    DO i=1,Pt_ag%axis%size
+      CALL axis__print(Pt_ag%axis%at(i)%pt)
+    ENDDO
+    PRINT *,"------------"
+    
+  END SUBROUTINE axis_group__print
+
+  RECURSIVE SUBROUTINE axis_group__Check(Pt_ag)
+  IMPLICIT NONE
+  
+    TYPE(axis_group),POINTER  :: Pt_ag
+    INTEGER :: i
+   
+    DO i=1,Pt_ag%groups%size
+      CALL axis_group__check(pt_ag%groups%at(i)%pt)
+    ENDDO
+
+    DO i=1,Pt_ag%axis%size
+      CALL axis__check(pt_ag%axis%at(i)%pt)
+    ENDDO
+  
+  END SUBROUTINE axis_group__check     
+   
+END MODULE mod_axis_group
+
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_context.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_context.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_context.f90	(revision 2528)
@@ -0,0 +1,233 @@
+MODULE mod_context
+  USE mod_xmlio_parameters
+  USE mod_sorted_list
+  USE mod_field
+  USE mod_field_group
+  USE mod_field_definition
+  USE mod_file
+  USE mod_file_group
+  USE mod_file_definition
+  USE mod_grid
+  USE mod_zoom
+  USE mod_grid_group
+  USE mod_grid_definition
+  USE mod_axis
+  USE mod_axis_group
+  USE mod_axis_definition
+  USE mod_dependency
+  USE mod_time_parameters
+
+
+  INTERFACE context__swap
+    MODULE PROCEDURE context__swap_id,context__swap_pt
+  END INTERFACE  
+  
+  TYPE, PUBLIC :: context
+    CHARACTER(len=str_len)         :: id
+    INTEGER                        :: number
+  
+    TYPE(vector_field),POINTER        :: field__field_Ids
+    TYPE(sorted_list),POINTER         :: field__Ids
+    TYPE(vector_field_group),POINTER  :: field_group__field_group_ids
+    TYPE(sorted_list),POINTER         :: field_group__Ids
+    TYPE(field_group),POINTER         :: field_definition__field_def
+    TYPE(vector_file),POINTER         :: file__file_Ids
+    TYPE(sorted_list),POINTER         :: file__Ids
+    TYPE(vector_file_group),POINTER   :: file_group__file_group_Ids
+    TYPE(sorted_list),POINTER         :: file_group__Ids 
+    TYPE(file_group),POINTER          :: file_definition__file_def 
+    TYPE(vector_grid),POINTER         :: grid__grid_Ids
+    TYPE(sorted_list),POINTER         :: grid__Ids 
+    TYPE(vector_zoom),POINTER         :: zoom__zoom_Ids
+    TYPE(sorted_list),POINTER         :: zoom__Ids 
+    TYPE(vector_grid_group),POINTER   :: grid_group__grid_group_Ids
+    TYPE(sorted_list),POINTER         :: grid_group__Ids 
+    TYPE(grid_group),POINTER          :: grid_definition__grid_def
+    TYPE(vector_axis),POINTER         :: axis__axis_Ids
+    TYPE(sorted_list),POINTER         :: axis__Ids 
+    TYPE(vector_axis_group),POINTER   :: axis_group__axis_group_Ids
+    TYPE(sorted_list),POINTER         :: axis_group__Ids 
+    TYPE(axis_group),POINTER          :: axis_definition__axis_def
+    TYPE(vector_file_dep),POINTER     :: dependency__file_enabled
+    TYPE(vector_field_out),POINTER    :: dependency__field_enabled 
+    TYPE(vector_field_dep),POINTER    :: dependency__field_id
+    TYPE(sorted_list),POINTER         :: dependency__sorted_id 
+    INTEGER,POINTER                   :: time_param__initial_timestep
+    REAL,POINTER                      :: time_param__initial_date
+    REAL,POINTER                      :: time_param__timestep_value 
+    INTEGER,POINTER                   :: time_param__timestep_number
+
+  END TYPE context
+  
+  INCLUDE 'vector_context_def.inc'
+  TYPE(vector_context),SAVE,POINTER  :: context_ids
+  TYPE(sorted_list),POINTER,SAVE,PRIVATE :: Ids
+
+ 
+  CONTAINS
+    INCLUDE 'vector_context_contains.inc'
+    
+    SUBROUTINE context__init
+    IMPLICIT NONE
+
+      ALLOCATE(context_Ids)
+      ALLOCATE(Ids)
+
+      CALL vector_context__new(context_Ids)
+      CALL sorted_list__new(ids)
+
+    END SUBROUTINE context__init
+
+    SUBROUTINE context__get(Id,Pt_context)
+      USE string_function
+      IMPLICIT NONE
+      CHARACTER(LEN=*),INTENT(IN)     :: Id
+      TYPE(context),POINTER              :: Pt_context
+
+      INTEGER                         :: Pos
+      LOGICAL                         :: success
+    
+      CALL sorted_list__find(Ids,hash(Id),Pos,success)
+      IF (success) THEN
+        Pt_context=>context_ids%at(Pos)%Pt
+      ELSE
+        Pt_context=>NULL()
+      ENDIF
+    
+    END SUBROUTINE context__get
+
+    SUBROUTINE context__get_new(Id,pt_context)
+    USE string_function
+    IMPLICIT NONE
+      CHARACTER(LEN=*),INTENT(IN)     :: Id
+      TYPE(context),POINTER              :: Pt_context
+
+      INTEGER                         :: Pos
+      LOGICAL                         :: success
+      
+      CALL sorted_list__find(Ids,hash(Id),Pos,success)
+      IF (success) THEN
+        Pt_context=>context_ids%at(Pos)%Pt
+      ELSE
+        CALL vector_context__get_new(context_ids,pt_context,Pos)
+        pt_context%number=Pos
+        Pt_context%id=Id
+        CALL sorted_list__Add(Ids,hash(Id),Pos)
+        
+        ALLOCATE(pt_context%field__field_Ids )
+        ALLOCATE(pt_context%field__Ids )
+        ALLOCATE(pt_context%field_group__field_group_ids )
+        ALLOCATE(pt_context%field_group__field_group_ids )
+        ALLOCATE(pt_context%field_group__Ids )
+        ALLOCATE(pt_context%field_definition__field_def )
+        ALLOCATE(pt_context%file__file_Ids)
+        ALLOCATE(pt_context%file__Ids)
+        ALLOCATE(pt_context%file_group__file_group_Ids)
+        ALLOCATE(pt_context%file_group__Ids) 
+        ALLOCATE(pt_context%file_definition__file_def) 
+        ALLOCATE(pt_context%grid__grid_Ids)
+        ALLOCATE(pt_context%grid__Ids) 
+        ALLOCATE(pt_context%zoom__zoom_Ids)
+        ALLOCATE(pt_context%zoom__Ids) 
+        ALLOCATE(pt_context%grid_group__grid_group_Ids)
+        ALLOCATE(pt_context%grid_group__Ids) 
+        ALLOCATE(pt_context%grid_definition__grid_def)
+        ALLOCATE(pt_context%axis__axis_Ids)
+        ALLOCATE(pt_context%axis__Ids) 
+        ALLOCATE(pt_context%axis_group__axis_group_Ids)
+        ALLOCATE(pt_context%axis_group__Ids) 
+        ALLOCATE(pt_context%axis_definition__axis_def)
+        ALLOCATE(pt_context%dependency__file_enabled)
+        ALLOCATE(pt_context%dependency__field_enabled) 
+        ALLOCATE(pt_context%dependency__field_id)
+        ALLOCATE(pt_context%dependency__sorted_id)  
+        ALLOCATE(pt_context%time_param__initial_timestep)
+        ALLOCATE(pt_context%time_param__initial_date)
+        ALLOCATE(pt_context%time_param__timestep_value) 
+        ALLOCATE(pt_context%time_param__timestep_number)
+
+        CALL context__swap(pt_context)
+        
+        CALL field__init
+        CALL field_group__Init
+        CALL field_definition__Init
+
+        CALL axis__init
+        CALL axis_group__Init
+        CALL axis_definition__Init
+
+        CALL grid__init
+        CALL grid_group__Init
+        CALL grid_definition__Init
+
+        CALL zoom__init
+
+        CALL file__init
+        CALL file_group__Init
+        CALL file_definition__Init
+
+      ENDIF
+
+    END SUBROUTINE context__get_new
+
+
+    SUBROUTINE context__create(Id)
+    IMPLICIT NONE
+      CHARACTER(LEN=*),INTENT(IN)     :: Id
+      
+      TYPE(context),POINTER              :: Pt_context
+
+      CALL context__get(Id,Pt_context)
+      IF (.NOT. ASSOCIATED(Pt_context)) CALL context__get_new(Id,Pt_context)
+      
+!      CALL field__init
+!      CALL field_group__init
+!      CALL field_definition__init
+      
+     END SUBROUTINE context__create
+
+     
+    SUBROUTINE context__swap_id(Id)
+    USE mod_field
+      IMPLICIT NONE
+      CHARACTER(LEN=*),INTENT(IN)     :: Id
+      TYPE(context),POINTER       :: Pt_context
+
+      INTEGER :: number
+      
+      CALL context__get(Id,Pt_context)
+      IF (.NOT. ASSOCIATED(Pt_context)) THEN
+!!      error message
+      ENDIF
+      
+      CALL context__swap(pt_context)  
+
+    END SUBROUTINE context__swap_id
+
+    SUBROUTINE context__swap_pt(Pt_context)
+    USE mod_field
+      IMPLICIT NONE
+      TYPE(context),POINTER       :: Pt_context
+
+      CALL field__swap_context(Pt_context%field__field_Ids ,Pt_context%field__Ids)
+      CALL field_group__swap_context(Pt_context%field_group__field_group_ids ,Pt_context%field_group__Ids)
+      CALL field_definition__swap_context(Pt_context%field_definition__field_def)
+      CALL file__swap_context(Pt_context%file__file_Ids,Pt_context%file__Ids)
+      CALL file_group__swap_context(Pt_context%file_group__file_group_Ids,Pt_context%file_group__Ids)
+      CALL file_definition__swap_context(Pt_context%file_definition__file_def) 
+      CALL grid__swap_context(pt_context%grid__grid_Ids,pt_context%grid__Ids) 
+      CALL zoom__swap_context(pt_context%zoom__zoom_Ids,pt_context%zoom__Ids) 
+      CALL grid_group__swap_context(pt_context%grid_group__grid_group_Ids,pt_context%grid_group__Ids) 
+      CALL grid_definition__swap_context(pt_context%grid_definition__grid_def)
+      CALL axis__swap_context(pt_context%axis__axis_Ids,pt_context%axis__Ids) 
+      CALL axis_group__swap_context(pt_context%axis_group__axis_group_Ids,pt_context%axis_group__Ids) 
+      CALL axis_definition__swap_context(pt_context%axis_definition__axis_def)
+      CALL dependency__swap_context(pt_context%dependency__file_enabled,pt_context%dependency__field_enabled,  &
+                                    pt_context%dependency__field_id,pt_context%dependency__sorted_id)
+      CALL time_parameters__swap_context(pt_context%time_param__initial_timestep,pt_context%time_param__initial_date,  &
+                                         pt_context%time_param__timestep_value,pt_context%time_param__timestep_number)
+                                    
+    END SUBROUTINE context__swap_pt
+
+
+END MODULE mod_context
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_dependency.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_dependency.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_dependency.f90	(revision 2528)
@@ -0,0 +1,247 @@
+MODULE mod_dependency
+USE mod_field
+USE mod_file
+USE mod_grid
+USE mod_axis
+USE mod_sorted_list
+USE mod_zoom
+
+TYPE file_dep
+  TYPE(file),POINTER           :: file
+  INTEGER                      :: hash
+  TYPE(vector_field),POINTER   :: fields
+  TYPE(vector_grid),POINTER    :: grids
+  TYPE(vector_zoom),POINTER    :: zooms
+  TYPE(vector_axis),POINTER    :: axis
+END TYPE file_dep
+
+TYPE field_dep
+  TYPE(field),POINTER :: field
+  INTEGER             :: hash
+  
+  TYPE(vector_field_out),POINTER   :: field_out
+END TYPE field_dep
+
+TYPE field_out
+  TYPE(Field), POINTER  :: field
+  TYPE(file),  POINTER  :: file
+  TYPE(axis),  POINTER  :: axis
+  TYPE(grid),  POINTER  :: grid
+  TYPE(zoom),  POINTER  :: zoom
+END TYPE field_out
+
+INCLUDE 'vector_field_dep_def.inc'
+INCLUDE 'vector_file_dep_def.inc'
+INCLUDE 'vector_field_out_def.inc'
+
+TYPE(vector_file_dep),POINTER,SAVE      :: file_enabled
+TYPE(vector_field_out),POINTER,SAVE     :: field_enabled 
+TYPE(vector_field_dep),POINTER,SAVE     :: field_id
+
+ 
+TYPE(sorted_list),POINTER,SAVE :: sorted_id
+
+CONTAINS
+
+INCLUDE 'vector_field_dep_contains.inc'
+INCLUDE 'vector_file_dep_contains.inc'
+INCLUDE 'vector_field_out_contains.inc'
+
+  
+  SUBROUTINE dependency__swap_context(saved_file_enabled,saved_field_enabled,save_field_id,saved_sorted_id)  
+  IMPLICIT NONE
+    TYPE(vector_file_dep),POINTER      :: saved_file_enabled
+    TYPE(vector_field_out),POINTER     :: saved_field_enabled 
+    TYPE(vector_field_dep),POINTER     :: save_field_id
+    TYPE(sorted_list),POINTER          :: saved_sorted_id  
+    
+    file_enabled=>saved_file_enabled   
+    field_enabled=>saved_field_enabled
+    field_id=>save_field_id
+    sorted_id=>saved_sorted_id
+      
+  END SUBROUTINE dependency__swap_context
+  
+  SUBROUTINE set_dependency
+  IMPLICIT NONE
+  
+   CALL set_file_dependency
+   CALL set_field_enabled
+   CALL set_field_dependency
+
+  END SUBROUTINE set_dependency
+  
+  
+  RECURSIVE SUBROUTINE set_file_dependency(Pt_file_group)
+  USE mod_file_definition
+  USE mod_file_group
+  USE string_function
+  USE mod_sorted_list
+  IMPLICIT NONE
+    TYPE (file_group),POINTER,OPTIONAL :: pt_file_group 
+    TYPE (file_group),POINTER          :: Pt_fg
+    TYPE (file)     ,POINTER           :: Pt_file
+    TYPE (file_dep),POINTER            :: Pt_file_dep
+    TYPE (sorted_list),POINTER         :: sorted_axis
+    TYPE (sorted_list),POINTER         :: sorted_grid
+    TYPE (sorted_list),POINTER         :: sorted_zoom
+    INTEGER                            :: i
+    INTEGER                            :: j
+    
+    ALLOCATE(sorted_axis)
+    ALLOCATE(sorted_grid)
+    ALLOCATE(sorted_zoom)
+    
+    IF (PRESENT(Pt_file_group)) THEN
+      Pt_fg=>Pt_file_group
+    ELSE
+      CALL vector_file_dep__new(file_enabled)
+      Pt_fg=>file_definition
+    ENDIF
+    
+    DO i=1,Pt_fg%groups%size
+      CALL set_file_dependency(Pt_fg%groups%at(i)%pt)
+    ENDDO
+    
+    DO i=1,Pt_fg%files%size
+      Pt_file=>pt_fg%files%at(i)%pt
+      IF (Pt_file%enabled) THEN
+        CALL vector_file_dep__get_new(file_enabled,Pt_file_dep)
+        
+        ALLOCATE(Pt_file_dep%fields)
+        ALLOCATE(Pt_file_dep%grids)
+        ALLOCATE(Pt_file_dep%zooms)
+        ALLOCATE(Pt_file_dep%axis)
+        pt_file_dep%file=>pt_file
+        pt_file_dep%hash=hash(pt_file%id)
+        CALL vector_field__new(Pt_file_dep%fields)
+        CALL vector_grid__new(Pt_file_dep%grids)
+        CALL vector_zoom__new(Pt_file_dep%zooms)
+        CALL vector_axis__new(Pt_file_dep%axis)
+        CALL sorted_list__new(sorted_axis)
+        CALL sorted_list__new(sorted_grid)
+        CALL sorted_list__new(sorted_zoom)
+        
+        CALL Treat_field_group(pt_file%field_list)
+        
+        CALL sorted_list__delete(sorted_axis)
+        CALL sorted_list__delete(sorted_grid)
+        CALL sorted_list__delete(sorted_zoom)
+      ENDIF
+    ENDDO
+    
+    CONTAINS 
+      RECURSIVE SUBROUTINE treat_field_group(pt_fg)
+      IMPLICIT NONE  
+        TYPE(field_group),POINTER :: Pt_fg
+        INTEGER                   :: i
+        
+        DO i=1,Pt_fg%groups%size
+          CALL treat_field_group(Pt_fg%groups%at(i)%pt)
+        ENDDO
+        
+        DO i=1,Pt_fg%fields%size
+          CALL treat_field(Pt_fg%fields%at(i)%pt)
+        ENDDO
+      END SUBROUTINE treat_field_group
+      
+      
+      SUBROUTINE treat_field(pt_field)
+      IMPLICIT NONE  
+        TYPE(field),POINTER :: Pt_field
+        LOGICAL             :: found
+        INTEGER             :: Pos
+
+        IF (Pt_field%enabled .AND. Pt_field%level <= Pt_file%output_level) THEN
+          CALL vector_field__set_new(Pt_file_dep%fields,Pt_field)
+  
+          IF (Pt_field%has_grid) THEN
+            CALL sorted_list__find(sorted_grid,hash(Pt_field%grid%id),pos,found)
+            IF (.NOT. found) THEN 
+              CALL vector_grid__set_new(pt_file_dep%grids,Pt_field%grid,pos)
+              CALL sorted_list__add(sorted_grid,hash(Pt_field%grid%id),pos)
+            ENDIF
+          ENDIF
+
+          IF (Pt_field%has_zoom) THEN
+            CALL sorted_list__find(sorted_zoom,hash(Pt_field%zoom%id),pos,found)
+            IF (.NOT. found) THEN 
+              CALL vector_zoom__set_new(pt_file_dep%zooms,Pt_field%zoom,pos)
+              CALL sorted_list__add(sorted_zoom,hash(Pt_field%zoom%id),pos)
+            ENDIF
+          ENDIF
+  
+          IF (Pt_field%has_axis) THEN
+            CALL sorted_list__find(sorted_axis,hash(Pt_field%axis%id),Pos,found)
+            IF (.NOT. found) THEN 
+              CALL vector_axis__set_new(Pt_file_dep%axis,Pt_field%axis,pos)
+              CALL sorted_list__add(sorted_axis,hash(Pt_field%axis%id),pos)
+            ENDIF
+          ENDIF
+        ENDIF
+      
+      END SUBROUTINE treat_field
+      
+  END SUBROUTINE set_file_dependency
+  
+  SUBROUTINE set_field_enabled
+  IMPLICIT NONE
+  TYPE(file_dep),POINTER   :: pt_file_dep
+  TYPE(field_out),POINTER  :: pt_field_out
+  INTEGER                  :: i
+  INTEGER                  :: j
+  
+    CALL vector_field_out__new(field_enabled)
+    
+    DO i=1,file_enabled%size
+      pt_file_dep=>file_enabled%at(i)%pt
+      DO j=1,pt_file_dep%fields%size
+        CALL vector_field_out__get_new(field_enabled,pt_field_out)
+        pt_field_out%field=>pt_file_dep%fields%at(j)%pt
+        pt_field_out%file=>pt_file_dep%file
+        pt_field_out%axis=>pt_field_out%field%axis
+        pt_field_out%grid=>pt_field_out%field%grid
+        pt_field_out%zoom=>pt_field_out%field%zoom
+      ENDDO
+    ENDDO
+   
+      
+  END SUBROUTINE set_field_enabled
+      
+  SUBROUTINE set_field_dependency
+  USE string_function
+  IMPLICIT NONE
+  TYPE(field_out),POINTER :: pt_field_out
+  TYPE(field_dep),POINTER :: pt_field_dep
+  TYPE(field),POINTER     :: pt_field
+  TYPE(field),POINTER     :: pt_field_base
+  INTEGER :: pos
+  LOGICAL :: found
+  INTEGER :: i
+  
+    CALL vector_field_dep__new(field_id)
+    CALL sorted_list__new(sorted_id)
+    
+    DO i=1,field_enabled%size
+      pt_field_out=>field_enabled%at(i)%pt
+      pt_field=>pt_field_out%field
+      pt_field_base=>pt_field%field_base
+      CALL sorted_list__find(sorted_id,hash(pt_field_base%id),pos,found)
+      IF (.NOT. found) THEN
+        CALL vector_field_dep__get_new(field_id,pt_field_dep,pos)
+        ALLOCATE(pt_field_dep%field_out)
+        CALL vector_field_out__new(pt_field_dep%field_out)
+        pt_field_dep%field=>pt_field_base       
+        CALL sorted_list__add(sorted_id,hash(pt_field_base%id),pos)
+      ELSE
+        pt_field_dep=>field_id%at(pos)%pt
+      ENDIF
+      
+      CALL vector_field_out__set_new(pt_field_dep%field_out,pt_field_out) 
+    ENDDO  
+      
+  END SUBROUTINE set_field_dependency     
+      
+    
+    
+END MODULE mod_dependency
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_domain.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_domain.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_domain.f90	(revision 2528)
@@ -0,0 +1,172 @@
+MODULE mod_domain
+   USE mod_xmlio_parameters
+   INTEGER, PARAMETER :: box=1
+   INTEGER, PARAMETER :: orange=2
+   
+  TYPE domain
+    INTEGER :: rank
+    INTEGER :: ni
+    INTEGER :: nj
+    INTEGER :: ibegin
+    INTEGER :: iend
+    INTEGER :: jbegin
+    INTEGER :: jend
+    REAL,POINTER :: lon(:,:)
+    REAL,POINTER :: lat(:,:)
+    
+    INTEGER         :: type
+    LOGICAL,POINTER :: mask(:)
+    INTEGER,POINTER :: i_index(:)
+    INTEGER,POINTER :: j_index(:)
+    INTEGER         :: nbp
+    LOGICAL         :: is_defined
+  END TYPE domain
+ 
+  INCLUDE 'vector_domain_def.inc'
+
+CONTAINS
+
+  INCLUDE 'vector_domain_contains.inc'
+
+  SUBROUTINE domain__new(Pt_domain)
+  IMPLICIT NONE
+    TYPE(domain),POINTER  :: Pt_domain
+    
+    Pt_domain%is_defined=.FALSE.
+    
+  END SUBROUTINE domain__new
+  
+  SUBROUTINE domain__set(Pt_domain,rank,ni,nj,ibegin,jbegin,lon,lat)
+  IMPLICIT NONE
+    TYPE(domain),POINTER  :: Pt_domain
+    INTEGER,INTENT(IN) :: rank
+    INTEGER,INTENT(IN) :: ni
+    INTEGER,INTENT(IN) :: nj
+    INTEGER,INTENT(IN) :: ibegin
+    INTEGER,INTENT(IN) :: jbegin
+    REAL,INTENT(IN)    :: lon(ni,nj)
+    REAL,INTENT(IN)    :: lat(ni,nj)
+
+    Pt_domain%rank=rank
+    Pt_domain%ni=ni
+    Pt_domain%nj=nj
+    Pt_domain%ibegin=ibegin
+    Pt_domain%jbegin=jbegin   
+    Pt_domain%iend=ibegin+ni-1
+    Pt_domain%jend=jbegin+nj-1
+    ALLOCATE(Pt_domain%lon(ni,nj))
+    ALLOCATE(Pt_domain%lat(ni,nj))
+    Pt_domain%lon(:,:)=lon(:,:)
+    Pt_domain%lat(:,:)=lat(:,:)
+    Pt_domain%is_defined=.TRUE.
+  END SUBROUTINE domain__set
+
+
+  SUBROUTINE domain__set_type_box(Pt_domain,mask)
+  USE error_msg
+  IMPLICIT NONE
+    TYPE(domain),POINTER  :: Pt_domain
+    LOGICAL,INTENT(IN),OPTIONAL :: mask(:,:)
+    INTEGER                     :: i,j
+  
+    Pt_domain%type=box
+    pt_domain%nbp=pt_domain%ni*pt_domain%nj
+    ALLOCATE(Pt_domain%i_index(pt_domain%nbp))
+    ALLOCATE(Pt_domain%j_index(pt_domain%nbp))
+    ALLOCATE(pt_domain%mask(pt_domain%nbp))
+
+    IF (PRESENT(mask)) THEN
+      IF ( size(mask,1)==pt_domain%ni .AND. size(mask,2)==pt_domain%nj) THEN
+        DO i=1,pt_domain%ni
+          DO j=1,pt_domain%nj
+            pt_domain%mask((j-1)*pt_domain%ni+i)=mask(i,j)
+          ENDDO
+        ENDDO
+      ELSE
+        WRITE (message,*) "mask dimensions are not compliant with domain dimensions :",   &
+                           size(mask,1),",",size(mask,2),"/=",Pt_domain%ni,",",Pt_domain%nj
+        CALL error("domain__set_type_box")
+      ENDIF
+    ELSE
+      pt_domain%mask(:)=.TRUE.
+    ENDIF
+    
+    DO i=1,pt_domain%ni
+      DO j=1,pt_domain%nj
+        pt_domain%i_index((j-1)*pt_domain%ni+i) = i
+        pt_domain%j_index((j-1)*pt_domain%ni+i) = j
+      ENDDO
+    ENDDO
+
+  END SUBROUTINE domain__set_type_box
+
+
+  SUBROUTINE domain__set_type_orange(Pt_domain,nbp,offset,opt_index)
+  IMPLICIT NONE
+    TYPE(domain),POINTER        :: Pt_domain
+    INTEGER,INTENT(IN)          :: nbp
+    INTEGER,INTENT(IN)          :: offset
+    INTEGER,INTENT(IN),OPTIONAL :: opt_index(:)
+    
+    INTEGER  :: index(nbp)
+    INTEGER  :: i
+    
+    Pt_domain%type=orange
+    
+    IF (PRESENT(opt_index)) THEN
+      index(:)=opt_index(:)       
+    ELSE
+      DO i=1,nbp
+        index(i)=i
+      ENDDO
+    ENDIF
+
+    pt_domain%nbp=nbp
+    ALLOCATE(pt_domain%i_index(nbp))
+    ALLOCATE(pt_domain%j_index(nbp))
+    ALLOCATE(pt_domain%mask(nbp))
+        
+    DO i=1,nbp
+!      Pt_domain%i_index(i)=(index(i)+offset)/pt_domain%ni+1+pt_domain%ibegin-1
+!      Pt_domain%j_index(i)=MOD(index(i)+offset,pt_domain%ni)+1+pt_domain%jbegin-1
+      Pt_domain%i_index(i)=MOD(index(i)+offset-1,pt_domain%ni)+1
+      Pt_domain%j_index(i)=(index(i)+offset-1)/pt_domain%ni+1
+      
+    ENDDO
+
+    Pt_domain%mask(:)=.TRUE.
+
+  END SUBROUTINE domain__set_type_orange
+
+
+    
+  SUBROUTINE domain__print(pt_domain)
+  IMPLICIT NONE
+    TYPE(domain),POINTER   :: Pt_domain
+
+    PRINT *,"---- DOMAIN ----"
+    
+    IF (pt_domain%is_defined) THEN
+      PRINT *,"rank :",pt_domain%rank
+      PRINT *,"ni :",pt_domain%ni
+      PRINT *,"nj :",pt_domain%nj
+      PRINT *,"ibegin",pt_domain%ibegin
+      PRINT *,"iend",pt_domain%iend
+    ELSE
+      PRINT *,"  ---> domain undefined"
+    ENDIF
+    
+    PRINT *,"-----------------"
+  END SUBROUTINE domain__print
+  
+  SUBROUTINE domain__copy(Pt_in,pt_out)
+  IMPLICIT NONE
+    TYPE(domain),POINTER   :: Pt_in
+    TYPE(domain),POINTER   :: Pt_out
+  
+    IF (pt_in%is_defined) THEN
+      CALL domain__set(pt_out,pt_in%rank,pt_in%ni,pt_in%nj,pt_in%ibegin,pt_in%jbegin,pt_in%lon,pt_in%lat)
+    ENDIF
+  END SUBROUTINE domain__copy
+  
+END MODULE mod_domain
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_error_msg.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_error_msg.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_error_msg.f90	(revision 2528)
@@ -0,0 +1,40 @@
+MODULE error_msg
+  USE mod_xmlio_parameters,ONLY : str_msg_len
+
+  CHARACTER(LEN=str_msg_len),SAVE :: message
+
+CONTAINS
+
+  SUBROUTINE Warning(sub_name)
+  IMPLICIT NONE
+    CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: sub_name
+    
+    IF (PRESENT(sub_name)) THEN
+      PRINT *,"--* WARNING *-- : in subroutine "//sub_name
+    ELSE
+      PRINT *,"--* WARNING *-- "
+    ENDIF
+    
+    PRINT *,"----> ",TRIM(message)
+    message=REPEAT(' ',str_msg_len)
+    
+  END SUBROUTINE warning
+  
+  SUBROUTINE error(sub_name)
+  IMPLICIT NONE
+    CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: sub_name
+    
+    IF (PRESENT(sub_name)) THEN
+      PRINT *,"--* WARNING *-- : in subroutine "//sub_name
+    ELSE
+      PRINT *,"--* WARNING *-- "
+    ENDIF
+
+    PRINT *,"----> ",TRIM(message)
+    message=REPEAT(' ',str_msg_len)
+    
+    STOP 
+  
+  END SUBROUTINE error    
+
+END MODULE error_msg
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_field.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_field.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_field.f90	(revision 2528)
@@ -0,0 +1,658 @@
+MODULE mod_field
+
+  USE mod_xmlio_parameters
+  USE mod_sorted_list
+  USE mod_axis
+  USE mod_grid
+  USE mod_zoom
+   
+  IMPLICIT NONE
+
+  TYPE, PUBLIC :: field
+    CHARACTER(len=str_len)         :: id
+    LOGICAL                        :: has_id
+    CHARACTER(len=str_len)         :: name
+    LOGICAL                        :: has_name
+    CHARACTER(len=str_len)         :: description
+    LOGICAL                        :: has_description
+    CHARACTER(len=str_len)         :: unit
+    LOGICAL                        :: has_unit
+    CHARACTER(len=str_len)         :: operation
+    LOGICAL                        :: has_operation
+    INTEGER                        :: freq_op
+    LOGICAL                        :: has_freq_op
+    CHARACTER(len=str_len)         :: axis_ref
+    LOGICAL                        :: has_axis_ref
+    CHARACTER(len=str_len)         :: grid_ref
+    LOGICAL                        :: has_grid_ref
+    CHARACTER(len=str_len)         :: zoom_ref
+    LOGICAL                        :: has_zoom_ref
+    INTEGER                        :: level
+    LOGICAL                        :: has_level
+    INTEGER                        :: prec
+    LOGICAL                        :: has_prec
+    CHARACTER(len=str_len)         :: field_ref
+    LOGICAL                        :: has_field_ref
+    TYPE(field),POINTER            :: field_base
+    LOGICAL                        :: has_field_base
+    LOGICAL                        :: enabled
+    LOGICAL                        :: has_enabled
+    LOGICAL                        :: solved_field_ref
+    TYPE(axis), POINTER            :: axis
+    LOGICAL                        :: has_axis
+    TYPE(grid),POINTER             :: grid
+    LOGICAL                        :: has_grid
+    TYPE(zoom),POINTER             :: zoom
+    LOGICAL                        :: has_zoom
+    INTEGER                        :: internal(internal_field)
+    
+    
+  END TYPE field
+  
+  INTERFACE field__set_attribut
+    MODULE PROCEDURE field__set_attribut_id,field__set_attribut_pt
+  END INTERFACE
+  
+  INCLUDE 'vector_field_def.inc'
+  
+  TYPE(vector_field),POINTER,SAVE            :: field_Ids
+  TYPE(sorted_list),POINTER,SAVE,PRIVATE     :: Ids
+  
+
+CONTAINS
+  INCLUDE 'vector_field_contains.inc'
+
+  SUBROUTINE field__swap_context(saved_field_ids,saved_ids)
+  IMPLICIT NONE
+    TYPE(vector_field),POINTER :: saved_field_ids
+    TYPE(sorted_list),POINTER  :: saved_ids
+    
+    field_Ids=>saved_field_ids
+    Ids=>saved_Ids
+
+  END SUBROUTINE field__swap_context
+
+  SUBROUTINE field__init
+  IMPLICIT NONE
+    
+    CALL vector_field__new(field_Ids)
+    CALL sorted_list__new(Ids)
+   
+  END SUBROUTINE field__init
+  
+  SUBROUTINE field__get(Id,Pt_field)
+  USE string_function
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)     :: Id
+    TYPE(field),POINTER             :: Pt_field
+
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_field=>field_ids%at(Pos)%Pt
+    ELSE
+      Pt_field=>NULL()
+    ENDIF
+    
+  END SUBROUTINE field__get
+    
+  
+  SUBROUTINE field__new(pt_field,Id)
+   USE string_function
+   IMPLICIT NONE
+   TYPE(field), POINTER          :: pt_field
+   CHARACTER(LEN=*),OPTIONAL     :: Id
+   
+   INTEGER              :: Pos
+
+   Pt_field%has_id=.FALSE.
+   pt_field%has_name = .FALSE.
+   pt_field%has_description = .FALSE.
+   pt_field%has_unit = .FALSE.
+   pt_field%has_operation = .FALSE.
+   pt_field%has_freq_op = .FALSE.
+   pt_field%has_axis_ref = .FALSE.
+   pt_field%has_grid_ref = .FALSE.
+   pt_field%has_zoom_ref = .FALSE.
+   pt_field%has_prec = .FALSE.
+   pt_field%has_level = .FALSE. 
+   pt_field%has_field_ref = .FALSE.
+   pt_field%has_field_base = .FALSE.
+   pt_field%has_enabled = .FALSE.
+   Pt_field%solved_field_ref=.FALSE.
+   Pt_field%has_axis=.FALSE.
+   Pt_field%has_grid=.FALSE.
+   Pt_field%has_zoom=.FALSE.
+      
+   IF (PRESENT(Id)) THEN
+     Pt_field%id=TRIM(ADJUSTL(Id))
+     Pt_field%has_id=.TRUE.
+     CALL vector_field__set_new(field_Ids,Pt_field,Pos)
+     CALL sorted_list__Add(Ids,hash(id),Pos)
+   ENDIF
+   
+ END SUBROUTINE field__new
+
+
+ SUBROUTINE field__set(p_field, name, ref, description, unit, operation, freq_op, axis_ref, grid_ref, zoom_ref, prec, level, &
+                       enabled)
+
+    TYPE(field), pointer :: p_field
+    CHARACTER(len=*), OPTIONAL :: name
+    CHARACTER(len=*), OPTIONAL :: ref
+    CHARACTER(len=*), OPTIONAL  :: description
+    CHARACTER(len=*), OPTIONAL  :: unit
+    CHARACTER(len=*), OPTIONAL :: operation
+    INTEGER, OPTIONAL  :: freq_op
+    CHARACTER(len=*),OPTIONAL :: axis_ref
+    CHARACTER(len=*),OPTIONAL :: grid_ref
+    CHARACTER(len=*),OPTIONAL :: zoom_ref
+    INTEGER, OPTIONAL :: prec
+    INTEGER, OPTIONAL :: level
+    LOGICAL, OPTIONAL :: enabled
+
+    IF (PRESENT(name)) THEN
+        p_field%name=TRIM(ADJUSTL(name))
+        p_field%has_name = .TRUE.
+    ENDIF
+    IF (PRESENT(ref)) THEN
+        p_field%field_ref=TRIM(ADJUSTL(ref))
+        p_field%has_field_ref = .TRUE.
+    ENDIF
+    IF (PRESENT(description)) THEN
+        p_field%description=TRIM(ADJUSTL(description))
+        p_field%has_description = .TRUE.
+    ENDIF
+ 
+    IF (PRESENT(unit)) then
+        p_field%unit=TRIM(ADJUSTL(unit))
+        p_field%has_unit = .TRUE.
+    ENDIF
+    IF (PRESENT(operation)) THEN
+        p_field%operation=TRIM(ADJUSTL(operation))
+        p_field%has_operation = .TRUE.
+    ENDIF
+    IF (PRESENT(freq_op)) THEN
+        p_field%freq_op=freq_op
+        p_field%has_freq_op = .TRUE.
+    ENDIF
+    IF (PRESENT(axis_ref)) THEN
+        p_field%axis_ref=TRIM(ADJUSTL(axis_ref))
+        p_field%has_axis_ref = .TRUE.
+    ENDIF
+    IF (PRESENT(grid_ref)) THEN
+        p_field%grid_ref=TRIM(ADJUSTL(grid_ref))
+        p_field%has_grid_ref = .TRUE.
+    ENDIF
+
+    IF (PRESENT(zoom_ref)) THEN
+        p_field%zoom_ref=TRIM(ADJUSTL(zoom_ref))
+        p_field%has_zoom_ref = .TRUE.
+    ENDIF
+
+    IF (PRESENT(prec)) then
+        p_field%prec=prec
+        p_field%has_prec = .TRUE.
+    ENDIF
+    
+    IF (PRESENT(level)) then
+        p_field%level=level
+        p_field%has_level = .TRUE.
+    ENDIF
+
+    IF (PRESENT(enabled)) then
+        p_field%enabled=enabled
+        p_field%has_enabled = .TRUE.
+    ENDIF
+
+  END SUBROUTINE field__set
+
+  SUBROUTINE field__set_attribut_id(id,attrib,Ok)
+  USE mod_attribut
+  USE mod_field_attribut
+  USE error_msg
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)   :: id
+    TYPE(attribut),INTENT(IN)     :: attrib
+    LOGICAL,OPTIONAL,INTENT(out)  :: Ok
+    
+    TYPE(field),POINTER             :: Pt_field
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_field=>field_ids%at(Pos)%Pt
+      CALL field__set_attribut(Pt_field,attrib)
+      IF (PRESENT(OK)) ok=.TRUE.
+    ELSE
+      IF (.NOT.PRESENT(OK)) THEN
+        WRITE(message,*) 'Field id :',id,'is undefined'
+        CALL error('mod_field::field__set_attribut')
+      ELSE
+        OK=.FALSE.
+      ENDIF
+    ENDIF  
+  END SUBROUTINE field__set_attribut_id
+
+    
+  SUBROUTINE field__set_attribut_pt(pt_field,attrib)
+  USE mod_attribut
+  USE mod_field_attribut
+  USE error_msg
+  IMPLICIT NONE
+    TYPE(field),POINTER             :: Pt_field
+    TYPE(attribut),INTENT(IN) :: attrib
+
+    SELECT CASE(attrib%name)
+      CASE (field__name)
+        IF (attrib%type==string0) CALL  field__set(pt_field,name=attrib%string0_ptr) ; RETURN
+      CASE (field__field_ref)
+        IF (attrib%type==string0) CALL  field__set(pt_field,ref=attrib%string0_ptr) ; RETURN
+      CASE (field__description)
+        IF (attrib%type==string0) CALL  field__set(pt_field,description=attrib%string0_ptr) ; RETURN
+      CASE (field__unit)
+        IF (attrib%type==string0) CALL  field__set(pt_field,unit=attrib%string0_ptr) ; RETURN
+      CASE (field__operation)
+        IF (attrib%type==string0) CALL  field__set(pt_field,operation=attrib%string0_ptr) ; RETURN
+      CASE (field__freq_op)
+        IF (attrib%type==integer0) CALL  field__set(pt_field,freq_op=attrib%integer0_ptr) ; RETURN
+      CASE (field__axis_ref)
+        IF (attrib%type==string0) CALL  field__set(pt_field,axis_ref=attrib%string0_ptr) ; RETURN
+      CASE (field__grid_ref)
+        IF (attrib%type==string0) CALL  field__set(pt_field,grid_ref=attrib%string0_ptr) ; RETURN
+      CASE (field__zoom_ref)
+        IF (attrib%type==string0) CALL  field__set(pt_field,zoom_ref=attrib%string0_ptr) ; RETURN
+      CASE (field__prec)
+        IF (attrib%type==integer0) CALL  field__set(pt_field,prec=attrib%integer0_ptr) ; RETURN
+      CASE (field__level)
+        IF (attrib%type==integer0) CALL  field__set(pt_field,level=attrib%integer0_ptr) ; RETURN
+      CASE (field__enabled)
+        IF (attrib%type==logical0) CALL  field__set(pt_field,enabled=attrib%logical0_ptr) ; RETURN
+     END SELECT
+
+     WRITE(message,*) 'field attribut ',attrib%name,' : type :',attrib%type,   &
+                      ' : Attribute type is incompatible with the provided value'
+     CALL error('mod_field::field__set_attribut')
+    
+  END SUBROUTINE field__set_attribut_pt    
+
+  SUBROUTINE field__print(pt_field)
+
+    TYPE(field), POINTER :: pt_field
+    
+    PRINT *,"--- FIELD ---"
+
+    IF (pt_field%has_id) THEN
+        PRINT *, 'id : ',TRIM(pt_field%id)
+    ELSE
+        PRINT *, 'id undefined '
+    ENDIF
+
+    IF (pt_field%has_name) THEN
+        PRINT *, 'name : ',TRIM(pt_field%name)
+    ELSE
+        PRINT *, 'name undefined '
+    ENDIF
+    IF (pt_field%has_description) THEN
+        PRINT *, 'description : ',TRIM(pt_field%description)
+    ELSE
+        PRINT *, 'description undefined '
+    ENDIF
+    IF (pt_field%has_unit) THEN
+        PRINT *, 'unit : ',TRIM(pt_field%unit)
+    ELSE
+        PRINT *, 'unit undefined '
+    ENDIF
+    IF (pt_field%has_operation) THEN
+        PRINT *, 'operation ',TRIM(pt_field%operation)
+    ELSE
+        PRINT *, 'operation undefined '
+    ENDIF
+    IF (pt_field%has_freq_op) THEN
+        PRINT *, 'freq_op ',pt_field%freq_op
+    ELSE
+        PRINT *, 'freq_op undefined '
+    ENDIF
+
+    IF (pt_field%has_axis_ref) THEN
+        PRINT *, 'axis_ref : ',TRIM(pt_field%axis_ref)
+    ELSE
+        PRINT *, 'axis_ref undefined '
+    ENDIF
+
+    IF (pt_field%has_grid_ref) THEN
+        PRINT *, 'grid_ref : ',TRIM(pt_field%grid_ref)
+    ELSE
+        PRINT *, 'grid_ref undefined '
+    ENDIF
+
+    IF (pt_field%has_zoom_ref) THEN
+        PRINT *, 'zoom_ref : ',TRIM(pt_field%zoom_ref)
+    ELSE
+        PRINT *, 'zoom_ref undefined '
+    ENDIF
+    
+    IF (pt_field%has_field_ref) THEN
+        PRINT *, 'field_ref : ',TRIM(pt_field%field_ref)
+    ELSE
+        PRINT *, 'field_ref undefined '
+    ENDIF
+
+!    call vert_axis__print(pt_field%p_vert_axis)
+!
+!    IF (pt_field%is_vert_axis_ref_def) THEN
+!        PRINT *, 'pt_field%vert_axis_ref ',TRIM(pt_field%vert_axis_ref)
+!    ELSE
+!        PRINT *, 'pt_field%vert_axis_ref undefined '
+!    ENDIF
+    IF (pt_field%has_prec) THEN
+        PRINT *, 'prec ',pt_field%prec
+    ELSE
+        PRINT *, 'prec undefined '
+    ENDIF
+    IF (pt_field%has_level) then
+        PRINT *, 'level ',pt_field%level
+    ELSE
+        PRINT *, 'level undefined '
+    ENDIF
+    IF (pt_field%has_field_base) THEN
+        PRINT *, 'field_base :',TRIM(Pt_field%field_base%id)
+    ELSE
+        PRINT *, 'field_base indefini'
+    ENDIF
+
+    IF (pt_field%has_enabled) THEN
+        PRINT *, 'enabled : ',pt_field%enabled
+    ELSE
+        PRINT *, 'enabled indefini'
+    ENDIF
+ 
+    PRINT *,"------------"
+    
+  END SUBROUTINE field__print
+
+!  SUBROUTINE field__resolve_ref_vert_axis(p_field)
+!
+!    TYPE(field), POINTER :: p_field
+!    CHARACTER(len=str_len) :: name
+!
+!    IF (p_field%is_vert_axis_ref_def) THEN
+!        name=p_field%vert_axis_ref
+!        IF (vert_axis_def__is_exist(name)) THEN
+!            CALL vert_axis_def__get(name,p_field%p_vert_axis)
+!            p_field%is_vert_axis_def = .TRUE.
+!        ENDIF
+!    ENDIF
+!
+!  END SUBROUTINE field__resolve_ref_vert_axis
+
+  SUBROUTINE field__apply_default(pt_field_default, pt_field_in, pt_field_out)
+
+    TYPE(field), POINTER :: pt_field_default, pt_field_in, pt_field_out
+
+    IF (pt_field_in%has_name) THEN
+        pt_field_out%name=pt_field_in%name
+        pt_field_out%has_name=.TRUE.
+    ELSE IF ( pt_field_default%has_name) THEN
+        pt_field_out%name=pt_field_default%name
+        pt_field_out%has_name=.TRUE.
+    ELSE
+        pt_field_out%has_name=.FALSE.
+    ENDIF
+        
+    IF (pt_field_in%has_description) THEN
+        pt_field_out%description=pt_field_in%description
+        pt_field_out%has_description=.TRUE.
+    ELSE IF ( pt_field_default%has_description ) THEN
+        pt_field_out%description=pt_field_default%description
+        pt_field_out%has_description=.TRUE.
+    ELSE
+        pt_field_out%has_description=.FALSE.
+    ENDIF
+
+    IF (pt_field_in%has_unit) THEN
+        pt_field_out%unit=pt_field_in%unit
+        pt_field_out%has_unit=.TRUE.
+    ELSE IF ( pt_field_default%has_unit ) THEN
+        pt_field_out%unit=pt_field_default%unit
+        pt_field_out%has_unit=.TRUE.
+    ELSE
+        pt_field_out%has_unit=.FALSE.
+    ENDIF
+
+    IF (pt_field_in%has_operation) THEN
+        pt_field_out%operation=pt_field_in%operation
+        pt_field_out%has_operation=.TRUE.
+    ELSE IF ( pt_field_default%has_operation ) THEN
+        pt_field_out%operation=pt_field_default%operation
+        pt_field_out%has_operation=.TRUE.
+    ELSE
+        pt_field_out%has_operation=.FALSE.
+    ENDIF
+
+    IF (pt_field_in%has_freq_op) THEN
+        pt_field_out%freq_op=pt_field_in%freq_op
+        pt_field_out%has_freq_op=.TRUE.
+    ELSE IF ( pt_field_default%has_freq_op ) THEN
+        pt_field_out%freq_op=pt_field_default%freq_op
+        pt_field_out%has_freq_op=.TRUE.
+    ELSE
+        pt_field_out%has_freq_op=.FALSE.
+    ENDIF
+
+!    IF (pt_field_in%has_axis) THEN
+!        pt_field_out%p_axis => pt_field_in%p_axis
+!        pt_field_out%has_axis=.TRUE.
+!    ELSE IF ( pt_field_default%has_axis ) THEN
+!        pt_field_out%p_axis => pt_field_default%p_axis
+!        pt_field_out%has_axis=.TRUE.
+!    ELSE
+!        pt_field_out%has_axis=.FALSE.
+!    ENDIF
+    
+    IF (pt_field_in%has_axis_ref) THEN
+        pt_field_out%axis_ref=pt_field_in%axis_ref
+        pt_field_out%has_axis_ref=.TRUE.
+    ELSE IF ( pt_field_default%has_axis_ref ) THEN
+        pt_field_out%axis_ref=pt_field_default%axis_ref
+        pt_field_out%has_axis_ref=.TRUE.
+    ELSE
+        pt_field_out%has_axis_ref=.FALSE.
+    ENDIF
+
+    IF (pt_field_in%has_grid_ref) THEN
+        pt_field_out%grid_ref=pt_field_in%grid_ref
+        pt_field_out%has_grid_ref=.TRUE.
+    ELSE IF ( pt_field_default%has_grid_ref ) THEN
+        pt_field_out%grid_ref=pt_field_default%grid_ref
+        pt_field_out%has_grid_ref=.TRUE.
+    ELSE
+        pt_field_out%has_grid_ref=.FALSE.
+    ENDIF
+
+    IF (pt_field_in%has_zoom_ref) THEN
+        pt_field_out%zoom_ref=pt_field_in%zoom_ref
+        pt_field_out%has_zoom_ref=.TRUE.
+    ELSE IF ( pt_field_default%has_zoom_ref ) THEN
+        pt_field_out%zoom_ref=pt_field_default%zoom_ref
+        pt_field_out%has_zoom_ref=.TRUE.
+    ELSE
+        pt_field_out%has_zoom_ref=.FALSE.
+    ENDIF
+
+    IF (pt_field_in%has_prec) THEN
+        pt_field_out%prec=pt_field_in%prec
+        pt_field_out%has_prec=.TRUE.
+    ELSE IF ( pt_field_default%has_prec ) THEN
+        pt_field_out%prec=pt_field_default%prec
+        pt_field_out%has_prec=.TRUE.
+    ELSE
+        pt_field_out%has_prec=.FALSE.
+    ENDIF
+
+    IF (pt_field_in%has_level) THEN
+        pt_field_out%level=pt_field_in%level
+        pt_field_out%has_level=.TRUE.
+    ELSE IF ( pt_field_default%has_level ) THEN
+        pt_field_out%level=pt_field_default%level
+        pt_field_out%has_level=.TRUE.
+    ELSE
+        pt_field_out%has_level=.FALSE.
+    ENDIF
+
+    IF (pt_field_in%has_enabled) THEN
+        pt_field_out%enabled=pt_field_in%enabled
+        pt_field_out%has_enabled=.TRUE.
+    ELSE IF ( pt_field_default%has_enabled ) THEN
+        pt_field_out%enabled=pt_field_default%enabled
+        pt_field_out%has_enabled=.TRUE.
+    ELSE
+        pt_field_out%has_enabled=.FALSE.
+    ENDIF
+    
+  END SUBROUTINE field__apply_default
+
+!  FUNCTION field__is_vert_axis_attached(p_field, vert_axis_name)
+!
+!    LOGICAL :: field__is_vert_axis_attached
+!    TYPE(field), POINTER :: p_field
+!    CHARACTER(len=*), INTENT(IN) :: vert_axis_name
+!
+!    field__is_vert_axis_attached = .false.
+!    IF (p_field%is_vert_axis_def) THEN
+!        IF (vert_axis_name == p_field%p_vert_axis%name) field__is_vert_axis_attached = .TRUE.
+!    ENDIF
+!
+!  END FUNCTION field__is_vert_axis_attached
+
+  RECURSIVE SUBROUTINE field__solve_field_ref(pt_field)
+  USE error_msg
+  IMPLICIT NONE
+    TYPE(field), POINTER :: pt_field
+    
+    TYPE(field), POINTER :: field_ref
+    
+    IF (.NOT. pt_field%solved_field_ref) THEN
+      
+      IF (pt_field%has_field_ref) THEN
+      
+        CALL field__get(pt_field%field_ref,field_ref)
+      
+        IF (.NOT. ASSOCIATED(field_ref)) THEN
+          WRITE (message,*) "The field : id = ",pt_field%id,"  name = ",Pt_field%name,   &
+                        " has a unknown reference to field : id =",pt_field%field_ref
+          CALL error("field__solve_field_ref")
+        ENDIF
+      
+        CALL field__get_field_base(field_ref,pt_field%field_base) 
+        Pt_field%has_field_base=.TRUE.
+        
+        CALL field__apply_default(field_ref,pt_field,pt_field)
+        
+          
+      ELSE 
+
+        IF (pt_field%has_id) THEN
+          pt_field%field_base=>pt_field
+        ENDIF
+      
+      ENDIF
+      
+      IF (.NOT. pt_field%has_name) THEN
+        IF (pt_field%has_id) THEN
+          pt_field%name=pt_field%id
+          pt_field%has_name=.TRUE.
+        ENDIF
+      ENDIF
+    
+      Pt_field%solved_field_ref=.TRUE.
+    
+    ENDIF
+    
+  END SUBROUTINE field__solve_field_ref
+  
+
+  RECURSIVE SUBROUTINE field__get_field_base(pt_field,pt_field_base)
+  IMPLICIT NONE
+    TYPE(field), POINTER :: pt_field
+    TYPE(field), POINTER :: pt_field_base
+    
+     
+    IF (.NOT. Pt_field%solved_field_ref) THEN
+      CALL field__solve_field_ref(Pt_field)
+    ENDIF
+     
+    IF (pt_field%has_field_base) THEN
+      pt_field_base=>pt_field%field_base
+    ELSE
+      pt_field_base=>pt_field
+    ENDIF
+   
+ END SUBROUTINE field__get_field_base
+
+ SUBROUTINE field__solve_axis_ref(pt_field)
+ USE error_msg
+ IMPLICIT NONE
+   TYPE(field), POINTER :: pt_field
+   
+   IF (pt_field%has_axis_ref) THEN
+     CALL axis__get(pt_field%axis_ref,pt_field%axis)
+     IF (ASSOCIATED(pt_field%axis)) THEN
+       pt_field%has_axis=.TRUE.
+     ELSE
+       WRITE (message,*) "The field : id = ",pt_field%id,"  name = ",Pt_field%name,   &
+                        " has a unknown reference to axis : id =",pt_field%axis_ref
+       CALL error("mod_field::field__solve_axis_ref")
+     ENDIF
+   ENDIF
+   
+ END SUBROUTINE field__solve_axis_ref
+   
+ SUBROUTINE field__solve_grid_ref(pt_field)
+ USE error_msg
+ IMPLICIT NONE
+   TYPE(field), POINTER :: pt_field
+   
+   IF (pt_field%has_grid_ref) THEN
+     CALL grid__get(pt_field%grid_ref,pt_field%grid)
+     IF (ASSOCIATED(pt_field%grid)) THEN
+       pt_field%has_grid=.TRUE.
+     ELSE
+       WRITE (message,*) "The field : id = ",pt_field%id,"  name = ",Pt_field%name,   &
+                        " has a unknown reference to grid : id =",pt_field%grid_ref
+       CALL error("mod_field::field__solve_grid_ref")
+     ENDIF
+   ENDIF
+   
+ END SUBROUTINE field__solve_grid_ref
+   
+ SUBROUTINE field__solve_zoom_ref(pt_field)
+ USE error_msg
+ IMPLICIT NONE
+   TYPE(field), POINTER :: pt_field
+   
+   IF (.NOT. pt_field%has_zoom_ref) THEN
+     IF (pt_field%has_grid_ref) THEN
+       pt_field%has_zoom_ref=.TRUE.
+       pt_field%zoom_ref=pt_field%grid_ref
+     ENDIF
+   ENDIF
+    
+   IF (pt_field%has_zoom_ref) THEN
+     CALL zoom__get(pt_field%zoom_ref,pt_field%zoom)
+     IF (ASSOCIATED(pt_field%zoom)) THEN
+       pt_field%has_zoom=.TRUE.
+     ELSE
+       WRITE (message,*) "The field : id = ",pt_field%id,"  name = ",Pt_field%name,   &
+                        " has a unknown reference to zoom : id =",pt_field%zoom_ref
+       CALL error("mod_field::field__solve_zoom_ref")
+     ENDIF
+   ENDIF
+   
+ END SUBROUTINE field__solve_zoom_ref
+
+   
+END MODULE mod_field
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_field_attribute.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_field_attribute.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_field_attribute.f90	(revision 2528)
@@ -0,0 +1,21 @@
+MODULE mod_field_attribut
+  USE mod_object
+
+  INTEGER,PARAMETER :: field__begin = field_object + 10
+  
+  INTEGER,PARAMETER :: field__name = field_object + 11
+  INTEGER,PARAMETER :: field__description = field_object + 12
+  INTEGER,PARAMETER :: field__unit = field_object + 13
+  INTEGER,PARAMETER :: field__operation = field_object + 14
+  INTEGER,PARAMETER :: field__freq_op = field_object + 15
+  INTEGER,PARAMETER :: field__axis_ref = field_object + 16
+  INTEGER,PARAMETER :: field__grid_ref = field_object + 17
+  INTEGER,PARAMETER :: field__zoom_ref = field_object + 18
+  INTEGER,PARAMETER :: field__level = field_object + 19
+  INTEGER,PARAMETER :: field__prec = field_object + 20
+  INTEGER,PARAMETER :: field__field_ref = field_object + 21
+  INTEGER,PARAMETER :: field__enabled = field_object + 22
+
+  INTEGER,PARAMETER :: field__end = field_object + 23
+  
+END MODULE mod_field_attribut
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_field_definition.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_field_definition.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_field_definition.f90	(revision 2528)
@@ -0,0 +1,26 @@
+MODULE mod_field_definition
+  USE mod_field_group
+  
+  TYPE(field_group),SAVE,POINTER :: field_definition
+ 
+CONTAINS
+
+  SUBROUTINE field_definition__swap_context(saved_field_definition)
+  IMPLICIT NONE
+    TYPE(field_group),POINTER :: saved_field_definition
+  
+    field_definition=>saved_field_definition
+
+  END SUBROUTINE field_definition__swap_context
+
+
+  SUBROUTINE field_definition__Init
+  IMPLICIT NONE
+  
+   CALL field_group__new(field_definition,"field_definition")
+
+  END SUBROUTINE field_definition__Init
+  
+        
+END MODULE mod_field_definition
+
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_field_group.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_field_group.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_field_group.f90	(revision 2528)
@@ -0,0 +1,304 @@
+MODULE mod_field_group
+
+  USE mod_field
+  USE mod_xmlio_parameters
+
+  IMPLICIT NONE
+
+  TYPE field_group
+    CHARACTER(LEN=str_len)                    :: id
+    LOGICAL                                   :: has_id
+    TYPE(vector_field_group), POINTER         :: groups
+    TYPE(vector_field),POINTER                :: fields     
+    TYPE(field), POINTER                      :: default_attribut
+  END TYPE field_group
+
+  INCLUDE "vector_field_group_def.inc"  
+
+  TYPE(vector_field_group),SAVE,POINTER      :: field_group_Ids
+  TYPE(sorted_list),POINTER,SAVE,PRIVATE     :: Ids 
+
+  INTERFACE field_group__set_attribut
+    MODULE PROCEDURE field_group__set_attribut_id,field_group__set_attribut_pt
+  END INTERFACE
+
+CONTAINS
+
+  INCLUDE "vector_field_group_contains.inc"
+
+
+  SUBROUTINE field_group__swap_context(saved_field_group_ids, saved_ids)
+  IMPLICIT NONE
+    TYPE(vector_field_group),POINTER   :: saved_field_group_Ids
+    TYPE(sorted_list),POINTER          :: saved_Ids
+    
+    field_group_ids=>saved_field_group_ids 
+    ids=>saved_ids
+    
+  END SUBROUTINE field_group__swap_context
+
+  SUBROUTINE field_group__init
+  IMPLICIT NONE
+    
+    CALL vector_field_group__new(field_group_Ids)
+    CALL sorted_list__new(Ids)
+   
+  END SUBROUTINE field_group__init
+
+  SUBROUTINE field_group__get(Id,Pt_fg)
+  USE string_function
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)     :: Id
+    TYPE(field_group),POINTER       :: Pt_fg
+
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_fg=>field_group_ids%at(Pos)%Pt
+    ELSE
+      Pt_fg=>NULL()
+    ENDIF
+    
+  END SUBROUTINE field_group__get
+
+  SUBROUTINE field_group__set_attribut_id(id,attrib,Ok)
+  USE mod_attribut
+  USE error_msg
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: id
+    TYPE(attribut),INTENT(IN) :: attrib
+    LOGICAL,OPTIONAL,INTENT(out)  :: Ok
+    
+    TYPE(field_group),POINTER             :: Pt_fg
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_fg=>field_group_ids%at(Pos)%Pt
+      CALL field_group__set_attribut(Pt_fg,attrib)
+      IF (PRESENT(OK)) ok=.TRUE.
+    ELSE
+      IF (.NOT.PRESENT(OK)) THEN
+        WRITE(message,*) 'Field group id :',id,'is undefined'
+        CALL error('mod_field_group::field_group__set_attribut')
+      ELSE
+        OK=.FALSE.
+      ENDIF
+    ENDIF 
+    
+  END SUBROUTINE field_group__set_attribut_id
+  
+  SUBROUTINE field_group__set_attribut_pt(pt_fg,attrib)
+  USE mod_attribut
+  USE mod_object
+  IMPLICIT NONE
+    TYPE(field_group),POINTER :: Pt_fg
+    TYPE(attribut),INTENT(IN) :: attrib
+     
+    IF (attrib%object==field_object) THEN
+      CALL field__set_attribut(Pt_fg%default_attribut,attrib)
+    ENDIF
+    
+  END SUBROUTINE field_group__set_attribut_pt
+    
+      
+  RECURSIVE SUBROUTINE field_group__new(Pt_fg,Id)
+  USE string_function
+  IMPLICIT NONE
+    TYPE(field_group),POINTER                :: Pt_fg
+    CHARACTER(LEN=*),OPTIONAL,INTENT(IN)     :: Id
+    
+    INTEGER :: Pos
+    
+    ALLOCATE(Pt_fg%groups)
+    ALLOCATE(Pt_fg%fields)
+    ALLOCATE(Pt_fg%default_attribut)
+    
+    CALL vector_field_group__new(Pt_fg%groups)
+    CALL vector_field__new(Pt_fg%fields)
+    CALL field__new(Pt_fg%default_attribut)
+    Pt_fg%has_id=.FALSE.
+      
+    IF (PRESENT(Id)) THEN
+      Pt_fg%id=TRIM(Id)
+      Pt_fg%has_id=.TRUE.
+      CALL vector_field_group__set_new(field_group_Ids,Pt_fg,Pos)
+      CALL sorted_list__Add(Ids,hash(id),Pos)
+    ENDIF
+
+  END SUBROUTINE field_group__new
+
+      
+  SUBROUTINE field_group__get_new_group(Pt_fg,Pt_fg_out,Id)
+  IMPLICIT NONE
+    TYPE(field_group),POINTER            :: Pt_fg
+    TYPE(field_group),POINTER            :: Pt_fg_out
+    CHARACTER(LEN=*),OPTIONAL      :: Id
+    
+    CALL vector_field_group__get_new(Pt_fg%groups,Pt_fg_out)
+ 
+    IF (PRESENT(id)) THEN
+      CALL field_group__new(Pt_fg_out,Id)
+    ELSE
+      CALL field_group__new(Pt_fg_out)
+    ENDIF
+    
+  END SUBROUTINE field_group__get_new_group
+
+  
+  SUBROUTINE field_group__get_new_field(Pt_fg,Pt_f_out,Id)
+  IMPLICIT NONE
+    TYPE(field_group),POINTER            :: Pt_fg
+    TYPE(field),POINTER                  :: Pt_f_out
+    CHARACTER(LEN=*),OPTIONAL      :: Id
+    
+    CALL vector_field__get_new(Pt_fg%fields,Pt_f_out)
+    
+    IF (PRESENT(id)) THEN
+      CALL field__new(Pt_f_out,Id)
+    ELSE
+      CALL field__new(Pt_f_out)
+    ENDIF
+    
+  END SUBROUTINE field_group__get_new_field
+  
+  
+  SUBROUTINE field_group__get_default_attrib(Pt_fg,Pt_f)
+  IMPLICIT NONE
+    TYPE(field_group),POINTER  :: Pt_fg
+    TYPE(field),POINTER        :: Pt_f
+    
+    Pt_f=>Pt_fg%default_attribut
+  END SUBROUTINE field_group__get_default_attrib
+
+  
+  RECURSIVE SUBROUTINE field_group__apply_default(Pt_fg,default)
+  IMPLICIT NONE
+    TYPE(field_group),POINTER           :: Pt_fg
+    TYPE(field),POINTER,OPTIONAL        :: default
+    
+    INTEGER :: i
+    
+    IF (PRESENT(default)) THEN
+      CALL field__apply_default(default,Pt_fg%default_attribut,Pt_fg%default_attribut)
+    ENDIF
+      
+    DO i=1,Pt_fg%groups%size
+      CALL field_group__apply_default(Pt_fg%groups%at(i)%pt,Pt_fg%default_attribut)
+    ENDDO
+    
+    DO i=1,Pt_fg%fields%size
+      CALL field__apply_default(Pt_fg%default_attribut,Pt_fg%fields%at(i)%pt,Pt_fg%fields%at(i)%pt)
+    ENDDO
+  
+  END SUBROUTINE field_group__apply_default
+  
+  SUBROUTINE field_group__solve_ref(pt_fg)
+  IMPLICIT NONE
+    TYPE(field_group),POINTER  :: Pt_fg
+
+    CALL field_group__solve_field_ref(Pt_fg)
+    CALL field_group__solve_axis_ref(Pt_fg)
+    CALL field_group__solve_grid_ref(Pt_fg)
+    CALL field_group__solve_zoom_ref(Pt_fg)
+
+  END SUBROUTINE  field_group__solve_ref
+     
+  RECURSIVE SUBROUTINE field_group__solve_field_ref(Pt_fg)
+  IMPLICIT NONE
+    TYPE(field_group),POINTER  :: Pt_fg
+    
+    INTEGER :: i
+
+    DO i=1,Pt_fg%groups%size
+      CALL field_group__solve_field_ref(Pt_fg%groups%at(i)%pt)
+    ENDDO
+    
+    DO i=1,Pt_fg%fields%size
+      CALL field__solve_field_ref(Pt_fg%fields%at(i)%pt)
+    ENDDO
+  
+  END SUBROUTINE field_group__solve_field_ref
+
+  RECURSIVE SUBROUTINE field_group__solve_axis_ref(Pt_fg)
+  IMPLICIT NONE
+    TYPE(field_group),POINTER  :: Pt_fg
+    
+    INTEGER :: i
+
+    DO i=1,Pt_fg%groups%size
+      CALL field_group__solve_axis_ref(Pt_fg%groups%at(i)%pt)
+    ENDDO
+    
+    DO i=1,Pt_fg%fields%size
+      CALL field__solve_axis_ref(Pt_fg%fields%at(i)%pt)
+    ENDDO
+  
+  END SUBROUTINE field_group__solve_axis_ref
+
+  RECURSIVE SUBROUTINE field_group__solve_grid_ref(Pt_fg)
+  IMPLICIT NONE
+    TYPE(field_group),POINTER  :: Pt_fg
+     
+    INTEGER :: i
+ 
+    DO i=1,Pt_fg%groups%size
+      CALL field_group__solve_grid_ref(Pt_fg%groups%at(i)%pt)
+    ENDDO
+       
+    DO i=1,Pt_fg%fields%size
+      CALL field__solve_grid_ref(Pt_fg%fields%at(i)%pt)
+    ENDDO
+  
+  END SUBROUTINE field_group__solve_grid_ref
+
+  RECURSIVE SUBROUTINE field_group__solve_zoom_ref(Pt_fg)
+  IMPLICIT NONE
+    TYPE(field_group),POINTER  :: Pt_fg
+     
+    INTEGER :: i
+ 
+    DO i=1,Pt_fg%groups%size
+      CALL field_group__solve_zoom_ref(Pt_fg%groups%at(i)%pt)
+    ENDDO
+       
+    DO i=1,Pt_fg%fields%size
+      CALL field__solve_zoom_ref(Pt_fg%fields%at(i)%pt)
+    ENDDO
+  
+  END SUBROUTINE field_group__solve_zoom_ref
+  
+  RECURSIVE SUBROUTINE field_group__print(Pt_fg)
+  IMPLICIT NONE
+    TYPE(field_group),POINTER  :: Pt_fg
+   
+    INTEGER :: i
+    
+    PRINT *,"--- FIELD GROUP ---"
+    IF (Pt_fg%has_id) THEN
+      PRINT *,"id :",TRIM(Pt_fg%id)
+    ELSE
+      PRINT *,"id undefined"
+    ENDIF
+    
+    PRINT *,"field default attribut :"
+    CALL field__print(Pt_fg%default_attribut)    
+
+    PRINT *,"owned field groups :",Pt_fg%groups%size      
+    DO i=1,Pt_fg%groups%size
+      CALL field_group__print(Pt_fg%groups%at(i)%pt)
+    ENDDO
+
+    PRINT *,"owned field :",Pt_fg%fields%size      
+    DO i=1,Pt_fg%fields%size
+      CALL field__print(Pt_fg%fields%at(i)%pt)
+    ENDDO
+    
+    PRINT *,"------------"
+    
+  END SUBROUTINE field_group__print     
+
+END MODULE mod_field_group
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_file.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_file.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_file.f90	(revision 2528)
@@ -0,0 +1,362 @@
+MODULE mod_file
+
+  USE mod_xmlio_parameters
+  USE mod_field_group
+  USE mod_sorted_list
+
+  TYPE, PUBLIC :: file
+    CHARACTER(len=str_len)           :: id
+    LOGICAL                          :: has_id
+    CHARACTER(len=str_len)           :: name
+    LOGICAL                          :: has_name
+    CHARACTER(len=str_len)           :: name_suffix
+    LOGICAL                          :: has_name_suffix
+    CHARACTER(len=str_len)           :: description
+    LOGICAL                          :: has_description
+    INTEGER                          :: output_freq
+    LOGICAL                          :: has_output_freq
+    INTEGER                          :: output_level
+    LOGICAL                          :: has_output_level
+    LOGICAL                          :: enabled
+    LOGICAL                          :: has_enabled
+    INTEGER                          :: internal(internal_file)
+    TYPE(field_group),POINTER        :: field_list 
+  END TYPE file
+
+  INCLUDE 'vector_file_def.inc'
+  
+  TYPE(vector_file),POINTER,SAVE             :: file_Ids
+  TYPE(sorted_list),POINTER,SAVE,PRIVATE     :: Ids 
+
+  INTERFACE file__set_attribut
+    MODULE PROCEDURE file__set_attribut_id,file__set_attribut_pt
+  END INTERFACE
+
+CONTAINS
+  INCLUDE 'vector_file_contains.inc'
+
+  SUBROUTINE file__swap_context(saved_file_ids,saved_ids)
+  IMPLICIT NONE
+    TYPE(vector_file),POINTER      :: saved_file_Ids
+    TYPE(sorted_list),POINTER      :: saved_Ids
+    
+    file_ids=>saved_file_ids
+    ids=>saved_ids 
+ 
+  END SUBROUTINE file__swap_context
+
+
+  SUBROUTINE file__init
+  IMPLICIT NONE
+    
+    CALL vector_file__new(file_Ids)
+    CALL sorted_list__new(Ids)
+   
+  END SUBROUTINE file__init
+  
+  SUBROUTINE file__get(Id,Pt_file)
+  USE string_function
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)     :: Id
+    TYPE(file),POINTER              :: Pt_file
+
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_file=>file_ids%at(Pos)%Pt
+    ELSE
+      Pt_file=>NULL()
+    ENDIF
+    
+  END SUBROUTINE file__get
+  
+  SUBROUTINE file__new(pt_file,Id)
+  USE string_function
+  IMPLICIT NONE
+   TYPE(file), POINTER           :: pt_file
+   CHARACTER(LEN=*),OPTIONAL     :: Id
+   INTEGER                       :: Pos
+
+   ALLOCATE(pt_file%field_list)
+   CALL field_group__new(pt_file%field_list)
+      
+   pt_file%has_id           = .FALSE.
+   pt_file%has_name         = .FALSE.
+   pt_file%has_name_suffix  = .FALSE.
+   pt_file%has_description  = .FALSE.
+   pt_file%has_output_freq  = .FALSE.
+   pt_file%has_output_level = .FALSE.
+   pt_file%has_output_level = .FALSE.
+   
+   IF (PRESENT(Id)) THEN
+     Pt_file%id=TRIM(ADJUSTL(Id))
+     Pt_file%has_id=.TRUE.
+     CALL vector_file__set_new(file_Ids,Pt_file,Pos)
+     CALL sorted_list__Add(Ids,hash(id),Pos)
+   ENDIF
+
+  END SUBROUTINE file__new
+
+  SUBROUTINE file__set(pt_file, name, name_suffix, description, output_freq, output_level,enabled)
+  IMPLICIT NONE
+    TYPE(file), POINTER         :: pt_file
+    CHARACTER(len=*)  ,OPTIONAL :: name
+    CHARACTER(len=*)  ,OPTIONAL :: name_suffix
+    CHARACTER(len=*)  ,OPTIONAL :: description
+    INTEGER           ,OPTIONAL :: output_freq
+    INTEGER           ,OPTIONAL :: output_level
+    LOGICAL           ,OPTIONAL :: enabled
+
+    IF (PRESENT(name)) THEN
+        pt_file%name=TRIM(ADJUSTL(name))
+        pt_file%has_name = .TRUE.
+    ENDIF
+
+    IF (PRESENT(name_suffix)) THEN
+        pt_file%name_suffix=TRIM(ADJUSTL(name_suffix))
+        pt_file%has_name_suffix = .TRUE.
+    ENDIF
+
+    IF (PRESENT(description)) THEN
+        pt_file%description=TRIM(ADJUSTL(description))
+        pt_file%has_description = .TRUE.
+    ENDIF
+ 
+    IF (PRESENT(output_freq)) then
+        pt_file%output_freq=output_freq
+        pt_file%has_output_freq = .TRUE.
+    ENDIF
+
+    IF (PRESENT(output_level)) then
+        pt_file%output_level = output_level
+        pt_file%has_output_level = .TRUE.
+    ENDIF
+
+    IF (PRESENT(enabled)) then
+        pt_file%enabled = enabled
+        pt_file%has_enabled = .TRUE.
+    ENDIF
+    
+  END SUBROUTINE file__set
+
+  SUBROUTINE file__set_attribut_id(id,attrib,ok)
+  USE mod_attribut
+  USE error_msg
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)   :: id
+    TYPE(attribut),INTENT(IN)     :: attrib
+    LOGICAL,OPTIONAL,INTENT(OUT)  :: ok
+    
+    TYPE(file),POINTER              :: Pt_file
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_file=>file_ids%at(Pos)%Pt
+      CALL file__set_attribut_pt(Pt_file,attrib)
+      IF (PRESENT(OK)) OK=.TRUE.
+    ELSE
+      IF (.NOT.PRESENT(OK)) THEN
+        WRITE(message,*) 'File id : ',id,' is undefined'
+        CALL error('mod_file::file__set_attribut')
+      ELSE
+        OK=.FALSE.
+      ENDIF
+    ENDIF  
+  
+  END SUBROUTINE file__set_attribut_id
+      
+  SUBROUTINE file__set_attribut_pt(Pt_file,attrib)
+  USE mod_attribut
+  USE mod_file_attribut
+  USE error_msg
+  IMPLICIT NONE
+    TYPE(file),POINTER        :: Pt_file
+    TYPE(attribut),INTENT(IN) :: attrib
+
+    
+    SELECT CASE(attrib%name)
+      CASE (file__name)
+        IF (attrib%type==string0) CALL  file__set(pt_file,name=attrib%string0_ptr(1:attrib%string_len)) ; RETURN
+      CASE (file__name_suffix)
+        IF (attrib%type==string0) CALL  file__set(pt_file,name_suffix=attrib%string0_ptr(1:attrib%string_len)) ; RETURN
+      CASE (file__description)
+        IF (attrib%type==string0) CALL  file__set(pt_file,description=attrib%string0_ptr(1:attrib%string_len)) ; RETURN
+      CASE (file__output_freq)
+        IF (attrib%type==integer0) CALL  file__set(pt_file,output_freq=attrib%integer0_ptr) ; RETURN
+      CASE (file__output_level)
+        IF (attrib%type==integer0) CALL  file__set(pt_file,output_level=attrib%integer0_ptr) ; RETURN
+      CASE (file__enabled)
+        IF (attrib%type==logical0) CALL  file__set(pt_file,enabled=attrib%logical0_ptr) ; RETURN
+     END SELECT
+
+     WRITE(message,*) 'file attribut ',attrib%name,' : type : ',attrib%type,       &
+                      ' : Attribute type is incompatible with the provided value'
+     CALL error('mod_file::file__set_attribut')
+    
+  END SUBROUTINE file__set_attribut_pt
+  
+     
+  SUBROUTINE file__get_field_list(pt_file,pt_field_list)
+  IMPLICIT NONE
+    TYPE(file),POINTER         :: pt_file
+    TYPE(field_group),POINTER  :: pt_field_list
+    
+      pt_field_list=>pt_file%field_list
+  
+  END SUBROUTINE file__get_field_list
+    
+  SUBROUTINE file__print(pt_file)
+  IMPLICIT NONE
+    TYPE(file), POINTER         :: pt_file
+
+    PRINT *,"---- FILE ----"
+    IF (pt_file%has_id) THEN
+      PRINT *,"id = ",TRIM(pt_file%id)
+    ELSE
+      PRINT *,"id undefined"
+    ENDIF
+    
+    IF (pt_file%has_name) THEN
+      PRINT *,"name = ",TRIM(pt_file%name)
+    ELSE
+      PRINT *,"name undefined"
+    ENDIF
+
+    IF (pt_file%has_name_suffix) THEN
+      PRINT *,"name_suffix = ",TRIM(pt_file%name_suffix)
+    ELSE
+      PRINT *,"name_suffix undefined"
+    ENDIF
+    
+    IF (pt_file%has_description) THEN
+      PRINT *,"description = ",TRIM(pt_file%description)
+    ELSE
+      PRINT *,"description undefined"
+    ENDIF
+ 
+    IF (pt_file%has_output_freq) THEN
+      PRINT *,"output_freq = ",pt_file%output_freq
+    ELSE
+      PRINT *,"output_freq undefined"
+    ENDIF
+
+    IF (pt_file%has_output_level) THEN
+      PRINT *,"output_level = ",pt_file%output_level
+    ELSE
+      PRINT *,"output_level undefined"
+    ENDIF
+
+    IF (pt_file%has_enabled) THEN
+      PRINT *,"enabled = ",pt_file%enabled
+    ELSE
+      PRINT *,"enabled undefined"
+    ENDIF
+
+    PRINT *,"field_list :"
+    CALL field_group__print(pt_file%field_list)
+
+    PRINT *,"--------------"
+
+  END SUBROUTINE file__print
+
+
+  SUBROUTINE file__apply_default(pt_file_default, pt_file_in, pt_file_out)
+
+    TYPE(file), POINTER :: pt_file_default, pt_file_in, pt_file_out
+
+    IF (pt_file_in%has_name) THEN
+        pt_file_out%name=pt_file_in%name
+        pt_file_out%has_name=.TRUE.
+    ELSE IF ( pt_file_default%has_name) THEN
+        pt_file_out%name=pt_file_default%name
+        pt_file_out%has_name=.TRUE.
+    ELSE
+        pt_file_out%has_name=.FALSE.
+    ENDIF
+
+    IF (pt_file_in%has_name_suffix) THEN
+        pt_file_out%name_suffix=pt_file_in%name_suffix
+        pt_file_out%has_name_suffix=.TRUE.
+    ELSE IF ( pt_file_default%has_name_suffix) THEN
+        pt_file_out%name_suffix=pt_file_default%name_suffix
+        pt_file_out%has_name_suffix=.TRUE.
+    ELSE
+        pt_file_out%has_name_suffix=.FALSE.
+    ENDIF
+        
+    IF (pt_file_in%has_description) THEN
+        pt_file_out%description=pt_file_in%description
+        pt_file_out%has_description=.TRUE.
+    ELSE IF ( pt_file_default%has_description ) THEN
+        pt_file_out%description=pt_file_default%description
+        pt_file_out%has_description=.TRUE.
+    ELSE
+        pt_file_out%has_description=.FALSE.
+    ENDIF
+
+    IF (pt_file_in%has_output_freq) THEN
+        pt_file_out%output_freq=pt_file_in%output_freq
+        pt_file_out%has_output_freq=.TRUE.
+    ELSE IF ( pt_file_default%has_output_freq ) THEN
+        pt_file_out%output_freq=pt_file_default%output_freq
+        pt_file_out%has_output_freq=.TRUE.
+    ELSE
+        pt_file_out%has_output_freq=.FALSE.
+    ENDIF
+
+    IF (pt_file_in%has_output_level) THEN
+        pt_file_out%output_level=pt_file_in%output_level
+        pt_file_out%has_output_level=.TRUE.
+    ELSE IF ( pt_file_default%has_output_level ) THEN
+        pt_file_out%output_level=pt_file_default%output_level
+        pt_file_out%has_output_level=.TRUE.
+    ELSE
+        pt_file_out%has_output_level=.FALSE.
+    ENDIF
+
+    IF (pt_file_in%has_enabled) THEN
+        pt_file_out%enabled=pt_file_in%enabled
+        pt_file_out%has_enabled=.TRUE.
+    ELSE IF ( pt_file_default%has_enabled ) THEN
+        pt_file_out%enabled=pt_file_default%enabled
+        pt_file_out%has_enabled=.TRUE.
+    ELSE
+        pt_file_out%has_enabled=.FALSE.
+    ENDIF
+    
+    CALL field_group__apply_default(pt_file_out%field_list)
+
+
+  END SUBROUTINE file__apply_default
+
+   
+  SUBROUTINE file__solve_field_ref(pt_file)
+  IMPLICIT NONE
+    TYPE(file), POINTER :: pt_file
+    
+    CALL field_group__solve_ref(pt_file%field_list)
+  
+  END SUBROUTINE file__solve_field_ref
+  
+  
+  SUBROUTINE file__Check(pt_file)
+  USE error_msg
+  IMPLICIT NONE
+    TYPE(file), POINTER :: pt_file
+      
+    IF (.NOT. pt_file%has_name) THEN
+      IF (pt_file%has_id) THEN
+        pt_file%name=TRIM(pt_file%id)
+      ELSE
+        WRITE(message,*) "File has no name and no id" 
+        CALL error("mod_file::file__check")
+      ENDIF 
+    ENDIF
+ 
+ END SUBROUTINE file__Check
+    
+END MODULE mod_file
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_file_attribut.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_file_attribut.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_file_attribut.f90	(revision 2528)
@@ -0,0 +1,16 @@
+MODULE mod_file_attribut
+  USE mod_object
+  
+  INTEGER,PARAMETER :: file__begin = file_object + 10
+    
+  INTEGER,PARAMETER :: file__name = file_object + 11
+  INTEGER,PARAMETER :: file__description = file_object + 12
+  INTEGER,PARAMETER :: file__output_freq = file_object + 13
+  INTEGER,PARAMETER :: file__output_level = file_object + 14
+  INTEGER,PARAMETER :: file__enabled = file_object + 15
+  INTEGER,PARAMETER :: file__name_suffix = file_object + 16
+
+  INTEGER,PARAMETER :: file__end = file_object + 17
+
+END MODULE mod_file_attribut
+  
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_file_definition.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_file_definition.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_file_definition.f90	(revision 2528)
@@ -0,0 +1,24 @@
+MODULE mod_file_definition
+  USE mod_file_group
+  
+  TYPE(file_group),SAVE,POINTER :: file_definition
+  
+CONTAINS
+
+  SUBROUTINE file_definition__swap_context(saved_file_definition)
+  IMPLICIT NONE
+    TYPE(file_group),POINTER      :: saved_file_definition
+     
+    file_definition=>saved_file_definition
+ 
+  END SUBROUTINE file_definition__swap_context
+
+  SUBROUTINE file_definition__Init
+  USE mod_file_group
+  IMPLICIT NONE
+  
+    CALL file_group__new(file_definition,"file_definition")
+    
+  END SUBROUTINE file_definition__Init
+        
+END MODULE mod_file_definition
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_file_group.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_file_group.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_file_group.f90	(revision 2528)
@@ -0,0 +1,259 @@
+MODULE mod_file_group
+  USE mod_file
+  USE mod_xmlio_parameters
+
+  IMPLICIT NONE
+
+  TYPE file_group
+    CHARACTER(LEN=str_len)                    :: id
+    LOGICAL                                   :: has_id
+    TYPE(vector_file_group), POINTER          :: groups
+    TYPE(vector_file),POINTER                 :: files     
+    TYPE(file), POINTER                       :: default_attribut
+  END TYPE file_group
+
+  INCLUDE "vector_file_group_def.inc"  
+
+  TYPE(vector_file_group),POINTER,SAVE       :: file_group_Ids
+  TYPE(sorted_list),POINTER,PRIVATE,SAVE     :: Ids 
+
+  INTERFACE file_group__set_attribut
+    MODULE PROCEDURE file_group__set_attribut_id,file_group__set_attribut_pt
+  END INTERFACE
+
+CONTAINS
+
+  INCLUDE "vector_file_group_contains.inc"
+
+  SUBROUTINE file_group__swap_context(saved_file_group_ids,saved_ids)
+  IMPLICIT NONE
+    TYPE(vector_file_group),POINTER      :: saved_file_group_Ids
+    TYPE(sorted_list),POINTER            :: saved_Ids
+    
+    file_group_ids=>saved_file_group_ids
+    ids=>saved_ids 
+ 
+  END SUBROUTINE file_group__swap_context
+
+  SUBROUTINE file_group__init
+  IMPLICIT NONE
+    
+    CALL vector_file_group__new(file_group_Ids)
+    CALL sorted_list__new(Ids)
+   
+  END SUBROUTINE file_group__init
+
+  SUBROUTINE file_group__get(Id,Pt_fg)
+  USE string_function
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)     :: Id
+    TYPE(file_group),POINTER        :: Pt_fg
+
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_fg=>file_group_ids%at(Pos)%Pt
+    ELSE
+      Pt_fg=>NULL()
+    ENDIF
+    
+  END SUBROUTINE file_group__get
+
+  SUBROUTINE file_group__set_attribut_id(id,attrib,Ok)
+  USE mod_attribut
+  USE error_msg
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: id
+    TYPE(attribut),INTENT(IN) :: attrib
+    LOGICAL,OPTIONAL,INTENT(out)  :: Ok
+    
+    TYPE(file_group),POINTER             :: Pt_fg
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_fg=>file_group_ids%at(Pos)%Pt
+      CALL file_group__set_attribut(Pt_fg,attrib)
+      IF (PRESENT(OK)) ok=.TRUE.
+    ELSE
+      IF (.NOT.PRESENT(OK)) THEN
+        WRITE(message,*) 'file group id :',id,' is undefined'
+        CALL error('mod_file_group::file_group__set_attribut')
+      ELSE
+        OK=.FALSE.
+      ENDIF
+    ENDIF 
+    
+  END SUBROUTINE file_group__set_attribut_id
+  
+  SUBROUTINE file_group__set_attribut_pt(pt_fg,attrib)
+  USE mod_attribut
+  USE mod_object
+  IMPLICIT NONE
+    TYPE(file_group),POINTER :: Pt_fg
+    TYPE(attribut),INTENT(IN) :: attrib
+     
+    IF (attrib%object==file_object) THEN
+      CALL file__set_attribut(Pt_fg%default_attribut,attrib)
+    ENDIF
+    
+  END SUBROUTINE file_group__set_attribut_pt
+  
+      
+  RECURSIVE SUBROUTINE file_group__new(Pt_fg,Id)
+  USE string_function
+  IMPLICIT NONE
+    TYPE(file_group),POINTER                :: Pt_fg
+    CHARACTER(LEN=*),OPTIONAL,INTENT(IN)     :: Id
+    
+    INTEGER :: Pos
+    
+    ALLOCATE(Pt_fg%groups)
+    ALLOCATE(Pt_fg%files)
+    ALLOCATE(Pt_fg%default_attribut)
+    
+    CALL vector_file_group__new(Pt_fg%groups)
+    CALL vector_file__new(Pt_fg%files)
+    CALL file__new(Pt_fg%default_attribut)
+    Pt_fg%has_id=.FALSE.
+      
+    IF (PRESENT(Id)) THEN
+      Pt_fg%id=TRIM(Id)
+      Pt_fg%has_id=.TRUE.
+      CALL vector_file_group__set_new(file_group_Ids,Pt_fg,Pos)
+      CALL sorted_list__Add(Ids,hash(id),Pos)
+    ENDIF
+
+  END SUBROUTINE file_group__new
+
+      
+  SUBROUTINE file_group__get_new_group(Pt_fg,Pt_fg_out,Id)
+  IMPLICIT NONE
+    TYPE(file_group),POINTER             :: Pt_fg
+    TYPE(file_group),POINTER             :: Pt_fg_out
+    CHARACTER(LEN=*),OPTIONAL      :: Id
+    
+    CALL vector_file_group__get_new(Pt_fg%groups,Pt_fg_out)
+    CALL file_group__new(Pt_fg_out)
+
+    IF (PRESENT(id)) THEN
+      CALL file_group__new(Pt_fg_out,Id)
+    ELSE
+      CALL file_group__new(Pt_fg_out)
+    ENDIF
+    
+  END SUBROUTINE file_group__get_new_group
+
+  
+  SUBROUTINE file_group__get_new_file(Pt_fg,Pt_f_out,Id)
+  IMPLICIT NONE
+    TYPE(file_group),POINTER            :: Pt_fg
+    TYPE(file),POINTER                  :: Pt_f_out
+    CHARACTER(LEN=*),OPTIONAL      :: Id
+    
+    CALL vector_file__get_new(Pt_fg%files,Pt_f_out)
+    
+    IF (PRESENT(id)) THEN
+      CALL file__new(Pt_f_out,Id)
+    ELSE
+      CALL file__new(Pt_f_out)
+    ENDIF
+    
+  END SUBROUTINE file_group__get_new_file
+  
+  
+  SUBROUTINE file_group__get_default_attrib(Pt_fg,Pt_f)
+  IMPLICIT NONE
+    TYPE(file_group),POINTER  :: Pt_fg
+    TYPE(file),POINTER        :: Pt_f
+    
+    Pt_f=>Pt_fg%default_attribut
+  END SUBROUTINE file_group__get_default_attrib
+  
+  RECURSIVE SUBROUTINE file_group__apply_default(Pt_fg,default)
+  IMPLICIT NONE
+    TYPE(file_group),POINTER  :: Pt_fg
+    TYPE(file),POINTER,OPTIONAL        :: default
+    
+    INTEGER :: i
+    
+    IF (PRESENT(default)) THEN
+      CALL file__apply_default(default,Pt_fg%default_attribut,Pt_fg%default_attribut)
+    ENDIF
+      
+    DO i=1,Pt_fg%groups%size
+      CALL file_group__apply_default(Pt_fg%groups%at(i)%pt,Pt_fg%default_attribut)
+    ENDDO
+    
+    DO i=1,Pt_fg%files%size
+      CALL file__apply_default(Pt_fg%default_attribut,Pt_fg%files%at(i)%pt,Pt_fg%files%at(i)%pt)
+    ENDDO
+  
+  END SUBROUTINE file_group__apply_default
+
+  RECURSIVE SUBROUTINE file_group__solve_field_ref(pt_fg)
+  IMPLICIT NONE
+    TYPE(file_group),POINTER  :: Pt_fg
+
+    INTEGER :: i
+
+    DO i=1,Pt_fg%groups%size
+      CALL file_group__solve_field_ref(Pt_fg%groups%at(i)%pt)
+    ENDDO
+    
+    DO i=1,Pt_fg%files%size
+      CALL file__solve_field_ref(Pt_fg%files%at(i)%pt)
+    ENDDO
+  
+  END SUBROUTINE file_group__solve_field_ref
+  
+  
+  RECURSIVE SUBROUTINE file_group__print(Pt_fg)
+  IMPLICIT NONE
+    TYPE(file_group),POINTER  :: Pt_fg
+   
+    INTEGER :: i
+    
+    PRINT *,"--- FILE GROUP ---"
+    IF (Pt_fg%has_id) THEN
+      PRINT *,"id :",TRIM(Pt_fg%id)
+    ELSE
+      PRINT *,"id undefined"
+    ENDIF
+    
+    PRINT *,"file default attribut :"
+    CALL file__print(Pt_fg%default_attribut)    
+
+    PRINT *,"owned file groups :"      
+    DO i=1,Pt_fg%groups%size
+      CALL file_group__print(Pt_fg%groups%at(i)%pt)
+    ENDDO
+
+    PRINT *,"owned file :"      
+    DO i=1,Pt_fg%files%size
+      CALL file__print(Pt_fg%files%at(i)%pt)
+    ENDDO
+  
+  END SUBROUTINE file_group__print     
+
+  RECURSIVE SUBROUTINE file_group__Check(Pt_fg)
+  IMPLICIT NONE
+  
+    TYPE(file_group),POINTER  :: Pt_fg
+    INTEGER :: i
+   
+    DO i=1,Pt_fg%groups%size
+      CALL file_group__check(pt_fg%groups%at(i)%pt)
+    ENDDO
+
+    DO i=1,Pt_fg%files%size
+      CALL file__check(pt_fg%files%at(i)%pt)
+    ENDDO
+  
+  END SUBROUTINE file_group__check     
+          
+END MODULE mod_file_group
+
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_grid.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_grid.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_grid.f90	(revision 2528)
@@ -0,0 +1,384 @@
+MODULE mod_grid
+  USE mod_xmlio_parameters
+  USE mod_sorted_list
+  USE mod_domain
+  USE mod_zoom
+
+  IMPLICIT NONE
+
+  TYPE, PUBLIC :: grid
+    CHARACTER(len=str_len)      :: id
+    LOGICAL                     :: has_id
+    CHARACTER(len=str_len)      :: name
+    LOGICAL                     :: has_name
+    CHARACTER(len=str_len)      :: description
+    LOGICAL                     :: has_description
+    TYPE(domain),POINTER        :: domain
+    TYPE(vector_domain),POINTER :: subdomain
+    TYPE(sorted_list),POINTER   :: rank_ids
+    INTEGER,POINTER             :: ranks(:)
+    INTEGER                     :: ni
+    INTEGER                     :: nj
+    LOGICAL                     :: has_dimension
+    TYPE(vector_zoom),POINTER   :: associated_zoom
+    TYPE(zoom),POINTER          :: global_zoom
+  END TYPE grid
+
+  INCLUDE 'vector_grid_def.inc'
+  
+  TYPE(vector_grid),POINTER,SAVE             :: grid_Ids
+  TYPE(sorted_list),POINTER,SAVE,PRIVATE     :: Ids 
+
+  INTERFACE grid__set_attribut
+    MODULE PROCEDURE grid__set_attribut_id,grid__set_attribut_pt
+  END INTERFACE
+
+CONTAINS
+  INCLUDE 'vector_grid_contains.inc'
+
+  SUBROUTINE grid__swap_context(saved_grid_Ids,saved_Ids)
+  IMPLICIT NONE
+    TYPE(vector_grid),POINTER          :: saved_grid_Ids
+    TYPE(sorted_list),POINTER          :: saved_Ids 
+    
+    grid_ids=>saved_grid_ids
+    ids=>saved_ids
+  END SUBROUTINE grid__swap_context
+  
+  
+  SUBROUTINE grid__init
+  IMPLICIT NONE
+    
+    CALL vector_grid__new(grid_Ids)
+    CALL sorted_list__new(Ids)
+   
+  END SUBROUTINE grid__init
+  
+  SUBROUTINE grid__get(Id,Pt_grid)
+  USE string_function
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)     :: Id
+    TYPE(grid),POINTER              :: Pt_grid
+
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_grid=>grid_ids%at(Pos)%Pt
+    ELSE
+      Pt_grid=>NULL()
+    ENDIF
+    
+  END SUBROUTINE grid__get
+  
+  SUBROUTINE grid__new(pt_grid,Id)
+  USE string_function
+  IMPLICIT NONE
+   TYPE(grid), POINTER           :: pt_grid
+   CHARACTER(LEN=*),OPTIONAL     :: Id
+   INTEGER                       :: Pos
+   
+   ALLOCATE(pt_grid%domain)
+   ALLOCATE(pt_grid%subdomain)
+   ALLOCATE(pt_grid%rank_ids)
+   ALLOCATE(pt_grid%associated_zoom)
+   
+   CALL domain__new(pt_grid%domain)
+   CALL vector_domain__new(pt_grid%subdomain)
+   CALL sorted_list__new(pt_grid%rank_ids)
+   CALL vector_zoom__new(pt_grid%associated_zoom)
+   
+   pt_grid%has_id          = .FALSE.
+   pt_grid%has_name        = .FALSE.
+   pt_grid%has_description = .FALSE.
+   pt_grid%has_dimension   = .FALSE.
+   
+   IF (PRESENT(Id)) THEN
+     Pt_grid%id=TRIM(ADJUSTL(Id))
+     Pt_grid%has_id=.TRUE.
+     CALL vector_grid__set_new(grid_Ids,Pt_grid,Pos)
+     CALL sorted_list__Add(Ids,hash(id),Pos)
+   ENDIF
+   
+   CALL grid__get_new_zoom(pt_grid,pt_grid%global_zoom,id)
+
+ END SUBROUTINE grid__new
+
+  SUBROUTINE grid__set(pt_grid, name, description)
+  IMPLICIT NONE
+    TYPE(grid), POINTER :: pt_grid
+    CHARACTER(len=*)  ,OPTIONAL :: name
+    CHARACTER(len=*)  ,OPTIONAL :: description
+
+    IF (PRESENT(name)) THEN
+        pt_grid%name=TRIM(ADJUSTL(name))
+        pt_grid%has_name = .TRUE.
+    ENDIF
+
+    IF (PRESENT(description)) THEN
+        pt_grid%description=TRIM(ADJUSTL(description))
+        pt_grid%has_description = .TRUE.
+    ENDIF
+
+  END SUBROUTINE grid__set
+
+
+  SUBROUTINE grid__set_attribut_id(id,attrib,ok)
+  USE mod_attribut
+  USE error_msg
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)   :: id
+    TYPE(attribut),INTENT(IN)     :: attrib
+    LOGICAL,OPTIONAL,INTENT(OUT)  :: ok
+    
+    TYPE(grid),POINTER              :: Pt_grid
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_grid=>grid_ids%at(Pos)%Pt
+      CALL grid__set_attribut_pt(Pt_grid,attrib)
+      IF (PRESENT(OK)) OK=.TRUE.
+    ELSE
+      IF (.NOT.PRESENT(OK)) THEN
+        WRITE(message,*) 'grid id :',id,'is undefined'
+        CALL error('mod_grid::grid__set_attribut')
+      ELSE
+        OK=.FALSE.
+      ENDIF
+    ENDIF  
+  
+  END SUBROUTINE grid__set_attribut_id
+      
+  SUBROUTINE grid__set_attribut_pt(Pt_grid,attrib)
+  USE mod_attribut
+  USE mod_grid_attribut
+  USE error_msg
+  IMPLICIT NONE
+    TYPE(grid),POINTER        :: Pt_grid
+    TYPE(attribut),INTENT(IN) :: attrib
+    
+    SELECT CASE(attrib%name)
+      CASE (grid__name)
+        IF (attrib%type==string0) CALL  grid__set(pt_grid,name=attrib%string0_ptr) ; RETURN
+      CASE (grid__description)
+        IF (attrib%type==string0) CALL  grid__set(pt_grid,description=attrib%string0_ptr) ; RETURN
+     END SELECT
+
+     WRITE(message,*) 'grid attribut ',attrib%name,' : type :',attrib%type,      &
+                      ' : Attribute type is incompatible with the provided value'
+     CALL error('mod_grid::grid__set_attribut')
+    
+  END SUBROUTINE grid__set_attribut_pt
+  
+  SUBROUTINE grid__set_dimension(pt_grid, ni, nj)
+  IMPLICIT NONE
+    TYPE(grid), POINTER   :: pt_grid
+    INTEGER,INTENT(IN)    :: ni
+    INTEGER,INTENT(IN)    :: nj
+    
+    pt_grid%ni=ni
+    pt_grid%nj=nj
+    pt_grid%has_dimension=.TRUE.
+    
+  END SUBROUTINE grid__set_dimension
+    
+
+  SUBROUTINE grid__get_new_subdomain(Pt_grid,rank,pt_domain)
+  IMPLICIT NONE
+    TYPE(grid), POINTER   :: pt_grid
+    INTEGER,INTENT(IN)    :: rank
+    TYPE(domain), POINTER :: Pt_domain
+    
+    INTEGER :: Pos
+    
+    CALL vector_domain__get_new(pt_grid%subdomain,pt_domain,Pos)
+    CALL sorted_list__add(pt_grid%rank_ids,rank,Pos)
+    CALL domain__new(pt_domain)
+    
+  END SUBROUTINE grid__get_new_subdomain    
+
+  SUBROUTINE grid__get_subdomain(Pt_grid,rank,pt_domain)
+  IMPLICIT NONE
+    TYPE(grid), POINTER     :: pt_grid
+    INTEGER,INTENT(IN)      :: rank
+    TYPE(domain), POINTER   :: Pt_domain
+
+    INTEGER    :: rank_id
+    LOGICAL    :: success
+
+    CALL sorted_list__find(pt_grid%rank_ids,rank,rank_id,success)
+    IF (success) THEN
+      pt_domain=>pt_grid%subdomain%at(rank_id)%pt
+    ELSE
+      !! message d'erreur 
+   ENDIF
+
+  END SUBROUTINE grid__get_subdomain
+   
+  SUBROUTINE grid__process_domain(Pt_grid)
+  IMPLICIT NONE
+    TYPE(grid), POINTER  :: pt_grid
+    TYPE(domain),POINTER :: subdomain
+    TYPE(zoom),POINTER :: pt_zoom
+    
+    REAL,ALLOCATABLE :: lon(:,:)
+    REAL,ALLOCATABLE :: lat(:,:)
+    INTEGER :: ib,ie,jb,je,ni,nj,ibegin,jbegin,iend,jend
+    INTEGER :: i
+    
+      ALLOCATE(pt_grid%ranks(1:pt_grid%subdomain%size))
+
+      DO i=1,pt_grid%subdomain%size
+        subdomain=>pt_grid%subdomain%at(i)%pt
+        IF (i==1) THEN
+          ib=subdomain%ibegin
+          ie=subdomain%iend   
+          jb=subdomain%jbegin
+          je=subdomain%jend
+        ELSE
+          IF (subdomain%ibegin<ib) ib=subdomain%ibegin
+          IF (subdomain%iend>ie) ie=subdomain%iend
+          IF (subdomain%jbegin<jb) jb=subdomain%jbegin
+          IF (subdomain%jend>je) je=subdomain%jend
+        ENDIF
+        pt_grid%ranks(subdomain%rank)=i
+      ENDDO
+      
+      ni=ie-ib+1
+      nj=je-jb+1
+      ibegin=ib
+      jbegin=jb
+      
+      ALLOCATE(lon(ni,nj))
+      ALLOCATE(lat(ni,nj))
+      
+      DO i=1,pt_grid%subdomain%size
+        subdomain=>pt_grid%subdomain%at(i)%pt
+        ib=subdomain%ibegin-ibegin+1
+        ie=subdomain%iend-ibegin+1   
+        jb=subdomain%jbegin-jbegin+1
+        je=subdomain%jend-jbegin+1
+        lon(ib:ie,jb:je)=subdomain%lon(:,:)
+        lat(ib:ie,jb:je)=subdomain%lat(:,:)
+      ENDDO
+      
+      CALL domain__set(pt_grid%domain,0,ni,nj,ibegin,jbegin,lon,lat)
+      iend=ibegin+ni-1
+      jend=jbegin+nj-1
+      
+      
+      pt_grid%global_zoom%ni_glo=pt_grid%ni
+      pt_grid%global_zoom%nj_glo=pt_grid%nj
+      pt_grid%global_zoom%ibegin_glo=1      
+      pt_grid%global_zoom%jbegin_glo=1
+      
+      DO i=1,pt_grid%associated_zoom%size
+        pt_zoom=>pt_grid%associated_zoom%at(i)%pt
+        
+        ib=MAX(pt_zoom%ibegin_glo-ibegin+1,1)
+        ie=MIN(pt_zoom%ibegin_glo+pt_zoom%ni_glo-ibegin,ni)
+        pt_zoom%ni_loc=MAX(ie-ib+1,0)
+        pt_zoom%ibegin_loc=ib
+
+        jb=MAX(pt_zoom%jbegin_glo-jbegin+1,1)
+        je=MIN(pt_zoom%jbegin_glo+pt_zoom%nj_glo-jbegin,nj)
+        pt_zoom%nj_loc=MAX(je-jb+1,0)
+        pt_zoom%jbegin_loc=jb
+      ENDDO
+                 
+            
+      DEALLOCATE(lon)
+      DEALLOCATE(lat)
+      
+    END SUBROUTINE grid__process_domain
+      
+            
+  SUBROUTINE grid__get_new_zoom(pt_grid,pt_zoom,zoom_id)
+  USE string_function
+  IMPLICIT NONE
+    TYPE(grid), POINTER                      :: pt_grid
+    TYPE(zoom),POINTER                       :: pt_zoom
+    CHARACTER(LEN=*),INTENT(IN),OPTIONAL     :: zoom_id
+    LOGICAL                                  :: success
+    
+     CALL vector_zoom__get_new(pt_grid%associated_zoom,Pt_zoom)
+     CALL zoom__new(Pt_zoom,zoom_id)
+    
+   END SUBROUTINE grid__get_new_zoom
+     
+  SUBROUTINE grid__print(pt_grid)
+  IMPLICIT NONE
+    TYPE(grid), POINTER  :: pt_grid
+    INTEGER              :: i
+    
+    PRINT *,"---- GRID ----"
+    
+    IF (pt_grid%has_id) THEN
+      PRINT *,"id = ",TRIM(pt_grid%id)
+    ELSE
+      PRINT *,"id undefined"
+    ENDIF
+    
+    IF (pt_grid%has_name) THEN
+      PRINT *,"name = ",TRIM(pt_grid%name)
+    ELSE
+      PRINT *,"name undefined"
+    ENDIF
+    
+    IF (pt_grid%has_description) THEN
+      PRINT *,"description = ",TRIM(pt_grid%description)
+    ELSE
+      PRINT *,"description undefined"
+    ENDIF
+    
+    IF (pt_grid%has_dimension) THEN
+      PRINT *,"Global grid dimension :"
+      PRINT *,"   ni =",pt_grid%ni
+      PRINT *,"   nj =",pt_grid%nj
+    ELSE
+      PRINT *,"Global dimension ni, nj undefined"
+    ENDIF
+    
+    PRINT *,"grid domain :"
+    CALL domain__print(pt_grid%domain)
+    
+    PRINT *,"grid subdomain :",pt_grid%subdomain%size
+    
+    DO i=1,pt_grid%subdomain%size
+      CALL domain__print(pt_grid%subdomain%at(i)%pt)
+    ENDDO
+    
+    PRINT *,"--------------"
+    
+  END SUBROUTINE grid__print
+
+  SUBROUTINE grid__apply_default(pt_grid_default, pt_grid_in, pt_grid_out)
+
+    TYPE(grid), POINTER :: pt_grid_default, pt_grid_in, pt_grid_out
+
+    IF (pt_grid_in%has_name) THEN
+        pt_grid_out%name=pt_grid_in%name
+        pt_grid_out%has_name=.TRUE.
+    ELSE IF ( pt_grid_default%has_name) THEN
+        pt_grid_out%name=pt_grid_default%name
+        pt_grid_out%has_name=.TRUE.
+    ELSE
+        pt_grid_out%has_name=.FALSE.
+    ENDIF
+        
+    IF (pt_grid_in%has_description) THEN
+        pt_grid_out%description=pt_grid_in%description
+        pt_grid_out%has_description=.TRUE.
+    ELSE IF ( pt_grid_default%has_description ) THEN
+        pt_grid_out%description=pt_grid_default%description
+        pt_grid_out%has_description=.TRUE.
+    ELSE
+        pt_grid_out%has_description=.FALSE.
+    ENDIF
+  
+  END SUBROUTINE grid__apply_default
+
+END MODULE mod_grid
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_grid_attribut.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_grid_attribut.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_grid_attribut.f90	(revision 2528)
@@ -0,0 +1,13 @@
+MODULE mod_grid_attribut
+  USE mod_object
+  
+  INTEGER,PARAMETER :: grid__begin = grid_object + 10
+
+  INTEGER,PARAMETER :: grid__name = grid_object + 11
+  INTEGER,PARAMETER :: grid__description = grid_object + 12
+
+  INTEGER,PARAMETER :: grid__end = grid_object + 13
+
+  
+END MODULE mod_grid_attribut
+  
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_grid_definition.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_grid_definition.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_grid_definition.f90	(revision 2528)
@@ -0,0 +1,24 @@
+MODULE mod_grid_definition
+  USE mod_grid_group
+  
+  TYPE(grid_group),SAVE,POINTER :: grid_definition
+  
+CONTAINS
+
+  SUBROUTINE grid_definition__swap_context(saved_grid_definition)      
+  IMPLICIT NONE
+    TYPE(grid_group),POINTER :: saved_grid_definition
+    
+    grid_definition=>saved_grid_definition
+    
+  END SUBROUTINE grid_definition__swap_context 
+
+  SUBROUTINE grid_definition__Init
+  USE mod_grid_group
+  IMPLICIT NONE
+  
+    CALL grid_group__new(grid_definition,"grid_definition")
+    
+  END SUBROUTINE grid_definition__Init
+ 
+END MODULE mod_grid_definition
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_grid_group.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_grid_group.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_grid_group.f90	(revision 2528)
@@ -0,0 +1,244 @@
+MODULE mod_grid_group
+  USE mod_grid
+  USE mod_xmlio_parameters
+
+  IMPLICIT NONE
+
+  TYPE grid_group
+    CHARACTER(LEN=str_len)                    :: id
+    LOGICAL                                   :: has_id
+    TYPE(vector_grid_group), POINTER          :: groups
+    TYPE(vector_grid),POINTER                 :: grids     
+    TYPE(grid), POINTER                       :: default_attribut
+  END TYPE grid_group
+
+  INCLUDE "vector_grid_group_def.inc"  
+
+  TYPE(vector_grid_group),POINTER,SAVE       :: grid_group_Ids
+  TYPE(sorted_list),POINTER,SAVE,PRIVATE     :: Ids 
+
+  INTERFACE grid_group__set_attribut
+    MODULE PROCEDURE grid_group__set_attribut_id,grid_group__set_attribut_pt
+  END INTERFACE
+
+CONTAINS
+
+  INCLUDE "vector_grid_group_contains.inc"
+
+  SUBROUTINE grid_group__swap_context(saved_grid_group_Ids,saved_ids)
+  IMPLICIT NONE
+  TYPE(vector_grid_group),POINTER       :: saved_grid_group_Ids
+  TYPE(sorted_list),POINTER             :: saved_Ids 
+   
+   grid_group_ids=>saved_grid_group_ids
+   ids=>saved_ids
+   
+  END SUBROUTINE grid_group__swap_context
+   
+  SUBROUTINE grid_group__init
+  IMPLICIT NONE
+    
+    CALL vector_grid_group__new(grid_group_Ids)
+    CALL sorted_list__new(Ids)
+   
+  END SUBROUTINE grid_group__init
+
+  SUBROUTINE grid_group__get(Id,Pt_gg)
+  USE string_function
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)     :: Id
+    TYPE(grid_group),POINTER        :: Pt_gg
+
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_gg=>grid_group_ids%at(Pos)%Pt
+    ELSE
+      Pt_gg=>NULL()
+    ENDIF
+    
+  END SUBROUTINE grid_group__get
+
+
+  SUBROUTINE grid_group__set_attribut_id(id,attrib,Ok)
+  USE mod_attribut
+  USE error_msg
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: id
+    TYPE(attribut),INTENT(IN) :: attrib
+    LOGICAL,OPTIONAL,INTENT(out)  :: Ok
+    
+    TYPE(grid_group),POINTER             :: Pt_gg
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_gg=>grid_group_ids%at(Pos)%Pt
+      CALL grid_group__set_attribut(Pt_gg,attrib)
+      IF (PRESENT(OK)) ok=.TRUE.
+    ELSE
+      IF (.NOT.PRESENT(OK)) THEN
+        WRITE(message,*) 'grid group id :',id,'is undefined'
+        CALL error('mod_grid_group::grid_group__set_attribut')
+      ELSE
+        OK=.FALSE.
+      ENDIF
+    ENDIF 
+    
+  END SUBROUTINE grid_group__set_attribut_id
+  
+  SUBROUTINE grid_group__set_attribut_pt(pt_gg,attrib)
+  USE mod_attribut
+  USE mod_object
+  IMPLICIT NONE
+    TYPE(grid_group),POINTER :: Pt_gg
+    TYPE(attribut),INTENT(IN) :: attrib
+     
+    IF (attrib%object==grid_object) THEN
+      CALL grid__set_attribut(pt_gg%default_attribut,attrib)
+    ENDIF
+    
+  END SUBROUTINE grid_group__set_attribut_pt    
+
+
+
+  RECURSIVE SUBROUTINE grid_group__new(Pt_gg,Id)
+  USE string_function
+  IMPLICIT NONE
+    TYPE(grid_group),POINTER                :: Pt_gg
+    CHARACTER(LEN=*),OPTIONAL,INTENT(IN)     :: Id
+    
+    INTEGER :: Pos
+    
+    ALLOCATE(Pt_gg%groups)
+    ALLOCATE(Pt_gg%grids)
+    ALLOCATE(Pt_gg%default_attribut)
+    
+    CALL vector_grid_group__new(Pt_gg%groups)
+    CALL vector_grid__new(Pt_gg%grids)
+    CALL grid__new(Pt_gg%default_attribut)
+    Pt_gg%has_id=.FALSE.
+      
+    IF (PRESENT(Id)) THEN
+      Pt_gg%id=TRIM(Id)
+      Pt_gg%has_id=.TRUE.
+      CALL vector_grid_group__set_new(grid_group_Ids,Pt_gg,Pos)
+      CALL sorted_list__Add(Ids,hash(id),Pos)
+    ENDIF
+
+  END SUBROUTINE grid_group__new
+
+      
+  SUBROUTINE grid_group__get_new_group(Pt_gg,Pt_gg_out,Id)
+  IMPLICIT NONE
+    TYPE(grid_group),POINTER             :: Pt_gg
+    TYPE(grid_group),POINTER             :: Pt_gg_out
+    CHARACTER(LEN=*),OPTIONAL            :: Id
+    
+    CALL vector_grid_group__get_new(Pt_gg%groups,Pt_gg_out)
+    CALL grid_group__new(Pt_gg_out)
+
+    IF (PRESENT(id)) THEN
+      CALL grid_group__new(Pt_gg_out,Id)
+    ELSE
+      CALL grid_group__new(Pt_gg_out)
+    ENDIF
+    
+  END SUBROUTINE grid_group__get_new_group
+
+  
+  SUBROUTINE grid_group__get_new_grid(Pt_gg,Pt_g_out,Id)
+  IMPLICIT NONE
+    TYPE(grid_group),POINTER            :: Pt_gg
+    TYPE(grid),POINTER                  :: Pt_g_out
+    CHARACTER(LEN=*),OPTIONAL      :: Id
+    
+    CALL vector_grid__get_new(Pt_gg%grids,Pt_g_out)
+    
+    IF (PRESENT(id)) THEN
+      CALL grid__new(Pt_g_out,Id)
+    ELSE
+      CALL grid__new(Pt_g_out)
+    ENDIF
+    
+  END SUBROUTINE grid_group__get_new_grid
+  
+  
+  SUBROUTINE grid_group__get_default_attrib(Pt_gg,Pt_g)
+  IMPLICIT NONE
+    TYPE(grid_group),POINTER  :: Pt_gg
+    TYPE(grid),POINTER        :: Pt_g
+    
+    Pt_g=>Pt_gg%default_attribut
+  END SUBROUTINE grid_group__get_default_attrib
+  
+  RECURSIVE SUBROUTINE grid_group__apply_default(Pt_gg,default)
+  IMPLICIT NONE
+    TYPE(grid_group),POINTER      :: Pt_gg
+    TYPE(grid),POINTER,OPTIONAL   :: default
+    
+    INTEGER :: i
+    
+    IF (PRESENT(default)) THEN
+      CALL grid__apply_default(default,Pt_gg%default_attribut,Pt_gg%default_attribut)
+    ENDIF
+      
+    DO i=1,Pt_gg%groups%size
+      CALL grid_group__apply_default(Pt_gg%groups%at(i)%pt,Pt_gg%default_attribut)
+    ENDDO
+    
+    DO i=1,Pt_gg%grids%size
+      CALL grid__apply_default(Pt_gg%default_attribut,Pt_gg%grids%at(i)%pt,Pt_gg%grids%at(i)%pt)
+    ENDDO
+  
+  END SUBROUTINE grid_group__apply_default
+
+  RECURSIVE SUBROUTINE grid_group__Process_domain(Pt_gg)
+  IMPLICIT NONE
+  TYPE(grid_group),POINTER  :: Pt_gg
+    INTEGER :: i
+    
+    DO i=1,pt_gg%groups%size
+      CALL grid_group__process_domain(pt_gg%groups%at(i)%pt)
+    ENDDO
+    
+    DO i=1,pt_gg%grids%size
+      CALL grid__process_domain(pt_gg%grids%at(i)%pt)
+    ENDDO
+    
+  END SUBROUTINE grid_group__Process_domain
+      
+
+  RECURSIVE SUBROUTINE grid_group__print(Pt_gg)
+  IMPLICIT NONE
+    TYPE(grid_group),POINTER  :: Pt_gg
+   
+    INTEGER :: i
+    
+    PRINT *,"--- GRID GROUP ---"
+    IF (pt_gg%has_id) THEN
+      PRINT *,"id  ",TRIM(pt_gg%id)
+    ELSE
+      PRINT *,"id undefined"
+    ENDIF
+    
+    PRINT *,"grid default attribut :"
+    CALL grid__print(Pt_gg%default_attribut)    
+
+    PRINT *,"owned grid groups : ",Pt_gg%groups%size      
+    DO i=1,Pt_gg%groups%size
+      CALL grid_group__print(Pt_gg%groups%at(i)%pt)
+    ENDDO
+
+    PRINT *,"owned grid : ",Pt_gg%grids%size     
+    DO i=1,Pt_gg%grids%size
+      CALL grid__print(Pt_gg%grids%at(i)%pt)
+    ENDDO
+    PRINT *,"------------"
+  
+  END SUBROUTINE grid_group__print
+     
+END MODULE mod_grid_group
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_object.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_object.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_object.f90	(revision 2528)
@@ -0,0 +1,14 @@
+MODULE mod_object
+
+  INTEGER,PARAMETER :: field_object=100
+  INTEGER,PARAMETER :: field_group_object=200
+  INTEGER,PARAMETER :: file_object=300
+  INTEGER,PARAMETER :: file_group_object=400
+  INTEGER,PARAMETER :: axis_object=500
+  INTEGER,PARAMETER :: axis_group_object=600
+  INTEGER,PARAMETER :: grid_object=700
+  INTEGER,PARAMETER :: grid_group_object=800
+  INTEGER,PARAMETER :: zoom_object=900
+  INTEGER,PARAMETER :: zoom_group_object=1000
+  
+END MODULE mod_object
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_parse_xml.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_parse_xml.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_parse_xml.f90	(revision 2528)
@@ -0,0 +1,810 @@
+MODULE parsing_xml
+  USE flib_dom
+  USE error_msg
+  USE string_function
+  
+CONTAINS
+
+  SUBROUTINE parsing_xml_file(name)
+  IMPLICIT NONE
+    CHARACTER(len=*), INTENT(IN) :: name
+    TYPE(fnode), POINTER :: myDoc
+
+    myDoc => parsefile(name)
+    CALL parsing_root(myDoc)
+
+    PRINT *, 'Le parsing est termine !!! '
+  
+  END SUBROUTINE parsing_xml_file
+  
+ 
+  SUBROUTINE parsing_root(root)
+  IMPLICIT NONE
+    TYPE(fnode), POINTER :: root
+    TYPE(fnode), POINTER :: child_node
+    TYPE(fnodeList), POINTER :: child_list
+
+    INTEGER :: il
+    CHARACTER(len=100) :: node_name
+     
+    IF (hasChildNodes(root)) THEN
+      child_list => getChildnodes(root)
+
+      DO il=0,getLength(child_list)-1
+        child_node => item(child_list,il)
+        node_name=getNodename(child_node)
+          
+        SELECT CASE (TRIM(node_name)) 
+          
+           CASE ('simulation') 
+             CALL parsing_simulation(child_node)
+
+           CASE DEFAULT
+             IF (is_bad_node(node_name)) THEN
+               WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing root'
+               CALL Warning("mod_parse_xml:parsing_root")
+             ENDIF
+        END SELECT
+      ENDDO
+    ENDIF
+             
+  END SUBROUTINE parsing_root
+
+  SUBROUTINE parsing_simulation(root)
+  IMPLICIT NONE
+    TYPE(fnode), POINTER :: root
+    TYPE(fnode), POINTER :: child_node
+    TYPE(fnodeList), POINTER :: child_list
+
+    INTEGER :: il
+    CHARACTER(len=100) :: node_name
+     
+     IF (hasChildNodes(root)) THEN
+      child_list => getChildnodes(root)
+
+      DO il=0,getLength(child_list)-1
+        child_node => item(child_list,il)
+        node_name=getNodename(child_node)
+          
+        SELECT CASE (TRIM(node_name)) 
+          
+           CASE ('context') 
+             CALL parsing_context(child_node)
+
+           CASE DEFAULT
+             IF (is_bad_node(node_name)) THEN
+               WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing simulation'
+               CALL Warning("mod_parse_xml:parsing_simulationt")
+             ENDIF
+         END SELECT
+       
+       ENDDO
+    ENDIF
+             
+  END SUBROUTINE parsing_simulation
+
+  SUBROUTINE parsing_context(node)
+  USE mod_context
+  USE mod_axis_definition
+  USE mod_grid_definition
+  USE mod_field_definition
+  USE mod_file_definition
+  IMPLICIT NONE  
+    TYPE(fnode), POINTER         :: node
+    
+    TYPE(fnode), POINTER     :: child_node
+    TYPE(fnodeList), POINTER :: child_list
+    TYPE(axis),POINTER       :: attribute
+    LOGICAL                  :: is_root
+    INTEGER :: il
+    CHARACTER(len=100) :: node_name
+    CHARACTER(len=100) :: value
+    
+    IF (is_attribute_exist(node,"id")) THEN
+      value=getAttribute(node,"id")
+      CALL context__create(TRIM(value))  
+      CALL context__swap(TRIM(value))
+    ENDIF
+    
+    IF (hasChildNodes(node)) THEN
+      child_list => getChildnodes(node)
+
+      DO il=0,getLength(child_list)-1
+        child_node => item(child_list,il)
+        node_name=getNodename(child_node)
+        
+        SELECT CASE (TRIM(node_name)) 
+          
+           CASE ('axis_definition') 
+             CALL parsing_axis_group(child_node,axis_definition,root=.TRUE.)
+               
+           CASE ('grid_definition')
+             CALL parsing_grid_group(child_node,grid_definition,root=.TRUE.)
+               
+           CASE ('field_definition')
+             CALL parsing_field_group(child_node,field_definition,root=.TRUE.)
+               
+           CASE ('file_definition')
+             CALL parsing_file_group(child_node,file_definition,root=.TRUE.)
+               
+           CASE DEFAULT
+             IF (is_bad_node(node_name)) THEN
+               WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing context'
+               CALL Warning("mod_parse_xml:parsing_context")
+             ENDIF   
+        END SELECT
+      ENDDO
+
+    ENDIF
+
+  END SUBROUTINE parsing_context
+
+
+  RECURSIVE SUBROUTINE parsing_axis_group(node,parent,root)
+  USE mod_axis_definition
+  USE mod_axis_group
+  USE mod_axis
+  IMPLICIT NONE  
+    TYPE(fnode), POINTER         :: node
+    TYPE(axis_group),POINTER     :: parent
+    LOGICAL,INTENT(IN),OPTIONAL :: root
+    
+    TYPE(axis_group),POINTER :: pt_axis_group
+    TYPE(fnode), POINTER     :: child_node
+    TYPE(fnodeList), POINTER :: child_list
+    TYPE(axis),POINTER       :: attribute
+    LOGICAL                  :: is_root
+    INTEGER :: il
+    CHARACTER(len=100) :: node_name
+    CHARACTER(len=100) :: value
+    
+    is_root=.FALSE.
+    IF (PRESENT(root)) is_root=root
+  
+    IF (is_root) THEN
+      pt_axis_group=>parent
+    ELSE  
+      IF (is_attribute_exist(node,"id")) THEN
+        value=getAttribute(node,"id")
+        CALL axis_group__get_new_group(parent,pt_axis_group,TRIM(value))
+      ELSE
+        CALL axis_group__get_new_group(parent,pt_axis_group)
+      ENDIF
+    ENDIF
+      
+    CALL axis_group__get_default_attrib(pt_axis_group,attribute)
+    CALL parsing_axis_attribute(node,attribute)
+    
+    IF (hasChildNodes(node)) THEN
+      child_list => getChildnodes(node)
+
+      DO il=0,getLength(child_list)-1
+        child_node => item(child_list,il)
+        node_name=getNodename(child_node)
+        
+        SELECT CASE (TRIM(node_name)) 
+        
+          CASE ('group') 
+            CALL parsing_axis_group(child_node,pt_axis_group)
+             
+          CASE ('axis')
+            CALL parsing_axis(child_node,pt_axis_group)
+
+          CASE DEFAULT
+            IF (is_bad_node(node_name)) THEN
+              WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing group_axis'
+              CALL Warning("mod_parse_xml:parsing_group_axis")
+            ENDIF
+        END SELECT
+      ENDDO
+    ENDIF
+
+  END SUBROUTINE parsing_axis_group
+
+  SUBROUTINE parsing_axis(node,parent)
+  USE mod_axis_group
+  USE mod_axis
+  IMPLICIT NONE  
+    TYPE(fnode), POINTER     :: node
+    TYPE(axis_group),POINTER :: parent
+    
+    TYPE(axis),POINTER :: pt_axis
+    TYPE(axis),POINTER       :: attribute
+    INTEGER :: il
+    CHARACTER(len=100) :: node_name
+    CHARACTER(len=100) :: value
+  
+      
+    IF (is_attribute_exist(node,"id")) THEN
+      value=getAttribute(node,"id")
+      CALL axis_group__get_new_axis(parent,pt_axis,TRIM(value))
+    ELSE
+      CALL axis_group__get_new_axis(parent,pt_axis)
+    ENDIF
+      
+    CALL parsing_axis_attribute(node,pt_axis)
+  
+  END SUBROUTINE parsing_axis
+
+  
+  SUBROUTINE parsing_axis_attribute(node,pt_axis)
+  USE mod_axis
+  IMPLICIT NONE
+    TYPE(fnode), POINTER     :: node
+    TYPE(axis),POINTER :: pt_axis
+
+    CHARACTER(len=100) :: value
+   
+    IF (is_attribute_exist(node,"name")) THEN
+      value =  getAttribute(node,"name")
+      CALL axis__set(pt_axis,name=TRIM(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"description")) THEN
+      value =  getAttribute(node,"description")
+      CALL axis__set(pt_axis,description=TRIM(value))
+    ENDIF
+        
+    IF (is_attribute_exist(node,"unit")) THEN
+      value =  getAttribute(node,"unit")
+      CALL axis__set(pt_axis,unit=TRIM(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"size")) THEN
+      value =  getAttribute(node,"size")
+      CALL axis__set(pt_axis,a_size=string_to_integer(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"positive")) THEN
+      value =  getAttribute(node,"positive")
+      CALL axis__set(pt_axis,positive=string_to_logical(value))
+    ENDIF
+   
+  END SUBROUTINE parsing_axis_attribute 
+
+
+
+
+
+
+
+
+  RECURSIVE SUBROUTINE parsing_grid_group(node,parent,root)
+  USE mod_grid_definition
+  USE mod_grid_group
+  USE mod_grid
+  IMPLICIT NONE  
+    TYPE(fnode), POINTER     :: node
+    TYPE(grid_group),POINTER :: parent
+    LOGICAL,INTENT(IN),OPTIONAL :: root
+
+    TYPE(grid_group),POINTER :: pt_grid_group
+    TYPE(fnode), POINTER     :: child_node
+    TYPE(fnodeList), POINTER :: child_list
+    TYPE(grid),POINTER       :: attribute
+    LOGICAL                  :: is_root
+    INTEGER :: il
+    CHARACTER(len=100) :: node_name
+    CHARACTER(len=100) :: value
+  
+    is_root=.FALSE.
+    IF (PRESENT(root)) is_root=root
+  
+    IF (is_root) THEN
+      pt_grid_group=>parent
+    ELSE  
+      IF (is_attribute_exist(node,"id")) THEN
+        value=getAttribute(node,"id")
+        CALL grid_group__get_new_group(parent,pt_grid_group,TRIM(value))
+      ELSE
+        CALL grid_group__get_new_group(parent,pt_grid_group)
+      ENDIF
+    ENDIF
+      
+    CALL grid_group__get_default_attrib(pt_grid_group,attribute)
+    CALL parsing_grid_attribute(node,attribute)
+    
+    IF (hasChildNodes(node)) THEN
+      child_list => getChildnodes(node)
+
+      DO il=0,getLength(child_list)-1
+        child_node => item(child_list,il)
+        node_name=getNodename(child_node)
+        
+        SELECT CASE (TRIM(node_name)) 
+        
+          CASE ('group') 
+            CALL parsing_grid_group(child_node,pt_grid_group)
+             
+          CASE ('grid')
+            CALL parsing_grid(child_node,pt_grid_group)
+
+          CASE DEFAULT
+            IF (is_bad_node(node_name)) THEN
+              WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing group_grid'
+              CALL Warning("mod_parse_xml:parsing_group_grid")
+            ENDIF
+        END SELECT
+      ENDDO
+    ENDIF
+
+  END SUBROUTINE parsing_grid_group
+
+  SUBROUTINE parsing_grid(node,parent)
+  USE mod_grid_group
+  USE mod_grid
+  IMPLICIT NONE  
+    TYPE(fnode), POINTER     :: node
+    TYPE(grid_group),POINTER :: parent
+    
+    TYPE(grid),POINTER       :: pt_grid
+    TYPE(fnode), POINTER     :: child_node
+    TYPE(fnodeList), POINTER :: child_list
+    INTEGER :: il
+    CHARACTER(len=100) :: node_name
+    CHARACTER(len=100) :: value
+  
+      
+    IF (is_attribute_exist(node,"id")) THEN
+      value=getAttribute(node,"id")
+      CALL grid_group__get_new_grid(parent,pt_grid,TRIM(value))
+    ELSE
+      CALL grid_group__get_new_grid(parent,pt_grid)
+    ENDIF
+      
+    CALL parsing_grid_attribute(node,pt_grid)
+    
+
+   IF (hasChildNodes(node)) THEN
+      child_list => getChildnodes(node)
+
+      DO il=0,getLength(child_list)-1
+        child_node => item(child_list,il)
+        node_name=getNodename(child_node)
+        
+        SELECT CASE (TRIM(node_name)) 
+        
+          CASE ('zoom') 
+            CALL parsing_zoom(child_node,pt_grid)
+             
+          CASE DEFAULT
+            IF (is_bad_node(node_name)) THEN
+              WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing grid'
+              CALL Warning("mod_parse_xml:parsing_grid")
+            ENDIF
+        END SELECT
+      ENDDO
+    ENDIF
+  
+  END SUBROUTINE parsing_grid
+
+  SUBROUTINE parsing_grid_attribute(node,pt_grid)
+  USE mod_grid
+  IMPLICIT NONE
+    TYPE(fnode), POINTER     :: node
+    TYPE(grid),POINTER :: pt_grid
+
+    CHARACTER(len=100) :: value
+   
+    IF (is_attribute_exist(node,"name")) THEN
+      value =  getAttribute(node,"name")
+      CALL grid__set(pt_grid,name=TRIM(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"description")) THEN
+      value =  getAttribute(node,"description")
+      CALL grid__set(pt_grid,description=TRIM(value))
+    ENDIF
+        
+  END SUBROUTINE parsing_grid_attribute 
+
+  SUBROUTINE parsing_zoom(node,parent)
+  USE mod_zoom
+  USE mod_grid 
+  IMPLICIT NONE  
+    TYPE(fnode), POINTER     :: node
+    TYPE(grid),POINTER       :: parent
+    
+    TYPE(zoom),POINTER       :: pt_zoom
+    INTEGER :: il
+    CHARACTER(len=100) :: node_name
+    CHARACTER(len=100) :: value
+  
+      
+    IF (is_attribute_exist(node,"id")) THEN
+      value=getAttribute(node,"id")
+      CALL grid__get_new_zoom(parent,pt_zoom,TRIM(value))
+    ELSE
+      CALL grid__get_new_zoom(parent,pt_zoom)
+    ENDIF
+      
+    CALL parsing_zoom_attribute(node,pt_zoom)
+    
+  END SUBROUTINE parsing_zoom
+
+
+  SUBROUTINE parsing_zoom_attribute(node,pt_zoom)
+  USE mod_zoom
+  IMPLICIT NONE
+    TYPE(fnode), POINTER     :: node
+    TYPE(zoom),POINTER       :: pt_zoom
+
+    CHARACTER(len=100) :: value
+   
+    IF (is_attribute_exist(node,"name")) THEN
+      value =  getAttribute(node,"name")
+      CALL zoom__set(pt_zoom,name=TRIM(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"description")) THEN
+      value =  getAttribute(node,"description")
+      CALL zoom__set(pt_zoom,description=TRIM(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"ni")) THEN
+      value =  getAttribute(node,"ni")
+      CALL zoom__set(pt_zoom,ni_glo=string_to_integer(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"nj")) THEN
+      value =  getAttribute(node,"nj")
+      CALL zoom__set(pt_zoom,nj_glo=string_to_integer(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"ibegin")) THEN
+      value =  getAttribute(node,"ibegin")
+      CALL zoom__set(pt_zoom,ibegin_glo=string_to_integer(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"jbegin")) THEN
+      value =  getAttribute(node,"jbegin")
+      CALL zoom__set(pt_zoom,jbegin_glo=string_to_integer(value))
+    ENDIF
+        
+  END SUBROUTINE parsing_zoom_attribute 
+
+
+
+  RECURSIVE SUBROUTINE parsing_field_group(node,parent,root)
+  USE mod_field_definition
+  USE mod_field_group
+  USE mod_field
+  IMPLICIT NONE  
+    TYPE(fnode), POINTER          :: node
+    TYPE(field_group),POINTER     :: parent
+    LOGICAL,INTENT(IN),OPTIONAL   :: root
+    
+    TYPE(field_group),POINTER :: pt_field_group
+    TYPE(fnode), POINTER     :: child_node
+    TYPE(fnodeList), POINTER :: child_list
+    TYPE(field),POINTER       :: attribute
+    INTEGER :: il
+    CHARACTER(len=100) :: node_name
+    CHARACTER(len=100) :: value
+    LOGICAL            :: is_root
+    
+    is_root=.FALSE.
+    IF (PRESENT(root)) is_root=root
+    
+    IF (is_root) THEN
+      pt_field_group=>parent
+    ELSE  
+      IF (is_attribute_exist(node,"id")) THEN
+        value=getAttribute(node,"id")
+        CALL field_group__get_new_group(parent,pt_field_group,TRIM(value))
+      ELSE
+        CALL field_group__get_new_group(parent,pt_field_group)
+      ENDIF
+    ENDIF
+      
+    CALL field_group__get_default_attrib(pt_field_group,attribute)
+    CALL parsing_field_attribute(node,attribute)
+    
+    IF (hasChildNodes(node)) THEN
+      child_list => getChildnodes(node)
+
+      DO il=0,getLength(child_list)-1
+        child_node => item(child_list,il)
+        node_name=getNodename(child_node)
+        
+        SELECT CASE (TRIM(node_name)) 
+        
+          CASE ('group') 
+            CALL parsing_field_group(child_node,pt_field_group)
+             
+          CASE ('field')
+            CALL parsing_field(child_node,pt_field_group)
+
+          CASE DEFAULT
+            IF (is_bad_node(node_name)) THEN
+              WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing group_field'
+              CALL Warning("mod_parse_xml:parsing_group_field")
+            ENDIF
+        END SELECT
+      ENDDO
+    ENDIF
+
+  END SUBROUTINE parsing_field_group
+
+  SUBROUTINE parsing_field(node,parent)
+  USE mod_field_group
+  USE mod_field
+  IMPLICIT NONE  
+    TYPE(fnode), POINTER     :: node
+    TYPE(field_group),POINTER :: parent
+    
+    TYPE(field),POINTER :: pt_field
+    TYPE(field),POINTER       :: attribute
+    INTEGER :: il
+    CHARACTER(len=100) :: node_name
+    CHARACTER(len=100) :: value
+  
+      
+    IF (is_attribute_exist(node,"id")) THEN
+      value=getAttribute(node,"id")
+      CALL field_group__get_new_field(parent,pt_field,TRIM(value))
+    ELSE
+      CALL field_group__get_new_field(parent,pt_field)
+    ENDIF
+      
+    CALL parsing_field_attribute(node,pt_field)
+  
+  END SUBROUTINE parsing_field
+
+  
+  SUBROUTINE parsing_field_attribute(node,pt_field)
+  USE mod_field
+  IMPLICIT NONE
+    TYPE(fnode), POINTER     :: node
+    TYPE(field),POINTER :: pt_field
+
+    CHARACTER(len=100) :: value
+   
+    IF (is_attribute_exist(node,"name")) THEN
+      value =  getAttribute(node,"name")
+      CALL field__set(pt_field,name=TRIM(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"description")) THEN
+      value =  getAttribute(node,"description")
+      CALL field__set(pt_field,description=TRIM(value))
+    ENDIF
+        
+    IF (is_attribute_exist(node,"unit")) THEN
+      value =  getAttribute(node,"unit")
+      CALL field__set(pt_field,unit=TRIM(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"operation")) THEN
+      value =  getAttribute(node,"operation")
+      CALL field__set(pt_field,operation=TRIM(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"freq_op")) THEN
+      value =  getAttribute(node,"freq_op")
+      CALL field__set(pt_field,freq_op=string_to_integer(value))
+    ENDIF
+   
+    IF (is_attribute_exist(node,"axis_ref")) THEN
+      value =  getAttribute(node,"axis_ref")
+      CALL field__set(pt_field,axis_ref=TRIM(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"grid_ref")) THEN
+      value =  getAttribute(node,"grid_ref")
+      CALL field__set(pt_field,grid_ref=TRIM(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"zoom_ref")) THEN
+      value =  getAttribute(node,"zoom_ref")
+      CALL field__set(pt_field,zoom_ref=TRIM(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"level")) THEN
+      value =  getAttribute(node,"level")
+      CALL field__set(pt_field,level=string_to_integer(value))
+    ENDIF
+    
+    IF (is_attribute_exist(node,"prec")) THEN
+      value =  getAttribute(node,"prec")
+      CALL field__set(pt_field,prec=string_to_integer(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"ref")) THEN
+      value =  getAttribute(node,"ref")
+      CALL field__set(pt_field,ref=TRIM(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"enabled")) THEN
+      value =  getAttribute(node,"enabled")
+      CALL field__set(pt_field,enabled=string_to_logical(value))
+    ENDIF
+  
+
+  END SUBROUTINE parsing_field_attribute 
+
+
+  RECURSIVE SUBROUTINE parsing_file_group(node,parent,root)
+  USE mod_file_definition
+  USE mod_file_group
+  USE mod_file
+  IMPLICIT NONE  
+    TYPE(fnode), POINTER          :: node
+    TYPE(file_group),POINTER      :: parent
+    LOGICAL,INTENT(IN),OPTIONAL   :: root
+
+    TYPE(file_group),POINTER :: pt_file_group
+    TYPE(fnode), POINTER     :: child_node
+    TYPE(fnodeList), POINTER :: child_list
+    TYPE(file),POINTER       :: attribute
+    LOGICAL                  :: is_root
+    INTEGER :: il
+    CHARACTER(len=100) :: node_name
+    CHARACTER(len=100) :: value
+    
+    is_root=.FALSE.
+    IF (PRESENT(root)) is_root=root
+  
+    IF (is_root) THEN
+      pt_file_group=>parent
+    ELSE  
+      IF (is_attribute_exist(node,"id")) THEN
+        value=getAttribute(node,"id")
+        CALL file_group__get_new_group(parent,pt_file_group,TRIM(value))
+      ELSE
+        CALL file_group__get_new_group(parent,pt_file_group)
+      ENDIF
+    ENDIF
+      
+    CALL file_group__get_default_attrib(pt_file_group,attribute)
+    CALL parsing_file_attribute(node,attribute)
+    
+    IF (hasChildNodes(node)) THEN
+      child_list => getChildnodes(node)
+
+      DO il=0,getLength(child_list)-1
+        child_node => item(child_list,il)
+        node_name=getNodename(child_node)
+        
+        SELECT CASE (TRIM(node_name)) 
+        
+          CASE ('group') 
+            CALL parsing_file_group(child_node,pt_file_group)
+             
+          CASE ('file')
+            CALL parsing_file(child_node,pt_file_group)
+
+          CASE DEFAULT
+            IF (is_bad_node(node_name)) THEN
+              WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing group_file'
+              CALL Warning("mod_parse_xml:parsing_group_file")
+            ENDIF
+        END SELECT
+      ENDDO
+    ENDIF
+
+  END SUBROUTINE parsing_file_group
+
+  SUBROUTINE parsing_file(node,parent)
+  USE mod_file_group
+  USE mod_file
+  IMPLICIT NONE  
+    TYPE(fnode), POINTER     :: node
+    TYPE(file_group),POINTER :: parent
+    
+    TYPE(file),POINTER :: pt_file
+    TYPE(file),POINTER       :: attribute
+    TYPE(fnode), POINTER     :: child_node
+    TYPE(fnodeList), POINTER :: child_list
+    INTEGER :: il
+    CHARACTER(len=100) :: node_name
+    CHARACTER(len=100) :: value
+  
+      
+    IF (is_attribute_exist(node,"id")) THEN
+      value=getAttribute(node,"id")
+      CALL file_group__get_new_file(parent,pt_file,TRIM(value))
+    ELSE
+      CALL file_group__get_new_file(parent,pt_file)
+    ENDIF
+      
+    CALL parsing_file_attribute(node,pt_file)
+  
+    IF (hasChildNodes(node)) THEN
+      child_list => getChildnodes(node)
+
+      DO il=0,getLength(child_list)-1
+        child_node => item(child_list,il)
+        node_name=getNodename(child_node)
+        
+        SELECT CASE (TRIM(node_name)) 
+        
+          CASE ('group') 
+            CALL parsing_field_group(child_node,pt_file%field_list)
+             
+          CASE ('field')
+            CALL parsing_field(child_node,pt_file%field_list)
+
+          CASE DEFAULT
+            IF (is_bad_node(node_name)) THEN
+              WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing group_file'
+              CALL Warning("mod_parse_xml:parsing_group_file")
+            ENDIF
+        END SELECT
+      ENDDO
+    ENDIF
+  END SUBROUTINE parsing_file
+
+  
+  SUBROUTINE parsing_file_attribute(node,pt_file)
+  USE mod_file
+  IMPLICIT NONE
+    TYPE(fnode), POINTER     :: node
+    TYPE(file),POINTER :: pt_file
+
+    CHARACTER(len=100) :: value
+   
+    IF (is_attribute_exist(node,"name")) THEN
+      value =  getAttribute(node,"name")
+      CALL file__set(pt_file,name=TRIM(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"name_suffix")) THEN
+      value =  getAttribute(node,"name_suffix")
+      CALL file__set(pt_file,name_suffix=TRIM(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"description")) THEN
+      value =  getAttribute(node,"description")
+      CALL file__set(pt_file,description=TRIM(value))
+    ENDIF
+        
+    IF (is_attribute_exist(node,"output_freq")) THEN
+      value =  getAttribute(node,"output_freq")
+      CALL file__set(pt_file,output_freq=string_to_integer(value))
+    ENDIF
+   
+    IF (is_attribute_exist(node,"output_level")) THEN
+      value =  getAttribute(node,"output_level")
+      CALL file__set(pt_file,output_level=string_to_integer(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"enabled")) THEN
+      value =  getAttribute(node,"enabled")
+      CALL file__set(pt_file,enabled=string_to_logical(value))
+    ENDIF
+
+  END SUBROUTINE parsing_file_attribute
+  
+
+   
+  
+  FUNCTION is_attribute_exist(node, name)
+
+    LOGICAL :: is_attribute_exist
+    TYPE(fnode), POINTER :: node
+    CHARACTER(len=*) :: name
+    CHARACTER(len=100) :: value
+
+    value=""
+    
+    is_attribute_exist= .false.
+    value=getAttribute(node, TRIM(name))
+    IF (value .NE. "") is_attribute_exist= .true.
+
+  END FUNCTION is_attribute_exist
+
+  FUNCTION is_bad_node(node_name)
+  IMPLICIT NONE
+    CHARACTER(len=*),INTENT(IN) :: node_name
+    LOGICAL                     :: is_bad_node
+    
+    IF (TRIM(node_name)=='#text' .OR. TRIM(node_name)=='#comment') THEN
+      is_bad_node=.FALSE.
+    ELSE
+      is_bad_node=.TRUE.
+    ENDIF
+      
+  END FUNCTION is_bad_node
+  
+END MODULE parsing_xml
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_sorted_list.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_sorted_list.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_sorted_list.f90	(revision 2528)
@@ -0,0 +1,167 @@
+MODULE mod_sorted_list
+
+  PRIVATE
+  
+  TYPE node
+   INTEGER :: key
+   INTEGER :: value
+   LOGICAL :: has_value
+   TYPE(node),POINTER :: child1
+   TYPE(node),POINTER :: child2
+  END TYPE node
+
+TYPE, PUBLIC :: sorted_list
+  PRIVATE
+  TYPE(vector_node),POINTER :: tree => NULL()
+  TYPE(node),POINTER        :: first => NULL()
+  INTEGER :: size = 0
+  LOGICAL :: is_init=.FALSE.
+END TYPE sorted_list 
+
+  PUBLIC :: sorted_list__new, sorted_list__add, sorted_list__find, sorted_list__delete 
+INCLUDE 'vector_node_def.inc'
+
+CONTAINS
+
+INCLUDE 'vector_node_contains.inc'
+  
+  SUBROUTINE node__new(Pt_n)
+  IMPLICIT NONE
+    TYPE(node), POINTER :: Pt_n
+    
+    Pt_n%has_value=.FALSE.
+    Pt_n%child1=>NULL()
+    pt_n%child2=>NULL()
+  END SUBROUTINE node__new
+  
+  
+  SUBROUTINE sorted_list__new(Pt_sl)
+  IMPLICIT NONE
+    TYPE(sorted_list), POINTER :: Pt_sl
+    TYPE(node), POINTER :: Pt_n
+    
+    IF (Pt_sl%is_init) CALL sorted_list__delete(Pt_sl)
+    
+    ALLOCATE(Pt_sl%tree)
+    CALL vector_node__new(Pt_sl%tree)
+    CALL vector_node__get_new(Pt_sl%tree,Pt_n)
+    CALL node__new(Pt_n)  
+    Pt_sl%first=>Pt_n
+    Pt_sl%Size=0
+    Pt_sl%is_init=.TRUE.
+    
+  END SUBROUTINE  sorted_list__new
+  
+  SUBROUTINE sorted_list__delete(Pt_sl)
+  IMPLICIT NONE
+    TYPE(sorted_list), POINTER :: Pt_sl
+    TYPE(node), POINTER :: Pt_n
+
+    IF (Pt_sl%is_init) THEN
+      CALL vector_node__delete(Pt_sl%tree)
+      DEALLOCATE(Pt_sl%tree)
+      Pt_sl%is_init=.FALSE.
+    ENDIF
+   
+  END SUBROUTINE  sorted_list__delete
+
+   
+  SUBROUTINE sorted_list__Add(Pt_sl,key,value)
+  IMPLICIT NONE
+    TYPE(sorted_list), POINTER :: Pt_sl
+    INTEGER,INTENT(IN)  :: key
+    INTEGER,INTENT(IN)  :: value
+
+    LOGICAL               :: Out
+    TYPE(node), POINTER   :: current
+    TYPE(node), POINTER   :: new 
+    
+    
+    CALL vector_node__get_new(Pt_sl%tree,new)
+    CALL node__new(new)
+    current=>Pt_sl%first
+    
+      
+    Out=.FALSE.
+    
+    DO WHILE (.NOT. out)
+      IF (current%has_value) THEN
+        IF (key > current%key) THEN
+          IF (ASSOCIATED(current%child2)) THEN
+            current=>current%child2
+          ELSE
+            current%child2=>new
+            out=.FALSE.
+          ENDIF
+        ELSE
+          IF (ASSOCIATED(current%child1)) THEN
+            current=>current%child1
+          ELSE
+            current%child1=>new
+            out=.FALSE.
+          ENDIF
+        ENDIF 
+      ELSE
+        current%has_value=.TRUE.
+        current%key=key
+        current%value=value
+        out=.TRUE.
+      ENDIF
+    ENDDO
+    
+    Pt_sl%Size=Pt_sl%Size+1
+       
+  END SUBROUTINE sorted_list__Add
+
+  
+  SUBROUTINE sorted_list__find(Pt_sl,key,value,success)
+  IMPLICIT NONE
+    TYPE(sorted_list),POINTER   :: Pt_sl
+    INTEGER,INTENT(IN)          :: key
+    INTEGER,INTENT(OUT)         :: value
+    LOGICAL,INTENT(OUT)         :: success
+    
+    LOGICAL               :: Out
+    TYPE(node), POINTER   :: current
+    
+    current=>Pt_sl%first
+    Out=.FALSE.
+    Success=.FALSE.
+    
+    DO WHILE (.NOT. out)
+      IF (current%has_value) THEN
+        IF (key == current%key) THEN
+          value=current%value
+          success=.TRUE.
+          out=.TRUE.
+        ELSE IF (key > current%key) THEN
+          IF (ASSOCIATED(current%child2)) THEN
+            current=>current%child2
+          ELSE
+            out=.TRUE.
+          ENDIF
+        ELSE
+          IF (ASSOCIATED(current%child1)) THEN
+            current=>current%child1
+          ELSE
+            out=.TRUE.
+          ENDIF
+        ENDIF
+      ELSE
+        out=.TRUE. 
+      ENDIF
+    ENDDO
+
+  END SUBROUTINE sorted_list__find
+
+  
+  SUBROUTINE sorted_list__get_first(Pt_sl,Pt_n)
+  IMPLICIT NONE
+    TYPE(sorted_list),POINTER   :: Pt_sl
+    TYPE(node),POINTER          :: Pt_n
+
+    Pt_n=>Pt_sl%tree%at(1)%Pt
+  END SUBROUTINE sorted_list__get_first  
+
+
+END MODULE mod_sorted_list
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_stdtype.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_stdtype.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_stdtype.f90	(revision 2528)
@@ -0,0 +1,48 @@
+MODULE mod_stdtype
+
+  INTEGER,PARAMETER :: integer0 = 0
+  INTEGER,PARAMETER :: integer1 = 1
+  INTEGER,PARAMETER :: integer2 = 2
+  INTEGER,PARAMETER :: integer3 = 3
+  INTEGER,PARAMETER :: integer4 = 4
+  INTEGER,PARAMETER :: integer5 = 5
+  INTEGER,PARAMETER :: integer6 = 6
+  INTEGER,PARAMETER :: integer7 = 7
+  
+  INTEGER,PARAMETER :: real0    = 8
+  INTEGER,PARAMETER :: real1    = 9
+  INTEGER,PARAMETER :: real2    = 10
+  INTEGER,PARAMETER :: real3    = 11
+  INTEGER,PARAMETER :: real4    = 12
+  INTEGER,PARAMETER :: real5    = 13
+  INTEGER,PARAMETER :: real6    = 14
+  INTEGER,PARAMETER :: real7    = 15
+
+  INTEGER,PARAMETER :: logical0 = 16
+  INTEGER,PARAMETER :: logical1 = 17
+  INTEGER,PARAMETER :: logical2 = 18
+  INTEGER,PARAMETER :: logical3 = 19
+  INTEGER,PARAMETER :: logical4 = 20
+  INTEGER,PARAMETER :: logical5 = 21
+  INTEGER,PARAMETER :: logical6 = 22
+  INTEGER,PARAMETER :: logical7 = 23
+  
+  INTEGER,PARAMETER :: string0  = 24
+  INTEGER,PARAMETER :: string1  = 25
+  INTEGER,PARAMETER :: string2  = 26
+  INTEGER,PARAMETER :: string3  = 27
+  INTEGER,PARAMETER :: string4  = 28
+  INTEGER,PARAMETER :: string5  = 29
+  INTEGER,PARAMETER :: string6  = 30
+  INTEGER,PARAMETER :: string7  = 31
+
+  INTEGER,PARAMETER :: char0   = 32
+  INTEGER,PARAMETER :: char1   = 33
+  INTEGER,PARAMETER :: char2   = 34
+  INTEGER,PARAMETER :: char3   = 35
+  INTEGER,PARAMETER :: char4   = 36
+  INTEGER,PARAMETER :: char5   = 37
+  INTEGER,PARAMETER :: char6   = 38
+  INTEGER,PARAMETER :: char7   = 39
+ 
+END MODULE mod_stdtype
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_time_parameters.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_time_parameters.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_time_parameters.f90	(revision 2528)
@@ -0,0 +1,26 @@
+MODULE mod_time_parameters
+
+  INTEGER,POINTER  :: initial_timestep
+  REAL,POINTER     :: initial_date
+  REAL,POINTER     :: timestep_value 
+  INTEGER,POINTER  :: timestep_number
+
+CONTAINS 
+
+  SUBROUTINE time_parameters__swap_context(saved_initial_timestep,saved_initial_date, &
+                                           saved_timestep_value,saved_timestep_number)
+  IMPLICIT NONE
+    INTEGER,POINTER  :: saved_initial_timestep
+    REAL,POINTER     :: saved_initial_date
+    REAL,POINTER     :: saved_timestep_value 
+    INTEGER,POINTER  :: saved_timestep_number
+   
+    initial_timestep => saved_initial_timestep
+    initial_date     => saved_initial_date
+    timestep_value   => saved_timestep_value 
+    timestep_number  => saved_timestep_number    
+    
+  END SUBROUTINE time_parameters__swap_context  
+    
+                                           
+END MODULE mod_time_parameters
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_vector_field.F90.old
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_vector_field.F90.old	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_vector_field.F90.old	(revision 2528)
@@ -0,0 +1,43 @@
+MODULE mod_field_vector
+  USE mod_field
+  
+  PRIVATE
+  
+   TYPE,PUBLIC :: field_vector
+     PRIVATE
+     TYPE(vector), POINTER :: list
+     TYPE(field),  POINTER :: default_attribut
+   END TYPE field_vector
+
+#define DATA_TYPE field
+#include "vectors_def.inc"
+
+  PUBLIC field_vector__new, field_vector__get_new
+
+CONTAINS
+
+#include "vectors_contains.inc"
+    
+  SUBROUTINE field_vector__new(Pt_vf)
+  IMPLICIT NONE
+    TYPE(field_vector),POINTER  :: Pt_vf
+    
+      CALL vector__new(Pt_vf%list)
+      CALL field__new(Pt_vf%default_attribut)
+  
+  END SUBROUTINE field_vector__new
+  
+
+  SUBROUTINE field_vector__get_new(Pt_vf,Pt_f_out,Id)
+  IMPLICIT NONE  
+    TYPE(field_vector),POINTER           :: Pt_vf
+    TYPE(field),POINTER                  :: Pt_f_out
+    CHARACTER(LEN=str_len),OPTIONAL      :: Id
+      
+      CALL vector__get_new(Pt_vf%list,Pt_f_out)
+      CALL field__new(Pt_f_out)
+   END SUBROUTINE field_vector__get_new
+   
+   
+END MODULE mod_field_vector
+  
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_xmlio_parameters.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_xmlio_parameters.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_xmlio_parameters.f90	(revision 2528)
@@ -0,0 +1,14 @@
+MODULE mod_xmlio_parameters
+
+  INTEGER, PARAMETER :: str_len=100
+  INTEGER, PARAMETER :: array_size_unit=2
+  INTEGER, PARAMETER :: default_vector_size=100
+  REAL, PARAMETER    :: default_vector_grow_factor=1.5
+  INTEGER, PARAMETER :: str_msg_len=1024
+  
+  INTEGER,PARAMETER  :: internal_file=10
+  INTEGER,PARAMETER  :: internal_field=10
+  INTEGER,PARAMETER  :: internal_axis=10
+  INTEGER,PARAMETER  :: internal_grid=10
+  
+END MODULE mod_xmlio_parameters
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_zoom.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_zoom.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_zoom.f90	(revision 2528)
@@ -0,0 +1,201 @@
+MODULE mod_zoom
+  USE mod_xmlio_parameters
+  USE mod_sorted_list
+
+  IMPLICIT NONE
+
+  TYPE,PUBLIC :: zoom
+    CHARACTER(len=str_len)      :: id
+    LOGICAL                     :: has_id
+    CHARACTER(len=str_len)      :: name
+    LOGICAL                     :: has_name
+    CHARACTER(len=str_len)      :: description
+    LOGICAL                     :: has_description
+    INTEGER                     :: ni_glo
+    LOGICAL                     :: has_ni_glo
+    INTEGER                     :: nj_glo
+    LOGICAL                     :: has_nj_glo
+    INTEGER                     :: ibegin_glo
+    LOGICAL                     :: has_ibegin_glo
+    INTEGER                     :: jbegin_glo
+    LOGICAL                     :: has_jbegin_glo
+    INTEGER                     :: ni_loc
+    INTEGER                     :: nj_loc
+    INTEGER                     :: ibegin_loc
+    INTEGER                     :: jbegin_loc
+  END TYPE zoom    
+
+  INCLUDE 'vector_zoom_def.inc'
+
+  TYPE(vector_zoom),POINTER,SAVE             :: zoom_Ids
+  TYPE(sorted_list),POINTER,SAVE,PRIVATE     :: Ids 
+
+  INTERFACE zoom__set_attribut
+    MODULE PROCEDURE zoom__set_attribut_id,zoom__set_attribut_pt
+  END INTERFACE
+  
+CONTAINS
+  
+  INCLUDE 'vector_zoom_contains.inc'
+
+  SUBROUTINE zoom__swap_context(saved_zoom_Ids,saved_Ids)
+  IMPLICIT NONE
+    TYPE(vector_zoom),POINTER          :: saved_zoom_Ids
+    TYPE(sorted_list),POINTER          :: saved_Ids 
+    
+    zoom_ids=>saved_zoom_ids
+    ids=>saved_ids
+  END SUBROUTINE zoom__swap_context
+
+
+  SUBROUTINE zoom__init
+  IMPLICIT NONE
+
+    CALL vector_zoom__new(zoom_Ids)
+    CALL sorted_list__new(Ids)
+    
+  END SUBROUTINE zoom__init
+  
+
+  SUBROUTINE zoom__new(pt_zoom,Id)
+  USE string_function
+  IMPLICIT NONE
+    TYPE(zoom),POINTER :: pt_zoom
+    CHARACTER(LEN=*),OPTIONAL     :: Id
+    INTEGER   :: Pos 
+      
+    pt_zoom%has_id=.FALSE.
+    pt_zoom%has_name=.FALSE.
+    pt_zoom%has_description=.FALSE.
+    pt_zoom%has_ni_glo=.FALSE.
+    pt_zoom%has_nj_glo=.FALSE.
+    pt_zoom%has_ibegin_glo=.FALSE.
+    pt_zoom%has_jbegin_glo=.FALSE.
+     
+    IF (PRESENT(Id)) THEN
+      Pt_zoom%id=TRIM(ADJUSTL(Id))
+      Pt_zoom%has_id=.TRUE.
+     CALL vector_zoom__set_new(zoom_Ids,Pt_zoom,Pos)
+     CALL sorted_list__Add(Ids,hash(id),Pos)
+    ENDIF
+   
+  END SUBROUTINE zoom__new
+   
+  SUBROUTINE zoom__set(pt_zoom,name,description,ni_glo,nj_glo,ibegin_glo,jbegin_glo)
+  IMPLICIT NONE
+    TYPE(zoom),POINTER                   :: pt_zoom
+    CHARACTER(len=*),OPTIONAL            :: name
+    CHARACTER(len=*),OPTIONAL            :: description
+    INTEGER,OPTIONAL                     :: ni_glo
+    INTEGER,OPTIONAL                     :: nj_glo
+    INTEGER,OPTIONAL                     :: ibegin_glo
+    INTEGER,OPTIONAL                     :: jbegin_glo
+    
+    IF (PRESENT(name)) THEN
+      pt_zoom%name=TRIM(ADJUSTL(name))
+      pt_zoom%has_name=.TRUE.
+    ENDIF
+    
+    IF (PRESENT(description)) THEN
+      pt_zoom%name=TRIM(ADJUSTL(description))
+      pt_zoom%has_description=.TRUE.
+    ENDIF
+    
+    IF (PRESENT(ni_glo)) THEN
+      pt_zoom%ni_glo=ni_glo
+      pt_zoom%has_ni_glo=.TRUE.
+    ENDIF
+
+    IF (PRESENT(nj_glo)) THEN
+      pt_zoom%nj_glo=nj_glo
+      pt_zoom%has_nj_glo=.TRUE.
+    ENDIF
+
+    IF (PRESENT(ibegin_glo)) THEN
+      pt_zoom%ibegin_glo=ibegin_glo
+      pt_zoom%has_ibegin_glo=.TRUE.
+    ENDIF
+    
+    IF (PRESENT(jbegin_glo)) THEN
+      pt_zoom%jbegin_glo=jbegin_glo
+      pt_zoom%has_ibegin_glo=.TRUE.
+    ENDIF
+               
+   END SUBROUTINE zoom__set   
+
+  SUBROUTINE zoom__set_attribut_id(id,attrib,ok)
+  USE mod_attribut
+  USE error_msg
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)   :: id
+    TYPE(attribut),INTENT(IN)     :: attrib
+    LOGICAL,OPTIONAL,INTENT(OUT)  :: ok
+    
+    TYPE(zoom),POINTER              :: Pt_zoom
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_zoom=>zoom_ids%at(Pos)%Pt
+      CALL zoom__set_attribut_pt(Pt_zoom,attrib)
+      IF (PRESENT(OK)) OK=.TRUE.
+    ELSE
+      IF (.NOT.PRESENT(OK)) THEN
+        WRITE(message,*) 'zoom id :',id,'is undefined'
+        CALL error('mod_zoom::zoom__set_attribut')
+      ELSE
+        OK=.FALSE.
+      ENDIF
+    ENDIF  
+  
+  END SUBROUTINE zoom__set_attribut_id
+      
+  SUBROUTINE zoom__set_attribut_pt(Pt_zoom,attrib)
+  USE mod_attribut
+  USE mod_zoom_attribut
+  USE error_msg
+  IMPLICIT NONE
+    TYPE(zoom),POINTER        :: Pt_zoom
+    TYPE(attribut),INTENT(IN) :: attrib
+    
+    SELECT CASE(attrib%name)
+      CASE (zoom__name)
+        IF (attrib%type==string0) CALL  zoom__set(pt_zoom,name=attrib%string0_ptr) ; RETURN
+      CASE (zoom__description)
+        IF (attrib%type==string0) CALL  zoom__set(pt_zoom,description=attrib%string0_ptr) ; RETURN
+      CASE (zoom__ni)
+        IF (attrib%type==integer0) CALL  zoom__set(pt_zoom,ni_glo=attrib%integer0_ptr) ; RETURN
+      CASE (zoom__nj)
+        IF (attrib%type==integer0) CALL  zoom__set(pt_zoom,nj_glo=attrib%integer0_ptr) ; RETURN
+      CASE (zoom__ibegin)
+        IF (attrib%type==integer0) CALL  zoom__set(pt_zoom,ibegin_glo=attrib%integer0_ptr) ; RETURN
+      CASE (zoom__jbegin)
+        IF (attrib%type==integer0) CALL  zoom__set(pt_zoom,jbegin_glo=attrib%integer0_ptr) ; RETURN
+     END SELECT
+
+     WRITE(message,*) 'zoom attribut ',attrib%name,' : type :',attrib%type,   &
+                      ' : Attribute type is incompatible with the provided value'
+     CALL error('mod_zoom::zoom__set_attribut')
+    
+  END SUBROUTINE zoom__set_attribut_pt
+
+  SUBROUTINE zoom__get(Id,pt_zoom)
+  USE string_function
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)     :: Id
+    TYPE(zoom),POINTER              :: Pt_zoom
+
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_zoom=>zoom_ids%at(Pos)%Pt
+    ELSE
+      Pt_zoom=>NULL()
+    ENDIF
+    
+  END SUBROUTINE zoom__get
+
+END MODULE mod_zoom
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_zoom_attribut.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_zoom_attribut.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_zoom_attribut.f90	(revision 2528)
@@ -0,0 +1,17 @@
+MODULE mod_zoom_attribut
+  USE mod_object
+   
+  INTEGER,PARAMETER :: zoom__begin = zoom_object + 10
+
+  INTEGER,PARAMETER :: zoom__name = zoom_object + 11
+  INTEGER,PARAMETER :: zoom__description = zoom_object + 12
+  INTEGER,PARAMETER :: zoom__ni = zoom_object + 13
+  INTEGER,PARAMETER :: zoom__nj = zoom_object + 14
+  INTEGER,PARAMETER :: zoom__ibegin = zoom_object + 15
+  INTEGER,PARAMETER :: zoom__jbegin = zoom_object + 16
+  
+  INTEGER,PARAMETER :: zoom__end = zoom_object + 17
+
+END MODULE mod_zoom_attribut
+
+
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/string_function.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/string_function.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/string_function.f90	(revision 2528)
@@ -0,0 +1,107 @@
+MODULE string_function
+ 
+
+
+
+CONTAINS
+
+  FUNCTION stdstr(string)
+  USE mod_xmlio_parameters
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: string
+    CHARACTER(LEN=str_len) :: stdstr
+    
+    stdstr=string
+  END FUNCTION stdstr
+    
+  
+  FUNCTION Hash(Str)
+  IMPLICIT NONE  
+    CHARACTER(LEN=*),INTENT(IN) :: Str
+    CHARACTER(LEN=LEN(str)) :: new_str
+    INTEGER :: Hash
+    INTEGER :: c
+    INTEGER :: i
+    
+    new_str=ADJUSTL(ADJUSTR(Str))
+    
+    Hash=0
+    DO i=1,LEN_TRIM(new_Str)
+      c = IACHAR(new_Str(i:i))
+      Hash=c+ISHFT(Hash,6)+ISHFT(Hash,16)-Hash
+    ENDDO
+    
+  END FUNCTION Hash
+  
+  FUNCTION String_to_integer(str,succed)
+  USE error_msg
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: Str
+    LOGICAL,OPTIONAL            :: succed
+    
+    INTEGER :: String_to_integer
+    INTEGER :: ierr
+    
+    READ(Str,FMT=*,iostat=ierr) String_to_integer
+    
+    IF (PRESENT(succed)) succed=.TRUE.
+      
+    IF (ierr/=0) THEN
+      IF (PRESENT(succed)) THEN
+        succed=.FALSE.
+      ELSE 
+        WRITE (message,*) 'Error when attempting to convert string :<<',TRIM(str),'>> to integer'
+        CALL Error("string_function:string_to_integer")
+      ENDIF
+    ENDIF
+  END FUNCTION String_to_integer
+  
+  FUNCTION String_to_real(str,succed)
+  USE error_msg
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: Str
+    LOGICAL,OPTIONAL            :: succed
+    
+    REAL    :: String_to_real
+    INTEGER :: ierr
+    
+    READ(Str,FMT=*,iostat=ierr) String_to_real
+    
+    IF (PRESENT(succed)) succed=.TRUE.
+      
+    IF (ierr/=0) THEN
+      IF (PRESENT(succed)) THEN
+        succed=.FALSE.
+      ELSE 
+        WRITE (message,*) 'Error when attempting to convert string :<<',TRIM(str),'>> to real'
+        CALL Error("string_function:string_to_real")
+      ENDIF
+    ENDIF
+    
+  END FUNCTION String_to_real
+  
+  FUNCTION String_to_logical(str,succed)
+  USE error_msg
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: Str
+    LOGICAL,OPTIONAL            :: succed
+    
+    LOGICAL :: String_to_logical
+    INTEGER :: ierr
+    
+    READ(Str,FMT=*,iostat=ierr) String_to_logical
+    
+    IF (PRESENT(succed)) succed=.TRUE.
+      
+    IF (ierr/=0) THEN
+      IF (PRESENT(succed)) THEN
+        succed=.FALSE.
+      ELSE 
+        WRITE (message,*) 'Error when attempting to convert string :<<',TRIM(str),'>> to logical'
+        CALL Error("string_function:string_to_logical")
+      ENDIF
+    ENDIF
+    
+  END FUNCTION String_to_logical
+    
+END MODULE string_function
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/test_xmlio.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/test_xmlio.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/test_xmlio.f90	(revision 2528)
@@ -0,0 +1,85 @@
+PROGRAM test_xmlio
+  USE xmlio
+  USE mod_interface_ioipsl
+  IMPLICIT NONE
+  
+  TYPE(field),POINTER :: Pt_f
+  TYPE(field_group),POINTER :: Pt_fg
+  TYPE(file),POINTER :: Pt_file
+  TYPE(grid),POINTER :: pt_grid 
+  INTEGER,PARAMETER  :: ni=360
+  INTEGER,PARAMETER  :: nj=180
+  REAL,DIMENSION(ni,nj) :: lon
+  REAL,DIMENSION(ni,nj) :: lat
+  INTEGER               :: i,j
+  TYPE(axis),POINTER :: pt_axis 
+  
+  DO i=1,ni
+    DO j=1,nj
+      lon(i,j)=i
+      lat(i,j)=j
+    ENDDO
+  ENDDO  
+  
+  
+  
+  CALL xmlio__init("iodef.xml")
+
+  CALL grid__get("grid_T",pt_grid)
+  CALL domain__set(pt_grid%domain,0,ni,nj,1,1,lon,lat)
+
+  CALL grid__get("grid_U",pt_grid)
+  CALL domain__set(pt_grid%domain,0,ni,nj,1,1,lon,lat)
+
+  CALL grid__get("grid_V",pt_grid)
+  CALL domain__set(pt_grid%domain,0,ni,nj,1,1,lon,lat)
+
+  CALL grid__get("grid_W",pt_grid)
+  CALL domain__set(pt_grid%domain,0,ni,nj,1,1,lon,lat)
+  
+  CALL axis__get("deptht",pt_axis)
+  CALL axis__set(pt_axis,a_size=5,values=(/1.,2.,3.,4.,5./))
+
+  CALL axis__get("depthu",pt_axis)
+  CALL axis__set(pt_axis,a_size=5,values=(/1.,2.,3.,4.,5./))
+
+  CALL axis__get("depthv",pt_axis)
+  CALL axis__set(pt_axis,a_size=5,values=(/1.,2.,3.,4.,5./))
+
+  CALL axis__get("depthw",pt_axis)
+  CALL axis__set(pt_axis,a_size=5,values=(/1.,2.,3.,4.,5./))
+
+
+  CALL axis_group__apply_default(axis_definition)
+  CALL grid_group__apply_default(grid_definition)
+  CALL field_group__apply_default(field_definition)
+  CALL file_group__apply_default(file_definition)
+  
+  CALL field_group__solve_ref(field_definition)
+  CALL file_group__solve_field_ref(file_definition)
+
+  CALL file_group__check(file_definition)
+  CALL axis_group__check(axis_definition)
+
+!
+  CALL axis_group__print(axis_definition)
+  CALL grid_group__print(grid_definition)
+  CALL field_group__print(field_definition)
+  CALL file_group__print(file_definition)
+!  CALL field_group__get_new_field(field_definition,pt_f,"toto")
+!  CALL field__set(Pt_f,name="toto",unit="kg")
+!  CALL field_group__get_new_field(field_definition,pt_f,"tata")
+!  CALL field__set(Pt_f,name="tata",unit="kg")
+!  CALL field_group__get_new_field(field_definition,pt_f,"titi")
+!  CALL field__set(Pt_f,name="titi",unit="kg")
+!  CALL field_group__get_new_field(field_definition,pt_f,"xyz")
+!  CALL field__set(Pt_f,name="xyz",unit="kg")
+   CALL set_file_dependency
+   CALL set_field_enabled
+   CALL set_field_dependency
+   
+   CALL set_time_parameters(0,0.,3600.)
+   
+   CALL create_header
+   
+END PROGRAM test_xmlio
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_axis_contains.inc
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_axis_contains.inc	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_axis_contains.inc	(revision 2528)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_axis__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_axis), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_axis__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_axis__new
+  
+  SUBROUTINE vector_axis__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_axis), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL axis__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_axis__delete
+  
+  SUBROUTINE vector_axis__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_axis), INTENT(INOUT)   :: vect
+    TYPE(axis),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_axis__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_axis__get_new
+
+  SUBROUTINE vector_axis__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_axis), INTENT(INOUT)   :: vect
+    TYPE(axis),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_axis__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_axis__set_new
+  
+  SUBROUTINE vector_axis__increase(vect)
+    TYPE(vector_axis), INTENT(INOUT) :: vect
+    TYPE (Pt_axis__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_axis__increase 
+    
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_axis_def.inc
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_axis_def.inc	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_axis_def.inc	(revision 2528)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_axis__ 
+    TYPE (axis),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_axis__
+
+  TYPE vector_axis
+  
+    TYPE (Pt_axis__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_axis
+  
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_axis_group_contains.inc
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_axis_group_contains.inc	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_axis_group_contains.inc	(revision 2528)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_axis_group__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_axis_group), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_axis_group__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_axis_group__new
+  
+  SUBROUTINE vector_axis_group__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_axis_group), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL axis_group__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_axis_group__delete
+  
+  SUBROUTINE vector_axis_group__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_axis_group), INTENT(INOUT)   :: vect
+    TYPE(axis_group),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_axis_group__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_axis_group__get_new
+
+  SUBROUTINE vector_axis_group__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_axis_group), INTENT(INOUT)   :: vect
+    TYPE(axis_group),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_axis_group__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_axis_group__set_new
+  
+  SUBROUTINE vector_axis_group__increase(vect)
+    TYPE(vector_axis_group), INTENT(INOUT) :: vect
+    TYPE (Pt_axis_group__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_axis_group__increase 
+    
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_axis_group_def.inc
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_axis_group_def.inc	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_axis_group_def.inc	(revision 2528)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_axis_group__ 
+    TYPE (axis_group),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_axis_group__
+
+  TYPE vector_axis_group
+  
+    TYPE (Pt_axis_group__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_axis_group
+  
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_contains.template
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_contains.template	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_contains.template	(revision 2528)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_#TYPE#__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_#TYPE#), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_#TYPE#__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_#TYPE#__new
+  
+  SUBROUTINE vector_#TYPE#__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_#TYPE#), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL #TYPE#__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_#TYPE#__delete
+  
+  SUBROUTINE vector_#TYPE#__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_#TYPE#), INTENT(INOUT)   :: vect
+    TYPE(#TYPE#),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_#TYPE#__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_#TYPE#__get_new
+
+  SUBROUTINE vector_#TYPE#__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_#TYPE#), INTENT(INOUT)   :: vect
+    TYPE(#TYPE#),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_#TYPE#__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_#TYPE#__set_new
+  
+  SUBROUTINE vector_#TYPE#__increase(vect)
+    TYPE(vector_#TYPE#), INTENT(INOUT) :: vect
+    TYPE (Pt_#TYPE#__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_#TYPE#__increase 
+    
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_context_contains.inc
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_context_contains.inc	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_context_contains.inc	(revision 2528)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_context__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_context), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_context__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_context__new
+  
+  SUBROUTINE vector_context__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_context), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL context__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_context__delete
+  
+  SUBROUTINE vector_context__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_context), INTENT(INOUT)   :: vect
+    TYPE(context),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_context__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_context__get_new
+
+  SUBROUTINE vector_context__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_context), INTENT(INOUT)   :: vect
+    TYPE(context),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_context__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_context__set_new
+  
+  SUBROUTINE vector_context__increase(vect)
+    TYPE(vector_context), INTENT(INOUT) :: vect
+    TYPE (Pt_context__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_context__increase 
+    
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_context_def.inc
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_context_def.inc	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_context_def.inc	(revision 2528)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_context__ 
+    TYPE (context),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_context__
+
+  TYPE vector_context
+  
+    TYPE (Pt_context__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_context
+  
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_def.template
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_def.template	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_def.template	(revision 2528)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_#TYPE#__ 
+    TYPE (#TYPE#),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_#TYPE#__
+
+  TYPE vector_#TYPE#
+  
+    TYPE (Pt_#TYPE#__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_#TYPE#
+  
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_domain_contains.inc
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_domain_contains.inc	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_domain_contains.inc	(revision 2528)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_domain__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_domain), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_domain__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_domain__new
+  
+  SUBROUTINE vector_domain__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_domain), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL domain__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_domain__delete
+  
+  SUBROUTINE vector_domain__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_domain), INTENT(INOUT)   :: vect
+    TYPE(domain),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_domain__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_domain__get_new
+
+  SUBROUTINE vector_domain__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_domain), INTENT(INOUT)   :: vect
+    TYPE(domain),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_domain__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_domain__set_new
+  
+  SUBROUTINE vector_domain__increase(vect)
+    TYPE(vector_domain), INTENT(INOUT) :: vect
+    TYPE (Pt_domain__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_domain__increase 
+    
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_domain_def.inc
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_domain_def.inc	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_domain_def.inc	(revision 2528)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_domain__ 
+    TYPE (domain),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_domain__
+
+  TYPE vector_domain
+  
+    TYPE (Pt_domain__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_domain
+  
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_contains.inc
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_contains.inc	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_contains.inc	(revision 2528)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_field__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_field), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_field__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_field__new
+  
+  SUBROUTINE vector_field__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_field), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL field__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_field__delete
+  
+  SUBROUTINE vector_field__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_field), INTENT(INOUT)   :: vect
+    TYPE(field),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_field__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_field__get_new
+
+  SUBROUTINE vector_field__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_field), INTENT(INOUT)   :: vect
+    TYPE(field),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_field__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_field__set_new
+  
+  SUBROUTINE vector_field__increase(vect)
+    TYPE(vector_field), INTENT(INOUT) :: vect
+    TYPE (Pt_field__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_field__increase 
+    
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_def.inc
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_def.inc	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_def.inc	(revision 2528)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_field__ 
+    TYPE (field),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_field__
+
+  TYPE vector_field
+  
+    TYPE (Pt_field__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_field
+  
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_dep_contains.inc
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_dep_contains.inc	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_dep_contains.inc	(revision 2528)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_field_dep__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_field_dep), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_field_dep__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_field_dep__new
+  
+  SUBROUTINE vector_field_dep__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_field_dep), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL field_dep__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_field_dep__delete
+  
+  SUBROUTINE vector_field_dep__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_field_dep), INTENT(INOUT)   :: vect
+    TYPE(field_dep),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_field_dep__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_field_dep__get_new
+
+  SUBROUTINE vector_field_dep__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_field_dep), INTENT(INOUT)   :: vect
+    TYPE(field_dep),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_field_dep__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_field_dep__set_new
+  
+  SUBROUTINE vector_field_dep__increase(vect)
+    TYPE(vector_field_dep), INTENT(INOUT) :: vect
+    TYPE (Pt_field_dep__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_field_dep__increase 
+    
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_dep_def.inc
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_dep_def.inc	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_dep_def.inc	(revision 2528)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_field_dep__ 
+    TYPE (field_dep),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_field_dep__
+
+  TYPE vector_field_dep
+  
+    TYPE (Pt_field_dep__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_field_dep
+  
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_group_contains.inc
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_group_contains.inc	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_group_contains.inc	(revision 2528)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_field_group__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_field_group), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_field_group__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_field_group__new
+  
+  SUBROUTINE vector_field_group__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_field_group), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL field_group__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_field_group__delete
+  
+  SUBROUTINE vector_field_group__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_field_group), INTENT(INOUT)   :: vect
+    TYPE(field_group),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_field_group__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_field_group__get_new
+
+  SUBROUTINE vector_field_group__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_field_group), INTENT(INOUT)   :: vect
+    TYPE(field_group),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_field_group__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_field_group__set_new
+  
+  SUBROUTINE vector_field_group__increase(vect)
+    TYPE(vector_field_group), INTENT(INOUT) :: vect
+    TYPE (Pt_field_group__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_field_group__increase 
+    
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_group_def.inc
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_group_def.inc	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_group_def.inc	(revision 2528)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_field_group__ 
+    TYPE (field_group),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_field_group__
+
+  TYPE vector_field_group
+  
+    TYPE (Pt_field_group__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_field_group
+  
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_out_contains.inc
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_out_contains.inc	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_out_contains.inc	(revision 2528)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_field_out__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_field_out), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_field_out__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_field_out__new
+  
+  SUBROUTINE vector_field_out__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_field_out), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL field_out__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_field_out__delete
+  
+  SUBROUTINE vector_field_out__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_field_out), INTENT(INOUT)   :: vect
+    TYPE(field_out),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_field_out__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_field_out__get_new
+
+  SUBROUTINE vector_field_out__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_field_out), INTENT(INOUT)   :: vect
+    TYPE(field_out),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_field_out__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_field_out__set_new
+  
+  SUBROUTINE vector_field_out__increase(vect)
+    TYPE(vector_field_out), INTENT(INOUT) :: vect
+    TYPE (Pt_field_out__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_field_out__increase 
+    
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_out_def.inc
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_out_def.inc	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_out_def.inc	(revision 2528)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_field_out__ 
+    TYPE (field_out),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_field_out__
+
+  TYPE vector_field_out
+  
+    TYPE (Pt_field_out__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_field_out
+  
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_file_contains.inc
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_file_contains.inc	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_file_contains.inc	(revision 2528)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_file__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_file), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_file__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_file__new
+  
+  SUBROUTINE vector_file__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_file), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL file__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_file__delete
+  
+  SUBROUTINE vector_file__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_file), INTENT(INOUT)   :: vect
+    TYPE(file),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_file__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_file__get_new
+
+  SUBROUTINE vector_file__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_file), INTENT(INOUT)   :: vect
+    TYPE(file),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_file__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_file__set_new
+  
+  SUBROUTINE vector_file__increase(vect)
+    TYPE(vector_file), INTENT(INOUT) :: vect
+    TYPE (Pt_file__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_file__increase 
+    
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_file_def.inc
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_file_def.inc	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_file_def.inc	(revision 2528)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_file__ 
+    TYPE (file),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_file__
+
+  TYPE vector_file
+  
+    TYPE (Pt_file__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_file
+  
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_file_dep_contains.inc
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_file_dep_contains.inc	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_file_dep_contains.inc	(revision 2528)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_file_dep__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_file_dep), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_file_dep__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_file_dep__new
+  
+  SUBROUTINE vector_file_dep__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_file_dep), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL file_dep__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_file_dep__delete
+  
+  SUBROUTINE vector_file_dep__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_file_dep), INTENT(INOUT)   :: vect
+    TYPE(file_dep),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_file_dep__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_file_dep__get_new
+
+  SUBROUTINE vector_file_dep__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_file_dep), INTENT(INOUT)   :: vect
+    TYPE(file_dep),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_file_dep__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_file_dep__set_new
+  
+  SUBROUTINE vector_file_dep__increase(vect)
+    TYPE(vector_file_dep), INTENT(INOUT) :: vect
+    TYPE (Pt_file_dep__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_file_dep__increase 
+    
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_file_dep_def.inc
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_file_dep_def.inc	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_file_dep_def.inc	(revision 2528)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_file_dep__ 
+    TYPE (file_dep),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_file_dep__
+
+  TYPE vector_file_dep
+  
+    TYPE (Pt_file_dep__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_file_dep
+  
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_file_group_contains.inc
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_file_group_contains.inc	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_file_group_contains.inc	(revision 2528)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_file_group__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_file_group), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_file_group__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_file_group__new
+  
+  SUBROUTINE vector_file_group__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_file_group), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL file_group__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_file_group__delete
+  
+  SUBROUTINE vector_file_group__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_file_group), INTENT(INOUT)   :: vect
+    TYPE(file_group),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_file_group__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_file_group__get_new
+
+  SUBROUTINE vector_file_group__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_file_group), INTENT(INOUT)   :: vect
+    TYPE(file_group),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_file_group__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_file_group__set_new
+  
+  SUBROUTINE vector_file_group__increase(vect)
+    TYPE(vector_file_group), INTENT(INOUT) :: vect
+    TYPE (Pt_file_group__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_file_group__increase 
+    
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_file_group_def.inc
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_file_group_def.inc	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_file_group_def.inc	(revision 2528)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_file_group__ 
+    TYPE (file_group),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_file_group__
+
+  TYPE vector_file_group
+  
+    TYPE (Pt_file_group__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_file_group
+  
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_grid_contains.inc
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_grid_contains.inc	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_grid_contains.inc	(revision 2528)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_grid__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_grid), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_grid__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_grid__new
+  
+  SUBROUTINE vector_grid__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_grid), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL grid__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_grid__delete
+  
+  SUBROUTINE vector_grid__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_grid), INTENT(INOUT)   :: vect
+    TYPE(grid),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_grid__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_grid__get_new
+
+  SUBROUTINE vector_grid__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_grid), INTENT(INOUT)   :: vect
+    TYPE(grid),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_grid__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_grid__set_new
+  
+  SUBROUTINE vector_grid__increase(vect)
+    TYPE(vector_grid), INTENT(INOUT) :: vect
+    TYPE (Pt_grid__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_grid__increase 
+    
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_grid_def.inc
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_grid_def.inc	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_grid_def.inc	(revision 2528)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_grid__ 
+    TYPE (grid),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_grid__
+
+  TYPE vector_grid
+  
+    TYPE (Pt_grid__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_grid
+  
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_grid_group_contains.inc
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_grid_group_contains.inc	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_grid_group_contains.inc	(revision 2528)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_grid_group__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_grid_group), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_grid_group__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_grid_group__new
+  
+  SUBROUTINE vector_grid_group__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_grid_group), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL grid_group__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_grid_group__delete
+  
+  SUBROUTINE vector_grid_group__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_grid_group), INTENT(INOUT)   :: vect
+    TYPE(grid_group),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_grid_group__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_grid_group__get_new
+
+  SUBROUTINE vector_grid_group__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_grid_group), INTENT(INOUT)   :: vect
+    TYPE(grid_group),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_grid_group__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_grid_group__set_new
+  
+  SUBROUTINE vector_grid_group__increase(vect)
+    TYPE(vector_grid_group), INTENT(INOUT) :: vect
+    TYPE (Pt_grid_group__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_grid_group__increase 
+    
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_grid_group_def.inc
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_grid_group_def.inc	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_grid_group_def.inc	(revision 2528)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_grid_group__ 
+    TYPE (grid_group),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_grid_group__
+
+  TYPE vector_grid_group
+  
+    TYPE (Pt_grid_group__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_grid_group
+  
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_node_contains.inc
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_node_contains.inc	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_node_contains.inc	(revision 2528)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_node__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_node), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_node__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_node__new
+  
+  SUBROUTINE vector_node__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_node), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL node__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_node__delete
+  
+  SUBROUTINE vector_node__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_node), INTENT(INOUT)   :: vect
+    TYPE(node),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_node__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_node__get_new
+
+  SUBROUTINE vector_node__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_node), INTENT(INOUT)   :: vect
+    TYPE(node),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_node__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_node__set_new
+  
+  SUBROUTINE vector_node__increase(vect)
+    TYPE(vector_node), INTENT(INOUT) :: vect
+    TYPE (Pt_node__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_node__increase 
+    
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_node_def.inc
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_node_def.inc	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_node_def.inc	(revision 2528)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_node__ 
+    TYPE (node),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_node__
+
+  TYPE vector_node
+  
+    TYPE (Pt_node__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_node
+  
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_zoom_contains.inc
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_zoom_contains.inc	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_zoom_contains.inc	(revision 2528)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_zoom__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_zoom), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_zoom__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_zoom__new
+  
+  SUBROUTINE vector_zoom__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_zoom), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL zoom__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_zoom__delete
+  
+  SUBROUTINE vector_zoom__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_zoom), INTENT(INOUT)   :: vect
+    TYPE(zoom),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_zoom__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_zoom__get_new
+
+  SUBROUTINE vector_zoom__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_zoom), INTENT(INOUT)   :: vect
+    TYPE(zoom),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_zoom__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_zoom__set_new
+  
+  SUBROUTINE vector_zoom__increase(vect)
+    TYPE(vector_zoom), INTENT(INOUT) :: vect
+    TYPE (Pt_zoom__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_zoom__increase 
+    
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_zoom_def.inc
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_zoom_def.inc	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_zoom_def.inc	(revision 2528)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_zoom__ 
+    TYPE (zoom),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_zoom__
+
+  TYPE vector_zoom
+  
+    TYPE (Pt_zoom__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_zoom
+  
Index: trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/xmlio.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/xmlio.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/xmlio.f90	(revision 2528)
@@ -0,0 +1,53 @@
+MODULE xmlio
+
+  USE mod_field
+  USE mod_field_group
+  USE mod_field_definition
+  USE mod_grid
+  USE mod_grid_group
+  USE mod_grid_definition
+  USE mod_axis
+  USE mod_axis_group
+  USE mod_axis_definition
+  USE mod_file
+  USE mod_file_group
+  USE mod_file_definition
+  USE mod_dependency
+  USE string_function
+  USE error_msg
+  USE mod_context
+  USE mod_time_parameters
+  
+CONTAINS
+
+  SUBROUTINE xmlio__Init(xml_file)
+  USE parsing_xml
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: xml_file
+    
+    CALL context__init
+    CALL parsing_xml_file(xml_file)
+    
+  END SUBROUTINE xmlio__init
+  
+  
+  SUBROUTINE xmlio__close_definition
+  IMPLICIT NONE
+  
+    CALL axis_group__apply_default(axis_definition)
+    CALL grid_group__apply_default(grid_definition)
+    CALL field_group__apply_default(field_definition)
+    CALL file_group__apply_default(file_definition)
+  
+    CALL field_group__solve_ref(field_definition)
+    CALL file_group__solve_field_ref(file_definition)
+
+    CALL file_group__check(file_definition)
+    CALL axis_group__check(axis_definition)
+    CALL grid_group__process_domain(grid_definition)
+     
+    CALL set_dependency
+
+  END SUBROUTINE xmlio__close_definition
+
+END MODULE xmlio
Index: trunk/NEMOGCM/EXTERNAL/fcm/COPYRIGHT.txt
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/COPYRIGHT.txt	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/COPYRIGHT.txt	(revision 2528)
@@ -0,0 +1,109 @@
+!------------------------------------------------------------------------------!
+!              Flexible Configuration Management Software License              !
+!                                                                              !
+!     Please read this Software Licence as you will be bound by its terms      !
+!                           if you use the Software                            !
+!------------------------------------------------------------------------------!
+
+The Licensor:
+-------------
+
+The Met Office of FitzRoy Road, Exeter EX1 3PB, United Kingdom
+--------------------------------------------------------------------------------
+
+1. Licence.
+-----------
+
+The Met Office grants you a non-exclusive, royalty free; world-wide,
+transferable Licence to use, modify, copy and distribute the Flexible
+Configuration Management software ("the software") accompanying this License
+providing:
+
+a. you undertake to provide to the Met Office a copy of any modifications made
+   by you on the same terms contained within this licence agreement;
+
+b. modified files carry prominent notices stating that you changed the files
+   and the date of change;
+
+c. distribution of original or modified files is made free of charge under the
+   terms of this Licence;
+
+d. the appropriate copyright notices, the above copyright notice and a
+   disclaimer of warranty is included with the distribution.
+
+2. Ownership.
+-------------
+
+The Flexible Configuration Management software is Crown copyright and is
+reproduced with the permission of Met Office under delegated authority from
+the Controller of HMSO. The software and documentation are provided to you to
+allow you to exercise your rights under this License, which is granted to you.
+
+3. Duration.
+------------
+
+This license will remain in effect until terminated.
+ 
+4. Termination.
+---------------
+
+You may terminate this license at any time by removing all copies of the
+software from your system.  This License will terminate immediately without
+notice from us if you fail to comply with any of the provisions of this
+License or in the event of your breaching the terms of this licence you are
+given notice that the license has been terminated.  Upon termination you will
+delete all copies of the software and any related documentation.
+
+5. Disclaimer of Warranty.
+--------------------------
+
+a. THE MET OFFICE DISCLAIMS ALL WARRANTIES, REPRESENTATIONS AND PROMISES,
+   INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF SATISFACTORY QUALITY
+   AND FIT FOR THE PURPOSE.  NEITHER DOES THE MET OFFICE MAKE ANY
+   REPRESENTATIONS AS TO COMPATABILITY WITH YOUR OPERATING SYSTEMS AND
+   PLATFORMS.
+
+b. In no event does the Met Office warrant that the software or related
+   documentation will satisfy your requirements, that the software and
+   documentation will be without errors or defects or that the operation of
+   the software will be uninterrupted.
+
+c. IN NO EVENT WILL THE MET OFFICE BE LIABLE FOR ANY OTHER DAMAGES, INCLUDING
+   BUT NOT LIMITED TO DAMAGES FOR LOSS OF PROFITS DATA OR USE OF THE SOFTWARE
+   OR FOR ANY INDIRECT, INCIDENTAL OR CONSEQUENTIAL DAMAGES, EVEN IF THE MET
+   OFFICE HAS BEEN SPECIFICALLY ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
+
+6. General Provisions.
+----------------------
+
+a. You will not do anything, relating to this software that will bring the Met
+   Office into disrepute.
+
+b. You will not use the name of the Met Office or any other contributor to
+   endorse or promote any products derived from the software without the
+   written permission of the Met Office.
+
+7. Acknowledgements.
+--------------------
+
+The logic to extract the calling interfaces of top level subroutines and
+functions from a Fortran source file is adapted from a script developed at
+ECMWF and is provided by kind permission of ECMWF under the same terms of this
+Licence.
+
+8. Entire Agreement.
+--------------------
+
+This License constitutes the entire agreement between us with respect to your
+rights or warranties for using the software and related documentation.  If any
+provision of this agreement is determined to be invalid or unenforceable the
+remaining provisions shall continue in full force.
+
+9. Governing Law.
+-----------------
+
+This Agreement is governed by and construed in accordance with the Laws of
+England.
+
+--------------------------------------------------------------------------------
+                                              © British Crown copyright 2006-10.
Index: trunk/NEMOGCM/EXTERNAL/fcm/LICENSE.html
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/LICENSE.html	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/LICENSE.html	(revision 2528)
@@ -0,0 +1,154 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
+    "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+
+<html xmlns="http://www.w3.org/1999/xhtml">
+<head>
+  <title>Flexible Configuration Management Software License</title>
+  <meta name="copyright" content="&copy; British Crown Copyright" />
+  <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
+<style type="text/css">
+/*<![CDATA[*/
+  <!--
+  body {
+    font: normal normal 10pt Arial, sans-serif;
+  }
+
+  h1 {
+    text-align: center;
+    text-decoration: underline;
+    font: normal bold 14pt Arial, sans-serif;
+  }
+
+  h2 {
+    text-align: left;
+    text-decoration: none;
+    font: normal normal 14pt Arial, sans-serif;
+  }
+
+  h3 {
+    text-align: left;
+    text-decoration: none;
+    font: normal bold 10pt Arial, sans-serif;
+  }
+
+  address {
+    text-align: right;
+    font: normal bold 11pt Arial, sans-serif;
+  }
+
+  ol li {
+    list-style: lower-alpha;
+  }
+  //-->
+/*]]>*/
+</style>
+</head>
+
+<body>
+  <h1>Flexible Configuration Management Software License</h1>
+
+  <h1>Please read this Software Licence as you will be bound by its terms if
+  you use the Software</h1>
+
+  <h2>The Licensor:</h2>
+
+  <h2>The Met Office of FitzRoy Road, Exeter EX1 3PB, United Kingdom</h2>
+
+  <h3>1. Licence.</h3>
+
+  <p>The Met Office grants you a non-exclusive, royalty free; world-wide,
+  transferable Licence to use, modify, copy and distribute the Flexible
+  Configuration Management software ("the software") accompanying this License
+  providing:</p>
+
+  <ol>
+    <li>you undertake to provide to the Met Office a copy of any modifications
+    made by you on the same terms contained within this licence agreement;</li>
+
+    <li>modified files carry prominent notices stating that you changed the
+    files and the date of change;</li>
+
+    <li>distribution of original or modified files is made free of charge under
+    the terms of this Licence;</li>
+
+    <li>the appropriate copyright notices, the above copyright notice and a
+    disclaimer of warranty is included with the distribution.</li>
+  </ol>
+
+  <h3>2. Ownership.</h3>
+
+  <p>The Flexible Configuration Management software is Crown copyright and is
+  reproduced with the permission of Met Office under delegated authority from
+  the Controller of HMSO. The software and documentation are provided to you to
+  allow you to exercise your rights under this License, which is granted to
+  you.</p>
+
+  <h3>3. Duration.</h3>
+
+  <p>This license will remain in effect until terminated.</p>
+
+  <h3>4. Termination.</h3>
+
+  <p>You may terminate this license at any time by removing all copies of the
+  software from your system. This License will terminate immediately without
+  notice from us if you fail to comply with any of the provisions of this
+  License or in the event of your breaching the terms of this licence you are
+  given notice that the license has been terminated. Upon termination you will
+  delete all copies of the software and any related documentation.</p>
+
+  <h3>5. Disclaimer of Warranty.</h3>
+
+  <ol>
+    <li>THE MET OFFICE DISCLAIMS ALL WARRANTIES, REPRESENTATIONS AND PROMISES,
+    INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF SATISFACTORY QUALITY
+    AND FIT FOR THE PURPOSE. NEITHER DOES THE MET OFFICE MAKE ANY
+    REPRESENTATIONS AS TO COMPATABILITY WITH YOUR OPERATING SYSTEMS AND
+    PLATFORMS.</li>
+
+    <li>In no event does the Met Office warrant that the software or related
+    documentation will satisfy your requirements, that the software and
+    documentation will be without errors or defects or that the operation of
+    the software will be uninterrupted.</li>
+
+    <li>IN NO EVENT WILL THE MET OFFICE BE LIABLE FOR ANY OTHER DAMAGES,
+    INCLUDING BUT NOT LIMITED TO DAMAGES FOR LOSS OF PROFITS DATA OR USE OF THE
+    SOFTWARE OR FOR ANY INDIRECT, INCIDENTAL OR CONSEQUENTIAL DAMAGES, EVEN IF
+    THE MET OFFICE HAS BEEN SPECIFICALLY ADVISED OF THE POSSIBILITY OF SUCH
+    DAMAGES.</li>
+  </ol>
+
+  <h3>6. General Provisions.</h3>
+
+  <ol>
+    <li>You will not do anything, relating to this software that will bring the
+    Met Office into disrepute.</li>
+
+    <li>You will not use the name of the Met Office or any other contributor to
+    endorse or promote any products derived from the software without the
+    written permission of the Met Office.</li>
+  </ol>
+
+  <h3>7. Acknowledgements.</h3>
+
+  <p>The logic to extract the calling interfaces of top level subroutines and
+  functions from a Fortran source file is adapted from a script developed at
+  ECMWF and is provided by kind permission of ECMWF under the same terms of this
+  Licence.</p>
+
+  <h3>8. Entire Agreement.</h3>
+
+  <p>This License constitutes the entire agreement between us with respect to
+  your rights or warranties for using the software and related documentation.
+  If any provision of this agreement is determined to be invalid or
+  unenforceable the remaining provisions shall continue in full force.</p>
+
+  <h3>9. Governing Law.</h3>
+
+  <p>This Agreement is governed by and construed in accordance with the Laws of
+  England.</p>
+
+  <address>
+    &copy; British Crown copyright 2006-10.
+  </address>
+</body>
+</html>
Index: trunk/NEMOGCM/EXTERNAL/fcm/README
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/README	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/README	(revision 2528)
@@ -0,0 +1,4 @@
+FCM release 1-5 created from revision 3579.
+
+For further details please refer to the release notes
+which can be found in the directory doc/release_notes.
Index: trunk/NEMOGCM/EXTERNAL/fcm/bin/fcm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/bin/fcm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/bin/fcm	(revision 2528)
@@ -0,0 +1,66 @@
+#!/usr/bin/env perl
+#-------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+#-------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Fcm::CLI;
+use Fcm::Interactive;
+
+if (!caller()) {
+    main(@ARGV);
+}
+
+sub main {
+    local(@ARGV) = @_;
+    if (@ARGV && $ARGV[0] eq 'gui-internal') {
+        shift(@ARGV);
+        Fcm::Interactive::set_impl(
+            'Fcm::Interactive::InputGetter::GUI',
+            {geometry => shift(@ARGV)},
+        );
+    }
+    Fcm::CLI::invoke();
+}
+
+__END__
+
+=head1 NAME
+
+fcm
+
+=head1 SYNOPSIS
+
+fcm SUBCOMMAND [OPTIONS] [ARGUMENTS]
+
+=head1 OVERVIEW
+
+B<fcm> is the command line client for code management commands, the extract
+system and the build system of the Flexible Configuration Management (FCM)
+system.  For full detail of the system, please refer to the FCM user guide,
+which you should receive with this distribution in both HTML and PDF formats.
+
+Run "fcm help" to access the built-in tool documentation.
+
+=head1 AUTHOR
+
+FCM Team L<fcm-team@metoffice.gov.uk>.
+Please feedback any bug reports or feature requests to us by e-mail.
+
+=head1 SEE ALSO
+
+L<svn (1)|svn>,
+L<perl (1)| perl>,
+L<Fcm::CLI|Fcm::CLI>
+
+=head1 COPYRIGHT
+
+You can use this release of B<FCM> freely under the terms of the FCM LICENSE,
+which you should receive with this distribution.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/bin/fcm_graphic_diff
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/bin/fcm_graphic_diff	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/bin/fcm_graphic_diff	(revision 2528)
@@ -0,0 +1,96 @@
+#!/usr/bin/env perl
+#-------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+#-------------------------------------------------------------------------------
+
+use strict;
+use warnings;
+
+use Getopt::Long qw{GetOptions};
+
+# ------------------------------------------------------------------------------
+
+my ($u, @label);
+GetOptions ('u' => \$u, 'L=s' => \@label);
+
+# Check existence of files
+for my $i (0 .. 1) {
+  die $ARGV[$i], ': not found, abort' unless $ARGV[$i] and -f $ARGV[$i];
+}
+
+my ($old, $new) = @ARGV;
+
+if ($old =~ m#.svn/empty-file$#) {
+  print 'Skipping new file', "\n\n";
+
+} elsif ($new =~ m#.svn/empty-file$#) {
+  print 'Skipping deleted file', "\n\n";
+
+} elsif (-z $old) {
+  print 'Skipping as old file is empty (or does not exist)', "\n\n";
+
+} elsif (-z $new) {
+  print 'Skipping as new file is empty (or deleted)', "\n\n";
+
+} elsif (-B $new) {
+  print 'Skipping binary file', "\n\n";
+
+} else {
+  # Print descriptions of files
+  if (@label >= 2) {
+    print '--- ', $label[0], "\n", '+++ ', $label[1], "\n\n";
+  }
+
+  # FCM_GRAPHIC_DIFF is the graphical diff tool command
+  my $cmd = (exists $ENV{FCM_GRAPHIC_DIFF} ? $ENV{FCM_GRAPHIC_DIFF} : 'xxdiff');
+
+  if ($cmd) {
+    my @options = ();
+
+    # Set options for labels if appropriate
+    if (@label >= 2) {
+      if ($cmd eq 'tkdiff') {
+        # Use tkdiff
+        @options = ('-L', $label[0], '-L', $label[1]);
+
+      } elsif ($cmd eq 'xxdiff') {
+        # Use xxdiff
+        @options = ('--title1', $label[0], '--title2', $label[1]);
+      }
+    }
+
+    # Execute the command
+    my @command = ($cmd, @options, $old, $new);
+    exec (@command) or die 'Cannot execute: ', join (' ', @command);
+  }
+
+  exit;
+}
+
+__END__
+
+=head1 NAME
+
+fcm_graphic_diff
+
+=head1 SYNOPSIS
+
+    fcm_graphic_diff [-u] [-L OLD_DESC] [-L NEW_DESC] OLD NEW
+
+=head1 DESCRIPTION
+
+Wrapper script which invokes a graphical diff tool. Its interface is
+compatible with the "svn diff" command and can be used in combination with
+its "--diff-cmd" option. The command prints the OLD_DESC and NEW_DESC if
+they are both set. The two arguments OLD and NEW must be set and are the
+files to compare. The graphical diff tool invoked depends on the value of
+the FCM_GRAPHIC_DIFF environment variable. The command exits if the
+environment variable is not set.
+
+=head1 COPYRIGHT
+
+(C) Crown copyright Met Office. All rights reserved.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/bin/fcm_graphic_merge
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/bin/fcm_graphic_merge	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/bin/fcm_graphic_merge	(revision 2528)
@@ -0,0 +1,83 @@
+#!/usr/bin/env perl
+#-------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+#-------------------------------------------------------------------------------
+
+use strict;
+use warnings;
+
+my ($base, $mine, $older, $yours) = @ARGV;
+
+# FCM_GRAPHIC_MERGE is the graphical merge tool command
+my $cmd = (exists $ENV{FCM_GRAPHIC_MERGE} ? $ENV{FCM_GRAPHIC_MERGE} : 'xxdiff');
+
+my $rc  = 2;
+my $out = '';
+if ($cmd eq 'xxdiff') {
+  # Launch xxdiff
+  my @command   = ($cmd, qw/-m -M/, $base, qw/-O -X/, $mine, $older, $yours);
+  my ($cmd_out) = qx(@command);
+  my $cmd_rc    = $?;
+
+  # Parse output from xxdiff
+  if ($cmd_out) {
+    chomp $cmd_out;
+    if ($cmd_out eq 'NODECISION') {
+      $out = 'made no decision';
+      $rc  = 1;
+
+    } elsif ($cmd_out eq 'MERGED' and $cmd_rc) {
+      $out = 'not resolved all the conflicts';
+      $rc  = 1;
+
+    } else {
+      $out = lc ($cmd_out);
+      $rc  = 0;
+    }
+
+  } else {
+    print STDERR $cmd, ': failed, abort.', "\n";
+  }
+
+} else {
+  # Throw error for unknown/undefined graphic merge tool
+  print STDERR ($cmd ? $cmd . ': ' : ''),
+               'unknown/undefined graphic merge tool, abort.', "\n";
+}
+
+if ($rc == 1) {
+  # Merge unresolved
+  print 'You have ', $out, '.', "\n";
+
+} elsif ($rc == 0) {
+  # Merge resolved
+  print 'You ', $out, ' all the changes.', "\n";
+}
+
+exit $rc;
+
+__END__
+
+=head1 NAME
+
+fcm_graphic_merge
+
+=head1 SYNOPSIS
+
+    fcm_graphic_merge BASE MINE OLDER YOURS
+
+=head1 DESCRIPTION
+
+Wrapper script which invokes a graphical merge tool. It returns 0 on
+success, 1 if conflicts not resolved or 2 on failure. (This is similar to
+GNU diff3.) BASE is the file you want to save the merge result into. MINE
+is the original file. YOURS is the file you want MINE to merge with. OLDER
+is the common ancestor of MINE and YOURS.
+
+=head1 COPYRIGHT
+
+(C) Crown copyright Met Office. All rights reserved.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/bin/fcm_gui
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/bin/fcm_gui	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/bin/fcm_gui	(revision 2528)
@@ -0,0 +1,1346 @@
+#!/usr/bin/env perl
+#-------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+#-------------------------------------------------------------------------------
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Cwd;
+use Fcm::Config;
+use Fcm::Keyword;
+use Fcm::Timer;
+use Fcm::Util;
+use File::Basename;
+use File::Spec;
+use Tk;
+use Tk::ROText;
+
+# ------------------------------------------------------------------------------
+
+# Argument
+if (@ARGV) {
+  my $dir = shift @ARGV;
+  chdir $dir if -d $dir;
+}
+
+# Get configuration settings
+my $config = Fcm::Config->new ();
+$config->get_config ();
+
+# ------------------------------------------------------------------------------
+
+# FCM subcommands
+my @subcmds = qw/CHECKOUT BRANCH STATUS DIFF ADD DELETE MERGE CONFLICTS COMMIT
+                 UPDATE SWITCH/;
+
+# Subcommands allowed when CWD is not a WC
+my @nwc_subcmds = qw/CHECKOUT BRANCH/;
+
+# Subcommands allowed, when CWD is a WC
+my @wc_subcmds = qw/STATUS BRANCH DIFF ADD DELETE MERGE CONFLICTS COMMIT UPDATE
+                    SWITCH/;
+
+# Subcommands that apply to WC only
+my @wco_subcmds = qw/BRANCH STATUS DIFF ADD DELETE MERGE CONFLICTS COMMIT UPDATE
+                     SWITCH/;
+
+# Subcommands that apply to top level WC only
+my @wcto_subcmds = qw/BRANCH MERGE COMMIT UPDATE SWITCH/;
+
+# Selected subcommand
+my $selsubcmd = '';
+
+# Selected subcommand is running?
+my $cmdrunning = 0;
+
+# PID of running subcommand
+my $cmdpid = undef;
+
+# List of subcommand frames
+my %subcmd_f;
+
+# List of subcommand buttons
+my %subcmd_b;
+
+# List of subcommand button help strings
+my %subcmd_help = (
+  BRANCH    => 'list information about, create or delete a branch.',
+  CHECKOUT  => 'check out a working copy from a repository.',
+  STATUS    => 'print the status of working copy files and directories.',
+  DIFF      => 'display the differences in modified files.',
+  ADD       => 'put files and directories under version control.',
+  DELETE    => 'remove files and directories from version control.',
+  MERGE     => 'merge changes into your working copy.',
+  CONFLICTS => 'use a graphical tool to resolve conflicts in your working copy.',
+  COMMIT    => 'send changes from your working copy to the repository.',
+  UPDATE    => 'bring changes from the repository into your working copy.',
+  SWITCH    => 'update your working copy to a different URL.',
+);
+
+for (keys %subcmd_help) {
+  $subcmd_help{$_} = 'Select the "' . lc ($_) . '" sub-command - ' .
+                     $subcmd_help{$_};
+}
+
+# List of subcommand button bindings (key name and underline position)
+my %subcmd_bind = (
+  BRANCH    => {KEY => '<Alt-Key-b>', U => 0},
+  CHECKOUT  => {KEY => '<Alt-Key-o>', U => 5},
+  STATUS    => {KEY => '<Alt-Key-s>', U => 0},
+  DIFF      => {KEY => '<Alt-Key-d>', U => 0},
+  ADD       => {KEY => '<Alt-Key-a>', U => 0},
+  DELETE    => {KEY => '<Alt-Key-t>', U => 4},
+  MERGE     => {KEY => '<Alt-Key-m>', U => 0},
+  CONFLICTS => {KEY => '<Alt-Key-f>', U => 3},
+  COMMIT    => {KEY => '<Alt-Key-c>', U => 0},
+  UPDATE    => {KEY => '<Alt-Key-u>', U => 0},
+  SWITCH    => {KEY => '<Alt-Key-w>', U => 1},
+);
+
+# List of subcommand variables
+my %subcmdvar = (
+  CWD       => cwd (),
+  WCT       => '',
+  CWD_URL   => '',
+  WCT_URL   => '',
+
+  BRANCH    => {
+    OPT     => 'info',
+    URL     => '',
+    NAME    => '',
+    TYPE    => 'DEV',
+    REVFLAG => 'NORMAL',
+    REV     => '',
+    TICKET  => '',
+    SRCTYPE => 'trunk',
+    S_CHD   => 0,
+    S_SIB   => 0,
+    S_OTH   => 0,
+    VERBOSE => 0,
+    OTHER   => '',
+  },
+
+  CHECKOUT  => {
+    URL     => '',
+    REV     => 'HEAD',
+    PATH    => '',
+    OTHER   => '',
+  },
+
+  STATUS    => {
+    USEWCT  => 0,
+    UPDATE  => 0,
+    VERBOSE => 0,
+    OTHER   => '',
+  },
+
+  DIFF      => {
+    USEWCT  => 0,
+    TOOL    => 'graphical',
+    BRANCH  => 0,
+    URL     => '',
+    OTHER   => '',
+  },
+
+  ADD       => {
+    USEWCT  => 0,
+    CHECK   => 1,
+    OTHER   => '',
+  },
+
+  DELETE    => {
+    USEWCT  => 0,
+    CHECK   => 1,
+    OTHER   => '',
+  },
+
+  MERGE     => {
+    USEWCT  => 1,
+    SRC     => '',
+    MODE    => 'automatic',
+    DRYRUN  => 0,
+    VERBOSE => 0,
+    REV     => '',
+    OTHER   => '',
+  },
+
+  CONFLICTS => {
+    USEWCT  => 0,
+    OTHER   => '',
+  },
+
+  COMMIT    => {
+    USEWCT  => 1,
+    DRYRUN  => 0,
+    OTHER   => '',
+  },
+
+  UPDATE    => {
+    USEWCT  => 1,
+    OTHER   => '',
+  },
+
+  SWITCH    => {
+    USEWCT  => 1,
+    URL     => '',
+    OTHER   => '',
+  },
+);
+
+# List of action buttons
+my %action_b;
+
+# List of action button help strings
+my %action_help = (
+  QUIT  => 'Quit fcm gui',
+  HELP  => 'Print help to the output text box for the selected sub-command',
+  CLEAR => 'Clear the output text box',
+  RUN   => 'Run the selected sub-command',
+);
+
+# List of action button bindings
+my %action_bind = (
+  QUIT  => {KEY => '<Control-Key-q>', U => undef},
+  HELP  => {KEY => '<F1>'           , U => undef},
+  CLEAR => {KEY => '<Alt-Key-l>'    , U => 1},
+  RUN   => {KEY => '<Alt-Key-r>'    , U => 0},
+);
+
+# List of branch subcommand options
+my %branch_opt = (
+  INFO   => undef,
+  CREATE => undef,
+  DELETE => undef,
+  LIST   => undef,
+);
+
+# List of branch create types
+my %branch_type = (
+  'DEV'         => undef,
+  'DEV::SHARE'  => undef,
+  'TEST'        => undef,
+  'TEST::SHARE' => undef,
+  'PKG'         => undef,
+  'PKG::SHARE'  => undef,
+  'PKG::CONFIG' => undef,
+  'PKG::REL'    => undef,
+);
+
+# List of branch create source type
+my %branch_srctype = (
+  TRUNK  => undef,
+  BRANCH => undef,
+);
+
+# List of branch create revision prefix option
+my %branch_revflag = (
+  NORMAL => undef,
+  NUMBER => undef,
+  NONE   => undef,
+);
+
+# List of branch info/delete options
+my %branch_info_opt = (
+  S_CHD   => 'Show children',
+  S_SIB   => 'Show siblings',
+  S_OTH   => 'Show other',
+  VERBOSE => 'Print extra information',
+);
+
+# List of diff display options
+my %diff_display_opt = (
+  default   => 'Default mode',
+  graphical => 'Graphical tool',
+  trac      => 'Trac (only for diff relative to the base of the branch)',
+);
+
+# Text in the status bar
+my $statustext = '';
+
+# ------------------------------------------------------------------------------
+
+my $mw = MainWindow->new ();
+
+my $mw_title = 'FCM GUI';
+$mw->title ($mw_title);
+
+# Frame containing subcommand selection buttons
+my $top_f = $mw->Frame ()->grid (
+  '-row'    => 0,
+  '-column' => 0,
+  '-sticky' => 'w',
+);
+
+# Frame containing subcommand options
+my $mid_f = $mw->Frame ()->grid (
+  '-row'    => 1,
+  '-column' => 0,
+  '-sticky' => 'ew',
+);
+
+# Frame containing action buttons
+my $bot_f = $mw->Frame ()->grid (
+  '-row'    => 2,
+  '-column' => 0,
+  '-sticky' => 'ew',
+);
+
+# Text box to display output
+my $out_t  = $mw->Scrolled ('ROText', '-scrollbars' => 'osow')->grid (
+  '-row'    => 3,
+  '-column' => 0,
+  '-sticky' => 'news',
+);
+
+# Text box - allow scroll with mouse wheel
+$out_t->bind (
+  '<4>' => sub {
+    $_[0]->yview ('scroll', -1, 'units') unless $Tk::strictMotif;
+  },
+);
+
+$out_t->bind (
+  '<5>' => sub {
+    $_[0]->yview ('scroll', +1, 'units') unless $Tk::strictMotif;
+  },
+);
+
+# Status bar
+$mw->Label (
+  '-textvariable' => \$statustext,
+  '-relief'       => 'groove',
+)->grid (
+  '-row'    => 4,
+  '-column' => 0,
+  '-sticky' => 'ews',
+);
+
+# Main window grid configure
+{
+  my ($cols, $rows) = $mw->gridSize ();
+  $mw->gridColumnconfigure ($_, '-weight' => 1) for (0 .. $cols - 1);
+  $mw->gridRowconfigure    ( 3, '-weight' => 1);
+}
+
+# Frame grid configure
+{
+  my ($cols, $rows) = $mid_f->gridSize ();
+  $bot_f->gridColumnconfigure (3, '-weight' => 1);
+}
+
+$mid_f->gridRowconfigure    (0, '-weight' => 1);
+$mid_f->gridColumnconfigure (0, '-weight' => 1);
+
+# ------------------------------------------------------------------------------
+
+# Buttons to select subcommands
+{
+  my $col = 0;
+  for my $name (@subcmds) {
+    $subcmd_b{$name} = $top_f->Button (
+      '-text'    => uc (substr ($name, 0, 1)) . lc (substr ($name, 1)),
+      '-command' => [\&button_clicked, $name],
+      '-width'   => 8,
+    )->grid (
+      '-row'    => 0,
+      '-column' => $col++,
+      '-sticky' => 'w',
+    );
+
+    $subcmd_b{$name}->bind ('<Enter>', sub {$statustext = $subcmd_help{$name}});
+    $subcmd_b{$name}->bind ('<Leave>', sub {$statustext = ''});
+
+    $subcmd_b{$name}->configure ('-underline' => $subcmd_bind{$name}{U})
+      if defined $subcmd_bind{$name}{U};
+
+    $mw->bind ($subcmd_bind{$name}{KEY}, sub {$subcmd_b{$name}->invoke});
+  }
+}
+
+# ------------------------------------------------------------------------------
+
+# Frames to contain subcommands options
+{
+  my %row = ();
+
+  for my $name (@subcmds) {
+    $subcmd_f{$name} = $mid_f->Frame ();
+    $subcmd_f{$name}->gridColumnconfigure (1, '-weight' => 1);
+
+    $row{$name} = 0;
+
+    # Widgets common to all sub-commands
+    $subcmd_f{$name}->Label ('-text' => 'Current working directory: ')->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Label ('-textvariable' => \($subcmdvar{CWD}))->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'w',
+    );
+  }
+
+  # Widgets common to all sub-commands that apply to working copies
+  for my $name (@wco_subcmds) {
+    my @labtxts = (
+      'Corresponding URL: ',
+      'Working copy top: ',
+      'Corresponding URL: ',
+    );
+    my @varrefs = \(
+      $subcmdvar{URL_CWD},
+      $subcmdvar{WCT},
+      $subcmdvar{URL_WCT},
+    );
+
+    for my $i (0 .. $#varrefs) {
+      $subcmd_f{$name}->Label ('-text' => $labtxts[$i])->grid (
+        '-row'    => $row{$name},
+        '-column' => 0,
+        '-sticky' => 'w',
+      );
+      $subcmd_f{$name}->Label ('-textvariable' => $varrefs[$i])->grid (
+        '-row'    => $row{$name}++,
+        '-column' => 1,
+        '-sticky' => 'w',
+      );
+    }
+
+    $subcmd_f{$name}->Checkbutton (
+      '-text'     => 'Apply sub-command to working copy top',
+      '-variable' => \($subcmdvar{$name}{USEWCT}),
+      '-state'    => (grep ({$_ eq $name} @wcto_subcmds) ? 'disabled' : 'normal'),
+    )->grid (
+      '-row'        => $row{$name}++,
+      '-column'     => 0,
+      '-columnspan' => 2,
+      '-sticky'     => 'w',
+    );
+  }
+
+  # Widget for the Branch sub-command
+  {
+    my $name = 'BRANCH';
+
+    # Radio buttons to select the sub-option of the branch sub-command
+    my $opt_f = $subcmd_f{$name}->Frame ()->grid (
+      '-row'        => $row{$name}++,
+      '-column'     => 0,
+      '-columnspan' => 2,
+      '-sticky'     => 'w',
+    );
+
+    my $col = 0;
+    for my $key (sort keys %branch_opt) {
+      my $opt = lc $key;
+
+      $branch_opt{$key} = $opt_f->Radiobutton (
+        '-text'     => $opt,
+        '-value'    => $opt,
+        '-variable' => \($subcmdvar{$name}{OPT}),
+        '-state'    => 'normal',
+      )->grid (
+        '-row'      => 0,
+        '-column'   => $col++,
+        '-sticky'   => 'w',
+      );
+    }
+
+    # Label and entry box for specifying URL
+    $subcmd_f{$name}->Label ('-text' => 'URL: ')->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{URL}),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+
+    # Label and entry box for specifying create branch name
+    $subcmd_f{$name}->Label (
+      '-text' => 'Branch name (create only): ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{NAME}),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+
+    # Label and entry box for specifying create branch source revision
+    $subcmd_f{$name}->Label (
+      '-text' => 'Source revision (create/list only): ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{REV}),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+
+    # Label and radio buttons box for specifying create branch type
+    $subcmd_f{$name}->Label (
+      '-text' => 'Branch type (create only): ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+
+    {
+      my $opt_f = $subcmd_f{$name}->Frame ()->grid (
+        '-row'    => $row{$name}++,
+        '-column' => 1,
+        '-sticky' => 'w',
+      );
+
+      my $col = 0;
+      for my $key (sort keys %branch_type) {
+        my $txt = lc $key;
+        my $opt = $key;
+
+        $branch_opt{$key} = $opt_f->Radiobutton (
+          '-text'     => $txt,
+          '-value'    => $opt,
+          '-variable' => \($subcmdvar{$name}{TYPE}),
+          '-state'    => 'normal',
+        )->grid (
+          '-row'      => 0,
+          '-column'   => $col++,
+          '-sticky'   => 'w',
+        );
+      }
+    }
+
+    # Label and radio buttons box for specifying create source type
+    $subcmd_f{$name}->Label (
+      '-text' => 'Source type (create only): ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+
+    {
+      my $opt_f = $subcmd_f{$name}->Frame ()->grid (
+        '-row'    => $row{$name}++,
+        '-column' => 1,
+        '-sticky' => 'w',
+      );
+
+      my $col = 0;
+      for my $key (sort keys %branch_srctype) {
+        my $txt = lc $key;
+        my $opt = lc $key;
+
+        $branch_opt{$key} = $opt_f->Radiobutton (
+          '-text'     => $txt,
+          '-value'    => $opt,
+          '-variable' => \($subcmdvar{$name}{SRCTYPE}),
+          '-state'    => 'normal',
+        )->grid (
+          '-row'      => 0,
+          '-column'   => $col++,
+          '-sticky'   => 'w',
+        );
+      }
+    }
+
+    # Label and radio buttons box for specifying create prefix option
+    $subcmd_f{$name}->Label (
+      '-text' => 'Prefix option (create only): ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+
+    {
+      my $opt_f = $subcmd_f{$name}->Frame ()->grid (
+        '-row'    => $row{$name}++,
+        '-column' => 1,
+        '-sticky' => 'w',
+      );
+
+      my $col = 0;
+      for my $key (sort keys %branch_revflag) {
+        my $txt = lc $key;
+        my $opt = $key;
+
+        $branch_opt{$key} = $opt_f->Radiobutton (
+          '-text'     => $txt,
+          '-value'    => $opt,
+          '-variable' => \($subcmdvar{$name}{REVFLAG}),
+          '-state'    => 'normal',
+        )->grid (
+          '-row'      => 0,
+          '-column'   => $col++,
+          '-sticky'   => 'w',
+        );
+      }
+    }
+
+    # Label and entry box for specifying ticket number
+    $subcmd_f{$name}->Label (
+      '-text' => 'Related Trac ticket(s) (create only): ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{TICKET}),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+
+    # Check button for info/delete
+    # --show-children, --show-siblings, --show-other, --verbose
+    $subcmd_f{$name}->Label (
+      '-text' => 'Options for info/delete only: ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+
+    {
+      my $opt_f = $subcmd_f{$name}->Frame ()->grid (
+        '-row'    => $row{$name}++,
+        '-column' => 1,
+        '-sticky' => 'w',
+      );
+
+      my $col = 0;
+
+      for my $key (sort keys %branch_info_opt) {
+        $opt_f->Checkbutton (
+          '-text'     => $branch_info_opt{$key},
+          '-variable' => \($subcmdvar{$name}{$key}),
+        )->grid (
+          '-row'    => 0,
+          '-column' => $col++,
+          '-sticky' => 'w',
+        );
+      }
+    }
+  }
+
+  # Widget for the Checkout sub-command
+  {
+    my $name = 'CHECKOUT';
+
+    # Label and entry boxes for specifying URL and revision
+    my @labtxts = (
+      'URL: ',
+      'Revision: ',
+      'Path: ',
+    );
+    my @varrefs = \(
+      $subcmdvar{$name}{URL},
+      $subcmdvar{$name}{REV},
+      $subcmdvar{$name}{PATH},
+    );
+
+    for my $i (0 .. $#varrefs) {
+      $subcmd_f{$name}->Label ('-text' => $labtxts[$i])->grid (
+        '-row'    => $row{$name},
+        '-column' => 0,
+        '-sticky' => 'w',
+      );
+      $subcmd_f{$name}->Entry (
+        '-textvariable' => $varrefs[$i],
+      )->grid (
+        '-row'    => $row{$name}++,
+        '-column' => 1,
+        '-sticky' => 'ew',
+      );
+    }
+  }
+
+  # Widget for the Status sub-command
+  {
+    my $name = 'STATUS';
+
+    # Checkbuttons for various options
+    my @labtxts = (
+      'Display update information',
+      'Print extra information',
+    );
+    my @varrefs = \(
+      $subcmdvar{$name}{UPDATE},
+      $subcmdvar{$name}{VERBOSE},
+    );
+
+    for my $i (0 .. $#varrefs) {
+      $subcmd_f{$name}->Checkbutton (
+        '-text'     => $labtxts[$i],
+        '-variable' => $varrefs[$i],
+      )->grid (
+        '-row'        => $row{$name}++,
+        '-column'     => 0,
+        '-columnspan' => 2,
+        '-sticky'     => 'w',
+      );
+    }
+  }
+
+  # Widget for the Diff sub-command
+  {
+    my $name = 'DIFF';
+
+    my $entry;
+    $subcmd_f{$name}->Checkbutton (
+      '-text'     => 'Show differences relative to the base of the branch',
+      '-variable' => \($subcmdvar{$name}{BRANCH}),
+      '-command'  => sub {
+        $entry->configure (
+          '-state' => ($subcmdvar{$name}{BRANCH} ? 'normal' : 'disabled'),
+        );
+      },
+    )->grid (
+      '-row'        => $row{$name}++,
+      '-column'     => 0,
+      '-columnspan' => 2,
+      '-sticky'     => 'w',
+    );
+
+    # Label and radio buttons box for specifying tool
+    $subcmd_f{$name}->Label (
+      '-text' => 'Display diff in: ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+
+    {
+      my $opt_f = $subcmd_f{$name}->Frame ()->grid (
+        '-row'    => $row{$name}++,
+        '-column' => 1,
+        '-sticky' => 'w',
+      );
+
+      my $col = 0;
+      for my $key (qw/default graphical trac/) {
+        my $txt = $diff_display_opt{$key};
+        my $opt = $key;
+
+        $branch_opt{$key} = $opt_f->Radiobutton (
+          '-text'     => $txt,
+          '-value'    => $opt,
+          '-variable' => \($subcmdvar{$name}{TOOL}),
+          '-state'    => 'normal',
+        )->grid (
+          '-row'      => 0,
+          '-column'   => $col++,
+          '-sticky'   => 'w',
+        );
+      }
+    }
+
+    $subcmd_f{$name}->Label ('-text' => 'Branch URL')->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+
+    $entry = $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{URL}),
+      '-state'        => ($subcmdvar{$name}{BRANCH} ? 'normal' : 'disabled'),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+  }
+
+  # Widget for the Add/Delete sub-command
+  for my $name (qw/ADD DELETE/) {
+
+    # Checkbuttons for various options
+    $subcmd_f{$name}->Checkbutton (
+      '-text'     => 'Check for files or directories not under version control',
+      '-variable' => \($subcmdvar{$name}{CHECK}),
+    )->grid (
+      '-row'        => $row{$name}++,
+      '-column'     => 0,
+      '-columnspan' => 2,
+      '-sticky'     => 'w',
+    );
+  }
+
+  # Widget for the Merge sub-command
+  {
+    my $name = 'MERGE';
+
+    # Label and radio buttons box for specifying merge mode
+    $subcmd_f{$name}->Label (
+      '-text' => 'Mode: ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+
+    {
+      my $opt_f = $subcmd_f{$name}->Frame ()->grid (
+        '-row'    => $row{$name}++,
+        '-column' => 1,
+        '-sticky' => 'w',
+      );
+
+      my $col = 0;
+      for my $key (qw/automatic custom reverse/) {
+        my $txt = lc $key;
+        my $opt = $key;
+
+        $branch_opt{$key} = $opt_f->Radiobutton (
+          '-text'     => $txt,
+          '-value'    => $opt,
+          '-variable' => \($subcmdvar{$name}{MODE}),
+          '-state'    => 'normal',
+        )->grid (
+          '-row'      => 0,
+          '-column'   => $col++,
+          '-sticky'   => 'w',
+        );
+      }
+    }
+
+    # Check buttons for dry-run
+    $subcmd_f{$name}->Checkbutton (
+      '-text'     => 'Dry run',
+      '-variable' => \($subcmdvar{$name}{DRYRUN}),
+    )->grid (
+      '-row'        => $row{$name}++,
+      '-column'     => 0,
+      '-columnspan' => 2,
+      '-sticky'     => 'w',
+    );
+
+    # Check buttons for verbose mode
+    $subcmd_f{$name}->Checkbutton (
+      '-text'     => 'Print extra information',
+      '-variable' => \($subcmdvar{$name}{VERBOSE}),
+    )->grid (
+      '-row'        => $row{$name}++,
+      '-column'     => 0,
+      '-columnspan' => 2,
+      '-sticky'     => 'w',
+    );
+
+    # Label and entry boxes for specifying merge source
+    $subcmd_f{$name}->Label (
+      '-text' => 'Source (automatic/custom only): ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{SRC}),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+
+    # Label and entry boxes for specifying merge revision (range)
+    $subcmd_f{$name}->Label (
+      '-text' => 'Revision (custom/reverse only): ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{REV}),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+  }
+
+  # Widget for the Commit sub-command
+  {
+    my $name = 'COMMIT';
+
+    # Checkbuttons for various options
+    $subcmd_f{$name}->Checkbutton (
+      '-text'     => 'Dry run',
+      '-variable' => \($subcmdvar{$name}{DRYRUN}),
+    )->grid (
+      '-row'        => $row{$name}++,
+      '-column'     => 0,
+      '-columnspan' => 2,
+      '-sticky'     => 'w',
+    );
+  }
+
+  # Widget for the Switch sub-command
+  {
+    my $name = 'SWITCH';
+
+    # Label and entry boxes for specifying switch URL
+    $subcmd_f{$name}->Label ('-text' => 'URL: ')->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{URL}),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+  }
+
+  # Widgets common to all sub-commands
+  for my $name (@subcmds) {
+    $subcmd_f{$name}->Label ('-text' => 'Other options: ')->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{OTHER}),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+  }
+}
+
+# ------------------------------------------------------------------------------
+
+# Buttons to perform main actions
+{
+  my $col = 0;
+  for my $name (qw/QUIT HELP CLEAR RUN/) {
+    $action_b{$name} = $bot_f->Button (
+      '-text'    => uc (substr ($name, 0, 1)) . lc (substr ($name, 1)),
+      '-command' => [\&button_clicked, $name],
+      '-width'   => 8,
+    )->grid (
+      '-row'    => 0,
+      '-column' => $col++,
+      '-sticky' => ($name eq 'RUN' ? 'ew' : 'w'),
+    );
+
+    $action_b{$name}->bind ('<Enter>', sub {$statustext = $action_help{$name}});
+    $action_b{$name}->bind ('<Leave>', sub {$statustext = ''});
+
+    $action_b{$name}->configure ('-underline' => $action_bind{$name}{U})
+      if defined $action_bind{$name}{U};
+
+    $mw->bind ($action_bind{$name}{KEY}, sub {$action_b{$name}->invoke});
+  }
+}
+
+&change_cwd ($subcmdvar{CWD});
+
+# ------------------------------------------------------------------------------
+
+# Handle the situation when the user attempts to quit the window while a
+# sub-command is running
+
+$mw->protocol ('WM_DELETE_WINDOW', sub {
+  if (defined $cmdpid) {
+    my $ans = $mw->messageBox (
+      '-title'   => $mw_title,
+      '-message' => $selsubcmd . ' is still running. Really quit?',
+      '-type'    => 'YesNo',
+      '-default' => 'No',
+    );
+
+    if ($ans eq 'Yes') {
+      kill 9, $cmdpid; # Need to kill the sub-process before quitting
+
+    } else {
+      return; # Do not quit
+    }
+  }
+
+  exit;
+});
+
+MainLoop;
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &change_cwd ($dir);
+#
+# DESCRIPTION
+#   Change current working directory to $dir
+# ------------------------------------------------------------------------------
+
+sub change_cwd {
+  my $dir = $_[0];
+  my @allowed_subcmds = (&is_wc ($dir) ? @wc_subcmds : @nwc_subcmds);
+
+  for my $subcmd (@subcmds) {
+    if (grep {$_ eq $subcmd} @allowed_subcmds) {
+      $subcmd_b{$subcmd}->configure ('-state' => 'normal');
+
+    } else {
+      $subcmd_b{$subcmd}->configure ('-state' => 'disabled');
+    }
+  }
+
+  &display_subcmd_frame ($allowed_subcmds[0])
+    if not grep {$_ eq $selsubcmd} @allowed_subcmds;
+
+  chdir $dir;
+  $subcmdvar{CWD} = $dir;
+
+  if (&is_wc ($dir)) {
+    $subcmdvar{WCT}     = &get_wct ($dir);
+    $subcmdvar{URL_CWD} = &get_url_of_wc ($dir);
+    $subcmdvar{URL_WCT} = &get_url_of_wc ($subcmdvar{WCT});
+
+    $branch_opt{INFO}  ->configure ('-state' => 'normal');
+    $branch_opt{DELETE}->configure ('-state' => 'normal');
+    $subcmdvar{BRANCH}{OPT} = 'info';
+
+  } else {
+    $branch_opt{INFO}  ->configure ('-state' => 'disabled');
+    $branch_opt{DELETE}->configure ('-state' => 'disabled');
+    $subcmdvar{BRANCH}{OPT} = 'create';
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &button_clicked ($name);
+#
+# DESCRIPTION
+#   Call back function to handle a click on a command button named $name.
+# ------------------------------------------------------------------------------
+
+sub button_clicked {
+  my $name = $_[0];
+
+  if (grep {$_ eq $name} keys %subcmd_b) {
+    &display_subcmd_frame ($name);
+
+  } elsif ($name eq 'CLEAR') {
+    $out_t->delete ('1.0', 'end');
+
+  } elsif ($name eq 'QUIT') {
+    exit;
+
+  } elsif ($name eq 'HELP') {
+    &invoke_cmd ('help ' . lc ($selsubcmd));
+
+  } elsif ($name eq 'RUN') {
+    &invoke_cmd (&setup_cmd ($selsubcmd));
+
+  } else {
+    $out_t->insert ('end', $name . ': function to be implemented' . "\n");
+    $out_t->yviewMoveto (1);
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &display_subcmd_frame ($name);
+#
+# DESCRIPTION
+#   Change selected subcommand to $name, and display the frame containing the
+#   widgets for configuring the options and arguments of that subcommand.
+# ------------------------------------------------------------------------------
+
+sub display_subcmd_frame {
+  my $name = $_[0];
+
+  if ($selsubcmd ne $name and not $cmdrunning) {
+    $subcmd_b{$name     }->configure ('-relief' => 'sunken');
+    $subcmd_b{$selsubcmd}->configure ('-relief' => 'raised') if $selsubcmd;
+
+    $subcmd_f{$name     }->grid ('-sticky' => 'new');
+    $subcmd_f{$selsubcmd}->gridForget if $selsubcmd;
+
+    $selsubcmd = $name;
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $pos = &get_wm_pos ();
+#
+# DESCRIPTION
+#   Returns the position part of the geometry string of the main window.
+# ------------------------------------------------------------------------------
+
+sub get_wm_pos {
+  my $geometry = $mw->geometry ();
+  $geometry =~ /^=?(?:\d+x\d+)?([+-]\d+[+-]\d+)$/;
+  return $1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $command = &setup_cmd ($name);
+#
+# DESCRIPTION
+#   Setup the the system command for the sub-command $name.
+# ------------------------------------------------------------------------------
+
+sub setup_cmd {
+  my $name = $_[0];
+  my $cmd  = '';
+
+  if ($name eq 'BRANCH') {
+    $cmd .= lc ($name);
+    if ($subcmdvar{$name}{OPT} eq 'create') {
+      $cmd .= ' -c --svn-non-interactive';
+      $cmd .= ' -n '     . $subcmdvar{$name}{NAME} if $subcmdvar{$name}{NAME};
+      $cmd .= ' -t '     . $subcmdvar{$name}{TYPE};
+      $cmd .= ' --rev-flag ' . $subcmdvar{$name}{REVFLAG};
+      $cmd .= ' -r ' . $subcmdvar{$name}{REV} if $subcmdvar{$name}{REV};
+      $cmd .= ' -k ' . $subcmdvar{$name}{TICKET} if $subcmdvar{$name}{TICKET};
+      $cmd .= ' --branch-of-branch ' if $subcmdvar{$name}{SRCTYPE} eq 'branch';
+
+    } elsif ($subcmdvar{$name}{OPT} eq 'delete') {
+      $cmd .= ' -v' if $subcmdvar{$name}{VERBOSE};
+      $cmd .= ' -d --svn-non-interactive';
+
+    } elsif ($subcmdvar{$name}{OPT} eq 'list') {
+      $cmd .= ' -l';
+      $cmd .= ' -r ' . $subcmdvar{$name}{REV} if $subcmdvar{$name}{REV};
+
+    } else {
+      $cmd .= ' -i';
+      $cmd .= ' --show-children' if $subcmdvar{$name}{S_CHD};
+      $cmd .= ' --show-siblings' if $subcmdvar{$name}{S_SIB};
+      $cmd .= ' --show-other'    if $subcmdvar{$name}{S_OTH};
+      $cmd .= ' -v' if $subcmdvar{$name}{VERBOSE};
+    }
+    $cmd .= ' ' . $subcmdvar{$name}{URL}   if $subcmdvar{$name}{URL};
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  } elsif ($name eq 'CHECKOUT') {
+    $cmd .= lc ($name);
+    $cmd .= ' -r' . $subcmdvar{$name}{REV} if $subcmdvar{$name}{REV};
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+    $cmd .= ' ' . $subcmdvar{$name}{URL};
+    $cmd .= ' ' . $subcmdvar{$name}{PATH} if $subcmdvar{$name}{PATH};
+
+  } elsif ($name eq 'STATUS') {
+    $cmd .= lc ($name);
+    $cmd .= ' -u' if $subcmdvar{$name}{UPDATE};
+    $cmd .= ' -v' if $subcmdvar{$name}{VERBOSE};
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  } elsif ($name eq 'DIFF') {
+    $cmd .= lc ($name);
+    $cmd .= ' -g' if $subcmdvar{$name}{TOOL} eq 'graphical';
+
+    if ($subcmdvar{$name}{BRANCH}) {
+      $cmd .= ' -b';
+      $cmd .= ' -t' if $subcmdvar{$name}{TOOL} eq 'trac';
+      $cmd .= ' ' . $subcmdvar{$name}{URL} if $subcmdvar{$name}{URL};
+    }
+
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  } elsif ($name eq 'ADD' or $name eq 'DELETE') {
+    $cmd .= lc ($name);
+    $cmd .= ' -c' if $subcmdvar{$name}{CHECK};
+    $cmd .= ' --non-interactive'
+      if $name eq 'DELETE' and not $subcmdvar{$name}{CHECK};
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  } elsif ($name eq 'MERGE') {
+    $cmd .= lc ($name);
+
+    if ($subcmdvar{$name}{MODE} ne 'automatic') {
+      $cmd .= ' --' . $subcmdvar{$name}{MODE};
+      $cmd .= ' --revision ' . $subcmdvar{$name}{REV} if $subcmdvar{$name}{REV};
+    }
+
+    $cmd .= ' --dry-run' if $subcmdvar{$name}{DRYRUN};
+    $cmd .= ' -v'        if $subcmdvar{$name}{VERBOSE};
+    $cmd .= ' ' . $subcmdvar{$name}{SRC}   if $subcmdvar{$name}{SRC};
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  } elsif ($name eq 'CONFLICTS') {
+    $cmd .= lc ($name);
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  } elsif ($name eq 'COMMIT') {
+    $cmd .= lc ($name);
+    $cmd .= ' --dry-run' if $subcmdvar{$name}{DRYRUN};
+    $cmd .= ' --svn-non-interactive';
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  } elsif ($name eq 'SWITCH') {
+    $cmd .= lc ($name);
+    $cmd .= ' ' . $subcmdvar{$name}{URL}   if $subcmdvar{$name}{URL};
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  } elsif ($name eq 'UPDATE') {
+    $cmd .= lc ($name);
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  }
+
+  return $cmd;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &invoke_cmd ($cmd);
+#
+# DESCRIPTION
+#   Invoke the command $cmd.
+# ------------------------------------------------------------------------------
+
+sub invoke_cmd {
+  my $cmd      = $_[0];
+  return unless $cmd;
+
+  my $disp_cmd = 'fcm ' . $cmd;
+  $cmd         = (index ($cmd, 'help ') == 0)
+                 ? $disp_cmd
+                 : ('fcm gui-internal ' . &get_wm_pos () . ' ' . $cmd);
+
+  # Change directory to working copy top if necessary
+  if ($subcmdvar{$selsubcmd}{USEWCT} and $subcmdvar{WCT} ne $subcmdvar{CWD}) {
+    chdir $subcmdvar{WCT};
+    $out_t->insert ('end', 'cd ' . $subcmdvar{WCT} . "\n");
+    $out_t->yviewMoveto (1);
+  }
+
+  # Report start of command
+  $out_t->insert ('end', timestamp_command ($disp_cmd, 'Start'));
+  $out_t->yviewMoveto (1);
+
+  # Open the command as a pipe
+  if ($cmdpid = open CMD, '-|', $cmd . ' 2>&1') {
+    # Disable all action buttons
+    $action_b{$_}->configure ('-state' => 'disabled') for (keys %action_b);
+    $cmdrunning = 1;
+
+    # Set up a file event to read output from the command
+    $mw->fileevent (\*CMD, readable => sub {
+      if (sysread CMD, my ($buf), 1024) {
+        # Insert text into the output text box as it becomes available
+        $out_t->insert ('end', $buf);
+        $out_t->yviewMoveto (1);
+
+      } else {
+        # Delete the file event and close the file when the command finishes
+        $mw->fileevent(\*CMD, readable => '');
+        close CMD;
+        $cmdpid = undef;
+
+        # Check return status
+        if ($?) {
+          $out_t->insert (
+            'end', '"' . $disp_cmd . '" failed (' . $? . ')' . "\n",
+          );
+          $out_t->yviewMoveto (1);
+        }
+
+        # Report end of command
+        $out_t->insert ('end', timestamp_command ($disp_cmd, 'End'));
+        $out_t->yviewMoveto (1);
+
+        # Change back to CWD if necessary
+        if ($subcmdvar{$selsubcmd}{USEWCT} and
+            $subcmdvar{WCT} ne $subcmdvar{CWD}) {
+          chdir $subcmdvar{CWD};
+          $out_t->insert ('end', 'cd ' . $subcmdvar{CWD} . "\n");
+          $out_t->yviewMoveto (1);
+        }
+
+        # Enable all action buttons again
+        $action_b{$_}->configure ('-state' => 'normal') for (keys %action_b);
+        $cmdrunning = 0;
+
+        # If the command is "checkout", change directory to working copy
+        if (lc ($selsubcmd) eq 'checkout' && $subcmdvar{CHECKOUT}{URL}) {
+          my $url = Fcm::Keyword::expand($subcmdvar{CHECKOUT}{URL});
+          my $dir = $subcmdvar{CHECKOUT}{PATH}
+                  ? $subcmdvar{CHECKOUT}{PATH}
+                  : basename $url;
+          $dir    = File::Spec->rel2abs ($dir);
+          &change_cwd ($dir);
+
+        # If the command is "switch", change URL
+        } elsif (lc ($selsubcmd) eq 'switch') {
+          $subcmdvar{URL_CWD} = &get_url_of_wc ($subcmdvar{CWD}, 1);
+          $subcmdvar{URL_WCT} = &get_url_of_wc ($subcmdvar{WCT}, 1);
+        }
+      }
+      1;
+    });
+
+  } else {
+    $mw->messageBox (
+      '-title'   => 'Error',
+      '-message' => 'Error running "' . $cmd . '"',
+      '-icon'    => 'error',
+    );
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+
+__END__
+
+=head1 NAME
+
+fcm_gui
+
+=head1 SYNOPSIS
+
+fcm_gui [DIR]
+
+=head1 DESCRIPTION
+
+The fcm_gui command is a simple graphical user interface for some of the
+commands of the FCM system. The optional argument DIR modifies the initial
+working directory.
+
+=head1 COPYRIGHT
+
+(C) Crown copyright Met Office. All rights reserved.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/bin/fcm_internal
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/bin/fcm_internal	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/bin/fcm_internal	(revision 2528)
@@ -0,0 +1,615 @@
+#!/usr/bin/env perl
+#-------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+#-------------------------------------------------------------------------------
+
+use strict;
+use warnings;
+
+use Fcm::Timer qw{timestamp_command};
+
+# Function declarations
+sub catfile;
+sub basename;
+sub dirname;
+
+# ------------------------------------------------------------------------------
+
+# Module level variables
+my %unusual_tool_name = ();
+
+# ------------------------------------------------------------------------------
+
+MAIN: {
+  # Name of program
+  my $this = basename $0;
+
+  # Arguments
+  my $subcommand = shift @ARGV;
+  my ($function, $type) = split /:/, $subcommand; 
+
+  my ($srcpackage, $src, $target, $requirepp, @objects, @blockdata);
+  
+  if ($function eq 'archive') {
+    ($target, @objects) = @ARGV;
+
+  } elsif ($function eq 'load') {
+    ($srcpackage, $src, $target, @blockdata) = @ARGV;
+
+  } else {
+    ($srcpackage, $src, $target, $requirepp) = @ARGV;
+  }
+
+  # Set up hash reference for all the required information
+  my %info = (
+    SRCPACKAGE => $srcpackage,
+    SRC        => $src,
+    TYPE       => $type,
+    TARGET     => $target,
+    REQUIREPP  => $requirepp,
+    OBJECTS    => \@objects,
+    BLOCKDATA  => \@blockdata,
+  );
+
+  # Get list of unusual tools
+  my $i = 0;
+  while (my $label = &get_env ('FCM_UNUSUAL_TOOL_LABEL' . $i)) {
+    my $value = &get_env ('FCM_UNUSUAL_TOOL_VALUE' . $i);
+    $unusual_tool_name{$label} = $value;
+    $i++;
+  }
+
+  # Invoke the action
+  my $rc = 0;
+  if ($function eq 'compile') {
+    $rc = &compile (\%info);
+
+  } elsif ($function eq 'load') {
+    $rc = &load (\%info);
+
+  } elsif ($function eq 'archive') {
+    $rc = &archive (\%info);
+
+  } else {
+    print STDERR $this, ': incorrect usage, abort';
+    $rc = 1;
+  }
+
+  # Throw error if action failed
+  if ($rc) {
+    print STDERR $this, ' ', $function, ' failed (', $rc, ')', "\n";
+    exit 1;
+
+  } else {
+    exit;
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = &compile (\%info);
+#
+# DESCRIPTION
+#   This method invokes the correct compiler with the correct options to
+#   compile the source file into the required target. The argument $info is a
+#   hash reference set up in MAIN. The following environment variables are
+#   used, where * is the source file type (F for Fortran, and C for C/C++):
+# 
+#   *C          - compiler command
+#   *C_OUTPUT   - *C option to specify the name of the output file
+#   *C_DEFINE   - *C option to declare a pre-processor def
+#   *C_INCLUDE  - *C option to declare an include directory
+#   *C_MODSEARCH- *C option to declare a module search directory
+#   *C_COMPILE  - *C option to ask the compiler to perform compile only
+#   *CFLAGS     - *C user options
+#   *PPKEYS     - list of pre-processor defs (may have sub-package suffix)
+#   FCM_VERBOSE - verbose level
+#   FCM_OBJDIR  - destination directory of object file
+#   FCM_TMPDIR  - temporary destination directory of object file
+# ------------------------------------------------------------------------------
+
+sub compile {
+  my $info = shift;
+
+  # Verbose mode
+  my $verbose = &get_env ('FCM_VERBOSE');
+  $verbose    = 1 unless defined ($verbose);
+
+  my @command = ();
+
+  # Guess file type for backward compatibility
+  my $type = $info->{TYPE} ? $info->{TYPE} : &guess_file_type ($info->{SRC});
+
+  # Compiler
+  push @command, &get_env ($type . 'C', 1);
+
+  # Compile output target (typical -o option)
+  push @command, &get_env ($type . 'C_OUTPUT', 1), $info->{TARGET};
+
+  # Pre-processor definition macros
+  if ($info->{REQUIREPP}) {
+    my @ppkeys = split /\s+/, &select_flags ($info, $type . 'PPKEYS');
+    my $defopt = &get_env ($type . 'C_DEFINE', 1);
+
+    push @command, (map {$defopt . $_} @ppkeys);
+  }
+
+  # Include search path
+  my $incopt  = &get_env ($type . 'C_INCLUDE', 1);
+  my @incpath = split /:/, &get_env ('FCM_INCPATH');
+  push @command, (map {$incopt . $_} @incpath);
+
+  # Compiled module search path
+  my $modopt  = &get_env ($type . 'C_MODSEARCH');
+  if ($modopt) {
+    push @command, (map {$modopt . $_} @incpath);
+  }
+
+  # Other compiler flags
+  my $flags = &select_flags ($info, $type . 'FLAGS');
+  push @command, $flags if $flags;
+
+  my $compile_only = &get_env ($type . 'C_COMPILE');
+  if ($flags !~ /(?:^|\s)$compile_only\b/) {
+    push @command, &get_env ($type . 'C_COMPILE');
+  }
+
+  # Name of source file
+  push @command, $info->{SRC};
+
+  # Execute command
+  my $objdir = &get_env ('FCM_OBJDIR', 1);
+  my $tmpdir = &get_env ('FCM_TMPDIR', 1);
+  chdir $tmpdir;
+
+  my $command = join ' ', @command;
+  if ($verbose > 1) {
+    print 'cd ', $tmpdir, "\n";
+    print &timestamp_command ($command, 'Start');
+
+  } elsif ($verbose) {
+    print $command, "\n";
+  }
+
+  my $rc = system $command;
+
+  print &timestamp_command ($command, 'End  ') if $verbose > 1;
+
+  # Move temporary output to correct location on success
+  # Otherwise, remove temporary output
+  if ($rc) { # error
+    unlink $info->{TARGET};
+
+  } else {   # success
+    print 'mv ', $info->{TARGET}, ' ', $objdir, "\n" if $verbose > 1;
+    rename $info->{TARGET}, &catfile ($objdir, $info->{TARGET});
+  }
+
+  # Move any Fortran module definition files to the INC directory
+  my @modfiles = <*.mod *.MOD>;
+  for my $file (@modfiles) {
+    rename $file, &catfile ($incpath[0], $file);
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = &load (\%info);
+#
+# DESCRIPTION
+#   This method invokes the correct loader with the correct options to link
+#   the main program object into an executable. The argument $info is a hash
+#   reference set up in MAIN. The following environment variables are used:
+# 
+#   LD           - * linker command
+#   LD_OUTPUT    - LD option to specify the name of the output file
+#   LD_LIBSEARCH - LD option to declare a directory in the library search path
+#   LD_LIBLINK   - LD option to declare an object library
+#   LDFLAGS      - LD user options
+#   FCM_VERBOSE  - verbose level
+#   FCM_LIBDIR   - destination directory of object libraries
+#   FCM_OBJDIR   - destination directory of object files
+#   FCM_BINDIR   - destination directory of executable file
+#   FCM_TMPDIR   - temporary destination directory of executable file
+#
+#   * If LD is not set, it will attempt to guess the file type and use the
+#     compiler as the linker.
+# ------------------------------------------------------------------------------
+
+sub load {
+  my $info = shift;
+
+  my $rc = 0;
+
+  # Verbose mode
+  my $verbose = &get_env ('FCM_VERBOSE');
+  $verbose    = 1 unless defined ($verbose);
+
+  # Create temporary object library
+  (my $name   = $info->{TARGET}) =~ s/\.\S+$//;
+  my $libname = '__fcm__' . $name;
+  my $lib     = 'lib' . $libname . '.a';
+  my $libfile = catfile (&get_env ('FCM_LIBDIR', 1), $lib);
+  $rc = &archive ({TARGET => $lib});
+
+  unless ($rc) {
+    my @command = ();
+
+    # Linker
+    my $ld = &select_flags ($info, 'LD');
+    if (not $ld) {
+      # Guess file type for backward compatibility
+      my $type = $info->{TYPE} ? $info->{TYPE} : &guess_file_type ($info->{SRC});
+      $ld = &get_env ($type . 'C', 1);
+    }
+    push @command, $ld;
+
+    # Linker output target (typical -o option)
+    push @command, &get_env ('LD_OUTPUT', 1), $info->{TARGET};
+
+    # Name of main object file
+    my $mainobj = (basename ($info->{SRC}) eq $info->{SRC})
+                  ? catfile (&get_env ('FCM_OBJDIR'), $info->{SRC})
+                  : $info->{SRC};
+    push @command, $mainobj;
+
+    # Link with Fortran BLOCKDATA objects if necessary
+    if (@{ $info->{BLOCKDATA} }) {
+      my @blockdata = @{ $info->{BLOCKDATA} };
+      my @objpath   = split /:/, &get_env ('FCM_OBJPATH');
+
+      # Search each BLOCKDATA object file from the object search path
+      for my $file (@blockdata) {
+        for my $dir (@objpath) {
+          my $full = catfile ($dir, $file);
+
+          if (-r $full) {
+            $file = $full;
+            last;
+          }
+        }
+
+        push @command, $file;
+      }
+    }
+
+    # Library search path
+    my $libopt  = &get_env ('LD_LIBSEARCH', 1);
+    my @libpath = split /:/, &get_env ('FCM_LIBPATH');
+    push @command, (map {$libopt . $_} @libpath);
+
+    # Link with temporary object library if it exists
+    push @command, &get_env ('LD_LIBLINK', 1) . $libname if -f $libfile;
+
+    # Other linker flags
+    my $flags = &select_flags ($info, 'LDFLAGS');
+    push @command, $flags;
+
+    # Execute command
+    my $tmpdir = &get_env ('FCM_TMPDIR', 1);
+    my $bindir = &get_env ('FCM_BINDIR', 1);
+    chdir $tmpdir;
+
+    my $command = join ' ', @command;
+    if ($verbose > 1) {
+      print 'cd ', $tmpdir, "\n";
+      print &timestamp_command ($command, 'Start');
+
+    } elsif ($verbose) {
+      print $command, "\n";
+    }
+
+    $rc = system $command;
+
+    print &timestamp_command ($command, 'End  ') if $verbose > 1;
+
+    # Move temporary output to correct location on success
+    # Otherwise, remove temporary output
+    if ($rc) { # error
+      unlink $info->{TARGET};
+
+    } else {   # success
+      print 'mv ', $info->{TARGET}, ' ', $bindir, "\n" if $verbose > 1;
+      rename $info->{TARGET}, &catfile ($bindir, $info->{TARGET});
+    }
+  }
+
+  # Remove the temporary object library
+  unlink $libfile if -f $libfile;
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = &archive (\%info);
+#
+# DESCRIPTION
+#   This method invokes the library archiver to create an object library. The
+#   argument $info is a hash reference set up in MAIN. The following
+#   environment variables are used:
+# 
+#   AR           - archiver command
+#   ARFLAGS      - AR options to update/create an object library
+#   FCM_VERBOSE  - verbose level
+#   FCM_LIBDIR   - destination directory of object libraries
+#   FCM_OBJPATH  - search path of object files
+#   FCM_OBJDIR   - destination directory of object files
+#   FCM_TMPDIR   - temporary destination directory of executable file
+# ------------------------------------------------------------------------------
+
+sub archive {
+  my $info = shift;
+
+  my $rc = 0;
+
+  # Verbose mode
+  my $verbose = &get_env ('FCM_VERBOSE');
+  $verbose    = 1 unless defined ($verbose);
+
+  # Set up the archive command
+  my $lib     = &basename ($info->{TARGET});
+  my $tmplib  = &catfile (&get_env ('FCM_TMPDIR', 1), $lib);
+  my @ar_cmd  = ();
+  push @ar_cmd, (&get_env ('AR', 1), &get_env ('ARFLAGS', 1));
+  push @ar_cmd, $tmplib;
+
+  # Get object directories and their files
+  my %objdir;
+  if (exists $info->{OBJECTS}) {
+    # List of objects set in the argument, sort into directory/file list
+    for my $name (@{ $info->{OBJECTS} }) {
+      my $dir = (&dirname ($name) eq '.')
+                ? &get_env ('FCM_OBJDIR', 1) : &dirname ($name);
+      $objdir{$dir}{&basename ($name)} = 1;
+    }
+
+  } else {
+    # Objects not listed in argument, search object path for all files
+    my @objpath  = split /:/, &get_env ('FCM_OBJPATH', 1);
+    my %objbase  = ();
+
+    # Get registered objects into a hash (keys = objects, values = 1)
+    my %objects = map {($_, 1)} split (/\s+/, &get_env ('OBJECTS'));
+
+    # Seach object path for all files
+    for my $dir (@objpath) {
+      next unless -d $dir;
+
+      chdir $dir;
+
+      # Use all files from each directory in the object search path
+      for ((glob ('*'))) {
+        next unless exists $objects{$_}; # consider registered objects only
+        $objdir{$dir}{$_} = 1 unless exists $objbase{$_};
+        $objbase{$_} = 1;
+      }
+    }
+  }
+
+  for my $dir (sort keys %objdir) {
+    next unless -d $dir;
+
+    # Go to each object directory and executes the library archive command 
+    chdir $dir;
+    my $command = join ' ', (@ar_cmd, sort keys %{ $objdir{$dir} });
+
+    if ($verbose > 1) {
+      print 'cd ', $dir, "\n";
+      print &timestamp_command ($command, 'Start');
+
+    } else {
+      print $command, "\n" if exists $info->{OBJECTS};
+    }
+
+    $rc = system $command;
+
+    print &timestamp_command ($command, 'End  ')
+      if $verbose > 1;
+    last if $rc;
+  }
+
+  # Move temporary output to correct location on success
+  # Otherwise, remove temporary output
+  if ($rc) { # error
+    unlink $tmplib;
+
+  } else {   # success
+    my $libdir = &get_env ('FCM_LIBDIR', 1);
+
+    print 'mv ', $tmplib, ' ', $libdir, "\n" if $verbose > 1;
+    rename $tmplib, &catfile ($libdir, $lib);
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $type = &guess_file_type ($filename);
+#
+# DESCRIPTION
+#   This function attempts to guess the file type by looking at the extension
+#   of the $filename. Only C and Fortran at the moment.
+# ------------------------------------------------------------------------------
+
+sub guess_file_type {
+  return (($_[0] =~ /\.c(\w+)?$/i) ? 'C' : 'F');
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flags = &select_flags (\%info, $set);
+#
+# DESCRIPTION
+#   This function selects the correct compiler/linker flags for the current
+#   sub-package from the environment variable prefix $set. The argument $info
+#   is a hash reference set up in MAIN.
+# ------------------------------------------------------------------------------
+
+sub select_flags {
+  my ($info, $set) = @_;
+
+  my $srcbase = &basename ($info->{SRC});
+  my @names    = ($set);
+  push @names, split (/__/, $info->{SRCPACKAGE} . '__' . $srcbase);
+
+  my $string = '';
+  for my $i (reverse (0 .. $#names)) {
+    my $var  = &get_env (join ('__', (@names[0 .. $i])));
+
+    $var = &get_env (join ('__', (@names[0 .. $i])))
+      if (not defined ($var)) and $i and $names[-1] =~ s/\.[^\.]+$//;
+
+    next unless defined $var;
+    $string = $var;
+    last;
+  }
+
+  return $string;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $variable = &get_env ($name);
+#   $variable = &get_env ($name, $compulsory);
+#
+# DESCRIPTION
+#   This internal method gets a variable from $ENV{$name}. If $compulsory is
+#   set to true, it throws an error if the variable is a not set or is an empty
+#   string. Otherwise, it returns C<undef> if the variable is not set.
+# ------------------------------------------------------------------------------
+
+sub get_env {
+  (my $name, my $compulsory) = @_;
+  my $string;
+
+  if ($name =~ /^\w+$/) {
+    # $name contains only word characters, variable is exported normally
+    die 'The environment variable "', $name, '" must be set, abort'
+      if $compulsory and not exists $ENV{$name};
+
+    $string = exists $ENV{$name} ? $ENV{$name} : undef;
+
+  } else {
+    # $name contains unusual characters
+    die 'The environment variable "', $name, '" must be set, abort'
+      if $compulsory and not exists $unusual_tool_name{$name};
+
+    $string = exists $unusual_tool_name{$name}
+              ? $unusual_tool_name{$name} : undef;
+  }
+
+  return $string;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $path = &catfile (@paths);
+#
+# DESCRIPTION
+#   This is a local implementation of what is in the File::Spec module.
+# ------------------------------------------------------------------------------
+
+sub catfile {
+  my @names = split (m!/!, join ('/', @_));
+  my $path  = shift @names;
+
+  for my $name (@names) {
+    $path .= '/' . $name if $name;
+  }
+
+  return $path;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $basename = &basename ($path);
+#
+# DESCRIPTION
+#   This is a local implementation of what is in the File::Basename module.
+# ------------------------------------------------------------------------------
+
+sub basename {
+  my $name = $_[0];
+
+  $name =~ s{/*$}{}; # remove trailing slashes
+
+  if ($name =~ m#.*/([^/]+)$#) {
+    return $1;
+
+  } else {
+    return $name;
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $dirname = &dirname ($path);
+#
+# DESCRIPTION
+#   This is a local implementation of what is in the File::Basename module.
+# ------------------------------------------------------------------------------
+
+sub dirname {
+  my $name = $_[0];
+
+  if ($name =~ m#^/+$#) {
+    return '/'; # dirname of root is root
+
+  } else {
+    $name =~ s{/*$}{}; # remove trailing slashes
+
+    if ($name =~ m#^(.*)/[^/]+$#) {
+      my $dir = $1;
+      $dir =~ s{/*$}{}; # remove trailing slashes
+      return $dir;
+
+    } else {
+      return '.';
+    }
+  }
+}
+
+# ------------------------------------------------------------------------------
+
+__END__
+
+=head1 NAME
+
+fcm_internal
+
+=head1 SYNOPSIS
+
+    fcm_internal SUBCOMMAND ARGS
+
+=head1 DESCRIPTION
+
+The fcm_internal command is a frontend for some of the internal commands of
+the FCM build system. The subcommand can be "compile", "load" or "archive"
+for invoking the compiler, loader and library archiver respectively. If
+"compile" or "load" is specified, it can be suffixed with ":TYPE" to
+specify the nature of the source file. If TYPE is not specified, it is set
+to C if the file extension begins with ".c". For all other file types, it
+is set to F (for Fortran source). For compile and load, the other arguments
+are 1) the name of the container package of the source file, 2) the path to
+the source file and 3) the target name after compiling or loading the
+source file. For compile, the 4th argument is a flag to indicate whether
+pre-processing is required for compiling the source file.  For load, the
+4th and the rest of the arguments is a list of object files that cannot be
+archived into the temporary load library and must be linked into the target
+through the linker command. (E.g. Fortran BLOCKDATA program units must be
+linked this way.) If archive is specified, the first argument should be the
+name of the library archive target and the rest should be the object files
+to be included in the archive. This command is invoked via the build system
+and should never be called directly by the user.
+
+=head1 COPYRIGHT
+
+(C) Crown copyright Met Office. All rights reserved.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/bin/fcm_setup_konqueror
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/bin/fcm_setup_konqueror	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/bin/fcm_setup_konqueror	(revision 2528)
@@ -0,0 +1,47 @@
+#!/bin/sh
+# ------------------------------------------------------------------------------
+# NAME
+#   fcm_setup_konqueror
+#
+# SYNOPSIS
+#   fcm_setup_konqueror
+#
+# DESCRIPTION
+#   Set up Konqueror to use "fcm gui".
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+# Check number of arguments
+script=`basename $0`
+usage="$script: no argument required"
+if (( $# != 0 )); then
+  echo "$usage, abort..." >&2
+  exit 1
+fi
+
+filename=fcm_gui.desktop
+
+file=`dirname $0`
+if [[ `basename $file` = bin ]]; then
+  file=`dirname $file`
+fi
+file=$file/etc/$filename
+
+if [[ ! -f $file ]]; then
+  echo "$script: $file not found, abort..." >&2
+  exit 1
+fi
+
+dir=$HOME/.kde/share/applnk/.hidden
+mkdir -p $dir
+cd $dir
+rm -f $filename             # Always remove.
+ln -s $file .
+
+echo "$script: finished"
+
+#EOF
Index: trunk/NEMOGCM/EXTERNAL/fcm/bin/fcm_update_version_dir.pl
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/bin/fcm_update_version_dir.pl	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/bin/fcm_update_version_dir.pl	(revision 2528)
@@ -0,0 +1,289 @@
+#!/usr/bin/env perl
+#-------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+#-------------------------------------------------------------------------------
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Cwd qw{cwd};
+use Getopt::Long qw{GetOptions};
+use Fcm::Config;
+use Fcm::Keyword;
+use Fcm::Util qw{get_url_of_wc get_wct is_wc run_command tidy_url};
+use File::Basename qw{basename dirname};
+use File::Path qw{mkpath};
+use File::Spec;
+use Pod::Usage qw{pod2usage};
+
+# Usage
+# ------------------------------------------------------------------------------
+my $this  = basename($0);
+
+# Options
+# ------------------------------------------------------------------------------
+my ($dest, $full, $help, $url);
+my $rc = GetOptions(
+  'dest|d=s' => \$dest,
+  'full|f'   => \$full,
+  'help'     => \$help,
+  'url|u=s'  => \$url,
+);
+if (!$rc) {
+  pod2usage({'-verbose' => 1});
+}
+if ($help) {
+  pod2usage({'-exitval' => 0, '-verbose' => 1});
+}
+if (!$url) {
+  pod2usage(
+    {'-message' => 'The --url=URL option is compulsory', '-verbose' => 1},
+  );
+}
+$dest ||= cwd();
+
+# Arguments
+# ------------------------------------------------------------------------------
+if (@ARGV) {
+  die 'Cannot read: ', $ARGV[0], ', abort' unless -f $ARGV[0] and -r $ARGV[0];
+}
+
+# Get configuration settings
+# ------------------------------------------------------------------------------
+my $config = Fcm::Config->new ();
+$config->get_config ();
+
+# Expand URL keyword
+$url = Fcm::Util::tidy_url(Fcm::Keyword::expand($url));
+
+# ------------------------------------------------------------------------------
+
+MAIN: {
+  my $date = localtime;
+  print $this, ': started on ', $date, "\n";
+
+  my %dirs;
+
+  # Read input (file) for a list directories and update conditions
+  while (<>) {
+    chomp;
+
+    # Ignore empty and comment lines
+    next if /^\s*(?:#|$)/;
+
+    # Each line must contain a relative path, and optionally a list of
+    # space delimited conditions
+    my @words = split /\s+/;
+    my $dir   = shift @words;
+
+    # Check that the conditions are valid
+    my @conditions;
+    for my $word (@words) {
+      if ($word =~ /^([<>]=?|[!=]=)(.+)$/i) {
+        # Condition must be a conditional operator followed by a revision
+        my ($operator, $rev) = ($1, $2);
+        $rev = (Fcm::Keyword::expand($url, $rev))[1];
+        push @conditions, $operator . $rev;
+
+      } else {
+        print STDERR 'Warning: ignore unknown syntax for update condition: ',
+                     $word, "\n";
+      }
+    }
+
+    # Add directory and its conditions to a hash
+    if ($dir =~ s#/\*$##) { # Directory finishes with wildcard
+
+      # Run "svn ls" in recursive mode
+      my $dirurl  = join ('/', ($url, $dir));
+      my @files   = &run_command ([qw/svn ls -R/, $dirurl], METHOD => 'qx');
+
+      # Find directories containing regular files
+      while (my $file = shift @files) {
+	# Skip directories
+	next if $file =~ m#/$#;
+
+	# Get "dirname" of regular file and add to hash
+	my $subdir = join ('/', ($dir, dirname ($file)));
+	$dirs{$subdir} = \@conditions;
+      }
+
+    } else {
+      $dirs{$dir} = \@conditions;
+    }
+
+  }
+
+  # Update each directory, if required
+  for my $dir (sort keys %dirs) {
+    # Use "svn log" to determine the revisions that need to be updated
+    my %allversions;
+    {
+      my $command = 'svn log -q ' . join ('/', ($url, $dir));
+      my @log     = &run_command (
+        [qw/svn log -q/, join ('/', ($url, $dir))], METHOD => 'qx',
+      );
+      @log        = grep /^r\d+/, @log;
+
+      # Assign a sequential "version" number to each sub-directory
+      my $version = scalar @log;
+      for (@log) {
+        m/^r(\d+)/;
+        $allversions{$1} = 'v' . $version--;
+      }
+    }
+    my %versions = %allversions;
+
+    # Extract only revisions matching the conditions
+    if (@{ $dirs{$dir} }) {
+      my @conditions = @{ $dirs{$dir} };
+
+      for my $condition (@conditions) {
+        for my $rev (keys %versions) {
+          delete $versions{$rev} unless eval ($rev . $condition);
+        }
+      }
+    }
+
+    # Destination directory
+    my $dirpath = File::Spec->catfile ($dest, $dir);
+
+    if (-d $dirpath) {
+      if ($full or not keys %versions) {
+        # Remove destination directory top, in full mode
+        # or if there are no matching revisions
+        &run_command ([qw/rm -rf/, $dirpath], PRINT => 1);
+
+      } else {
+        # Delete excluded revisions if they exist, in incremental mode
+        if (opendir DIR, $dirpath) {
+          while (my $rev = readdir 'DIR') {
+            next unless $rev =~ /^\d+$/;
+
+            if (not grep {$_ eq $rev} keys %versions) {
+              my @command = (qw/rm -rf/, File::Spec->catfile ($dirpath, $rev));
+              &run_command (\@command, PRINT => 1);
+
+              # Remove "version" symlink
+              my $verlink = File::Spec->catfile ($dirpath, $allversions{$rev});
+              unlink $verlink if -l $verlink;
+            }
+          }
+          closedir DIR;
+        }
+      }
+    }
+
+    # Create container directory of destination if it does not already exist
+    if (keys %versions and not -d $dirpath) {
+      print '-> mkdir -p ', $dirpath, "\n";
+      my $rc = mkpath $dirpath;
+      die 'mkdir -p ', $dirpath, ' failed' unless $rc;
+    }
+
+    # Update each version directory that needs updating
+    for my $rev (keys %versions) {
+      my $revpath = File::Spec->catfile ($dest, $dir, $rev);
+
+      # Create version directory if it does not exist
+      if (not -e $revpath) {
+        # Use "svn export" to create the version directory
+        my @command = (
+          qw/svn export -q -r/,
+          $rev,
+          join ('/', ($url, $dir)),
+          $revpath,
+        );
+
+        &run_command (\@command, PRINT => 1);
+      }
+
+      # Create "version" symlink if necessary
+      my $verlink = File::Spec->catfile ($dest, $dir, $versions{$rev});
+      symlink $rev, $verlink unless -l $verlink;
+    }
+
+    # Symbolic link to the "latest" version directory
+    my $headlink = File::Spec->catfile ($dest, $dir, 'latest');
+    my $headrev  = 0;
+    for my $rev (keys %versions) {
+      $headrev = $rev if $rev > $headrev;
+    }
+
+    if (-l $headlink) {
+      # Remove old symbolic link if there is no revision to update or if it
+      # does not point to the correct version directory
+      my $org = readlink $headlink;
+      unlink $headlink if (! $headrev or $org ne $headrev);
+    }
+
+    # (Re-)create the "latest" symbolic link, if necessary
+    symlink $headrev, $headlink if ($headrev and not -l $headlink);
+  }
+
+  $date = localtime;
+  print $this, ': finished normally on ', $date, "\n";
+}
+
+__END__
+
+=head1 NAME
+
+fcm_update_version_dir.pl
+
+=head1 SYNOPSIS
+
+    fcm_update_version_dir.pl [OPTIONS] [CFGFILE]
+
+=head1 DESCRIPTION
+
+Update the version directories for a list of relative paths in the source
+repository URL.
+
+=head1 OPTIONS
+
+=over 4
+
+=item --dest=DEST, -d DEST
+
+Specify a destination for the extraction. If not specified, the command extracts
+to the current working directory.
+
+=item --help, -h
+
+Print help and exit.
+
+=item --full, -f
+
+Specify the full mode. If not specified, the command runs in incremental mode.
+
+=item --url=URL, -u URL
+
+Specify the source repository URL. No default.
+
+=back
+
+=head1 ARGUMENTS
+
+A configuration file may be given to this command, or it will attempt to read
+from the standard input. Each line in the configuration must contain a relative
+path that resides under the given source repository URL. (Empty lines and lines
+beginning with a "#" are ignored.) Optionally, each relative path may be
+followed by a list of space separated "conditions".  Each condition is a
+conditional operator (>, >=, <, <=, == or !=) followed by a revision number or
+the keyword HEAD. The command uses the revision log to determine the revisions
+at which the relative path has been updated in the source repository URL. If
+these revisions also satisfy the "conditions" set by the user, they will be
+considered in the extraction.  In full mode, everything is re-extracted. In
+incremental mode, the version directories are only updated if they do not
+already exist.
+
+=head1 COPYRIGHT
+
+(C) Crown copyright Met Office. All rights reserved.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/etc/fcm.cfg.eg
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/etc/fcm.cfg.eg	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/etc/fcm.cfg.eg	(revision 2528)
@@ -0,0 +1,266 @@
+# ------------------------------------------------------------------------------
+# FCM central configuration file
+# ------------------------------------------------------------------------------
+
+# ------------------------------------------------------------------------------
+# Standard repository locations
+# ------------------------------------------------------------------------------
+
+# 3dVOM repository
+set::url::3dvom              svn://fcm9/3dVOM_svn/3dVOM
+
+# AAPP repository
+set::url::aapp               svn://fcm7/AAPP_svn/AAPP
+
+# AMV repository
+set::url::amv                svn://fcm7/AMV_svn/AMV
+
+# ANCIL repository
+set::url::ancil              svn://fcm8/ANCIL_svn/ANCIL
+
+# ATSR repository
+set::url::atsr               svn://fcm7/ATSR_svn/ATSR
+
+# BLASIUS repository
+set::url::blasius            svn://fcm2/BLASIUS_svn/BLASIUS		      
+
+# CICE repository
+set::url::cice               svn://fcm3/CICE_svn/CICE
+
+# CMA repository
+set::url::cma                svn://fcm9/CMA_svn/CMA
+
+# CVC repository
+set::url::cvc_admin          svn://fcm6/CVC_svn/Admin
+set::url::bufr               svn://fcm6/CVC_svn/BUFR
+set::url::bullseye           svn://fcm6/CVC_svn/Bullseye
+set::url::cat                svn://fcm6/CVC_svn/CAT
+set::url::deicing            svn://fcm6/CVC_svn/Deicing
+set::url::ea                 svn://fcm6/CVC_svn/EA  
+set::url::ensemble           svn://fcm6/CVC_svn/Ensemble
+set::url::gales              svn://fcm6/CVC_svn/Gales
+set::url::ifv                svn://fcm6/CVC_svn/IFV
+set::url::mogreps            svn://fcm6/CVC_svn/MOGREPS
+set::url::openroad           svn://fcm6/CVC_svn/OpenRoad
+set::url::powertable         svn://fcm6/CVC_svn/PowerTable
+set::url::qnh                svn://fcm6/CVC_svn/QNH
+set::url::tafs               svn://fcm6/CVC_svn/TAFS
+set::url::warnings           svn://fcm6/CVC_svn/WARNINGS
+
+# DA repository
+set::url::da                 svn://fcm5/DA_svn/DA
+
+# ENS repository
+set::url::ens                svn://fcm9/ENS_svn/ENS
+
+# ERSEM repository
+set::url::ersem              svn://fcm3/ERSEM_svn/ERSEM
+set::url::ersem_pml          svn://fcm3/ERSEM_svn/ERSEM_PML
+
+# FCM repository
+set::url::fcm                svn://fcm1/FCM_svn/FCM
+set::url::fcm_admin          svn://fcm1/FCM_svn/Admin
+
+
+# FLUME repository
+set::url::flume_metadata     svn://fcm2/FLUME_svn/metadata
+set::url::flume_framework    svn://fcm2/FLUME_svn/framework
+set::url::flume_models       svn://fcm2/FLUME_svn/models
+set::url::flume_jobs         svn://fcm2/FLUME_svn/jobs
+
+# FORMOST repository
+set::url::formost_local      svn://fcm9/FORMOST_svn/FORMOST_LOCAL
+set::url::formost_remote     svn://fcm9/FORMOST_svn/FORMOST_REMOTE
+
+# GEN repository
+set::url::gen                svn://fcm1/GEN_svn/GEN
+
+# GS repository
+set::url::gs                 svn://fcm9/GS_svn/GS
+
+# HadGOA repository
+set::url::hadgoa             svn://fcm9/HadGOA_svn/HadGOA
+
+# HadISD repository
+set::url::hadisd_gen         svn://fcm9/HadISD_svn/general
+set::url::hadisd_homog       svn://fcm9/HadISD_svn/homogenisation
+set::url::hadisd_qc          svn://fcm9/HadISD_svn/quality_control
+
+# IRIS repository
+set::url::iris               svn://fcm9/IRIS_svn/IRIS
+
+# LEM repository
+set::url::lem                svn://fcm2/LEM_svn/LEM
+
+# LINK repository
+set::url::link               svn://fcm1/LINK_svn/LINK
+
+# MASS_MIG repository
+set::url::mass_mig           svn://fcm9/MASS_MIG_svn/MASS_MIG
+
+# MOOSE repository
+set::url::moose              svn://fcm9/MOOSE_svn/MOOSE
+
+# MOSIG repository
+set::url::mosig              svn://fcm9/MOSIG_svn/MOSIG
+
+# MUMTI repository
+set::url::mumti              svn://fcm1/MUMTI_svn/Project
+
+# NEMO repository
+set::url::nemosys            svn://fcm3/NEMO_svn/NEMOSYS
+set::url::nemovar            svn://fcm3/NEMO_svn/NEMOVAR
+set::url::nemo               svn://fcm3/NEMO_svn/NEMO
+set::url::ioipsl             svn://fcm3/NEMO_svn/IOIPSL
+set::url::ocnasm             svn://fcm3/NEMO_svn/OCNASM
+set::url::nemoukmo           svn://fcm3/NEMO_svn/UKMO
+
+# NWPSAF repository
+
+set::url::meto_1dvar         svn://fcm7/NWPSAF_svn/MetOffice_1DVar		   
+set::url::ssmis_1dvar        svn://fcm7/NWPSAF_svn/ssmis_1DVar		   
+set::url::ssmis_pp           svn://fcm7/NWPSAF_svn/ssmis_PP		   
+
+# NWPWEB repository
+set::url::www_nwp            svn://fcm1/NWPWEB_svn/www_nwp
+
+# obsmon repository
+set::url::obsmon_dc          svn://fcm4/obsmon_svn/DC
+set::url::obsmon_rtm         svn://fcm4/obsmon_svn/RTM
+
+# ODB repository
+set::url::odb                svn://fcm4/ODB_svn/ODB
+
+# OCN repository
+set::url::polcoms            svn://fcm3/OCN_svn/POLCOMS
+
+# OPFC repository
+set::url::opfc               svn://fcm9/OPFC_svn/OPFC
+
+# OPS repository
+set::url::ops                svn://fcm4/OPS_svn/OPS
+set::url::ops_admin          svn://fcm4/OPS_svn/Admin
+set::url::ops_data           svn://fcm4/OPS_svn/Data
+set::url::ops_external       svn://fcm4/OPS_svn/External
+
+# OSTIA repository
+set::url::ostia              svn://fcm3/OSTIA_svn/OSTIA
+
+# PF repository
+set::url::pf                 svn://fcm5/PF_svn/PF
+
+# PostProc repository
+set::url::pp                 svn://fcm9/PostProc_svn/PostProc
+set::url::ppancil            svn://fcm9/PostProc_svn/PostProcAncil
+set::url::ppvssps            svn://fcm9/PostProc_svn/VerificationSSPS
+
+# PRISM repository
+set::url::oasis3             svn://fcm2/PRISM_svn/OASIS3
+set::url::oasis4             svn://fcm2/PRISM_svn/OASIS4
+set::url::prism_ukmo         svn://fcm2/PRISM_svn/PRISM_UKMO
+
+# radarnet repository
+set::url::radarnet4          svn://fcm9/radarnet_svn/radarnet4
+
+# RADSAT repository
+set::url::polar              svn://fcm7/RADSAT_svn/POLAR
+set::url::radsat             svn://fcm7/RADSAT_svn/RADSAT
+
+# ROPP repository
+set::url::ropp_doc           svn://fcm7/ROPP_svn/ropp_doc
+set::url::ropp_src           svn://fcm7/ROPP_svn/ropp_src
+set::url::ropp_test          svn://fcm7/ROPP_svn/ropp_test
+set::url::ropp_web           svn://fcm7/ROPP_svn/ropp_web
+
+# RTTOV repository
+set::url::rttov              svn://fcm7/RTTOV_svn/RTTOV 
+set::url::rttov8             svn://fcm7/RTTOV_svn/RTTOV8
+set::url::rttov9             svn://fcm7/RTTOV_svn/RTTOV9
+
+# SAUtils repository
+set::url::autoscat_global    svn://fcm7/SAUtils_svn/AUTOSCAT_Global
+set::url::autoscat_nae       svn://fcm7/SAUtils_svn/AUTOSCAT_NAE
+set::url::climetop           svn://fcm7/SAUtils_svn/CLIMETOP
+set::url::dataflow           svn://fcm7/SAUtils_svn/DataFlow
+set::url::gpsiwv_mon         svn://fcm7/SAUtils_svn/GPSIWV_Mon
+set::url::gpswv_nrt          svn://fcm7/SAUtils_svn/GPSWV_NRT
+set::url::gpsro_mon          svn://fcm7/SAUtils_svn/GPSRO_Mon
+set::url::iasi_mon           svn://fcm7/SAUtils_svn/IASI_Mon
+set::url::metstrike          svn://fcm7/SAUtils_svn/METSTRIKE
+set::url::scatwind_mon       svn://fcm7/SAUtils_svn/Scatwind_Mon
+
+# SBV repository
+set::url::sbv                svn://fcm6/SBV_svn/SBV
+set::url::sbv_admin          svn://fcm6/SBV_svn/Admin
+
+# SCS repository
+set::url::scs                svn://fcm1/SCS_svn/SCS
+set::url::scs_admin          svn://fcm1/SCS_svn/Admin
+set::url::tik                svn://fcm1/SCS_svn/TIK
+set::url::tt                 svn://fcm1/SCS_svn/TT
+
+# SPS repository
+set::url::sps                svn://fcm7/SPS_svn/SPS
+set::url::tigger             svn://fcm7/SPS_svn/Tigger
+set::url::sps_archive        svn://fcm7/SPS_svn/Archive
+
+# SURF repository
+set::url::surf               svn://fcm8/SURF_svn/SURF
+
+# SWARV repository
+set::url::swarv              svn://fcm9/SWARV_svn/SWARV
+
+# test repository
+set::url::test               svn://fcm1/test_svn/OPS
+
+# tutorial repository
+set::url::tutorial           svn://fcm1/tutorial_svn/tutorial
+
+# THORPEX repository
+set::url::thorpex            svn://fcm9/ENS_svn/ENS
+
+# TRUI repository
+set::url::trui               svn://fcm1/TRUI_svn/TRUI
+
+# UM repository
+set::url::um                 svn://fcm2/UM_svn/UM
+set::url::um_admin           svn://fcm2/UM_svn/Admin
+set::url::gcom               svn://fcm2/UM_svn/GCOM
+
+# UM tutorial repository
+set::url::um_tutorial        svn://fcm2/UM_TUTORIAL_svn/UM
+
+# utils repository
+set::url::app_publications   svn://fcm9/utils_svn/APP_publications
+set::url::asyncios           svn://fcm9/utils_svn/asyncIOS
+set::url::avapps_coldsoak    svn://fcm9/utils_svn/avapps_coldsoak
+set::url::avapps_verCB       svn://fcm9/utils_svn/avapps_verCB
+set::url::crmtest            svn://fcm9/utils_svn/cr_model_testing
+set::url::cr_valnote         svn://fcm9/utils_svn/cr_validation_note
+set::url::fray_utils         svn://fcm9/utils_svn/fray_utils
+set::url::hpss_tests         svn://fcm9/utils_svn/HPSS_tests
+set::url::jules_benchmarking svn://fcm9/utils_svn/jules_benchmarking
+set::url::jules_standalone   svn://fcm9/utils_svn/jules_standalone
+set::url::kid                svn://fcm9/utils_svn/KiD
+set::url::numerical_methods  svn://fcm9/utils_svn/numerical_methods
+set::url::wavefc             svn://fcm9/utils_svn/wave_forecasting
+
+# VAR repository
+set::url::var                svn://fcm5/VAR_svn/VAR
+set::url::var_admin          svn://fcm5/VAR_svn/Admin
+set::url::var_data           svn://fcm5/VAR_svn/Data
+
+# VER repository
+set::url::ver                svn://fcm6/VER_svn/VER
+set::url::ver_admin          svn://fcm6/VER_svn/Admin
+set::url::ver_archive        svn://fcm6/VER_svn/Archive
+
+# VMM repository
+set::url::vmm                svn://fcm9/VMM_svn/VMM
+
+# WW3 repository
+set::url::ww3                svn://fcm3/WW3_svn/WW3
+set::url::ww3_config         svn://fcm3/WW3_svn/WW3CONFIG
+set::url::ww3_utils          svn://fcm3/WW3_svn/WW3UTILS
+
+# EOF
Index: trunk/NEMOGCM/EXTERNAL/fcm/etc/fcm_gui.desktop
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/etc/fcm_gui.desktop	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/etc/fcm_gui.desktop	(revision 2528)
@@ -0,0 +1,13 @@
+[Desktop Entry]
+Comment=
+Exec=fcm gui %f
+Hidden=false
+Icon=wizard
+MimeType=inode/directory
+Name=FCM GUI
+Path=
+Terminal=0
+TerminalOptions=
+Type=Application
+X-KDE-SubstituteUID=false
+X-KDE-Username=
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Base.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Base.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Base.pm	(revision 2528)
@@ -0,0 +1,112 @@
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::Base
+#
+# DESCRIPTION
+#   This is base class for all FCM OO packages.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::Base;
+
+# Standard pragma
+use strict;
+use warnings;
+
+use Fcm::Config;
+
+my @scalar_properties = (
+  'config', # instance of Fcm::Config, configuration setting
+);
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = Fcm::Base->new;
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::Base class.
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self  = {};
+  for (@scalar_properties) {
+    $self->{$_} = exists $args{uc ($_)} ? $args{uc ($_)} : undef;
+  }
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @scalar_properties.
+# ------------------------------------------------------------------------------
+
+for my $name (@scalar_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    # Argument specified, set property to specified argument
+    if (@_) {
+      $self->{$name} = $_[0];
+    }
+
+    # Default value for property
+    if (not defined $self->{$name}) {
+      if ($name eq 'config') {
+        # Configuration setting of the main program
+        $self->{$name} = Fcm::Config->instance();
+      }
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $self->setting (@args); # $self->config->setting
+#   $value = $self->verbose (@args); # $self->config->verbose
+# ------------------------------------------------------------------------------
+
+for my $name (qw/setting verbose/) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+    return $self->config->$name (@_);
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $self->cfglabel (@args);
+#
+# DESCRIPTION
+#   This is an alias to $self->config->setting ('CFG_LABEL', @args);
+# ------------------------------------------------------------------------------
+
+sub cfglabel {
+  my $self = shift;
+  return $self->setting ('CFG_LABEL', @_);
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Build.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Build.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Build.pm	(revision 2528)
@@ -0,0 +1,1606 @@
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::Build
+#
+# DESCRIPTION
+#   This is the top level class for the FCM build system.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+use strict;
+use warnings;
+
+package Fcm::Build;
+use base qw(Fcm::ConfigSystem);
+
+use Carp             qw{croak}                                       ;
+use Cwd              qw{cwd}                                         ;
+use Fcm::BuildSrc                                                    ;
+use Fcm::BuildTask                                                   ;
+use Fcm::Config                                                      ;
+use Fcm::Dest                                                        ;
+use Fcm::CfgLine                                                     ;
+use Fcm::Timer       qw{timestamp_command}                           ;
+use Fcm::Util        qw{expand_tilde run_command touch_file w_report};
+use File::Basename   qw{dirname}                                     ;
+use File::Spec                                                       ;
+use List::Util       qw{first}                                       ;
+use Text::ParseWords qw{shellwords}                                  ;
+
+# List of scalar property methods for this class
+my @scalar_properties = (
+  'name',    # name of this build
+  'target',  # targets of this build
+);
+
+# List of hash property methods for this class
+my @hash_properties = (
+  'srcpkg',      # source packages of this build
+  'dummysrcpkg', # dummy for handling package inheritance with file extension
+);
+
+# List of compare_setting_X methods
+my @compare_setting_methods = (
+  'compare_setting_bld_blockdata', # program executable blockdata dependency
+  'compare_setting_bld_dep',       # custom dependency setting
+  'compare_setting_bld_dep_excl',  # exclude dependency setting
+  'compare_setting_bld_dep_n',     # no dependency check
+  'compare_setting_bld_dep_pp',    # custom PP dependency setting
+  'compare_setting_bld_dep_exe',   # program executable extra dependency
+  'compare_setting_bld_exe_name',  # program executable rename
+  'compare_setting_bld_pp',        # PP flags
+  'compare_setting_infile_ext',    # input file extension
+  'compare_setting_outfile_ext',   # output file extension
+  'compare_setting_tool',          # build tool settings
+);
+
+my $DELIMITER_LIST = $Fcm::Config::DELIMITER_LIST;
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = Fcm::Build->new;
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::Build class.
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = Fcm::ConfigSystem->new (%args);
+
+  $self->{$_} = undef for (@scalar_properties);
+
+  $self->{$_} = {} for (@hash_properties);
+
+  bless $self, $class;
+
+  # List of sub-methods for parse_cfg
+  push @{ $self->cfg_methods }, (qw/target source tool dep misc/);
+
+  # Optional prefix in configuration declaration
+  $self->cfg_prefix ($self->setting (qw/CFG_LABEL BDECLARE/));
+
+  # System type
+  $self->type ('bld');
+
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @scalar_properties.
+# ------------------------------------------------------------------------------
+
+for my $name (@scalar_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    # Argument specified, set property to specified argument
+    if (@_) {
+      $self->{$name} = $_[0];
+    }
+
+    # Default value for property
+    if (not defined $self->{$name}) {
+      if ($name eq 'target') {
+        # Reference to an array
+        $self->{$name} = [];
+
+      } elsif ($name eq 'name') {
+        # Empty string
+        $self->{$name} = '';
+      }
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %hash = %{ $obj->X () };
+#   $obj->X (\%hash);
+#
+#   $value = $obj->X ($index);
+#   $obj->X ($index, $value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @hash_properties.
+#
+#   If no argument is set, this method returns a hash containing a list of
+#   objects. If an argument is set and it is a reference to a hash, the objects
+#   are replaced by the the specified hash.
+#
+#   If a scalar argument is specified, this method returns a reference to an
+#   object, if the indexed object exists or undef if the indexed object does
+#   not exist. If a second argument is set, the $index element of the hash will
+#   be set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+for my $name (@hash_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my ($self, $arg1, $arg2) = @_;
+
+    # Ensure property is defined as a reference to a hash
+    $self->{$name} = {} if not defined ($self->{$name});
+
+    # Argument 1 can be a reference to a hash or a scalar index
+    my ($index, %hash);
+
+    if (defined $arg1) {
+      if (ref ($arg1) eq 'HASH') {
+        %hash = %$arg1;
+
+      } else {
+        $index = $arg1;
+      }
+    }
+
+    if (defined $index) {
+      # A scalar index is defined, set and/or return the value of an element
+      $self->{$name}{$index} = $arg2 if defined $arg2;
+
+      return (
+        exists $self->{$name}{$index} ? $self->{$name}{$index} : undef
+      );
+
+    } else {
+      # A scalar index is not defined, set and/or return the hash
+      $self->{$name} = \%hash if defined $arg1;
+      return $self->{$name};
+    }
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   ($rc, $new_lines) = $self->X ($old_lines);
+#
+# DESCRIPTION
+#   This method compares current settings with those in the cache, where X is
+#   one of @compare_setting_methods.
+#
+#   If setting has changed:
+#   * For bld_blockdata, bld_dep_ext and bld_exe_name, it sets the re-generate
+#     make-rule flag to true.
+#   * For bld_dep_excl, in a standalone build, the method will remove the
+#     dependency cache files for affected sub-packages. It returns an error if
+#     the current build inherits from previous builds.
+#   * For bld_pp, it updates the PP setting for affected sub-packages.
+#   * For infile_ext, in a standalone build, the method will remove all the
+#     sub-package cache files and trigger a re-build by removing most
+#     sub-directories created by the previous build. It returns an error if the
+#     current build inherits from previous builds.
+#   * For outfile_ext, in a standalone build, the method will remove all the
+#     sub-package dependency cache files. It returns an error if the current
+#     build inherits from previous builds.
+#   * For tool, it updates the "flags" files for any changed tools.
+# ------------------------------------------------------------------------------
+
+for my $name (@compare_setting_methods) {
+  no strict 'refs';
+
+  *$name = sub {
+    my ($self, $old_lines) = @_;
+
+    (my $prefix = uc ($name)) =~ s/^COMPARE_SETTING_//;
+
+    my ($changed, $new_lines) =
+      $self->compare_setting_in_config ($prefix, $old_lines);
+
+    my $rc = scalar (keys %$changed);
+
+    if ($rc and $old_lines) {
+      $self->srcpkg ('')->is_updated (1);
+
+      if ($name =~ /^compare_setting_bld_dep(?:_excl|_n|_pp)?$/) {
+        # Mark affected packages as being updated
+        for my $key (keys %$changed) {
+          for my $pkg (values %{ $self->srcpkg }) {
+            next unless $pkg->is_in_package ($key);
+            $pkg->is_updated (1);
+          }
+        }
+
+      } elsif ($name eq 'compare_setting_bld_pp') {
+        # Mark affected packages as being updated
+        for my $key (keys %$changed) {
+          for my $pkg (values %{ $self->srcpkg }) {
+            next unless $pkg->is_in_package ($key);
+            next unless $self->srcpkg ($key)->is_type_any (
+              keys %{ $self->setting ('BLD_TYPE_DEP_PP') }
+            ); # Is a type requiring pre-processing
+
+            $pkg->is_updated (1);
+          }
+        }
+
+      } elsif ($name eq 'compare_setting_infile_ext') {
+        # Re-set input file type if necessary
+        for my $key (keys %$changed) {
+          for my $pkg (values %{ $self->srcpkg }) {
+            next unless $pkg->src and $pkg->ext and $key eq $pkg->ext;
+
+            $pkg->type (undef);
+          }
+        }
+
+        # Mark affected packages as being updated
+        for my $pkg (values %{ $self->srcpkg }) {
+          $pkg->is_updated (1);
+        }
+
+      } elsif ($name eq 'compare_setting_outfile_ext') {
+        # Mark affected packages as being updated
+        for my $pkg (values %{ $self->srcpkg }) {
+          $pkg->is_updated (1);
+        }
+
+      } elsif ($name eq 'compare_setting_tool') {
+        # Update the "flags" files for changed tools
+        for my $name (sort keys %$changed) {
+          my ($tool, @names) = split /__/, $name;
+          my $pkg  = join ('__', @names);
+          my @srcpkgs = $self->srcpkg ($pkg)
+                        ? ($self->srcpkg ($pkg))
+                        : @{ $self->dummysrcpkg ($pkg)->children };
+
+          for my $srcpkg (@srcpkgs) {
+            my $file = File::Spec->catfile (
+              $self->dest->flagsdir, $srcpkg->flagsbase ($tool)
+            );
+            &touch_file ($file) or croak $file, ': cannot update, abort';
+
+            print $file, ': updated', "\n" if $self->verbose > 2;
+          }
+        }
+      }
+    }
+
+    return ($rc, $new_lines);
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   ($rc, $new_lines) = $self->compare_setting_dependency ($old_lines, $flag);
+#
+# DESCRIPTION
+#   This method uses the previous settings to determine the dependencies of
+#   current source files.
+# ------------------------------------------------------------------------------
+
+sub compare_setting_dependency {
+  my ($self, $old_lines, $flag) = @_;
+
+  my $prefix = $flag ? 'DEP_PP' : 'DEP';
+  my $method = $flag ? 'ppdep'  : 'dep';
+
+  my $rc = 0;
+  my $new_lines = [];
+
+  # Separate old lines
+  my %old;
+  if ($old_lines) {
+    for my $line (@$old_lines) {
+      next unless $line->label_starts_with ($prefix);
+      $old{$line->label_from_field (1)} = $line;
+    }
+  }
+
+  # Go through each source to see if the cache is up to date
+  my $count = 0;
+  my %mtime;
+  for my $srcpkg (values %{ $self->srcpkg }) {
+    next unless $srcpkg->cursrc and $srcpkg->type;
+
+    my $key = $srcpkg->pkgname;
+    my $out_of_date = $srcpkg->is_updated;
+
+    # Check modification time of cache and source file if not out of date
+    if (exists $old{$key}) {
+      if (not $out_of_date) {
+        $mtime{$old{$key}->src} = (stat ($old{$key}->src))[9]
+          if not exists ($mtime{$old{$key}->src});
+
+        $out_of_date = 1 if $mtime{$old{$key}->src} < $srcpkg->curmtime;
+      }
+    }
+    else {
+      $out_of_date = 1;
+    }
+
+    if ($out_of_date) {
+      # Re-scan dependency
+      $srcpkg->is_updated(1);
+      my ($source_is_read, $dep_hash_ref) = $srcpkg->get_dep($flag);
+      if ($source_is_read) {
+        $count++;
+      }
+      $srcpkg->$method($dep_hash_ref);
+      $rc = 1;
+    }
+    else {
+      # Use cached dependency
+      my ($progname, %hash) = split (
+        /$Fcm::Config::DELIMITER_PATTERN/, $old{$key}->value
+      );
+      $srcpkg->progname ($progname) if $progname and not $flag;
+      $srcpkg->$method (\%hash);
+    }
+
+    # New lines values: progname[::dependency-name::type][...]
+    my @value = ((defined $srcpkg->progname ? $srcpkg->progname : ''));
+    for my $name (sort keys %{ $srcpkg->$method }) {
+      push @value, $name, $srcpkg->$method ($name);
+    }
+
+    push @$new_lines, Fcm::CfgLine->new (
+      LABEL => $prefix . $Fcm::Config::DELIMITER . $key,
+      VALUE => join ($Fcm::Config::DELIMITER, @value),
+    );
+  }
+
+  print 'No. of file', ($count > 1 ? 's' : ''), ' scanned for',
+        ($flag ? ' PP': ''), ' dependency: ', $count, "\n"
+    if $self->verbose and $count;
+
+  return ($rc, $new_lines);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   ($rc, $new_lines) = $self->compare_setting_srcpkg ($old_lines);
+#
+# DESCRIPTION
+#   This method uses the previous settings to determine the type of current
+#   source files.
+# ------------------------------------------------------------------------------
+
+sub compare_setting_srcpkg {
+  my ($self, $old_lines) = @_;
+
+  my $prefix = 'SRCPKG';
+
+  # Get relevant items from old lines, stripping out $prefix
+  my %old;
+  if ($old_lines) {
+    for my $line (@$old_lines) {
+      next unless $line->label_starts_with ($prefix);
+      $old{$line->label_from_field (1)} = $line;
+    }
+  }
+
+  # Check for change, use previous setting if exist
+  my $out_of_date = 0;
+  my %mtime;
+  for my $key (keys %{ $self->srcpkg }) {
+    if (exists $old{$key}) {
+      next unless $self->srcpkg ($key)->cursrc;
+
+      my $type = defined $self->setting ('BLD_TYPE', $key)
+                 ? $self->setting ('BLD_TYPE', $key) : $old{$key}->value;
+
+      $self->srcpkg ($key)->type ($type);
+
+      if ($type ne $old{$key}->value) {
+        $self->srcpkg ($key)->is_updated (1);
+        $out_of_date = 1;
+      }
+
+      if (not $self->srcpkg ($key)->is_updated) {
+        $mtime{$old{$key}->src} = (stat ($old{$key}->src))[9]
+          if not exists ($mtime{$old{$key}->src});
+
+        $self->srcpkg ($key)->is_updated (1)
+          if $mtime{$old{$key}->src} < $self->srcpkg ($key)->curmtime;
+      }
+
+    } else {
+      $self->srcpkg ($key)->is_updated (1);
+      $out_of_date = 1;
+    }
+  }
+
+  # Check for deleted keys
+  for my $key (keys %old) {
+    next if $self->srcpkg ($key);
+
+    $out_of_date = 1;
+  }
+
+  # Return reference to an array of new lines
+  my $new_lines = [];
+  for my $key (keys %{ $self->srcpkg }) {
+    push @$new_lines, Fcm::CfgLine->new (
+      LABEL => $prefix . $Fcm::Config::DELIMITER . $key,
+      VALUE => $self->srcpkg ($key)->type,
+    );
+  }
+
+  return ($out_of_date, $new_lines);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   ($rc, $new_lines) = $self->compare_setting_target ($old_lines);
+#
+# DESCRIPTION
+#   This method compare the previous target settings with current ones.
+# ------------------------------------------------------------------------------
+
+sub compare_setting_target {
+  my ($self, $old_lines) = @_;
+
+  my $prefix = 'TARGET';
+  my $old;
+  if ($old_lines) {
+    for my $line (@$old_lines) {
+      next unless $line->label_starts_with ($prefix);
+      $old = $line->value;
+      last;
+    }
+  }
+
+  my $new = join (' ', sort @{ $self->target });
+
+  return (
+    (defined ($old) ? $old ne $new : 1),
+    [Fcm::CfgLine->new (LABEL => $prefix, VALUE => $new)],
+  );
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->invoke_fortran_interface_generator ();
+#
+# DESCRIPTION
+#   This method invokes the Fortran interface generator for all Fortran free
+#   format source files. It returns true on success.
+# ------------------------------------------------------------------------------
+
+sub invoke_fortran_interface_generator {
+  my $self = shift;
+
+  my $pdoneext = $self->setting (qw/OUTFILE_EXT PDONE/);
+
+  # Set up build task to generate interface files for all selected Fortran 9x
+  # sources
+  my %task = ();
+  SRC_FILE:
+  for my $srcfile (values %{ $self->srcpkg }) {
+    if (!defined($srcfile->interfacebase())) {
+      next SRC_FILE;
+    }
+    my $target  = $srcfile->interfacebase . $pdoneext;
+
+    $task{$target} = Fcm::BuildTask->new (
+      TARGET     => $target,
+      TARGETPATH => $self->dest->donepath,
+      SRCFILE    => $srcfile,
+      DEPENDENCY => [$srcfile->flagsbase ('GENINTERFACE')],
+      ACTIONTYPE => 'GENINTERFACE',
+    );
+
+    # Set up build tasks for each source file/package flags file for interface
+    # generator tool
+    for my $i (1 .. @{ $srcfile->pkgnames }) {
+      my $target = $srcfile->flagsbase ('GENINTERFACE', -$i);
+      my $depend = $i < @{ $srcfile->pkgnames }
+                   ? $srcfile->flagsbase ('GENINTERFACE', -$i - 1)
+                   : undef;
+
+      $task{$target} = Fcm::BuildTask->new (
+        TARGET     => $target,
+        TARGETPATH => $self->dest->flagspath,
+        DEPENDENCY => [defined ($depend) ? $depend : ()],
+        ACTIONTYPE => 'UPDATE',
+      ) if not exists $task{$target};
+    }
+  }
+
+  # Set up build task to update the flags file for interface generator tool
+  $task{$self->srcpkg ('')->flagsbase ('GENINTERFACE')} = Fcm::BuildTask->new (
+    TARGET     => $self->srcpkg ('')->flagsbase ('GENINTERFACE'),
+    TARGETPATH => $self->dest->flagspath,
+    ACTIONTYPE => 'UPDATE',
+  );
+
+  my $count = 0;
+
+  # Performs task
+  for my $task (values %task) {
+    next unless $task->actiontype eq 'GENINTERFACE';
+
+    my $rc = $task->action (TASKLIST => \%task);
+    $count++ if $rc;
+  }
+
+  print 'No. of generated Fortran interface', ($count > 1 ? 's' : ''), ': ',
+        $count, "\n"
+    if $self->verbose and $count;
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->invoke_make (%args);
+#
+# DESCRIPTION
+#   This method invokes the make stage of the build system. It returns true on
+#   success.
+#
+# ARGUMENTS
+#   ARCHIVE - If set to "true", invoke the "archive" mode. Most build files and
+#             directories created by this build will be archived using the
+#             "tar" command.  If not set, the default is not to invoke the
+#             "archive" mode.
+#   JOBS    - Specify number of jobs that can be handled by "make". If set, the
+#             value must be a natural integer. If not set, the default value is
+#             1 (i.e.  run "make" in serial mode).
+#   TARGETS - Specify targets to be built. If set, these targets will be built
+#             instead of the ones specified in the build configuration file.
+# ------------------------------------------------------------------------------
+
+sub invoke_make {
+  my ($self, %args) = @_;
+  $args{TARGETS} ||= ['all'];
+  $args{JOBS}    ||= 1;
+  my @command = (
+    $self->setting(qw/TOOL MAKE/),
+    shellwords($self->setting(qw/TOOL MAKEFLAGS/)),
+    # -f Makefile
+    ($self->setting(qw/TOOL MAKE_FILE/), $self->dest()->bldmakefile()),
+    # -j N
+    ($args{JOBS} ? ($self->setting(qw/TOOL MAKE_JOB/), $args{JOBS}) : ()),
+    # -s
+    ($self->verbose() >= 3 ? $self->setting(qw/TOOL MAKE_SILENT/) : ()),
+    @{$args{TARGETS}}
+  );
+  my $old_cwd = $self->_chdir($self->dest()->rootdir());
+  run_command(
+    \@command, ERROR => 'warn', RC => \my($code), TIME => $self->verbose() >= 3,
+  );
+  $self->_chdir($old_cwd);
+
+  my $rc = !$code;
+  if ($rc && $args{ARCHIVE}) {
+    $rc = $self->dest()->archive();
+  }
+  $rc &&= $self->dest()->create_bldrunenvsh();
+  while (my ($key, $source) = each(%{$self->srcpkg()})) {
+    $rc &&= defined($source->write_lib_dep_excl());
+  }
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->invoke_pre_process ();
+#
+# DESCRIPTION
+#   This method invokes the pre-process stage of the build system. It
+#   returns true on success.
+# ------------------------------------------------------------------------------
+
+sub invoke_pre_process {
+  my $self = shift;
+   
+  # Check whether pre-processing is necessary
+  my $invoke = 0;
+  for (values %{ $self->srcpkg }) {
+    next unless $_->get_setting ('BLD_PP');
+    $invoke = 1;
+    last;
+  }
+  return 1 unless $invoke;
+
+  # Scan header dependency
+  my $rc = $self->compare_setting (
+    METHOD_LIST => ['compare_setting_dependency'],
+    METHOD_ARGS => ['BLD_TYPE_DEP_PP'],
+    CACHEBASE   => $self->setting ('CACHE_DEP_PP'),
+  );
+
+  return $rc if not $rc;
+
+  my %task     = ();
+  my $pdoneext = $self->setting (qw/OUTFILE_EXT PDONE/);
+
+  # Set up tasks for each source file
+  for my $srcfile (values %{ $self->srcpkg }) {
+    if ($srcfile->is_type_all (qw/CPP INCLUDE/)) {
+      # Set up a copy build task for each include file
+      $task{$srcfile->base} = Fcm::BuildTask->new (
+        TARGET     => $srcfile->base,
+        TARGETPATH => $self->dest->incpath,
+        SRCFILE    => $srcfile,
+        DEPENDENCY => [keys %{ $srcfile->ppdep }],
+        ACTIONTYPE => 'COPY',
+      );
+
+    } elsif ($srcfile->lang ('TOOL_SRC_PP')) {
+      next unless $srcfile->get_setting ('BLD_PP');
+
+      # Set up a PP build task for each source file
+      my $target = $srcfile->base . $pdoneext;
+
+      # Issue warning for duplicated tasks
+      if (exists $task{$target}) {
+        w_report 'WARNING: ', $target, ': unable to create task for: ',
+                 $srcfile->src, ': task already exists for: ',
+                 $task{$target}->srcfile->src;
+        next;
+      }
+
+      $task{$target} = Fcm::BuildTask->new (
+        TARGET     => $target,
+        TARGETPATH => $self->dest->donepath,
+        SRCFILE    => $srcfile,
+        DEPENDENCY => [$srcfile->flagsbase ('PPKEYS'), keys %{ $srcfile->ppdep }],
+        ACTIONTYPE => 'PP',
+      );
+
+      # Set up update ppkeys/flags build tasks for each source file/package
+      my $ppkeys = $self->setting (
+        'TOOL_SRC_PP', $srcfile->lang ('TOOL_SRC_PP'), 'PPKEYS'
+      );
+
+      for my $i (1 .. @{ $srcfile->pkgnames }) {
+        my $target = $srcfile->flagsbase ($ppkeys, -$i);
+        my $depend = $i < @{ $srcfile->pkgnames }
+                     ? $srcfile->flagsbase ($ppkeys, -$i - 1)
+                     : undef;
+
+        $task{$target} = Fcm::BuildTask->new (
+          TARGET     => $target,
+          TARGETPATH => $self->dest->flagspath,
+          DEPENDENCY => [defined ($depend) ? $depend : ()],
+          ACTIONTYPE => 'UPDATE',
+        ) if not exists $task{$target};
+      }
+    }
+  }
+
+  # Set up update global ppkeys build tasks
+  for my $lang (keys %{ $self->setting ('TOOL_SRC_PP') }) {
+    my $target = $self->srcpkg ('')->flagsbase (
+      $self->setting ('TOOL_SRC_PP', $lang, 'PPKEYS')
+    );
+
+    $task{$target} = Fcm::BuildTask->new (
+      TARGET     => $target,
+      TARGETPATH => $self->dest->flagspath,
+      ACTIONTYPE => 'UPDATE',
+    );
+  }
+
+  # Build all PP tasks
+  my $count = 0;
+  for my $task (values %task) {
+    next unless $task->actiontype eq 'PP';
+
+    my $rc = $task->action (TASKLIST => \%task);
+    $task->srcfile->is_updated ($rc);
+    $count++ if $rc;
+  }
+
+  print 'No. of pre-processed file', ($count > 1 ? 's' : ''), ': ', $count, "\n"
+    if $self->verbose and $count;
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->invoke_scan_dependency ();
+#
+# DESCRIPTION
+#   This method invokes the scan dependency stage of the build system. It
+#   returns true on success.
+# ------------------------------------------------------------------------------
+
+sub invoke_scan_dependency {
+  my $self = shift;
+
+  # Scan/retrieve dependency
+  # ----------------------------------------------------------------------------
+  my $rc = $self->compare_setting (
+    METHOD_LIST => ['compare_setting_dependency'],
+    CACHEBASE   => $self->setting ('CACHE_DEP'),
+  );
+
+  # Check whether make file is out of date
+  # ----------------------------------------------------------------------------
+  my $out_of_date = not -r $self->dest->bldmakefile;
+
+  if ($rc and not $out_of_date) {
+    for (qw/CACHE CACHE_DEP/) {
+      my $cache_mtime = (stat (File::Spec->catfile (
+        $self->dest->cachedir, $self->setting ($_),
+      )))[9];
+      my $mfile_mtime = (stat ($self->dest->bldmakefile))[9];
+
+      next if not defined $cache_mtime;
+      next if $cache_mtime < $mfile_mtime;
+      $out_of_date = 1;
+      last;
+    }
+  }
+
+  if ($rc and not $out_of_date) {
+    for (values %{ $self->srcpkg }) {
+      next unless $_->is_updated;
+      $out_of_date = 1;
+      last;
+    }
+  }
+
+  if ($rc and $out_of_date) {
+    # Write Makefile
+    # --------------------------------------------------------------------------
+    # Register non-word package name
+    my $unusual = 0;
+    for my $key (sort keys %{ $self->srcpkg }) {
+      next if $self->srcpkg ($key)->src;
+      next if $key =~ /^\w*$/;
+
+      $self->setting (
+        ['FCM_PCK_OBJECTS', $key], 'FCM_PCK_OBJECTS' . $unusual++,
+      );
+    }
+
+    # Write different parts in the Makefile
+    my $makefile = '# Automatic Makefile' . "\n\n";
+    $makefile .= 'FCM_BLD_NAME = ' . $self->name . "\n" if $self->name;
+    $makefile .= 'FCM_BLD_CFG = ' . $self->cfg->actual_src . "\n";
+    $makefile .= 'export FCM_VERBOSE ?= ' . $self->verbose . "\n\n";
+    $makefile .= $self->dest->write_rules;
+    $makefile .= $self->_write_makefile_perl5lib;
+    $makefile .= $self->_write_makefile_tool;
+    $makefile .= $self->_write_makefile_vpath;
+    $makefile .= $self->_write_makefile_target;
+
+    # Write rules for each source package
+    # Ensure that container packages come before files - this allows $(OBJECTS)
+    # and its dependent variables to expand correctly
+    my @srcpkg = sort {
+      if ($self->srcpkg ($a)->libbase and $self->srcpkg ($b)->libbase) {
+        $b cmp $a;
+
+      } elsif ($self->srcpkg ($a)->libbase) {
+        -1;
+
+      } elsif ($self->srcpkg ($b)->libbase) {
+        1;
+
+      } else {
+        $a cmp $b;
+      }
+    } keys %{ $self->srcpkg };
+
+    for (@srcpkg) {
+      $makefile .= $self->srcpkg ($_)->write_rules if $self->srcpkg ($_)->rules;
+    }
+    $makefile .= '# EOF' . "\n";
+
+    # Update Makefile
+    open OUT, '>', $self->dest->bldmakefile
+      or croak $self->dest->bldmakefile, ': cannot open (', $!, '), abort';
+    print OUT $makefile;
+    close OUT
+      or croak $self->dest->bldmakefile, ': cannot close (', $!, '), abort';
+
+    print $self->dest->bldmakefile, ': updated', "\n" if $self->verbose;
+
+    # Check for duplicated targets
+    # --------------------------------------------------------------------------
+    # Get list of types that cannot have duplicated targets
+    my @no_duplicated_target_types = split (
+      /$DELIMITER_LIST/,
+      $self->setting ('BLD_TYPE_NO_DUPLICATED_TARGET'),
+    );
+
+    my %targets;
+    for my $name (sort keys %{ $self->srcpkg }) {
+      next unless $self->srcpkg ($name)->rules;
+
+      for my $key (sort keys %{ $self->srcpkg ($name)->rules }) {
+        if (exists $targets{$key}) {
+          # Duplicated target: warning for most file types
+          my $status = 'WARNING';
+
+          # Duplicated target: error for the following file types
+          if (@no_duplicated_target_types and
+              $self-srcpkg ($name)->is_type_any (@no_duplicated_target_types) and
+              $targets{$key}->is_type_any (@no_duplicated_target_types)) {
+            $status = 'ERROR';
+            $rc = 0;
+          }
+
+          # Report the warning/error
+          w_report $status, ': ', $key, ': duplicated targets for building:';
+          w_report '       ', $targets{$key}->src;
+          w_report '       ', $self->srcpkg ($name)->src;
+
+        } else {
+          $targets{$key} = $self->srcpkg ($name);
+        }
+      }
+    }
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->invoke_setup_build ();
+#
+# DESCRIPTION
+#   This method invokes the setup_build stage of the build system. It returns
+#   true on success.
+# ------------------------------------------------------------------------------
+
+sub invoke_setup_build {
+  my $self = shift;
+
+  my $rc = 1;
+
+  # Extract archived sub-directories if necessary
+  $rc = $self->dest->dearchive if $rc;
+
+  # Compare cache
+  $rc = $self->compare_setting (METHOD_LIST => [
+    'compare_setting_target', # targets
+    'compare_setting_srcpkg', # source package type
+    @compare_setting_methods,
+  ]) if $rc;
+
+  # Set up runtime dependency scan patterns
+  my %dep_pattern = %{ $self->setting ('BLD_DEP_PATTERN') };
+  for my $key (keys %dep_pattern) {
+    my $pattern = $dep_pattern{$key};
+
+    while ($pattern =~ /##([\w:]+)##/g) {
+      my $match = $1;
+      my $val   = $self->setting (split (/$Fcm::Config::DELIMITER/, $match));
+
+      last unless defined $val;
+      $val =~ s/\./\\./;
+
+      $pattern =~ s/##$match##/$val/;
+    }
+
+    $self->setting (['BLD_DEP_PATTERN', $key], $pattern)
+      unless $pattern eq $dep_pattern{$key};
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->invoke_system (%args);
+#
+# DESCRIPTION
+#   This method invokes the build system. It returns true on success. See also
+#   the header for invoke_make for further information on arguments.
+#
+# ARGUMENTS
+#   STAGE - If set, it should be an integer number or a recognised keyword or
+#           abbreviation. If set, the build is performed up to the named stage.
+#           If not set, the default is to perform all stages of the build.
+#           Allowed values are:
+#             1, setup or s
+#             2, pre_process or pp
+#             3, generate_dependency or gd
+#             4, generate_interface or gi
+#             5, all, a, make or m
+# ------------------------------------------------------------------------------
+
+sub invoke_system {
+  my $self = shift;
+  my %args = @_;
+
+  # Parse arguments
+  # ----------------------------------------------------------------------------
+  # Default: run all 5 stages
+  my $stage = (exists $args{STAGE} and $args{STAGE}) ? $args{STAGE} : 5;
+
+  # Resolve named stages
+  if ($stage !~ /^\d$/) {
+    my %stagenames = (
+      'S(?:ETUP)?'                      => 1,
+      'P(?:RE)?_?P(?:ROCESS)?'          => 2,
+      'G(?:ENERATE)?_?D(?:ENPENDENCY)?' => 3,
+      'G(?:ENERATE)?_?I(?:NTERFACE)?'   => 4,
+      '(?:A(?:LL)|M(?:AKE)?)'           => 5,
+    );
+
+    # Does it match a recognised stage?
+    for my $name (keys %stagenames) {
+      next unless $stage =~ /$name/i;
+
+      $stage = $stagenames{$name};
+      last;
+    }
+
+    # Specified stage name not recognised, default to 5
+    if ($stage !~ /^\d$/) {
+      w_report 'WARNING: ', $stage, ': invalid build stage, default to 5.';
+      $stage = 5;
+    }
+  }
+
+  # Run the method associated with each stage
+  # ----------------------------------------------------------------------------
+  my $rc = 1;
+
+  my @stages = (
+    ['Setup build'               , 'invoke_setup_build'],
+    ['Pre-process'               , 'invoke_pre_process'],
+    ['Scan dependency'           , 'invoke_scan_dependency'],
+    ['Generate Fortran interface', 'invoke_fortran_interface_generator'],
+    ['Make'                      , 'invoke_make'],
+  );
+
+  for my $i (1 .. 5) {
+    last if (not $rc) or $i > $stage;
+
+    my ($name, $method) = @{ $stages[$i - 1] };
+    $rc = $self->invoke_stage ($name, $method, %args) if $rc and $stage >= $i;
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->parse_cfg_dep (\@cfg_lines);
+#
+# DESCRIPTION
+#   This method parses the dependency settings in the @cfg_lines.
+# ------------------------------------------------------------------------------
+
+sub parse_cfg_dep {
+  my ($self, $cfg_lines) = @_;
+
+  my $rc = 1;
+
+  # EXCL_DEP, EXE_DEP and BLOCKDATA declarations
+  # ----------------------------------------------------------------------------
+  for my $name (qw/BLD_BLOCKDATA BLD_DEP BLD_DEP_EXCL BLD_DEP_EXE/) {
+    for my $line (grep {$_->slabel_starts_with_cfg ($name)} @$cfg_lines) {
+      # Separate label into a list, delimited by double-colon, remove 1st field
+      my @flds = $line->slabel_fields;
+      shift @flds;
+
+      if ($name =~ /^(?:BLD_DEP|BLD_DEP_EXCL|BLD_DEP_PP)$/) {
+        # BLD_DEP_*: label fields may contain sub-package
+        my $pk = @flds ? join ('__', @flds) : '';
+
+        # Check whether sub-package is valid
+        if ($pk and not ($self->srcpkg ($pk) or $self->dummysrcpkg ($pk))) {
+          $line->error ($line->label . ': invalid sub-package in declaration.');
+          $rc = 0;
+          next;
+        }
+
+        # Setting is stored in an array reference
+        $self->setting ([$name, $pk], [])
+          if not defined $self->setting ($name, $pk);
+
+        # Add current declaration to the array if necessary
+        my $list  = $self->setting ($name, $pk);
+        my $value = $name eq 'BLD_DEP_EXCL' ? uc ($line->value) : $line->value;
+        push @$list, $value if not grep {$_ eq $value} @$list;
+
+      } else {
+        # EXE_DEP and BLOCKDATA: label field may be an executable target
+        my $target = @flds ? $flds[0] : '';
+
+        # The value contains a list of objects and/or sub-package names
+        my @deps   = split /\s+/, $line->value;
+
+        if (not @deps) {
+          if ($name eq 'BLD_BLOCKDATA') {
+            # The objects containing a BLOCKDATA program unit must be declared
+            $line->error ($line->label . ': value not set.');
+            $rc = 0;
+            next;
+
+          } else {
+            # If $value is a null string, target(s) depends on all objects
+            push @deps, '';
+          }
+        }
+
+        for my $dep (@deps) {
+          $dep =~ s/$Fcm::Config::DELIMITER_PATTERN/__/g;
+        }
+
+        $self->setting ([$name, $target], join (' ', sort @deps));
+      }
+
+      $line->parsed (1);
+    }
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->parse_cfg_dest (\@cfg_lines);
+#
+# DESCRIPTION
+#   This method parses the build destination settings in the @cfg_lines.
+# ------------------------------------------------------------------------------
+
+sub parse_cfg_dest {
+  my ($self, $cfg_lines) = @_;
+
+  my $rc = $self->SUPER::parse_cfg_dest ($cfg_lines);
+
+  # Set up search paths
+  for my $name (@Fcm::Dest::paths) {
+    (my $label = uc ($name)) =~ s/PATH//;
+
+    $self->setting (['PATH', $label], $self->dest->$name);
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->parse_cfg_misc (\@cfg_lines);
+#
+# DESCRIPTION
+#   This method parses misc build settings in the @cfg_lines.
+# ------------------------------------------------------------------------------
+
+sub parse_cfg_misc {
+    my ($self, $cfg_lines_ref) = @_;
+    my $rc = 1;
+    my %item_of = (
+        BLD_DEP_N    => [\&_parse_cfg_misc_dep_n   , 1   ], # boolean
+        BLD_EXE_NAME => [\&_parse_cfg_misc_exe_name      ],
+        BLD_LIB      => [\&_parse_cfg_misc_dep_n         ],
+        BLD_PP       => [\&_parse_cfg_misc_dep_n   , 1   ], # boolean
+        BLD_TYPE     => [\&_parse_cfg_misc_dep_n         ],
+        INFILE_EXT   => [\&_parse_cfg_misc_file_ext, 0, 1], # uc($value)
+        OUTFILE_EXT  => [\&_parse_cfg_misc_file_ext, 1, 0], # uc($ns)
+    );
+    while (my ($key, $item) = each(%item_of)) {
+        my ($handler, @extra_arguments) = @{$item};
+        for my $line (@{$cfg_lines_ref}) {
+            if ($line->slabel_starts_with_cfg($key)) {
+                if ($handler->($self, $key, $line, @extra_arguments)) {
+                    $line->parsed(1);
+                }
+                else {
+                    $rc = 0;
+                }
+            }
+        }
+    }
+    return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# parse_cfg_misc: handler of BLD_EXE_NAME or similar.
+sub _parse_cfg_misc_exe_name {
+    my ($self, $key, $line) = @_;
+    my ($prefix, $name, @fields) = $line->slabel_fields();
+    if (!$name || @fields) {
+        $line->error(sprintf('%s: expects a single label name field.', $key));
+        return 0;
+    }
+    $self->setting([$key, $name], $line->value());
+    return 1;
+}
+
+# ------------------------------------------------------------------------------
+# parse_cfg_misc: handler of BLD_DEP_N or similar.
+sub _parse_cfg_misc_dep_n {
+    my ($self, $key, $line, $value_is_boolean) = @_;
+    my ($prefix, @fields) = $line->slabel_fields();
+    my $ns = @fields ? join(q{__}, @fields) : q{};
+    if ($ns && !$self->srcpkg($ns) && !$self->dummysrcpkg($ns)) {
+        $line->error($line->label() . ': invalid sub-package in declaration.');
+        return 0;
+    }
+    my @srcpkgs
+        = $self->dummysrcpkg($ns) ? @{$self->dummysrcpkg($ns)->children()}
+        :                           $self->srcpkg($ns)
+        ;
+    my $value = $value_is_boolean ? $line->bvalue() : $line->value();
+    for my $srcpkg (@srcpkgs) {
+        $self->setting([$key, $srcpkg->pkgname()], $value);
+    }
+    return 1;
+}
+
+# ------------------------------------------------------------------------------
+# parse_cfg_misc: handler of INFILE_EXT/OUTFILE_EXT or similar.
+sub _parse_cfg_misc_file_ext {
+    my ($self, $key, $line, $ns_in_uc, $value_in_uc) = @_;
+    my ($prefix, $ns) = $line->slabel_fields();
+    my $value = $value_in_uc ? uc($line->value()) : $line->value();
+    $self->setting([$key, ($ns_in_uc ? uc($ns) : $ns)], $value);
+    return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->parse_cfg_source (\@cfg_lines);
+#
+# DESCRIPTION
+#   This method parses the source package settings in the @cfg_lines.
+# ------------------------------------------------------------------------------
+
+sub parse_cfg_source {
+  my ($self, $cfg_lines) = @_;
+
+  my $rc  = 1;
+  my %src = ();
+
+  # Automatic source directory search?
+  # ----------------------------------------------------------------------------
+  my $search = 1;
+
+  for my $line (grep {$_->slabel_starts_with_cfg ('SEARCH_SRC')} @$cfg_lines) {
+    $search = $line->bvalue;
+    $line->parsed (1);
+  }
+
+  # Search src/ sub-directory if necessary
+  %src = %{ $self->dest->get_source_files } if $search;
+
+  # SRC declarations
+  # ----------------------------------------------------------------------------
+  for my $line (grep {$_->slabel_starts_with_cfg ('FILE')} @$cfg_lines) {
+    # Expand ~ notation and path relative to srcdir of destination
+    my $value = $line->value;
+    $value = File::Spec->rel2abs (&expand_tilde ($value), $self->dest->srcdir);
+
+    if (not -r $value) {
+      $line->error ($value . ': source does not exist or is not readable.');
+      next;
+    }
+
+    # Package name
+    my @names = $line->slabel_fields;
+    shift @names;
+
+    # If package name not set, determine using the path if possible
+    if (not @names) {
+      my $package = $self->dest->get_pkgname_of_path ($value);
+      @names = @$package if defined $package;
+    }
+
+    if (not @names) {
+      $line->error ($self->cfglabel ('FILE') .
+                    ': package not specified/cannot be determined.');
+      next;
+    }
+
+    $src{join ('__', @names)} = $value;
+
+    $line->parsed (1);
+  }
+
+  # For directories, get non-recursive file listing, and add to %src
+  # ----------------------------------------------------------------------------
+  for my $key (keys %src) {
+    next unless -d $src{$key};
+
+    opendir DIR, $src{$key} or die $src{$key}, ': cannot read directory';
+    while (my $base = readdir 'DIR') {
+      next if $base =~ /^\./;
+
+      my $file = File::Spec->catfile ($src{$key}, $base);
+      next unless -f $file and -r $file;
+
+      my $name = join ('__', ($key, $base));
+      $src{$name} = $file unless exists $src{$name};
+    }
+    closedir DIR;
+
+    delete $src{$key};
+  }
+
+  # Set up source packages
+  # ----------------------------------------------------------------------------
+  my %pkg = ();
+  for my $name (keys %src) {
+    $pkg{$name} = Fcm::BuildSrc->new (PKGNAME => $name, SRC => $src{$name});
+  }
+
+  # INHERIT::SRC declarations
+  # ----------------------------------------------------------------------------
+  my %can_inherit = ();
+  for my $line (
+    grep {$_->slabel_starts_with_cfg(qw/INHERIT FILE/)} @{$cfg_lines}
+  ) {
+    my ($key1, $key2, @ns) = $line->slabel_fields();
+    $can_inherit{join('__', @ns)} = $line->bvalue();
+    $line->parsed(1);
+  }
+
+  # Inherit packages, if it is OK to do so
+  for my $inherited_build (reverse(@{$self->inherit()})) {
+    SRCPKG:
+    while (my ($key, $srcpkg) = each(%{$inherited_build->srcpkg()})) {
+      if (exists($pkg{$key}) || !$srcpkg->src()) {
+        next SRCPKG;
+      }
+      my $known_key = first {exists($can_inherit{$_})} @{$srcpkg->pkgnames()};
+      if (defined($known_key) && !$can_inherit{$known_key}) {
+        next SRCPKG;
+      }
+      $pkg{$key} = $srcpkg;
+    }
+  }
+
+  # Get list of intermediate "packages"
+  # ----------------------------------------------------------------------------
+  for my $name (keys %pkg) {
+    # Name of current package
+    my @names = split /__/, $name;
+
+    my $cur = $name;
+
+    while ($cur) {
+      # Name of parent package
+      pop @names;
+      my $parent = @names ? join ('__', @names) : '';
+
+      # If parent package does not exist, create it
+      $pkg{$parent} = Fcm::BuildSrc->new (PKGNAME => $parent)
+        unless exists $pkg{$parent};
+
+      # Current package is a child of the parent package
+      push @{ $pkg{$parent}->children }, $pkg{$cur}
+        unless grep {$_->pkgname eq $cur} @{ $pkg{$parent}->children };
+
+      # Go up a package
+      $cur = $parent;
+    }
+  }
+
+  $self->srcpkg (\%pkg);
+
+  # Dummy: e.g. "foo/bar/baz.egg" belongs to the "foo/bar/baz" dummy.
+  # ----------------------------------------------------------------------------
+  for my $name (keys %pkg) {
+    (my $dname = $name) =~ s/\.\w+$//;
+    next if $dname eq $name;
+    next if $self->srcpkg ($dname);
+
+    $self->dummysrcpkg ($dname, Fcm::BuildSrc->new (PKGNAME => $dname))
+      unless $self->dummysrcpkg ($dname);
+    push @{ $self->dummysrcpkg ($dname)->children }, $pkg{$name};
+  }
+
+  # Make sure a package is defined
+  # ----------------------------------------------------------------------------
+  if (not %{$self->srcpkg}) {
+    w_report 'ERROR: ', $self->cfg->actual_src, ': no source file to build.';
+    $rc = 0;
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->parse_cfg_target (\@cfg_lines);
+#
+# DESCRIPTION
+#   This method parses the target settings in the @cfg_lines.
+# ------------------------------------------------------------------------------
+
+sub parse_cfg_target {
+  my ($self, $cfg_lines) = @_;
+
+  # NAME declaraions
+  # ----------------------------------------------------------------------------
+  for my $line (grep {$_->slabel_starts_with_cfg ('NAME')} @$cfg_lines) {
+    $self->name ($line->value);
+    $line->parsed (1);
+  }
+
+  # TARGET declarations
+  # ----------------------------------------------------------------------------
+  for my $line (grep {$_->slabel_starts_with_cfg ('TARGET')} @$cfg_lines) {
+    # Value is a space delimited list
+    push @{ $self->target }, split (/\s+/, $line->value);
+    $line->parsed (1);
+  }
+
+  # INHERIT::TARGET declarations
+  # ----------------------------------------------------------------------------
+  # By default, do not inherit target
+  my $inherit_flag = 0;
+
+  for (grep {$_->slabel_starts_with_cfg (qw/INHERIT TARGET/)} @$cfg_lines) {
+    $inherit_flag = $_->bvalue;
+    $_->parsed (1);
+  }
+
+  # Inherit targets from inherited build, if $inherit_flag is set to true
+  # ----------------------------------------------------------------------------
+  if ($inherit_flag) {
+    for my $use (reverse @{ $self->inherit }) {
+      unshift @{ $self->target }, @{ $use->target };
+    }
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->parse_cfg_tool (\@cfg_lines);
+#
+# DESCRIPTION
+#   This method parses the tool settings in the @cfg_lines.
+# ------------------------------------------------------------------------------
+
+sub parse_cfg_tool {
+  my ($self, $cfg_lines) = @_;
+
+  my $rc = 1;
+
+  my %tools         = %{ $self->setting ('TOOL') };
+  my @package_tools = split(/$DELIMITER_LIST/, $self->setting('TOOL_PACKAGE'));
+
+  # TOOL declaration
+  # ----------------------------------------------------------------------------
+  for my $line (grep {$_->slabel_starts_with_cfg ('TOOL')} @$cfg_lines) {
+    # Separate label into a list, delimited by double-colon, remove TOOL
+    my @flds = $line->slabel_fields;
+    shift @flds;
+
+    # Check that there is a field after TOOL
+    if (not @flds) {
+      $line->error ('TOOL: not followed by a valid label.');
+      $rc = 0;
+      next;
+    }
+
+    # The first field is the tool iteself, identified in uppercase
+    $flds[0] = uc ($flds[0]);
+
+    # Check that the tool is recognised
+    if (not exists $tools{$flds[0]}) {
+      $line->error ($flds[0] . ': not a valid TOOL.');
+      $rc = 0;
+      next;
+    }
+
+    # Check sub-package declaration
+    if (@flds > 1 and not grep {$_ eq $flds[0]} @package_tools) {
+      $line->error ($flds[0] . ': sub-package not accepted with this TOOL.');
+      $rc = 0;
+      next;
+    }
+
+    # Name of declared package
+    my $pk = join ('__', @flds[1 .. $#flds]);
+
+    # Check whether package exists
+    if (not ($self->srcpkg ($pk) or $self->dummysrcpkg ($pk))) {
+      $line->error ($line->label . ': invalid sub-package in declaration.');
+      $rc = 0;
+      next;
+    }
+
+    $self->setting (['TOOL', join ('__', @flds)], $line->value);
+    $line->parsed (1);
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $self->_write_makefile_perl5lib ();
+#
+# DESCRIPTION
+#   This method returns a makefile $string for defining $PERL5LIB.
+# ------------------------------------------------------------------------------
+
+sub _write_makefile_perl5lib {
+  my $self = shift;
+
+  my $classpath = File::Spec->catfile (split (/::/, ref ($self))) . '.pm';
+
+  my $libdir  = dirname (dirname ($INC{$classpath}));
+  my @libpath = split (/:/, (exists $ENV{PERL5LIB} ? $ENV{PERL5LIB} : ''));
+
+  my $string = ((grep {$_ eq $libdir} @libpath)
+                ? ''
+                : 'export PERL5LIB := ' . $libdir .
+                  (exists $ENV{PERL5LIB} ? ':$(PERL5LIB)' : '') . "\n\n");
+
+  return $string;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $self->_write_makefile_target ();
+#
+# DESCRIPTION
+#   This method returns a makefile $string for defining the default targets.
+# ------------------------------------------------------------------------------
+
+sub _write_makefile_target {
+  my $self = shift;
+
+  # Targets of the build
+  # ----------------------------------------------------------------------------
+  my @targets = @{ $self->target };
+  if (not @targets) {
+    # Build targets not specified by user, default to building all main programs
+    my @programs = ();
+
+    # Get all main programs from all packages
+    for my $pkg (values %{ $self->srcpkg }) {
+      push @programs, $pkg->exebase if $pkg->exebase;
+    }
+
+    @programs = sort (@programs);
+
+    if (@programs) {
+      # Build main programs, if there are any
+      @targets = @programs;
+
+    } else {
+      # No main program in source tree, build the default library
+      @targets = ($self->srcpkg ('')->libbase);
+    }
+  }
+
+  my $return = 'FCM_BLD_TARGETS = ' . join (' ', @targets) . "\n\n";
+
+  # Default targets
+  $return .= '.PHONY : all' . "\n\n";
+  $return .= 'all : $(FCM_BLD_TARGETS)' . "\n\n";
+
+  # Targets for copy dummy
+  $return .= sprintf("%s:\n\ttouch \$@\n\n", $self->setting(qw/BLD_CPDUMMY/));
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $self->_write_makefile_tool ();
+#
+# DESCRIPTION
+#   This method returns a makefile $string for defining the build tools.
+# ------------------------------------------------------------------------------
+
+sub _write_makefile_tool {
+  my $self = shift;
+
+  # List of build tools
+  my $tool = $self->setting ('TOOL');
+
+  # List of tools local to FCM, (will not be exported)
+  my %localtool = map {($_, 1)} split ( # map into a hash table
+    /$DELIMITER_LIST/, $self->setting ('TOOL_LOCAL'),
+  );
+
+  # Export required tools
+  my $count = 0;
+  my $return = '';
+  for my $name (sort keys %$tool) {
+    # Ignore local tools
+    next if exists $localtool{(split (/__/, $name))[0]};
+
+    if ($name =~ /^\w+$/) {
+      # Tools with normal name, just export it as an environment variable
+      $return .= 'export ' . $name . ' = ' . $tool->{$name} . "\n";
+
+    } else {
+      # Tools with unusual characters, export using a label/value pair
+      $return .= 'export FCM_UNUSUAL_TOOL_LABEL' . $count . ' = ' . $name . "\n";
+      $return .= 'export FCM_UNUSUAL_TOOL_VALUE' . $count . ' = ' .
+                 $tool->{$name} . "\n";
+      $count++;
+    }
+  }
+
+  $return .= "\n";
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $self->_write_makefile_vpath ();
+#
+# DESCRIPTION
+#   This method returns a makefile $string for defining vpath directives.
+# ------------------------------------------------------------------------------
+
+sub _write_makefile_vpath {
+  my $self = shift();
+  my $FMT = 'vpath %%%s $(FCM_%sPATH)';
+  my %SETTING_OF = %{$self->setting('BLD_VPATH')};
+  my %EXT_OF = %{$self->setting('OUTFILE_EXT')};
+  # Note: each setting can be either an empty string or a comma-separated list
+  # of output file extension keys.
+  join(
+    "\n",
+    (
+      map
+      {
+        my $key = $_;
+        my @types = split(qr{$DELIMITER_LIST}msx, $SETTING_OF{$key});
+          @types ? (map {sprintf($FMT, $EXT_OF{$_}, $key)} sort @types)
+        :          sprintf($FMT, q{}, $key)
+        ;
+      }
+      sort keys(%SETTING_OF)
+    ),
+  ) . "\n\n";
+}
+
+# Wraps chdir. Returns the old working directory.
+sub _chdir {
+  my ($self, $path) = @_;
+  if ($self->verbose() >= 3) {
+    printf("cd %s\n", $path);
+  }
+  my $old_cwd = cwd();
+  chdir($path) || croak(sprintf("%s: cannot change directory ($!)\n", $path));
+  $old_cwd;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Build/Fortran.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Build/Fortran.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Build/Fortran.pm	(revision 2528)
@@ -0,0 +1,536 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+# ------------------------------------------------------------------------------
+package Fcm::Build::Fortran;
+
+use Text::Balanced qw{extract_bracketed extract_delimited};
+
+# Actions of this class
+my %ACTION_OF = (extract_interface => \&_extract_interface);
+
+# Regular expressions
+# Matches a variable attribute
+my $RE_ATTR = qr{
+    allocatable|dimension|external|intent|optional|parameter|pointer|save|target
+}imsx;
+# Matches a name
+my $RE_NAME = qr{[A-Za-z]\w*}imsx;
+# Matches a specification type
+my $RE_SPEC = qr{
+    character|complex|double\s*precision|integer|logical|real|type
+}imsx;
+# Matches the identifier of a program unit that does not have arguments
+my $RE_UNIT_BASE = qr{block\s*data|module|program}imsx;
+# Matches the identifier of a program unit that has arguments
+my $RE_UNIT_CALL = qr{function|subroutine}imsx;
+# Matches the identifier of any program unit
+my $RE_UNIT      = qr{$RE_UNIT_BASE|$RE_UNIT_CALL}msx;
+my %RE = (
+    # A comment line
+    COMMENT     => qr{\A\s*(?:!|\z)}msx,
+    # A trailing comment, capture the expression before the comment
+    COMMENT_END => qr{\A([^'"]*?)\s*!.*\z}msx,
+    # A contination marker, capture the expression before the marker
+    CONT        => qr{\A(.*)&\s*\z}msx,
+    # A contination marker at the beginning of a line, capture the marker and
+    # the expression after the marker
+    CONT_LEAD   => qr{\A(\s*&)(.*)\z}msx,
+    # Capture a variable identifier, removing any type component expression
+    NAME_COMP   => qr{\b($RE_NAME)(?:\s*\%\s*$RE_NAME)*\b}msx,
+    # Matches the first identifier in a line
+    NAME_LEAD   => qr{\A\s*$RE_NAME\s*}msx,
+    # Captures a name identifier after a comma, and the expression after
+    NAME_LIST   => qr{\A(?:.*?)\s*,\s*($RE_NAME)\b(.*)\z}msx,
+    # Captures the next quote character
+    QUOTE       => qr{\A[^'"]*(['"])}msx,
+    # Matches an attribute declaration
+    TYPE_ATTR   => qr{\A\s*($RE_ATTR)\b}msx,
+    # Matches a type declaration
+    TYPE_SPEC   => qr{\A\s*($RE_SPEC)\b}msx,
+    # Captures the expression after one or more program unit attributes
+    UNIT_ATTR   => qr{\A\s*(?:(?:elemental|recursive|pure)\s+)+(.*)\z}imsx,
+    # Captures the identifier and the symbol of a program unit with no arguments
+    UNIT_BASE   => qr{\A\s*($RE_UNIT_BASE)\s+($RE_NAME)\s*\z}imsx,
+    # Captures the identifier and the symbol of a program unit with arguments
+    UNIT_CALL   => qr{\A\s*($RE_UNIT_CALL)\s+($RE_NAME)\b}imsx,
+    # Captures the end of a program unit, its identifier and its symbol
+    UNIT_END    => qr{\A\s*(end)(?:\s+($RE_NAME)(?:\s+($RE_NAME))?)?\s*\z}imsx,
+    # Captures the expression after a program unit type specification
+    UNIT_SPEC   => qr{\A\s*$RE_SPEC\b(.*)\z}imsx,
+);
+
+# Keywords in type declaration statements
+my %TYPE_DECL_KEYWORD_SET = map { ($_, 1) } qw{
+    allocatable
+    dimension
+    in
+    inout
+    intent
+    kind
+    len
+    optional
+    out
+    parameter
+    pointer
+    save
+    target
+};
+
+# Creates and returns an instance of this class.
+sub new {
+    my ($class) = @_;
+    bless(
+        sub {
+            my $key = shift();
+            if (!exists($ACTION_OF{$key})) {
+                return;
+            }
+            $ACTION_OF{$key}->(@_);
+        },
+        $class,
+    );
+}
+
+# Methods.
+for my $key (keys(%ACTION_OF)) {
+    no strict qw{refs};
+    *{$key} = sub { my $self = shift(); $self->($key, @_) };
+}
+
+# Extracts the calling interfaces of top level subroutines and functions from
+# the $handle for reading Fortran sources.
+sub _extract_interface {
+    my ($handle) = @_;
+    map { _present_line($_) } @{_reduce_to_interface(_load($handle))};
+}
+
+# Reads $handle for the next Fortran statement, handling continuations.
+sub _load {
+    my ($handle) = @_;
+    my $ctx = {signature_token_set_of => {}, statements => []};
+    my $state = {
+        in_contains  => undef, # in a "contains" section of a program unit
+        in_interface => undef, # in an "interface" block
+        in_quote     => undef, # in a multi-line quote
+        stack        => [],    # program unit stack
+    };
+    my $NEW_STATEMENT = sub {
+        {   name        => q{}, # statement name, e.g. function, integer, ...
+            lines       => [],  # original lines in the statement
+            line_number => 0,   # line number (start) in the original source
+            symbol      => q{}, # name of a program unit (signature, end)
+            type        => q{}, # e.g. signature, use, type, attr, end
+            value       => q{}, # the actual value of the statement
+        };
+    };
+    my $statement;
+LINE:
+    while (my $line = readline($handle)) {
+        if (!defined($statement)) {
+            $statement = $NEW_STATEMENT->();
+        }
+        my $value = $line;
+        chomp($value);
+        # Pre-processor directives and continuation
+        if (!$statement->{line_number} && index($value, '#') == 0) {
+            $statement->{line_number} = $.;
+            $statement->{name}        = 'cpp';
+        }
+        if ($statement->{name} eq 'cpp') {
+            push(@{$statement->{lines}}, $line);
+            $statement->{value} .= $value;
+            if (rindex($value, '\\') != length($value) - 1) {
+                $statement = undef;
+            }
+            next LINE;
+        }
+        # Normal Fortran
+        if ($value =~ $RE{COMMENT}) {
+            next LINE;
+        }
+        if (!$statement->{line_number}) {
+            $statement->{line_number} = $.;
+        }
+        my ($cont_head, $cont_tail);
+        if ($statement->{line_number} != $.) { # is a continuation
+            ($cont_head, $cont_tail) = $value =~ $RE{CONT_LEAD};
+            if ($cont_head) {
+                $value = $cont_tail;
+            }
+        }
+        # Correctly handle ! and & in quotes
+        my ($head, $tail) = (q{}, $value);
+        if ($state->{in_quote} && index($value, $state->{in_quote}) >= 0) {
+            my $index = index($value, $state->{in_quote});
+            $head = substr($value, 0, $index + 1);
+            $tail
+                = length($value) > $index + 1
+                ? substr($value, $index + 2)
+                : q{};
+            $state->{in_quote} = undef;
+        }
+        if (!$state->{in_quote}) {
+            while ($tail) {
+                if (index($tail, q{!}) >= 0) {
+                    if (!($tail =~ s/$RE{COMMENT_END}/$1/)) {
+                        ($head, $tail, $state->{in_quote})
+                            = _load_extract_quote($head, $tail);
+                    }
+                }
+                else {
+                    while (index($tail, q{'}) > 0
+                        || index($tail, q{"}) > 0)
+                    {
+                        ($head, $tail, $state->{in_quote})
+                            = _load_extract_quote($head, $tail);
+                    }
+                    $head .= $tail;
+                    $tail = q{};
+                }
+            }
+        }
+        $cont_head ||= q{};
+        push(@{$statement->{lines}}, $cont_head . $head . $tail . "\n");
+        $statement->{value} .= $head . $tail;
+        # Process a statement only if it is marked with a continuation
+        if (!($statement->{value} =~ s/$RE{CONT}/$1/)) {
+            $statement->{value} =~ s{\s+\z}{}msx;
+            if (_process($statement, $ctx, $state)) {
+                push(@{$ctx->{statements}}, $statement);
+            }
+            $statement = undef;
+        }
+    }
+    return $ctx;
+}
+
+# Helper, removes a quoted string from $tail.
+sub _load_extract_quote {
+    my ($head, $tail) = @_;
+    my ($extracted, $remainder, $prefix)
+        = extract_delimited($tail, q{'"}, qr{[^'"]*}msx, q{});
+    if ($extracted) {
+        return ($head . $prefix . $extracted, $remainder);
+    }
+    else {
+        my ($quote) = $tail =~ $RE{QUOTE};
+        return ($head . $tail, q{}, $quote);
+    }
+}
+
+# Study statements and put attributes into array $statements
+sub _process {
+    my ($statement, $ctx, $state) = @_;
+    my $name;
+
+    # End Interface
+    if ($state->{in_interface}) {
+        if ($statement->{value} =~ qr{\A\s*end\s*interface\b}imsx) {
+            $state->{in_interface} = 0;
+        }
+        return;
+    }
+
+    # End Program Unit
+    if (@{$state->{stack}} && $statement->{value} =~ qr{\A\s*end\b}imsx) {
+        my ($end, $type, $symbol) = lc($statement->{value}) =~ $RE{UNIT_END};
+        if (!$end) {
+            return;
+        }
+        my ($top_type, $top_symbol) = @{$state->{stack}->[-1]};
+        if (!$type
+            || $top_type eq $type && (!$symbol || $top_symbol eq $symbol))
+        {
+            pop(@{$state->{stack}});
+            if ($state->{in_contains} && !@{$state->{stack}}) {
+                $state->{in_contains} = 0;
+            }
+            if (!$state->{in_contains}) {
+                $statement->{name}   = $top_type;
+                $statement->{symbol} = $top_symbol;
+                $statement->{type}   = 'end';
+                return $statement;
+            }
+        }
+        return;
+    }
+
+    # Interface/Contains
+    ($name) = $statement->{value} =~ qr{\A\s*(contains|interface)\b}imsx;
+    if ($name) {
+        $state->{'in_' . lc($name)} = 1;
+        return;
+    }
+
+    # Program Unit
+    my ($type, $symbol, @tokens) = _process_prog_unit($statement->{value});
+    if ($type) {
+        push(@{$state->{stack}}, [$type, $symbol]);
+        if ($state->{in_contains}) {
+            return;
+        }
+        $statement->{name}   = lc($type);
+        $statement->{type}   = 'signature';
+        $statement->{symbol} = lc($symbol);
+        $ctx->{signature_token_set_of}{$symbol}
+            = {map { (lc($_) => 1) } @tokens};
+        return $statement;
+    }
+    if ($state->{in_contains}) {
+        return;
+    }
+
+    # Use
+    if ($statement->{value} =~ qr{\A\s*(use)\b}imsx) {
+        $statement->{name} = 'use';
+        $statement->{type} = 'use';
+        return $statement;
+    }
+
+    # Type Declarations
+    ($name) = $statement->{value} =~ $RE{TYPE_SPEC};
+    if ($name) {
+        $name =~ s{\s}{}gmsx;
+        $statement->{name} = lc($name);
+        $statement->{type} = 'type';
+        return $statement;
+    }
+
+    # Attribute Statements
+    ($name) = $statement->{value} =~ $RE{TYPE_ATTR};
+    if ($name) {
+        $statement->{name} = $name;
+        $statement->{type} = 'attr';
+        return $statement;
+    }
+}
+
+# Parse a statement for program unit header. Returns a list containing the type,
+# the symbol and the signature tokens of the program unit.
+sub _process_prog_unit {
+    my ($string) = @_;
+    my ($type, $symbol, @args) = (q{}, q{});
+    # Is it a blockdata, module or program?
+    ($type, $symbol) = $string =~ $RE{UNIT_BASE};
+    if ($type) {
+        $type = lc($type);
+        $type =~ s{\s*}{}gmsx;
+        return ($type, $symbol);
+    }
+    # Remove the attribute and type declaration of a procedure
+    $string =~ s/$RE{UNIT_ATTR}/$1/;
+    my ($match) = $string =~ $RE{UNIT_SPEC};
+    if ($match) {
+        $string = $match;
+        extract_bracketed($string);
+    }
+    # Is it a function or subroutine?
+    ($type, $symbol) = lc($string) =~ $RE{UNIT_CALL};
+    if (!$type) {
+        return;
+    }
+    my $extracted = extract_bracketed($string, q{()}, qr{[^(]*}msx);
+
+    # Get signature tokens from SUBROUTINE/FUNCTION
+    if ($extracted) {
+        $extracted =~ s{\s}{}gmsx;
+        @args = split(q{,}, substr($extracted, 1, length($extracted) - 2));
+        if ($type eq 'function') {
+            my $result = extract_bracketed($string, q{()}, qr{[^(]*}msx);
+            if ($result) {
+                $result =~ s{\A\(\s*(.*?)\s*\)\z}{$1}msx; # remove braces
+                push(@args, $result);
+            }
+            else {
+                push(@args, $symbol);
+            }
+        }
+    }
+    return (lc($type), lc($symbol), map { lc($_) } @args);
+}
+
+# Reduces the list of statements to contain only the interface block.
+sub _reduce_to_interface {
+    my ($ctx) = @_;
+    my (%token_set, @interface_statements);
+STATEMENT:
+    for my $statement (reverse(@{$ctx->{statements}})) {
+        if ($statement->{type} eq 'end'
+            && grep { $_ eq $statement->{name} } qw{subroutine function})
+        {
+            push(@interface_statements, $statement);
+            %token_set
+                = %{$ctx->{signature_token_set_of}{$statement->{symbol}}};
+            next STATEMENT;
+        }
+        if ($statement->{type} eq 'signature'
+            && grep { $_ eq $statement->{name} } qw{subroutine function})
+        {
+            push(@interface_statements, $statement);
+            %token_set = ();
+            next STATEMENT;
+        }
+        if ($statement->{type} eq 'use') {
+            my ($head, $tail)
+                = split(qr{\s*:\s*}msx, lc($statement->{value}), 2);
+            if ($tail) {
+                my @imports = map { [split(qr{\s*=>\s*}msx, $_, 2)] }
+                    split(qr{\s*,\s*}msx, $tail);
+                my @useful_imports
+                    = grep { exists($token_set{$_->[0]}) } @imports;
+                if (!@useful_imports) {
+                    next STATEMENT;
+                }
+                if (@imports != @useful_imports) {
+                    my @token_strings
+                        = map { $_->[0] . ($_->[1] ? ' => ' . $_->[1] : q{}) }
+                        @useful_imports;
+                    my ($last, @rest) = reverse(@token_strings);
+                    my @token_lines
+                        = (reverse(map { $_ . q{,&} } @rest), $last);
+                    push(
+                        @interface_statements,
+                        {   lines => [
+                                sprintf("%s:&\n", $head),
+                                (map { sprintf(" & %s\n", $_) } @token_lines),
+                            ]
+                        },
+                    );
+                    next STATEMENT;
+                }
+            }
+            push(@interface_statements, $statement);
+            next STATEMENT;
+        }
+        if ($statement->{type} eq 'attr') {
+            my ($spec, @tokens) = ($statement->{value} =~ /$RE{NAME_COMP}/g);
+            if (grep { exists($token_set{$_}) } @tokens) {
+                for my $token (@tokens) {
+                    $token_set{$token} = 1;
+                }
+                push(@interface_statements, $statement);
+                next STATEMENT;
+            }
+        }
+        if ($statement->{type} eq 'type') {
+            my ($variable_string, $spec_string)
+                = reverse(split('::', lc($statement->{value}), 2));
+            if ($spec_string) {
+                $spec_string =~ s{$RE{NAME_LEAD}}{}msx;
+            }
+            else {
+                # The first expression in the statement is the type + attrib
+                $variable_string =~ s{$RE{NAME_LEAD}}{}msx;
+                $spec_string = extract_bracketed($variable_string, '()',
+                    qr{[\s\*]*}msx);
+            }
+            # Useful tokens are those that comes after a comma
+            my $tail = q{,} . lc($variable_string);
+            my @tokens;
+            while ($tail) {
+                if ($tail =~ qr{\A\s*['"]}msx) {
+                    extract_delimited($tail, q{'"}, qr{\A[^'"]*}msx, q{});
+                }
+                elsif ($tail =~ qr{\A\s*\(}msx) {
+                    extract_bracketed($tail, '()', qr{\A[^(]*}msx);
+                }
+                else {
+                    my $token;
+                    ($token, $tail) = $tail =~ $RE{NAME_LIST};
+                    if ($token && $token_set{$token}) {
+                        @tokens = ($variable_string =~ /$RE{NAME_COMP}/g);
+                        $tail = q{};
+                    }
+                }
+            }
+            if (@tokens && $spec_string) {
+                my @spec_tokens = (lc($spec_string) =~ /$RE{NAME_COMP}/g);
+                push(
+                    @tokens,
+                    (   grep { !exists($TYPE_DECL_KEYWORD_SET{$_}) }
+                            @spec_tokens
+                    ),
+                );
+            }
+            if (grep { exists($token_set{$_}) } @tokens) {
+                for my $token (@tokens) {
+                    $token_set{$token} = 1;
+                }
+                push(@interface_statements, $statement);
+                next STATEMENT;
+            }
+        }
+    }
+    if (!@interface_statements) {
+        return [];
+    }
+    [   {lines => ["interface\n"]},
+        reverse(@interface_statements),
+        {lines => ["end interface\n"]},
+    ];
+}
+
+# Processes and returns the line of the statement.
+sub _present_line {
+    my ($statement) = @_;
+    map {
+        s{\s+}{ }gmsx;      # collapse multiple spaces
+        s{\s+\z}{\n}msx;    # remove trailing spaces
+        $_;
+    } @{$statement->{lines}};
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+Fcm::Build::Fortran
+
+=head1 SYNOPSIS
+
+    use Fcm::Build::Fortran;
+    my $fortran_util = Fcm::Build::Fortran->new();
+    open(my($handle), '<', $path_to_a_fortran_source_file);
+    print($fortran_util->extract_interface($handle)); # prints interface
+    close($handle);
+
+=head1 DESCRIPTION
+
+A class to analyse Fortran source. Currently, it has a single method to extract
+the calling interfaces of top level subroutines and functions in a Fortran
+source.
+
+=head1 METHODS
+
+=over 4
+
+=item $class->new()
+
+Creates and returns an instance of this class.
+
+=item $instance->extract_interface($handle)
+
+Extracts the calling interfaces of top level subroutines and functions in a
+Fortran source that can be read from $handle. Returns an interface block as a
+list of lines.
+
+=back
+
+=head1 ACKNOWLEDGEMENT
+
+This module is inspired by the logic developed by the European Centre
+for Medium-Range Weather Forecasts (ECMWF).
+
+=head1 COPYRIGHT
+
+(C) Crown copyright Met Office. All rights reserved.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/BuildSrc.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/BuildSrc.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/BuildSrc.pm	(revision 2528)
@@ -0,0 +1,1498 @@
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::BuildSrc
+#
+# DESCRIPTION
+#   This is a class to group functionalities of source in a build.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+use strict;
+use warnings;
+
+package Fcm::BuildSrc;
+use base qw{Fcm::Base};
+
+use Carp qw{croak};
+use Cwd qw{cwd};
+use Fcm::Build::Fortran;
+use Fcm::CfgFile;
+use Fcm::CfgLine;
+use Fcm::Config;
+use Fcm::Timer qw{timestamp_command};
+use Fcm::Util qw{find_file_in_path run_command};
+use File::Basename qw{basename dirname};
+use File::Spec;
+
+# List of scalar property methods for this class
+my @scalar_properties = (
+  'children',   # list of children packages
+  'is_updated', # is this source (or its associated settings) updated?
+  'mtime',      # modification time of src
+  'ppmtime',    # modification time of ppsrc
+  'ppsrc',      # full path of the pre-processed source
+  'pkgname',    # package name of the source
+  'progname',   # program unit name in the source
+  'src',        # full path of the source
+  'type',       # type of the source
+);
+
+# List of hash property methods for this class
+my @hash_properties = (
+  'dep',   # dependencies
+  'ppdep', # pre-process dependencies
+  'rules', # make rules
+);
+
+# Error message formats
+my %ERR_MESS_OF = (
+  CHDIR       => '%s: cannot change directory (%s), abort',
+  OPEN        => '%s: cannot open (%s), abort',
+  CLOSE_PIPE  => '%s: failed (%d), abort',
+);
+
+# Event message formats and levels
+my %EVENT_SETTING_OF = (
+  CHDIR            => ['%s: change directory'                   , 2],
+  F_INTERFACE_NONE => ['%s: Fortran interface generation is off', 3],
+  GET_DEPENDENCY   => ['%s: %d line(s), %d auto dependency(ies)', 3],
+);
+
+my %RE_OF = (
+  F_PREFIX => qr{
+    (?:
+      (?:ELEMENTAL|PURE(?:\s+RECURSIVE)?|RECURSIVE(?:\s+PURE)?)
+      \s+
+    )?
+  }imsx,
+  F_SPEC => qr{
+    (?:
+      (?:CHARACTER|COMPLEX|DOUBLE\s*PRECISION|INTEGER|LOGICAL|REAL|TYPE)
+      (?: \s* \( .+ \) | \s* \* \d+ \s*)??
+      \s+
+    )?
+  }imsx,
+);
+
+{
+  # Returns a singleton instance of Fcm::Build::Fortran.
+  my $FORTRAN_UTIL;
+  sub _get_fortran_util {
+    $FORTRAN_UTIL ||= Fcm::Build::Fortran->new();
+    return $FORTRAN_UTIL;
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = Fcm::BuildSrc->new (%args);
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::BuildSrc class. See
+#   above for allowed list of properties. (KEYS should be in uppercase.)
+# ------------------------------------------------------------------------------
+
+sub new {
+  my ($class, %args) = @_;
+  my $self = bless(Fcm::Base->new(%args), $class);
+  for my $key (@scalar_properties, @hash_properties) {
+    $self->{$key}
+      = exists($args{uc($key)}) ? $args{uc($key)}
+      :                           undef
+      ;
+  }
+  $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @scalar_properties.
+# ------------------------------------------------------------------------------
+
+for my $name (@scalar_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    # Argument specified, set property to specified argument
+    if (@_) {
+      $self->{$name} = $_[0];
+
+      if ($name eq 'ppsrc') {
+        $self->ppmtime (undef);
+
+      } elsif ($name eq 'src') {
+        $self->mtime (undef);
+      }
+    }
+
+    # Default value for property
+    if (not defined $self->{$name}) {
+      if ($name eq 'children') {
+        # Reference to an empty array
+        $self->{$name} = [];
+        
+      } elsif ($name =~ /^(?:is_cur|pkgname|ppsrc|src)$/) {
+        # Empty string
+        $self->{$name} = '';
+        
+      } elsif ($name eq 'mtime') {
+        # Modification time
+        $self->{$name} = (stat $self->src)[9] if $self->src;
+        
+      } elsif ($name eq 'ppmtime') {
+        # Modification time
+        $self->{$name} = (stat $self->ppsrc)[9] if $self->ppsrc;
+        
+      } elsif ($name eq 'type') {
+        # Attempt to get the type if src is set
+        $self->{$name} = $self->get_type if $self->src;
+      }
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %hash = %{ $obj->X () };
+#   $obj->X (\%hash);
+#
+#   $value = $obj->X ($index);
+#   $obj->X ($index, $value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @hash_properties.
+#
+#   If no argument is set, this method returns a hash containing a list of
+#   objects. If an argument is set and it is a reference to a hash, the objects
+#   are replaced by the the specified hash.
+#
+#   If a scalar argument is specified, this method returns a reference to an
+#   object, if the indexed object exists or undef if the indexed object does
+#   not exist. If a second argument is set, the $index element of the hash will
+#   be set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+for my $name (@hash_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my ($self, $arg1, $arg2) = @_;
+
+    # Ensure property is defined as a reference to a hash
+    if (not defined $self->{$name}) {
+      if ($name eq 'rules') {
+        $self->{$name} = $self->get_rules;
+
+      } else {
+        $self->{$name} = {};
+      }
+    }
+
+    # Argument 1 can be a reference to a hash or a scalar index
+    my ($index, %hash);
+
+    if (defined $arg1) {
+      if (ref ($arg1) eq 'HASH') {
+        %hash = %$arg1;
+
+      } else {
+        $index = $arg1;
+      }
+    }
+
+    if (defined $index) {
+      # A scalar index is defined, set and/or return the value of an element
+      $self->{$name}{$index} = $arg2 if defined $arg2;
+
+      return (
+        exists $self->{$name}{$index} ? $self->{$name}{$index} : undef
+      );
+
+    } else {
+      # A scalar index is not defined, set and/or return the hash
+      $self->{$name} = \%hash if defined $arg1;
+      return $self->{$name};
+    }
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   This method returns/sets property X, all derived from src, where X is:
+#     base  - (read-only) basename of src
+#     dir   - (read-only) dirname of src
+#     ext   - (read-only) file extension of src
+#     root  - (read-only) basename of src without the file extension
+# ------------------------------------------------------------------------------
+
+sub base {
+  return &basename ($_[0]->src);
+}
+
+# ------------------------------------------------------------------------------
+
+sub dir {
+  return &dirname ($_[0]->src);
+}
+
+# ------------------------------------------------------------------------------
+
+sub ext {
+  return substr $_[0]->base, length ($_[0]->root);
+}
+
+# ------------------------------------------------------------------------------
+
+sub root {
+  (my $root = $_[0]->base) =~ s/\.\w+$//;
+  return $root;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   This method returns/sets property X, all derived from ppsrc, where X is:
+#     ppbase  - (read-only) basename of ppsrc
+#     ppdir   - (read-only) dirname of ppsrc
+#     ppext   - (read-only) file extension of ppsrc
+#     pproot  - (read-only) basename of ppsrc without the file extension
+# ------------------------------------------------------------------------------
+
+sub ppbase {
+  return &basename ($_[0]->ppsrc);
+}
+
+# ------------------------------------------------------------------------------
+
+sub ppdir {
+  return &dirname ($_[0]->ppsrc);
+}
+
+# ------------------------------------------------------------------------------
+
+sub ppext {
+  return substr $_[0]->ppbase, length ($_[0]->pproot);
+}
+
+# ------------------------------------------------------------------------------
+
+sub pproot {
+  (my $root = $_[0]->ppbase) =~ s/\.\w+$//;
+  return $root;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#
+# DESCRIPTION
+#   This method returns/sets property X, derived from src or ppsrc, where X is:
+#     curbase  - (read-only) basename of cursrc
+#     curdir   - (read-only) dirname of cursrc
+#     curext   - (read-only) file extension of cursrc
+#     curmtime - (read-only) modification time of cursrc
+#     curroot  - (read-only) basename of cursrc without the file extension
+#     cursrc   - ppsrc or src
+# ------------------------------------------------------------------------------
+
+for my $name (qw/base dir ext mtime root src/) {
+  no strict 'refs';
+
+  my $subname = 'cur' . $name;
+
+  *$subname = sub {
+    my $self = shift;
+    my $method = $self->ppsrc ? 'pp' . $name : $name;
+    return $self->$method (@_);
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $base = $obj->X ();
+#
+# DESCRIPTION
+#   This method returns a basename X for the source, where X is:
+#     donebase      - "done" file name
+#     etcbase       - target for copying data files
+#     exebase       - executable name for source containing a main program
+#     interfacebase - Fortran interface file name
+#     libbase       - library file name
+#     objbase       - object name for source containing compilable source
+#   If the source file contains a compilable procedure, this method returns
+#   the name of the object file.
+# ------------------------------------------------------------------------------
+
+sub donebase {
+  my $self   = shift;
+
+  my $return;
+  if ($self->is_type_all ('SOURCE')) {
+    if ($self->objbase and not $self->is_type_all ('PROGRAM')) {
+      $return = ($self->progname ? $self->progname : lc ($self->curroot)) .
+                $self->setting (qw/OUTFILE_EXT DONE/);
+    }
+
+  } elsif ($self->is_type_all ('INCLUDE')) {
+    $return = $self->curbase . $self->setting (qw/OUTFILE_EXT IDONE/);
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+
+sub etcbase {
+  my $self = shift;
+
+  my $return = @{ $self->children }
+               ? $self->pkgname . $self->setting (qw/OUTFILE_EXT ETC/)
+               : undef;
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+
+sub exebase {
+  my $self = shift;
+
+  my $return;
+  if ($self->objbase and $self->is_type_all ('PROGRAM')) {
+    if ($self->setting ('BLD_EXE_NAME', $self->curroot)) {
+      $return = $self->setting ('BLD_EXE_NAME', $self->curroot);
+
+    } else {
+      $return = $self->curroot . $self->setting (qw/OUTFILE_EXT EXE/);
+    }
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+
+sub interfacebase {
+  my $self = shift();
+  if (
+        uc($self->get_setting(qw/TOOL GENINTERFACE/)) ne 'NONE'
+    &&  $self->progname()
+    &&  $self->is_type_all(qw/SOURCE/)
+    &&  $self->is_type_any(qw/FORTRAN9X FPP9X/)
+    &&  !$self->is_type_any(qw/PROGRAM MODULE BLOCKDATA/)
+  ) {
+    my $flag = lc($self->get_setting(qw/TOOL INTERFACE/));
+    my $ext  = $self->setting(qw/OUTFILE_EXT INTERFACE/);
+
+    return (($flag eq 'program' ? $self->progname() : $self->curroot()) . $ext);
+  }
+  return;
+}
+
+# ------------------------------------------------------------------------------
+
+sub objbase {
+  my $self = shift;
+
+  my $return;
+
+  if ($self->is_type_all ('SOURCE')) {
+    my $ext = $self->setting (qw/OUTFILE_EXT OBJ/);
+
+    if ($self->is_type_any (qw/FORTRAN FPP/)) {
+      $return = lc ($self->progname) . $ext if $self->progname;
+
+    } else {
+      $return = lc ($self->curroot) . $ext;
+    }
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->flagsbase ($flag, [$index,]);
+#
+# DESCRIPTION
+#   This method returns the property flagsbase (derived from pkgname) the base
+#   name of the flags-file (to indicate changes in a particular build tool) for
+#   $flag, which can have the value:
+#     *FLAGS  - compiler flags flags-file
+#     *PPKEYS - pre-processor keys (i.e. macro definitions) flags-file
+#     LD      - linker flags-file
+#     LDFLAGS - linker flags flags-file
+#   If $index is set, the $index'th element in pkgnames is used for the package
+#   name.
+# ------------------------------------------------------------------------------
+
+sub flagsbase {
+  my ($self, $flag, $index) = @_;
+
+  (my $pkg = $index ? $self->pkgnames->[$index] : $self->pkgname) =~ s/\.\w+$//;
+
+  if ($self->is_type_all ('SOURCE')) {
+    if ($flag eq 'FLAGS' or $flag eq 'PPKEYS' and $self->lang) {
+      my %tool_src = %{ $self->setting ('TOOL_SRC') };
+      $flag = $tool_src{$self->lang}{$flag} ? $tool_src{$self->lang}{$flag} : '';
+    }
+  }
+
+  if ($flag) {
+    return join ('__', ($flag, $pkg ? $pkg : ())) .
+           $self->setting (qw/OUTFILE_EXT FLAGS/);
+
+  } else {
+    return undef;
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->libbase ([$prefix], [$suffix]);
+#
+# DESCRIPTION
+#   This method returns the property libbase (derived from pkgname) the base
+#   name of the library archive. $prefix and $suffix defaults to 'lib' and '.a'
+#   respectively.
+# ------------------------------------------------------------------------------
+
+sub libbase {
+  my ($self, $prefix, $suffix) = @_;
+  $prefix ||= 'lib';
+  $suffix ||= $self->setting(qw/OUTFILE_EXT LIB/);
+  if ($self->src()) { # applies to directories only
+    return;
+  }
+  my $name = $self->setting('BLD_LIB', $self->pkgname());
+  if (!defined($name)) {
+    $name = $self->pkgname();
+  }
+  $prefix . $name . $suffix;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->lang ([$setting]);
+#
+# DESCRIPTION
+#   This method returns the property lang (derived from type) the programming
+#   language name if type matches one supported in the TOOL_SRC setting. If
+#   $setting is specified, use $setting instead of TOOL_SRC.
+# ------------------------------------------------------------------------------
+
+sub lang {
+  my ($self, $setting) = @_;
+
+  my @keys = keys %{ $self->setting ($setting ? $setting : 'TOOL_SRC') };
+
+  my $return = undef;
+  for my $key (@keys) {
+    next unless $self->is_type_all ('SOURCE', $key);
+    $return = $key;
+    last;
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->pkgnames;
+#
+# DESCRIPTION
+#   This method returns a list of container packages, derived from pkgname:
+# ------------------------------------------------------------------------------
+
+sub pkgnames {
+  my $self = shift;
+
+  my $return = [];
+  if ($self->pkgname) {
+    my @names = split (/__/, $self->pkgname);
+
+    for my $i (0 .. $#names) {
+      push @$return, join ('__', (@names[0 .. $i]));
+    }
+
+    unshift @$return, '';
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %dep = %{$obj->get_dep()};
+#   %dep = %{$obj->get_dep($flag)};
+#
+# DESCRIPTION
+#   This method scans the current source file for dependencies and returns the
+#   dependency hash (keys = dependencies, values = dependency types). If $flag
+#   is specified, the config setting for $flag is used to determine the types of
+#   types. Otherwise, those specified in 'BLD_TYPE_DEP' is used.
+# ------------------------------------------------------------------------------
+
+sub get_dep {
+  my ($self, $flag) = @_;
+  # Work out list of exclude for this file, using its sub-package name
+  my %EXCLUDE_SET = map {($_, 1)} @{$self->get_setting('BLD_DEP_EXCL')};
+  # Determine what dependencies are supported by this known type
+  my %DEP_TYPE_OF = %{$self->setting($flag ? $flag : 'BLD_TYPE_DEP')};
+  my %PATTERN_OF = %{$self->setting('BLD_DEP_PATTERN')};
+  my @dep_types = ();
+  if (!$self->get_setting('BLD_DEP_N')) {
+    DEP_TYPE:
+    while (my ($key, $dep_type_string) = each(%DEP_TYPE_OF)) {
+      # Check if current file is a type of file requiring dependency scan
+      if (!$self->is_type_all($key)) {
+        next DEP_TYPE;
+      }
+      # Get list of dependency type for this file
+      for my $dep_type (split(/$Fcm::Config::DELIMITER/, $dep_type_string)) {
+        if (exists($PATTERN_OF{$dep_type}) && !exists($EXCLUDE_SET{$dep_type})) {
+          push(@dep_types, $dep_type);
+        }
+      }
+    }
+  }
+
+  # Automatic dependencies
+  my %dep_of;
+  my $can_get_symbol # Also scan for program unit name in Fortran source
+      =  !$flag
+      && $self->is_type_all('SOURCE')
+      && $self->is_type_any(qw/FPP FORTRAN/)
+      ;
+  my $has_read_file;
+  if ($can_get_symbol || @dep_types) {
+    my $handle = _open($self->cursrc());
+    LINE:
+    while (my $line = readline($handle)) {
+      chomp($line);
+      if ($line =~ qr{\A \s* \z}msx) { # empty lines
+        next LINE;
+      }
+      if ($can_get_symbol) {
+        my $symbol = _get_dep_symbol($line);
+        if ($symbol) {
+          $self->progname($symbol);
+          $can_get_symbol = 0;
+          next LINE;
+        }
+      }
+      DEP_TYPE:
+      for my $dep_type (@dep_types) {
+        my ($match) = $line =~ /$PATTERN_OF{$dep_type}/i;
+        if (!$match) {
+          next DEP_TYPE;
+        }
+        # $match may contain multiple items delimited by space
+        for my $item (split(qr{\s+}msx, $match)) {
+          my $key = uc($dep_type . $Fcm::Config::DELIMITER . $item);
+          if (!exists($EXCLUDE_SET{$key})) {
+            $dep_of{$item} = $dep_type;
+          }
+        }
+        next LINE;
+      }
+    }
+    $self->_event('GET_DEPENDENCY', $self->pkgname(), $., scalar(keys(%dep_of)));
+    close($handle);
+    $has_read_file = 1;
+  }
+
+  # Manual dependencies
+  my $manual_deps_ref
+      = $self->setting('BLD_DEP' . ($flag ? '_PP' : ''), $self->pkgname());
+  if (defined($manual_deps_ref)) {
+    for (@{$manual_deps_ref}) {
+      my ($dep_type, $item) = split(/$Fcm::Config::DELIMITER/, $_, 2);
+      $dep_of{$item} = $dep_type;
+    }
+  }
+
+  return ($has_read_file, \%dep_of);
+}
+
+# Returns, if possible, the program unit declared in the $line.
+sub _get_dep_symbol {
+  my $line = shift();
+  for my $pattern (
+    qr{\A \s* $RE_OF{F_PREFIX} SUBROUTINE              \s+ ([A-Za-z]\w*)}imsx,
+    qr{\A \s* MODULE (?!\s+PROCEDURE)                  \s+ ([A-Za-z]\w*)}imsx,
+    qr{\A \s* PROGRAM                                  \s+ ([A-Za-z]\w*)}imsx,
+    qr{\A \s* $RE_OF{F_PREFIX} $RE_OF{F_SPEC} FUNCTION \s+ ([A-Za-z]\w*)}imsx,
+    qr{\A \s* BLOCK\s*DATA                             \s+ ([A-Za-z]\w*)}imsx,
+  ) {
+    my ($match) = $line =~ $pattern;
+    if ($match) {
+      return lc($match);
+    }
+  }
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @out = @{ $obj->get_fortran_interface () };
+#
+# DESCRIPTION
+#   This method invokes the Fortran interface block generator to generate
+#   an interface block for the current source file. It returns a reference to
+#   an array containing the lines of the interface block.
+# ------------------------------------------------------------------------------
+
+sub get_fortran_interface {
+  my $self = shift();
+  my %ACTION_OF = (
+    q{}    => \&_get_fortran_interface_by_internal_code,
+    f90aib => \&_get_fortran_interface_by_f90aib,
+    none   => sub {$self->_event('F_INTERFACE_NONE', $self->root()); []},
+  );
+  my $key = lc($self->get_setting(qw/TOOL GENINTERFACE/));
+  if (!$key || !exists($ACTION_OF{$key})) {
+    $key = q{};
+  }
+  $ACTION_OF{$key}->($self->cursrc());
+}
+
+# Generates Fortran interface block using "f90aib".
+sub _get_fortran_interface_by_f90aib {
+  my $path = shift();
+  my $command = sprintf(q{f90aib <'%s' 2>'%s'}, $path, File::Spec->devnull());
+  my $pipe = _open($command, '-|');
+  my @lines = readline($pipe);
+  close($pipe) || croak($ERR_MESS_OF{CLOSE_PIPE}, $command, $?);
+  \@lines;
+}
+
+# Generates Fortran interface block using internal code.
+sub _get_fortran_interface_by_internal_code {
+  my $path = shift();
+  my $handle = _open($path);
+  my @lines = _get_fortran_util()->extract_interface($handle);
+  close($handle);
+  \@lines;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @out = @{ $obj->get_pre_process () };
+#
+# DESCRIPTION
+#   This method invokes the pre-processor on the source file and returns a
+#   reference to an array containing the lines of the pre-processed source on
+#   success.
+# ------------------------------------------------------------------------------
+
+sub get_pre_process {
+  my $self = shift;
+
+  # Supported source files
+  my $lang = $self->lang ('TOOL_SRC_PP');
+  return unless $lang;
+
+  # List of include directories
+  my @inc = @{ $self->setting (qw/PATH INC/) };
+
+  # Build the pre-processor command according to file type
+  my %tool        = %{ $self->setting ('TOOL') };
+  my %tool_src_pp = %{ $self->setting ('TOOL_SRC_PP', $lang) };
+
+  # The pre-processor command and its options
+  my @command = ($tool{$tool_src_pp{COMMAND}});
+  my @ppflags = split /\s+/, $self->get_setting ('TOOL', $tool_src_pp{FLAGS});
+
+  # List of defined macros, add "-D" in front of each macro
+  my @ppkeys  = split /\s+/, $self->get_setting ('TOOL', $tool_src_pp{PPKEYS});
+  @ppkeys     = map {($tool{$tool_src_pp{DEFINE}} . $_)} @ppkeys;
+
+  # Add "-I" in front of each include directories
+  @inc        = map {($tool{$tool_src_pp{INCLUDE}} . $_)} @inc;
+
+  push @command, (@ppflags, @ppkeys, @inc, $self->base);
+
+  # Change to container directory of source file
+  my $old_cwd = $self->_chdir($self->dir());
+
+  # Execute the command, getting the output lines
+  my $verbose = $self->verbose;
+  my @outlines = &run_command (
+    \@command, METHOD => 'qx', PRINT => $verbose > 1, TIME => $verbose > 2,
+  );
+
+  # Change back to original directory
+  $self->_chdir($old_cwd);
+
+  return \@outlines;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rules = %{ $self->get_rules };
+#
+# DESCRIPTION
+#   This method returns a reference to a hash in the following format:
+#     $rules = {
+#       target => {ACTION => action, DEP => [dependencies], ...},
+#       ...    => {...},
+#     };
+#   where the 1st rank keys are the available targets for building this source
+#   file, the second rank keys are ACTION and DEP. The value of ACTION is the
+#   action for building the target, which can be "COMPILE", "LOAD", "TOUCH",
+#   "CP" or "AR". The value of DEP is a refernce to an array containing a list
+#   of dependencies suitable for insertion into the Makefile.
+# ------------------------------------------------------------------------------
+
+sub get_rules {
+  my $self = shift;
+
+  my $rules;
+  my %outfile_ext = %{ $self->setting ('OUTFILE_EXT') };
+
+  if ($self->is_type_all (qw/SOURCE/)) {
+    # Source file
+    # --------------------------------------------------------------------------
+    # Determine whether the language of the source file is supported
+    my %tool_src = %{ $self->setting ('TOOL_SRC') };
+
+    return () unless $self->lang;
+
+    # Compile object
+    # --------------------------------------------------------------------------
+    if ($self->objbase) {
+      # Depends on the source file
+      my @dep = ($self->rule_src);
+
+      # Depends on the compiler flags flags-file
+      my @flags;
+      push @flags, ('FLAGS' )
+        if $self->flagsbase ('FLAGS' );
+      push @flags, ('PPKEYS')
+        if $self->flagsbase ('PPKEYS') and not $self->ppsrc;
+
+      push @dep, $self->flagsbase ($_) for (@flags);
+
+      # Source file dependencies
+      for my $name (sort keys %{ $self->dep }) {
+        # A Fortran 9X module, lower case object file name
+        if ($self->dep ($name) eq 'USE') {
+          (my $root = $name) =~ s/\.\w+$//;
+          push @dep, lc ($root) . $outfile_ext{OBJ};
+
+        # An include file
+        } elsif ($self->dep ($name) =~ /^(?:INC|H|INTERFACE)$/) {
+          push @dep, $name;
+        }
+      }
+
+      $rules->{$self->objbase} = {ACTION => 'COMPILE', DEP => \@dep};
+
+      # Touch flags-files
+      # ------------------------------------------------------------------------
+      for my $flag (@flags) {
+        next unless $self->flagsbase ($flag);
+
+        $rules->{$self->flagsbase ($flag)} = {
+          ACTION => 'TOUCH',
+          DEP    => [
+            $self->flagsbase ($tool_src{$self->lang}{$flag}, -2),
+          ],
+          DEST   => '$(FCM_FLAGSDIR)',
+        };
+      }
+    }
+
+    if ($self->exebase) {
+      # Link into an executable
+      # ------------------------------------------------------------------------
+      my @dep = ();
+      push @dep, $self->objbase               if $self->objbase;
+      push @dep, $self->flagsbase ('LD'     ) if $self->flagsbase ('LD'     );
+      push @dep, $self->flagsbase ('LDFLAGS') if $self->flagsbase ('LDFLAGS');
+
+      # Depends on BLOCKDATA program units, for Fortran programs
+      my %blockdata = %{ $self->setting ('BLD_BLOCKDATA') };
+      my @blkobj    = ();
+
+      if ($self->is_type_any (qw/FPP FORTRAN/) and keys %blockdata) {
+        # List of BLOCKDATA object files
+        if (exists $blockdata{$self->exebase}) {
+          @blkobj = split /\s+/, $blockdata{$self->exebase};
+
+        } elsif (exists $blockdata{''}) {
+          @blkobj = split /\s+/, $blockdata{''};
+        }
+
+        for my $name (@blkobj) {
+          (my $root = $name) =~ s/\.\w+$//;
+          $name = $root . $outfile_ext{OBJ};
+          push @dep, $root . $outfile_ext{DONE};
+        }
+      }
+
+      # Extra executable dependencies
+      my %exe_dep = %{ $self->setting ('BLD_DEP_EXE') };
+      if (keys %exe_dep) {
+        my @exe_deps;
+        if (exists $exe_dep{$self->exebase}) {
+          @exe_deps = split /\s+/, $exe_dep{$self->exebase};
+
+        } elsif (exists $exe_dep{''}) {
+          @exe_deps = $exe_dep{''} ? split (/\s+/, $exe_dep{''}) : ('');
+        }
+
+        my $pattern = '\\' . $outfile_ext{OBJ} . '$';
+
+        for my $name (@exe_deps) {
+          if ($name =~ /$pattern/) {
+            # Extra dependency is an object
+            (my $root = $name) =~ s/\.\w+$//;
+            push @dep, $root . $outfile_ext{DONE};
+
+          } else {
+            # Extra dependency is a sub-package
+            my $var;
+            if ($self->setting ('FCM_PCK_OBJECTS', $name)) {
+              # sub-package name contains unusual characters
+              $var = $self->setting ('FCM_PCK_OBJECTS', $name);
+
+            } else {
+              # sub-package name contains normal characters
+              $var = $name ? join ('__', ('OBJECTS', $name)) : 'OBJECTS';
+            }
+
+            push @dep, '$(' . $var . ')';
+          }
+        }
+      }
+
+      # Source file dependencies
+      for my $name (sort keys %{ $self->dep }) {
+        (my $root = $name) =~ s/\.\w+$//;
+
+        # Lowercase name for object dependency
+        $root = lc ($root) unless $self->dep ($name) =~ /^(?:INC|H)$/;
+
+        # Select "done" file extension
+        if ($self->dep ($name) =~ /^(?:INC|H)$/) {
+          push @dep, $name . $outfile_ext{IDONE};
+
+        } else {
+          push @dep, $root . $outfile_ext{DONE};
+        }
+      }
+
+      $rules->{$self->exebase} = {
+        ACTION => 'LOAD', DEP => \@dep, BLOCKDATA => \@blkobj,
+      };
+
+      # Touch Linker flags-file
+      # ------------------------------------------------------------------------
+      for my $flag (qw/LD LDFLAGS/) {
+        $rules->{$self->flagsbase ($flag)} = {
+          ACTION => 'TOUCH',
+          DEP    => [$self->flagsbase ($flag, -2)],
+          DEST   => '$(FCM_FLAGSDIR)',
+        };
+      }
+
+    }
+
+    if ($self->donebase) {
+      # Touch done file
+      # ------------------------------------------------------------------------
+      my @dep = ($self->objbase);
+
+      for my $name (sort keys %{ $self->dep }) {
+        (my $root = $name) =~ s/\.\w+$//;
+
+        # Lowercase name for object dependency
+        $root = lc ($root) unless $self->dep ($name) =~ /^(?:INC|H)$/;
+
+        # Select "done" file extension
+        if ($self->dep ($name) =~ /^(?:INC|H)$/) {
+          push @dep, $name . $outfile_ext{IDONE};
+
+        } else {
+          push @dep, $root . $outfile_ext{DONE};
+        }
+      }
+
+      $rules->{$self->donebase} = {
+        ACTION => 'TOUCH', DEP => \@dep, DEST => '$(FCM_DONEDIR)',
+      };
+    }
+    
+    if ($self->interfacebase) {
+      # Interface target
+      # ------------------------------------------------------------------------
+      # Source file dependencies
+      my @dep = ();
+      for my $name (sort keys %{ $self->dep }) {
+        # Depends on Fortran 9X modules
+        push @dep, lc ($name) . $outfile_ext{OBJ}
+          if $self->dep ($name) eq 'USE';
+      }
+
+      $rules->{$self->interfacebase} = {ACTION => '', DEP => \@dep};
+    }
+
+  } elsif ($self->is_type_all ('INCLUDE')) {
+    # Copy include target
+    # --------------------------------------------------------------------------
+    my @dep = ($self->rule_src);
+
+    for my $name (sort keys %{ $self->dep }) {
+      # A Fortran 9X module, lower case object file name
+      if ($self->dep ($name) eq 'USE') {
+        (my $root = $name) =~ s/\.\w+$//;
+        push @dep, lc ($root) . $outfile_ext{OBJ};
+
+      # An include file
+      } elsif ($self->dep ($name) =~ /^(?:INC|H|INTERFACE)$/) {
+        push @dep, $name;
+      }
+    }
+
+    $rules->{$self->curbase} = {
+      ACTION => 'CP', DEP => \@dep, DEST => '$(FCM_INCDIR)',
+    };
+
+    # Touch IDONE file
+    # --------------------------------------------------------------------------
+    if ($self->donebase) {
+      my @dep = ($self->rule_src);
+
+      for my $name (sort keys %{ $self->dep }) {
+        (my $root = $name) =~ s/\.\w+$//;
+
+        # Lowercase name for object dependency
+        $root   = lc ($root) unless $self->dep ($name) =~ /^(?:INC|H)$/;
+
+        # Select "done" file extension
+        if ($self->dep ($name) =~ /^(?:INC|H)$/) {
+          push @dep, $name . $outfile_ext{IDONE};
+
+        } else {
+          push @dep, $root . $outfile_ext{DONE};
+        }
+      }
+
+      $rules->{$self->donebase} = {
+        ACTION => 'TOUCH', DEP => \@dep, DEST => '$(FCM_DONEDIR)',
+      };
+    }
+
+  } elsif ($self->is_type_any (qw/EXE SCRIPT/)) {
+    # Copy executable file
+    # --------------------------------------------------------------------------
+    my @dep = ($self->rule_src);
+
+    # Depends on dummy copy file, if file is an "always build type"
+    push @dep, $self->setting (qw/BLD_CPDUMMY/)
+      if $self->is_type_any (split (
+        /$Fcm::Config::DELIMITER_LIST/, $self->setting ('BLD_TYPE_ALWAYS_BUILD')
+      ));
+
+    # Depends on other executable files
+    for my $name (sort keys %{ $self->dep }) {
+      push @dep, $name if $self->dep ($name) eq 'EXE';
+    }
+
+    $rules->{$self->curbase} = {
+      ACTION => 'CP', DEP => \@dep, DEST => '$(FCM_BINDIR)',
+    };
+
+  } elsif (@{ $self->children }) {
+    # Targets for top level and package flags files and dummy dependencies
+    # --------------------------------------------------------------------------
+    my %tool_src   = %{ $self->setting ('TOOL_SRC') };
+    my %flags_tool = (LD => '', LDFLAGS => '');
+
+    for my $key (keys %tool_src) {
+      $flags_tool{$tool_src{$key}{FLAGS}} = $tool_src{$key}{COMMAND}
+        if exists $tool_src{$key}{FLAGS};
+
+      $flags_tool{$tool_src{$key}{PPKEYS}} = ''
+        if exists $tool_src{$key}{PPKEYS};
+    }
+
+    for my $name (sort keys %flags_tool) {
+      my @dep = $self->pkgname eq '' ? () : $self->flagsbase ($name, -2);
+      push @dep, $self->flagsbase ($flags_tool{$name})
+        if $self->pkgname eq '' and $flags_tool{$name};
+
+      $rules->{$self->flagsbase ($flags_tool{$name})} = {
+        ACTION => 'TOUCH',
+        DEST   => '$(FCM_FLAGSDIR)',
+      } if $self->pkgname eq '' and $flags_tool{$name};
+
+      $rules->{$self->flagsbase ($name)} = {
+        ACTION => 'TOUCH',
+        DEP    => \@dep,
+        DEST   => '$(FCM_FLAGSDIR)',
+      };
+    }
+
+    # Package object and library
+    # --------------------------------------------------------------------------
+    {
+      my @dep;
+      # Add objects from children
+      for my $child (sort {$a->pkgname cmp $b->pkgname} @{ $self->children }) {
+        push @dep, $child->rule_obj_var (1)
+          if $child->libbase and $child->rules ($child->libbase);
+        push @dep, $child->objbase
+          if $child->cursrc and $child->objbase and
+             not $child->is_type_any (qw/PROGRAM BLOCKDATA/);
+      }
+
+      if (@dep) {
+        $rules->{$self->libbase} = {ACTION => 'AR', DEP => \@dep};
+      }
+    }
+
+    # Package data files
+    # --------------------------------------------------------------------------
+    {
+      my @dep;
+      for my $child (@{ $self->children }) {
+        push @dep, $child->rule_src if $child->src and not $child->type;
+      }
+
+      if (@dep) {
+        push @dep, $self->setting (qw/BLD_CPDUMMY/);
+        $rules->{$self->etcbase} = {
+          ACTION => 'CP_DATA', DEP => \@dep, DEST => '$(FCM_ETCDIR)',
+        };
+      }
+    }
+  }
+
+  return $rules;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->get_setting ($setting[, @prefix]);
+#
+# DESCRIPTION
+#   This method gets the correct $setting for the current source by following
+#   its package name. If @prefix is set, get the setting with the given prefix.
+# ------------------------------------------------------------------------------
+
+sub get_setting {
+  my ($self, $setting, @prefix) = @_;
+
+  my $val;
+  for my $name (reverse @{ $self->pkgnames }) {
+    my @names = split /__/, $name;
+    $val = $self->setting ($setting, join ('__', (@prefix, @names)));
+
+    $val = $self->setting ($setting, join ('__', (@prefix, @names)))
+      if (not defined $val) and @names and $names[-1] =~ s/\.[^\.]+$//;
+    last if defined $val;
+  }
+
+  return $val;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $type = $self->get_type();
+#
+# DESCRIPTION
+#   This method determines whether the source is a type known to the
+#   build system. If so, it returns the type flags delimited by "::".
+# ------------------------------------------------------------------------------
+
+sub get_type {
+  my $self = shift();
+  my @IGNORE_LIST
+    = split(/$Fcm::Config::DELIMITER_LIST/, $self->setting('INFILE_IGNORE'));
+  if (grep {$self->curbase() eq $_} @IGNORE_LIST) {
+    return q{};
+  }
+  # User defined
+  my $type = $self->setting('BLD_TYPE', $self->pkgname());
+  # Extension
+  if (!defined($type)) {
+    my $ext = $self->curext() ? substr($self->curext(), 1) : q{};
+    $type = $self->setting('INFILE_EXT', $ext);
+  }
+  # Pattern of name
+  if (!defined($type)) {
+    my %NAME_PATTERN_TO_TYPE_HASH = %{$self->setting('INFILE_PAT')};
+    PATTERN:
+    while (my ($pattern, $value) = each(%NAME_PATTERN_TO_TYPE_HASH)) {
+      if ($self->curbase() =~ $pattern) {
+        $type = $value;
+        last PATTERN;
+      }
+    }
+  }
+  # Pattern of #! line
+  if (!defined($type) && -s $self->cursrc() && -T _) {
+    my $handle = _open($self->cursrc());
+    my $line = readline($handle);
+    close($handle);
+    my %SHEBANG_PATTERN_TO_TYPE_HASH = %{$self->setting('INFILE_TXT')};
+    PATTERN:
+    while (my ($pattern, $value) = each(%SHEBANG_PATTERN_TO_TYPE_HASH)) {
+      if ($line =~ qr{^\#!.*$pattern}msx) {
+        $type = $value;
+        last PATTERN;
+      }
+    }
+  }
+  if (!$type) {
+    return $type;
+  }
+  # Extra type information for selected file types
+  my %EXTRA_FOR = (
+    qr{\b (?:FORTRAN|FPP) \b}msx => \&_get_type_extra_for_fortran,
+    qr{\b C \b}msx               => \&_get_type_extra_for_c,
+  );
+  EXTRA:
+  while (my ($key, $code_ref) = each(%EXTRA_FOR)) {
+    if ($type =~ $key) {
+      my $handle = _open($self->cursrc());
+      LINE:
+      while (my $line = readline($handle)) {
+        my $extra = $code_ref->($line);
+        if ($extra) {
+          $type .= $Fcm::Config::DELIMITER . $extra;
+          last LINE;
+        }
+      }
+      close($handle);
+      last EXTRA;
+    }
+  }
+  return $type;
+}
+
+sub _get_type_extra_for_fortran {
+  my ($match) = $_[0] =~ qr{\A \s* (PROGRAM|MODULE|BLOCK\s*DATA) \b}imsx;
+  if (!$match) {
+    return;
+  }
+  $match =~ s{\s}{}g;
+  uc($match)
+}
+
+sub _get_type_extra_for_c {
+  ($_[0] =~ qr{int\s+main\s*\(}msx) ? 'PROGRAM' : undef;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $obj->is_in_package ($name);
+#
+# DESCRIPTION
+#   This method returns true if current package is in the package $name.
+# ------------------------------------------------------------------------------
+
+sub is_in_package {
+  my ($self, $name) = @_;
+  
+  my $return = 0;
+  for (@{ $self->pkgnames }) {
+    next unless /^$name(?:\.\w+)?$/;
+    $return = 1;
+    last;
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $obj->is_type_all ($arg, ...);
+#   $flag = $obj->is_type_any ($arg, ...);
+#
+# DESCRIPTION
+#   This method returns a flag for the following:
+#     is_type_all - does type match all of the arguments?
+#     is_type_any - does type match any of the arguments?
+# ------------------------------------------------------------------------------
+
+for my $name ('all', 'any') {
+  no strict 'refs';
+
+  my $subname = 'is_type_' . $name;
+
+  *$subname = sub {
+    my ($self, @intypes) = @_;
+
+    my $rc = 0;
+    if ($self->type) {
+      my %types = map {($_, 1)} split /$Fcm::Config::DELIMITER/, $self->type;
+
+      for my $intype (@intypes) {
+        $rc = exists $types{$intype};
+        last if ($name eq 'all' and not $rc) or ($name eq 'any' and $rc);
+      }
+    }
+
+    return $rc;
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $obj->rule_obj_var ([$read]);
+#
+# DESCRIPTION
+#   This method returns a string containing the make rule object variable for
+#   the current package. If $read is set, return $($string)
+# ------------------------------------------------------------------------------
+
+sub rule_obj_var {
+  my ($self, $read) = @_;
+
+  my $return;
+  if ($self->setting ('FCM_PCK_OBJECTS', $self->pkgname)) {
+    # Package name registered in unusual list
+    $return = $self->setting ('FCM_PCK_OBJECTS', $self->pkgname);
+
+  } else {
+    # Package name not registered in unusual list
+    $return = $self->pkgname
+              ? join ('__', ('OBJECTS', $self->pkgname)) : 'OBJECTS';
+  }
+
+  $return = $read ? '$(' . $return . ')' : $return;
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $obj->rule_src ();
+#
+# DESCRIPTION
+#   This method returns a string containing the location of the source file
+#   relative to the build root. This string will be suitable for use in a
+#   "Make" rule file for FCM.
+# ------------------------------------------------------------------------------
+
+sub rule_src {
+  my $self = shift;
+
+  my $return = $self->cursrc;
+  LABEL: for my $name (qw/SRC PPSRC/) {
+    for my $i (0 .. @{ $self->setting ('PATH', $name) } - 1) {
+      my $dir = $self->setting ('PATH', $name)->[$i];
+      next unless index ($self->cursrc, $dir) == 0;
+
+      $return = File::Spec->catfile (
+        '$(FCM_' . $name . 'DIR' . ($i ? $i : '') . ')',
+        File::Spec->abs2rel ($self->cursrc, $dir),
+      );
+      last LABEL;
+    }
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->write_lib_dep_excl ();
+#
+# DESCRIPTION
+#   This method writes a set of exclude dependency configurations for the
+#   library of this package.
+# ------------------------------------------------------------------------------
+
+sub write_lib_dep_excl {
+  my $self = shift();
+  if (!find_file_in_path($self->libbase(), $self->setting(qw/PATH LIB/))) {
+    return 0;
+  }
+
+  my $ETC_DIR = $self->setting(qw/PATH ETC/)->[0];
+  my $CFG_EXT = $self->setting(qw/OUTFILE_EXT CFG/);
+  my $LABEL_OF_EXCL_DEP = $self->cfglabel('BLD_DEP_EXCL');
+  my @SETTINGS = (
+       #dependency   #source file type list       #dependency name function
+       ['H'        , [qw{INCLUDE CPP          }], sub {$_[0]->base()}         ],
+       ['INTERFACE', [qw{INCLUDE INTERFACE    }], sub {$_[0]->base()}         ],
+       ['INC'      , [qw{INCLUDE              }], sub {$_[0]->base()}         ],
+       ['USE'      , [qw{SOURCE FORTRAN MODULE}], sub {$_[0]->root()}         ],
+       ['INTERFACE', [qw{SOURCE FORTRAN       }], sub {$_[0]->interfacebase()}],
+       ['OBJ'      , [qw{SOURCE               }], sub {$_[0]->root()}         ],
+  );
+
+  my $cfg = Fcm::CfgFile->new();
+  my @stack = ($self);
+  NODE:
+  while (my $node = pop(@stack)) {
+    # Is a directory
+    if (@{$node->children()}) {
+      push(@stack, reverse(@{$node->children()}));
+      next NODE;
+    }
+    # Is a typed file
+    if (
+          $node->cursrc()
+      &&  $node->type()
+      &&  !$node->is_type_any(qw{PROGRAM BLOCKDATA})
+    ) {
+      for (@SETTINGS) {
+        my ($key, $type_list_ref, $name_func_ref) = @{$_};
+        my $name = $name_func_ref->($node);
+        if ($name && $node->is_type_all(@{$type_list_ref})) {
+          push(
+            @{$cfg->lines()},
+            Fcm::CfgLine->new(
+              label => $LABEL_OF_EXCL_DEP,
+              value => $key . $Fcm::Config::DELIMITER . $name,
+            ),
+          );
+          next NODE;
+        }
+      }
+    }
+  }
+
+  # Write to configuration file
+  $cfg->print_cfg(
+    File::Spec->catfile($ETC_DIR, $self->libbase('lib', $CFG_EXT)),
+  );
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $obj->write_rules ();
+#
+# DESCRIPTION
+#   This method returns a string containing the "Make" rules for building the
+#   source file.
+# ------------------------------------------------------------------------------
+
+sub write_rules {
+  my $self  = shift;
+  my $mk    = '';
+
+  for my $target (sort keys %{ $self->rules }) {
+    my $rule = $self->rules ($target);
+    next unless defined ($rule->{ACTION});
+
+    if ($rule->{ACTION} eq 'AR') {
+      my $var = $self->rule_obj_var;
+      $mk .= ($var eq 'OBJECTS' ? 'export ' : '') . $var . ' =';
+      $mk .= ' ' . join (' ', @{ $rule->{DEP} });
+      $mk .= "\n\n";
+    }
+
+    $mk .= $target . ':';
+    
+    if ($rule->{ACTION} eq 'AR') {
+      $mk .= ' ' . $self->rule_obj_var (1);
+
+    } else {
+      for my $dep (@{ $rule->{DEP} }) {
+        $mk .= ' ' . $dep;
+      }
+    }
+
+    $mk .= "\n";
+
+    if (exists $rule->{ACTION}) {
+      if ($rule->{ACTION} eq 'AR') {
+        $mk .= "\t" . 'fcm_internal archive $@ $^' . "\n";
+
+      } elsif ($rule->{ACTION} eq 'CP') {
+        $mk .= "\t" . 'cp $< ' . $rule->{DEST} . "\n";
+        $mk .= "\t" . 'chmod u+w ' .
+               File::Spec->catfile ($rule->{DEST}, '$@') . "\n";
+
+      } elsif ($rule->{ACTION} eq 'CP_DATA') {
+        $mk .= "\t" . 'cp $^ ' . $rule->{DEST} . "\n";
+        $mk .= "\t" . 'touch ' .
+               File::Spec->catfile ($rule->{DEST}, '$@') . "\n";
+
+      } elsif ($rule->{ACTION} eq 'COMPILE') {
+        if ($self->lang) {
+          $mk .= "\t" . 'fcm_internal compile:' . substr ($self->lang, 0, 1) .
+                 ' ' . $self->pkgnames->[-2] . ' $< $@';
+          $mk .= ' 1' if ($self->flagsbase ('PPKEYS') and not $self->ppsrc);
+          $mk .= "\n";
+        }
+
+      } elsif ($rule->{ACTION} eq 'LOAD') {
+        if ($self->lang) {
+          $mk .= "\t" . 'fcm_internal load:' . substr ($self->lang, 0, 1) .
+                 ' ' . $self->pkgnames->[-2] . ' $< $@';
+          $mk .= ' ' . join (' ', @{ $rule->{BLOCKDATA} })
+            if @{ $rule->{BLOCKDATA} };
+          $mk .= "\n";
+        }
+
+      } elsif ($rule->{ACTION} eq 'TOUCH') {
+        $mk .= "\t" . 'touch ' .
+               File::Spec->catfile ($rule->{DEST}, '$@') . "\n";
+      }
+    }
+
+    $mk .= "\n";
+  }
+
+  return $mk;
+}
+
+# Wraps "chdir". Returns old directory.
+sub _chdir {
+  my ($self, $dir) = @_;
+  my $old_cwd = cwd();
+  $self->_event('CHDIR', $dir);
+  chdir($dir) || croak(sprintf($ERR_MESS_OF{CHDIR}, $dir));
+  $old_cwd;
+}
+
+# Wraps an event.
+sub _event {
+  my ($self, $key, @args) = @_;
+  my ($format, $level) = @{$EVENT_SETTING_OF{$key}};
+  $level ||= 1;
+  if ($self->verbose() >= $level) {
+    printf($format . ".\n", @args);
+  }
+}
+
+# Wraps "open".
+sub _open {
+  my ($path, $mode) = @_;
+  $mode ||= '<';
+  open(my $handle, $mode, $path) || croak(sprintf($ERR_MESS_OF{OPEN}, $path, $!));
+  $handle;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/BuildTask.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/BuildTask.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/BuildTask.pm	(revision 2528)
@@ -0,0 +1,340 @@
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::BuildTask
+#
+# DESCRIPTION
+#   This class hosts information of a build task in the FCM build system.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::BuildTask;
+@ISA = qw(Fcm::Base);
+
+# Standard pragma
+use strict;
+use warnings;
+
+# Standard modules
+use Carp;
+use File::Compare;
+use File::Copy;
+use File::Basename;
+use File::Path;
+use File::Spec::Functions;
+
+# FCM component modules
+use Fcm::Base;
+use Fcm::Timer;
+use Fcm::Util;
+
+# List of property methods for this class
+my @scalar_properties = (
+  'actiontype',  # type of action
+  'dependency',  # list of dependencies for this target
+  'srcfile',     # reference to input Fcm::BuildSrc instance
+  'output',      # output file
+  'outputmtime', # output file modification time
+  'target',      # target name for this task
+  'targetpath',  # search path for the target
+);
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = Fcm::BuildTask->new (%args);
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::BuildTask class. See
+#   above for allowed list of properties. (KEYS should be in uppercase.)
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = Fcm::Base->new (%args);
+
+  bless $self, $class;
+
+  for my $name (@scalar_properties) {
+    $self->{$name} = exists $args{uc ($name)} ? $args{uc ($name)} : undef;
+  }
+
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @scalar_properties.
+# ------------------------------------------------------------------------------
+
+for my $name (@scalar_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    # Argument specified, set property to specified argument
+    if (@_) {
+      $self->{$name} = $_[0];
+
+      if ($name eq 'output') {
+        $self->{outputmtime} = $_[0] ? (stat $_[0]) [9] : undef;
+      }
+    }
+
+    # Default value for property
+    if (not defined $self->{$name}) {
+      if ($name eq 'dependency' or $name eq 'targetpath') {
+        # Reference to an array
+        $self->{$name} = [];
+      }
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->action (TASKLIST => \%tasklist);
+#
+# DESCRIPTION
+#   This method performs the task action and sets the output accordingly. The
+#   argument TASKLIST must be a reference to a hash containing the other tasks
+#   of the build, which this task may depend on. The keys of the hash must the
+#   name of the target names of the tasks, and the values of the hash must be
+#   the references to the corresponding Fcm::BuildTask instances. The method
+#   returns true if the task has been performed to create a new version of the
+#   target.
+# ------------------------------------------------------------------------------
+
+sub action {
+  my $self     = shift;
+  my %args     = @_;
+  my $tasklist = exists $args{TASKLIST} ? $args{TASKLIST} : {};
+
+  return unless $self->actiontype;
+
+  my $uptodate     = 1;
+  my $dep_uptodate = 1;
+
+  # Check if dependencies are up to date
+  # ----------------------------------------------------------------------------
+  for my $depend (@{ $self->dependency }) {
+    if (exists $tasklist->{$depend}) {
+      if (not $tasklist->{$depend}->output) {
+        # Dependency task output is not set, performs its task action
+        if ($tasklist->{$depend}->action (TASKLIST => $tasklist)) {
+          $uptodate     = 0;
+          $dep_uptodate = 0;
+        }
+      }
+
+    } elsif ($self->verbose > 1) {
+      w_report 'Warning: Task for "', $depend,
+               '" does not exist, may be required by ', $self->target;
+    }
+  }
+
+  # Check if the target exists in the search path
+  # ----------------------------------------------------------------------------
+  if (@{ $self->targetpath }) {
+    my $output = find_file_in_path ($self->target, $self->targetpath);
+    $self->output ($output) if $output;
+  }
+
+  # Target is out of date if it does not exist
+  if ($uptodate) {
+    $uptodate = 0 if not $self->output;
+  }
+
+  # Check if current target is older than its dependencies
+  # ----------------------------------------------------------------------------
+  if ($uptodate) {
+    for my $depend (@{ $self->dependency }) {
+      next unless exists $tasklist->{$depend};
+
+      if ($tasklist->{$depend}->outputmtime > $self->outputmtime) {
+        $uptodate     = 0;
+        $dep_uptodate = 0;
+      }
+    }
+
+    if ($uptodate and ref $self->srcfile) {
+      $uptodate = 0 if $self->srcfile->mtime > $self->outputmtime;
+    }
+  }
+
+  if ($uptodate) {
+    # Current target and its dependencies are up to date
+    # --------------------------------------------------------------------------
+    if ($self->actiontype eq 'PP') {
+      # "done" file up to date, set name of pre-processed source file
+      # ------------------------------------------------------------------------
+      my $base     = $self->srcfile->root . lc ($self->srcfile->ext);
+      my @pknames  = split '__', (@{ $self->srcfile->pkgnames })[-2];
+      my @path     = map {
+        catfile ($_, @pknames);
+      } @{ $self->setting (qw/PATH PPSRC/) };
+      my $oldfile = find_file_in_path ($base, \@path);
+      $self->srcfile->ppsrc ($oldfile);
+    }
+
+  } else {
+    # Perform action is not up to date
+    # --------------------------------------------------------------------------
+    # (For GENINTERFACE and PP, perform action if "done" file not up to date)
+    my $new_output = @{ $self->targetpath }
+                     ? catfile ($self->targetpath->[0], $self->target)
+                     : $self->target;
+
+    # Create destination container directory if necessary
+    my $destdir = dirname $new_output;
+
+    if (not -d $destdir) {
+      print 'Make directory: ', $destdir, "\n" if $self->verbose > 2;
+      mkpath $destdir;
+    }
+
+    # List of actions
+    if ($self->actiontype eq 'UPDATE') {
+      # Action is UPDATE: Update file
+      # ------------------------------------------------------------------------
+      print 'Update: ', $new_output, "\n" if $self->verbose > 2;
+      touch_file $new_output
+        or croak 'Unable to update "', $new_output, '", abort';
+      $self->output ($new_output);
+
+    } elsif ($self->actiontype eq 'COPY') {
+      # Action is COPY: copy file to destination if necessary
+      # ------------------------------------------------------------------------
+      my $copy_required = ($dep_uptodate and $self->output and -r $self->output)
+                          ? compare ($self->output, $self->srcfile->src)
+                          : 1;
+
+      if ($copy_required) {
+        # Set up copy command
+        my $srcfile = $self->srcfile->src;
+        my $destfile = catfile ($destdir, basename($srcfile));
+        print 'Copy: ', $srcfile, "\n", '  to: ', $destfile, "\n"
+          if $self->verbose > 2;
+        &copy ($srcfile, $destfile)
+          or die $srcfile, ': copy to ', $destfile, ' failed (', $!, '), abort';
+        chmod (((stat ($srcfile))[2] & 07777), $destfile);
+
+        $self->output ($new_output);
+
+      } else {
+        $uptodate = 1;
+      }
+
+    } elsif ($self->actiontype eq 'PP' or $self->actiontype eq 'GENINTERFACE') {
+      # Action is PP or GENINTERFACE: process file
+      # ------------------------------------------------------------------------
+      my ($newlines, $base, @path);
+
+      if ($self->actiontype eq 'PP') {
+        # Invoke the pre-processor on the source file
+        # ----------------------------------------------------------------------
+        # Get lines in the pre-processed source
+        $newlines = $self->srcfile->get_pre_process;
+        $base     = $self->srcfile->root . lc ($self->srcfile->ext);
+
+        # Get search path for the existing pre-processed file
+        my @pknames  = split '__', (@{ $self->srcfile->pkgnames })[-2];
+        @path        = map {
+          catfile ($_, @pknames);
+        } @{ $self->setting (qw/PATH PPSRC/) };
+
+      } else { # if ($self->actiontype eq 'GENINTERFACE')
+        # Invoke the interface generator
+        # ----------------------------------------------------------------------
+        # Get new interface lines
+        $newlines = $self->srcfile->get_fortran_interface;
+
+        # Get search path for the existing interface file
+        $base     = $self->srcfile->interfacebase;
+        @path     = @{ $self->setting (qw/PATH INC/) },
+      }
+
+
+      # If pre-processed or interface file exists,
+      # compare its content with new lines to see if it has been updated
+      my $update_required = 1;
+      my $oldfile = find_file_in_path ($base, \@path);
+
+      if ($oldfile and -r $oldfile) {
+        # Read old file
+        open FILE, '<', $oldfile;
+        my @oldlines = readline 'FILE';
+        close FILE;
+
+        # Compare old contents and new contents
+        if (@oldlines eq @$newlines) {
+          $update_required = grep {
+            $oldlines[$_] ne $newlines->[$_];
+          } (0 .. $#oldlines);
+        }
+      }
+
+      if ($update_required) {
+        # Update the pre-processed source or interface file
+        # ----------------------------------------------------------------------
+        # Determine container directory of the  pre-processed or interface file
+        my $newfile = @path ? catfile ($path[0], $base) : $base;
+
+        # Create the container directory if necessary
+        if (not -d $path[0]) {
+          print 'Make directory: ', $path[0], "\n"
+            if $self->verbose > 1;
+          mkpath $path[0];
+        }
+
+        # Update the pre-processor or interface file
+        open FILE, '>', $newfile
+          or croak 'Cannot write to "', $newfile, '" (', $!, '), abort';
+        print FILE @$newlines;
+        close FILE
+          or croak 'Cannot write to "', $newfile, '" (', $!, '), abort';
+        print 'Generated: ', $newfile, "\n" if $self->verbose > 1;
+
+        # Set the name of the pre-processed file
+        $self->srcfile->ppsrc ($newfile) if $self->actiontype eq 'PP';
+
+      } else {
+        # Content in pre-processed source or interface file is up to date
+        # ----------------------------------------------------------------------
+        $uptodate = 1;
+
+        # Set the name of the pre-processed file
+        $self->srcfile->ppsrc ($oldfile) if $self->actiontype eq 'PP';
+      }
+
+      # Update the "done" file
+      print 'Update: ', $new_output, "\n" if $self->verbose > 2;
+      touch_file $new_output
+        or croak 'Unable to update "', $new_output, '", abort';
+      $self->output ($new_output);
+
+    } else {
+      carp 'Action type "', $self->actiontype, "' not supported";
+    }
+  }
+
+  return not $uptodate;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI.pm	(revision 2528)
@@ -0,0 +1,172 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::CLI;
+
+use Carp qw{croak};
+use Fcm::CLI::Config;
+use Fcm::CLI::Exception;
+use Fcm::Util::ClassLoader;
+use File::Basename qw{basename};
+use Getopt::Long qw{GetOptions};
+use Scalar::Util qw{blessed};
+
+################################################################################
+# Invokes the FCM command line interface
+sub invoke {
+    local(@ARGV) = @ARGV;
+    my $config          = Fcm::CLI::Config->instance();
+    my $subcommand_name = @ARGV ? shift(@ARGV) : q{};
+    my $subcommand      = $config->get_subcommand_of($subcommand_name);
+    eval {
+        if (!$subcommand) {
+            croak(Fcm::CLI::Exception->new({message => 'unknown command'}));
+        }
+        my ($opts_ref, $args_ref, $is_help) = _parse_argv_using($subcommand);
+        my ($invoker_class, $invoker);
+        if ($is_help) {
+            $invoker_class
+                = _load_invoker_class_of($config->get_subcommand_of(q{}));
+            $invoker = $invoker_class->new({
+                command   => $subcommand_name,
+                arguments => [$subcommand_name],
+            });
+        }
+        else {
+            $invoker_class = _load_invoker_class_of($subcommand);
+            $invoker = $invoker_class->new({
+                command   => $subcommand_name,
+                options   => $opts_ref,
+                arguments => $args_ref,
+                (
+                    $subcommand->get_invoker_config()
+                    ? %{$subcommand->get_invoker_config()}
+                    : ()
+                ),
+            });
+        }
+        $invoker->invoke();
+    };
+    if ($@) {
+        if (Fcm::CLI::Exception->caught($@)) {
+            die(sprintf(
+                qq{%s%s: %s\nType "%s help%s" for usage\n},
+                basename($0),
+                ($subcommand_name ? qq{ $subcommand_name} : q{}),
+                $@->get_message(),
+                basename($0),
+                defined($subcommand) ? qq{ $subcommand_name} : q{},
+            ));
+        }
+        else {
+            die($@);
+        }
+    }
+}
+
+################################################################################
+# Parses options in @ARGV using the options settings of a subcommand
+sub _parse_argv_using {
+    my ($subcommand) = @_;
+    my %options = ();
+    my $is_help = undef;
+    if (($subcommand->get_options())) {
+        my $problem = q{};
+        local($SIG{__WARN__}) = sub {
+            ($problem) = @_;
+        };
+        my $success = GetOptions(
+            \%options,
+            (map {$_->get_arg_for_getopt_long()} ($subcommand->get_options())),
+        );
+        if (!$success) {
+            croak(Fcm::CLI::Exception->new({message => sprintf(
+                "option parse failed: %s", $problem,
+            )}));
+        }
+
+        OPTION:
+        for my $option ($subcommand->get_options()) {
+            if (!exists($options{$option->get_name()})) {
+                next OPTION;
+            }
+            if ($option->is_help()) {
+                $is_help = 1;
+            }
+            if (
+                $option->has_arg() == $option->ARRAY_ARG
+                && $option->get_delimiter()
+            ) {
+                $options{$option->get_name()} = [split(
+                    $option->get_delimiter(),
+                    join(
+                        $option->get_delimiter(),
+                        @{$options{$option->get_name()}},
+                    ),
+                )];
+            }
+        }
+    }
+    return (\%options, [@ARGV], $is_help);
+}
+
+################################################################################
+# Loads and returns the invoker class of a subcommand
+sub _load_invoker_class_of {
+    my ($subcommand) = @_;
+    my $invoker_class
+        = $subcommand->get_invoker_class() ? $subcommand->get_invoker_class()
+        :                                    'Fcm::CLI::Invoker'
+        ;
+    return Fcm::Util::ClassLoader::load($invoker_class);
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::CLI
+
+=head1 SYNOPSIS
+
+    use Fcm::CLI
+    Fcm::CLI::invoke();
+
+=head1 DESCRIPTION
+
+Invokes the FCM command line interface.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item invoke()
+
+Invokes the FCM command line interface.
+
+=back
+
+=head1 TO DO
+
+Move option/argument parsing to L<Fcm::CLI::Invoker|Fcm::CLI::Invoker>?
+
+Use an OO interface?
+
+=head1 SEE ALSO
+
+L<Fcm::CLI::Config|Fcm::CLI::Config>,
+L<Fcm::CLI::Invoker|Fcm::CLI::Invoker>,
+L<Fcm::CLI::Subcommand|Fcm::CLI::Subcommand>,
+L<Fcm::CLI::Option|Fcm::CLI::Option>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Config.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Config.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Config.pm	(revision 2528)
@@ -0,0 +1,133 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::CLI::Config;
+
+use Fcm::CLI::Config::Default;
+use List::Util qw{first};
+use Scalar::Util qw{blessed};
+
+my $INSTANCE;
+
+################################################################################
+# Class method: returns an instance of this class
+sub instance {
+    my ($class, $args_ref) = @_;
+    if ($args_ref || !$INSTANCE) {
+        $INSTANCE = bless({
+            core_subcommands => [@Fcm::CLI::Config::Default::CORE_SUBCOMMANDS],
+            vc_subcommands   => [@Fcm::CLI::Config::Default::VC_SUBCOMMANDS],
+            (defined($args_ref) ? %{$args_ref} : ()), 
+        }, $class);
+    }
+    return $INSTANCE;
+}
+
+################################################################################
+# Returns a subcommand matching $key
+sub get_subcommand_of {
+    my ($self, $key) = @_;
+    if (blessed($key) && $key->isa('Fcm::CLI::Subcommand')) {
+        return first {"$_" eq "$key"} ($self->get_subcommands());
+    }
+    else {
+        return first {$_->has_a_name($key)} ($self->get_subcommands());
+    }
+}
+
+################################################################################
+# Returns the subcommands
+sub get_subcommands {
+    my ($self) = @_;
+    my @return = ($self->get_core_subcommands(), $self->get_vc_subcommands());
+    return (wantarray() ? @return : \@return);
+}
+
+################################################################################
+# Returns the core subcommands
+sub get_core_subcommands {
+    my ($self) = @_;
+    return (
+        wantarray() ? @{$self->{core_subcommands}} : $self->{core_subcommands}
+    );
+}
+
+################################################################################
+# Returns the subcommands that are relevant only with a VC system
+sub get_vc_subcommands {
+    my ($self) = @_;
+    return (wantarray() ? @{$self->{vc_subcommands}} : $self->{vc_subcommands});
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::CLI::Config
+
+=head1 SYNOPSIS
+
+    use Fcm::CLI::Config;
+    $cli_config = Fcm::CLI::Config->instance();
+    $subcommand = $cli_config->get_subcommand_of($key);
+    @subcommands = $cli_config->get_subcommands();
+    @core_subcommands = $cli_config->get_core_subcommands();
+    @vc_subcommands = $cli_config->get_vc_subcommands();
+
+=head1 DESCRIPTION
+
+This class provides the configuration of the FCM command line interface.
+
+=head1 METHODS
+
+=over 4
+
+=item instance($arg_ref)
+
+Returns an instance of this class.
+
+Creates the instance on first call, or replaces it with a new one if $args_ref
+is defined in subsequent call. $args_ref should be a reference to a hash. The
+hash can contain I<core_subcommands> and I<vc_subcommands>. Each of these
+settings should point to an array reference containing L<Fcm::CLI::Subcommand>
+objects. If the setting is unspecified, it uses the default from
+L<Fcm::CLI::Config::Default|Fcm::CLI::Config::Default>.
+
+=item get_subcommand_of($key)
+
+Returns a L<Fcm::CLI::Subcommand|Fcm::CLI::Subcommand> object matching the
+search $key. Returns undef if there is no match.
+
+=item get_subcommands()
+
+Short-hand for:
+    ($self->get_core_subcommands(), $self->get_vc_subcommands())
+
+=item get_core_subcommands()
+
+Returns the core subcommands.
+
+=item get_vc_subcommands()
+
+Returns the subcommands that are relevant only in the presence of a VC system.
+
+=back
+
+=head1 SEE ALSO
+
+L<Fcm::CLI::Config::Default|Fcm::CLI::Config::Default>,
+L<Fcm::CLI::Invoker|Fcm::CLI::Invoker>,
+L<Fcm::CLI::Subcommand|Fcm::CLI::Subcommand>,
+L<Fcm::CLI::Option|Fcm::CLI::Option>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Config/Default.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Config/Default.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Config/Default.pm	(revision 2528)
@@ -0,0 +1,412 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::CLI::Config::Default;
+
+use Fcm::CLI::Option;
+use Fcm::CLI::Subcommand;
+
+my %DESCRIPTION_OF = (
+    # --------------------------------------------------------------------------
+    BROWSER => <<'END_DESCRIPTION',
+If TARGET is specified, it must be a FCM URL keyword, a Subversion URL or the
+path to a local working copy. If not specified, the current working directory
+is assumed to be a working copy. If the --browser option is specified, the
+specified web browser command is used to launch the repository browser.
+Otherwise, it attempts to use the default browser from the configuration
+setting.
+END_DESCRIPTION
+    # --------------------------------------------------------------------------
+    BUILD => <<'END_DESCRIPTION',
+The path to a CFGFILE may be provided. Otherwise, the build system searches the
+default locations for a bld cfg file.
+
+If no option is specified, the options "-s 5 -t all -j 1 -v 1" are assumed.
+
+If the option for full build is specified, the sub-directories created by
+previous builds will be removed, so that the current build can start cleanly.
+
+The -s option can be used to limit the actions performed by the build system up
+to a named stage. The stages are:
+    "1", "s" or "setup"                - stage 1, setup
+    "2", "pp" or "pre_process"         - stage 2, pre-process
+    "3", "gd" or "generate_dependency" - stage 3, generate dependency
+    "4", "gi" or "generate_interface"  - stage 4, generate Fortran 9X interface
+    "5", "m", "make"                   - stage 5, make
+
+If a colon separated list of targets is specified using the -t option, the
+default targets specified in the configuration file will not be used.
+
+If archive mode is switched on, build sub-directories that are only used in the
+build process will be archived to TAR files. The default is off.
+
+If specified, the verbose level must be an integer greater than 0. Verbose
+level 0 is the quiet mode. Increasing the verbose level will increase the
+amount of diagnostic output.
+
+When a build is invoked, it sets up a lock file in the build root directory.
+The lock is normally removed at the end of the build. While the lock file is in
+place, the build commands invoked in the same root directory will fail.  If
+you need to bypass this check for whatever reason, you can invoke the build
+system with the --ignore-lock option.
+END_DESCRIPTION
+    # --------------------------------------------------------------------------
+    CFG_PRINTER => <<'END_DESCRIPTION',
+If no option is specified, the output will be sent to standard output.
+END_DESCRIPTION
+    # --------------------------------------------------------------------------
+    EXTRACT => <<'END_DESCRIPTION',
+The path to a CFG file may be provided. Otherwise, the extract system searches
+the default locations for an ext cfg file.
+
+If no option is specified, the system will attempt an incremental extract where
+appropriate.
+
+If specified, the verbose level must be an integer greater than 0. Verbose
+level 0 is the quiet mode. Increasing the verbose level will increase the
+amount of diagnostic output.
+
+When an extract is invoked, it sets up a lock file in the extract destination
+root directory. The lock is normally removed at the end of the extract. While
+the lock file is in place, other extract commands invoked in the same
+destination root directory will fail. If you need to bypass this check for
+whatever reason, you can invoke the extract system with the --ignore-lock
+option.
+END_DESCRIPTION
+    # --------------------------------------------------------------------------
+    EXTRACT_CONFIG_COMPARATOR => <<'END_DESCRIPTION',
+Compares the extract configurations of two similar extract configuration files
+CFGFILE1 and CFGFILE2.
+
+In normal mode with verbosity level 2 or above, displays the change log of each
+revision.
+
+In wiki mode, print revision tables in wiki format. The argument to the --wiki
+option must be the Subversion URL or FCM URL keyword of a FCM project
+associated with the intended Trac system. The --verbose option has no effect
+in wiki mode.
+END_DESCRIPTION
+    # --------------------------------------------------------------------------
+    GUI => <<'END_DESCRIPTION',
+The optional argument PATH modifies the initial working directory of the GUI.
+END_DESCRIPTION
+    # --------------------------------------------------------------------------
+    KEYWORD => <<'END_DESCRIPTION',
+If no argument is specified, prints registered location keywords. Otherwise,
+prints the implied location keywords and revision keywords for the specified
+target.
+END_DESCRIPTION
+);
+
+my %OPTION_OF = (
+    ARCHIVE => Fcm::CLI::Option->new({
+        name        => 'archive',
+        letter      => 'a',
+        description => 'archives sub-directories on success',
+    }),
+
+    BROWSER => Fcm::CLI::Option->new({
+        name        => 'browser',
+        letter      => 'b',
+        description => 'specifies the web browser command',
+        has_arg     => Fcm::CLI::Option->SCALAR_ARG,
+    }),
+
+    CLEAN => Fcm::CLI::Option->new({
+        name        => 'clean',
+        description => 'cleans the destination',
+    }),
+
+    FULL => Fcm::CLI::Option->new({
+        name        => 'full',
+        letter      => 'f',
+        description => 'runs in full mode',
+    }),
+
+    HELP => Fcm::CLI::Option->new({
+        name        => 'help',
+        letter      => 'h',
+        description => 'prints help',
+        is_help     => 1,
+    }),
+
+    IGNORE_LOCK => Fcm::CLI::Option->new({
+        name        => 'ignore-lock',
+        description => 'ignores lock file',
+    }),
+
+    JOBS => Fcm::CLI::Option->new({
+        name        => 'jobs',
+        letter      => 'j',
+        description => 'number of parallel jobs',
+        has_arg     => Fcm::CLI::Option->SCALAR_ARG,
+    }),
+
+    OUTPUT => Fcm::CLI::Option->new({
+        name        => 'output',
+        letter      => 'o',
+        description => 'sends output to the specified file',
+        has_arg     => Fcm::CLI::Option->SCALAR_ARG,
+    }),
+
+    STAGE => Fcm::CLI::Option->new({
+        name        => 'stage',
+        letter      => 's',
+        description => 'runs command up to a named stage',
+        has_arg     => Fcm::CLI::Option->SCALAR_ARG,
+    }),
+
+    TARGETS => Fcm::CLI::Option->new({
+        name        => 'targets',
+        letter      => 't',
+        delimiter   => ':',
+        description => 'list of build targets, delimited by (:)',
+        has_arg     => Fcm::CLI::Option->ARRAY_ARG,
+    }),
+
+    VERBOSITY => Fcm::CLI::Option->new({
+        name        => 'verbose',
+        letter      => 'v',
+        description => 'verbose level',
+        has_arg     => Fcm::CLI::Option->SCALAR_ARG,
+    }),
+
+    WIKI => Fcm::CLI::Option->new({
+        name        => 'wiki',
+        letter      => 'w',
+        description => 'print revision tables in wiki format',
+        has_arg     => Fcm::CLI::Option->SCALAR_ARG,
+    }),
+);
+
+my %SUBCOMMAND_OF = (
+    BRANCH => Fcm::CLI::Subcommand->new({
+        names         => ['branch', 'br'],
+        synopsis      => 'branch utilities',
+        invoker_class => 'Fcm::CLI::Invoker::CM',
+        is_vc         => 1,
+    }),
+
+    BROWSER => Fcm::CLI::Subcommand->new({
+        names         => ['trac', 'www'],
+        synopsis      => 'invokes the browser for a version controlled target',
+        usage         => '[OPTIONS...] [TARGET]',
+        description   => $DESCRIPTION_OF{BROWSER},
+        invoker_class => 'Fcm::CLI::Invoker::Browser',
+        options       => [
+            $OPTION_OF{BROWSER},
+            $OPTION_OF{HELP},
+        ],
+    }),
+
+    BUILD => Fcm::CLI::Subcommand->new({
+        names          => ['build', 'bld'],
+        synopsis       => 'invokes the build system',
+        usage          => '[OPTIONS...] [CFGFILE]',
+        description    => $DESCRIPTION_OF{BUILD},
+        invoker_class  => 'Fcm::CLI::Invoker::ConfigSystem',
+        invoker_config => {
+            impl_class         => 'Fcm::Build',
+            cli2invoke_key_map => {
+                'archive'     => 'ARCHIVE',
+                'clean'       => 'CLEAN',
+                'full'        => 'FULL',
+                'ignore-lock' => 'IGNORE_LOCK',
+                'jobs'        => 'JOBS',
+                'stage'       => 'STAGE',
+                'targets'     => 'TARGETS',
+            },
+        },
+        options        => [
+            $OPTION_OF{ARCHIVE},
+            $OPTION_OF{CLEAN},
+            $OPTION_OF{FULL},
+            $OPTION_OF{HELP},
+            $OPTION_OF{IGNORE_LOCK},
+            $OPTION_OF{JOBS},
+            $OPTION_OF{STAGE},
+            $OPTION_OF{TARGETS},
+            $OPTION_OF{VERBOSITY},
+        ],
+    }),
+
+    CFG_PRINTER => Fcm::CLI::Subcommand->new({
+        names         => ['cfg'],
+        synopsis      => 'invokes the CFG file pretty printer',
+        usage         => '[OPTIONS...] [CFGFILE]',
+        description   => $DESCRIPTION_OF{CFG_PRINTER},
+        invoker_class => 'Fcm::CLI::Invoker::CfgPrinter',
+        options       => [
+            $OPTION_OF{HELP},
+            $OPTION_OF{OUTPUT},
+        ],
+    }),
+
+    CM => Fcm::CLI::Subcommand->new({
+        names => [qw{
+            add
+            blame     praise annotate ann
+            cat
+            checkout  co
+            cleanup
+            commit    ci
+            copy      cp
+            delete    del    remove   rm
+            diff      di
+            export
+            import
+            info
+            list      ls
+            lock
+            log
+            merge
+            mkdir
+            move      mv     rename   ren
+            propdel   pdel   pd
+            propedit  pedit  pe
+            propget   pget   pg
+            proplist  plist  pl
+            propset   pset   ps
+            resolved
+            revert
+            status    stat   st
+            switch    sw
+            unlock
+            update    up
+        }],
+        invoker_class => 'Fcm::CLI::Invoker::CM',
+        is_vc         => 1,
+    }),
+
+    CONFLICTS => Fcm::CLI::Subcommand->new({
+        names         => ['conflicts', 'cf'],
+        synopsis      => 'resolves conflicts in your working copy',
+        usage         => '[PATH]',
+        invoker_class => 'Fcm::CLI::Invoker::CM',
+        is_vc         => 1,
+    }),
+
+    EXTRACT => Fcm::CLI::Subcommand->new({
+        names          => ['extract', 'ext'],
+        synopsis       => 'invokes the extract system',
+        usage          => '[OPTIONS...] [CFGFILE]',
+        description    => $DESCRIPTION_OF{EXTRACT},
+        invoker_class  => 'Fcm::CLI::Invoker::ConfigSystem',
+        invoker_config => {
+            impl_class         => 'Fcm::Extract',
+            cli2invoke_key_map => {
+                'clean'       => 'CLEAN',
+                'full'        => 'FULL',
+                'ignore-lock' => 'IGNORE_LOCK',
+            },
+        },
+        options        => [
+            $OPTION_OF{CLEAN},
+            $OPTION_OF{FULL},
+            $OPTION_OF{HELP},
+            $OPTION_OF{IGNORE_LOCK},
+            $OPTION_OF{VERBOSITY},
+        ],
+    }),
+
+    EXTRACT_CONFIG_COMPARATOR => Fcm::CLI::Subcommand->new({
+        names         => ['cmp-ext-cfg'],
+        synopsis      => 'invokes the extract configuration files comparator',
+        usage         => '[OPTIONS...] CFGFILE1 CFGFILE2',
+        description   => $DESCRIPTION_OF{EXTRACT_CONFIG_COMPARATOR},
+        invoker_class => 'Fcm::CLI::Invoker::ExtractConfigComparator',
+        options       => [
+            $OPTION_OF{HELP},
+            $OPTION_OF{VERBOSITY},
+            $OPTION_OF{WIKI},
+        ],
+    }),
+
+    GUI => Fcm::CLI::Subcommand->new({
+        names         => ['gui'],
+        synopsis      => 'invokes the GUI wrapper for code management commands',
+        usage         => '[PATH]',
+        description   => $DESCRIPTION_OF{GUI},
+        invoker_class => 'Fcm::CLI::Invoker::GUI',
+    }),
+
+    HELP => Fcm::CLI::Subcommand->new({
+        names         => ['help', q{?}, q{}],
+        synopsis      => 'displays the usage of this program or its subcommands',
+        usage         => '[SUBCOMMAND]',
+        description   => q{},
+        invoker_class => 'Fcm::CLI::Invoker::Help',
+        options       => [$OPTION_OF{HELP}],
+    }),
+
+    KEYWORD => Fcm::CLI::Subcommand->new({
+        names         => ['keyword-print', 'kp'],
+        synopsis      => 'prints registered location and/or revision keywords',
+        usage         => '[TARGET]',
+        description   => $DESCRIPTION_OF{KEYWORD},
+        invoker_class => 'Fcm::CLI::Invoker::KeywordPrinter',
+        options       => [$OPTION_OF{HELP}],
+    }),
+
+    MKPATCH => Fcm::CLI::Subcommand->new({
+        names         => ['mkpatch'],
+        synopsis      => 'creates patches from specified revisions of a URL',
+        usage         => '[OPTIONS] URL [OUTDIR]',
+        invoker_class => 'Fcm::CLI::Invoker::CM',
+        is_vc         => 1,
+    }),
+);
+
+our @CORE_SUBCOMMANDS = (
+    $SUBCOMMAND_OF{HELP},
+    $SUBCOMMAND_OF{BUILD},
+    $SUBCOMMAND_OF{CFG_PRINTER},
+);
+
+our @VC_SUBCOMMANDS = (
+    $SUBCOMMAND_OF{BRANCH},
+    $SUBCOMMAND_OF{BROWSER},
+    $SUBCOMMAND_OF{CONFLICTS},
+    $SUBCOMMAND_OF{EXTRACT},
+    $SUBCOMMAND_OF{EXTRACT_CONFIG_COMPARATOR},
+    $SUBCOMMAND_OF{GUI},
+    $SUBCOMMAND_OF{KEYWORD},
+    $SUBCOMMAND_OF{MKPATCH},
+    $SUBCOMMAND_OF{CM},
+);
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::CLI::Config::Default
+
+=head1 SYNOPSIS
+
+    use Fcm::CLI::Config::Default;
+    @core_subcommands = @Fcm::CLI::Config::Default::CORE_SUBCOMMANDS;
+    @vc_subcommands = @Fcm::CLI::Config::Default::VC_SUBCOMMANDS;
+
+=head1 DESCRIPTION
+
+This module stores the default configuration of the FCM command line interface.
+It should only be used by L<Fcm::CLI::Config|Fcm::CLI::Config>.
+
+=head1 SEE ALSO
+
+L<Fcm::CLI::Config|Fcm::CLI::Config>,
+L<Fcm::CLI::Invoker|Fcm::CLI::Invoker>,
+L<Fcm::CLI::Subcommand|Fcm::CLI::Subcommand>,
+L<Fcm::CLI::Option|Fcm::CLI::Option>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Exception.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Exception.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Exception.pm	(revision 2528)
@@ -0,0 +1,42 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::CLI::Exception;
+use base qw{Fcm::Exception};
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::CLI::Exception
+
+=head1 SYNOPSIS
+
+    use Carp qw{croak};
+    use Fcm::CLI::Exception;
+    croak(Fcm::CLI::Exception->new({message => 'something is wrong'}));
+
+=head1 DESCRIPTION
+
+This class extends L<Fcm::Exception|Fcm::Exception>. This exception is thrown
+on errors associated with the command line interface.
+
+=head1 METHODS
+
+See L<Fcm::Exception|Fcm::Exception> for a list of methods.
+
+=head1 SEE ALSO
+
+L<Fcm::Exception|Fcm::Exception>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker.pm	(revision 2528)
@@ -0,0 +1,136 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::CLI::Invoker;
+
+use Carp qw{croak};
+use Fcm::CLI::Exception;
+
+################################################################################
+# Constructor
+sub new {
+    my ($class, $args_ref) = @_;
+    return bless({%{$args_ref}}, $class);
+}
+
+################################################################################
+# Returns the name of the (sub)command as given by the user
+sub get_command {
+    my ($self) = @_;
+    return $self->{command};
+}
+
+################################################################################
+# Returns a reference to a hash containing the options
+sub get_options {
+    my ($self) = @_;
+    return (wantarray() ? %{$self->{options}} : $self->{options});
+}
+
+################################################################################
+# Returns a reference to an array containing the arguments
+sub get_arguments {
+    my ($self) = @_;
+    return (wantarray() ? @{$self->{arguments}} : $self->{arguments});
+}
+
+################################################################################
+# Invokes the sub-system
+sub invoke {
+    my ($self) = @_;
+    my $message = "command not implemented\n";
+    $message .= sprintf("opts:");
+    for my $key (sort keys(%{$self->get_options()})) {
+        my $value = $self->get_options()->{$key};
+        $message .= sprintf(
+            " [%s=%s]",
+            $key,
+            ($value && ref($value) eq 'ARRAY' ? join(q{, }, @{$value}) : $value)
+        );
+    }
+    $message .= sprintf("\n");
+    $message .= sprintf("args: [%s]\n", join(q{] [}, $self->get_arguments()));
+    croak(Fcm::CLI::Exception->new({message => $message}));
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::CLI::Invoker
+
+=head1 SYNOPSIS
+
+    use Fcm::CLI::Invoker;
+    $invoker = Fcm::CLI::Invoker->new({
+        command   => $command,
+        options   => \%options,
+        arguments => $arguments,
+    });
+    $invoker->invoke();
+
+=head1 DESCRIPTION
+
+This is the base class for an invoker of a FCM sub-system from the CLI.
+Sub-classes should override the invoke() method.
+
+=head1 METHODS
+
+=over 4
+
+=item new($args_ref)
+
+Constructor. It accepts a hash reference as an argument. The element I<command>
+should be set to the actual (sub)command as specified by the user. The element
+I<options> should be a reference to a hash containing the specified command line
+options. The element I<arguments> should be a reference to an array containing
+the remaining command line arguments.
+
+=item get_command()
+
+Returns the actual (sub)command as specified by the user.
+
+=item get_options()
+
+Returns a hash containing the specified command line options. In scalar context,
+returns a reference to the hash.
+
+=item get_arguments()
+
+Returns an array containing the (remaining) command line arguments. In scalar
+context, returns a reference to the array.
+
+=item invoke()
+
+Sub-classes should override this method. Calling the method in this base
+class causes the system to croak() with a
+L<Fcm::CLI::Exception|Fcm::CLI::Exception>.
+
+=back
+
+=head1 DIAGNOSTICS
+
+=over 4
+
+=item L<Fcm::CLI::Exception|Fcm::CLI::Exception>
+
+The C<invoke()> croak() with this exception.
+
+=back
+
+=head1 SEE ALSO
+
+L<Fcm::CLI::Exception|Fcm::CLI::Exception>,
+L<Fcm::CLI::Subcommand|Fcm::CLI::Subcommand>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/Browser.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/Browser.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/Browser.pm	(revision 2528)
@@ -0,0 +1,119 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::CLI::Invoker::Browser;
+use base qw{Fcm::CLI::Invoker};
+
+use Carp qw{croak};
+use Fcm::CLI::Exception;
+use Fcm::Config;
+use Fcm::Keyword;
+use Fcm::Util qw{expand_tilde get_url_of_wc is_wc run_command};
+
+################################################################################
+# Invokes the sub-system
+sub invoke {
+    my ($self) = @_;
+    my $config = Fcm::Config->instance();
+    my $browser
+        = $self->get_options()->{browser} ? $self->get_options()->{browser}
+        :                                   $config->setting(qw/WEB_BROWSER/)
+        ;
+    my ($target) = $self->get_arguments();
+    if (!$target) {
+        if (is_wc()) {
+            $target = q{.};
+        }
+        else {
+            croak(Fcm::CLI::Exception->new({
+                message => 'no TARGET specified and . not a working copy',
+            }));
+        }
+    }
+    $target = expand_tilde($target);
+    if (-e $target) {
+        $target = get_url_of_wc($target);
+    }
+
+    my $browser_url = Fcm::Keyword::get_browser_url($target);
+    my @command = (split(qr{\s+}xms, $browser), $browser_url);
+    run_command(\@command, METHOD => 'exec', PRINT => 1);
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::CLI::Invoker::Browser
+
+=head1 SYNOPSIS
+
+    use Fcm::CLI::Invoker::Browser;
+    $invoker = Fcm::CLI::Invoker::Browser->new({
+        command   => $command,
+        options   => \%options,
+        arguments => $arguments,
+    });
+    $invoker->invoke();
+
+=head1 DESCRIPTION
+
+This class extends L<Fcm::CLI::Invoker|Fcm::CLI::Invoker> an inherits all its
+methods. An object of this class is used to invoke a web browser of a VC
+location.
+
+=head1 METHODS
+
+See L<Fcm::CLI::Invoker|Fcm::CLI::Invoker> for a list of inherited methods.
+
+=over 4
+
+=item invoke()
+
+Invokes a web browser for a VC target, if it can be mapped to a browser URL. If
+a target is not specified in arguments, it uses the current working directory
+as the target.
+
+If the browser option is set, it is used as the browser command. Otherwise, the
+default browser is used.
+
+=back
+
+=head1 DIAGNOSTICS
+
+=over 4
+
+=item L<Fcm::CLI::Exception|Fcm::CLI::Exception>
+
+The invoke() method can croak() with this exception if no target is specified
+and a target cannot be deduced from the current working directory.
+
+=item L<Fcm::Keyword::Exception|Fcm::Keyword::Exception>
+
+The invoke() method can croak() with this exception if the target cannot be
+mapped to a browser URL.
+
+=back
+
+=head1 TO DO
+
+Unit tests.
+
+=head1 SEE ALSO
+
+L<Fcm::CLI::Exception|Fcm::CLI::Exception>,
+L<Fcm::CLI::Invoker|Fcm::CLI::Invoker>,
+L<Fcm::CLI::Subcommand|Fcm::CLI::Subcommand>,
+L<Fcm::Keyword|Fcm::Keyword>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/CM.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/CM.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/CM.pm	(revision 2528)
@@ -0,0 +1,69 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::CLI::Invoker::CM;
+use base qw{Fcm::CLI::Invoker};
+
+use Fcm::Cm qw{cli};
+
+################################################################################
+# Invokes the sub-system
+sub invoke {
+    my ($self) = @_;
+    return cli($self->get_command(), @ARGV);
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::CLI::Invoker::CM
+
+=head1 SYNOPSIS
+
+    use Fcm::CLI::Invoker::CM;
+    $invoker = Fcm::CLI::Invoker::CM->new();
+    $invoker->invoke();
+
+=head1 DESCRIPTION
+
+This class extends L<Fcm::CLI::Invoker|Fcm::CLI::Invoker> an inherits all its
+methods. An object of this class is used to invoke a command in the CM
+sub-system.
+
+It is worth noting that this is not yet a full implementation.
+
+=head1 METHODS
+
+See L<Fcm::CLI::Invoker|Fcm::CLI::Invoker> for a list of inherited methods.
+
+=over 4
+
+=item invoke()
+
+Invokes a command in the CM sub-system.
+
+=back
+
+=head1 TO DO
+
+Bring the CM system into this framework.
+
+Unit tests.
+
+=head1 SEE ALSO
+
+L<Fcm::Cm|Fcm::Cm>,
+L<Fcm::CLI::Subcommand|Fcm::CLI::Subcommand>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/CfgPrinter.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/CfgPrinter.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/CfgPrinter.pm	(revision 2528)
@@ -0,0 +1,105 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::CLI::Invoker::CfgPrinter;
+use base qw{Fcm::CLI::Invoker};
+
+use Carp qw{croak};
+use Fcm::Exception;
+use Fcm::CfgFile;
+use Fcm::Config;
+
+################################################################################
+# Invokes the sub-system
+sub invoke {
+    my ($self) = @_;
+    my ($cfg_file) = $self->get_arguments();
+    if (!$cfg_file) {
+        croak(Fcm::CLI::Exception->new({message => 'no CFGFILE specified'}));
+    }
+    my $cfg = Fcm::CfgFile->new(SRC => $cfg_file);
+    Fcm::Config->instance()->verbose(0); # suppress message printing to STDOUT
+    my $read = $cfg->read_cfg();
+    if (!$read) {
+        croak(Fcm::Exception->new({message => sprintf(
+            "% :cannot read", $cfg_file,
+        )}));
+    }
+    $cfg->print_cfg($self->get_options()->{output});
+ }
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::CLI::Invoker::CfgPrinter
+
+=head1 SYNOPSIS
+
+    use Fcm::CLI::Invoker::CfgPrinter;
+    $invoker = Fcm::CLI::Invoker::CfgPrinter->new({
+        command   => $command,
+        options   => \%options,
+        arguments => $arguments,
+    });
+    $invoker->invoke();
+
+=head1 DESCRIPTION
+
+This class extends L<Fcm::CLI::Invoker|Fcm::CLI::Invoker> an inherits all its
+methods. An object of this class is used to invoke the pretty printer for FCM
+configuration files.
+
+=head1 METHODS
+
+See L<Fcm::CLI::Invoker|Fcm::CLI::Invoker> for a list of inherited methods.
+
+=over 4
+
+=item invoke()
+
+Invokes the pretty printer for a FCM configuration file.
+
+If the I<output> option is set, output goes to the location specified by this
+value.  Otherwise, it prints to STDOUT.
+
+=back
+
+=head1 DIAGNOSTICS
+
+=over 4
+
+=item L<Fcm::Exception|Fcm::Exception>
+
+The invoke() method can croak() with this exception if the configuration file
+cannot be read.
+
+=item L<Fcm::CLI::Exception|Fcm::CLI::Exception>
+
+The invoke() method can croak() with this exception if no configuration file is
+specified.
+
+=back
+
+=head1 TO DO
+
+Unit tests.
+
+=head1 SEE ALSO
+
+L<Fcm::CfgFile|Fcm::CfgFile>,
+L<Fcm::CLI::Exception|Fcm::CLI::Exception>,
+L<Fcm::CLI::Invoker|Fcm::CLI::Invoker>,
+L<Fcm::CLI::Subcommand|Fcm::CLI::Subcommand>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/ConfigSystem.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/ConfigSystem.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/ConfigSystem.pm	(revision 2528)
@@ -0,0 +1,117 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::CLI::Invoker::ConfigSystem;
+use base qw{Fcm::CLI::Invoker};
+
+use Cwd qw{cwd};
+use Fcm::CLI::Exception;
+use Fcm::Config;
+use Fcm::Util::ClassLoader;
+
+################################################################################
+# Returns a hash map to convert CLI options to system invoke options.
+sub get_cli2invoke_key_map {
+    my ($self) = @_;
+    return (
+          wantarray() ? %{$self->{cli2invoke_key_map}}
+        :               $self->{cli2invoke_key_map}
+    );
+}
+
+################################################################################
+# Returns the Fcm::ConfigSystem class for invoking the sub-system.
+sub get_impl_class {
+    my ($self) = @_;
+    return $self->{impl_class};
+}
+
+################################################################################
+# Invokes the sub-system
+sub invoke {
+    my ($self) = @_;
+    my $options_ref = $self->get_options();
+    if (exists($options_ref->{verbose})) {
+        Fcm::Config->instance()->verbose($options_ref->{verbose});
+    }
+
+    Fcm::Util::ClassLoader::load($self->get_impl_class());
+    my $system = $self->get_impl_class()->new();
+    my ($cfg_file) = $self->get_arguments();
+    $system->cfg()->src($cfg_file ? $cfg_file : cwd());
+
+    my %map = $self->get_cli2invoke_key_map();
+    my %invoke_args = map {($map{$_}, $options_ref->{$_})} keys(%map);
+    $system->invoke(%invoke_args);
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::CLI::Invoke::ConfigSystem
+
+=head1 SYNOPSIS
+
+    use Fcm::CLI::Invoker::ConfigSystem;
+    $invoker = Fcm::CLI::Invoker::ConfigSystem->new({
+        command            => $command,
+        options            => \%options,
+        arguments          => $arguments,
+        impl_class         => $class_name,
+        cli2invoke_key_map => {
+            option => 'OPTION',
+            # ... more keys
+        },
+    });
+    $invoker->invoke();
+
+=head1 DESCRIPTION
+
+This class extends L<Fcm::CLI::Invoker|Fcm::CLI::Invoker> and inherits all its
+methods. An object of this class is used to invoke a
+L<Fcm::ConfigSystem|Fcm::ConfigSystem>, e.g. extract and build.
+
+=head1 METHODS
+
+See L<Fcm::CLI::Invoker|Fcm::CLI::Invoker> for a list of inherited methods.
+
+=over 4
+
+=item get_cli2invoke_key_map()
+
+Returns a hash containing a mapping table from the names of the relevant command
+line options to the names to be given to the invoke() method of the implementing
+L<Fcm::ConfigSystem|Fcm::ConfigSystem> object.
+
+=item get_impl_class()
+
+Returns the actual class that implements L<Fcm::ConfigSystem|Fcm::ConfigSystem>.
+An object of this implementation will be created and used by invoke().
+
+=item invoke()
+
+Invokes the L<Fcm::ConfigSystem|Fcm::ConfigSystem> sub-system. If a
+configuration file is not specified in the argument, it uses the current working
+directory.
+
+=back
+
+=head1 SEE ALSO
+
+L<Fcm::ConfigSystem|Fcm::ConfigSystem>,
+L<Fcm::CLI::Exception|Fcm::CLI::Exception>,
+L<Fcm::CLI::Invoker|Fcm::CLI::Invoker>,
+L<Fcm::CLI::Subcommand|Fcm::CLI::Subcommand>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/ExtractConfigComparator.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/ExtractConfigComparator.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/ExtractConfigComparator.pm	(revision 2528)
@@ -0,0 +1,83 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::CLI::Invoker::ExtractConfigComparator;
+use base qw{Fcm::CLI::Invoker};
+
+use Cwd qw{cwd};
+use Fcm::ExtractConfigComparator;
+use Fcm::Config;
+
+################################################################################
+# Invokes the sub-system
+sub invoke {
+    my ($self) = @_;
+    my ($cfg_file1, $cfg_file2) = $self->get_arguments();
+    if (exists($self->get_options()->{verbose})) {
+        Fcm::Config->instance()->verbose($self->get_options()->{verbose});
+    }
+
+    my $system = Fcm::ExtractConfigComparator->new({
+        files => [$cfg_file1, $cfg_file2], wiki => $self->get_options()->{wiki},
+    });
+    $system->invoke();
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::CLI::ExtractInvoker
+
+=head1 SYNOPSIS
+
+    use Fcm::CLI::Invoker::ExtractConfigComparator;
+    $invoker = Fcm::CLI::Invoker::ExtractConfigComparator->new({
+        command   => $command,
+        options   => \%options,
+        arguments => $arguments,
+    });
+    $invoker->invoke();
+
+=head1 DESCRIPTION
+
+This class extends L<Fcm::CLI::Invoker|Fcm::CLI::Invoker> an inherits all its
+methods. An object of this class is used to invoke the extract configuration
+comparator.
+
+=head1 METHODS
+
+See L<Fcm::CLI::Invoker|Fcm::CLI::Invoker> for a list of inherited methods.
+
+=over 4
+
+=item invoke()
+
+Invokes the extract configuration comparator.
+
+The I<wiki> option is mapped directly to that of the constructor of
+L<Fcm::ExtractConfigComparator|Fcm::ExtractConfigComparator> object.
+
+=back
+
+=head1 TO DO
+
+Unit tests.
+
+=head1 SEE ALSO
+
+L<Fcm::ExtractConfigComparator|Fcm::ExtractConfigComparator>,
+L<Fcm::CLI::Invoker|Fcm::CLI::Invoker>,
+L<Fcm::CLI::Subcommand|Fcm::CLI::Subcommand>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/GUI.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/GUI.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/GUI.pm	(revision 2528)
@@ -0,0 +1,70 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::CLI::Invoker::GUI;
+use base qw{Fcm::CLI::Invoker};
+
+use Fcm::Util qw{run_command};
+
+################################################################################
+# Invokes the sub-system
+sub invoke {
+    my ($self) = @_;
+    my ($target) = $self->get_arguments();
+    run_command(['fcm_gui', ($target ? $target : ())], METHOD => 'exec');
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::CLI::GUIInvoker
+
+=head1 SYNOPSIS
+
+    use Fcm::CLI::Invoker::GUI;
+    $invoker = Fcm::CLI::Invoker::GUI->new({
+        command   => $command,
+        options   => \%options,
+        arguments => $arguments,
+    });
+    $invoker->invoke($command, \%options, $target);
+
+=head1 DESCRIPTION
+
+This class extends L<Fcm::CLI::Invoker|Fcm::CLI::Invoker> an inherits all its
+methods. An object of this class is used to invoke the FCM GUI.
+
+=head1 METHODS
+
+See L<Fcm::CLI::Invoker|Fcm::CLI::Invoker> for a list of inherited methods.
+
+=over 4
+
+=item invoke()
+
+Invokes the FCM GUI. If a target is specified as argument, it is the initial
+working directory of the GUI.
+
+=back
+
+=head1 TO DO
+
+Unit tests.
+
+=head1 SEE ALSO
+
+L<Fcm::CLI::Invoker|Fcm::CLI::Invoker>,
+L<Fcm::CLI::Subcommand|Fcm::CLI::Subcommand>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/Help.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/Help.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/Help.pm	(revision 2528)
@@ -0,0 +1,220 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::CLI::Invoker::Help;
+use base qw{Fcm::CLI::Invoker};
+
+use Carp qw{croak};
+use Fcm::CLI::Exception;
+use Fcm::CLI::Config;
+use Fcm::Config;
+use Fcm::Util qw{run_command};
+use IO::File;
+
+################################################################################
+# Invokes the sub-system
+sub invoke {
+    my ($self) = @_;
+    my @subcommand_names = $self->get_arguments();
+    if (@subcommand_names) {
+        for my $subcommand_name (@subcommand_names) {
+            my $help_string = $self->_get_help_for($subcommand_name);
+            if (!defined($help_string)) {
+                croak(Fcm::CLI::Exception->new({message => sprintf(
+                    "%s: unknown command", $subcommand_name,
+                )}));
+            }
+            print($help_string, "\n");
+        }
+    }
+    else {
+        print($self->_get_help());
+    }
+}
+
+################################################################################
+# Returns the help string for a subcommand matching $subcommand_name
+sub _get_help_for {
+    my ($self, $subcommand_name) = @_;
+    my $subcommand
+        = Fcm::CLI::Config->instance()->get_subcommand_of($subcommand_name);
+    if (!$subcommand) {
+        return;
+    }
+    if ($subcommand->is_vc()) {
+        my $invoker = $subcommand->get_invoker($subcommand_name);
+        local(@ARGV) = '--help';
+        $invoker->invoke();
+        return q{};
+    }
+    my $prog = Fcm::Config->instance()->setting('FCM_COMMAND');
+    # FIXME: can do with using Text::Template or Perl6::Form
+    my $help = sprintf(
+        "%s %s: %s\n",
+        $prog,
+        $subcommand->as_string(),
+        $subcommand->get_synopsis(),
+    );
+    $help .= sprintf(
+        "usage: %s %s %s\n",
+        $prog, $subcommand->get_names()->[0], $subcommand->get_usage(),
+    );
+    if ($subcommand->get_description()) {
+        my @lines = (q{}, split("\n", $subcommand->get_description()), q{});
+        $help .= join(qq{\n  }, @lines) . "\n";
+    }
+    if ($subcommand->get_options()) {
+        $help .= "Valid options:\n";
+        my $max_length_of_name = 0;
+        my @option_names;
+        for my $option ($subcommand->get_options()) {
+            if (length($option->get_name()) > $max_length_of_name) {
+                $max_length_of_name = length($option->get_name());
+            }
+        }
+        for my $option ($subcommand->get_options()) {
+            $help .= sprintf(
+                "  --%s%s%s%s : %s\n",
+                $option->get_name(),
+                q{ } x ($max_length_of_name - length($option->get_name())),
+                (
+                    $option->get_letter()
+                    ? q{ [-} . $option->get_letter() . q{]} : q{     }
+                ),
+                ($option->has_arg() ? q{ arg} : q{ } x 4),
+                $option->get_description(),
+            );
+        }
+    }
+    return $help;
+}
+
+################################################################################
+# Returns the general help string
+sub _get_help {
+    my ($self) = @_;
+    my $release = $self->_get_release();
+
+    # FIXME: can do with using Text::Template or Perl6::Form
+    my $prog = Fcm::Config->instance()->setting('FCM_COMMAND');
+    my $return = sprintf(
+          qq{usage: %s <subcommand> [options] [args]\n}
+        . qq{Flexible configuration management system, release %s.\n}
+        . qq{Type "%s help <subcommand>" for help on a specific subcommand\n}
+        . qq{\n}
+        . qq{Available subcommands:\n}
+        ,
+        $prog, $release, $prog,
+    );
+    for my $subcommand (Fcm::CLI::Config->instance()->get_core_subcommands()) {
+        $return .= sprintf(qq{  %s\n}, $subcommand->as_string());
+    }
+
+    my @lines = run_command(
+        [qw/svn help/], DEVNULL => 1, METHOD => 'qx', ERROR => 'ignore',
+    );
+    if (@lines) {
+        for my $subcommand (Fcm::CLI::Config->instance()->get_vc_subcommands()) {
+            if (defined($subcommand->get_synopsis())) {
+                $return .= sprintf(qq{  %s\n}, $subcommand->as_string());
+            }
+            else {
+                $return .= qq{  <version control system commands, see below>\n};
+            }
+        }
+        $return .= "\n=> svn help\n". join(q{}, @lines);
+    }
+    return $return;
+}
+
+################################################################################
+# Returns the release number of the current program
+sub _get_release {
+    my ($self) = @_;
+    my $release  = Fcm::Config->instance()->setting('FCM_RELEASE');
+    my $rev_file = Fcm::Config->instance()->setting('FCM_REV_FILE');
+    if (-r $rev_file) {
+        my $handle = IO::File->new($rev_file, 'r');
+        if ($handle) {
+            my $rev = $handle->getline();
+            $handle->close();
+            chomp($rev);
+            if ($rev) {
+                $release .= qq{ (r$rev)};
+            }
+        }
+    }
+    return $release;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::CLI::Invoker::Help
+
+=head1 SYNOPSIS
+
+    use Fcm::CLI::Invoker::Help;
+    $invoker = Fcm::CLI::Invoker::Help->new({
+        command   => $command,
+        options   => \%options,
+        arguments => $arguments,
+    });
+    $invoker->invoke();
+
+=head1 DESCRIPTION
+
+This class extends L<Fcm::CLI::Invoker|Fcm::CLI::Invoker> an inherits all its
+methods. An object of this class is used to provide help on the command line
+interface.
+
+=head1 METHODS
+
+See L<Fcm::CLI::Invoker|Fcm::CLI::Invoker> for a list of inherited methods.
+
+=over 4
+
+=item invoke()
+
+Provides help. If a subcommand name is specified in the argument, provides help
+for the specified subcommand. If a subcommand name is not specified, provides
+general CLI help.
+
+=back
+
+=head1 DIAGNOSTICS
+
+=over 4
+
+=item L<Fcm::CLI::Exception|Fcm::CLI::Exception>
+
+The invoke() method can croak() with this exception if the specified subcommand
+cannot be identified.
+
+=back
+
+=head1 TO DO
+
+Unit tests.
+
+Separate logic in this module with that of L<Fcm::CLI::Config|Fcm::CLI::Config>.
+
+Decouples help formatter with this invoker.
+
+=head1 SEE ALSO
+
+L<Fcm::CLI::Exception|Fcm::CLI::Exception>,
+L<Fcm::CLI::Subcommand|Fcm::CLI::Subcommand>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/KeywordPrinter.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/KeywordPrinter.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/KeywordPrinter.pm	(revision 2528)
@@ -0,0 +1,124 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::CLI::Invoker::KeywordPrinter;
+use base qw{Fcm::CLI::Invoker};
+
+use Carp qw{croak};
+use Fcm::CLI::Exception;
+use Fcm::Keyword;
+use Fcm::Keyword::Formatter::Entries;
+use Fcm::Keyword::Formatter::Entry::Location;
+use Fcm::Keyword::Exception;
+use Fcm::Util qw{get_url_of_wc};
+
+################################################################################
+# Invokes the sub-system
+sub invoke {
+    my ($self) = @_;
+    my @targets = $self->get_arguments();
+    if (@targets) {
+        for my $target (@targets) {
+            my $entry_list = Fcm::Keyword::get_location_entries_for($target);
+            my $loc = $target;
+            if (-e $target) {
+                $loc = get_url_of_wc($target);
+                if (!$loc) {
+                    croak(Fcm::Keyword::Exception->new({message => sprintf(
+                        "%s: unrecognised version control resource", $target,
+                    )}));
+                }
+            }
+            my @entry_list = Fcm::Keyword::get_location_entries_for($loc);
+            if (!@entry_list) {
+                croak(Fcm::Keyword::Exception->new({message => sprintf(
+                    "%s: no FCM location keyword found for this target", $target,
+                )}));
+            }
+            my $formatter = Fcm::Keyword::Formatter::Entry::Location->new();
+            for my $entry (
+                sort {$a->get_key() cmp $b->get_key()}
+                grep {!$_->is_implied()}
+                @entry_list
+            ) {
+                print($formatter->format($entry), "\n");
+            }
+        }
+    }
+    else {
+        my $formatter = Fcm::Keyword::Formatter::Entries->new();
+        print($formatter->format(Fcm::Keyword::get_entries()));
+    }
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::CLI::Invoker::KeywordPrinter
+
+=head1 SYNOPSIS
+
+    use Fcm::CLI::Invoker::KeywordPrinter;
+    $invoker = Fcm::CLI::Invoker::KeywordPrinter->new({
+        command   => $command,
+        options   => \%options,
+        arguments => $arguments,
+    });
+    $invoker->invoke();
+
+=head1 DESCRIPTION
+
+This class extends L<Fcm::CLI::Invoker|Fcm::CLI::Invoker> an inherits all its
+methods. An object of this class is used to invoke the location keyword printer.
+
+=head1 METHODS
+
+See L<Fcm::CLI::Invoker|Fcm::CLI::Invoker> for a list of inherited methods.
+
+=over 4
+
+=item invoke()
+
+Invokes the location keyword printer. If a namespace is specified in the
+argument, prints revision keywords and browser mapping templates for the
+specified namespace. If a namespace is not specified, prints all registered
+location keywords.
+
+=back
+
+=head1 DIAGNOSTICS
+
+=over 4
+
+=item L<Fcm::Keyword::Exception|Fcm::Keyword::Exception>
+
+The invoke() method can croak() with this exception if there is no matching
+namespace matching that of the specified.
+
+=back
+
+=head1 TO DO
+
+Unit tests.
+
+=head1 SEE ALSO
+
+L<Fcm::CLI::Exception|Fcm::CLI::Exception>,
+L<Fcm::CLI::Invoker|Fcm::CLI::Invoker>,
+L<Fcm::CLI::Subcommand|Fcm::CLI::Subcommand>,
+L<Fcm::Keyword|Fcm::Keyword>,
+L<Fcm::Keyword::Formatter::Entries|Fcm::Keyword::Formatter::Entries>,
+L<Fcm::Keyword::Formatter::Entry::Location|Fcm::Keyword::Formatter::Entry::Location>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Option.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Option.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Option.pm	(revision 2528)
@@ -0,0 +1,183 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::CLI::Option;
+
+use constant NO_ARG     => 0;
+use constant SCALAR_ARG => 1;
+use constant ARRAY_ARG  => 2;
+use constant HASH_ARG   => 3;
+use constant ARG_STRING_SUFFIX_FOR => (q{}, q{=s}, q{=s@}, q{=s%});
+
+################################################################################
+# Constructor
+sub new {
+    my ($class, $args_ref) = @_;
+    return bless({%{$args_ref}}, $class);
+}
+
+################################################################################
+# Methods: get_*
+for my $key (
+    # Returns the delimiter of this option, if it is an array
+    'delimiter',
+    # Returns the description of this option
+    'description',
+    # Returns the (long) name of this option
+    'name',
+) {
+    no strict qw{refs};
+    my $getter = "get_$key";
+    *$getter = sub {
+        my ($self) = @_;
+        return $self->{$key};
+    }
+}
+
+################################################################################
+# Returns the letter of this option
+sub get_letter {
+    my ($self) = @_;
+    if (defined($self->{letter})) {
+        return substr($self->{letter}, 0, 1);
+    }
+    else {
+        return;
+    }
+}
+
+################################################################################
+# Returns whether the current option has no, scalar, array or hash arguments
+sub has_arg {
+    my ($self) = @_;
+    return (defined($self->{has_arg}) ? $self->{has_arg} : $self->NO_ARG);
+}
+
+################################################################################
+# Returns true if this option is associated with help
+sub is_help {
+    my ($self) = @_;
+    return $self->{is_help};
+}
+
+################################################################################
+# Returns an option string/reference pair for Getopt::Long::GetOptions
+sub get_arg_for_getopt_long {
+    my ($self) = @_;
+    my $option_string
+        = $self->get_name()
+          . ($self->get_letter() ? q{|} . $self->get_letter() : q{})
+          . (ARG_STRING_SUFFIX_FOR)[$self->has_arg()]
+          ;
+    return $option_string;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::CLI::Option
+
+=head1 SYNOPSIS
+
+    use Fcm::CLI::Option;
+    $option = Fcm::CLI::Option->new({
+        name        => 'name',
+        letter      => 'n',
+        has_arg     => Fcm::CLI::Option->SCALAR_ARG,
+        is_help     => 1,
+        description => 'an example option',
+    });
+
+    # time passes ...
+    use Getopt::Long qw{GetOptions};
+    $success = GetOptions(
+        \%hash,
+        $option->get_arg_for_getopt_long(), # ('name|n=s')
+        # and other options ...
+    );
+    $option_value = $option->get_value();
+
+=head1 DESCRIPTION
+
+An object of this class represents a CLI option.
+
+=head1 METHODS
+
+=over 4
+
+=item new($args_ref)
+
+Constructor.
+
+=item get_arg_for_getopt_long()
+
+Returns an option string for this option that is suitable for use as arguments
+to L<Getopt::Long|Getopt::Long>.
+
+=item get_description()
+
+Returns a description of this option.
+
+=item get_delimiter()
+
+Returns the delimiter of this option. This is only relevant if has_arg() is
+equal to C<ARRAY_ARG>. If set, the argument for this option should be re-grouped
+using this delimiter.
+
+=item get_name()
+
+Returns the (long) name of this option.
+
+=item get_letter()
+
+Returns the option letter of this option.
+
+=item has_arg()
+
+Returns whether this option has no, scalar, array or hash arguments. See
+L</CONSTANTS> for detail.
+
+=item is_help()
+
+Returns true if this option is associated with help.
+
+=back
+
+=head1 CONSTANTS
+
+=over 4
+
+=item NO_ARG
+
+An option has no argument. (Default)
+
+=item SCALAR_ARG
+
+An option has a single scalar argument.
+
+=item ARRAY_ARG
+
+An option has multiple arguments, which can be placed in an array.
+
+=item HASH_ARG
+
+An option has multiple arguments, which can be placed in an hash.
+
+=back
+
+=head1 SEE ALSO
+
+L<Getopt::Long|Getopt::Long>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Subcommand.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Subcommand.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Subcommand.pm	(revision 2528)
@@ -0,0 +1,245 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::CLI::Subcommand;
+
+use Carp qw{croak};
+use Fcm::CLI::Exception;
+use Fcm::Util::ClassLoader;
+
+################################################################################
+# Constructor
+sub new {
+    my ($class, $args_ref) = @_;
+    return bless({%{$args_ref}}, $class);
+}
+
+################################################################################
+# Methods: get_*
+for my $key (
+    # Returns the long description of this subcommand
+    'description',
+    # Returns the class of the invoker of this subcommand
+    'invoker_class',
+    # Returns the extra config to be given to the invoker of this subcommand
+    'invoker_config',
+    # Returns the names of this subcommand
+    'names',
+    # Returns the options of this subcommand
+    'options',
+    # Returns the synopsis of this subcommand
+    'synopsis',
+    # Returns the usage of this subcommand
+    'usage',
+) {
+    no strict qw{refs};
+    my $getter = "get_$key";
+    *$getter = sub {
+        my ($self) = @_;
+        if (defined($self->{$key})) {
+            if (ref($self->{$key}) eq 'ARRAY') {
+                return (wantarray() ? @{$self->{$key}} : $self->{$key});
+            }
+            else {
+                return $self->{$key};
+            }
+        }
+        else {
+            return;
+        }
+    }
+}
+
+################################################################################
+# Returns true if this subcommand represents a command in the CM sub-system
+sub is_vc {
+    my ($self) = @_;
+    return $self->{is_vc};
+}
+
+################################################################################
+# Returns true if $string matches a name of this subcommand
+sub has_a_name {
+    my ($self, $string) = @_;
+    if ($self->get_names() && ref($self->get_names()) eq 'ARRAY') {
+        my %name_of = map {$_, 1} @{$self->get_names()};
+        return exists($name_of{$string});
+    }
+    else {
+        return;
+    }
+}
+
+################################################################################
+# Invokes this subcommand based on current @ARGV
+sub get_invoker {
+    my ($self, $command) = @_;
+    my %options = ();
+    if (($self->get_options())) {
+        my $problem = q{};
+        local($SIG{__WARN__}) = sub {
+            ($problem) = @_;
+        };
+        my $success = GetOptions(
+            \%options,
+            (map {$_->get_arg_for_getopt_long()} ($self->get_options())),
+        );
+        if (!$success) {
+            croak(Fcm::CLI::Exception->new({message => sprintf(
+                "%s: option parse failed: %s", $command, $problem,
+            )}));
+        }
+    }
+    my $invoker_class
+        = $self->get_invoker_class() ? $self->get_invoker_class()
+        :                              'Fcm::CLI::Invoker'
+        ;
+    Fcm::Util::ClassLoader::load($invoker_class);
+    my $invoker = $invoker_class->new({
+        command   => $command,
+        options   => \%options,
+        arguments => [@ARGV],
+    });
+    return $invoker;
+}
+
+################################################################################
+# Returns a simple string representation of this subcommand
+sub as_string {
+    my ($self) = @_;
+    # FIXME: can do with using Text::Template or Perl6::Form
+    if (
+           $self->get_names()
+        && ref($self->get_names()) eq 'ARRAY'
+        && @{$self->get_names()}
+    ) {
+        my @names = $self->get_names();
+        my $return = $names[0];
+        for my $i (1 .. $#names) {
+            if ($names[$i]) {
+                $return
+                    .= $i == 1       ? q{ (} . $names[$i]
+                    :                  q{, } . $names[$i]
+                    ;
+            }
+            if ($i == $#names) {
+                $return .= q{)};
+            }
+        }
+        return $return;
+    }
+    else {
+        return q{};
+    }
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::CLI::Subcommand
+
+=head1 SYNOPSIS
+
+    use Fcm::CLI::Subcommand;
+    $subcommand = Fcm::CLI::Subcommand->new({
+        names          => ['build', 'bld'],
+        options        => [
+            Fcm::CLI::Option->new(
+                # ... some arguments ...
+            ),
+            # ... more options
+        ],
+        synopsis       => 'invokes the build system',
+        description    => $description,
+        usage          => '[OPTIONS] [CONFIG]',
+        invoker_class  => $invoker_class,
+        invoker_config => {
+            option1 => $option1,
+            # ... more options
+        },
+    });
+    $boolean = $subcommand->has_a_name($string);
+    $invoker_class = $subcommand->get_invoker_class();
+
+=head1 DESCRIPTION
+
+An object of this class is used to store the configuration of a subcommand of
+the FCM CLI.
+
+=head1 METHODS
+
+=over 4
+
+=item new($args_ref)
+
+Constructor.
+
+=item get_description()
+
+Returns the long description of this subcommand.
+
+=item get_invoker_class()
+
+Returns the invoker class of this subcommand, which should be a sub-class of
+L<Fcm::CLI::Invoker|Fcm::CLI::Invoker>.
+
+=item get_invoker_cconfig()
+
+Returns a reference to a hash containing the extra configuration to be given to
+the constructor of the invoker of this subcommand.
+
+=item get_names()
+
+Returns an array containing the names of this subcommand.
+
+=item get_options()
+
+Returns an array containing the options of this subcommand. Each element of
+the array should be a L<Fcm::CLI::Option|Fcm::CLI::Option> object.
+
+=item get_synopsis()
+
+Returns a short synopsis of this subcommand.
+
+=item get_usage()
+
+Returns a short usage statement of this subcommand.
+
+=item is_vc()
+
+Returns true if this subcommand represents commands in the underlying VC system.
+
+=item has_a_name($string)
+
+Returns true if a name in C<$self-E<gt>get_names()> matches $string.
+
+=back
+
+=head1 DIAGNOSTICS
+
+=over 4
+
+=item L<Fcm::CLI::Exception|Fcm::CLI::Exception>
+
+The invoke() method may croak() with this exception.
+
+=back
+
+=head1 SEE ALSO
+
+L<Fcm::CLI::Exception|Fcm::CLI::Exception>,
+L<Fcm::CLI::Invoker|Fcm::CLI::Invoker>,
+L<Fcm::CLI::Option|Fcm::CLI::Option>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-add.pod
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-add.pod	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-add.pod	(revision 2528)
@@ -0,0 +1,22 @@
+=head1 NAME
+
+fcm add
+
+=head1 SYNOPSIS
+
+    fcm add [options] [args]
+
+=head1 OPTIONS
+
+=over 4
+
+=item -c [--check]
+
+Check for any files or directories reported by "L<svn|svn> status" as not under
+version control and add them.
+
+=back
+
+For other options, see output of "L<svn|svn> help add".
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-branch.pod
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-branch.pod	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-branch.pod	(revision 2528)
@@ -0,0 +1,173 @@
+=head1 NAME
+
+fcm branch (br)
+
+=head1 SYNOPSIS
+
+Create, delete or display information of a branch, or list branches in a
+project.
+
+    fcm branch [--info] [OPTIONS] [TARGET]
+    fcm branch --delete [OPTIONS] [TARGET]
+    fcm branch --create [OPTIONS] [SOURCE]
+    fcm branch --list   [OPTIONS] [SOURCE]
+
+=head1 ARGUMENTS
+
+TARGET (and SOURCE) can be an URL or a Subversion working copy. Otherwise,
+the current working directory must be a working copy. For --info and
+--delete, the specified URL (or the URL of the working copy) must be a URL
+under a valid branch in a standard FCM project. For --create and --list, it
+must be a URL under a standard FCM project.
+
+=head1 OPTIONS
+
+=over 4
+
+=item --info or -i
+
+Display information about a branch. This is the default option if --create,
+--delete and --list are not specified.
+
+=item --delete or -d
+
+Delete a branch.
+
+=item --create or -c
+
+Create a new branch from SOURCE. The --name option must be used to specify a
+short name for the new branch.
+
+=item --list or -l
+
+List all the branches owned by the current user in SOURCE. If the --user option
+is specified with a list of users, list all the branches owned by these users
+instead of the current user.
+
+=back
+
+Valid options with --info and --delete:
+
+=over 4
+
+=item -v [--verbose]
+
+Print extra information.
+
+=item -a [--show-all]
+
+Set --show-children, --show-other and --show-siblings.
+
+=item --show-children
+
+Report children of the current branch.
+
+=item --show-other
+
+Report custom/ reverse merges into the current branch.
+
+=item --show-siblings
+
+Report merges with siblings of the current branch.
+
+=back
+
+Valid options with --delete and --create:
+
+=over 4
+
+=item --non-interactive
+
+Do no interactive prompting. This option implies --svn-non-interactive.
+
+=item --password arg
+
+Specify a password for write access to the repository.
+
+=item --svn-non-interactive
+
+Do no interactive prompting at commit time. This option is implied by
+--non-interactive.
+
+=back
+
+Valid options with --create and --list:
+
+=over 4
+
+=item -r [--revision] arg
+
+Specify the operative revision of the SOURCE for creating the branch.
+
+=back
+
+Valid options with --create:
+
+=over 4
+
+=item --branch-of-branch
+
+If this option is specified and the SOURCE is a branch, it will create a new
+branch from the SOURCE branch. Otherwise, the branch is created from the trunk.
+
+=item -k [--ticket] arg
+
+Specify one (or more) Trac ticket. If specified, the command will add to the
+commit log the line "Relates to ticket #<ticket>". Multiple tickets can be set
+by specifying this option multiple times, or by specifying the tickets in a
+comma-separated list.
+
+=item -n [--name] arg
+
+Specify a short name for the branch, which should contain only characters in the
+set [A-Za-z0-9_-.].
+
+=item --rev-flag arg
+
+Specify a flag for determining the prefix of the branch name. The flag can be
+the the string "NORMAL", "NUMBER" or "NONE".  "NORMAL" is the default behaviour,
+in which the branch name will be prefixed with a Subversion revision number if
+the revision is not associated with a registered FCM revision keyword. If the
+revision is registered with a FCM revision keyword, the keyword will be used in
+place of the number. If "NUMBER" is specified, the branch name will always be
+prefixed with a Subversion revision number. If "NONE" is specified, the branch
+name will not be prefixed by a revision number or keyword.
+
+=item -t [--type] arg
+
+Specify the type of the branch to be created. It must be one of the following:
+
+ DEV::USER [DEV, USER] - a development branch for the user
+ DEV::SHARE [SHARE]    - a shared development branch
+ TEST::USER [TEST]     - a test branch for the user
+ TEST::SHARE           - a shared test branch
+ PKG::USER [PKG]       - a package branch for the user
+ PKG::SHARE            - a shared package branch
+ PKG::CONFIG [CONFIG]  - a configuration branch
+ PKG::REL [REL]        - a release branch
+
+If not specified, the default is to create a development branch for the current
+user, i.e.  DEV::USER.
+
+=back
+
+Valid options with --list:
+
+=over 4
+
+=item -a [--show-all]
+
+Print all branches.
+
+=item -u [--user] arg
+
+Specify a colon-separated list of users. List branches owned by these users
+instead of the current user.
+
+=item -v [--verbose]
+
+Print Subversion URL instead of FCM URL keywords.
+
+=back
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-commit.pod
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-commit.pod	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-commit.pod	(revision 2528)
@@ -0,0 +1,31 @@
+=head1 NAME
+
+fcm commit (ci)
+
+=head1 SYNOPSIS
+
+    fcm commit [OPTIONS] [PATH ...]
+
+Send changes from your working copy to the repository. Invoke your favourite
+editor to prompt you for a commit log message. Update your working copy
+following the commit.
+
+=head1 OPTIONS
+
+=over 4
+
+=item --dry-run
+
+Allows you to add to the commit message without committing.
+
+=item --svn-non-interactive
+
+Do no interactive prompting at commit time.
+
+=item --password arg
+
+Specify a password ARG.
+
+=back
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-conflicts.pod
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-conflicts.pod	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-conflicts.pod	(revision 2528)
@@ -0,0 +1,17 @@
+=head1 NAME
+
+fcm conflicts (cf)
+
+=head1 SYNOPSIS
+
+Use graphical tool to resolve any conflicts within your working copy.
+
+    fcm conflicts [PATH]
+
+=head1 ARGUMENTS
+
+Invoke a graphical merge tool to help you resolve conflicts in your working copy
+at PATH. It prompts you to run "L<svn|svn> resolved" each time you have resolved
+the conflicts in a text file.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-delete.pod
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-delete.pod	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-delete.pod	(revision 2528)
@@ -0,0 +1,22 @@
+=head1 NAME
+
+fcm delete (del, remove, rm)
+
+=head1 SYNOPSIS
+
+    fcm delete [options] [args]
+
+=head1 OPTIONS
+
+=over 4
+
+=item -c [--check]
+
+Check for any files or directories reported by "L<svn|svn> status" as missing
+and schedule them for removal.
+
+=back
+
+For other options, see output of "L<svn|svn> help delete".
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-diff.pod
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-diff.pod	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-diff.pod	(revision 2528)
@@ -0,0 +1,79 @@
+=head1 NAME
+
+fcm diff (di)
+
+=head1 SYNOPSIS
+
+    1. fcm diff --branch [OPTIONS] [TARGET]
+    2. fcm diff [OPTIONS] [ARGS]
+
+=over 4
+
+=item 1.
+
+Show differences relative to the base of the target branch, i.e. the changes
+available for merging from the target branch into its parent. If TARGET is
+specified, it must either be a URL or a working copy.  Otherwise, the target is
+the the current directory which must be a working copy. The target URL must be a
+branch in a standard FCM project.
+
+=item 2.
+
+See description of "L<svn|svn> diff" below.
+
+=back
+
+=head1 OPTIONS
+
+Valid options with --branch:
+
+=over 4
+
+=item --diff-cmd arg
+
+As described below in the help for "L<svn|svn> diff".
+
+=item -g [--graphical]
+
+As described below.
+
+=item --summarise
+
+As described below
+
+=item --summarize
+
+As described below in the help for "L<svn|svn> diff".
+
+=item -t [--trac]
+
+If TARGET is a URL, use Trac to display the diff.
+
+=item --wiki
+
+If TARGET is a URL, print Trac link for the diff.
+
+=item -x [--extensions] arg
+
+As described below in the help for "L<svn|svn> diff".
+
+=back
+
+Other options:
+
+=over 4
+
+=item -g [--graphical]
+
+Use a graphical diff tool to display the differences. This option should not be
+used in combination with --diff-cmd.
+
+=item --summarise
+
+Same as --summarize as described below.
+
+=back
+
+For other options, see output of "L<svn|svn> help diff".
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-merge.pod
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-merge.pod	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-merge.pod	(revision 2528)
@@ -0,0 +1,71 @@
+=head1 NAME
+
+fcm merge
+
+=head1 SYNOPSIS
+
+Merge changes from a source into your working copy.
+
+    1. fcm merge SOURCE
+    2. fcm merge --custom  --revision N[:M] SOURCE
+       fcm merge --custom  URL[\@REV1] URL[\@REV2]
+    3. fcm merge --reverse --revision [M:]N
+
+=over 4
+
+=item 1.
+
+If neither --custom nor --reverse is specified, the command merges changes
+automatically from SOURCE into your working copy. SOURCE must be a valid
+URL[@REV] of a branch in a standard FCM project. The base of the merge will be
+calculated automatically based on the common ancestor and latest merge
+information between the SOURCE and the branch of the working copy.
+
+=item 2.
+
+If --custom is specified, the command can be used in two forms.
+  
+In the first form, it performs a custom merge from the specified changeset(s) of
+SOURCE into your working copy. SOURCE must be a valid URL[@REV] of a branch in
+a standard FCM project. If a single revision is specified, the merge delta is (N
+- 1):N of SOURCE. Otherwise, the merge delta, is N:M of SOURCE, where N < M.
+     
+In the second form, it performs a custom merge using the delta between the two
+specified branch URLs. For each URL, if a peg revision is not specified, the
+command will peg the URL with its last changed revision.
+
+=item 3.
+
+If --reverse is specified, the command performs a reverse merge of the
+changeset(s) specified by the --revision option. If a single revision is
+specified, the merge delta is N:(N - 1). Otherwise, the merge delta is M:N,
+where M > N. Note that you do not have to specify a SOURCE for a reverse merge,
+because the SOURCE should always be the branch your working copy is pointing to.
+  
+=back
+
+The command provide a commit log message template following the merge.
+
+=head1 OPTIONS
+
+=over 4
+
+=item --dry-run
+
+Try operation but make no changes.
+
+=item --non-interactive
+
+Do no interactive prompting.
+
+=item -r [--revision] arg
+
+Specify a (range of) revision number(s).
+
+=item --verbose
+
+Print extra information.
+
+=back
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-mkpatch.pod
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-mkpatch.pod	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-mkpatch.pod	(revision 2528)
@@ -0,0 +1,60 @@
+=head1 NAME
+
+fcm mkpatch
+
+=head1 SYNOPSIS
+
+mkpatch: Create patches from specified revisions of a URL
+
+    fcm mkpatch [OPTIONS] URL [OUTDIR]
+
+Create patches from specified revisions of the specified URL. If OUTDIR is
+specified, the output is sent to OUTDIR. Otherwise, the output will be sent to a
+default location in the current directory ($PWD/fcm-mkpatch-out). The output
+directory will contain the patch for each revision as well as a script for
+importing the patch.
+
+A warning is given if the URL is not of a branch in a FCM project or if it is a
+sub-directory of a branch.
+
+=head1 OPTIONS
+
+=over 4
+
+=item --exclude arg
+
+Exclude a path in the URL. Multiple paths can be specified by using a
+colon-separated list of paths, or by specifying this option multiple times.
+
+The specified path must be a relative path of the URL. Glob patterns such as *
+and ? are acceptable. Changes in an excluded path will not be considered in the
+patch. A changeset containing changes only in the excluded path will not be
+considered at all.
+
+=item --organisation arg
+
+This option can be used to specify the name of your organisation.
+
+The command will attempt to parse the commit log message for each revision in
+the patch. It will remove all merge templates, replace Trac links with a
+modified string, and add information about the original changeset. If you
+specify the name of your organisation, it will replace Trac links such as
+"ticket:123" with "$organisation_ticket:123", and report the original changeset
+with a message such as "$organisation_changeset:1000".  If the organisation
+name is not specified then it defaults to "original".
+
+=item -r [--revision] arg
+
+Specify a revision number or a revision number range.
+
+If a revision is specified with the --revision option, it will attempt to create
+a patch based on the changes at that revision. If a revision is not specified,
+it will attempt to create a patch based on the changes at the HEAD revision. If
+a revision range is specified, it will attempt to create a patch for each
+revision in that range (including the change in the lower range) where changes
+have taken place in the URL. No output will be written if there is no change in
+the given revision (range).
+
+=back
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-switch.pod
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-switch.pod	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-switch.pod	(revision 2528)
@@ -0,0 +1,14 @@
+=head1 NAME
+
+fcm switch (sw)
+
+=head1 SYNOPSIS
+
+    1. switch URL [PATH]
+    2. switch --relocate FROM TO [PATH...]
+
+Note: if --relocate is not specified, "fcm switch" will only support the options
+--non-interactive, -r [--revision] and -q [--quiet]. For detail, see the output
+of "L<svn|svn> help switch".
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-update.pod
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-update.pod	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-update.pod	(revision 2528)
@@ -0,0 +1,14 @@
+=head1 NAME
+
+fcm update (up)
+
+=head1 SYNOPSIS
+
+Bring changes from the repository into the working copy.
+
+    usage: update [PATH...]
+
+Note: "fcm update" only supports --non-interactive, -r [--revision] arg and -q
+[--quiet]. For detail, see the output of "L<svn|svn> help update".
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CfgFile.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CfgFile.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CfgFile.pm	(revision 2528)
@@ -0,0 +1,679 @@
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::CfgFile
+#
+# DESCRIPTION
+#   This class is used for reading and writing FCM config files. A FCM config
+#   file is a line-based text file that provides information on how to perform
+#   a particular task using the FCM system.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::CfgFile;
+@ISA = qw(Fcm::Base);
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+use Carp;
+use File::Basename;
+use File::Path;
+use File::Spec;
+
+# FCM component modules
+use Fcm::Base;
+use Fcm::CfgLine;
+use Fcm::Config;
+use Fcm::Keyword;
+use Fcm::Util;
+
+# List of property methods for this class
+my @scalar_properties = (
+  'actual_src', # actual source of configuration file
+  'lines',      # list of lines, Fcm::CfgLine objects
+  'pegrev',     # peg revision of configuration file
+  'src',        # source of configuration file
+  'type',       # type of configuration file
+  'version',    # version of configuration file
+);
+
+# Local module variables
+my $expand_type   = 'bld|ext'; # config file type that needs variable expansions
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = Fcm::CfgFile->new (%args);
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::CfgFile class. See above
+#   for allowed list of properties. (KEYS should be in uppercase.)
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = Fcm::Base->new (%args);
+
+  bless $self, $class;
+
+  for (@scalar_properties) {
+    $self->{$_} = exists $args{uc ($_)} ? $args{uc ($_)} : undef;
+  }
+
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @scalar_properties.
+# ------------------------------------------------------------------------------
+
+for my $name (@scalar_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    if (@_) {
+      $self->{$name} = $_[0];
+    }
+
+    if (not defined $self->{$name}) {
+      if ($name eq 'lines') {
+        $self->{$name} = [];
+      }
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $mtime = $obj->mtime ();
+#
+# DESCRIPTION
+#   This method returns the modified time of the configuration file source.
+# ------------------------------------------------------------------------------
+
+sub mtime {
+  my $self  = shift;
+  my $mtime = undef;
+
+  if (-f $self->src) {
+    $mtime = (stat $self->src)[9];
+  }
+
+  return $mtime;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $read = $obj->read_cfg ();
+#
+# DESCRIPTION
+#   This method reads the current configuration file. It returns the number of
+#   lines read from the config file, or "undef" if it fails. The result is
+#   placed in the LINES array of the current instance, and can be accessed via
+#   the "lines" method.
+# ------------------------------------------------------------------------------
+
+sub read_cfg {
+  my $self = shift;
+
+  my @lines = $self->_get_cfg_lines;
+
+  # List of CFG types that need INC declarations expansion
+  my %exp_inc    = ();
+  for (split (/$Fcm::Config::DELIMITER_LIST/, $self->setting ('CFG_EXP_INC'))) {
+    $exp_inc{uc ($_)} = 1;
+  }
+
+  # List of CFG labels that are reserved keywords
+  my %cfg_keywords = ();
+  for (split (/$Fcm::Config::DELIMITER_LIST/, $self->setting ('CFG_KEYWORD'))) {
+    $cfg_keywords{$self->cfglabel ($_)} = 1;
+  }
+
+  # Loop each line, to separate lines into label : value pairs
+  my $cont = undef;
+  my $here = undef;
+  for my $line_num (1 .. @lines) {
+    my $line = $lines[$line_num - 1];
+    chomp $line;
+
+    my $label   = '';
+    my $value   = '';
+    my $comment = '';
+
+    # If this line is a continuation, set $start to point to the line that
+    # starts this continuation. Otherwise, set $start to undef
+    my $start = defined ($cont) ? $self->lines->[$cont] : undef;
+    my $warning = undef;
+
+    if ($line =~ /^(\s*#.*)$/) { # comment line
+      $comment = $1;
+
+    } elsif ($line =~ /\S/) {    # non-blank line
+      if (defined $cont) {
+        # Previous line has a continuation mark
+        $value = $line;
+
+        # Separate value and comment
+        if ($value =~ s/((?:\s+|^)#\s+.*)$//) {
+          $comment = $1;
+        }
+
+        # Remove leading spaces
+        $value =~ s/^\s*\\?//;
+
+        # Expand environment variables
+        my $warn;
+        ($value, $warn) = $self->_expand_variable ($value, 1) if $value;
+        $warning .= ($warning ? ', ' : '') . $warn if $warn;
+
+        # Expand internal variables
+        ($value, $warn) = $self->_expand_variable ($value, 0) if $value;
+        $warning .= ($warning ? ', ' : '') . $warn if $warn;
+
+        # Get "line" that begins the current continuation
+        my $v = $start->value . $value;
+        $v =~ s/\\$//;
+        $start->value ($v);
+
+      } else {
+        # Previous line does not have a continuation mark
+        if ($line =~ /^\s*(\S+)(?:\s+(.*))?$/) {
+          # Check line contains a valid label:value pair
+          $label = $1;
+          $value = defined ($2) ? $2 : '';
+
+          # Separate value and comment
+          if ($value =~ s/((?:\s+|^)#\s+.*)$//) {
+            $comment = $1;
+          }
+
+          # Remove trailing spaces
+          $value =~ s/\s+$//;
+
+          # Value begins with $HERE?
+          $here  = ($value =~ /\$\{?HERE\}?(?:[^A-Z_]|$)/);
+
+          # Expand environment variables
+          my $warn;
+          ($value, $warn) = $self->_expand_variable ($value, 1) if $value;
+          $warning .= ($warning ? ', ' : '') . $warn if $warn;
+
+          # Expand internal variables
+          ($value, $warn) = $self->_expand_variable ($value, 0) if $value;
+          $warning .= ($warning ? ', ' : '') . $warn if $warn;
+        }
+      }
+
+      # Determine whether current line ends with a continuation mark
+      if ($value =~ s/\\$//) {
+        $cont = scalar (@{ $self->lines }) unless defined $cont;
+
+      } else {
+        $cont = undef;
+      }
+    }
+
+    if (exists $exp_inc{uc ($self->type)} and
+        uc ($start ? $start->label : $label) eq $self->cfglabel ('INC') and
+        not defined $cont) {
+      # Current configuration file requires expansion of INC declarations
+      # The start/current line is an INC declaration
+      # The current line is not a continuation or is the end of the continuation
+
+      # Get lines from an "include" configuration file
+      my $src = ($start ? $start->value : $value);
+      $src   .= '@' . $self->pegrev if $here and $self->pegrev;
+
+      if ($src) {
+        # Invoke a new instance to read the source
+        my $cfg = Fcm::CfgFile->new (
+          SRC => expand_tilde ($src), TYPE => $self->type,
+        );
+
+        $cfg->read_cfg;
+
+        # Add lines to the lines array in the current configuration file
+        $comment = 'INC ' . $src . ' ';
+        push @{$self->lines}, Fcm::CfgLine->new (
+          comment => $comment . '# Start',
+          number  => ($start ? $start->number : $line_num),
+          src     => $self->actual_src,
+          warning => $warning,
+        );
+        push @{ $self->lines }, @{ $cfg->lines };
+        push @{$self->lines}, Fcm::CfgLine->new (
+          comment => $comment . '# End',
+          src     => $self->actual_src,
+        );
+
+      } else {
+        push @{$self->lines}, Fcm::CfgLine->new (
+          number  => $line_num,
+          src     => $self->actual_src,
+          warning => 'empty INC declaration.'
+        );
+      }
+
+    } else {
+      # Push label:value pair into lines array
+      push @{$self->lines}, Fcm::CfgLine->new (
+        label   => $label,
+        value   => ($label ? $value : ''),
+        comment => $comment,
+        number  => $line_num,
+        src     => $self->actual_src,
+        warning => $warning,
+      );
+    }
+
+    next if defined $cont; # current line not a continuation
+
+    my $slabel = ($start ? $start->label : $label);
+    my $svalue = ($start ? $start->value : $value);
+    next unless $slabel;
+
+    # Check config file type and version
+    if (index (uc ($slabel), $self->cfglabel ('CFGFILE')) == 0) {
+      my @words = split /$Fcm::Config::DELIMITER_PATTERN/, $slabel;
+      shift @words;
+
+      my $name = @words ? lc ($words[0]) : 'type';
+
+      if ($self->can ($name)) {
+        $self->$name ($svalue);
+      }
+    }
+
+    # Set internal variable
+    $slabel =~ s/^\%//; # Remove leading "%" from label
+
+    $self->config->variable ($slabel, $svalue)
+      unless exists $cfg_keywords{$slabel};
+  }
+
+  # Report and reset warnings
+  # ----------------------------------------------------------------------------
+  for my $line (@{ $self->lines }) {
+    w_report $line->format_warning if $line->warning;
+    $line->warning (undef);
+  }
+
+  return @{ $self->lines };
+
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->print_cfg ($file, [$force]);
+#
+# DESCRIPTION
+#   This method prints the content of current configuration file. If no
+#   argument is specified, it prints output to the standard output. If $file is
+#   specified, and is a writable file name, the output is sent to the file.  If
+#   the file already exists, its content is compared to the current output.
+#   Nothing will be written if the content is unchanged unless $force is
+#   specified. Otherwise, for typed configuration files, the existing file is
+#   renamed using a prefix that contains its last modified time. The method
+#   returns 1 if there is no error.
+# ------------------------------------------------------------------------------
+
+sub print_cfg {
+  my ($self, $file, $force) = @_;
+
+  # Count maximum number of characters in the labels, (for pretty printing)
+  my $max_label_len = 0;
+  for my $line (@{ $self->lines }) {
+    next unless $line->label;
+    my $label_len  = length $line->label;
+    $max_label_len = $label_len if $label_len > $max_label_len;
+  }
+
+  # Output string
+  my $out = '';
+
+  # Append each line of the config file to the output string
+  for my $line (@{ $self->lines }) {
+    $out .= $line->print_line ($max_label_len - length ($line->label) + 1);
+    $out .= "\n";
+  }
+
+  if ($out) {
+    my $old_select = select;
+
+    # Open file if necessary
+    if ($file) {
+      # Make sure the host directory exists and is writable
+      my $dirname = dirname $file;
+      if (not -d $dirname) {
+        print 'Make directory: ', $dirname, "\n" if $self->verbose;
+        mkpath $dirname;
+      }
+      croak $dirname, ': cannot write to config file directory, abort'
+        unless -d $dirname and -w $dirname;
+
+      if (-f $file and not $force) {
+        if (-r $file) {
+          # Read old config file to see if content has changed
+          open IN, '<', $file or croak $file, ': cannot open (', $!, '), abort';
+          my $in_lines = '';
+          while (my $line = <IN>) {
+            $in_lines .= $line;
+          }
+          close IN or croak $file, ': cannot close (', $!, '), abort';
+
+          # Return if content is up-to-date
+          if ($in_lines eq $out) {
+            print 'No change in ', lc ($self->type), ' cfg: ', $file, "\n"
+              if $self->verbose > 1 and $self->type;
+            return 1;
+          }
+        }
+
+        # If config file already exists, make sure it is writable
+        if (-w $file) {
+          if ($self->type) {
+            # Existing config file writable, rename it using its time stamp
+            my $mtime = (stat $file)[9];
+            my ($sec, $min, $hour, $mday, $mon, $year) = (gmtime $mtime)[0 .. 5];
+            my $timestamp = sprintf '%4d%2.2d%2.2d_%2.2d%2.2d%2.2d_',
+                            $year + 1900, $mon + 1, $mday, $hour, $min, $sec;
+            my $oldfile   = File::Spec->catfile (
+              $dirname, $timestamp . basename ($file)
+            );
+            rename $file, $oldfile;
+            print 'Rename existing ', lc ($self->type), ' cfg: ',
+                  $oldfile, "\n" if $self->verbose > 1;
+          }
+
+        } else {
+          # Existing config file not writable, throw an error
+          croak $file, ': config file not writable, abort';
+        }
+      }
+
+      # Open file and select file handle
+      open OUT, '>', $file
+        or croak $file, ': cannot open config file (', $!, '), abort';
+      select OUT;
+    }
+
+    # Print output
+    print $out;
+
+    # Close file if necessary
+    if ($file) {
+      select $old_select;
+      close OUT or croak $file, ': cannot close config file (', $!, '), abort';
+
+      if ($self->type and $self->verbose > 1) {
+        print 'Generated ', lc ($self->type), ' cfg: ', $file, "\n";
+
+      } elsif ($self->verbose > 2) {
+        print 'Generated cfg: ', $file, "\n";
+      }
+    }
+
+  } else {
+    # Warn if nothing to print
+    my $warning = 'Empty configuration';
+    $warning   .= ' - nothing written to file: ' . $file if $file;
+    carp $warning if $self->type;
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @lines = $self->_get_cfg_lines ();
+#
+# DESCRIPTION
+#   This internal method reads from a configuration file residing in a
+#   Subversion repository or in the normal file system.
+# ------------------------------------------------------------------------------
+
+sub _get_cfg_lines {
+  my $self  = shift;
+  my @lines = ();
+
+  my $verbose = $self->verbose;
+
+  my ($src) = $self->src();
+  if ($src =~ qr{\A([A-Za-z][\w\+-\.]*):}xms) { # is a URI
+    $src = Fcm::Keyword::expand($src);
+    # Config file resides in a SVN repository
+    # --------------------------------------------------------------------------
+    # Set URL source and version
+    my $rev = 'HEAD';
+
+    # Extract version from source if it exists
+    if ($src =~ s{\@ ([^\@]+) \z}{}xms) {
+      $rev = $1;
+    }
+
+    $src = Fcm::Util::tidy_url($src);
+
+    # Check whether URL is a config file
+    my $rc;
+    my @cmd = (qw/svn cat/, $src . '@' . $rev);
+    @lines = &run_command (
+      \@cmd, METHOD => 'qx', DEVNULL => 1, RC => \$rc, ERROR => 'ignore',
+    );
+
+    # Error in "svn cat" command
+    if ($rc) {
+      # See whether specified config file is a known type
+      my %cfgname = %{ $self->setting ('CFG_NAME') };
+      my $key     = uc $self->type;
+      my $file    = exists $cfgname{$key} ? $cfgname{$key} : '';
+
+      # If config file is a known type, specified URL may be a directory
+      if ($file) {
+        # Check whether a config file with a default name exists in the URL
+        my $path = $src . '/' . $file;
+        my @cmd  = (qw/svn cat/, $path . '@' . $rev);
+
+        @lines = &run_command (
+          \@cmd, METHOD => 'qx', DEVNULL => 1, RC => \$rc, ERROR => 'ignore',
+        );
+
+        # Check whether a config file with a default name exists under the "cfg"
+        # sub-directory of the URL
+        if ($rc) {
+          my $cfgdir = $self->setting (qw/DIR CFG/);
+          $path   = $src . '/' . $cfgdir . '/' . $file;
+          my @cmd = (qw/svn cat/, $path . '@' . $rev);
+
+          @lines  = &run_command (
+            \@cmd, METHOD => 'qx', DEVNULL => 1, RC => \$rc, ERROR => 'ignore',
+          );
+        }
+
+        $src = $path unless $rc;
+      }
+    }
+
+    if ($rc) {
+      # Error in "svn cat"
+      croak 'Unable to locate config file from "', $self->src, '", abort';
+
+    } else {
+      # Print diagnostic, if necessary
+      if ($verbose and $self->type and $self->type =~ /$expand_type/) {
+        print 'Config file (', $self->type, '): ', $src;
+        print '@', $rev if $rev;
+        print "\n";
+      }
+    }
+
+    # Record the actual source location
+    $self->pegrev ($rev);
+    $self->actual_src ($src);
+
+  } else {
+    # Config file resides in the normal file system
+    # --------------------------------------------------------------------------
+    my $src = $self->src;
+
+    if (-d $src) { # Source is a directory
+      croak 'Config file "', $src, '" is a directory, abort' if not $self->type;
+
+      # Get name of the config file by looking at the type
+      my %cfgname = %{ $self->setting ('CFG_NAME') };
+      my $key     = uc $self->type;
+      my $file    = exists $cfgname{$key} ? $cfgname{$key} : '';
+
+      if ($file) {
+        my $cfgdir = $self->setting (qw/DIR CFG/);
+
+        # Check whether a config file with a default name exists in the
+        # specified path, then check whether a config file with a default name
+        # exists under the "cfg" sub-directory of the specified path
+        if (-f File::Spec->catfile ($self->src, $file)) {
+          $src = File::Spec->catfile ($self->src, $file);
+
+        } elsif (-f File::Spec->catfile ($self->src, $cfgdir, $file)) {
+          $src = File::Spec->catfile ($self->src, $cfgdir, $file);
+
+        } else {
+          croak 'Unable to locate config file from "', $self->src, '", abort';
+        }
+
+      } else {
+        croak 'Unknown config file type "', $self->type, '", abort';
+      }
+    }
+
+    if (-r $src) {
+      open FILE, '<', $src;
+      print 'Config file (', $self->type, '): ', $src, "\n"
+        if $verbose and $self->type and $self->type =~ /$expand_type/;
+
+      @lines = readline 'FILE';
+      close FILE;
+
+    } else {
+      croak 'Unable to read config file "', $src, '", abort';
+    }
+
+    # Record the actual source location
+    $self->actual_src ($src);
+  }
+
+  return @lines;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $self->_expand_variable ($string, $env[, \%recursive]);
+#
+# DESCRIPTION
+#   This internal method expands variables in $string. If $env is true, it
+#   expands environment variables. Otherwise, it expands local variables. If
+#   %recursive is set, it indicates that this method is being called
+#   recursively. In which case, it must not attempt to expand a variable that
+#   exists in the keys of %recursive.
+# ------------------------------------------------------------------------------
+
+sub _expand_variable {
+  my ($self, $string, $env, $recursive) = @_;
+
+  # Pattern for environment/local variable
+  my @patterns = $env
+    ? (qr#\$([A-Z][A-Z0-9_]+)#, qr#\$\{([A-Z][A-Z0-9_]+)\}#)
+    : (qr#%(\w+(?:::[\w\.-]+)*)#, qr#%\{(\w+(?:(?:::|/)[\w\.-]+)*)\}#);
+
+  my $ret = '';
+  my $warning = undef;
+  while ($string) {
+    # Find the first match in $string
+    my ($prematch, $match, $postmatch, $var_label);
+    for my $pattern (@patterns) {
+      next unless $string =~ /$pattern/;
+      if ((not defined $prematch) or length ($`) < length ($prematch)) {
+        $prematch = $`;
+        $match = $&;
+        $var_label = $1;
+        $postmatch = $';
+      }
+    }
+
+    if ($match) {
+      $ret .= $prematch;
+      $string = $postmatch;
+
+      # Get variable value from environment or local configuration
+      my $variable = $env
+                     ? (exists $ENV{$var_label} ? $ENV{$var_label} : undef)
+                     : $self->config->variable ($var_label);
+
+      if ($env and $var_label eq 'HERE' and not defined $variable) {
+        $variable = dirname ($self->actual_src);
+        $variable = File::Spec->rel2abs ($variable) if not &is_url ($variable);
+      }
+
+      # Substitute match with value of variable
+      if (defined $variable) {
+        my $cyclic = 0;
+        if ($recursive) {
+          if (exists $recursive->{$var_label}) {
+            $cyclic = 1;
+
+          } else {
+            $recursive->{$var_label} = 1;
+          }
+
+        } else {
+          $recursive = {$var_label => 1};
+        }
+
+        if ($cyclic) {
+          $warning .= ', ' if $warning;
+          $warning .= $match . ': cyclic dependency, variable not expanded';
+          $ret .= $variable;
+
+        } else {
+          my ($r, $w) = $self->_expand_variable ($variable, $env, $recursive);
+          $ret .= $r;
+          if ($w) {
+            $warning .= ', ' if $warning;
+            $warning .= $w;
+          }
+        }
+
+      } else {
+        $warning .= ', ' if $warning;
+        $warning .= $match . ': variable not expanded';
+        $ret .= $match;
+      }
+
+    } else {
+      $ret .= $string;
+      $string = "";
+    }
+  }
+
+  return ($ret, $warning);
+}
+
+1;
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CfgLine.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CfgLine.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CfgLine.pm	(revision 2528)
@@ -0,0 +1,333 @@
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::CfgLine
+#
+# DESCRIPTION
+#   This class is used for grouping the settings in each line of a FCM
+#   configuration file.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::CfgLine;
+@ISA = qw(Fcm::Base);
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+use File::Basename;
+
+# In-house modules
+use Fcm::Base;
+use Fcm::Config;
+use Fcm::Util;
+
+# List of property methods for this class
+my @scalar_properties = (
+  'bvalue',  # line value, in boolean
+  'comment', # (in)line comment
+  'error',   # error message for incorrect usage while parsing the line
+  'label',   # line label
+  'line',    # content of the line
+  'number',  # line number in source file
+  'parsed',  # has this line been parsed (by the extract/build system)?
+  'prefix',  # optional prefix for line label
+  'slabel',  # label without the optional prefix
+  'src',     # name of source file
+  'value',   # line value
+  'warning', # warning message for deprecated usage
+);
+
+# Useful variables
+our $COMMENT_RULER = '-' x 78;
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @cfglines = Fcm::CfgLine->comment_block (@comment);
+#
+# DESCRIPTION
+#   This method returns a list of Fcm::CfgLine objects representing a comment
+#   block with the comment string @comment.
+# ------------------------------------------------------------------------------
+
+sub comment_block {
+  my @return = (
+    Fcm::CfgLine->new (comment => $COMMENT_RULER),
+    (map {Fcm::CfgLine->new (comment => $_)} @_),
+    Fcm::CfgLine->new (comment => $COMMENT_RULER),
+    Fcm::CfgLine->new (),
+  );
+
+  return @return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = Fcm::CfgLine->new (%args);
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::CfgLine class. See above
+#   for allowed list of properties. (KEYS should be in uppercase.)
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = Fcm::Base->new (%args);
+
+  for (@scalar_properties) {
+    $self->{$_} = exists $args{uc ($_)} ? $args{uc ($_)} : undef;
+    $self->{$_} = $args{$_} if exists $args{$_};
+  }
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @scalar_properties.
+# ------------------------------------------------------------------------------
+
+for my $name (@scalar_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    if (@_) {
+      $self->{$name} = $_[0];
+
+      if ($name eq 'line' or $name eq 'label') {
+        $self->{slabel} = undef;
+
+      } elsif ($name eq 'line' or $name eq 'value') {
+        $self->{bvalue} = undef;
+      }
+    }
+
+    # Default value for property
+    if (not defined $self->{$name}) {
+      if ($name =~ /^(?:comment|error|label|line|prefix|src|value)$/) {
+        # Blank
+        $self->{$name} = '';
+
+      } elsif ($name eq 'slabel') {
+        if ($self->prefix and $self->label_starts_with ($self->prefix)) {
+          $self->{$name} = $self->label_from_field (1);
+
+        } else {
+          $self->{$name} = $self->label;
+        }
+
+      } elsif ($name eq 'bvalue') {
+        if (defined ($self->value)) {
+          $self->{$name} = ($self->value =~ /^(\s*|false|no|off|0*)$/i)
+                           ? 0 : $self->value;
+        }
+      }
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @fields = $obj->label_fields ();
+#   @fields = $obj->slabel_fields ();
+#
+# DESCRIPTION
+#   These method returns a list of fields in the (s)label.
+# ------------------------------------------------------------------------------
+
+for my $name (qw/label slabel/) {
+  no strict 'refs';
+
+  my $sub_name = $name . '_fields';
+  *$sub_name = sub  {
+    return (split (/$Fcm::Config::DELIMITER_PATTERN/, $_[0]->$name));
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $obj->label_from_field ($index);
+#   $string = $obj->slabel_from_field ($index);
+#
+# DESCRIPTION
+#   These method returns the (s)label from field $index onwards.
+# ------------------------------------------------------------------------------
+
+for my $name (qw/label slabel/) {
+  no strict 'refs';
+
+  my $sub_name = $name . '_from_field';
+  *$sub_name = sub  {
+    my ($self, $index) = @_;
+    my $method = $name . '_fields';
+    my @fields = $self->$method;
+    return join ($Fcm::Config::DELIMITER, @fields[$index .. $#fields]);
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $obj->label_starts_with (@fields);
+#   $flag = $obj->slabel_starts_with (@fields);
+#
+# DESCRIPTION
+#   These method returns a true if (s)label starts with the labels in @fields
+#   (ignore case).
+# ------------------------------------------------------------------------------
+
+for my $name (qw/label slabel/) {
+  no strict 'refs';
+
+  my $sub_name = $name . '_starts_with';
+  *$sub_name = sub  {
+    my ($self, @fields) = @_;
+    my $return = 1;
+
+    my $method = $name . '_fields';
+    my @all_fields = $self->$method;
+
+    for my $i (0 .. $#fields) {
+      next if lc ($fields[$i]) eq lc ($all_fields[$i]);
+      $return = 0;
+      last;
+    }
+
+    return $return;
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $obj->label_starts_with_cfg (@fields);
+#   $flag = $obj->slabel_starts_with_cfg (@fields);
+#
+# DESCRIPTION
+#   These method returns a true if (s)label starts with the configuration file
+#   labels in @fields (ignore case).
+# ------------------------------------------------------------------------------
+
+for my $name (qw/label slabel/) {
+  no strict 'refs';
+
+  my $sub_name = $name . '_starts_with_cfg';
+  *$sub_name = sub  {
+    my ($self, @fields) = @_;
+
+    for my $field (@fields) {
+      $field = $self->cfglabel ($field);
+    }
+
+    my $method = $name . '_starts_with';
+    return $self->$method (@fields);
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $mesg = $obj->format_error ();
+#
+# DESCRIPTION
+#   This method returns a string containing a formatted error message for
+#   anything reported to the current line.
+# ------------------------------------------------------------------------------
+
+sub format_error {
+  my ($self) = @_;
+  my $mesg = '';
+
+  $mesg .= $self->format_warning;
+
+  if ($self->error or not $self->parsed) {
+    $mesg = 'ERROR: ' . $self->src . ': LINE ' . $self->number . ':' . "\n";
+    if ($self->error) {
+      $mesg .= '       ' . $self->error;
+
+    } else {
+      $mesg .= '       ' . $self->label . ': label not recognised.';
+    }
+  }
+
+  return $mesg;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $mesg = $obj->format_warning ();
+#
+# DESCRIPTION
+#   This method returns a string containing a formatted warning message for
+#   any warning reported to the current line.
+# ------------------------------------------------------------------------------
+
+sub format_warning {
+  my ($self) = @_;
+  my $mesg = '';
+
+  if ($self->warning) {
+    $mesg = 'WARNING: ' . $self->src . ': LINE ' . $self->number . ':' . "\n";
+    $mesg .= '         ' . $self->warning;
+  }
+
+  return $mesg;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $line = $obj->print_line ([$space]);
+#
+# DESCRIPTION
+#   This method returns a configuration line using $self->label, $self->value
+#   and $self->comment. The value in $self->line is re-set. If $space is set
+#   and is a positive integer, it sets the spacing between the label and the
+#   value in the line. The default is 1.
+# ------------------------------------------------------------------------------
+
+sub print_line {
+  my ($self, $space) = @_;
+
+  # Set space between label and value, default to 1 character
+  $space = 1 unless $space and $space =~ /^[1-9]\d*$/;
+
+  my $line = '';
+
+  # Add label and value, if label is set
+  if ($self->label) {
+    $line .= $self->label . ' ' x $space;
+    $line .= $self->value if defined $self->value;
+  }
+
+  # Add comment if necessary
+  my $comment = $self->comment;
+  $comment =~ s/^\s*//;
+
+  if ($comment) {
+    $comment = '# ' . $comment if $comment !~ /^#/;
+    $line .= ' ' if $line;
+    $line .= $comment;
+  }
+
+  return $self->line ($line);
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Cm.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Cm.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Cm.pm	(revision 2528)
@@ -0,0 +1,2721 @@
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::Cm
+#
+# DESCRIPTION
+#   This module contains the FCM code management functionalities and wrappers
+#   to Subversion commands.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::Cm;
+use base qw{Exporter};
+
+our @EXPORT_OK = qw(cli cm_check_missing cm_check_unknown cm_switch cm_update);
+
+use Cwd            qw{cwd};
+use Getopt::Long   qw{GetOptions :config bundling};
+use Fcm::CLI::Exception;
+use Fcm::Config;
+use Fcm::CmBranch;
+use Fcm::CmUrl;
+use Fcm::Keyword;
+use Fcm::Util      qw{
+    get_url_of_wc
+    get_url_peg_of_wc
+    get_wct
+    is_url
+    is_wc
+    run_command
+    tidy_url
+};
+use File::Basename qw{basename dirname};
+use File::Path     qw{mkpath rmtree};
+use File::Spec;
+use File::Temp     qw{tempfile};
+use Pod::Usage     qw{pod2usage};
+
+# ------------------------------------------------------------------------------
+
+# CLI message handler
+our $CLI_MESSAGE = \&_cli_message;
+
+# List of CLI messages
+our %CLI_MESSAGE_FOR = (
+    q{}         => "%s",
+    BRANCH_LIST => "%s at %s: %d branch(es) found for %s.\n",
+    CHDIR_WCT   => "%s: working directory changed to top of working copy.\n",
+    CF          => "Conflicts in: %s\n",
+    MERGE       => "Performing merge ...\n",
+    MERGE_CF    => "About to merge in changes from %s compared with %s\n",
+    MERGE_CI    => "The following is added to the commit message file:\n%s",
+    MERGE_DRY   => "This merge will result in the following change:\n",
+    MERGE_REVS  => "Merge(s) available from %s: %s\n",
+    OUT_DIR     => "Output directory: %s\n",
+    PATCH_DONE  => "%s: patch generated.\n",
+    PATCH_REV   => "Patch created for changeset %s\n",
+    SEPARATOR   => q{-} x 80 . "\n",
+    STATUS      => "Status of the target working copy(ies):\n%s",
+);
+
+# CLI abort and error messages
+our %CLI_MESSAGE_FOR_ABORT = (
+    FAIL => "%s: command failed.\n",
+    NULL => "%s: command will result in no change.\n",
+    USER => "%s: abort by user.\n",
+);
+
+# CLI abort and error messages
+our %CLI_MESSAGE_FOR_ERROR = (
+    CHDIR               => "%s: cannot change to directory.\n",
+    CLI                 => "%s",
+    CLI_HELP            => "Type 'fcm help %s' for usage.\n",
+    CLI_MERGE_ARG1      => "Arg 1 must be the source in auto/custom mode.\n",
+    CLI_MERGE_ARG2      => "Arg 2 must be the source in custom mode"
+                           . " if --revision not set.\n",
+    CLI_OPT_ARG         => "--%s: invalid argument [%s].\n",
+    CLI_OPT_WITH_OPT    => "--%s: must be specified with --%s.\n",
+    CLI_USAGE           => "incorrect usage",
+    DIFF_PROJECTS       => "%s (target) and %s (source) are not related.\n",
+    INVALID_BRANCH      => "%s: not a valid URL of a standard FCM branch.\n",
+    INVALID_PROJECT     => "%s: not a valid URL of a standard FCM project.\n",
+    INVALID_TARGET      => "%s: not a valid working copy or URL.\n",
+    INVALID_URL         => "%s: not a valid URL.\n",
+    INVALID_WC          => "%s: not a valid working copy.\n",
+    MERGE_REV_INVALID   => "%s: not a revision in the available merge list.\n",
+    MERGE_SELF          => "%s: cannot be merged to its own working copy: %s.\n",
+    MERGE_UNRELATED     => "%s: target and %s: source not directly related.\n",
+    MERGE_UNSAFE        => "%s: source contains changes outside the target"
+                           . " sub-directory. Please merge with a full tree.\n",
+    MKPATH              => "%s: cannot create directory.\n",
+    NOT_EXIST           => "%s: does not exist.\n",
+    PARENT_NOT_EXIST    => "%s: parent %s no longer exists.\n",
+    RMTREE              => "%s: cannot remove.\n",
+    ST_CONFLICT         => "File(s) in conflicts:\n%s",
+    ST_MISSING          => "File(s) missing:\n%s",
+    ST_OUT_OF_DATE      => "File(s) out of date:\n%s",
+    SWITCH_UNSAFE       => "%s: merge template exists."
+                           . " Please remove before retrying.\n",
+    WC_EXIST            => "%s: working copy already exists.\n",
+    WC_INVALID_BRANCH   => "%s: not a working copy of a standard FCM branch.\n",
+    WC_URL_NOT_EXIST    => "%s: working copy URL does not exists at HEAD.\n",
+);
+
+# List of CLI prompt messages
+our %CLI_MESSAGE_FOR_PROMPT = (
+    CF_OVERWRITE      => qq{%s: existing changes will be overwritten.\n}
+                         . qq{ Do you wish to continue?},
+    CI                => qq{Would you like to commit this change?},
+    CI_BRANCH_SHARED  => qq{\n}
+                         . qq{*** WARNING: YOU ARE COMMITTING TO A %s BRANCH.\n}
+                         . qq{*** Please ensure that you have the}
+                         . qq{ owner's permission.\n\n}
+                         . qq{Would you like to commit this change?},
+    CI_BRANCH_USER    => qq{\n}
+                         . qq{*** WARNING: YOU ARE COMMITTING TO A BRANCH}
+                         . qq{ NOT OWNED BY YOU.\n}
+                         . qq{*** Please ensure that you have the}
+                         . qq{ owner's permission.\n\n}
+                         . qq{Would you like to commit this change?},
+    CI_TRUNK          => qq{\n}
+                         . qq{*** WARNING: YOU ARE COMMITTING TO THE TRUNK.\n}
+                         . qq{*** Please ensure that your change conforms to}
+                         . qq{ your project's working practices.\n\n}
+                         . qq{Would you like to commit this change?},
+    CONTINUE          => qq{Are you sure you want to continue?},
+    MERGE             => qq{Would you like to go ahead with the merge?},
+    MERGE_REV         => qq{Please enter the revision you wish to merge from},
+    MKPATCH_OVERWRITE => qq{%s: output location exists. OK to overwrite?},
+    RUN_SVN_COMMAND   => qq{Would you like to run "svn %s"?},
+);
+
+# List of CLI warning messages
+our %CLI_MESSAGE_FOR_WARNING = (
+    BRANCH_SUBDIR   => "%s: is a sub-directory of a branch in a FCM project.\n",
+    CF_BINARY       => "%s: ignoring binary file, please resolve manually.\n",
+    INVALID_BRANCH  => $CLI_MESSAGE_FOR_ERROR{INVALID_BRANCH},
+    ST_IN_TRAC_DIFF => "%s: local changes cannot be displayed in Trac.\n"
+);
+
+# CLI prompt handler and title prefix
+our $CLI_PROMPT = \&_cli_prompt;
+our $CLI_PROMPT_PREFIX = q{fcm };
+
+# List of exception handlers [$class, CODE->($function, $e)]
+our @CLI_EXCEPTION_HANDLERS = (
+    ['Fcm::CLI::Exception', \&_cli_e_handler_of_cli_exception],
+    ['Fcm::Cm::Exception' , \&_cli_e_handler_of_cm_exception],
+    ['Fcm::Cm::Abort'     , \&_cli_e_handler_of_cm_abort],
+);
+
+# Event handlers
+our %CLI_HANDLER_OF = (
+    'WC_STATUS'      => \&_cli_handler_of_wc_status,
+    'WC_STATUS_PATH' => \&_cli_handler_of_wc_status_path,
+);
+
+# Handlers of sub-commands
+our %CLI_IMPL_OF = (
+    'add'       => \&_cli_command_add,
+    'branch'    => \&cm_branch,
+    'commit'    => \&cm_commit,
+    'conflicts' => \&cm_conflicts,
+    'checkout'  => \&_cli_command_checkout,
+    'delete'    => \&_cli_command_delete,
+    'diff'      => \&cm_diff,
+    'merge'     => \&cm_merge,
+    'mkpatch'   => \&cm_mkpatch,
+    'switch'    => \&_cli_command_switch,
+    'update'    => \&_cli_command_update,
+);
+
+# List of overridden subcommands that need to display "svn help"
+our %CLI_MORE_HELP_FOR = map {($_, 1)} qw{add diff delete switch update};
+
+# The preferred name of subcommand aliases
+our %CLI_PREFERRED_NAME_OF = (
+    'ann'      => 'blame',
+    'annotate' => 'blame',
+    'br'       => 'branch',
+    'ci'       => 'commit',
+    'cf'       => 'conflicts',
+    'co'       => 'checkout',
+    'cp'       => 'copy',
+    'del'      => 'delete',
+    'di'       => 'diff',
+    'ls'       => 'list',
+    'mv'       => 'move',
+    'pd'       => 'propdel',
+    'pdel'     => 'propdel',
+    'pe'       => 'propedit',
+    'pedit'    => 'propedit',
+    'pg'       => 'propget',
+    'pget'     => 'propget',
+    'pl'       => 'proplist',
+    'plist'    => 'proplist',
+    'praise'   => 'blame',
+    'ps'       => 'propset',
+    'pset'     => 'propset',
+    'remove'   => 'delete',
+    'ren'      => 'move',
+    'rename'   => 'move',
+    'rm'       => 'delete',
+    'sw'       => 'switch',
+    'up'       => 'update',
+);
+
+# List of subcommands that accept URL inputs
+our %CLI_SUBCOMMAND_URL = map {($_, 1)} qw{
+    blame
+    branch
+    cat
+    checkout
+    copy
+    delete
+    diff
+    export
+    import
+    info
+    list
+    lock
+    log
+    merge
+    mkdir
+    mkpatch
+    move
+    propdel
+    propedit
+    propget
+    proplist
+    propset
+    switch
+    unlock
+};
+
+# List of subcommands that accept revision inputs
+our %CLI_SUBCOMMAND_REV = map {($_, 1)} qw{
+    blame
+    branch
+    cat
+    checkout
+    copy
+    diff
+    export
+    info
+    list
+    log
+    merge
+    mkpatch
+    move
+    propdel
+    propedit
+    propget
+    proplist
+    propset
+    switch
+};
+
+# Common patterns
+our %PATTERN_OF = (
+    # A CLI option
+    CLI_OPT => qr{
+        \A            (?# beginning)
+        (--\w[\w-]*=) (?# capture 1, a long option label)
+        (.*)          (?# capture 2, the value of the option)
+        \z            (?# end)
+    }xms,
+    # A CLI revision option
+    CLI_OPT_REV => qr{
+        \A                      (?# beginning)
+        (--revision(?:=|\z)|-r) (?# capture 1, --revision, --revision= or -r)
+        (.*)                    (?# capture 2, trailing value)
+        \z                      (?# end)
+    }xms,
+    # A CLI revision option range
+    CLI_OPT_REV_RANGE => qr{
+        \A                  (?# beginning)
+        (                   (?# capture 1, begin)
+            (?:\{[^\}]+\}+) (?# a date in curly braces)
+            |               (?# or)
+            [^:]+           (?# anything but a colon)
+        )                   (?# capture 1, end)
+        (?::(.*))?          (?# colon, and capture 2 til the end)
+        \z                  (?# end)
+    }xms,
+    # A FCM branch path look-alike, should be configurable in the future
+    FCM_BRANCH_PATH => qr{
+        \A                            (?# beginning)
+        /*                            (?# some slashes)
+        (?:                           (?# group 1, begin)
+            (?:trunk/*(?:@\d+)?\z)    (?# trunk at a revision)
+            |                         (?# or)
+            (?:trunk|branches|tags)/+ (?# trunk, branch or tags)
+        )                             (?# group 1, end)
+    }xms,
+    # Last line of output from "svn status -u"
+    ST_AGAINST_REV => qr{
+        \A                           (?# beginning)
+        Status\sagainst\srevision:.* (?# output of svn status -u)
+        \z                           (?# end)
+    }xms,
+    # Extract path from "svn status"
+    ST_PATH => qr{
+        \A   (?# beginning)
+        .{6} (?# 6 columns)
+        \s+  (?# spaces)
+        (.+) (?# capture 1, target path)
+        \z   (?# end)
+    }xms,
+    # A legitimate "svn" revision
+    SVN_REV => qr{
+        \A                                      (?# beginning)
+        (?:\d+|HEAD|BASE|COMMITTED|PREV|\{.+\}) (?# digit, reserved words, date)
+        \z                                      (?# end)
+    }ixms,
+);
+
+# Status matchers
+our %ST_MATCHER_FOR = (
+    MISSING     => sub {substr($_[0], 0, 1) eq '!'},
+    MODIFIED    => sub {substr($_[0], 0, 6) =~ qr{\S}xms},
+    OUT_OF_DATE => sub {substr($_[0], 7, 1) eq '*'},
+    UNKNOWN     => sub {substr($_[0], 0, 1) eq '?'},
+);
+
+# ------------------------------------------------------------------------------
+# Entry function for the FCM code management CLI. Calls the relevant FCM code
+# management function or SVN command based on $function.
+sub cli {
+    my ($function, @args) = @_;
+    if (exists($CLI_PREFERRED_NAME_OF{$function})) {
+        $function = $CLI_PREFERRED_NAME_OF{$function};
+    }
+    if (grep {$_ eq '-h' || $_ eq '--help'} @args) {
+        return _cli_help($function, 'NOEXIT');
+    }
+    if (exists($CLI_SUBCOMMAND_URL{$function})) {
+        _cli_keyword_expand_url(\@args);
+    }
+    if (exists($CLI_SUBCOMMAND_REV{$function})) {
+        _cli_keyword_expand_rev(\@args);
+    }
+    if (exists($CLI_IMPL_OF{$function})) {
+        eval {
+            local(@ARGV) = @args;
+            return $CLI_IMPL_OF{$function}->(@args);
+        };
+        if ($@) {
+            my $e = $@;
+            for (@CLI_EXCEPTION_HANDLERS) {
+                my ($class, $handler) = @{$_};
+                if ($class->caught($e)) {
+                    return $handler->($function, $e);
+                }
+            }
+            die($e);
+        }
+    }
+    else {
+        return _svn($function, @args);
+    }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &Fcm::Cm::cm_branch ();
+#
+# DESCRIPTION
+#   This is a FCM command to check information, create or delete a branch in
+#   a Subversion repository.
+# ------------------------------------------------------------------------------
+
+sub cm_branch {
+  # Process command line options
+  # ----------------------------------------------------------------------------
+  my (
+    $info,
+    $delete,
+    $create,
+    $list,
+    $branch_of_branch,
+    $name,
+    $non_interactive,
+    $password,
+    $rev,
+    $rev_flag,
+    $show_all,
+    $show_children,
+    $show_other,
+    $show_siblings,
+    $svn_non_interactive,
+    @tickets,
+    $type,
+    @userlist,
+    $verbose,
+  );
+  my $rc = GetOptions(
+    'info|i'              => \$info,
+    'delete|d'            => \$delete,
+    'create|c'            => \$create,
+    'list|l'              => \$list,
+    'branch-of-branch'    => \$branch_of_branch,
+    'name|n=s'            => \$name,
+    'non-interactive'     => \$non_interactive,
+    'password=s'          => \$password,
+    'revision|r=s'        => \$rev,
+    'rev-flag=s'          => \$rev_flag,
+    'show-all|a'          => \$show_all,
+    'show-children'       => \$show_children,
+    'show-other'          => \$show_other,
+    'show-siblings'       => \$show_siblings,
+    'svn-non-interactive' => \$svn_non_interactive,
+    'ticket|k=s'          => \@tickets,
+    'type|t=s'            => \$type,
+    'user|u=s'            => \@userlist,
+    'verbose|v'           => \$verbose,
+  );
+  if (!$rc) {
+    _cli_err();
+  }
+
+  my $num_options = 0;
+  $num_options++ if defined $info;
+  $num_options++ if defined $delete;
+  $num_options++ if defined $create;
+  $num_options++ if defined $list;
+  if ($num_options > 1) {
+    _cli_err();
+  }
+
+  # Get URL of repository or branch
+  # ----------------------------------------------------------------------------
+  my $url;
+  if ($ARGV[0]) {
+    $url = Fcm::CmUrl->new (URL => $ARGV[0]);
+
+    if (not $url->is_url) {
+      # An argument is specified and is not a URL
+      # Assume that it is a path with a working copy
+      if (&is_wc ($ARGV[0])) {
+        $url = Fcm::CmUrl->new (URL => &get_url_of_wc ($ARGV[0]));
+
+      } else {
+        return _cm_err(Fcm::Cm::Exception->INVALID_WC, $ARGV[0]);
+      }
+    }
+
+  } else {
+    # An argument is not specified
+    # Assume that the current directory is a working copy
+    if (&is_wc ()) {
+      $url = Fcm::CmUrl->new (URL => &get_url_of_wc ());
+
+    } else {
+      return _cm_err(Fcm::Cm::Exception->INVALID_TARGET, '.');
+    }
+  }
+
+  # Ensure $url->url_peg is a URL of a standard FCM project
+  if (!$url->project_url()) {
+    return _cm_err(Fcm::Cm::Exception->INVALID_PROJECT, $url->url_peg());
+  }
+
+  if ($create) {
+    # The --create option is specified, create a branch
+    # --------------------------------------------------------------------------
+
+    # Check branch type flags
+    if ($type) {
+      $type = uc ($type);
+
+      if ($type =~ /^(USER|SHARE)$/) {
+        $type = 'DEV' . $Fcm::Config::DELIMITER . $1;
+
+      } elsif ($type =~ /^(CONFIG|REL)$/) {
+        $type = 'PKG' . $Fcm::Config::DELIMITER . $1;
+
+      } elsif ($type =~ /^(DEV|TEST|PKG)$/) {
+        $type = $1 . $Fcm::Config::DELIMITER . 'USER';
+
+      } elsif ($type !~ /^(?:DEV|TEST|PKG)$Fcm::Config::DELIMITER(?:USER|SHARE)$/
+               and $type !~ /^PKG$Fcm::Config::DELIMITER(?:CONFIG|REL)/) {
+        _cli_err('CLI_OPT_ARG', 'type', $type);
+      }
+
+    } else {
+      $type = 'DEV' . $Fcm::Config::DELIMITER . 'USER';
+    }
+
+    # Check branch name
+    if (!$name) {
+      _cli_err('CLI_OPT_WITH_OPT', 'name', 'create');
+    }
+
+    if ($name !~ qr{\A[\w.-]+\z}xms) {
+      _cli_err('CLI_OPT_ARG', 'name', $name);
+    }
+
+    # Check revision flag is valid
+    if ($rev_flag) {
+      $rev_flag = uc ($rev_flag);
+      if ($rev_flag !~ qr{\A (?:NORMAL|NUMBER|NONE) \z}xms) {
+        _cli_err('CLI_OPT_ARG', 'rev-flag', $rev_flag);
+      }
+
+    } else {
+      $rev_flag = 'NORMAL';
+    }
+
+    # Handle multiple tickets
+    @tickets = split (
+      /$Fcm::Config::DELIMITER_LIST/,
+      join ($Fcm::Config::DELIMITER_LIST, @tickets)
+    );
+    s/^#// for (@tickets);
+    @tickets = sort {$a <=> $b} @tickets;
+
+    # Determine whether to create a branch of a branch
+    $url->branch ('trunk') unless $branch_of_branch;
+
+    # Create the branch
+    my $branch = Fcm::CmBranch->new;
+    $branch->create (
+      SRC                 => $url,
+      TYPE                => $type,
+      NAME                => $name,
+      PASSWORD            => $password,
+      REV_FLAG            => $rev_flag,
+      TICKET              => \@tickets,
+      REV                 => $rev,
+      NON_INTERACTIVE     => $non_interactive,
+      SVN_NON_INTERACTIVE => $svn_non_interactive,
+    );
+
+  } elsif ($list) {
+    # The option --list is specified
+    # List branches owned by current or specified users
+    # --------------------------------------------------------------------------
+    # Get URL of the project "branches/" sub-directory
+    $url->subdir ('');
+    $url->branch ('');
+
+    my @branches = $url->branch_list($rev);
+    if (!$show_all) {
+      @userlist = split(qr{:}xms, join(q{:}, @userlist));
+      if (!@userlist) {
+        @userlist = (Fcm::Config->instance()->user_id());
+      }
+      my %filter = map {($_, 1)} @userlist;
+      @branches = grep {
+        $filter{Fcm::CmBranch->new(URL => $_)->branch_owner()}
+      } @branches
+    }
+
+    # Output, number of branches found
+    $CLI_MESSAGE->(
+      'BRANCH_LIST',
+      $url->project_url_peg(),
+      $rev ? "r$rev" : 'HEAD',
+      scalar(@branches),
+      ($show_all ? '[--show-all]' : join(q{, }, sort(@userlist))),
+    );
+
+    if (@branches) {
+      # Output the URL of each branch
+      if (not $verbose) {
+        my $project = $url->project_url;
+        @branches = map {Fcm::Keyword::unexpand($_)} @branches;
+      }
+      @branches = map {$_ . "\n"} sort @branches;
+      $CLI_MESSAGE->(q{}, join(q{}, @branches));
+
+    } else {
+      # No branch found, exit with an error code
+      return;
+    }
+
+  } else {
+    # The option --info or --delete is specified
+    # Report branch information (and/or delete a branch)
+    # --------------------------------------------------------------------------
+    # Set verbose level
+    Fcm::Config->instance()->verbose ($verbose ? 1 : 0);
+
+    # Set up the branch, report any error
+    my $branch = Fcm::CmBranch->new (URL => $url->url_peg);
+    if (!$branch->branch()) {
+      return _cm_err(Fcm::Cm::Exception->INVALID_BRANCH, $branch->url_peg());
+    }
+    if (!$branch->url_exists()) {
+      return _cm_err(Fcm::Cm::Exception->NOT_EXIST, $branch->url_peg());
+    }
+
+    # Remove the sub-directory part of the URL
+    $branch->subdir ('');
+
+    # Report branch info
+    $branch->display_info (
+      SHOW_CHILDREN => ($show_all || $show_children),
+      SHOW_OTHER    => ($show_all || $show_other   ),
+      SHOW_SIBLINGS => ($show_all || $show_siblings),
+    );
+
+    # Delete branch if --delete is specified
+    $branch->del (
+      PASSWORD            => $password,
+      NON_INTERACTIVE     => $non_interactive,
+      SVN_NON_INTERACTIVE => $svn_non_interactive,
+    ) if $delete;
+  }
+
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &Fcm::Cm::cm_commit ();
+#
+# DESCRIPTION
+#   This is a FCM wrapper to the "svn commit" command.
+# ------------------------------------------------------------------------------
+
+sub cm_commit {
+  my ($dry_run, $svn_non_interactive, $password);
+  my $rc = GetOptions(
+    'dry-run'             => \$dry_run,
+    'svn-non-interactive' => \$svn_non_interactive,
+    'password=s'          => \$password,
+  );
+  if (!$rc) {
+    _cli_err();
+  }
+
+  # The remaining argument is the path to a working copy
+  my ($path) = @ARGV;
+
+  if ($path) {
+    if (!-e $path) {
+      return _cm_err(Fcm::Cm::Exception->NOT_EXIST, $path);
+    }
+
+  } else {
+    # No argument specified, use current working directory
+    $path = cwd ();
+  }
+
+  # Make sure we are in a working copy
+  if (!is_wc($path)) {
+    return _cm_err(Fcm::Cm::Exception->INVALID_WC, $path);
+  }
+
+  # Make sure we are at the top level of the working copy
+  # (otherwise we might miss any template commit message)
+  my $dir = &get_wct ($path);
+
+  if ($dir ne cwd ()) {
+    chdir($dir) || return _cm_err(Fcm::Cm::Exception->CHDIR, $dir);
+    $CLI_MESSAGE->('CHDIR_WCT', $dir);
+  }
+
+  # Get update status of working copy
+  # Check working copy files are not in conflict, missing, or out of date
+  my @status = _svn_status_get([], 1);
+  unless (defined $dry_run) {
+    my (@conflict, @missing, @outdate);
+
+    for (@status) {
+      if (/^C/) {
+        push @conflict, $_;
+        next;
+      }
+
+      if (/^!/) {
+        push @missing, $_;
+        next;
+      }
+
+      if (/^.{7}\*/) {
+        push @outdate, $_;
+        next;
+      }
+
+      # Check that all files which have been added have the svn:executable
+      # property set correctly (in case the developer adds a script before they
+      # remember to set the execute bit)
+      next unless /^A.{7} *\d+ +(.*)/;
+      my $file = $1;
+
+      next unless -f $file;
+      my ($command, @arguments)
+        = (-x $file && !-l $file) ? ('propset', '*') : ('propdel');
+      run_command(['svn', $command, qw{-q svn:executable}, @arguments, $file]);
+    }
+
+    # Abort commit if files are in conflict, missing, or out of date
+    if (@conflict or @missing or @outdate) {
+      for (
+        ['ST_CONFLICT'   , \@conflict],
+        ['ST_MISSING'    , \@missing ],
+        ['ST_OUT_OF_DATE', \@outdate ],
+      ) {
+        my ($key, $array_ref) = @{$_};
+        if (@{$array_ref}) {
+          $CLI_MESSAGE->($key, join(q{}, @{$array_ref}));
+        }
+      }
+      return _cm_abort(Fcm::Cm::Abort->FAIL);
+    }
+  }
+
+  # Read in any existing message
+  my $ci_mesg = Fcm::CmCommitMessage->new;
+  $ci_mesg->read_file;
+
+  # Execute "svn status" for a list of changed items
+  @status = grep !/^\?/, _svn_status_get();
+
+  # Abort if there is no change in the working copy
+  if (!@status) {
+    return _cm_abort(Fcm::Cm::Abort->NULL);
+  }
+
+  # Get associated URL of current working copy
+  my $url = Fcm::CmUrl->new (URL => &get_url_of_wc ());
+
+  # Include URL, or project, branch and sub-directory info in @status
+  unshift @status, "\n";
+
+  if ($url->project and $url->branch) {
+    unshift @status, (
+      '[Project: ' . $url->project                           . ']' . "\n",
+      '[Branch : ' . $url->branch                            . ']' . "\n",
+      '[Sub-dir: ' . ($url->subdir ? $url->subdir : '<top>') . ']' . "\n",
+    );
+
+  } else {
+    unshift @status, '[URL: ' . $url->url . ']' . "\n";
+  }
+
+  # Use a temporary file to store the final commit log message
+  $ci_mesg->ignore_mesg (\@status);
+  my $logfile = $ci_mesg->edit_file (TEMP => 1);
+
+  # Check with the user to see if he/she wants to go ahead
+  my $reply = 'n';
+  if (!defined($dry_run)) {
+    # Add extra warning for trunk commit
+    my @prompt_args;
+    my $user = Fcm::Config->instance()->user_id();
+
+    if ($url->is_trunk()) {
+      @prompt_args = ('CI_TRUNK');
+    }
+    elsif ($user && $url->is_branch() && $url->branch_owner() ne $user) {
+      if (exists $Fcm::CmUrl::owner_keywords{$url->branch_owner}) {
+        @prompt_args = (
+          'CI_BRANCH_SHARED',
+          uc($Fcm::CmUrl::owner_keywords{$url->branch_owner()}),
+        );
+      }
+      else {
+        @prompt_args = ('CI_BRANCH_USER');
+      }
+    }
+    else {
+      @prompt_args = ('CI');
+    }
+    $reply = $CLI_PROMPT->('commit', @prompt_args);
+  }
+
+  if ($reply eq 'y') {
+    # Commit the change if user replies "y" for "yes"
+    my @command = (
+      qw/svn commit -F/, $logfile,
+      ($svn_non_interactive  ? '--non-interactive'       : ()),
+      (defined $password     ? ('--password', $password) : ()),
+    );
+    my $rc;
+    &run_command (\@command, RC => \$rc, ERROR => 'warn');
+
+    if ($rc) {
+      # Commit failed
+      # Write temporary commit log content to commit log message file
+      $ci_mesg->write_file;
+
+      # Fail the command
+      return _cm_abort(Fcm::Cm::Abort->FAIL);
+    }
+
+    # Remove commit message file
+    unlink $ci_mesg->file;
+
+    # Update the working copy
+    $CLI_MESSAGE->(q{}, join(q{}, _svn_update()));
+
+  } else {
+    $ci_mesg->write_file;
+    if (!$dry_run) {
+      return _cm_abort();
+    }
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &Fcm::Cm::cm_conflicts ();
+#
+# DESCRIPTION
+#   This is a FCM command for resolving conflicts within working copy using a
+#   graphical merge tool.
+# ------------------------------------------------------------------------------
+
+sub cm_conflicts {
+  # Path to the working copy
+  my $path = $ARGV[0];
+  $path    = cwd () if not $path;
+
+  # Check for any files with conflicts
+  my @status = grep /^C.{4} *(.*)/, &run_command (
+    [qw/svn st/, ($path eq cwd () ? () : $path)], METHOD => 'qx',
+  );
+  my @files  = map {m/^C.{4} *(.*)/; $1} @status;
+
+  # Save current working directory
+  my $topdir = cwd ();
+
+  # Set up environment for graphical merge
+  # Use environment variable if set, otherwise use default setting
+  local(%ENV) = %ENV;
+  $ENV{FCM_GRAPHIC_MERGE}
+    ||= Fcm::Config->instance()->setting (qw/TOOL GRAPHIC_MERGE/);
+
+  FILE:
+  for my $file (@files) {
+    # Print name of file in conflicts
+    $CLI_MESSAGE->('CF', $file);
+
+    # Determine directory and base name of file in conflicts
+    my $base = basename $file;
+    my $dir  = dirname $file;
+
+    # Change to container directory of file in conflicts
+    chdir(File::Spec->catfile($topdir, $dir))
+      || return _cm_err(Fcm::Cm::Exception->CHDIR, $dir);
+
+    # Use "svn info" to determine conflict marker files
+    my @info = &run_command ([qw/svn info/, $base], METHOD => 'qx');
+
+    # Ignore if $base is a binary file
+    if (-B $base) {
+      $CLI_MESSAGE->('CF_BINARY', $base);
+      next FILE;
+    }
+
+    # Get conflicts markers files
+    my ($older, $mine, $yours);
+
+    for (@info) {
+      $older = $1 if (/^Conflict Previous Base File: (.*)/);
+      $mine  = $1 if (/^Conflict Previous Working File: (.*)/);
+      $yours = $1 if (/^Conflict Current Base File: (.*)/);
+    }
+
+    if (-f $base and (stat $base)[9] > (stat $mine)[9] + 1) {
+      # If $base is newer (by more than a second), it may contain saved changes
+      if ($CLI_PROMPT->('conflicts', 'CF_OVERWRITE', $base) ne 'y') {
+        next FILE;
+      }
+    }
+
+    # Launch graphic merge tool
+    my $rc;
+    my $command = [qw/fcm_graphic_merge/, $base, $mine, $older, $yours];
+    # $rc == 0: all conflicts resovled
+    # $rc == 1: some conflicts not resolved
+    # $rc == 2: trouble
+    eval {
+      run_command($command, RC => \$rc);
+    };
+    if ($@) {
+      if (!defined($rc) || $rc > 1) {
+        die($@);
+      }
+    }
+    next FILE if $rc;
+
+    # Prompt user to run "svn resolved" on the file
+    if ($CLI_PROMPT->('conflicts', 'RUN_SVN_COMMAND', 'resolved') eq 'y') {
+      run_command([qw{svn resolved}, $base]);
+    }
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &Fcm::Cm::cm_diff ();
+#
+# DESCRIPTION
+#   This is a wrapper to "svn diff". It adds two extra functionalities. The
+#   first one allows the command to show differences relative to the base of
+#   the branch. The second one allows differences to be displayed via a
+#   graphical tool.
+# ------------------------------------------------------------------------------
+
+sub cm_diff {
+  # Set up environment for graphical diff
+  # Use environment variable if set, otherwise use default setting
+  local(%ENV) = %ENV;
+  $ENV{FCM_GRAPHIC_DIFF}
+    ||= Fcm::Config->instance()->setting(qw/TOOL GRAPHIC_DIFF/);
+
+  # Check for the --branch options
+  # ----------------------------------------------------------------------------
+  my $branch = grep {$_ eq '-b' or $_ eq '--branch'} @ARGV;
+
+  if (not $branch) {
+    # The --branch option not specified, just call "svn diff"
+    # Convert the --graphical to qw/--diff-cmd fcm_graphical_diff/
+    # Convert the --summarise to --summarize
+    @ARGV = map {
+      my @return;
+      if ($_ eq '-g' or $_ eq '--graphical') {
+        @return = (qw/--diff-cmd fcm_graphic_diff/)
+
+      } elsif ($_ eq '--summarise') {
+        @return = ('--summarize');
+
+      } else {
+        @return = ($_);
+      }
+      @return;
+    } @ARGV;
+
+    # Execute the command
+    return _svn('diff', @ARGV);
+  }
+
+  # The --branch option is specified
+  # ----------------------------------------------------------------------------
+
+  # Determine whether the --graphical option is specified,
+  # if so set the appropriate command
+  # ----------------------------------------------------------------------------
+  my ($diff_cmd, $extensions, $graphical, $summarise, $trac, $wiki);
+  my $rc = GetOptions (
+    'b|branch'            => \$branch,
+    'diff-cmd=s'          => \$diff_cmd,
+    'x|extensions=s'      => \$extensions,
+    'g|graphical'         => \$graphical,
+    'summarise|summarize' => \$summarise,
+    't|trac'              => \$trac,
+    'wiki'                => \$wiki,
+  );
+  if (!$rc) {
+    _cli_err();
+  }
+
+  my @diff_cmd = ();
+
+  if ($graphical) {
+    @diff_cmd = (qw/--diff-cmd fcm_graphic_diff/);
+
+  } elsif ($diff_cmd) {
+    @diff_cmd = ('--diff-cmd', $diff_cmd);
+
+    push @diff_cmd, '--extensions', split (/\s+/, $extensions) if $extensions;
+  }
+
+  # The remaining argument should either be a URL or a PATH
+  my ($url_arg, $path_arg);
+
+  if (@ARGV) {
+    my $arg = Fcm::CmUrl->new (URL => $ARGV[0]);
+
+    if ($arg->is_url) {
+      $url_arg = $ARGV[0];
+
+    } else {
+      $path_arg = $ARGV[0];
+    }
+  }
+
+  # Get repository and branch information
+  # ----------------------------------------------------------------------------
+  my ($url, $path);
+  if (defined $url_arg) {
+    # If a URL is specified, get repository and branch information from it
+    $url = Fcm::CmBranch->new (URL => $url_arg);
+
+  } else {
+    # Get repository and branch information from the specified path or the
+    # current directory if it is a working copy
+    $path = $path_arg ? $path_arg : cwd ();
+    if (!is_wc($path)) {
+      return _cm_err(Fcm::Cm::Exception->INVALID_WC, $path);
+    }
+
+    $url  = Fcm::CmBranch->new (URL => &get_url_peg_of_wc ($path));
+  }
+
+  # Check that URL is a standard FCM branch
+  if (!$url->is_branch()) {
+    return _cm_err(Fcm::Cm::Exception->INVALID_BRANCH, $url->url_peg());
+  }
+
+  # Save and remove sub-directory part of the URL
+  my $subdir = $url->subdir ();
+  $url->subdir ('');
+
+  # Check that $url exists
+  if (!$url->url_exists()) {
+    return _cm_err(Fcm::Cm::Exception->INVALID_URL, $url->url_peg());
+  }
+
+  # Compare current branch with its parent
+  # ----------------------------------------------------------------------------
+  my $parent = Fcm::CmBranch->new (URL => $url->parent->url);
+  $parent->pegrev ($url->pegrev) if $url->pegrev;
+
+  if (!$parent->url_exists()) {
+    return _cm_err(
+      Fcm::Cm::Exception->PARENT_NOT_EXIST, $url->url_peg(), $parent->url(),
+    );
+  }
+
+  my $base = $parent->base_of_merge_from ($url);
+
+  # Ensure the correct diff (syntax) is displayed
+  # ----------------------------------------------------------------------------
+  # Reinstate the sub-tree part into the URL
+  $url->subdir ($subdir);
+  $base->subdir ($subdir);
+
+  # Ensure the branch URL has a peg revision
+  $url->pegrev ($url->svninfo (FLAG => 'Last Changed Rev')) if not $url->pegrev;
+
+  if ($trac or $wiki) {
+    # Trac/wiki
+    # --------------------------------------------------------------------------
+    if (!$url_arg && _svn_status_get([$path_arg ? $path_arg : q{.}])) {
+      $CLI_MESSAGE->('ST_IN_TRAC_DIFF', ($path_arg ? $path_arg : q{.}));
+    }
+
+    # Trac wiki syntax
+    my $wiki_syntax = 'diff:' . $base->path_peg . '//' . $url->path_peg;
+
+    if ($wiki) {
+      # Print Trac wiki syntax only
+      $CLI_MESSAGE->(q{}, "$wiki_syntax\n");
+
+    } else { # if $trac
+      # Use Trac to view "diff"
+      my $browser = Fcm::Config->instance()->setting(qw/WEB_BROWSER/);
+      $browser ||= 'firefox';
+
+      my $trac_url = Fcm::Keyword::get_browser_url($url->project_url());
+      $trac_url =~ s{/intertrac/.*$}{/intertrac/$wiki_syntax}xms;
+
+      &run_command ([$browser, $trac_url], METHOD => 'exec', PRINT => 1);
+    }
+
+  } else {
+    # Execute the "diff" command
+    # --------------------------------------------------------------------------
+    my @command = (
+      qw/svn diff/, @diff_cmd,
+      ($summarise ? ('--summarize') : ()),
+      '--old', $base->url_peg,
+      '--new', ($url_arg ? $url->url_peg : ($path_arg ? $path_arg : '.')),
+    );
+    &run_command (\@command, PRINT => 1);
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &Fcm::Cm::cm_merge ();
+#
+# DESCRIPTION
+#   This is a wrapper to "svn merge".
+# ------------------------------------------------------------------------------
+
+sub cm_merge {
+  # Options
+  # ----------------------------------------------------------------------------
+  my ($custom, $dry_run, $non_interactive, $reverse, $rev, $verbose);
+  my $rc = GetOptions(
+    'custom'          => \$custom,
+    'dry-run'         => \$dry_run,
+    'non-interactive' => \$non_interactive,
+    'reverse'         => \$reverse,
+    'revision|r=s'    => \$rev,
+    'verbose|v'       => \$verbose,
+  );
+  if (!$rc) {
+    _cli_err();
+  }
+
+  # Find out the URL of the working copy
+  # ----------------------------------------------------------------------------
+  my ($target, $wct);
+  if (&is_wc ()) {
+    $wct = &get_wct ();
+
+    if ($wct ne cwd ()) {
+      chdir($wct) || return _cm_err(Fcm::Cm::Exception->CHDIR, $wct);
+      $CLI_MESSAGE->('CHDIR_WCT', $wct);
+    }
+
+    $target = Fcm::CmBranch->new (URL => &get_url_of_wc ($wct));
+
+  } else {
+    return _cm_err(Fcm::Cm::Exception->INVALID_WC, '.');
+  }
+
+  if (!$target->url_exists()) {
+    return _cm_err(Fcm::Cm::Exception->WC_URL_NOT_EXIST, '.');
+  }
+
+  # The target must be at the top of a branch
+  # $subdir will be used later to determine whether the merge is allowed or not
+  my $subdir = $target->subdir;
+  $target->subdir ('') if $subdir;
+
+  # Check for any local modifications
+  # ----------------------------------------------------------------------------
+  if (!$dry_run && !$non_interactive) {
+    _svn_status_checker('merge', 'MODIFIED', $CLI_HANDLER_OF{WC_STATUS})->();
+  }
+
+  # Determine the SOURCE URL
+  # ----------------------------------------------------------------------------
+  my $source;
+
+  if ($reverse) {
+    # Reverse merge, the SOURCE is the the working copy URL
+    $source = Fcm::CmBranch->new (URL => $target->url);
+
+  } else {
+    # Automatic/custom merge, argument 1 is the SOURCE of the merge
+    my $source_url = shift (@ARGV);
+    if (!$source_url) {
+      _cli_err('CLI_MERGE_ARG1');
+    }
+
+    $source = _cm_get_source($source_url, $target);
+  }
+
+  # Parse the revision option
+  # ----------------------------------------------------------------------------
+  if ($reverse && !$rev) {
+    _cli_err('CLI_OPT_WITH_OPT', 'revision', 'reverse');
+  }
+  my @revs = (($reverse || $custom) && $rev ? split(qr{:}xms, $rev) : ());
+
+  # Determine the merge delta and the commit log message
+  # ----------------------------------------------------------------------------
+  my (@delta, $mesg);
+  my $separator = '-' x 80 . "\n";
+
+  if ($reverse) {
+    # Reverse merge
+    # --------------------------------------------------------------------------
+    if (@revs == 1) {
+      $revs[1] = ($revs[0] - 1);
+
+    } else {
+      @revs = sort {$b <=> $a} @revs;
+    }
+
+    $source->pegrev ($source->svninfo (FLAG => 'Last Changed Rev'))
+      unless $source->pegrev;
+    $source->subdir ($subdir);
+
+    # "Delta" of the "svn merge" command
+    @delta = ('-r' . $revs[0] . ':' . $revs[1], $source->url_peg);
+
+    # Template message
+    $mesg = 'Reversed r' . $revs[0] .
+            (($revs[1] < $revs[0] - 1) ? ':' . $revs[1] : '') . ' of ' .
+            $source->path . "\n";
+
+  } elsif ($custom) {
+    # Custom merge
+    # --------------------------------------------------------------------------
+    if (@revs) {
+      # Revision specified
+      # ------------------------------------------------------------------------
+      # Only one revision N specified, use (N - 1):N as the delta
+      unshift @revs, ($revs[0] - 1) if @revs == 1;
+
+      $source->pegrev ($source->svninfo (FLAG => 'Last Changed Rev'))
+        unless $source->pegrev;
+      $source->subdir ($subdir);
+      $target->subdir ($subdir);
+
+      # "Delta" of the "svn merge" command
+      @delta = ('-r' . $revs[0] . ':' . $revs[1], $source->url_peg);
+
+      # Template message
+      $mesg = 'Custom merge into ' . $target->path . ': r' . $revs[1] .
+              ' cf. r' . $revs[0] . ' of ' . $source->path_peg . "\n";
+
+    } else {
+      # Revision not specified
+      # ------------------------------------------------------------------------
+      # Get second source URL
+      my $source2_url = shift (@ARGV);
+      if (!$source2_url) {
+        _cli_err('CLI_MERGE_ARG2');
+      }
+
+      my $source2 = _cm_get_source($source2_url, $target);
+
+      $source->pegrev  ($source->svninfo  (FLAG => 'Last Changed Rev'))
+        unless $source->pegrev;
+      $source2->pegrev ($source2->svninfo (FLAG => 'Last Changed Rev'))
+        unless $source2->pegrev;
+      $source->subdir  ($subdir);
+      $source2->subdir ($subdir);
+      $target->subdir  ($subdir);
+
+      # "Delta" of the "svn merge" command
+      @delta = ($source->url_peg, $source2->url_peg);
+
+      # Template message
+      $mesg = 'Custom merge into ' . $target->path . ': ' . $source->path_peg .
+              ' cf. ' . $source2->path_peg . "\n";
+    }
+
+  } else {
+    # Automatic merge
+    # --------------------------------------------------------------------------
+    # Check to ensure source branch is not the same as the target branch
+    if (!$target->branch()) {
+      return _cm_err(Fcm::Cm::Exception->WC_INVALID_BRANCH, $wct);
+    }
+    if ($source->branch() eq $target->branch()) {
+      return _cm_err(Fcm::Cm::Exception->MERGE_SELF, $target->url_peg(), $wct);
+    }
+
+    # Only allow the merge if the source and target are "directly related"
+    # --------------------------------------------------------------------------
+    my $anc = $target->ancestor ($source);
+    return _cm_err(
+      Fcm::Cm::Exception->MERGE_UNRELATED, $target->url_peg(), $source->url_peg
+    ) unless
+      ($anc->url eq $target->url and $anc->url_peg eq $source->parent->url_peg)
+      or
+      ($anc->url eq $source->url and $anc->url_peg eq $target->parent->url_peg)
+      or
+      ($anc->url eq $source->parent->url and $anc->url eq $target->parent->url);
+
+    # Check for available merges from the source
+    # --------------------------------------------------------------------------
+    my @revs = $target->avail_merge_from ($source, 1);
+
+    if (@revs) {
+      if ($verbose) {
+        # Verbose mode, print log messages of available merges
+        $CLI_MESSAGE->('MERGE_REVS', $source->path_peg(), q{});
+        for (@revs) {
+          $CLI_MESSAGE->('SEPARATOR');
+          $CLI_MESSAGE->(q{}, $source->display_svnlog($_));
+        }
+        $CLI_MESSAGE->('SEPARATOR');
+      }
+      else {
+        # Normal mode, list revisions of available merges
+        $CLI_MESSAGE->('MERGE_REVS', $source->path_peg(), join(q{ }, @revs));
+      }
+
+    } else {
+      return _cm_abort(Fcm::Cm::Abort->NULL);
+    }
+
+    # If more than one merge available, prompt user to enter a revision number
+    # to merge from, default to $revs [0]
+    # --------------------------------------------------------------------------
+    if ($non_interactive || @revs == 1) {
+      $source->pegrev($revs[0]);
+    }
+    else {
+      my $reply = $CLI_PROMPT->(
+        {type => q{}, default => $revs[0]}, 'merge', 'MERGE_REV',
+      );
+      if (!defined($reply)) {
+        return _cm_abort();
+      }
+      # Expand revision keyword if necessary
+      if ($reply) {
+        $reply = (Fcm::Keyword::expand($target->project_url(), $reply))[1];
+      }
+      # Check that the reply is a number in the available merges list
+      if (!grep {$_ eq $reply} @revs) {
+        return _cm_err(Fcm::Cm::Exception->MERGE_REV_INVALID, $reply)
+      }
+      $source->pegrev($reply);
+    }
+
+    # If the working copy top is pointing to a sub-directory of a branch,
+    # we need to check whether the merge will result in losing changes made in
+    # other sub-directories of the source.
+    if ($subdir and not $target->allow_subdir_merge_from ($source, $subdir)) {
+      return _cm_err(Fcm::Cm::Exception->MERGE_UNSAFE, $source->url_peg());
+    }
+
+    # Calculate the base of the merge
+    my $base = $target->base_of_merge_from ($source);
+
+    # $source and $base must take into account the sub-directory
+    my $s = Fcm::CmBranch->new (URL => $source->url_peg);
+    my $b = Fcm::CmBranch->new (URL => $base->url_peg);
+
+    $s->subdir ($subdir) if $subdir;
+    $b->subdir ($subdir) if $subdir;
+
+    # Diagnostic
+    $CLI_MESSAGE->('MERGE_CF', $s->path_peg(), $b->path_peg());
+
+    # Delta of the "svn merge" command
+    @delta = ($b->url_peg, $s->url_peg);
+
+    # Template message
+    $mesg = 'Merged into ' . $target->path . ': ' . $source->path_peg .
+            ' cf. ' . $base->path_peg . "\n";
+  }
+
+  # Run "svn merge" in "--dry-run" mode to see the result
+  # ----------------------------------------------------------------------------
+  my @out   = &run_command (
+    [qw/svn merge --dry-run/, @delta],
+    METHOD => 'qx', PRINT => ($dry_run and $verbose),
+  );
+
+  # Abort merge if it will result in no change
+  if (not @out) {
+    return _cm_abort(Fcm::Cm::Abort->NULL);
+  }
+
+  # Report result of "svn merge --dry-run"
+  if ($dry_run || !$non_interactive) {
+    $CLI_MESSAGE->('MERGE_DRY');
+    $CLI_MESSAGE->('SEPARATOR');
+    $CLI_MESSAGE->(q{}, join(q{}, @out));
+    $CLI_MESSAGE->('SEPARATOR');
+  }
+
+  return if $dry_run;
+
+  # Prompt the user to see if (s)he would like to go ahead
+  # ----------------------------------------------------------------------------
+  # Go ahead with merge only if user replies "y"
+  if (!$non_interactive && $CLI_PROMPT->('merge', 'MERGE') ne 'y') {
+    return _cm_abort();
+  }
+  $CLI_MESSAGE->('MERGE');
+  run_command([qw/svn merge/, @delta], PRINT => $verbose);
+
+  # Prepare the commit log
+  # ----------------------------------------------------------------------------
+  # Read in any existing message
+  my $ci_mesg = Fcm::CmCommitMessage->new;
+  $ci_mesg->read_file;
+  $ci_mesg->auto_mesg ([$mesg, @{ $ci_mesg->auto_mesg }]);
+  $ci_mesg->write_file;
+
+  if ($verbose) {
+    $CLI_MESSAGE->('SEPARATOR');
+    $CLI_MESSAGE->('MERGE_CI', $mesg);
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &Fcm::Cm::cm_mkpatch ();
+#
+# DESCRIPTION
+#   This is a FCM command to create a patching script from particular revisions
+#   of a URL.
+# ------------------------------------------------------------------------------
+
+sub cm_mkpatch {
+  # Process command line options and arguments
+  # ----------------------------------------------------------------------------
+  my (@exclude, $organisation, $revision);
+  my $rc = GetOptions(
+    'exclude=s'      => \@exclude,
+    'organisation=s' => \$organisation,
+    'r|revision=s'   => \$revision,
+  );
+  if (!$rc) {
+    _cli_err();
+  }
+
+  # Excluded paths, convert glob into regular patterns
+  @exclude = split (/:/, join (':', @exclude));
+  for (@exclude) {
+    s#\*#[^/]*#; # match any number of non-slash character
+    s#\?#[^/]#;  # match a non-slash character
+    s#/*$##;     # remove trailing slash
+  }
+
+  # Organisation prefix
+  $organisation = $organisation ? $organisation : 'original';
+
+  # Make sure revision option is set correctly
+  my @revs = $revision ? split (/:/, $revision) : ();
+  @revs    = @revs [0, 1] if @revs > 2;
+
+  # Arguments
+  my ($u, $outdir) = @ARGV;
+
+  if (!$u) {
+    _cli_err();
+  }
+
+  my $url = Fcm::CmUrl->new (URL => $u);
+  if (!$url->is_url()) {
+    return _cm_err(Fcm::Cm::Exception->INVALID_URL, $u);
+  }
+  if (!$url->url_exists()) {
+    return _cm_err(Fcm::Cm::Exception->NOT_EXIST, $u);
+  }
+  if (!$url->branch()) {
+    $CLI_MESSAGE->('INVALID_BRANCH', $u);
+  }
+  elsif ($url->subdir()) {
+    $CLI_MESSAGE->('BRANCH_SUBDIR', $u);
+  }
+
+  if (@revs) {
+    # If HEAD revision is given, convert it into a number
+    # --------------------------------------------------------------------------
+    for my $rev (@revs) {
+      $rev = $url->svninfo (FLAG => 'Revision') if uc ($rev) eq 'HEAD';
+    }
+
+  } else {
+    # If no revision is given, use the HEAD
+    # --------------------------------------------------------------------------
+    $revs[0] = $url->svninfo (FLAG => 'Revision');
+  }
+
+  $revs[1] = $revs[0] if @revs == 1;
+
+  # Check that output directory is set
+  # ----------------------------------------------------------------------------
+  $outdir = File::Spec->catfile (cwd (), 'fcm-mkpatch-out') if not $outdir;
+
+  if (-e $outdir) {
+    # Ask user to confirm removal of old output directory if it exists
+    if ($CLI_PROMPT->('mkpatch', 'MKPATCH_OVERWRITE') ne 'y') {
+      return _cm_abort();
+    }
+
+    rmtree($outdir) || return _cm_err(Fcm::Cm::Exception->RMTREE, $outdir);
+  }
+
+  # (Re-)create output directory
+  mkpath($outdir) || return _cm_err(Fcm::Cm::Exception->MKPATH, $outdir);
+  $CLI_MESSAGE->('OUT_DIR', $outdir);
+
+  # Get and process log of URL
+  # ----------------------------------------------------------------------------
+  my @script   = (); # main output script
+  my %log      = $url->svnlog (REV => \@revs);
+  my $url_path = $url->path;
+
+  for my $rev (sort {$a <=> $b} keys %log) {
+    # Look at the changed paths for each revision
+    my $use_patch = 1;  # OK to use a patch file?
+    my @paths;
+    PATH: for my $path (sort keys %{ $log{$rev}{paths} }) {
+      my $file = $path;
+
+      # Skip paths outside of the branch
+      next PATH unless $file =~ s#^$url_path/*##;
+
+      # Skip excluded paths
+      for my $exclude (@exclude) {
+        if ($file =~ m#^$exclude(?:/*|$)#) {
+          # Can't use a patch file if any files have been excluded
+          $use_patch = 0;
+          next PATH;
+        }
+      }
+
+      # Can't use a patch file if any files have been added or replaced
+      $use_patch = 0 if $log{$rev}{paths}{$path}{action} eq 'A' or
+                        $log{$rev}{paths}{$path}{action} eq 'R';
+
+      push @paths, $path;
+    }
+
+    # If a patch is being used, make sure it isn't just property changes
+    if ($use_patch) {
+      my @changedpaths;
+      for my $path (@paths) {
+        (my $file = $path) =~ s#^$url_path/*##;
+        if ($log{$rev}{paths}{$path}{action} eq 'M') {
+          my ($diff) = &run_command (
+                         [qw/svn diff --no-diff-deleted --summarize -c/,
+                          $rev, $url->url . '/' . $file. '@' . $rev],
+                         METHOD => 'qx');
+          next unless $diff =~ /^[A-Z]/;
+        }
+        push @changedpaths, $path;
+      }
+      @paths = @changedpaths;
+    }
+
+    next unless @paths;
+
+    # Create the patch using "svn diff"
+    my @patch = ();
+    if ($use_patch) {
+      @patch = &run_command ([qw/svn diff --no-diff-deleted -c/, $rev,
+                              $url->url], METHOD => 'qx');
+      if (@patch) {
+        # Don't use the patch if it may contain subversion keywords
+        for (@patch) {
+          $use_patch = 0 if /\$[a-zA-Z:]+ *\$/;
+        }
+      } else {
+        $use_patch = 0;
+      }
+    }
+
+    # Create a directory for this revision in the output directory
+    my $outdir_rev = File::Spec->catfile ($outdir, $rev);
+    mkpath($outdir_rev)
+      || return _cm_err(Fcm::Cm::Exception->MKPATH, $outdir_rev);
+
+    # Parse commit log message
+    my @msg = split /\n/, $log{$rev}{msg};
+    for (@msg) {
+      # Re-instate line break
+      $_ .= "\n";
+
+      # Remove line if it matches a merge template
+      $_ = '' if /^Reversed r\d+(?::\d+)? of \S+$/;
+      $_ = '' if /^Custom merge into \S+:.+$/;
+      $_ = '' if /^Merged into \S+: \S+ cf\. \S+$/;
+
+      # Modify Trac ticket link
+      s/(?:#|ticket:)(\d+)/${organisation}_ticket:$1/g;
+
+      # Modify Trac changeset link
+      s/(?:r|changeset:)(\d+)/${organisation}_changeset:$1/g;
+      s/\[(\d+)\]/${organisation}_changeset:$1/g;
+    }
+
+    push @msg, '(' . $organisation . '_changeset:' . $rev . ')' . "\n";
+
+    # Write commit log message in a file
+    my $f_revlog = File::Spec->catfile ($outdir_rev, 'log-message');
+    open FILE, '>', $f_revlog or die $f_revlog, ': cannot open (', $!, ')';
+    print FILE @msg;
+    close FILE or die $f_revlog, ': cannot close (', $!, ')';
+
+    # Handle each changed path
+    my $export_file   = 1;  # name for next exported file (gets incremented)
+    my $patch_needed  = 0;  # is a patch file required?
+    my @before_script = (); # patch script to run before patch applied
+    my @after_script  = (); # patch script to run after patch applied
+    my @copied_dirs   = (); # copied directories
+    CHANGED: for my $path (@paths) {
+      (my $file = $path) =~ s#^$url_path/*##;
+      my $url_file = $url->url . '/' . $file . '@' . $rev;
+
+      # Skip paths within copied directories
+      for my $copied_dir (@copied_dirs) {
+        next CHANGED if $file =~ m#^$copied_dir(?:/*|$)#;
+      }
+
+      if ($log{$rev}{paths}{$path}{action} eq 'D') {
+        # Script to delete file
+        push @after_script, 'svn delete ' . $file;
+
+      } else {
+        my $export_required = 0;
+        my $recursive_add   = 0;
+        my $is_newfile      = 0;
+
+        # Skip property changes
+        if ($log{$rev}{paths}{$path}{action} eq 'M') {
+          my ($diff) = &run_command (
+                         [qw/svn diff --no-diff-deleted --summarize -c/,
+                          $rev, $url->url . '/' . $file. '@' . $rev],
+                         METHOD => 'qx');
+          next CHANGED unless $diff =~ /^[A-Z]/;
+        }
+
+        # Determine if the file is a directory
+        my $is_dir = 0;
+        if ($log{$rev}{paths}{$path}{action} ne 'M') {
+          my @info = &run_command ([qw/svn info/, $url_file], METHOD => 'qx');
+          for (@info) {
+            if (/^Node Kind: (\w+)/) {
+              $is_dir = 1 if $1 eq 'directory';
+              last;
+            }
+          }
+        }
+
+        # Decide how to treat added files
+        if ($log{$rev}{paths}{$path}{action} eq 'A') {
+          # Determine if the file is copied
+          if (exists $log{$rev}{paths}{$path}{'copyfrom-path'}) {
+            if ($is_dir) {
+              # A copied directory needs to be treated as a new file, exported
+              # and added recursively
+              $is_newfile      = 1;
+              $export_required = 1;
+              $recursive_add   = 1;
+              push @copied_dirs, $file;
+            } else {
+              # History exists for this file
+              my $copyfrom_path = $log{$rev}{paths}{$path}{'copyfrom-path'};
+              my $copyfrom_rev  = $log{$rev}{paths}{$path}{'copyfrom-rev'};
+              my $cp_url = Fcm::CmUrl->new (
+                URL => $url->root . $copyfrom_path . '@' . $copyfrom_rev,
+              );
+
+              if ($copyfrom_path =~ s#^$url_path/*##) {
+                # File is copied from a file under the specified URL
+                # Check source exists
+                $is_newfile = 1 unless $cp_url->url_exists ($rev - 1);
+              } else {
+                # File copied from outside of the specified URL
+                $is_newfile = 1;
+
+                # Check branches can be determined
+                if ($url->branch and $cp_url->branch) {
+
+                  # Follow its history, stop on copy
+                  my %cp_log = $cp_url->svnlog (STOP_ON_COPY => 1);
+
+                  # "First" revision of the copied file
+                  my $cp_rev = (sort {$a <=> $b} keys %cp_log) [0];
+                  my %attrib = %{ $cp_log{$cp_rev}{paths}{$cp_url->path} }
+                    if $cp_log{$cp_rev}{paths}{$cp_url->path};
+
+                  # Check whether the "first" revision is copied from elsewhere.
+                  if (exists $attrib{'copyfrom-path'}) {
+                    # If source exists in the specified URL, set up the copy
+                    my $cp_cp_url = Fcm::CmUrl->new (
+                      URL => $url->root . $attrib{'copyfrom-path'} . '@' .
+                             $attrib{'copyfrom-rev'},
+                    );
+                    $cp_cp_url->branch ($url->branch);
+                    if ($cp_cp_url->url_exists ($rev - 1)) {
+                      ($copyfrom_path = $cp_cp_url->path) =~ s#^$url_path/*##;
+                      # Check path is defined - if not it probably means the
+                      # branch doesn't follow the FCM naming convention
+                      $is_newfile = 0 if $copyfrom_path;
+                    }
+                  }
+
+                  # Note: The logic above does not cover all cases. However, it
+                  # should do the right thing for the most common case. Even
+                  # where it gets it wrong the file contents should always be
+                  # correct even if the file history is not.
+                }
+              }
+
+              # Check whether file is copied from an excluded path
+              if (not $is_newfile) {
+                for my $exclude (@exclude) {
+                  if ($copyfrom_path =~ m#^$exclude(?:/*|$)#) {
+                    $is_newfile = 1;
+                    last;
+                  }
+                }
+              }
+
+              # Script to copy file, if required
+              push @before_script, 'svn copy ' . $copyfrom_path .  ' ' . $file
+                if not $is_newfile;
+            }
+
+          } else {
+            # History does not exist, must be a new file
+            $is_newfile = 1;
+            # If it's a directory then create it (in case patch doesn't)
+            push @before_script, 'mkdir ' . $file if $is_dir;
+          }
+        }
+
+        if ($log{$rev}{paths}{$path}{action} eq 'R') {
+          # Script to delete file
+          push @before_script, 'svn delete ' . $file;
+
+          # Now treat as new file
+          $is_newfile = 1;
+        }
+
+        # Script to add the file, if required
+        if ($is_newfile) {
+          if ($recursive_add) {
+            push @after_script, 'svn add ' . $file;
+          } else {
+            push @after_script, 'svn add --non-recursive ' . $file;
+          }
+        }
+
+        # Decide whether the file needs to be exported
+        if (not $is_dir) {
+          if (not $use_patch) {
+            $export_required = 1;
+          } else {
+            # Export the file if it is binary
+            my @mime_type = &run_command
+             ([qw/svn propget svn:mime-type/, $url_file], METHOD => 'qx');
+            for (@mime_type) {
+              $export_required = 1 if not /^text\//;
+            }
+            # Only create a patch file if necessary
+            $patch_needed = 1 if not $export_required;
+          }
+        }
+
+        if ($export_required) {
+          # Download the file using "svn export"
+          my $export = File::Spec->catfile ($outdir_rev, $export_file);
+          &run_command ([qw/svn export -q -r/, $rev, $url_file, $export]);
+
+          # Copy the exported file into the file
+          push @before_script,
+               'cp -r ${fcm_patch_dir}/' . $export_file . ' ' . $file;
+          $export_file++;
+        }
+      }
+    }
+
+    # Write the patch file
+    if ($patch_needed) {
+      my $patchfile = File::Spec->catfile ($outdir_rev, 'patchfile');
+      open FILE, '>', $patchfile
+        or die $patchfile, ': cannot open (', $!, ')';
+      print FILE @patch;
+      close FILE or die $patchfile, ': cannot close (', $!, ')';
+    }
+
+    # Add line break to each line in @before_script and @after_script
+    @before_script = map {($_ ? $_ . ' || exit 1' . "\n" : "\n")}
+                     @before_script if (@before_script);
+    @after_script  = map {($_ ? $_ . ' || exit 1' . "\n" : "\n")}
+                     @after_script if (@after_script);
+
+    # Write patch script to output
+    my $out = File::Spec->catfile ($outdir_rev, 'apply-patch');
+    open FILE, '>', $out or die $out, ': cannot open (', $!, ')';
+
+    # Script header
+    my $shell = Fcm::Config->instance()->setting(qw/TOOL SHELL/);
+    print FILE <<EOF;
+#!$shell
+# ------------------------------------------------------------------------------
+# NAME
+#   apply-patch
+#
+# DESCRIPTION
+#   This script is generated automatically by the "fcm mkpatch" command. It
+#   applies the patch to the current working directory which must be a working
+#   copy of a valid project tree that can accept the import of the patches.
+#
+#   Patch created from $organisation URL: $u
+#   Changeset: $rev
+# ------------------------------------------------------------------------------
+
+this=`basename \$0`
+echo "\$this: Applying patch for changeset $rev."
+
+# Location of the patch, base on the location of this script
+cd `dirname \$0` || exit 1
+fcm_patch_dir=\$PWD
+
+# Change directory back to the working copy
+cd \$OLDPWD || exit 1
+
+# Check working copy does not have local changes
+status=`svn status`
+if [[ -n \$status ]]; then
+  echo "\$this: working copy contains changes, abort." >&2
+  exit 1
+fi
+if [[ -a "#commit_message#" ]]; then
+  echo "\$this: existing commit message in "#commit_message#", abort." >&2
+  exit 1
+fi
+
+# Apply the changes
+EOF
+
+    # Script content
+    print FILE @before_script if @before_script;
+    print FILE "patch -p0 <\${fcm_patch_dir}/patchfile || exit 1\n"
+      if $patch_needed;
+    print FILE @after_script  if @after_script;
+
+    # Script footer
+    print FILE <<EOF;
+
+# Copy in the commit message
+cp \${fcm_patch_dir}/log-message "#commit_message#"
+
+echo "\$this: finished normally."
+#EOF
+EOF
+
+    close FILE or die $out, ': cannot close (', $!, ')';
+
+    # Add executable permission
+    chmod 0755, $out;
+
+    # Script to commit the change
+    push @script, '${fcm_patches_dir}/' . $rev . '/apply-patch';
+    push @script, 'svn commit -F "#commit_message#"';
+    push @script, 'rm -f "#commit_message#"';
+    push @script, 'svn update';
+    push @script, '';
+
+    $CLI_MESSAGE->('PATCH_REV', $rev);
+  }
+
+  # Write the main output script if necessary. Otherwise remove output directory
+  # ----------------------------------------------------------------------------
+  if (@script) {
+    # Add line break to each line in @script
+    @script = map {($_ ? $_ . ' || exit 1' . "\n" : "\n")} @script;
+
+    # Write script to output
+    my $out = File::Spec->catfile ($outdir, 'fcm-import-patch');
+    open FILE, '>', $out or die $out, ': cannot open (', $!, ')';
+
+    # Script header
+    my $shell = Fcm::Config->instance()->setting(qw/TOOL SHELL/);
+    print FILE <<EOF;
+#!$shell
+# ------------------------------------------------------------------------------
+# NAME
+#   fcm-import-patch
+#
+# SYNOPSIS
+#   fcm-import-patch TARGET
+#
+# DESCRIPTION
+#   This script is generated automatically by the "fcm mkpatch" command, as are
+#   the revision "patches" created in the same directory. The script imports the
+#   patches into TARGET, which must either be a URL or a working copy of a valid
+#   project tree that can accept the import of the patches.
+#
+#   Patch created from $organisation URL: $u
+# ------------------------------------------------------------------------------
+
+this=`basename \$0`
+
+# Check argument
+target=\$1
+
+# First argument must be a URL or working copy
+if [[ -z \$target ]]; then
+  echo "\$this: the first argument must be a URL or a working copy, abort." >&2
+  exit 1
+fi
+
+if [[ \$target == svn://*  || \$target == svn+ssh://* || \\
+      \$target == http://* || \$target == https://*   || \\
+      \$target == file://* ]]; then
+  # A URL, checkout a working copy in a temporary location
+  fcm_tmp_dir=`mktemp -d \${TMPDIR:=/tmp}/\$this.XXXXXX`
+  fcm_working_copy=\$fcm_tmp_dir
+  svn checkout -q \$target \$fcm_working_copy || exit 1
+else
+  fcm_working_copy=\$target
+fi
+
+# Location of the patches, base on the location of this script
+cd `dirname \$0` || exit 1
+fcm_patches_dir=\$PWD
+
+# Change directory to the working copy
+cd \$fcm_working_copy || exit 1
+
+# Set the language to avoid encoding problems
+export LANG=en_GB
+
+# Commands to apply patches
+EOF
+
+    # Script content
+    print FILE @script;
+
+    # Script footer
+    print FILE <<EOF;
+# Remove temporary working copy, if necessary
+if [[ -d \$fcm_tmp_dir && -w \$fcm_tmp_dir ]]; then
+  rm -rf \$fcm_tmp_dir
+fi
+
+echo "\$this: finished normally."
+#EOF
+EOF
+
+    close FILE or die $out, ': cannot close (', $!, ')';
+
+    # Add executable permission
+    chmod 0755, $out;
+
+    # Diagnostic
+    $CLI_MESSAGE->('PATCH_DONE', $outdir);
+
+  } else {
+    # Remove output directory
+    rmtree $outdir or die $outdir, ': cannot remove';
+
+    # Diagnostic
+    return _cm_abort(Fcm::Cm::Abort->NULL);
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# CLI: fcm add.
+sub _cli_command_add {
+    my @args = map {($_ eq '--check' || $_ eq '-c' ? () : $_)} @_;
+    my %option = (st_check_handler => $CLI_HANDLER_OF{'WC_STATUS_PATH'});
+    return (
+        @args == @_ ? _svn("add", @args) : cm_check_unknown(\%option, @args)
+    );
+}
+
+# ------------------------------------------------------------------------------
+# CLI: fcm checkout.
+sub _cli_command_checkout {
+    if (@ARGV) {
+        my $target = is_url($ARGV[-1]) ? cwd() : $ARGV[-1];
+        if (-d $target && is_wc($target)) {
+            return _cm_err(Fcm::Cm::Exception->WC_EXIST, $target);
+        }
+    }
+    return _svn('checkout', @ARGV);
+}
+
+# ------------------------------------------------------------------------------
+# CLI: fcm delete.
+sub _cli_command_delete {
+    my @args = map {($_ eq '--check' || $_ eq '-c' ? () : $_)} @_;
+    my %option = (st_check_handler => $CLI_HANDLER_OF{'WC_STATUS_PATH'});
+    return (
+        @args == @_ ? _svn("delete", @args) : cm_check_missing(\%option, @args)
+    );
+}
+
+# ------------------------------------------------------------------------------
+# CLI: fcm switch.
+sub _cli_command_switch {
+    local(@ARGV) = @_;
+    if (grep {$_ eq '--relocate'} @ARGV) {
+        return _svn('switch', @ARGV);
+    }
+    my %option;
+    if (!GetOptions(\%option, 'non-interactive', 'revision|r=s', 'quiet|q')) {
+        _cli_err();
+    }
+    if (!$option{'non-interactive'}) {
+        $option{st_check_handler} = $CLI_HANDLER_OF{WC_STATUS};
+    }
+    if (!@ARGV) {
+        _cli_err();
+    }
+    $CLI_MESSAGE->(q{}, join(q{}, cm_switch(\%option, @ARGV)));
+}
+
+# ------------------------------------------------------------------------------
+# CLI: fcm update.
+sub _cli_command_update {
+    local(@ARGV) = @_;
+    my %option;
+    if (!GetOptions(\%option, 'non-interactive', 'revision|r=s', 'quiet|q')) {
+        _cli_err();
+    }
+    if (!$option{'non-interactive'}) {
+        $option{st_check_handler} = $CLI_HANDLER_OF{WC_STATUS};
+    }
+    $CLI_MESSAGE->(q{}, join(q{}, cm_update(\%option, @ARGV)));
+}
+
+# ------------------------------------------------------------------------------
+# CLI error.
+sub _cli_err {
+    my ($key, @args) = @_;
+    $key ||= 'CLI_USAGE';
+    my $message = sprintf($CLI_MESSAGE_FOR_ERROR{$key}, @args);
+    die(Fcm::CLI::Exception->new({message => $message}));
+}
+
+# ------------------------------------------------------------------------------
+# Handles abort exception.
+sub _cli_e_handler_of_cm_abort {
+    my ($function, $e) = @_;
+    if ($e->get_code() eq $e->FAIL) {
+        die(sprintf($CLI_MESSAGE_FOR_ABORT{FAIL}, $function));
+    }
+    else {
+        $CLI_MESSAGE->($e->get_code(), $function);
+    }
+}
+
+# ------------------------------------------------------------------------------
+# Handles CM exception.
+sub _cli_e_handler_of_cm_exception {
+    my ($function, $e) = @_;
+    die(sprintf($CLI_MESSAGE_FOR_ERROR{$e->get_code()}, $e->get_targets()));
+}
+
+# ------------------------------------------------------------------------------
+# Handles CLI exception.
+sub _cli_e_handler_of_cli_exception {
+    my ($function, $e) = @_;
+    $CLI_MESSAGE->('CLI', $e);
+    $CLI_MESSAGE->('CLI_HELP', $function);
+}
+
+# ------------------------------------------------------------------------------
+# The default handler of the "WC_STATUS" event.
+sub _cli_handler_of_wc_status {
+    my ($name, $target_list_ref, $status_list_ref) = @_;
+    if (@{$status_list_ref}) {
+        $CLI_MESSAGE->('STATUS', join(q{}, @{$status_list_ref}));
+        if ($CLI_PROMPT->($name, 'CONTINUE') ne 'y') {
+            return _cm_abort();
+        }
+    }
+    return @{$status_list_ref};
+}
+
+# ------------------------------------------------------------------------------
+# The default handler of the "WC_STATUS_PATH" event.
+sub _cli_handler_of_wc_status_path {
+    my ($name, $target_list_ref, $status_list_ref) = @_;
+    $CLI_MESSAGE->(q{}, join(q{}, @{$status_list_ref}));
+    my @paths = map {chomp(); ($_ =~ $PATTERN_OF{ST_PATH})} @{$status_list_ref};
+    my @paths_of_interest;
+    while (my $path = shift(@paths)) {
+        my %handler_of = (
+            a => sub {push(@paths_of_interest, $path, @paths); @paths = ()},
+            n => sub {},
+            y => sub {push(@paths_of_interest, $path)},
+        );
+        my $reply = $CLI_PROMPT->(
+            {type => 'yna'}, $name, 'RUN_SVN_COMMAND', "$name $path",
+        );
+        $handler_of{$reply}->();
+    }
+    return @paths_of_interest;
+}
+
+# ------------------------------------------------------------------------------
+# Prints help for a given $subcommand.
+sub _cli_help {
+    my ($key, $exit_val) = @_;
+    my $pod
+        = File::Spec->catfile(dirname($INC{'Fcm/Cm.pm'}), 'CLI', "fcm-$key.pod");
+    my $has_pod = -f $pod;
+    if ($has_pod) {
+        pod2usage({
+            '-exitval' => defined($exit_val) ? $exit_val : 2,
+            '-input'   => $pod,
+            '-verbose' => 1,
+        });
+    }
+    if (!$has_pod || exists($CLI_MORE_HELP_FOR{$key})) {
+        local(@ARGV) = ($key);
+        return _svn('help', $key);
+    }
+}
+
+# ------------------------------------------------------------------------------
+# Expands location keywords in a list.
+sub _cli_keyword_expand_url {
+    my ($arg_list_ref) = @_;
+    ARG:
+    for my $arg (@{$arg_list_ref}) {
+        my ($label, $value) = ($arg =~ $PATTERN_OF{CLI_OPT});
+        if (!$label) {
+            ($label, $value) = (q{}, $arg);
+        }
+        if (!$value) {
+            next ARG;
+        }
+        eval {
+            $value = Fcm::Util::tidy_url(Fcm::Keyword::expand($value));
+        };
+        if ($@) {
+            if ($value ne 'fcm:revision') {
+                die($@);
+            }
+        }
+        $arg = $label . $value;
+    }
+}
+
+# ------------------------------------------------------------------------------
+# Expands revision keywords in -r and --revision options in a list.
+sub _cli_keyword_expand_rev {
+    my ($arg_list_ref) = @_;
+    my @targets;
+    for my $arg (@{$arg_list_ref}) {
+        if (-e $arg && is_wc($arg) || is_url($arg)) {
+            push(@targets, $arg);
+        }
+    }
+    if (!@targets) {
+        push(@targets, get_url_of_wc());
+    }
+    if (!@targets) {
+        return;
+    }
+    my @old_arg_list = @{$arg_list_ref};
+    my @new_arg_list = ();
+    ARG:
+    while (defined(my $arg = shift(@old_arg_list))) {
+        my ($key, $value) = $arg =~ $PATTERN_OF{CLI_OPT_REV};
+        if (!$key) {
+            push(@new_arg_list, $arg);
+            next ARG;
+        }
+        push(@new_arg_list, '--revision');
+        if (!$value) {
+            $value = shift(@old_arg_list);
+        }
+        my @revs = grep {defined()} ($value =~ $PATTERN_OF{CLI_OPT_REV_RANGE});
+        my ($url, @url_list) = @targets;
+        for my $rev (@revs) {
+            if ($rev !~ $PATTERN_OF{SVN_REV}) {
+                $rev = (Fcm::Keyword::expand($url, $rev))[1];
+            }
+            if (@url_list) {
+                $url = shift(@url_list);
+            }
+        }
+        push(@new_arg_list, join(q{:}, @revs));
+    }
+    @{$arg_list_ref} = @new_arg_list;
+}
+
+# ------------------------------------------------------------------------------
+# Prints a message.
+sub _cli_message {
+    my ($key, @args) = @_;
+    for (
+        [\*STDOUT, \%CLI_MESSAGE_FOR        , q{}          ],
+        [\*STDERR, \%CLI_MESSAGE_FOR_WARNING, q{[WARNING] }],
+        [\*STDERR, \%CLI_MESSAGE_FOR_ABORT  , q{[ABORT] }  ],
+        [\*STDERR, \%CLI_MESSAGE_FOR_ERROR  , q{[ERROR] }  ],
+    ) {
+        my ($handle, $hash_ref, $prefix) = @{$_};
+        if (exists($hash_ref->{$key})) {
+            return printf({$handle} $prefix . $hash_ref->{$key}, @args);
+        }
+    }
+}
+
+# ------------------------------------------------------------------------------
+# Wrapper for Fcm::Interactive::get_input.
+sub _cli_prompt {
+    my %option
+        = (type => 'yn', default => 'n', (ref($_[0]) ? %{shift(@_)} : ()));
+    my ($name, $key, @args) = @_;
+    return Fcm::Interactive::get_input(
+        title   => $CLI_PROMPT_PREFIX . $name,
+        message => sprintf($CLI_MESSAGE_FOR_PROMPT{$key}, @args),
+        %option,
+    );
+}
+
+# ------------------------------------------------------------------------------
+# Check missing status and delete.
+sub cm_check_missing {
+    my %option = %{shift()};
+    my $checker
+        = _svn_status_checker('delete', 'MISSING', $option{st_check_handler});
+    my @paths = $checker->(\@_);
+    if (@paths) {
+        run_command([qw{svn delete}, @paths]);
+    }
+}
+
+# ------------------------------------------------------------------------------
+# Check unknown status and add.
+sub cm_check_unknown {
+    my %option = %{shift()};
+    my $checker
+        = _svn_status_checker('add', 'UNKNOWN', $option{st_check_handler});
+    my @paths = $checker->(\@_);
+    if (@paths) {
+        run_command([qw{svn add}, @paths]);
+    }
+}
+
+# ------------------------------------------------------------------------------
+# FCM wrapper to SVN switch.
+sub cm_switch {
+    my %option = %{shift()};
+    my ($target, $path) = @_;
+    $path ||= cwd();
+    if (!-e $path) {
+        return _cm_err(Fcm::Cm::Exception->NOT_EXIST, $path);
+    }
+    if (!is_wc($path)) {
+        return _cm_err(Fcm::Cm::Exception->INVALID_WC, $path);
+    }
+
+    # Check for merge template in the commit log file in the working copy
+    my $path_of_wc = get_wct($path);
+    my $ci_mesg = Fcm::CmCommitMessage->new();
+    $ci_mesg->dir($path_of_wc);
+    $ci_mesg->read_file();
+    if (@{$ci_mesg->auto_mesg()}) {
+        return _cm_err(
+            Fcm::Cm::Exception->SWITCH_UNSAFE,
+            $path eq $path_of_wc ? $ci_mesg->base() : $ci_mesg->file(),
+        );
+    }
+
+    # Check for any local modifications
+    if (defined($option{st_check_handler})) {
+        my $handler = $CLI_HANDLER_OF{WC_STATUS};
+        _svn_status_checker('switch', 'MODIFIED', $handler)->([$path_of_wc]);
+    }
+
+    # Invokes "svn switch"
+    _svn(
+        {METHOD => 'qx', PRINT => !$option{quiet}},
+        'switch',
+        ($option{'non-interactive'} ? '--non-interactive'       : ()),
+        ($option{revision}          ? ('-r', $option{revision}) : ()),
+        ($option{quiet}             ? '--quiet'                 : ()),
+        _cm_get_source(
+            $target,
+            Fcm::CmBranch->new(URL => get_url_of_wc($path_of_wc)),
+        )->url_peg(),
+        ($path_of_wc eq cwd() ? () : $path_of_wc),
+    );
+}
+
+# ------------------------------------------------------------------------------
+# FCM wrapper to SVN update.
+sub cm_update {
+    my %option = %{shift()};
+    my @targets = @_;
+    if (!@targets) {
+        @targets = (cwd());
+    }
+    for my $target (@targets) {
+        if (!-e $target) {
+            return _cm_err(Fcm::Cm::Exception->NOT_EXIST, $target);
+        }
+        if (!is_wc($target)) {
+            return _cm_err(Fcm::Cm::Exception->INVALID_WC, $target);
+        }
+        $target = get_wct($target);
+        if ($target eq cwd()) {
+            $target = q{.};
+        }
+    }
+    if (defined($option{st_check_handler})) {
+        my ($matcher_keys_ref, $show_updates)
+            = defined($option{revision}) ? (['MODIFIED'               ], undef)
+            :                              (['MODIFIED', 'OUT_OF_DATE'], 1    )
+            ;
+        my $matcher = sub {
+            for my $key (@{$matcher_keys_ref}) {
+                $ST_MATCHER_FOR{$key}->(@_) && return 1;
+            }
+        };
+        _svn_status_checker(
+            'update', $matcher, $option{st_check_handler}, $show_updates,
+        )->(\@targets);
+    }
+    if ($option{revision} && $option{revision} !~ $PATTERN_OF{SVN_REV}) {
+        $option{revision} = (
+            Fcm::Keyword::expand(get_url_of_wc($targets[0]), $option{revision})
+        )[1];
+    }
+    return _svn_update(\@targets, \%option);
+}
+
+# ------------------------------------------------------------------------------
+# Raises an abort exception.
+sub _cm_abort {
+    my ($code) = @_;
+    $code ||= Fcm::Cm::Abort->USER;
+    die(bless({code => $code, message => 'abort'}, 'Fcm::Cm::Abort'));
+}
+
+# ------------------------------------------------------------------------------
+# Raises a failure.
+sub _cm_err {
+    my ($code, @targets) = @_;
+    die(bless(
+        {code => $code, message => "ERROR: $code", targets => \@targets},
+        'Fcm::Cm::Exception',
+    ));
+}
+
+# ------------------------------------------------------------------------------
+# Returns the corresponding Fcm::CmBranch instance for $src_url w.r.t. $target.
+sub _cm_get_source {
+    my ($src_url, $target) = @_;
+    my $source = Fcm::CmBranch->new(URL => $src_url);
+    if (!$source->is_url()) {
+        # Not a full URL, construct full URL based on current URL
+        $source->url_peg($target->url_peg());
+        my $project = $target->project();
+        my ($path) = $src_url =~ qr{\A/*(.*)\z}xms;
+        if (index($path, $project) == 0) {
+            # Argument contains the full path under the repository root
+            $path = substr($path, length($project));
+        }
+        if ($path =~ $PATTERN_OF{FCM_BRANCH_PATH}) {
+            # Argument contains the full branch name
+            $path = join(q{/}, $target->project_path(), $path);
+        }
+        else {
+            # Argument contains the shorter branch name
+            $path = join(q{/}, $target->project_path(), 'branches', $path);
+        }
+        $source->path_peg($path);
+    }
+    # Replace source sub-directory with the target sub-directory
+    $source->subdir($target->subdir());
+    # Ensure that the branch name exists
+    if (!$source->url_exists()) {
+        return _cm_err(Fcm::Cm::Exception->INVALID_URL, $src_url);
+    }
+    # Ensure that the branch name is valid
+    if (!$source->branch()) {
+        return _cm_err(Fcm::Cm::Exception->INVALID_BRANCH, $src_url);
+    }
+    # Ensure that the source and target URLs are in the same project
+    if ($source->project_url() ne $target->project_url()) {
+        return _cm_err(
+            Fcm::Cm::Exception->DIFF_PROJECTS,
+            $target->url_peg(),
+            $source->url_peg(),
+        );
+    }
+    return $source;
+}
+
+# ------------------------------------------------------------------------------
+# Runs "svn".
+sub _svn {
+    my @args = @_;
+    my %option;
+    if (@args && ref($args[0])) {
+        %option = %{shift(@args)};
+    }
+    return run_command(
+        ['svn', @args],
+        PRINT => ($args[0] ne 'cat' && !grep {$_ eq '--xml'} @args),
+        %option,
+    );
+}
+
+# ------------------------------------------------------------------------------
+# Returns the results of "svn status".
+sub _svn_status_get {
+    my ($target_list_ref, $show_updates) = @_;
+    my @targets = (defined($target_list_ref) ? @{$target_list_ref} : ());
+    for my $target (@targets) {
+        if ($target eq cwd()) {
+            $target = q{.};
+        }
+    }
+    my @options = ($show_updates ? qw{--show-updates} : ());
+    return _svn({METHOD => 'qx', PRINT => 0}, 'status', @options, @targets);
+}
+
+# ------------------------------------------------------------------------------
+# Returns a "svn status" checker.
+sub _svn_status_checker {
+    my ($name, $matcher, $handler, $show_updates) = @_;
+    if (!ref($matcher)) {
+        $matcher = $ST_MATCHER_FOR{$matcher};
+    }
+    return sub {
+        my ($target_list_ref) = @_;
+        my @status = _svn_status_get($target_list_ref, $show_updates);
+        if ($show_updates) {
+            @status = map {$_ =~ $PATTERN_OF{ST_AGAINST_REV} ? () : $_} @status;
+        }
+        my @status_of_interest = grep {$matcher->($_)} @status;
+        if (defined($handler)) {
+            return $handler->($name, $target_list_ref, \@status_of_interest);
+        }
+        return @status_of_interest;
+    }
+}
+
+# ------------------------------------------------------------------------------
+# Runs "svn update".
+sub _svn_update {
+    my ($target_list_ref, $option_hash_ref) = @_;
+    my %option = (defined($option_hash_ref) ? %{$option_hash_ref} : ());
+    _svn(
+        {METHOD => 'qx', PRINT => !$option{quiet}},
+        'update',
+        ($option{'non-interactive'} ? '--non-interactive'       : ()),
+        ($option{revision}          ? ('-r', $option{revision}) : ()),
+        ($option{quiet}             ? '--quiet'                 : ()),
+        (defined($target_list_ref) ? @{$target_list_ref} : ()),
+    );
+}
+
+# ------------------------------------------------------------------------------
+# Abort exception.
+package Fcm::Cm::Abort;
+use base qw{Fcm::Exception};
+use constant {FAIL => 'FAIL', NULL => 'NULL', USER => 'USER'};
+
+sub get_code {
+    return $_[0]->{code};
+}
+
+# ------------------------------------------------------------------------------
+# Resource exception.
+package Fcm::Cm::Exception;
+our @ISA = qw{Fcm::Cm::Abort};
+use constant {
+    CHDIR             => 'CHDIR',
+    INVALID_BRANCH    => 'INVALID_BRANCH',
+    INVALID_PROJECT   => 'INVALID_PROJECT',
+    INVALID_TARGET    => 'INVALID_TARGET',
+    INVALID_URL       => 'INVALID_URL',
+    INVALID_WC        => 'INVALID_WC',
+    MERGE_REV_INVALID => 'MERGE_REV_INVALID',
+    MERGE_SELF        => 'MERGE_SELF',
+    MERGE_UNRELATED   => 'MERGE_UNRELATED',
+    MERGE_UNSAFE      => 'MERGE_UNSAFE',
+    MKPATH            => 'MKPATH',
+    NOT_EXIST         => 'NOT_EXIST',
+    PARENT_NOT_EXIST  => 'PARENT_NOT_EXIST',
+    RMTREE            => 'RMTREE',
+    SWITCH_UNSAFE     => 'SWITCH_UNSAFE',
+    WC_EXIST          => 'WC_EXIST',
+    WC_INVALID_BRANCH => 'WC_INVALID_BRANCH',
+    WC_URL_NOT_EXIST  => 'WC_URL_NOT_EXIST',
+};
+
+sub get_targets {
+    return @{$_[0]->{targets}};
+}
+
+1;
+__END__
+
+=pod
+
+=head1 NAME
+
+Fcm::Cm
+
+=head1 SYNOPSIS
+
+    use Fcm::Cm qw{cli};
+
+    # Use as a wrapper to Subversion, and other FCM code management commands
+    cli('info', '--revision', 'HEAD', $url);
+
+    use Fcm::Cm qw{cm_check_missing cm_check_unknown cm_switch cm_update};
+
+    # Checks status for "missing" items and "svn delete" them
+    $missing_st_handler = sub {
+        my ($name, $target_list_ref, $status_list_ref) = @_;
+        # ...
+        return @paths_of_interest;
+    };
+    cm_check_missing({st_check_handler => $missing_st_handler}, @targets);
+
+    # Checks status for "unknown" items and "svn add" them
+    $unknown_st_handler = sub {
+        my ($name, $target_list_ref, $status_list_ref) = @_;
+        # ...
+        return @paths_of_interest;
+    };
+    cm_check_unknown({st_check_handler => $unknown_st_handler}, @targets);
+
+    # Sets up a status checker
+    $st_check_handler = sub {
+        my ($name, $target_list_ref, $status_list_ref) = @_;
+        # ...
+    };
+    # Switches a "working copy" at the "root" level to a new URL target
+    cm_switch(
+        {
+            'non-interactive'  => $non_interactive_flag,
+            'quiet'            => $quiet_flag,
+            'revision'         => $revision,
+            'st_check_handler' => $st_check_handler,
+        },
+        $target, $path_of_wc,
+    );
+    # Runs "svn update" on each working copy from their "root" level
+    cm_update(
+        {
+            'non-interactive'  => $non_interactive_flag,
+            'quiet'            => $quiet_flag,
+            'revision'         => $revision,
+            'st_check_handler' => $st_check_handler,
+        },
+        @targets,
+    );
+
+=head1 DESCRIPTION
+
+Wraps the Subversion client and implements other FCM code management
+functionalities.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item cli($function,@args)
+
+Implements the FCM code management CLI. If --help or -h is specified in @args,
+it displays help and returns.  Otherwise, it attempts to expand any FCM location
+and revision keywords in @args. Calls the relevant FCM code management function
+according to $function, or a SVN command if $function is not modified by FCM.
+
+=item cm_check_missing(\%option,@targets)
+
+Use "svn status" to check for missing items in @targets. If @targets is an empty
+list, the function adds the current working directory to it. Expects
+$option{st_check_handler} to be a CODE reference. Calls
+$option{st_check_handler} with ($name, $target_list_ref, $status_list_ref) where
+$name is "delete", $target_list_ref is \@targets, and $status_list_ref is an
+ARRAY reference to a list of "svn status" output with the "missing" status.
+$option{st_check_handler} should return a list of interesting paths, which will
+be scheduled for removal using "svn delete".
+
+=item cm_check_unknown(\%option,@targets)
+
+Similar to cm_check_missing(\%option,@targets) but checks for "unknown" items,
+which will be scheduled for addition using "svn add".
+
+=item cm_switch(\%option,$target,$path_of_wc)
+
+Invokes "svn switch" at the root of a working copy specified by $path_of_wc (or
+the current working directory if $path_of_wc is not specified).
+$option{'non-interactive'}, $option{quiet}, $option{revision} determines the
+options (of the same name) that are passed to "svn switch". If
+$option{st_check_handler} is set, it should be a CODE reference, and will be
+called with ('switch', [$path_of_wc], $status_list_ref), where $status_list_ref
+is an ARRAY reference to the output returned by "svn status" on $path_of_wc.
+This can be used for the application to display the working copy status to the
+user before prompting him/her to continue. The return value of
+$option{st_check_handler} is ignored.
+
+=item cm_update(\%option,@targets)
+
+Invokes "svn update" at the root of each working copy specified by @targets. If
+@targets is an empty list, the function adds the current working directory to
+it. $option{'non-interactive'}, $option{quiet}, $option{revision} determines the
+options (of the same name) that are passed to "svn update". If
+$option{st_check_handler} is set, it should be a CODE reference, and will be
+called with ($name, $target_list_ref, $status_list_ref), where $name is
+'update', $target_list_ref is \@targets and $status_list_ref is an ARRAY
+reference to the output returned by "svn status -u" on the @targets. This can be
+used for the application to display the working copy update status to the user
+before prompting him/her to continue. The return value of
+$option{st_check_handler} is ignored.
+
+=back
+
+=head1 DIAGNOSTICS
+
+The following exceptions can be raised:
+
+=over 4
+
+=item Fcm::Cm::Abort
+
+This exception @ISA L<Fcm::Exception|Fcm::Exception>. It is raised if a command
+is aborted for some reason. The $e->get_code() method can be used to retrieve an
+error code, which can be one of the following:
+
+=over 4
+
+=item $e->FAIL
+
+The command aborts because of a failure.
+
+=item $e->NULL
+
+The command aborts because it will result in no change.
+
+=item $e->USER
+
+The command aborts because of an action by the user.
+
+=back
+
+=item Fcm::Cm::Exception
+
+This exception @ISA L<Fcm::Abort|Fcm::Abort>. It is raised if a command fails
+with a known reason. The $e->get_targets() method can be used to retrieve a list
+of targets/resources associated with this exception. The $e->get_code() method
+can be used to retrieve an error code, which can be one of the following:
+
+=over 4
+
+=item $e->CHDIR
+
+Fails to change directory to a target.
+
+=item $e->INVALID_BRANCH
+
+A target is not a valid branch URL in the standard FCM project layout.
+
+=item $e->INVALID_PROJECT
+
+A target is not a valid project URL in the standard FCM project layout.
+
+=item $e->INVALID_TARGET
+
+A target is not a valid Subversion URL or working copy.
+
+=item $e->INVALID_URL
+
+A target is not a valid Subversion URL.
+
+=item $e->INVALID_WC
+
+A target is not a valid Subversion working copy.
+
+=item $e->MERGE_REV_INVALID
+
+An invalid revision (target element 0) is specified for a merge.
+
+=item $e->MERGE_SELF
+
+Attempt to merge a URL (target element 0) to its own working copy (target
+element 1).
+
+=item $e->MERGE_UNRELATED
+
+The merge target (target element 0) is not directly related to the merge source
+(target element 1).
+
+=item $e->MERGE_UNSAFE
+
+A merge source (target element 0) contains changes outside the target
+sub-directory.
+
+=item $e->MKPATH
+
+Fail to create a directory (target element 0) recursively.
+
+=item $e->NOT_EXIST
+
+A target does not exist.
+
+=item $e->PARENT_NOT_EXIST
+
+The parent of the target no longer exists.
+
+=item $e->RMTREE
+
+Fail to remove a directory (target element 0) recursively.
+
+=item $e->SWITCH_UNSAFE
+
+A merge template exists in the commit message file (target element 0) in a
+working copy target.
+
+=item $e->WC_EXIST
+
+The target working copy already exists.
+
+=item $e->WC_INVALID_BRANCH
+
+The URL of the target working copy is not a valid branch URL in the standard FCM
+project layout.
+
+=item $e->WC_URL_NOT_EXIST
+
+The URL of the target working copy no longer exists at the HEAD revision.
+
+=back
+
+=back
+
+=head1 TO DO
+
+Reintegrate with L<Fcm::CmUrl|Fcm::CmUrl> and L<Fcm::CmBranch|Fcm::CmBranch>,
+but separate this module into the CLI part and the CM part. Expose the remaining
+CM functions when this is done.
+
+Use L<SVN::Client|SVN::Client> to interface with Subversion.
+
+Move C<mkpatch> out of this module.
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CmBranch.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CmBranch.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CmBranch.pm	(revision 2528)
@@ -0,0 +1,1217 @@
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::CmBranch
+#
+# DESCRIPTION
+#   This class contains methods for manipulating a branch. It is a sub-class of
+#   Fcm::CmUrl, and inherits all methods from that class.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::CmBranch;
+@ISA = qw(Fcm::CmUrl);
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+use Carp;
+use File::Spec;
+
+# FCM component modules
+use Fcm::CmCommitMessage;
+use Fcm::CmUrl;
+use Fcm::Config;
+use Fcm::Interactive;
+use Fcm::Keyword;
+use Fcm::Util qw/run_command e_report w_report svn_date/;
+
+my @properties = (
+  'CREATE_REV',  # revision at which the branch is created
+  'DELETE_REV',  # revision at which the branch is deleted
+  'PARENT',      # reference to parent branch Fcm::CmBranch
+  'ANCESTOR',    # list of common ancestors with other branches
+                 # key = URL, value = ancestor Fcm::CmBranch
+  'LAST_MERGE',  # list of last merges from branches
+                 # key = URL@REV, value = [TARGET, UPPER, LOWER]
+  'AVAIL_MERGE', # list of available revisions for merging
+                 # key = URL@REV, value = [REV ...]
+  'CHILDREN',    # list of children of this branch
+  'SIBLINGS',    # list of siblings of this branch
+);
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cm_branch = Fcm::CmBranch->new (URL => $url,);
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::CmBranch class.
+#
+# ARGUMENTS
+#   URL    - URL of a branch
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = Fcm::CmUrl->new (%args);
+
+  $self->{$_} = undef for (@properties);
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_branch->url_peg;
+#   $cm_branch->url_peg ($url);
+#
+# DESCRIPTION
+#   This method returns/sets the current URL.
+# ------------------------------------------------------------------------------
+
+sub url_peg {
+  my $self = shift;
+
+  if (@_) {
+    if (! $self->{URL} or $_[0] ne $self->{URL}) {
+      # Re-set URL and other essential variables in the SUPER-class
+      $self->SUPER::url_peg (@_);
+
+      # Re-set essential variables
+      $self->{$_} = undef for (@properties);
+    }
+  }
+
+  return $self->{URL};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rev = $cm_branch->create_rev;
+#
+# DESCRIPTION
+#   This method returns the revision at which the branch was created.
+# ------------------------------------------------------------------------------
+
+sub create_rev {
+  my $self = shift;
+
+  if (not $self->{CREATE_REV}) {
+    return unless $self->url_exists ($self->pegrev);
+
+    # Use "svn log" to find out the first revision of the branch
+    my %log = $self->svnlog (STOP_ON_COPY => 1);
+
+    # Look at log in ascending order
+    my $rev   = (sort {$a <=> $b} keys %log) [0];
+    my $paths = $log{$rev}{paths};
+
+    # Get revision when URL is first added to the repository
+    if (exists $paths->{$self->branch_path}) {
+      $self->{CREATE_REV} = $rev if $paths->{$self->branch_path}{action} eq 'A';
+    }
+  }
+
+  return $self->{CREATE_REV};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $parent = $cm_branch->parent;
+#
+# DESCRIPTION
+#   This method returns the parent (a Fcm::CmBranch object) of the current
+#   branch.
+# ------------------------------------------------------------------------------
+
+sub parent {
+  my $self = shift;
+
+  if (not $self->{PARENT}) {
+    # Use the log to find out the parent revision
+    my %log = $self->svnlog (REV => $self->create_rev);
+
+    if (exists $log{paths}{$self->branch_path}) {
+      my $path = $log{paths}{$self->branch_path};
+
+      if ($path->{action} eq 'A') {
+        if (exists $path->{'copyfrom-path'}) {
+          # Current branch is copied from somewhere, set the source as the parent
+          my $url = $self->root .  $path->{'copyfrom-path'};
+          my $rev = $path->{'copyfrom-rev'};
+          $self->{PARENT} = Fcm::CmBranch->new (URL => $url . '@' . $rev);
+
+        } else {
+          # Current branch is not copied from somewhere
+          $self->{PARENT} = $self;
+        }
+      }
+    }
+  }
+
+  return $self->{PARENT};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rev = $cm_branch->delete_rev;
+#
+# DESCRIPTION
+#   This method returns the revision at which the branch was deleted.
+# ------------------------------------------------------------------------------
+
+sub delete_rev {
+  my $self = shift;
+
+  if (not $self->{DELETE_REV}) {
+    return if $self->url_exists ('HEAD');
+
+    # Container of the current URL
+    (my $dir_url = $self->branch_url) =~ s#/+[^/]+/*$##;
+
+    # Use "svn log" on the container between a revision where the branch exists
+    # and the HEAD
+    my $dir = Fcm::CmUrl->new (URL => $dir_url);
+    my %log = $dir->svnlog (
+      REV => ['HEAD', ($self->pegrev ? $self->pegrev : $self->create_rev)],
+    );
+
+    # Go through the log to see when branch no longer exists
+    for my $rev (sort {$a <=> $b} keys %log) {
+      next unless exists $log{$rev}{paths}{$self->branch_path} and
+                  $log{$rev}{paths}{$self->branch_path}{action} eq 'D';
+
+      $self->{DELETE_REV} = $rev;
+      last;
+    }
+  }
+
+  return $self->{DELETE_REV};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_branch->is_child_of ($branch);
+#
+# DESCRIPTION
+#   This method returns true if the current branch is a child of $branch.
+# ------------------------------------------------------------------------------
+
+sub is_child_of {
+  my ($self, $branch) = @_;
+
+  # The trunk cannot be a child branch
+  return if $self->is_trunk;
+
+  # If $branch is a branch, use name of $self to see when it is created
+  if ($branch->is_branch and $self->url =~ m#/r(\d+)_[^/]+/*$#) {
+    my $rev = $1;
+
+    # $self can only be a child if it is copied from a revision > the create
+    # revision of $branch
+    return if $rev < $branch->create_rev;
+  }
+
+  return if $self->parent->url ne $branch->url;
+
+  # If $branch is a branch, ensure that it is created before $self
+  return if $branch->is_branch and $self->create_rev <= $branch->create_rev;
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_branch->is_sibling_of ($branch);
+#
+# DESCRIPTION
+#   This method returns true if the current branch is a sibling of $branch.
+# ------------------------------------------------------------------------------
+
+sub is_sibling_of {
+  my ($self, $branch) = @_;
+
+  # The trunk cannot be a sibling branch
+  return if $branch->is_trunk;
+
+  return if $self->parent->url ne $branch->parent->url;
+
+  # If the parent is a branch, ensure they are actually the same branch
+  return if $branch->parent->is_branch and
+            $self->parent->create_rev != $branch->parent->create_rev;
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_get_relatives ($relation);
+#
+# DESCRIPTION
+#   This method sets the $self->{$relation} variable by inspecting the list of
+#   branches at the current revision of the current branch. $relation can be
+#   either "CHILDREN" or "SIBLINGS".
+# ------------------------------------------------------------------------------
+
+sub _get_relatives {
+  my ($self, $relation) = @_;
+
+  my @branch_list = $self->branch_list;
+
+  $self->{$relation} = [];
+
+  # If we are searching for CHILDREN, get list of SIBLINGS, and vice versa
+  my $other = ($relation eq 'CHILDREN' ? 'SIBLINGS' : 'CHILDREN');
+  my %other_list;
+  if ($self->{$other}) {
+    %other_list = map {$_->url, 1} @{ $self->{$other} };
+  }
+
+  for my $u (@branch_list) {
+    # Ignore URL of current branch and its parent
+    next if $u eq $self->url;
+    next if $self->is_branch and $u eq $self->parent->url;
+
+    # Ignore if URL is a branch detected to be another type of relative
+    next if exists $other_list{$u};
+
+    # Construct new Fcm::CmBranch object from branch URL
+    my $url = $u . ($self->pegrev ? '@' . $self->pegrev : '');
+    my $branch = Fcm::CmBranch->new (URL => $url);
+
+    # Test whether $branch is a relative we are looking for
+    if ($relation eq 'CHILDREN') {
+      push @{ $self->{$relation} }, $branch if $branch->is_child_of ($self);
+
+    } else {
+      push @{ $self->{$relation} }, $branch if $branch->is_sibling_of ($self);
+    }
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @children = $cm_branch->children;
+#
+# DESCRIPTION
+#   This method returns a list of children (Fcm::CmBranch objects) of the
+#   current branch that exists in the current revision.
+# ------------------------------------------------------------------------------
+
+sub children {
+  my $self = shift;
+
+  $self->_get_relatives ('CHILDREN') if not $self->{CHILDREN};
+
+  return @{ $self->{CHILDREN} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @siblings = $cm_branch->siblings;
+#
+# DESCRIPTION
+#   This method returns a list of siblings (Fcm::CmBranch objects) of the
+#   current branch that exists in the current revision.
+# ------------------------------------------------------------------------------
+
+sub siblings {
+  my $self = shift;
+
+  $self->_get_relatives ('SIBLINGS') if not $self->{SIBLINGS};
+
+  return @{ $self->{SIBLINGS} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ancestor = $cm_branch->ancestor ($branch);
+#
+# DESCRIPTION
+#   This method returns the common ancestor (a Fcm::CmBranch object) of a
+#   specified $branch and the current branch. The argument $branch must be a
+#   Fcm::CmBranch object. Both the current branch and $branch are assumed to be
+#   in the same project.
+# ------------------------------------------------------------------------------
+
+sub ancestor {
+  my ($self, $branch) = @_;
+
+  if (not exists $self->{ANCESTOR}{$branch->url_peg}) {
+    if ($self->url_peg eq $branch->url_peg) {
+      $self->{ANCESTOR}{$branch->url_peg} = $self;
+
+    } else {
+      # Get family tree of current branch, from trunk to current branch
+      my @this_family = ($self);
+      while (not $this_family [0]->is_trunk) {
+        unshift @this_family, $this_family [0]->parent;
+      }
+
+      # Get family tree of $branch, from trunk to $branch
+      my @that_family = ($branch);
+      while (not $that_family [0]->is_trunk) {
+        unshift @that_family, $that_family [0]->parent;
+      }
+
+      # Find common ancestor from list of parents
+      my $ancestor = undef;
+
+      while (not $ancestor) {
+        # $this and $that should both start as some revisions on the trunk.
+        # Walk down a generation each time it loops around.
+        my $this = shift @this_family;
+        my $that = shift @that_family;
+
+        if ($this->url eq $that->url) {
+          if ($this->is_trunk or $this->create_rev eq $that->create_rev) {
+            # $this and $that are the same branch
+            if (@this_family and @that_family) {
+              # More generations in both branches, try comparing the next
+              # generations.
+              next;
+
+            } else {
+              # End of lineage in one of the branches, ancestor is at the lower
+              # revision of the current URL.
+              if ($this->pegrev and $that->pegrev) {
+                $ancestor = $this->pegrev < $that->pegrev ? $this : $that;
+
+              } else {
+                $ancestor = $this->pegrev ? $this : $that;
+              }
+            }
+
+          } else {
+            # Despite the same URL, $this and $that are different branches as
+            # they are created at different revisions. The ancestor must be the
+            # parent with the lower revision. (This should not occur at the
+            # start.)
+            $ancestor = $this->parent->pegrev < $that->parent->pegrev
+                        ? $this->parent : $that->parent;
+          }
+
+        } else {
+          # Different URLs, ancestor must be the parent with the lower revision.
+          # (This should not occur at the start.)
+          $ancestor = $this->parent->pegrev < $that->parent->pegrev
+                      ? $this->parent : $that->parent;
+        }
+      }
+
+      $self->{ANCESTOR}{$branch->url_peg} = $ancestor;
+    }
+  }
+
+  return $self->{ANCESTOR}{$branch->url_peg};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   ($target, $upper, $lower) = $cm_branch->last_merge_from (
+#     $branch, $stop_on_copy,
+#   );
+#
+# DESCRIPTION
+#   This method returns a 3-element list with information of the last merge
+#   into the current branch from a specified $branch. The first element in the
+#   list $target (a Fcm::CmBranch object) is the target at which the merge was
+#   performed. (This can be the current branch or a parent branch up to the
+#   common ancestor with the specified $branch.) The second and third elements,
+#   $upper and $lower, (both Fcm::CmBranch objects), are the upper and lower
+#   ends of the source delta. If there is no merge from $branch into the
+#   current branch from their common ancestor to the current revision, this
+#   method will return an empty list. If $stop_on_copy is specified, it ignores
+#   merges from parents of $branch, and merges into parents of the current
+#   branch.
+# ------------------------------------------------------------------------------
+
+sub last_merge_from {
+  my ($self, $branch, $stop_on_copy) = @_;
+
+  if (not exists $self->{LAST_MERGE}{$branch->url_peg}) {
+    # Get "log" of current branch down to the common ancestor
+    my %log = $self->svnlog (
+      REV => [
+       ($self->pegrev ? $self->pegrev : 'HEAD'),
+       $self->ancestor ($branch)->pegrev,
+      ],
+
+      STOP_ON_COPY => $stop_on_copy,
+    );
+
+    my $cr = $self;
+
+    # Go down the revision log, checking for merge template messages
+    REV: for my $rev (sort {$b <=> $a} keys %log) {
+      # Loop each line of the log message at each revision
+      my @msg = split /\n/, $log{$rev}{msg};
+
+      # Also consider merges into parents of current branch
+      $cr = $cr->parent if ($cr->is_branch and $rev < $cr->create_rev);
+
+      for (@msg) {
+        # Ignore unless log message matches a merge template
+        next unless /Merged into \S+: (\S+) cf\. (\S+)/;
+
+        # Upper $1 and lower $2 ends of the source delta
+        my $u_path = $1;
+        my $l_path = $2;
+
+        # Add the root directory to the paths if necessary
+        $u_path = '/' . $u_path if substr ($u_path, 0, 1) ne '/';
+        $l_path = '/' . $l_path if substr ($l_path, 0, 1) ne '/';
+
+        # Only consider merges with specified branch (and its parent)
+        (my $path = $u_path) =~ s/@(\d+)$//;
+        my $u_rev = $1;
+
+        my $br = $branch;
+        $br    = $br->parent while (
+          $br->is_branch and $u_rev < $br->create_rev and not $stop_on_copy
+        );
+
+        next unless $br->branch_path eq $path;
+
+        # If $br is a parent of branch, ignore those merges with the parent
+        # above the branch point of the current branch
+        next if $br->pegrev and $br->pegrev < $u_rev;
+
+        # Set the return values
+        $self->{LAST_MERGE}{$branch->url_peg} = [
+          Fcm::CmBranch->new (URL => $cr->url . '@' . $rev), # target
+          Fcm::CmBranch->new (URL => $self->root . $u_path), # delta upper
+          Fcm::CmBranch->new (URL => $self->root . $l_path), # delta lower
+        ];
+
+        last REV;
+      }
+    }
+  }
+
+  return (exists $self->{LAST_MERGE}{$branch->url_peg}
+          ? @{ $self->{LAST_MERGE}{$branch->url_peg} } : ());
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @revs = $cm_branch->avail_merge_from ($branch[, $stop_on_copy]);
+#
+# DESCRIPTION
+#   This method returns a list of revisions of a specified $branch, which are
+#   available for merging into the current branch. If $stop_on_copy is
+#   specified, it will not list available merges from the parents of $branch.
+# ------------------------------------------------------------------------------
+
+sub avail_merge_from {
+  my ($self, $branch, $stop_on_copy) = @_;
+
+  if (not exists $self->{AVAIL_MERGE}{$branch->url_peg}) {
+    # Find out the revision of the upper delta at the last merge from $branch
+    # If no merge is found, use revision of common ancestor with $branch
+    my @last_merge = $self->last_merge_from ($branch);
+    my $rev        = $self->ancestor ($branch)->pegrev;
+    $rev           = $last_merge [1]->pegrev
+      if @last_merge and $last_merge [1]->pegrev > $rev;
+
+    # Get the "log" of the $branch down to $rev
+    my %log = $branch->svnlog (
+      REV          => [($branch->pegrev ? $branch->pegrev : 'HEAD'), $rev],
+      STOP_ON_COPY => $stop_on_copy,
+    );
+
+    # No need to include $rev itself, as it has already been merged
+    delete $log{$rev};
+
+    # No need to include the branch create revision
+    delete $log{$branch->create_rev}
+      if $branch->is_branch and exists $log{$branch->create_rev};
+
+    if (keys %log) {
+      # Check whether there is a latest merge from $self into $branch, if so,
+      # all revisions of $branch below that merge should become unavailable
+      my @last_merge_into = $branch->last_merge_from ($self);
+
+      if (@last_merge_into) {
+        for my $rev (keys %log) {
+          delete $log{$rev} if $rev < $last_merge_into [0]->pegrev;
+        }
+      }
+    }
+
+    # Available merges include all revisions above the branch creation revision
+    # or the revision of the last merge
+    $self->{AVAIL_MERGE}{$branch->url_peg} = [sort {$b <=> $a} keys %log];
+  }
+
+  return @{ $self->{AVAIL_MERGE}{$branch->url_peg} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $lower = $cm_branch->base_of_merge_from ($branch);
+#
+# DESCRIPTION
+#   This method returns the lower delta (a Fcm::CmBranch object) for the next
+#   merge from $branch.
+# ------------------------------------------------------------------------------
+
+sub base_of_merge_from {
+  my ($self, $branch) = @_;
+
+  # Base is the ancestor if there is no merge between $self and $branch
+  my $return = $self->ancestor ($branch);
+
+  # Get configuration for the last merge from $branch to $self
+  my @merge_from = $self->last_merge_from ($branch);
+
+  # Use the upper delta of the last merge from $branch, as all revisions below
+  # that have already been merged into the $self
+  $return = $merge_from [1]
+    if @merge_from and $merge_from [1]->pegrev > $return->pegrev;
+
+  # Get configuration for the last merge from $self to $branch
+  my @merge_into = $branch->last_merge_from ($self);
+
+  # Use the upper delta of the last merge from $self, as the current revision
+  # of $branch already contains changes of $self up to the peg revision of the
+  # upper delta
+  $return = $merge_into [1]
+    if @merge_into and $merge_into [0]->pegrev > $return->pegrev;
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_branch->allow_subdir_merge_from ($branch, $subdir);
+#
+# DESCRIPTION
+#   This method returns true if a merge from the sub-directory $subdir in
+#   $branch  is allowed - i.e. it does not result in losing changes made in
+#   $branch outside of $subdir.
+# ------------------------------------------------------------------------------
+
+sub allow_subdir_merge_from {
+  my ($self, $branch, $subdir) = @_;
+
+  # Get revision at last merge from $branch or ancestor
+  my @merge_from = $self->last_merge_from ($branch);
+  my $last       = @merge_from ? $merge_from [1] : $self->ancestor ($branch);
+  my $rev        = $last->pegrev;
+
+  my $return = 1;
+  if ($branch->pegrev > $rev) {
+    # Use "svn diff --summarize" to work out what's changed between last
+    # merge/ancestor and current revision
+    my $range = $branch->pegrev . ':' . $rev;
+    my @out = &run_command (
+      [qw/svn diff --summarize -r/, $range, $branch->url_peg], METHOD => 'qx', 
+    );
+
+    # Returns false if there are changes outside of $subdir
+    my $url = join ('/', $branch->url, $subdir);
+    for my $line (@out) {
+      chomp $line;
+      $line = substr ($line, 7); # file name begins at column 7
+      if ($line !~ m#^$url(?:/|$)#) {
+        $return = 0;
+        last;
+      }
+    }
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cm_branch->create (
+#     SRC                  => $src,
+#     TYPE                 => $type,
+#     NAME                 => $name,
+#     [PASSWORD            => $password,]
+#     [REV_FLAG            => $rev_flag,]
+#     [TICKET              => \@tickets,]
+#     [REV                 => $rev,]
+#     [NON_INTERACTIVE     => 1,]
+#     [SVN_NON_INTERACTIVE => 1,]
+#   );
+#
+# DESCRIPTION
+#   This method creates a branch in a Subversion repository.
+#
+# OPTIONS
+#   SRC                 - reference to a Fcm::CmUrl object.
+#   TYPE                - Specify the branch type. See help in "fcm branch" for
+#                         further information.
+#   NAME                - specify the name of the branch.
+#   NON_INTERACTIVE     - Do no interactive prompting, set SVN_NON_INTERACTIVE
+#                         to true automatically.
+#   PASSWORD            - specify the password for commit access.
+#   REV                 - specify the operative revision of the source.
+#   REV_FLAG            - A flag to specify the behaviour of the prefix to the
+#                         branch name. See help in "fcm branch" for further
+#                         information.
+#   SVN_NON_INTERACTIVE - Do no interactive prompting when running svn commit,
+#                         etc. This option is implied by NON_INTERACTIVE.
+#   TICKET              - Specify one or more related tickets for the branch.
+# ------------------------------------------------------------------------------
+
+sub create {
+  my $self = shift;
+  my %args = @_;
+
+  # Options
+  # ----------------------------------------------------------------------------
+  # Compulsory options
+  my $src  = $args{SRC};
+  my $type = $args{TYPE};
+  my $name = $args{NAME};
+
+  # Other options
+  my $rev_flag        = $args{REV_FLAG}        ? $args{REV_FLAG}    : 'NORMAL';
+  my @tickets         = exists $args{TICKET}   ? @{ $args{TICKET} } : ();
+  my $password        = exists $args{PASSWORD} ? $args{PASSWORD}    : undef;
+  my $orev            = exists $args{REV}      ? $args{REV}         : 'HEAD';
+
+  my $non_interactive     = exists $args{NON_INTERACTIVE}
+                            ? $args{NON_INTERACTIVE} : 0;
+  my $svn_non_interactive = exists $args{SVN_NON_INTERACTIVE}
+                            ? $args{SVN_NON_INTERACTIVE} : 0;
+  $svn_non_interactive    = $non_interactive ? 1 : $svn_non_interactive;
+
+  # Analyse the source URL
+  # ----------------------------------------------------------------------------
+  # Create branch from the trunk by default
+  $src->branch ('trunk') if not $src->branch;
+
+  # Remove "sub-directory" part from source URL
+  $src->subdir ('')      if $src->subdir;
+
+  # Remove "peg revision" part because it does not work with "svn copy"
+  $src->pegrev ('')      if $src->pegrev;
+
+  # Find out the URL and the last changed revision of the specified URL at the
+  # specified operative revision
+  my $url = $src->svninfo (FLAG => 'URL', REV => $orev);
+  e_report $src->url, ': cannot determine the operative URL at revision ',
+           $orev, ', abort.' if not $url;
+
+  $src->url ($url) if $url ne $src->url;
+
+  my $rev = $src->svninfo (FLAG => 'Last Changed Rev', REV => $orev);
+  e_report $src->url, ': cannot determine the last changed rev at revision',
+           $orev, ', abort.' if not $rev;
+
+  # Warn user if last changed revision is not the specified revision
+  w_report 'Warning: branch will be created from revision ', $rev,
+           ', i.e. the last changed rev.'
+    unless $orev and $orev eq $rev;
+
+  # Determine the sub-directory names of the branch
+  # ----------------------------------------------------------------------------
+  my @branch_dirs = ('branches');
+
+  # Split branch type flags into a hash table
+  my %type_flags = ();
+  $type_flags{$_} = 1 for ((split /$Fcm::Config::DELIMITER/, $type));
+
+  # Branch sub-directory 1, development, test or package
+  for my $flag (qw/DEV TEST PKG/) {
+    if (exists $type_flags{$flag}) {
+      push @branch_dirs, lc ($flag);
+      last;
+    }
+  }
+
+  # Branch sub-directory 2, user, share, configuration or release
+  if (exists $type_flags{USER}) {
+    die 'Unable to determine your user ID, abort' unless $self->config->user_id;
+
+    push @branch_dirs, $self->config->user_id;
+
+  } else {
+    for my $flag (keys %Fcm::CmUrl::owner_keywords) {
+      if (exists $type_flags{uc ($flag)}) {
+        push @branch_dirs, $flag;
+        last;
+      }
+    }
+  }
+
+  # Branch sub-directory 3, branch name
+  # Prefix branch name with revision number/keyword if necessary
+  my $prefix = '';
+  if ($rev_flag ne 'NONE') {
+    $prefix = $rev;
+
+    # Attempt to replace revision number with a revision keyword if necessary
+    if ($rev_flag eq 'NORMAL') {
+      $prefix = (Fcm::Keyword::unexpand($src->url_peg(), $rev))[1];
+    }
+
+    # $prefix is still a revision number, add "r" in front of it
+    $prefix = 'r' . $prefix if $prefix eq $rev;
+
+    # Add an underscore before the branch name
+    $prefix.= '_';
+  }
+
+  # Branch name
+  push @branch_dirs, $prefix . $name;
+
+  # Check whether the branch already exists, fail if so
+  # ----------------------------------------------------------------------------
+  # Construct the URL of the branch
+  $self->project_url ($src->project_url);
+  $self->branch  (join ('/', @branch_dirs));
+
+  # Check that branch does not already exists
+  e_report $self->url, ': branch already exists, abort.' if $self->url_exists;
+
+  # Message for the commit log
+  # ----------------------------------------------------------------------------
+  my @message = ('Created ' . $self->branch_path .  ' from ' .
+                 $src->branch_path . '@' . $rev . '.' . "\n");
+
+  # Add related Trac ticket links to commit log if set
+  if (@tickets) {
+    my $ticket_mesg = 'Relates to ticket' . (@tickets > 1 ? 's' : '');
+
+    while (my $ticket = shift @tickets) {
+      $ticket_mesg .= ' #' . $ticket;
+      $ticket_mesg .= (@tickets > 1 ? ',' : ' and') if @tickets >= 1;
+    }
+
+    push @message, $ticket_mesg . ".\n";
+  }
+
+  # Create a temporary file for the commit log message
+  my $ci_mesg = Fcm::CmCommitMessage->new;
+  $ci_mesg->auto_mesg (\@message);
+  $ci_mesg->ignore_mesg (['A' . ' ' x 4 . $self->url . "\n"]);
+  my $logfile = $ci_mesg->edit_file (TEMP => 1, BATCH => $non_interactive);
+
+  # Check with the user to see if he/she wants to go ahead
+  # ----------------------------------------------------------------------------
+  if (not $non_interactive) {
+    my $reply = Fcm::Interactive::get_input(
+      title   => 'fcm branch',
+      message => 'Would you like to go ahead and create this branch?',
+      type    => 'yn',
+      default => 'n',
+    );
+
+    return unless $reply eq 'y';
+  }
+
+  # Ensure existence of container sub-directories of the branch
+  # ----------------------------------------------------------------------------
+  for my $i (0 .. $#branch_dirs - 1) {
+    my $subdir     = join ('/', @branch_dirs[0 .. $i]);
+    my $subdir_url = Fcm::CmUrl->new (URL => $src->project_url . '/' . $subdir);
+
+    # Check whether each sub-directory of the branch already exists,
+    # if sub-directory does not exist, create it
+    next if $subdir_url->url_exists;
+
+    print 'Creating sub-directory: ', $subdir, "\n";
+
+    my @command = (
+      qw/svn mkdir/,
+      '-m', 'Created ' . $subdir . ' directory.',
+      ($svn_non_interactive  ? '--non-interactive'       : ()),
+      (defined $password     ? ('--password', $password) : ()),
+
+      $subdir_url->url,
+    );
+    &run_command (\@command);
+  }
+
+  # Create the branch
+  # ----------------------------------------------------------------------------
+  {
+    print 'Creating branch ', $self->url, ' ...', "\n";
+    my @command = (
+      qw/svn copy/,
+      '-r', $rev,
+      '-F', $logfile,
+      ($svn_non_interactive  ? '--non-interactive'       : ()),
+      (defined $password     ? ('--password', $password) : ()),
+
+      $src->url, $self->url,
+    );
+    &run_command (\@command);
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cm_branch->delete (
+#     [NON_INTERACTIVE     => 1,]
+#     [PASSWORD            => $password,]
+#     [SVN_NON_INTERACTIVE => 1,]
+#   );
+#
+# DESCRIPTION
+#   This method deletes the current branch from the Subversion repository.
+#
+# OPTIONS
+#   NON_INTERACTIVE     - Do no interactive prompting, set SVN_NON_INTERACTIVE
+#                         to true automatically.
+#   PASSWORD            - specify the password for commit access.
+#   SVN_NON_INTERACTIVE - Do no interactive prompting when running svn commit,
+#                         etc. This option is implied by NON_INTERACTIVE.
+# ------------------------------------------------------------------------------
+
+sub del {
+  my $self = shift;
+  my %args = @_;
+
+  # Options
+  # ----------------------------------------------------------------------------
+  my $password            = exists $args{PASSWORD} ? $args{PASSWORD} : undef;
+  my $non_interactive     = exists $args{NON_INTERACTIVE}
+                            ? $args{NON_INTERACTIVE} : 0;
+  my $svn_non_interactive = exists $args{SVN_NON_INTERACTIVE}
+                            ? $args{SVN_NON_INTERACTIVE} : 0;
+  $svn_non_interactive    = $non_interactive ? 1 : $svn_non_interactive;
+
+  # Ensure URL is a branch
+  # ----------------------------------------------------------------------------
+  e_report $self->url_peg, ': not a branch, abort.' if not $self->is_branch;
+
+  # Message for the commit log
+  # ----------------------------------------------------------------------------
+  my @message = ('Deleted ' . $self->branch_path . '.' . "\n");
+
+  # Create a temporary file for the commit log message
+  my $ci_mesg = Fcm::CmCommitMessage->new;
+  $ci_mesg->auto_mesg (\@message);
+  $ci_mesg->ignore_mesg (['D' . ' ' x 4 . $self->url . "\n"]);
+  my $logfile = $ci_mesg->edit_file (TEMP => 1, BATCH => $non_interactive);
+
+  # Check with the user to see if he/she wants to go ahead
+  # ----------------------------------------------------------------------------
+  if (not $non_interactive) {
+    my $mesg = '';
+    my $user = $self->config->user_id;
+
+    if ($user and $self->branch_owner ne $user) {
+      $mesg .= "\n";
+
+      if (exists $Fcm::CmUrl::owner_keywords{$self->branch_owner}) {
+        my $type = $Fcm::CmUrl::owner_keywords{$self->branch_owner};
+        $mesg .= '*** WARNING: YOU ARE DELETING A ' . uc ($type) .
+                 ' BRANCH.';
+
+      } else {
+        $mesg .= '*** WARNING: YOU ARE DELETING A BRANCH NOT OWNED BY YOU.';
+      }
+
+      $mesg .= "\n" .
+               '*** Please ensure that you have the owner\'s permission.' .
+               "\n\n";
+    }
+
+    $mesg   .= 'Would you like to go ahead and delete this branch?';
+
+    my $reply = Fcm::Interactive::get_input (
+      title   => 'fcm branch',
+      message => $mesg,
+      type    => 'yn',
+      default => 'n',
+    );
+
+    return unless $reply eq 'y';
+  }
+
+  # Delete branch if answer is "y" for "yes"
+  # ----------------------------------------------------------------------------
+  print 'Deleting branch ', $self->url, ' ...', "\n";
+  my @command = (
+    qw/svn delete/,
+    '-F', $logfile,
+    (defined $password    ? ('--password', $password) : ()),
+    ($svn_non_interactive ? '--non-interactive'       : ()),
+
+    $self->url,
+  );
+  &run_command (\@command);
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cm_branch->display_info (
+#     [SHOW_CHILDREN => 1],
+#     [SHOW_OTHER    => 1]
+#     [SHOW_SIBLINGS => 1]
+#   );
+#
+# DESCRIPTION
+#   This method displays information of the current branch. If SHOW_CHILDREN is
+#   set, it shows information of all current children branches of the current
+#   branch. If SHOW_SIBLINGS is set, it shows information of siblings that have
+#   been merged recently with the current branch. If SHOW_OTHER is set, it shows
+#   information of custom/reverse merges.
+# ------------------------------------------------------------------------------
+
+sub display_info {
+  my $self = shift;
+  my %args = @_;
+
+  # Arguments
+  # ----------------------------------------------------------------------------
+  my $show_children = exists $args{SHOW_CHILDREN} ? $args{SHOW_CHILDREN} : 0;
+  my $show_other    = exists $args{SHOW_OTHER   } ? $args{SHOW_OTHER}    : 0;
+  my $show_siblings = exists $args{SHOW_SIBLINGS} ? $args{SHOW_SIBLINGS} : 0;
+
+  # Useful variables
+  # ----------------------------------------------------------------------------
+  my $separator  = '-' x 80 . "\n";
+  my $separator2 = '  ' . '-' x 78 . "\n";
+
+  # Print "info" as returned by "svn info"
+  # ----------------------------------------------------------------------------
+  for my $key ('URL', 'Repository Root', 'Revision', 'Last Changed Author',
+               'Last Changed Rev', 'Last Changed Date') {
+    print $key, ': ', $self->svninfo (FLAG => $key), "\n"
+      if $self->svninfo (FLAG => $key);
+  }
+
+  if ($self->config->verbose) {
+    # Verbose mode, print log message at last changed revision
+    my %log = $self->svnlog (REV => $self->svninfo (FLAG => 'Last Changed Rev'));
+    my @log = split /\n/, $log{msg};
+    print 'Last Changed Log:', "\n\n", map ({'  ' . $_ . "\n"} @log), "\n";
+  }
+
+  if ($self->is_branch) {
+    # Print create information
+    # --------------------------------------------------------------------------
+    my %log = $self->svnlog (REV => $self->create_rev);
+
+    print $separator;
+    print 'Branch Create Author: ', $log{author}, "\n" if $log{author};
+    print 'Branch Create Rev: ', $self->create_rev, "\n";
+    print 'Branch Create Date: ', &svn_date ($log{date}), "\n";
+
+    if ($self->config->verbose) {
+      # Verbose mode, print log message at last create revision
+      my @log = split /\n/, $log{msg};
+      print 'Branch Create Log:', "\n\n", map ({'  ' . $_ . "\n"} @log), "\n";
+    }
+
+    # Print delete information if branch no longer exists
+    # --------------------------------------------------------------------------
+    print 'Branch Delete Rev: ', $self->delete_rev, "\n" if $self->delete_rev;
+
+    # Report merges into/from the parent
+    # --------------------------------------------------------------------------
+    # Print the URL@REV of the parent branch
+    print $separator, 'Branch Parent: ', $self->parent->url_peg, "\n";
+
+    # Set up a new object for the parent at the current revision
+    # --------------------------------------------------------------------------
+    my $p_url  = $self->parent->url;
+    $p_url    .= '@' . $self->pegrev if $self->pegrev;
+    my $parent = Fcm::CmBranch->new (URL => $p_url);
+
+    if (not $parent->url_exists) {
+      print 'Branch parent deleted.', "\n";
+      return;
+    }
+
+    # Report merges into/from the parent
+    # --------------------------------------------------------------------------
+    print $self->_report_merges ($parent, 'Parent');
+  }
+
+  # Report merges with siblings
+  # ----------------------------------------------------------------------------
+  if ($show_siblings) {
+    # Report number of sibling branches found
+    print $separator, 'Searching for siblings ... ';
+    my @siblings = $self->siblings;
+    print scalar (@siblings), ' ', (@siblings> 1 ? 'siblings' : 'sibling'),
+          ' found.', "\n";
+
+    # Report branch name and merge information only if there are recent merges
+    my $out = '';
+    for my $sibling (@siblings) {
+      my $string = $self->_report_merges ($sibling, 'Sibling');
+
+      $out .= $separator2 . '  ' . $sibling->url . "\n" . $string if $string;
+    }
+
+    if (@siblings) {
+      if ($out) {
+        print 'Merges with existing siblings:', "\n", $out;
+
+      } else {
+        print 'No merges with existing siblings.', "\n";
+      }
+    }
+  }
+
+  # Report children
+  # ----------------------------------------------------------------------------
+  if ($show_children) {
+    # Report number of child branches found
+    print $separator, 'Searching for children ... ';
+    my @children = $self->children;
+    print scalar (@children), ' ', (@children > 1 ? 'children' : 'child'),
+          ' found.', "\n";
+
+    # Report children if they exist
+    print 'Current children:', "\n" if @children;
+
+    for my $child (@children) {
+      print $separator2, '  ', $child->url, "\n";
+      print '  Child Create Rev: ', $child->create_rev, "\n";
+      print $self->_report_merges ($child, 'Child');
+    }
+  }
+
+  # Report custom/reverse merges into the branch
+  # ----------------------------------------------------------------------------
+  if ($show_other) {
+    my %log = $self->svnlog (STOP_ON_COPY => 1);
+    my @out;
+
+    # Go down the revision log, checking for merge template messages
+    REV: for my $rev (sort {$b <=> $a} keys %log) {
+      # Loop each line of the log message at each revision
+      my @msg = split /\n/, $log{$rev}{msg};
+
+      for (@msg) {
+        # Ignore unless log message matches a merge template
+        if (/^Reversed r\d+(:\d+)? of \S+$/ or
+            s/^(Custom merge) into \S+(:.+)$/$1$2/) {
+          push @out, ('r' . $rev . ': ' . $_) . "\n";
+        }
+      }
+    }
+
+    print $separator, 'Other merges:', "\n", @out if @out;
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $self->_report_merges ($branch, $relation);
+#
+# DESCRIPTION
+#   This method returns a string for displaying merge information with a
+#   branch, the $relation of which can be a Parent, a Sibling or a Child.
+# ------------------------------------------------------------------------------
+
+sub _report_merges {
+  my ($self, $branch, $relation) = @_;
+
+  my $indent    = ($relation eq 'Parent') ? '' : '  ';
+  my $separator = ($relation eq 'Parent') ? ('-' x 80) : ('  ' . '-' x 78);
+  $separator   .= "\n";
+
+  my $return = '';
+
+  # Report last merges into/from the $branch
+  # ----------------------------------------------------------------------------
+  my %merge  = (
+    'Last Merge From ' . $relation . ':'
+    => [$self->last_merge_from ($branch, 1)],
+    'Last Merge Into ' . $relation . ':'
+    => [$branch->last_merge_from ($self, 1)],
+  );
+
+  if ($self->config->verbose) {
+    # Verbose mode, print the log of the merge
+    for my $key (keys %merge) {
+      next if not @{ $merge{$key} };
+
+      # From: target (0) is self, upper delta (1) is $branch
+      # Into: target (0) is $branch, upper delta (1) is self
+      my $t = ($key =~ /From/) ? $self : $branch;
+
+      $return .= $indent . $key . "\n";
+      $return .= $separator . $t->display_svnlog ($merge{$key}[0]->pegrev);
+    }
+
+  } else {
+    # Normal mode, print in simplified form (rREV Parent@REV)
+    for my $key (keys %merge) {
+      next if not @{ $merge{$key} };
+
+      # From: target (0) is self, upper delta (1) is $branch
+      # Into: target (0) is $branch, upper delta (1) is self
+      $return .= $indent . $key . ' r' . $merge{$key}[0]->pegrev . ' ' .
+                 $merge{$key}[1]->path_peg . ' cf. ' .
+                 $merge{$key}[2]->path_peg . "\n";
+    }
+  }
+
+  if ($relation eq 'Sibling') {
+    # For sibling, do not report further if there is no recent merge
+    my @values = values %merge;
+
+    return $return unless (@{ $values[0] } or @{ $values[1] });
+  }
+
+  # Report available merges into/from the $branch
+  # ----------------------------------------------------------------------------
+  my %avail = (
+    'Merges Avail From ' . $relation . ':'
+    => ($self->delete_rev ? [] : [$self->avail_merge_from ($branch, 1)]),
+    'Merges Avail Into ' . $relation . ':'
+    => [$branch->avail_merge_from ($self, 1)],
+  );
+
+  if ($self->config->verbose) {
+    # Verbose mode, print the log of each revision
+    for my $key (keys %avail) {
+      next unless @{ $avail{$key} };
+
+      $return .= $indent . $key . "\n";
+
+      my $s = ($key =~ /From/) ? $branch: $self;
+
+      for my $rev (@{ $avail{$key} }) {
+        $return .= $separator . $s->display_svnlog ($rev);
+      }
+    }
+
+  } else {
+    # Normal mode, print only the revisions
+    for my $key (keys %avail) {
+      next unless @{ $avail{$key} };
+
+      $return .= $indent . $key . ' ' . join (' ', @{ $avail{$key} }) . "\n";
+    }
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CmCommitMessage.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CmCommitMessage.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CmCommitMessage.pm	(revision 2528)
@@ -0,0 +1,319 @@
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::CmCommitMessage
+#
+# DESCRIPTION
+#   This class contains methods to read, write and edit the commit message file
+#   in a working copy.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::CmCommitMessage;
+@ISA = qw(Fcm::Base);
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+use Carp;
+use Cwd;
+use File::Spec;
+use File::Temp qw/tempfile/;
+
+# FCM component modules
+use Fcm::Base;
+use Fcm::Util qw/e_report run_command/;
+
+# List of property methods for this class
+my @scalar_properties = (
+  'auto_mesg',   # the automatically inserted part of a commit message
+  'base',        # the base name of the commit message file
+  'dir',         # the directory container of the commit message file
+  'ignore_mesg', # the ignored part of a commit message
+  'user_mesg',   # the user defined part of a commit message
+);
+
+# Commit log delimiter messages
+my $log_delimiter        = '--Add your commit message ABOVE - ' .
+                           'do not alter this line or those below--';
+my $auto_delimiter       = '--FCM message (will be inserted automatically)--';
+my $auto_delimiter_old   = '--This line will be ignored and those below ' .
+                           'will be inserted automatically--';
+my $status_delimiter     = '--Change summary ' .
+                           '(not part of commit message)--';
+my $status_delimiter_old = '--This line, and those below, will be ignored--';
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = Fcm::CmCommitMessage->new ();
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::CmCommitMessage class.
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = Fcm::Base->new (%args);
+
+  $self->{$_} = undef for (@scalar_properties);
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @scalar_properties.
+# ------------------------------------------------------------------------------
+
+for my $name (@scalar_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    # Argument specified, set property to specified argument
+    if (@_) {
+      $self->{$name} = $_[0];
+    }
+
+    # Default value for property
+    if (not defined $self->{$name}) {
+      if ($name eq 'base') {
+        # Reference to an array
+        $self->{$name} = '#commit_message#';
+
+      } elsif ($name eq 'dir') {
+        # Current working directory
+        $self->{$name} = &cwd ();
+
+      } elsif ($name =~ /_mesg$/) {
+        # Reference to an array
+        $self->{$name} = [];
+      }
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $file = $obj->file;
+#   $obj->file ($file);
+#
+# DESCRIPTION
+#   This method returns the full name of the commit message file. If an
+#   argument is specified, the file is reset using the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub file {
+  my ($self, $file) = @_;
+
+  if ($file) {
+    $self->dir  (dirname  ($file));
+    $self->base (basename ($file));
+  }
+
+  return File::Spec->catfile ($self->dir, $self->base);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   ($user, $auto) = $obj->read_file ();
+#
+# DESCRIPTION
+#   This function reads from the commit log message file. It resets the user
+#   and the automatic messages after reading the file. It returns the message
+#   back in two array references.
+# ------------------------------------------------------------------------------
+
+sub read_file {
+  my $self = shift;
+
+  my @user = ();
+  my @auto = ();
+  my $file = $self->file;
+
+  if (-r $file) {
+    open FILE, '<', $file or croak 'Cannot open ', $file, '(', $!, '), abort';
+
+    my $in_auto = 0;
+    while (<FILE>) {
+
+      next if (index ($_, $log_delimiter) == 0); 
+
+      if (index ($_, $status_delimiter)     == 0 ||
+          index ($_, $status_delimiter_old) == 0) {
+        # Ignore after the ignore delimiter
+        last;
+      }
+
+      if (index ($_, $auto_delimiter)     == 0 ||
+          index ($_, $auto_delimiter_old) == 0) {
+        # Beginning of the automatically inserted message
+        $in_auto = 1;
+        next;
+      }
+
+      if ($in_auto) {
+        push @auto, $_;
+
+      } else {
+        push @user, $_;
+      }
+    }
+
+    close FILE;
+
+    $self->user_mesg (\@user);
+    $self->auto_mesg (\@auto);
+  }
+
+  return (\@user, \@auto);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj->write_file ();
+#
+# DESCRIPTION
+#   This function writes to the commit log message file based on the content of
+#   the user defined message, and the automatically inserted message.
+# ------------------------------------------------------------------------------
+
+sub write_file {
+  my $self = shift;
+  my %args = @_;
+
+  my @user = @{ $self->user_mesg };
+  my @auto = @{ $self->auto_mesg };
+  my $file = $self->file;
+
+  open FILE, '>', $file or die 'Cannot open ', $file, '(', $!, '), abort';
+  print FILE @user;
+  print FILE $log_delimiter, "\n", $auto_delimiter, "\n", @auto if @auto;
+  close FILE or croak 'Cannot close ', $file, '(', $!, '), abort';
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $file = $obj->edit_file ([TEMP => 1,] [BATCH => 1,]);
+#
+# DESCRIPTION
+#   This function normally triggers an editor for editing the commit message.
+#   If TEMP is set, it edits a temporary file. Otherwise, it edits the current
+#   commit message file. It resets the user defined message on success. Returns
+#   the name of the commit log file. Do not start the editor if BATCH is set.
+# ------------------------------------------------------------------------------
+
+sub edit_file {
+  my $self  = shift;
+  my %args  = @_;
+  my $temp  = exists $args{TEMP}  ? $args{TEMP}  : 0;
+  my $batch = exists $args{BATCH} ? $args{BATCH} : 0;
+
+  my @user   = @{ $self->user_mesg };
+  my @auto   = @{ $self->auto_mesg };
+  my @ignore = @{ $self->ignore_mesg };
+  my $file   = $self->file;
+
+  if ($temp) {
+    my $fh;
+    ($fh, $file) = tempfile (SUFFIX => ".fcm", UNLINK => 1);
+    close $fh;
+  }
+
+  # Add original or code driven message and status information to the file
+  my $select = select;
+  open FILE, '>', $file or croak 'Cannot open ', $file, ' (', $!, '), abort';
+  select FILE;
+
+  print @user;
+  print (@auto || @user ? '' : "\n");
+  print $log_delimiter, "\n";
+  print $auto_delimiter, "\n", @auto, "\n" if @auto;
+  print $status_delimiter, "\n\n";
+  print @ignore if @ignore;
+
+  close FILE or die 'Cannot close ', $file, ' (', $!, '), abort';
+  select $select;
+
+  if (not $batch) {
+    # Select editor
+    my $editor = 'nedit';
+    
+    if ($ENV{'SVN_EDITOR'}) {
+      $editor = $ENV{'SVN_EDITOR'};
+
+    } elsif ($ENV{'VISUAL'}) {
+      $editor = $ENV{'VISUAL'};
+
+    } elsif ($ENV{'EDITOR'}) {
+      $editor = $ENV{'EDITOR'};
+    }
+
+    # Execute command to start the editor
+    print 'Starting ', $editor, ' to edit commit message ...', "\n";
+    &run_command ([split (/\s+/, $editor), $file]);
+  }
+
+  # Read the edited file, and extract user log message from it
+  open FILE, '<', $file or croak 'Cannot open ', $file, ' (', $!, '), abort';
+  my (@log);
+  my $delimiter_found = 0;
+
+  while (<FILE>) {
+    if (index ($_, $log_delimiter) == 0) {
+      $delimiter_found = 1;
+      last;
+    }
+    push @log, $_;
+  }
+
+  close FILE;
+
+  # Ensure log delimiter line was not altered
+  e_report 'Error: the line "', $log_delimiter, '" has been altered, abort.'
+    if not $delimiter_found;
+
+  # Check for empty commit log
+  e_report 'Error: log message unchanged or not specified, abort.'
+    if join (' ', (@log, @auto)) =~ /^\s*$/;
+
+  # Echo the commit message to standard output
+  my $separator = '-' x 80 . "\n";
+  print 'Change summary:', "\n";
+  print $separator, @ignore, $separator;
+  print 'Commit message is as follows:', "\n";
+  print $separator, @log, @auto, $separator;
+
+  open FILE, '>', $file or croak 'Cannot open ', $file, ' (', $!, '), abort';
+  print FILE @log, @auto;
+  close FILE or croak 'Cannot close ', $file, ' (', $!, '), abort';
+
+  # Reset the array for the user specified log message
+  $self->user_mesg (\@log);
+
+  return $file;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CmUrl.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CmUrl.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CmUrl.pm	(revision 2528)
@@ -0,0 +1,1149 @@
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::CmUrl
+#
+# DESCRIPTION
+#   This class contains methods for manipulating a Subversion URL in a standard
+#   FCM project.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::CmUrl;
+@ISA = qw(Fcm::Base);
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+use HTTP::Date;
+use XML::DOM;
+
+# FCM component modules
+use Fcm::Base;
+use Fcm::Keyword;
+use Fcm::Util qw/run_command svn_date/;
+
+# Special branches
+our %owner_keywords = (Share => 'shared', Config => 'config', Rel => 'release');
+
+# Revision pattern
+my $rev_pattern = '\d+|HEAD|BASE|COMMITTED|PREV|\{.+\}';
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cm_url = Fcm::CmUrl->new ([URL => $url,]);
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::CmUrl class.
+#
+# ARGUMENTS
+#   URL - URL of a branch
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = Fcm::Base->new (%args);
+
+  $self->{URL} = (exists $args{URL} ? $args{URL} : '');
+
+  for (qw/ANALYSED BRANCH BRANCH_LIST INFO LIST LOG LOG_RANGE PEGREV RLIST
+          PROJECT SUBDIR/) {
+    $self->{$_} = undef;
+  }
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_url->url_peg;
+#   $cm_url->url_peg ($url);
+#
+# DESCRIPTION
+#   This method returns/sets the current URL@PEG.
+# ------------------------------------------------------------------------------
+
+sub url_peg {
+  my $self = shift;
+
+  if (@_) {
+    if (! $self->{URL} or $_[0] ne $self->{URL}) {
+      # Re-set URL
+      $self->{URL} = shift;
+
+      # Re-set essential variables
+      $self->{$_}  = undef for (qw/ANALYSED RLIST LIST INFO LOG LOG_RANGE/);
+    }
+  }
+
+  return $self->{URL};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_url->is_url ();
+#
+# DESCRIPTION
+#   Returns true if current url is a valid Subversion URL.
+# ------------------------------------------------------------------------------
+
+sub is_url {
+  my $self = shift;
+
+  # This should handle URL beginning with svn://, http:// and svn+ssh://
+  return ($self->url_peg =~ m#^[\+\w]+://#);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_url->url_exists ([$rev]);
+#
+# DESCRIPTION
+#   Returns true if current url exists (at operative revision $rev) in a
+#   Subversion repository.
+# ------------------------------------------------------------------------------
+
+sub url_exists {
+  my ($self, $rev) = @_;
+
+  my $exists = $self->svnlist (REV => $rev);
+
+  return defined ($exists);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $cm_url->svninfo ([FLAG => $flag], [REV => $rev]);
+#
+# DESCRIPTION
+#   Returns the value of $flag, where $flag is a field returned by "svn info".
+#   (If $flag is not set, default to "URL".) Otherwise returns an empty string.
+#   If REV is specified, it will be used as the operative revision.
+# ------------------------------------------------------------------------------
+
+sub svninfo {
+  my $self = shift;
+  my %args = @_;
+
+  my $flag = exists $args{FLAG} ? $args{FLAG} : 'URL';
+  my $rev  = exists $args{REV}  ? $args{REV}  : undef;
+
+  $rev = ($self->pegrev ? $self->pegrev : 'HEAD') if not $rev;
+
+  return if not $self->is_url;
+
+  # Get "info" for the specified revision if necessary
+  if (not exists $self->{INFO}{$rev}) {
+    # Invoke "svn info" command
+    my @info = &run_command (
+      [qw/svn info -r/, $rev, $self->url_peg],
+      PRINT   => $self->config->verbose > 2,
+      METHOD  => 'qx',
+      DEVNULL => 1,
+      ERROR   => 'ignore',
+    );
+
+    # Store selected information
+    for (@info) {
+      chomp;
+
+      if (/^(.+?):\s*(.+)$/) {
+        $self->{INFO}{$rev}{$1} = $2;
+      }
+    }
+  }
+
+  my $return = exists $self->{INFO}{$rev}{$flag}
+               ? $self->{INFO}{$rev}{$flag} : undef;
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %logs = $cm_url->svnlog (
+#     [REV          => $rev,]
+#     [REV          => \@revs,] # reference to a 2-element array
+#     [STOP_ON_COPY => 1,]
+#   );
+#
+# DESCRIPTION
+#   Returns the logs for the current URL. If REV is a range of revisions or not
+#   specified, return a hash where the keys are revision numbers and the values
+#   are the entries (which are hash references). If a single REV is specified,
+#   return the entry (a hash reference) at the specified REV. Each entry in the
+#   returned list is a hash reference, with the following structure:
+#
+#   $entry = {
+#     author => $author,              # the commit author
+#     date   => $date,                # the commit date (in seconds since epoch)
+#     msg    => $msg,                 # the log message
+#     paths  => {                     # list of changed paths
+#       $path1  => {                  # a changed path
+#         copyfrom-path => $frompath, # copy-from-path
+#         copyfrom-rev  => $fromrev,  # copy-from-revision
+#         action        => $action,   # action status code
+#       },
+#       ...     => { ... },           # ... more changed paths ...
+#     },
+#   }
+# ------------------------------------------------------------------------------
+
+sub svnlog {
+  my $self = shift;
+  my %args = @_;
+
+  my $stop_on_copy  = exists $args{STOP_ON_COPY} ? $args{STOP_ON_COPY} : 0;
+  my $rev_arg       = exists $args{REV}          ? $args{REV}          : 0;
+
+  my @revs;
+
+  # Get revision options
+  # ----------------------------------------------------------------------------
+  if ($rev_arg) {
+    if (ref ($rev_arg)) {
+      # Revsion option is an array, a range of revisions specified?
+      ($revs [0], $revs [1]) = @$rev_arg;
+
+    } else {
+      # A single revision specified
+      $revs [0] = $rev_arg;
+    }
+
+    # Expand 'HEAD' revision
+    for my $rev (@revs) {
+      next unless uc ($rev) eq 'HEAD';
+      $rev = $self->svninfo (FLAG => 'Revision', REV => 'HEAD');
+    }
+
+  } else {
+    # No revision option specified, get log for all revisions
+    $revs [0] = $self->svninfo (FLAG => 'Revision');
+    $revs [1] = 1;
+  }
+
+  $revs [1] = $revs [0] if not $revs [1];
+  @revs     = sort {$b <=> $a} @revs;
+
+  # Check whether a "svn log" run is necessary
+  # ----------------------------------------------------------------------------
+  my $need_update = ! ($revs [0] == $revs [1] and exists $self->{LOG}{$revs [0]});
+  my @ranges      = @revs;
+  if ($need_update and $self->{LOG_RANGE}) {
+    my %log_range = %{ $self->{LOG_RANGE} };
+
+    if ($stop_on_copy) {
+      $ranges [1] = $log_range{UPPER} if $ranges [1] >= $log_range{LOWER_SOC};
+
+    } else {
+      $ranges [1] = $log_range{UPPER} if $ranges [1] >= $log_range{LOWER};
+    }
+  }
+
+  $need_update = 0 if $ranges [0] < $ranges [1];
+
+  if ($need_update) {
+    # Invoke "svn log" command for all revisions of the current branch
+    # --------------------------------------------------------------------------
+    my @command = (
+      qw/svn log --xml -v/, ($stop_on_copy ? '--stop-on-copy' : ()),
+      '-r' . join (':', @ranges),
+      $self->url_peg,
+    );
+
+    my $rc;
+    my @xml = &run_command (
+      \@command,
+      PRINT   => $self->config->verbose > 2,
+      METHOD  => 'qx',
+      DEVNULL => 1,
+      ERROR   => 'ignore',
+      RC      => \$rc,
+    );
+
+    # Parse the XML
+    # --------------------------------------------------------------------------
+    if (not $rc) {
+      my $parser = XML::DOM::Parser->new;
+      my $doc    = $parser->parse (join ('', @xml));
+
+      my $entry_list = $doc->getElementsByTagName ('logentry');
+
+      # Record the author, date, message and path change for each revision
+      for my $i (0 .. $entry_list->getLength - 1) {
+        # Select current entry from node list
+        my $entry = $entry_list->item ($i);
+        my %this = ();
+
+        # Revision is an attribute of the entry node
+        my $rev   = $entry->getAttributeNode ('revision')->getValue;
+
+        # Author, date and log message are children elements of the entry node
+        for my $key (qw/author date msg/) {
+          # Get data of each node, also convert date to seconds since epoch
+          my $node    = $entry->getElementsByTagName ($key)->item (0);
+          my $data    = ($node and $node->getFirstChild)
+                        ? $node->getFirstChild->getData : '';
+          $this{$key} = ($key eq 'date' ? str2time ($data) : $data);
+        }
+
+        # Path nodes are grand children elements of the entry node
+        my $paths = $entry->getElementsByTagName ('path');
+
+        for my $p (0 .. $paths->getLength - 1) {
+          # Select current path node from node list
+          my $node = $paths->item ($p);
+
+          # Get data from the path node
+          my $path = $node->getFirstChild->getData;
+          $this{paths}{$path} = {};
+
+          # Action, copyfrom-path and copyfrom-rev are attributes of path nodes
+          for my $key (qw/action copyfrom-path copyfrom-rev/) {
+            next unless $node->getAttributeNode ($key); # ensure attribute exists
+
+            $this{paths}{$path}{$key} = $node->getAttributeNode ($key)->getValue;
+          }
+        }
+
+        $self->{LOG}{$rev} = \%this;
+      }
+    }
+
+    # Update the range cache
+    # --------------------------------------------------------------------------
+    # Upper end of the range
+    $self->{LOG_RANGE}{UPPER} = $ranges [0]
+      if ! $self->{LOG_RANGE}{UPPER} or $ranges [0] > $self->{LOG_RANGE}{UPPER};
+
+    # Lower end of the range, need to take into account the stop-on-copy option
+    if ($stop_on_copy) {
+      # Lower end of the range with stop-on-copy option
+      $self->{LOG_RANGE}{LOWER_SOC} = $ranges [1]
+        if ! $self->{LOG_RANGE}{LOWER_SOC} or
+           $ranges [1] < $self->{LOG_RANGE}{LOWER_SOC};
+
+      my $low = (sort {$a <=> $b} keys %{ $self->{LOG} }) [0];
+      $self->{LOG_RANGE}{LOWER} = $low
+        if ! $self->{LOG_RANGE}{LOWER} or $low < $self->{LOG_RANGE}{LOWER};
+
+    } else {
+      # Lower end of the range without the stop-on-copy option
+      $self->{LOG_RANGE}{LOWER} = $ranges [1]
+        if ! $self->{LOG_RANGE}{LOWER} or
+           $ranges [1] < $self->{LOG_RANGE}{LOWER};
+
+      $self->{LOG_RANGE}{LOWER_SOC} = $ranges [1]
+        if ! $self->{LOG_RANGE}{LOWER_SOC} or
+           $ranges [1] < $self->{LOG_RANGE}{LOWER_SOC};
+    }
+  }
+
+  my %return = ();
+
+  if (! $rev_arg or ref ($rev_arg)) {
+    # REV is an array, return log entries if they are within range
+    for my $rev (sort {$b <=> $a} keys %{ $self->{LOG} }) {
+      next if $rev > $revs [0] or $revs [1] > $rev;
+
+      $return{$rev} = $self->{LOG}{$rev};
+
+      if ($stop_on_copy) {
+        last if exists $self->{LOG}{$rev}{paths}{$self->branch_path} and
+           $self->{LOG}{$rev}{paths}{$self->branch_path}{action} eq 'A';
+      }
+    }
+
+  } else {
+    # REV is a scalar, return log of the specified revision if it exists
+    %return = %{ $self->{LOG}{$revs [0]} } if exists $self->{LOG}{$revs [0]};
+  }
+
+  return %return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $cm_branch->display_svnlog ($rev, [$wiki]);
+#
+# DESCRIPTION
+#   This method returns a string for displaying the log of the current branch
+#   at a $rev. If $wiki is set, returns a string for displaying in a Trac wiki
+#   table.  The value of $wiki should be the Subversion URL of a FCM project
+#   associated with the intended Trac system.
+# ------------------------------------------------------------------------------
+
+sub display_svnlog {
+  my ($self, $rev, $wiki) = @_;
+  my $return = '';
+
+  my %log = $self->svnlog (REV => $rev);
+
+  if ($wiki) {
+    # Output in Trac wiki format
+    # --------------------------------------------------------------------------
+    $return .= '|| ' . &svn_date ($log{date}) . ' || ' . $log{author} . ' || ';
+
+    my $trac_url = Fcm::Keyword::get_browser_url($self->url);
+
+    # Get list of tickets from log
+    my @tickets;
+    while ($log{msg} =~ /(?:(\w+):)?(?:#|ticket:)(\d+)/g) {
+      push @tickets, [$1, $2];
+    }
+    @tickets = sort {
+      if ($a->[0] and $b->[0]) {
+        $a->[0] cmp $b->[0] or $a->[1] <=> $b->[1];
+
+      } elsif ($a->[0]) {
+        1;
+
+      } else {
+        $a->[1] <=> $b->[1];
+      }
+    } @tickets;
+
+    if ($trac_url =~ m#^$wiki(?:/*|$)#) {
+      # URL is in the specified $wiki, use Trac link
+      $return .= '[' . $rev . '] ||';
+
+      for my $ticket (@tickets) {
+        $return .= ' ';
+        $return .= $ticket->[0] . ':' if $ticket->[0];
+        $return .= '#' . $ticket->[1];
+      }
+
+      $return .= ' ||';
+
+    } else {
+      # URL is not in the specified $wiki, use full URL
+      my $rev_url = $trac_url;
+      $rev_url    =~ s{/intertrac/source:.*\z}{/intertrac/changeset:$rev}xms;
+      $return    .= '[' . $rev_url . ' ' . $rev . '] ||';
+
+      my $ticket_url = $trac_url;
+      $ticket_url    =~ s{/intertrac/source:.*\z}{/intertrac/}xms;
+
+      for my $ticket (@tickets) {
+        $return .= ' [' . $ticket_url;
+        $return .= $ticket->[0] . ':' if $ticket->[0];
+        $return .= 'ticket:' . $ticket->[1] . ' ' . $ticket->[1] . ']';
+      }
+
+      $return .= ' ||';
+    }
+
+  } else {
+    # Output in plain text format
+    # --------------------------------------------------------------------------
+    my @msg  = split /\n/, $log{msg};
+    my $line = (@msg > 1 ? ' lines' : ' line');
+
+    $return .= join (
+      ' | ',
+      ('r' . $rev, $log{author}, &svn_date ($log{date}), scalar (@msg) . $line),
+    );
+    $return .= "\n\n";
+    $return .= $log{msg};
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @list = $cm_url->svnlist ([REV => $rev], [RECURSIVE => 1]);
+#
+# DESCRIPTION
+#   The method returns a list of paths as returned by "svn list". If RECURSIVE
+#   is set, "svn list" is invoked with the "-R" option.
+# ------------------------------------------------------------------------------
+
+sub svnlist {
+  my $self = shift;
+  my %args = @_;
+
+  my $recursive = exists $args{RECURSIVE} ? $args{RECURSIVE} : 0;
+  my $rev       = exists $args{REV}       ? $args{REV}       : undef;
+  my $key       = $recursive ? 'RLIST' : 'LIST';
+
+  # Find out last changed revision of the current URL
+  $rev = $self->svninfo (FLAG => 'Last Changed Rev', REV => $rev);
+  return () if not $rev;
+
+  # Get directory listing for the current URL at the last changed revision
+  if (not exists $self->{$key}{$rev}) {
+    my $rc;
+
+    my @list = map {chomp; $_} &run_command (
+      [qw/svn list -r/, $rev, ($recursive ? '-R' : ()), $self->url_peg],
+      METHOD => 'qx', ERROR => 'ignore', DEVNULL => 1, RC => \$rc,
+    );
+
+    $self->{$key}{$rev} = $rc ? undef : \@list;
+  }
+
+  return (defined ($self->{$key}{$rev}) ? @{ $self->{$key}{$rev} } : undef);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @list = $cm_url->branch_list ($rev);
+#
+# DESCRIPTION
+#   The method returns a list of branches in the current project, assuming the
+#   FCM naming convention. If $rev if specified, it returns the list of
+#   branches at $rev.
+# ------------------------------------------------------------------------------
+
+sub branch_list {
+  my ($self, $rev) = @_;
+
+  # Current URL must be a valid FCM project
+  return if not $self->project;
+
+  # Find out last changed revision of the current URL
+  $rev = $self->svninfo (FLAG => 'Revision', REV => $rev);
+  return () if not $rev;
+
+  if (not exists $self->{BRANCH_LIST}{$rev}) {
+    $self->{BRANCH_LIST}{$rev} = [];
+
+    # Get URL of the project "branches/" sub-directory
+    my $url = Fcm::CmUrl->new (URL => $self->project_url . '/branches');
+
+    # List three levels underneath "branches/"
+    # First level, i.e. dev, test, pkg, etc
+    my @list1 = map {$url->url . '/' . $_} $url->svnlist (REV => $rev);
+    @list1    = grep m#/$#, @list1;
+
+    # Second level, i.e. user name, Shared, Rel or Config
+    my @list2;
+    for (@list1) {
+      my $u    = Fcm::CmUrl->new (URL => $_);
+      my @list = $u->svnlist (REV => $rev);
+
+      push @list2, map {$u->url . $_} @list;
+    }
+
+    # Third level, branch name
+    for (@list2) {
+      my $u    = Fcm::CmUrl->new (URL => $_);
+      my @list = map {s#/*$##; $_} $u->svnlist (REV => $rev);
+
+      push @{ $self->{BRANCH_LIST}{$rev} }, map {$u->url . $_} @list;
+    }
+  }
+
+  return @{ $self->{BRANCH_LIST}{$rev} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_analyse_url ();
+#
+# DESCRIPTION
+#   The method analyses the current URL, breaking it up into the project
+#   (substring of URL up to the slash before "trunk", "branches" or "tags"),
+#   branch name ("trunk", "branches/<type>/<id>/<name>" or "tags/<name>") and
+#   the sub-directory below the top of the project sub-tree. It re-sets the
+#   corresponding interal variables.
+# ------------------------------------------------------------------------------
+
+sub _analyse_url {
+  my $self = shift;
+  my ($url, $project, $branch, $subdir, $pegrev);
+
+  # Check that URL is set
+  $url    = $self->url_peg;
+  return if not $url;
+  return if not $self->is_url;
+
+  # Extract from URL the peg revision
+  $pegrev = $1 if $url =~ s/@($rev_pattern)$//i;
+
+  if ($url =~ m#^(.*?)/+(trunk|branches|tags)(?:/+(.*))?/*$#) {
+    # URL is under the "trunk", a branch or a tag
+    $project                 = $1;
+    my ($branch_id, $remain) = ($2, $3);
+
+    $remain = '' if not defined $remain;
+
+    if ($branch_id eq 'trunk') {
+      # URL under the "trunk"
+      $branch = 'trunk';
+
+    } else {
+      # URL under a branch or a tag
+      $branch = $branch_id;
+
+      # Assume "3 sub-directories", FCM branch naming convention
+      for (1 .. 3) {
+        if ($remain =~ s#^([^/]+)(?:/+|$)##) {
+          $branch .=  '/' . $1;
+
+        } else {
+          $branch = undef;
+          last;
+        }
+      }
+    }
+
+    $subdir = $remain ? $remain : '' if $branch;
+
+  } else {
+    # URL is at some level above the "trunk", a branch or a tag
+    # Use "svn ls" to determine whether it is a project URL
+    my @list = $self->svnlist (REV => ($pegrev ? $pegrev : 'HEAD'));
+    my %lines = map {chomp $_; ($_, 1)} @list;
+
+    # A project URL should have the "trunk", "branches" and "tags" directories
+    ($project = $url) =~ s#/*$##
+      if $lines{'trunk/'} and $lines{'branches/'} and $lines{'tags/'};
+  }
+
+  $self->{PROJECT}  = $project;
+  $self->{BRANCH}   = $branch;
+  $self->{SUBDIR}   = $subdir;
+  $self->{PEGREV}   = $pegrev;
+  $self->{ANALYSED} = 1;
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_url->root ();
+#
+# DESCRIPTION
+#   The method returns the repository root of the current URL.
+# ------------------------------------------------------------------------------
+
+sub root {
+  my $self = shift;
+
+  return $self->svninfo (FLAG => 'Repository Root');
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_url->project_url_peg ();
+#   $cm_url->project_url_peg ($url);
+#
+# DESCRIPTION
+#   The method returns the URL@PEG of the "project" part of the current URL. If
+#   an argument is specified, the URL of the "project" part and the peg
+#   revision of the current URL are re-set.
+# ------------------------------------------------------------------------------
+
+sub project_url_peg {
+  my $self = shift;
+
+  if (@_) {
+    my $url = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->project_url_peg or $url ne $self->project_url_peg) {
+      my $pegrev = ($url =~ s/@($rev_pattern)$//i) ? $1 : '';
+
+      $url .= '/' . $self->branch if $self->branch;
+      $url .= '/' . $self->subdir if $self->subdir;
+      $url .= '@' . $pegrev       if $pegrev;
+
+      $self->url_peg ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return $self->{PROJECT} . ($self->pegrev ? '@' . $self->pegrev : '');
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_url->project_url ();
+#   $cm_url->project_url ($url);
+#
+# DESCRIPTION
+#   The method returns the URL of the "project" part of the current URL. If an
+#   argument is specified, the URL of the "project" part of the current URL is
+#   re-set.
+# ------------------------------------------------------------------------------
+
+sub project_url {
+  my $self = shift;
+
+  if (@_) {
+    my $url = shift;
+    $url =~ s/@($rev_pattern)$//i;
+
+    # Re-construct URL is necessary
+    if (! $self->project_url or $url ne $self->project_url) {
+      $url .= '/' . $self->branch if $self->branch;
+      $url .= '/' . $self->subdir if $self->subdir;
+
+      $self->url ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return $self->{PROJECT};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $path = $cm_url->project_path ();
+#   $cm_url->project_path ($path);
+#
+# DESCRIPTION
+#   The method returns the path of the "project" part of the current URL. If an
+#   argument is specified, the path of the "project" part of the current URL is
+#   re-set.
+# ------------------------------------------------------------------------------
+
+sub project_path {
+  my $self = shift;
+
+  # Repository root
+  my $root = $self->root;
+  $root    = substr (
+    $self->project_url,
+    0,
+    length ($self->project_url) - length ($self->project) - 1
+  ) if not $root;
+
+  if (@_) {
+    my $path = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->project_path or $path ne $self->project_path) {
+      $path .= '/' . $self->branch if $self->branch;
+      $path .= '/' . $self->subdir if $self->subdir;
+
+      $self->path ($path);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return substr ($self->{PROJECT}, length ($root));
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $name = $cm_url->project ();
+#   $cm_url->project ($name);
+#
+# DESCRIPTION
+#   The method returns the basename of the "project" part of the current URL.
+#   If an argument is specified, the basename of the "project" part of the
+#   current URL is re-set.
+# ------------------------------------------------------------------------------
+
+sub project {
+  my $self = shift;
+
+  if (@_) {
+    my $name = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->project or $name ne $self->project) {
+      my $url = '';
+      if ($self->project) {
+        $url =  $self->project;
+        $url =~ s#/[^/]+$##;
+
+      } else {
+        $url =  $self->root;
+      }
+
+      $url .=  '/' . $name;
+      $url .=  '/' . $self->branch if $self->branch;
+      $url .=  '/' . $self->subdir if $self->subdir;
+      $url .=  '@' . $self->pegrev if $self->pegrev;
+
+      $self->url_peg ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  my $name = $self->{PROJECT};
+  $name =~ s#^.*/([^/]+)$#$1# if $name;
+
+  return $name;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_url->branch_url_peg ();
+#   $cm_url->branch_url_peg ($url);
+#
+# DESCRIPTION
+#   The method returns the URL@PEG of the "branch" part of the current URL. If
+#   an argument is specified, the URL@PEG of the "branch" part of the current
+#   URL is re-set.
+# ------------------------------------------------------------------------------
+
+sub branch_url_peg {
+  my $self = shift;
+
+  if (@_) {
+    my $url = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->branch_url_peg or $url ne $self->branch_url_peg) {
+      my $pegrev = ($url =~ s/@($rev_pattern)$//i) ? $1 : '';
+
+      $url .= '/' . $self->subdir if $self->subdir;
+      $url .= '@' . $pegrev       if $pegrev;
+
+      $self->url_peg ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return $self->project_url . '/' . $self->branch .
+         ($self->pegrev ? '@' . $self->pegrev : '');
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_url->branch_url ();
+#   $cm_url->branch_url ($url);
+#
+# DESCRIPTION
+#   The method returns the URL of the "branch" part of the current URL. If an
+#   argument is specified, the URL of the "branch" part of the current URL is
+#   re-set.
+# ------------------------------------------------------------------------------
+
+sub branch_url {
+  my $self = shift;
+
+  if (@_) {
+    my $url = shift;
+    $url =~ s/@($rev_pattern)$//i;
+
+    # Re-construct URL is necessary
+    if (! $self->branch_url or $url ne $self->branch_url) {
+      $url .= '/' . $self->subdir if $self->subdir;
+
+      $self->url ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return $self->project_url . '/' . $self->branch;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $path = $cm_url->branch_path ();
+#   $cm_url->branch_path ($path);
+#
+# DESCRIPTION
+#   The method returns the path of the "branch" part of the current URL. If an
+#   argument is specified, the path of the "branch" part of the current URL is
+#   re-set.
+# ------------------------------------------------------------------------------
+
+sub branch_path {
+  my $self = shift;
+
+  if (@_) {
+    my $path = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->branch_path or $path ne $self->branch_path) {
+      $path .= '/' . $self->subdir if $self->subdir;
+
+      $self->path ($path);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return ($self->branch ? $self->project_path . '/' . $self->branch : undef);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $branch = $cm_url->branch ();
+#   $cm_url->branch ($branch);
+#
+# DESCRIPTION
+#   The method returns the "branch" part of the current URL. If an argument is
+#   specified, the "branch" part of the current URL is re-set.
+# ------------------------------------------------------------------------------
+
+sub branch {
+  my $self = shift;
+
+  if (@_) {
+    my $branch = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->branch or $branch ne $self->branch) {
+      my $url = $self->project_url;
+      $url   .= '/' . $branch;
+      $url   .= '/' . $self->subdir if $self->subdir;
+
+      $self->url ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return $self->{BRANCH};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $obj->branch_owner;
+#
+# DESCRIPTION
+#   This method returns the owner of the branch.
+# ------------------------------------------------------------------------------
+
+sub branch_owner {
+  my $self = shift;
+  my $return;
+
+  if ($self->is_branch and $self->branch_url =~ m#/([^/]+)/[^/]+/*$#) {
+    my $user = $1;
+    $return = $user;
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_url->is_trunk ();
+#
+# DESCRIPTION
+#   The method returns true if the the current URL is (a sub-tree of) the trunk.
+# ------------------------------------------------------------------------------
+
+sub is_trunk {
+  my $self = shift;
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return ($self->branch and $self->branch eq 'trunk');
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_url->is_branch ();
+#
+# DESCRIPTION
+#   The method returns true if the the current URL is (a sub-tree of) a branch.
+# ------------------------------------------------------------------------------
+
+sub is_branch {
+  my $self = shift;
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return ($self->branch and $self->branch =~ m#^branches/#);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_url->is_tag ();
+#
+# DESCRIPTION
+#   The method returns true if the the current URL is (a sub-tree of) a tag.
+# ------------------------------------------------------------------------------
+
+sub is_tag {
+  my $self = shift;
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return ($self->branch and $self->branch =~ m#^tags/#);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $subdir = $cm_url->subdir ();
+#   $cm_url->subdir ($subdir);
+#
+# DESCRIPTION
+#   The method returns the "subdir" part of the current URL. If an argument is
+#   specified, the "subdir" part of the current URL is re-set.
+# ------------------------------------------------------------------------------
+
+sub subdir {
+  my $self = shift;
+
+  if (@_) {
+    my $subdir = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->subdir or $subdir ne $self->subdir) {
+      my $url = $self->project_url;
+      $url   .= '/' . $self->branch if $self->branch;
+      $url   .= '/' . $subdir if $subdir;
+
+      $self->url ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return $self->{SUBDIR};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_url->url ();
+#   $cm_url->url ($url);
+#
+# DESCRIPTION
+#   The method returns the URL without the "peg revision" part. If an argument
+#   is specified, the URL is re-set without modifying the "peg revision" part.
+# ------------------------------------------------------------------------------
+
+sub url {
+  my $self = shift;
+
+  if (@_) {
+    my $url = shift;
+    $url    =~ s/@($rev_pattern)$//i;
+
+    # Re-construct URL if necessary
+    if (! $self->url or $url ne $self->url) {
+      $self->url_peg ($url . ($self->pegrev ? '@' . $self->pegrev : ''));
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  (my $url = $self->url_peg) =~ s/@($rev_pattern)$//i;
+
+  return $url;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $path = $cm_url->path ();
+#   $cm_url->path ($path);
+#
+# DESCRIPTION
+#   The method returns the "path" part of the URL (i.e. URL without the
+#   "root" part). If an argument is specified, the "path" part of the URL is
+#   re-set.
+# ------------------------------------------------------------------------------
+
+sub path {
+  my $self = shift;
+
+  # Repository root
+  my $root = $self->root;
+  $root    = substr (
+    $self->project_url,
+    0,
+    length ($self->project_url) - length ($self->project) - 1
+  ) if not $root;
+
+  if (@_) {
+    my $path = shift;
+    $path    =~ s/@($rev_pattern)$//i;
+
+    # Re-construct URL is necessary
+    if (! $self->path or $path ne $self->path) {
+      my $url = ($root . (substr ($path, 0, 1) eq '/' ? '' : '/') . $path);
+      $self->url ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return substr ($self->url, length ($root));
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $path = $cm_url->path_peg ();
+#   $cm_url->path_peg ($path);
+#
+# DESCRIPTION
+#   The method returns the PATH@PEG part of the URL (i.e. URL without the
+#   "root" part). If an argument is specified, the PATH@PEG part of the URL is
+#   re-set.
+# ------------------------------------------------------------------------------
+
+sub path_peg {
+  my $self = shift;
+
+  # Repository root
+  my $root = $self->root;
+  $root    = substr (
+    $self->project_url,
+    0,
+    length ($self->project_url) - length ($self->project) - 1
+  ) if not $root;
+
+  if (@_) {
+    my $path = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->path_peg or $path ne $self->path_peg) {
+      my $url = ($root . (substr ($path, 0, 1) eq '/' ? '' : '/') . $path);
+      $self->url_peg ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return substr ($self->url_peg, length ($root));
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rev = $cm_url->pegrev ();
+#   $cm_url->pegrev ($rev);
+#
+# DESCRIPTION
+#   The method returns the "peg revision" part of the current URL. If an
+#   argument is specified, the "peg revision" part of the current URL is
+#   re-set.
+# ------------------------------------------------------------------------------
+
+sub pegrev {
+  my $self = shift;
+
+  if (@_) {
+    my $pegrev = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->pegrev or $pegrev ne $self->pegrev) {
+      $self->url_peg ($self->url . ($pegrev ? '@' . $pegrev : ''));
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return $self->{PEGREV};
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Config.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Config.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Config.pm	(revision 2528)
@@ -0,0 +1,894 @@
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::Config
+#
+# DESCRIPTION
+#   This is a class for reading and processing central and user configuration
+#   settings for FCM.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::Config;
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+use File::Basename;
+use File::Spec::Functions;
+use FindBin;
+use POSIX qw/setlocale LC_ALL/;
+
+# FCM component modules
+use Fcm::CfgFile;
+
+# Other declarations:
+sub _get_hash_value;
+
+# Delimiter for setting and for list
+our $DELIMITER         = '::';
+our $DELIMITER_PATTERN = qr{::|/};
+our $DELIMITER_LIST    = ',';
+
+my $INSTANCE;
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config = Fcm::Config->instance();
+#
+# DESCRIPTION
+#   Returns an instance of this class.
+# ------------------------------------------------------------------------------
+
+sub instance {
+    my ($class) = @_;
+    if (!defined($INSTANCE)) {
+        $INSTANCE = $class->new();
+        $INSTANCE->get_config();
+        $INSTANCE->is_initialising(0);
+    }
+    return $INSTANCE;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = Fcm::Config->new (VERBOSE => $verbose);
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::Config class.
+#
+# ARGUMENTS
+#   VERBOSE - Set the verbose level of diagnostic output
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  # Ensure that all subsequent Subversion output is in UK English
+  if (setlocale (LC_ALL, 'en_GB')) {
+    $ENV{LANG} = 'en_GB';
+  }
+
+  my $self = {
+    initialising   => 1,
+    central_config => undef,
+    user_config    => undef,
+    user_id        => undef,
+    verbose        => exists $args{VERBOSE} ? $args{VERBOSE} : undef,
+    variable       => {},
+
+    # Primary settings
+    setting => {
+      # Current command
+      FCM_COMMAND => &basename ($0),
+
+      # Current FCM release identifier
+      FCM_RELEASE => '1-5',
+
+      # Location of file with the last changed revision of the FCM trunk
+      FCM_REV_FILE => catfile (dirname ($FindBin::Bin), 'etc', 'fcm_rev'),
+
+      # Fortran BLOCKDATA dependencies
+      BLD_BLOCKDATA => {},
+
+      # Copy dummy target
+      BLD_CPDUMMY => '$(FCM_DONEDIR)/FCM_CP.dummy',
+
+      # No dependency check
+      BLD_DEP_N => {},
+
+      # Additional (PP) dependencies
+      BLD_DEP => {},
+      BLD_DEP_PP => {},
+
+      # Excluded dependency
+      BLD_DEP_EXCL => {
+        '' => [
+          # Fortran intrinsic modules
+          'USE' . $DELIMITER . 'ISO_C_BINDING',
+          'USE' . $DELIMITER . 'IEEE_EXCEPTIONS',
+          'USE' . $DELIMITER . 'IEEE_ARITHMETIC',
+          'USE' . $DELIMITER . 'IEEE_FEATURES',
+
+          # Fortran intrinsic subroutines
+          'OBJ' . $DELIMITER . 'CPU_TIME',
+          'OBJ' . $DELIMITER . 'GET_COMMAND',
+          'OBJ' . $DELIMITER . 'GET_COMMAND_ARGUMENT',
+          'OBJ' . $DELIMITER . 'GET_ENVIRONMENT_VARIABLE',
+          'OBJ' . $DELIMITER . 'MOVE_ALLOC',
+          'OBJ' . $DELIMITER . 'MVBITS',
+          'OBJ' . $DELIMITER . 'RANDOM_NUMBER',
+          'OBJ' . $DELIMITER . 'RANDOM_SEED',
+          'OBJ' . $DELIMITER . 'SYSTEM_CLOCK',
+
+          # Dummy statements
+          'OBJ' . $DELIMITER . 'NONE',
+          'EXE' . $DELIMITER . 'NONE',
+        ],
+      },
+
+      # Extra executable dependencies
+      BLD_DEP_EXE => {},
+
+      # Dependency pattern for each type
+      BLD_DEP_PATTERN => {
+        H         => q/^#\s*include\s*['"](\S+)['"]/,
+        USE       => q/^\s*use\s+(\w+)/,
+        INTERFACE => q/^#?\s*include\s+['"](\S+##OUTFILE_EXT/ . $DELIMITER .
+                     q/INTERFACE##)['"]/,
+        INC       => q/^\s*include\s+['"](\S+)['"]/,
+        OBJ       => q#^\s*(?:/\*|!)\s*depends\s*on\s*:\s*(\S+)#,
+        EXE       => q/^\s*(?:#|;)\s*(?:calls|list|if|interface)\s*:\s*(\S+)/,
+      },
+
+      # Rename main program targets
+      BLD_EXE_NAME => {},
+
+      # Rename library targets
+      BLD_LIB => {'' => 'fcm_default'},
+
+      # Name of Makefile and run environment shell script
+      BLD_MISC => {
+        'BLDMAKEFILE' => 'Makefile',
+        'BLDRUNENVSH' => 'fcm_env.sh',
+      },
+
+      # PP flags
+      BLD_PP => {},
+
+      # Custom source file type
+      BLD_TYPE => {},
+
+      # Types that always need to be built
+      BLD_TYPE_ALWAYS_BUILD =>                   'PVWAVE' .
+                               $DELIMITER_LIST . 'GENLIST' .
+                               $DELIMITER_LIST . 'SQL',
+
+      # Dependency scan types
+      BLD_TYPE_DEP => {
+        FORTRAN =>              'USE' .
+                   $DELIMITER . 'INTERFACE' .
+                   $DELIMITER . 'INC' .
+                   $DELIMITER . 'OBJ',
+        FPP     =>              'USE' .
+                   $DELIMITER . 'INTERFACE' .
+                   $DELIMITER . 'INC' .
+                   $DELIMITER . 'H' .
+                   $DELIMITER . 'OBJ',
+        CPP     =>              'H' .
+                   $DELIMITER . 'OBJ',
+        C       =>              'H' .
+                   $DELIMITER . 'OBJ',
+        SCRIPT  =>              'EXE',
+      },
+
+      # Dependency scan types for pre-processing
+      BLD_TYPE_DEP_PP => {
+        FPP => 'H',
+        CPP => 'H',
+        C   => 'H',
+      },
+
+      # Types that cannot have duplicated targets
+      BLD_TYPE_NO_DUPLICATED_TARGET => '',
+
+      # BLD_VPATH, each value must be a comma separate list
+      # ''     translates to %
+      # 'FLAG' translates to {OUTFILE_EXT}{FLAG}
+      BLD_VPATH   => {
+        BIN   => q{},
+        ETC   => 'ETC',
+        DONE  => join($DELIMITER_LIST, qw{DONE IDONE}),
+        FLAGS => 'FLAGS',
+        INC   => q{},
+        LIB   => 'LIB',
+        OBJ   => 'OBJ',
+      },
+
+      # Cache basename
+      CACHE          => '.config',
+      CACHE_DEP      => '.config_dep',
+      CACHE_DEP_PP   => '.config_dep_pp',
+      CACHE_FILE_SRC => '.config_file_src',
+
+      # Types of "inc" statements expandable CFG files
+      CFG_EXP_INC =>                   'BLD' .
+                     $DELIMITER_LIST . 'EXT' .
+                     $DELIMITER_LIST . 'FCM',
+
+      # Configuration file labels that can be declared more than once
+      CFG_KEYWORD =>                   'USE' .
+                     $DELIMITER_LIST . 'INC' .
+                     $DELIMITER_LIST . 'TARGET' .
+                     $DELIMITER_LIST . 'BLD_DEP_EXCL',
+
+      # Labels for all types of FCM configuration files
+      CFG_LABEL => {
+        CFGFILE => 'CFG', # config file information
+        INC     => 'INC', # "include" from an configuration file
+
+        # Labels for central/user internal config setting
+        SETTING => 'SET',
+
+        # Labels for systems that allow inheritance
+        DEST => 'DEST', # destination
+        USE  => 'USE',  # use (inherit) a previous configuration
+
+        # Labels for bld and pck cfg
+        TARGET => 'TARGET', # BLD: declare targets, PCK: target of source file
+
+        # Labels for bld cfg
+        BLD_BLOCKDATA => 'BLOCKDATA',   # declare Fortran BLOCKDATA dependencies
+        BLD_DEP       => 'DEP',         # additional dependencies
+        BLD_DEP_N     => 'NO_DEP',      # no dependency check
+        BLD_DEP_EXCL  => 'EXCL_DEP',    # exclude automatic dependencies
+        BLD_DEP_EXE   => 'EXE_DEP',     # declare dependencies for program
+        BLD_EXE_NAME  => 'EXE_NAME',    # rename a main program
+        BLD_LIB       => 'LIB',         # rename library
+        BLD_PP        => 'PP',          # sub-package needs pre-process?
+        BLD_TYPE      => 'SRC_TYPE',    # custom source file type
+        DIR           => 'DIR',         # DEPRECATED, same as DEST
+        INFILE_EXT    => 'INFILE_EXT',  # change input file name extension type
+        INHERIT       => 'INHERIT',     # inheritance flag
+        NAME          => 'NAME',        # name the build
+        OUTFILE_EXT   => 'OUTFILE_EXT', # change output file type extension
+        FILE          => 'SRC',         # declare a sub-package
+        SEARCH_SRC    => 'SEARCH_SRC',  # search src/ sub-directory?
+        TOOL          => 'TOOL',        # declare a tool
+
+        # Labels for ext cfg
+        BDECLARE   => 'BLD',      # build declaration
+        CONFLICT   => 'CONFLICT', # set conflict mode
+        DIRS       => 'SRC',      # declare source directory
+        EXPDIRS    => 'EXPSRC',   # declare expandable source directory
+        MIRROR     => 'MIRROR',   # DEPRECATED, same as RDEST::MIRROR_CMD
+        OVERRIDE   => 'OVERRIDE', # DEPRECATED, replaced by CONFLICT
+        RDEST      => 'RDEST',    # declare remote destionation
+        REVISION   => 'REVISION', # declare branch revision in a project
+        REVMATCH   => 'REVMATCH', # branch revision must match changed revision
+        REPOS      => 'REPOS',    # declare branch in a project
+        VERSION    => 'VERSION',  # DEPRECATED, same as REVISION
+      },
+
+      # Default names of known FCM configuration files
+      CFG_NAME => {
+        BLD        => 'bld.cfg',      # build configuration file
+        EXT        => 'ext.cfg',      # extract configuration file
+        PARSED     => 'parsed_',      # as-parsed configuration file prefix
+      },
+
+      # Latest version of known FCM configuration files
+      CFG_VERSION => {
+        BLD        => '1.0', # bld cfg
+        EXT        => '1.0', # ext cfg
+      },
+
+      # Standard sub-directories for extract/build
+      DIR => {
+        BIN    => 'bin',    # executable
+        BLD    => 'bld',    # build
+        CACHE  => '.cache', # cache
+        CFG    => 'cfg',    # configuration
+        DONE   => 'done',   # "done"
+        ETC    => 'etc',    # miscellaneous items
+        FLAGS  => 'flags',  # "flags"
+        INC    => 'inc',    # include
+        LIB    => 'lib',    # library
+        OBJ    => 'obj',    # object
+        PPSRC  => 'ppsrc',  # pre-processed source
+        SRC    => 'src',    # source
+        TMP    => 'tmp',    # temporary directory
+      },
+
+      # A flag to indicate whether the revision of a given branch for extract
+      # must match with the revision of a changed revision of the branch
+      EXT_REVMATCH => 0, # default is false (allow any revision)
+
+      # Input file name extension and type
+      # (may overlap with output (below) and vpath (above))
+      INFILE_EXT => {
+        # General extensions
+        'f'    =>              'FORTRAN' .
+                  $DELIMITER . 'SOURCE',
+        'for'  =>              'FORTRAN' .
+                  $DELIMITER . 'SOURCE',
+        'ftn'  =>              'FORTRAN' .
+                  $DELIMITER . 'SOURCE',
+        'f77'  =>              'FORTRAN' .
+                  $DELIMITER . 'SOURCE',
+        'f90'  =>              'FORTRAN' .
+                  $DELIMITER . 'FORTRAN9X' .
+                  $DELIMITER . 'SOURCE',
+        'f95'  =>              'FORTRAN' .
+                  $DELIMITER . 'FORTRAN9X' .
+                  $DELIMITER . 'SOURCE',
+        'F'    =>              'FPP' .
+                  $DELIMITER . 'SOURCE',
+        'FOR'  =>              'FPP' .
+                  $DELIMITER . 'SOURCE',
+        'FTN'  =>              'FPP' .
+                  $DELIMITER . 'SOURCE',
+        'F77'  =>              'FPP' .
+                  $DELIMITER . 'SOURCE',
+        'F90'  =>              'FPP' .
+                  $DELIMITER . 'FPP9X' .
+                  $DELIMITER . 'SOURCE',
+        'F95'  =>              'FPP' .
+                  $DELIMITER . 'FPP9X' .
+                  $DELIMITER . 'SOURCE',
+        'c'    =>              'C' .
+                  $DELIMITER . 'SOURCE',
+        'cpp'  =>              'C' .
+                  $DELIMITER . 'C++' .
+                  $DELIMITER . 'SOURCE',
+        'h'    =>              'CPP' .
+                  $DELIMITER . 'INCLUDE',
+        'o'    =>              'BINARY' .
+                  $DELIMITER . 'OBJ',
+        'obj'  =>              'BINARY' .
+                  $DELIMITER . 'OBJ',
+        'exe'  =>              'BINARY' .
+                  $DELIMITER . 'EXE',
+        'a'    =>              'BINARY' .
+                  $DELIMITER . 'LIB',
+        'sh'   =>              'SCRIPT' .
+                  $DELIMITER . 'SHELL',
+        'ksh'  =>              'SCRIPT' .
+                  $DELIMITER . 'SHELL',
+        'bash' =>              'SCRIPT' .
+                  $DELIMITER . 'SHELL',
+        'csh'  =>              'SCRIPT' .
+                  $DELIMITER . 'SHELL',
+        'pl'   =>              'SCRIPT' .
+                  $DELIMITER . 'PERL',
+        'pm'   =>              'SCRIPT' .
+                  $DELIMITER . 'PERL',
+        'py'   =>              'SCRIPT' .
+                  $DELIMITER . 'PYTHON',
+        'tcl'  =>              'SCRIPT' .
+                  $DELIMITER . 'TCL',
+        'pro'  =>              'SCRIPT' .
+                  $DELIMITER . 'PVWAVE',
+
+        # Local extensions
+        'cfg'       =>              'CFGFILE',
+        'h90'       =>              'CPP' .
+                       $DELIMITER . 'INCLUDE',
+        'inc'       =>              'FORTRAN' .
+                       $DELIMITER . 'FORTRAN9X' .
+                       $DELIMITER . 'INCLUDE',
+        'interface' =>              'FORTRAN' .
+                       $DELIMITER . 'FORTRAN9X' .
+                       $DELIMITER . 'INCLUDE' .
+                       $DELIMITER . 'INTERFACE',
+      },
+
+      # Ignore input files matching the following names (comma-separated list)
+      INFILE_IGNORE =>                   'fcm_env.ksh' .
+                       $DELIMITER_LIST . 'fcm_env.sh',
+
+      # Input file name pattern and type
+      INFILE_PAT => {
+        '\w+Scr_\w+'              =>              'SCRIPT' .
+                                     $DELIMITER . 'SHELL',
+        '\w+Comp_\w+'             =>              'SCRIPT' .
+                                     $DELIMITER . 'SHELL' .
+                                     $DELIMITER . 'GENTASK',
+        '\w+(?:IF|Interface)_\w+' =>              'SCRIPT' .
+                                     $DELIMITER . 'SHELL' .
+                                     $DELIMITER . 'GENIF',
+        '\w+Suite_\w+'            =>              'SCRIPT' .
+                                     $DELIMITER . 'SHELL' .
+                                     $DELIMITER . 'GENSUITE',
+        '\w+List_\w+'             =>              'SCRIPT' .
+                                     $DELIMITER . 'SHELL' .
+                                     $DELIMITER . 'GENLIST',
+        '\w+Sql_\w+'              =>              'SCRIPT' .
+                                     $DELIMITER . 'SQL',
+      },
+
+      # Input text file pattern and type
+      INFILE_TXT => {
+        '(?:[ck]|ba)?sh'  =>              'SCRIPT' .
+                             $DELIMITER . 'SHELL',
+        'perl'            =>              'SCRIPT' .
+                             $DELIMITER . 'PERL',
+        'python'          =>              'SCRIPT' .
+                             $DELIMITER . 'PYTHON',
+        'tcl(?:sh)?|wish' =>              'SCRIPT' .
+                             $DELIMITER . 'TCL',
+      },
+
+      # Lock file
+      LOCK => {
+        BLDLOCK => 'fcm.bld.lock', # build lock file
+        EXTLOCK => 'fcm.ext.lock', # extract lock file
+      },
+
+      # Output file type and extension
+      # (may overlap with input and vpath (above))
+      OUTFILE_EXT => {
+        CFG       => '.cfg',       # FCM configuration file
+        DONE      => '.done',      # "done" files for compiled source
+        ETC       => '.etc',       # "etc" dummy file
+        EXE       => '.exe',       # binary executables
+        FLAGS     => '.flags',     # "flags" files, compiler flags config
+        IDONE     => '.idone',     # "done" files for included source
+        INTERFACE => '.interface', # interface for F90 subroutines/functions
+        LIB       => '.a',         # archive object library
+        MOD       => '.mod',       # compiled Fortran module information files
+        OBJ       => '.o',         # compiled object files
+        PDONE     => '.pdone',     # "done" files for pre-processed files
+        TAR       => '.tar',       # TAR archive
+      },
+
+      # Build commands and options (i.e. tools)
+      TOOL => {
+        SHELL        => '/bin/sh',         # Default shell
+
+        CPP          => 'cpp',             # C pre-processor
+        CPPFLAGS     => '-C',              # CPP flags
+        CPP_INCLUDE  => '-I',              # CPP flag, specify "include" path
+        CPP_DEFINE   => '-D',              # CPP flag, define macro
+        CPPKEYS      => '',                # CPP keys (definition macro)
+
+        CC           => 'cc',              # C compiler
+        CFLAGS       => '',                # CC flags
+        CC_COMPILE   => '-c',              # CC flag, compile only
+        CC_OUTPUT    => '-o',              # CC flag, specify output file name
+        CC_INCLUDE   => '-I',              # CC flag, specify "include" path
+        CC_DEFINE    => '-D',              # CC flag, define macro
+
+        FPP          => 'cpp',             # Fortran pre-processor
+        FPPFLAGS     => '-P -traditional', # FPP flags
+        FPP_INCLUDE  => '-I',              # FPP flag, specify "include" path
+        FPP_DEFINE   => '-D',              # FPP flag, define macro
+        FPPKEYS      => '',                # FPP keys (definition macro)
+
+        FC           => 'f90',             # Fortran compiler
+        FFLAGS       => '',                # FC flags
+        FC_COMPILE   => '-c',              # FC flag, compile only
+        FC_OUTPUT    => '-o',              # FC flag, specify output file name
+        FC_INCLUDE   => '-I',              # FC flag, specify "include" path
+        FC_MODSEARCH => '',                # FC flag, specify "module" path
+        FC_DEFINE    => '-D',              # FC flag, define macro
+
+        LD           => '',                # linker
+        LDFLAGS      => '',                # LD flags
+        LD_OUTPUT    => '-o',              # LD flag, specify output file name
+        LD_LIBSEARCH => '-L',              # LD flag, specify "library" path
+        LD_LIBLINK   => '-l',              # LD flag, specify link library
+
+        AR           => 'ar',              # library archiver
+        ARFLAGS      => 'rs',              # AR flags
+
+        MAKE         => 'make',            # make command
+        MAKEFLAGS    => '',                # make flags
+        MAKE_FILE    => '-f',              # make flag, path to Makefile
+        MAKE_SILENT  => '-s',              # make flag, silent diagnostic
+        MAKE_JOB     => '-j',              # make flag, number of jobs
+
+        INTERFACE    => 'file',            # name interface after file/program
+        GENINTERFACE => '',                # Fortran 9x interface generator
+
+        DIFF3        => 'diff3',           # extract diff3 merge
+        DIFF3FLAGS   => '-E -m',           # DIFF3 flags
+        GRAPHIC_DIFF => 'xxdiff',          # graphical diff tool
+        GRAPHIC_MERGE=> 'xxdiff',          # graphical merge tool
+      },
+
+      # List of tools that are local to FCM, (will not be exported to a Makefile)
+      TOOL_LOCAL =>                   'CPP' .
+                    $DELIMITER_LIST . 'CPPFLAGS' .
+                    $DELIMITER_LIST . 'CPP_INCLUDE' .
+                    $DELIMITER_LIST . 'CPP_DEFINE' .
+                    $DELIMITER_LIST . 'DIFF3' .
+                    $DELIMITER_LIST . 'DIFF3_FLAGS' .
+                    $DELIMITER_LIST . 'FPP' .
+                    $DELIMITER_LIST . 'FPPFLAGS' .
+                    $DELIMITER_LIST . 'FPP_INCLUDE' .
+                    $DELIMITER_LIST . 'FPP_DEFINE' .
+                    $DELIMITER_LIST . 'GRAPHIC_DIFF' .
+                    $DELIMITER_LIST . 'GRAPHIC_MERGE' .
+                    $DELIMITER_LIST . 'MAKE' .
+                    $DELIMITER_LIST . 'MAKEFLAGS' .
+                    $DELIMITER_LIST . 'MAKE_FILE' .
+                    $DELIMITER_LIST . 'MAKE_SILENT' .
+                    $DELIMITER_LIST . 'MAKE_JOB' .
+                    $DELIMITER_LIST . 'INTERFACE' .
+                    $DELIMITER_LIST . 'GENINTERFACE' .
+                    $DELIMITER_LIST . 'MIRROR' .
+                    $DELIMITER_LIST . 'REMOTE_SHELL',
+
+      # List of tools that allow sub-package declarations
+      TOOL_PACKAGE =>                   'CPPFLAGS' .
+                      $DELIMITER_LIST . 'CPPKEYS' .
+                      $DELIMITER_LIST . 'CFLAGS' .
+                      $DELIMITER_LIST . 'FPPFLAGS' .
+                      $DELIMITER_LIST . 'FPPKEYS' .
+                      $DELIMITER_LIST . 'FFLAGS' .
+                      $DELIMITER_LIST . 'LD' .
+                      $DELIMITER_LIST . 'LDFLAGS' .
+                      $DELIMITER_LIST . 'INTERFACE' .
+                      $DELIMITER_LIST . 'GENINTERFACE',
+
+      # Supported tools for compilable source
+      TOOL_SRC_PP => {
+        FPP     => {
+          COMMAND => 'FPP',
+          FLAGS   => 'FPPFLAGS',
+          PPKEYS  => 'FPPKEYS',
+          INCLUDE => 'FPP_INCLUDE',
+          DEFINE  => 'FPP_DEFINE',
+        },
+
+        C       => {
+          COMMAND => 'CPP',
+          FLAGS   => 'CPPFLAGS',
+          PPKEYS  => 'CPPKEYS',
+          INCLUDE => 'CPP_INCLUDE',
+          DEFINE  => 'CPP_DEFINE',
+        },
+      },
+
+      # Supported tools for compilable source
+      TOOL_SRC => {
+        FORTRAN => {
+          COMMAND => 'FC',
+          FLAGS   => 'FFLAGS',
+          OUTPUT  => 'FC_OUTPUT',
+          INCLUDE => 'FC_INCLUDE',
+        },
+
+        FPP     => {
+          COMMAND => 'FC',
+          FLAGS   => 'FFLAGS',
+          PPKEYS  => 'FPPKEYS',
+          OUTPUT  => 'FC_OUTPUT',
+          INCLUDE => 'FC_INCLUDE',
+          DEFINE  => 'FC_DEFINE',
+        },
+
+        C       => {
+          COMMAND => 'CC',
+          FLAGS   => 'CFLAGS',
+          PPKEYS  => 'CPPKEYS',
+          OUTPUT  => 'CC_OUTPUT',
+          INCLUDE => 'CC_INCLUDE',
+          DEFINE  => 'CC_DEFINE',
+        },
+      },
+
+      # FCM URL keyword and prefix, FCM revision keyword, and FCM Trac URL
+      URL          => {},
+      URL_REVISION => {},
+
+      URL_BROWSER_MAPPING => {},
+      URL_BROWSER_MAPPING_DEFAULT => {
+        LOCATION_COMPONENT_PATTERN
+        => qr{\A // ([^/]+) /+ ([^/]+)_svn /+(.*) \z}xms,
+        BROWSER_URL_TEMPLATE
+        => 'http://{1}/projects/{2}/intertrac/source:{3}{4}',
+        BROWSER_REV_TEMPLATE => '@{1}',
+      },
+
+      # Default web browser
+      WEB_BROWSER   => 'firefox',
+    },
+  };
+
+  # Backward compatibility: the REPOS setting is equivalent to the URL setting
+  $self->{setting}{REPOS} = $self->{setting}{URL};
+
+  # Alias the REVISION and TRAC setting to URL_REVISION and URL_TRAC
+  $self->{setting}{REVISION} = $self->{setting}{URL_REVISION};
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in the "new" method.
+# ------------------------------------------------------------------------------
+
+for my $name (qw/central_config user_config user_id verbose/) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    # Argument specified, set property to specified argument
+    if (@_) {
+      $self->{$name} = $_[0];
+    }
+
+    # Default value for property
+    if (not defined $self->{$name}) {
+      if ($name eq 'central_config') {
+        # Central configuration file
+        if (-r catfile (dirname ($FindBin::Bin), 'etc', 'fcm.cfg')) {
+          $self->{$name} = catfile (
+            dirname ($FindBin::Bin), 'etc', 'fcm.cfg'
+          );
+
+        } elsif (-r catfile ($FindBin::Bin, 'fcm.cfg')) {
+          $self->{$name} = catfile ($FindBin::Bin, 'fcm.cfg');
+        }
+
+      } elsif ($name eq 'user_config') {
+        # User configuration file
+        my $home = (getpwuid ($<))[7];
+        $home = $ENV{HOME} if not defined $home;
+        $self->{$name} = catfile ($home, '.fcm')
+          if defined ($home) and -r catfile ($home, '.fcm');
+
+      } elsif ($name eq 'user_id') {
+        # User ID of current process
+        my $user = (getpwuid ($<))[0];
+        $user = $ENV{LOGNAME} if not defined $user;
+        $user = $ENV{USER} if not defined $user;
+        $self->{$name} = $user;
+
+      } elsif ($name eq 'verbose') {
+        # Verbose mode
+        $self->{$name} = exists $ENV{FCM_VERBOSE} ? $ENV{FCM_VERBOSE} : 1;
+      }
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $obj->is_initialising();
+#
+# DESCRIPTION
+#   Returns true if this object is initialising.
+# ------------------------------------------------------------------------------
+sub is_initialising {
+  my ($self, $value) = @_;
+  if (defined($value)) {
+    $self->{initialising} = $value;
+  }
+  return $self->{initialising};
+}
+
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %hash = %{ $obj->X () };
+#   $obj->X (\%hash);
+#
+#   $value = $obj->X ($index);
+#   $obj->X ($index, $value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in the "new" method.
+#
+#   If no argument is set, this method returns a hash containing a list of
+#   objects. If an argument is set and it is a reference to a hash, the objects
+#   are replaced by the the specified hash.
+#
+#   If a scalar argument is specified, this method returns a reference to an
+#   object, if the indexed object exists or undef if the indexed object does
+#   not exist. If a second argument is set, the $index element of the hash will
+#   be set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+for my $name (qw/variable/) {
+  no strict 'refs';
+
+  *$name = sub {
+    my ($self, $arg1, $arg2) = @_;
+
+    # Ensure property is defined as a reference to a hash
+    $self->{$name} = {} if not defined ($self->{$name});
+
+    # Argument 1 can be a reference to a hash or a scalar index
+    my ($index, %hash);
+
+    if (defined $arg1) {
+      if (ref ($arg1) eq 'HASH') {
+        %hash = %$arg1;
+
+      } else {
+        $index = $arg1;
+      }
+    }
+
+    if (defined $index) {
+      # A scalar index is defined, set and/or return the value of an element
+      $self->{$name}{$index} = $arg2 if defined $arg2;
+
+      return (
+        exists $self->{$name}{$index} ? $self->{$name}{$index} : undef
+      );
+
+    } else {
+      # A scalar index is not defined, set and/or return the hash
+      $self->{$name} = \%hash if defined $arg1;
+      return $self->{$name};
+    }
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $setting = $obj->setting (@labels);
+#   $obj->setting (\@labels, $setting);
+#
+# DESCRIPTION
+#   This method returns/sets an item under the setting hash table. The depth
+#   within the hash table is given by the list of arguments @labels, which
+#   should match with the keys in the multi-dimension setting hash table.
+# ------------------------------------------------------------------------------
+
+sub setting {
+  my $self = shift;
+
+  if (@_) {
+    my $arg1 = shift;
+    my $s    = $self->{setting};
+
+    if (ref ($arg1) eq 'ARRAY') {
+      # Assign setting
+      # ------------------------------------------------------------------------
+      my $value = shift;
+
+      while (defined (my $label = shift @$arg1)) {
+        if (exists $s->{$label}) {
+          if (ref $s->{$label} eq 'HASH') {
+            $s = $s->{$label};
+
+          } else {
+            $s->{$label} = $value;
+            last;
+          }
+
+        } else {
+          if (@$arg1) {
+            $s->{$label} = {};
+            $s           = $s->{$label};
+
+          } else {
+            $s->{$label} = $value;
+          }
+        }
+      }
+
+    } else {
+      # Get setting
+      # ------------------------------------------------------------------------
+      return _get_hash_value ($s->{$arg1}, @_) if exists $s->{$arg1};
+    }
+  }
+
+  return undef;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj->get_config ();
+#
+# DESCRIPTION
+#   This method reads the configuration settings from the central and the user
+#   configuration files.
+# ------------------------------------------------------------------------------
+
+sub get_config {
+  my $self = shift;
+
+  $self->_read_config_file ($self->central_config);  
+  $self->_read_config_file ($self->user_config);
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj->_read_config_file ();
+#
+# DESCRIPTION
+#   This internal method reads a configuration file and assign values to the
+#   attributes of the current instance.
+# ------------------------------------------------------------------------------
+
+sub _read_config_file {
+  my $self        = shift;
+  my $config_file = $_[0];
+
+  if (!$config_file || !-f $config_file || !-r $config_file) {
+    return;
+  }
+
+  my $cfgfile = Fcm::CfgFile->new (SRC => $config_file, TYPE => 'FCM');
+  $cfgfile->read_cfg ();
+
+  LINE: for my $line (@{ $cfgfile->lines }) {
+    next unless $line->label;
+
+    # "Environment variables" start with $
+    if ($line->label =~ /^\$([A-Za-z_]\w*)$/) {
+      $ENV{$1} = $line->value;
+      next LINE;
+    }
+
+    # "Settings variables" start with "set"
+    if ($line->label_starts_with_cfg ('SETTING')) {
+      my @tags = $line->label_fields;
+      shift @tags;
+      @tags = map {uc} @tags;
+      $self->setting (\@tags, $line->value);
+      next LINE;
+    }
+
+    # Not a standard setting variable, put in internal variable list
+    (my $label = $line->label) =~ s/^\%//;
+    $self->variable ($label, $line->value);
+  }
+
+  1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ref = _get_hash_value (arg1, arg2, ...);
+#
+# DESCRIPTION
+#   This internal method recursively gets a value from a multi-dimensional
+#   hash.
+# ------------------------------------------------------------------------------
+
+sub _get_hash_value {
+  my $value = shift;
+
+  while (defined (my $arg = shift)) {
+    if (exists $value->{$arg}) {
+      $value = $value->{$arg};
+
+    } else {
+      return undef;
+    }
+  }
+
+  return $value;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ConfigSystem.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ConfigSystem.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ConfigSystem.pm	(revision 2528)
@@ -0,0 +1,735 @@
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::ConfigSystem
+#
+# DESCRIPTION
+#   This is the base class for FCM systems that are based on inherited
+#   configuration files, e.g. the extract and the build systems.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::ConfigSystem;
+use base qw{Fcm::Base};
+
+use strict;
+use warnings;
+
+use Fcm::CfgFile;
+use Fcm::CfgLine;
+use Fcm::Dest;
+use Fcm::Util     qw{expand_tilde e_report w_report};
+use Sys::Hostname qw{hostname};
+
+# List of property methods for this class
+my @scalar_properties = (
+ 'cfg',         # configuration file
+ 'cfg_methods', # list of sub-methods for parse_cfg
+ 'cfg_prefix',  # optional prefix in configuration declaration
+ 'dest',        # destination for output
+ 'inherit',     # list of inherited configurations
+ 'inherited',   # list of inheritance hierarchy
+ 'type',        # system type
+);
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = Fcm::ConfigSystem->new;
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::ConfigSystem class.
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = Fcm::Base->new (%args);
+
+  $self->{$_} = undef for (@scalar_properties);
+
+  bless $self, $class;
+
+  # List of sub-methods for parse_cfg
+  $self->cfg_methods ([qw/header inherit dest/]);
+
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @scalar_properties.
+# ------------------------------------------------------------------------------
+
+for my $name (@scalar_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    # Argument specified, set property to specified argument
+    if (@_) {
+      $self->{$name} = $_[0];
+    }
+
+    # Default value for property
+    if (not defined $self->{$name}) {
+      if ($name eq 'cfg') {
+        # New configuration file
+        $self->{$name} = Fcm::CfgFile->new (TYPE => $self->type);
+
+      } elsif ($name =~ /^(?:cfg_methods|inherit|inherited)$/) {
+        # Reference to an array
+        $self->{$name} = [];
+
+      } elsif ($name eq 'cfg_prefix' or $name eq 'type') {
+        # Reference to an array
+        $self->{$name} = '';
+
+      } elsif ($name eq 'dest') {
+        # New destination
+        $self->{$name} = Fcm::Dest->new (TYPE => $self->type);
+      }
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   ($rc, $out_of_date) = $obj->check_cache ();
+#
+# DESCRIPTION
+#   This method returns $rc = 1 on success or undef on failure. It returns
+#   $out_of_date = 1 if current cache file is out of date relative to those in
+#   inherited runs or 0 otherwise.
+# ------------------------------------------------------------------------------
+
+sub check_cache {
+  my $self = shift;
+
+  my $rc = 1;
+  my $out_of_date = 0;
+
+  if (@{ $self->inherit } and -f $self->dest->cache) {
+    # Get modification time of current cache file
+    my $cur_mtime = (stat ($self->dest->cache))[9];
+
+    # Compare with modification times of inherited cache files
+    for my $use (@{ $self->inherit }) {
+      next unless -f $use->dest->cache;
+      my $use_mtime = (stat ($use->dest->cache))[9];
+      $out_of_date = 1 if $use_mtime > $cur_mtime;
+    }
+  }
+
+  return ($rc, $out_of_date);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->check_lock ();
+#
+# DESCRIPTION
+#   This method returns true if no lock is found in the destination or if the
+#   locks found are allowed. 
+# ------------------------------------------------------------------------------
+
+sub check_lock {
+  my $self = shift;
+
+  # Check all types of locks
+  for my $method (@Fcm::Dest::lockfiles) {
+    my $lock = $self->dest->$method;
+
+    # Check whether lock exists
+    next unless -e $lock;
+
+    # Check whether this lock is allowed
+    next if $self->check_lock_is_allowed ($lock);
+
+    # Throw error if a lock exists
+    w_report 'ERROR: ', $lock, ': lock file exists,';
+    w_report '       ', $self->dest->rootdir, ': destination is busy.';
+    return;
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->check_lock_is_allowed ($lock);
+#
+# DESCRIPTION
+#   This method returns true if it is OK for $lock to exist in the destination.
+# ------------------------------------------------------------------------------
+
+sub check_lock_is_allowed {
+  my ($self, $lock) = @_;
+
+  # Disallow all types of locks by default
+  return 0;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->compare_setting (
+#     METHOD_LIST  => \@method_list,
+#     [METHOD_ARGS => \@method_args,]
+#     [CACHEBASE   => $cachebase,]
+#   );
+#
+# DESCRIPTION
+#   This method gets settings from the previous cache and updates the current.
+#
+# METHOD
+#   The method returns true on success. @method_list must be a list of method
+#   names for processing the cached lines in the previous run. If an existing
+#   cache exists, its content is read into $old_lines, which is a list of
+#   Fcm::CfgLine objects. Otherwise, $old_lines is set to undef. If $cachebase
+#   is set, it is used for as the cache basename. Otherwise, the default for
+#   the current system is used. It calls each method in the @method_list using
+#   $self->$method ($old_lines, @method_args), which should return a
+#   two-element list. The first element should be a return code (1 for out of
+#   date, 0 for up to date and undef for failure). The second element should be
+#   a reference to a list of Fcm::CfgLine objects for the output.
+# ------------------------------------------------------------------------------
+
+sub compare_setting {
+  my ($self, %args) = @_;
+
+  my @method_list = exists ($args{METHOD_LIST}) ? @{ $args{METHOD_LIST} } : ();
+  my @method_args = exists ($args{METHOD_ARGS}) ? @{ $args{METHOD_ARGS} } : ();
+  my $cachebase   = exists ($args{CACHEBASE}) ? $args{CACHEBASE} : undef;
+
+  my $rc = 1;
+
+  # Read cache if the file exists
+  # ----------------------------------------------------------------------------
+  my $cache = $cachebase
+              ? File::Spec->catfile ($self->dest->cachedir, $cachebase)
+              : $self->dest->cache;
+  my @in_caches = ();
+  if (-r $cache) {
+    push @in_caches, $cache;
+
+  } else {
+    for my $use (@{ $self->inherit }) {
+      my $use_cache = $cachebase
+                      ? File::Spec->catfile ($use->dest->cachedir, $cachebase)
+                      : $use->dest->cache;
+      push @in_caches, $use_cache if -r $use_cache;
+    }
+  }
+
+  my $old_lines = undef;
+  for my $in_cache (@in_caches) {
+    next unless -r $in_cache;
+    my $cfg = Fcm::CfgFile->new (SRC => $in_cache);
+
+    if ($cfg->read_cfg) {
+      $old_lines = [] if not defined $old_lines;
+      push @$old_lines, @{ $cfg->lines };
+    }
+  }
+
+  # Call methods in @method_list to see if cache is out of date
+  # ----------------------------------------------------------------------------
+  my @new_lines = ();
+  my $out_of_date = 0;
+  for my $method (@method_list) {
+    my ($return, $lines);
+    ($return, $lines) = $self->$method ($old_lines, @method_args) if $rc;
+
+    if (defined $return) {
+      # Method succeeded
+      push @new_lines, @$lines;
+      $out_of_date = 1 if $return;
+
+    } else {
+      # Method failed
+      $rc = $return;
+      last;
+    }
+  }
+
+  # Update the cache in the current run
+  # ----------------------------------------------------------------------------
+  if ($rc) {
+    if (@{ $self->inherited } and $out_of_date) {
+      # If this is an inherited configuration, the cache must not be changed
+      w_report 'ERROR: ', $self->cfg->src,
+               ': inherited configuration does not match with its cache.';
+      $rc = undef;
+
+    } elsif ((not -f $cache) or $out_of_date) {
+      my $cfg = Fcm::CfgFile->new;
+      $cfg->lines ([sort {$a->label cmp $b->label} @new_lines]);
+      $rc = $cfg->print_cfg ($cache, 1);
+    }
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   ($changed_hash_ref, $new_lines_array_ref) =
+#     $self->compare_setting_in_config($prefix, \@old_lines);
+#
+# DESCRIPTION
+#   This method compares old and current settings for a specified item.
+#
+# METHOD
+#   This method does two things.
+#
+#   It uses the current configuration for the $prefix item to generate a list of
+#   new Fcm::CfgLine objects (which is returned as a reference in the second
+#   element of the returned list).
+#
+#   The values of the old lines are then compared with those of the new lines.
+#   Any settings that are changed are stored in a hash, which is returned as a
+#   reference in the first element of the returned list. The key of the hash is
+#   the name of the changed setting, and the value is the value of the new
+#   setting or undef if the setting no longer exists.
+#
+# ARGUMENTS
+#   $prefix    - the name of an item in Fcm::Config to be compared
+#   @old_lines - a list of Fcm::CfgLine objects containing the old settings
+# ------------------------------------------------------------------------------
+
+sub compare_setting_in_config {
+  my ($self, $prefix, $old_lines_ref) = @_;
+  
+  my %changed = %{$self->setting($prefix)};
+  my (@new_lines, %new_val_of);
+  while (my ($key, $val) = each(%changed)) {
+    $new_val_of{$key} = (ref($val) eq 'ARRAY' ? join(q{ }, sort(@{$val})) : $val);
+    push(@new_lines, Fcm::CfgLine->new(
+      LABEL => $prefix . $Fcm::Config::DELIMITER . $key,
+      VALUE => $new_val_of{$key},
+    ));
+  }
+
+  if (defined($old_lines_ref)) {
+    my %old_val_of
+      = map {($_->label_from_field(1), $_->value())} # converts into a hash
+        grep {$_->label_starts_with($prefix)}        # gets relevant lines
+        @{$old_lines_ref};
+
+    while (my ($key, $val) = each(%old_val_of)) {
+      if (exists($changed{$key})) {
+        if ($val eq $new_val_of{$key}) { # no change from old to new
+          delete($changed{$key});
+        }
+      }
+      else { # exists in old but not in new
+        $changed{$key} = undef;
+      }
+    }
+  }
+
+  return (\%changed, \@new_lines);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->invoke ([CLEAN => 1, ]%args);
+#
+# DESCRIPTION
+#   This method invokes the system. If CLEAN is set to true, it will only parse
+#   the configuration and set up the destination, but will not invoke the
+#   system. See the invoke_setup_dest and the invoke_system methods for list of
+#   other arguments in %args.
+# ------------------------------------------------------------------------------
+
+sub invoke {
+  my $self = shift;
+  my %args = @_;
+
+  # Print diagnostic at beginning of run
+  # ----------------------------------------------------------------------------
+  # Name of the system
+  (my $name = ref ($self)) =~ s/^Fcm:://;
+
+  # Print start time on system run, if verbose is true
+  my $date = localtime;
+  print $name, ' command started on ', $date, '.', "\n"
+    if $self->verbose;
+
+  # Start time (seconds since epoch)
+  my $otime = time;
+
+  # Parse the configuration file
+  my $rc = $self->invoke_stage ('Parse configuration', 'parse_cfg');
+
+  # Set up the destination
+  $rc = $self->invoke_stage ('Setup destination', 'invoke_setup_dest', %args)
+    if $rc;
+
+  # Invoke the system
+  # ----------------------------------------------------------------------------
+  $rc = $self->invoke_system (%args) if $rc and not $args{CLEAN};
+
+  # Remove empty directories
+  $rc = $self->dest->clean (MODE => 'EMPTY') if $rc;
+
+  # Print diagnostic at end of run
+  # ----------------------------------------------------------------------------
+  # Print lapse time at the end, if verbose is true
+  if ($self->verbose) {
+    my $total = time - $otime;
+    my $s_str = $total > 1 ? 'seconds' : 'second';
+    print '->TOTAL: ', $total, ' ', $s_str, "\n";
+  }
+
+  # Report end of system run
+  $date = localtime;
+  if ($rc) {
+    # Success
+    print $name, ' command finished on ', $date, '.', "\n"
+      if $self->verbose;
+
+  } else {
+    # Failure
+    e_report $name, ' failed on ', $date, '.';
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->invoke_setup_dest ([CLEAN|FULL => 1], [IGNORE_LOCK => 1]);
+#
+# DESCRIPTION
+#   This method sets up the destination and returns true on success.
+#
+# ARGUMENTS
+#   CLEAN|FULL   - If set to "true", set up the system in "clean|full" mode.
+#                  Sub-directories and files in the root directory created by
+#                  the previous invocation of the system will be removed. If
+#                  not set, the default is to run in "incremental" mode.
+#   IGNORE_LOCK  - If set to "true", it ignores any lock files that may exist in
+#                  the destination root directory. 
+# ------------------------------------------------------------------------------
+
+sub invoke_setup_dest {
+  my $self = shift;
+  my %args = @_;
+
+  # Set up destination
+  # ----------------------------------------------------------------------------
+  # Print destination in verbose mode
+  if ($self->verbose()) {
+    printf(
+      "Destination: %s@%s:%s\n",
+      scalar(getpwuid($<)),
+      hostname(),
+      $self->dest()->rootdir(),
+    );
+  }
+
+  my $rc = 1;
+  my $out_of_date = 0;
+
+  # Check whether lock exists in the destination root
+  $rc = $self->check_lock if $rc and not $args{IGNORE_LOCK};
+
+  # Check whether current cache is out of date relative to the inherited ones
+  ($rc, $out_of_date) = $self->check_cache if $rc;
+
+  # Remove sub-directories and files in destination in "full" mode
+  $rc = $self->dest->clean (MODE => 'ALL')
+    if $rc and ($args{FULL} or $args{CLEAN} or $out_of_date);
+
+  # Create build root directory if necessary
+  $rc = $self->dest->create if $rc;
+
+  # Set a lock in the destination root
+  $rc = $self->dest->set_lock if $rc;
+
+  # Generate an as-parsed configuration file
+  $self->cfg->print_cfg ($self->dest->parsedcfg);
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->invoke_stage ($name, $method, @args);
+#
+# DESCRIPTION
+#   This method invokes a named stage of the system, where $name is the name of
+#   the stage, $method is the name of the method for invoking the stage and
+#   @args are the arguments to the &method.
+# ------------------------------------------------------------------------------
+
+sub invoke_stage {
+  my ($self, $name, $method, @args) = @_;
+
+  # Print diagnostic at beginning of a stage
+  print '->', $name, ': start', "\n" if $self->verbose;
+  my $stime = time;
+
+  # Invoke the stage
+  my $rc = $self->$method (@args);
+
+  # Print diagnostic at end of a stage
+  my $total = time - $stime;
+  my $s_str = $total > 1 ? 'seconds' : 'second';
+  print '->', $name, ': ', $total, ' ', $s_str, "\n";
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->invoke_system (%args);
+#
+# DESCRIPTION
+#   This is a prototype method for invoking the system.
+# ------------------------------------------------------------------------------
+
+sub invoke_system {
+  my $self = shift;
+  my %args = @_;
+
+  print "Dummy code.\n";
+
+  return 0;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->parse_cfg ();
+#
+# DESCRIPTION
+#   This method calls other methods to parse the configuration file.
+# ------------------------------------------------------------------------------
+
+sub parse_cfg {
+  my $self = shift;
+
+  return unless $self->cfg->src;
+
+  # Read config file
+  # ----------------------------------------------------------------------------
+  return unless $self->cfg->read_cfg;
+
+  if ($self->cfg->type ne $self->type) {
+    w_report 'ERROR: ', $self->cfg->src, ': not a ', $self->type,
+             ' config file.';
+    return;
+  }
+
+  # Strip out optional prefix from all labels
+  # ----------------------------------------------------------------------------
+  if ($self->cfg_prefix) {
+    for my $line (@{ $self->cfg->lines }) {
+      $line->prefix ($self->cfg_prefix);
+    }
+  }
+
+  # Filter lines from the configuration file
+  # ----------------------------------------------------------------------------
+  my @cfg_lines = grep {
+    $_->slabel                   and       # ignore empty/comment lines
+    index ($_->slabel, '%') != 0 and       # ignore user variable
+    not $_->slabel_starts_with_cfg ('INC') # ignore INC line
+  } @{ $self->cfg->lines };
+
+  # Parse the lines to read in the various settings, by calling the methods:
+  # $self->parse_cfg_XXX, where XXX is: header, inherit, dest, and the values
+  # in the list @{ $self->cfg_methods }.
+  # ----------------------------------------------------------------------------
+  my $rc = 1;
+  for my $name (@{ $self->cfg_methods }) {
+    my $method = 'parse_cfg_' . $name;
+    $self->$method (\@cfg_lines) or $rc = 0;
+  }
+
+  # Report warnings/errors
+  # ----------------------------------------------------------------------------
+  for my $line (@cfg_lines) {
+    $rc = 0 if not $line->parsed;
+    my $mesg = $line->format_error;
+    w_report $mesg if $mesg;
+  }
+
+  return ($rc);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->parse_cfg_dest (\@cfg_lines);
+#
+# DESCRIPTION
+#   This method parses the destination settings in the @cfg_lines.
+# ------------------------------------------------------------------------------
+
+sub parse_cfg_dest {
+  my ($self, $cfg_lines) = @_;
+
+  my $rc = 1;
+
+  # DEST/DIR declarations
+  # ----------------------------------------------------------------------------
+  my @lines  = grep {
+    $_->slabel_starts_with_cfg ('DEST') or $_->slabel_starts_with_cfg ('DIR')
+  } @$cfg_lines;
+
+  # Only ROOTDIR declarations are accepted
+  for my $line (@lines) {
+    my ($d, $method) = $line->slabel_fields;
+    $d = lc $d;
+    $method = lc $method;
+
+    # Backward compatibility
+    $d = 'dest' if $d eq 'dir';
+
+    # Default to "rootdir"
+    $method = 'rootdir' if (not $method) or $method eq 'root';
+
+    # Only "rootdir" can be set
+    next unless $method eq 'rootdir';
+
+    $self->$d->$method (&expand_tilde ($line->value));
+    $line->parsed (1);
+  }
+
+  # Make sure root directory is set
+  # ----------------------------------------------------------------------------
+  if (not $self->dest->rootdir) {
+    w_report 'ERROR: ', $self->cfg->actual_src,
+             ': destination root directory not set.';
+    $rc = 0;
+  }
+
+  # Inherit destinations
+  # ----------------------------------------------------------------------------
+  for my $use (@{ $self->inherit }) {
+    push @{ $self->dest->inherit }, (@{ $use->dest->inherit }, $use->dest);
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->parse_cfg_header (\@cfg_lines);
+#
+# DESCRIPTION
+#   This method parses the header setting in the @cfg_lines.
+# ------------------------------------------------------------------------------
+
+sub parse_cfg_header {
+  my ($self, $cfg_lines) = @_;
+
+  # Set header lines as "parsed"
+  map {$_->parsed (1)} grep {$_->slabel_starts_with_cfg ('CFGFILE')} @$cfg_lines;
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->parse_cfg_inherit (\@cfg_lines);
+#
+# DESCRIPTION
+#   This method parses the inherit setting in the @cfg_lines.
+# ------------------------------------------------------------------------------
+
+sub parse_cfg_inherit {
+  my ($self, $cfg_lines) = @_;
+
+  # USE declaration
+  # ----------------------------------------------------------------------------
+  my @lines = grep {$_->slabel_starts_with_cfg ('USE')} @$cfg_lines;
+
+  # Check for cyclic dependency
+  if (@lines and grep {$_ eq $self->cfg->actual_src} @{ $self->inherited }) {
+    # Error if current configuration file is in its own inheritance hierarchy
+    w_report 'ERROR: ', $self->cfg->actual_src, ': attempt to inherit itself.';
+    $_->error ($_->label . ': ignored due to cyclic dependency.') for (@lines);
+    return 0;
+  }
+
+  my $rc = 1;
+
+  for my $line (@lines) {
+    # Invoke new instance of the current class
+    my $use = ref ($self)->new;
+
+    # Set configuration file, inheritance hierarchy
+    # and attempt to parse the configuration
+    $use->cfg->src  (&expand_tilde ($line->value));
+    $use->inherited ([$self->cfg->actual_src, @{ $self->inherited }]);
+    $use->parse_cfg;
+
+    # Add to list of inherit configurations
+    push @{ $self->inherit }, $use;
+
+    $line->parsed (1);
+  }
+
+  # Check locks in inherited destination
+  # ----------------------------------------------------------------------------
+  for my $use (@{ $self->inherit }) {
+    $rc = 0 unless $use->check_lock;
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @cfglines = $obj->to_cfglines ();
+#
+# DESCRIPTION
+#   This method returns the configuration lines of this object.
+# ------------------------------------------------------------------------------
+
+sub to_cfglines {
+  my ($self) = @_;
+
+  my @inherited_dests = map {
+    Fcm::CfgLine->new (
+      label => $self->cfglabel ('USE'), value => $_->dest->rootdir
+    );
+  } @{ $self->inherit };
+
+  return (
+    Fcm::CfgLine::comment_block ('File header'),
+    Fcm::CfgLine->new (
+      label => $self->cfglabel ('CFGFILE') . $Fcm::Config::DELIMITER . 'TYPE',
+      value => $self->type,
+    ),
+    Fcm::CfgLine->new (
+      label => $self->cfglabel ('CFGFILE') . $Fcm::Config::DELIMITER . 'VERSION',
+      value => '1.0',
+    ),
+    Fcm::CfgLine->new (),
+
+    @inherited_dests,
+
+    Fcm::CfgLine::comment_block ('Destination'),
+    ($self->dest->to_cfglines()),
+  );
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Dest.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Dest.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Dest.pm	(revision 2528)
@@ -0,0 +1,887 @@
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::Dest
+#
+# DESCRIPTION
+#   This class contains methods to set up a destination location of an FCM
+#   extract/build.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use warnings;
+use strict;
+
+package Fcm::Dest;
+use base qw{Fcm::Base};
+
+use Carp             qw{croak}                          ;
+use Cwd              qw{cwd}                            ;
+use Fcm::CfgLine                                        ;
+use Fcm::Timer       qw{timestamp_command}              ;
+use Fcm::Util        qw{run_command touch_file w_report};
+use File::Basename   qw{basename dirname}               ;
+use File::Find       qw{find}                           ;
+use File::Path       qw{mkpath rmtree}                  ;
+use File::Spec                                          ;
+use Sys::Hostname    qw{hostname}                       ;
+use Text::ParseWords qw{shellwords}                     ;
+
+# Useful variables
+# ------------------------------------------------------------------------------
+# List of configuration files
+our @cfgfiles = (
+  'bldcfg',     # default location of the build configuration file
+  'extcfg',     # default location of the extract configuration file
+);
+
+# List of cache and configuration files, according to the dest type
+our @cfgfiles_type = (
+  'cache',     # default location of the cache file
+  'cfg',       # default location of the configuration file
+  'parsedcfg', # default location of the as-parsed configuration file
+);
+
+# List of lock files
+our @lockfiles = (
+  'bldlock',    # the build lock file
+  'extlock',    # the extract lock file
+);
+
+# List of misc files
+our @miscfiles_bld = (
+  'bldrunenvsh', # the build run environment shell script
+  'bldmakefile', # the build Makefile
+);
+
+# List of sub-directories created by extract
+our @subdirs_ext = (
+  'cfgdir',     # sub-directory for configuration files
+  'srcdir',     # sub-directory for source tree
+);
+
+# List of sub-directories that can be archived by "tar" at end of build
+our @subdirs_tar = (
+  'donedir',    # sub-directory for "done" files
+  'flagsdir',   # sub-directory for "flags" files
+  'incdir',     # sub-directory for include files
+  'ppsrcdir',   # sub-directory for pre-process source tree
+  'objdir',     # sub-directory for object files
+);
+
+# List of sub-directories created by build
+our @subdirs_bld = (
+  'bindir',     # sub-directory for executables
+  'etcdir',     # sub-directory for miscellaneous files
+  'libdir',     # sub-directory for object libraries
+  'tmpdir',     # sub-directory for temporary build files
+  @subdirs_tar, # -see above-
+);
+
+# List of sub-directories under rootdir
+our @subdirs = (
+  'cachedir',   # sub-directory for caches
+  @subdirs_ext, # -see above-
+  @subdirs_bld, # -see above-
+);
+
+# List of inherited search paths
+# "rootdir" + all @subdirs, with "XXXdir" replaced with "XXXpath"
+our @paths = (
+    'rootpath',
+    (map {my $key = $_; $key =~ s{dir\z}{path}msx; $key} @subdirs),
+);
+
+# List of properties and their default values.
+my %PROP_OF = (
+  # the original destination (if current destination is a mirror)
+  'dest0'                => undef,
+  # list of inherited Fcm::Dest objects
+  'inherit'              => [],
+  # remote login name
+  'logname'              => scalar(getpwuid($<)),
+  # lock file
+  'lockfile'             => undef,
+  # remote machine
+  'machine'              => hostname(),
+  # mirror command to use
+  'mirror_cmd'           => 'rsync',
+  # (for rsync) remote mkdir, the remote shell command
+  'rsh_mkdir_rsh'        => 'ssh',
+  # (for rsync) remote mkdir, the remote shell command flags
+  'rsh_mkdir_rshflags'   => '-n -oBatchMode=yes',
+  # (for rsync) remote mkdir, the remote shell command
+  'rsh_mkdir_mkdir'      => 'mkdir',
+  # (for rsync) remote mkdir, the remote shell command flags
+  'rsh_mkdir_mkdirflags' => '-p',
+  # (for rsync) remote mkdir, the remote shell command
+  'rsync'                => 'rsync',
+  # (for rsync) remote mkdir, the remote shell command flags
+  'rsyncflags'           => q{-a --exclude='.*' --delete-excluded}
+                            . q{ --timeout=900 --rsh='ssh -oBatchMode=yes'},
+  # destination root directory
+  'rootdir'              => undef,
+  # destination type, "bld" (default) or "ext"
+  'type'                 => 'bld',
+);
+# Hook for property setter
+my %PROP_HOOK_OF = (
+  'inherit' => \&_reset_inherit,
+  'rootdir' => \&_reset_rootdir,
+);
+
+# Mirror implementations
+my %MIRROR_IMPL_OF = (
+  rdist => \&_mirror_with_rdist,
+  rsync => \&_mirror_with_rsync,
+);
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = Fcm::Dest->new(%args);
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::Dest class. See above for
+#   allowed list of properties. (KEYS should be in uppercase.)
+# ------------------------------------------------------------------------------
+
+sub new {
+  my ($class, %args) = @_;
+  my $self = bless(Fcm::Base->new(%args), $class);
+  while (my ($key, $value) = each(%args)) {
+    $key = lc($key);
+    if (exists($PROP_OF{$key})) {
+        $self->{$key} = $value;
+    }
+  }
+  for my $key (@subdirs, @paths, @lockfiles, @cfgfiles) {
+    $self->{$key} = undef;
+  }
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->DESTROY;
+#
+# DESCRIPTION
+#   This method is called automatically when the Fcm::Dest object is
+#   destroyed.
+# ------------------------------------------------------------------------------
+
+sub DESTROY {
+  my $self = shift;
+
+  # Remove the lockfile if it is set
+  unlink $self->lockfile if $self->lockfile and -w $self->lockfile;
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in %PROP_OF.
+# ------------------------------------------------------------------------------
+
+while (my ($key, $default) = each(%PROP_OF)) {
+  no strict 'refs';
+  *{$key} = sub {
+    my $self = shift();
+    # Set property to specified value
+    if (@_) {
+      $self->{$key} = $_[0];
+      if (exists($PROP_HOOK_OF{$key})) {
+        $PROP_HOOK_OF{$key}->($self, $key);
+      }
+    }
+    # Sets default where possible
+    if (!defined($self->{$key})) {
+      $self->{$key} = $default;
+    }
+    return $self->{$key};
+  };
+}
+
+# Remote shell property: deprecated.
+sub remote_shell {
+  my $self = shift();
+  $self->rsh_mkdir_rsh(@_);
+}
+
+# Resets properties associated with root directory.
+sub _reset_rootdir {
+  my $self = shift();
+  for my $key (@cfgfiles, @lockfiles, @miscfiles_bld, @subdirs) {
+    $self->{$key} = undef;
+  }
+}
+
+# Reset properties associated with inherited paths.
+sub _reset_inherit {
+  my $self = shift();
+  for my $key (@paths) {
+    $self->{$key} = undef;
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#
+# DESCRIPTION
+#   This method returns X, where X is a location derived from rootdir, and can
+#   be one of:
+#     bindir, bldcfg, blddir, bldlock, bldrunenv, cache, cachedir, cfg, cfgdir,
+#     donedir, etcdir, extcfg, extlock, flagsdir, incdir, libdir, parsedcfg,
+#     ppsrcdir, objdir, or tmpdir.
+#
+#   Details of these properties are explained earlier.
+# ------------------------------------------------------------------------------
+
+for my $name (@cfgfiles, @cfgfiles_type, @lockfiles, @miscfiles_bld, @subdirs) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    # If variable not set, derive it from rootdir
+    if ($self->rootdir and not defined $self->{$name}) {
+      if ($name eq 'cache') {
+        # Cache file under root/.cache
+        $self->{$name} =  File::Spec->catfile (
+          $self->cachedir, $self->setting ('CACHE'),
+        );
+
+      } elsif ($name eq 'cfg') {
+        # Configuration file of current type
+        my $method = $self->type . 'cfg';
+        $self->{$name} = $self->$method;
+
+      } elsif (grep {$name eq $_} @cfgfiles) {
+        # Configuration files under the root/cfg
+        (my $label = uc ($name)) =~ s/CFG//;
+        $self->{$name} = File::Spec->catfile (
+          $self->cfgdir, $self->setting ('CFG_NAME', $label),
+        );
+
+      } elsif (grep {$name eq $_} @lockfiles) {
+        # Lock file
+        $self->{$name} = File::Spec->catfile (
+          $self->rootdir, $self->setting ('LOCK', uc ($name)),
+        );
+
+      } elsif (grep {$name eq $_} @miscfiles_bld) {
+        # Misc file
+        $self->{$name} = File::Spec->catfile (
+          $self->rootdir, $self->setting ('BLD_MISC', uc ($name)),
+        );
+
+      } elsif ($name eq 'parsedcfg') {
+        # As-parsed configuration file of current type
+        $self->{$name} = File::Spec->catfile (
+          dirname ($self->cfg),
+          $self->setting (qw/CFG_NAME PARSED/) . basename ($self->cfg),
+        )
+
+      } elsif (grep {$name eq $_} @subdirs) {
+        # Sub-directories under the root
+        (my $label = uc ($name)) =~ s/DIR//;
+        $self->{$name} = File::Spec->catfile (
+          $self->rootdir,
+          $self->setting ('DIR', $label),
+          ($name eq 'cachedir' ? '.' . $self->type : ()),
+        );
+      }
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#
+# DESCRIPTION
+#   This method returns X, an array containing the search path of a destination
+#   directory, which can be one of:
+#     binpath, bldpath, cachepath, cfgpath, donepath, etcpath, flagspath,
+#     incpath, libpath, ppsrcpath, objpath, rootpath, srcpath, or tmppath,
+#
+#   Details of these properties are explained earlier.
+# ------------------------------------------------------------------------------
+
+for my $name (@paths) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    (my $dir = $name) =~ s/path/dir/;
+
+    if ($self->$dir and not defined $self->{$name}) {
+      my @path = ();
+
+      # Recursively inherit the search path
+      for my $d (@{ $self->inherit }) {
+        unshift @path, $d->$dir;
+      }
+
+      # Place the path of the current build in the front
+      unshift @path, $self->$dir;
+
+      $self->{$name} = \@path;
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->archive ();
+#
+# DESCRIPTION
+#   This method creates TAR archives for selected sub-directories.
+# ------------------------------------------------------------------------------
+
+sub archive {
+  my $self = shift;
+
+  # Save current directory
+  my $cwd = cwd ();
+
+  my $tar      = $self->setting (qw/OUTFILE_EXT TAR/);
+  my $verbose  = $self->verbose;
+
+  for my $name (@subdirs_tar) {
+    my $dir = $self->$name;
+
+    # Ignore unless sub-directory exists
+    next unless -d $dir;
+
+    # Change to container directory
+    my $base = basename ($dir);
+    print 'cd ', dirname ($dir), "\n" if $verbose > 2;
+    chdir dirname ($dir);
+
+    # Run "tar" command
+    my $rc = &run_command (
+      [qw/tar -czf/, $base . $tar, $base],
+      PRINT => $verbose > 1, ERROR => 'warn',
+    );
+
+    # Remove sub-directory
+    &run_command ([qw/rm -rf/, $base], PRINT => $verbose > 1) if not $rc;
+  }
+
+  # Change back to "current" directory
+  print 'cd ', $cwd, "\n" if $verbose > 2;
+  chdir $cwd;
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $authority = $obj->authority();
+#
+# DESCRIPTION
+#   Returns LOGNAME@MACHINE for this destination if LOGNAME is defined and not
+#   the same as the user ID of the current process. Returns MACHINE if LOGNAME
+#   is the same as the user ID of the current process, but MACHINE is not the
+#   same as the current hostname. Returns an empty string if LOGNAME and
+#   MACHINE are not defined or are the same as in the current process.
+# ------------------------------------------------------------------------------
+
+sub authority {
+  my $self = shift;
+  my $return = '';
+
+  if ($self->logname ne $self->config->user_id) {
+    $return = $self->logname . '@' . $self->machine;
+
+  } elsif ($self->machine ne &hostname()) {
+    $return = $self->machine;
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->clean([ITEM => <list>,] [MODE => 'ALL|CONTENT|EMPTY',]);
+#
+# DESCRIPTION
+#   This method removes files/directories from the destination. If ITEM is set,
+#   it must be a reference to a list of method names for files/directories to
+#   be removed. Otherwise, the list is determined by the destination type. If
+#   MODE is ALL, all directories/files created by the extract/build are
+#   removed. If MODE is CONTENT, only contents within sub-directories are
+#   removed. If MODE is EMPTY (default), only empty sub-directories are
+#   removed.
+# ------------------------------------------------------------------------------
+
+sub clean {
+  my ($self, %args) = @_;
+  my $mode = exists $args{MODE} ? $args{MODE} : 'EMPTY';
+  my $rc = 1;
+  my @names
+    = $args{ITEM}            ? @{$args{ITEM}}
+    : $self->type() eq 'ext' ? ('cachedir', @subdirs_ext)
+    :                          ('cachedir', @subdirs_bld, @miscfiles_bld)
+    ;
+  my @items;
+  if ($mode eq 'CONTENT') {
+    for my $name (@names) {
+      my $item = $self->$name();
+      push(@items, _directory_contents($item));
+    }
+  }
+  else {
+    for my $name (@names) {
+      my $item = $self->$name();
+      if ($mode eq 'ALL' || -d $item && !_directory_contents($item)) {
+        push(@items, $item);
+      }
+    }
+  }
+  for my $item (@items) {
+    if ($self->verbose() >= 2) {
+      printf("%s: remove\n", $item);
+    }
+    eval {rmtree($item)};
+    if ($@) {
+      w_report($@);
+      $rc = 0;
+    }
+  }
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->create ([DIR => <dir-list>,]);
+#
+# DESCRIPTION
+#   This method creates the directories of a destination. If DIR is set, it
+#   must be a reference to a list of sub-directories to be created.  Otherwise,
+#   the sub-directory list is determined by the destination type. It returns
+#   true if the destination is created or if it exists and is writable.
+# ------------------------------------------------------------------------------
+
+sub create {
+  my ($self, %args) = @_;
+
+  my $rc = 1;
+
+  my @dirs;
+  if (exists $args{DIR} and $args{DIR}) {
+    # Create only selected sub-directories
+    @dirs = @{ $args{DIR} };
+
+  } else {
+    # Create rootdir, cachedir and read-write sub-directories for extract/build
+    @dirs = (
+      qw/rootdir cachedir/,
+      ($self->type eq 'ext' ? @subdirs_ext : @subdirs_bld),
+    );
+  }
+
+  for my $name (@dirs) {
+    my $dir = $self->$name;
+
+    # Create directory if it does not already exist
+    if (not -d $dir) {
+      print 'Make directory: ', $dir, "\n" if $self->verbose > 1;
+      mkpath $dir;
+    }
+
+    # Check whether directory exists and is writable
+    unless (-d $dir and -w $dir) {
+      w_report 'ERROR: ', $dir, ': cannot write to destination.';
+      $rc = 0;
+    }
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->create_bldrunenvsh ();
+#
+# DESCRIPTION
+#   This method creates the runtime environment script for the build.
+# ------------------------------------------------------------------------------
+
+sub create_bldrunenvsh {
+  my $self = shift;
+
+  # Path to executable files and directory for misc files
+  my @bin_paths = grep {_directory_contents($_)} @{$self->binpath()};
+  my $bin_dir = -d $self->bindir() ? $self->bindir() : undef;
+  my $etc_dir = _directory_contents($self->etcdir()) ? $self->etcdir() : undef;
+
+  # Create a runtime environment script if necessary
+  if (@bin_paths || $etc_dir) {
+    my $path = $self->bldrunenvsh();
+    open(my $handle, '>', $path) || croak("$path: cannot open ($!)\n");
+    printf($handle "#!%s\n", $self->setting(qw/TOOL SHELL/));
+    if (@bin_paths) {
+      printf($handle "PATH=%s:\$PATH\n", join(':', @bin_paths));
+      print($handle "export PATH\n");
+    }
+    if ($etc_dir) {
+      printf($handle "FCM_ETCDIR=%s\n", $etc_dir);
+      print($handle "export FCM_ETCDIR\n");
+    }
+    close($handle) || croak("$path: cannot close ($!)\n");
+
+    # Create symbolic links fcm_env.ksh and bin/fcm_env.ksh for backward
+    # compatibility
+    my $FCM_ENV_KSH = 'fcm_env.ksh';
+    for my $link (
+      File::Spec->catfile($self->rootdir, $FCM_ENV_KSH),
+      ($bin_dir ? File::Spec->catfile($bin_dir, $FCM_ENV_KSH) : ()),
+    ) {
+      if (-l $link && readlink($link) ne $path || -e $link) {
+        unlink($link);
+      }
+      if (!-l $link) {
+        symlink($path, $link) || croak("$link: cannot create symbolic link\n");
+      }
+    }
+  }
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->dearchive ();
+#
+# DESCRIPTION
+#   This method extracts from TAR archives for selected sub-directories.
+# ------------------------------------------------------------------------------
+
+sub dearchive {
+  my $self = shift;
+
+  my $tar     = $self->setting (qw/OUTFILE_EXT TAR/);
+  my $verbose = $self->verbose;
+
+  # Extract archives if necessary
+  for my $name (@subdirs_tar) {
+    my $tar_file = $self->$name . $tar;
+
+    # Check whether tar archive exists for the named sub-directory
+    next unless -f $tar_file;
+
+    # If so, extract the archive and remove it afterwards
+    &run_command ([qw/tar -xzf/, $tar_file], PRINT => $verbose > 1);
+    &run_command ([qw/rm -f/, $tar_file], PRINT => $verbose > 1);
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $name = $obj->get_pkgname_of_path ($path);
+#
+# DESCRIPTION
+#   This method returns the package name of $path if $path is in (a relative
+#   path of) $self->srcdir, or undef otherwise.
+# ------------------------------------------------------------------------------
+
+sub get_pkgname_of_path {
+  my ($self, $path) = @_;
+
+  my $relpath = File::Spec->abs2rel ($path, $self->srcdir);
+  my $name = $relpath ? [File::Spec->splitdir ($relpath)] : undef;
+
+  return $name;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %src = $obj->get_source_files ();
+#
+# DESCRIPTION
+#   This method returns a hash (keys = package names, values = file names)
+#   under $self->srcdir.
+# ------------------------------------------------------------------------------
+
+sub get_source_files {
+  my $self = shift;
+
+  my %src;
+  if ($self->srcdir and -d $self->srcdir) {
+    &find (sub {
+      return if /^\./;                    # ignore system/hidden file
+      return if -d $File::Find::name;     # ignore directory
+      return if not -r $File::Find::name; # ignore unreadable files
+
+      my $name = join (
+        '__', @{ $self->get_pkgname_of_path ($File::Find::name) },
+      );
+      $src{$name} = $File::Find::name;
+    }, $self->srcdir);
+  }
+
+  return \%src;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->mirror (\@items);
+#
+# DESCRIPTION
+#   This method mirrors @items (list of method names for directories or files)
+#   from $dest0 (which must be an instance of Fcm::Dest for a local
+#   destination) to this destination.
+# ------------------------------------------------------------------------------
+
+sub mirror {
+  my ($self, $items_ref) = @_;
+  if ($self->authority() || $self->dest0()->rootdir() ne $self->rootdir()) {
+    # Diagnostic
+    if ($self->verbose()) {
+      printf(
+        "Destination: %s\n",
+        ($self->authority() ? $self->authority() . q{:} : q{}) . $self->rootdir()
+      );
+    }
+    if ($MIRROR_IMPL_OF{$self->mirror_cmd()}) {
+      $MIRROR_IMPL_OF{$self->mirror_cmd()}->($self, $self->dest0(), $items_ref);
+    }
+    else {
+      # Unknown mirroring tool
+      w_report($self->mirror_cmd, ': unknown mirroring tool, abort.');
+      return 0;
+    }
+  }
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->_mirror_with_rdist ($dest0, \@items);
+#
+# DESCRIPTION
+#   This internal method implements $self->mirror with "rdist".
+# ------------------------------------------------------------------------------
+
+sub _mirror_with_rdist {
+  my ($self, $dest0, $items) = @_;
+
+  my $rhost = $self->authority ? $self->authority : &hostname();
+
+  # Print distfile content to temporary file
+  my @distfile = ();
+  for my $label (@$items) {
+    push @distfile, '( ' . $dest0->$label . ' ) -> ' . $rhost . "\n";
+    push @distfile, '  install ' . $self->$label . ';' . "\n";
+  }
+
+  # Set up mirroring command (use "rdist" at the moment)
+  my $command = 'rdist -R';
+  $command   .= ' -q' unless $self->verbose > 1;
+  $command   .= ' -f - 1>/dev/null';
+
+  # Diagnostic
+  my $croak = 'Cannot execute "' . $command . '"';
+  if ($self->verbose > 2) {
+    print timestamp_command ($command, 'Start');
+    print '  ', $_ for (@distfile);
+  }
+
+  # Execute the mirroring command
+  open COMMAND, '|-', $command or croak $croak, ' (', $!, '), abort';
+  for my $line (@distfile) {
+    print COMMAND $line;
+  }
+  close COMMAND or croak $croak, ' (', $?, '), abort';
+
+  # Diagnostic
+  print timestamp_command ($command, 'End  ') if $self->verbose > 2;
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->_mirror_with_rsync($dest0, \@items);
+#
+# DESCRIPTION
+#   This internal method implements $self->mirror() with "rsync".
+# ------------------------------------------------------------------------------
+
+sub _mirror_with_rsync {
+  my ($self, $dest0, $items_ref) = @_;
+  my @rsh_mkdir;
+  if ($self->authority()) {
+    @rsh_mkdir = (
+        $self->rsh_mkdir_rsh(),
+        shellwords($self->rsh_mkdir_rshflags()),
+        $self->authority(),
+        $self->rsh_mkdir_mkdir(),
+        shellwords($self->rsh_mkdir_mkdirflags()),
+    );
+  }
+  my @rsync = ($self->rsync(), shellwords($self->rsyncflags()));
+  my @rsync_verbose = ($self->verbose() > 2 ? '-v' : ());
+  my $auth = $self->authority() ? $self->authority() . q{:} : q{};
+  for my $item (@{$items_ref}) {
+    # Create container directory, as rsync does not do it automatically
+    my $dir = dirname($self->$item());
+    if (@rsh_mkdir) {
+      run_command([@rsh_mkdir, $dir], TIME => $self->verbose() > 2);
+    }
+    else {
+      mkpath($dir);
+    }
+    run_command(
+      [@rsync, @rsync_verbose, $dest0->$item(), $auth . $dir],
+      TIME => $self->verbose > 2,
+    );
+  }
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->set_lock ();
+#
+# DESCRIPTION
+#   This method sets a lock in the current destination.
+# ------------------------------------------------------------------------------
+
+sub set_lock {
+  my $self = shift;
+
+  $self->lockfile ();
+
+  if ($self->type eq 'ext' and not $self->dest0) {
+    # Only set an extract lock for the local destination
+    $self->lockfile ($self->extlock);
+
+  } elsif ($self->type eq 'bld') {
+    # Set a build lock
+    $self->lockfile ($self->bldlock);
+  }
+
+  return &touch_file ($self->lockfile) if $self->lockfile;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @cfglines = $obj->to_cfglines ([$index]);
+#
+# DESCRIPTION
+#   This method returns a list of configuration lines for the current
+#   destination. If it is set, $index is the index number of the current
+#   destination.
+# ------------------------------------------------------------------------------
+
+sub to_cfglines {
+  my ($self, $index) = @_;
+
+  my $PREFIX = $self->cfglabel($self->dest0() ? 'RDEST' : 'DEST');
+  my $SUFFIX = ($index ? $Fcm::Config::DELIMITER . $index : q{});
+
+  my @return = (
+    Fcm::CfgLine->new(label => $PREFIX . $SUFFIX, value => $self->rootdir()),
+  );
+  if ($self->dest0()) {
+    for my $name (qw{
+      logname
+      machine
+      mirror_cmd
+      rsh_mkdir_rsh
+      rsh_mkdir_rshflags
+      rsh_mkdir_mkdir
+      rsh_mkdir_mkdirflags
+      rsync
+      rsyncflags
+    }) {
+      if ($self->{$name} && $self->{$name} ne $PROP_OF{$name}) { # not default
+        push(
+          @return,
+          Fcm::CfgLine->new(
+            label => $PREFIX . $Fcm::Config::DELIMITER . uc($name) . $SUFFIX,
+            value => $self->{$name},
+          ),
+        );
+      }
+    }
+  }
+
+  return @return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $obj->write_rules ();
+#
+# DESCRIPTION
+#   This method returns a string containing Makefile variable declarations for
+#   directories and search paths in this destination.
+# ------------------------------------------------------------------------------
+
+sub write_rules {
+  my $self   = shift;
+  my $return = '';
+
+  # FCM_*DIR*
+  for my $i (0 .. @{ $self->inherit }) {
+    for my $name (@paths) {
+      (my $label = $name) =~ s/path$/dir/;
+      my $dir = $name eq 'rootpath' ? $self->$name->[$i] : File::Spec->catfile (
+        '$(FCM_ROOTDIR' . ($i ? $i : '') . ')',
+        File::Spec->abs2rel ($self->$name->[$i], $self->rootpath->[$i]),
+      );
+
+      $return .= ($i ? '' : 'export ') . 'FCM_' . uc ($label) . ($i ? $i : '') .
+                 ' := ' . $dir . "\n";
+    }
+  }
+
+  # FCM_*PATH
+  for my $name (@paths) {
+    (my $label = $name) =~ s/path$/dir/;
+
+    $return .= 'export FCM_' . uc ($name) . ' := ';
+    for my $i (0 .. @{ $self->$name } - 1) {
+      $return .= ($i ? ':' : '') . '$(FCM_' . uc ($label) . ($i ? $i : '') . ')';
+    }
+    $return .= "\n";
+  }
+
+  $return .= "\n";
+
+  return $return;
+}
+
+# Returns contents in directory.
+sub _directory_contents {
+  my $path = shift();
+  if (!-d $path) {
+    return;
+  }
+  opendir(my $handle, $path) || croak("$path: cannot open directory ($!)\n");
+  my @items = grep {$_ ne q{.} && $_ ne q{..}} readdir($handle);
+  closedir($handle);
+  map {File::Spec->catfile($path . $_)} @items;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Exception.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Exception.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Exception.pm	(revision 2528)
@@ -0,0 +1,95 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::Exception;
+use overload (q{""} => \&as_string);
+
+use Scalar::Util qw{blessed};
+
+# ------------------------------------------------------------------------------
+# Returns true if $e is a blessed instance of this class.
+sub caught {
+    my ($class, $e) = @_;
+    return (blessed($e) && $e->isa($class));
+}
+
+# ------------------------------------------------------------------------------
+# Constructor
+sub new {
+    my ($class, $args_ref) = @_;
+    return bless(
+        {message => q{unknown problem}, ($args_ref ? %{$args_ref} : ())},
+        $class,
+    );
+}
+
+# ------------------------------------------------------------------------------
+# Returns a string representation of this exception
+sub as_string {
+    my ($self) = @_;
+    return sprintf("%s: %s\n", blessed($self), $self->get_message());
+}
+
+# ------------------------------------------------------------------------------
+# Returns the message of this exception
+sub get_message {
+    my ($self) = @_;
+    return $self->{message};
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::Exception
+
+=head1 SYNOPSIS
+
+    use Fcm::Exception;
+    eval {
+        croak(Fcm::Exception->new({message => $message}));
+    };
+    if ($@) {
+        if (Fcm::Exception->caught($@)) {
+            print({STDERR} $@);
+        }
+    }
+
+=head1 DESCRIPTION
+
+This exception is raised when there is a generic problem in FCM.
+
+=head1 METHODS
+
+=over 4
+
+=item $class->caught($e)
+
+Returns true if $e is a blessed instance of this class.
+
+=item $class->new({message=E<gt>$message})
+
+Returns a new instance of this exception. Its first argument must be a
+reference to a hash containing the detailed I<message> of the exception.
+
+=item $e->as_string()
+
+Returns a string representation of this exception.
+
+=item $e->get_message()
+
+Returns the detailed message of this exception.
+
+=back
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Extract.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Extract.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Extract.pm	(revision 2528)
@@ -0,0 +1,1118 @@
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::Extract
+#
+# DESCRIPTION
+#   This is the top level class for the FCM extract system.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::Extract;
+@ISA = qw(Fcm::ConfigSystem);
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+use File::Path;
+use File::Spec;
+
+# FCM component modules
+use Fcm::CfgFile;
+use Fcm::CfgLine;
+use Fcm::Config;
+use Fcm::ConfigSystem;
+use Fcm::Dest;
+use Fcm::ExtractFile;
+use Fcm::ExtractSrc;
+use Fcm::Keyword;
+use Fcm::ReposBranch;
+use Fcm::SrcDirLayer;
+use Fcm::Util;
+
+# List of scalar property methods for this class
+my @scalar_properties = (
+ 'bdeclare', # list of build declarations
+ 'branches', # list of repository branches
+ 'conflict', # conflict mode
+ 'rdest'   , # remote destination information
+);
+
+# List of hash property methods for this class
+my @hash_properties = (
+ 'srcdirs' , # list of source directory extract info
+ 'files',    # list of files processed key=pkgname, value=Fcm::ExtractFile
+);
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = Fcm::Extract->new;
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::Extract class.
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = Fcm::ConfigSystem->new (%args);
+
+  $self->{$_} = undef for (@scalar_properties);
+
+  $self->{$_} = {} for (@hash_properties);
+
+  bless $self, $class;
+
+  # List of sub-methods for parse_cfg
+  push @{ $self->cfg_methods }, (qw/rdest bld conflict project/);
+
+  # System type
+  $self->type ('ext');
+
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @scalar_properties.
+# ------------------------------------------------------------------------------
+
+for my $name (@scalar_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    # Argument specified, set property to specified argument
+    if (@_) {
+      $self->{$name} = $_[0];
+    }
+
+    # Default value for property
+    if (not defined $self->{$name}) {
+      if ($name eq 'bdeclare' or $name eq 'branches') {
+        # Reference to an array
+        $self->{$name} = [];
+
+      } elsif ($name eq 'rdest') {
+        # New extract destination local/remote
+        $self->{$name} = Fcm::Dest->new (DEST0 => $self->dest(), TYPE => 'ext');
+
+      } elsif ($name eq 'conflict') {
+        # Conflict mode, default to "merge"
+        $self->{$name} = 'merge';
+      }
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %hash = %{ $obj->X () };
+#   $obj->X (\%hash);
+#
+#   $value = $obj->X ($index);
+#   $obj->X ($index, $value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @hash_properties.
+#
+#   If no argument is set, this method returns a hash containing a list of
+#   objects. If an argument is set and it is a reference to a hash, the objects
+#   are replaced by the the specified hash.
+#
+#   If a scalar argument is specified, this method returns a reference to an
+#   object, if the indexed object exists or undef if the indexed object does
+#   not exist. If a second argument is set, the $index element of the hash will
+#   be set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+for my $name (@hash_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my ($self, $arg1, $arg2) = @_;
+
+    # Ensure property is defined as a reference to a hash
+    $self->{$name} = {} if not defined ($self->{$name});
+
+    # Argument 1 can be a reference to a hash or a scalar index
+    my ($index, %hash);
+
+    if (defined $arg1) {
+      if (ref ($arg1) eq 'HASH') {
+        %hash = %$arg1;
+
+      } else {
+        $index = $arg1;
+      }
+    }
+
+    if (defined $index) {
+      # A scalar index is defined, set and/or return the value of an element
+      $self->{$name}{$index} = $arg2 if defined $arg2;
+
+      return (
+        exists $self->{$name}{$index} ? $self->{$name}{$index} : undef
+      );
+
+    } else {
+      # A scalar index is not defined, set and/or return the hash
+      $self->{$name} = \%hash if defined $arg1;
+      return $self->{$name};
+    }
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->check_lock_is_allowed ($lock);
+#
+# DESCRIPTION
+#   This method returns true if it is OK for $lock to exist in the destination.
+# ------------------------------------------------------------------------------
+
+sub check_lock_is_allowed {
+  my ($self, $lock) = @_;
+
+  # Allow existence of build lock in inherited extract
+  return ($lock eq $self->dest->bldlock and @{ $self->inherited });
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->invoke_extract ();
+#
+# DESCRIPTION
+#   This method invokes the extract stage of the extract system. It returns
+#   true on success.
+# ------------------------------------------------------------------------------
+
+sub invoke_extract {
+  my $self = shift;
+
+  my $rc = 1;
+
+  my @methods = (
+    'expand_cfg',       # expand URL, revision keywords, relative path, etc
+    'create_dir_stack', # analyse the branches to create an extract sequence
+    'extract_src',      # use the sequence to extract source to destination
+    'write_cfg',        # generate final configuration file
+    'write_cfg_bld',    # generate build configuration file
+  );
+
+  for my $method (@methods) {
+    $rc = $self->$method if $rc;
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->invoke_mirror ();
+#
+# DESCRIPTION
+#   This method invokes the mirror stage of the extract system. It returns
+#   true on success.
+# ------------------------------------------------------------------------------
+
+sub invoke_mirror {
+  my $self = shift;
+  return $self->rdest->mirror ([qw/bldcfg extcfg srcdir/]);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->invoke_system ();
+#
+# DESCRIPTION
+#   This method invokes the extract system. It returns true on success.
+# ------------------------------------------------------------------------------
+
+sub invoke_system {
+  my $self = shift;
+
+  my $rc = 1;
+  
+  $rc = $self->invoke_stage ('Extract', 'invoke_extract');
+  $rc = $self->invoke_stage ('Mirror', 'invoke_mirror')
+    if $rc and $self->rdest->rootdir;
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->parse_cfg_rdest(\@cfg_lines);
+#
+# DESCRIPTION
+#   This method parses the remote destination settings in the @cfg_lines.
+# ------------------------------------------------------------------------------
+
+sub parse_cfg_rdest {
+  my ($self, $cfg_lines_ref) = @_;
+
+  # RDEST declarations
+  # ----------------------------------------------------------------------------
+  for my $line (grep {$_->slabel_starts_with_cfg('RDEST')} @{$cfg_lines_ref}) {
+    my ($d, $method) = map {lc($_)} $line->slabel_fields();
+    $method ||= 'rootdir';
+    if ($self->rdest()->can($method)) {
+      $self->rdest()->$method(expand_tilde($line->value()));
+      $line->parsed(1);
+    }
+  }
+
+  # MIRROR declaration, deprecated = RDEST::MIRROR_CMD
+  # ----------------------------------------------------------------------------
+  for my $line (grep {$_->slabel_starts_with_cfg('MIRROR')} @{$cfg_lines_ref}) {
+    $self->rdest()->mirror_cmd($line->value());
+    $line->parsed(1);
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->parse_cfg_bld (\@cfg_lines);
+#
+# DESCRIPTION
+#   This method parses the build configurations in the @cfg_lines.
+# ------------------------------------------------------------------------------
+
+sub parse_cfg_bld {
+  my ($self, $cfg_lines) = @_;
+
+  # BLD declarations
+  # ----------------------------------------------------------------------------
+  for my $line (grep {$_->slabel_starts_with_cfg ('BDECLARE')} @$cfg_lines) {
+    # Remove BLD from label
+    my @words = $line->slabel_fields;
+
+    # Check that a declaration follows BLD
+    next if @words <= 1;
+
+    push @{ $self->bdeclare }, Fcm::CfgLine->new (
+      LABEL  => join ($Fcm::Config::DELIMITER, @words),
+      PREFIX => $self->cfglabel ('BDECLARE'),
+      VALUE  => $line->value,
+    );
+    $line->parsed (1);
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->parse_cfg_conflict (\@cfg_lines);
+#
+# DESCRIPTION
+#   This method parses the conflict settings in the @cfg_lines.
+# ------------------------------------------------------------------------------
+
+sub parse_cfg_conflict {
+  my ($self, $cfg_lines) = @_;
+
+  # Deprecated: Override mode setting
+  # ----------------------------------------------------------------------------
+  for my $line (grep {$_->slabel_starts_with_cfg ('OVERRIDE')} @$cfg_lines) {
+    next if ($line->slabel_fields) > 1;
+    $self->conflict ($line->bvalue ? 'override' : 'fail');
+    $line->parsed (1);
+    $line->warning($line->slabel . ' is deprecated. Use ' .
+                   $line->cfglabel('CONFLICT') . ' override|merge|fail.');
+  }
+
+  # Conflict mode setting
+  # ----------------------------------------------------------------------------
+  my @conflict_modes = qw/fail merge override/;
+  my $conflict_modes_pattern = join ('|', @conflict_modes);
+  for my $line (grep {$_->slabel_starts_with_cfg ('CONFLICT')} @$cfg_lines) {
+    if ($line->value =~ /$conflict_modes_pattern/i) {
+      $self->conflict (lc ($line->value));
+      $line->parsed (1);
+
+    } elsif ($line->value =~ /^[012]$/) {
+      $self->conflict ($conflict_modes[$line->value]);
+      $line->parsed (1);
+
+    } else {
+      $line->error ($line->value, ': invalid value');
+    }
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->parse_cfg_project (\@cfg_lines);
+#
+# DESCRIPTION
+#   This method parses the project settings in the @cfg_lines.
+# ------------------------------------------------------------------------------
+
+sub parse_cfg_project {
+  my ($self, $cfg_lines) = @_;
+
+  # Flag to indicate that a declared branch revision must match with its changed
+  # revision
+  # ----------------------------------------------------------------------------
+  for my $line (grep {$_->slabel_starts_with_cfg ('REVMATCH')} @$cfg_lines) {
+    next if ($line->slabel_fields) > 1;
+    $self->setting ([qw/EXT_REVMATCH/], $line->bvalue);
+    $line->parsed (1);
+  }
+
+  # Repository, revision and source directories
+  # ----------------------------------------------------------------------------
+  for my $name (qw/repos revision dirs expdirs/) {
+    my @lines = grep {
+      $_->slabel_starts_with_cfg (uc ($name)) or
+      $name eq 'revision' and $_->slabel_starts_with_cfg ('VERSION');
+    } @$cfg_lines;
+    for my $line (@lines) {
+      my @names = $line->slabel_fields;
+      shift @names;
+
+      # Detemine package and tag
+      my $tag     = pop @names;
+      my $pckroot = $names[0];
+      my $pck     = join ($Fcm::Config::DELIMITER, @names);
+
+      # Check that $tag and $pckroot are defined
+      next unless $tag and $pckroot;
+
+      # Check if branch already exists.
+      # If so, set $branch to point to existing branch
+      my $branch = undef;
+      for (@{ $self->branches }) {
+        next unless $_->package eq $pckroot and $_->tag eq $tag;
+
+        $branch = $_;
+        last;
+      }
+
+      # Otherwise, create a new branch
+      if (not $branch) {
+        $branch = Fcm::ReposBranch->new (PACKAGE => $pckroot, TAG => $tag,);
+
+        push @{ $self->branches }, $branch;
+      }
+
+      if ($name eq 'repos' or $name eq 'revision') {
+        # Branch location or revision
+        $branch->$name ($line->value);
+
+      } else { # $name eq 'dirs' or $name eq 'expdirs'
+        # Source directory or expandable source directory
+        if ($pck eq $pckroot and $line->value !~ m#^/#) {
+          # Sub-package name not set and source directory quoted as a relative
+          # path, determine package name from path name
+          $pck = join (
+            $Fcm::Config::DELIMITER,
+            ($pckroot, File::Spec->splitdir ($line->value)),
+          );
+        }
+
+        # A "/" is equivalent to the top (empty) package
+        my $value = ($line->value =~ m#^/+$#) ? '' : $line->value;
+        $branch->$name ($pck, $value);
+      }
+
+      $line->parsed (1);
+    }
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->expand_cfg ();
+#
+# DESCRIPTION
+#   This method expands the settings of the extract configuration.
+# ------------------------------------------------------------------------------
+
+sub expand_cfg {
+  my $self = shift;
+
+  my $rc = 1;
+  for my $use (@{ $self->inherit }) {
+    $rc = $use->expand_cfg if $rc;
+  }
+
+  return $rc unless $rc;
+
+  # Establish a set of source directories from the "base repository"
+  my %base_branches = ();
+
+  # Inherit "base" set of source directories from re-used extracts
+  for my $use (@{ $self->inherit }) {
+    my @branches = @{ $use->branches };
+
+    for my $branch (@branches) {
+      my $package              = $branch->package;
+      $base_branches{$package} = $branch unless exists $base_branches{$package};
+    }
+  }
+
+  for my $branch (@{ $self->branches }) {
+    # Expand URL keywords if necessary
+    if ($branch->repos) {
+      my $repos = Fcm::Util::tidy_url(Fcm::Keyword::expand($branch->repos()));
+      $branch->repos ($repos) if $repos ne $branch->repos;
+    }
+
+    # Check that repository type and revision are set
+    if ($branch->repos and &is_url ($branch->repos)) {
+      $branch->type ('svn') unless $branch->type;
+      $branch->revision ('head') unless $branch->revision;
+
+    } else {
+      $branch->type ('user') unless $branch->type;
+      $branch->revision ('user') unless $branch->revision;
+    }
+
+    $rc = $branch->expand_revision if $rc; # Get revision number from keywords
+    $rc = $branch->expand_path     if $rc; # Expand relative path to full path
+    $rc = $branch->expand_all      if $rc; # Search sub-directories
+    last unless $rc;
+
+    my $package = $branch->package;
+
+    if (exists $base_branches{$package}) {
+      # A base branch for this package exists
+
+      # If current branch has no source directory, use the set provided by the
+      # base branch
+      my %dirs = %{ $branch->dirs };
+      $branch->add_base_dirs ($base_branches{$package}) unless keys %dirs;
+
+    } else {
+      # This package does not yet have a base branch, set this branch as base
+      $base_branches{$package} = $branch;
+    }
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->create_dir_stack ();
+#
+# DESCRIPTION
+#   This method creates a hash of source directories to be processed. If the
+#   flag INHERITED is set to true, the source directories are assumed processed
+#   and extracted.
+# ------------------------------------------------------------------------------
+
+sub create_dir_stack {
+  my $self = shift;
+  my %args = @_;
+
+  # Inherit from USE ext cfg
+  for my $use (@{ $self->inherit }) {
+    $use->create_dir_stack () or return 0;
+    my %use_srcdirs = %{ $use->srcdirs };
+
+    while (my ($key, $value) = each %use_srcdirs) {
+      $self->srcdirs ($key, $value);
+
+      # Re-set destination to current destination
+      my @path = split (/$Fcm::Config::DELIMITER/, $key);
+      $self->srcdirs ($key)->{DEST} = File::Spec->catfile (
+        $self->dest->srcdir, @path,
+      );
+    }
+  }
+
+  # Build stack from current ext cfg
+  for my $branch (@{ $self->branches }) {
+    my %branch_dirs = %{ $branch->dirs };
+
+    for my $dir (keys %branch_dirs) {
+      # Check whether source directory is already in the list
+      if (not $self->srcdirs ($dir)) { # if not, create it
+        $self->srcdirs ($dir, {
+          DEST  => File::Spec->catfile (
+            $self->dest->srcdir, split (/$Fcm::Config::DELIMITER/, $dir)
+          ),
+          STACK => [],
+          FILES => {},
+        });
+      }
+
+      my $stack = $self->srcdirs ($dir)->{STACK}; # copy reference
+
+      # Create a new layer in the input stack
+      my $layer = Fcm::SrcDirLayer->new (
+        NAME      => $dir,
+        PACKAGE   => $branch->package,
+        TAG       => $branch->tag,
+        LOCATION  => $branch->dirs ($dir),
+        REPOSROOT => $branch->repos,
+        REVISION  => $branch->revision,
+        TYPE      => $branch->type,
+        EXTRACTED => @{ $self->inherited }
+                     ? $self->srcdirs ($dir)->{DEST} : undef,
+      );
+
+      # Check whether layer is already in the stack
+      my $exist = grep {
+        $_->location eq $layer->location and $_->revision eq $layer->revision;
+      } @{ $stack };
+
+      if (not $exist) {
+        # If not already exist, put layer into stack
+
+        # Note: user stack always comes last
+        if (! $layer->user and exists $stack->[-1] and $stack->[-1]->user) {
+          my $lastlayer = pop @{ $stack };
+          push @{ $stack }, $layer;
+          $layer = $lastlayer;
+        }
+
+        push @{ $stack }, $layer;
+
+      } elsif ($layer->user) {
+
+        # User layer already exists, overwrite it
+        $stack->[-1] = $layer;
+
+      }
+    }
+  }
+
+  # Use the cache to sort the source directory layer hash
+  return $self->compare_setting (METHOD_LIST => ['sort_dir_stack']);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   ($rc, \@new_lines) = $self->sort_dir_stack ($old_lines);
+#
+# DESCRIPTION
+#   This method sorts thesource directories hash to be processed.
+# ------------------------------------------------------------------------------
+
+sub sort_dir_stack {
+  my ($self, $old_lines) = @_;
+
+  my $rc = 0;
+
+  my %old = ();
+  if ($old_lines) {
+    for my $line (@$old_lines) {
+      $old{$line->label} = $line->value;
+    }
+  }
+
+  my %new;
+
+  # Compare each layer to base layer, discard unnecessary layers
+  DIR: for my $srcdir (keys %{ $self->srcdirs }) {
+    my @stack = ();
+
+    while (my $layer = shift @{ $self->srcdirs ($srcdir)->{STACK} }) {
+      if ($layer->user) {
+        # Local file system branch, check that the declared location exists
+        if (-d $layer->location) {
+          # Local file system branch always takes precedence
+          push @stack, $layer;
+
+        } else {
+          w_report 'ERROR: ', $layer->location, ': declared source directory ',
+                   'does not exists ';
+          $rc = undef;
+          last DIR;
+        }
+
+      } else {
+        my $key = join ($Fcm::Config::DELIMITER, (
+          $srcdir, $layer->location, $layer->revision
+        ));
+
+        unless ($layer->extracted and $layer->commit) {
+          # See if commit revision information is cached
+          if (keys %old and exists $old{$key}) {
+            $layer->commit ($old{$key});
+
+          } else {
+            $layer->get_commit;
+            $rc = 1;
+          }
+
+          # Check source directory for commit revision, if necessary
+          if (not $layer->commit) {
+            w_report 'Error: cannot determine the last changed revision of ',
+                     $layer->location;
+            $rc = undef;
+            last DIR;
+          }
+
+          # Set cache directory for layer
+          my $tag_ver = $layer->tag . '__' . $layer->commit;
+          $layer->cachedir (File::Spec->catfile (
+            $self->dest->cachedir,
+            split (/$Fcm::Config::DELIMITER/, $srcdir),
+            $tag_ver,
+          ));
+        }
+
+        # New line in cache config file
+        $new{$key} = $layer->commit;
+
+        # Push this layer in the stack:
+        # 1. it has a different revision compared to the top layer
+        # 2. it is the top layer (base line code)
+        if (@stack > 0) {
+          push @stack, $layer if $layer->commit != $stack[0]->commit;
+
+        } else {
+          push @stack, $layer;
+        }
+
+      }
+    }
+
+    $self->srcdirs ($srcdir)->{STACK} = \@stack;
+  }
+
+  # Write "commit cache" file
+  my @new_lines;
+  if (defined ($rc)) {
+    for my $key (sort keys %new) {
+      push @new_lines, Fcm::CfgLine->new (label => $key, value => $new{$key});
+    }
+  }
+
+  return ($rc, \@new_lines);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->extract_src ();
+#
+# DESCRIPTION
+#   This internal method performs the extract of the source directories and
+#   files if necessary.
+# ------------------------------------------------------------------------------
+
+sub extract_src {
+  my $self = shift;
+  my $rc = 1;
+
+  # Ensure destinations exist and are directories
+  for my $srcdir (values %{ $self->srcdirs }) {
+    last if not $rc;
+    if (-f $srcdir->{DEST}) {
+      w_report $srcdir->{DEST},
+               ': destination exists and is not a directory, abort.';
+      $rc = 0;
+    }
+  }
+
+  # Retrieve previous/record current extract configuration for each file.
+  $rc = $self->compare_setting (
+    CACHEBASE => $self->setting ('CACHE_FILE_SRC'),
+    METHOD_LIST => ['compare_setting_srcfiles'],
+  ) if $rc;
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   ($rc, \@new_lines) = $self->compare_setting_srcfiles ($old_lines);
+#
+# DESCRIPTION
+#   For each file to be extracted, this method creates an instance of an
+#   Fcm::ExtractFile object. It then compares its file's sources to determine
+#   if they have changed. If so, it will allow the Fcm::ExtractFile to
+#   "re-extract" the file to the destination. Otherwise, it will set
+#   Fcm::ExtractFile->dest_status to a null string to denote an "unchanged"
+#   dest_status.
+#
+# SEE ALSO
+#   Fcm::ConfigSystem->compare_setting.
+# ------------------------------------------------------------------------------
+
+sub compare_setting_srcfiles {
+  my ($self, $old_lines) = @_;
+  my $rc = 1;
+
+  # Retrieve previous extract configuration for each file
+  # ----------------------------------------------------------------------------
+  my %old = ();
+  if ($old_lines) {
+    for my $line (@$old_lines) {
+      $old{$line->label} = $line->value;
+    }
+  }
+
+  # Build up a sequence using a Fcm::ExtractFile object for each file
+  # ----------------------------------------------------------------------------
+  for my $srcdir (values %{ $self->srcdirs }) {
+    my %pkgnames0; # (to be) list of package names in the base layer
+    for my $i (0 .. @{ $srcdir->{STACK} } - 1) {
+      my $layer = $srcdir->{STACK}->[$i];
+      # Update the cache for each layer of the stack if necessary
+      $layer->update_cache unless $layer->extracted or -d $layer->localdir;
+
+      # Get list of files in the cache or local directory
+      my %pkgnames;
+      for my $file (($layer->get_files)) {
+        my $pkgname = join (
+          '/', split (/$Fcm::Config::DELIMITER/, $layer->name), $file
+        );
+        $pkgnames0{$pkgname} = 1 if $i == 0; # store package name in base layer
+        $pkgnames{$pkgname} = 1; # store package name in the current layer
+        if (not $self->files ($pkgname)) {
+          $self->files ($pkgname, Fcm::ExtractFile->new (
+            conflict => $self->conflict,
+            dest     => $self->dest->srcpath,
+            pkgname  => $pkgname,
+          ));
+
+          # Base is empty
+          $self->files ($pkgname)->src->[0] = Fcm::ExtractSrc->new (
+            id      => $layer->tag,
+            pkgname => $pkgname,
+          ) if $i > 0;
+        }
+        my $cache = File::Spec->catfile ($layer->localdir, $file);
+        push @{ $self->files ($pkgname)->src }, Fcm::ExtractSrc->new (
+          cache   => $cache,
+          id      => $layer->tag,
+          pkgname => $pkgname,
+          rev     => ($layer->user ? (stat ($cache))[9] : $layer->commit),
+          uri     => join ('/', $layer->location, $file),
+        );
+      }
+
+      # List of removed files in this layer (relative to base layer)
+      if ($i > 0) {
+        for my $pkgname (keys %pkgnames0) {
+          push @{ $self->files ($pkgname)->src }, Fcm::ExtractSrc->new (
+            id      => $layer->tag,
+            pkgname => $pkgname,
+          ) if not exists $pkgnames{$pkgname}
+        }
+      }
+    }
+  }
+
+  # Compare with old settings
+  # ----------------------------------------------------------------------------
+  my %new = ();
+  for my $key (sort keys %{ $self->files }) {
+    # Set up value for cache
+    my @sources = ();
+    for my $src (@{ $self->files ($key)->src }) {
+      push @sources, (defined ($src->uri) ? ($src->uri . '@' . $src->rev) : '');
+    }
+
+    my $value = join ($Fcm::Config::DELIMITER, @sources);
+
+    # Set Fcm::ExtractFile->dest_status to "unchanged" if value is unchanged
+    $self->files ($key)->dest_status ('')
+      if exists $old{$key} and $old{$key} eq $value;
+
+    # Write current settings
+    $new{$key} = $value;
+  }
+
+  # Delete those that exist in previous extract but not in current
+  # ----------------------------------------------------------------------------
+  for my $key (sort keys %old) {
+    next if exists $new{$key};
+    $self->files ($key, Fcm::ExtractFile->new (
+      dest    => $self->dest->srcpath,
+      pkgname => $key,
+    ));
+  }
+
+  # Extract each file, if necessary
+  # ----------------------------------------------------------------------------
+  for my $key (sort keys %{ $self->files }) {
+    $rc = $self->files ($key)->run if defined ($rc);
+    last if not defined ($rc);
+  }
+
+  # Report status
+  # ----------------------------------------------------------------------------
+  if (defined ($rc) and $self->verbose) {
+    my %src_status_count = ();
+    my %dest_status_count = ();
+    for my $key (sort keys %{ $self->files }) {
+      # Report changes in destination in verbose 1 or above
+      my $dest_status = $self->files ($key)->dest_status;
+      my $src_status = $self->files ($key)->src_status;
+      next unless $self->verbose and $dest_status;
+
+      if ($dest_status and $dest_status ne '?') {
+        if (exists $dest_status_count{$dest_status}) {
+          $dest_status_count{$dest_status}++;
+
+        } else {
+          $dest_status_count{$dest_status} = 1;
+        }
+      }
+
+      if ($src_status and $src_status ne '?') {
+        if (exists $src_status_count{$src_status}) {
+          $src_status_count{$src_status}++;
+
+        } else {
+          $src_status_count{$src_status} = 1;
+        }
+      }
+
+      # Destination status in column 1, source status in column 2
+      if ($self->verbose > 1) {
+        my @srcs = @{$self->files ($key)->src_actual};
+        print ($dest_status ? $dest_status : ' ');
+        print ($src_status ? $src_status : ' ');
+        print ' ' x 5, $key;
+        print ' (', join (', ', map {$_->id} @srcs), ')' if @srcs;
+        print "\n";
+      }
+    }
+
+    # Report number of files in each dest_status category
+    if (%dest_status_count) {
+      print 'Column 1: ' if $self->verbose > 1;
+      print 'Destination status summary:', "\n";
+      for my $key (sort keys %Fcm::ExtractFile::DEST_STATUS_CODE) {
+        next unless $key;
+        next if not exists ($dest_status_count{$key});
+        print '  No of files ';
+        print '[', $key, '] ' if $self->verbose > 1;
+        print $Fcm::ExtractFile::DEST_STATUS_CODE{$key}, ': ',
+              $dest_status_count{$key}, "\n";
+      }
+    }
+
+    # Report number of files in each dest_status category
+    if (%src_status_count) {
+      print 'Column 2: ' if $self->verbose > 1;
+      print 'Source status summary:', "\n";
+      for my $key (sort keys %Fcm::ExtractFile::SRC_STATUS_CODE) {
+        next unless $key;
+        next if not exists ($src_status_count{$key});
+        print '  No of files ';
+        print '[', $key, '] ' if $self->verbose > 1;
+        print $Fcm::ExtractFile::SRC_STATUS_CODE{$key}, ': ',
+              $src_status_count{$key}, "\n";
+      }
+    }
+  }
+
+  # Record configuration of current extract for each file
+  # ----------------------------------------------------------------------------
+  my @new_lines;
+  if (defined ($rc)) {
+    for my $key (sort keys %new) {
+      push @new_lines, Fcm::CfgLine->new (label => $key, value => $new{$key});
+    }
+  }
+
+  return ($rc, \@new_lines);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @array = $self->sort_bdeclare ();
+#
+# DESCRIPTION
+#   This method returns sorted build declarations, filtering out repeated
+#   entries, where possible.
+# ------------------------------------------------------------------------------
+
+sub sort_bdeclare {
+  my $self = shift;
+
+  # Get list of build configuration labels that can be declared multiple times
+  my %cfg_keyword = map {
+    ($self->cfglabel ($_), 1)
+  } split (/$Fcm::Config::DELIMITER_LIST/, $self->setting ('CFG_KEYWORD'));
+
+  my @bdeclares = ();
+  for my $d (reverse @{ $self->bdeclare }) {
+    # Reconstruct array from bottom up
+    # * always add declarations that can be declared multiple times
+    # * otherwise add only if it is declared below
+    unshift @bdeclares, $d
+      if exists $cfg_keyword{uc (($d->slabel_fields)[0])} or
+         not grep {$_->slabel eq $d->slabel} @bdeclares;
+  }
+
+  return (sort {$a->slabel cmp $b->slabel} @bdeclares);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @cfglines = $obj->to_cfglines ();
+#
+# DESCRIPTION
+#   See description of Fcm::ConfigSystem->to_cfglines for further information.
+# ------------------------------------------------------------------------------
+
+sub to_cfglines {
+  my ($self) = @_;
+
+  return (
+    Fcm::ConfigSystem::to_cfglines($self),
+
+    $self->rdest->to_cfglines (),
+    Fcm::CfgLine->new (),
+
+    @{ $self->bdeclare } ? (
+      Fcm::CfgLine::comment_block ('Build declarations'),
+      map {
+        Fcm::CfgLine->new (label => $_->label, value => $_->value)
+      } ($self->sort_bdeclare),
+      Fcm::CfgLine->new (),
+    ) : (),
+
+    Fcm::CfgLine::comment_block ('Project and branches'),
+    (map {($_->to_cfglines ())} @{ $self->branches }),
+
+    ($self->conflict ne 'merge') ? (
+      Fcm::CfgLine->new (
+        label => $self->cfglabel ('CONFLICT'), value => $self->conflict,
+      ),
+      Fcm::CfgLine->new (),
+    ) : (),
+  );
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @cfglines = $obj->to_cfglines_bld ();
+#
+# DESCRIPTION
+#   Returns a list of configuration lines of the current extract suitable for
+#   feeding into the build system.
+# ------------------------------------------------------------------------------
+
+sub to_cfglines_bld {
+  my ($self) = @_;
+
+  my $dest = $self->rdest->rootdir ? 'rdest' : 'dest';
+  my $root = File::Spec->catfile ('$HERE', '..');
+
+  my @inherits;
+  my @no_inherits;
+  if (@{ $self->inherit }) {
+    # List of inherited builds
+    for (@{ $self->inherit }) {
+      push @inherits, Fcm::CfgLine->new (
+        label => $self->cfglabel ('USE'), value => $_->$dest->rootdir
+      );
+    }
+
+    # List of files that should not be inherited
+    for my $key (sort keys %{ $self->files }) {
+      next unless $self->files ($key)->dest_status eq 'd';
+      my $label = join ('::', (
+        $self->cfglabel ('INHERIT'),
+        $self->cfglabel ('FILE'),
+        split (m#/#, $self->files ($key)->pkgname),
+      ));
+      push @no_inherits, Fcm::CfgLine->new (label => $label, value => 'false');
+    }
+  }
+
+  return (
+    Fcm::CfgLine::comment_block ('File header'),
+    (map
+      {my ($lbl, $val) = @{$_}; Fcm::CfgLine->new(label => $lbl, value => $val)}
+      (
+        [$self->cfglabel('CFGFILE') . $Fcm::Config::DELIMITER . 'TYPE'   , 'bld'],
+        [$self->cfglabel('CFGFILE') . $Fcm::Config::DELIMITER . 'VERSION', '1.0'],
+        [],
+      )
+    ),
+
+    @{ $self->inherit } ? (
+      @inherits,
+      @no_inherits,
+      Fcm::CfgLine->new (),
+    ) : (),
+
+    Fcm::CfgLine::comment_block ('Destination'),
+    Fcm::CfgLine->new (label => $self->cfglabel ('DEST'), value => $root),
+    Fcm::CfgLine->new (),
+
+    @{ $self->bdeclare } ? (
+      Fcm::CfgLine::comment_block ('Build declarations'),
+      map {
+        Fcm::CfgLine->new (label => $_->slabel, value => $_->value)
+      } ($self->sort_bdeclare),
+      Fcm::CfgLine->new (),
+    ) : (),
+  );
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->write_cfg ();
+#
+# DESCRIPTION
+#   This method writes the configuration file at the end of the run. It calls
+#   $self->write_cfg_system ($cfg) to write any system specific settings.
+# ------------------------------------------------------------------------------
+
+sub write_cfg {
+  my $self = shift;
+
+  my $cfg = Fcm::CfgFile->new (TYPE => $self->type);
+  $cfg->lines ([$self->to_cfglines()]);
+  $cfg->print_cfg ($self->dest->extcfg);
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->write_cfg_bld ();
+#
+# DESCRIPTION
+#   This internal method writes the build configuration file.
+# ------------------------------------------------------------------------------
+
+sub write_cfg_bld {
+  my $self = shift;
+
+  my $cfg = Fcm::CfgFile->new (TYPE => 'bld');
+  $cfg->lines ([$self->to_cfglines_bld()]);
+  $cfg->print_cfg ($self->dest->bldcfg);
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ExtractConfigComparator.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ExtractConfigComparator.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ExtractConfigComparator.pm	(revision 2528)
@@ -0,0 +1,358 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+################################################################################
+# A generic reporter of the comparator's result
+{
+    package Reporter;
+
+    ############################################################################
+    # Class method: Constructor
+    sub new {
+        my ($class) = @_;
+        return bless(\do{my $annon_scalar}, $class);
+    }
+
+    ############################################################################
+    # Class method: Factory for Reporter object
+    sub get_reporter {
+        my ($self, $comparator) = @_;
+        my $class = defined($comparator->get_wiki()) ? 'WikiReporter'
+                  :                                    'TextReporter'
+                  ;
+        return $class->new();
+    }
+
+    ############################################################################
+    # Reports the results
+    sub report {
+        my ($self, $comparator) = @_;
+        if (keys(%{$comparator->get_log_of()})) {
+            print("Revisions at which extract declarations are modified:\n\n");
+        }
+        $self->report_impl($comparator);
+    }
+
+    ############################################################################
+    # Does the actual reporting
+    sub report_impl {
+        my ($self, $comparator) = @_;
+    }
+}
+
+################################################################################
+# Reports the comparator's result in Trac wiki format
+{
+    package WikiReporter;
+    our @ISA = qw{Reporter};
+
+    use Fcm::CmUrl;
+    use Fcm::Keyword;
+    use Fcm::Util qw{tidy_url};
+
+    ############################################################################
+    # Reports the comparator's result
+    sub report_impl {
+        my ($self, $comparator) = @_;
+        # Output in wiki format
+        my $wiki_url = Fcm::CmUrl->new(
+            URL => tidy_url(Fcm::Keyword::expand($comparator->get_wiki()))
+        );
+        my $base_trac
+            = $comparator->get_wiki()
+            ? Fcm::Keyword::get_browser_url($wiki_url->project_url())
+            : $wiki_url;
+        if (!$base_trac) {
+            $base_trac = $wiki_url;
+        }
+
+        for my $key (sort keys(%{$comparator->get_log_of()})) {
+            my $branch_trac = Fcm::Keyword::get_browser_url($key);
+            $branch_trac =~ s{\A $base_trac (?:/*|\z)}{source:}xms;
+            print("[$branch_trac]:\n");
+            my %branch_of = %{$comparator->get_log_of()->{$key}};
+            for my $rev (sort {$b <=> $a} keys(%branch_of)) {
+                print(
+                    $branch_of{$rev}->display_svnlog($rev, $base_trac), "\n",
+                );
+            }
+            print("\n");
+        }
+    }
+}
+
+################################################################################
+# Reports the comparator's result in simple text format
+{
+    package TextReporter;
+    our @ISA = qw{Reporter};
+
+    use Fcm::Config;
+
+    my $SEPARATOR = q{-} x 80 . "\n";
+
+    ############################################################################
+    # Reports the comparator's result
+    sub report_impl {
+        my ($self, $comparator) = @_;
+        for my $key (sort keys(%{$comparator->get_log_of()})) {
+            # Output in plain text format
+            print $key, ':', "\n";
+            my %branch_of = %{$comparator->get_log_of()->{$key}};
+            if (Fcm::Config->instance()->verbose() > 1) {
+                for my $rev (sort {$b <=> $a} keys(%branch_of)) {
+                    print(
+                        $SEPARATOR, $branch_of{$rev}->display_svnlog($rev), "\n"
+                    );
+                }
+            }
+            else {
+                print(join(q{ }, sort {$b <=> $a} keys(%branch_of)), "\n");
+            }
+            print $SEPARATOR, "\n";
+        }
+    }
+}
+
+package Fcm::ExtractConfigComparator;
+
+use Fcm::CmUrl;
+use Fcm::Extract;
+
+################################################################################
+# Class method: Constructor
+sub new {
+    my ($class, $args_ref) = @_;
+    return bless({%{$args_ref}}, $class);
+}
+
+################################################################################
+# Returns an array containing the 2 configuration files to compare
+sub get_files {
+    my ($self) = @_;
+    return (wantarray() ? @{$self->{files}} : $self->{files});
+}
+
+################################################################################
+# Returns the wiki link on wiki mode
+sub get_wiki {
+    my ($self) = @_;
+    return $self->{wiki};
+}
+
+################################################################################
+# Returns the result log
+sub get_log_of {
+    my ($self) = @_;
+    return (wantarray() ? %{$self->{log_of}} : $self->{log_of});
+}
+
+################################################################################
+# Invokes the comparator
+sub invoke {
+    my ($self) = @_;
+
+    # Reads the extract configurations
+    my (@cfg, $rc);
+    for my $i (0 .. 1) {
+        $cfg[$i] = Fcm::Extract->new();
+        $cfg[$i]->cfg()->src($self->get_files()->[$i]);
+        $cfg[$i]->parse_cfg();
+        $rc = $cfg[$i]->expand_cfg();
+        if (!$rc) {
+            e_report();
+        }
+    }
+
+    # Get list of URLs
+    # --------------------------------------------------------------------------
+    my @urls = ();
+    for my $i (0 .. 1) {
+        # List of branches in each extract configuration file
+        my @branches = @{$cfg[$i]->branches()};
+        BRANCH:
+        for my $branch (@branches) {
+            # Ignore declarations of local directories
+            if ($branch->type() eq 'user') {
+                next BRANCH;
+            }
+
+            # List of SRC declarations in each branch
+            my %dirs = %{$branch->dirs()};
+
+            for my $dir (values(%dirs)) {
+                # Set up a new instance of Fcm::CmUrl object for each SRC
+                my $cm_url = Fcm::CmUrl->new (
+                    URL => $dir . (
+                        $branch->revision() ? '@' . $branch->revision() : q{}
+                    ),
+                );
+
+                $urls[$i]{$cm_url->branch_url()}{$dir} = $cm_url;
+            }
+        }
+    }
+
+    # Compare
+    # --------------------------------------------------------------------------
+    $self->{log_of} = {};
+    for my $i (0 .. 1) {
+        # Compare the first file with the second one and then vice versa
+        my $j = ($i == 0) ? 1 : 0;
+
+        for my $branch (sort keys(%{$urls[$i]})) {
+            if (exists($urls[$j]{$branch})) {
+                # Same REPOS declarations in both files
+                DIR:
+                for my $dir (sort keys(%{$urls[$i]{$branch}})) {
+                    if (exists($urls[$j]{$branch}{$dir})) {
+                        if ($i == 1) {
+                            next DIR;
+                        }
+
+                        my $this_url = $urls[$i]{$branch}{$dir};
+                        my $that_url = $urls[$j]{$branch}{$dir};
+
+                        # Compare their last changed revisions
+                        my $this_rev
+                            = $this_url->svninfo(FLAG => 'Last Changed Rev');
+                        my $that_rev
+                            = $that_url->svninfo(FLAG => 'Last Changed Rev');
+
+                        # Make sure last changed revisions differ
+                        if ($this_rev eq $that_rev) {
+                            next DIR;
+                        }
+
+                        # Not interested in the log before the minimum revision
+                        my $min_rev
+                            = $this_url->pegrev() > $that_url->pegrev()
+                              ? $that_url->pegrev() : $this_url->pegrev();
+
+                        $this_rev = $min_rev if $this_rev < $min_rev;
+                        $that_rev = $min_rev if $that_rev < $min_rev;
+
+                        # Get list of changed revisions using the commit log
+                        my $u = ($this_rev > $that_rev) ? $this_url : $that_url;
+                        my %revs = $u->svnlog(REV => [$this_rev, $that_rev]);
+
+                        REV:
+                        for my $rev (keys %revs) {
+                            # Check if revision is already in the list
+                            if (
+                                   exists($self->{log_of}{$branch}{$rev})
+                                || $rev == $min_rev
+                            ) {
+                                next REV;
+                            }
+
+                            # Get list of changed paths. Accept this revision
+                            # only if it contains changes in the current branch
+                            my %paths  = %{$revs{$rev}{paths}};
+
+                            PATH:
+                            for my $path (keys(%paths)) {
+                                my $change_url
+                                    = Fcm::CmUrl->new(URL => $u->root() . $path);
+
+                                if ($change_url->branch() eq $u->branch()) {
+                                    $self->{log_of}{$branch}{$rev} = $u;
+                                    last PATH;
+                                }
+                            }
+                        }
+                    }
+                    else {
+                        $self->_report_added(
+                            $urls[$i]{$branch}{$dir}->url_peg(), $i, $j);
+                    }
+                }
+            }
+            else {
+                $self->_report_added($branch, $i, $j);
+            }
+        }
+    }
+
+    my $reporter = Reporter->get_reporter($self);
+    $reporter->report($self);
+    return $rc;
+}
+
+################################################################################
+# Reports added/deleted declaration
+sub _report_added {
+    my ($self, $branch, $i, $j) = @_;
+    printf(
+        "%s:\n  in    : %s\n  not in: %s\n\n",
+        $branch, $self->get_files()->[$i], $self->get_files()->[$j],
+    );
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::ExtractConfigComparator
+
+=head1 SYNOPSIS
+
+    use Fcm::ExtractConfigComparator;
+    my $comparator = Fcm::ExtractConfigComparator->new({files => \@files});
+    $comparator->invoke();
+
+=head1 DESCRIPTION
+
+An object of this class represents a comparator of FCM extract configuration.
+It is used to compare the VC branch declarations in 2 FCM extract configuration
+files.
+
+=head1 METHODS
+
+=over 4
+
+=item C<new({files =E<gt> \@files, wiki =E<gt> $wiki})>
+
+Constructor.
+
+=item get_files()
+
+Returns an array containing the 2 configuration files to compare.
+
+=item get_wiki()
+
+Returns the wiki link on wiki mode.
+
+=item invoke()
+
+Invokes the comparator.
+
+=back
+
+=head1 TO DO
+
+More documentation.
+
+Improve the parser for extract configuration.
+
+Separate the comparator with the reporters.
+
+Add reporter to display HTML.
+
+More unit tests.
+
+=head1 SEE ALSO
+
+L<Fcm::Extract|Fcm::Extract>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ExtractFile.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ExtractFile.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ExtractFile.pm	(revision 2528)
@@ -0,0 +1,410 @@
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::ExtractFile
+#
+# DESCRIPTION
+#   Select/combine a file in different branches and extract it to destination.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+use warnings;
+use strict;
+
+package Fcm::ExtractFile;
+use base qw{Fcm::Base};
+
+use Fcm::Util      qw{run_command w_report};
+use File::Basename qw{dirname};
+use File::Compare  qw{compare};
+use File::Copy     qw{copy};
+use File::Path     qw{mkpath};
+use File::Spec;
+use File::Temp     qw(tempfile);
+
+# List of property methods for this class
+my @scalar_properties = (
+  'conflict',    # conflict mode
+  'dest',        # search path to destination file
+  'dest_status', # destination status, see below
+  'pkgname',     # package name of this file
+  'src',         # list of Fcm::ExtractSrc, specified for this file
+  'src_actual',  # list of Fcm::ExtractSrc, actually used by this file
+  'src_status',  # source status, see below
+);
+
+# Status code definition for $self->dest_status
+our %DEST_STATUS_CODE = (
+  ''  => 'unchanged',
+  'M' => 'modified',
+  'A' => 'added',
+  'a' => 'added, overridding inherited',
+  'D' => 'deleted',
+  'd' => 'deleted, overridding inherited',
+  '?' => 'irrelevant',
+);
+
+# Status code definition for $self->src_status
+our %SRC_STATUS_CODE = (
+  'A' => 'added by a branch',
+  'B' => 'from the base',
+  'D' => 'deleted by a branch',
+  'M' => 'modified by a branch',
+  'G' => 'merged from 2+ branches',
+  'O' => 'overridden by a branch',
+  '?' => 'irrelevant',
+);
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = Fcm::ExtractFile->new ();
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::ExtractFile class.
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = Fcm::Base->new (%args);
+
+  for (@scalar_properties) {
+    $self->{$_} = exists $args{$_} ? $args{$_} : undef;
+  }
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @scalar_properties.
+# ------------------------------------------------------------------------------
+
+for my $name (@scalar_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    # Argument specified, set property to specified argument
+    if (@_) {
+      $self->{$name} = $_[0];
+    }
+
+    # Default value for property
+    if (not defined $self->{$name}) {
+      if ($name eq 'conflict') {
+        $self->{$name} = 'merge'; # default to "merge" mode
+
+      } elsif ($name eq 'dest' or $name eq 'src' or $name eq 'src_actual') {
+        $self->{$name} = [];      # default to an empty list
+      }
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->run();
+#
+# DESCRIPTION
+#   This method runs only if $self->dest_status is not defined. It updates the
+#   destination according to the source in the list and the conflict mode
+#   setting. It updates the file in $self->dest as appropriate and sets
+#   $self->dest_status. (See above.) This method returns true on success.
+# ------------------------------------------------------------------------------
+
+sub run {
+  my ($self) = @_;
+  my $rc = 1;
+
+  if (not defined ($self->dest_status)) {
+    # Assume file unchanged
+    $self->dest_status ('');
+
+    if (@{ $self->src }) {
+      my $used;
+      # Determine or set up a file for comparing with the destination
+      ($rc, $used) = $self->run_get_used();
+
+      # Attempt to compare the destination with $used. Update on change.
+      if ($rc) {
+        $rc = defined ($used) ? $self->run_update($used) : $self->run_delete();
+      }
+
+    } else {
+      # No source, delete file in destination
+      $self->src_status ('?');
+      $rc = $self->run_delete();
+    }
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->run_delete();
+#
+# DESCRIPTION
+#   This method is part of run(). It detects this file in the destination path.
+#   If this file is in the current destination, it attempts to delete it and
+#   sets the dest_status to "D". If this file is in an inherited destination,
+#   it sets the dest_status to "d".
+# ------------------------------------------------------------------------------
+
+sub run_delete {
+  my ($self) = @_;
+
+  my $rc = 1;
+
+  $self->dest_status ('?');
+  for my $i (0 .. @{ $self->dest } - 1) {
+    my $dest = File::Spec->catfile ($self->dest->[$i], $self->pkgname);
+    next unless -f $dest;
+    if ($i == 0) {
+      $rc = unlink $dest;
+      $self->dest_status ('D');
+
+    } else {
+      $self->dest_status ('d');
+      last;
+    }
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   ($rc, $used) = $obj->run_get_used();
+#
+# DESCRIPTION
+#   This method is part of run(). It attempts to work out or set up the $used
+#   file. ($used is undef if it is not defined in a branch for this file.)
+# ------------------------------------------------------------------------------
+
+sub run_get_used {
+  my ($self) = @_;
+  my $rc = 1;
+  my $used;
+
+  my @sources = ($self->src->[0]);
+  my $src_status = 'B';
+  if (defined ($self->src->[0]->cache)) {
+    # File exists in base branch
+    for my $i (1 .. @{ $self->src } - 1) {
+      if (defined ($self->src->[$i]->cache)) {
+        # Detect changes in this file between base branch and branch $i
+        push @sources, $self->src->[$i]
+          if &compare ($self->src->[0]->cache, $self->src->[$i]->cache);
+
+      } else {
+        # File deleted in branch $i
+        @sources = ($self->src->[$i]);
+        last unless $self->conflict eq 'override';
+      }
+    }
+
+    if ($rc) {
+      if (@sources > 2) {
+        if ($self->conflict eq 'fail') {
+          # On conflict, fail in fail mode
+          w_report 'ERROR: ', $self->pkgname,
+                   ': modified in 2+ branches in fail conflict mode.';
+          $rc = undef;
+
+        } elsif ($self->conflict eq 'override') {
+          $used = $sources[-1]->cache;
+          $src_status = 'O';
+
+        } else {
+          # On conflict, attempt to merge in merge mode
+          ($rc, $used) = $self->run_get_used_by_merge (@sources);
+          $src_status = 'G' if $rc;
+        }
+
+      } else {
+        # 0 or 1 change, use last source
+        if (defined $sources[-1]->cache) {
+          $used = $sources[-1]->cache;
+          $src_status = 'M' if @sources > 1;
+
+        } else {
+          $src_status = 'D';
+        }
+      }
+    }
+
+  } else {
+    # File does not exist in base branch
+    @sources = ($self->src->[-1]);
+    $used = $self->src->[1]->cache;
+    $src_status = (defined ($used) ? 'A' : 'D');
+    if ($self->conflict ne 'override' and defined ($used)) {
+      for my $i (1 - @{ $self->src } .. -2) {
+        # Allow this only if files are the same in all branches
+        my $file = $self->src->[$i]->cache;
+        if ((not defined ($file)) or &compare ($used, $file)) {
+          w_report 'ERROR: ', $self->pkgname, ': cannot merge:',
+                   ' not found in base branch,',
+                   ' but differs in subsequent branches.';
+          $rc = undef;
+          last;
+
+        } else {
+          unshift @sources, $self->src->[$i];
+        }
+      }
+    }
+  }
+
+  $self->src_status ($src_status);
+  $self->src_actual (\@sources);
+
+  return ($rc, $used);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   ($rc, $used) = $obj->run_get_used_by_merge(@soruces);
+#
+# DESCRIPTION
+#   This method is part of run_get_used(). It attempts to merge the files in
+#   @sources and return a temporary file $used. @sources should be an array of
+#   Fcm::ExtractSrc objects. On success, $rc will be set to true.
+# ------------------------------------------------------------------------------
+
+sub run_get_used_by_merge {
+  my ($self, @sources) = @_;
+  my $rc = 1;
+
+  # Get temporary file
+  my ($fh, $used) = &tempfile ('fcm.ext.merge.XXXXXX', UNLINK => 1);
+  close $fh or die $used, ': cannot close';
+
+  for my $i (2 .. @sources - 1) {
+    # Invoke the diff3 command to merge
+    my $mine = ($i == 2 ? $sources[1]->cache : $used);
+    my $older = $sources[0]->cache;
+    my $yours = $sources[$i]->cache;
+    my @command = (
+      $self->setting (qw/TOOL DIFF3/),
+      split (/\s+/, $self->setting (qw/TOOL DIFF3FLAGS/)),
+      $mine, $older, $yours,
+    );
+    my $code;
+    my @out = &run_command (
+      \@command,
+      METHOD => 'qx',
+      ERROR  => 'ignore',
+      PRINT  => $self->verbose > 1,
+      RC     => \$code,
+      TIME   => $self->verbose > 2,
+    );
+
+    if ($code) {
+      # Failure, report and return
+      my $m = ($code == 1)
+              ? 'cannot resolve conflicts:'
+              : $self->setting (qw/TOOL DIFF3/) . 'command failed';
+      w_report 'ERROR: ', $self->pkgname, ': merge - ', $m;
+      if ($code == 1 and $self->verbose) {
+        for (0 .. $i) {
+          my $src = $sources[$_]->uri eq $sources[$_]->cache
+                    ? $sources[$_]->cache
+                    : ($sources[$_]->uri . '@' . $sources[$_]->rev);
+          w_report '  source[', $_, ']=', $src;
+        }
+
+        for (0 .. $i) {
+          w_report '  cache', $_, '=', $sources[$_]->cache;
+        }
+
+        w_report @out if $self->verbose > 2;
+      }
+      $rc = undef;
+      last;
+
+    } else {
+      # Success, write result to temporary file
+      open FILE, '>', $used or die $used, ': cannot open (', $!, ')';
+      print FILE @out;
+      close FILE or die $used, ': cannot close (', $!, ')';
+
+      # File permission, use most permissive combination of $mine and $yours
+      my $perm = ((stat($mine))[2] & 07777) | ((stat($yours))[2] & 07777);
+      chmod ($perm, $used);
+    }
+  }
+
+  return ($rc, $used);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->run_update($used_file);
+#
+# DESCRIPTION
+#   This method is part of run(). It compares the $used_file with the one in
+#   the destination. If the file does not exist in the destination or if its
+#   content is out of date, the destination is updated with the content in the
+#   $used_file. Returns true on success.
+# ------------------------------------------------------------------------------
+
+sub run_update {
+  my ($self, $used_file) = @_;
+  my ($is_diff, $is_diff_in_perms, $is_in_prev, $rc) = (1, 1, undef, 1);
+
+  # Compare with the previous version if it exists
+  DEST:
+  for my $i (0 .. @{$self->dest()} - 1) {
+    my $prev_file = File::Spec->catfile($self->dest()->[$i], $self->pkgname());
+    if (-f $prev_file) {
+      $is_in_prev = $i;
+      $is_diff = compare($used_file, $prev_file);
+      $is_diff_in_perms = (stat($used_file))[2] != (stat($prev_file))[2];
+      last DEST;
+    }
+  }
+  if (!$is_diff && !$is_diff_in_perms) {
+    return $rc;
+  }
+
+  # Update destination
+  my $dest_file = File::Spec->catfile($self->dest()->[0], $self->pkgname());
+  if ($is_diff) {
+    my $dir = dirname($dest_file);
+    if (!-d $dir) {
+      mkpath($dir);
+    }
+    $rc = copy($used_file, $dest_file);
+  }
+  $rc &&= chmod((stat($used_file))[2] & oct(7777), $dest_file);
+  if ($rc) {
+    $self->dest_status(
+        $is_in_prev          ? 'a'
+      : defined($is_in_prev) ? 'M'
+      :                        'A'
+    );
+  }
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ExtractSrc.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ExtractSrc.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ExtractSrc.pm	(revision 2528)
@@ -0,0 +1,87 @@
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::ExtractSrc
+#
+# DESCRIPTION
+#   This class is used by the extract system to define the functionalities of a
+#   source file (or directory) in a branch.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::ExtractSrc;
+@ISA = qw(Fcm::Base);
+
+# Standard pragma
+use warnings;
+use strict;
+
+# FCM component modules
+use Fcm::Base;
+
+# List of scalar property methods for this class
+my @scalar_properties = (
+  'cache',   # location of the cache of this file in the current extract
+  'id',      # short ID of the branch where this file is from
+  'ignore',  # if set to true, ignore this file from this source
+  'pkgname', # package name of this file
+  'rev',     # last changed revision/timestamp of this file
+  'uri',     # URL/source path of this file
+);
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = Fcm::ExtractSrc->new (%args);
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::ExtractSrc class. See
+#   @scalar_properties above for allowed list of properties in the constructor.
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = Fcm::Base->new (%args);
+
+  for (@scalar_properties) {
+    $self->{$_} = exists $args{$_} ? $args{$_} : undef;
+  }
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @scalar_properties.
+# ------------------------------------------------------------------------------
+
+for my $name (@scalar_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    # Argument specified, set property to specified argument
+    if (@_) {
+      $self->{$name} = $_[0];
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Interactive.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Interactive.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Interactive.pm	(revision 2528)
@@ -0,0 +1,131 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::Interactive;
+use base qw{Exporter};
+
+our @EXPORT_OK = qw{get_input};
+
+use Fcm::Util::ClassLoader;
+
+my $DEFAULT_IMPL_CLASS = 'Fcm::Interactive::InputGetter::CLI';
+my %DEFAULT_IMPL_CLASS_OPTIONS = ();
+
+my $IMPL_CLASS = $DEFAULT_IMPL_CLASS;
+my %IMPL_CLASS_OPTIONS = %DEFAULT_IMPL_CLASS_OPTIONS;
+
+################################################################################
+# Returns the name of the current class/settings for getting input
+sub get_impl {
+    return (wantarray() ? ($IMPL_CLASS, \%IMPL_CLASS_OPTIONS) : $IMPL_CLASS);
+}
+
+################################################################################
+# Returns the name of the current class/settings for getting input
+sub get_default_impl {
+    return (
+        wantarray()
+        ? ($DEFAULT_IMPL_CLASS, \%DEFAULT_IMPL_CLASS_OPTIONS)
+        : $DEFAULT_IMPL_CLASS
+    );
+}
+
+################################################################################
+# Sets the name of the class/settings for getting input
+sub set_impl {
+    my ($impl_class, $impl_class_options_ref) = @_;
+    if ($impl_class) {
+        $IMPL_CLASS = $impl_class;
+        if ($impl_class_options_ref) {
+            %IMPL_CLASS_OPTIONS = (%{$impl_class_options_ref});
+        }
+        else {
+            %IMPL_CLASS_OPTIONS = ();
+        }
+    }
+}
+
+################################################################################
+# Gets an input from the user and returns it
+sub get_input {
+    my (%options) = @_;
+    my ($class_name, $class_options_ref) = get_impl();
+    Fcm::Util::ClassLoader::load($class_name);
+    %options = map {lc($_), $options{$_}} keys(%options);
+    return $class_name->new({%{$class_options_ref}, %options})->invoke();
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::Interactive
+
+=head1 SYNOPSIS
+
+    use Fcm::Interactive;
+    Fcm::Interactive::set_impl('My::InputGetter', {option1 => 'value1', ...});
+    $answer = Fcm::Interactive::get_input(
+        title   => 'My title',
+        message => 'Would you like to ...?',
+        type    => 'yn',
+        default => 'n',
+    );
+
+=head1 DESCRIPTION
+
+Common interface for getting an interactive user reply. The default is to use a
+L<Fcm::Interactive::InputGetter::CLI|Fcm::Interactive::InputGetter::CLI> object
+with no extra options.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item get_impl()
+
+Returns the class that implements the function for get_input(%options). In
+scalar context, returns the class name only. In list context, returns the class
+name and the extra hash options that would be passed to its constructor.
+
+=item get_default_impl()
+
+Returns the defaut values for get_impl().
+
+=item set_impl($impl_class,$impl_class_options_ref)
+
+Sets the class that implements the function for get_input(%options). The name
+of the class is given in $impl_class. Any extra options that should be given to
+the constructor should be set in the hash reference $impl_class_options_ref.
+
+=item get_input(%options)
+
+Calls the appropriate function to get an input string from the user, and
+returns it.
+
+Input options are: I<title>, for a short title of the prompt, I<message>, for
+the message prompt, I<type> for the prompt type, and I<default> for the default
+value of the return value.
+
+Prompt type can be YN (yes or no), YNA (yes, no or all) or input (for an input
+string).
+
+=back
+
+=head1 SEE ALSO
+
+L<Fcm::Interactive::InputGetter|Fcm::Interactive::InputGetter>,
+L<Fcm::Interactive::InputGetter::CLI|Fcm::Interactive::InputGetter::CLI>,
+L<Fcm::Interactive::InputGetter::GUI|Fcm::Interactive::InputGetter::GUI>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Interactive/InputGetter.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Interactive/InputGetter.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Interactive/InputGetter.pm	(revision 2528)
@@ -0,0 +1,122 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::Interactive::InputGetter;
+
+use Carp qw{croak};
+
+################################################################################
+# Constructor
+sub new {
+    my ($class, $args_ref) = @_;
+    return bless({%{$args_ref}}, $class);
+}
+
+################################################################################
+# Methods: get_*
+for my $key (
+    ############################################################################
+    # Returns the title of the prompt
+    'title',
+    ############################################################################
+    # Returns the message of the prompt
+    'message',
+    ############################################################################
+    # Returns the of the prompt
+    'type',
+    ############################################################################
+    # Returns the default return value
+    'default',
+) {
+    no strict qw{refs};
+    my $getter = "get_$key";
+    *$getter = sub {
+        my ($self) = @_;
+        return $self->{$key};
+    }
+}
+
+################################################################################
+# Invokes the getter
+sub invoke {
+    my ($self) = @_;
+    croak("Fcm::Interactive::InputGetter->invoke() not implemented.");
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::Interactive::TxtInputGetter
+
+=head1 SYNOPSIS
+
+    use Fcm::Interactive::TxtInputGetter;
+    $answer = Fcm::Interactive::get_input(
+        title   => 'My title',
+        message => 'Would you like to ...?',
+        type    => 'yn',
+        default => 'n',
+    );
+
+=head1 DESCRIPTION
+
+An object of this abstract class is used by
+L<Fcm::Interactive|Fcm::Interactive> to get a user reply.
+
+=head1 METHODS
+
+=over 4
+
+=item new($args_ref)
+
+Constructor, normally invoked via L<Fcm::Interactive|Fcm::Interactive>.
+
+Input options are: I<title>, for a short title of the prompt, I<message>, for
+the message prompt, I<type> for the prompt type, and I<default> for the default
+value of the return value.
+
+Prompt type can be YN (yes or no), YNA (yes, no or all) or input (for an input
+string).
+
+=item get_title()
+
+Returns the title of the prompt.
+
+=item get_message()
+
+Returns the message of the prompt.
+
+=item get_type()
+
+Returns the type of the prompt, can be YN (yes or no), YNA (yes, no or all) or
+input (for an input string).
+
+=item get_default()
+
+Returns the default return value of invoke().
+
+=item invoke()
+
+Gets an input string from the user, and returns it. Sub-classes must override
+this method.
+
+=back
+
+=head1 SEE ALSO
+
+L<Fcm::Interactive|Fcm::Interactive>,
+L<Fcm::Interactive::TxtInputGetter|Fcm::Interactive::TxtInputGetter>,
+L<Fcm::Interactive::GUIInputGetter|Fcm::Interactive::GUIInputGetter>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Interactive/InputGetter/CLI.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Interactive/InputGetter/CLI.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Interactive/InputGetter/CLI.pm	(revision 2528)
@@ -0,0 +1,87 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::Interactive::InputGetter::CLI;
+use base qw{Fcm::Interactive::InputGetter};
+
+my $DEF_MSG = q{ (or just press <return> for "%s")};
+my %EXTRA_MSG_FOR = (
+    yn  => qq{\nEnter "y" or "n"},
+    yna => qq{\nEnter "y", "n" or "a"},
+);
+my %CHECKER_FOR = (
+    yn  => sub {$_[0] eq 'y' || $_[0] eq 'n'},
+    yna => sub {$_[0] eq 'y' || $_[0] eq 'n' || $_[0] eq 'a'},
+);
+
+sub invoke {
+    my ($self) = @_;
+    my $type = $self->get_type() ? lc($self->get_type()) : q{};
+    my $message
+        = $self->get_message()
+        . (exists($EXTRA_MSG_FOR{$type}) ? $EXTRA_MSG_FOR{$type} : q{})
+        . ($self->get_default() ? sprintf($DEF_MSG, $self->get_default()) : q{})
+        . q{: }
+        ;
+    while (1) {
+        print($message);
+        my $answer = readline(STDIN);
+        chomp($answer);
+        if (!$answer && $self->get_default()) {
+            $answer = $self->get_default();
+        }
+        if (!exists($CHECKER_FOR{$type}) || $CHECKER_FOR{$type}->($answer)) {
+            return $answer;
+        }
+    }
+    return;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::Interactive::InputGetter::CLI
+
+=head1 SYNOPSIS
+
+    use Fcm::Interactive;
+    $answer = Fcm::Interactive::get_input(
+        title   => 'My title',
+        message => 'Would you like to ...?',
+        type    => 'yn',
+        default => 'n',
+    );
+
+=head1 DESCRIPTION
+
+This is a solid implementation of
+L<Fcm::Interactive::InputGetter|Fcm::Interactive::InputGetter>. It gets a user
+reply from STDIN using a prompt on STDOUT.
+
+=head1 METHODS
+
+See L<Fcm::Interactive::InputGetter|Fcm::Interactive::InputGetter> for a list of
+methods.
+
+=head1 TO DO
+
+Use IO::Prompt.
+
+=head1 SEE ALSO
+
+L<Fcm::Interactive|Fcm::Interactive>,
+L<Fcm::Interactive::InputGetter|Fcm::Interactive::InputGetter>,
+L<Fcm::Interactive::InputGetter::GUI|Fcm::Interactive::InputGetter::GUI>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Interactive/InputGetter/GUI.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Interactive/InputGetter/GUI.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Interactive/InputGetter/GUI.pm	(revision 2528)
@@ -0,0 +1,248 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::Interactive::InputGetter::GUI;
+use base qw{Fcm::Interactive::InputGetter};
+
+use Tk;
+
+################################################################################
+# Returns the geometry string for the pop up message box
+sub get_geometry {
+    my ($self) = @_;
+    return $self->{geometry};
+}
+
+################################################################################
+# Invokes the getter
+sub invoke {
+    my ($self) = @_;
+    my $answer;
+    local $| = 1;
+
+    # Create a main window
+    my $mw = MainWindow->new();
+    $mw->title($self->get_title());
+
+    # Define the default which applies if the dialog box is just closed or
+    # the user selects 'cancel'
+    $answer = $self->get_default() ? $self->get_default() : q{};
+
+    if (defined($self->get_type()) && $self->get_type() =~ qr{\A yn}ixms) {
+        # Create a yes-no(-all) dialog box
+
+        # If TYPE is YNA then add a third button: 'all'
+        my $buttons = $self->get_type() =~ qr{a \z}ixms ? 3 : 2;
+
+        # Message of the dialog box
+        $mw->Label('-text' => $self->get_message())->grid(
+            '-row'        => 0,
+            '-column'     => 0,
+            '-columnspan' => $buttons,
+            '-padx'       => 10,
+            '-pady'       => 10,
+        );
+
+        # The "yes" button
+        my $y_b = $mw->Button(
+            '-text'      => 'Yes',
+            '-underline' => 0,
+            '-command'   => sub {$answer = 'y'; $mw->destroy()},
+        )
+        ->grid('-row' => 1, '-column' => 0, '-padx' => 5, '-pady' => 5);
+
+        # The "no" button
+        my $n_b = $mw->Button (
+            '-text'      => 'No',
+            '-underline' => 0,
+            '-command'   => sub {$answer = 'n'; $mw->destroy()},
+        )
+        ->grid('-row' => 1, '-column' => 1, '-padx' => 5, '-pady' => 5);
+
+        # The "all" button
+        my $a_b;
+        if ($buttons == 3) {
+            $a_b = $mw->Button(
+                '-text'      => 'All',
+                '-underline' => 0,
+                '-command'   => sub {$answer = 'a'; $mw->destroy()},
+            )
+            ->grid('-row' => 1, '-column' => 2, '-padx' => 5, '-pady' => 5);
+        }
+
+        # Keyboard binding
+        if ($buttons == 3) {
+            $mw->bind('<Key>' => sub {
+                my $button
+                    = $Tk::event->K() eq 'Y' || $Tk::event->K() eq 'y' ? $y_b
+                    : $Tk::event->K() eq 'N' || $Tk::event->K() eq 'n' ? $n_b
+                    : $Tk::event->K() eq 'A' || $Tk::event->K() eq 'a' ? $a_b
+                    :                                                    undef
+                    ;
+                if (defined($button)) {
+                    $button->invoke();
+                }
+            });
+        }
+        else {
+            $mw->bind('<Key>' => sub {
+                my $button
+                    = $Tk::event->K() eq 'Y' || $Tk::event->K() eq 'y' ? $y_b
+                    : $Tk::event->K() eq 'N' || $Tk::event->K() eq 'n' ? $n_b
+                    :                                                    undef
+                    ;
+                if (defined($button)) {
+                    $button->invoke();
+                }
+            });
+        }
+
+        # Handle the situation when the user attempts to quit the window
+        $mw->protocol('WM_DELETE_WINDOW', sub {
+            if (self->get_default()) {
+                $answer = $self->get_default();
+            }
+            $mw->destroy();
+        });
+    }
+    else {
+        # Create a dialog box to obtain an input string
+        # Message of the dialog box
+        $mw->Label('-text' => $self->get_message())->grid(
+            '-row'    => 0,
+            '-column' => 0,
+            '-padx'   => 5,
+            '-pady'   => 5,
+        );
+
+        # Entry box for the user to type in the input string
+        my $entry   = $answer;
+        my $input_e = $mw->Entry(
+            '-textvariable' => \$entry,
+            '-width'        => 40,
+        )
+        ->grid(
+            '-row'    => 0,
+            '-column' => 1,
+            '-sticky' => 'ew',
+            '-padx'   => 5,
+            '-pady'   => 5,
+        );
+
+        my $b_f = $mw->Frame->grid(
+            '-row'        => 1,
+            '-column'     => 0,
+            '-columnspan' => 2,
+            '-sticky'     => 'e',
+        );
+
+        # An OK button to accept the input string
+        my $ok_b = $b_f->Button (
+            '-text' => 'OK',
+            '-command' => sub {$answer = $entry; $mw->destroy()},
+        )
+        ->grid('-row' => 0, '-column' => 0, '-padx' => 5, '-pady' => 5);
+
+        # A Cancel button to reject the input string
+        my $cancel_b = $b_f->Button(
+            '-text' => 'Cancel',
+            '-command' => sub {$answer = undef; $mw->destroy()},
+        )
+        ->grid('-row' => 0, '-column' => 1, '-padx' => 5, '-pady' => 5);
+
+        # Keyboard binding
+        $mw->bind ('<Key>' => sub {
+            if ($Tk::event->K eq 'Return' or $Tk::event->K eq 'KP_Enter') {
+                $ok_b->invoke();
+            }
+            elsif ($Tk::event->K eq 'Escape') {
+                $cancel_b->invoke();
+            }
+        });
+
+        # Allow the entry box to expand
+        $mw->gridColumnconfigure(1, '-weight' => 1);
+
+        # Set initial focus on the entry box
+        $input_e->focus();
+        $input_e->icursor('end');
+    }
+
+    $mw->geometry($self->get_geometry());
+
+    # Switch on "always on top" property for $mw
+    $mw->property(
+        qw/set _NET_WM_STATE ATOM/,
+        32,
+        ['_NET_WM_STATE_STAYS_ON_TOP'],
+        ($mw->toplevel()->wrapper())[0],
+    );
+
+    MainLoop();
+    return $answer;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::Interactive::InputGetter::GUI
+
+=head1 SYNOPSIS
+
+    use Fcm::Interactive;
+    $answer = Fcm::Interactive::get_input(
+        title   => 'My title',
+        message => 'Would you like to ...?',
+        type    => 'yn',
+        default => 'n',
+    );
+
+=head1 DESCRIPTION
+
+This is a solid implementation of
+L<Fcm::Interactive::InputGetter|Fcm::Interactive::InputGetter>. It gets a user
+reply from a TK pop up message box.
+
+=head1 METHODS
+
+See L<Fcm::Interactive::InputGetter|Fcm::Interactive::InputGetter> for a list of
+inherited methods.
+
+=over 4
+
+=item new($args_ref)
+
+As in L<Fcm::Interactive::InputGetter|Fcm::Interactive::InputGetter>, but also
+accept a I<geometry> element for setting the geometry string of the pop up
+message box.
+
+=item get_geometry()
+
+Returns the geometry string for the pop up message box.
+
+=back
+
+=head1 TO DO
+
+Tidy up the logic of invoke(). Separate the logic for YN/A box and string input
+box, probably using a strategy pattern. Factor out the logic for the display
+and the return value.
+
+=head1 SEE ALSO
+
+L<Fcm::Interactive|Fcm::Interactive>,
+L<Fcm::Interactive::InputGetter|Fcm::Interactive::InputGetter>,
+L<Fcm::Interactive::InputGetter::CLI|Fcm::Interactive::InputGetter::CLI>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword.pm	(revision 2528)
@@ -0,0 +1,376 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::Keyword;
+
+use Carp qw{croak};
+use Fcm::Config;
+use Fcm::Exception;
+use Fcm::Keyword::Config;
+use Fcm::Keyword::Exception;
+use URI;
+
+my $ENTRIES;
+
+my $PREFIX_OF_LOCATION_KEYWORD = 'fcm';
+my $PATTERN_OF_RESERVED_REVISION_KEYWORDS
+    = qr{\A (?:\d+|HEAD|BASE|COMMITTED|PREV|\{[^\}]+\}) \z}ixms;
+
+################################################################################
+# Returns the Fcm::Keyword::Entries object for storing the location entries
+sub get_entries {
+    my ($reset) = @_;
+    if ($reset || !$ENTRIES) {
+        $ENTRIES = Fcm::Keyword::Config::get_entries('LOCATION_ENTRIES');
+    }
+    return $ENTRIES;
+}
+
+################################################################################
+# Returns a list of Fcm::Keyword::Entry::Location objects matching $in_loc
+sub get_location_entries_for {
+    my ($in_loc) = @_;
+    my ($loc, $rev, @entry_trail_refs) = _parse_loc($in_loc);
+    return (map {$_->[0]} @entry_trail_refs);
+}
+
+################################################################################
+# Returns the prefix of location keyword (with or without the delimiter).
+sub get_prefix_of_location_keyword {
+    my ($with_delimiter) = @_;
+    return $PREFIX_OF_LOCATION_KEYWORD . ($with_delimiter ? ':' : '');
+}
+
+################################################################################
+# Expands (the keywords in) the specfied location (and REV), and returns them
+sub expand {
+    my ($in_loc, $in_rev) = @_;
+    my ($loc, $rev) = _expand($in_loc, $in_rev);
+    return _unparse_loc($loc, $rev, $in_rev);
+}
+
+################################################################################
+# Returns the corresponding browser URL for the input VC location
+sub get_browser_url {
+    my ($in_loc, $in_rev) = @_;
+
+    my ($loc, $rev, @entry_trail_refs) = _expand($in_loc, $in_rev);
+    if (!@entry_trail_refs) {
+        croak(Fcm::Keyword::Exception->new({message => sprintf(
+            "%s: cannot be mapped to a browser URL", $in_loc,
+        )}));
+    }
+
+    my @entries = map {$_->[0]} @entry_trail_refs;
+    my $location_component_pattern
+        = _get_browser_url_setting(\@entries, 'location_component_pattern');
+    my $browser_url_template
+        = _get_browser_url_setting(\@entries, 'browser_url_template');
+    my $browser_rev_template
+        = _get_browser_url_setting(\@entries, 'browser_rev_template');
+
+    if (
+           $location_component_pattern
+        && $browser_url_template
+        && $browser_rev_template
+    ) {
+        my $uri = URI->new($loc);
+        my $sps = $uri->opaque();
+        my @matches = $sps =~ $location_component_pattern;
+        if (@matches) {
+            my $result = $browser_url_template;
+            for my $field_number (1 .. @matches) {
+                my $match = $matches[$field_number - 1];
+                $result =~ s/\{ $field_number \}/$match/xms;
+            }
+            my $rev_field = scalar(@matches) + 1;
+            if ($rev) {
+                my $rev_string = $browser_rev_template;
+                $rev_string =~ s/\{1\}/$rev/xms;
+                $result =~ s/\{ $rev_field \}/$rev_string/xms;
+            }
+            else {
+                $result =~ s/\{ $rev_field \}//xms;
+            }
+            return $result;
+        }
+    }
+    else {
+        croak(Fcm::Keyword::Exception->new({message => sprintf(
+            "%s: mapping templates not defined correctly", $in_loc,
+        )}));
+    }
+}
+
+################################################################################
+# Returns a browser URL setting, helper function for get_browser_url()
+sub _get_browser_url_setting {
+    my ($entries_ref, $setting) = @_;
+    my $getter = "get_$setting";
+    for my $entry (@{$entries_ref}) {
+        my $setting = $entry->$getter();
+        if ($setting) {
+            return $setting;
+        }
+    }
+    my $config = Fcm::Config->instance();
+    return $config->setting('URL_BROWSER_MAPPING_DEFAULT', uc($setting));
+}
+
+################################################################################
+# Un-expands the specfied location (and REV) to keywords, and returns them
+sub unexpand {
+    my ($in_loc, $in_rev) = @_;
+    my ($loc, $rev, @entry_trail_refs) = _parse_loc($in_loc, $in_rev);
+    if (@entry_trail_refs) {
+        my ($entry, $trail) = @{$entry_trail_refs[0]};
+        if ($rev) {
+            GET_REV_KEY:
+            for my $entry_trail_ref (@entry_trail_refs) {
+                my ($e, $t) = @{$entry_trail_ref};
+                my $rev_key
+                    = $e->get_revision_entries()->get_entry_by_value($rev);
+                if ($rev_key) {
+                    $rev = $rev_key->get_key();
+                    last GET_REV_KEY;
+                }
+            }
+        }
+        $loc = get_prefix_of_location_keyword(1) . $entry->get_key() . $trail;
+        return _unparse_loc($loc, $rev, $in_rev);
+    }
+    return _unparse_loc($in_loc, $in_rev, $in_rev);
+}
+
+################################################################################
+# Expands (the keywords in) the specfied location (and REV), and returns them
+sub _expand {
+    my ($in_loc, $in_rev) = @_;
+    my ($loc, $rev, @entry_trail_refs) = _parse_loc($in_loc, $in_rev);
+    if (@entry_trail_refs) {
+        my ($entry, $trail) = @{$entry_trail_refs[0]};
+        $loc = $entry->get_value() . $trail;
+        if ($rev && $rev !~ $PATTERN_OF_RESERVED_REVISION_KEYWORDS) {
+            my $r;
+            GET_REV:
+            for my $entry_trail_ref (@entry_trail_refs) {
+                my ($e, $t) = @{$entry_trail_ref};
+                $r = $e->get_revision_entries()->get_entry_by_key($rev);
+                if ($r) {
+                    $rev = $r->get_value();
+                    last GET_REV;
+                }
+            }
+            if (!$r) {
+                croak(Fcm::Keyword::Exception->new({message => sprintf(
+                    "%s: %s: unknown revision keyword",
+                    $loc, $rev,
+                )}));
+            }
+        }
+    }
+    return ($loc, $rev, @entry_trail_refs);
+}
+
+################################################################################
+# Parses $in_loc (and $in_rev)
+sub _parse_loc {
+    my ($in_loc, $in_rev) = @_;
+    if (!$in_loc) {
+        croak(Fcm::Exception->new({
+            message => 'internal error: $in_loc not defined',
+        }));
+    }
+    if ($in_loc) {
+        if (!defined($in_rev)) {
+            my ($loc, $rev) = $in_loc =~ qr{\A (.+) \@ ([^/\@]+) \z}xms;
+            if ($loc && $rev) {
+                return ($loc, $rev, _get_loc_entry($loc));
+            }
+            else {
+                return ($in_loc, $in_rev, _get_loc_entry($in_loc));
+            }
+        }
+        return ($in_loc, $in_rev, _get_loc_entry($in_loc));
+    }
+    return;
+}
+
+################################################################################
+# Returns a list of keyword entries/trailing path pairs for the input location
+sub _get_loc_entry {
+    my ($loc) = @_;
+    if ($loc) {
+        my $uri = URI->new($loc);
+        if (
+               $uri->scheme()
+            && $uri->scheme() eq get_prefix_of_location_keyword()
+        ) {
+            my ($key, $trail) = $uri->opaque() =~ qr{\A ([^/\@]+) (.*) \z}xms;
+            my $entry = get_entries()->get_entry_by_key($key);
+            if (!$entry || !$entry->get_value()) {
+                die(Fcm::Keyword::Exception->new({message => sprintf(
+                    "%s: unknown FCM location keyword", $loc,
+                )}));
+            }
+            $loc = $entry->get_value() . ($trail ? $trail : q{});
+        }
+        my @entry_trail_pairs = ();
+        my $lead = $loc;
+        GET_ENTRY:
+        while ($lead) {
+            my $entry = get_entries()->get_entry_by_value($lead);
+            if ($entry) {
+                my $trail = substr($loc, length($lead));
+                push @entry_trail_pairs, [$entry, $trail];
+            }
+            if (!($lead =~ s{/+ [^/]* \z}{}xms)) {
+                last GET_ENTRY;
+            }
+        }
+        if (@entry_trail_pairs) {
+            return @entry_trail_pairs;
+        }
+        else {
+            return;
+        }
+    }
+    return;
+}
+
+################################################################################
+# If $in_rev, returns (LOC, REV). Otherwise, returns LOC@REV
+sub _unparse_loc {
+    my ($loc, $rev, $in_rev) = @_;
+    if (!$loc) {
+        return;
+    }
+    return ($in_rev ? ($loc, $rev) : join(q{@}, $loc, ($rev ? $rev : ())));
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::Keyword
+
+=head1 SYNOPSIS
+
+    use Fcm::Keyword;
+
+    $loc = Fcm::Keyword::expand('fcm:namespace/path@rev-keyword');
+    $loc = Fcm::Keyword::unexpand('svn://host/namespace/path@1234');
+
+    ($loc, $rev) = Fcm::Keyword::expand('fcm:namespace/path', 'rev-keyword');
+    ($loc, $rev) = Fcm::Keyword::unexpand('svn://host/namespace/path', 1234);
+
+    $loc = Fcm::Keyword::get_browser_url('fcm:namespace/path');
+    $loc = Fcm::Keyword::get_browser_url('svn://host/namespace/path');
+
+    $loc = Fcm::Keyword::get_browser_url('fcm:namespace/path@1234');
+    $loc = Fcm::Keyword::get_browser_url('svn://host/namespace/path@1234');
+
+    $loc = Fcm::Keyword::get_browser_url('fcm:namespace/path', 1234);
+    $loc = Fcm::Keyword::get_browser_url('svn://host/namespace/path', 1234);
+
+    $entries = Fcm::Keyword::get_entries();
+
+=head1 DESCRIPTION
+
+This module contains utilities to expand and unexpand FCM location and revision
+keywords.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item expand($loc)
+
+Expands FCM keywords in $loc and returns the result.
+
+If $loc is a I<fcm> scheme URI, the leading part (before any "/" or "@"
+characters) of the URI opaque is the namespace of a FCM location keyword. This
+is expanded into the actual value. Optionally, $loc can be suffixed with a peg
+revision (an "@" followed by any characters). If a peg revision is a FCM
+revision keyword, it is expanded into the actual revision.
+
+=item expand($loc,$rev)
+
+Same as C<expand($loc)>, but $loc should not contain a peg revision. Returns a
+list containing the expanded version of $loc and $rev.
+
+=item get_browser_url($loc)
+
+Given a repository $loc in a known keyword namespace, returns the corresponding
+URL for the code browser.
+
+Optionally, $loc can be suffixed with a peg revision (an "@" followed by any
+characters).
+
+=item get_browser_url($loc,$rev)
+
+Same as get_browser_url($loc), but the revision should be specified using $rev
+but not pegged with $loc.
+
+=item get_entries([$reset])
+
+Returns the L<Fcm::Keyword::Entries|Fcm::Keyword::Entries> object for storing
+location keyword entries. If $reset if true, reloads the entries.
+
+=item get_location_entries_for($loc)
+
+Returns a list of L<Fcm::Keyword::Entry::Location|Fcm::Keyword::Entry::Location>
+objects matching $loc.
+
+=item get_prefix_of_location_keyword($with_delimiter)
+
+Returns the prefix of a FCM location keyword, (currently "fcm"). If
+$with_delimiter is specified and is true, returns the prefix with the delimiter,
+(currently "fcm:").
+
+=item unexpand($loc)
+
+Does the opposite of expand($loc). Returns the FCM location keyword equivalence
+of $loc. If the $loc can be mapped using 2 or more namespaces, the namespace
+that results in the longest substitution is used. Optionally, $loc can be
+suffixed with a peg revision (an "@" followed by any characters). If a peg
+revision is a known revision, it is turned into its corresponding revision
+keyword.
+
+=item unexpand($loc,$rev)
+
+Same as unexpand($loc), but $loc should not contain a peg revision. Returns a
+list containing the unexpanded version of $loc and $rev 
+
+=back
+
+=head1 DIAGNOSTICS
+
+=over 4
+
+=item L<Fcm::Keyword::Exception|Fcm::Keyword::Exception>
+
+Functions in this module may die() with this exception when it fails to expand
+a keyword.
+
+=back
+
+=head1 SEE ALSO
+
+L<Fcm::Keyword::Config|Fcm::Keyword::Config>,
+L<Fcm::Keyword::Entries|Fcm::Keyword::Entries>,
+L<Fcm::Keyword::Entry|Fcm::Keyword::Entry>,
+L<Fcm::Keyword::Entry::Location|Fcm::Keyword::Entry::Location>,
+L<Fcm::Keyword::Exception|Fcm::Keyword::Exception>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Config.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Config.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Config.pm	(revision 2528)
@@ -0,0 +1,143 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::Keyword::Config;
+
+use Carp;
+use Fcm::Keyword::Entries;
+use Fcm::Keyword::Exception;
+use Fcm::Util::ClassLoader;
+
+our %CONFIG_OF = (
+    LOCATION_ENTRIES => {
+        entry_class => 'Fcm::Keyword::Entry::Location',
+        loaders => [
+            {
+                class => 'Fcm::Keyword::Loader::Config::Location',
+            },
+        ],
+    },
+    REVISION_ENTRIES => {
+        entry_class => 'Fcm::Keyword::Entry',
+        loaders => [
+            {
+                class   => 'Fcm::Keyword::Loader::Config::Revision',
+                options => [{key => 'namespace', valuekey => 'key'}],
+            },
+            {
+                class   => 'Fcm::Keyword::Loader::VC::Revision',
+                options => [{key => 'source', valuekey => 'value'}],
+            },
+        ],
+    },
+);
+
+################################################################################
+# Returns a Fcm::Keyword::Entries object for given configuration
+sub get_entries {
+    my ($context, $args_ref) = @_;
+    if (!exists($CONFIG_OF{$context})) {
+        croak(Fcm::Keyword::Exception->new({message => sprintf(
+            "%s: keyword configuration not found", $context,
+        )}));
+    }
+    my $config_ref = $CONFIG_OF{$context};
+    my @loaders;
+    if (exists($config_ref->{loaders})) {
+        for my $loader_config (@{$config_ref->{loaders}}) {
+            my $class = $loader_config->{class};
+            Fcm::Util::ClassLoader::load($class);
+            my %options;
+            if (exists($loader_config->{options})) {
+                for my $option_ref (@{$loader_config->{options}}) {
+                    my $key = $option_ref->{key};
+                    my $value;
+                    if (exists($option_ref->{value})) {
+                        $value = $option_ref->{value};
+                    }
+                    elsif (
+                           exists($option_ref->{valuekey})
+                        && $args_ref
+                        && ref($args_ref) eq 'HASH'
+                        && exists($args_ref->{$option_ref->{valuekey}})
+                    ) {
+                        $value = $args_ref->{$option_ref->{valuekey}};
+                    }
+                    $options{$key} = $value;
+                }
+            }
+            push @loaders, $class->new(\%options);
+        }
+    }
+    my %entries_options = (
+        (@loaders ? (loaders => \@loaders) : ()),
+        (
+            exists($config_ref->{entry_class})
+            ? (entry_class => $config_ref->{entry_class})
+            : ()
+        ),
+    );
+    return Fcm::Keyword::Entries->new(\%entries_options);
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::Keyword::Config
+
+=head1 SYNOPSIS
+
+    use Fcm::Keyword::Config;
+
+=head1 DESCRIPTION
+
+This module stores the default configuration used by modules in the
+L<Fcm::Keyword> family.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item get_entries($context,$args_ref)
+
+Returns a L<Fcm::Keyword::Entries|Fcm::Keyword::Entries> object for a given
+$context. If there is no matching $context in the configuration, croak() with a
+L<Fcm::Keyword::Exception|Fcm::Keyword::Exception>. $args_ref is an optional
+argument, which should be a reference to a hash containing a I<key> and a
+I<value> element. It can be used by this function to set up the constructor
+options in the loaders of the returned
+L<Fcm::Keyword::Entries|Fcm::Keyword::Entries> object.
+
+=back
+
+=head1 DIAGNOSTICS
+
+=head1 TO DO
+
+Allow configuration to be changed in runtime.
+
+Convert this module to OO?
+
+Separate configuration from logic if this module becomes any bigger.
+
+Unit tests.
+
+=head1 SEE ALSO
+
+L<Fcm::Keyword|Fcm::Keyword>,
+L<Fcm::Keyword::Entries|Fcm::Keyword::Entries>,
+L<Fcm::Keyword::Exception|Fcm::Keyword::Exception>,
+L<Fcm::Keyword::Entry::Location|Fcm::Keyword::Entry::Location>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Entries.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Entries.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Entries.pm	(revision 2528)
@@ -0,0 +1,211 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::Keyword::Entries;
+
+use Carp qw{croak};
+use Fcm::Util::ClassLoader;
+
+sub new {
+    my ($class, $args_ref) = @_;
+    return bless(
+        {
+            entry_class             => 'Fcm::Keyword::Entry',
+            entry_by                => {key => {}, value => {}},
+            has_loaded_entries_from => {},
+            loaders                 => [],
+            ($args_ref && ref($args_ref) eq 'HASH' ? %{$args_ref} : ()),
+        },
+        $class,
+    );
+}
+
+################################################################################
+# Returns the class of entries stored by this entries list
+sub get_entry_class {
+    my ($self) = @_;
+    return $self->{entry_class};
+}
+
+################################################################################
+# Returns all entries
+sub get_all_entries {
+    my ($self) = @_;
+    if (!%{$self->{entry_by}{key}}) {
+        # Nothing set, attempt to load entries
+        $self->load_entries();
+    }
+    if (wantarray()) {
+        return values(%{$self->{entry_by}{key}});
+    }
+    else {
+        return [values(%{$self->{entry_by}{key}})];
+    }
+}
+
+################################################################################
+# Methods: get_entry_by_*
+for my $name (
+    ### Returns an entry with a matching key
+    'key',
+    ### Returns an entry with a matching value
+    'value'
+) {
+    no strict qw{refs};
+    my $method = "get_entry_by_$name";
+    *$method = sub {
+        my ($self, $search_key) = @_;
+        if (!defined($search_key)) {
+            return;
+        }
+        my $sk = ($name eq 'key') ? uc($search_key) : $search_key;
+        if (!exists($self->{entry_by}{$name}{$sk})) {
+            $self->load_entries($name, $sk);
+        }
+        if (exists($self->{entry_by}{$name}{$sk})) {
+            return $self->{entry_by}{$name}{$sk};
+        }
+        else {
+            return;
+        }
+    }
+}
+
+################################################################################
+# Adds an entry
+sub add_entry {
+    my ($self, $key, $value, $args_ref) = @_;
+    Fcm::Util::ClassLoader::load($self->get_entry_class());
+    my $entry = $self->get_entry_class()->new({
+        key   => uc($key),
+        value => $value,
+        ($args_ref && ref($args_ref) eq 'HASH' ? %{$args_ref} : ()),
+    });
+    $self->{entry_by}{key}{uc($key)} = $entry;
+    $self->{entry_by}{value}{$value} = $entry;
+    return $entry;
+}
+
+################################################################################
+# Returns the loaders for this entries list
+sub get_loaders {
+    my ($self) = @_;
+    return (wantarray() ? @{$self->{loaders}} : $self->{loaders});
+}
+
+################################################################################
+# Loads entries using its loaders
+sub load_entries {
+    my ($self, $name, $search_key) = @_;
+    LOADER:
+    for my $loader ($self->get_loaders()) {
+        if ($self->{has_loaded_entries_from}{$loader->get_source()}) {
+            next LOADER;
+        }
+        $self->{has_loaded_entries_from}{$loader->get_source()}
+            = $loader->load_to($self);
+        if ($name && exists($self->{entry_by}{$name}{$search_key})) {
+            last LOADER;
+        }
+    }
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::Keyword::Entries
+
+=head1 SYNOPSIS
+
+    use Fcm::Keyword::Entries;
+
+    my $entries = Fcm::Keyword::Entries->new({
+        entry_class => $entry_class,
+        loaders     => \@loaders,
+    });
+    $entry = $entries->get_entry_by_key($key);
+    $entry = $entries->get_entry_by_value($value);
+
+    for my $entry ($entries->get_entries()) {
+        # ...
+    }
+
+    $entries->add_entry($key, $value);
+
+=head1 DESCRIPTION
+
+This module is used to manipulate FCM keyword entries. It is used by
+L<Fcm::Keyword|Fcm::Keyword> to store keyword entries, which are
+L<Fcm::Keyword::Entry|Fcm::Keyword::Entry> objects.
+
+=head1 METHODS
+
+=over 4
+
+=item C<new({entry_class =E<gt> $entry_class, loaders =E<gt> \@loaders})>
+
+Constructor. The argument should be a reference to hash, where:
+
+I<entry_class> is a string representing the class name of entries in this
+object. The class must be a sub-class of
+L<Fcm::Keyword::Entry|Fcm::Keyword::Entry>. The default is
+"L<Fcm::Keyword::Entry|Fcm::Keyword::Entry>".
+
+I<loaders> is a reference to an array of
+L<Fcm::Keyword::Loader|Fcm::Keyword::Loader> objects, which will be used to
+load entries into this object. The default is an empty array.
+
+=item add_entry($key,$value)
+
+Adds an entry. Returns the added entry. (Keys are converted to uppercases
+automatically.)
+
+=item get_all_entries()
+
+Returns all entries that are currently loaded.
+
+=item get_entry_by_key($key)
+
+Return an entry, whose key matches $key. (Search is case-insensitive.) Returns
+undef if there is no matching entry.
+
+=item get_entry_by_value($value)
+
+Return an entry, whose value matches $value. (Search is case-sensitive.)
+Returns undef if there is no matching entry.
+
+=item get_loaders()
+
+Returns the loaders for loading entries.
+
+=item load_entries()
+
+Loads entries from its loaders, as returned by get_loaders(). This method can
+also be triggered by get_all_entries(), if the entry list is empty, or by
+get_entry_by_key($key) and get_entry_by_value($value) methods, if there is no
+matching entry in the current lookup lists.
+
+=back
+
+=head1 TO DO
+
+Handle duplicated entries in add_entry($key,$value).
+
+=head1 SEE ALSO
+
+L<Fcm::Keyword|Fcm::Keyword>,
+L<Fcm::Keyword::Entry|Fcm::Keyword::Entry>,
+L<Fcm::Keyword::Loader|Fcm::Keyword::Loader>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Entry.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Entry.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Entry.pm	(revision 2528)
@@ -0,0 +1,83 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::Keyword::Entry;
+
+sub new {
+    my ($class, $args_ref) = @_;
+    if (!$args_ref) {
+        $args_ref = {};
+    }
+    return bless({%{$args_ref}}, $class);
+}
+
+################################################################################
+### Methods: get_*
+for my $name (
+    # Returns the key of this entry
+    'key',
+    # Returns the value of this entry
+    'value',
+) {
+    no strict qw{refs};
+    my $getter = "get_$name";
+    *$getter = sub {
+        my ($self) = @_;
+        return $self->{$name};
+    }
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::Keyword::Entry
+
+=head1 SYNOPSIS
+
+    use Fcm::Keyword::Entry;
+
+    $entry = Fcm::Keyword::Entry->new({key => $key, value => $value});
+    $key = $entry->get_key();
+    $value = $entry->get_value();
+
+=head1 DESCRIPTION
+
+An object of this class represents a FCM keyword entry.
+
+=head1 METHODS
+
+=over 4
+
+=item C<new({key =E<gt> $key, value =E<gt> $value})>
+
+Constructor.
+
+=item get_key()
+
+Returns the key of this keyword entry.
+
+=item get_value()
+
+Returns the value of this keyword entry.
+
+=back
+
+Simple formatter for displaying an entry.
+
+=head1 SEE ALSO
+
+L<Fcm::Keyword|Fcm::Keyword>,
+L<Fcm::Keyword::Entries|Fcm::Keyword::Entries>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Entry/Location.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Entry/Location.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Entry/Location.pm	(revision 2528)
@@ -0,0 +1,146 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::Keyword::Entry::Location;
+use base qw{Fcm::Keyword::Entry};
+
+use Fcm::Keyword::Config;
+
+sub new {
+    my ($class, $args_ref) = @_;
+    if (!$args_ref) {
+        $args_ref = {};
+    }
+    $args_ref = {
+        browser_rev_template       => undef,
+        browser_url_template       => undef,
+        implied_entry_list         => [],
+        is_implied                 => 0,
+        location_component_pattern => undef,
+        revision_entries           => Fcm::Keyword::Config::get_entries(
+            'REVISION_ENTRIES', $args_ref,
+        ),
+        %{$args_ref},
+    },
+    return bless({%{$args_ref}}, $class);
+}
+
+################################################################################
+# Methods: get_*
+for my $key (
+    # Returns a template for constructing the browser URL
+    'browser_url_template',
+    # Returns a template for constructing the revision part in the browser URL
+    'browser_rev_template',
+    # Returns a list of entries implied this entry
+    'implied_entry_list',
+    # Returns the component pattern for a location matching this entry
+    'location_component_pattern',
+    # Returns the entries for revision keywords
+    'revision_entries',
+) {
+    no strict qw{refs};
+    my $getter = "get_$key";
+    *$getter = sub {
+        my ($self) = @_;
+        return $self->{$key};
+    }
+}
+
+################################################################################
+# Returns true if this is an implied entry
+sub is_implied {
+    my ($self) = @_;
+    return $self->{is_implied};
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::Keyword::Entry::Location
+
+=head1 SYNOPSIS
+
+    use Fcm::Keyword::Entry::Location;
+
+    $entry = Fcm::Keyword::Entry::Location->new({
+        key => $key, value => $value, # ...
+    });
+
+    $key = $entry->get_key();
+    $value = $entry->get_value();
+    $revision_entries = $entry->get_revision_entries();
+
+=head1 DESCRIPTION
+
+This is a sub-class of L<Fcm::Keyword::Entry|Fcm::Keyword::Entry>. An object of
+this class represents a FCM location keyword entry.
+
+=head1 METHODS
+
+See L<Fcm::Keyword::Entry|Fcm::Keyword::Entry> for inherited methods.
+
+=over 4
+
+=item new($args_ref)
+
+Constructor.
+
+=item get_browser_url_template()
+
+Returns the template string for constructing the browser URL. The string {1},
+{2}, {3}, etc in the template string will be substituted by the components
+captured by the location component pattern and the revision template. See
+C<get_url_component_pattern()> and C<get_browser_rev_template()>.
+
+=item get_browser_rev_template()
+
+Returns the template string for constructing the revision part of the browser
+URL. The string {1} in the template string will be substituted by the revision.
+See C<get_browser_url_template()>.
+
+=item get_implied_entry_list()
+
+Returns a list of entries implied by this entry.
+
+=item get_location_component_pattern()
+
+Returns a regular expression, when matched against the scheme-specific-part in
+the actual URI of a location in the namespace of this keyword entry, will
+capture a list of components, which can then be used to replace the numbered
+fields in the browser URL template. See C<get_browser_url_template()>.
+
+=item get_revision_entries()
+
+Returns a L<Fcm::Keyword::Entries|Fcm::Keyword::Entries> object containing the
+revision keyword entries of this location.
+
+=item is_implied()
+
+Returns true if this is an implied entry.
+
+=back
+
+=head1 TO DO
+
+Introduce a Fcm::Keyword::Config module to store entries constructor setting.
+
+=head1 SEE ALSO
+
+L<Fcm::Keyword|Fcm::Keyword>,
+L<Fcm::Keyword::Config|Fcm::Keyword::Config>,
+L<Fcm::Keyword::Entries|Fcm::Keyword::Entries>,
+L<Fcm::Keyword::Entry|Fcm::Keyword::Entry>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Exception.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Exception.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Exception.pm	(revision 2528)
@@ -0,0 +1,42 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::Keyword::Exception;
+use base qw{Fcm::Exception};
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::Keyword::Exception
+
+=head1 SYNOPSIS
+
+    use Carp qw{croak};
+    use Fcm::Keyword::Exception;
+    croak(Fcm::Keyword::Exception->new({message => 'something is wrong'}));
+
+=head1 DESCRIPTION
+
+This class extends L<Fcm::Exception|Fcm::Exception>. This exception is thrown
+on errors associated with the command line interface.
+
+=head1 METHODS
+
+See L<Fcm::Exception|Fcm::Exception> for a list of methods.
+
+=head1 SEE ALSO
+
+L<Fcm::Exception|Fcm::Exception>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Formatter/Entries.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Formatter/Entries.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Formatter/Entries.pm	(revision 2528)
@@ -0,0 +1,77 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::Keyword::Formatter::Entries;
+
+use Fcm::Keyword::Formatter::Entry;
+
+################################################################################
+# Constructor
+sub new {
+    my ($class) = @_;
+    return bless(\do{my $annon_scalar}, $class);
+}
+
+################################################################################
+# Formats a keyword entry
+sub format {
+    my ($self, $entries) = @_;
+    my $formatter = Fcm::Keyword::Formatter::Entry->new();
+    my $return = q{};
+    for my $entry (
+        sort {$a->get_key() cmp $b->get_key()}
+        grep {!$_->can('is_implied') || !$_->is_implied()}
+        $entries->get_all_entries()
+    ) {
+        $return .= $formatter->format($entry);
+    }
+    return $return;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::Keyword::Formatter::Entries
+
+=head1 SYNOPSIS
+
+    use Fcm::Keyword::Formatter::Entries;
+    $formatter = Fcm::Keyword::Formatter::Entries->new();
+    print($formatter->format($entries));
+
+=head1 DESCRIPTION
+
+An object of this class is used to format a keyword entries object.
+
+=head1 METHODS
+
+=over 4
+
+=item new()
+
+Constructor.
+
+=item format($entries)
+
+Returns a simple string representation of $entries.
+
+=back
+
+=head1 SEE ALSO
+
+L<Fcm::Keyword::Entries|Fcm::Keyword::Entries>,
+L<Fcm::Keyword::Entry|Fcm::Keyword::Entry>,
+L<Fcm::Keyword::Formatter::Entry|Fcm::Keyword::Formatter::Entry>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Formatter/Entry.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Formatter/Entry.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Formatter/Entry.pm	(revision 2528)
@@ -0,0 +1,64 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::Keyword::Formatter::Entry;
+
+################################################################################
+# Constructor
+sub new {
+    my ($class) = @_;
+    return bless(\do{my $annon_scalar}, $class);
+}
+
+################################################################################
+# Formats a keyword entry
+sub format {
+    my ($self, $entry) = @_;
+    return sprintf("%s = %s\n", $entry->get_key(), $entry->get_value());
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::Keyword::Formatter::Entry
+
+=head1 SYNOPSIS
+
+    use Fcm::Keyword::Formatter::Entry;
+    $formatter = Fcm::Keyword::Formatter::Entry->new();
+    print($formatter->format($entry));
+
+=head1 DESCRIPTION
+
+An object of this class is used to format a keyword entry.
+
+=head1 METHODS
+
+=over 4
+
+=item new()
+
+Constructor.
+
+=item format($entry)
+
+Returns a simple string representation of $entry.
+
+=back
+
+=head1 SEE ALSO
+
+L<Fcm::Keyword::Entry|Fcm::Keyword::Entry>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Formatter/Entry/Location.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Formatter/Entry/Location.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Formatter/Entry/Location.pm	(revision 2528)
@@ -0,0 +1,72 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::Keyword::Formatter::Entry::Location;
+use base qw{Fcm::Keyword::Formatter::Entry};
+
+use Fcm::Config;
+use Fcm::Keyword::Formatter::Entries;
+
+################################################################################
+# Formats a keyword entry
+sub format {
+    my ($self, $entry) = @_;
+    my $return = $self->SUPER::format($entry);
+    for my $implied_entry (@{$entry->get_implied_entry_list()}) {
+        $return .= $self->SUPER::format($implied_entry);
+    }
+    if (@{$entry->get_revision_entries()->get_all_entries()}) {
+        my $formatter = Fcm::Keyword::Formatter::Entries->new();
+        $return .= "\n[revision keyword]\n";
+        $return .= $formatter->format($entry->get_revision_entries());
+    }
+    return $return;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::Keyword::Formatter::Entry::Location
+
+=head1 SYNOPSIS
+
+    use Fcm::Keyword::Formatter::Entry::Location;
+    $formatter = Fcm::Keyword::Formatter::Entry::Location->new();
+    print($formatter->format($entry));
+
+=head1 DESCRIPTION
+
+An object of this class is used to format the detail in a location keyword entry.
+
+=head1 METHODS
+
+=over 4
+
+=item new()
+
+Constructor.
+
+=item format($entry)
+
+Returns a string representation of $entry.
+
+=back
+
+=head1 SEE ALSO
+
+L<Fcm::Keyword::Entry|Fcm::Keyword::Entry>,
+L<Fcm::Keyword::Formatter::Entry|Fcm::Keyword::Formatter::Entry>,
+L<Fcm::Keyword::Formatter::Entries|Fcm::Keyword::Formatter::Entries>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Loader.pod
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Loader.pod	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Loader.pod	(revision 2528)
@@ -0,0 +1,43 @@
+=head1 NAME
+
+Fcm::Keyword::Loader
+
+=head1 SYNOPSIS
+
+    $loader->load_to($entries);
+
+=head1 DESCRIPTION
+
+This is an interface of a class that loads FCM keywords into a
+L<Fcm::Keyword::Entries|Fcm::Keyword::Entries> object.
+
+=head1 METHODS
+
+=over 4
+
+=item get_source()
+
+The name of the source where this loader loads its FCM keywords from.
+
+=item load_to($entries)
+
+Loads FCM keywords into $entries, which should be a
+L<Fcm::Keyword::Entries|Fcm::Keyword::Entries> object. Returns the number of
+successfully loaded entries.
+
+=back
+
+=head1 SEE ALSO
+
+L<Fcm::Keyword|Fcm::Keyword>,
+L<Fcm::Keyword::Entries|Fcm::Keyword::Entries>,
+L<Fcm::Keyword::Entry|Fcm::Keyword::Entry>,
+L<Fcm::Keyword::Loader::Config::Location|Fcm::Keyword::Loader::Config::Location>,
+L<Fcm::Keyword::Loader::Config::Revision|Fcm::Keyword::Loader::Config::Revision>,
+L<Fcm::Keyword::Loader::VC::Revision|Fcm::Keyword::Loader::VC::Revision>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Loader/Config/Location.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Loader/Config/Location.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Loader/Config/Location.pm	(revision 2528)
@@ -0,0 +1,128 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::Keyword::Loader::Config::Location;
+
+use Fcm::Config;
+
+my %IMPLIED_NAMESPACE_SUFFIX = (tr => 'trunk', br => 'branches', tg => 'tags');
+
+sub new {
+    my ($class) = @_;
+    return bless(\do{my $annon_scalar}, $class);
+}
+
+################################################################################
+# Returns 'Fcm::Config'
+sub get_source {
+    my ($self) = @_;
+    return 'Fcm::Config';
+}
+
+################################################################################
+# Loads location keywords from Fcm::Config to $entries
+sub load_to {
+    my ($self, $entries) = @_;
+    my $config = $self->get_source()->instance();
+    my $load_counter = 0;
+    for my $key (keys(%{$config->setting('URL')})) {
+        my $value = $config->setting('URL', $key);
+        my $location_component_pattern = $config->setting(
+            'URL_BROWSER_MAPPING', $key, 'LOCATION_COMPONENT_PATTERN');
+        my $browser_url_template = $config->setting(
+            'URL_BROWSER_MAPPING', $key, 'BROWSER_URL_TEMPLATE');
+        my $browser_rev_template = $config->setting(
+            'URL_BROWSER_MAPPING', $key, 'BROWSER_REV_TEMPLATE');
+        my $entry = $entries->add_entry(
+            $key,
+            $value,
+            {
+                location_component_pattern => $location_component_pattern,
+                browser_url_template       => $browser_url_template,
+                browser_rev_template       => $browser_rev_template,
+            },
+        );
+        $load_counter++;
+
+        # Set up implied keywords
+        for my $suffix (keys(%IMPLIED_NAMESPACE_SUFFIX)) {
+            my $value_suf = $value . '/' . $IMPLIED_NAMESPACE_SUFFIX{$suffix};
+            for my $join (q{_}, q{-}) {
+                my $implied_entry = $entries->add_entry(
+                    uc($key . $join . $suffix),
+                    $value_suf,
+                    {is_implied => 1},
+                );
+                push(@{$entry->get_implied_entry_list()}, $implied_entry);
+                $load_counter++;
+            }
+        }
+    }
+    return ($config->is_initialising() ? 0 : defined($load_counter));
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::Keyword::Loader::Config::Location
+
+=head1 SYNOPSIS
+
+    $loader = Fcm::Keyword::Loader::Config::Location->new();
+    $loader->load_to($entries);
+
+=head1 DESCRIPTION
+
+This class implements the L<Fcm::Keyword::Loader|Fcm::Keyword::Loader>
+interface.
+
+Loads location keywords from L<Fcm::Config|Fcm::Config> into a
+L<Fcm::Keyword::Entries|Fcm::Keyword::Entries> object containing
+L<Fcm::Keyword::Entry::Location|Fcm::Keyword::Entry::Location> objects.
+
+=head1 METHODS
+
+=over 4
+
+=item new()
+
+Constructor.
+
+=item get_source()
+
+Returns the string "L<Fcm::Config|Fcm::Config>".
+
+=item load_to($entries)
+
+Loads location keywords and implied keywords from L<Fcm::Config|Fcm::Config> to
+$entries. It also loads settings for mapping location to browser URL. Returns
+true on success. (However, if L<Fcm::Config|Fcm::Config> is initialising,
+returns false to force a reload next time.)
+
+=back
+
+=head1 TO DO
+
+Need a more flexible system for implied keywords.
+
+=head1 SEE ALSO
+
+L<Fcm::Config|Fcm::Config>,
+L<Fcm::Keyword|Fcm::Keyword>,
+L<Fcm::Keyword::Entries|Fcm::Keyword::Entries>,
+L<Fcm::Keyword::Entry|Fcm::Keyword::Entry>,
+L<Fcm::Keyword::Loader|Fcm::Keyword::Loader>,
+L<Fcm::Keyword::Loader::Config::Revision|Fcm::Keyword::Loader::Config::Revision>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Loader/Config/Revision.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Loader/Config/Revision.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Loader/Config/Revision.pm	(revision 2528)
@@ -0,0 +1,110 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::Keyword::Loader::Config::Revision;
+
+use Fcm::Config;
+
+sub new {
+    my ($class, $args_ref) = @_;
+    return bless({%{$args_ref}}, $class);
+}
+
+################################################################################
+# Returns the namespace where the revision keywords belong
+sub get_namespace {
+    my ($self) = @_;
+    return $self->{namespace};
+}
+
+################################################################################
+# Returns 'Fcm::Config'
+sub get_source {
+    my ($self) = @_;
+    return 'Fcm::Config';
+}
+
+################################################################################
+# Loads revision keywords from Fcm::Config to $entries
+sub load_to {
+    my ($self, $entries) = @_;
+    my $load_counter = 0;
+    my $config = $self->get_source()->instance();
+    my $rev_keyword_ref = $config->setting(
+        qw/URL_REVISION/,
+        uc($self->get_namespace()),
+    );
+    if ($rev_keyword_ref) {
+        for my $key (keys(%{$rev_keyword_ref})) {
+            $entries->add_entry($key, $rev_keyword_ref->{$key});
+            $load_counter++;
+        }
+    }
+    return ($config->is_initialising() ? 0 : defined($load_counter));
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::Keyword::Loader::Config::Revision
+
+=head1 SYNOPSIS
+
+    $loader = Fcm::Keyword::Loader::Config::Revision->new({namespace => $name});
+    $loader->load_to($entries);
+
+=head1 DESCRIPTION
+
+Loads revision keywords from L<Fcm::Config|Fcm::Config> into a
+L<Fcm::Keyword::Entries|Fcm::Keyword::Entries> object containing
+L<Fcm::Keyword::Entry|Fcm::Keyword::Entry> objects.
+
+=head1 METHODS
+
+=over 4
+
+=item C<new({namespace =E<gt> $namespace})>
+
+Constructor. The argument $namespace is the namespace where the revision
+keywords belong.
+
+=item get_namespace()
+
+Returns the namespace where the revision keywords belong.
+
+=item get_source()
+
+Returns the string "L<Fcm::Config|Fcm::Config>".
+
+=item load_to($entries)
+
+Loads revision keywords in the namespace given by C<$self-E<gt>get_namespace()>
+from L<Fcm::Config|Fcm::Config> to $entries. Returns true on success. (However,
+if L<Fcm::Config|Fcm::Config> is initialising, returns false to force a reload
+next time.)
+
+=back
+
+=head1 SEE ALSO
+
+L<Fcm::Config|Fcm::Config>,
+L<Fcm::Keyword|Fcm::Keyword>,
+L<Fcm::Keyword::Entries|Fcm::Keyword::Entries>,
+L<Fcm::Keyword::Entry|Fcm::Keyword::Entry>,
+L<Fcm::Keyword::Entry::Location|Fcm::Keyword::Entry::Location>,
+L<Fcm::Keyword::Loader|Fcm::Keyword::Loader>,
+L<Fcm::Keyword::Loader::Config::Location|Fcm::Keyword::Loader::Config::Location>
+L<Fcm::Keyword::Loader::VC::Revision|Fcm::Keyword::Loader::VC::Revision>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Loader/VC/Revision.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Loader/VC/Revision.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Loader/VC/Revision.pm	(revision 2528)
@@ -0,0 +1,103 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::Keyword::Loader::VC::Revision;
+
+use Fcm::Util qw{run_command};
+
+sub new {
+    my ($class, $args_ref) = @_;
+    return bless({%{$args_ref}}, $class);
+}
+
+################################################################################
+# Returns the VC location where revision keywords will be loaded from
+sub get_source {
+    my ($self) = @_;
+    return $self->{source};
+}
+
+################################################################################
+# Loads revision keywords from $self->get_source() to $entries
+sub load_to {
+    my ($self, $entries) = @_;
+    my @lines = run_command(
+        [qw{svn pg fcm:revision}, $self->get_source()],
+        DEVNULL => 1,
+        ERROR   => 'ignore',
+        METHOD  => 'qx',
+    );
+    my $load_counter = 0;
+    for my $line (@lines) {
+        chomp($line);
+        my ($key, $value) = split(qr{\s+ = \s+}xms, $line);
+        if ($key && $value) {
+            $entries->add_entry($key, $value);
+            $load_counter++;
+        }
+    }
+    return defined($load_counter);
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::Keyword::Loader::VC::Revision
+
+=head1 SYNOPSIS
+
+    $loader = Fcm::Keyword::Loader::VC::Revision->new({source => $source});
+    $loader->load_to($entries);
+
+=head1 DESCRIPTION
+
+Loads revision keywords from a VC location into a
+L<Fcm::Keyword::Entries|Fcm::Keyword::Entries> object containing
+L<Fcm::Keyword::Entry|Fcm::Keyword::Entry> objects.
+
+=head1 METHODS
+
+=over 4
+
+=item C<new({source =E<gt> $source})>
+
+Constructor. The argument $source is the VC location from which revision
+keywords will be loaded from.
+
+=item get_source()
+
+Returns the source VC location from which revision keywords will be loaded
+from.
+
+=item load_to($entries)
+
+Loads revision keywords from C<$self-E<gt>get_source()> to $entries.
+
+=back
+
+=head1 TO DO
+
+Abstract away the call to the VC system, which assumes the Subversion shell
+client at the moment.
+
+=head1 SEE ALSO
+
+L<Fcm::Keyword|Fcm::Keyword>,
+L<Fcm::Keyword::Entries|Fcm::Keyword::Entries>,
+L<Fcm::Keyword::Entry|Fcm::Keyword::Entry>,
+L<Fcm::Keyword::Entry::Location|Fcm::Keyword::Entry::Location>,
+L<Fcm::Keyword::Loader|Fcm::Keyword::Loader>,
+L<Fcm::Keyword::Loader::Config::Revision|Fcm::Keyword::Loader::Config::Revision>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ReposBranch.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ReposBranch.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ReposBranch.pm	(revision 2528)
@@ -0,0 +1,506 @@
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::ReposBranch
+#
+# DESCRIPTION
+#   This class contains methods for gathering information for a repository
+#   branch. It currently supports Subversion repository and local user
+#   directory.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+use warnings;
+use strict;
+
+package Fcm::ReposBranch;
+use base qw{Fcm::Base};
+
+use Fcm::CfgLine;
+use Fcm::Keyword;
+use Fcm::Util      qw{expand_tilde is_url run_command w_report};
+use File::Basename qw{dirname};
+use File::Find     qw{find};
+use File::Spec;
+
+# List of scalar property methods for this class
+my @scalar_properties = (
+  'package',  # package name of which this repository belongs
+  'repos',    # repository branch root URL/path
+  'revision', # the revision of this branch
+  'tag',      # "tag" name of this branch of the repository
+  'type',     # repository type
+);
+
+# List of hash property methods for this class
+my @hash_properties = (
+  'dirs',    # list of non-recursive directories in this branch
+  'expdirs', # list of recursive directories in this branch
+);
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = Fcm::ReposBranch->new (%args);
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::ReposBranch class. See
+#   @scalar_properties above for allowed list of properties in the constructor.
+#   (KEYS should be in uppercase.)
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = Fcm::Base->new (%args);
+
+  for (@scalar_properties) {
+    $self->{$_} = exists $args{uc ($_)} ? $args{uc ($_)} : undef;
+  }
+
+  $self->{$_} = {} for (@hash_properties);
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @scalar_properties.
+# ------------------------------------------------------------------------------
+
+for my $name (@scalar_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    # Argument specified, set property to specified argument
+    if (@_) {
+      $self->{$name} = $_[0];
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %hash = %{ $obj->X () };
+#   $obj->X (\%hash);
+#
+#   $value = $obj->X ($index);
+#   $obj->X ($index, $value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @hash_properties.
+#
+#   If no argument is set, this method returns a hash containing a list of
+#   objects. If an argument is set and it is a reference to a hash, the objects
+#   are replaced by the the specified hash.
+#
+#   If a scalar argument is specified, this method returns a reference to an
+#   object, if the indexed object exists or undef if the indexed object does
+#   not exist. If a second argument is set, the $index element of the hash will
+#   be set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+for my $name (@hash_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my ($self, $arg1, $arg2) = @_;
+
+    # Ensure property is defined as a reference to a hash
+    $self->{$name} = {} if not defined ($self->{$name});
+
+    # Argument 1 can be a reference to a hash or a scalar index
+    my ($index, %hash);
+
+    if (defined $arg1) {
+      if (ref ($arg1) eq 'HASH') {
+        %hash = %$arg1;
+
+      } else {
+        $index = $arg1;
+      }
+    }
+
+    if (defined $index) {
+      # A scalar index is defined, set and/or return the value of an element
+      $self->{$name}{$index} = $arg2 if defined $arg2;
+
+      return (
+        exists $self->{$name}{$index} ? $self->{$name}{$index} : undef
+      );
+
+    } else {
+      # A scalar index is not defined, set and/or return the hash
+      $self->{$name} = \%hash if defined $arg1;
+      return $self->{$name};
+    }
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->expand_revision;
+#
+# DESCRIPTION
+#   This method expands the revision keywords of the current branch to a
+#   revision number. It returns true on success.
+# ------------------------------------------------------------------------------
+
+sub expand_revision {
+  my $self = shift;
+
+  my $rc = 1;
+  if ($self->type eq 'svn') {
+    # Expand revision keyword
+    my $rev = (Fcm::Keyword::expand($self->repos(), $self->revision()))[1];
+
+    # Get last changed revision of the specified revision
+    my $info_ref = $self->_svn_info($self->repos(), $rev);
+    if (!defined($info_ref->{'Revision'})) {
+      my $url = $self->repos() . ($rev ? '@' . $rev : q{});
+      w_report("ERROR: $url: not a valid URL\n");
+      return 0;
+    }
+    my $lc_rev = $info_ref->{'Last Changed Rev'};
+    $rev       = $info_ref->{'Revision'};
+
+    # Print info if specified revision is not the last commit revision
+    if (uc($self->revision()) ne 'HEAD' && $lc_rev != $rev) {
+      my $message = $self->repos . '@' . $rev . ': last changed at [' .
+                    $lc_rev . '].';
+      if ($self->setting ('EXT_REVMATCH') and uc ($self->revision) ne 'HEAD') {
+        w_report "ERROR: specified and last changed revisions differ:\n",
+                 '       ', $message, "\n";
+        $rc = 0;
+
+      } else {
+        print 'INFO: ', $message, "\n";
+      }
+    }
+
+    if ($self->verbose > 1 and uc ($self->revision) ne 'HEAD') {
+      # See if there is a later change of the branch at the HEAD
+      my $head_lc_rev = $self->_svn_info($self->repos())->{'Last Changed Rev'};
+
+      if (defined($head_lc_rev) && $head_lc_rev != $lc_rev) {
+        # Ensure that this is the same branch by checking its history
+        my @lines = &run_command (
+          [qw/svn log -q --incremental -r/, $lc_rev, $self->repos . '@HEAD'],
+          METHOD => 'qx', TIME => $self->verbose > 2,
+        );
+
+        print 'INFO: ', $self->repos, '@', $rev,
+              ': newest commit at [', $head_lc_rev, '].', "\n"
+          if @lines;
+      }
+    }
+
+    $self->revision ($rev) if $rev ne $self->revision;
+
+  } elsif ($self->type eq 'user') {
+    1; # Do nothing
+
+  } else {
+    w_report 'ERROR: ', $self->repos, ': repository type "', $self->type,
+             '" not supported.';
+    $rc = 0;
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->expand_path;
+#
+# DESCRIPTION
+#   This method expands the relative path names of sub-directories to full
+#   path names. It returns true on success.
+# ------------------------------------------------------------------------------
+
+sub expand_path {
+  my $self = shift;
+
+  my $rc = 1;
+  if ($self->type eq 'svn') {
+    # SVN repository
+    # Do nothing unless there is a declared repository for this branch
+    return unless $self->repos;
+
+    # Remove trailing /
+    my $repos = $self->repos;
+    $self->repos ($repos) if $repos =~ s#/+$##;
+
+    # Consider all declared (expandable) sub-directories
+    for my $name (qw/dirs expdirs/) {
+      for my $dir (keys %{ $self->$name }) {
+        # Do nothing if declared sub-directory is quoted as a full URL
+        next if &is_url ($self->$name ($dir));
+
+        # Expand sub-directory to full URL
+        $self->$name ($dir, $self->repos . (
+          $self->$name ($dir) ? ('/' . $self->$name ($dir)) : ''
+        ));
+      }
+    }
+    # Note: "catfile" cannot be used in the above statement because it has
+    #       the tendency of removing a slash from double slashes.
+
+  } elsif ($self->type eq 'user') {
+    # Local user directories
+
+    # Expand leading ~ for all declared (expandable) sub-directories
+    for my $name (qw/dirs expdirs/) {
+      for my $dir (keys %{ $self->$name }) {
+        $self->$name ($dir, expand_tilde $self->$name ($dir));
+      }
+    }
+
+    # A top directory for the source is declared
+    if ($self->repos) {
+      # Expand leading ~ for the top directory
+      $self->repos (expand_tilde $self->repos);
+
+      # Get the root directory of the file system
+      my $rootdir = File::Spec->rootdir ();
+
+      # Expand top directory to absolute path, if necessary
+      $self->repos (File::Spec->rel2abs ($self->repos))
+        if $self->repos !~ m/^$rootdir/;
+
+      # Remove trailing /
+      my $repos = $self->repos;
+      $self->repos ($repos) if $repos =~ s#/+$##;
+
+      # Consider all declared (expandable) sub-directories
+      for my $name (qw/dirs expdirs/) {
+        for my $dir (keys %{ $self->$name }) {
+          # Do nothing if declared sub-directory is quoted as a full path
+          next if $self->$name ($dir) =~ m#^$rootdir#;
+
+          # Expand sub-directory to full path
+          $self->$name (
+            $dir, $self->$name ($dir)
+                  ? File::Spec->catfile ($self->repos, $self->$name ($dir))
+                  : $self->repos
+          );
+        }
+      }
+    }
+
+  } else {
+    w_report 'ERROR: ', $self->repos, ': repository type "', $self->type,
+             '" not supported.';
+    $rc = 0;
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->expand_all();
+#
+# DESCRIPTION
+#   This method searches the expandable source directories recursively for
+#   source directories containing regular files. The namespaces and the locators
+#   of these sub-directories are then added to the source directory hash table.
+#   Returns true on success.
+# ------------------------------------------------------------------------------
+
+sub expand_all {
+  my ($self) = @_;
+  my %finder_of = (
+    user => sub {
+      my ($root_locator) = @_;
+      my %ns_of;
+      my $wanted = sub {
+        my $base_name = $_;
+        my $path = $File::Find::name;
+        if (-f $path && -r $path && !-l $path) {
+          my $dir_path      = dirname($path);
+          my $rel_dir_path  = File::Spec->abs2rel($dir_path, $root_locator);
+          if (!exists($ns_of{$dir_path})) {
+            $ns_of{$dir_path} = [File::Spec->splitdir($rel_dir_path)];
+          }
+        }
+      };
+      find($wanted, $root_locator);
+      return \%ns_of;
+    },
+    svn  => sub {
+      my ($root_locator) = @_;
+      my $runner = sub {
+        map {chomp($_); $_} run_command(
+          ['svn', @_,  '-R', join('@', $root_locator, $self->revision())],
+          METHOD => 'qx', TIME => $self->config()->verbose() > 2,
+        );
+      };
+      # FIXME: check for symlink switched off due to "svn pg" being very slow
+      #my %symlink_in
+      #  = map {($_ =~ qr{\A(.+)\s-\s(\*)\z}xms)} ($runner->(qw{pg svn:special}));
+      #my @locators
+      #  = grep {$_ !~ qr{/\z}xms && !$symlink_in{$_}} ($runner->('ls'));
+      my @locators = grep {$_ !~ qr{/\z}xms} ($runner->('ls'));
+      my %ns_of;
+      for my $locator (@locators) {
+        my ($rel_dir_locator) = $locator =~ qr{\A(.*)/[^/]+\z}xms; # dirname
+        $rel_dir_locator ||= q{};
+        my $dir_locator = join(q{/}, $root_locator, $rel_dir_locator);
+        if (!exists($ns_of{$dir_locator})) {
+          $ns_of{$dir_locator} = [split(q{/}, $rel_dir_locator)];
+        }
+      }
+      return \%ns_of;
+    },
+  );
+
+  if (!defined($finder_of{$self->type()})) {
+    w_report(sprintf(
+        qq{ERROR: %s: resource type "%s" not supported},
+        $self->repos(),
+        $self->type(),
+    ));
+    return;
+  }
+  while (my ($root_ns, $root_locator) = each(%{$self->expdirs()})) {
+    my @root_ns_list = split(qr{$Fcm::Config::DELIMITER}xms, $root_ns);
+    my $ns_hash_ref = $finder_of{$self->type()}->($root_locator);
+    while (my ($dir_path, $ns_list_ref) = each(%{$ns_hash_ref})) {
+      if (!grep {$_ =~ qr{\A\.}xms || $_ =~ qr{~\z}xms} @{$ns_list_ref}) {
+        my $ns = join($Fcm::Config::DELIMITER, @root_ns_list, @{$ns_list_ref});
+        $self->dirs($ns, $dir_path);
+      }
+    }
+  }
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $n = $obj->add_base_dirs ($base);
+#
+# DESCRIPTION
+#   Add a list of source directories to the current branch based on the set
+#   provided by $base, which must be a reference to a Fcm::ReposBranch
+#   instance. It returns the total number of used sub-directories in the
+#   current repositories.
+# ------------------------------------------------------------------------------
+
+sub add_base_dirs {
+  my $self = shift;
+  my $base = shift;
+
+  my %base_dirs = %{ $base->dirs };
+
+  for my $key (keys %base_dirs) {
+    # Remove repository root from base directories
+    if ($base_dirs{$key} eq $base->repos) {
+      $base_dirs{$key} = '';
+
+    } else {
+      $base_dirs{$key} = substr $base_dirs{$key}, length ($base->repos) + 1;
+    }
+
+    # Append base directories to current repository root
+    $self->dirs ($key, $base_dirs{$key});
+  }
+
+  # Expand relative path names of sub-directories
+  $self->expand_path;
+
+  return scalar keys %{ $self->dirs };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @cfglines = $obj->to_cfglines ();
+#
+# DESCRIPTION
+#   This method returns a list of configuration lines for the current branch.
+# ------------------------------------------------------------------------------
+
+sub to_cfglines {
+  my ($self) = @_;
+  my @return = ();
+
+  my $suffix = $self->package . $Fcm::Config::DELIMITER . $self->tag;
+  push @return, Fcm::CfgLine->new (
+    label => $self->cfglabel ('REPOS') . $Fcm::Config::DELIMITER . $suffix,
+    value => $self->repos,
+  ) if $self->repos;
+
+  push @return, Fcm::CfgLine->new (
+    label => $self->cfglabel ('REVISION') . $Fcm::Config::DELIMITER . $suffix,
+    value => $self->revision,
+  ) if $self->revision;
+
+  for my $key (sort keys %{ $self->dirs }) {
+    my $value = $self->dirs ($key);
+
+    # Use relative path where possible
+    if ($self->repos) {
+      if ($value eq $self->repos) {
+        $value = '';
+
+      } elsif (index ($value, $self->repos) == 0) {
+        $value = substr ($value, length ($self->repos) + 1);
+      }
+    }
+
+    # Use top package name where possible
+    my $dsuffix = $key . $Fcm::Config::DELIMITER . $self->tag;
+    $dsuffix = $suffix if $value ne $self->dirs ($key) and $key eq join (
+      $Fcm::Config::DELIMITER, $self->package, File::Spec->splitdir ($value)
+    );
+
+    push @return, Fcm::CfgLine->new (
+      label => $self->cfglabel ('DIRS') . $Fcm::Config::DELIMITER . $dsuffix,
+      value => $value,
+    );
+  }
+
+  push @return, Fcm::CfgLine->new ();
+
+  return @return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   my $hash_ref = $self->_svn_info($url[, $rev]);
+#
+# DESCRIPTION
+#   Executes "svn info" and returns each field in a hash.
+# ------------------------------------------------------------------------------
+sub _svn_info {
+  my ($self, $url, $rev) = @_;
+  return {
+    map {
+      chomp();
+      my ($key, $value) = split(qr{\s*:\s*}xms, $_, 2);
+      $key ? ($key, $value) : ();
+    } run_command(
+      [qw{svn info}, ($rev ? ('-r', $rev, join('@', $url, $rev)) : $url)], 
+      DEVNULL => 1, METHOD => 'qx', TIME => $self->verbose() > 2,
+    )
+  };
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/SrcDirLayer.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/SrcDirLayer.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/SrcDirLayer.pm	(revision 2528)
@@ -0,0 +1,264 @@
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::SrcDirLayer
+#
+# DESCRIPTION
+#   This class contains methods to manipulate the extract of a source
+#   directory from a branch of a (Subversion) repository.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use warnings;
+use strict;
+
+package Fcm::SrcDirLayer;
+use base qw{Fcm::Base};
+
+use Fcm::Util      qw{run_command e_report w_report};
+use File::Basename qw{dirname};
+use File::Path     qw{mkpath};
+use File::Spec;
+
+# List of property methods for this class
+my @scalar_properties = (
+  'cachedir',  # cache directory for this directory branch
+  'commit',    # revision at which the source directory was changed
+  'extracted', # is this branch already extracted?
+  'files',     # list of source files in this directory branch
+  'location',  # location of the source directory in the branch
+  'name',      # sub-package name of the source directory
+  'package',   # top level package name of which the current repository belongs
+  'reposroot', # repository root URL
+  'revision',  # revision of the repository branch
+  'tag',       # package/revision tag of the current repository branch
+  'type',      # type of the repository branch ("svn" or "user")
+);
+
+my %ERR_MESS_OF = (
+    CACHE_WRITE => '%s: cannot write to cache',
+    SYMLINK     => '%s/%s: ignore symbolic link',
+    VC_TYPE     => '%s: repository type not supported',
+);
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = Fcm::SrcDirLayer->new (%args);
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::SrcDirLayer class. See
+#   above for allowed list of properties. (KEYS should be in uppercase.)
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = Fcm::Base->new (%args);
+
+  for (@scalar_properties) {
+    $self->{$_} = exists $args{uc ($_)} ? $args{uc ($_)} : undef;
+  }
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @scalar_properties.
+# ------------------------------------------------------------------------------
+
+for my $name (@scalar_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    # Argument specified, set property to specified argument
+    if (@_) {
+      $self->{$name} = $_[0];
+    }
+
+    # Default value for property
+    if (not defined $self->{$name}) {
+      if ($name eq 'files') {
+        # Reference to an array
+        $self->{$name} = [];
+      }
+    }
+
+    return $self->{$name};
+  }
+}
+
+# Handles error/warning events.
+sub _err {
+    my ($key, $args_ref, $warn_only) = @_;
+    my $reporter = $warn_only ? \&w_report : \&e_report;
+    $args_ref ||= [];
+    $reporter->(sprintf($ERR_MESS_OF{$key} . ".\n", @{$args_ref}));
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $dir = $obj->localdir;
+#
+# DESCRIPTION
+#   This method returns the user or cache directory for the current revision
+#   of the repository branch.
+# ------------------------------------------------------------------------------
+
+sub localdir {
+  my $self = shift;
+
+  return $self->user ? $self->location : $self->cachedir;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $user = $obj->user;
+#
+# DESCRIPTION
+#   This method returns the string "user" if the current source directory
+#   branch is a local directory. Otherwise, it returns "undef".
+# ------------------------------------------------------------------------------
+
+sub user {
+  my $self = shift;
+
+  return $self->type eq 'user' ? 'user' : undef;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rev = $obj->get_commit;
+#
+# DESCRIPTION
+#   If the current repository type is "svn", this method attempts to obtain
+#   the revision in which the branch is last committed. On a successful
+#   operation, it returns this revision number. Otherwise, it returns
+#   "undef".
+# ------------------------------------------------------------------------------
+
+sub get_commit {
+  my $self = shift;
+
+  if ($self->type eq 'svn') {
+    # Execute the "svn info" command
+    my @lines   = &run_command (
+      [qw/svn info -r/, $self->revision, $self->location . '@' . $self->revision],
+      METHOD => 'qx', TIME => $self->config->verbose > 2,
+    );
+
+    my $rev;
+    for (@lines) {
+      if (/^Last\s+Changed\s+Rev\s*:\s*(\d+)/i) {
+        $rev = $1;
+        last;
+      }
+    }
+
+    # Commit revision of this source directory
+    $self->commit ($rev);
+
+    return $self->commit;
+
+  } elsif ($self->type eq 'user') {
+    return;
+
+  } else {
+    _err('VC_TYPE', [$self->type()]);
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->update_cache;
+#
+# DESCRIPTION
+#   If the current repository type is "svn", this method attempts to extract
+#   the current revision source directory from the current branch from the
+#   repository, sending the output to the cache directory. It returns true on
+#   a successful operation, or false if the repository is not of type "svn".
+# ------------------------------------------------------------------------------
+
+sub update_cache {
+  my $self = shift;
+
+  return unless $self->cachedir;
+
+  # Create cache extract destination, if necessary
+  my $dirname = dirname $self->cachedir;
+  mkpath($dirname);
+
+  if (!-w $dirname) {
+    _err('CACHE_WRITE', [$dirname]);
+  }
+  
+  if ($self->type eq 'svn') {
+    # Set up the extract command, "svn export --force -q -N"
+    my @command = (
+      qw/svn export --force -q -N/,
+      $self->location . '@' . $self->revision,
+      $self->cachedir,
+    );
+
+    &run_command (\@command, TIME => $self->config->verbose > 2);
+
+  } elsif ($self->type eq 'user') {
+    return;
+
+  } else {
+    _err('VC_TYPE', [$self->type()]);
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @files = $obj->get_files();
+#
+# DESCRIPTION
+#   This method returns a list of file base names in the (cache of) this source
+#   directory in the current branch.
+# ------------------------------------------------------------------------------
+
+sub get_files {
+  my ($self) = @_;
+  opendir(my $dir, $self->localdir())
+    || die($self->localdir(), ': cannot read directory');
+  my @base_names = ();
+  BASE_NAME:
+  while (my $base_name = readdir($dir)) {
+    if ($base_name =~ qr{\A\.}xms || $base_name =~ qr{~\z}xms) {
+        next BASE_NAME;
+    }
+    my $path = File::Spec->catfile($self->localdir(), $base_name);
+    if (-d $path) {
+        next BASE_NAME;
+    }
+    if (-l $path) {
+        _err('SYMLINK', [$self->location(), $base_name], 1);
+        next BASE_NAME;
+    }
+    push(@base_names, $base_name);
+  }
+  closedir($dir);
+  $self->files(\@base_names);
+  return @base_names;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Timer.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Timer.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Timer.pm	(revision 2528)
@@ -0,0 +1,72 @@
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::Timer
+#
+# DESCRIPTION
+#   This is a package of timer utility used by the FCM command.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::Timer;
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Exports
+our (@ISA, @EXPORT, @EXPORT_OK);
+
+sub timestamp_command;
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(timestamp_command);
+
+# ------------------------------------------------------------------------------
+
+# Module level variables
+my %cmd_start_time = (); # Command start time, (key = command, value = time)
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = &Fcm::Timer::timestamp_command ($command[, $status]);
+#
+# DESCRIPTION
+#   This function returns a string adding to $command a prefix according the
+#   value of $status. If $status is not specified or does not match the word
+#   "end", the status is assumed to be "start". At "start", the prefix will
+#   contain the current timestamp. If $status is the word "end", the prefix
+#   will contain the total time taken since this function was called with the
+#   same $command at the "start" status.
+# ------------------------------------------------------------------------------
+
+sub timestamp_command {
+  (my $command, my $status) = @_;
+
+  my $prefix;
+  if ($status and $status =~ /end/i) {
+    # Status is "end", insert time taken
+    my $lapse = time () - $cmd_start_time{$command};
+    $prefix = sprintf "# Time taken: %12d s=> ", $lapse;
+
+  } else {
+    # Status is "start", insert time stamp
+    $cmd_start_time{$command} = time;
+
+    (my $sec, my $min, my $hour, my $mday, my $mon, my $year) = localtime;
+    $prefix = sprintf "# Start: %04d-%02d-%02d %02d:%02d:%02d=> ",
+              $year + 1900, $mon + 1, $mday, $hour, $min, $sec;
+  }
+
+  return $prefix . $command . "\n";
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Util.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Util.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Util.pm	(revision 2528)
@@ -0,0 +1,552 @@
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::Util
+#
+# DESCRIPTION
+#   This is a package of misc utilities used by the FCM command.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+use warnings;
+use strict;
+
+package Fcm::Util;
+require Exporter;
+our @ISA = qw{Exporter};
+
+sub expand_tilde;
+sub e_report;
+sub find_file_in_path;
+sub get_command_string;
+sub get_rev_of_wc;
+sub get_url_of_wc;
+sub get_url_peg_of_wc;
+sub get_wct;
+sub is_url;
+sub is_wc;
+sub print_command;
+sub run_command;
+sub svn_date;
+sub tidy_url;
+sub touch_file;
+sub w_report;
+
+our @EXPORT = qw{
+    expand_tilde
+    e_report
+    find_file_in_path
+    get_command_string
+    get_rev_of_wc
+    get_url_of_wc
+    get_url_peg_of_wc
+    get_wct
+    is_url
+    is_wc
+    print_command
+    run_command
+    svn_date
+    tidy_url
+    touch_file
+    w_report
+};
+
+# Standard modules
+use Carp;
+use Cwd;
+use File::Basename;
+use File::Find;
+use File::Path;
+use File::Spec;
+use POSIX qw{strftime SIGINT SIGKILL SIGTERM WEXITSTATUS WIFSIGNALED WTERMSIG};
+
+# FCM component modules
+use Fcm::Timer;
+
+# ------------------------------------------------------------------------------
+
+# Module level variables
+my %svn_info       = (); # "svn info" log, (key1 = path,
+                         # key2 = URL, Revision, Last Changed Rev)
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %srcdir = &Fcm::Util::find_file_in_path ($file, \@path);
+#
+# DESCRIPTION
+#   Search $file in @path. Returns the full path of the $file if it is found
+#   in @path. Returns "undef" if $file is not found in @path.
+# ------------------------------------------------------------------------------
+
+sub find_file_in_path {
+  my ($file, $path) = @_;
+
+  for my $dir (@$path) {
+    my $full_file = File::Spec->catfile ($dir, $file);
+    return $full_file if -e $full_file;
+  }
+
+  return undef;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $expanded_path = &Fcm::Util::expand_tilde ($path);
+#
+# DESCRIPTION
+#   Returns an expanded path if $path is a path that begins with a tilde (~).
+# ------------------------------------------------------------------------------
+
+sub expand_tilde {
+  my $file = $_[0];
+
+  $file =~ s#^~([^/]*)#$1 ? (getpwnam $1)[7] : ($ENV{HOME} || $ENV{LOGDIR})#ex;
+
+  # Expand . and ..
+  while ($file =~ s#/+\.(?:/+|$)#/#g) {next}
+  while ($file =~ s#/+[^/]+/+\.\.(?:/+|$)#/#g) {next}
+
+  # Remove trailing /
+  $file =~ s#/*$##;
+
+  return $file;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = &Fcm::Util::touch_file ($file);
+#
+# DESCRIPTION
+#   Touch $file if it exists. Create $file if it does not exist. Return 1 for
+#   success or 0 otherwise.
+# ------------------------------------------------------------------------------
+
+sub touch_file {
+  my $file = $_[0];
+  my $rc   = 1;
+
+  if (-e $file) {
+    my $now = time;
+    $rc = utime $now, $now, $file;
+
+  } else {
+    mkpath dirname ($file) unless -d dirname ($file);
+
+    $rc = open FILE, '>', $file;
+    $rc = close FILE if $rc;
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = &is_wc ([$path]);
+#
+# DESCRIPTION
+#   Returns true if current working directory (or $path) is a Subversion
+#   working copy.
+# ------------------------------------------------------------------------------
+
+sub is_wc {
+  my $path = @_ ? $_[0] : cwd ();
+
+  if (-d $path) {
+    return (-e File::Spec->catfile ($path, qw/.svn format/)) ? 1 : 0;
+
+  } elsif (-f $path) {
+    return (-e File::Spec->catfile (dirname ($path), qw/.svn format/)) ? 1 : 0;
+
+  } else {
+    return 0;
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = &is_url ($url);
+#
+# DESCRIPTION
+#   Returns true if $url is a URL.
+# ------------------------------------------------------------------------------
+
+sub is_url {
+  # This should handle URL beginning with svn://, http:// and svn+ssh://
+  return ($_[0] =~ m#^[\+\w]+://#);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = tidy_url($url);
+#
+# DESCRIPTION
+#   Returns a tidied version of $url by removing . and .. in the path.
+# ------------------------------------------------------------------------------
+
+sub tidy_url {
+    my ($url) = @_;
+    if (!is_url($url)) {
+        return $url;
+    }
+    my $DOT_PATTERN     = qr{/+ \. (?:/+|(@|\z))}xms;
+    my $DOT_DOT_PATTERN = qr{/+ [^/]+ /+ \.\. (?:/+|(@|\z))}xms;
+    my $TRAILING_SLASH_PATTERN = qr{([^/]+) /* (@|\z)}xms;
+    my $RIGHT_EVAL = q{'/' . ($1 ? $1 : '')};
+    DOT:
+    while ($url =~ s{$DOT_PATTERN}{$RIGHT_EVAL}eegxms) {
+        next DOT;
+    }
+    DOT_DOT:
+    while ($url =~ s{$DOT_DOT_PATTERN}{$RIGHT_EVAL}eegxms) {
+        next DOT_DOT;
+    }
+    $url =~ s{$TRAILING_SLASH_PATTERN}{$1$2}xms;
+    return $url;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = &get_wct ([$dir]);
+#
+# DESCRIPTION
+#   If current working directory (or $dir) is a Subversion working copy,
+#   returns the top directory of this working copy; otherwise returns an empty
+#   string.
+# ------------------------------------------------------------------------------
+
+sub get_wct {
+  my $dir = @_ ? $_[0] : cwd ();
+
+  return '' if not &is_wc ($dir);
+
+  my $updir = dirname $dir;
+  while (&is_wc ($updir)) {
+    $dir   = $updir;
+    $updir = dirname $dir;
+    last if $updir eq $dir;
+  }
+
+  return $dir;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = &get_url_of_wc ([$path[, $refresh]]);
+#
+# DESCRIPTION
+#   If current working directory (or $path) is a Subversion working copy,
+#   returns the URL of the associated Subversion repository; otherwise returns
+#   an empty string. If $refresh is specified, do not use the cached
+#   information.
+# ------------------------------------------------------------------------------
+
+sub get_url_of_wc {
+  my $path    = @_ ? $_[0] : cwd ();
+  my $refresh = exists $_[1] ? $_[1] : 0;
+  my $url  = '';
+
+  if (&is_wc ($path)) {
+    delete $svn_info{$path} if $refresh;
+    &_invoke_svn_info (PATH => $path) unless exists $svn_info{$path};
+    $url = $svn_info{$path}{URL};
+  }
+
+  return $url;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = &get_url_peg_of_wc ([$path[, $refresh]]);
+#
+# DESCRIPTION
+#   If current working directory (or $path) is a Subversion working copy,
+#   returns the URL@REV of the associated Subversion repository; otherwise
+#   returns an empty string. If $refresh is specified, do not use the cached
+#   information.
+# ------------------------------------------------------------------------------
+
+sub get_url_peg_of_wc {
+  my $path    = @_ ? $_[0] : cwd ();
+  my $refresh = exists $_[1] ? $_[1] : 0;
+  my $url  = '';
+
+  if (&is_wc ($path)) {
+    delete $svn_info{$path} if $refresh;
+    &_invoke_svn_info (PATH => $path) unless exists $svn_info{$path};
+    $url = $svn_info{$path}{URL} . '@' . $svn_info{$path}{Revision};
+  }
+
+  return $url;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &_invoke_svn_info (PATH => $path);
+#
+# DESCRIPTION
+#   The function is internal to this module. It invokes "svn info" on $path to
+#   gather information on URL, Revision and Last Changed Rev. The information
+#   is stored in a hash table at the module level, so that the information can
+#   be re-used.
+# ------------------------------------------------------------------------------
+
+sub _invoke_svn_info {
+  my %args = @_;
+  my $path = $args{PATH};
+  my $cfg  = Fcm::Config->instance();
+
+  return if exists $svn_info{$path};
+
+  # Invoke "svn info" command
+  my @info = &run_command (
+    [qw/svn info/, $path],
+    PRINT => $cfg->verbose > 2, METHOD => 'qx', DEVNULL => 1, ERROR => 'ignore',
+  );
+  for (@info) {
+    chomp;
+
+    if (/^(URL|Revision|Last Changed Rev):\s*(.+)$/) {
+      $svn_info{$path}{$1} = $2;
+    }
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = &get_command_string ($cmd);
+#   $string = &get_command_string (\@cmd);
+#
+# DESCRIPTION
+#   The function returns a string by converting the list in @cmd or the scalar
+#   $cmd to a form, where it can be executed as a shell command.
+# ------------------------------------------------------------------------------
+
+sub get_command_string {
+  my $cmd    = $_[0];
+  my $return = '';
+
+  if (ref ($cmd) and ref ($cmd) eq 'ARRAY') {
+    # $cmd is a reference to an array
+
+    # Print each argument
+    for my $i (0 .. @{ $cmd } - 1) {
+      my $arg = $cmd->[$i];
+
+      $arg =~ s/./*/g if $i > 0 and $cmd->[$i - 1] eq '--password';
+
+      if ($arg =~ /[\s'"*?]/) {
+        # Argument contains a space, quote it
+        if (index ($arg, "'") >= 0) {
+          # Argument contains an apostrophe, quote it with double quotes
+          $return .= ($i > 0 ? ' ' : '') . '"' . $arg . '"';
+
+        } else {
+          # Otherwise, quote argument with apostrophes
+          $return .= ($i > 0 ? ' ' : '') . "'" . $arg . "'";
+        }
+
+      } else {
+        # Argument does not contain a space, just print it
+        $return .= ($i > 0 ? ' ' : '') . ($arg eq '' ? "''" : $arg);
+      }
+    }
+
+  } else {
+    # $cmd is a scalar, just print it "as is"
+    $return = $cmd;
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &print_command ($cmd);
+#   &print_command (\@cmd);
+#
+# DESCRIPTION
+#   The function prints the list in @cmd or the scalar $cmd, as it would be
+#   executed by the shell.
+# ------------------------------------------------------------------------------
+
+sub print_command {
+  my $cmd = $_[0];
+
+  print '=> ', &get_command_string ($cmd) , "\n";
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @return = &run_command (\@cmd, <OPTIONS>);
+#   @return = &run_command ($cmd , <OPTIONS>);
+#
+# DESCRIPTION
+#   This function executes the command in the list @cmd or in the scalar $cmd.
+#   The remaining are optional arguments in a hash table. Valid options are
+#   listed below. If the command is run using "qx", the function returns the
+#   standard output from the command. If the command is run using "system", the
+#   function returns true on success. By default, the function dies on failure.
+#
+# OPTIONS
+#   METHOD  => $method - this can be "system", "exec" or "qx". This determines
+#                        how the command will be executed. If not set, the
+#                        default is to run the command with "system".
+#   PRINT   => 1       - if set, print the command before executing it.
+#   ERROR   => $flag   - this should only be set if METHOD is set to "system"
+#                        or "qx". The $flag can be "die" (default), "warn" or
+#                        "ignore". If set to "die", the function dies on error.
+#                        If set to "warn", the function issues a warning on
+#                        error, and the function returns false. If set to
+#                        "ignore", the function returns false on error.
+#   RC      => 1       - if set, must be a reference to a scalar, which will be
+#                        set to the return code of the command.
+#   DEVNULL => 1       - if set, re-direct STDERR to /dev/null before running
+#                        the command.
+#   TIME    => 1       - if set, print the command with a timestamp before
+#                        executing it, and print the time taken when it
+#                        completes. This option supersedes the PRINT option.
+# ------------------------------------------------------------------------------
+
+sub run_command {
+  my ($cmd, %input_opt_of) = @_;
+  my %opt_of = (
+    DEVNULL => undef,
+    ERROR   => 'die',
+    METHOD  => 'system',
+    PRINT   => undef,
+    RC      => undef,
+    TIME    => undef,
+    %input_opt_of,
+  );
+  local($|) = 1; # Make sure STDOUT is flushed before running command
+
+  # Print the command before execution, if necessary
+  if ($opt_of{TIME}) {
+    print(timestamp_command(get_command_string($cmd)));
+  }
+  elsif ($opt_of{PRINT}) {
+    print_command($cmd);
+  }
+
+  # Re-direct STDERR to /dev/null if necessary
+  if ($opt_of{DEVNULL}) {
+    no warnings;
+    open(OLDERR, ">&STDERR") || croak("Cannot dup STDERR ($!), abort");
+    use warnings;
+    open(STDERR, '>', File::Spec->devnull())
+      || croak("Cannot redirect STDERR ($!), abort");
+    # Make sure the channels are unbuffered
+    my $select = select();
+    select(STDERR); local($|) = 1;
+    select($select);
+  }
+
+  my @return = ();
+  if (ref($cmd) && ref($cmd) eq 'ARRAY') {
+    # $cmd is an array
+    my @command = @{$cmd};
+    if ($opt_of{METHOD} eq 'qx') {
+      @return = qx(@command);
+    }
+    elsif ($opt_of{METHOD} eq 'exec') {
+      exec(@command);
+    }
+    else {
+      system(@command);
+      @return = $? ? () : (1);
+    }
+  }
+  else {
+    # $cmd is an scalar
+    if ($opt_of{METHOD} eq 'qx') {
+      @return = qx($cmd);
+    }
+    elsif ($opt_of{METHOD} eq 'exec') {
+      exec($cmd);
+    }
+    else {
+      system($cmd);
+      @return = $? ? () : (1);
+    }
+  }
+  my $rc = $?;
+
+  # Put STDERR back to normal, if redirected previously
+  if ($opt_of{DEVNULL}) {
+    close(STDERR);
+    open(STDERR, ">&OLDERR") || croak("Cannot dup STDERR ($!), abort");
+  }
+
+  # Print the time taken for command after execution, if necessary
+  if ($opt_of{TIME}) {
+    print(timestamp_command(get_command_string($cmd), 'end'));
+  }
+
+  # Signal and return code
+  my ($signal, $status) = (WTERMSIG($rc), WEXITSTATUS($rc));
+  if (exists($opt_of{RC})) {
+    ${$opt_of{RC}} = $status;
+  }
+  if (WIFSIGNALED($rc) && grep {$signal == $_} (SIGINT, SIGKILL, SIGTERM)) {
+    croak(sprintf('%s terminated (%d)', get_command_string($cmd), $signal));
+  }
+  if ($status && $opt_of{ERROR} ne 'ignore') {
+    my $func_ref = $opt_of{ERROR} eq 'warn' ? \&carp : \&croak;
+    $func_ref->(sprintf('%s failed (%d)', get_command_string($cmd), $status));
+  }
+  return @return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &e_report (@message);
+#
+# DESCRIPTION
+#   The function prints @message to STDERR and aborts with a error.
+# ------------------------------------------------------------------------------
+
+sub e_report {
+  print STDERR @_, "\n" if @_;
+
+  exit 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &w_report (@message);
+#
+# DESCRIPTION
+#   The function prints @message to STDERR and returns.
+# ------------------------------------------------------------------------------
+
+sub w_report {
+  print STDERR @_, "\n" if @_;
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $date = &svn_date ($time);
+#
+# DESCRIPTION
+#   The function returns a date, formatted as by Subversion. The argument $time
+#   is the number of seconds since epoch.
+# ------------------------------------------------------------------------------
+
+sub svn_date {
+  my $time = shift;
+
+  return strftime ('%Y-%m-%d %H:%M:%S %z (%a, %d %b %Y)', localtime ($time));
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Util/ClassLoader.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Util/ClassLoader.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Util/ClassLoader.pm	(revision 2528)
@@ -0,0 +1,80 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::Util::ClassLoader;
+use base qw{Exporter};
+
+our @EXPORT_OK = qw{load};
+
+use Carp qw{croak};
+use Fcm::Exception;
+
+sub load {
+    my ($class, $test_method) = @_;
+    if (!$test_method) {
+        $test_method = 'new';
+    }
+    if (!UNIVERSAL::can($class, $test_method)) {
+        eval('require ' . $class);
+        if ($@) {
+            croak(Fcm::Exception->new({message => sprintf(
+                "%s: class loading failed: %s", $class, $@,
+            )}));
+        }
+    }
+    return $class;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::ClassLoader
+
+=head1 SYNOPSIS
+
+    use Fcm::Util::ClassLoader;
+    $load_ok = Fcm::Util::ClassLoader::load($class);
+
+=head1 DESCRIPTION
+
+A wrapper for loading a class dynamically.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item load($class,$test_method)
+
+If $class can call $test_method, returns $class. Otherwise, attempts to
+require() $class and returns it. If this fails, croak() with a
+L<Fcm::Exception|Fcm::Exception>.
+
+=item load($class)
+
+Shorthand for C<load($class, 'new')>.
+
+=back
+
+=head1 DIAGNOSTICS
+
+=over 4
+
+=item L<Fcm::Exception|Fcm::Exception>
+
+The load($class,$test_method) function croak() with this exception if it fails
+to load the specified class.
+
+=back
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: trunk/NEMOGCM/EXTERNAL/fcm/man/man1/fcm.1
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/man/man1/fcm.1	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/man/man1/fcm.1	(revision 2528)
@@ -0,0 +1,35 @@
+.\" Process this file with
+.\" groff -man -Tascii fcm.1
+.\"
+.TH fcm 1 "" "" "User Commands"
+.SH NAME
+fcm - command line client for the Flexible Configuration Management system
+.SH SYNOPSIS
+.B fcm
+.I command
+[
+.I options
+] [
+.I args
+]
+.SH OVERVIEW
+.B fcm
+is the command line client for code management commands, the extract system and
+the build system of the Flexible Configuration Management (FCM) system.
+For full detail of the system, please refer to the FCM user guide, which you
+should receive with this distribution in both HTML and PDF formats.
+.PP
+Run "fcm help" to access the built-in tool documentation.
+.SH AUTHOR
+FCM Team <fcm-team@metoffice.gov.uk>.
+Please feedback any bug reports or feature requests to us by e-mail.
+.SH COPYRIGHT
+British Crown Copyright \(co Met Office. All rights reserved.
+.PP
+You can use this release of
+.B FCM
+freely under the terms of the FCM LICENSE,
+which you should receive with this distribution.
+.SH SEE ALSO
+.BR svn (1),
+.BR perl (1)
Index: trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Build/Fortran-extract-interface-result.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Build/Fortran-extract-interface-result.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Build/Fortran-extract-interface-result.f90	(revision 2528)
@@ -0,0 +1,70 @@
+interface
+logical function func_simple()
+end function func_simple
+logical function func_simple_1()
+end function
+logical function func_simple_2()
+end
+pure logical function func_simple_pure()
+end function func_simple_pure
+recursive pure integer function func_simple_recursive_pure(i)
+integer, intent(in) :: i
+end function func_simple_recursive_pure
+elemental logical function func_simple_elemental()
+end function func_simple_elemental
+integer(selected_int_kind(0)) function func_with_use_and_args(egg, ham)
+use foo
+use bar, only:&
+ & i_am_dim
+integer, intent(in) :: egg(i_am_dim)
+integer, intent(in) :: ham(i_am_dim, 2)
+end function func_with_use_and_args
+character(20) function func_with_parameters(egg, ham)
+character*(*), parameter :: x_param = '01234567890'
+character(*), parameter :: &
+ y_param &
+ = '!&!&!&!&!&!'
+character(len(x_param)), intent(in) :: egg
+character(len(y_param)), intent(in) :: ham
+end function func_with_parameters
+function func_with_parameters_1(egg, ham) result(r)
+integer, parameter :: x_param = 10
+integer z_param
+parameter(z_param = 2)
+real, intent(in), dimension(x_param) :: egg
+integer, intent(in) :: ham
+logical :: r(z_param)
+end function func_with_parameters_1
+character(10) function func_with_contains(mushroom, tomoato)
+character(5) mushroom
+character(5) tomoato
+end function func_with_contains
+Function func_mix_local_and_result(egg, ham, bacon) Result(Breakfast)
+Integer, Intent(in) :: egg, ham
+Real, Intent(in) :: bacon
+Real :: tomato, breakfast
+End Function func_mix_local_and_result
+subroutine sub_simple()
+end subroutine sub_simple
+subroutine sub_simple_1()
+end subroutine
+subroutine sub_simple_2()
+end
+subroutine sub_simple_3()
+end sub&
+&routine&
+& sub_simple_3
+subroutine sub_with_contains(foo)
+character*(len('!"&''&"!')) &
+ foo
+end subroutine sub_with_contains
+subroutine sub_with_renamed_import(i_am_dim)
+integer, parameter :: d = 2
+complex :: i_am_dim(d)
+end subroutine sub_with_renamed_import
+subroutine sub_with_external(proc)
+external proc
+end subroutine sub_with_external
+subroutine sub_with_end()
+end subroutine sub_with_end
+end interface
Index: trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Build/Fortran-extract-interface-source.f90
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Build/Fortran-extract-interface-source.f90	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Build/Fortran-extract-interface-source.f90	(revision 2528)
@@ -0,0 +1,181 @@
+! A simple function
+logical function func_simple()
+func_simple = .true.
+end function func_simple
+
+! A simple function, but with less friendly end
+logical function func_simple_1()
+func_simple_1 = .true.
+end function
+
+! A simple function, but with even less friendly end
+logical function func_simple_2()
+func_simple_2 = .true.
+end
+
+! A pure simple function
+pure logical function func_simple_pure()
+func_simple_pure = .true.
+end function func_simple_pure
+
+! A pure recursive function
+recursive pure integer function func_simple_recursive_pure(i)
+integer, intent(in) :: i
+if (i <= 0) then
+    func_simple_recursive_pure = i
+else
+    func_simple_recursive_pure = i + func_simple_recursive_pure(i - 1)
+end if
+end function func_simple_recursive_pure
+
+! An elemental simple function
+elemental logical function func_simple_elemental()
+func_simple_elemental = .true.
+end function func_simple_elemental
+
+! A module with nonsense
+module bar
+type food
+integer :: cooking_method
+end type food
+type organic
+integer :: growing_method
+end type organic
+integer, parameter :: i_am_dim = 10
+end module bar
+
+! A module with more nonsense
+module foo
+use bar, only: FOOD
+integer :: foo_int
+contains
+subroutine foo_sub(egg)
+integer, parameter :: egg_dim = 10
+type(Food), intent(in) :: egg
+write(*, *) egg
+end subroutine foo_sub
+elemental function foo_func() result(f)
+integer :: f
+f = 0
+end function
+end module foo
+
+! An function with arguments and module imports
+integer(selected_int_kind(0)) function func_with_use_and_args(egg, ham)
+use foo
+! Deliberate trailing spaces in next line
+use bar, only : organic,     i_am_dim   
+implicit none
+integer, intent(in) :: egg(i_am_dim)
+integer, intent(in) :: ham(i_am_dim, 2)
+real bacon
+! Deliberate trailing spaces in next line
+type(   organic   ) :: tomato   
+func_with_use_and_args = egg(1) + ham(1, 1)
+end function func_with_use_and_args
+
+! A function with some parameters
+character(20) function func_with_parameters(egg, ham)
+implicit none
+character*(*), parameter :: x_param = '01234567890'
+character(*), parameter :: & ! throw in some comments
+    y_param                &
+    = '!&!&!&!&!&!'          ! how to make life interesting
+integer, parameter :: z = 20
+character(len(x_param)), intent(in) :: egg
+character(len(y_param)), intent(in) :: ham
+func_with_parameters = egg // ham
+end function func_with_parameters
+
+! A function with some parameters, with a result
+function func_with_parameters_1(egg, ham) result(r)
+implicit none
+integer, parameter :: x_param = 10
+integer z_param
+parameter(z_param = 2)
+real, intent(in), dimension(x_param) :: egg
+integer, intent(in) :: ham
+logical :: r(z_param)
+r(1) = int(egg(1)) + ham > 0
+r(2) = .false.
+end function func_with_parameters_1
+
+! A function with a contains
+character(10) function func_with_contains(mushroom, tomoato)
+character(5) mushroom
+character(5) tomoato
+func_with_contains = func_with_contains_1()
+contains
+character(10) function func_with_contains_1()
+func_with_contains_1 = mushroom // tomoato
+end function func_with_contains_1
+end function func_with_contains
+
+! A function with its result declared after a local in the same statement
+Function func_mix_local_and_result(egg, ham, bacon) Result(Breakfast)
+Integer, Intent(in) :: egg, ham
+Real, Intent(in) :: bacon
+Real :: tomato, breakfast
+Breakfast = real(egg) + real(ham) + bacon
+End Function func_mix_local_and_result
+
+! A simple subroutine
+subroutine sub_simple()
+end subroutine sub_simple
+
+! A simple subroutine, with not so friendly end
+subroutine sub_simple_1()
+end subroutine
+
+! A simple subroutine, with even less friendly end
+subroutine sub_simple_2()
+end
+
+! A simple subroutine, with funny continuation
+subroutine sub_simple_3()
+end sub&
+&routine&
+& sub_simple_3
+
+! A subroutine with a few contains
+subroutine sub_with_contains(foo) ! " &
+! Deliberate trailing spaces in next line
+use Bar, only: i_am_dim    
+character*(len('!"&''&"!')) & ! what a mess!
+    foo
+call sub_with_contains_first()
+call sub_with_contains_second()
+call sub_with_contains_third()
+print*, foo
+contains
+subroutine sub_with_contains_first()
+interface
+integer function x()
+end function x
+end interface
+end subroutine sub_with_contains_first
+subroutine sub_with_contains_second()
+end subroutine
+subroutine sub_with_contains_third()
+end subroutine
+end subroutine sub_with_contains
+
+! A subroutine with a renamed module import
+subroutine sub_with_renamed_import(i_am_dim)
+use bar, only: i_am_not_dim => i_am_dim
+integer, parameter :: d = 2
+complex :: i_am_dim(d)
+print*, i_am_dim
+end subroutine sub_with_renamed_import
+
+! A subroutine with an external argument
+subroutine sub_with_external(proc)
+external proc
+call proc()
+end subroutine sub_with_external
+
+! A subroutine with a variable named "end"
+subroutine sub_with_end()
+integer :: end
+end = 0
+end subroutine sub_with_end
Index: trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Build/Fortran.t
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Build/Fortran.t	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Build/Fortran.t	(revision 2528)
@@ -0,0 +1,43 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/../../../lib";
+
+use Test::More (tests => 3);
+
+if (!caller()) {
+    main(@ARGV);
+}
+
+sub main {
+    my $CLASS = 'Fcm::Build::Fortran';
+    use_ok($CLASS);
+    my $util = $CLASS->new();
+    isa_ok($util, $CLASS);
+    test_extract_interface($util);
+}
+
+sub test_extract_interface {
+    my ($util) = @_;
+    my $root = ($0 =~ qr{\A(.+)\.t\z}msx)[0];
+    my $f90 = $root . '-extract-interface-source.f90';
+    my $f90_interface = $root . '-extract-interface-result.f90';
+    open(my($handle_for_source), '<', $f90) || die("$f90: $!");
+    my @actual_lines = $util->extract_interface($handle_for_source);
+    close($handle_for_source);
+    open(my($handle_for_result), '<', $f90_interface)
+        || die("$f90_interface: $!");
+    my @expected_lines = readline($handle_for_result);
+    close($handle_for_result);
+    is_deeply(\@actual_lines, \@expected_lines, 'extract_interface');
+}
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI.t
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI.t	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI.t	(revision 2528)
@@ -0,0 +1,237 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+
+################################################################################
+# A sub-class of Fcm::CLI::Invoker for testing
+{
+    package TestInvoker;
+    use base qw{Fcm::CLI::Invoker};
+
+    our $LATEST_INSTANCE;
+
+    ############################################################################
+    # Returns a test attrib
+    sub get_test_attrib {
+        my ($self) = @_;
+        return $self->{test_attrib};
+    }
+
+    ############################################################################
+    # Invokes the sub-system
+    sub invoke {
+        my ($self) = @_;
+        $LATEST_INSTANCE = $self;
+    }
+}
+
+use Fcm::CLI::Config;
+use Fcm::CLI::Subcommand;
+use Test::More (tests => 25);
+
+main();
+
+sub main {
+    use_ok('Fcm::CLI');
+    test_invalid_subcommand();
+    test_invoker_not_implemented();
+    test_normal_invoke();
+    test_help_invoke();
+    test_get_invoker_normal();
+    test_load_invoker_class();
+}
+
+################################################################################
+# Tests to ensure that an invalid subcommand results in an exception
+sub test_invalid_subcommand {
+    Fcm::CLI::Config->instance({core_subcommands => [], vc_subcommands => []});
+    eval {
+        local(@ARGV) = ('foo');
+        Fcm::CLI::invoke();
+    };
+    like($@, qr{foo: unknown command}, 'invalid subcommand');
+}
+
+################################################################################
+# Tests to ensure that an unimplemented invoker results in an exception
+sub test_invoker_not_implemented {
+    Fcm::CLI::Config->instance({
+        core_subcommands => [
+            Fcm::CLI::Subcommand->new({names => ['foo']}),
+            Fcm::CLI::Subcommand->new({
+                names => ['bar'], invoker_class => 'barley',
+            }),
+        ],
+        vc_subcommands   => [],
+    });
+    eval {
+        local(@ARGV) = ('foo');
+        Fcm::CLI::invoke();
+    };
+    like($@, qr{foo: \s command \s not \s implemented}xms, 'not implemented');
+    eval {
+        local(@ARGV) = ('bar');
+        Fcm::CLI::invoke();
+    };
+    like($@, qr{barley: \s class \s loading \s failed}xms, 'not implemented');
+}
+
+################################################################################
+# Tests normal usage of invoke
+sub test_normal_invoke {
+    my $prefix = "normal invoke";
+    Fcm::CLI::Config->instance({
+        core_subcommands => [
+            Fcm::CLI::Subcommand->new({
+                names          => ['foo'],
+                invoker_class  => 'TestInvoker',
+                invoker_config => {test_attrib => 'test_attrib value'},
+            }),
+        ],
+        vc_subcommands   => [],
+    });
+    ok(!$TestInvoker::LATEST_INSTANCE, "$prefix: invoker not called");
+    local(@ARGV) = ('foo', 'bar', 'baz');
+    Fcm::CLI::invoke();
+    my $invoker = $TestInvoker::LATEST_INSTANCE;
+    if (!$invoker) {
+        fail($prefix);
+    }
+    else {
+        is($invoker->get_command(), 'foo', "$prefix: invoker command");
+        is_deeply({$invoker->get_options()}, {}, "$prefix: invoker options");
+        is_deeply([$invoker->get_arguments()], ['bar', 'baz'],
+            "$prefix: invoker arguments");
+        is($invoker->get_test_attrib(), 'test_attrib value',
+            "$prefix: invoker test attrib");
+    }
+    $TestInvoker::LATEST_INSTANCE = undef;
+}
+
+################################################################################
+# Tests help usage of invoke
+sub test_help_invoke {
+    my $prefix = "help invoke";
+    Fcm::CLI::Config->instance({
+        core_subcommands => [
+            Fcm::CLI::Subcommand->new({
+                names          => ['foo'],
+                invoker_class  => 'TestInvoker',
+                invoker_config => {test_attrib => 'test_attrib value normal'},
+                options        => [
+                    Fcm::CLI::Option->new({name => 'foo', is_help => 1}),
+                ],
+            }),
+            Fcm::CLI::Subcommand->new({
+                names          => [q{}],
+                invoker_class  => 'TestInvoker',
+            }),
+        ],
+        vc_subcommands   => [],
+    });
+    ok(!$TestInvoker::LATEST_INSTANCE, "$prefix: invoker not called");
+    local(@ARGV) = ('foo', '--foo');
+    Fcm::CLI::invoke();
+    my $invoker = $TestInvoker::LATEST_INSTANCE;
+    if (!$invoker) {
+        fail($prefix);
+    }
+    else {
+        is_deeply([$invoker->get_arguments()], ['foo'],
+            "$prefix: invoker argument");
+    }
+    $TestInvoker::LATEST_INSTANCE = undef;
+}
+
+################################################################################
+# Tests getting an invoker
+sub test_get_invoker_normal {
+    my $prefix = 'get invoker normal';
+    my @options = (
+        Fcm::CLI::Option->new({name => 'foo'}),
+        Fcm::CLI::Option->new({name => 'bar'}),
+        Fcm::CLI::Option->new({name => 'baz'}),
+        Fcm::CLI::Option->new({
+            name      => q{pork},
+            delimiter => q{,},
+            has_arg   => Fcm::CLI::Option->ARRAY_ARG,
+        }),
+    );
+    my $subcommand = Fcm::CLI::Subcommand->new({options => \@options});
+    my %TEST = (
+        test1 => {
+            argv      => ['--foo', '--bar', 'egg', 'ham', 'sausage'],
+            command   => 'command',
+            options   => {foo => 1, bar => 1},
+            arguments => ['egg', 'ham', 'sausage'],
+        },
+        test2 => {
+            argv      => ['--baz', '--foo', '--bar'],
+            command   => 'test',
+            options   => {foo => 1, bar => 1, baz => 1},
+            arguments => [],
+        },
+        test3 => {
+            argv      => ['egg', 'ham', 'sausage'],
+            command   => 'meal',
+            options   => {},
+            arguments => ['egg', 'ham', 'sausage'],
+        },
+        test4 => {
+            argv      => ['--pork', 'ham', '--pork', 'sausage'],
+            command   => 'pig',
+            options   => {pork => ['ham', 'sausage']},
+            arguments => [],
+        },
+        test5 => {
+            argv      => ['--pork', 'ham,sausage', '--pork', 'bacon', 'liver'],
+            command   => 'pig',
+            options   => {pork => ['ham', 'sausage', 'bacon']},
+            arguments => ['liver'],
+        },
+    );
+    for my $key (keys(%TEST)) {
+        local(@ARGV) = @{$TEST{$key}{argv}};
+        my ($opts_ref, $args_ref) = Fcm::CLI::_parse_argv_using($subcommand);
+        is_deeply($opts_ref, $TEST{$key}{options},
+            "$prefix $key: get options");
+        is_deeply($args_ref, $TEST{$key}{arguments},
+            "$prefix $key: get arguments");
+    }
+    my %BAD_TEST = (
+        test1 => {
+            argv => ['--egg', '--bar', 'foo', 'ham', 'sausage'],
+        },
+        test2 => {
+            argv => ['--foo=egg'],
+        },
+    );
+    for my $key (keys(%BAD_TEST)) {
+        local(@ARGV) = @{$BAD_TEST{$key}{argv}};
+        eval {
+            Fcm::CLI::_parse_argv_using($subcommand);
+        };
+        isa_ok($@, 'Fcm::CLI::Exception', "$prefix $key");
+    }
+}
+
+################################################################################
+# Tests loading an invoker with a different class
+sub test_load_invoker_class {
+    my $prefix = 'get invoker class';
+    eval {
+        my $subcommand = Fcm::CLI::Subcommand->new({invoker_class => 'foo'});
+        Fcm::CLI::_load_invoker_class_of($subcommand);
+    };
+    isa_ok($@, 'Fcm::Exception', "$prefix");
+
+    my $invoker_class = 'Fcm::CLI::Invoker::ConfigSystem';
+    my $subcommand
+        = Fcm::CLI::Subcommand->new({invoker_class => $invoker_class});
+    my $class = Fcm::CLI::_load_invoker_class_of($subcommand);
+    is($class, $invoker_class, "$prefix: $invoker_class");
+}
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Config.t
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Config.t	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Config.t	(revision 2528)
@@ -0,0 +1,86 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Fcm::CLI::Config::Default;
+use Fcm::CLI::Subcommand;
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::CLI::Config';
+    use_ok($class);
+    test_get_instance($class);
+    test_get_subcommand_of_string($class);
+}
+
+################################################################################
+# Tests normal usage of getting an instance
+sub test_get_instance {
+    my ($class) = @_;
+    my $prefix = 'constructor';
+    my $cli_config = $class->instance();
+    isa_ok($cli_config, $class, "$prefix");
+    is_deeply(
+        [$cli_config->get_core_subcommands()],
+        \@Fcm::CLI::Config::Default::CORE_SUBCOMMANDS,
+        "$prefix: default core",
+    );
+    is_deeply(
+        [$cli_config->get_vc_subcommands()],
+        \@Fcm::CLI::Config::Default::VC_SUBCOMMANDS,
+        "$prefix: default vc",
+    );
+    is_deeply(
+        [$cli_config->get_subcommands()],
+        [$cli_config->get_core_subcommands(), $cli_config->get_vc_subcommands()],
+        "$prefix: default",
+    );
+    is($class->instance(), $cli_config, "$prefix: same instance");
+    isnt($class->instance({}), $cli_config, "$prefix: not the same instance");
+    my $empty_cli_config = $class->instance({
+        core_subcommands => [],
+        vc_subcommands   => [],
+    });
+    is_deeply(
+        [$empty_cli_config->get_core_subcommands()],
+        [],
+        "$prefix: empty core",
+    );
+    is_deeply(
+        [$empty_cli_config->get_vc_subcommands()],
+        [],
+        "$prefix: empty vc",
+    );
+    is_deeply(
+        [$empty_cli_config->get_subcommands()],
+        [],
+        "$prefix: empty",
+    );
+}
+
+################################################################################
+# Tests getting a subcommand of a matching string
+sub test_get_subcommand_of_string {
+    my ($class) = @_;
+    my $prefix = 'get_subcommand_of';
+    my $foo_subcommand = Fcm::CLI::Subcommand->new({names => ['food', 'foo']});
+    my $bar_subcommand = Fcm::CLI::Subcommand->new({names => ['barley', 'bar']});
+    my $cli_config = $class->instance({
+        core_subcommands => [$foo_subcommand, $bar_subcommand],
+        vc_subcommands   => [],
+    });
+    for my $key ('food', 'foo') {
+        is($cli_config->get_subcommand_of($key), $foo_subcommand,
+            "$prefix: $key");
+    }
+    for my $key ('barley', 'bar') {
+        is($cli_config->get_subcommand_of($key), $bar_subcommand,
+            "$prefix: $key");
+    }
+    is($cli_config->get_subcommand_of('baz'), undef, "$prefix: baz");
+}
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Config/Default.t
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Config/Default.t	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Config/Default.t	(revision 2528)
@@ -0,0 +1,15 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::CLI::Config::Default';
+    use_ok($class);
+}
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Exception.t
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Exception.t	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Exception.t	(revision 2528)
@@ -0,0 +1,27 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::CLI::Exception';
+    use_ok($class);
+    test_normal($class);
+}
+
+################################################################################
+# Tests normal usage
+sub test_normal {
+    my ($class) = @_;
+    my $prefix = 'normal';
+    my $e = $class->new({message => 'message'});
+    isa_ok($e, $class, $prefix);
+    is("$e", "$class: message\n", "$prefix: as_string()");
+    is($e->get_message(), 'message', "$prefix: get_message()");
+}
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker.t
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker.t	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker.t	(revision 2528)
@@ -0,0 +1,38 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::CLI::Invoker';
+    use_ok($class);
+    test_normal($class);
+}
+
+################################################################################
+# Tests normal usage
+sub test_normal {
+    my ($class) = @_;
+    my $prefix = "normal";
+    my %OPTIONS   = (option1 => 1, option2 => 2, option3 => 3);
+    my @ARGUMENTS = ('argument 1', 'argument 2');
+    my $invoker = $class->new({
+        command   => 'command',
+        options   => \%OPTIONS,
+        arguments => \@ARGUMENTS,
+    });
+    isa_ok($invoker, $class, $prefix);
+    is($invoker->get_command(), 'command', "$prefix: command");
+    is_deeply({$invoker->get_options()}, \%OPTIONS, "$prefix: options");
+    is_deeply([$invoker->get_arguments()], \@ARGUMENTS, "$prefix: arguments");
+    eval {
+        $invoker->invoke();
+    };
+    isa_ok($@, 'Fcm::CLI::Exception', "$prefix: invoke");
+}
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/Browser.t
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/Browser.t	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/Browser.t	(revision 2528)
@@ -0,0 +1,17 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::CLI::Invoker::Browser';
+    use_ok($class);
+}
+
+# TODO: actual unit tests
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/CM.t
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/CM.t	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/CM.t	(revision 2528)
@@ -0,0 +1,17 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::CLI::Invoker::CM';
+    use_ok($class);
+}
+
+# TODO: actual unit tests
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/CfgPrinter.t
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/CfgPrinter.t	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/CfgPrinter.t	(revision 2528)
@@ -0,0 +1,17 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::CLI::Invoker::CfgPrinter';
+    use_ok($class);
+}
+
+# TODO: actual unit tests
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/ConfigSystem.t
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/ConfigSystem.t	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/ConfigSystem.t	(revision 2528)
@@ -0,0 +1,94 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+################################################################################
+# A mock Fcm::ConfigSystem object
+{
+    package MockConfigSystem;
+    use base qw{Fcm::ConfigSystem};
+
+    our $LATEST_INVOKED_INSTANCE;
+
+    ############################################################################
+    # Returns the arguments to the last invoke() call
+    sub get_invoke_args {
+        my ($self) = @_;
+        return $self->{invoke_args};
+    }
+
+    ############################################################################
+    # Does nothing but captures the arguments
+    sub invoke {
+        my ($self, %args) = @_;
+        $LATEST_INVOKED_INSTANCE = $self;
+        $self->{invoke_args} = \%args;
+        return 1;
+    }
+}
+
+use Cwd;
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::CLI::Invoker::ConfigSystem';
+    use_ok($class);
+    test_invoke($class);
+}
+
+################################################################################
+# Tests normal usage of invoke()
+sub test_invoke {
+    my ($class) = @_;
+    my $prefix = "invoke";
+    my %TEST = (
+        test1 => {
+            command            => 'pig',
+            options            => {'egg' => 1},
+            arguments          => ['bacon'],
+            expected_options   => {FOO => undef, BAR_BAZ => undef, EGGS => 1},
+            expected_arguments => 'bacon',
+        },
+        test2 => {
+            command            => 'pig',
+            options            => {'foo' => 1, 'bar-baz' => 1},
+            arguments          => [],
+            expected_options   => {FOO => 1, BAR_BAZ => 1, EGGS => undef},
+            expected_arguments => cwd(),
+        }
+    );
+    for my $key (keys(%TEST)) {
+        my $invoker = $class->new({
+            command            => $TEST{$key}{command},
+            options            => $TEST{$key}{options},
+            arguments          => $TEST{$key}{arguments},
+            impl_class         => 'MockConfigSystem',
+            cli2invoke_key_map => {
+                'foo' => 'FOO', 'bar-baz' => 'BAR_BAZ', 'egg' => 'EGGS',
+            },
+        });
+        isa_ok($invoker, 'Fcm::CLI::Invoker::ConfigSystem', "$prefix: $key");
+        $invoker->invoke();
+        my $config_system_instance = $MockConfigSystem::LATEST_INVOKED_INSTANCE;
+        isa_ok(
+            $config_system_instance,
+            'Fcm::ConfigSystem',
+            "$prefix: $key: Fcm::ConfigSystem",
+        );
+        is(
+            $config_system_instance->cfg()->src(),
+            $TEST{$key}{expected_arguments},
+            "$prefix: $key: cfg()->src()",
+        );
+        is_deeply(
+            $config_system_instance->get_invoke_args(),
+            $TEST{$key}{expected_options},
+            "$prefix: $key: invoke args",
+        );
+    }
+}
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/ExtractConfigComparator.t
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/ExtractConfigComparator.t	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/ExtractConfigComparator.t	(revision 2528)
@@ -0,0 +1,17 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::CLI::Invoker::ExtractConfigComparator';
+    use_ok($class);
+}
+
+# TODO: actual unit tests
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/GUI.t
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/GUI.t	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/GUI.t	(revision 2528)
@@ -0,0 +1,17 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::CLI::Invoker::GUI';
+    use_ok($class);
+}
+
+# TODO: actual unit tests
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/Help.t
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/Help.t	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/Help.t	(revision 2528)
@@ -0,0 +1,17 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::CLI::Invoker::Help';
+    use_ok($class);
+}
+
+# TODO: actual unit tests
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/KeywordPrinter.t
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/KeywordPrinter.t	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/KeywordPrinter.t	(revision 2528)
@@ -0,0 +1,17 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::CLI::Invoker::KeywordPrinter';
+    use_ok($class);
+}
+
+# TODO: actual unit tests
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Option.t
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Option.t	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Option.t	(revision 2528)
@@ -0,0 +1,168 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::CLI::Option';
+    use_ok($class);
+    test_simplest($class);
+    test_simplest_scalar_arg($class);
+    test_simplest_array_arg($class);
+    test_simplest_hash_arg($class);
+    test_simple($class);
+    test_simple_scalar_arg($class);
+    test_simple_array_arg($class);
+    test_simple_hash_arg($class);
+    test_long_letter($class);
+}
+
+################################################################################
+# Tests simplest usage
+sub test_simplest {
+    my ($class) = @_;
+    my $prefix = 'simplest';
+    my $option = $class->new({
+        delimiter   => 'delimiter-value',
+        description => 'description value',
+        name        => 'name-value',
+    });
+    isa_ok($option, $class);
+    is($option->get_delimiter(), 'delimiter-value', "$prefix: delimiter");
+    is($option->get_description(), 'description value', "$prefix: description");
+    is($option->get_name(), 'name-value', "$prefix: name");
+    is($option->get_letter(), undef, "$prefix: letter");
+    ok(!$option->has_arg(), "$prefix: has arg");
+    is($option->get_arg_for_getopt_long(), 'name-value', "$prefix: has arg");
+}
+
+################################################################################
+# Tests simplest usage with a scalar argument
+sub test_simplest_scalar_arg {
+    my ($class) = @_;
+    my $prefix = 'simplest scalar arg';
+    my $option = $class->new({
+        description => 'description value',
+        name        => 'name-value',
+        has_arg     => $class->SCALAR_ARG,
+    });
+    isa_ok($option, $class);
+    is($option->has_arg(), $class->SCALAR_ARG, "$prefix: has arg");
+    is($option->get_arg_for_getopt_long(), 'name-value=s', "$prefix: has arg");
+}
+
+################################################################################
+# Tests simplest usage with array argument
+sub test_simplest_array_arg {
+    my ($class) = @_;
+    my $prefix = 'simplest array arg';
+    my $option = $class->new({
+        description => 'description value',
+        name        => 'name-value',
+        has_arg     => $class->ARRAY_ARG,
+    });
+    isa_ok($option, $class);
+    is($option->has_arg(), $class->ARRAY_ARG, "$prefix: has arg");
+    is($option->get_arg_for_getopt_long(), 'name-value=s@', "$prefix: has arg");
+}
+
+################################################################################
+# Tests simplest usage with hash argument
+sub test_simplest_hash_arg {
+    my ($class) = @_;
+    my $prefix = 'simplest hash arg';
+    my $option = $class->new({
+        description => 'description value',
+        name        => 'name-value',
+        has_arg     => $class->HASH_ARG,
+    });
+    isa_ok($option, $class);
+    is($option->has_arg(), $class->HASH_ARG, "$prefix: has arg");
+    is($option->get_arg_for_getopt_long(), 'name-value=s%', "$prefix: has arg");
+}
+
+################################################################################
+# Tests simple usage
+sub test_simple {
+    my ($class) = @_;
+    my $prefix = 'simple';
+    my $option = $class->new({
+        description => 'description value',
+        name        => 'name-value',
+        letter      => 'n',
+    });
+    isa_ok($option, $class);
+    is($option->get_description(), 'description value', "$prefix: description");
+    is($option->get_name(), 'name-value', "$prefix: name");
+    is($option->get_letter(), 'n', "$prefix: letter");
+    is($option->has_arg(), $class->NO_ARG, "$prefix: has arg");
+    is($option->get_arg_for_getopt_long(), 'name-value|n', "$prefix: has arg");
+}
+
+################################################################################
+# Tests simple usage with a scalar argument
+sub test_simple_scalar_arg {
+    my ($class) = @_;
+    my $prefix = 'simple scalar arg';
+    my $option = $class->new({
+        description => 'description value',
+        name        => 'name-value',
+        letter      => 'n',
+        has_arg     => $class->SCALAR_ARG,
+    });
+    isa_ok($option, $class);
+    is($option->has_arg(), $class->SCALAR_ARG, "$prefix: has arg");
+    is($option->get_arg_for_getopt_long(), 'name-value|n=s', "$prefix: has arg");
+}
+
+################################################################################
+# Tests simplest usage with array argument
+sub test_simple_array_arg {
+    my ($class) = @_;
+    my $prefix = 'simple array arg';
+    my $option = $class->new({
+        description => 'description value',
+        name        => 'name-value',
+        letter      => 'n',
+        has_arg     => $class->ARRAY_ARG,
+    });
+    isa_ok($option, $class);
+    is($option->has_arg(), $class->ARRAY_ARG, "$prefix: has arg");
+    is($option->get_arg_for_getopt_long(), 'name-value|n=s@', "$prefix: has arg");
+}
+
+################################################################################
+# Tests simplest usage with hash argument
+sub test_simple_hash_arg {
+    my ($class) = @_;
+    my $prefix = 'simple hash arg';
+    my $option = $class->new({
+        description => 'description value',
+        name        => 'name-value',
+        letter      => 'n',
+        has_arg     => $class->HASH_ARG,
+    });
+    isa_ok($option, $class);
+    is($option->has_arg(), $class->HASH_ARG, "$prefix: has arg");
+    is($option->get_arg_for_getopt_long(), 'name-value|n=s%', "$prefix: has arg");
+}
+
+################################################################################
+# Tests longer than 1 letter
+sub test_long_letter {
+    my ($class) = @_;
+    my $prefix = 'long letter';
+    my $option = $class->new({
+        name   => 'name-value',
+        letter => 'name',
+    });
+    isa_ok($option, $class);
+    is($option->get_letter(), 'n', "$prefix: letter");
+    is($option->get_arg_for_getopt_long(), 'name-value|n', "$prefix: has arg");
+}
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Subcommand.t
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Subcommand.t	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Subcommand.t	(revision 2528)
@@ -0,0 +1,74 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Fcm::CLI::Option;
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::CLI::Subcommand';
+    use_ok($class);
+    test_constructor($class);
+    test_has_a_name($class);
+    test_as_string($class);
+}
+
+################################################################################
+# Tests the constructor
+sub test_constructor {
+    my ($class) = @_;
+    my $prefix = 'constructor';
+    my %OPTION_OF = (
+        description    => 'description value',
+        invoker_class  => 'invoker_class value',
+        invoker_config => 'invoker_config value',
+        is_vc          => 'is_vc value',
+        names          => 'names value',
+        options        => 'options value',
+        synopsis       => 'synopsis value',
+        usage          => 'usage value',
+    );
+    my $subcommand = Fcm::CLI::Subcommand->new(\%OPTION_OF);
+    isa_ok($subcommand, $class, $prefix);
+    for my $key (keys(%OPTION_OF)) {
+        my $getter = index($key, 'is') == 0 ? $key : "get_$key";
+        is($subcommand->$getter(), $OPTION_OF{$key}, "$prefix: $getter");
+    }
+}
+
+################################################################################
+# Tests match a string name to a subcommand
+sub test_has_a_name {
+    my ($class) = @_;
+    my $prefix = 'has a name';
+    my @NAMES = ('foo', 'bar', 'baz');
+    my $subcommand = $class->new({names => \@NAMES});
+    for my $name (@NAMES) {
+        ok($subcommand->has_a_name($name), "$prefix: $name");
+    }
+    for my $name (qw{egg ham mayo}) {
+        ok(!$subcommand->has_a_name($name), "$prefix: $name");
+    }
+}
+
+################################################################################
+# Tests string representation of a subcommand
+sub test_as_string {
+    my ($class) = @_;
+    my $prefix = 'as string';
+    my %OPTION_OF = (
+        'foo (bar, baz)' => ['foo', 'bar', 'baz'],
+        'foo (bar)'      => ['foo', 'bar'],
+        'foo'            => ['foo'],
+        q{}              => [],
+    );
+    for my $key (keys(%OPTION_OF)) {
+        my $subcommand = $class->new({names => $OPTION_OF{$key}});
+        is($subcommand->as_string(), $key, "$prefix: $key");
+    }
+}
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/ConfigSystem.t
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/ConfigSystem.t	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/ConfigSystem.t	(revision 2528)
@@ -0,0 +1,170 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+use strict;
+use warnings;
+
+use Fcm::CfgLine;
+use Fcm::Config;
+use Scalar::Util qw{reftype};
+use Test::More (tests => 90);
+
+BEGIN: {
+    use_ok('Fcm::ConfigSystem');
+}
+
+my $CONFIG = undef;
+
+# ------------------------------------------------------------------------------
+if (!caller()) {
+    main(@ARGV);
+}
+
+# ------------------------------------------------------------------------------
+sub main {
+    local @ARGV = @_;
+    test_compare_setting_in_config();
+}
+
+# ------------------------------------------------------------------------------
+# Tests "compare_setting_in_config".
+sub test_compare_setting_in_config {
+    my $PREFIX = 'TEST';
+    my %S = (egg => [qw{boiled poached}], ham => 'roasted', bacon => 'fried');
+    my %S_MOD = (ham => 'boiled');
+    my %S_MOD_ARRAY = (egg => [qw{scrambled omelette}]);
+    my %S_ADD = (mushroom => 'sauteed');
+    my %S_DEL = (bacon => undef);
+
+    my @ITEMS = (
+        {
+            name     => 'empty',
+            original => {},
+            added    => {},
+            removed  => {},
+            modified => {},
+        },
+        {
+            name     => 'add keys to empty',
+            original => {},
+            added    => {%S},
+            removed  => {},
+            modified => {%S},
+        },
+        {
+            name     => 'remove all',
+            original => {%S},
+            added    => {},
+            removed  => {},
+            modified => {map {($_, undef)} keys(%S)},
+        },
+        {
+            name     => 'no change',
+            original => {%S},
+            added    => {%S},
+            removed  => {},
+            modified => {},
+        },
+        {
+            name     => 'modify key',
+            original => {%S},
+            added    => {%S, %S_MOD},
+            removed  => {},
+            modified => {%S_MOD},
+        },
+        {
+            name     => 'modify an array key',
+            original => {%S},
+            added    => {%S, %S_MOD_ARRAY},
+            removed  => {},
+            modified => {%S_MOD_ARRAY},
+        },
+        {
+            name     => 'add a key',
+            original => {%S},
+            added    => {%S, %S_ADD},
+            removed  => {},
+            modified => {%S_ADD},
+        },
+        {
+            name     => 'delete a key',
+            original => {%S},
+            added    => {%S},
+            removed  => {%S_DEL},
+            modified => {%S_DEL},
+        },
+        {
+            name     => 'modify a key and delete a key',
+            original => {%S},
+            added    => {%S, %S_MOD},
+            removed  => {%S_DEL},
+            modified => {%S_MOD, %S_DEL},
+        },
+        {
+            name     => 'add a key and delete a key',
+            original => {%S},
+            added    => {%S, %S_ADD},
+            removed  => {%S_DEL},
+            modified => {%S_ADD, %S_DEL},
+        },
+    );
+
+    # A naive function to serialise an array reference
+    my $flatten = sub {
+        if (ref($_[0]) && reftype($_[0]) eq 'ARRAY') {
+            join(q{ }, sort(@{$_[0]}))
+        }
+        else {
+            $_[0];
+        }
+    };
+
+    my $CONFIG = Fcm::Config->instance();
+    for my $item (@ITEMS) {
+        # New settings
+        $CONFIG->{setting}{$PREFIX} = {%{$item->{added}}};
+        for my $key (keys(%{$item->{removed}})) {
+            delete($CONFIG->{setting}{$PREFIX}{$key});
+        }
+
+        # Old lines
+        my @old_lines = map {
+            Fcm::CfgLine->new(
+                LABEL => $PREFIX . $Fcm::Config::DELIMITER . $_,
+                VALUE => $flatten->($item->{original}{$_}),
+            )
+        } keys(%{$item->{original}});
+
+        # Invokes the method
+        my $system = Fcm::ConfigSystem->new();
+        my ($changed_hash_ref, $new_cfg_lines_ref)
+            = $system->compare_setting_in_config($PREFIX, \@old_lines);
+
+        # Tests the return values
+        my $T = $item->{name};
+        is_deeply(
+            $changed_hash_ref, $item->{modified},
+            "$T: \$changed_hash_ref content",
+        );
+        is(
+            scalar(@{$new_cfg_lines_ref}),
+            scalar(keys(%{$item->{added}})) - scalar(keys(%{$item->{removed}})),
+            "$T: \$new_cfg_lines_ref length",
+        );
+        for my $line (@{$new_cfg_lines_ref}) {
+            my $key = $line->label_from_field(1);
+            ok(exists($item->{added}{$key}), "$T: expected label $key");
+            ok(!exists($item->{removed}{$key}), "$T: unexpected label $key");
+            is(
+                $line->value(), $flatten->($item->{added}{$key}),
+                "$T: line content $key",
+            );
+        }
+    }
+}
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Exception.t
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Exception.t	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Exception.t	(revision 2528)
@@ -0,0 +1,38 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::Exception';
+    use_ok($class);
+    test_constructor_empty($class);
+    test_normal($class);
+}
+
+################################################################################
+# Tests empty constructor
+sub test_constructor_empty {
+    my ($class) = @_;
+    my $prefix = 'empty constructor';
+    my $e = $class->new();
+    isa_ok($e, $class, $prefix);
+    isnt("$e", undef, "$prefix: as_string() not undef");
+}
+
+################################################################################
+# Tests normal usage
+sub test_normal {
+    my ($class) = @_;
+    my $prefix = 'normal';
+    my $e = $class->new({message => 'message'});
+    isa_ok($e, $class, $prefix);
+    is("$e", "$class: message\n", "$prefix: as_string()");
+    is($e->get_message(), 'message', "$prefix: get_message()");
+}
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/ExtractConfigComparator.t
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/ExtractConfigComparator.t	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/ExtractConfigComparator.t	(revision 2528)
@@ -0,0 +1,17 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::ExtractConfigComparator';
+    use_ok($class);
+}
+
+# TODO: more real tests
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Interactive.t
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Interactive.t	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Interactive.t	(revision 2528)
@@ -0,0 +1,94 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+################################################################################
+# A sub-class of Fcm::Interactive::InputGetter for testing
+{
+    package TestInputGetter;
+    use base qw{Fcm::Interactive::InputGetter};
+
+    ############################################################################
+    # A callback for testing
+    sub get_callback {
+        my ($self) = @_;
+        return $self->{callback};
+    }
+
+    ############################################################################
+    # Returns some pre-defined strings
+    sub invoke {
+        my ($self) = @_;
+        $self->get_callback()->(
+            $self->get_title(),
+            $self->get_message(),
+            $self->get_type(),
+            $self->get_default(),
+        );
+        return 'answer';
+    }
+}
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    use_ok('Fcm::Interactive');
+    test_default_impl();
+    test_set_impl();
+    test_get_input();
+}
+
+################################################################################
+# Tests default setting of input getter implementation
+sub test_default_impl {
+    my $prefix = 'default impl';
+    my ($class_name, $class_options_ref) = Fcm::Interactive::get_default_impl();
+    is($class_name, 'Fcm::Interactive::InputGetter::CLI', "$prefix: class name");
+    is_deeply($class_options_ref, {}, "$prefix: class options");
+}
+
+################################################################################
+# Tests setting the input getter implementation
+sub test_set_impl {
+    my $prefix = 'set impl';
+    my %options = (extra => 'extra-value');
+    my $name = 'TestInputGetter';
+    Fcm::Interactive::set_impl($name, \%options);
+    my ($class_name, $class_options_ref) = Fcm::Interactive::get_impl();
+    is($class_name, $name, "$prefix: class name");
+    is_deeply($class_options_ref, \%options, "$prefix: class options");
+}
+
+################################################################################
+# Tests getting input with test input getter
+sub test_get_input {
+    my $prefix = 'get input';
+    my %EXPECTED = (
+        TITLE   => 'title-value',
+        MESSAGE => 'message-value',
+        TYPE    => 'type-value',
+        DEFAULT => 'default-value',
+        ANSWER  => 'answer',
+    );
+    Fcm::Interactive::set_impl('TestInputGetter', {
+        callback => sub {
+            my ($title, $message, $type, $default) = @_;
+            is($title, $EXPECTED{TITLE}, "$prefix: title");
+            is($message, $EXPECTED{MESSAGE}, "$prefix: message");
+            is($type, $EXPECTED{TYPE}, "$prefix: type");
+            is($default, $EXPECTED{DEFAULT}, "$prefix: default");
+        },
+    });
+    my $ans = Fcm::Interactive::get_input(
+        title   => $EXPECTED{TITLE},
+        message => $EXPECTED{MESSAGE},
+        type    => $EXPECTED{TYPE},
+        default => $EXPECTED{DEFAULT},
+    );
+    is($ans, $EXPECTED{ANSWER}, "$prefix: answer");
+}
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Interactive/InputGetter.t
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Interactive/InputGetter.t	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Interactive/InputGetter.t	(revision 2528)
@@ -0,0 +1,34 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::Interactive::InputGetter';
+    use_ok($class);
+    test_constructor($class);
+}
+
+################################################################################
+# Tests usage of constructor
+sub test_constructor {
+    my ($class) = @_;
+    my $prefix = 'constructor';
+    my $input_getter = $class->new({
+        title   => 'title-value',
+        message => 'message-value',
+        type    => 'type-value',
+        default => 'default-value',
+    });
+    isa_ok($input_getter, $class);
+    is($input_getter->get_title(), 'title-value', "$prefix: get title");
+    is($input_getter->get_message(), 'message-value', "$prefix: get message");
+    is($input_getter->get_type(), 'type-value', "$prefix: get type");
+    is($input_getter->get_default(), 'default-value', "$prefix: get default");
+}
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Interactive/InputGetter/CLI.pm
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Interactive/InputGetter/CLI.pm	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Interactive/InputGetter/CLI.pm	(revision 2528)
@@ -0,0 +1,27 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::Interactive::InputGetter::CLI';
+    use_ok($class);
+    test_constructor($class);
+}
+
+################################################################################
+# Tests usage of constructor
+sub test_constructor {
+    my ($class) = @_;
+    my $prefix = 'constructor';
+    my $input_getter = $class->new({});
+    isa_ok($input_getter, $class);
+}
+
+# TODO: tests the invoke method
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Interactive/InputGetter/GUI.t
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Interactive/InputGetter/GUI.t	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Interactive/InputGetter/GUI.t	(revision 2528)
@@ -0,0 +1,34 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::Interactive::InputGetter::GUI';
+    use_ok($class);
+    test_constructor($class);
+}
+
+################################################################################
+# Tests usage of constructor
+sub test_constructor {
+    my ($class) = @_;
+    my $prefix = 'constructor';
+    my $input_getter = $class->new({
+        title   => 'title-value',
+        message => 'message-value',
+        type    => 'type-value',
+        default => 'default-value',
+        geometry => 'geometry-value',
+    });
+    isa_ok($input_getter, $class);
+    is($input_getter->get_geometry(), 'geometry-value', "$prefix: geometry");
+}
+
+# TODO: tests the invoke method
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword.t
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword.t	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword.t	(revision 2528)
@@ -0,0 +1,323 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Carp qw{croak};
+use Fcm::Keyword::Config;
+use Test::More (tests => 227);
+
+BEGIN: {
+    use_ok('Fcm::Keyword');
+}
+
+if (!caller()) {
+    main(@ARGV);
+}
+
+sub main {
+    local @ARGV = @_;
+    local %Fcm::Keyword::Config::CONFIG_OF = (
+        LOCATION_ENTRIES => {entry_class => 'Fcm::Keyword::Entry::Location'},
+        REVISION_ENTRIES => {entry_class => 'Fcm::Keyword::Entry'},
+    );
+    test_get_prefix_of_location_keyword();
+    test_get_entries();
+    test_expand();
+    test_unexpand();
+    test_get_browser_url();
+}
+
+################################################################################
+# Tests get_prefix_of_location_keyword().
+sub test_get_prefix_of_location_keyword {
+    is(Fcm::Keyword::get_prefix_of_location_keyword(), 'fcm');
+    is(Fcm::Keyword::get_prefix_of_location_keyword(1), 'fcm:');
+}
+
+################################################################################
+# Tests get_entries().
+sub test_get_entries {
+    my $entries = Fcm::Keyword::get_entries();
+    isa_ok($entries, 'Fcm::Keyword::Entries');
+    for (1 .. 10) {
+        is(Fcm::Keyword::get_entries(), $entries, "get_entries: is singleton");
+    }
+    isnt(Fcm::Keyword::get_entries(1), $entries, "get_entries: can reset");
+}
+
+################################################################################
+# Tests expand().
+sub test_expand {
+    my $T = 'expand';
+
+    # Add some keywords for testing
+    _add_keyword_entries([
+    #   ['name'  , 'value'                   , {'rev1' => rev, ...}],
+        ['FOO'   , 'test://foo/foo'      , {'V1.0' => 256, 'V1-1' => 4790}],
+        ['FOO-TR', 'test://foo/foo/trunk', {}],
+    ]);
+
+    _do_keyword_tests($T, \&Fcm::Keyword::expand, [
+    # Tests to ensure that valid targets are expanded
+    #   [['input'               ], ['expected'                     ]],
+        [['fcm:FOO'             ], ['test://foo/foo'               ]],
+        [['fcm:FOO'     , 'V1.0'], ['test://foo/foo'       , '256' ]],
+        [['fcm:Foo'             ], ['test://foo/foo'               ]],
+        [['fcm:foo'             ], ['test://foo/foo'               ]],
+        [['fcm:foo'     , 'v1.0'], ['test://foo/foo'       , '256' ]],
+        [['fcm:foo'     , 'head'], ['test://foo/foo'       , 'head']],
+        [['fcm:foo/'            ], ['test://foo/foo/'              ]],
+        [['fcm:foo/'    , '1234'], ['test://foo/foo/'      , '1234']],
+        [['fcm:foo/'    , 'v1.0'], ['test://foo/foo/'      , '256' ]],
+        [['fcm:foo/'    , 'v1-1'], ['test://foo/foo/'      , '4790']],
+        [['fcm:foo/bar'         ], ['test://foo/foo/bar'           ]],
+        [['fcm:foo/bar' , 'PREV'], ['test://foo/foo/bar'   , 'PREV']],
+        [['fcm:foo/bar' , 'base'], ['test://foo/foo/bar'   , 'base']],
+        [['fcm:foo/bar' , 'v1-1'], ['test://foo/foo/bar'   , '4790']],
+        [['fcm:foo/bar/', '7777'], ['test://foo/foo/bar/'  , '7777']],
+        [['fcm:foo/bar/', '{11}'], ['test://foo/foo/bar/'  , '{11}']],
+        [['fcm:foo/bar/', 'v1.0'], ['test://foo/foo/bar/'  , '256' ]],
+        [['fcm:foo-tr'          ], ['test://foo/foo/trunk'         ]],
+        [['fcm:foo-tr'  , 'head'], ['test://foo/foo/trunk' , 'head']],
+        [['fcm:foo-tr'  , 'v1.0'], ['test://foo/foo/trunk' , '256' ]],
+        [['fcm:foo-tr/'         ], ['test://foo/foo/trunk/'        ]],
+        [['fcm:foo-tr/' , '1234'], ['test://foo/foo/trunk/', '1234']],
+        [['fcm:foo-tr/' , 'v1-1'], ['test://foo/foo/trunk/', '4790']],
+    # Tests to ensure that non-keyword targets are not expanded
+    #   [['input'                     ]], # 'expected' same as 'input'
+        [['no-change'                 ]],
+        [['foo/bar'                   ]],
+        [['/foo/bar'                  ]],
+        [['/foo/bar'     , 'head'     ]],
+        [['/foo/bar/'                 ]],
+        [['/foo/bar/'    , 'not-a-key']],
+        [['svn://foo/bar'             ]],
+        [['svn://foo/bar', '1234'     ]],
+        [['file://foo/bar'            ]],
+        [['http://foo/bar'            ]],
+    ]);
+
+    # Tests for unexpected keywords
+    for my $key (qw{foo bar baz}) {
+        eval {
+            Fcm::Keyword::expand("fcm:foo\@$key");
+        };
+        isa_ok($@, 'Fcm::Keyword::Exception', "$T: $key: invalid revision");
+    }
+
+    # Tests for "undef", all expecting exceptions
+    for my $target_ref ([undef], [undef, undef], [undef, 'foo']) {
+        eval {
+            Fcm::Keyword::expand(@{$target_ref});
+        };
+        isa_ok($@, 'Fcm::Exception', "$T: undef");
+    }
+}
+
+################################################################################
+# Tests unexpand().
+sub test_unexpand {
+    my $T = 'unexpand';
+
+    # Add some keywords for testing
+    _add_keyword_entries([
+    #   ['name'  , 'value'               , {'rev1' => rev, ...}],
+        ['FOO'   , 'test://foo/foo'      , {'V1.0' => 256, 'V1-1' => 4790}],
+        ['FOO_TR', 'test://foo/foo/trunk', {}],
+        ['FOO-TR', 'test://foo/foo/trunk', {}],
+    ]);
+
+    _do_keyword_tests($T, \&Fcm::Keyword::unexpand, [
+    # Tests to ensure that valid targets are expanded
+    #   [['input'                        ], ['expected'            ]],
+        [['test://foo/foo'               ], ['fcm:FOO'             ]],
+        [['test://foo/foo'       , '256' ], ['fcm:FOO'     , 'V1.0']],
+        [['test://foo/foo'       , 'head'], ['fcm:FOO'     , 'head']],
+        [['test://foo/foo/'              ], ['fcm:FOO/'            ]],
+        [['test://foo/foo/'      , '1234'], ['fcm:FOO/'    , '1234']],
+        [['test://foo/foo/'      , '256' ], ['fcm:FOO/'    , 'V1.0']],
+        [['test://foo/foo/'      , '4790'], ['fcm:FOO/'    , 'V1-1']],
+        [['test://foo/foo/bar'           ], ['fcm:FOO/bar'         ]],
+        [['test://foo/foo/bar'   , 'PREV'], ['fcm:FOO/bar' , 'PREV']],
+        [['test://foo/foo/bar'   , 'base'], ['fcm:FOO/bar' , 'base']],
+        [['test://foo/foo/bar'   , '4790'], ['fcm:FOO/bar' , 'V1-1']],
+        [['test://foo/foo/bar/'  , '7777'], ['fcm:FOO/bar/', '7777']],
+        [['test://foo/foo/bar/'  , '{11}'], ['fcm:FOO/bar/', '{11}']],
+        [['test://foo/foo/bar/'  , '256' ], ['fcm:FOO/bar/', 'V1.0']],
+        [['test://foo/foo/trunk'         ], ['fcm:FOO-TR'          ]],
+        [['test://foo/foo/trunk' , 'head'], ['fcm:FOO-TR'  , 'head']],
+        [['test://foo/foo/trunk' , '256' ], ['fcm:FOO-TR'  , 'V1.0']],
+        [['test://foo/foo/trunk/'        ], ['fcm:FOO-TR/'         ]],
+        [['test://foo/foo/trunk/', '1234'], ['fcm:FOO-TR/' , '1234']],
+        [['test://foo/foo/trunk/', '4790'], ['fcm:FOO-TR/' , 'V1-1']],
+    # Tests to ensure that non-keyword targets are not expanded
+    #   [['input'                     ]], # 'expected' same as 'input'
+        [['no-change'                 ]],
+        [['foo/bar'                   ]],
+        [['/foo/bar'                  ]],
+        [['/foo/bar'     , 'head'     ]],
+        [['/foo/bar/'                 ]],
+        [['/foo/bar/'    , 'not-a-key']],
+        [['svn://foo/bar'             ]],
+        [['svn://foo/bar', '1234'     ]],
+        [['file://foo/bar'            ]],
+        [['http://foo/bar'            ]],
+    ]);
+
+    # Tests for "undef", all expecting exceptions
+    for my $target_ref ([undef], [undef, undef], [undef, 'foo']) {
+        eval {
+            Fcm::Keyword::unexpand(@{$target_ref});
+        };
+        isa_ok($@, 'Fcm::Exception', "$T: undef");
+    }
+}
+
+################################################################################
+# Tests get_browser_url().
+sub test_get_browser_url {
+    my $T = 'get_browser_url';
+
+    # Add some keywords for testing
+    _add_keyword_entries([
+    #   ['name'  , 'value'                        , {'rev1' => rev, ...}],
+        ['FOO'   , 'test://foo/foo_svn/foo'       , {'V1' => 256, 'W2' => 479}],
+        ['FOO-TR', 'test://foo/foo_svn/foo/trunk'],
+        ['FOO_TR', 'test://foo/foo_svn/foo/trunk'],
+    ]);
+
+    my ($INPUT, $EXPECTED) = (0, 1);
+    my ($LOC, $REV) = (0, 1);
+    for my $test_ref (
+    # Tests to ensure that valid targets are expanded
+    #   [['input'                                ], 'expected'                                                ],
+        [['test://foo/foo_svn/foo'               ], 'http://foo/projects/foo/intertrac/source:foo'            ],
+        [['test://foo/foo_svn/foo'       , '256' ], 'http://foo/projects/foo/intertrac/source:foo@256'        ],
+        [['test://foo/foo_svn/foo'       , 'head'], 'http://foo/projects/foo/intertrac/source:foo@head'       ],
+        [['test://foo/foo_svn/foo/'              ], 'http://foo/projects/foo/intertrac/source:foo/'           ],
+        [['test://foo/foo_svn/foo/'      , '1234'], 'http://foo/projects/foo/intertrac/source:foo/@1234'      ],
+        [['test://foo/foo_svn/foo/'      , '256' ], 'http://foo/projects/foo/intertrac/source:foo/@256'       ],
+        [['test://foo/foo_svn/foo/'      , '479' ], 'http://foo/projects/foo/intertrac/source:foo/@479'       ],
+        [['test://foo/foo_svn/foo/bar'           ], 'http://foo/projects/foo/intertrac/source:foo/bar'        ],
+        [['test://foo/foo_svn/foo/bar'   , '479' ], 'http://foo/projects/foo/intertrac/source:foo/bar@479'    ],
+        [['test://foo/foo_svn/foo/bar/'  , '7777'], 'http://foo/projects/foo/intertrac/source:foo/bar/@7777'  ],
+        [['test://foo/foo_svn/foo/bar/'  , '{11}'], 'http://foo/projects/foo/intertrac/source:foo/bar/@{11}'  ],
+        [['test://foo/foo_svn/foo/bar/'  , '256' ], 'http://foo/projects/foo/intertrac/source:foo/bar/@256'   ],
+        [['test://foo/foo_svn/foo/trunk'         ], 'http://foo/projects/foo/intertrac/source:foo/trunk'      ],
+        [['test://foo/foo_svn/foo/trunk' , 'head'], 'http://foo/projects/foo/intertrac/source:foo/trunk@head' ],
+        [['test://foo/foo_svn/foo/trunk' , '256' ], 'http://foo/projects/foo/intertrac/source:foo/trunk@256'  ],
+        [['test://foo/foo_svn/foo/trunk/'        ], 'http://foo/projects/foo/intertrac/source:foo/trunk/'     ],
+        [['test://foo/foo_svn/foo/trunk/', '1234'], 'http://foo/projects/foo/intertrac/source:foo/trunk/@1234'],
+        [['test://foo/foo_svn/foo/trunk/', '479' ], 'http://foo/projects/foo/intertrac/source:foo/trunk/@479' ],
+        [['fcm:FOO'                              ], 'http://foo/projects/foo/intertrac/source:foo'            ],
+        [['fcm:FOO'                      , 'V1'  ], 'http://foo/projects/foo/intertrac/source:foo@256'        ],
+        [['fcm:FOO'                      , 'head'], 'http://foo/projects/foo/intertrac/source:foo@head'       ],
+        [['fcm:FOO/'                             ], 'http://foo/projects/foo/intertrac/source:foo/'           ],
+        [['fcm:FOO/'                     , '1234'], 'http://foo/projects/foo/intertrac/source:foo/@1234'      ],
+        [['fcm:FOO/'                     , 'V1'  ], 'http://foo/projects/foo/intertrac/source:foo/@256'       ],
+        [['fcm:FOO/'                     , 'W2'  ], 'http://foo/projects/foo/intertrac/source:foo/@479'       ],
+        [['fcm:FOO/bar'                          ], 'http://foo/projects/foo/intertrac/source:foo/bar'        ],
+        [['fcm:FOO/bar'                  , 'W2'  ], 'http://foo/projects/foo/intertrac/source:foo/bar@479'    ],
+        [['fcm:FOO/bar/'                 , '7777'], 'http://foo/projects/foo/intertrac/source:foo/bar/@7777'  ],
+        [['fcm:FOO/bar/'                 , '{11}'], 'http://foo/projects/foo/intertrac/source:foo/bar/@{11}'  ],
+        [['fcm:FOO/bar/'                 , 'v1'  ], 'http://foo/projects/foo/intertrac/source:foo/bar/@256'   ],
+        [['fcm:FOO-TR'                           ], 'http://foo/projects/foo/intertrac/source:foo/trunk'      ],
+        [['fcm:FOO-TR'                   , 'head'], 'http://foo/projects/foo/intertrac/source:foo/trunk@head' ],
+        [['fcm:FOO-TR'                   , 'V1'  ], 'http://foo/projects/foo/intertrac/source:foo/trunk@256'  ],
+        [['fcm:FOO-TR/'                          ], 'http://foo/projects/foo/intertrac/source:foo/trunk/'     ],
+        [['fcm:FOO-TR/'                  , '1234'], 'http://foo/projects/foo/intertrac/source:foo/trunk/@1234'],
+        [['fcm:FOO-TR/'                  , 'w2'  ], 'http://foo/projects/foo/intertrac/source:foo/trunk/@479' ],
+    ) {
+        my $input = $test_ref->[$INPUT][$LOC];
+        if (exists($test_ref->[$INPUT][$REV])) {
+            $input .= '@' . $test_ref->[$INPUT][$REV];
+        }
+        for (
+            {name => "$T: scalar input: $input", input => [$input]},
+            {name => "$T: list input: $input"  , input => $test_ref->[$INPUT]},
+        ) {
+            my $output;
+            eval {
+                $output = Fcm::Keyword::get_browser_url(@{$_->{input}});
+                is($output, $test_ref->[$EXPECTED], $_->{name});
+            };
+            if ($@) {
+                fail("$_->{name}: $@");
+            }
+        }
+    }
+
+    # Tests correct behaviour for "undef"
+    for my $bad_url (undef, '') {
+        eval {
+            Fcm::Keyword::get_browser_url($bad_url);
+        };
+        isa_ok($@, 'Fcm::Exception', sprintf(
+            "$T: %s", (defined($bad_url) ? $bad_url : 'undef'),
+        ));
+    }
+
+    # Tests correct behaviour for invalid inputs
+    for my $bad_url ('foo', 'svn://no/such/url', 'fcm:no_such_project/trunk') {
+        eval {
+            Fcm::Keyword::get_browser_url($bad_url);
+        };
+        isa_ok($@, 'Fcm::Keyword::Exception', "$T: $bad_url: invalid keyword");
+    }
+}
+
+################################################################################
+# Adds keyword entries.
+sub _add_keyword_entries {
+    my ($items_ref) = @_;
+    my ($NAME, $LOC, $REV) = (0 .. 2);
+    my $entries = Fcm::Keyword::get_entries(1); # reset
+    for my $item_ref (@{$items_ref}) {
+        my $entry = $entries->add_entry($item_ref->[$NAME], $item_ref->[$LOC]);
+        while (my ($key, $value) = each(%{$item_ref->[$REV]})) {
+            $entry->get_revision_entries()->add_entry($key, $value);
+        }
+    }
+}
+
+################################################################################
+# Performs keyword testings.
+sub _do_keyword_tests {
+    my ($T, $action_ref, $tests_ref) = @_;
+    my ($INPUT, $EXPECTED) = (0, 1);
+    my ($LOC, $REV) = (0, 1);
+    for my $test_ref (@{$tests_ref}) {
+        if (!defined($test_ref->[$EXPECTED])) {
+            $test_ref->[$EXPECTED] = $test_ref->[$INPUT];
+        }
+        my %value_of;
+        for my $i (0 .. $#{$test_ref}) {
+            $value_of{$i} = $test_ref->[$i][$LOC];
+            if (exists($test_ref->[$i][$REV])) {
+                $value_of{$i} .= '@' . $test_ref->[$i][$REV];
+            }
+        }
+        eval {
+            is(
+                $action_ref->($value_of{$INPUT}), $value_of{$EXPECTED},
+                "$T: scalar context: $value_of{$INPUT}",
+            );
+        };
+        if ($@) {
+            fail("$T: scalar context: $value_of{$INPUT}: $@");
+        }
+        eval {
+            is_deeply(
+                [$action_ref->(@{$test_ref->[$INPUT]})],
+                $test_ref->[$EXPECTED],
+                "$T: list context: $value_of{$INPUT}",
+            );
+        };
+        if ($@) {
+            fail("$T: list context: $value_of{$INPUT}: $@");
+        }
+    }
+}
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Config.t
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Config.t	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Config.t	(revision 2528)
@@ -0,0 +1,15 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $module = 'Fcm::Keyword::Config';
+    use_ok($module);
+}
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Entries.t
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Entries.t	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Entries.t	(revision 2528)
@@ -0,0 +1,228 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+################################################################################
+# A Fcm::Keyword::Entry sub-class for testing
+{
+    package TestEntry;
+    use base qw{Fcm::Keyword::Entry};
+}
+
+################################################################################
+# A mock loader implementing the Fcm::Keyword::Loader interface
+{
+    package MockLoader0;
+    use Scalar::Util qw{blessed};
+
+    ############################################################################
+    # Constructor
+    sub new {
+        my ($class) = @_;
+        return bless({number_of_calls_to_load_to => 0}, $class);
+    }
+
+    ############################################################################
+    ##Returns the package name
+    sub get_source {
+        my ($self) = @_;
+        return blessed($self);
+    }
+
+    ############################################################################
+    # Returns number of times $self->load_to() has been called
+    sub get_number_of_calls_to_load_to {
+        my ($self) = @_;
+        return $self->{number_of_calls_to_load_to};
+    }
+
+    ############################################################################
+    # Loads data into $entries, and returns number of entries loaded
+    sub load_to {
+        my ($self, $entries) = @_;
+        $self->{number_of_calls_to_load_to}++;
+        return $self->load_to_impl($entries);
+    }
+
+    ############################################################################
+    # Returns 0
+    sub load_to_impl {
+        my ($self, $entries) = @_;
+        return 0;
+    }
+}
+
+################################################################################
+# A mock loader implementing the Fcm::Keyword::Loader interface
+{
+    package MockLoader1;
+    our @ISA = qw{MockLoader0};
+
+    my %VALUE_OF = (foo => 'foo1', bar => 'bar2', baz => 'baz3');
+
+    ############################################################################
+    # Returns a reference to the mock data
+    sub get_data {
+        my ($class) = @_;
+        return \%VALUE_OF;
+    }
+
+    ############################################################################
+    ##Writes mock data to the $entries object
+    sub load_to_impl {
+        my ($self, $entries) = @_;
+        my $counter = 0;
+        for my $key (keys(%{$self->get_data()})) {
+            $entries->add_entry($key, $self->get_data()->{$key});
+            $counter++;
+        }
+        return $counter;
+    }
+}
+
+################################################################################
+# A mock loader implementing the Fcm::Keyword::Loader interface
+{
+    package MockLoader2;
+    our @ISA = qw{MockLoader1};
+
+    my %VALUE_OF = (sausages => 'pig', eggs => 'hen', chips => 'potato');
+
+    ############################################################################
+    # Returns a reference to the mock data
+    sub get_data {
+        my ($class) = @_;
+        return \%VALUE_OF;
+    }
+}
+
+package main;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::Keyword::Entries';
+    use_ok($class);
+    test_empty_constructor($class);
+    test_constructor($class);
+    test_add_entry($class);
+    test_loaders($class);
+}
+
+################################################################################
+# Tests empty constructor
+sub test_empty_constructor {
+    my ($class) = @_;
+    my $prefix = 'empty constructor';
+    my $entries = $class->new();
+    isa_ok($entries, $class);
+    is($entries->get_entry_class(), 'Fcm::Keyword::Entry',
+        "$prefix: default entry class");
+    is_deeply([$entries->get_loaders()], [], "$prefix: empty list of loaders");
+    is_deeply([$entries->get_all_entries()], [],
+        "$prefix: empty list of entries");
+    for my $arg ('foo', undef) {
+        is($entries->get_entry_by_key($arg), undef,
+            "$prefix: entry by key: undef");
+        is($entries->get_entry_by_value($arg), undef,
+            "$prefix: entry by value: undef");
+    }
+}
+
+################################################################################
+# Tests other constructor usages
+sub test_constructor {
+    my ($class) = @_;
+    my $prefix = 'constructor';
+    my @loaders = (MockLoader1->new(), MockLoader2->new());
+    my $entries = $class->new({
+        entry_class => 'not-a-class',
+        loaders     => \@loaders,
+    });
+    isa_ok($entries, $class);
+    is($entries->get_entry_class(), 'not-a-class', "$prefix: entry class");
+    is_deeply([$entries->get_loaders()], \@loaders, "$prefix: list of loaders");
+    eval {
+        $entries->add_entry('key', 'value');
+    };
+    isnt($@, undef, "$prefix: invalid entry class");
+}
+
+################################################################################
+# Tests adding entries
+sub test_add_entry {
+    my ($class) = @_;
+    my $prefix = 'add entry';
+    my %VALUE_OF = (key1 => 'value1', egg => 'white and yolk', 'xyz.abc' => '');
+    for my $entry_class ('Fcm::Keyword::Entry', 'TestEntry') {
+        my $entries = $class->new({entry_class => $entry_class});
+        my $number_of_entries = 0;
+        for my $key (keys(%VALUE_OF)) {
+            my $entry = $entries->add_entry($key, $VALUE_OF{$key});
+            isa_ok($entry, $entry_class);
+            is(scalar(@{$entries->get_all_entries()}), ++$number_of_entries,
+                "$prefix: number of entries: $number_of_entries");
+        }
+        for my $key (keys(%VALUE_OF)) {
+            my $entry = $entries->get_entry_by_key($key);
+            isa_ok($entry, $entry_class);
+            is($entry->get_key(), uc($key), "$prefix: get by key: $key");
+            is($entry->get_value(), $VALUE_OF{$key},
+                "$prefix: get by key: $key: value");
+        }
+        for my $key (keys(%VALUE_OF)) {
+            my $entry = $entries->get_entry_by_value($VALUE_OF{$key});
+            isa_ok($entry, $entry_class);
+            is($entry->get_key(), uc($key), "$prefix: get by value: $key");
+            is($entry->get_value(), $VALUE_OF{$key},
+                "$prefix: get by value: $key: value");
+        }
+        is($entries->get_entry_by_key('no-such-key'), undef,
+            "$prefix: get by key: no-such-key");
+        is($entries->get_entry_by_value('no-such-value'), undef,
+            "$prefix: get by value: no-such-value");
+    }
+}
+
+################################################################################
+# Tests usage of loaders
+sub test_loaders {
+    my ($class) = @_;
+    my $prefix = "loader";
+    my @loaders = (MockLoader0->new(), MockLoader1->new(), MockLoader2->new());
+    my $entries = $class->new({loaders => \@loaders});
+    for my $loader (@loaders) {
+        is($loader->get_number_of_calls_to_load_to(), 0, "$prefix: not loaded");
+    }
+    for my $key (keys(%{$loaders[1]->get_data()})) {
+        my $value = $loaders[1]->get_data()->{$key};
+        my $entry = $entries->get_entry_by_key($key);
+        is($entry->get_key(), uc($key), "$prefix: by key: $key: key");
+        is($entries->get_entry_by_value($value), $entry,
+            "$prefix: by value: $key: object");
+    }
+    is($loaders[0]->get_number_of_calls_to_load_to(), 1,
+        "$prefix: loaded once: 0");
+    is($loaders[1]->get_number_of_calls_to_load_to(), 1,
+        "$prefix: loaded once: 1");
+    is($loaders[2]->get_number_of_calls_to_load_to(), 0,
+        "$prefix: not loaded: 2");
+    for my $key (keys(%{$loaders[2]->get_data()})) {
+        my $value = $loaders[2]->get_data()->{$key};
+        my $entry = $entries->get_entry_by_key($key);
+        is($entry->get_key(), uc($key), "$prefix: by key: $key: key");
+        is($entries->get_entry_by_value($value), $entry,
+            "$prefix: by value: $key: object");
+    }
+    is($loaders[0]->get_number_of_calls_to_load_to(), 2,
+        "$prefix: loaded once: 0");
+    is($loaders[1]->get_number_of_calls_to_load_to(), 1,
+        "$prefix: loaded once: 1");
+    is($loaders[2]->get_number_of_calls_to_load_to(), 1,
+        "$prefix: not loaded: 2");
+}
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Entry.t
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Entry.t	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Entry.t	(revision 2528)
@@ -0,0 +1,26 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::Keyword::Entry';
+    use_ok($class);
+    test_normal($class);
+}
+
+################################################################################
+# Tests normal usage
+sub test_normal {
+    my ($class) = 'Fcm::Keyword::Entry';
+    my $entry = $class->new({key => 'key', value => 'value'});
+    isa_ok($entry, $class);
+    is($entry->get_key(), 'key', "normal: get_key()");
+    is($entry->get_value(), 'value', "normal: get_value()");
+}
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Entry/Location.t
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Entry/Location.t	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Entry/Location.t	(revision 2528)
@@ -0,0 +1,29 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my ($class) = 'Fcm::Keyword::Entry::Location';
+    use_ok($class);
+    test_constructor($class);
+}
+
+################################################################################
+# Tests constructor
+sub test_constructor {
+    my ($class) = @_;
+    my $prefix = 'constructor';
+    isa_ok($class->new(), $class, "$prefix: empty");
+    my $entry = $class->new({key => 'key', value => 'value'});
+    isa_ok($entry, $class, "$prefix: normal");
+    is($entry->get_key(), 'key', "$prefix: normal: get_key()");
+    is($entry->get_value(), 'value', "$prefix: normal: get_value()");
+    isa_ok($entry->get_revision_entries(), 'Fcm::Keyword::Entries');
+}
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Exception.t
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Exception.t	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Exception.t	(revision 2528)
@@ -0,0 +1,27 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::Keyword::Exception';
+    use_ok($class);
+    test_normal($class);
+}
+
+################################################################################
+# Tests normal usage
+sub test_normal {
+    my ($class) = @_;
+    my $prefix = 'normal';
+    my $e = $class->new({message => 'message'});
+    isa_ok($e, $class, $prefix);
+    is("$e", "$class: message\n", "$prefix: as_string()");
+    is($e->get_message(), 'message', "$prefix: get_message()");
+}
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Formatter/Entries.t
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Formatter/Entries.t	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Formatter/Entries.t	(revision 2528)
@@ -0,0 +1,31 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Fcm::Keyword::Entries;
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::Keyword::Formatter::Entries';
+    use_ok($class);
+    test_normal($class);
+}
+
+################################################################################
+# Tests normal usage
+sub test_normal {
+    my ($class) = @_;
+    my $prefix = 'normal';
+    my $formatter = $class->new();
+    isa_ok($formatter, $class, $prefix);
+    my $entries = Fcm::Keyword::Entries->new();
+    $entries->add_entry('foo', 'food');
+    $entries->add_entry('bar', 'barley');
+    is($formatter->format($entries), "BAR = barley\nFOO = food\n",
+        "$prefix: format");
+}
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Formatter/Entry.t
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Formatter/Entry.t	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Formatter/Entry.t	(revision 2528)
@@ -0,0 +1,28 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Fcm::Keyword::Entry;
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::Keyword::Formatter::Entry';
+    use_ok($class);
+    test_normal($class);
+}
+
+################################################################################
+# Tests normal usage
+sub test_normal {
+    my ($class) = @_;
+    my $prefix = 'normal';
+    my $formatter = $class->new();
+    isa_ok($formatter, $class, $prefix);
+    my $entry = Fcm::Keyword::Entry->new({key => 'k', value => 'v'});
+    is($formatter->format($entry), "k = v\n", "$prefix: format");
+}
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Formatter/Entry/Location.t
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Formatter/Entry/Location.t	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Formatter/Entry/Location.t	(revision 2528)
@@ -0,0 +1,28 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Fcm::Keyword::Entry::Location;
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::Keyword::Formatter::Entry::Location';
+    use_ok($class);
+    test_normal($class);
+}
+
+################################################################################
+# Tests normal usage
+sub test_normal {
+    my ($class) = @_;
+    my $prefix = 'normal';
+    my $formatter = $class->new();
+    isa_ok($formatter, $class, $prefix);
+    my $entry = Fcm::Keyword::Entry::Location->new({key => 'k', value => 'v'});
+    like($formatter->format($entry), qr{k \s = \s v}xms, "$prefix: format");
+}
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Loader/Config/Location.t
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Loader/Config/Location.t	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Loader/Config/Location.t	(revision 2528)
@@ -0,0 +1,68 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Fcm::Config;
+use Fcm::Keyword::Entries;
+use Test::More qw{no_plan};
+
+my %VALUE_OF = (
+    foo => 'fcm-test://foo/foo',
+    bar => 'fcm-test://bar/bar',
+    baz => 'fcm-test://baz/baz',
+);
+
+main();
+
+sub main {
+    my $class = 'Fcm::Keyword::Loader::Config::Location';
+    use_ok($class);
+    test_constructor($class);
+    test_load_to($class);
+}
+
+################################################################################
+# Tests simple usage of the constructor
+sub test_constructor {
+    my ($class) = @_;
+    my $prefix = "constructor";
+    my $loader = $class->new();
+    isa_ok($loader, $class);
+    is($loader->get_source(), 'Fcm::Config', "$prefix: get_source()");
+}
+
+################################################################################
+# Tests loading to an Fcm::Keyword::Entries object
+sub test_load_to {
+    my ($class) = @_;
+    my $prefix = 'load to';
+    my $config = Fcm::Config->instance();
+    for my $key (keys(%VALUE_OF)) {
+        $config->setting(['URL', $key], $VALUE_OF{$key});
+    }
+    my $loader = $class->new();
+    my $entries = Fcm::Keyword::Entries->new({
+        entry_class => 'Fcm::Keyword::Entry::Location',
+    });
+    isnt($loader->load_to($entries), 0, "$prefix: number loaded");
+    for my $key (keys(%VALUE_OF)) {
+        my $entry = $entries->get_entry_by_key($key);
+        if ($entry) {
+            is($entry->get_key(), uc($key), "$prefix: by key: $key");
+            is($entry->get_value(), $VALUE_OF{$key}, "$prefix: by value: $key");
+            is(
+                $entries->get_entry_by_value($VALUE_OF{$key}),
+                $entry,
+                "$prefix: by key: $key: object",
+            );
+        }
+        else {
+            fail("$prefix: by key: $key");
+        }
+    }
+}
+
+# TODO: tests loading of browser mapping
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Loader/Config/Revision.t
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Loader/Config/Revision.t	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Loader/Config/Revision.t	(revision 2528)
@@ -0,0 +1,80 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Fcm::Config;
+use Fcm::Keyword::Entries;
+use Test::More qw{no_plan};
+
+my %VALUE_OF = (
+    bar => {
+        'bar3'    => 3,
+        'bar3.1'  => 31,
+        'bar3.14' => 314,
+    },
+    baz => {
+        'bear'   => 4,
+        'bee'    => 6,
+        'spider' => 8,
+    },
+);
+
+main();
+
+sub main {
+    my $class = 'Fcm::Keyword::Loader::Config::Revision';
+    use_ok($class);
+    test_constructor($class);
+    test_load_to($class);
+}
+
+################################################################################
+# Tests simple usage of the constructor
+sub test_constructor {
+    my ($class) = @_;
+    my $prefix = "constructor";
+    my $loader = $class->new({namespace => 'namespace'});
+    isa_ok($loader, $class);
+    is($loader->get_namespace(), 'namespace', "$prefix: get_namespace()");
+    is($loader->get_source(), 'Fcm::Config', "$prefix: get_source()");
+}
+
+################################################################################
+# Tests loading to an Fcm::Keyword::Entries object
+sub test_load_to {
+    my ($class) = @_;
+    my $prefix = 'load to';
+    my $config = Fcm::Config->instance();
+    for my $key (keys(%VALUE_OF)) {
+        for my $rev_key (keys(%{$VALUE_OF{$key}})) {
+            my $value = $VALUE_OF{$key}{$rev_key};
+            $config->setting(['URL_REVISION', uc($key), uc($rev_key)], $value);
+        }
+        my $entries = Fcm::Keyword::Entries->new();
+        my $loader = $class->new({namespace => $key});
+        isnt($loader->load_to($entries), 0, "$prefix: number loaded");
+        for my $rev_key (keys(%{$VALUE_OF{$key}})) {
+            my $entry = $entries->get_entry_by_key($rev_key);
+            my $value = $VALUE_OF{$key}{$rev_key};
+            if ($entry) {
+                is(
+                    $entry->get_key(),
+                    uc($rev_key),
+                    "$prefix: by key: $rev_key",
+                );
+                is($entry->get_value(), $value, "$prefix: by value: $rev_key");
+                is(
+                    $entries->get_entry_by_value($value),
+                    $entry,
+                    "$prefix: by key: $key: object",
+                );
+            }
+            else {
+                fail("$prefix: by key: $rev_key");
+            }
+        }
+    }
+}
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Loader/VC/Revision.t
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Loader/VC/Revision.t	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Loader/VC/Revision.t	(revision 2528)
@@ -0,0 +1,101 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Carp qw{croak};
+use Fcm::Keyword::Entries;
+use File::Basename qw{dirname};
+use File::Spec;
+use File::Temp qw{tempdir};
+use IO::File;
+use IO::Pipe;
+use POSIX qw{WIFEXITED};
+use Test::More (tests => 17);
+
+my %VALUE_OF = (
+    bar => {
+        'bar3'    => 3,
+        'bar3.1'  => 31,
+        'bar3.14' => 314,
+    },
+    baz => {
+        'bear'   => 4,
+        'bee'    => 6,
+        'spider' => 8,
+    },
+);
+
+main();
+
+sub main {
+    my $class = 'Fcm::Keyword::Loader::VC::Revision';
+    use_ok($class);
+    test_constructor($class);
+    test_load_to($class);
+}
+
+################################################################################
+# Tests simple usage of the constructor
+sub test_constructor {
+    my ($class) = @_;
+    my $prefix = "constructor";
+    my $loader = $class->new({source => 'foo'});
+    isa_ok($loader, $class);
+    is($loader->get_source(), 'foo', "$prefix: get_source()");
+    ok($loader->load_to(), "$prefix: load_to"); # FIXME: should fail?
+}
+
+################################################################################
+# Tests loading to an Fcm::Keyword::Entries object
+sub test_load_to {
+    my ($class) = @_;
+    my $prefix = 'load to';
+    my $temp_dir = tempdir(CLEANUP => 1);
+    my $repos = File::Spec->catfile($temp_dir, 'repos');
+    WIFEXITED(system(qw{svnadmin create}, $repos))
+        || croak("$repos: cannot create: $?");
+    my $dump_file = File::Spec->catfile(dirname($0), 'Revision.dump');
+    my $handle = IO::File->new($dump_file, 'r');
+    if (!$handle) {
+        croak("$dump_file: cannot load: $!");
+    }
+    my $dump = do{local $/; $handle->getline()};
+    $handle->close();
+    my $pipe = IO::Pipe->new();
+    $pipe->writer(qw{svnadmin load -q}, $repos);
+    print($pipe $dump);
+    $pipe->close();
+    if ($?) {
+        croak("$dump_file: cannot load: $?");
+    }
+    my $repos_url = "file://$repos";
+    my $loader = $class->new({source => $repos_url});
+    my $entries = Fcm::Keyword::Entries->new();
+    ok($loader->load_to($entries), "$prefix: nothing to load");
+    for my $key (keys(%VALUE_OF)) {
+        my $url = "$repos_url/$key";
+        my $loader = $class->new({source => $url});
+        $loader->load_to($entries);
+        for my $rev_key (keys(%{$VALUE_OF{$key}})) {
+            my $entry = $entries->get_entry_by_key($rev_key);
+            if ($entry) {
+                is(
+                    $entry->get_key(),
+                    uc($rev_key),
+                    "$prefix: by key: $rev_key",
+                );
+                is(
+                    $entries->get_entry_by_value($VALUE_OF{$key}{$rev_key}),
+                    $entry,
+                    "$prefix: by value: $rev_key: object",
+                );
+            }
+            else {
+                fail("$prefix: by key: $rev_key");
+            }
+        }
+    }
+}
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Util.t
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Util.t	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Util.t	(revision 2528)
@@ -0,0 +1,44 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    use_ok('Fcm::Util');
+    test_tidy_url();
+}
+
+################################################################################
+# Tests tidy_url
+sub test_tidy_url {
+    my $prefix = "tidy_url";
+    my %RESULT_OF = (
+        ''                         => '',
+        'foo'                      => 'foo',
+        'foo/bar'                  => 'foo/bar',
+        'http://foo/bar'           => 'http://foo/bar',
+        'http://foo/bar@1234'      => 'http://foo/bar@1234',
+        'http://foo/bar/@1234'     => 'http://foo/bar@1234',
+        'http://foo/bar/.'         => 'http://foo/bar',
+        'http://foo/bar/.@1234'    => 'http://foo/bar@1234',
+        'http://foo/bar/./@1234'   => 'http://foo/bar@1234',
+        'http://foo/bar/./baz'     => 'http://foo/bar/baz',
+        'http://foo/bar/..'        => 'http://foo',
+        'http://foo/bar/..@1234'   => 'http://foo@1234',
+        'http://foo/bar/../@1234'  => 'http://foo@1234',
+        'http://foo/bar/../baz'    => 'http://foo/baz',
+        'http://foo/bar/../.'      => 'http://foo',
+        'http://foo/bar/baz/../..' => 'http://foo',
+    );
+    for my $key (sort keys(%RESULT_OF)) {
+        is(tidy_url($key), $RESULT_OF{$key}, "$prefix: $key");
+    }
+}
+
+# TODO: more unit tests
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Util/ClassLoader.t
===================================================================
--- trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Util/ClassLoader.t	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/fcm/t/Fcm/Util/ClassLoader.t	(revision 2528)
@@ -0,0 +1,55 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+################################################################################
+# A class for testing the loader
+{
+    package MyTestClass;
+
+    sub new {
+        my ($class) = @_;
+        return bless(\do{my $annon_scalar}, $class);
+    }
+}
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    use_ok('Fcm::Util::ClassLoader');
+    test_normal();
+    test_bad();
+}
+
+################################################################################
+# Tests loading classes that should load OK
+sub test_normal {
+    my $prefix = 'normal';
+    my @CLASSES = (
+        'Fcm::CLI::Config',
+        'Fcm::Exception',
+        'Fcm::CLI::Config', # repeat
+        'MyTestClass',
+    );
+    for my $class (@CLASSES) {
+        ok(Fcm::Util::ClassLoader::load($class), "$prefix: load $class");
+    }
+}
+
+################################################################################
+# Tests loading classes that should fail
+sub test_bad {
+    my $prefix = 'bad';
+    my @CLASSES = ('Foo', 'Bar', 'Baz', 'No::Such::Class', 'Foo');
+    for my $class (@CLASSES) {
+        eval {
+            Fcm::Util::ClassLoader::load($class);
+        };
+        isa_ok($@, 'Fcm::Exception', "$prefix: load $class");
+    }
+}
+
+__END__
Index: trunk/NEMOGCM/EXTERNAL/svn_tools/svn_load_dirs.pl
===================================================================
--- trunk/NEMOGCM/EXTERNAL/svn_tools/svn_load_dirs.pl	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/svn_tools/svn_load_dirs.pl	(revision 2528)
@@ -0,0 +1,2049 @@
+#!/usr/bin/perl -w
+
+# Copyright (c) 2002,2003,2004,2005,2006,2007,2009 Dolby.  All rights reserved.
+#
+# Licensed under the Academic Free License version 3.0.  See LICENSE_AFL3.txt
+# or http://www.opensource.org/licenses/academic.php for a copy of the license
+# text.
+
+# $HeadURL: http://svn.apache.org/repos/asf/subversion/branches/1.6.x/contrib/client-side/svn_load_dirs/svn_load_dirs.pl.in $
+# $LastChangedDate: 2009-10-12 12:57:16 +0000 (Mon, 12 Oct 2009) $
+# $LastChangedBy: hwright $
+# $LastChangedRevision: 880030 $
+
+$| = 1;
+
+use strict;
+use Carp;
+use Cwd;
+use Digest::MD5  2.20;
+use File::Copy   2.03;
+use File::Find;
+use File::Path   1.0404;
+use File::Temp   0.12   qw(tempdir tempfile);
+use Getopt::Long 2.25;
+use Text::Wrap;
+use URI          1.17;
+use English;
+
+$Text::Wrap::columns = 72;
+
+# Specify the location of the svn command.
+my $svn = '/sw/bin/svn';
+
+# Process the command line options.
+
+# The base URL for the portion of the repository to work in.  Note
+# that this does not have to be the root of the subversion repository,
+# it can point to a subdirectory in the repository.
+my $repos_base_url;
+
+# The relative path from the repository base URL to work in to the
+# directory to load the input directories into.
+my $repos_load_rel_path;
+
+# To specify where tags, which are simply copies of the imported
+# directory, should be placed relative to the repository base URL, use
+# the -t command line option.  This value must contain regular
+# expressions that match portions of the input directory names to
+# create an unique tag for each input directory.  The regular
+# expressions are surrounded by a specified character to distinguish
+# the regular expression from the normal directory path.
+my $opt_import_tag_location;
+
+# Do not ask for any user input.  Just go ahead and do everything.
+my $opt_no_user_input;
+
+# Do not automatically set the svn:executable property based on the
+# file's exe bit.
+my $opt_no_auto_exe;
+
+# Username to use for commits.
+my $opt_svn_username;
+
+# Password to use for commits.
+my $opt_svn_password;
+
+# Verbosity level.
+my $opt_verbose;
+
+# Path to already checked-out working copy.
+my $opt_existing_wc_dir;
+
+# List of filename patterns to ignore (as in .subversion/config's
+# "global-ignores" option).
+my $opt_glob_ignores;
+
+# This is the character used to separate regular expressions occuring
+# in the tag directory path from the path itself.
+my $REGEX_SEP_CHAR = '@';
+
+# This specifies a configuration file that contains a list of regular
+# expressions to check against a file and the properties to set on
+# matching files.
+my $property_config_filename;
+
+GetOptions('no_user_input'           => \$opt_no_user_input,
+           'no_auto_exe'             => \$opt_no_auto_exe,
+           'property_cfg_filename=s' => \$property_config_filename,
+           'svn_password=s'          => \$opt_svn_password,
+           'svn_username=s'          => \$opt_svn_username,
+           'tag_location=s'          => \$opt_import_tag_location,
+           'verbose+'                => \$opt_verbose,
+           'wc=s'                    => \$opt_existing_wc_dir,
+           'glob_ignores=s'          => \$opt_glob_ignores)
+  or &usage;
+&usage("$0: too few arguments") if @ARGV < 2;
+
+$repos_base_url      = shift;
+$repos_load_rel_path = shift;
+
+# Check that the repository base URL and the import directories do not
+# contain any ..'s.
+if ($repos_base_url =~ /\.{2}/)
+  {
+    die "$0: repos base URL $repos_base_url cannot contain ..'s.\n";
+  }
+if ($repos_load_rel_path =~ /\.{2}/)
+  {
+    die "$0: repos import relative directory path $repos_load_rel_path ",
+        "cannot contain ..'s.\n";
+  }
+
+# If there are no directories listed on the command line, then the
+# directories are read from standard input.  In this case, the
+# -no_user_input command line option must be specified.
+if (!@ARGV and !$opt_no_user_input)
+  {
+    &usage("$0: must use -no_user_input if no dirs listed on command line.");
+  }
+
+# The tag option cannot be used when directories are read from
+# standard input because tags may collide and no user input can be
+# taken to verify that the input is ok.
+if (!@ARGV and $opt_import_tag_location)
+  {
+    &usage("$0: cannot use -tag_location when dirs are read from stdin.");
+  }
+
+# If the tag directory is set, then the import directory cannot be '.'.
+if (defined $opt_import_tag_location and $repos_load_rel_path eq '.')
+  {
+    &usage("$0: cannot set import_dir to '.' and use -t command line option.");
+  }
+
+# Set the svn command line options that are used anytime svn connects
+# to the repository.
+my @svn_use_repos_cmd_opts;
+&set_svn_use_repos_cmd_opts($opt_svn_username, $opt_svn_password);
+
+# Check that the tag directories do not contain any ..'s.  Also, the
+# import and tag directories cannot be absolute.
+if (defined $opt_import_tag_location and $opt_import_tag_location =~ /\.{2}/)
+  {
+    die "$0: repos tag relative directory path $opt_import_tag_location ",
+        "cannot contain ..'s.\n";
+  }
+if ($repos_load_rel_path =~ m|^/|)
+  {
+    die "$0: repos import relative directory path $repos_load_rel_path ",
+        "cannot start with /.\n";
+  }
+if (defined $opt_import_tag_location and $opt_import_tag_location =~ m|^/|)
+  {
+    die "$0: repos tagrelative directory path $opt_import_tag_location ",
+        "cannot start with /.\n";
+  }
+
+if (defined $opt_existing_wc_dir)
+  {
+    unless (-e $opt_existing_wc_dir)
+      {
+        die "$0: working copy '$opt_existing_wc_dir' does not exist.\n";
+      }
+
+    unless (-d _)
+      {
+        die "$0: working copy '$opt_existing_wc_dir' is not a directory.\n";
+      }
+
+    unless (-d "$opt_existing_wc_dir/.svn")
+      {
+        die "$0: working copy '$opt_existing_wc_dir' does not have .svn ",
+            "directory.\n";
+      }
+
+    $opt_existing_wc_dir = Cwd::abs_path($opt_existing_wc_dir)
+  }
+
+# If no glob_ignores specified, try to deduce from config file,
+# or use the default below.
+my $ignores_str =
+    '*.o *.lo *.la #*# .*.rej *.rej .*~ *~ .#* .DS_Store';
+
+if ( defined $opt_glob_ignores)
+  {
+    $ignores_str = $opt_glob_ignores;
+  }
+elsif ( -f "$ENV{HOME}/.subversion/config" )
+  {
+    open my $conf, "$ENV{HOME}/.subversion/config";
+    while (<$conf>)
+      {
+        if ( /^global-ignores\s*=\s*(.*?)\s*$/ )
+          {
+	    $ignores_str = $1;
+            last;
+          }
+      }
+  }
+
+my @glob_ignores = map
+                     {
+                       s/\./\\\./g; s/\*/\.\*/g; "^$_\$";
+                     } split(/\s+/, $ignores_str);
+unshift @glob_ignores, '\.svn$';
+
+# Convert the string URL into a URI object.
+$repos_base_url    =~ s|/*$||;
+my $repos_base_uri = URI->new($repos_base_url);
+
+# Check that $repos_load_rel_path is not a directory here implying
+# that a command line option was forgotten.
+if ($repos_load_rel_path ne '.' and -d $repos_load_rel_path)
+  {
+    die "$0: import_dir '$repos_load_rel_path' is a directory.\n";
+  }
+
+# The remaining command line arguments should be directories.  Check
+# that they all exist and that there are no duplicates.
+if (@ARGV)
+  {
+    my %dirs;
+    foreach my $dir (@ARGV)
+      {
+        unless (-e $dir)
+          {
+            die "$0: directory '$dir' does not exist.\n";
+          }
+
+        unless (-d _)
+          {
+            die "$0: directory '$dir' is not a directory.\n";
+          }
+
+        if ($dirs{$dir})
+          {
+            die "$0: directory '$dir' is listed more than once on command ",
+                "line.\n";
+          }
+        $dirs{$dir} = 1;
+      }
+  }
+
+# Create the tag locations and print them for the user to review.
+# Check that there are no duplicate tags.
+my %load_tags;
+if (@ARGV and defined $opt_import_tag_location)
+  {
+    my %seen_tags;
+
+    foreach my $load_dir (@ARGV)
+      {
+        my $load_tag = &get_tag_dir($load_dir);
+
+        print "Directory $load_dir will be tagged as $load_tag\n";
+
+        if ($seen_tags{$load_tag})
+          {
+            die "$0: duplicate tag generated.\n";
+          }
+        $seen_tags{$load_tag} = 1;
+
+        $load_tags{$load_dir} = $load_tag;
+      }
+
+    exit 0 unless &get_answer("Please examine identified tags.  Are they " .
+                              "acceptable? (Y/n) ", 'ny', 1);
+    print "\n";
+  }
+
+# Load the property configuration filename, if one was specified, into
+# an array of hashes, where each hash contains a regular expression
+# and a property to apply to the file if the regular expression
+# matches.
+my @property_settings;
+if (defined $property_config_filename and length $property_config_filename)
+  {
+    open(CFG, $property_config_filename)
+      or die "$0: cannot open '$property_config_filename' for reading: $!\n";
+
+    my $ok = 1;
+
+    while (my $line = <CFG>)
+      {
+        next if $line =~ /^\s*$/;
+        next if $line =~ /^\s*#/;
+
+        # Split the input line into words taking into account that
+        # single or double quotes may define a single word with
+        # whitespace in it.  The format for the file is
+        # regex control property_name property_value
+        my @line = &split_line($line);
+        next if @line == 0;
+
+        unless (@line == 2 or @line == 4)
+          {
+            warn "$0: line $. of '$property_config_filename' has to have 2 ",
+                 "or 4 columns.\n";
+            $ok = 0;
+            next;
+          }
+        my ($regex, $control, $property_name, $property_value) = @line;
+
+        unless ($control eq 'break' or $control eq 'cont')
+          {
+            warn "$0: line $. of '$property_config_filename' has illegal ",
+                 "value for column 3 '$control', must be 'break' or 'cont'.\n";
+            $ok = 0;
+            next;
+          }
+
+        # Compile the regular expression.
+        my $re;
+        eval { $re = qr/$regex/i };
+        if ($@)
+          {
+            warn "$0: line $. of '$property_config_filename' regex '$regex' ",
+                 "does not compile:\n$@\n";
+            $ok = 0;
+            next;
+          }
+
+        push(@property_settings, {name    => $property_name,
+                                  value   => $property_value,
+                                  control => $control,
+                                  re      => $re});
+      }
+    close(CFG)
+      or warn "$0: error in closing '$property_config_filename' for ",
+              "reading: $!\n";
+
+    exit 1 unless $ok;
+  }
+
+# Check that the svn base URL works by running svn log on it.  Only
+# get the HEAD revision log message; there's no need to waste
+# bandwidth seeing all of the log messages.
+print "Checking that the base URL is a Subversion repository.\n";
+read_from_process($svn, 'log', '-r', 'HEAD',
+                  @svn_use_repos_cmd_opts, $repos_base_uri);
+print "\n";
+
+my $orig_cwd = cwd;
+
+# The first step is to determine the root of the svn repository.  Do
+# this with the svn log command.  Take the svn_url hostname and port
+# as the initial url and append to it successive portions of the final
+# path until svn log succeeds.
+print "Finding the root URL of the Subversion repository.\n";
+my $repos_root_uri;
+my $repos_root_uri_path;
+my $repos_base_path_segment;
+{
+  my $r = $repos_base_uri->clone;
+  my @path_segments            = grep { length($_) } $r->path_segments;
+  my @repos_base_path_segments = @path_segments;
+  unshift(@path_segments, '');
+  $r->path('');
+  my @r_path_segments;
+
+  while (@path_segments)
+    {
+      $repos_root_uri_path = shift @path_segments;
+      push(@r_path_segments, $repos_root_uri_path);
+      $r->path_segments(@r_path_segments);
+      if (safe_read_from_pipe($svn, 'log', '-r', 'HEAD',
+                              @svn_use_repos_cmd_opts, $r) == 0)
+        {
+          $repos_root_uri = $r;
+          last;
+        }
+      shift @repos_base_path_segments;
+    }
+  $repos_base_path_segment = join('/', @repos_base_path_segments);
+}
+
+if ($repos_root_uri)
+  {
+    print "Determined that the svn root URL is $repos_root_uri.\n\n";
+  }
+else
+  {
+    die "$0: cannot determine root svn URL.\n";
+  }
+
+# Create a temporary directory for svn to work in.
+my $temp_dir = tempdir( "svn_load_dirs_XXXXXXXXXX", TMPDIR => 1 );
+
+# Put in a signal handler to clean up any temporary directories.
+sub catch_signal {
+  my $signal = shift;
+  warn "$0: caught signal $signal.  Quitting now.\n";
+  exit 1;
+}
+
+$SIG{HUP}  = \&catch_signal;
+$SIG{INT}  = \&catch_signal;
+$SIG{TERM} = \&catch_signal;
+$SIG{PIPE} = \&catch_signal;
+
+# Create an object that when DESTROY'ed will delete the temporary
+# directory.  The CLEANUP flag to tempdir should do this, but they
+# call rmtree with 1 as the last argument which takes extra security
+# measures that do not clean up the .svn directories.
+my $temp_dir_cleanup = Temp::Delete->new;
+
+# Determine the native end of line style for this system.  Do this the
+# most portable way, by writing a file with a single \n in non-binary
+# mode and then reading the file in binary mode.
+my $native_eol = &determine_native_eol;
+
+# Check if all the directories exist to load the directories into the
+# repository.  If not, ask if they should be created.  For tags, do
+# not create the tag directory itself, that is done on the svn cp.
+{
+  print "Finding if any directories need to be created in repository.\n";
+
+  my @dirs_to_create;
+  my @urls_to_create;
+  my %seen_dir;
+  my @load_tags_without_last_segment;
+
+  # Assume that the last portion of the tag directory contains the
+  # version number and remove it from the directories to create,
+  # because the tag directory will be created by svn cp.
+  foreach my $load_tag (sort values %load_tags)
+    {
+      # Skip this tag if there is only one segment in its name.
+      my $index = rindex($load_tag, '/');
+      next if $index == -1;
+
+      # Trim off the last segment and record the result.
+      push(@load_tags_without_last_segment, substr($load_tag, 0, $index));
+    }
+  
+  foreach my $dir ($repos_load_rel_path, @load_tags_without_last_segment)
+    {
+      next unless length $dir;
+      my $d = '';
+      foreach my $segment (split('/', $dir))
+        {
+          $d = length $d ? "$d/$segment" : $segment;
+          my $url = "$repos_base_url/$d";
+          unless ($seen_dir{$d})
+            {
+              $seen_dir{$d} = 1;
+              if (safe_read_from_pipe($svn, 'log', '-r', 'HEAD',
+                                      @svn_use_repos_cmd_opts, $url) != 0)
+                {
+                  push(@dirs_to_create, $d);
+                  push(@urls_to_create, $url);
+                }
+            }
+        }
+    }
+
+  if (@dirs_to_create)
+    {
+      print "The following directories do not exist and need to exist:\n";
+      foreach my $dir (@dirs_to_create)
+        {
+          print "  $dir\n";
+        }
+      exit 0 unless &get_answer("You must add them now to load the " .
+                                "directories.  Continue (Y/n)? ", 'ny', 1);
+
+      my $message = "Create directories to load project into.\n\n";
+
+      foreach my $dir (@dirs_to_create)
+        {
+          if (length $repos_base_path_segment)
+            {
+              $message .= "* $repos_base_path_segment/$dir: New directory.\n";
+            }
+          else
+            {
+              $message .= "* $dir: New directory.\n";
+            }
+        }
+      $message = wrap('', '  ', $message);
+
+      read_from_process($svn, 'mkdir', @svn_use_repos_cmd_opts,
+                        '-m', $message, @urls_to_create);
+    }
+  else
+    {
+      print "No directories need to be created to prepare repository.\n";
+    }
+}
+
+# Either checkout a new working copy from the repository or use an
+# existing working copy.
+if (defined $opt_existing_wc_dir)
+  {
+    # Update an already existing working copy.
+    print "Not checking out anything; using existing working directory at\n";
+    print "$opt_existing_wc_dir\n";
+
+    chdir($opt_existing_wc_dir)
+      or die "$0: cannot chdir '$opt_existing_wc_dir': $!\n";
+
+    read_from_process($svn, 'update', @svn_use_repos_cmd_opts);
+  }
+else
+  {
+    # Check out the svn repository starting at the svn URL into a
+    # fixed directory name.
+    my $checkout_dir_name = 'my_import_wc';
+
+    # Check out only the directory being imported to, otherwise the
+    # checkout of the entire base URL can be very huge, if it contains
+    # a large number of tags.
+    my $checkout_url;
+    if ($repos_load_rel_path eq '.')
+      {
+        $checkout_url = $repos_base_url;
+      }
+    else
+      {
+        $checkout_url = "$repos_base_url/$repos_load_rel_path";
+      }
+
+    print "Checking out $checkout_url into $temp_dir/$checkout_dir_name\n";
+
+    chdir($temp_dir)
+      or die "$0: cannot chdir '$temp_dir': $!\n";
+
+    read_from_process($svn, 'checkout',
+                      @svn_use_repos_cmd_opts,
+                      $checkout_url, $checkout_dir_name);
+
+    chdir($checkout_dir_name)
+      or die "$0: cannot chdir '$checkout_dir_name': $!\n";
+  }
+
+# At this point, the current working directory is the top level
+# directory of the working copy.  Record the absolute path to this
+# location because the script will chdir back here later on.
+my $wc_import_dir_cwd = cwd;
+
+# Set up the names for the path to the import and tag directories.
+my $repos_load_abs_path;
+if ($repos_load_rel_path eq '.')
+  {
+    $repos_load_abs_path = length($repos_base_path_segment) ?
+                           $repos_base_path_segment : "/";
+  }
+else
+  {
+    $repos_load_abs_path = length($repos_base_path_segment) ?
+                           "$repos_base_path_segment/$repos_load_rel_path" :
+                           $repos_load_rel_path;
+  }
+
+# Now go through each source directory and copy each file from the
+# source directory to the target directory.  For new target files, add
+# them to svn.  For files that no longer exist, delete them.
+my $print_rename_message = 1;
+my @load_dirs            = @ARGV;
+while (defined (my $load_dir = &get_next_load_dir))
+  {
+    my $load_tag = $load_tags{$load_dir};
+
+    if (defined $load_tag)
+      {
+        print "\nLoading $load_dir and will save in tag $load_tag.\n";
+      }
+    else
+      {
+        print "\nLoading $load_dir.\n";
+      }
+
+    # The first hash is keyed by the old name in a rename and the
+    # second by the new name.  The last variable contains a list of
+    # old and new filenames in a rename.
+    my %rename_from_files;
+    my %rename_to_files;
+    my @renamed_filenames;
+
+    unless ($opt_no_user_input)
+      {
+        my $repeat_loop;
+        do
+          {
+            $repeat_loop = 0;
+
+            my %add_files;
+            my %del_files;
+
+            # Get the list of files and directories in the repository
+            # working copy.  This hash is called %del_files because
+            # each file or directory will be deleted from the hash
+            # using the list of files and directories in the source
+            # directory, leaving the files and directories that need
+            # to be deleted.
+            %del_files = &recursive_ls_and_hash($wc_import_dir_cwd);
+
+            # This anonymous subroutine finds all the files and
+            # directories in the directory to load.  It notes the file
+            # type and for each file found, it deletes it from
+            # %del_files.
+            my $wanted = sub
+              {
+                s#^\./##;
+                return if $_ eq '.';
+
+                my $source_path = $_;
+                my $dest_path   = "$wc_import_dir_cwd/$_";
+
+                my ($source_type) = &file_info($source_path);
+                my ($dest_type)   = &file_info($dest_path);
+
+                # Fail if the destination type exists but is of a
+                # different type of file than the source type.
+                if ($dest_type ne '0' and $source_type ne $dest_type)
+                  {
+                    die "$0: does not handle changing source and destination ",
+                        "type for '$source_path'.\n";
+                  }
+
+                if ($source_type ne 'd' and
+                    $source_type ne 'f' and
+                    $source_type ne 'l')
+                  {
+                    warn "$0: skipping loading file '$source_path' of type ",
+                         "'$source_type'.\n";
+                    unless ($opt_no_user_input)
+                      {
+                        print STDERR "Press return to continue: ";
+                        <STDIN>;
+                      }
+                    return;
+                  }
+
+                unless (defined delete $del_files{$source_path})
+                  {
+                    $add_files{$source_path}{type} = $source_type;
+                  }
+              };
+
+            # Now change into the directory containing the files to
+            # load.  First change to the original directory where this
+            # script was run so that if the specified directory is a
+            # relative directory path, then the script can change into
+            # it.
+            chdir($orig_cwd)
+              or die "$0: cannot chdir '$orig_cwd': $!\n";
+            chdir($load_dir)
+              or die "$0: cannot chdir '$load_dir': $!\n";
+
+            find({no_chdir   => 1,
+                  preprocess => sub { sort { $b cmp $a }
+                                      grep { $_ !~ /^[._]svn$/ } @_ },
+                  wanted     => $wanted
+                 }, '.');
+
+            # At this point %add_files contains the list of new files
+            # and directories to be created in the working copy tree
+            # and %del_files contains the files and directories that
+            # need to be deleted.  Because there may be renames that
+            # have taken place, give the user the opportunity to
+            # rename any deleted files and directories to ones being
+            # added.
+            my @add_files = sort keys %add_files;
+            my @del_files = sort keys %del_files;
+
+            # Because the source code management system may keep the
+            # original renamed file or directory in the working copy
+            # until a commit, remove them from the list of deleted
+            # files or directories.
+            &filter_renamed_files(\@del_files, \%rename_from_files);
+
+            # Now change into the working copy directory in case any
+            # renames need to be performed.
+            chdir($wc_import_dir_cwd)
+              or die "$0: cannot chdir '$wc_import_dir_cwd': $!\n";
+
+            # Only do renames if there are both added and deleted
+            # files and directories.
+            if (@add_files and @del_files)
+              {
+                my $max = @add_files > @del_files ? @add_files : @del_files;
+
+                # Print the files that have been added and deleted.
+                # Find the deleted file with the longest name and use
+                # that for the width of the filename column.  Add one
+                # to the filename width to let the directory /
+                # character be appended to a directory name.
+                my $line_number_width = 4;
+                my $filename_width    = 0;
+                foreach my $f (@del_files)
+                  {
+                    my $l = length($f);
+                    $filename_width = $l if $l > $filename_width;
+                  }
+                ++$filename_width;
+                my $printf_format = "%${line_number_width}d";
+
+                if ($print_rename_message)
+                  {
+                    $print_rename_message = 0;
+                    print "\n",
+                      "The following table lists files and directories that\n",
+                      "exist in either the Subversion repository or the\n",
+                      "directory to be imported but not both.  You now have\n",
+                      "the opportunity to match them up as renames instead\n",
+                      "of deletes and adds.  This is a Good Thing as it'll\n",
+                      "make the repository take less space.\n\n",
+                      "The left column lists files and directories that\n",
+                      "exist in the Subversion repository and do not exist\n",
+                      "in the directory being imported.  The right column\n",
+                      "lists files and directories that exist in the\n",
+                      "directory being imported.  Match up a deleted item\n",
+                      "from the left column with an added item from the\n",
+                      "right column.  Note the line numbers on the left\n",
+                      "which you type into this script to have a rename\n",
+                      "performed.\n";
+                  }
+
+                # Sort the added and deleted files and directories by
+                # the lowercase versions of their basenames instead of
+                # their complete path, which makes finding files that
+                # were moved into different directories easier to
+                # match up.
+                @add_files = map { $_->[0] }
+                             sort { $a->[1] cmp $b->[1] }
+                             map { [$_->[0], lc($_->[1])] }
+                             map { [$_, m#([^/]+)$#] }
+                             @add_files;
+                @del_files = map { $_->[0] }
+                             sort { $a->[1] cmp $b->[1] }
+                             map { [$_->[0], lc($_->[1])] }
+                             map { [$_, m#([^/]+)$#] }
+                             @del_files;
+
+              RELIST:
+
+                for (my $i=0; $i<$max; ++$i)
+                  {
+                    my $add_filename = '';
+                    my $del_filename = '';
+                    if ($i < @add_files)
+                      {
+                        $add_filename = $add_files[$i];
+                        if ($add_files{$add_filename}{type} eq 'd')
+                          {
+                            $add_filename .= '/';
+                          }
+                      }
+                    if ($i < @del_files)
+                      {
+                        $del_filename = $del_files[$i];
+                        if ($del_files{$del_filename}{type} eq 'd')
+                          {
+                            $del_filename .= '/';
+                          }
+                      }
+
+                    if ($i % 22 == 0)
+                      {
+                        print
+                          "\n",
+                          " " x $line_number_width,
+                          " ",
+                          "Deleted", " " x ($filename_width-length("Deleted")),
+                          " ",
+                          "Added\n";
+                      }
+
+                    printf $printf_format, $i;
+                    print  " ", $del_filename,
+                           "_" x ($filename_width - length($del_filename)),
+                           " ", $add_filename, "\n";
+
+                    if (($i+1) % 22 == 0)
+                      {
+                        unless (&get_answer("Continue printing (Y/n)? ",
+                                            'ny', 1))
+                          {
+                            last;
+                          }
+                      }
+                  }
+
+                # Get the feedback from the user.
+                my $line;
+                my $add_filename;
+                my $add_index;
+                my $del_filename;
+                my $del_index;
+                my $got_line = 0;
+                do {
+                  print "Enter two indexes for each column to rename, ",
+                        "(R)elist, or (F)inish: ";
+                  $line = <STDIN>;
+                  $line = '' unless defined $line;
+                  if ($line =~ /^R$/i )
+                    {
+                      goto RELIST;
+                    }
+                  
+                  if ($line =~ /^F$/i)
+                    {
+                      $got_line = 1;
+                    }
+                  elsif ($line =~ /^(\d+)\s+(\d+)$/)
+                    {
+                      print "\n";
+
+                      $del_index = $1;
+                      $add_index = $2;
+                      if ($del_index >= @del_files)
+                        {
+                          print "Delete index $del_index is larger than ",
+                                "maximum index of ", scalar @del_files - 1,
+                                ".\n";
+                          $del_index = undef;
+                        }
+                      if ($add_index > @add_files)
+                        {
+                          print "Add index $add_index is larger than maximum ",
+                                "index of ", scalar @add_files - 1, ".\n";
+                          $add_index = undef;
+                        }
+                      $got_line = defined $del_index && defined $add_index;
+
+                      # Check that the file or directory to be renamed
+                      # has the same file type.
+                      if ($got_line)
+                        {
+                          $add_filename = $add_files[$add_index];
+                          $del_filename = $del_files[$del_index];
+                          if ($add_files{$add_filename}{type} ne
+                              $del_files{$del_filename}{type})
+                            {
+                              print "File types for $del_filename and ",
+                                    "$add_filename differ.\n";
+                              $got_line = undef;
+                            }
+                        }
+                    }
+                } until ($got_line);
+
+                if ($line !~ /^F$/i)
+                  {
+                    print "Renaming $del_filename to $add_filename.\n";
+
+                    $repeat_loop = 1;
+
+                    # Because subversion cannot rename the same file
+                    # or directory twice, which includes doing a
+                    # rename of a file in a directory that was
+                    # previously renamed, a commit has to be
+                    # performed.  Check if the file or directory being
+                    # renamed now would cause such a problem and
+                    # commit if so.
+                    my $do_commit_now = 0;
+                    foreach my $rename_to_filename (keys %rename_to_files)
+                      {
+                        if (contained_in($del_filename,
+                                         $rename_to_filename,
+                                         $rename_to_files{$rename_to_filename}{type}))
+                          {
+                            $do_commit_now = 1;
+                            last;
+                          }
+                      }
+
+                    if ($do_commit_now)
+                      {
+                        print "Now committing previously run renames.\n";
+                        &commit_renames($load_dir,
+                                        \@renamed_filenames,
+                                        \%rename_from_files,
+                                        \%rename_to_files);
+                      }
+
+                    push(@renamed_filenames, $del_filename, $add_filename);
+                    {
+                      my $d = $del_files{$del_filename};
+                      $rename_from_files{$del_filename} = $d;
+                      $rename_to_files{$add_filename}   = $d;
+                    }
+
+                    # Check that any required directories to do the
+                    # rename exist.
+                    my @add_segments = split('/', $add_filename);
+                    pop(@add_segments);
+                    my $add_dir = '';
+                    my @add_dirs;
+                    foreach my $segment (@add_segments)
+                      {
+                        $add_dir = length($add_dir) ? "$add_dir/$segment" :
+                                                      $segment;
+                        unless (-d $add_dir)
+                          {
+                            push(@add_dirs, $add_dir);
+                          }
+                      }
+
+                    if (@add_dirs)
+                      {
+                        read_from_process($svn, 'mkdir', @add_dirs);
+                      }
+
+                    read_from_process($svn, 'mv',
+                                      $del_filename, $add_filename);
+                  }
+              }
+          } while ($repeat_loop);
+      }
+
+    # If there are any renames that have not been committed, then do
+    # that now.
+    if (@renamed_filenames)
+      {
+        &commit_renames($load_dir,
+                        \@renamed_filenames,
+                        \%rename_from_files,
+                        \%rename_to_files);
+      }
+
+    # At this point all renames have been performed.  Now get the
+    # final list of files and directories in the working copy
+    # directory.  The %add_files hash will contain the list of files
+    # and directories to add to the working copy and %del_files starts
+    # with all the files already in the working copy and gets files
+    # removed that are in the imported directory, which results in a
+    # list of files that should be deleted.  %upd_files holds the list
+    # of files that have been updated.
+    my %add_files;
+    my %del_files = &recursive_ls_and_hash($wc_import_dir_cwd);
+    my %upd_files;
+
+    # This anonymous subroutine copies files from the source directory
+    # to the working copy directory.
+    my $wanted = sub
+      {
+        s#^\./##;
+        return if $_ eq '.';
+
+        my $source_path = $_;
+        my $dest_path   = "$wc_import_dir_cwd/$_";
+
+        my ($source_type, $source_is_exe) = &file_info($source_path);
+        my ($dest_type)                   = &file_info($dest_path);
+
+        return if ($source_type ne 'd' and
+                   $source_type ne 'f' and
+                   $source_type ne 'l');
+
+        # Fail if the destination type exists but is of a different
+        # type of file than the source type.
+        if ($dest_type ne '0' and $source_type ne $dest_type)
+          {
+            die "$0: does not handle changing source and destination type ",
+                "for '$source_path'.\n";
+          }
+
+        # Determine if the file is being added or is an update to an
+        # already existing file using the file's digest.
+        my $del_info = delete $del_files{$source_path};
+        if (defined $del_info)
+          {
+            if (defined (my $del_digest = $del_info->{digest}))
+              {
+                my $new_digest = &digest_hash_file($source_path);
+                if ($new_digest ne $del_digest)
+                  {
+                    print "U   $source_path\n";
+                    $upd_files{$source_path} = $del_info;
+                  }
+              }
+          }
+        else
+          {
+            print "A   $source_path\n";
+            $add_files{$source_path}{type} = $source_type;
+
+            # Create an array reference to hold the list of properties
+            # to apply to this object.
+            unless (defined $add_files{$source_path}{properties})
+              {
+                $add_files{$source_path}{properties} = [];
+              }
+
+            # Go through the list of properties for a match on this
+            # file or directory and if there is a match, then apply
+            # the property to it.
+            foreach my $property (@property_settings)
+              {
+                my $re = $property->{re};
+                if ($source_path =~ $re)
+                  {
+                    my $property_name  = $property->{name};
+                    my $property_value = $property->{value};
+
+                    # The property value may not be set in the
+                    # configuration file, since the user may just want
+                    # to set the control flag.
+                    if (defined $property_name and defined $property_value)
+                      {
+                        # Ignore properties that do not apply to
+                        # directories.
+                        if ($source_type eq 'd')
+                          {
+                            if ($property_name eq 'svn:eol-style' or
+                                $property_name eq 'svn:executable' or
+                                $property_name eq 'svn:keywords' or
+                                $property_name eq 'svn:mime-type')
+                              {
+                                next;
+                              }
+                          }
+
+                        # Ignore properties that do not apply to
+                        # files.
+                        if ($source_type eq 'f')
+                          {
+                            if ($property_name eq 'svn:externals' or
+                                $property_name eq 'svn:ignore')
+                              {
+                                next;
+                              }
+                          }
+
+                        print "Adding to '$source_path' property ",
+                              "'$property_name' with value ",
+                              "'$property_value'.\n";
+
+                        push(@{$add_files{$source_path}{properties}},
+                             $property);
+                      }
+
+                    last if $property->{control} eq 'break';
+                  }
+              }
+          }
+
+        # Add svn:executable to files that have their executable bit
+        # set.
+        if ($source_is_exe and !$opt_no_auto_exe)
+          {
+            print "Adding to '$source_path' property 'svn:executable' with ",
+                  "value '*'.\n";
+            my $property = {name => 'svn:executable', value => '*'};
+            push (@{$add_files{$source_path}{properties}},
+                  $property);
+          }
+
+        # Now make sure the file or directory in the source directory
+        # exists in the repository.
+        if ($source_type eq 'd')
+          {
+            if ($dest_type eq '0')
+              {
+                mkdir($dest_path)
+                  or die "$0: cannot mkdir '$dest_path': $!\n";
+              }
+          }
+        elsif
+          ($source_type eq 'l') {
+            my $link_target = readlink($source_path)
+              or die "$0: cannot readlink '$source_path': $!\n";
+            if ($dest_type eq 'l')
+              {
+                my $old_target = readlink($dest_path)
+                  or die "$0: cannot readlink '$dest_path': $!\n";
+                return if ($old_target eq $link_target);
+                unlink($dest_path)
+                  or die "$0: unlink '$dest_path' failed: $!\n";
+              }
+            symlink($link_target, $dest_path)
+              or die "$0: cannot symlink '$dest_path' to '$link_target': $!\n";
+          }
+        elsif
+          ($source_type eq 'f') {
+            # Only copy the file if the digests do not match.
+            if ($add_files{$source_path} or $upd_files{$source_path})
+              {
+                copy($source_path, $dest_path)
+                  or die "$0: copy '$source_path' to '$dest_path': $!\n";
+              }
+          }
+        else
+          {
+            die "$0: does not handle copying files of type '$source_type'.\n";
+          }
+      };
+
+    # Now change into the directory containing the files to load.
+    # First change to the original directory where this script was run
+    # so that if the specified directory is a relative directory path,
+    # then the script can change into it.
+    chdir($orig_cwd)
+      or die "$0: cannot chdir '$orig_cwd': $!\n";
+    chdir($load_dir)
+      or die "$0: cannot chdir '$load_dir': $!\n";
+
+    find({no_chdir   => 1,
+          preprocess => sub { sort { $b cmp $a }
+                              grep { $_ !~ /^[._]svn$/ } @_ },
+          wanted     => $wanted
+         }, '.');
+
+    # The files and directories that are in %del_files are the files
+    # and directories that need to be deleted.  Because svn will
+    # return an error if a file or directory is deleted in a directory
+    # that subsequently is deleted, first find all directories and
+    # remove from the list any files and directories inside those
+    # directories from this list.  Work through the list repeatedly
+    # working from short to long names so that directories containing
+    # other files and directories will be deleted first.
+    my $repeat_loop;
+    do
+      {
+        $repeat_loop = 0;
+        my @del_files = sort {length($a) <=> length($b) || $a cmp $b}
+                        keys %del_files;
+        &filter_renamed_files(\@del_files, \%rename_from_files);
+        foreach my $file (@del_files)
+          {
+            if ($del_files{$file}{type} eq 'd')
+              {
+                my $dir        = "$file/";
+                my $dir_length = length($dir);
+                foreach my $f (@del_files)
+                  {
+                    next if $file eq $f;
+                    if (length($f) >= $dir_length and
+                        substr($f, 0, $dir_length) eq $dir)
+                      {
+                        print "d   $f\n";
+                        delete $del_files{$f};
+                        $repeat_loop = 1;
+                      }
+                  }
+
+                # If there were any deletions of files and/or
+                # directories inside a directory that will be deleted,
+                # then restart the entire loop again, because one or
+                # more keys have been deleted from %del_files.
+                # Equally important is not to stop this loop if no
+                # deletions have been done, otherwise later
+                # directories that may contain files and directories
+                # to be deleted will not be deleted.
+                last if $repeat_loop;
+              }
+          }
+      } while ($repeat_loop);
+
+    # What is left are files that are not in any directories to be
+    # deleted and directories to be deleted.  To delete the files,
+    # deeper files and directories must be deleted first.  Because we
+    # have a hash keyed by remaining files and directories to be
+    # deleted, instead of trying to figure out which directories and
+    # files are contained in other directories, just reverse sort by
+    # the path length and then alphabetically.
+    my @del_files = sort {length($b) <=> length($a) || $a cmp $b }
+                    keys %del_files;
+    &filter_renamed_files(\@del_files, \%rename_from_files);
+    foreach my $file (@del_files)
+      {
+        print "D   $file\n";
+      }
+
+    # Now change back to the trunk directory and run the svn commands.
+    chdir($wc_import_dir_cwd)
+      or die "$0: cannot chdir '$wc_import_dir_cwd': $!\n";
+
+    # If any of the added files have the svn:eol-style property set,
+    # then pass -b to diff, otherwise diff may fail because the end of
+    # lines have changed and the source file and file in the
+    # repository will not be identical.
+    my @diff_ignore_space_changes;
+
+    if (keys %add_files)
+      {
+        my @add_files = sort {length($a) <=> length($b) || $a cmp $b}
+                        keys %add_files;
+        my $target_filename = &make_targets_file(@add_files);
+        read_from_process($svn, 'add', '-N', '--targets', $target_filename);
+        unlink($target_filename);
+
+        # Add properties on the added files.
+        foreach my $add_file (@add_files)
+          {
+            foreach my $property (@{$add_files{$add_file}{properties}})
+              {
+                my $property_name  = $property->{name};
+                my $property_value = $property->{value};
+
+                if ($property_name eq 'svn:eol-style')
+                  {
+                    @diff_ignore_space_changes = ('-b');
+                  }
+                
+                # Write the value to a temporary file in case it's multi-line
+                my ($handle, $tmpfile) = tempfile(DIR => $temp_dir);
+                print $handle $property_value;
+                close($handle);
+
+                read_from_process($svn,
+                                  'propset',
+                                  $property_name,
+                                  '--file',
+                                  $tmpfile,
+                                  $add_file);
+              }
+          }
+      }
+    if (@del_files)
+      {
+        my $target_filename = &make_targets_file(@del_files);
+        read_from_process($svn, 'rm', '--targets', $target_filename);
+        unlink($target_filename);
+      }
+
+    # Go through the list of updated files and check the svn:eol-style
+    # property.  If it is set to native, then convert all CR, CRLF and
+    # LF's in the file to the native end of line characters.  Also,
+    # modify diff's command line so that it will ignore the change in
+    # end of line style.
+    if (keys %upd_files)
+      {
+        my @upd_files = sort {length($a) <=> length($b) || $a cmp $b}
+                        keys %upd_files;
+        foreach my $upd_file (@upd_files)
+          {
+            # Always append @BASE to a filename in case they contain a
+            # @ character, in which case the Subversion command line
+            # client will attempt to parse the characters after the @
+            # as a revision and most likely fail, or if the characters
+            # after the @ are a valid revision, then it'll possibly
+            # get the incorrect information.  So always append @BASE
+            # and any preceding @'s will be treated normally and the
+            # correct information will be retrieved.
+            my @command = ($svn,
+                           'propget',
+                           'svn:eol-style',
+                           "$upd_file\@BASE");
+            my @lines = read_from_process(@command);
+            next unless @lines;
+            if (@lines > 1)
+              {
+                warn "$0: '@command' returned more than one line of output: ",
+                  "'@lines'.\n";
+                next;
+              }
+
+            my $eol_style = $lines[0];
+            if ($eol_style eq 'native')
+              {
+                @diff_ignore_space_changes = ('-b');
+                if (&convert_file_to_native_eol($upd_file))
+                  {
+                    print "Native eol-style conversion modified $upd_file.\n";
+                  }
+              }
+          }
+      }
+
+    my $message = wrap('', '', "Load $load_dir into $repos_load_abs_path.\n");
+    read_from_process($svn, 'commit',
+                      @svn_use_repos_cmd_opts,
+                      '-m', $message);
+
+    # If an update is not run now after a commit, then some file and
+    # directory paths will have an older revisions associated with
+    # them and any future commits will fail because they are out of
+    # date.
+    read_from_process($svn, 'update', @svn_use_repos_cmd_opts);
+
+    # Now remove any files and directories to be deleted in the
+    # repository.
+    if (@del_files)
+      {
+        rmtree(\@del_files, 1, 0);
+      }
+
+    # Now make the tag by doing a copy in the svn repository itself.
+    if (defined $load_tag)
+      {
+        my $repos_tag_abs_path = length($repos_base_path_segment) ?
+                                 "$repos_base_path_segment/$load_tag" :
+                                 $load_tag;
+
+        my $from_url = $repos_load_rel_path eq '.' ?
+                       $repos_load_rel_path :
+                       "$repos_base_url/$repos_load_rel_path";
+        my $to_url   = "$repos_base_url/$load_tag";
+
+        $message     = wrap("",
+                            "",
+                            "Tag $repos_load_abs_path as " .
+                            "$repos_tag_abs_path.\n");
+        read_from_process($svn, 'cp', @svn_use_repos_cmd_opts,
+                          '-m', $message, $from_url, $to_url);
+
+        # Now check out the tag and run a recursive diff between the
+        # original source directory and the tag for a consistency
+        # check.
+        my $checkout_dir_name = "my_tag_wc_named_$load_tag";
+        print "Checking out $to_url into $temp_dir/$checkout_dir_name\n";
+
+        chdir($temp_dir)
+          or die "$0: cannot chdir '$temp_dir': $!\n";
+
+        read_from_process($svn, 'checkout',
+                          @svn_use_repos_cmd_opts,
+                          $to_url, $checkout_dir_name);
+
+        chdir($checkout_dir_name)
+          or die "$0: cannot chdir '$checkout_dir_name': $!\n";
+
+        chdir($orig_cwd)
+          or die "$0: cannot chdir '$orig_cwd': $!\n";
+        read_from_process('diff', '-u', @diff_ignore_space_changes,
+                          '-x', '.svn',
+                          '-r', $load_dir, "$temp_dir/$checkout_dir_name");
+      }
+  }
+
+exit 0;
+
+sub usage
+{
+  warn "@_\n" if @_;
+  die "usage: $0 [options] svn_url svn_import_dir [dir_v1 [dir_v2 [..]]]\n",
+      "  svn_url        is the file:// or http:// URL of the svn repository\n",
+      "  svn_import_dir is the path relative to svn_url where to load dirs\n",
+      "  dir_v1 ..      list dirs to import otherwise read from stdin\n",
+      "options are\n",
+      "  -no_user_input don't ask yes/no questions and assume yes answer\n",
+      "  -no_auto_exe   don't set svn:executable for executable files\n",
+      "  -p filename    table listing properties to apply to matching files\n",
+      "  -svn_username  username to perform commits as\n",
+      "  -svn_password  password to supply to svn commit\n",
+      "  -t tag_dir     create a tag copy in tag_dir, relative to svn_url\n",
+      "  -v             increase program verbosity, multiple -v's allowed\n",
+      "  -wc path       use the already checked-out working copy at path\n",
+      "                 instead of checkout out a fresh working copy\n",
+      "  -glob_ignores  List of filename patterns to ignore (as in svn's\n",
+      "                 global-ignores config option)\n";
+}
+
+# Get the next directory to load, either from the command line or from
+# standard input.
+my $get_next_load_dir_init = 0;
+my @get_next_load_dirs;
+sub get_next_load_dir
+{
+  if (@ARGV)
+    {
+      unless ($get_next_load_dir_init)
+        {
+          $get_next_load_dir_init = 1;
+          @get_next_load_dirs     = @ARGV;
+        }
+      return shift @get_next_load_dirs;
+    }
+
+  if ($opt_verbose)
+    {
+      print "Waiting for next directory to import on standard input:\n";
+    }
+  my $line = <STDIN>;
+
+  print "\n" if $opt_verbose;
+
+  chomp $line;
+  if ($line =~ m|(\S+)\s+(\S+)|)
+    {
+      $line = $1;
+      set_svn_use_repos_cmd_opts($2, $opt_svn_password);
+    }
+  $line;
+}
+
+# This constant stores the commonly used string to indicate that a
+# subroutine has been passed an incorrect number of arguments.
+use vars qw($INCORRECT_NUMBER_OF_ARGS);
+$INCORRECT_NUMBER_OF_ARGS = "passed incorrect number of arguments.\n";
+
+# Creates a temporary file in the temporary directory and stores the
+# arguments in it for use by the svn --targets command line option.
+# If any part of the file creation failed, exit the program, as
+# there's no workaround.  Use a unique number as a counter to the
+# files.
+my $make_targets_file_counter;
+sub make_targets_file
+{
+  unless (@_)
+    {
+      confess "$0: make_targets_file $INCORRECT_NUMBER_OF_ARGS";
+    }
+
+  $make_targets_file_counter = 1 unless defined $make_targets_file_counter;
+
+  my $filename = sprintf "%s/targets.%05d",
+                 $temp_dir,
+                 $make_targets_file_counter;
+  ++$make_targets_file_counter;
+
+  open(TARGETS, ">$filename")
+    or die "$0: cannot open '$filename' for writing: $!\n";
+
+  foreach my $file (@_)
+    {
+      print TARGETS "$file\n";
+    }
+
+  close(TARGETS)
+    or die "$0: error in closing '$filename' for writing: $!\n";
+
+  $filename;
+}
+
+# Set the svn command line options that are used anytime svn connects
+# to the repository.
+sub set_svn_use_repos_cmd_opts
+{
+  unless (@_ == 2)
+    {
+      confess "$0: set_svn_use_repos_cmd_opts $INCORRECT_NUMBER_OF_ARGS";
+    }
+
+  my $username = shift;
+  my $password = shift;
+
+  @svn_use_repos_cmd_opts = ('--non-interactive');
+  if (defined $username and length $username)
+    {
+      push(@svn_use_repos_cmd_opts, '--username', $username);
+    }
+  if (defined $password)
+    {
+      push(@svn_use_repos_cmd_opts, '--password', $password);
+    }
+}
+
+sub get_tag_dir
+{
+  unless (@_ == 1)
+    {
+      confess "$0: get_tag_dir $INCORRECT_NUMBER_OF_ARGS";
+    }
+
+  my $load_dir = shift;
+
+  # Take the tag relative directory, search for pairs of
+  # REGEX_SEP_CHAR's and use the regular expression inside the pair to
+  # put in the tag directory name.
+  my $tag_location = $opt_import_tag_location;
+  my $load_tag     = '';
+  while ((my $i = index($tag_location, $REGEX_SEP_CHAR)) >= 0)
+    {
+      $load_tag .= substr($tag_location, 0, $i, '');
+      substr($tag_location, 0, 1, '');
+      my $j = index($tag_location, $REGEX_SEP_CHAR);
+      if ($j < 0)
+        {
+          die "$0: -t value '$opt_import_tag_location' does not have ",
+              "matching $REGEX_SEP_CHAR.\n";
+        }
+      my $regex = substr($tag_location, 0, $j, '');
+      $regex = "($regex)" unless ($regex =~ /\(.+\)/);
+      substr($tag_location, 0, 1, '');
+      my @results = $load_dir =~ m/$regex/;
+      $load_tag .= join('', @results);
+    }
+  $load_tag .= $tag_location;
+
+  $load_tag;
+}
+
+# Return a two element array.  The first element is a single character
+# that represents the type of object the path points to.  The second
+# is a boolean (1 for true, '' for false) if the path points to a file
+# and if the file is executable.
+sub file_info
+{
+  lstat(shift) or return ('0', '');
+  -b _ and return ('b', '');
+  -c _ and return ('c', '');
+  -d _ and return ('d', '');
+  -f _ and return ('f', -x _);
+  -l _ and return ('l', '');
+  -p _ and return ('p', '');
+  -S _ and return ('S', '');
+  return '?';
+}
+
+# Start a child process safely without using /bin/sh.
+sub safe_read_from_pipe
+{
+  unless (@_)
+    {
+      croak "$0: safe_read_from_pipe $INCORRECT_NUMBER_OF_ARGS";
+    }
+
+  my $openfork_available = "MSWin32" ne $OSNAME;
+  if ($openfork_available)
+    {
+      print "Running @_\n";
+      my $pid = open(SAFE_READ, "-|");
+      unless (defined $pid)
+        {
+          die "$0: cannot fork: $!\n";
+        }
+      unless ($pid)
+        {
+          # child
+          open(STDERR, ">&STDOUT")
+            or die "$0: cannot dup STDOUT: $!\n";
+          exec(@_)
+            or die "$0: cannot exec '@_': $!\n";
+        }
+    }
+  else
+    {
+      # Redirect the comment into a temp file and use that to work around
+      # Windoze's (non-)handling of multi-line commands.
+      my @commandline = ();
+      my $command;
+      my $comment;
+        
+      while ($command = shift)
+        {
+          if ("-m" eq $command)
+            {
+              my $comment = shift;
+              my ($handle, $tmpfile) = tempfile(DIR => $temp_dir);
+              print $handle $comment;
+              close($handle);
+                
+              push(@commandline, "--file");
+              push(@commandline, $tmpfile);
+            }
+          else
+            {
+              # Munge the command to protect it from the command line
+              $command =~ s/\"/\\\"/g;
+              if ($command =~ m"\s") { $command = "\"$command\""; }
+              if ($command eq "") { $command = "\"\""; }
+              if ($command =~ m"\n")
+                {
+                  warn "$0: carriage return detected in command - may not work\n";
+                }
+              push(@commandline, $command);
+            }
+        }
+        
+      print "Running @commandline\n";
+      if ( $comment ) { print $comment; }
+        
+      # Now do the pipe.
+      open(SAFE_READ, "@commandline |")
+        or die "$0: cannot pipe to command: $!\n";
+    }
+    
+  # parent
+  my @output;
+  while (<SAFE_READ>)
+    {
+      chomp;
+      push(@output, $_);
+    }
+  close(SAFE_READ);
+  my $result = $?;
+  my $exit   = $result >> 8;
+  my $signal = $result & 127;
+  my $cd     = $result & 128 ? "with core dump" : "";
+  if ($signal or $cd)
+    {
+      warn "$0: pipe from '@_' failed $cd: exit=$exit signal=$signal\n";
+    }
+  if (wantarray)
+    {
+      return ($result, @output);
+    }
+  else
+    {
+      return $result;
+    }
+}
+
+# Use safe_read_from_pipe to start a child process safely and exit the
+# script if the child failed for whatever reason.
+sub read_from_process
+{
+  unless (@_)
+    {
+      croak "$0: read_from_process $INCORRECT_NUMBER_OF_ARGS";
+    }
+  my ($status, @output) = &safe_read_from_pipe(@_);
+  if ($status)
+    {
+      print STDERR "$0: @_ failed with this output:\n", join("\n", @output),
+                   "\n";
+      unless ($opt_no_user_input)
+        {
+          print STDERR
+            "Press return to quit and clean up svn working directory: ";
+          <STDIN>;
+        }
+      exit 1;
+    }
+  else
+    {
+      return @output;
+    }
+}
+
+# Get a list of all the files and directories in the specified
+# directory, the type of file and a digest hash of file types.
+sub recursive_ls_and_hash
+{
+  unless (@_ == 1)
+    {
+      croak "$0: recursive_ls_and_hash $INCORRECT_NUMBER_OF_ARGS";
+    }
+
+  # This is the directory to change into.
+  my $dir = shift;
+
+  # Get the current directory so that the script can change into the
+  # current working directory after changing into the specified
+  # directory.
+  my $return_cwd = cwd;
+
+  chdir($dir)
+    or die "$0: cannot chdir '$dir': $!\n";
+
+  my %files;
+
+  my $wanted = sub
+    {
+      s#^\./##;
+      return if $_ eq '.';
+      my ($file_type) = &file_info($_);
+      my $file_digest;
+      if ($file_type eq 'f' or ($file_type eq 'l' and stat($_) and -f _))
+        {
+          $file_digest = &digest_hash_file($_);
+        }
+      $files{$_} = {type   => $file_type,
+                    digest => $file_digest};
+    };
+  find({no_chdir   => 1,
+        preprocess => sub
+	  {
+            grep
+              {
+                my $ok=1;
+                foreach my $x (@glob_ignores)
+                  {
+                    if ( $_ =~ /$x/ ) {$ok=0;last;}
+                  }
+                $ok
+              } @_
+          },
+        wanted     => $wanted
+       }, '.');
+
+  chdir($return_cwd)
+    or die "$0: cannot chdir '$return_cwd': $!\n";
+
+  %files;
+}
+
+# Given a list of files and directories which have been renamed but
+# not commtited, commit them with a proper log message.
+sub commit_renames
+{
+  unless (@_ == 4)
+    {
+      croak "$0: commit_renames $INCORRECT_NUMBER_OF_ARGS";
+    }
+
+  my $load_dir          = shift;
+  my $renamed_filenames = shift;
+  my $rename_from_files = shift;
+  my $rename_to_files   = shift;
+
+  my $number_renames    = @$renamed_filenames/2;
+
+  my $message = "To prepare to load $load_dir into $repos_load_abs_path, " .
+                "perform $number_renames rename" .
+                ($number_renames > 1 ? "s" : "") . ".\n";
+
+  # Text::Wrap::wrap appears to replace multiple consecutive \n's with
+  # one \n, so wrap the text and then append the second \n.
+  $message  = wrap("", "", $message) . "\n";
+  while (@$renamed_filenames)
+    {
+      my $from  = "$repos_load_abs_path/" . shift @$renamed_filenames;
+      my $to    = "$repos_load_abs_path/" . shift @$renamed_filenames;
+      $message .= wrap("", "  ", "* $to: Renamed from $from.\n");
+    }
+
+  # Change to the top of the working copy so that any
+  # directories will also be updated.
+  my $cwd = cwd;
+  chdir($wc_import_dir_cwd)
+    or die "$0: cannot chdir '$wc_import_dir_cwd': $!\n";
+  read_from_process($svn, 'commit', @svn_use_repos_cmd_opts, '-m', $message);
+  read_from_process($svn, 'update', @svn_use_repos_cmd_opts);
+  chdir($cwd)
+    or die "$0: cannot chdir '$cwd': $!\n";
+
+  # Some versions of subversion have a bug where renamed files
+  # or directories are not deleted after a commit, so do that
+  # here.
+  my @del_files = sort {length($b) <=> length($a) || $a cmp $b }
+                  keys %$rename_from_files;
+  rmtree(\@del_files, 1, 0);
+
+  # Empty the list of old and new renamed names.
+  undef %$rename_from_files;
+  undef %$rename_to_files;
+}
+
+# Take a one file or directory and see if its name is equal to a
+# second or is contained in the second if the second file's file type
+# is a directory.
+sub contained_in
+{
+  unless (@_ == 3)
+    {
+      croak "$0: contain_in $INCORRECT_NUMBER_OF_ARGS";
+    }
+
+  my $contained      = shift;
+  my $container      = shift;
+  my $container_type = shift;
+
+  if ($container eq $contained)
+    {
+      return 1;
+    }
+
+  if ($container_type eq 'd')
+    {
+      my $dirname        = "$container/";
+      my $dirname_length = length($dirname);
+
+      if ($dirname_length <= length($contained) and
+          $dirname eq substr($contained, 0, $dirname_length))
+        {
+          return 1;
+        }
+    }
+
+  return 0;
+}
+
+# Take an array reference containing a list of files and directories
+# and take a hash reference and remove from the array reference any
+# files and directories and the files the directory contains listed in
+# the hash.
+sub filter_renamed_files
+{
+  unless (@_ == 2)
+    {
+      croak "$0: filter_renamed_files $INCORRECT_NUMBER_OF_ARGS";
+    }
+
+  my $array_ref = shift;
+  my $hash_ref  = shift;
+
+  foreach my $remove_filename (keys %$hash_ref)
+    {
+      my $remove_file_type = $hash_ref->{$remove_filename}{type};
+      for (my $i=0; $i<@$array_ref;)
+        {
+          if (contained_in($array_ref->[$i],
+                           $remove_filename,
+                           $remove_file_type))
+            {
+              splice(@$array_ref, $i, 1);
+              next;
+            }
+          ++$i;
+        }
+    }
+}
+
+# Get a digest hash of the specified filename.
+sub digest_hash_file
+{
+  unless (@_ == 1)
+    {
+      croak "$0: digest_hash_file $INCORRECT_NUMBER_OF_ARGS";
+    }
+
+  my $filename = shift;
+
+  my $ctx = Digest::MD5->new;
+  if (open(READ, $filename))
+    {
+      binmode READ;
+      $ctx->addfile(*READ);
+      close(READ);
+    }
+  else
+    {
+      die "$0: cannot open '$filename' for reading: $!\n";
+    }
+  $ctx->digest;
+}
+
+# Read standard input until a line contains the required input or an
+# empty line to signify the default answer.
+sub get_answer
+{
+  unless (@_ == 3)
+    {
+      croak "$0: get_answer $INCORRECT_NUMBER_OF_ARGS";
+    }
+
+  my $message = shift;
+  my $answers = shift;
+  my $def_ans = shift;
+
+  return $def_ans if $opt_no_user_input;
+
+  my $char;
+  do
+    {
+      print $message;
+      $char = '';
+      my $line = <STDIN>;
+      if (defined $line and length $line)
+        {
+          $char = substr($line, 0, 1);
+          $char = '' if $char eq "\n";
+        }
+    } until $char eq '' or $answers =~ /$char/ig;
+
+  return $def_ans if $char eq '';
+  return pos($answers) - 1;
+}
+
+# Determine the native end of line on this system by writing a \n in
+# non-binary mode to an empty file and reading the same file back in
+# binary mode.
+sub determine_native_eol
+{
+  my $filename = "$temp_dir/svn_load_dirs_eol_test.$$";
+  if (-e $filename)
+    {
+      unlink($filename)
+        or die "$0: cannot unlink '$filename': $!\n";
+    }
+
+  # Write the \n in non-binary mode.
+  open(NL_TEST, ">$filename")
+    or die "$0: cannot open '$filename' for writing: $!\n";
+  print NL_TEST "\n";
+  close(NL_TEST)
+    or die "$0: error in closing '$filename' for writing: $!\n";
+
+  # Read the \n in binary mode.
+  open(NL_TEST, $filename)
+    or die "$0: cannot open '$filename' for reading: $!\n";
+  binmode NL_TEST;
+  local $/;
+  undef $/;
+  my $eol = <NL_TEST>;
+  close(NL_TEST)
+    or die "$0: cannot close '$filename' for reading: $!\n";
+  unlink($filename)
+    or die "$0: cannot unlink '$filename': $!\n";
+
+  my $eol_length = length($eol);
+  unless ($eol_length)
+    {
+      die "$0: native eol length on this system is 0.\n";
+    }
+
+  print "Native EOL on this system is ";
+  for (my $i=0; $i<$eol_length; ++$i)
+    {
+      printf "\\%03o", ord(substr($eol, $i, 1));
+    }
+  print ".\n\n";
+
+  $eol;
+}
+
+# Take a filename, open the file and replace all CR, CRLF and LF's
+# with the native end of line style for this system.
+sub convert_file_to_native_eol
+{
+  unless (@_ == 1)
+    {
+      croak "$0: convert_file_to_native_eol $INCORRECT_NUMBER_OF_ARGS";
+    }
+
+  my $filename = shift;
+  open(FILE, $filename)
+    or die "$0: cannot open '$filename' for reading: $!\n";
+  binmode FILE;
+  local $/;
+  undef $/;
+  my $in = <FILE>;
+  close(FILE)
+    or die "$0: error in closing '$filename' for reading: $!\n";
+  my $out = '';
+
+  # Go through the file and transform it byte by byte.
+  my $i = 0;
+  while ($i < length($in))
+    {
+      my $cc = substr($in, $i, 2);
+      if ($cc eq "\015\012")
+        {
+          $out .= $native_eol;
+          $i += 2;
+          next;
+        }
+
+      my $c = substr($cc, 0, 1);
+      if ($c eq "\012" or $c eq "\015")
+        {
+          $out .= $native_eol;
+        }
+      else
+        {
+          $out .= $c;
+        }
+      ++$i;
+    }
+
+  return 0 if $in eq $out;
+
+  my $tmp_filename = ".svn/tmp/svn_load_dirs.$$";
+  open(FILE, ">$tmp_filename")
+    or die "$0: cannot open '$tmp_filename' for writing: $!\n";
+  binmode FILE;
+  print FILE $out;
+  close(FILE)
+    or die "$0: cannot close '$tmp_filename' for writing: $!\n";
+  rename($tmp_filename, $filename)
+    or die "$0: cannot rename '$tmp_filename' to '$filename': $!\n";
+
+  return 1;
+}
+
+# Split the input line into words taking into account that single or
+# double quotes may define a single word with whitespace in it.
+sub split_line
+{
+  unless (@_ == 1)
+    {
+      croak "$0: split_line $INCORRECT_NUMBER_OF_ARGS";
+    }
+
+  my $line = shift;
+
+  # Strip leading whitespace.  Do not strip trailing whitespace which
+  # may be part of quoted text that was never closed.
+  $line =~ s/^\s+//;
+
+  my $line_length  = length $line;
+  my @words        = ();
+  my $current_word = '';
+  my $in_quote     = '';
+  my $in_protect   = '';
+  my $in_space     = '';
+  my $i            = 0;
+
+  while ($i < $line_length)
+    {
+      my $c = substr($line, $i, 1);
+      ++$i;
+
+      if ($in_protect)
+        {
+          if ($c eq $in_quote)
+            {
+              $current_word .= $c;
+            }
+          elsif ($c eq '"' or $c eq "'")
+            {
+              $current_word .= $c;
+            }
+          else
+            {
+              $current_word .= "$in_protect$c";
+            }
+          $in_protect = '';
+        }
+      elsif ($c eq '\\')
+        {
+          $in_protect = $c;
+        }
+      elsif ($in_quote)
+        {
+          if ($c eq $in_quote)
+            {
+              $in_quote = '';
+            }
+          else
+            {
+              $current_word .= $c;
+            }
+        }
+      elsif ($c eq '"' or $c eq "'")
+        {
+          $in_quote = $c;
+        }
+      elsif ($c =~ m/^\s$/)
+        {
+          unless ($in_space)
+            {
+              push(@words, $current_word);
+              $current_word = '';
+            }
+        }
+      else
+        {
+          $current_word .= $c;
+        }
+
+      $in_space = $c =~ m/^\s$/;
+    }
+
+  # Handle any leftovers.
+  $current_word .= $in_protect if $in_protect;
+  push(@words, $current_word) if length $current_word;
+
+  @words;
+}
+
+# This package exists just to delete the temporary directory.
+package Temp::Delete;
+
+sub new
+{
+  bless {}, shift;
+}
+
+sub DESTROY
+{
+  print "Cleaning up $temp_dir\n";
+  File::Path::rmtree([$temp_dir], 0, 0);
+}
Index: trunk/NEMOGCM/EXTERNAL/svn_tools/update_vendor.sh
===================================================================
--- trunk/NEMOGCM/EXTERNAL/svn_tools/update_vendor.sh	(revision 2528)
+++ trunk/NEMOGCM/EXTERNAL/svn_tools/update_vendor.sh	(revision 2528)
@@ -0,0 +1,131 @@
+#!/bin/bash
+# N.B. run this script on EXTERNAL directory!!!
+
+set -u
+
+if [ $# -ne 4 ]; then
+    echo "Usage: $0 vendor_branch nemo_vendor_old new username"
+    echo "first  argument: vendor name (for example: IOIPSL)"
+    echo "second argument: old tag name of the vendor in NEMO vendors deposit (for example: v2_1_9 or 53)"
+    echo "third  argument: definition of the tag or the revision number of the vendor to be updated (for example: v2_2_1 or 114)"
+    echo "fourth argument: user login name"
+    echo
+    echo "run this script on EXTERNAL/svn_tools directory"
+    echo
+    echo
+    echo "examples"
+    echo
+    echo "./update_vendor.sh IOIPSL v2_1_9 v2_2_1 smasson"
+    echo "./update_vendor.sh XMLF90 53 114 smasson"
+    echo "./update_vendor.sh XMLIO_SERVER 53 114 smasson"
+    echo "./update_vendor.sh AGRIF 00 1988 smasson"
+
+   exit 1
+fi
+
+vendor_branch=$1
+nemo_vendor_old=$2
+new=$3
+username=$4
+
+#-
+#-----------------------------------------------------------------------------------
+# path definitions... could need to be changed...
+#-----------------------------------------------------------------------------------
+#-
+
+#- My projet url
+svn_nemo_vendor=svn+ssh://$username@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/vendors/$vendor_branch
+
+#- EXTERNAL directory in which we want to merge vendors
+svn_external=svn+ssh://$username@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/DEV_r1879_FCM/NEMOGCM/EXTERNAL
+
+#- Vendor project original url
+case $vendor_branch in
+    IOIPSL) vendor_url=http://forge.ipsl.jussieu.fr/igcmg/svn/$vendor_branch/tags ;;
+    AGRIF) vendor_url=http://forge.ipsl.jussieu.fr/nemo/svn/trunk/$vendor_branch ;;
+    XMLF90) vendor_url=http://forge.ipsl.jussieu.fr/ioserver/svn/$vendor_branch ;;
+    XMLIO_SERVER) vendor_url=http://forge.ipsl.jussieu.fr/ioserver/svn/XMLIO_SERVER/trunk ;;
+    fcm) echo "url of fcm undefined..." ; exit 2 ;;
+    *)  echo "wrong definition of the vendor name..." ; exit 3 ;;
+esac
+
+#- get a tag or a revision??
+if [ "$vendor_branch" = "IOIPSL" ] 
+then
+    rev_or_tag="tag"
+else
+    rev_or_tag="rev"
+fi
+
+#-
+#-----------------------------------------------------------------------------------
+# end of path definitions...
+#-----------------------------------------------------------------------------------
+#-
+echo
+echo "########################################################"
+echo "#                                                      #"
+echo "#  run this script in EXTERNAL/svn_tools directory!!!  #"
+echo "#                                                      #"
+echo "########################################################"
+echo
+
+#- checkout new vendor version without the .svn directories (-> use export instead of checkout) and put it in a working_directory
+echo
+echo "Downloading $vendor_branch tag $new into working_directory..."
+echo
+[[ ( -d working_directory ) || ( -f working_directory ) ]] && rm -rf working_directory # cleaning
+if [ "$rev_or_tag" = "tag" ] 
+then
+    svn export $vendor_url/$new working_directory      # specify the tag path
+else
+    svn export -r $new $vendor_url working_directory   # specify the revision number
+fi
+
+#- update the vendor deposit:
+#- 1) create a clean version of the current version (take care od added and removed file) and commit it
+#- 2) tag it with a new name $nemo_vendor_new
+if [ "$rev_or_tag" = "tag" ] 
+then
+    nemo_vendor_new=$new
+else
+    nemo_vendor_new=r_$new
+fi
+echo
+echo "updating $vendor_branch/current and tagging this new version as $vendor_branch/$nemo_vendor_new"
+echo
+./svn_load_dirs.pl -t $nemo_vendor_new $svn_nemo_vendor current working_directory
+#- 
+#- merge old and new version of $vendor_branch in $svn_external/$vendor_branch
+#-
+echo
+echo "##############################################"
+echo
+echo "merge old and new version of $vendor_branch in $svn_external/$vendor_branch"
+echo "if everything is ok you should execute the folling command:"
+echo
+echo "svn merge $svn_nemo_vendor/$nemo_vendor_old $svn_nemo_vendor/current ../$vendor_branch"
+
+echo
+echo
+echo "##############################################"
+echo
+echo "Commiting the merge of $vendor_branch changes toward $svn_external/$vendor_branch"
+echo "if everything is ok you should execute the folling command:"
+echo
+echo "svn ci --message \"merging $vendor_branch/$nemo_vendor_new into the EXTERNAL deposit\" ../$vendor_branch"
+echo
+echo
+
+ 
+## NOTE : after a merge we have conflicts
+## to resole them it is necessary to do, for example : svn resolved IOIPSL/directory with conflits
+
+## NOTE : if you have a good merge then you have to committ:
+## cd $tmp_dir/IOIPSL
+## svn status ../IOIPSL
+## svn ci --username $username --message "merge IOIPSL version $nemo_vendor_new"
+
+exit 0
+
Index: trunk/NEMOGCM/License_CeCILL.txt
===================================================================
--- trunk/NEMOGCM/License_CeCILL.txt	(revision 2528)
+++ trunk/NEMOGCM/License_CeCILL.txt	(revision 2528)
@@ -0,0 +1,34 @@
+The following licence information concerns ONLY the NEMO SYSTEM
+===============================================================
+
+Copyright © Centre National de la Recherche Scientifique CNRS  
+
+This software is a computer program whose purpose is the numerical
+modelling of the ocean dynamics (direct, adjoint and linear-tangent
+components), tracers, biogeochemistry and sea-ice.
+
+This software is governed by the CeCILL  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
+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 license and that you accept its terms.
Index: trunk/NEMOGCM/NEMO/LIM_SRC_2/dom_ice_2.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_2/dom_ice_2.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_2/dom_ice_2.F90	(revision 2528)
@@ -5,10 +5,13 @@
    !!======================================================================
    !! History :   2.0  !  03-08  (C. Ethe)  Free form and module
+   !!             3.3  !  2009-05 (G.Garric, C. Bricaud) addition of lim2_evp case
    !!----------------------------------------------------------------------
 #if defined key_lim2
    !!----------------------------------------------------------------------
-   !!   LIM 2.0, UCL-LOCEAN-IPSL (2005)
+   !!   'key_lim2'                                       LIM2 sea-ice model
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
    USE par_ice_2
@@ -22,13 +25,24 @@
       !                                        !  (otherwise = jpj+10 (SH) or -10 (SH) )
 
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)         ::   fs2cor , fcor,   &  !: coriolis factor and coeficient
-      &                                              covrai ,         &  !: sine of geographic latitude
-      &                                              area   ,         &  !: surface of grid cell 
-      &                                              tms    , tmu        !: temperature and velocity points masks
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2,2)     ::   wght   ,         &  !: weight of the 4 neighbours to compute averages
-      &                                              akappa , bkappa     !: first and third group of metric coefficients
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2,2,2,2) ::   alambd   !: second group of metric coefficients
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)         ::   fs2cor , fcor     !: coriolis factor and coeficient
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)         ::   covrai            !: sine of geographic latitude
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)         ::   area              !: surface of grid cell 
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)         ::   tms    , tmu      !: temperature and velocity points masks
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2,2)     ::   wght              !: weight of the 4 neighbours to compute averages
 
+
+# if defined key_lim2_vp
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2,2)     ::   akappa , bkappa   !: first and third group of metric coefficients
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2,2,2,2) ::   alambd            !: second group of metric coefficients
+# else
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)         ::   tmv    , tmf      !: y-velocity and F-points masks
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)         ::   tmi               !: ice mask: =1 if ice thick > 0
+# endif
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option          Empty module         NO LIM-2 sea-ice model
+   !!----------------------------------------------------------------------
+#endif
    !!======================================================================
-#endif
 END MODULE dom_ice_2
Index: trunk/NEMOGCM/NEMO/LIM_SRC_2/ice_2.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_2/ice_2.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_2/ice_2.F90	(revision 2528)
@@ -4,5 +4,6 @@
    !! Sea Ice physics:  diagnostics variables of ice defined in memory
    !!=====================================================================
-   !! History :  2.0  !  03-08  (C. Ethe)  F90: Free form and module
+   !! History :  2.0  !  2003-08  (C. Ethe)  F90: Free form and module
+   !!            3.3  !  2009-05  (G.Garric) addition of the lim2_evp cas
    !!----------------------------------------------------------------------
 #if defined key_lim2
@@ -10,53 +11,79 @@
    !!   'key_lim2' :                                  LIM 2.0 sea-ice model
    !!----------------------------------------------------------------------
-   !!  LIM 2.0, UCL-LOCEAN-IPSL (2006)
-   !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-   !! * Modules used
    USE par_ice_2          ! LIM sea-ice parameters
 
    IMPLICIT NONE
    PRIVATE
+   
+   INTEGER , PUBLIC ::   numit     !: ice iteration index
+   REAL(wp), PUBLIC ::   rdt_ice   !: ice time step
 
-   !!* Share parameters namelist (namicerun read in iceini) *
+   !                                                                     !!* namicerun read in iceini  *
    CHARACTER(len=32)     , PUBLIC ::   cn_icerst_in  = "restart_ice_in"   !: suffix of ice restart name (input)
    CHARACTER(len=32)     , PUBLIC ::   cn_icerst_out = "restart_ice"      !: suffix of ice restart name (output)
    LOGICAL               , PUBLIC ::   ln_limdyn     = .TRUE.             !: flag for ice dynamics (T) or not (F)
    LOGICAL               , PUBLIC ::   ln_limdmp     = .FALSE.            !: Ice damping
-   REAL(wp)              , PUBLIC ::   hsndif        = 0.e0               !: computation of temp. in snow (0) or not (9999)
-   REAL(wp)              , PUBLIC ::   hicdif        = 0.e0               !: computation of temp. in ice (0) or not (9999)
-   REAL(wp), DIMENSION(2), PUBLIC ::   acrit = (/ 1.e-06 , 1.e-06 /)      !: minimum fraction for leads in 
-   !                                                                      !: north and south hemisphere
-   !!* ice-dynamic namelist (namicedyn) *
-   INTEGER , PUBLIC ::   nbiter = 1         !: number of sub-time steps for relaxation
-   INTEGER , PUBLIC ::   nbitdr = 250       !: maximum number of iterations for relaxation
-   REAL(wp), PUBLIC ::   rdt_ice            !: ice time step
-   REAL(wp), PUBLIC ::   epsd   = 1.0e-20   !: tolerance parameter for dynamic
-   REAL(wp), PUBLIC ::   alpha  = 0.5       !: coefficient for semi-implicit coriolis
-   REAL(wp), PUBLIC ::   dm     = 0.6e+03   !: diffusion constant for dynamics
-   REAL(wp), PUBLIC ::   om     = 0.5       !: relaxation constant
-   REAL(wp), PUBLIC ::   resl   = 5.0e-05   !: maximum value for the residual of relaxation
-   REAL(wp), PUBLIC ::   cw     = 5.0e-03   !: drag coefficient for oceanic stress
-   REAL(wp), PUBLIC ::   angvg  = 0.e0      !: turning angle for oceanic stress
-   REAL(wp), PUBLIC ::   pstar  = 1.0e+04   !: first bulk-rheology parameter
-   REAL(wp), PUBLIC ::   c_rhg  = 20.e0     !: second bulk-rhelogy parameter
-   REAL(wp), PUBLIC ::   etamn  = 0.e+07    !: minimun value for viscosity
-   REAL(wp), PUBLIC ::   creepl = 2.e-08    !: creep limit
-   REAL(wp), PUBLIC ::   ecc    = 2.e0      !: eccentricity of the elliptical yield curve
-   REAL(wp), PUBLIC ::   ahi0   = 350.e0    !: sea-ice hor. eddy diffusivity coeff. (m2/s)
+   LOGICAL               , PUBLIC ::   ln_nicep      = .TRUE.             !: flag grid points output (T) or not (F)
+   REAL(wp)              , PUBLIC ::   hsndif        = 0._wp              !: snow temp. computation (0) or not (9999)
+   REAL(wp)              , PUBLIC ::   hicdif        = 0._wp              !: ice  temp. computation (0) or not (9999)
+   REAL(wp), DIMENSION(2), PUBLIC ::   acrit = (/ 1.e-6_wp , 1.e-6_wp /)  !: minimum lead fraction in the 2 hemisphere
+   
+   !                                          !!* ice-dynamic namelist (namicedyn) *
+   INTEGER , PUBLIC ::   nbiter =    1         !: number of sub-time steps for relaxation
+   INTEGER , PUBLIC ::   nbitdr =  250         !: maximum number of iterations for relaxation
+   INTEGER , PUBLIC ::   nevp   =  360         !: number of EVP subcycling iterations
+   INTEGER , PUBLIC ::   telast = 3600         !: timescale for EVP elastic waves
+   REAL(wp), PUBLIC ::   epsd   = 1.0e-20_wp   !: tolerance parameter for dynamic
+   REAL(wp), PUBLIC ::   alpha  = 0.5_wp       !: coefficient for semi-implicit coriolis
+   REAL(wp), PUBLIC ::   dm     = 0.6e+03_wp   !: diffusion constant for dynamics
+   REAL(wp), PUBLIC ::   om     = 0.5_wp       !: relaxation constant
+   REAL(wp), PUBLIC ::   resl   = 5.0e-05_wp   !: maximum value for the residual of relaxation
+   REAL(wp), PUBLIC ::   cw     = 5.0e-03_wp   !: drag coefficient for oceanic stress
+   REAL(wp), PUBLIC ::   angvg  = 0._wp        !: turning angle for oceanic stress
+   REAL(wp), PUBLIC ::   pstar  = 1.0e+04_wp   !: first bulk-rheology parameter
+   REAL(wp), PUBLIC ::   c_rhg  = 20._wp       !: second bulk-rhelogy parameter
+   REAL(wp), PUBLIC ::   etamn  = 0._wp        !: minimun value for viscosity
+   REAL(wp), PUBLIC ::   creepl = 2.e-08_wp    !: creep limit
+   REAL(wp), PUBLIC ::   ecc    = 2._wp        !: eccentricity of the elliptical yield curve
+   REAL(wp), PUBLIC ::   ahi0   = 350._wp      !: sea-ice hor. eddy diffusivity coeff. (m2/s)
+   REAL(wp), PUBLIC ::   alphaevp = 1._wp      !: coefficient for the solution of EVP int. stresses
 
-   REAL(wp), PUBLIC ::   usecc2             !:  = 1.0 / ( ecc * ecc )
-   REAL(wp), PUBLIC ::   rhoco              !: = rau0 * cw
-   REAL(wp), PUBLIC ::   sangvg, cangvg     !: sin and cos of the turning angle for ocean stress
-   REAL(wp), PUBLIC ::   pstarh             !: pstar / 2.0
+   REAL(wp), PUBLIC ::   usecc2                !:  = 1.0 / ( ecc * ecc )
+   REAL(wp), PUBLIC ::   rhoco                 !: = rau0 * cw
+   REAL(wp), PUBLIC ::   sangvg, cangvg        !: sin and cos of the turning angle for ocean stress
+   REAL(wp), PUBLIC ::   pstarh                !: pstar / 2.0
 
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ahiu , ahiv   !: hor. diffusivity coeff. at ocean U- and V-points (m2/s)
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   pahu , pahv   !: ice hor. eddy diffusivity coef. at ocean U- and V-points
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ust2s         !: friction velocity
+
+   !!* Ice Rheology
+# if defined key_lim2_vp
+   !                                                      !!* VP rheology *
+   LOGICAL , PUBLIC ::   lk_lim2_vp = .TRUE.               !: Visco-Plactic reology flag 
+   !
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hsnm , hicm   !: mean snow and ice thicknesses
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ust2s                 !: friction velocity
+   !
+# else
+   !                                                      !!* EVP rheology *
+   LOGICAL , PUBLIC::   lk_lim2_vp = .FALSE.               !: Visco-Plactic reology flag 
+   !
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   stress1_i     !: first stress tensor element       
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   stress2_i     !: second stress tensor element
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   stress12_i    !: diagonal stress tensor element
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   delta_i       !: rheology delta factor (see Flato and Hibler 95) [s-1]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   divu_i        !: Divergence of the velocity field [s-1] -> limrhg.F90
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   shear_i       !: Shear of the velocity field [s-1] -> limrhg.F90
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   at_i          !: ice fraction
+   !
+   REAL(wp), PUBLIC, DIMENSION(:,:)    , POINTER :: vt_s ,vt_i    !: mean snow and ice thicknesses
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj), TARGET  :: hsnm , hicm   !: target vt_s,vt_i pointers 
+#endif
 
-   !!* diagnostic quantities
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sist          !: Sea-Ice Surface Temperature (Kelvin)
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rdvosif       !: ice volume change at ice surface (only used for outputs)
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rdvobif       !: ice volume change at ice bottom  (only used for outputs)
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fdvolif       !: Total   ice volume change (only used for outputs)
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rdvonif       !: Lateral ice volume change (only used for outputs)
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sist          !: Sea-Ice Surface Temperature [Kelvin]
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   tfu           !: Freezing/Melting point temperature of sea water at SSS
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hicif         !: Ice thickness
@@ -71,17 +98,16 @@
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rdmicif       !: Variation of ice mass
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qldif         !: heat balance of the lead (or of the open ocean)
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qcmif         !: Energy needed to bring the ocean surface layer until its freezing 
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qcmif         !: Energy needed to freeze the ocean surface layer
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fdtcn         !: net downward heat flux from the ice to the ocean
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qdtcn         !: energy from the ice to the ocean point (at a factor 2)
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   thcm          !: part of the solar energy used in the lead heat budget
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fstric        !: Solar flux transmitted trough the ice
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ffltbif       !: Array linked with the max heat contained in brine pockets (?)
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ffltbif       !: linked with the max heat contained in brine pockets (?)
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fscmbq        !: Linked with the solar flux below the ice (?)
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fsbbq         !: Also linked with the solar flux below the ice (?)
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qfvbq         !: Array used to store energy in case of toral lateral ablation (?)
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qfvbq         !: used to store energy in case of toral lateral ablation (?)
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   dmgwi         !: Variation of the mass of snow ice
-
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   u_ice, v_ice   !: two components of the ice   velocity at I-point (m/s)
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   u_oce, v_oce   !: two components of the ocean velocity at I-point (m/s)
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   u_ice, v_ice  !: two components of the ice   velocity at I-point (m/s)
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   u_oce, v_oce  !: two components of the ocean velocity at I-point (m/s)
 
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jplayersp1) ::   tbif  !: Temperature inside the ice/snow layer
@@ -102,4 +128,8 @@
 #endif
 
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!======================================================================
 END MODULE ice_2
Index: trunk/NEMOGCM/NEMO/LIM_SRC_2/iceini_2.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_2/iceini_2.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_2/iceini_2.F90	(revision 2528)
@@ -6,4 +6,5 @@
    !! History :   1.0  !  02-08  (G. Madec)  F90: Free form and modules
    !!             2.0  !  03-08  (C. Ethe)  add ice_run
+   !!             3.3  !  09-05  (G.Garric, C. Bricaud) addition of the lim2_evp case
    !!----------------------------------------------------------------------
 #if defined key_lim2
@@ -15,14 +16,14 @@
    !!   ice_run_2        : Definition some run parameter for ice model
    !!----------------------------------------------------------------------
-   USE dom_oce
-   USE dom_ice_2
-   USE sbc_oce         ! surface boundary condition: ocean
-   USE sbc_ice         ! surface boundary condition: ice
-   USE phycst          ! Define parameters for the routines
-   USE ice_2
-   USE limmsh_2
-   USE limistate_2
-   USE limrst_2   
-   USE in_out_manager
+   USE dom_oce          ! ocean domain
+   USE dom_ice_2        ! LIM2: ice domain
+   USE sbc_oce          ! surface boundary condition: ocean
+   USE sbc_ice          ! surface boundary condition: ice
+   USE phycst           ! Define parameters for the routines
+   USE ice_2            ! LIM2: ice variable
+   USE limmsh_2         ! LIM2: mesh
+   USE limistate_2      ! LIM2: initial state
+   USE limrst_2         ! LIM2: restart
+   USE in_out_manager   ! I/O manager
       
    IMPLICIT NONE
@@ -32,9 +33,8 @@
 
    !!----------------------------------------------------------------------
-   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005) 
+   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -43,25 +43,24 @@
       !!                  ***  ROUTINE ice_init_2  ***
       !!
-      !! ** purpose :   
+      !! ** purpose :   initialisation of LIM-2 domain and variables  
       !!----------------------------------------------------------------------
       !
-      ! Open the namelist file 
-      CALL ctl_opn( numnam_ice, 'namelist_ice', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )      
-      CALL ice_run_2                    !  read in namelist some run parameters
-                 
-      ! Louvain la Neuve Ice model
-      rdt_ice = nn_fsbc * rdttra(1)
-
-      CALL lim_msh_2                  ! ice mesh initialization
-     
-      ! Initial sea-ice state
-      IF( .NOT.ln_rstart ) THEN
-         CALL lim_istate_2            ! start from rest: sea-ice deduced from sst
-      ELSE
-         CALL lim_rst_read_2          ! start from a restart file
+      !                                ! Open the namelist file 
+      CALL ctl_opn( numnam_ice, 'namelist_ice', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 
+      !    
+      CALL ice_run_2                   ! read in namelist some run parameters
+      !          
+      rdt_ice = nn_fsbc * rdttra(1)    ! sea-ice time step
+      numit   = nit000 - 1
+      !
+      CALL lim_msh_2                   ! ice mesh initialization
+      !
+      !                                ! Initial sea-ice state
+      IF( .NOT.ln_rstart ) THEN   ;   CALL lim_istate_2     ! start from rest: sea-ice deduced from sst
+      ELSE                        ;   CALL lim_rst_read_2   ! start from a restart file
       ENDIF
-      
-      tn_ice(:,:,1) = sist(:,:)         ! initialisation of ice temperature   
-      fr_i  (:,:) = 1.0 - frld(:,:)   ! initialisation of sea-ice fraction    
+      !
+      tn_ice(:,:,1) = sist(:,:)        ! initialisation of ice temperature   
+      fr_i  (:,:) = 1.0 - frld(:,:)    ! initialisation of sea-ice fraction    
       !
    END SUBROUTINE ice_init_2
@@ -82,8 +81,8 @@
       !!-------------------------------------------------------------------
       !                    
-      REWIND ( numnam_ice )                       ! Read Namelist namicerun 
-      READ   ( numnam_ice , namicerun )
-
-      IF(lwp) THEN
+      REWIND( numnam_ice )                      ! Read Namelist namicerun 
+      READ  ( numnam_ice , namicerun )
+      !
+      IF(lwp) THEN                              ! control print
          WRITE(numout,*)
          WRITE(numout,*) 'ice_run : ice share parameters for dynamics/advection/thermo of sea-ice'
Index: trunk/NEMOGCM/NEMO/LIM_SRC_2/limadv_2.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_2/limadv_2.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_2/limadv_2.F90	(revision 2528)
@@ -37,7 +37,7 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/LIM 3.2,  UCL-LOCEAN-IPSL (2009) 
+   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/LIM_SRC_2/limdia_2.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_2/limdia_2.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_2/limdia_2.F90	(revision 2528)
@@ -57,7 +57,7 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005) 
+   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/LIM_SRC_2/limdmp_2.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_2/limdmp_2.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_2/limdmp_2.F90	(revision 2528)
@@ -2,169 +2,170 @@
    !!======================================================================
    !!                       ***  MODULE limdmp_2   ***
-   !!  Ice model : restoring Ice thickness and Fraction leads
+   !!  LIM-2 ice model : restoring Ice thickness and Fraction leads
    !!======================================================================
-   !! History :   2.0  !  04-04 (S. Theetten) Original code
+   !! History :   2.0  !  2004-04 (S. Theetten) Original code
+   !!             3.3  !  2010-06 (J.-M. Molines) use of fldread
    !!----------------------------------------------------------------------
-#if defined key_lim2   &&   defined key_tradmp
+#if defined key_lim2
    !!----------------------------------------------------------------------
-   !!   'key_lim2'  AND                               LIM 2.0 sea-ice model
-   !!   'key_tradmp'                                                Damping
-   !!----------------------------------------------------------------------
+   !!   'key_lim2'                                    LIM 2.0 sea-ice model
    !!----------------------------------------------------------------------
    !!   lim_dmp_2      : ice model damping
    !!----------------------------------------------------------------------
    USE in_out_manager  ! I/O manager
-   USE phycst          ! physical constants
-   USE ice_2
-   USE tradmp
-   USE dom_oce
-   USE oce
-   USE iom
+   USE ice_2           ! ice variables 
+   USE sbc_oce, ONLY : nn_fsbc ! for fldread
+   USE dom_oce         ! for mi0; mi1 etc ...
+   USE fldread         ! read input fields
    
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   lim_dmp_2     ! called by ice_step_2
+   PUBLIC   lim_dmp_2     ! called by sbc_ice_lim2
+
+   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   resto_ice   ! restoring coeff. on ICE   [s-1]
+
+   INTEGER, PARAMETER :: jp_hicif = 1 , jp_frld = 2
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_icedmp    ! structure of ice damping input
    
-   INTEGER                        ::   nice1, nice2,  &  ! first and second record used
-      &                                inumice_dmp       ! logical unit for ice variables (damping)
-   REAL(wp), DIMENSION(jpi,jpj)   ::   hicif_dta  ,   &  ! ice thickness at a given time
-      &                                frld_dta          ! fraction lead at a given time
-   REAL(wp), DIMENSION(jpi,jpj,2) ::   hicif_data ,   &  ! ice thickness data at two consecutive times
-      &                                frld_data         ! fraction lead data at two consecutive times
-
    !! * Substitution
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   LIM 2.0 , UCL-LOCEAN-IPSL  (2006)
+   !! NEMO/LIM 3.3 , UCL-NEMO-consortium (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
-   SUBROUTINE lim_dmp_2(kt)
+   SUBROUTINE lim_dmp_2( kt )
       !!-------------------------------------------------------------------
-      !!                   ***  ROUTINE lim_dmp_2 ***
+      !!                   ***  ROUTINE lim_dmp_2  ***
       !!
-      !! ** purpose : ice model damping : restoring ice thickness and 
-      !!              fraction leads
+      !! ** purpose : ice model damping : restoring ice thickness and fraction leads
       !!
-      !! ** method  : the key_tradmp must be used to compute resto(:,:) coef.
+      !! ** method  : the key_tradmp must be used to compute resto(:,:,1) coef.
       !!---------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt     ! ocean time-step
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step
       !
-      INTEGER             ::   ji, jj         ! dummy loop indices
+      INTEGER  ::   ji, jj         ! dummy loop indices
+      REAL(wp) ::   zfrld, zhice   ! local scalars
       !!---------------------------------------------------------------------
       !
-      CALL dta_lim_2( kt )
-
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            hicif(ji,jj) = hicif(ji,jj) - rdt_ice * resto(ji,jj,1) * ( hicif(ji,jj) - hicif_dta(ji,jj) )
-            frld(ji,jj)  = frld (ji,jj) - rdt_ice * resto(ji,jj,1) * ( frld(ji,jj)  - frld_dta (ji,jj) )  
-         END DO
-      END DO
+      IF (kt == nit000)  THEN 
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'lim_dmp_2 : Ice thickness and ice concentration restoring'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+         !
+         ! ice_resto_init create resto_ice (in 1/s) for restoring ice parameters near open boundaries.
+         ! Double check this routine to verify if it corresponds to your config
+         CALL lim_dmp_init
+      ENDIF
+      !
+      IF( ln_limdmp ) THEN   ! ice restoring in this case
+         !
+         CALL fld_read( kt, nn_fsbc, sf_icedmp )
+         !
+!CDIR COLLAPSE
+         hicif(:,:) = MAX( 0._wp,                     &        ! h >= 0         avoid spurious out of physical range
+            &         hicif(:,:) - rdt_ice * resto_ice(:,:,1) * ( hicif(:,:) - sf_icedmp(jp_hicif)%fnow(:,:,1) )  ) 
+!CDIR COLLAPSE
+         hicif(:,:) = MAX( 0._wp, MIN( 1._wp,         &        ! 0<= frld<=1    values which blow the run up
+            &         frld (:,:) - rdt_ice * resto_ice(:,:,1) * ( frld (:,:) - sf_icedmp(jp_frld )%fnow(:,:,1) )  )  )
+         !
+      ENDIF
       !
    END SUBROUTINE lim_dmp_2
 
 
-   SUBROUTINE dta_lim_2( kt ) 
+   SUBROUTINE lim_dmp_init
       !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE dta_lim_2  ***
+      !!                   ***  ROUTINE lim_dmp_init  ***
       !!
-      !! ** Purpose :   Reads monthly ice thickness and fraction lead  data
+      !! ** Purpose :   Initialization for the ice thickness and concentration 
+      !!                restoring
+      !!              restoring will be used. It is used to mimic ice open
+      !!              boundaries.
       !!
-      !! ** Method  :   Read on unit numicedt the interpolated ice variable
-      !!      onto the model grid.
-      !!      Data begin at january.
-      !!      The value is centered at the middle of month.
-      !!      In the opa model, kt=1 agree with january 1.
-      !!      At each time step, a linear interpolation is applied between
-      !!      two monthly values.
+      !! ** Method  :  ?????
       !!      
-      !! ** Action  :   define hicif_dta and frld_dta arrays at time-step kt
+      !! ** Action  :   define resto_ice(:,:,1)
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt     ! ocean time-step
+      INTEGER  :: ji, jj, jk       ! dummy loop indices
+      INTEGER  :: irelax, ierror   ! error flag for allocation
       !
-      INTEGER  ::   imois, iman, i15          ! temporary integers
-      REAL(wp) ::   zxy
+      REAL(wp) :: zdmpmax, zdmpmin, zfactor, zreltim ! temporary scalar
+      !
+      CHARACTER(len=100)           ::   cn_dir       ! Root directory for location of ssr files
+      TYPE(FLD_N), DIMENSION (2)   ::   sl_icedmp    ! informations about the icedmp  field to be read
+      TYPE(FLD_N)                  ::   sn_hicif     ! 
+      TYPE(FLD_N)                  ::   sn_frld      ! 
+      NAMELIST/namice_dmp/ cn_dir, ln_limdmp, sn_hicif, sn_frld
       !!----------------------------------------------------------------------
+      !
+      ! 1)  initialize fld read structure for input data 
+      !     --------------------------------------------
+      ln_limdmp = .false.                 !* set file information (default values)
+      cn_dir    = './'
+      ! (NB: frequency positive => hours, negative => months)
+      !                !    file     ! frequency ! variable ! time intep !  clim   ! 'yearly' or ! weights  ! rotation !
+      !                !    name     !  (hours)  !  name    !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs    !
+      sn_hicif = FLD_N( 'ice_damping ', -1       , 'hicif'  ,  .true.    , .true.  ,  'yearly'   ,  ''      ,  ''      )
+      sn_frld  = FLD_N( 'ice_damping ', -1       , 'frld'   ,  .true.    , .true.  ,  'yearly'   ,  ''      ,  ''      )
 
-      ! 0. Initialization
-      ! -----------------
-      iman  = INT( raamo )
-!!! better but change the results     i15 = INT( 2*FLOAT( nday ) / ( FLOAT( nobis(nmonth) ) + 0.5 ) )
-      i15   = nday / 16
-      imois = nmonth + i15 - 1
-      IF( imois == 0 ) imois = iman
-      
-      ! 1. First call kt=nit000: Initialization and Open
-      ! -----------------------
-      IF( kt == nit000 ) THEN
-         nice1 = 0
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'dtalim : Ice thickness and lead fraction  monthly fields'
-         IF(lwp) WRITE(numout,*) '~~~~~~'
-         IF(lwp) WRITE(numout,*) '             NetCDF FORMAT'
-         IF(lwp) WRITE(numout,*)
-         ! open file
-         CALL iom_open( 'ice_damping_ATL4.nc', inumice_dmp )
+      REWIND( numnam_ice )                !* read in namelist_ice namicedmp
+      READ  ( numnam_ice, namice_dmp )
+      !
+      IF ( lwp ) THEN                     !* control print
+         WRITE (numout,*)'     lim_dmp_init : lim_dmp initialization ' 
+         WRITE (numout,*)'       Namelist namicedmp read '
+         WRITE (numout,*)'         Ice restoring (T) or not (F) ln_limdmp =', ln_limdmp 
+         WRITE (numout,*)
+         WRITE (numout,*)'     CAUTION : here hard coded ice restoring along northern and southern boundaries'
+         WRITE (numout,*)'               adapt the lim_dmp_init routine to your needs'
       ENDIF
 
+      ! 2)  initialise resto_ice    ==>  config dependant !
+      !     --------------------         ++++++++++++++++
+      !
+      IF( ln_limdmp ) THEN                !* ice restoring is used, follow initialization
+         ! 
+         sl_icedmp ( jp_hicif ) = sn_hicif
+         sl_icedmp ( jp_frld  ) = sn_frld
+         ALLOCATE ( sf_icedmp (2) , resto_ice(jpi,jpj,1), STAT=ierror )
+         IF( ierror > 0 ) THEN
+            CALL ctl_stop( 'lim_dmp_init: unable to allocate sf_icedmp structure or resto_ice array' )   ;   RETURN
+         ENDIF
+         ALLOCATE( sf_icedmp(jp_hicif)%fnow(jpi,jpj,1) , sf_icedmp(jp_hicif)%fdta(jpi,jpj,1,2) )
+         ALLOCATE( sf_icedmp(jp_frld )%fnow(jpi,jpj,1) , sf_icedmp(jp_frld )%fdta(jpi,jpj,1,2) )
+         !                         ! fill sf_icedmp with sn_icedmp and control print
+         CALL fld_fill( sf_icedmp, sl_icedmp, cn_dir, 'lim_dmp_init', 'Ice  restoring input data', 'namicedmp' )
+      
+         resto_ice(:,:,:) = 0._wp
+         !      Re-calculate the North and South boundary restoring term
+         !      because those boundaries may change with the prescribed zoom area.
+         !
+         irelax  = 16                     ! width of buffer zone with respect to close boundary
+         zdmpmax = 10._wp                 ! max restoring time scale  (days) (low restoring)
+         zdmpmin = rdt_ice / 86400._wp    ! min restoring time scale  (days) (high restoring)
+         !                                ! days / grid-point
+         zfactor = ( zdmpmax - zdmpmin ) / REAL( irelax, wp )
 
-      ! 2. Read monthly file
-      ! --------------------
-      IF( ( kt == nit000 ) .OR. imois /= nice1 ) THEN
-         !
-         ! Calendar computation
-         nice1 = imois        ! first file record used 
-         nice2 = nice1 + 1    ! last  file record used
-         nice1 = MOD( nice1, iman )
-         nice2 = MOD( nice2, iman )
-         IF( nice1 == 0 )   nice1 = iman
-         IF( nice2 == 0 )   nice2 = iman
-         IF(lwp) WRITE(numout,*) 'first record file used nice1 ', nice1
-         IF(lwp) WRITE(numout,*) 'last  record file used nice2 ', nice2
-         
-         ! Read monthly ice thickness Levitus 
-         CALL iom_get( inumice_dmp, jpdom_data, 'iicethic', hicif_data(:,:,1), nice1 ) 
-         CALL iom_get( inumice_dmp, jpdom_data, 'iicethic', hicif_data(:,:,2), nice2 ) 
-         
-         ! Read monthly ice thickness Levitus 
-         CALL iom_get( inumice_dmp, jpdom_data, 'ileadfra', frld_data(:,:,1), nice1 ) 
-         CALL iom_get( inumice_dmp, jpdom_data, 'ileadfra', frld_data(:,:,2), nice2 ) 
-         
-         ! The fraction lead read in the file is in fact the 
-         ! ice concentration which is 1 - the fraction lead
-         frld_data = 1 - frld_data          
-         
-         IF(lwp) THEN
-            WRITE(numout,*)
-            WRITE(numout,*) ' Ice thickness month ', nice1,' and ', nice2
-            WRITE(numout,*)
-            WRITE(numout,*) ' Ice thickness month = ', nice1
-            CALL prihre( hicif_data(1,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
-            WRITE(numout,*)
-            WRITE(numout,*) ' Fraction lead months ', nice1,' and ', nice2
-            WRITE(numout,*)
-            WRITE(numout,*) ' Fraction lead month = ', nice1
-            CALL prihre( frld_data(1,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
-         ENDIF
+         !    South boundary restoring term
+         ! REM: if there is no ice in the model and in the data, 
+         !      no restoring even with non zero resto_ice
+         DO jj = mj0(jpjzoom - 1 + 1), mj1(jpjzoom -1 + irelax)
+            zreltim = zdmpmin + zfactor * ( mjg(jj) - jpjzoom + 1 )
+            resto_ice(:,jj,:) = 1._wp / ( zreltim * 86400._wp )
+         END DO
 
-         CALL FLUSH(numout)
-
+         ! North boundary restoring term
+         DO jj =  mj0(jpjzoom -1 + jpjglo - irelax), mj1(jpjzoom - 1 + jpjglo)
+            zreltim = zdmpmin + zfactor * (jpjglo - ( mjg(jj) - jpjzoom + 1 ))
+            resto_ice(:,jj,:) = 1.e0 / ( zreltim * 86400 )
+         END DO
       ENDIF
-        
-      ! 3. At every time step compute ice thickness and fraction lead data
-      ! ------------------------------------------------------------------
-      zxy = FLOAT( nday + 15 - 30 * i15 ) / 30.
-      hicif_dta(:,:) = (1.-zxy) * hicif_data(:,:,1) + zxy * hicif_data(:,:,2)
-      frld_dta (:,:) = (1.-zxy) * frld_data (:,:,1) + zxy * frld_data (:,:,2)
-
-      IF( kt == nitend )   CALL iom_close( inumice_dmp )
       !
-   END SUBROUTINE dta_lim_2
-
+   END SUBROUTINE lim_dmp_init
+   
 #else
    !!----------------------------------------------------------------------
Index: trunk/NEMOGCM/NEMO/LIM_SRC_2/limdyn_2.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_2/limdyn_2.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_2/limdyn_2.F90	(revision 2528)
@@ -4,8 +4,9 @@
    !!   Sea-Ice dynamics :  
    !!======================================================================
-   !! History :   1.0  !  01-04  (LIM)  Original code
-   !!             2.0  !  02-08  (C. Ethe, G. Madec)  F90, mpp
-   !!             2.0  !  03-08  (C. Ethe) add lim_dyn_init
-   !!             2.0  !  06-07  (G. Madec)  Surface module
+   !! History :  1.0  ! 2001-04  (LIM)  Original code
+   !!            2.0  ! 2002-08  (C. Ethe, G. Madec)  F90, mpp
+   !!            2.0  ! 2003-08  (C. Ethe) add lim_dyn_init
+   !!            2.0  ! 2006-07  (G. Madec)  Surface module
+   !!            3.3  ! 2009-05 (G. Garric, C. Bricaud) addition of the lim2_evp case
    !!---------------------------------------------------------------------
 #if defined key_lim2
@@ -16,32 +17,30 @@
    !!    lim_dyn_init_2 : initialization and namelist read
    !!----------------------------------------------------------------------
-   USE dom_oce        ! ocean space and time domain
-   USE sbc_oce        !
-   USE phycst         !
-   USE ice_2          !
-   USE dom_ice_2      !
-   USE limistate_2    !
-   USE limrhg_2       ! ice rheology
-
-   USE lbclnk         !
-   USE lib_mpp        !
-   USE in_out_manager ! I/O manager
-   USE prtctl         ! Print control
+   USE dom_oce          ! ocean space and time domain
+   USE sbc_oce          ! ocean surface boundary condition
+   USE phycst           ! physical constant
+   USE ice_2            ! LIM-2: ice variables
+   USE sbc_ice          ! Surface boundary condition: sea-ice fields
+   USE dom_ice_2        ! LIM-2: ice domain
+   USE limistate_2      ! LIM-2: initial state
+   USE limrhg_2         ! LIM-2: VP  ice rheology
+   USE limrhg           ! LIM  : EVP ice rheology
+   USE lbclnk           ! lateral boundary condition - MPP link
+   USE lib_mpp          ! MPP library
+   USE in_out_manager   ! I/O manager
+   USE prtctl           ! Print control
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   lim_dyn_2 ! routine called by sbc_ice_lim
-
-   !! * Module variables
-   REAL(wp)  ::  rone    = 1.e0   ! constant value
-
+   PUBLIC   lim_dyn_2   ! routine called by sbc_ice_lim
+
+   !! * Substitutions
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2006) 
+   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
@@ -83,9 +82,11 @@
          ! ---------------------------------------------------
          
-         IF( lk_mpp .OR. nbit_cmp == 1 ) THEN                    ! mpp: compute over the whole domain
+         IF( lk_mpp .OR. lk_mpp_rep ) THEN                    ! mpp: compute over the whole domain
             i_j1 = 1   
             i_jpj = jpj
             IF(ln_ctl)   CALL prt_ctl_info( 'lim_dyn  :    i_j1 = ', ivar1=i_j1, clinfo2=' ij_jpj = ', ivar2=i_jpj )
-            CALL lim_rhg_2( i_j1, i_jpj )
+            IF( lk_lim2_vp )   THEN   ;   CALL lim_rhg_2( i_j1, i_jpj )             !  VP rheology
+            ELSE                      ;   CALL lim_rhg  ( i_j1, i_jpj )             ! EVP rheology
+            ENDIF
             !
          ELSE                                 ! optimization of the computational area
@@ -105,9 +106,13 @@
                   i_j1 = i_j1 + 1
                END DO
-               i_j1 = MAX( 1, i_j1-1 )
-               IF(ln_ctl)   WRITE(numout,*) 'lim_dyn : NH i_j1 = ', i_j1, ' ij_jpj = ', i_jpj
-               ! 
-               CALL lim_rhg_2( i_j1, i_jpj )
-               ! 
+               IF( lk_lim2_vp )   THEN             ! VP  rheology
+                  i_j1 = MAX( 1, i_j1-1 )
+                  CALL lim_rhg_2( i_j1, i_jpj )
+               ELSE                                ! EVP rheology
+                  i_j1 = MAX( 1, i_j1-2 )
+                  CALL lim_rhg( i_j1, i_jpj )
+               ENDIF
+               IF(ln_ctl)   WRITE(numout,*) 'lim_dyn : NH i_j1 = ', i_j1, 'ij_jpj = ', i_jpj
+               !
                ! Southern hemisphere
                i_j1  =  1 
@@ -116,9 +121,13 @@
                   i_jpj = i_jpj - 1
                END DO
-               i_jpj = MIN( jpj, i_jpj+2 )
-               IF(ln_ctl)   WRITE(numout,*) 'lim_dyn : SH i_j1 = ', i_j1, ' ij_jpj = ', i_jpj
-               ! 
-               CALL lim_rhg_2( i_j1, i_jpj )
-               ! 
+               IF( lk_lim2_vp )   THEN             ! VP  rheology
+                  i_jpj = MIN( jpj, i_jpj+2 )
+                  CALL lim_rhg_2( i_j1, i_jpj )
+               ELSE                                ! EVP rheology
+                  i_jpj = MIN( jpj, i_jpj+1 )
+                  CALL lim_rhg( i_j1, i_jpj )
+               ENDIF
+               IF(ln_ctl)   WRITE(numout,*) 'lim_dyn : SH i_j1 = ', i_j1, 'ij_jpj = ', i_jpj
+               !
             ELSE                                 ! local domain extends over one hemisphere only
                !                                 ! Rheology is computed only over the ice cover
@@ -134,9 +143,15 @@
                   i_jpj = i_jpj - 1
                END DO
-               i_jpj = MIN( jpj, i_jpj+2)
-    
+               i_jpj = MIN( jpj, i_jpj+2 )
+               ! 
+               IF( lk_lim2_vp )   THEN             ! VP  rheology
+                  i_jpj = MIN( jpj, i_jpj+2 )
+                  CALL lim_rhg_2( i_j1, i_jpj )                !  VP rheology
+               ELSE                                ! EVP rheology
+                  i_j1  = MAX( 1  , i_j1-2  )
+                  i_jpj = MIN( jpj, i_jpj+1 )
+                  CALL lim_rhg  ( i_j1, i_jpj )                ! EVP rheology
+               ENDIF
                IF(ln_ctl)   WRITE(numout,*) 'lim_dyn : one hemisphere: i_j1 = ', i_j1, ' ij_jpj = ', i_jpj
-               ! 
-               CALL lim_rhg_2( i_j1, i_jpj )
                !
             ENDIF
@@ -148,18 +163,23 @@
          ! computation of friction velocity
          ! --------------------------------
-         ! ice-ocean velocity at U & V-points (u_ice v_ice at I-point ; ssu_m, ssv_m at U- & V-points)
-         
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1   ! NO vector opt.
-               zu_io(ji,jj) = 0.5 * ( u_ice(ji+1,jj+1) + u_ice(ji+1,jj  ) ) - ssu_m(ji,jj)
-               zv_io(ji,jj) = 0.5 * ( v_ice(ji+1,jj+1) + v_ice(ji  ,jj+1) ) - ssv_m(ji,jj)
-            END DO
-         END DO
+         SELECT CASE( cp_ice_msh )           ! ice-ocean relative velocity at u- & v-pts
+         CASE( 'C' )                               ! EVP : C-grid ice dynamics
+            zu_io(:,:) = u_ice(:,:) - ssu_m(:,:)           ! ice-ocean & ice velocity at ocean velocity points
+            zv_io(:,:) = v_ice(:,:) - ssv_m(:,:)
+         CASE( 'I' )                               ! VP  : B-grid ice dynamics (I-point) 
+            DO jj = 1, jpjm1                               ! u_ice v_ice at I-point ; ssu_m, ssv_m at U- & V-points
+               DO ji = 1, jpim1   ! NO vector opt.         !
+                  zu_io(ji,jj) = 0.5_wp * ( u_ice(ji+1,jj+1) + u_ice(ji+1,jj  ) ) - ssu_m(ji,jj)
+                  zv_io(ji,jj) = 0.5_wp * ( v_ice(ji+1,jj+1) + v_ice(ji  ,jj+1) ) - ssv_m(ji,jj)
+               END DO
+            END DO
+         END SELECT
+
          ! frictional velocity at T-point
+         zcoef = 0.5_wp * cw
          DO jj = 2, jpjm1
             DO ji = 2, jpim1   ! NO vector opt. because of zu_io
-               ust2s(ji,jj) = 0.5 * cw                                                          &
-                  &         * (  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)
+               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)
             END DO
          END DO
@@ -170,6 +190,6 @@
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               ust2s(ji,jj) = zcoef * tms(ji,jj) * 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) )
+               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)
             END DO
          END DO
@@ -180,5 +200,5 @@
       !
       IF(ln_ctl)   CALL prt_ctl(tab2d_1=ust2s , clinfo1=' lim_dyn  : ust2s :')
-
+      !
    END SUBROUTINE lim_dyn_2
 
@@ -198,5 +218,6 @@
       NAMELIST/namicedyn/ epsd, alpha,     &
          &                dm, nbiter, nbitdr, om, resl, cw, angvg, pstar,   &
-         &                c_rhg, etamn, creepl, ecc, ahi0
+         &                c_rhg, etamn, creepl, ecc, ahi0,                  &
+         &                nevp, telast,alphaevp
       !!-------------------------------------------------------------------
 
@@ -223,4 +244,13 @@
          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,*) '       timescale for elastic waves telast = ', telast
+         WRITE(numout,*) '       coefficient for the solution of int. stresses alphaevp = ', alphaevp
+      ENDIF
+      !
+      IF( angvg /= 0._wp .AND. .NOT.lk_lim2_vp ) THEN
+         CALL ctl_warn( 'lim_dyn_init_2: turning angle for oceanic stress not properly coded for EVP ',   &
+            &           '(see limsbc_2 module). We force  angvg = 0._wp'  )
+         angvg = 0._wp
       ENDIF
 
Index: trunk/NEMOGCM/NEMO/LIM_SRC_2/limhdf_2.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_2/limhdf_2.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_2/limhdf_2.F90	(revision 2528)
@@ -32,7 +32,7 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005) 
+   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/LIM_SRC_2/limistate_2.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_2/limistate_2.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_2/limistate_2.F90	(revision 2528)
@@ -46,7 +46,7 @@
    REAL(wp) ::   zone      = 1.e0     ! constant value = 1
    !!----------------------------------------------------------------------
-   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2006) 
+   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/LIM_SRC_2/limmsh_2.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_2/limmsh_2.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_2/limmsh_2.F90	(revision 2528)
@@ -4,4 +4,8 @@
    !! LIM 2.0 ice model :   definition of the ice mesh parameters
    !!======================================================================
+   !! History :   -   ! 2001-04 (LIM) original code
+   !!            1.0  ! 2002-08 (C. Ethe, G. Madec) F90, module
+   !!            3.3  ! 2009-05 (G. Garric, C. Bricaud) addition of the lim2_evp case
+   !!----------------------------------------------------------------------
 #if defined key_lim2
    !!----------------------------------------------------------------------
@@ -10,5 +14,4 @@
    !!   lim_msh_2   : definition of the ice mesh
    !!----------------------------------------------------------------------
-   !! * Modules used
    USE phycst
    USE dom_oce
@@ -20,13 +23,11 @@
    PRIVATE
 
-   !! * Accessibility
    PUBLIC lim_msh_2      ! routine called by ice_ini_2.F90
 
    !!----------------------------------------------------------------------
-   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005) 
+   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
@@ -43,19 +44,13 @@
       !! 
       !! ** Refer.  : Deleersnijder et al. Ocean Modelling 100, 7-10 
-      !!
-      !! ** History :
-      !!         original    : 01-04 (LIM)
-      !!         addition    : 02-08 (C. Ethe, G. Madec)
       !!--------------------------------------------------------------------- 
-      !! * Local variables
       INTEGER :: ji, jj      ! dummy loop indices
-
-      REAL(wp), DIMENSION(jpi,jpj) ::  &
-         zd2d1 , zd1d2       ! Derivative of zh2 (resp. zh1) in the x direction
-         !                   ! (resp. y direction) (defined at the center)
-      REAL(wp) ::         &
-         zh1p  , zh2p   , &  ! Idem zh1, zh2 for the bottom left corner of the grid
-         zd2d1p, zd1d2p , &  ! Idem zd2d1, zd1d2 for the bottom left corner of the grid
-         zusden, zusden2     ! temporary scalars
+      REAL(wp) ::   zusden   ! local scalars
+#if defined key_lim2_vp
+      REAL(wp) ::   zusden2           ! local scalars
+      REAL(wp) ::   zh1p  , zh2p      !   -      -
+      REAL(wp) ::   zd2d1p, zd1d2p    !   -      -
+      REAL(wp), DIMENSION(jpi,jpj) ::   zd2d1 , zd1d2   ! 2D workspace
+#endif
       !!---------------------------------------------------------------------
 
@@ -76,5 +71,5 @@
       njeqm1 = njeq - 1 
 
-      fcor(:,:) = 2. * omega * SIN( gphit(:,:) * rad )   !  coriolis factor
+      fcor(:,:) = 2. * omega * SIN( gphit(:,:) * rad )   !  coriolis factor at T-point
  
 !i    DO jj = 1, jpj
@@ -115,11 +110,17 @@
       !-------------------
 !!ibug ???
-      akappa(:,:,:,:) = 0.e0
       wght(:,:,:,:) = 0.e0
+      tmu(:,:)      = 0.e0
+#if defined key_lim2_vp 
+      akappa(:,:,:,:)     = 0.e0
       alambd(:,:,:,:,:,:) = 0.e0
-      tmu(:,:) = 0.e0
+#else
+      tmv(:,:) = 0.e0
+      tmf(:,:) = 0.e0
+#endif
 !!i
       
-      
+
+#if defined key_lim2_vp      
       ! metric coefficients for sea ice dynamic
       !----------------------------------------
@@ -155,8 +156,25 @@
       CALL lbc_lnk( wght(:,:,2,1), 'I', 1. )      ! but it is never used
       CALL lbc_lnk( wght(:,:,2,2), 'I', 1. )
+#else
+      ! metric coefficients for sea ice dynamic (EVP rheology)
+      !----------------------------------------
+      DO jj = 1, jpjm1                                       ! weights (wght) at F-points
+         DO ji = 1, jpim1
+            zusden = 1. / (  ( e1t(ji+1,jj  ) + e1t(ji,jj) )   &
+               &           * ( e2t(ji  ,jj+1) + e2t(ji,jj) ) ) 
+            wght(ji,jj,1,1) = zusden * e1t(ji+1,jj) * e2t(ji,jj+1)
+            wght(ji,jj,1,2) = zusden * e1t(ji+1,jj) * e2t(ji,jj  )
+            wght(ji,jj,2,1) = zusden * e1t(ji  ,jj) * e2t(ji,jj+1)
+            wght(ji,jj,2,2) = zusden * e1t(ji  ,jj) * e2t(ji,jj  )
+         END DO
+      END DO
+      CALL lbc_lnk( wght(:,:,1,1), 'F', 1. )   ;   CALL lbc_lnk( wght(:,:,1,2),'F', 1. )       ! lateral boundary cond.   
+      CALL lbc_lnk( wght(:,:,2,1), 'F', 1. )   ;   CALL lbc_lnk( wght(:,:,2,2),'F', 1. )
+#endif
     
       ! Coefficients for divergence of the stress tensor
       !-------------------------------------------------
 
+#if defined key_lim2_vp
       DO jj = 2, jpj
          DO ji = 2, jpi   ! NO vector opt.
@@ -226,4 +244,5 @@
       CALL lbc_lnk( alambd(:,:,2,1,1,1), 'I', 1. )      !
       CALL lbc_lnk( alambd(:,:,2,1,1,2), 'I', 1. )      !
+#endif
             
 
@@ -233,4 +252,6 @@
       tms(:,:) = tmask(:,:,1)      ! ice T-point  : use surface tmask
 
+#if defined key_lim2_vp
+      ! VP rheology : ice velocity point is I-point
 !i here we can use umask with a i and j shift of -1,-1
       tmu(:,1) = 0.e0
@@ -241,11 +262,17 @@
          END DO
       END DO
-      
-      !--lateral boundary conditions    
-      CALL lbc_lnk( tmu(:,:), 'I', 1. )
-      
+      CALL lbc_lnk( tmu(:,:), 'I', 1. )      !--lateral boundary conditions    
+#else
+      ! EVP rheology : ice velocity point are U- & V-points ; ice vorticity
+      ! point is F-point
+      tmu(:,:) = umask(:,:,1)
+      tmv(:,:) = vmask(:,:,1)
+      tmf(:,:) = 0.e0                        ! used of fmask except its special value along the coast (rn_shlat)
+      WHERE( fmask(:,:,1) == 1.e0 )   tmf(:,:) = 1.e0
+#endif
+      !
       ! unmasked and masked area of T-grid cell
       area(:,:) = e1t(:,:) * e2t(:,:)
-      
+      !
    END SUBROUTINE lim_msh_2
 
Index: trunk/NEMOGCM/NEMO/LIM_SRC_2/limrhg.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_2/limrhg.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_2/limrhg.F90	(revision 2528)
@@ -0,0 +1,1 @@
+link ../LIM_SRC_3/limrhg.F90
Index: trunk/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90	(revision 2528)
@@ -4,14 +4,15 @@
    !!   Ice rheology :  performs sea ice rheology
    !!======================================================================
-   !! History :  0.0  !  93-12  (M.A. Morales Maqueda.)  Original code
-   !!            1.0  !  94-12  (H. Goosse) 
-   !!            2.0  !  03-12  (C. Ethe, G. Madec)  F90, mpp
-   !!            " "  !  06-08  (G. Madec)  surface module, ice-stress at I-point
-   !!            " "  !  09-09  (G. Madec)  Huge verctor optimisation
-   !!----------------------------------------------------------------------
-#if defined key_lim2
-   !!----------------------------------------------------------------------
-   !!   'key_lim2'                                    LIM 2.0 sea-ice model
-   !!----------------------------------------------------------------------
+   !! History :  0.0  !  1993-12  (M.A. Morales Maqueda.)  Original code
+   !!            1.0  !  1994-12  (H. Goosse) 
+   !!            2.0  !  2003-12  (C. Ethe, G. Madec)  F90, mpp
+   !!             -   !  2006-08  (G. Madec)  surface module, ice-stress at I-point
+   !!             -   !  2009-09  (G. Madec)  Huge verctor optimisation
+   !!            3.3  !  2009-05  (G.Garric, C. Bricaud) addition of the lim2_evp case
+   !!----------------------------------------------------------------------
+#if defined   key_lim2   &&   defined key_lim2_vp
+   !!----------------------------------------------------------------------
+   !!   'key_lim2'                AND                   LIM-2 sea-ice model
+   !!   'key_lim2_vp'                                       VP ice rheology
    !!----------------------------------------------------------------------
    !!   lim_rhg_2   : computes ice velocities
@@ -21,8 +22,8 @@
    USE sbc_oce        ! surface boundary condition: ocean variables
    USE sbc_ice        ! surface boundary condition: ice variables
-   USE dom_ice_2      ! domaine: ice variables
+   USE dom_ice_2      ! LIM2: ice domain
    USE phycst         ! physical constant
-   USE ice_2          ! ice variables
-   USE lbclnk         ! lateral boundary condition
+   USE ice_2          ! LIM2: ice variables
+   USE lbclnk         ! lateral boundary condition - MPP exchanges
    USE lib_mpp        ! MPP library
    USE in_out_manager ! I/O manager
@@ -34,15 +35,14 @@
    PUBLIC   lim_rhg_2 ! routine called by lim_dyn
 
-   REAL(wp) ::   rzero   = 0.e0   ! constant value: zero
-   REAL(wp) ::   rone    = 1.e0   !            and  one
+   REAL(wp) ::   rzero   = 0._wp   ! constant value: zero
+   REAL(wp) ::   rone    = 1._wp   !            and  one
 
    !! * Substitutions
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2006) 
+   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
@@ -65,9 +65,9 @@
       INTEGER ::   iter, jter          ! temporary integers
       CHARACTER (len=50) ::   charout
-      REAL(wp) ::   ze11  , ze12  , ze22  , ze21               ! temporary scalars
-      REAL(wp) ::   zt11  , zt12  , zt21  , zt22               !    "         "
-      REAL(wp) ::   zvis11, zvis21, zvis12, zvis22             !    "         "
-      REAL(wp) ::   zgphsx, ztagnx, zgsshx, zunw, zur, zusw    !    "         "
-      REAL(wp) ::   zgphsy, ztagny, zgsshy, zvnw, zvr          !    "         "
+      REAL(wp) ::   ze11  , ze12  , ze22  , ze21               ! local scalars
+      REAL(wp) ::   zt11  , zt12  , zt21  , zt22               !   -      -
+      REAL(wp) ::   zvis11, zvis21, zvis12, zvis22             !   -      -
+      REAL(wp) ::   zgphsx, ztagnx, zgsshx, zunw, zur, zusw    !   -      -
+      REAL(wp) ::   zgphsy, ztagny, zgsshy, zvnw, zvr          !   -      -
       REAL(wp) ::   zresm,  za, zac, zmod
       REAL(wp) ::   zmpzas, zstms, zindu, zusdtp, zmassdt, zcorlal
@@ -89,45 +89,37 @@
       REAL(wp), DIMENSION(jpi,0:jpj+1) ::   zzfrld, zztms
       REAL(wp), DIMENSION(jpi,0:jpj+1) ::   zi1, zi2, zmasst, zpresh
-
       !!-------------------------------------------------------------------
-
-!!bug
-!!    u_oce(:,:) = 0.e0
-!!    v_oce(:,:) = 0.e0
-!!    write(*,*) 'rhg min, max u & v', maxval(u_oce), minval(u_oce), maxval(v_oce), minval(v_oce)
-!!bug
       
       !  Store initial velocities
       !  ----------------
-      zztms(:,0    ) = 0.e0       ;    zzfrld(:,0    ) = 0.e0
-      zztms(:,jpj+1) = 0.e0       ;    zzfrld(:,jpj+1) = 0.e0
-      zu0(:,0    ) = 0.e0         ;    zv0(:,0    ) = 0.e0
-      zu0(:,jpj+1) = 0.e0         ;    zv0(:,jpj+1) = 0.e0
-      zztms(:,1:jpj) = tms(:,:)   ;    zzfrld(:,1:jpj) = frld(:,:)
-      zu0(:,1:jpj) = u_ice(:,:)   ;    zv0(:,1:jpj) = v_ice(:,:)
-
-      zu_a(:,:)    = zu0(:,:)     ;   zv_a(:,:) = zv0(:,:)
-      zu_n(:,:)    = zu0(:,:)     ;   zv_n(:,:) = zv0(:,:)
+      zztms(:,0    ) = 0._wp        ;   zzfrld(:,0    ) = 0._wp
+      zztms(:,jpj+1) = 0._wp        ;   zzfrld(:,jpj+1) = 0._wp
+      zu0  (:,0    ) = 0._wp        ;   zv0   (:,0    ) = 0._wp
+      zu0  (:,jpj+1) = 0._wp        ;   zv0   (:,jpj+1) = 0._wp
+      zztms(:,1:jpj) = tms  (:,:)   ;   zzfrld(:,1:jpj) = frld (:,:)
+      zu0  (:,1:jpj) = u_ice(:,:)   ;   zv0   (:,1:jpj) = v_ice(:,:)
+      zu_a (:, :   ) = zu0  (:,:)   ;   zv_a  (:, :   ) = zv0  (:,:)
+      zu_n (:, :   ) = zu0  (:,:)   ;   zv_n  (:, :   ) = zv0  (:,:)
 
 !i
-      zi1   (:,:) = 0.e0
-      zi2   (:,:) = 0.e0
-      zpresh(:,:) = 0.e0
-      zmasst(:,:) = 0.e0
+      zi1   (:,:) = 0._wp
+      zi2   (:,:) = 0._wp
+      zpresh(:,:) = 0._wp
+      zmasst(:,:) = 0._wp
 !i
 !!gm violant
-      zfrld(:,:) =0.e0
-      zcorl(:,:) =0.e0
-      zmass(:,:) =0.e0
-      za1ct(:,:) =0.e0
-      za2ct(:,:) =0.e0
+      zfrld(:,:) =0._wp
+      zcorl(:,:) =0._wp
+      zmass(:,:) =0._wp
+      za1ct(:,:) =0._wp
+      za2ct(:,:) =0._wp
 !!gm end
 
-      zviszeta(:,:) = 0.e0
-      zviseta (:,:) = 0.e0
-
-!i    zviszeta(:,0    ) = 0.e0    ;    zviseta(:,0    ) = 0.e0
-!i    zviszeta(:,jpj  ) = 0.e0    ;    zviseta(:,jpj  ) = 0.e0
-!i    zviszeta(:,jpj+1) = 0.e0    ;    zviseta(:,jpj+1) = 0.e0
+      zviszeta(:,:) = 0._wp
+      zviseta (:,:) = 0._wp
+
+!i    zviszeta(:,0    ) = 0._wp    ;    zviseta(:,0    ) = 0._wp
+!i    zviszeta(:,jpj  ) = 0._wp    ;    zviseta(:,jpj  ) = 0._wp
+!i    zviszeta(:,jpj+1) = 0._wp    ;    zviseta(:,jpj+1) = 0._wp
 
 
@@ -141,11 +133,11 @@
          DO ji = 1 , jpi
             ! only the sinus changes its sign with the hemisphere
-            zsang(ji,jj)  = SIGN( 1.e0, fcor(ji,jj) ) * sangvg   ! only the sinus changes its sign with the hemisphere
+            zsang(ji,jj)  = SIGN( 1._wp, fcor(ji,jj) ) * sangvg   ! only the sinus changes its sign with the hemisphere
             !
             zmasst(ji,jj) = tms(ji,jj) * ( rhosn * hsnm(ji,jj) + rhoic * hicm(ji,jj) )
             zpresh(ji,jj) = tms(ji,jj) *  pstarh * hicm(ji,jj) * EXP( -c_rhg * frld(ji,jj) )
 !!gm  :: stress given at I-point (F-point for the ocean) only compute the ponderation with the ice fraction (1-frld)
-            zi1(ji,jj)    = tms(ji,jj) * ( 1.0 - frld(ji,jj) )
-            zi2(ji,jj)    = tms(ji,jj) * ( 1.0 - frld(ji,jj) )
+            zi1(ji,jj)    = tms(ji,jj) * ( 1._wp - frld(ji,jj) )
+            zi2(ji,jj)    = tms(ji,jj) * ( 1._wp - frld(ji,jj) )
          END DO
       END DO
@@ -161,5 +153,5 @@
             zstms = zztms(ji,jj  ) * wght(ji,jj,2,2) + zztms(ji-1,jj  ) * wght(ji,jj,1,2)   &
                &  + zztms(ji,jj-1) * wght(ji,jj,2,1) + zztms(ji-1,jj-1) * wght(ji,jj,1,1)
-            zusw  = 1.0 / MAX( zstms, epsd )
+            zusw  = 1._wp / MAX( zstms, epsd )
 
             zt11 = zztms(ji  ,jj  ) * zzfrld(ji  ,jj  ) 
@@ -199,7 +191,7 @@
             ! Gradient of the sea surface height
             zgsshx =  (   (ssh_m(ji  ,jj  ) - ssh_m(ji-1,jj  ))/e1u(ji-1,jj  )   &
-               &       +  (ssh_m(ji  ,jj-1) - ssh_m(ji-1,jj-1))/e1u(ji-1,jj-1)   ) * 0.5
+               &       +  (ssh_m(ji  ,jj-1) - ssh_m(ji-1,jj-1))/e1u(ji-1,jj-1)   ) * 0.5_wp
             zgsshy =  (   (ssh_m(ji  ,jj  ) - ssh_m(ji  ,jj-1))/e2v(ji  ,jj-1)   &
-               &       +  (ssh_m(ji-1,jj  ) - ssh_m(ji-1,jj-1))/e2v(ji-1,jj-1)   ) * 0.5
+               &       +  (ssh_m(ji-1,jj  ) - ssh_m(ji-1,jj-1))/e2v(ji-1,jj-1)   ) * 0.5_wp
 
             ! Computation of the velocity field taking into account the ice-ice interaction.                                 
@@ -217,5 +209,5 @@
          !                                                ! ==================== !        
          zindu = MOD( iter , 2 )
-         zusdtp = ( zindu * 2.0 + ( 1.0 - zindu ) * 1.0 )  * REAL( nbiter ) / rdt_ice
+         zusdtp = ( zindu * 2._wp + ( 1._wp - zindu ) * 1._wp )  * REAL( nbiter ) / rdt_ice
 
          ! Computation of free drift field for free slip boundary conditions.
@@ -239,8 +231,8 @@
                zdgi = zt12 + zt21
                ztrace2 = zdgp * zdgp 
-               zdeter  = zt11 * zt22 - 0.25 * zdgi * zdgi
+               zdeter  = zt11 * zt22 - 0.25_wp * zdgi * zdgi
 
                !  Creep limit depends on the size of the grid.
-               zdelta = MAX( SQRT( ztrace2 + ( ztrace2 - 4.0 * zdeter ) * usecc2 ),  creepl)
+               zdelta = MAX( SQRT( ztrace2 + ( ztrace2 - 4._wp * zdeter ) * usecc2 ),  creepl)
 
                !-  Computation of viscosities.
@@ -254,8 +246,8 @@
             DO ji = 2, fs_jpim1   ! NO vector opt.
                !* zc1u , zc2v
-               zvis11 = 2.0 * zviseta (ji-1,jj-1) + dm
-               zvis12 =       zviseta (ji-1,jj-1) + dm
-               zvis21 =       zviseta (ji-1,jj-1)
-               zvis22 =       zviszeta(ji-1,jj-1) - zviseta(ji-1,jj-1)
+               zvis11 = 2._wp * zviseta (ji-1,jj-1) + dm
+               zvis12 =         zviseta (ji-1,jj-1) + dm
+               zvis21 =         zviseta (ji-1,jj-1)
+               zvis22 =         zviszeta(ji-1,jj-1) - zviseta(ji-1,jj-1)
                zdiag  = zvis22 * ( akappa(ji-1,jj-1,1,1) + akappa(ji-1,jj-1,2,1) )
                zs11_11 =  zvis11 * akappa(ji-1,jj-1,1,1) + zdiag
@@ -264,8 +256,8 @@
                zs22_11 =  zvis11 * akappa(ji-1,jj-1,2,1) + zdiag
 
-               zvis11 = 2.0 * zviseta (ji,jj-1) + dm
-               zvis22 =       zviszeta(ji,jj-1) - zviseta(ji,jj-1)
-               zvis12 =       zviseta (ji,jj-1) + dm
-               zvis21 =       zviseta (ji,jj-1)
+               zvis11 = 2._wp * zviseta (ji,jj-1) + dm
+               zvis22 =         zviszeta(ji,jj-1) - zviseta(ji,jj-1)
+               zvis12 =         zviseta (ji,jj-1) + dm
+               zvis21 =         zviseta (ji,jj-1)
                zdiag = zvis22 * ( -akappa(ji,jj-1,1,1) + akappa(ji,jj-1,2,1) )
                zs11_21 = -zvis11 * akappa(ji,jj-1,1,1) + zdiag
@@ -274,9 +266,9 @@
                zs21_21 = -zvis12 * akappa(ji,jj-1,1,2) + zvis21 * akappa(ji,jj-1,2,2)
 
-               zvis11 = 2.0 * zviseta (ji-1,jj) + dm
-               zvis22 =       zviszeta(ji-1,jj) - zviseta(ji-1,jj)
-               zvis12 =       zviseta (ji-1,jj) + dm
-               zvis21 =       zviseta (ji-1,jj)
-               zdiag = zvis22 * ( akappa(ji-1,jj,1,1) + akappa(ji-1,jj,2,1) )
+               zvis11 = 2._wp * zviseta (ji-1,jj) + dm
+               zvis22 =         zviszeta(ji-1,jj) - zviseta(ji-1,jj)
+               zvis12 =         zviseta (ji-1,jj) + dm
+               zvis21 =         zviseta (ji-1,jj)
+               zdiag  = zvis22 * ( akappa(ji-1,jj,1,1) + akappa(ji-1,jj,2,1) )
                zs11_12 =  zvis11 * akappa(ji-1,jj,1,1) + zdiag
                zs12_12 = -zvis12 * akappa(ji-1,jj,2,2) - zvis21 * akappa(ji-1,jj,1,2)
@@ -284,8 +276,8 @@
                zs21_12 = -zvis12 * akappa(ji-1,jj,1,2) - zvis21 * akappa(ji-1,jj,2,2)
 
-               zvis11 = 2.0 * zviseta (ji,jj) + dm
-               zvis22 =       zviszeta(ji,jj) - zviseta(ji,jj)
-               zvis12 =       zviseta (ji,jj) + dm
-               zvis21 =       zviseta (ji,jj)
+               zvis11 = 2._wp * zviseta (ji,jj) + dm
+               zvis22 =         zviszeta(ji,jj) - zviseta(ji,jj)
+               zvis12 =         zviseta (ji,jj) + dm
+               zvis21 =         zviseta (ji,jj)
                zdiag = zvis22 * ( -akappa(ji,jj,1,1) + akappa(ji,jj,2,1) )
                zs11_22 = -zvis11 * akappa(ji,jj,1,1) + zdiag
@@ -313,8 +305,8 @@
 
                !* zc1v , zc2v.
-               zvis11 = 2.0 * zviseta (ji-1,jj-1) + dm
-               zvis22 =       zviszeta(ji-1,jj-1) - zviseta(ji-1,jj-1)
-               zvis12 =       zviseta (ji-1,jj-1) + dm
-               zvis21 =       zviseta (ji-1,jj-1)
+               zvis11 = 2._wp * zviseta (ji-1,jj-1) + dm
+               zvis22 =         zviszeta(ji-1,jj-1) - zviseta(ji-1,jj-1)
+               zvis12 =         zviseta (ji-1,jj-1) + dm
+               zvis21 =         zviseta (ji-1,jj-1)
                zdiag = zvis22 * ( akappa(ji-1,jj-1,1,2) + akappa(ji-1,jj-1,2,2) )
                zs11_11 =  zvis11 * akappa(ji-1,jj-1,1,2) + zdiag
@@ -323,8 +315,8 @@
                zs21_11 =  zvis12 * akappa(ji-1,jj-1,1,1) - zvis21 * akappa(ji-1,jj-1,2,1)
  
-               zvis11 = 2.0 * zviseta (ji,jj-1) + dm
-               zvis22 =       zviszeta(ji,jj-1) - zviseta(ji,jj-1)
-               zvis12 =       zviseta (ji,jj-1) + dm
-               zvis21 =       zviseta (ji,jj-1)
+               zvis11 = 2._wp * zviseta (ji,jj-1) + dm
+               zvis22 =         zviszeta(ji,jj-1) - zviseta(ji,jj-1)
+               zvis12 =         zviseta (ji,jj-1) + dm
+               zvis21 =         zviseta (ji,jj-1)
                zdiag = zvis22 * ( akappa(ji,jj-1,1,2) + akappa(ji,jj-1,2,2) )
                zs11_21 =  zvis11 * akappa(ji,jj-1,1,2) + zdiag
@@ -333,8 +325,8 @@
                zs21_21 = -zvis12 * akappa(ji,jj-1,1,1) - zvis21 * akappa(ji,jj-1,2,1)
 
-               zvis11 = 2.0 * zviseta (ji-1,jj) + dm
-               zvis22 =       zviszeta(ji-1,jj) - zviseta(ji-1,jj)
-               zvis12 =       zviseta (ji-1,jj) + dm
-               zvis21 =       zviseta (ji-1,jj)
+               zvis11 = 2._wp * zviseta (ji-1,jj) + dm
+               zvis22 =         zviszeta(ji-1,jj) - zviseta(ji-1,jj)
+               zvis12 =         zviseta (ji-1,jj) + dm
+               zvis21 =         zviseta (ji-1,jj)
                zdiag = zvis22 * ( akappa(ji-1,jj,1,2) - akappa(ji-1,jj,2,2) )
                zs11_12 =  zvis11 * akappa(ji-1,jj,1,2) + zdiag
@@ -343,8 +335,8 @@
                zs21_12 =  zvis12 * akappa(ji-1,jj,1,1) - zvis21 * akappa(ji-1,jj,2,1)
 
-               zvis11 = 2.0 * zviseta (ji,jj) + dm
-               zvis22 =       zviszeta(ji,jj) - zviseta(ji,jj)
-               zvis12 =       zviseta (ji,jj) + dm
-               zvis21 =       zviseta (ji,jj)
+               zvis11 = 2._wp * zviseta (ji,jj) + dm
+               zvis22 =         zviszeta(ji,jj) - zviseta(ji,jj)
+               zvis12 =         zviseta (ji,jj) + dm
+               zvis21 =         zviseta (ji,jj)
                zdiag = zvis22 * ( akappa(ji,jj,1,2) - akappa(ji,jj,2,2) )
                zs11_22 =  zvis11 * akappa(ji,jj,1,2) + zdiag
@@ -386,8 +378,8 @@
                   ze22 = + akappa(ji,jj-1,2,2) * zv_a(ji+1,jj) + akappa(ji,jj-1,2,1) * zu_a(ji+1,jj)
                   ze21 =   akappa(ji,jj-1,1,1) * zv_a(ji+1,jj) - akappa(ji,jj-1,1,2) * zu_a(ji+1,jj)
-                  zvis11 = 2.0 * zviseta (ji,jj-1) + dm
-                  zvis22 =       zviszeta(ji,jj-1) - zviseta(ji,jj-1)
-                  zvis12 =       zviseta (ji,jj-1) + dm
-                  zvis21 =       zviseta (ji,jj-1)
+                  zvis11 = 2._wp * zviseta (ji,jj-1) + dm
+                  zvis22 =         zviszeta(ji,jj-1) - zviseta(ji,jj-1)
+                  zvis12 =         zviseta (ji,jj-1) + dm
+                  zvis21 =         zviseta (ji,jj-1)
                   zdiag = zvis22 * ( ze11 + ze22 )
                   zs11_21 =  zvis11 * ze11 + zdiag
@@ -404,8 +396,8 @@
                   ze21 =   akappa(ji-1,jj,1,1) * ( zv_a(ji  ,jj+1) - zv_a(ji-1,jj+1) )   &
                      &   - akappa(ji-1,jj,1,2) * ( zu_a(ji  ,jj+1) + zu_a(ji-1,jj+1) )
-                  zvis11 = 2.0 * zviseta (ji-1,jj) + dm
-                  zvis22 =       zviszeta(ji-1,jj) - zviseta(ji-1,jj)
-                  zvis12 =       zviseta (ji-1,jj) + dm
-                  zvis21 =       zviseta (ji-1,jj)
+                  zvis11 = 2._wp * zviseta (ji-1,jj) + dm
+                  zvis22 =         zviszeta(ji-1,jj) - zviseta(ji-1,jj)
+                  zvis12 =         zviseta (ji-1,jj) + dm
+                  zvis21 =         zviseta (ji-1,jj)
                   zdiag = zvis22 * ( ze11 + ze22 )
                   zs11_12 =  zvis11 * ze11 + zdiag
@@ -422,8 +414,8 @@
                   ze21 =   akappa(ji,jj,1,1) * ( zv_a(ji+1,jj) + zv_a(ji+1,jj+1) - zv_a(ji  ,jj+1) )   &
                      &   - akappa(ji,jj,1,2) * ( zu_a(ji+1,jj) + zu_a(ji+1,jj+1) + zu_a(ji  ,jj+1) )
-                  zvis11 = 2.0 * zviseta (ji,jj) + dm
-                  zvis22 =       zviszeta(ji,jj) - zviseta(ji,jj)
-                  zvis12 =       zviseta (ji,jj) + dm
-                  zvis21 =       zviseta (ji,jj)
+                  zvis11 = 2._wp * zviseta (ji,jj) + dm
+                  zvis22 =         zviszeta(ji,jj) - zviseta(ji,jj)
+                  zvis12 =         zviseta (ji,jj) + dm
+                  zvis21 =         zviseta (ji,jj)
                   zdiag = zvis22 * ( ze11 + ze22 )
                   zs11_22 =  zvis11 * ze11 + zdiag
@@ -441,8 +433,8 @@
                   ze21 =   akappa(ji-1,jj-1,1,1) * ( zv_a(ji  ,jj-1) - zv_a(ji-1,jj-1) - zv_a(ji-1,jj) )   &
                      &  -  akappa(ji-1,jj-1,1,2) * ( zu_a(ji  ,jj-1) + zu_a(ji-1,jj-1) + zu_a(ji-1,jj) )
-                  zvis11 = 2.0 * zviseta (ji-1,jj-1) + dm
-                  zvis22 =       zviszeta(ji-1,jj-1) - zviseta(ji-1,jj-1)
-                  zvis12 =       zviseta (ji-1,jj-1) + dm
-                  zvis21 =       zviseta (ji-1,jj-1)
+                  zvis11 = 2._wp * zviseta (ji-1,jj-1) + dm
+                  zvis22 =         zviszeta(ji-1,jj-1) - zviseta(ji-1,jj-1)
+                  zvis12 =         zviseta (ji-1,jj-1) + dm
+                  zvis21 =         zviseta (ji-1,jj-1)
                   zdiag = zvis22 * ( ze11 + ze22 )
                   zs11_11 =  zvis11 * ze11 + zdiag
@@ -459,8 +451,8 @@
                   ze21 =   akappa(ji,jj-1,1,1) * ( zv_a(ji+1,jj-1) - zv_a(ji  ,jj-1) )   &
                      &   - akappa(ji,jj-1,1,2) * ( zu_a(ji+1,jj-1) + zu_a(ji  ,jj-1) )
-                  zvis11 = 2.0 * zviseta (ji,jj-1) + dm
-                  zvis22 =       zviszeta(ji,jj-1) - zviseta(ji,jj-1)
-                  zvis12 =       zviseta (ji,jj-1) + dm
-                  zvis21 =       zviseta (ji,jj-1)
+                  zvis11 = 2._wp * zviseta (ji,jj-1) + dm
+                  zvis22 =         zviszeta(ji,jj-1) - zviseta(ji,jj-1)
+                  zvis12 =         zviseta (ji,jj-1) + dm
+                  zvis21 =         zviseta (ji,jj-1)
                   zdiag = zvis22 * ( ze11 + ze22 )
                   zs11_21 =  zs11_21 + zvis11 * ze11 + zdiag
@@ -473,8 +465,8 @@
                   ze22 = - akappa(ji-1,jj,2,2) * zv_a(ji-1,jj) + akappa(ji-1,jj,2,1) * zu_a(ji-1,jj)
                   ze21 = - akappa(ji-1,jj,1,1) * zv_a(ji-1,jj) - akappa(ji-1,jj,1,2) * zu_a(ji-1,jj)
-                  zvis11 = 2.0 * zviseta (ji-1,jj) + dm
-                  zvis22 =       zviszeta(ji-1,jj) - zviseta(ji-1,jj)
-                  zvis12 =       zviseta (ji-1,jj) + dm
-                  zvis21 =       zviseta (ji-1,jj)
+                  zvis11 = 2._wp * zviseta (ji-1,jj) + dm
+                  zvis22 =         zviszeta(ji-1,jj) - zviseta(ji-1,jj)
+                  zvis12 =         zviseta (ji-1,jj) + dm
+                  zvis21 =         zviseta (ji-1,jj)
                   zdiag = zvis22 * ( ze11 + ze22 )
                   zs11_12 =  zs11_12 + zvis11 * ze11 + zdiag
@@ -504,12 +496,12 @@
                   zvr     = zv_a(ji,jj) - v_oce(ji,jj)
 !!!!
-                  zmod    = SQRT( zur*zur + zvr*zvr ) * ( 1.0 - zfrld(ji,jj) )
+                  zmod    = SQRT( zur*zur + zvr*zvr ) * ( 1._wp - zfrld(ji,jj) )
                   za      = rhoco * zmod
 !!!!
-!!gm chg resul    za      = rhoco * SQRT( zur*zur + zvr*zvr ) * ( 1.0 - zfrld(ji,jj) )
+!!gm chg resul    za      = rhoco * SQRT( zur*zur + zvr*zvr ) * ( 1._wp - zfrld(ji,jj) )
                   zac     = za * cangvg
                   zmpzas  = alpha * zcorl(ji,jj) + za * zsang(ji,jj)
                   zmassdt = zusdtp * zmass(ji,jj)
-                  zcorlal = ( 1.0 - alpha ) * zcorl(ji,jj)
+                  zcorlal = ( 1._wp - alpha ) * zcorl(ji,jj)
 
                   za1 =  zmassdt * zu0(ji,jj) + zcorlal * zv0(ji,jj) + za1ct(ji,jj)   &
@@ -525,5 +517,5 @@
                   zunw   = (  ( za1 + zd1 ) * zc2 + ( za2 + zd2 ) * zc1 ) * zden
                   zvnw   = (  ( za2 + zd2 ) * zb1 - ( za1 + zd1 ) * zb2 ) * zden
-                  zmask  = ( 1.0 - MAX( rzero, SIGN( rone , 1.0 - zmass(ji,jj) ) ) ) * tmu(ji,jj)
+                  zmask  = ( 1._wp - MAX( rzero, SIGN( rone , 1._wp - zmass(ji,jj) ) ) ) * tmu(ji,jj)
 
                   zu_n(ji,jj) = ( zu_a(ji,jj) + om * ( zunw - zu_a(ji,jj) ) * tmu(ji,jj) ) * zmask
@@ -580,5 +572,5 @@
 #else
    !!----------------------------------------------------------------------
-   !!   Default option          Dummy module       NO 2.0 LIM sea-ice model
+   !!   Default option        Dummy module      NO VP & LIM-2 sea-ice model
    !!----------------------------------------------------------------------
 CONTAINS
Index: trunk/NEMOGCM/NEMO/LIM_SRC_2/limrst_2.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_2/limrst_2.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_2/limrst_2.F90	(revision 2528)
@@ -6,9 +6,9 @@
    !! History :  2.0  !  01-04  (C. Ethe, G. Madec)  Original code
    !!                 !  06-07  (S. Masson)  use IOM for restart read/write
+   !!            3.3  !  09-05  (G.Garric) addition of the lim2_evp case
    !!----------------------------------------------------------------------
 #if defined key_lim2
    !!----------------------------------------------------------------------
    !!   'key_lim2' :                                  LIM 2.0 sea-ice model
-   !!----------------------------------------------------------------------
    !!----------------------------------------------------------------------
    !!   lim_rst_opn_2   : open ice restart file
@@ -16,11 +16,10 @@
    !!   lim_rst_read_2  : read  the ice restart file 
    !!----------------------------------------------------------------------
-   USE dom_oce         ! ocean space and time domain
-   USE ice_2
-   USE sbc_oce
-   USE sbc_ice
-
-   USE in_out_manager
-   USE iom
+   USE dom_oce          ! ocean domain
+   USE ice_2            ! LIM-2: sea-ice variables
+   USE sbc_oce          ! Surface Boundary Condition: ocean
+   USE sbc_ice          ! Surface Boundary Condition: sea-ice
+   USE in_out_manager   ! I/O manager
+   USE iom              ! I/O library
 
    IMPLICIT NONE
@@ -35,9 +34,8 @@
 
    !!----------------------------------------------------------------------
-   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2006) 
+   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
@@ -84,4 +82,5 @@
    END SUBROUTINE lim_rst_opn_2
 
+
    SUBROUTINE lim_rst_write_2( kt )
       !!----------------------------------------------------------------------
@@ -108,50 +107,55 @@
       CALL iom_rstput( iter, nitrst, numriw, 'kt_ice', REAL( iter, wp) ) 
       
-      CALL iom_rstput( iter, nitrst, numriw, 'hicif' , hicif (:,:)   )      ! prognostic variables 
-      CALL iom_rstput( iter, nitrst, numriw, 'hsnif' , hsnif (:,:)   )
-      CALL iom_rstput( iter, nitrst, numriw, 'frld'  , frld  (:,:)   )
-      CALL iom_rstput( iter, nitrst, numriw, 'sist'  , sist  (:,:)   )
-      CALL iom_rstput( iter, nitrst, numriw, 'tbif1' , tbif  (:,:,1) )
-      CALL iom_rstput( iter, nitrst, numriw, 'tbif2' , tbif  (:,:,2) )
-      CALL iom_rstput( iter, nitrst, numriw, 'tbif3' , tbif  (:,:,3) )
-      CALL iom_rstput( iter, nitrst, numriw, 'u_ice' , u_ice (:,:)   )
-      CALL iom_rstput( iter, nitrst, numriw, 'v_ice' , v_ice (:,:)   )
-      CALL iom_rstput( iter, nitrst, numriw, 'qstoif', qstoif(:,:)   )
-      CALL iom_rstput( iter, nitrst, numriw, 'fsbbq' , fsbbq (:,:)   )
-      CALL iom_rstput( iter, nitrst, numriw, 'sxice' , sxice (:,:)   )
-      CALL iom_rstput( iter, nitrst, numriw, 'syice' , syice (:,:)   )
-      CALL iom_rstput( iter, nitrst, numriw, 'sxxice', sxxice(:,:)   )
-      CALL iom_rstput( iter, nitrst, numriw, 'syyice', syyice(:,:)   )
-      CALL iom_rstput( iter, nitrst, numriw, 'sxyice', sxyice(:,:)   )
-      CALL iom_rstput( iter, nitrst, numriw, 'sxsn'  , sxsn  (:,:)   )
-      CALL iom_rstput( iter, nitrst, numriw, 'sysn'  , sysn  (:,:)   )
-      CALL iom_rstput( iter, nitrst, numriw, 'sxxsn' , sxxsn (:,:)   )
-      CALL iom_rstput( iter, nitrst, numriw, 'syysn' , syysn (:,:)   )
-      CALL iom_rstput( iter, nitrst, numriw, 'sxysn' , sxysn (:,:)   )
-      CALL iom_rstput( iter, nitrst, numriw, 'sxa'   , sxa   (:,:)   )
-      CALL iom_rstput( iter, nitrst, numriw, 'sya'   , sya   (:,:)   )
-      CALL iom_rstput( iter, nitrst, numriw, 'sxxa'  , sxxa  (:,:)   )
-      CALL iom_rstput( iter, nitrst, numriw, 'syya'  , syya  (:,:)   )
-      CALL iom_rstput( iter, nitrst, numriw, 'sxya'  , sxya  (:,:)   )
-      CALL iom_rstput( iter, nitrst, numriw, 'sxc0'  , sxc0  (:,:)   )
-      CALL iom_rstput( iter, nitrst, numriw, 'syc0'  , syc0  (:,:)   )
-      CALL iom_rstput( iter, nitrst, numriw, 'sxxc0' , sxxc0 (:,:)   )
-      CALL iom_rstput( iter, nitrst, numriw, 'syyc0' , syyc0 (:,:)   )
-      CALL iom_rstput( iter, nitrst, numriw, 'sxyc0' , sxyc0 (:,:)   )
-      CALL iom_rstput( iter, nitrst, numriw, 'sxc1'  , sxc1  (:,:)   )
-      CALL iom_rstput( iter, nitrst, numriw, 'syc1'  , syc1  (:,:)   )
-      CALL iom_rstput( iter, nitrst, numriw, 'sxxc1' , sxxc1 (:,:)   )
-      CALL iom_rstput( iter, nitrst, numriw, 'syyc1' , syyc1 (:,:)   )
-      CALL iom_rstput( iter, nitrst, numriw, 'sxyc1' , sxyc1 (:,:)   )
-      CALL iom_rstput( iter, nitrst, numriw, 'sxc2'  , sxc2  (:,:)   )
-      CALL iom_rstput( iter, nitrst, numriw, 'syc2'  , syc2  (:,:)   )
-      CALL iom_rstput( iter, nitrst, numriw, 'sxxc2' , sxxc2 (:,:)   )
-      CALL iom_rstput( iter, nitrst, numriw, 'syyc2' , syyc2 (:,:)   )
-      CALL iom_rstput( iter, nitrst, numriw, 'sxyc2' , sxyc2 (:,:)   )
-      CALL iom_rstput( iter, nitrst, numriw, 'sxst'  , sxst  (:,:)   )
-      CALL iom_rstput( iter, nitrst, numriw, 'syst'  , syst  (:,:)   )
-      CALL iom_rstput( iter, nitrst, numriw, 'sxxst' , sxxst (:,:)   )
-      CALL iom_rstput( iter, nitrst, numriw, 'syyst' , syyst (:,:)   )
-      CALL iom_rstput( iter, nitrst, numriw, 'sxyst' , sxyst (:,:)   )
+      CALL iom_rstput( iter, nitrst, numriw, 'hicif'      , hicif (:,:)   )      ! prognostic variables 
+      CALL iom_rstput( iter, nitrst, numriw, 'hsnif'      , hsnif (:,:)   )
+      CALL iom_rstput( iter, nitrst, numriw, 'frld'       , frld  (:,:)   )
+      CALL iom_rstput( iter, nitrst, numriw, 'sist'       , sist  (:,:)   )
+      CALL iom_rstput( iter, nitrst, numriw, 'tbif1'      , tbif  (:,:,1) )
+      CALL iom_rstput( iter, nitrst, numriw, 'tbif2'      , tbif  (:,:,2) )
+      CALL iom_rstput( iter, nitrst, numriw, 'tbif3'      , tbif  (:,:,3) )
+      CALL iom_rstput( iter, nitrst, numriw, 'u_ice'      , u_ice (:,:)   )
+      CALL iom_rstput( iter, nitrst, numriw, 'v_ice'      , v_ice (:,:)   )
+      CALL iom_rstput( iter, nitrst, numriw, 'qstoif'     , qstoif(:,:)   )
+      CALL iom_rstput( iter, nitrst, numriw, 'fsbbq'      , fsbbq (:,:)   )
+#if ! defined key_lim2_vp
+      CALL iom_rstput( iter, nitrst, numriw, 'stress1_i'  , stress1_i (:,:) )    ! EVP rheology
+      CALL iom_rstput( iter, nitrst, numriw, 'stress2_i'  , stress2_i (:,:) )
+      CALL iom_rstput( iter, nitrst, numriw, 'stress12_i' , stress12_i(:,:) )
+#endif
+      CALL iom_rstput( iter, nitrst, numriw, 'sxice'      , sxice (:,:)   )
+      CALL iom_rstput( iter, nitrst, numriw, 'syice'      , syice (:,:)   )
+      CALL iom_rstput( iter, nitrst, numriw, 'sxxice'     , sxxice(:,:)   )
+      CALL iom_rstput( iter, nitrst, numriw, 'syyice'     , syyice(:,:)   )
+      CALL iom_rstput( iter, nitrst, numriw, 'sxyice'     , sxyice(:,:)   )
+      CALL iom_rstput( iter, nitrst, numriw, 'sxsn'       , sxsn  (:,:)   )
+      CALL iom_rstput( iter, nitrst, numriw, 'sysn'       , sysn  (:,:)   )
+      CALL iom_rstput( iter, nitrst, numriw, 'sxxsn'      , sxxsn (:,:)   )
+      CALL iom_rstput( iter, nitrst, numriw, 'syysn'      , syysn (:,:)   )
+      CALL iom_rstput( iter, nitrst, numriw, 'sxysn'      , sxysn (:,:)   )
+      CALL iom_rstput( iter, nitrst, numriw, 'sxa'        , sxa   (:,:)   )
+      CALL iom_rstput( iter, nitrst, numriw, 'sya'        , sya   (:,:)   )
+      CALL iom_rstput( iter, nitrst, numriw, 'sxxa'       , sxxa  (:,:)   )
+      CALL iom_rstput( iter, nitrst, numriw, 'syya'       , syya  (:,:)   )
+      CALL iom_rstput( iter, nitrst, numriw, 'sxya'       , sxya  (:,:)   )
+      CALL iom_rstput( iter, nitrst, numriw, 'sxc0'       , sxc0  (:,:)   )
+      CALL iom_rstput( iter, nitrst, numriw, 'syc0'       , syc0  (:,:)   )
+      CALL iom_rstput( iter, nitrst, numriw, 'sxxc0'      , sxxc0 (:,:)   )
+      CALL iom_rstput( iter, nitrst, numriw, 'syyc0'      , syyc0 (:,:)   )
+      CALL iom_rstput( iter, nitrst, numriw, 'sxyc0'      , sxyc0 (:,:)   )
+      CALL iom_rstput( iter, nitrst, numriw, 'sxc1'       , sxc1  (:,:)   )
+      CALL iom_rstput( iter, nitrst, numriw, 'syc1'       , syc1  (:,:)   )
+      CALL iom_rstput( iter, nitrst, numriw, 'sxxc1'      , sxxc1 (:,:)   )
+      CALL iom_rstput( iter, nitrst, numriw, 'syyc1'      , syyc1 (:,:)   )
+      CALL iom_rstput( iter, nitrst, numriw, 'sxyc1'      , sxyc1 (:,:)   )
+      CALL iom_rstput( iter, nitrst, numriw, 'sxc2'       , sxc2  (:,:)   )
+      CALL iom_rstput( iter, nitrst, numriw, 'syc2'       , syc2  (:,:)   )
+      CALL iom_rstput( iter, nitrst, numriw, 'sxxc2'      , sxxc2 (:,:)   )
+      CALL iom_rstput( iter, nitrst, numriw, 'syyc2'      , syyc2 (:,:)   )
+      CALL iom_rstput( iter, nitrst, numriw, 'sxyc2'      , sxyc2 (:,:)   )
+      CALL iom_rstput( iter, nitrst, numriw, 'sxst'       , sxst  (:,:)   )
+      CALL iom_rstput( iter, nitrst, numriw, 'syst'       , syst  (:,:)   )
+      CALL iom_rstput( iter, nitrst, numriw, 'sxxst'      , sxxst (:,:)   )
+      CALL iom_rstput( iter, nitrst, numriw, 'syyst'      , syyst (:,:)   )
+      CALL iom_rstput( iter, nitrst, numriw, 'sxyst'      , sxyst (:,:)   )
       
       IF( iter == nitrst ) THEN
@@ -218,41 +222,46 @@
       ENDIF
 
-      CALL iom_get( numrir, jpdom_autoglo, 'qstoif', qstoif )    
-      CALL iom_get( numrir, jpdom_autoglo, 'fsbbq' , fsbbq  )    
-      CALL iom_get( numrir, jpdom_autoglo, 'sxice' , sxice  )
-      CALL iom_get( numrir, jpdom_autoglo, 'syice' , syice  )
-      CALL iom_get( numrir, jpdom_autoglo, 'sxxice', sxxice )
-      CALL iom_get( numrir, jpdom_autoglo, 'syyice', syyice )
-      CALL iom_get( numrir, jpdom_autoglo, 'sxyice', sxyice )
-      CALL iom_get( numrir, jpdom_autoglo, 'sxsn'  , sxsn   )
-      CALL iom_get( numrir, jpdom_autoglo, 'sysn'  , sysn   )
-      CALL iom_get( numrir, jpdom_autoglo, 'sxxsn' , sxxsn  )
-      CALL iom_get( numrir, jpdom_autoglo, 'syysn' , syysn  )
-      CALL iom_get( numrir, jpdom_autoglo, 'sxysn' , sxysn  )
-      CALL iom_get( numrir, jpdom_autoglo, 'sxa'   , sxa    )
-      CALL iom_get( numrir, jpdom_autoglo, 'sya'   , sya    )
-      CALL iom_get( numrir, jpdom_autoglo, 'sxxa'  , sxxa   )
-      CALL iom_get( numrir, jpdom_autoglo, 'syya'  , syya   )
-      CALL iom_get( numrir, jpdom_autoglo, 'sxya'  , sxya   )
-      CALL iom_get( numrir, jpdom_autoglo, 'sxc0'  , sxc0   )
-      CALL iom_get( numrir, jpdom_autoglo, 'syc0'  , syc0   )
-      CALL iom_get( numrir, jpdom_autoglo, 'sxxc0' , sxxc0  )
-      CALL iom_get( numrir, jpdom_autoglo, 'syyc0' , syyc0  )
-      CALL iom_get( numrir, jpdom_autoglo, 'sxyc0' , sxyc0  )
-      CALL iom_get( numrir, jpdom_autoglo, 'sxc1'  , sxc1   )
-      CALL iom_get( numrir, jpdom_autoglo, 'syc1'  , syc1   )
-      CALL iom_get( numrir, jpdom_autoglo, 'sxxc1' , sxxc1  )
-      CALL iom_get( numrir, jpdom_autoglo, 'syyc1' , syyc1  )
-      CALL iom_get( numrir, jpdom_autoglo, 'sxyc1' , sxyc1  )
-      CALL iom_get( numrir, jpdom_autoglo, 'sxc2'  , sxc2   )
-      CALL iom_get( numrir, jpdom_autoglo, 'syc2'  , syc2   )
-      CALL iom_get( numrir, jpdom_autoglo, 'sxxc2' , sxxc2  )
-      CALL iom_get( numrir, jpdom_autoglo, 'syyc2' , syyc2  )
-      CALL iom_get( numrir, jpdom_autoglo, 'sxyc2' , sxyc2  )
-      CALL iom_get( numrir, jpdom_autoglo, 'sxst'  , sxst   )
-      CALL iom_get( numrir, jpdom_autoglo, 'syst'  , syst   )
-      CALL iom_get( numrir, jpdom_autoglo, 'sxxst' , sxxst  )
-      CALL iom_get( numrir, jpdom_autoglo, 'syyst' , syyst  )
-      CALL iom_get( numrir, jpdom_autoglo, 'sxyst' , sxyst  )
+      CALL iom_get( numrir, jpdom_autoglo, 'qstoif'     , qstoif )    
+      CALL iom_get( numrir, jpdom_autoglo, 'fsbbq'      , fsbbq  )    
+#if ! defined key_lim2_vp
+      CALL iom_get( numrir, jpdom_autoglo, 'stress1_i'  , stress1_i  )
+      CALL iom_get( numrir, jpdom_autoglo, 'stress2_i'  , stress2_i  )
+      CALL iom_get( numrir, jpdom_autoglo, 'stress12_i' , stress12_i )
+#endif
+      CALL iom_get( numrir, jpdom_autoglo, 'sxice'      , sxice  )
+      CALL iom_get( numrir, jpdom_autoglo, 'syice'      , syice  )
+      CALL iom_get( numrir, jpdom_autoglo, 'sxxice'     , sxxice )
+      CALL iom_get( numrir, jpdom_autoglo, 'syyice'     , syyice )
+      CALL iom_get( numrir, jpdom_autoglo, 'sxyice'     , sxyice )
+      CALL iom_get( numrir, jpdom_autoglo, 'sxsn'       , sxsn   )
+      CALL iom_get( numrir, jpdom_autoglo, 'sysn'       , sysn   )
+      CALL iom_get( numrir, jpdom_autoglo, 'sxxsn'      , sxxsn  )
+      CALL iom_get( numrir, jpdom_autoglo, 'syysn'      , syysn  )
+      CALL iom_get( numrir, jpdom_autoglo, 'sxysn'      , sxysn  )
+      CALL iom_get( numrir, jpdom_autoglo, 'sxa'        , sxa    )
+      CALL iom_get( numrir, jpdom_autoglo, 'sya'        , sya    )
+      CALL iom_get( numrir, jpdom_autoglo, 'sxxa'       , sxxa   )
+      CALL iom_get( numrir, jpdom_autoglo, 'syya'       , syya   )
+      CALL iom_get( numrir, jpdom_autoglo, 'sxya'       , sxya   )
+      CALL iom_get( numrir, jpdom_autoglo, 'sxc0'       , sxc0   )
+      CALL iom_get( numrir, jpdom_autoglo, 'syc0'       , syc0   )
+      CALL iom_get( numrir, jpdom_autoglo, 'sxxc0'      , sxxc0  )
+      CALL iom_get( numrir, jpdom_autoglo, 'syyc0'      , syyc0  )
+      CALL iom_get( numrir, jpdom_autoglo, 'sxyc0'      , sxyc0  )
+      CALL iom_get( numrir, jpdom_autoglo, 'sxc1'       , sxc1   )
+      CALL iom_get( numrir, jpdom_autoglo, 'syc1'       , syc1   )
+      CALL iom_get( numrir, jpdom_autoglo, 'sxxc1'      , sxxc1  )
+      CALL iom_get( numrir, jpdom_autoglo, 'syyc1'      , syyc1  )
+      CALL iom_get( numrir, jpdom_autoglo, 'sxyc1'      , sxyc1  )
+      CALL iom_get( numrir, jpdom_autoglo, 'sxc2'       , sxc2   )
+      CALL iom_get( numrir, jpdom_autoglo, 'syc2'       , syc2   )
+      CALL iom_get( numrir, jpdom_autoglo, 'sxxc2'      , sxxc2  )
+      CALL iom_get( numrir, jpdom_autoglo, 'syyc2'      , syyc2  )
+      CALL iom_get( numrir, jpdom_autoglo, 'sxyc2'      , sxyc2  )
+      CALL iom_get( numrir, jpdom_autoglo, 'sxst'       , sxst   )
+      CALL iom_get( numrir, jpdom_autoglo, 'syst'       , syst   )
+      CALL iom_get( numrir, jpdom_autoglo, 'sxxst'      , sxxst  )
+      CALL iom_get( numrir, jpdom_autoglo, 'syyst'      , syyst  )
+      CALL iom_get( numrir, jpdom_autoglo, 'sxyst'      , sxyst  )
       
       CALL iom_close( numrir )
Index: trunk/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90	(revision 2528)
@@ -2,9 +2,11 @@
    !!======================================================================
    !!                       ***  MODULE limsbc_2   ***
-   !!           computation of the flux at the sea ice/ocean interface
+   !! LIM-2 :   updates the fluxes at the ocean surface with ice-ocean fluxes
    !!======================================================================
-   !! History : 00-01 (H. Goosse) Original code
-   !!           02-07 (C. Ethe, G. Madec) re-writing F90
-   !!           06-07 (G. Madec) surface module
+   !! History :  LIM  ! 2000-01 (H. Goosse) Original code
+   !!            1.0  ! 2002-07 (C. Ethe, G. Madec) re-writing F90
+   !!            3.0  ! 2006-07 (G. Madec) surface module
+   !!            3.3  ! 2009-05 (G. Garric, C. Bricaud) addition of the lim2_evp case
+   !!             -   ! 2010-11 (G. Madec) ice-ocean stress computed at each ocean time-step
    !!----------------------------------------------------------------------
 #if defined key_lim2
@@ -12,18 +14,19 @@
    !!   'key_lim2'                                    LIM 2.0 sea-ice model
    !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !!   lim_sbc_2  : flux at the ice / ocean interface
+   !!   lim_sbc_flx_2  : update mass, heat and salt fluxes at the ocean surface
+   !!   lim_sbc_tau_2  : update i- and j-stresses, and its modulus at the ocean surface
    !!----------------------------------------------------------------------
    USE par_oce          ! ocean parameters
+   USE phycst           ! physical constants
    USE dom_oce          ! ocean domain
-   USE sbc_ice          ! surface boundary condition
-   USE sbc_oce          ! surface boundary condition
-   USE phycst           ! physical constants
-   USE ice_2            ! LIM sea-ice variables
-
-   USE lbclnk           ! ocean lateral boundary condition
+   USE dom_ice_2        ! LIM-2: ice domain
+   USE ice_2            ! LIM-2: ice variables
+   USE sbc_ice          ! surface boundary condition: ice
+   USE sbc_oce          ! surface boundary condition: ocean
+
+   USE lbclnk           ! ocean lateral boundary condition - MPP exchanges
    USE in_out_manager   ! I/O manager
    USE diaar5, ONLY :   lk_diaar5
-   USE iom              ! 
+   USE iom              ! I/O library
    USE albedo           ! albedo parameters
    USE prtctl           ! Print control
@@ -33,23 +36,27 @@
    PRIVATE
 
-   PUBLIC lim_sbc_2     ! called by sbc_ice_lim_2
-
-   REAL(wp)  ::   epsi16 = 1.e-16  ! constant values
-   REAL(wp)  ::   rzero  = 0.e0    
-   REAL(wp)  ::   rone   = 1.e0
-   REAL(wp), DIMENSION(jpi,jpj)  ::   soce_r
-   REAL(wp), DIMENSION(jpi,jpj)  ::   sice_r
+   PUBLIC   lim_sbc_flx_2   ! called by sbc_ice_lim_2
+   PUBLIC   lim_sbc_tau_2   ! called by sbc_ice_lim_2
+
+   REAL(wp)  ::   r1_rdtice            ! = 1. / rdt_ice 
+   REAL(wp)  ::   epsi16 = 1.e-16_wp   ! constant values
+   REAL(wp)  ::   rzero  = 0._wp       !     -      -
+   REAL(wp)  ::   rone   = 1._wp       !     -      -
+   !
+   REAL(wp), DIMENSION(jpi,jpj) ::   soce_0, sice_0   ! constant SSS and ice salinity used in levitating sea-ice case
+
+   REAL(wp), DIMENSION(jpi,jpj) ::   utau_oce, vtau_oce   ! air-ocean surface i- & j-stress              [N/m2]
+   REAL(wp), DIMENSION(jpi,jpj) ::   tmod_io              ! modulus of the ice-ocean relative velocity   [m/s]
 
    !! * Substitutions
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2006) 
+   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
-   SUBROUTINE lim_sbc_2( kt )
+   SUBROUTINE lim_sbc_flx_2( kt )
       !!-------------------------------------------------------------------
       !!                ***  ROUTINE lim_sbc_2 ***
@@ -75,50 +82,35 @@
       !!              Tartinville et al. 2001 Ocean Modelling, 3, 95-108.
       !!---------------------------------------------------------------------
-      INTEGER ::   kt    ! number of iteration
+      INTEGER, INTENT(in) ::   kt    ! number of iteration
       !!
-      INTEGER  ::   ji, jj           ! dummy loop indices
-      INTEGER  ::   ifvt, i1mfr, idfr               ! some switches
-      INTEGER  ::   iflt, ial, iadv, ifral, ifrdv
-      REAL(wp) ::   zrdtir           ! 1. / rdt_ice
-      REAL(wp) ::   zqsr  , zqns     ! solar & non solar heat flux
-      REAL(wp) ::   zinda            ! switch for testing the values of ice concentration
-      REAL(wp) ::   zfons            ! salt exchanges at the ice/ocean interface
-      REAL(wp) ::   zemp             ! freshwater exchanges at the ice/ocean interface
-      REAL(wp) ::   zfrldu, zfrldv   ! lead fraction at U- & V-points
-      REAL(wp) ::   zutau , zvtau    ! lead fraction at U- & V-points
-      REAL(wp) ::   zu_io , zv_io    ! 2 components of the ice-ocean velocity
-! interface 2D --> 3D
-      REAL(wp), DIMENSION(jpi,jpj,1) ::   zalb     ! albedo of ice under overcast sky
-      REAL(wp), DIMENSION(jpi,jpj,1) ::   zalbp    ! albedo of ice under clear sky
-      REAL(wp) ::   zsang, zmod, zztmp, zfm
-      REAL(wp), DIMENSION(jpi,jpj) ::   ztio_u, ztio_v   ! component of ocean stress below sea-ice at I-point
-      REAL(wp), DIMENSION(jpi,jpj) ::   ztiomi           ! module    of ocean stress below sea-ice at I-point
-      REAL(wp), DIMENSION(jpi,jpj) ::   zqnsoce          ! save qns before its modification by ice model
-
+      INTEGER  ::   ji, jj   ! dummy loop indices
+      INTEGER  ::   ii0, ii1, ij0, ij1         ! local integers
+      INTEGER  ::   ifvt, i1mfr, idfr, iflt    !   -       -
+      INTEGER  ::   ial, iadv, ifral, ifrdv    !   -       -
+      REAL(wp) ::   zqsr, zqns, zfm            ! local scalars
+      REAL(wp) ::   zinda, zfons, zemp         !   -      -
+      REAL(wp), DIMENSION(jpi,jpj)   ::   zqnsoce       ! 2D workspace
+      REAL(wp), DIMENSION(jpi,jpj,1) ::   zalb, zalbp   ! 2D/3D workspace
       !!---------------------------------------------------------------------
      
-      zrdtir = 1. / rdt_ice
-      
       IF( kt == nit000 ) THEN
          IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'lim_sbc_2 : LIM 2.0 sea-ice - surface boundary condition'
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~   '
-
-         soce_r(:,:) = soce
-         sice_r(:,:) = sice
-         !
-         IF( cp_cfg == "orca" ) THEN
-           !   ocean/ice salinity in the Baltic sea 
-           DO jj = 1, jpj
-              DO ji = 1, jpi
-                 IF( glamt(ji,jj) >= 14. .AND.  glamt(ji,jj) <= 32. .AND. gphit(ji,jj) >= 54. .AND. gphit(ji,jj) <= 66. ) THEN 
-                   soce_r(ji,jj) = 4.e0 
-                   sice_r(ji,jj) = 2.e0
-                 END IF
-              END DO
-           END DO
-           !
-         END IF
-      END IF
+         IF(lwp) WRITE(numout,*) 'lim_sbc_flx_2 : LIM-2 sea-ice - surface boundary condition - Mass, heat & salt fluxes'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~   '
+         !
+         r1_rdtice = 1. / rdt_ice
+         !
+         soce_0(:,:) = soce                     ! constant SSS and ice salinity used in levitating sea-ice case
+         sice_0(:,:) = sice
+         !
+         IF( cp_cfg == "orca" ) THEN            ! decrease ocean & ice reference salinities in the Baltic sea 
+            WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.   &
+               &   54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp         ) 
+               soce_0(:,:) = 4._wp
+               sice_0(:,:) = 2._wp
+            END WHERE
+         ENDIF
+         !
+      ENDIF
 
       !------------------------------------------!
@@ -126,8 +118,4 @@
       !------------------------------------------!
 
-!!gm
-!!gm CAUTION   
-!!gm re-verifies the non solar expression, especially over open ocen
-!!gm
       zqnsoce(:,:) = qns(:,:)
       DO jj = 1, jpj
@@ -186,9 +174,9 @@
             zqns    =  - ( 1. - thcm(ji,jj) ) * zqsr   &   ! part of the solar energy used in leads
                &       + iflt    * ( fscmbq(ji,jj) + ffltbif(ji,jj) )                            &
-               &       + ifral   * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) * zrdtir    &
-               &       + ifrdv   * ( qfvbq(ji,jj) + qdtcn(ji,jj) ) * zrdtir
+               &       + ifral   * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) * r1_rdtice    &
+               &       + ifrdv   * ( qfvbq(ji,jj) + qdtcn(ji,jj) )                   * r1_rdtice 
 
             fsbbq(ji,jj) = ( 1.0 - ( ifvt + iflt ) ) * fscmbq(ji,jj)     ! ???
-            
+            !
             qsr  (ji,jj) = zqsr                                          ! solar heat flux 
             qns  (ji,jj) = zqns - fdtcn(ji,jj)                           ! non solar heat flux
@@ -198,104 +186,41 @@
       CALL iom_put( 'hflx_ice_cea', - fdtcn(:,:) )      
       CALL iom_put( 'qns_io_cea', qns(:,:) - zqnsoce(:,:) * pfrld(:,:) )      
-      CALL iom_put( 'qsr_io_cea', fstric(:,:) * (1. - pfrld(:,:)) )
+      CALL iom_put( 'qsr_io_cea', fstric(:,:) * (1.e0 - pfrld(:,:)) )
 
       !------------------------------------------!
       !      mass flux at the ocean surface      !
       !------------------------------------------!
-
-!!gm
-!!gm CAUTION   
-!!gm re-verifies the emp & emps expression, especially the absence of 1-frld on zfm
-!!gm
       DO jj = 1, jpj
          DO ji = 1, jpi
-            
+            !
 #if defined key_coupled
-          zemp = emp_tot(ji,jj) - emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) )    &   ! 
-             &   + rdmsnif(ji,jj) * zrdtir                                      !  freshwaterflux due to snow melting 
+            ! freshwater exchanges at the ice-atmosphere / ocean interface (coupled mode)
+            zemp = emp_tot(ji,jj) - emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) )    &   ! 
+               &   + rdmsnif(ji,jj) * r1_rdtice                                   !  freshwaterflux due to snow melting 
 #else
-!!$            !  computing freshwater exchanges at the ice/ocean interface
-!!$            zpme = - evap(ji,jj)    *   frld(ji,jj)           &   !  evaporation over oceanic fraction
-!!$               &   + tprecip(ji,jj)                           &   !  total precipitation
-!!$               &   - sprecip(ji,jj) * ( 1. - pfrld(ji,jj) )   &   !  remov. snow precip over ice
-!!$               &   - rdmsnif(ji,jj) / rdt_ice                     !  freshwaterflux due to snow melting 
             !  computing freshwater exchanges at the ice/ocean interface
             zemp = + emp(ji,jj)     *         frld(ji,jj)      &   !  e-p budget over open ocean fraction 
                &   - tprecip(ji,jj) * ( 1. -  frld(ji,jj) )    &   !  liquid precipitation reaches directly the ocean
                &   + sprecip(ji,jj) * ( 1. - pfrld(ji,jj) )    &   !  taking into account change in ice cover within the time step
-               &   + rdmsnif(ji,jj) * zrdtir                       !  freshwaterflux due to snow melting 
+               &   + rdmsnif(ji,jj) * r1_rdtice                    !  freshwaterflux due to snow melting 
                !                                                   !  ice-covered fraction:
 #endif            
-
+            !
             !  computing salt exchanges at the ice/ocean interface
-            zfons =  ( soce_r(ji,jj) - sice_r(ji,jj) ) * ( rdmicif(ji,jj) * zrdtir ) 
-            
+            zfons =  ( soce_0(ji,jj) - sice_0(ji,jj) ) * ( rdmicif(ji,jj) * r1_rdtice ) 
+            !
             !  converting the salt flux from ice to a freshwater flux from ocean
             zfm  = zfons / ( sss_m(ji,jj) + epsi16 )
-            
+            !
             emps(ji,jj) = zemp + zfm      ! surface ocean concentration/dilution effect (use on SSS evolution)
             emp (ji,jj) = zemp            ! surface ocean volume flux (use on sea-surface height evolution)
-
+            !
          END DO
       END DO
 
-      IF( lk_diaar5 ) THEN
-         CALL iom_put( 'isnwmlt_cea'  ,                 rdmsnif(:,:) * zrdtir )
-         CALL iom_put( 'fsal_virt_cea',   soce_r(:,:) * rdmicif(:,:) * zrdtir )
-         CALL iom_put( 'fsal_real_cea', - sice_r(:,:) * rdmicif(:,:) * zrdtir )
-      ENDIF
-
-      !------------------------------------------!
-      !    momentum flux at the ocean surface    !
-      !------------------------------------------!
-
-      IF ( ln_limdyn ) THEN                        ! Update the stress over ice-over area (only in ice-dynamic case)
-         !                                         ! otherwise the atmosphere-ocean stress is used everywhere
-
-         ! ... ice stress over ocean with a ice-ocean rotation angle (at I-point)
-!CDIR NOVERRCHK
-         DO jj = 1, jpj
-!CDIR NOVERRCHK
-            DO ji = 1, jpi
-               ! ... change the cosinus angle sign in the south hemisphere
-               zsang  = SIGN(1.e0, gphif(ji,jj) ) * sangvg
-               ! ... ice velocity relative to the ocean at I-point
-               zu_io  = u_ice(ji,jj) - u_oce(ji,jj)
-               zv_io  = v_ice(ji,jj) - v_oce(ji,jj)
-               zmod   = SQRT( zu_io * zu_io + zv_io * zv_io )
-               zztmp  = rhoco * zmod
-               ! ... components of ice stress over ocean with a ice-ocean rotation angle (at I-point)
-               ztio_u(ji,jj) = zztmp * ( cangvg * zu_io - zsang * zv_io )
-               ztio_v(ji,jj) = zztmp * ( cangvg * zv_io + zsang * zu_io )
-               ! ... module of ice stress over ocean (at I-point)
-               ztiomi(ji,jj) = zztmp * zmod
-               ! 
-            END DO
-         END DO
-
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1   ! NO vector opt.
-               ! ... components of ice-ocean stress at U and V-points  (from I-point values)
-               zutau  = 0.5 * ( ztio_u(ji+1,jj) + ztio_u(ji+1,jj+1) )
-               zvtau  = 0.5 * ( ztio_v(ji,jj+1) + ztio_v(ji+1,jj+1) )
-               ! ... open-ocean (lead) fraction at U- & V-points (from T-point values)
-               zfrldu = 0.5 * ( frld(ji,jj) + frld(ji+1,jj  ) )
-               zfrldv = 0.5 * ( frld(ji,jj) + frld(ji  ,jj+1) )
-               ! ... update components of surface ocean stress (ice-cover wheighted)
-               utau(ji,jj) = zfrldu * utau(ji,jj) + ( 1. - zfrldu ) * zutau
-               vtau(ji,jj) = zfrldv * vtau(ji,jj) + ( 1. - zfrldv ) * zvtau
-               ! ... module of ice-ocean stress at T-points (from I-point values)
-               zztmp = 0.25 * ( ztiomi(ji,jj) + ztiomi(ji+1,jj) + ztiomi(ji,jj+1) + ztiomi(ji+1,jj+1) )
-               ! ... update module of surface ocean stress (ice-cover wheighted)
-               taum(ji,jj) = frld(ji,jj) * taum(ji,jj) + ( 1. - frld(ji,jj) ) * zztmp
-               !
-            END DO
-         END DO
-
-         ! boundary condition on the stress (utau,vtau,taum)
-         CALL lbc_lnk( utau, 'U', -1. )
-         CALL lbc_lnk( vtau, 'V', -1. )
-         CALL lbc_lnk( taum, 'T',  1. )
-
+      IF( lk_diaar5 ) THEN       ! AR5 diagnostics
+         CALL iom_put( 'isnwmlt_cea'  ,                 rdmsnif(:,:) * r1_rdtice )
+         CALL iom_put( 'fsal_virt_cea',   soce_0(:,:) * rdmicif(:,:) * r1_rdtice )
+         CALL iom_put( 'fsal_real_cea', - sice_0(:,:) * rdmicif(:,:) * r1_rdtice )
       ENDIF
 
@@ -304,5 +229,5 @@
       !-----------------------------------------------!
 
-      IF ( lk_cpl ) THEN           
+      IF( lk_cpl ) THEN          ! coupled case
          ! Ice surface temperature 
          tn_ice(:,:,1) = sist(:,:)          ! sea-ice surface temperature       
@@ -313,5 +238,5 @@
       ENDIF
 
-      IF(ln_ctl) THEN
+      IF(ln_ctl) THEN            ! control print
          CALL prt_ctl(tab2d_1=qsr   , clinfo1=' lim_sbc: qsr    : ', tab2d_2=qns   , clinfo2=' qns     : ')
          CALL prt_ctl(tab2d_1=emp   , clinfo1=' lim_sbc: emp    : ', tab2d_2=emps  , clinfo2=' emps    : ')
@@ -320,14 +245,171 @@
          CALL prt_ctl(tab2d_1=fr_i  , clinfo1=' lim_sbc: fr_i   : ', tab2d_2=tn_ice(:,:,1), clinfo2=' tn_ice  : ')
       ENDIF 
-   
-    END SUBROUTINE lim_sbc_2
+      !
+   END SUBROUTINE lim_sbc_flx_2
+
+
+   SUBROUTINE lim_sbc_tau_2( kt , pu_oce, pv_oce )
+      !!-------------------------------------------------------------------
+      !!                ***  ROUTINE lim_sbc_tau ***
+      !!  
+      !! ** Purpose : Update the ocean surface stresses due to the ice
+      !!         
+      !! ** Action  : * at each ice time step (every nn_fsbc time step):
+      !!                - compute the modulus of ice-ocean relative velocity 
+      !!                  at T-point (C-grid) or I-point (B-grid)
+      !!                      tmod_io = rhoco * | U_ice-U_oce |
+      !!                - update the modulus of stress at ocean surface
+      !!                      taum = frld * taum + (1-frld) * tmod_io * | U_ice-U_oce |
+      !!              * at each ocean time step (each kt): 
+      !!                  compute linearized ice-ocean stresses as
+      !!                      Utau = tmod_io * | U_ice - pU_oce |
+      !!                using instantaneous current ocean velocity (usually before)
+      !!
+      !!    NB: - the averaging operator used depends on the ice dynamics grid (cp_ice_msh='I' or 'C')
+      !!        - ice-ocean rotation angle only allowed in cp_ice_msh='I' case
+      !!        - here we make an approximation: taum is only computed every ice time step
+      !!          This avoids mutiple average to pass from T -> U,V grids and next from U,V grids 
+      !!          to T grid. taum is used in TKE and GLS, which should not be too sensitive to this approximaton...
+      !!
+      !! ** Outputs : - utau, vtau   : surface ocean i- and j-stress (u- & v-pts) updated with ice-ocean fluxes
+      !!              - taum         : modulus of the surface ocean stress (T-point) updated with ice-ocean fluxes
+      !!---------------------------------------------------------------------
+      INTEGER ,                     INTENT(in) ::   kt               ! ocean time-step index
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pu_oce, pv_oce   ! surface ocean currents
+      !!
+      INTEGER  ::   ji, jj   ! dummy loop indices
+      REAL(wp) ::   zfrldu, zat_u, zu_i, zutau_ice, zu_t, zmodt   ! local scalar
+      REAL(wp) ::   zfrldv, zat_v, zv_i, zvtau_ice, zv_t, zmodi   !   -      -
+      REAL(wp) ::   zsang, zumt                                          !    -         -
+      REAL(wp), DIMENSION(jpi,jpj) ::   ztio_u, ztio_v   ! ocean stress below sea-ice
+      !!---------------------------------------------------------------------
+      !
+      IF( kt == nit000 .AND. lwp ) THEN         ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'lim_sbc_tau_2 : LIM 2.0 sea-ice - surface ocean momentum fluxes'
+         WRITE(numout,*) '~~~~~~~~~~~~~ '
+         IF( lk_lim2_vp )   THEN   ;   WRITE(numout,*) '                VP  rheology - B-grid case'
+         ELSE                      ;   WRITE(numout,*) '                EVP rheology - C-grid case'
+         ENDIF
+      ENDIF
+      !
+      SELECT CASE( cp_ice_msh )     
+      !                             !-----------------------!
+      CASE( 'I' )                   !  B-grid ice dynamics  !   I-point (i.e. F-point with sea-ice indexation)
+         !                          !--=--------------------!
+         !
+         IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !==  Ice time-step only  ==! (i.e. surface module time-step)
+!CDIR NOVERRCHK
+            DO jj = 1, jpj                               !* modulus of ice-ocean relative velocity at I-point
+!CDIR NOVERRCHK
+               DO ji = 1, jpi
+                  zu_i  = u_ice(ji,jj) - u_oce(ji,jj)                   ! ice-ocean relative velocity at I-point
+                  zv_i  = v_ice(ji,jj) - v_oce(ji,jj)
+                  tmod_io(ji,jj) = SQRT( zu_i * zu_i + zv_i * zv_i )    ! modulus of this velocity (at I-point)
+               END DO
+            END DO
+!CDIR NOVERRCHK
+            DO jj = 1, jpjm1                             !* update the modulus of stress at ocean surface (T-point)
+!CDIR NOVERRCHK
+               DO ji = 1, jpim1   ! NO vector opt.
+                  !                                               ! modulus of U_ice-U_oce at T-point
+                  zumt  = 0.25_wp * (  tmod_io(ji+1,jj) + tmod_io(ji+1,jj+1)    &   
+                     &               + tmod_io(ji,jj+1) + tmod_io(ji+1,jj+1)  )
+                  !                                               ! update the modulus of stress at ocean surface
+                  taum(ji,jj) = frld(ji,jj) * taum(ji,jj) + ( 1._wp - frld(ji,jj) ) * rhoco * zumt * zumt
+               END DO
+            END DO
+            CALL lbc_lnk( taum, 'T', 1. )
+            !
+            utau_oce(:,:) = utau(:,:)                    !* save the air-ocean stresses at ice time-step
+            vtau_oce(:,:) = vtau(:,:)
+            !
+         ENDIF
+         !
+         !                                        !==  at each ocean time-step  ==!
+         !
+         !                                               !* ice/ocean stress WITH a ice-ocean rotation angle at I-point
+         DO jj = 2, jpj
+            zsang  = SIGN( 1._wp, gphif(1,jj) ) * sangvg          ! change the cosine angle sign in the SH 
+            DO ji = 2, jpi    ! NO vect. opt. possible
+               ! ... ice-ocean relative velocity at I-point using instantaneous surface ocean current at u- & v-pts
+               zu_i = u_ice(ji,jj) - 0.5_wp * ( pu_oce(ji-1,jj  ) + pu_oce(ji-1,jj-1) ) * tmu(ji,jj)
+               zv_i = v_ice(ji,jj) - 0.5_wp * ( pv_oce(ji  ,jj-1) + pv_oce(ji-1,jj-1) ) * tmu(ji,jj)
+               ! ... components of stress with a ice-ocean rotation angle 
+               zmodi = rhoco * tmod_io(ji,jj)                     
+               ztio_u(ji,jj) = zmodi * ( cangvg * zu_i - zsang * zv_i )
+               ztio_v(ji,jj) = zmodi * ( cangvg * zv_i + zsang * zu_i )
+            END DO
+         END DO
+         !                                               !* surface ocean stresses at u- and v-points
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1   ! NO vector opt.
+               !                                   ! ice-ocean stress at U and V-points  (from I-point values)
+               zutau_ice  = 0.5_wp * ( ztio_u(ji+1,jj) + ztio_u(ji+1,jj+1) )
+               zvtau_ice  = 0.5_wp * ( ztio_v(ji,jj+1) + ztio_v(ji+1,jj+1) )
+               !                                   ! open-ocean (lead) fraction at U- & V-points (from T-point values)
+               zfrldu = 0.5_wp * ( frld(ji,jj) + frld(ji+1,jj  ) )
+               zfrldv = 0.5_wp * ( frld(ji,jj) + frld(ji  ,jj+1) )
+               !                                   ! update the surface ocean stress (ice-cover wheighted)
+               utau(ji,jj) = zfrldu * utau_oce(ji,jj) + ( 1._wp - zfrldu ) * zutau_ice
+               vtau(ji,jj) = zfrldv * vtau_oce(ji,jj) + ( 1._wp - zfrldv ) * zvtau_ice
+            END DO
+         END DO
+         CALL lbc_lnk( utau, 'U', -1. )   ;   CALL lbc_lnk( vtau, 'V', -1. )     ! lateral boundary condition
+         !
+         !
+         !                          !-----------------------!
+      CASE( 'C' )                   !  C-grid ice dynamics  !   U & V-points (same as in the ocean)
+         !                          !--=--------------------!
+         !
+         IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !==  Ice time-step only  ==! (i.e. surface module time-step)
+!CDIR NOVERRCHK
+            DO jj = 2, jpjm1                          !* modulus of the ice-ocean velocity at T-point
+!CDIR NOVERRCHK
+               DO ji = fs_2, fs_jpim1
+                  zu_t  = u_ice(ji,jj) + u_ice(ji-1,jj) - u_oce(ji,jj) - u_oce(ji-1,jj)   ! 2*(U_ice-U_oce) at T-point
+                  zv_t  = v_ice(ji,jj) + v_ice(ji,jj-1) - v_oce(ji,jj) - v_oce(ji,jj-1)      
+                  zmodt =  0.25_wp * (  zu_t * zu_t + zv_t * zv_t  )                      ! |U_ice-U_oce|^2
+                  !                                               ! update the modulus of stress at ocean surface
+                  taum   (ji,jj) = frld(ji,jj) * taum(ji,jj) + ( 1._wp - frld(ji,jj) ) * rhoco * zmodt
+                  tmod_io(ji,jj) = SQRT( zmodt ) * rhoco          ! rhoco*|Uice-Uoce|
+               END DO
+            END DO
+            CALL lbc_lnk( taum, 'T', 1. )   ;   CALL lbc_lnk( tmod_io, 'T', 1. )
+            !
+            utau_oce(:,:) = utau(:,:)                 !* save the air-ocean stresses at ice time-step
+            vtau_oce(:,:) = vtau(:,:)
+            !
+         ENDIF
+         !
+         !                                        !==  at each ocean time-step  ==!
+         !
+         DO jj = 2, jpjm1                             !* ice stress over ocean WITHOUT a ice-ocean rotation angle
+            DO ji = fs_2, fs_jpim1
+               !                                            ! ocean area at u- & v-points
+               zfrldu  = 0.5_wp * ( frld(ji,jj) + frld(ji+1,jj  ) )
+               zfrldv  = 0.5_wp * ( frld(ji,jj) + frld(ji  ,jj+1) )
+               !                                            ! quadratic drag formulation without rotation
+               !                                            ! using instantaneous surface ocean current
+               zutau_ice = 0.5 * ( tmod_io(ji,jj) + tmod_io(ji+1,jj) ) * ( u_ice(ji,jj) - pu_oce(ji,jj) )
+               zvtau_ice = 0.5 * ( tmod_io(ji,jj) + tmod_io(ji,jj+1) ) * ( v_ice(ji,jj) - pv_oce(ji,jj) )
+               !                                            ! update the surface ocean stress (ice-cover wheighted)
+               utau(ji,jj) = zfrldu * utau_oce(ji,jj) + ( 1._wp - zfrldu ) * zutau_ice
+               vtau(ji,jj) = zfrldv * vtau_oce(ji,jj) + ( 1._wp - zfrldv ) * zvtau_ice
+            END DO
+         END DO
+         CALL lbc_lnk( utau, 'U', -1. )   ;   CALL lbc_lnk( vtau, 'V', -1. )   ! lateral boundary condition
+         !
+      END SELECT
+
+      IF(ln_ctl)   CALL prt_ctl( tab2d_1=utau, clinfo1=' lim_sbc: utau   : ', mask1=umask,   &
+         &                       tab2d_2=vtau, clinfo2=' vtau    : '        , mask2=vmask )
+      !  
+   END SUBROUTINE lim_sbc_tau_2
 
 #else
    !!----------------------------------------------------------------------
-   !!   Default option :        Dummy module       NO LIM 2.0 sea-ice model
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE lim_sbc_2         ! Dummy routine
-   END SUBROUTINE lim_sbc_2
+   !!   Default option         Empty module        NO LIM 2.0 sea-ice model
+   !!----------------------------------------------------------------------
 #endif 
 
Index: trunk/NEMOGCM/NEMO/LIM_SRC_2/limtab_2.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_2/limtab_2.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_2/limtab_2.F90	(revision 2528)
@@ -20,7 +20,7 @@
 
    !!----------------------------------------------------------------------
-   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005) 
+   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 CONTAINS
Index: trunk/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90	(revision 2528)
@@ -50,7 +50,7 @@
 #  include "vectopt_loop_substitute.h90"
    !!-------- -------------------------------------------------------------
-   !! NEMO/LIM 3.2,  UCL-LOCEAN-IPSL (2009) 
+   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/LIM_SRC_2/limthd_lac_2.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_2/limthd_lac_2.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_2/limthd_lac_2.F90	(revision 2528)
@@ -28,7 +28,7 @@
       zone   = 1.e0
    !!----------------------------------------------------------------------
-   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005) 
+   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 CONTAINS
Index: trunk/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90	(revision 2528)
@@ -33,7 +33,7 @@
       &          zone   = 1.e0
    !!----------------------------------------------------------------------
-   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005) 
+   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/LIM_SRC_2/limtrp_2.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_2/limtrp_2.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_2/limtrp_2.F90	(revision 2528)
@@ -7,4 +7,5 @@
    !!            2.0  !  2001-05 (G. Madec, R. Hordoir) opa norm
    !!             -   !  2004-01 (G. Madec, C. Ethe)  F90, mpp
+   !!            3.3  !  2009-05  (G. Garric, C. Bricaud) addition of the lim2_evp case
    !!----------------------------------------------------------------------
 #if defined key_lim2
@@ -32,19 +33,18 @@
    PUBLIC   lim_trp_2   ! called by sbc_ice_lim_2
 
-   REAL(wp), PUBLIC  ::   bound  = 0.e0   !: boundary condit. (0.0 no-slip, 1.0 free-slip)
-
-   REAL(wp)  ::           &  ! constant values
-      epsi06 = 1.e-06  ,  &
-      epsi03 = 1.e-03  ,  &
-      epsi16 = 1.e-16  ,  &
-      rzero  = 0.e0    ,  &
-      rone   = 1.e0
+   REAL(wp), PUBLIC ::   bound  = 0.e0          !: boundary condit. (0.0 no-slip, 1.0 free-slip)
+
+   REAL(wp)  ::   epsi06 = 1.e-06   ! constant values
+   REAL(wp)  ::   epsi03 = 1.e-03  
+   REAL(wp)  ::   epsi16 = 1.e-16  
+   REAL(wp)  ::   rzero  = 0.e0   
+   REAL(wp)  ::   rone   = 1.e0
 
    !! * Substitution
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/LIM 3.2,  UCL-LOCEAN-IPSL (2010) 
+   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -87,17 +87,22 @@
          ! ice velocities at ocean U- and V-points (zui_u,zvi_v)
          ! ---------------------------------------
-         zvbord = 1.0 + ( 1.0 - bound )      ! zvbord=2 no-slip, =0 free slip boundary conditions        
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1   ! NO vector opt.
-               zui_u(ji,jj) = ( u_ice(ji+1,jj  ) + u_ice(ji+1,jj+1) ) / ( MAX( tmu(ji+1,jj  ) + tmu(ji+1,jj+1), zvbord ) )
-               zvi_v(ji,jj) = ( v_ice(ji  ,jj+1) + v_ice(ji+1,jj+1) ) / ( MAX( tmu(ji  ,jj+1) + tmu(ji+1,jj+1), zvbord ) )
-            END DO
-         END DO
-         CALL lbc_lnk( zui_u, 'U', -1. )   ;   CALL lbc_lnk( zvi_v, 'V', -1. )         ! Lateral boundary conditions
-
+         IF( lk_lim2_vp ) THEN      ! VP rheology : B-grid sea-ice dynamics (I-point ice velocity)
+            zvbord = 1._wp + ( 1._wp - bound )      ! zvbord=2 no-slip, =0 free slip boundary conditions        
+            DO jj = 1, jpjm1
+               DO ji = 1, jpim1   ! NO vector opt.
+                  zui_u(ji,jj) = ( u_ice(ji+1,jj) + u_ice(ji+1,jj+1) ) / ( MAX( tmu(ji+1,jj)+tmu(ji+1,jj+1), zvbord ) )
+                  zvi_v(ji,jj) = ( v_ice(ji,jj+1) + v_ice(ji+1,jj+1) ) / ( MAX( tmu(ji,jj+1)+tmu(ji+1,jj+1), zvbord ) )
+               END DO
+            END DO
+            CALL lbc_lnk( zui_u, 'U', -1. )   ;   CALL lbc_lnk( zvi_v, 'V', -1. )      ! Lateral boundary conditions
+            !
+         ELSE                       ! EVP rheology : C-grid sea-ice dynamics (u- & v-points ice velocity)
+            zui_u(:,:) = u_ice(:,:)      ! EVP rheology: ice (u,v) at u- and v-points
+            zvi_v(:,:) = v_ice(:,:)
+         ENDIF
 
          ! CFL test for stability
          ! ----------------------
-         zcfl  = 0.e0
+         zcfl  = 0._wp
          zcfl  = MAX( zcfl, MAXVAL( ABS( zui_u(1:jpim1, :     ) ) * rdt_ice / e1u(1:jpim1, :     ) ) )
          zcfl  = MAX( zcfl, MAXVAL( ABS( zvi_v( :     ,1:jpjm1) ) * rdt_ice / e2v( :     ,1:jpjm1) ) )
@@ -109,6 +114,6 @@
          ! content of properties
          ! ---------------------
-         zs0sn (:,:) =  hsnm(:,:) * area(:,:)                 ! Snow volume.
-         zs0ice(:,:) =  hicm(:,:) * area(:,:)                 ! Ice volume.
+         zs0sn (:,:) =  hsnm(:,:)              * area  (:,:)  ! Snow volume.
+         zs0ice(:,:) =  hicm(:,:)              * area  (:,:)  ! Ice volume.
          zs0a  (:,:) =  ( 1.0 - frld(:,:) )    * area  (:,:)  ! Surface covered by ice.
          zs0c0 (:,:) =  tbif(:,:,1) / rt0_snow * zs0sn (:,:)  ! Heat content of the snow layer.
@@ -188,6 +193,6 @@
 !        DO jj = 1, jpjm1          ! NB: has not to be defined on jpj line and jpi row
 !           DO ji = 1 , fs_jpim1   ! vector opt.
-!              IF( MIN( zs0a(ji,jj) , zs0a(ji+1,jj) ) == 0.e0 )   pahu(ji,jj) = 0.e0
-!              IF( MIN( zs0a(ji,jj) , zs0a(ji,jj+1) ) == 0.e0 )   pahv(ji,jj) = 0.e0
+!              IF( MIN( zs0a(ji,jj) , zs0a(ji+1,jj) ) == 0.e0 )   pahu(ji,jj) = 0._wp
+!              IF( MIN( zs0a(ji,jj) , zs0a(ji,jj+1) ) == 0.e0 )   pahv(ji,jj) = 0._wp
 !           END DO
 !        END DO
Index: trunk/NEMOGCM/NEMO/LIM_SRC_2/limwri_2.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_2/limwri_2.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_2/limwri_2.F90	(revision 2528)
@@ -60,7 +60,7 @@
 #   include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!  LIM 2.0, UCL-LOCEAN-IPSL (2006)
+   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -112,5 +112,5 @@
          CALL dia_nam ( clhstnam, nwrite, 'icemod' )
          CALL histbeg ( clhstnam, jpi, glamt, jpj, gphit,    &
-            &           1, jpi, 1, jpj, niter, zjulian, rdt_ice, nhorid, nice , domain_id=nidom)
+            &           1, jpi, 1, jpj, niter, zjulian, rdt_ice, nhorid, nice , domain_id=nidom, snc4chunks=snc4set)
          CALL histvert( nice, "deptht", "Vertical T levels", "m", 1, zdept, ndepid, "down")
          CALL wheneq  ( jpij , tmask(:,:,1), 1, 1., ndex51, ndim)
@@ -120,5 +120,5 @@
                &                                  , nhorid, 1, 1, 1, -99, 32, clop, zsto, zout )
          END DO
-         CALL histend( nice )
+         CALL histend( nice, snc4set )
          !
       ENDIF
@@ -305,5 +305,5 @@
       CALL histdef( kid, "isnowpre", "Snow precipitation"      , "kg/m2/s", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
 
-      CALL histend( kid )   ! end of the file definition
+      CALL histend( kid, snc4set )   ! end of the file definition
 
       CALL histwrite( kid, "isnowthi", kt, hsnif          , jpi*jpj, (/1/) )   
Index: trunk/NEMOGCM/NEMO/LIM_SRC_2/limwri_dimg_2.h90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_2/limwri_dimg_2.h90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_2/limwri_dimg_2.h90	(revision 2528)
@@ -1,7 +1,7 @@
     SUBROUTINE lim_wri_2(kt)
    !!----------------------------------------------------------------------
-   !!  LIM 2.0, UCL-LOCEAN-IPSL (2005)
+   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
     !!-------------------------------------------------------------------
Index: trunk/NEMOGCM/NEMO/LIM_SRC_2/par_ice_2.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_2/par_ice_2.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_2/par_ice_2.F90	(revision 2528)
@@ -24,7 +24,7 @@
 #endif
    !!----------------------------------------------------------------------
-   !! NEMO/LIM 2.0, UCL-LOCEAN-IPSL (2008)
+   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!======================================================================
 END MODULE par_ice_2
Index: trunk/NEMOGCM/NEMO/LIM_SRC_2/thd_ice_2.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_2/thd_ice_2.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_2/thd_ice_2.F90	(revision 2528)
@@ -8,7 +8,7 @@
    !!   2.0  !  02-11  (C. Ethe)  F90: Free form and module
    !!----------------------------------------------------------------------
-   !!   LIM 2.0, UCL-LOCEAN-IPSL (2005)
+   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
    !! * Modules used
Index: trunk/NEMOGCM/NEMO/LIM_SRC_3/dom_ice.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_3/dom_ice.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_3/dom_ice.F90	(revision 2528)
@@ -26,7 +26,7 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/LIM 3.2, UCL-ASTR-LOCEAN-IPSL (2009)
+   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!======================================================================
 END MODULE dom_ice
Index: trunk/NEMOGCM/NEMO/LIM_SRC_3/ice.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_3/ice.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_3/ice.F90	(revision 2528)
@@ -1,36 +1,19 @@
 MODULE ice
+   !!======================================================================
+   !!                        ***  MODULE ice  ***
+   !! LIM-3 Sea Ice physics:  diagnostics variables of ice defined in memory
+   !!=====================================================================
+   !! History :  3.0  ! 2008-03  (M. Vancoppenolle) : original code LIM-3
+   !!----------------------------------------------------------------------
 #if defined key_lim3
    !!----------------------------------------------------------------------
    !!   'key_lim3' :                                   LIM3 sea-ice model
    !!----------------------------------------------------------------------
-   !! History :
-   !!   2.0  !  03-08  (C. Ethe)  F90: Free form and module
-   !!   3.0  !  08-03  (M. Vancoppenolle) : LIM3 !
-   !!----------------------------------------------------------------------
-   !!  LIM 3.0, UCL-LOCEAN-IPSL (2005)
-   !! $Id$
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
-   !!----------------------------------------------------------------------
-   !! * Modules used
    USE par_ice          ! LIM sea-ice parameters
 
    IMPLICIT NONE
    PRIVATE
-   !!
+
    !!======================================================================
-   !!                        ***  MODULE ice  ***
-   !!
-   !!                           **************
-   !!                           * L I M  3.0 *
-   !!                           **************
-   !!
-   !!                         ''in ice we trust''
-   !!
-   !!                   This module contains the sea ice 
-   !!                 diagnostics variables of ice defined 
-   !!                             in memory
-   !!
-   !!======================================================================
-   !!
    !! LIM3 by the use of sweat, agile fingers and sometimes brain juice, 
    !!  was developed in Louvain-la-Neuve by : 
@@ -48,5 +31,5 @@
    !!
    !!    * Gurvan Madec, Claude Talandier, Christian Ethe 
-   !!      and Rachid Benshila (LOCEAN-IPSL, France)
+   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
    !!    * Xavier Fettweis (UCL-ASTR), Ralph Timmermann (AWI, Germany)
    !!    * Bill Lipscomb (LANL), Cecilia Bitz (UWa) 
@@ -64,17 +47,11 @@
    !!    * Bouillon et al., in prep for 2008.
    !!
-   !!    Or the reference manual, that should be available by 2009
-   !!
+   !!    Or the reference manual, that should be available by 2010
    !!======================================================================
    !!                                                                     |
-   !!            *****************************************                |
-   !!            *                                       *                |
-   !! ************ I C E   S T A T E   V A R I A B L E S **************** |
-   !!            *                                       *                |
-   !!            *****************************************                |
+   !!              I C E   S T A T E   V A R I A B L E S                  |
    !!                                                                     |
    !! Introduction :                                                      |
    !! --------------                                                      |
-   !!                                                                     |
    !! Every ice-covered grid cell is characterized by a series of state   |
    !! variables. To account for unresolved spatial variability in ice     |
@@ -130,5 +107,4 @@
    !!                                                                     |
    !! ** Global variables                                                 |
-   !!                                                                     |
    !!-------------|-------------|---------------------------------|-------|
    !! a_i         | a_i_b       |    Ice concentration            |       |
@@ -145,5 +121,4 @@
    !!                                                                     |
    !! ** Equivalent variables                                             |
-   !!                                                                     |
    !!-------------|-------------|---------------------------------|-------|
    !!                                                                     |
@@ -179,15 +154,17 @@
    !! et_s        !      -      !    Total snow enthalpy          | 10^9 J| 
    !! bv_i        !      -      !    Mean relative brine volume   | ???   | 
-   !!                                                                     |
-   !!                                                                     |
    !!=====================================================================
 
-   LOGICAL, PUBLIC ::    &
-      con_i = .false.           ! switch for conservation test
+   LOGICAL, PUBLIC ::   con_i = .false.   ! switch for conservation test
 
    !!--------------------------------------------------------------------------
    !! * Share Module variables
    !!--------------------------------------------------------------------------
-   REAL(wp), PUBLIC ::   rdt_ice      !: ice time step
+   INTEGER , PUBLIC ::   nstart    !: iteration number of the begining of the run 
+   INTEGER , PUBLIC ::   nlast     !: iteration number of the end of the run 
+   INTEGER , PUBLIC ::   nitrun    !: number of iteration
+   INTEGER , PUBLIC ::   numit     !: iteration number
+   REAL(wp), PUBLIC ::   tpstot    !: time of the run in seconds
+   REAL(wp), PUBLIC ::   rdt_ice   !: ice time step
 
    INTEGER , PUBLIC ::   &     !!: ** ice-dynamic namelist (namicedyn) **
Index: trunk/NEMOGCM/NEMO/LIM_SRC_3/iceini.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_3/iceini.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_3/iceini.F90	(revision 2528)
@@ -4,4 +4,7 @@
    !!   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
+   !!----------------------------------------------------------------------
 #if defined key_lim3
    !!----------------------------------------------------------------------
@@ -10,29 +13,29 @@
    !!   ice_init       : sea-ice model initialization
    !!----------------------------------------------------------------------
-   USE dom_oce
-   USE in_out_manager
-   USE sbc_oce         ! Surface boundary condition: ocean fields
-   USE sbc_ice         ! Surface boundary condition: ice fields
-   USE phycst          ! Define parameters for the routines
-   USE ice
-   USE limmsh
-   USE limistate
-   USE limthd         ! LIM: ice thermodynamics 
-   USE limthd_sal     ! LIM: ice thermodynamics: salinity 
-   USE limrst
-   USE par_ice
-   USE limvar
-   USE lib_mpp
+   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: sea-ice variables
+   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 par_ice        ! LIM: sea-ice parameters
+   USE limvar         ! LIM: variables
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC ice_init                 ! called by opa.F90
-   !!----------------------------------------------------------------------
-   !!   LIM 3.0,  UCL-ASTR-LOCEAN-IPSL (2008) 
+   PUBLIC   ice_init   ! called by opa.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
@@ -42,14 +45,10 @@
       !!
       !! ** purpose :   
-      !!
-      !! History :
-      !!   2.0  !  02-08  (G. Madec)  F90: Free form and modules
-      !!   3.0  !  08-03  (M. Vancop) ITD, salinity, EVP-C
       !!----------------------------------------------------------------------
-
-      ! Open the namelist file 
+      !
+      !                                ! Open the namelist file 
       CALL ctl_opn( numnam_ice, 'namelist_ice', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )
-
-      CALL ice_run                    !  read in namelist some run parameters
+      !
+      CALL ice_run                     ! namelist read some ice run parameters
       !
       CALL lim_thd_init                ! namelist read ice thermodynics parameters
@@ -63,5 +62,5 @@
       CALL lim_itd_ini                 ! initialize the ice thickness distribution
 
-     !                                ! Initial sea-ice state
+      !                                ! Initial sea-ice state
       IF( .NOT.ln_rstart ) THEN              ! start from rest
          numit = 0
@@ -79,11 +78,12 @@
       fr_i(:,:) = at_i(:,:)           ! initialisation of sea-ice fraction
       !
-      nstart = numit  + nn_fsbc
-      nitrun = nitend - nit000 + 1
-      nlast  = numit  + nitrun
+      nstart = numit  + nn_fsbc      
+      nitrun = nitend - nit000 + 1 
+      nlast  = numit  + nitrun 
       !
       IF( nstock == 0  )   nstock = nlast + 1
-
+      !
    END SUBROUTINE ice_init
+
 
    SUBROUTINE ice_run
@@ -97,22 +97,17 @@
       !!
       !! ** input   :   Namelist namicerun
-      !!
-      !! history :
-      !!   2.0  !  03-08 (C. Ethe)  Original code
-      !!   3.0  !  08-03 (M. Vancop) LIM3
       !!-------------------------------------------------------------------
       NAMELIST/namicerun/ cn_icerst_in, cn_icerst_out, ln_limdyn, acrit, hsndif, hicdif, cai, cao, ln_nicep
       !!-------------------------------------------------------------------
-
-      !                                           ! Read Namelist namicerun 
-      REWIND ( numnam_ice )
-      READ   ( numnam_ice , namicerun )
-
+      !                    
+      REWIND( numnam_ice )                ! Read Namelist namicerun 
+      READ  ( numnam_ice , 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
+      !
+      IF(lwp) THEN                        ! control print
          WRITE(numout,*)
          WRITE(numout,*) 'ice_run : ice share parameters for dynamics/advection/thermo of sea-ice'
@@ -124,50 +119,24 @@
          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
-      ENDIF
-
+         WRITE(numout,*) '   Several ice points in the ice or not in ocean.output    = ', ln_nicep
+      ENDIF
+      !
    END SUBROUTINE ice_run
+
 
    SUBROUTINE lim_itd_ini
       !!------------------------------------------------------------------
       !!                ***  ROUTINE lim_itd_ini ***
-      !! ** Purpose :
-      !!            Initializes the ice thickness distribution
-      !! ** Method  :
-      !!            Very simple. Currently there are no ice types in the
-      !!            model...
-      !!
-      !! ** Arguments :
-      !!           kideb , kiut : Starting and ending points on which the
-      !!                         the computation is applied
-      !!
-      !! ** Inputs / Ouputs : (global commons)
-      !!
-      !! ** External :
-      !!
-      !! ** References :
-      !!
-      !! ** History :
-      !!           (12-2005) Martin Vancoppenolle
-      !!
+      !!
+      !! ** Purpose :   Initializes the ice thickness distribution
+      !! ** Method  :   ...
       !!------------------------------------------------------------------
-      !! * Arguments
-
-      !! * Local variables
-      INTEGER ::   jl,       &   ! ice category dummy loop index
-         jm            ! ice types    dummy loop index
-
-      REAL(wp)  ::           &  ! constant values
-         zeps      =  1.0e-10,   & !
-         zc1                 ,   & !
-         zc2                 ,   & !
-         zc3                 ,   & !
-         zx1
-
+      INTEGER  ::   jl, jm               ! 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,*) '~~~~~~~~~~~~'
-
-      !!-- End of declarations
-      !!------------------------------------------------------------------------------
 
       !------------------------------------------------------------------------------!
@@ -207,22 +176,20 @@
       !- Thickness categories boundaries 
       !----------------------------------
-      hi_max(:) = 0.0
-      hi_max_typ(:,:) = 0.0
+      hi_max(:) = 0._wp
+      hi_max_typ(:,:) = 0._wp
 
       !- Type 1 - undeformed ice
-      zc1 = 3./REAL(ice_cat_bounds(1,2)-ice_cat_bounds(1,1)+1)
-      zc2 = 10.0*zc1
-      zc3 = 3.0
+      zc1 =  3._wp / REAL( ice_cat_bounds(1,2) - ice_cat_bounds(1,1) + 1 , wp )
+      zc2 = 10._wp * zc1
+      zc3 =  3._wp
 
       DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2)
-         zx1 = REAL(jl-1) / REAL(ice_cat_bounds(1,2)-ice_cat_bounds(1,1)+1)
-         hi_max(jl) = hi_max(jl-1) + zc1 + zc2 * (1.0 + TANH ( zc3 * (zx1 - 1.0 ) ) )
+         zx1 = REAL( jl-1 , wp ) / REAL( ice_cat_bounds(1,2) - ice_cat_bounds(1,1) + 1 , wp )
+         hi_max(jl) = hi_max(jl-1) + zc1 + zc2 * (1._wp + TANH( zc3 * (zx1 - 1._wp ) ) )
       END DO
 
       !- Fill in the hi_max_typ vector, useful in other circumstances
-      ! Tricky trick
-      ! hi_max_typ is actually not used in the code and will be removed in a
-      ! next flyspray at this time, the tricky trick will also be removed
-      ! Martin, march 08
+      ! Tricky trick: hi_max_typ is actually not used in the code and will be removed in a
+      ! next flyspray at this time, the tricky trick will also be removed (Martin, march 08)
       DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2)
          hi_max_typ(jl,1) = hi_max(jl)
@@ -239,11 +206,11 @@
          END DO
       ENDIF
-
+      !
       DO jl = 1, jpl
-         hi_mean(jl) = ( hi_max(jl) + hi_max(jl-1) ) / 2.0
-      END DO
-
+         hi_mean(jl) = ( hi_max(jl) + hi_max(jl-1) ) * 0.5_wp
+      END DO
+      !
       tn_ice(:,:,:) = t_su(:,:,:)
-
+      !
    END SUBROUTINE lim_itd_ini
 
@@ -255,7 +222,4 @@
    SUBROUTINE ice_init        ! Empty routine
    END SUBROUTINE ice_init
-
-   SUBROUTINE lim_itd_ini
-   END SUBROUTINE lim_itd_ini
 #endif
 
Index: trunk/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90	(revision 2528)
@@ -34,7 +34,7 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/LIM 3.2,  UCL-LOCEAN-IPSL (2009) 
+   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90	(revision 2528)
@@ -36,7 +36,7 @@
    !! * Module variables
    !!----------------------------------------------------------------------
-   !!   LIM 3.0,  UCL-LOCEAN-IPSL (2005)
+   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/LIM_SRC_3/limdia.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_3/limdia.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_3/limdia.F90	(revision 2528)
@@ -14,18 +14,14 @@
    !!   lim_dia_init   : initialization and namelist read
    !!----------------------------------------------------------------------
-   !! * Modules used
-   USE phycst
-   USE in_out_manager
-   USE par_ice         ! ice parameters
-   USE sbc_ice         ! ice variables
-   USE daymod
-   USE dom_ice
-   USE ice
-   USE dom_oce
-   USE sbc_oce         ! Surface boundary condition: ocean fields
-   USE dom_oce
-   USE lib_mpp
-   USE in_out_manager
- 
+   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
+   USE sbc_oce         ! surface boundary condition: ocean fields
+   USE daymod          ! model calendar
+   USE phycst          ! physical constant
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! MPP library
+   
    IMPLICIT NONE
    PRIVATE
@@ -46,5 +42,5 @@
    INTEGER  ::   nbvt                ! number of time variables
    INTEGER  ::   naveg               ! number of step for accumulation before averaging
-   REAL(wp) ::   epsi06 = 1.e-6   ! small number
+   REAL(wp) ::   epsi06 = 1.e-6_wp   ! small number
 
    CHARACTER(len= 8) ::   fmtinf = '1PE13.5 '   ! format of the output values  
@@ -84,6 +80,6 @@
       ! 0) date from the minimum of ice extent
       !---------------------------------------
-      zday_min = 273.        ! zday_min = date of minimum extent, here September 30th
-      zday = REAL(numit-nit000) * rdt_ice / ( 86400. * REAL(nn_fsbc) )
+      zday_min = 273._wp        ! zday_min = date of minimum extent, here September 30th
+      zday = REAL(numit-nit000,wp) * rdt_ice / ( 86400._wp * REAL(nn_fsbc,wp) )
       !
       IF( zday > zday_min ) THEN   ;   zshift_date  =  zday - zday_min
@@ -97,5 +93,5 @@
 
       DO jv = nbvt + 1, nvinfo      ! put everything to zero
-         vinfor(jv) = 0.
+         vinfor(jv) = 0._wp
       END DO
 
@@ -108,27 +104,27 @@
          DO ji = fs_2, fs_jpim1   ! vector opt.
             IF( tms(ji,jj) == 1 ) THEN
-               vinfor(3)  = vinfor(3)  + at_i(ji,jj)*aire(ji,jj) * 1.e-12 !ice area
-               IF (at_i(ji,jj).GT.0.15) vinfor(5) = vinfor(5) + aire(ji,jj) * 1.e-12 !ice extent
-               vinfor(7)  = vinfor(7)  + vt_i(ji,jj)*aire(ji,jj) * 1.e-12 !ice volume
-               vinfor(9)  = vinfor(9)  + vt_s(ji,jj)*aire(ji,jj) * 1.e-12 !snow volume
-               vinfor(15) = vinfor(15) + ot_i(ji,jj) *vt_i(ji,jj)*aire(ji,jj) * 1.e-12 !mean age
-               vinfor(29) = vinfor(29) + smt_i(ji,jj)*vt_i(ji,jj)*aire(ji,jj) * 1.e-12 !mean salinity
+               vinfor(3)  = vinfor(3)  + at_i(ji,jj)*aire(ji,jj) * 1.e-12_wp !ice area
+               IF (at_i(ji,jj).GT.0.15) vinfor(5) = vinfor(5) + aire(ji,jj) * 1.e-12_wp !ice extent
+               vinfor(7)  = vinfor(7)  + vt_i(ji,jj)*aire(ji,jj) * 1.e-12_wp !ice volume
+               vinfor(9)  = vinfor(9)  + vt_s(ji,jj)*aire(ji,jj) * 1.e-12_wp !snow volume
+               vinfor(15) = vinfor(15) + ot_i(ji,jj) *vt_i(ji,jj)*aire(ji,jj) * 1.e-12_wp !mean age
+               vinfor(29) = vinfor(29) + smt_i(ji,jj)*vt_i(ji,jj)*aire(ji,jj) * 1.e-12_wp !mean salinity
                ! the computation of this diagnostic is not reliable
                vinfor(31) = vinfor(31) + vt_i(ji,jj)*( u_ice(ji,jj)*u_ice(ji,jj) + & 
                   v_ice(ji,jj)*v_ice(ji,jj) )*aire(ji,jj)/1.0e12 
-               vinfor(53) = vinfor(53) + emps(ji,jj)*aire(ji,jj) * 1.e-12 !salt flux
-               vinfor(55) = vinfor(55) + fsbri(ji,jj)*aire(ji,jj) * 1.e-12 !brine drainage flux
-               vinfor(57) = vinfor(57) + fseqv(ji,jj)*aire(ji,jj) * 1.e-12 !equivalent salt flux
-               vinfor(59) = vinfor(59) +(sst_m(ji,jj)+rt0)*at_i(ji,jj)*aire(ji,jj) * 1.e-12  !SST
-               vinfor(61) = vinfor(61) + sss_m(ji,jj)*at_i(ji,jj)*aire(ji,jj) * 1.e-12  !SSS
-               vinfor(65) = vinfor(65) + et_s(ji,jj)/1.0e9*aire(ji,jj) * 1.e-12  ! snow temperature
-               vinfor(67) = vinfor(67) + et_i(ji,jj)/1.0e9*aire(ji,jj) * 1.e-12       ! ice heat content
-               vinfor(69) = vinfor(69) + v_i(ji,jj,1)*aire(ji,jj) * 1.e-12 !ice volume
-               vinfor(71) = vinfor(71) + v_i(ji,jj,2)*aire(ji,jj) * 1.e-12 !ice volume
-               vinfor(73) = vinfor(73) + v_i(ji,jj,3)*aire(ji,jj) * 1.e-12 !ice volume
-               vinfor(75) = vinfor(75) + v_i(ji,jj,4)*aire(ji,jj) * 1.e-12 !ice volume
-               vinfor(77) = vinfor(77) + v_i(ji,jj,5)*aire(ji,jj) * 1.e-12 !ice volume
+               vinfor(53) = vinfor(53) + emps(ji,jj)*aire(ji,jj) * 1.e-12_wp !salt flux
+               vinfor(55) = vinfor(55) + fsbri(ji,jj)*aire(ji,jj) * 1.e-12_wp !brine drainage flux
+               vinfor(57) = vinfor(57) + fseqv(ji,jj)*aire(ji,jj) * 1.e-12_wp !equivalent salt flux
+               vinfor(59) = vinfor(59) +(sst_m(ji,jj)+rt0)*at_i(ji,jj)*aire(ji,jj) * 1.e-12_wp  !SST
+               vinfor(61) = vinfor(61) + sss_m(ji,jj)*at_i(ji,jj)*aire(ji,jj) * 1.e-12_wp  !SSS
+               vinfor(65) = vinfor(65) + et_s(ji,jj)/1.0e9*aire(ji,jj) * 1.e-12_wp  ! snow temperature
+               vinfor(67) = vinfor(67) + et_i(ji,jj)/1.0e9*aire(ji,jj) * 1.e-12_wp       ! ice heat content
+               vinfor(69) = vinfor(69) + v_i(ji,jj,1)*aire(ji,jj) * 1.e-12_wp !ice volume
+               vinfor(71) = vinfor(71) + v_i(ji,jj,2)*aire(ji,jj) * 1.e-12_wp !ice volume
+               vinfor(73) = vinfor(73) + v_i(ji,jj,3)*aire(ji,jj) * 1.e-12_wp !ice volume
+               vinfor(75) = vinfor(75) + v_i(ji,jj,4)*aire(ji,jj) * 1.e-12_wp !ice volume
+               vinfor(77) = vinfor(77) + v_i(ji,jj,5)*aire(ji,jj) * 1.e-12_wp !ice volume
                vinfor(79) = 0.0
-               vinfor(81) = vinfor(81) + emp(ji,jj)*aire(ji,jj) * 1.e-12 ! mass flux
+               vinfor(81) = vinfor(81) + emp(ji,jj)*aire(ji,jj) * 1.e-12_wp ! mass flux
             ENDIF
          END DO
@@ -139,5 +135,5 @@
             DO ji = fs_2, fs_jpim1   ! vector opt.
                IF( tms(ji,jj) == 1 ) THEN
-                  vinfor(11) = vinfor(11) + v_i(ji,jj,jl)*aire(ji,jj) * 1.e-12 !undef def ice volume
+                  vinfor(11) = vinfor(11) + v_i(ji,jj,jl)*aire(ji,jj) * 1.e-12_wp !undef def ice volume
                ENDIF
             END DO
@@ -145,5 +141,5 @@
       END DO
 
-      vinfor(13) = 0.
+      vinfor(13) = 0._wp
 
       vinfor(15) = vinfor(15) / MAX(vinfor(7),epsi06) ! these have to be divided by total ice volume to have the
@@ -169,6 +165,6 @@
             DO ji = fs_2, fs_jpim1   ! vector opt.
                IF( tms(ji,jj) == 1 ) THEN
-                  vinfor(33) = vinfor(33) + d_v_i_trp(ji,jj,jl)*aire(ji,jj) * 1.e-12 !ice volume
-                  vinfor(35) = vinfor(35) + d_v_i_thd(ji,jj,jl)*aire(ji,jj) * 1.e-12 !ice volume
+                  vinfor(33) = vinfor(33) + d_v_i_trp(ji,jj,jl)*aire(ji,jj) * 1.e-12_wp !ice volume
+                  vinfor(35) = vinfor(35) + d_v_i_thd(ji,jj,jl)*aire(ji,jj) * 1.e-12_wp !ice volume
                ENDIF
             END DO
@@ -179,10 +175,10 @@
          DO ji = fs_2, fs_jpim1   ! vector opt.
             IF( tms(ji,jj) == 1 ) THEN
-               vinfor(37) = vinfor(37) + diag_sni_gr(ji,jj)*aire(ji,jj) * 1.e-12 !th growth rates
-               vinfor(39) = vinfor(39) + diag_lat_gr(ji,jj)*aire(ji,jj) * 1.e-12 
-               vinfor(41) = vinfor(41) + diag_bot_gr(ji,jj)*aire(ji,jj) * 1.e-12
-               vinfor(43) = vinfor(43) + diag_dyn_gr(ji,jj)*aire(ji,jj) * 1.e-12 
-               vinfor(45) = vinfor(45) + dv_dt_thd(ji,jj,5)*aire(ji,jj) * 1.e-12
-               vinfor(47) = vinfor(47) + v_newice(ji,jj) *aire(ji,jj) * 1.e-12 / rdt_ice ! volume acc in OW
+               vinfor(37) = vinfor(37) + diag_sni_gr(ji,jj)*aire(ji,jj) * 1.e-12_wp !th growth rates
+               vinfor(39) = vinfor(39) + diag_lat_gr(ji,jj)*aire(ji,jj) * 1.e-12_wp 
+               vinfor(41) = vinfor(41) + diag_bot_gr(ji,jj)*aire(ji,jj) * 1.e-12_wp
+               vinfor(43) = vinfor(43) + diag_dyn_gr(ji,jj)*aire(ji,jj) * 1.e-12_wp 
+               vinfor(45) = vinfor(45) + dv_dt_thd(ji,jj,5)*aire(ji,jj) * 1.e-12_wp
+               vinfor(47) = vinfor(47) + v_newice(ji,jj) *aire(ji,jj) * 1.e-12_wp / rdt_ice ! volume acc in OW
             ENDIF
          END DO
@@ -193,5 +189,5 @@
             DO ji = fs_2, fs_jpim1   ! vector opt.
                IF( tms(ji,jj) == 1 ) THEN
-                  vinfor(63) = vinfor(63) + t_su(ji,jj,jl)*a_i(ji,jj,jl)*aire(ji,jj) * 1.e-12
+                  vinfor(63) = vinfor(63) + t_su(ji,jj,jl)*a_i(ji,jj,jl)*aire(ji,jj) * 1.e-12_wp
                ENDIF
             END DO
@@ -209,21 +205,21 @@
                DO jl = 1, jpl
                   IF ((o_i(ji,jj,jl) - zshift_date).LT.0.0) THEN
-                     vinfor(17) = vinfor(17) + a_i(ji,jj,jl)*aire(ji,jj) * 1.e-12 ! FY ice area
-                     vinfor(25) = vinfor(25) + v_i(ji,jj,jl)*aire(ji,jj) * 1.e-12 ! FY ice volume
-                     vinfor(49) = vinfor(49) + sm_i(ji,jj,jl)*v_i(ji,jj,jl)*aire(ji,jj) * 1.e-12 !FY ice salinity
+                     vinfor(17) = vinfor(17) + a_i(ji,jj,jl)*aire(ji,jj) * 1.e-12_wp ! FY ice area
+                     vinfor(25) = vinfor(25) + v_i(ji,jj,jl)*aire(ji,jj) * 1.e-12_wp ! FY ice volume
+                     vinfor(49) = vinfor(49) + sm_i(ji,jj,jl)*v_i(ji,jj,jl)*aire(ji,jj) * 1.e-12_wp !FY ice salinity
                      zafy = zafy + a_i(ji,jj,jl)
                   ENDIF
                   IF ((o_i(ji,jj,jl) - zshift_date).GT.0.0) THEN
-                     vinfor(19) = vinfor(19) + a_i(ji,jj,jl)*aire(ji,jj) * 1.e-12    ! MY ice area
-                     vinfor(27) = vinfor(27) + v_i(ji,jj,jl)*aire(ji,jj) * 1.e-12 ! MY ice volume
-                     vinfor(51) = vinfor(51) + sm_i(ji,jj,jl)*v_i(ji,jj,jl)*aire(ji,jj) * 1.e-12 !MY ice salinity
+                     vinfor(19) = vinfor(19) + a_i(ji,jj,jl)*aire(ji,jj) * 1.e-12_wp    ! MY ice area
+                     vinfor(27) = vinfor(27) + v_i(ji,jj,jl)*aire(ji,jj) * 1.e-12_wp ! MY ice volume
+                     vinfor(51) = vinfor(51) + sm_i(ji,jj,jl)*v_i(ji,jj,jl)*aire(ji,jj) * 1.e-12_wp !MY ice salinity
                      zamy = zamy + a_i(ji,jj,jl)
                   ENDIF
                END DO
                IF ((at_i(ji,jj).GT.0.15).AND.(zafy.GT.zamy)) THEN
-                  vinfor(21) = vinfor(21) + aire(ji,jj) * 1.e-12 ! Seasonal ice extent
+                  vinfor(21) = vinfor(21) + aire(ji,jj) * 1.e-12_wp ! Seasonal ice extent
                ENDIF
                IF ((at_i(ji,jj).GT.0.15).AND.(zafy.LE.zamy)) THEN
-                  vinfor(23) = vinfor(23) + aire(ji,jj) * 1.e-12 ! Perennial ice extent
+                  vinfor(23) = vinfor(23) + aire(ji,jj) * 1.e-12_wp ! Perennial ice extent
                ENDIF
             ENDIF
@@ -245,7 +241,7 @@
       DO ji = 134, 138
          vinfor(83) = vinfor(83) - v_ice(ji,jj) * & 
-            e1t(ji,jj)*at_i(ji,jj)*rdt_ice * 1.e-12
+            e1t(ji,jj)*at_i(ji,jj)*rdt_ice * 1.e-12_wp
          vinfor(84) = vinfor(84) - v_ice(ji,jj) * & 
-            e1t(ji,jj)*vt_i(ji,jj)*rdt_ice * 1.e-12
+            e1t(ji,jj)*vt_i(ji,jj)*rdt_ice * 1.e-12_wp
       END DO
 
@@ -258,28 +254,28 @@
          DO ji = fs_2, fs_jpim1   ! vector opt.
             IF( tms(ji,jj) == 1 ) THEN
-               vinfor(4)  = vinfor(4)  + at_i(ji,jj)*aire(ji,jj) * 1.e-12 !ice area
-               IF (at_i(ji,jj).GT.0.15) vinfor(6) = vinfor(6) + aire(ji,jj) * 1.e-12 !ice extent
-               vinfor(8)  = vinfor(8)  + vt_i(ji,jj)*aire(ji,jj) * 1.e-12 !ice volume
-               vinfor(10) = vinfor(10) + vt_s(ji,jj)*aire(ji,jj) * 1.e-12 !snow volume
-               vinfor(16) = vinfor(16) + ot_i(ji,jj)*vt_i(ji,jj)*aire(ji,jj) * 1.e-12 !mean age
-               vinfor(30) = vinfor(30) + smt_i(ji,jj)*vt_i(ji,jj)*aire(ji,jj) * 1.e-12 !mean salinity
+               vinfor(4)  = vinfor(4)  + at_i(ji,jj)*aire(ji,jj) * 1.e-12_wp !ice area
+               IF (at_i(ji,jj).GT.0.15) vinfor(6) = vinfor(6) + aire(ji,jj) * 1.e-12_wp !ice extent
+               vinfor(8)  = vinfor(8)  + vt_i(ji,jj)*aire(ji,jj) * 1.e-12_wp !ice volume
+               vinfor(10) = vinfor(10) + vt_s(ji,jj)*aire(ji,jj) * 1.e-12_wp !snow volume
+               vinfor(16) = vinfor(16) + ot_i(ji,jj)*vt_i(ji,jj)*aire(ji,jj) * 1.e-12_wp !mean age
+               vinfor(30) = vinfor(30) + smt_i(ji,jj)*vt_i(ji,jj)*aire(ji,jj) * 1.e-12_wp !mean salinity
                ! this diagnostic is not well computed (weighted by vol instead
                ! of area)
                vinfor(32) = vinfor(32) + vt_i(ji,jj)*( u_ice(ji,jj)*u_ice(ji,jj) + & 
                   v_ice(ji,jj)*v_ice(ji,jj) )*aire(ji,jj)/1.0e12 !ice vel
-               vinfor(54) = vinfor(54) + at_i(ji,jj)*emps(ji,jj)*aire(ji,jj) * 1.e-12 ! Total salt flux
-               vinfor(56) = vinfor(56) + at_i(ji,jj)*fsbri(ji,jj)*aire(ji,jj) * 1.e-12 ! Brine drainage salt flux
-               vinfor(58) = vinfor(58) + at_i(ji,jj)*fseqv(ji,jj)*aire(ji,jj) * 1.e-12 ! Equivalent salt flux
-               vinfor(60) = vinfor(60) +(sst_m(ji,jj)+rt0)*at_i(ji,jj)*aire(ji,jj) * 1.e-12  !SST
-               vinfor(62) = vinfor(62) + sss_m(ji,jj)*at_i(ji,jj)*aire(ji,jj) * 1.e-12  !SSS
-               vinfor(66) = vinfor(66) + et_s(ji,jj)/1.0e9*aire(ji,jj) * 1.e-12 ! snow temperature
-               vinfor(68) = vinfor(68) + et_i(ji,jj)/1.0e9*aire(ji,jj) * 1.e-12 ! ice enthalpy
-               vinfor(70) = vinfor(70) + v_i(ji,jj,1)*aire(ji,jj) * 1.e-12 !ice volume
-               vinfor(72) = vinfor(72) + v_i(ji,jj,2)*aire(ji,jj) * 1.e-12 !ice volume
-               vinfor(74) = vinfor(74) + v_i(ji,jj,3)*aire(ji,jj) * 1.e-12 !ice volume
-               vinfor(76) = vinfor(76) + v_i(ji,jj,4)*aire(ji,jj) * 1.e-12 !ice volume
-               vinfor(78) = vinfor(78) + v_i(ji,jj,5)*aire(ji,jj) * 1.e-12 !ice volume
+               vinfor(54) = vinfor(54) + at_i(ji,jj)*emps(ji,jj)*aire(ji,jj) * 1.e-12_wp ! Total salt flux
+               vinfor(56) = vinfor(56) + at_i(ji,jj)*fsbri(ji,jj)*aire(ji,jj) * 1.e-12_wp ! Brine drainage salt flux
+               vinfor(58) = vinfor(58) + at_i(ji,jj)*fseqv(ji,jj)*aire(ji,jj) * 1.e-12_wp ! Equivalent salt flux
+               vinfor(60) = vinfor(60) +(sst_m(ji,jj)+rt0)*at_i(ji,jj)*aire(ji,jj) * 1.e-12_wp  !SST
+               vinfor(62) = vinfor(62) + sss_m(ji,jj)*at_i(ji,jj)*aire(ji,jj) * 1.e-12_wp  !SSS
+               vinfor(66) = vinfor(66) + et_s(ji,jj)/1.0e9*aire(ji,jj) * 1.e-12_wp ! snow temperature
+               vinfor(68) = vinfor(68) + et_i(ji,jj)/1.0e9*aire(ji,jj) * 1.e-12_wp ! ice enthalpy
+               vinfor(70) = vinfor(70) + v_i(ji,jj,1)*aire(ji,jj) * 1.e-12_wp !ice volume
+               vinfor(72) = vinfor(72) + v_i(ji,jj,2)*aire(ji,jj) * 1.e-12_wp !ice volume
+               vinfor(74) = vinfor(74) + v_i(ji,jj,3)*aire(ji,jj) * 1.e-12_wp !ice volume
+               vinfor(76) = vinfor(76) + v_i(ji,jj,4)*aire(ji,jj) * 1.e-12_wp !ice volume
+               vinfor(78) = vinfor(78) + v_i(ji,jj,5)*aire(ji,jj) * 1.e-12_wp !ice volume
                vinfor(80) = 0.0
-               vinfor(82) = vinfor(82) + emp(ji,jj)*aire(ji,jj) * 1.e-12 ! mass flux
+               vinfor(82) = vinfor(82) + emp(ji,jj)*aire(ji,jj) * 1.e-12_wp ! mass flux
             ENDIF
          END DO
@@ -289,5 +285,5 @@
          DO jj = 2, njeqm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               vinfor(12) = vinfor(12) + v_i(ji,jj,jl)*aire(ji,jj) * 1.e-12 !undef def ice volume
+               vinfor(12) = vinfor(12) + v_i(ji,jj,jl)*aire(ji,jj) * 1.e-12_wp !undef def ice volume
             END DO
          END DO
@@ -320,6 +316,6 @@
             DO ji = fs_2, fs_jpim1   ! vector opt.
                IF( tms(ji,jj) == 1 ) THEN
-                  vinfor(34) = vinfor(34) + d_v_i_trp(ji,jj,jl)*aire(ji,jj) * 1.e-12 !ice volume
-                  vinfor(36) = vinfor(36) + d_v_i_thd(ji,jj,jl)*aire(ji,jj) * 1.e-12 !ice volume
+                  vinfor(34) = vinfor(34) + d_v_i_trp(ji,jj,jl)*aire(ji,jj) * 1.e-12_wp !ice volume
+                  vinfor(36) = vinfor(36) + d_v_i_thd(ji,jj,jl)*aire(ji,jj) * 1.e-12_wp !ice volume
                ENDIF
             END DO
@@ -330,10 +326,10 @@
          DO ji = fs_2, fs_jpim1   ! vector opt.
             IF( tms(ji,jj) == 1 ) THEN
-               vinfor(38) = vinfor(38) + diag_sni_gr(ji,jj)*aire(ji,jj) * 1.e-12 !th growth rates
-               vinfor(40) = vinfor(40) + diag_lat_gr(ji,jj)*aire(ji,jj) * 1.e-12 
-               vinfor(42) = vinfor(42) + diag_bot_gr(ji,jj)*aire(ji,jj) * 1.e-12
-               vinfor(44) = vinfor(44) + diag_dyn_gr(ji,jj)*aire(ji,jj) * 1.e-12 
-               vinfor(46) = vinfor(46) + dv_dt_thd(ji,jj,5)*aire(ji,jj) * 1.e-12
-               vinfor(48) = vinfor(48) + v_newice(ji,jj) *aire(ji,jj) * 1.e-12 / rdt_ice ! volume acc in OW
+               vinfor(38) = vinfor(38) + diag_sni_gr(ji,jj)*aire(ji,jj) * 1.e-12_wp !th growth rates
+               vinfor(40) = vinfor(40) + diag_lat_gr(ji,jj)*aire(ji,jj) * 1.e-12_wp 
+               vinfor(42) = vinfor(42) + diag_bot_gr(ji,jj)*aire(ji,jj) * 1.e-12_wp
+               vinfor(44) = vinfor(44) + diag_dyn_gr(ji,jj)*aire(ji,jj) * 1.e-12_wp 
+               vinfor(46) = vinfor(46) + dv_dt_thd(ji,jj,5)*aire(ji,jj) * 1.e-12_wp
+               vinfor(48) = vinfor(48) + v_newice(ji,jj) *aire(ji,jj) * 1.e-12_wp / rdt_ice ! volume acc in OW
             ENDIF
          END DO
@@ -344,5 +340,5 @@
             DO ji = fs_2, fs_jpim1   ! vector opt.
                IF( tms(ji,jj) == 1 ) THEN
-                  vinfor(64) = vinfor(64) + t_su(ji,jj,jl)*a_i(ji,jj,jl)*aire(ji,jj) * 1.e-12
+                  vinfor(64) = vinfor(64) + t_su(ji,jj,jl)*a_i(ji,jj,jl)*aire(ji,jj) * 1.e-12_wp
                ENDIF
             END DO
@@ -356,25 +352,25 @@
          DO ji = fs_2, fs_jpim1   ! vector opt.
             IF( tms(ji,jj) == 1 ) THEN
-               zafy = 0.
-               zamy = 0.
+               zafy = 0._wp
+               zamy = 0._wp
                DO jl = 1, jpl
-                  IF( (o_i(ji,jj,jl) - zshift_date) < 0. ) THEN
-                     vinfor(18) = vinfor(18) + a_i(ji,jj,jl)*aire(ji,jj) * 1.e-12 ! FY ice area
-                     vinfor(26) = vinfor(26) + v_i(ji,jj,jl)*aire(ji,jj) * 1.e-12 ! FY ice volume
+                  IF( (o_i(ji,jj,jl) - zshift_date) < 0._wp ) THEN
+                     vinfor(18) = vinfor(18) + a_i(ji,jj,jl)*aire(ji,jj) * 1.e-12_wp ! FY ice area
+                     vinfor(26) = vinfor(26) + v_i(ji,jj,jl)*aire(ji,jj) * 1.e-12_wp ! FY ice volume
                      zafy = zafy + a_i(ji,jj,jl)
-                     vinfor(50) = vinfor(50) + sm_i(ji,jj,jl)*v_i(ji,jj,jl)*aire(ji,jj) * 1.e-12 !FY ice salinity
+                     vinfor(50) = vinfor(50) + sm_i(ji,jj,jl)*v_i(ji,jj,jl)*aire(ji,jj) * 1.e-12_wp !FY ice salinity
                   ENDIF
-                  IF( (o_i(ji,jj,jl) - zshift_date) > 0. ) THEN
-                     vinfor(20) = vinfor(20) + a_i(ji,jj,jl)*aire(ji,jj) * 1.e-12    ! MY ice area
-                     vinfor(28) = vinfor(28) + v_i(ji,jj,jl)*aire(ji,jj) * 1.e-12
-                     vinfor(52) = vinfor(52) + sm_i(ji,jj,jl)*v_i(ji,jj,jl)*aire(ji,jj) * 1.e-12 !FY ice salinity
+                  IF( (o_i(ji,jj,jl) - zshift_date) > 0._wp ) THEN
+                     vinfor(20) = vinfor(20) + a_i(ji,jj,jl)*aire(ji,jj) * 1.e-12_wp    ! MY ice area
+                     vinfor(28) = vinfor(28) + v_i(ji,jj,jl)*aire(ji,jj) * 1.e-12_wp
+                     vinfor(52) = vinfor(52) + sm_i(ji,jj,jl)*v_i(ji,jj,jl)*aire(ji,jj) * 1.e-12_wp !FY ice salinity
                      zamy = zamy + a_i(ji,jj,jl)
                   ENDIF
                END DO ! jl
                IF ((at_i(ji,jj).GT.0.15).AND.(zafy.GT.zamy)) THEN
-                  vinfor(22) = vinfor(22) + aire(ji,jj) * 1.e-12 ! Seasonal ice extent
+                  vinfor(22) = vinfor(22) + aire(ji,jj) * 1.e-12_wp ! Seasonal ice extent
                ENDIF
                IF ((at_i(ji,jj).GT.0.15).AND.(zafy.LE.zamy)) THEN
-                  vinfor(24) = vinfor(24) + aire(ji,jj) * 1.e-12 ! Perennial ice extent
+                  vinfor(24) = vinfor(24) + aire(ji,jj) * 1.e-12_wp ! Perennial ice extent
                ENDIF
             ENDIF ! tms
@@ -397,5 +393,5 @@
       naveg = 0
       DO jv = 1, nvinfo
-         vinfom(jv) = 0.
+         vinfom(jv) = 0._wp
       END DO
       !MV      ENDIF
@@ -568,5 +564,5 @@
       !--Initialisation of the arrays for the accumulation
       DO jv = 1, nvinfo
-         vinfom(jv) = 0.
+         vinfom(jv) = 0._wp
       END DO
       naveg = 0
Index: trunk/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90	(revision 2528)
@@ -4,4 +4,7 @@
    !!   Sea-Ice dynamics :  
    !!======================================================================
+   !! 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
+   !!----------------------------------------------------------------------
 #if defined key_lim3
    !!----------------------------------------------------------------------
@@ -11,5 +14,4 @@
    !!    lim_dyn_init : initialization and namelist read
    !!----------------------------------------------------------------------
-   !! * Modules used
    USE phycst
    USE in_out_manager  ! I/O manager
@@ -28,19 +30,13 @@
    PRIVATE
 
-   !! * Accessibility
-   PUBLIC lim_dyn  ! routine called by ice_step
+   PUBLIC   lim_dyn   ! routine called by ice_step
 
    !! * Substitutions
 #  include "vectopt_loop_substitute.h90"
-
-   !! * Module variables
-   REAL(wp)  ::  rone    = 1.e0   ! constant value
-
-   !!----------------------------------------------------------------------
-   !!   LIM 3.0,  UCL-ASTR-LOCEAN-IPSL (2008)
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
@@ -57,15 +53,10 @@
       !!              - computation of the stress at the ocean surface         
       !!              - treatment of the case if no ice dynamic
-      !! History :
-      !!   1.0  !  01-04   (LIM)  Original code
-      !!   2.0  !  02-08   (C. Ethe, G. Madec)  F90, mpp
-      !!   3.0  !  2007-03 (M.A. Morales Maqueda, S. Bouillon, M. Vancoppenolle) 
-      !!                   LIM3, EVP, C-grid
       !!------------------------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt     ! number of iteration
-      !! * Local variables
+      !!
       INTEGER  ::   ji, jj, jl, ja    ! dummy loop indices
       INTEGER  ::   i_j1, i_jpj       ! Starting/ending j-indices for rheology
-      REAL(wp) ::   zcoef             ! temporary scalar
+      REAL(wp) ::   zcoef             ! local scalar
       REAL(wp), DIMENSION(jpj)     ::   zind           ! i-averaged indicator of sea-ice
       REAL(wp), DIMENSION(jpj)     ::   zmsk           ! i-averaged of tmask
@@ -91,5 +82,5 @@
          ! ---------------------------------------------------
 
-         IF( lk_mpp .OR. nbit_cmp == 1 ) THEN                    ! mpp: compute over the whole domain
+         IF( lk_mpp .OR. lk_mpp_rep ) THEN                    ! mpp: compute over the whole domain
             i_j1 = 1
             i_jpj = jpj
@@ -156,9 +147,9 @@
          zv_io(:,:) = v_ice(:,:) - ssv_m(:,:)
          ! frictional velocity at T-point
+         zcoef = 0.5 * cw
          DO jj = 2, jpjm1 
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               ust2s(ji,jj) = 0.5 * cw                                                          &
-                  &         * (  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)
+               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)
             END DO
          END DO
@@ -169,11 +160,10 @@
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               ust2s(ji,jj) = zcoef * tms(ji,jj) * 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) )
+               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)
             END DO
          END DO
          !
       ENDIF
-
       CALL lbc_lnk( ust2s, 'T',  1. )   ! T-point
 
@@ -216,6 +206,7 @@
          END DO
       ENDIF
-
+      !
    END SUBROUTINE lim_dyn
+
 
    SUBROUTINE lim_dyn_init
@@ -230,9 +221,4 @@
       !!
       !! ** input   :   Namelist namicedyn
-      !!
-      !! history :
-      !!  8.5  ! 03-08 (C. Ethe) original code
-      !!  9.0  ! 07-03 (MA Morales Maqueda, S. Bouillon, M. Vancoppenolle)
-      !!               EVP-Cgrid-LIM3
       !!-------------------------------------------------------------------
       NAMELIST/namicedyn/ epsd, alpha,     &
@@ -242,11 +228,8 @@
       !!-------------------------------------------------------------------
 
-      ! Define the initial parameters
-      ! -------------------------
-
-      ! Read Namelist namicedyn
-      REWIND ( numnam_ice )
-      READ   ( numnam_ice  , namicedyn )
-      IF(lwp) THEN
+      REWIND( numnam_ice )                ! Read Namelist namicedyn
+      READ  ( numnam_ice  , namicedyn )
+      
+      IF(lwp) THEN                        ! control print
          WRITE(numout,*)
          WRITE(numout,*) 'lim_dyn_init : ice parameters for ice dynamics '
@@ -270,13 +253,18 @@
          WRITE(numout,*) '   timescale for elastic waves                      telast = ', telast
          WRITE(numout,*) '   coefficient for the solution of int. stresses  alphaevp = ', alphaevp
-
-      ENDIF
-
-      usecc2 = 1.0 / ( ecc * ecc )
-      rhoco  = rau0 * cw
+      ENDIF
+      !
+      IF( angvg /= 0._wp ) THEN
+         CALL ctl_warn( 'lim_dyn_init: turning angle for oceanic stress not properly coded for EVP ',   &
+            &           '(see limsbc module). We force  angvg = 0._wp'  )
+         angvg = 0._wp
+      ENDIF
+      
+      usecc2 = 1._wp / ( ecc * ecc )
+      rhoco  = rau0  * cw
       angvg  = angvg * rad
       sangvg = SIN( angvg )
       cangvg = COS( angvg )
-      pstarh = pstar / 2.0
+      pstarh = pstar * 0.5_wp
 
       !  Diffusion coefficients.
Index: trunk/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90	(revision 2528)
@@ -32,7 +32,7 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005) 
+   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90	(revision 2528)
@@ -4,4 +4,6 @@
    !!              Initialisation of diagnostics ice variables
    !!======================================================================
+   !! History :  2.0  ! 2004-01 (C. Ethe, G. Madec)  Original code
+   !!----------------------------------------------------------------------
 #if defined key_lim3
    !!----------------------------------------------------------------------
@@ -11,48 +13,40 @@
    !!   lim_istate_init :  initialization of ice state and namelist read
    !!----------------------------------------------------------------------
-   !! * 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 eosbn2          ! equation of state
-   USE in_out_manager
-   USE dom_ice
-   USE ice
-   USE lbclnk
+   USE phycst           ! physical constant
+   USE oce              ! dynamics and tracers variables
+   USE dom_oce          ! ocean domain
+   USE sbc_oce          ! Surface boundary condition: ocean fields
+   USE eosbn2           ! equation of state
+   USE ice              ! sea-ice variables
+   USE par_ice          ! ice parameters
+   USE dom_ice          ! sea-ice domain
+   USE in_out_manager   ! I/O manager
+   USE lbclnk           ! lateral boundary condition - MPP exchanges
 
    IMPLICIT NONE
    PRIVATE
 
-   !! * Accessibility
-   PUBLIC lim_istate      ! routine called by lim_init.F90
-
-   !! * Module variables
-   REAL(wp) ::             & !!! ** init namelist (namiceini) **
-      ttest    = 2.0  ,    &  ! threshold water temperature for initial sea ice
-      hninn    = 0.5  ,    &  ! initial snow thickness in the north
-      hginn_u  = 2.5  ,    &  ! initial ice thickness in the north
-      aginn_u  = 0.7  ,    &  ! initial leads area in the north
-      hginn_d  = 5.0  ,    &  ! initial ice thickness in the north
-      aginn_d  = 0.25 ,    &  ! initial leads area in the north
-      hnins    = 0.1  ,    &  ! initial snow thickness in the south
-      hgins_u  = 1.0  ,    &  ! initial ice thickness in the south
-      agins_u  = 0.7  ,    &  ! initial leads area in the south
-      hgins_d  = 2.0  ,    &  ! initial ice thickness in the south
-      agins_d  = 0.2  ,    &  ! initial leads area in the south
-      sinn     = 6.301 ,   &  ! initial salinity 
-      sins     = 6.301
-
-   REAL(wp)  ::            &  ! constant values
-      zzero   = 0.0     ,  &
-      zone    = 1.0
-
-   !!----------------------------------------------------------------------
-   !!   LIM 3.0,  UCL-LOCEAN-IPSL (2008)
+   PUBLIC   lim_istate      ! routine called by lim_init.F90
+
+   !                                  !!** init namelist (namiceini) **
+   REAL(wp) ::   ttest    = 2.0_wp     ! threshold water temperature for initial sea ice
+   REAL(wp) ::   hninn    = 0.5_wp     ! initial snow thickness in the north
+   REAL(wp) ::   hginn_u  = 2.5_wp     ! initial ice thickness in the north
+   REAL(wp) ::   aginn_u  = 0.7_wp     ! initial leads area in the north
+   REAL(wp) ::   hginn_d  = 5.0_wp     ! initial ice thickness in the north
+   REAL(wp) ::   aginn_d  = 0.25_wp    ! initial leads area in the north
+   REAL(wp) ::   hnins    = 0.1_wp     ! initial snow thickness in the south
+   REAL(wp) ::   hgins_u  = 1.0_wp     ! initial ice thickness in the south
+   REAL(wp) ::   agins_u  = 0.7_wp     ! initial leads area in the south
+   REAL(wp) ::   hgins_d  = 2.0_wp     ! initial ice thickness in the south
+   REAL(wp) ::   agins_d  = 0.2_wp     ! initial leads area in the south
+   REAL(wp) ::   sinn     = 6.301_wp   ! initial salinity 
+   REAL(wp) ::   sins     = 6.301_wp   !
+
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
@@ -65,21 +59,11 @@
       !! ** Method  :   restart from a state defined in a binary file
       !!                or from arbitrary sea-ice conditions
-      !!
-      !! History :
-      !!   2.0  !  01-04  (C. Ethe, G. Madec)  Original code
-      !!--------------------------------------------------------------------
-
-      !! * Local variables
+      !!-------------------------------------------------------------------
       INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices
-
-      REAL(wp) ::       &  ! temporary scalar
-         zeps6, zeps, ztmelts, &
-         epsi06
-      REAL(wp), DIMENSION(jpm) ::   &
-         zgfactorn, zhin, &
-         zgfactors, zhis
-      REAL(wp) ::  &
-         zvol, zare, zh, zh1, zh2, zh3, zan, zbn, zas, zbs 
-      REAL(wp), DIMENSION(jpi,jpj) ::   zidto    ! ice indicator
+      REAL(wp) ::   zeps6, zeps, ztmelts, epsi06   ! local scalars
+      REAL(wp) ::  zvol, zare, zh, zh1, zh2, zh3, zan, zbn, zas, zbs 
+      REAL(wp), DIMENSION(jpm)     ::   zgfactorn, zhin 
+      REAL(wp), DIMENSION(jpm)     ::   zgfactors, zhis
+      REAL(wp), DIMENSION(jpi,jpj) ::   zidto      ! ice indicator
       !--------------------------------------------------------------------
 
@@ -87,5 +71,5 @@
       ! 1) Preliminary things 
       !--------------------------------------------------------------------
-      epsi06 = 1.0e-6
+      epsi06 = 1.e-6_wp
 
       CALL lim_istate_init     !  reading the initials parameters of the ice
@@ -116,17 +100,17 @@
 
       ! constants for heat contents
-      zeps   = 1.0d-20
-      zeps6  = 1.0d-06
+      zeps   = 1.e-20_wp
+      zeps6  = 1.e-06_wp
 
       ! zgfactor for initial ice distribution
-      zgfactorn(:) = 0.0
-      zgfactors(:) = 0.0
+      zgfactorn(:) = 0._wp
+      zgfactors(:) = 0._wp
 
       ! first ice type
       DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2)
-         zhin (1)     = ( hi_max(jl-1) + hi_max(jl) ) / 2.0
-         zgfactorn(1) = zgfactorn(1) + exp(-(zhin(1)-hginn_u)*(zhin(1)-hginn_u)/2.0)
-         zhis (1)     = ( hi_max(jl-1) + hi_max(jl) ) / 2.0
-         zgfactors(1) = zgfactors(1) + exp(-(zhis(1)-hgins_u)*(zhis(1)-hgins_u)/2.0)
+         zhin (1)     = ( hi_max(jl-1) + hi_max(jl) ) * 0.5_wp
+         zgfactorn(1) = zgfactorn(1) + exp(-(zhin(1)-hginn_u)*(zhin(1)-hginn_u) * 0.5_wp )
+         zhis (1)     = ( hi_max(jl-1) + hi_max(jl) ) * 0.5_wp
+         zgfactors(1) = zgfactors(1) + exp(-(zhis(1)-hgins_u)*(zhis(1)-hgins_u) * 0.5_wp )
       END DO ! jl
       zgfactorn(1) = aginn_u / zgfactorn(1)
@@ -135,12 +119,12 @@
       ! -------------
       ! new distribution, polynom of second order, conserving area and volume
-      zh1 = 0.0
-      zh2 = 0.0
-      zh3 = 0.0
+      zh1 = 0._wp
+      zh2 = 0._wp
+      zh3 = 0._wp
       DO jl = 1, jpl
-         zh = ( hi_max(jl-1) + hi_max(jl) ) / 2.0
+         zh = ( hi_max(jl-1) + hi_max(jl) ) * 0.5_wp
          zh1 = zh1 + zh
-         zh2 = zh2 + zh*zh
-         zh3 = zh3 + zh*zh*zh
+         zh2 = zh2 + zh * zh
+         zh3 = zh3 + zh * zh * zh
       END DO
       IF(lwp) WRITE(numout,*) ' zh1 : ', zh1
@@ -148,7 +132,7 @@
       IF(lwp) WRITE(numout,*) ' zh3 : ', zh3
 
-      zvol = aginn_u*hginn_u
+      zvol = aginn_u * hginn_u
       zare = aginn_u
-      IF ( jpl .GE. 2 ) THEN
+      IF( jpl >= 2 ) THEN
          zbn = ( zvol*zh2 - zare*zh3 ) / ( zh2*zh2 - zh1*zh3)
          zan = ( zare - zbn*zh1 ) / zh2
@@ -160,7 +144,7 @@
       IF(lwp) WRITE(numout,*) ' zan : ', zan 
 
-      zvol = agins_u*hgins_u
+      zvol = agins_u * hgins_u
       zare = agins_u
-      IF ( jpl .GE. 2 ) THEN
+      IF( jpl >= 2 ) THEN
          zbs = ( zvol*zh2 - zare*zh3 ) / ( zh2*zh2 - zh1*zh3)
          zas = ( zare - zbs*zh1 ) / zh2
@@ -205,5 +189,5 @@
             !--- Northern hemisphere
             !----------------------------------------------------------------
-            IF( fcor(ji,jj) >= 0.e0 ) THEN    
+            IF( fcor(ji,jj) >= 0._wp ) THEN    
 
                !-----------------------
@@ -453,6 +437,6 @@
             ENDIF ! on fcor
 
-         ENDDO
-      ENDDO
+         END DO
+      END DO
 
       !--------------------------------------------------------------------
@@ -494,5 +478,4 @@
 
       DO jl = 1, jpl
-
          CALL lbc_lnk( a_i(:,:,jl)  , 'T', 1. )
          CALL lbc_lnk( v_i(:,:,jl)  , 'T', 1. )
@@ -500,5 +483,5 @@
          CALL lbc_lnk( smv_i(:,:,jl), 'T', 1. )
          CALL lbc_lnk( oa_i(:,:,jl) , 'T', 1. )
-
+         !
          CALL lbc_lnk( ht_i(:,:,jl) , 'T', 1. )
          CALL lbc_lnk( ht_s(:,:,jl) , 'T', 1. )
@@ -514,15 +497,15 @@
             CALL lbc_lnk(e_i(:,:,jk,jl), 'T', 1. )
          END DO
-
-         a_i (:,:,jl) = tms(:,:) * a_i(:,:,jl)
-
+         !
+         a_i(:,:,jl) = tms(:,:) * a_i(:,:,jl)
       END DO
 
       CALL lbc_lnk( at_i , 'T', 1. )
       at_i(:,:) = tms(:,:) * at_i(:,:)                       ! put 0 over land
-
+      !
       CALL lbc_lnk( fsbbq  , 'T', 1. )
-
+      !
    END SUBROUTINE lim_istate
+
 
    SUBROUTINE lim_istate_init
@@ -532,24 +515,17 @@
       !! ** Purpose : Definition of initial state of the ice 
       !!
-      !! ** Method : Read the namiceini namelist and check the parameter 
-      !!       values called at the first timestep (nit000)
+      !! ** Method :   Read the namiceini namelist and check the parameter 
+      !!             values called at the first timestep (nit000)
       !!
-      !! ** input : 
-      !!        Namelist namiceini
-      !!
-      !! history :
-      !!  8.5  ! 03-08 (C. Ethe) original code
+      !! ** input  :   namelist namiceini
       !!-----------------------------------------------------------------------------
-      NAMELIST/namiceini/ ttest, hninn, hginn_u, aginn_u, hginn_d, aginn_d, hnins, &
-         hgins_u, agins_u, hgins_d, agins_d, sinn, sins
+      NAMELIST/namiceini/ ttest, hninn, hginn_u, aginn_u, hginn_d, aginn_d, hnins,   &
+         &                hgins_u, agins_u, hgins_d, agins_d, sinn, sins
       !!-----------------------------------------------------------------------------
-
-      ! Define the initial parameters
-      ! -------------------------
-
-      ! Read Namelist namiceini 
-      REWIND ( numnam_ice )
+      !
+      REWIND ( numnam_ice )               ! Read Namelist namiceini 
       READ   ( numnam_ice , namiceini )
-      IF(lwp) THEN
+      !
+      IF(lwp) THEN                        ! control print
          WRITE(numout,*)
          WRITE(numout,*) 'lim_istate_init : ice parameters inititialisation '
@@ -569,5 +545,5 @@
          WRITE(numout,*) '   initial  ice salinity       in the south     sins       = ', sins
       ENDIF
-
+      !
    END SUBROUTINE lim_istate_init
 
Index: trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90	(revision 2528)
@@ -86,7 +86,7 @@
 
    !!----------------------------------------------------------------------
-   !!   LIM 3.0,  UCL-LOCEAN-IPSL (2008)
+   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90	(revision 2528)
@@ -1,7 +1,3 @@
 MODULE limitd_th
-#if defined key_lim3
-   !!----------------------------------------------------------------------
-   !!   'key_lim3' :                                   LIM3 sea-ice model
-   !!----------------------------------------------------------------------
    !!======================================================================
    !!                       ***  MODULE limitd_th ***
@@ -9,7 +5,9 @@
    !!                   computation of changes in g(h)      
    !!======================================================================
-
+#if defined key_lim3
    !!----------------------------------------------------------------------
-   !! * Modules used
+   !!   'key_lim3' :                                   LIM3 sea-ice model
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
    USE dom_ice
    USE par_oce          ! ocean parameters
@@ -17,5 +15,4 @@
    USE phycst           ! physical constants (ocean directory) 
    USE thd_ice
-   USE in_out_manager
    USE ice
    USE par_ice
@@ -24,4 +21,5 @@
    USE limcons
    USE prtctl           ! Print control
+   USE in_out_manager
    USE lib_mpp 
 
@@ -29,5 +27,4 @@
    PRIVATE
 
-   !! * Routine accessibility
    PUBLIC lim_itd_th        ! called by ice_stp
    PUBLIC lim_itd_th_rem
@@ -36,5 +33,4 @@
    PUBLIC lim_itd_shiftice
 
-   !! * Module variables
    REAL(wp)  ::           &  ! constant values
       epsi20 = 1e-20   ,  &
@@ -44,7 +40,7 @@
 
    !!----------------------------------------------------------------------
-   !!   LIM 3.0,  UCL-LOCEAN-IPSL (2008)
+   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/LIM_SRC_3/limmsh.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_3/limmsh.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_3/limmsh.F90	(revision 2528)
@@ -24,7 +24,7 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/LIM 3.2,  UCL-ASTR-LOCEAN-IPSL (2009) 
+   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90	(revision 2528)
@@ -7,49 +7,49 @@
    !!            3.0  !  2008-03  (M. Vancoppenolle) LIM3
    !!             -   !  2008-11  (M. Vancoppenolle, S. Bouillon, Y. Aksenov) add surface tilt in ice rheolohy 
+   !!            3.3  !  2009-05  (G.Garric) addition of the lim2_evp cas
    !!----------------------------------------------------------------------
-#if defined key_lim3
+#if defined key_lim3 || (  defined key_lim2 && ! defined key_lim2_vp )
    !!----------------------------------------------------------------------
-   !!   'key_lim3'                                      LIM3 sea-ice model
+   !!   'key_lim3'               OR                     LIM-3 sea-ice model
+   !!   'key_lim2' AND NOT 'key_lim2_vp'             VP LIM-2 sea-ice model
    !!----------------------------------------------------------------------
    !!   lim_rhg   : computes ice velocities
    !!----------------------------------------------------------------------
-   !! * Modules used
-   USE phycst
-   USE par_oce
-   USE dom_oce
-   USE dom_ice
-   USE sbc_oce         ! Surface boundary condition: ocean fields
-   USE sbc_ice         ! Surface boundary condition: ice fields
-   USE ice
-   USE lbclnk
-   USE lib_mpp
-   USE in_out_manager  ! I/O manager
-   USE limitd_me
-   USE prtctl          ! Print control
-
+   USE phycst           ! Physical constant
+   USE par_oce          ! Ocean parameters
+   USE dom_oce          ! Ocean domain
+   USE sbc_oce          ! Surface boundary condition: ocean fields
+   USE sbc_ice          ! Surface boundary condition: ice fields
+   USE lbclnk           ! Lateral Boundary Condition / MPP link
+   USE lib_mpp          ! MPP library
+   USE in_out_manager   ! I/O manager
+   USE prtctl           ! Print control
+#if defined key_lim3
+   USE ice              ! LIM-3: ice variables
+   USE dom_ice          ! LIM-3: ice domain
+   USE limitd_me        ! LIM-3: 
+#else
+   USE ice_2            ! LIM2: ice variables
+   USE dom_ice_2        ! LIM2: ice domain
+#endif
 
    IMPLICIT NONE
    PRIVATE
 
-   !! * Routine accessibility
-   PUBLIC lim_rhg  ! routine called by lim_dyn
-
+   PUBLIC   lim_rhg   ! routine called by lim_dyn (or lim_dyn_2)
+
+   REAL(wp) ::   rzero   = 0._wp   ! constant values
+   REAL(wp) ::   rone    = 1._wp   ! constant values
+      
    !! * Substitutions
 #  include "vectopt_loop_substitute.h90"
-
-   !! * Module variables
-   REAL(wp)  ::           &  ! constant values
-      rzero   = 0.e0   ,  &
-      rone    = 1.e0
    !!----------------------------------------------------------------------
-   !!   LIM 3.0,  UCL-LOCEAN-IPSL (2008) 
+   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
    SUBROUTINE lim_rhg( k_j1, k_jpj )
-
       !!-------------------------------------------------------------------
       !!                 ***  SUBROUTINE lim_rhg  ***
@@ -98,34 +98,16 @@
       !!                 e.g. in the Canadian Archipelago
       !!
-      !! ** References : Hunke and Dukowicz, JPO97
-      !!                 Bouillon et al., 08, in prep (update this when
-      !!                 published)
-      !!                 Vancoppenolle et al., OM08
+      !! 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
+      INTEGER, INTENT(in) ::   k_jpj   ! northern j-index for ice computation
       !!
-      !!-------------------------------------------------------------------
-      ! * Arguments
-      !
-      INTEGER, INTENT(in) :: &
-         k_j1 ,                      & !: southern j-index for ice computation
-         k_jpj                         !: northern j-index for ice computation
-
-      ! * Local variables
-      INTEGER ::   ji, jj              !: dummy loop indices
-
-      INTEGER  :: &
-         jter                          !: temporary integers
-
+      INTEGER ::   ji, jj   ! dummy loop indices
+      INTEGER ::   jter     ! local integers
       CHARACTER (len=50) ::   charout
-
-      REAL(wp) :: &
-         zt11, zt12, zt21, zt22,     & !: temporary scalars
-         ztagnx, ztagny,             & !: wind stress on U/V points                       
-         delta                         !
-
-      REAL(wp) :: &
-         za,                         & !:
-         zstms,                      & !: temporary scalar for ice strength
-         zsang,                      & !: temporary scalar for coriolis term
-         zmask                         !: mask for the computation of ice mass
+      REAL(wp) ::   zt11, zt12, zt21, zt22, ztagnx, ztagny, delta                         !
+      REAL(wp) ::   za, zstms, zsang, zmask   ! local scalars
 
       REAL(wp),DIMENSION(jpi,jpj) :: &
@@ -145,38 +127,44 @@
 
       REAL(wp) :: &
-         dtevp,                      & !: time step for subcycling
-         dtotel,                     & !:
-         ecc2,                       & !: square of yield ellipse eccenticity
-         z0,                         & !: temporary scalar
-         zr,                         & !: temporary scalar
-         zcca, zccb,                 & !: temporary scalars
-         zu_ice2,                    & !: 
-         zv_ice1,                    & !:
-         zddc, zdtc,                 & !: temporary array for delta on corners
-         zdst,                       & !: temporary array for delta on centre
-         zdsshx, zdsshy,             & !: term for the gradient of ocean surface
-         sigma1, sigma2                !: internal ice stress
+         dtevp,                      & ! time step for subcycling
+         dtotel,                     & !
+         ecc2,                       & ! square of yield ellipse eccenticity
+         z0,                         & ! temporary scalar
+         zr,                         & ! temporary scalar
+         zcca, zccb,                 & ! temporary scalars
+         zu_ice2,                    & ! 
+         zv_ice1,                    & !
+         zddc, zdtc,                 & ! temporary array for delta on corners
+         zdst,                       & ! temporary array for delta on centre
+         zdsshx, zdsshy,             & ! term for the gradient of ocean surface
+         sigma1, sigma2                ! internal ice stress
+
+      REAL(wp),DIMENSION(jpi,jpj) ::   zf1, zf2   ! arrays for internal stresses
 
       REAL(wp),DIMENSION(jpi,jpj) :: &
-         zf1, zf2                      !: arrays for internal stresses
-
-      REAL(wp),DIMENSION(jpi,jpj) :: &
-         zdd, zdt,                   & !: Divergence and tension at centre of grid cells
-         zds,                        & !: Shear on northeast corner of grid cells
-         deltat,                     & !: Delta at centre of grid cells
-         deltac,                     & !: Delta on corners
-         zs1, zs2,                   & !: Diagonal stress tensor components zs1 and zs2 
-         zs12                          !: Non-diagonal stress tensor component zs12
+         zdd, zdt,                   & ! Divergence and tension at centre of grid cells
+         zds,                        & ! Shear on northeast corner of grid cells
+         deltat,                     & ! Delta at centre of grid cells
+         deltac,                     & ! Delta on corners
+         zs1, zs2,                   & ! Diagonal stress tensor components zs1 and zs2 
+         zs12                          ! Non-diagonal stress tensor component zs12
 
       REAL(wp) :: &
-         zresm            ,          & !: Maximal error on ice velocity
-         zindb            ,          & !: ice (1) or not (0)      
-         zdummy                        !: dummy argument
-
-      REAL(wp),DIMENSION(jpi,jpj) :: &
-         zu_ice           ,          & !: Ice velocity on previous time step
-         zv_ice           ,          &
-         zresr                         !: Local error on velocity
-
+         zresm            ,          & ! Maximal error on ice velocity
+         zindb            ,          & ! ice (1) or not (0)      
+         zdummy                        ! dummy argument
+
+      REAL(wp),DIMENSION(jpi,jpj) ::   zu_ice, zv_ice, zresr   ! Local error on velocity
+      !!-------------------------------------------------------------------
+#if  defined key_lim2 && ! defined key_lim2_vp
+# if defined key_agrif
+     USE ice_2, vt_s => hsnm
+     USE ice_2, vt_i => hicm
+# else
+     vt_s => hsnm
+     vt_i => hicm
+# endif
+     at_i(:,:) = 1. - frld(:,:)
+#endif
       !
       !------------------------------------------------------------------------------!
@@ -185,22 +173,23 @@
       !
       ! Put every vector to 0
-      zpresh(:,:) = 0.0 ; zc1(:,:) = 0.0
-      zpreshc(:,:) = 0.0
-      u_ice2(:,:)  = 0.0 ; v_ice1(:,:)  = 0.0
-      zdd(:,:)     = 0.0 ; zdt(:,:)     = 0.0 ; zds(:,:)     = 0.0
-
-      ! Ice strength on T-points
-      CALL lim_itd_me_icestrength(ridge_scheme_swi)
-
-      ! Ice mass and temp variables
-!CDIR NOVERRCHK
-      DO jj = k_j1 , k_jpj
+      zpresh (:,:) = 0._wp   ;   zc1   (:,:) = 0._wp
+      zpreshc(:,:) = 0._wp
+      u_ice2 (:,:) = 0._wp   ;   v_ice1(:,:) = 0._wp
+      zdd    (:,:) = 0._wp   ;   zdt   (:,:) = 0._wp   ;   zds(:,:) = 0._wp
+
+#if defined key_lim3
+      CALL lim_itd_me_icestrength( ridge_scheme_swi )      ! LIM-3: Ice strength on T-points
+#endif
+
+!CDIR NOVERRCHK
+      DO jj = k_j1 , k_jpj       ! Ice mass and temp variables
 !CDIR NOVERRCHK
          DO ji = 1 , jpi
             zc1(ji,jj)    = tms(ji,jj) * ( rhosn * vt_s(ji,jj) + rhoic * vt_i(ji,jj) )
-            zpresh(ji,jj) = tms(ji,jj) *  strength(ji,jj) / 2.
+#if defined key_lim3
+            zpresh(ji,jj) = tms(ji,jj) *  strength(ji,jj) * 0.5_wp
+#endif
             ! tmi = 1 where there is ice or on land
-            tmi(ji,jj)    = 1.0 - ( 1.0 - MAX( 0.0 , SIGN ( 1.0 , vt_i(ji,jj) - &
-               epsd ) ) ) * tms(ji,jj)
+            tmi(ji,jj)    = 1._wp - ( 1._wp - MAX( 0._wp , SIGN ( 1._wp , vt_i(ji,jj) - epsd ) ) ) * tms(ji,jj)
          END DO
       END DO
@@ -247,24 +236,20 @@
          DO ji = fs_2, fs_jpim1
 
-            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)
+            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)
 
             ! 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 + epsd )
+            zfrld2(ji,jj) = ( zt22 * ( 1.0 - at_i(ji,jj) ) + zt21 * ( 1.0 - at_i(ji,jj+1) ) ) / ( zt21 + zt22 + epsd )
 
             ! Mass, coriolis coeff. and currents
             zmass1(ji,jj) = ( zt12*zc1(ji,jj) + zt11*zc1(ji+1,jj) ) / (zt11+zt12+epsd)
             zmass2(ji,jj) = ( zt22*zc1(ji,jj) + zt21*zc1(ji,jj+1) ) / (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 )
+            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 )
             !
             u_oce1(ji,jj)  = u_oce(ji,jj)
@@ -290,6 +275,6 @@
             ! include it later
 
-            zdsshx =  (ssh_m(ji+1,jj) - ssh_m(ji,jj))/e1u(ji,jj)
-            zdsshy =  (ssh_m(ji,jj+1) - ssh_m(ji,jj))/e2v(ji,jj)
+            zdsshx =  ( ssh_m(ji+1,jj) - ssh_m(ji,jj) ) / e1u(ji,jj)
+            zdsshy =  ( ssh_m(ji,jj+1) - ssh_m(ji,jj) ) / e2v(ji,jj)
 
             za1ct(ji,jj) = ztagnx - zmass1(ji,jj) * grav * zdsshx
@@ -306,19 +291,19 @@
       ! Time step for subcycling
       dtevp  = rdt_ice / nevp
-      dtotel = dtevp / ( 2.0 * telast )
+      dtotel = dtevp / ( 2._wp * telast )
 
       !-ecc2: square of yield ellipse eccenticrity (reminder: must become a namelist parameter)
-      ecc2 = ecc*ecc
+      ecc2 = ecc * ecc
 
       !-Initialise stress tensor 
-      zs1(:,:)  = stress1_i(:,:) 
-      zs2(:,:)  = stress2_i(:,:)
+      zs1 (:,:) = stress1_i (:,:) 
+      zs2 (:,:) = stress2_i (:,:)
       zs12(:,:) = stress12_i(:,:)
 
-      !----------------------!
+      !                                               !----------------------!
       DO jter = 1 , nevp                              !    loop over jter    !
-         !----------------------!        
+         !                                            !----------------------!        
          DO jj = k_j1, k_jpj-1
-            zu_ice(:,jj) = u_ice(:,jj) ! velocity at previous time step
+            zu_ice(:,jj) = u_ice(:,jj)    ! velocity at previous time step
             zv_ice(:,jj) = v_ice(:,jj)
          END DO
@@ -385,6 +370,5 @@
             END DO
          END DO
-         CALL lbc_lnk( v_ice1(:,:), 'U', -1. )
-         CALL lbc_lnk( u_ice2(:,:), 'V', -1. )
+         CALL lbc_lnk( v_ice1, 'U', -1. )   ;   CALL lbc_lnk( u_ice2, 'V', -1. )      ! lateral boundary cond.
 
 !CDIR NOVERRCHK
@@ -394,15 +378,13 @@
 
                !- 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)          &
-                  &          )                                              &
+               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( zdd(ji,jj)*zdd(ji,jj) +                        & 
-                  &                       ( zdt(ji,jj)*zdt(ji,jj) + zdst*zdst ) * usecc2 )  
-               deltat(ji,jj) = MAX( SQRT(zdd(ji,jj)**2 +                    &
-                  (zdt(ji,jj)**2 + zdst**2)*usecc2), creepl )
+               delta = SQRT( zdd(ji,jj)*zdd(ji,jj) + ( zdt(ji,jj)*zdt(ji,jj) + zdst*zdst ) * usecc2 )  
+               deltat(ji,jj) = MAX( SQRT(zdd(ji,jj)**2 + (zdt(ji,jj)**2 + zdst**2)*usecc2), creepl )
 
                !-Calculate stress tensor components zs1 and zs2 
Index: trunk/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90	(revision 2528)
@@ -4,4 +4,7 @@
    !! Ice restart :  write the ice restart file
    !!======================================================================
+   !! History:   -   ! 2005-04 (M. Vancoppenolle) Original code
+   !!           3.0  ! 2008-03 (C. Ethe) restart files in using IOM interface
+   !!----------------------------------------------------------------------
 #if defined key_lim3
    !!----------------------------------------------------------------------
@@ -12,20 +15,18 @@
    !!   lim_rst_read    : read  the restart file 
    !!----------------------------------------------------------------------
-   !! * Modules used
-   USE ice
-   USE par_ice
-   USE in_out_manager
-   USE dom_oce
-   USE sbc_oce         ! Surface boundary condition: ocean fields
-   USE sbc_ice         ! Surface boundary condition: ice fields
-   USE iom
+   USE ice              ! sea-ice variables
+   USE par_ice          ! sea-ice parameters
+   USE dom_oce          ! ocean domain
+   USE sbc_oce          ! Surface boundary condition: ocean fields
+   USE sbc_ice          ! Surface boundary condition: ice fields
+   USE in_out_manager   ! I/O manager
+   USE iom              ! I/O library
 
    IMPLICIT NONE
    PRIVATE
 
-   !! * Accessibility
-   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 iceinit.F90
+   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
 
    LOGICAL, PUBLIC ::   lrst_ice         !: logical to control the ice restart write 
@@ -33,9 +34,8 @@
 
    !!----------------------------------------------------------------------
-   !!   LIM 3.0,  UCL-LOCEAN-IPSL (2008)
+   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
@@ -48,5 +48,5 @@
       INTEGER, INTENT(in) ::   kt       ! number of iteration
       !
-      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step deine as a character
+      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step define as a character
       CHARACTER(LEN=50)   ::   clname   ! ice output restart file name
       !!----------------------------------------------------------------------
@@ -54,8 +54,9 @@
       IF( kt == nit000 )   lrst_ice = .FALSE.   ! default definition
 
-      ! to get better performances with NetCDF format:
-      ! we open and define the ice restart file one ice time step before writing the data (-> at nitrst - 2*nn_fsbc + 1)
-      ! 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
+      ! in order to get better performances with NetCDF format, we open and define the ice restart file 
+      ! one ice time step before writing the data (-> at nitrst - 2*nn_fsbc + 1), 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
@@ -75,5 +76,5 @@
             ENDIF
          ENDIF
-
+         !
          CALL iom_open( clname, numriw, ldwrt = .TRUE., kiolib = jprstlib )
          lrst_ice = .TRUE.
@@ -82,4 +83,5 @@
    END SUBROUTINE lim_rst_opn
 
+
    SUBROUTINE lim_rst_write( kt )
       !!----------------------------------------------------------------------
@@ -87,15 +89,12 @@
       !!
       !! ** purpose  :   output of sea-ice variable in a netcdf file
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt     ! number of iteration
       !!
-      !!----------------------------------------------------------------------
-      ! Arguments :
-      INTEGER, INTENT(in) ::   kt     ! number of iteration
-
-      ! Local variables :
+      INTEGER ::   ji, jj, jk ,jl   ! dummy loop indices
+      INTEGER ::   iter
+      CHARACTER(len=15) ::   znam
+      CHARACTER(len=1)  ::   zchar, zchar1
       REAL(wp), DIMENSION(jpi,jpj) :: z2d
-      INTEGER :: ji, jj, jk ,jl
-      INTEGER :: iter
-      CHARACTER(len=15) :: znam
-      CHARACTER(len=1)  :: zchar, zchar1
       !!----------------------------------------------------------------------
 
@@ -111,6 +110,6 @@
       ! ------------------ 
       !                                                                        ! calendar control
-      CALL iom_rstput( iter, nitrst, numriw, 'nn_fsbc', REAL( nn_fsbc, wp) )      ! time-step 
-      CALL iom_rstput( iter, nitrst, numriw, 'kt_ice' , REAL( iter , wp) )        ! date
+      CALL iom_rstput( iter, nitrst, numriw, 'nn_fsbc', REAL( nn_fsbc, wp ) )      ! time-step 
+      CALL iom_rstput( iter, nitrst, numriw, 'kt_ice' , REAL( iter   , wp ) )      ! date
 
       ! Prognostic variables 
@@ -288,6 +287,6 @@
       ENDIF
       !
-
    END SUBROUTINE lim_rst_write
+
 
    SUBROUTINE lim_rst_read
@@ -297,15 +296,13 @@
       !! ** purpose  :   read of sea-ice variable restart in a netcdf file
       !!----------------------------------------------------------------------
-      ! Local variables
       INTEGER :: ji, jj, jk, jl, indx
       REAL(wp) ::   zfice, ziter
-      REAL(wp) :: & !parameters for the salinity profile
-         zs_inf, z_slope_s, zsmax, zsmin, zalpha, zindb
-      REAL(wp), DIMENSION(nlay_i) :: zs_zero 
-      REAL(wp), DIMENSION(jpi,jpj) :: z2d
-      CHARACTER(len=15) :: znam
-      CHARACTER(len=1)  :: zchar, zchar1
-      INTEGER           :: jlibalt = jprstlib
-      LOGICAL           :: llok
+      REAL(wp) ::   zs_inf, z_slope_s, zsmax, zsmin, zalpha, zindb   ! local scalars used for the salinity profile
+      REAL(wp), DIMENSION(nlay_i)  ::   zs_zero 
+      REAL(wp), DIMENSION(jpi,jpj) ::   z2d
+      CHARACTER(len=15) ::   znam
+      CHARACTER(len=1)  ::   zchar, zchar1
+      INTEGER           ::   jlibalt = jprstlib
+      LOGICAL           ::   llok
       !!----------------------------------------------------------------------
 
@@ -384,8 +381,5 @@
       END DO
 
-      ! Salinity profile
-      !-----------------
-      IF( num_sal == 2 ) THEN
-         !     CALL lim_var_salprof
+      IF( num_sal == 2 ) THEN      ! Salinity profile
          DO jl = 1, jpl
             DO jk = 1, nlay_i
@@ -393,18 +387,17 @@
                   DO ji = 1, jpi
                      zs_inf        = sm_i(ji,jj,jl)
-                     z_slope_s     = 2.0*sm_i(ji,jj,jl)/MAX(0.01,ht_i(ji,jj,jl))
+                     z_slope_s     = 2._wp * sm_i(ji,jj,jl) / MAX( 0.01_wp , ht_i(ji,jj,jl) )
                      !- slope of the salinity profile
-                     zs_zero(jk)   = z_slope_s * ( FLOAT(jk)-1.0/2.0 ) * &
-                        ht_i(ji,jj,jl) / FLOAT(nlay_i)
-                     zsmax = 4.5
-                     zsmin = 3.5
+                     zs_zero(jk)   = z_slope_s * ( REAL(jk,wp) - 0.5_wp ) * ht_i(ji,jj,jl) / REAL(nlay_i,wp)
+                     zsmax = 4.5_wp
+                     zsmin = 3.5_wp
                      IF( sm_i(ji,jj,jl) .LT. zsmin ) THEN
-                        zalpha = 1.0
+                        zalpha = 1._wp
                      ELSEIF( sm_i(ji,jj,jl) .LT.zsmax ) THEN
-                        zalpha = sm_i(ji,jj,jl) / (zsmin-zsmax) + zsmax / (zsmax-zsmin)
+                        zalpha = sm_i(ji,jj,jl) / ( zsmin - zsmax ) + zsmax / ( zsmax - zsmin )
                      ELSE
-                        zalpha = 0.0
+                        zalpha = 0._wp
                      ENDIF
-                     s_i(ji,jj,jk,jl) = zalpha*zs_zero(jk) + ( 1.0 - zalpha )*zs_inf
+                     s_i(ji,jj,jk,jl) = zalpha * zs_zero(jk) + ( 1._wp - zalpha ) * zs_inf
                   END DO
                END DO
@@ -558,9 +551,8 @@
          END DO
       END DO
-
+      !
       CALL iom_close( numrir )
-
+      !
    END SUBROUTINE lim_rst_read
-
 
 #else
Index: trunk/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90	(revision 2528)
@@ -4,7 +4,9 @@
    !!           computation of the flux at the sea ice/ocean interface
    !!======================================================================
-   !! History :   -   !  2006-07 (M. Vancoppelle)  LIM3 original code
-   !!            3.0  !  2008-03 (C. Tallandier)  surface module
-   !!             -   !  2008-04 (C. Tallandier)  split in 2 + new ice-ocean coupling
+   !! History :   -   ! 2006-07 (M. Vancoppelle)  LIM3 original code
+   !!            3.0  ! 2008-03 (C. Tallandier)  surface module
+   !!             -   ! 2008-04 (C. Tallandier)  split in 2 + new ice-ocean coupling
+   !!            3.3  ! 2010-05 (G. Madec) decrease ocean & ice reference salinities in the Baltic sea
+   !!                 !                  + simplification of the ice-ocean stress calculation
    !!----------------------------------------------------------------------
 #if defined key_lim3
@@ -12,7 +14,7 @@
    !!   'key_lim3'                                    LIM 3.0 sea-ice model
    !!----------------------------------------------------------------------
-   !!   lim_sbc  : flux at the ice / ocean interface
-   !!----------------------------------------------------------------------
-   USE oce
+   !!   lim_sbc_flx  : updates mass, heat and salt fluxes at the ocean surface
+   !!   lim_sbc_tau  : update i- and j-stresses, and its modulus at the ocean surface
+   !!----------------------------------------------------------------------
    USE par_oce          ! ocean parameters
    USE par_ice          ! ice parameters
@@ -21,9 +23,8 @@
    USE sbc_oce          ! Surface boundary condition: ocean fields
    USE phycst           ! physical constants
+   USE albedo           ! albedo parameters
    USE ice              ! LIM sea-ice variables
-
    USE lbclnk           ! ocean lateral boundary condition
    USE in_out_manager   ! I/O manager
-   USE albedo           ! albedo parameters
    USE prtctl           ! Print control
 
@@ -34,181 +35,22 @@
    PUBLIC   lim_sbc_tau   ! called by sbc_ice_lim
 
-   REAL(wp)  ::   epsi16 = 1.e-16  ! constant values
-   REAL(wp)  ::   rzero  = 0.e0    
-   REAL(wp)  ::   rone   = 1.e0
-
-   REAL(wp), DIMENSION(jpi,jpj) ::   utau_oce, vtau_oce   !: air-ocean surface i- & j-stress              [N/m2]
-   REAL(wp), DIMENSION(jpi,jpj) ::   tmod_io              !: modulus of the ice-ocean relative velocity   [m/s]
-   REAL(wp), DIMENSION(jpi,jpj) ::   ssu_mb  , ssv_mb     !: before mean ocean surface currents           [m/s]
+   REAL(wp)  ::   r1_rdtice            ! = 1. / rdt_ice 
+   REAL(wp)  ::   epsi16 = 1.e-16_wp   ! constant values
+   REAL(wp)  ::   rzero  = 0._wp    
+   REAL(wp)  ::   rone   = 1._wp
+
+   REAL(wp), DIMENSION(jpi,jpj) ::   utau_oce, vtau_oce   ! air-ocean surface i- & j-stress              [N/m2]
+   REAL(wp), DIMENSION(jpi,jpj) ::   tmod_io              ! modulus of the ice-ocean relative velocity   [m/s]
+
+   REAL(wp), DIMENSION(jpi,jpj) ::   soce_0, sice_0   ! constant SSS and ice salinity used in levitating sea-ice case
 
    !! * Substitutions
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/LIM  3.2 ,  UCL-LOCEAN-IPSL (2009) 
+   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
-
-   SUBROUTINE lim_sbc_tau( kt, kcpl )
-      !!-------------------------------------------------------------------
-      !!                ***  ROUTINE lim_sbc_tau ***
-      !!  
-      !! ** Purpose : Update the ocean surface stresses due to the ice
-      !!         
-      !! ** Action  : - compute the ice-ocean stress depending on kcpl:
-      !!              fluxes at the ice-ocean interface.
-      !!     Case 0  :  old LIM-3 way, computed at ice time-step only
-      !!     Case 1  :  at each ocean time step the stresses are computed
-      !!                using the current ocean velocity (now)
-      !!     Case 2  :  combination of half case 0 + half case 1
-      !!     
-      !! ** Outputs : - utau   : sea surface i-stress (ocean referential)
-      !!              - vtau   : sea surface j-stress (ocean referential)
-      !!
-      !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90.
-      !!              Tartinville et al. 2001 Ocean Modelling, 3, 95-108.
-      !!---------------------------------------------------------------------
-      INTEGER ::   kt     ! number of ocean iteration
-      INTEGER ::   kcpl   ! ice-ocean coupling indicator: =0  LIM-3 old case
-      !                   !                               =1  stresses computed using now ocean velocity
-      !                   !                               =2  combination of 0 and 1 cases
-      !!
-      INTEGER  ::   ji, jj   ! dummy loop indices
-      REAL(wp) ::   zfrldu, zat_u, zu_ico, zutaui, zu_u, zu_ij, zu_im1j   ! temporary scalar
-      REAL(wp) ::   zfrldv, zat_v, zv_ico, zvtaui, zv_v, zv_ij, zv_ijm1   !    -         -
-      REAL(wp) ::   zsang, zztmp                                          !    -         -
-      REAL(wp), DIMENSION(jpi,jpj) ::   ztio_u, ztio_v   ! ocean stress below sea-ice
-#if defined key_coupled    
-      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zalb     ! albedo of ice under overcast sky
-      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zalbp    ! albedo of ice under clear sky
-#endif
-     !!---------------------------------------------------------------------
-
-      IF( kt == nit000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'lim_sbc_tau : LIM 3.0 sea-ice - surface ocean momentum fluxes'
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ '
-      ENDIF
-
-      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN
-!CDIR NOVERRCHK
-         DO jj = 2, jpjm1                         !* modulus of the ice-ocean velocity
-!CDIR NOVERRCHK
-            DO ji = fs_2, fs_jpim1
-               zu_ij   = u_ice(ji  ,jj) - ssu_m(ji  ,jj)               ! (i  ,j)
-               zu_im1j = u_ice(ji-1,jj) - ssu_m(ji-1,jj)               ! (i-1,j)
-               zv_ij   = v_ice(ji,jj  ) - ssv_m(ji,jj  )               ! (i,j  )
-               zv_ijm1 = v_ice(ji,jj-1) - ssv_m(ji,jj-1)               ! (i,j-1)
-               zztmp =  0.5 * ( zu_ij * zu_ij + zu_im1j * zu_im1j   &  ! mean of the square values instead
-                  &           + zv_ij * zv_ij + zv_ijm1 * zv_ijm1 )    ! of the square of the mean values...
-               ! WARNING, here we make an approximation for case 1 and 2: taum is not computed at each time
-               ! step but only every nn_fsbc time step. This avoid mutiple avarage to pass from T -> U,V grids
-               ! and next from U,V grids to T grid. Taum is used in tke, which should not be too sensitive to
-               ! this approximaton...
-               taum(ji,jj) = ( 1. - at_i(ji,jj) ) * taum(ji,jj) + at_i(ji,jj) * rhoco * zztmp
-               tmod_io(ji,jj) = SQRT( zztmp ) 
-            END DO
-         END DO
-         CALL lbc_lnk( taum, 'T', 1. )   ;   CALL lbc_lnk( tmod_io, 'T', 1. )
-      ENDIF
-
-      SELECT CASE( kcpl )
-         !                                        !--------------------------------!
-      CASE( 0 )                                   !  LIM 3 old stress computation  !  (at ice timestep only)
-         !                                        !--------------------------------! 
-         !                                             !* ice stress over ocean with a ice-ocean rotation angle
-         DO jj = 1, jpjm1
-            zsang  = SIGN( 1.e0, gphif(1,jj) ) * sangvg         ! change the sinus angle sign in the south hemisphere
-            DO ji = 1, fs_jpim1
-               zu_u = u_ice(ji,jj) - u_oce(ji,jj)               ! ice velocity relative to the ocean
-               zv_v = v_ice(ji,jj) - v_oce(ji,jj)
-               !                                                ! quadratic drag formulation with rotation
-!!gm still an error in the rotation, but usually the angle is zero (zsang=0, cangvg=1)
-               zutaui   = 0.5 * ( tmod_io(ji,jj) + tmod_io(ji+1,jj) ) * rhoco * ( cangvg * zu_u - zsang * zv_v ) 
-               zvtaui   = 0.5 * ( tmod_io(ji,jj) + tmod_io(ji,jj+1) ) * rhoco * ( cangvg * zv_v + zsang * zu_u ) 
-               !                                                ! bound for too large stress values
-               ! IMPORTANT: the exponential below prevents numerical oscillations in the ice-ocean stress
-               ! This is not physically based. A cleaner solution is offer in CASE kcpl=2
-               ztio_u(ji,jj) = zutaui * EXP( - ( tmod_io(ji,jj) + tmod_io(ji+1,jj) )  )
-               ztio_v(ji,jj) = zvtaui * EXP( - ( tmod_io(ji,jj) + tmod_io(ji,jj+1) )  ) 
-            END DO
-         END DO
-         DO jj = 2, jpjm1                                       ! stress at the surface of the ocean
-            DO ji = fs_2, fs_jpim1   ! vertor opt.
-               zfrldu = 0.5 * ( ato_i(ji,jj) + ato_i(ji+1,jj  ) )   ! open-ocean fraction at U- & V-points (from T-point values)
-               zfrldv = 0.5 * ( ato_i(ji,jj) + ato_i(ji  ,jj+1) )
-               !                                                    ! update surface ocean stress
-               utau(ji,jj) = zfrldu * utau(ji,jj) + ( 1. - zfrldu ) * ztio_u(ji,jj)
-               vtau(ji,jj) = zfrldv * vtau(ji,jj) + ( 1. - zfrldv ) * ztio_v(ji,jj)
-            END DO
-         END DO
-         CALL lbc_lnk( utau, 'U', -1. )   ;   CALL lbc_lnk( vtau, 'V', -1. )   ! lateral boundary condition
-
-         !
-         !                                        !--------------------------------!
-      CASE( 1 )                                   !  Use the now velocity          !  (at each ocean timestep)
-         !                                        !--------------------------------! 
-         IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN
-            utau_oce(:,:) = utau(:,:)                 !* save the air-ocean stresses at ice time-step
-            vtau_oce(:,:) = vtau(:,:)
-         ENDIF
-         !
-        DO jj = 2, jpjm1                              !* ice stress over ocean with a ice-ocean rotation angle
-            zsang  = SIGN(1.e0, gphif(1,jj-1) ) * sangvg        ! change the sinus angle sign in the south hemisphere
-            DO ji = fs_2, fs_jpim1
-               zat_u  = ( at_i(ji,jj) + at_i(ji+1,jj) ) * 0.5   ! ice area at u and V-points
-               zat_v  = ( at_i(ji,jj) + at_i(ji,jj+1) ) * 0.5
-               !                                                ! (u,v) ice-ocean velocity at (U,V)-point, resp.
-               zu_u   = u_ice(ji,jj) - ub(ji,jj,1)
-               zv_v   = v_ice(ji,jj) - vb(ji,jj,1)
-               !                                                ! quadratic drag formulation with rotation
-!!gm still an error in the rotation, but usually the angle is zero (zsang=0, cangvg=1)
-               zutaui   = 0.5 * ( tmod_io(ji,jj) + tmod_io(ji+1,jj) ) * rhoco * ( cangvg * zu_u - zsang * zv_v ) 
-               zvtaui   = 0.5 * ( tmod_io(ji,jj) + tmod_io(ji,jj+1) ) * rhoco * ( cangvg * zv_v + zsang * zu_u ) 
-               !                                                   ! stress at the ocean surface
-               utau(ji,jj) = ( 1.- zat_u ) * utau_oce(ji,jj) + zat_u * zutaui
-               vtau(ji,jj) = ( 1.- zat_v ) * vtau_oce(ji,jj) + zat_v * zvtaui
-            END DO
-         END DO
-         CALL lbc_lnk( utau, 'U', -1. )   ;   CALL lbc_lnk( vtau, 'V', -1. )   ! lateral boundary condition
-
-         !
-         !                                        !--------------------------------!
-      CASE( 2 )                                   !  mixed 0 and 2 cases           !  (at each ocean timestep)
-         !                                        !--------------------------------! 
-         IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN
-            utau_oce(:,:) = utau (:,:)               !* save the air-ocean stresses at ice time-step
-            vtau_oce(:,:) = vtau (:,:)
-            ssu_mb  (:,:) = ssu_m(:,:)               !* save the ice-ocean velocity at ice time-step
-            ssv_mb  (:,:) = ssv_m(:,:)
-         ENDIF
-         DO jj = 2, jpjm1                            !* ice stress over ocean with a ice-ocean rotation angle
-            zsang  = SIGN(1.e0, gphif(1,jj-1) ) * sangvg
-            DO ji = fs_2, fs_jpim1
-               zat_u = ( at_i(ji,jj) + at_i(ji+1,jj) ) * 0.5     ! ice area at u and V-points
-               zat_v = ( at_i(ji,jj) + at_i(ji,jj+1) ) * 0.5 
-               !
-               zu_ico = u_ice(ji,jj) - 0.5 * ( ub(ji,jj,1) + ssu_mb(ji,jj) )   ! ice-oce velocity using ub and ssu_mb
-               zv_ico = v_ice(ji,jj) - 0.5 * ( vb(ji,jj,1) + ssv_mb(ji,jj) )
-               !                                        ! quadratic drag formulation with rotation
-!!gm still an error in the rotation, but usually the angle is zero (zsang=0, cangvg=1)
-               zutaui = 0.5 * ( tmod_io(ji,jj) + tmod_io(ji+1,jj) ) * rhoco * ( cangvg * zu_ico - zsang * zv_ico )
-               zvtaui = 0.5 * ( tmod_io(ji,jj) + tmod_io(ji,jj+1) ) * rhoco * ( cangvg * zv_ico + zsang * zu_ico )
-               !
-               utau(ji,jj) = ( 1.-zat_u ) * utau_oce(ji,jj) + zat_u * zutaui    ! stress at the ocean surface
-               vtau(ji,jj) = ( 1.-zat_v ) * vtau_oce(ji,jj) + zat_v * zvtaui
-            END DO
-         END DO
-         CALL lbc_lnk( utau, 'U', -1. )   ;   CALL lbc_lnk( vtau, 'V', -1. )   ! lateral boundary condition
-         !
-      END SELECT
-
-      IF(ln_ctl)   CALL prt_ctl( tab2d_1=utau, clinfo1=' lim_sbc: utau   : ', mask1=umask,   &
-         &                       tab2d_2=vtau, clinfo2=' vtau    : '        , mask2=vmask )
-      !  
-   END SUBROUTINE lim_sbc_tau
-
 
    SUBROUTINE lim_sbc_flx( kt )
@@ -234,5 +76,5 @@
       !!              Tartinville et al. 2001 Ocean Modelling, 3, 95-108.
       !!---------------------------------------------------------------------
-      INTEGER ::   kt    ! number of iteration
+      INTEGER, INTENT(in) ::   kt    ! number of iteration
       !!
       INTEGER  ::   ji, jj           ! dummy loop indices
@@ -253,4 +95,18 @@
          IF(lwp) WRITE(numout,*) 'lim_sbc_flx : LIM 3.0 sea-ice - heat salt and mass ocean surface fluxes'
          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ '
+         !
+         r1_rdtice = 1. / rdt_ice
+         !
+         soce_0(:,:) = soce
+         sice_0(:,:) = sice
+         !
+         IF( cp_cfg == "orca" ) THEN           ! decrease ocean & ice reference salinities in the Baltic sea 
+            WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.   &
+               &   54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp         ) 
+               soce_0(:,:) = 4._wp
+               sice_0(:,:) = 2._wp
+            END WHERE
+         ENDIF
+         !
       ENDIF
 
@@ -297,6 +153,6 @@
                ! fscmbq and ffltbif are obsolete
                !              &           + iflt * ffltbif(ji,jj) !!! only if one category is used
-               &           + ifral   * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) / rdt_ice   &
-               &           + ifrdv   * ( qfvbq(ji,jj) + qdtcn(ji,jj) ) / rdt_ice                     &
+               &           + ifral   * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) * r1_rdtice   &
+               &           + ifrdv   * ( qfvbq(ji,jj) + qdtcn(ji,jj) )                   * r1_rdtice   &
                &           + fhmec(ji,jj)     & ! new contribution due to snow melt in ridging!!
                &           + fheat_rpo(ji,jj) & ! contribution from ridge formation
@@ -339,11 +195,11 @@
                WRITE(numout,*) ' qcmif     : ', qcmif(jiindx,jjindx)
                WRITE(numout,*) ' qldif     : ', qldif(jiindx,jjindx)
-               WRITE(numout,*) ' qcmif / dt: ', qcmif(jiindx,jjindx) / rdt_ice
-               WRITE(numout,*) ' qldif / dt: ', qldif(jiindx,jjindx) / rdt_ice
+               WRITE(numout,*) ' qcmif / dt: ', qcmif(jiindx,jjindx) * r1_rdtice
+               WRITE(numout,*) ' qldif / dt: ', qldif(jiindx,jjindx) * r1_rdtice
                WRITE(numout,*) ' ifrdv     : ', ifrdv
                WRITE(numout,*) ' qfvbq     : ', qfvbq(jiindx,jjindx)
                WRITE(numout,*) ' qdtcn     : ', qdtcn(jiindx,jjindx)
-               WRITE(numout,*) ' qfvbq / dt: ', qfvbq(jiindx,jjindx) / rdt_ice
-               WRITE(numout,*) ' qdtcn / dt: ', qdtcn(jiindx,jjindx) / rdt_ice
+               WRITE(numout,*) ' qfvbq / dt: ', qfvbq(jiindx,jjindx) * r1_rdtice
+               WRITE(numout,*) ' qdtcn / dt: ', qdtcn(jiindx,jjindx) * r1_rdtice
                WRITE(numout,*) ' '
                WRITE(numout,*) ' fdtcn     : ', fdtcn(jiindx,jjindx)
@@ -374,18 +230,16 @@
 
             !  computing freshwater exchanges at the ice/ocean interface
-            zpme = - emp(ji,jj)     * ( 1.0 - at_i(ji,jj) )  &   !  evaporation over oceanic fraction
-               &   + tprecip(ji,jj) *         at_i(ji,jj)    &   !  total precipitation
-               ! old fashioned way               
-               !              &   - sprecip(ji,jj) * ( 1. - pfrld(ji,jj) )  &   !  remov. snow precip over ice
-               &   - sprecip(ji,jj) * ( 1. - (pfrld(ji,jj)**betas) )  &   !  remov. snow precip over ice
-               &   - rdmsnif(ji,jj) / rdt_ice                &   !  freshwaterflux due to snow melting 
-               ! new contribution from snow falling when ridging
-               &   + fmmec(ji,jj)
+            zpme = - emp(ji,jj)     * ( 1.0 - at_i(ji,jj)          )  &   ! evaporation over oceanic fraction
+               &   + tprecip(ji,jj) *         at_i(ji,jj)             &   ! all precipitation reach the ocean
+               &   - sprecip(ji,jj) * ( 1. - (pfrld(ji,jj)**betas) )  &   ! except solid precip intercepted by sea-ice
+               &   - rdmsnif(ji,jj) * r1_rdtice                       &   ! freshwaterflux due to snow melting 
+               &   + fmmec(ji,jj)                                         ! snow falling when ridging
+
 
             !  computing salt exchanges at the ice/ocean interface
             !  sice should be the same as computed with the ice model
-            zfons =  ( soce - sice ) * ( rdmicif(ji,jj) / rdt_ice ) 
+            zfons =  ( soce_0(ji,jj) - sice_0(ji,jj) ) * rdmicif(ji,jj) * r1_rdtice 
             ! SOCE
-            zfons =  ( sss_m(ji,jj) - sice ) * ( rdmicif(ji,jj) / rdt_ice ) 
+            zfons =  ( sss_m (ji,jj) - sice_0(ji,jj) ) * rdmicif(ji,jj) * r1_rdtice
 
             !CT useless            !  salt flux for constant salinity
@@ -445,4 +299,87 @@
    END SUBROUTINE lim_sbc_flx
 
+
+   SUBROUTINE lim_sbc_tau( kt , pu_oce, pv_oce )
+      !!-------------------------------------------------------------------
+      !!                ***  ROUTINE lim_sbc_tau ***
+      !!  
+      !! ** Purpose : Update the ocean surface stresses due to the ice
+      !!         
+      !! ** Action  : * at each ice time step (every nn_fsbc time step):
+      !!                - compute the modulus of ice-ocean relative velocity 
+      !!                  (*rho*Cd) at T-point (C-grid) or I-point (B-grid)
+      !!                      tmod_io = rhoco * | U_ice-U_oce |
+      !!                - update the modulus of stress at ocean surface
+      !!                      taum = frld * taum + (1-frld) * tmod_io * | U_ice-U_oce |
+      !!              * at each ocean time step (every kt): 
+      !!                  compute linearized ice-ocean stresses as
+      !!                      Utau = tmod_io * | U_ice - pU_oce |
+      !!                using instantaneous current ocean velocity (usually before)
+      !!
+      !!    NB: - ice-ocean rotation angle no more allowed
+      !!        - here we make an approximation: taum is only computed every ice time step
+      !!          This avoids mutiple average to pass from T -> U,V grids and next from U,V grids 
+      !!          to T grid. taum is used in TKE and GLS, which should not be too sensitive to this approximaton...
+      !!
+      !! ** Outputs : - utau, vtau   : surface ocean i- and j-stress (u- & v-pts) updated with ice-ocean fluxes
+      !!              - taum         : modulus of the surface ocean stress (T-point) updated with ice-ocean fluxes
+      !!---------------------------------------------------------------------
+      INTEGER ,                     INTENT(in) ::   kt               ! ocean time-step index
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pu_oce, pv_oce   ! surface ocean currents
+      !!
+      INTEGER  ::   ji, jj   ! dummy loop indices
+      REAL(wp) ::   zat_u, zutau_ice, zu_t, zmodt   ! local scalar
+      REAL(wp) ::   zat_v, zvtau_ice, zv_t          !   -      -
+     !!---------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'lim_sbc_tau : LIM-3 sea-ice - surface ocean momentum fluxes'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ '
+      ENDIF
+
+      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
+               zu_t = u_ice(ji,jj) + u_ice(ji-1,jj) - u_oce(ji,jj) - u_oce(ji-1,jj)   
+               zv_t = v_ice(ji,jj) + v_ice(ji,jj-1) - v_oce(ji,jj) - v_oce(ji,jj-1) 
+               !                                              ! |U_ice-U_oce|^2
+               zmodt =  0.25_wp * (  zu_t * zu_t + zv_t * zv_t  )
+               !                                               ! update the ocean stress modulus
+               taum(ji,jj) = ( 1._wp - at_i(ji,jj) ) * taum(ji,jj) + at_i(ji,jj) * rhoco * zmodt
+               tmod_io(ji,jj) = rhoco * SQRT( zmodt )          ! rhoco * |U_ice-U_oce| at T-point
+            END DO
+         END DO
+         CALL lbc_lnk( taum, 'T', 1. )   ;   CALL lbc_lnk( tmod_io, 'T', 1. )
+         !
+         utau_oce(:,:) = utau(:,:)                    !* save the air-ocean stresses at ice time-step
+         vtau_oce(:,:) = vtau(:,:)
+         !
+      ENDIF
+         !
+         !                                     !==  every ocean time-step  ==!
+         !
+      DO jj = 2, jpjm1                                !* update the stress WITHOUT a ice-ocean rotation angle
+         DO ji = fs_2, fs_jpim1   ! Vect. Opt.
+            zat_u  = ( at_i(ji,jj) + at_i(ji+1,jj) ) * 0.5_wp   ! ice area at u and V-points
+            zat_v  = ( at_i(ji,jj) + at_i(ji,jj+1) ) * 0.5_wp
+            !                                                   ! linearized quadratic drag formulation
+            zutau_ice   = 0.5_wp * ( tmod_io(ji,jj) + tmod_io(ji+1,jj) ) * ( u_ice(ji,jj) - pu_oce(ji,jj) )
+            zvtau_ice   = 0.5_wp * ( tmod_io(ji,jj) + tmod_io(ji,jj+1) ) * ( v_ice(ji,jj) - pv_oce(ji,jj) )
+            !                                                   ! stresses at the ocean surface
+            utau(ji,jj) = ( 1._wp - zat_u ) * utau_oce(ji,jj) + zat_u * zutau_ice
+            vtau(ji,jj) = ( 1._wp - zat_v ) * vtau_oce(ji,jj) + zat_v * zvtau_ice
+         END DO
+      END DO
+      CALL lbc_lnk( utau, 'U', -1. )   ;   CALL lbc_lnk( vtau, 'V', -1. )   ! lateral boundary condition
+      !
+      IF(ln_ctl)   CALL prt_ctl( tab2d_1=utau, clinfo1=' lim_sbc: utau   : ', mask1=umask,   &
+         &                       tab2d_2=vtau, clinfo2=' vtau    : '        , mask2=vmask )
+      !  
+   END SUBROUTINE lim_sbc_tau
+
 #else
    !!----------------------------------------------------------------------
Index: trunk/NEMOGCM/NEMO/LIM_SRC_3/limtab.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_3/limtab.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_3/limtab.F90	(revision 2528)
@@ -22,7 +22,7 @@
 
    !!----------------------------------------------------------------------
-   !!   LIM 3.0,  UCL-ASTR-LOCEAN-IPSL (2008) 
+   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 CONTAINS
Index: trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90	(revision 2528)
@@ -7,6 +7,7 @@
    !!            2.0  ! 2002-07 (C. Ethe, G. Madec)  LIM-2 (F90 rewriting)
    !!            3.0  ! 2005-11 (M. Vancoppenolle)  LIM-3 : Multi-layer thermodynamics + salinity variations
-   !!             -   ! 2007-04 (M. Vancoppenolle) add lim_thd_glohec and lim_thd_con_dif
+   !!             -   ! 2007-04 (M. Vancoppenolle) add lim_thd_glohec, lim_thd_con_dh and lim_thd_con_dif
    !!            3.2  ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in rdmsnif
+   !!            3.3  ! 2010-11 (G. Madec) corrected snow melting heat (due to factor betas)
    !!----------------------------------------------------------------------
 #if defined key_lim3
@@ -14,37 +15,39 @@
    !!   'key_lim3'                                      LIM3 sea-ice model
    !!----------------------------------------------------------------------
-   !!   lim_thd      : thermodynamic of sea ice
+   !!   lim_thd        : thermodynamic of sea ice
+   !!   lim_thd_init   : initialisation of sea-ice thermodynamic
    !!----------------------------------------------------------------------
    USE phycst          ! physical constants
    USE dom_oce         ! ocean space and time domain variables
-   USE ice             ! LIM sea-ice variables
-   USE par_ice
+   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
-   USE limthd_dif
-   USE limthd_dh
-   USE limthd_sal
-   USE limthd_ent
-   USE limtab
-   USE limvar
+   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 limtab          ! LIM: 1D <==> 2D transformation
+   USE limvar          ! LIM: sea-ice variables
+   USE lbclnk          ! lateral boundary condition - MPP links
+   USE lib_mpp         ! MPP library
    USE in_out_manager  ! I/O manager
    USE prtctl          ! Print control
-   USE lbclnk
-   USE lib_mpp
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   lim_thd    ! called by lim_step
-
-   REAL(wp) ::   epsi20 = 1e-20   ! constant values
-   REAL(wp) ::   epsi16 = 1e-16   !
-   REAL(wp) ::   epsi06 = 1e-06   !
-   REAL(wp) ::   epsi04 = 1e-04   !
-   REAL(wp) ::   zzero  = 0.e0    !
-   REAL(wp) ::   zone   = 1.e0    !
+   PUBLIC   lim_thd        ! called by limstp module
+   PUBLIC   lim_thd_init   ! called by iceini module
+
+   REAL(wp) ::   epsi20 = 1e-20_wp   ! constant values
+   REAL(wp) ::   epsi16 = 1e-16_wp   !
+   REAL(wp) ::   epsi06 = 1e-06_wp   !
+   REAL(wp) ::   epsi04 = 1e-04_wp   !
+   REAL(wp) ::   zzero  = 0._wp      !
+   REAL(wp) ::   zone   = 1._wp      !
 
    !! * Substitutions
@@ -52,9 +55,8 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/LIM  3.2 ,  UCL-LOCEAN-IPSL (2009) 
+   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -84,9 +86,8 @@
       REAL(wp) ::   zfric_umax = 2e-02    ! upper bound for the friction velocity
       REAL(wp) ::   zinda, zindb, zthsnice, zfric_u    ! temporary scalar
-      REAL(wp) ::   zfntlat, zpareff                   !    -         -
+      REAL(wp) ::   zfntlat, zpareff   !    -         -
       REAL(wp) ::   zeps, zareamin, zcoef
       REAL(wp), DIMENSION(jpi,jpj) ::   zqlbsbq   ! link with lead energy budget qldif
       !!-------------------------------------------------------------------
-
       
       !------------------------------------------------------------------------------!
@@ -99,5 +100,4 @@
       !--------------------
       ! Change the units of heat content; from global units to J.m3
-
       DO jl = 1, jpl
          DO jk = 1, nlay_i
@@ -166,5 +166,5 @@
             pfrld(ji,jj)   = 1.0 - at_i(ji,jj)
             zinda          = 1.0 - MAX( zzero , SIGN( zone , - ( 1.0 - pfrld(ji,jj) ) ) )
-
+            !
             !           !  solar irradiance transmission at the mixed layer bottom and used in the lead heat budget
             !           !  practically no "direct lateral ablation"
@@ -181,15 +181,13 @@
             qdtcn(ji,jj)  = zindb * fdtcn(ji,jj) * (1.0 - at_i(ji,jj)) * rdt_ice
             !                       
-
-            ! still need to be updated : fdtcn !!!!
-            !           !-- Lead heat budget (part 1, next one is in limthd_dh
-            !           !-- qldif -- (or qldif_1d in 1d routines)
-            qldif(ji,jj) =  tms(ji,jj) * rdt_ice  * (                             & 
-               &   pfrld(ji,jj)        * (  qsr(ji,jj)                            &   ! solar heat 
-               &                            + qns(ji,jj)                          &   ! non solar heat 
-               &                            + fdtcn(ji,jj)                        &   ! turbulent ice-ocean heat 
-               &                            + fsbbq(ji,jj) * ( 1.0 - zindb )  )   &   ! residual heat from previous step 
+            !           !-- Lead heat budget, qldif (part 1, next one is in limthd_dh) 
+            !           !   caution: exponent betas used as more snow can fallinto leads
+            qldif(ji,jj) =  tms(ji,jj) * rdt_ice  * (                             &
+               &   pfrld(ji,jj)        * (  qsr(ji,jj)                            &   ! solar heat
+               &                            + qns(ji,jj)                          &   ! non solar heat
+               &                            + fdtcn(ji,jj)                        &   ! turbulent ice-ocean heat
+               &                            + fsbbq(ji,jj) * ( 1.0 - zindb )  )   &   ! residual heat from previous step
                & - pfrld(ji,jj)**betas * sprecip(ji,jj) * lfus                    )   ! latent heat of sprecip melting
-            
+            !
             ! Positive heat budget is used for bottom ablation
             zfntlat        = 1.0 - MAX( zzero , SIGN( zone ,  - qldif(ji,jj) ) )
@@ -198,12 +196,12 @@
             != 0 if ice and positive heat budget and 1 if one of those two is false
             zqlbsbq(ji,jj) = qldif(ji,jj) * ( 1.0 - zpareff ) / MAX( at_i(ji,jj) * rdt_ice , epsi16 )
-
+            !
             ! Heat budget of the lead, energy transferred from ice to ocean
             qldif  (ji,jj) = zpareff * qldif(ji,jj)
             qdtcn  (ji,jj) = zpareff * qdtcn(ji,jj)
-
+            !
             ! Energy needed to bring ocean surface layer until its freezing (qcmif, limflx)
             qcmif  (ji,jj) =  rau0 * rcp * fse3t(ji,jj,1) * ( t_bo(ji,jj) - (sst_m(ji,jj) + rt0) ) * ( 1. - zinda )
-
+            !
             ! oceanic heat flux (limthd_dh)
             fbif   (ji,jj) = zindb * (  fsbbq(ji,jj) / MAX( at_i(ji,jj) , epsi20 ) + fdtcn(ji,jj) )
@@ -223,5 +221,5 @@
          ENDIF
 
-         zareamin = 1.0e-10
+         zareamin = 1.e-10
          nbpb = 0
          DO jj = 1, jpj
@@ -359,10 +357,10 @@
             CALL tab_1d_2d( nbpb, rdvonif, npb, dvnbq_1d  (1:nbpb), jpi, jpj ) 
             CALL tab_1d_2d( nbpb, fseqv  , npb, fseqv_1d  (1:nbpb), jpi, jpj )
-
+            !
             IF( num_sal == 2 ) THEN
                CALL tab_1d_2d( nbpb, fsbri, npb, fsbri_1d(1:nbpb), jpi, jpj )
                CALL tab_1d_2d( nbpb, fhbri, npb, fhbri_1d(1:nbpb), jpi, jpj )
             ENDIF
-
+            !
             !+++++
             !temporary stuff for a dummy version
@@ -375,5 +373,5 @@
             CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qnsr_ice_1d(1:nbpb), jpi, jpj)
             !+++++
-
+            !
             IF( lk_mpp )   CALL mpp_comm_free( ncomm_ice ) !RB necessary ??
          ENDIF
@@ -388,5 +386,4 @@
       ! 5.1) Ice heat content              
       !------------------------
-
       ! Enthalpies are global variables we have to readjust the units
       zcoef = 1.e0 / ( unit_fac * REAL(nlay_i) )
@@ -401,5 +398,4 @@
       ! 5.2) Snow heat content              
       !------------------------
-
       ! Enthalpies are global variables we have to readjust the units
       zcoef = 1.e0 / ( unit_fac * REAL(nlay_s) )
@@ -424,5 +420,5 @@
       IF( con_i )   fbif(:,:) = fbif(:,:) + zqlbsbq(:,:)
 
-      IF(ln_ctl) THEN   ! Control print
+      IF(ln_ctl) THEN            ! Control print
          CALL prt_ctl_info(' ')
          CALL prt_ctl_info(' - Cell values : ')
@@ -454,7 +450,6 @@
             END DO
          END DO
-
       ENDIF
-
+      !
    END SUBROUTINE lim_thd
 
@@ -524,17 +519,14 @@
       END DO
       ! layer by layer
-      dq_i_layer(:,:)    = q_i_layer_fin(:,:) - q_i_layer_in(:,:)
+      dq_i_layer(:,:) = q_i_layer_fin(:,:) - q_i_layer_in(:,:)
 
       !----------------------------------------
       ! Atmospheric heat flux, ice heat budget
       !----------------------------------------
-
-      DO ji = kideb, kiut
-         zji = MOD( npb(ji) - 1, jpi ) + 1
-         zjj = ( npb(ji) - 1 ) / jpi + 1
-
-         fatm(ji,jl) = qnsr_ice_1d(ji) + (1.0-i0(ji))*qsr_ice_1d(ji)
-
-         sum_fluxq(ji,jl) = fc_su(ji) - fc_bo_i(ji) + qsr_ice_1d(ji)*i0(ji) - fstroc(zji,zjj,jl)
+      DO ji = kideb, kiut
+         zji = MOD( npb(ji) - 1 , jpi ) + 1
+         zjj =    ( npb(ji) - 1 ) / jpi + 1
+         fatm     (ji,jl) = qnsr_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji)
+         sum_fluxq(ji,jl) = fc_su(ji) - fc_bo_i(ji) + qsr_ice_1d(ji) * i0(ji) - fstroc(zji,zjj,jl)
       END DO
 
@@ -542,10 +534,9 @@
       ! Conservation error
       !--------------------
-
       DO ji = kideb, kiut
          cons_error(ji,jl) = ABS( dq_i(ji,jl) / rdt_ice + sum_fluxq(ji,jl) )
       END DO
 
-      numce = 0
+      numce  = 0
       meance = 0.0
       DO ji = kideb, kiut
@@ -554,6 +545,6 @@
             meance = meance + cons_error(ji,jl)
          ENDIF
-      ENDDO
-      IF (numce .GT. 0 ) meance = meance / numce
+      END DO
+      IF( numce .GT. 0 ) meance = meance / numce
 
       WRITE(numout,*) ' Maximum tolerated conservation error : ', max_cons_err
@@ -565,16 +556,15 @@
       ! Surface error due to imbalance between Fatm and Fcsu
       !-------------------------------------------------------
-      numce  = 0.0
+      numce  = 0
       meance = 0.0
 
       DO ji = kideb, kiut
          surf_error(ji,jl) = ABS ( fatm(ji,jl) - fc_su(ji) )
-         IF ( ( t_su_b(ji) .LT. rtt ) .AND. ( surf_error(ji,jl) .GT. &
-            max_surf_err ) ) THEN
+         IF( ( t_su_b(ji) .LT. rtt ) .AND. ( surf_error(ji,jl) .GT. max_surf_err ) ) THEN
             numce = numce + 1 
             meance = meance + surf_error(ji,jl)
          ENDIF
       ENDDO
-      IF (numce .GT. 0 ) meance = meance / numce
+      IF( numce .GT. 0 ) meance = meance / numce
 
       WRITE(numout,*) ' Maximum tolerated surface error : ', max_surf_err
@@ -590,5 +580,4 @@
       ! Write ice state in case of big errors
       !---------------------------------------
-
       DO ji = kideb, kiut
          IF ( ( ( t_su_b(ji) .LT. rtt ) .AND. ( surf_error(ji,jl) .GT. max_surf_err ) ) .OR. &
@@ -596,5 +585,5 @@
             zji                 = MOD( npb(ji) - 1, jpi ) + 1
             zjj                 = ( npb(ji) - 1 ) / jpi + 1
-
+            !
             WRITE(numout,*) ' alerte 1     '
             WRITE(numout,*) ' Untolerated conservation / surface error after '
@@ -612,6 +601,5 @@
             !        WRITE(numout,*) ' qt_i_fin  : ', qt_i_fin(ji,jl)
             !        WRITE(numout,*) ' qt_s_fin  : ', qt_s_fin(ji,jl)
-            !        WRITE(numout,*) ' qt        : ', qt_i_fin(ji,jl) + &
-            !                                         qt_s_fin(ji,jl)
+            !        WRITE(numout,*) ' qt        : ', qt_i_fin(ji,jl) + qt_s_fin(ji,jl)
             WRITE(numout,*) ' ht_i       : ', ht_i_b(ji)
             WRITE(numout,*) ' ht_s       : ', ht_s_b(ji)
@@ -640,17 +628,12 @@
             WRITE(numout,*)
             WRITE(numout,*) ' Layer by layer ... '
-            WRITE(numout,*) ' dq_snow : ', ( qt_s_fin(ji,jl) - &
-               qt_s_in(ji,jl) )  & 
-               / rdt_ice
-            WRITE(numout,*) ' dfc_snow  : ', fc_s(ji,1) -      &
-               fc_s(ji,0)
+            WRITE(numout,*) ' dq_snow : ', ( qt_s_fin(ji,jl) - qt_s_in(ji,jl) ) / rdt_ice
+            WRITE(numout,*) ' dfc_snow  : ', fc_s(ji,1) - fc_s(ji,0)
             DO jk = 1, nlay_i
                WRITE(numout,*) ' layer  : ', jk
                WRITE(numout,*) ' dq_ice : ', dq_i_layer(ji,jk) / rdt_ice  
                WRITE(numout,*) ' radab  : ', radab(ji,jk)
-               WRITE(numout,*) ' dfc_i  : ', fc_i(ji,jk) -               &
-                  fc_i(ji,jk-1)
-               WRITE(numout,*) ' tot f  : ', fc_i(ji,jk) -               &
-                  fc_i(ji,jk-1) - radab(ji,jk)
+               WRITE(numout,*) ' dfc_i  : ', fc_i(ji,jk) - fc_i(ji,jk-1)
+               WRITE(numout,*) ' tot f  : ', fc_i(ji,jk) - fc_i(ji,jk-1) - radab(ji,jk)
             END DO
 
@@ -662,12 +645,9 @@
 
 
-   SUBROUTINE lim_thd_con_dh(kideb,kiut,jl)
+   SUBROUTINE lim_thd_con_dh( kideb, kiut, jl )
       !!-----------------------------------------------------------------------
       !!                   ***  ROUTINE lim_thd_con_dh  *** 
       !!                 
       !! ** Purpose :   Test energy conservation after enthalpy redistr.
-      !!
-      !! history :
-      !!  9.9  ! 07-04 (M.Vancoppenolle) original code
       !!-----------------------------------------------------------------------
       INTEGER, INTENT(in) ::        &
@@ -745,10 +725,9 @@
       ! Write ice state in case of big errors
       !---------------------------------------
-
       DO ji = kideb, kiut
          IF ( cons_error(ji,jl) .GT. max_cons_err  ) THEN
             zji                 = MOD( npb(ji) - 1, jpi ) + 1
             zjj                 = ( npb(ji) - 1 ) / jpi + 1
-
+            !
             WRITE(numout,*) ' alerte 1 - category : ', jl
             WRITE(numout,*) ' Untolerated conservation error after limthd_ent '
@@ -771,10 +750,8 @@
             WRITE(numout,*) ' qt_s_in    : ', qt_s_in(ji,jl) / rdt_ice
             WRITE(numout,*) ' qt_i_in    : ', qt_i_in(ji,jl) / rdt_ice
-            WRITE(numout,*) ' qt_in      : ', ( qt_i_in(ji,jl) + &
-               qt_s_in(ji,jl) ) / rdt_ice
+            WRITE(numout,*) ' qt_in      : ', ( qt_i_in(ji,jl) + qt_s_in(ji,jl) ) / rdt_ice
             WRITE(numout,*) ' qt_s_fin   : ', qt_s_fin(ji,jl) / rdt_ice
             WRITE(numout,*) ' qt_i_fin   : ', qt_i_fin(ji,jl) / rdt_ice
-            WRITE(numout,*) ' qt_fin     : ', ( qt_i_fin(ji,jl) + &
-               qt_s_fin(ji,jl) ) / rdt_ice
+            WRITE(numout,*) ' qt_fin     : ', ( qt_i_fin(ji,jl) + qt_s_fin(ji,jl) ) / rdt_ice
             WRITE(numout,*) ' * '
             WRITE(numout,*) ' Ice variables --- : '
@@ -785,5 +762,4 @@
             WRITE(numout,*) ' dh_i_surf : ', dh_i_surf(ji)
             WRITE(numout,*) ' dh_i_bott : ', dh_i_bott(ji)
-
          ENDIF
          !
@@ -800,5 +776,4 @@
       !!
       !! ** Method  :   Formula (Bitz and Lipscomb, 1999)
-      !!
       !!-------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kideb, kiut   ! bounds for the spatial loop
@@ -827,5 +802,4 @@
 
    SUBROUTINE lim_thd_init
-
       !!-----------------------------------------------------------------------
       !!                   ***  ROUTINE lim_thd_init *** 
@@ -838,5 +812,5 @@
       !!
       !! ** input   :   Namelist namicether
-       !!-------------------------------------------------------------------
+      !!-------------------------------------------------------------------
       NAMELIST/namicethd/ hmelt , hiccrit, fraz_swi, maxfrazb, vfrazb, Cfrazb,   &
          &                hicmin, hiclim, amax  ,                                &
@@ -845,5 +819,5 @@
          &                kappa_i, nconv_i_thd, maxer_i_thd, thcon_i_swi
       !!-------------------------------------------------------------------
-
+      !
       IF(lwp) THEN
          WRITE(numout,*)
@@ -851,8 +825,8 @@
          WRITE(numout,*) '~~~~~~~'
       ENDIF
-
+      !
       REWIND( numnam_ice )                  ! read Namelist numnam_ice
       READ  ( numnam_ice , namicethd )
-      
+      !
       IF(lwp) THEN                          ! control print
          WRITE(numout,*)
@@ -892,11 +866,6 @@
 #else
    !!----------------------------------------------------------------------
-   !!   Default option                               NO  LIM3 sea-ice model
+   !!   Default option         Dummy module          NO  LIM3 sea-ice model
    !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE lim_thd         ! Empty routine
-   END SUBROUTINE lim_thd
-   SUBROUTINE lim_thd_con_dif
-   END SUBROUTINE lim_thd_con_dif
 #endif
 
Index: trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90	(revision 2528)
@@ -17,8 +17,8 @@
    USE phycst           ! physical constants (OCE directory) 
    USE sbc_oce          ! Surface boundary condition: ocean fields
+   USE ice
+   USE par_ice
    USE thd_ice
    USE in_out_manager
-   USE ice
-   USE par_ice
    USE lib_mpp
 
@@ -35,7 +35,7 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/LIM 3.2,  UCL-LOCEAN-IPSL (2009)
+   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90	(revision 2528)
@@ -1,7 +1,3 @@
 MODULE limthd_dif
-#if defined key_lim3
-   !!----------------------------------------------------------------------
-   !!   'key_lim3'                                      LIM3 sea-ice model
-   !!----------------------------------------------------------------------
    !!======================================================================
    !!                       ***  MODULE limthd_dif ***
@@ -9,7 +5,9 @@
    !!                   computation of surface and inner T  
    !!======================================================================
-
    !!----------------------------------------------------------------------
-   !! * Modules used
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                      LIM3 sea-ice model
+   !!----------------------------------------------------------------------
    USE par_oce          ! ocean parameters
    USE phycst           ! physical constants (ocean directory) 
@@ -23,8 +21,6 @@
    PRIVATE
 
-   !! * Routine accessibility
-   PUBLIC lim_thd_dif        ! called by lim_thd
-
-   !! * Module variables
+   PUBLIC   lim_thd_dif   ! called by lim_thd
+
    REAL(wp)  ::           &  ! constant values
       epsi20 = 1e-20   ,  &
@@ -34,9 +30,8 @@
 
    !!----------------------------------------------------------------------
-   !!   LIM 3.0,  UCL-LOCEAN-IPSL (2005)
+   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -870,3 +865,4 @@
    END SUBROUTINE lim_thd_dif
 #endif
+   !!======================================================================
 END MODULE limthd_dif
Index: trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90	(revision 2528)
@@ -1,7 +1,3 @@
 MODULE limthd_ent
-#if defined key_lim3
-   !!----------------------------------------------------------------------
-   !!   'key_lim3'                                      LIM3 sea-ice model
-   !!----------------------------------------------------------------------
    !!======================================================================
    !!                       ***  MODULE limthd_ent   ***
@@ -10,7 +6,10 @@
    !!                       after vertical growth/decay
    !!======================================================================
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                      LIM3 sea-ice model
+   !!----------------------------------------------------------------------
    !!   lim_thd_ent : ice redistribution of enthalpy
-
-   !! * Modules used
+   !!----------------------------------------------------------------------
    USE par_oce          ! ocean parameters
    USE dom_oce
@@ -27,8 +26,6 @@
    PRIVATE
 
-   !! * Routine accessibility
-   PUBLIC  lim_thd_ent     ! called by lim_thd
-
-   !! * Module variables
+   PUBLIC   lim_thd_ent     ! called by lim_thd
+
    REAL(wp)  ::           &  ! constant values
       epsi20 = 1.e-20  ,  &
@@ -37,11 +34,9 @@
       zone   = 1.e0    ,  &
       epsi10 = 1.0e-10
-
    !!----------------------------------------------------------------------
-   !!   LIM 3.0,  UCL-LOCEAN-IPSL (2005)
+   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
Index: trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90	(revision 2528)
@@ -1,6 +1,3 @@
 MODULE limthd_lac
-   !!----------------------------------------------------------------------
-   !!   'key_lim3'                                      LIM3 sea-ice model
-   !!----------------------------------------------------------------------
    !!======================================================================
    !!                       ***  MODULE limthd_lac   ***
@@ -9,6 +6,8 @@
 #if defined key_lim3
    !!----------------------------------------------------------------------
+   !!   'key_lim3'                                      LIM3 sea-ice model
+   !!----------------------------------------------------------------------
    !!   lim_lat_acr    : lateral accretion of ice
-   !! * Modules used
+   !!----------------------------------------------------------------------
    USE par_oce          ! ocean parameters
    USE dom_oce
@@ -42,7 +41,7 @@
 
    !!----------------------------------------------------------------------
-   !!   LIM 3.0,  UCL-ASTR-LOCEAN-IPSL (2008) 
+   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90	(revision 2528)
@@ -1,51 +1,43 @@
 MODULE limthd_sal
-   !!----------------------------------------------------------------------
-   !!   'key_lim3'                                      LIM3 sea-ice model
-   !!----------------------------------------------------------------------
    !!======================================================================
    !!                       ***  MODULE limthd_sal ***
-   !!                   computation salinity variations in
-   !!                               the ice
+   !! LIM-3 sea-ice :  computation of salinity variations in the ice
    !!======================================================================
+   !! History :   -   ! 2003-05 (M. Vancoppenolle) UCL-ASTR first coding for LIM3-1D
+   !!            3.0  ! 2005-12 (M. Vancoppenolle) adapted to the 3-D version
+   !!---------------------------------------------------------------------
 #if defined key_lim3
    !!----------------------------------------------------------------------
+   !!   'key_lim3'                                      LIM-3 sea-ice model
+   !!----------------------------------------------------------------------
    !!   lim_thd_sal : salinity variations in the ice
-   !! * Modules used
+   !!----------------------------------------------------------------------
    USE par_oce          ! ocean parameters
    USE phycst           ! physical constants (ocean directory)
    USE sbc_oce          ! Surface boundary condition: ocean fields
-   USE thd_ice
-   USE ice
-   USE in_out_manager
-   USE limvar
-   USE par_ice
+   USE ice              ! LIM: sea-ice variables
+   USE par_ice          ! LIM: sea-ice parameters
+   USE thd_ice          ! LIM: sea-ice thermodynamics
+   USE limvar           ! LIM: sea-ice variables
+   USE in_out_manager   ! I/O manager
 
    IMPLICIT NONE
    PRIVATE
 
-   !! * Routine accessibility
-   PUBLIC lim_thd_sal        ! called by lim_thd
-   PUBLIC lim_thd_sal_init   ! called by lim_thd
-
-   !! * Module variables
-   REAL(wp)  ::           &  ! constant values
-      epsi20 = 1e-20   ,  &
-      epsi13 = 1e-13   ,  &
-      zzero  = 0.e0    ,  &
-      zone   = 1.e0
-
-   !!----------------------------------------------------------------------
-   !!   LIM 3.0,  UCL-ASTR-LOCEAN-IPSL (2008)
+   PUBLIC   lim_thd_sal        ! called by limthd module
+   PUBLIC   lim_thd_sal_init   ! called by iceini module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
-   SUBROUTINE lim_thd_sal(kideb,kiut)
+   SUBROUTINE lim_thd_sal( kideb, kiut )
       !!-------------------------------------------------------------------
-      !!                ***  ROUTINE lim_thd_sal  ***       
-      !! ** Purpose :
-      !!        This routine computes new salinities in the ice
+      !!                ***  ROUTINE lim_thd_sal  ***    
+      !!   
+      !! ** Purpose :   computes new salinities in the ice
       !!
       !! ** Method  :  4 possibilities
@@ -54,67 +46,21 @@
       !!               -> num_sal = 3 -> S = S(z)   [multiyear ice]
       !!               -> num_sal = 4 -> S = S(h)   [Cox and Weeks 74]
-      !!           
-      !! ** Steps
-      !!
-      !! ** Arguments
-      !!
-      !! ** Inputs / Outputs
-      !!
-      !! ** External
-      !!
-      !! ** References
-      !!
-      !! ** History  : 
-      !!
-      !! "Je ne suis pour l'instant qu'a 80% de ma condition, mais c'est 
-      !!  les 30% qui restent qui seront les plus difficiles"
-      !!                                           E. Mpenza
-      !!
-      !!-------------------------------------------------------------------
-      !! History :
-      !!   ori  !  03-05 M. Vancoppenolle UCL-ASTR first coding for LIM-1D
-      !!   3.0  !  05-12 Routine rewritten for the 3-D version
       !!---------------------------------------------------------------------
-      !!
-      !! * Local variables
-      INTEGER, INTENT(in) :: &
-         kideb, kiut             !: thickness category index
-
-      INTEGER ::             &
-         ji, jk ,            &   !: geographic and layer index 
-         zji, zjj
-
-      REAL(wp) ::            &
-         zsold,              &   !: old salinity
-         zeps=1.0e-06   ,    &   !: very small
-         iflush         ,    &   !: flushing (1) or not (0)
-         iaccrbo        ,    &   !: bottom accretion (1) or not (0)
-         igravdr        ,    &   !: gravity drainage or not
-         isnowic        ,    &   !: gravity drainage or not
-         i_ice_switch   ,    &   !: ice thickness above a certain treshold or not
-         ztmelts        ,    &   !: freezing point of sea ice
-         zaaa           ,    &   !: dummy factor
-         zbbb           ,    &   !: dummy factor
-         zccc           ,    &   !: dummy factor
-         zdiscrim                !: dummy factor
-
-      REAL(wp), DIMENSION(jpij) ::          &
-         ze_init        ,    &   !initial total enthalpy
-         zhiold         ,    &
-         zsiold
-
+      INTEGER, INTENT(in) ::  kideb, kiut   ! thickness category index
+      !
+      INTEGER  ::   ji, jk     ! dummy loop indices 
+      INTEGER  ::   zji, zjj   ! local integers
+      REAL(wp) ::   zsold, zeps, iflush, iaccrbo, igravdr, isnowic, i_ice_switch,  ztmelts   ! local scalars
+      REAL(wp) ::   zaaa, zbbb, zccc, zdiscrim   ! local scalars
+      REAL(wp), DIMENSION(jpij) ::   ze_init, zhiold, zsiold   ! 1D workspace
       !!---------------------------------------------------------------------
 
+      zeps=1.0e-06_wp
+
       !------------------------------------------------------------------------------|
       ! 1) Constant salinity, constant in time                                       |
       !------------------------------------------------------------------------------|
 
-      IF (num_sal.eq.1) THEN
-
-         !         WRITE(numout,*)
-         !         WRITE(numout,*) 'lim_thd_sal : Ice salinity computation module ', &
-         !         num_sal
-         !         WRITE(numout,*) '~~~~~~~~~~~~'
-
+      IF( num_sal == 1 ) THEN
          DO jk = 1, nlay_i
             DO ji = kideb, kiut
@@ -122,10 +68,10 @@
             END DO ! ji
          END DO ! jk
-
+         !
          DO ji = kideb, kiut
             sm_i_b(ji)      =  bulk_sal 
          END DO ! ji
-
-      ENDIF ! num_sal .EQ. 1
+         !
+      ENDIF
 
       !------------------------------------------------------------------------------|
@@ -174,6 +120,5 @@
             ! isnowic : 1 if snow ice formation
             i_ice_switch = 1.0 - MAX ( 0.0 , SIGN ( 1.0 , - ht_i_b(ji) + 1.0e-2 ) )
-            isnowic      = 1.0 - MAX ( 0.0 , SIGN ( 1.0 , - dh_snowice(ji) ) ) * &
-               i_ice_switch
+            isnowic      = 1.0 - MAX ( 0.0 , SIGN ( 1.0 , - dh_snowice(ji) ) ) * i_ice_switch
 
             !---------------------
@@ -182,12 +127,8 @@
 
             ! drainage by gravity drainage
-            dsm_i_gd_1d(ji) = - igravdr *                                     & 
-               MAX( sm_i_b(ji) - sal_G , 0.0 ) /             &
-               time_G * rdt_ice 
+            dsm_i_gd_1d(ji) = - igravdr * MAX( sm_i_b(ji) - sal_G , 0._wp ) / time_G * rdt_ice 
 
             ! drainage by flushing  
-            dsm_i_fl_1d(ji)  = - iflush *                                     &
-               MAX( sm_i_b(ji) - sal_F , 0.0 ) /             & 
-               time_F * rdt_ice
+            dsm_i_fl_1d(ji)  = - iflush * MAX( sm_i_b(ji) - sal_F , 0._wp ) / time_F * rdt_ice
 
             !-----------------
@@ -199,15 +140,13 @@
             ! to conserve energy
             zsiold(ji) = sm_i_b(ji)
-            sm_i_b(ji) = sm_i_b(ji)                                           &
-               + dsm_i_fl_1d(ji) + dsm_i_gd_1d(ji)  !                 &
+            sm_i_b(ji) = sm_i_b(ji) + dsm_i_fl_1d(ji) + dsm_i_gd_1d(ji)
 
             ! if no ice, salinity eq 0.1
-            i_ice_switch  = 1.0 - MAX ( 0.0, SIGN (1.0 , - ht_i_b(ji) ) )
-            sm_i_b(ji)    = i_ice_switch*sm_i_b(ji) + s_i_min * ( 1.0 -       &
-               i_ice_switch )
+            i_ice_switch = 1._wp - MAX ( 0._wp, SIGN( 1._wp , - ht_i_b(ji) ) )
+            sm_i_b(ji)   = i_ice_switch*sm_i_b(ji) + s_i_min * ( 1._wp - i_ice_switch )
          END DO ! ji
 
          ! Salinity profile
-         CALL lim_var_salprof1d(kideb,kiut)
+         CALL lim_var_salprof1d( kideb, kiut )
 
          !----------------------------
@@ -217,11 +156,11 @@
          DO ji = kideb, kiut
             ! iflush  : 1 if summer 
-            iflush       =  MAX( 0.0 , SIGN ( 1.0 , t_su_b(ji) - rtt ) ) 
+            iflush  =  MAX( 0._wp , SIGN ( 1._wp , t_su_b(ji) - rtt ) ) 
             ! igravdr : 1 if t_su lt t_bo
-            igravdr      =  MAX( 0.0 , SIGN ( 1.0 , t_bo_b(ji) - t_su_b(ji) ) ) 
+            igravdr =  MAX( 0._wp , SIGN ( 1._wp , t_bo_b(ji) - t_su_b(ji) ) ) 
             ! iaccrbo : 1 if bottom accretion
-            iaccrbo      =  MAX( 0.0 , SIGN ( 1.0 , dh_i_bott(ji) ) )
-
-            fhbri_1d(ji) = 0.0
+            iaccrbo =  MAX( 0._wp , SIGN ( 1._wp , dh_i_bott(ji) ) )
+            !
+            fhbri_1d(ji) = 0._wp
          END DO ! ji
 
@@ -230,11 +169,8 @@
          !----------------------------
          DO ji = kideb, kiut
-            i_ice_switch  = 1.0 - MAX ( 0.0, SIGN (1.0 , - ht_i_b(ji) ) )
-            fsbri_1d(ji) = fsbri_1d(ji) -  &
-               i_ice_switch * rhoic * a_i_b(ji) * ht_i_b(ji) *  &
-               ( MAX(dsm_i_gd_1d(ji) + dsm_i_fl_1d(ji), &
-               sm_i_b(ji) - zsiold(ji) ) ) / rdt_ice
-            IF ( num_sal .EQ. 4 ) fsbri_1d(ji) = 0.0
-
+            i_ice_switch = 1._wp - MAX ( 0._wp, SIGN( 1._wp , - ht_i_b(ji) ) )
+            fsbri_1d(ji) = fsbri_1d(ji) - i_ice_switch * rhoic * a_i_b(ji) * ht_i_b(ji)         &
+               &         * ( MAX(dsm_i_gd_1d(ji) + dsm_i_fl_1d(ji), sm_i_b(ji) - zsiold(ji) ) ) / rdt_ice
+            IF( num_sal == 4 ) fsbri_1d(ji) = 0._wp
          END DO ! ji
 
@@ -244,20 +180,15 @@
          !--------------------
          DO jk = 1, nlay_i
-
             DO ji = kideb, kiut
-
                ztmelts    =  -tmut*s_i_b(ji,jk) + rtt
                !Conversion q(S,T) -> T (second order equation)
                zaaa         =  cpic
-               zbbb         =  ( rcp - cpic ) * ( ztmelts - rtt ) + &
-                  q_i_b(ji,jk) / rhoic - lfus
+               zbbb         =  ( rcp - cpic ) * ( ztmelts - rtt ) + q_i_b(ji,jk) / rhoic - lfus
                zccc         =  lfus * ( ztmelts - rtt )
                zdiscrim     =  SQRT( MAX(zbbb*zbbb - 4.0*zaaa*zccc,0.0) )
-               t_i_b(ji,jk) =  rtt - ( zbbb + zdiscrim ) / & 
-                  ( 2.0 *zaaa )
+               t_i_b(ji,jk) =  rtt - ( zbbb + zdiscrim ) / ( 2.0 *zaaa )
             END DO !ji
-
          END DO !jk
-
+         !
       ENDIF ! num_sal .EQ. 2
 
@@ -266,5 +197,5 @@
       !------------------------------------------------------------------------------|
 
-      IF ( num_sal .EQ. 3 ) THEN
+      IF( num_sal .EQ. 3 ) THEN
 
          WRITE(numout,*)
@@ -320,8 +251,6 @@
             zji                 = MOD( npb(ji) - 1, jpi ) + 1
             zjj                 = ( npb(ji) - 1 ) / jpi + 1
-            fseqv_1d(ji) = fseqv_1d(ji)              + & 
-               ( sss_m(zji,zjj) - bulk_sal    ) * & 
-               rhoic * a_i_b(ji) * &
-               MAX( dh_i_bott(ji) , 0.0 ) / rdt_ice
+            fseqv_1d(ji) = fseqv_1d(ji) + ( sss_m(zji,zjj) - bulk_sal    )               &
+               &                        * rhoic * a_i_b(ji) * MAX( dh_i_bott(ji) , 0.0 ) / rdt_ice
          END DO
       ELSE
@@ -329,14 +258,11 @@
             zji                 = MOD( npb(ji) - 1, jpi ) + 1
             zjj                 = ( npb(ji) - 1 ) / jpi + 1
-            fseqv_1d(ji) = fseqv_1d(ji)              + & 
-               ( sss_m(zji,zjj) - s_i_new(ji) ) * & 
-               rhoic * a_i_b(ji) * &
-               MAX( dh_i_bott(ji) , 0.0 ) / rdt_ice
+            fseqv_1d(ji) = fseqv_1d(ji) + ( sss_m(zji,zjj) - s_i_new(ji) )               &
+               &                        * rhoic * a_i_b(ji) * MAX( dh_i_bott(ji) , 0.0 ) / rdt_ice
          END DO ! ji
       ENDIF
-
-      !-- End of salinity computations
+      !
    END SUBROUTINE lim_thd_sal
-   !==============================================================================
+
 
    SUBROUTINE lim_thd_sal_init
@@ -346,20 +272,17 @@
       !! ** Purpose :   initialization of ice salinity parameters
       !!
-      !! ** Method  : Read the namicesal namelist and check the parameter
-      !!       values called at the first timestep (nit000)
+      !! ** Method  :   Read the namicesal namelist and check the parameter
+      !!              values called at the first timestep (nit000)
       !!
       !! ** input   :   Namelist namicesal
-      !!
-      !! history :
-      !!   3.0  !  July 2005 M. Vancoppenolle  Original code
       !!-------------------------------------------------------------------
-      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/ num_sal, bulk_sal, sal_G, time_G, sal_F, time_F,   &
+         &                s_i_max, s_i_min, s_i_0, s_i_1
       !!-------------------------------------------------------------------
-
-      ! Read Namelist namicesal
-      REWIND ( numnam_ice )
-      READ   ( numnam_ice  , namicesal )
-      IF(lwp) THEN
+      !
+      REWIND( numnam_ice )                   ! Read Namelist namicesal
+      READ  ( numnam_ice  , namicesal )
+      !
+      IF(lwp) THEN                           ! control print
          WRITE(numout,*)
          WRITE(numout,*) 'lim_thd_sal_init : Ice parameters for salinity '
@@ -376,14 +299,11 @@
          WRITE(numout,*) ' 2nd salinity for salinity profile  : ', s_i_1
       ENDIF
-
+      !
    END SUBROUTINE lim_thd_sal_init
 
 #else
    !!----------------------------------------------------------------------
-   !!   Default option         Empty Module                No sea-ice model
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE lim_thd_sal        ! Empty routine
-   END SUBROUTINE lim_thd_sal
+   !!   Default option         Dummy Module          No LIM-3 sea-ice model
+   !!----------------------------------------------------------------------
 #endif
    !!======================================================================
Index: trunk/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90	(revision 2528)
@@ -11,5 +11,4 @@
    !!   lim_trp_init : initialization and namelist read
    !!----------------------------------------------------------------------
-   !! * Modules used
    USE phycst
    USE dom_oce
@@ -47,7 +46,7 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   LIM 3.0,  UCL-ASTR-LOCEAN-IPSL (2008)
+   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/LIM_SRC_3/limupdate.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_3/limupdate.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_3/limupdate.F90	(revision 2528)
@@ -13,9 +13,6 @@
    !!   'key_lim3'                                      LIM3 sea-ice model
    !!----------------------------------------------------------------------
-   !!    lim_update   : computes update of sea-ice global variables 
-   !!                   from trend terms
+   !!    lim_update   : computes update of sea-ice global variables from trend terms
    !!----------------------------------------------------------------------
-   !! * Modules used
-   USE limistate
    USE limrhg          ! ice rheology
    USE lbclnk
@@ -54,7 +51,7 @@
 
    !!----------------------------------------------------------------------
-   !!   LIM 3.0,  UCL-ASTR-LOCEAN-IPSL (2008)
+   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90	(revision 2528)
@@ -63,7 +63,7 @@
 
    !!----------------------------------------------------------------------
-   !!   LIM 3.0,  UCL-ASTR-LOCEAN-IPSL (2008)
+   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90	(revision 2528)
@@ -1,6 +1,3 @@
 MODULE limwri
-   !!----------------------------------------------------------------------
-   !!   'key_lim3'                                      LIM3 sea-ice model
-   !!----------------------------------------------------------------------
    !!======================================================================
    !!                     ***  MODULE  limwri  ***
@@ -9,12 +6,9 @@
 #if defined key_lim3
    !!----------------------------------------------------------------------
-   !!  LIM 3.0, UCL-LOCEAN-IPSL (2008)
-   !! $Id$
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
+   !!   'key_lim3'                                      LIM3 sea-ice model
    !!----------------------------------------------------------------------
    !!   lim_wri      : write of the diagnostics variables in ouput file 
    !!   lim_wri_init : initialization and namelist read
    !!----------------------------------------------------------------------
-   !! * Modules used
    USE ioipsl
    USE dianam          ! build name of file (routine)
@@ -63,10 +57,14 @@
       zzero  = 0.e0     ,  &
       zone   = 1.e0
-
+      
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
+
 #if defined key_dimgout
-
 # include "limwri_dimg.h90"
-
 #else
 
@@ -145,5 +143,5 @@
          CALL dia_nam ( clhstnam, nwrite, 'icemod' )
          CALL histbeg ( clhstnam, jpi, glamt, jpj, gphit, 1, jpi, 1, jpj, niter, zjulian, rdt_ice,   &
-            &           nhorid, nice, domain_id=nidom )
+            &           nhorid, nice, domain_id=nidom, snc4chunks=snc4set )
          CALL histvert( nice, "deptht", "Vertical T levels", "m", 1, zdept, ndepid, "down")
          CALL wheneq  ( jpij , tmask(:,:,1), 1, 1., ndex51, ndim)
@@ -159,5 +157,5 @@
          END DO
 
-         CALL histend(nice)
+         CALL histend(nice, snc4set)
 
          !-----------------
@@ -174,5 +172,5 @@
             niter, zjulian, rdt_ice,   & ! time
             nhorida,                   & ! ? linked with horizontal ...
-            nicea , domain_id=nidom)                  ! file 
+            nicea , domain_id=nidom, snc4chunks=snc4set)                  ! file 
          CALL histvert( nicea, "icethi", "L levels",               &
             "m", ipl , hi_mean , nz )
@@ -194,5 +192,5 @@
          CALL histdef( nicea, "iice_etd", "Brine volume distr. "               , "%"    ,   &  
             jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout )
-         CALL histend(nicea)
+         CALL histend(nicea, snc4set)
       ENDIF
 
Index: trunk/NEMOGCM/NEMO/LIM_SRC_3/limwri_dimg.h90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_3/limwri_dimg.h90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_3/limwri_dimg.h90	(revision 2528)
@@ -1,7 +1,7 @@
 SUBROUTINE lim_wri
    !!----------------------------------------------------------------------
-   !!  LIM 3.0, UCL-LOCEAN-IPSL (2008)
+   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
    !!-------------------------------------------------------------------
Index: trunk/NEMOGCM/NEMO/LIM_SRC_3/par_ice.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_3/par_ice.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_3/par_ice.F90	(revision 2528)
@@ -20,7 +20,7 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/LIM 3.2, UCL-ASTR-LOCEAN-IPSL (2009)
+   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!======================================================================
 END MODULE par_ice
Index: trunk/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90
===================================================================
--- trunk/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90	(revision 2528)
@@ -7,7 +7,7 @@
    !!   2.0  !  02-11  (C. Ethe)  F90: Free form and module
    !!----------------------------------------------------------------------
-   !!   LIM 3.0, UCL-LOCEAN-IPSL (2008)
+   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
    !! * Modules used
Index: trunk/NEMOGCM/NEMO/NST_SRC/agrif2model.F90
===================================================================
--- trunk/NEMOGCM/NEMO/NST_SRC/agrif2model.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/NST_SRC/agrif2model.F90	(revision 2528)
@@ -1,7 +1,7 @@
 #if defined key_agrif
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2006) 
+   !! NEMO/NST 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90
===================================================================
--- trunk/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90	(revision 2528)
@@ -33,7 +33,7 @@
 #endif
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)
+   !! NEMO/NST 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!======================================================================
 END MODULE agrif_oce
Index: trunk/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
===================================================================
--- trunk/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90	(revision 2528)
@@ -8,8 +8,8 @@
    !!            3.2  !  2009-04  (R. Benshila) 
    !!----------------------------------------------------------------------
-#if defined key_agrif && ! defined key_off_tra
+#if defined key_agrif && ! defined key_offline
    !!----------------------------------------------------------------------
    !!   'key_agrif'                                              AGRIF zoom
-   !!   NOT 'key_off_tra'                               NO off-line tracers
+   !!   NOT 'key_offline'                               NO off-line tracers
    !!----------------------------------------------------------------------
    !!   Agrif_tra     :
@@ -34,7 +34,7 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)
+   !! NEMO/NST 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -220,7 +220,5 @@
             DO jj=1,jpj
                ua(1:2,jj,jk) = (zua(1:2,jj,jk)/(rhoy*e2u(1:2,jj)))
-#if ! defined key_zco
                ua(1:2,jj,jk) = ua(1:2,jj,jk) / fse3u(1:2,jj,jk)
-#endif
             END DO
          END DO
@@ -276,7 +274,5 @@
             DO jj=1,jpj
                va(2,jj,jk) = (zva(2,jj,jk)/(zrhox*e1v(2,jj)))*vmask(2,jj,jk)
-#if ! defined key_zco
                va(2,jj,jk) = va(2,jj,jk) / fse3v(2,jj,jk)
-#endif           
             END DO
          END DO
@@ -294,7 +290,5 @@
                ua(nlci-2:nlci-1,jj,jk) = (zua(nlci-2:nlci-1,jj,jk)/(rhoy*e2u(nlci-2:nlci-1,jj)))
 
-#if ! defined key_zco
                ua(nlci-2:nlci-1,jj,jk) = ua(nlci-2:nlci-1,jj,jk) / fse3u(nlci-2:nlci-1,jj,jk)
-#endif
 
             END DO
@@ -354,7 +348,5 @@
             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)
-#if ! defined key_zco
                va(nlci-1,jj,jk) = va(nlci-1,jj,jk) / fse3v(nlci-1,jj,jk)
-#endif
             END DO
          END DO
@@ -371,7 +363,5 @@
             DO ji=1,jpi
                va(ji,1:2,jk) = (zva(ji,1:2,jk)/(zrhox*e1v(ji,1:2)))
-#if ! defined key_zco
                va(ji,1:2,jk) = va(ji,1:2,jk) / fse3v(ji,1:2,jk)
-#endif
             END DO
          END DO
@@ -427,7 +417,5 @@
             DO ji=1,jpi
                ua(ji,2,jk) = (zua(ji,2,jk)/(rhoy*e2u(ji,2)))*umask(ji,2,jk) 
-#if ! defined key_zco
                ua(ji,2,jk) = ua(ji,2,jk) / fse3u(ji,2,jk)
-#endif                
             END DO
          END DO
@@ -444,7 +432,5 @@
             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)))
-#if ! defined key_zco
                va(ji,nlcj-2:nlcj-1,jk) = va(ji,nlcj-2:nlcj-1,jk) / fse3v(ji,nlcj-2:nlcj-1,jk)
-#endif
             END DO
          END DO
@@ -501,7 +487,5 @@
             DO ji=1,jpi
                ua(ji,nlcj-1,jk) = (zua(ji,nlcj-1,jk)/(rhoy*e2u(ji,nlcj-1)))*umask(ji,nlcj-1,jk)
-#if ! defined key_zco
                ua(ji,nlcj-1,jk) = ua(ji,nlcj-1,jk) / fse3u(ji,nlcj-1,jk)
-#endif          
             END DO
          END DO
@@ -514,5 +498,5 @@
    SUBROUTINE Agrif_ssh( kt )
       !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE Agrif_ssh  ***
+      !!                  ***  ROUTINE Agrif_DYN  ***
       !!----------------------------------------------------------------------  
       INTEGER, INTENT(in) ::   kt
@@ -521,4 +505,5 @@
 
       IF( Agrif_Root() )   RETURN
+
 
       IF((nbondi == -1).OR.(nbondi == 2)) THEN
@@ -559,7 +544,5 @@
             DO ji=i1,i2
                tabres(ji,jj,jk) = e2u(ji,jj) * un(ji,jj,jk)
-#if ! defined key_zco
                tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3u(ji,jj,jk)
-#endif
             END DO
          END DO
@@ -602,7 +585,5 @@
             DO ji=i1,i2
                tabres(ji,jj,jk) = e1v(ji,jj) * vn(ji,jj,jk)
-#if ! defined key_zco
                tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3v(ji,jj,jk)
-#endif           
             END DO
          END DO
Index: trunk/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90
===================================================================
--- trunk/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90	(revision 2528)
@@ -2,5 +2,5 @@
 
 Module agrif_opa_sponge
-#if defined key_agrif  && ! defined key_off_tra
+#if defined key_agrif  && ! defined key_offline
    USE par_oce
    USE oce
@@ -15,7 +15,7 @@
 
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2006)
+   !! NEMO/NST 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -130,11 +130,6 @@
          DO jj = 1, jpjm1
             DO ji = 1, jpim1
-#if defined key_zco
-               zabe1 = umask(ji,jj,jk) * spe1ur(ji,jj)
-               zabe2 = vmask(ji,jj,jk) * spe2vr(ji,jj)
-#else
                zabe1 = umask(ji,jj,jk) * spe1ur(ji,jj) * fse3u(ji,jj,jk)
                zabe2 = vmask(ji,jj,jk) * spe2vr(ji,jj) * fse3v(ji,jj,jk)
-#endif
                ztu(ji,jj,jk) = zabe1 * ( tbdiff(ji+1,jj  ,jk) - tbdiff(ji,jj,jk) )
                zsu(ji,jj,jk) = zabe1 * ( sbdiff(ji+1,jj  ,jk) - sbdiff(ji,jj,jk) )
@@ -146,9 +141,5 @@
          DO jj = 2,jpjm1
             DO ji = 2,jpim1
-#if defined key_zco
-               zbtr = spbtr2(ji,jj)
-#else
                zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk)
-#endif
                ! horizontal diffusive trends
                zta = zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)   &
@@ -282,11 +273,4 @@
          DO jj = 2, jpjm1
             DO ji = 2, jpim1   ! vector opt.
-#if defined key_zco
-               zbtr = spbtr2(ji,jj)
-               hdivdiff(ji,jj,jk) = (  e2u(ji,jj) * ubdiff(ji,jj,jk) &
-                  - e2u(ji-1,jj  ) * ubdiff(ji-1,jj  ,jk)      &
-                  &               + e1v(ji,jj) * vbdiff(ji,jj,jk) - &
-                  &              e1v(ji  ,jj-1) * vbdiff(ji  ,jj-1,jk)  ) * zbtr
-#else
                zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk)
                hdivdiff(ji,jj,jk) =   &
@@ -297,5 +281,4 @@
                   vbdiff(ji,jj,jk) - e1v(ji  ,jj-1)* &
                   fse3v(ji  ,jj-1,jk)  * vbdiff(ji  ,jj-1,jk)  ) * zbtr
-#endif
             END DO
          END DO
@@ -303,15 +286,8 @@
          DO jj = 1, jpjm1
             DO ji = 1, jpim1   ! vector opt.
-#if defined key_zco	    
-               zbtr = spbtr3(ji,jj)
-               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
-#else
                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
-#endif		  
             END DO
          END DO
@@ -324,18 +300,4 @@
          DO jj = 2, jpjm1
             DO ji = 2, jpim1   ! vector opt.
-#if defined key_zco
-               ! horizontal diffusive trends
-               ze2u = rotdiff (ji,jj,jk)
-               ze1v = hdivdiff(ji,jj,jk)
-               zua = - (                ze2u                  - &
-                  rotdiff (ji,jj-1,jk) ) / e2u(ji,jj)   &
-                  + ( hdivdiff(ji+1,jj,jk) -     &
-                  ze1v                  ) / e1u(ji,jj)
-
-               zva = + (                ze2u                  - &
-                  rotdiff (ji-1,jj,jk) ) / e1v(ji,jj)   &
-                  + ( hdivdiff(ji,jj+1,jk) -       &
-                  ze1v                  ) / e2v(ji,jj)
-#else
                ze2u = rotdiff (ji,jj,jk)
                ze1v = hdivdiff(ji,jj,jk)
@@ -348,5 +310,4 @@
                   + ( hdivdiff(ji,jj+1,jk) - ze1v    &
                   ) / e2v(ji,jj)
-#endif
 
                ! add it to the general momentum trends
Index: trunk/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90
===================================================================
--- trunk/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90	(revision 2528)
@@ -2,5 +2,5 @@
 
 MODULE agrif_opa_update
-#if defined key_agrif  && ! defined key_off_tra
+#if defined key_agrif  && ! defined key_offline
    USE par_oce
    USE oce
@@ -16,7 +16,7 @@
 
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2006)
+   !! NEMO/NST 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -184,7 +184,4 @@
                DO ji=i1,i2
                   tabres(ji,jj,jk) = e2u(ji,jj) * un(ji,jj,jk)
-#if ! defined key_zco
-                  tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3u(ji,jj,jk)
-#endif
                END DO
             END DO
@@ -197,7 +194,5 @@
                   un(ji,jj,jk) = tabres(ji,jj,jk) / (e2u(ji,jj))
                   un(ji,jj,jk) = un(ji,jj,jk) * umask(ji,jj,jk)
-#if ! defined key_zco
                   un(ji,jj,jk) = un(ji,jj,jk) / fse3u(ji,jj,jk)
-#endif
                END DO
             END DO
@@ -226,7 +221,5 @@
                DO ji=i1,i2
                   tabres(ji,jj,jk) = e1v(ji,jj) * vn(ji,jj,jk)
-#if ! defined key_zco
                   tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3v(ji,jj,jk)
-#endif
                END DO
             END DO
@@ -239,7 +232,5 @@
                   vn(ji,jj,jk) = tabres(ji,jj,jk) / (e1v(ji,jj))
                   vn(ji,jj,jk) = vn(ji,jj,jk) * vmask(ji,jj,jk)
-#if ! defined key_zco
                   vn(ji,jj,jk) = vn(ji,jj,jk) / fse3v(ji,jj,jk)
-#endif
                END DO
             END DO
Index: trunk/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90
===================================================================
--- trunk/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90	(revision 2528)
@@ -14,7 +14,7 @@
 
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2006)
+   !! NEMO/NST 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90
===================================================================
--- trunk/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90	(revision 2528)
@@ -16,7 +16,7 @@
 
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2006)
-   !! $Id: agrif_opa_sponge.F90 1156 2008-06-26 16:06:45Z rblod $
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! NEMO/NST 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -123,11 +123,6 @@
          DO jj = 1, jpjm1
             DO ji = 1, jpim1
-#if defined key_zco
-               zabe1 = umask(ji,jj,jk) * spe1ur(ji,jj)
-               zabe2 = vmask(ji,jj,jk) * spe2vr(ji,jj)
-#else
                zabe1 = umask(ji,jj,jk) * spe1ur(ji,jj) * fse3u(ji,jj,jk)
                zabe2 = vmask(ji,jj,jk) * spe2vr(ji,jj) * fse3v(ji,jj,jk)
-#endif
                ztru(ji,jj,jk,jl) = zabe1 * ( trbdiff(ji+1,jj  ,jk,jl) - trbdiff(ji,jj,jk,jl) )
                ztrv(ji,jj,jk,jl) = zabe2 * ( trbdiff(ji  ,jj+1,jk,jl) - trbdiff(ji,jj,jk,jl) )
@@ -137,9 +132,5 @@
          DO jj = 2,jpjm1
             DO ji = 2,jpim1
-#if defined key_zco
-               zbtr = spbtr2(ji,jj)
-#else
                zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk)
-#endif
                ! horizontal diffusive trends
                ztra = zbtr * (  ztru(ji,jj,jk,jl) - ztru(ji-1,jj,jk,jl)   &
Index: trunk/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90
===================================================================
--- trunk/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90	(revision 2528)
@@ -18,7 +18,7 @@
 
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2006)
+   !! NEMO/NST 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/NST_SRC/agrif_user.F90
===================================================================
--- trunk/NEMOGCM/NEMO/NST_SRC/agrif_user.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/NST_SRC/agrif_user.F90	(revision 2528)
@@ -1,7 +1,7 @@
 #if defined key_agrif
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2006)
+   !! NEMO/NST 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -55,5 +55,5 @@
    END SUBROUTINE Agrif_InitWorkspace
 
-#if ! defined key_off_tra
+#if ! defined key_offline
 
    SUBROUTINE Agrif_InitValues
@@ -66,5 +66,5 @@
       USE oce 
       USE dom_oce
-      USE opa
+      USE nemogcm
 #if defined key_top
       USE trc
@@ -111,6 +111,6 @@
 #endif
 
-      Call opa_init  ! Initializations of each fine grid
-      Call agrif_opa_init
+      Call nemo_init  ! Initializations of each fine grid
+      Call agrif_nemo_init
 
       ! 1. Declaration of the type of variable which have to be interpolated
@@ -308,6 +308,6 @@
 #if defined key_top
         ! Check passive tracer cell
-        IF( ndttrc .ne. 1 ) THEN
-           WRITE(*,*) 'ndttrc should be equal to 1'
+        IF( nn_dttrc .ne. 1 ) THEN
+           WRITE(*,*) 'nn_dttrc should be equal to 1'
         ENDIF
 #endif
@@ -339,5 +339,5 @@
       USE oce 
       USE dom_oce
-      USE opa
+      USE nemogcm
       USE trc
       USE in_out_manager
@@ -359,6 +359,6 @@
 #endif
 
-      Call opa_init  ! Initializations of each fine grid
-      Call agrif_opa_init
+      Call nemo_init  ! Initializations of each fine grid
+      Call agrif_nemo_init
 
       ! 1. Declaration of the type of variable which have to be interpolated
@@ -445,6 +445,6 @@
          ENDIF
         ! Check passive tracer cell
-        IF( ndttrc .ne. 1 ) THEN
-           WRITE(*,*) 'ndttrc should be equal to 1'
+        IF( nn_dttrc .ne. 1 ) THEN
+           WRITE(*,*) 'nn_dttrc should be equal to 1'
         ENDIF
 
@@ -473,5 +473,5 @@
 
 
-   SUBROUTINE agrif_opa_init
+   SUBROUTINE agrif_nemo_init
       !!----------------------------------------------------------------------
       !!                     *** ROUTINE agrif_init ***
@@ -484,5 +484,5 @@
       NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn
       !!----------------------------------------------------------------------
-
+      !
       REWIND( numnam )                ! Read namagrif namelist
       READ  ( numnam, namagrif )
@@ -490,6 +490,6 @@
       IF(lwp) THEN                    ! control print
          WRITE(numout,*)
-         WRITE(numout,*) 'agrif_opa_init : AGRIF parameters'
-         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters'
+         WRITE(numout,*) '~~~~~~~~~~~~~~~'
          WRITE(numout,*) '   Namelist namagrif : set AGRIF parameters'
          WRITE(numout,*) '      baroclinic update frequency       nn_cln_update = ', nn_cln_update
@@ -505,5 +505,5 @@
       visc_dyn      = rn_sponge_dyn
       !
-    END SUBROUTINE agrif_opa_init
+    END SUBROUTINE agrif_nemo_init
 
 # if defined key_mpp_mpi
@@ -520,13 +520,9 @@
       !!----------------------------------------------------------------------
       !
-      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
+      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
       END SELECT
       !
Index: trunk/NEMOGCM/NEMO/OFF_SRC/ctlopn.f90
===================================================================
--- trunk/NEMOGCM/NEMO/OFF_SRC/ctlopn.f90	(revision 2527)
+++ 	(revision )
@@ -1,157 +1,0 @@
-   SUBROUTINE ctlopn ( knum, cdfile, cdstat, cdform, cdacce,   &
-                       klengh, kout, ldwp, krequ )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE ctlopn  ***
-      !!
-      !! ** Purpose :   Open file and check if required file is available.
-      !!
-      !! ** Method  :   Fortan open
-      !!
-      !! History :
-      !!        !  95-12  (G. Madec)  Original code
-      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
-      !!----------------------------------------------------------------------
-      USE in_out_manager 
-
-      IMPLICIT NONE
-
-      INTEGER, INTENT( out ) ::   &
-         knum      ! logical unit to open
-      INTEGER, INTENT( in ) ::   &
-         krequ,    & ! =1 file required (stop if not exist)
-         !           ! =0 file not required (create the file if does not exist)
-         kout,     & ! number of logical units for write
-         klengh      ! record length
-
-      INTEGER ::   iost
-      CHARACTER (len=* ), INTENT( in ) ::   &
-         cdacce,   & ! access specifier
-         cdform,   & ! formatting specifier
-         cdstat      ! disposition specifier
-      CHARACTER (len=* ), INTENT( in ) ::   &
-         cdfile      ! file name to open
-
-      LOGICAL ::  ldwp   ! boolean term for print
-      !!----------------------------------------------------------------------
-      !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-      !! $Id$ 
-      !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
-      !!----------------------------------------------------------------------
-
-      knum=getunit()
-
-      ! 1. Required file
-      ! ----------------
-
-      IF( krequ == 1 ) THEN
-
-         iost=0
-         IF( cdacce(1:6) == 'DIRECT' )  THEN
-            OPEN( UNIT=knum, FILE=cdfile, FORM=cdform, ACCESS=cdacce,   &
-               STATUS=cdstat, RECL=klengh, ERR=100, IOSTAT=iost )
-         ELSE
-            OPEN( UNIT=knum, FILE=cdfile, FORM=cdform, ACCESS=cdacce,   &
-               STATUS=cdstat, ERR=100, IOSTAT=iost)
-         ENDIF
-         IF( iost == 0 ) THEN
-            IF(ldwp) THEN
-               WRITE(kout,*) '     file   : ', cdfile,' open ok'
-               WRITE(kout,*) '     unit   = ', knum
-               WRITE(kout,*) '     status = ', cdstat
-               WRITE(kout,*) '     form   = ', cdform
-               WRITE(kout,*) '     access = ', cdacce
-               WRITE(kout,*)
-            ENDIF
-         ENDIF
-100      CONTINUE
-         IF( iost /= 0 ) THEN
-            IF(ldwp) THEN
-               WRITE(kout,*)
-               WRITE(kout,*) ' ===>>>> : bad opening file: ', cdfile
-               WRITE(kout,*) ' =======   ===  '
-               WRITE(kout,*) '           unit   = ', knum
-               WRITE(kout,*) '           status = ', cdstat
-               WRITE(kout,*) '           form   = ', cdform
-               WRITE(kout,*) '           access = ', cdacce
-               WRITE(kout,*) '           iostat = ', iost
-               WRITE(kout,*) '           we stop. verify the file '
-               WRITE(kout,*)
-            ENDIF
-            STOP 'ctlopn bad opening'
-         ENDIF
-         
-         
-         ! 2. Not required, file create if not exist
-         ! -----------------------------------------
-         
-      ELSEIF( krequ == 0 ) THEN
-
-         iost = 0
-         IF( cdacce(1:6) == 'DIRECT' ) THEN
-            OPEN( UNIT=knum, FILE=cdfile, FORM=cdform, ACCESS=cdacce,   &
-               STATUS=cdstat, RECL=klengh, ERR=200, IOSTAT=iost )
-         ELSE
-            OPEN( UNIT=knum, FILE=cdfile, FORM=cdform, ACCESS=cdacce,   &
-               STATUS=cdstat, ERR=200, IOSTAT=iost )
-         ENDIF
-         IF(iost == 0) THEN
-            IF(ldwp) THEN
-               WRITE(kout,*) '     file   : ', cdfile,' open ok'
-               WRITE(kout,*) '     unit   = ', knum
-               WRITE(kout,*) '     status = ', cdstat
-               WRITE(kout,*) '     form   = ', cdform
-               WRITE(kout,*) '     access = ', cdacce
-               WRITE(kout,*)
-            ENDIF
-         ENDIF
-200      CONTINUE
-         IF( iost /= 0 ) THEN
-            iost = 0
-            IF(ldwp) THEN
-               WRITE(kout,*)
-               WRITE(kout,*) '     ===>>>> : file ', cdfile,   &
-                  ' does not exist: it is created'
-               WRITE(kout,*) ' =======   ===  '
-            ENDIF
-            IF( cdacce(1:6) == 'DIRECT' ) THEN
-               OPEN( UNIT=knum, FILE=cdfile, FORM=cdform,   &
-                  ACCESS=cdacce, STATUS=cdstat,   &
-                  RECL=klengh, ERR=210, IOSTAT=iost )
-            ELSE
-               OPEN( UNIT=knum, FILE=cdfile, FORM=cdform,   &
-                  ACCESS=cdacce, STATUS=cdstat, ERR=210,   &
-                  IOSTAT=iost )
-            ENDIF
-            IF(ldwp) THEN
-               WRITE(kout,*) '     file   : ', cdfile,' open ok'
-               WRITE(kout,*) '     unit   = ', knum
-               WRITE(kout,*) '     status = ', cdstat
-               WRITE(kout,*) '     form   = ', cdform
-               WRITE(kout,*) '     access = ', cdacce
-               WRITE(kout,*)
-            ENDIF
-210         CONTINUE
-            IF( iost /= 0 ) THEN
-               IF(ldwp) THEN
-                  WRITE(kout,*) ' logical unit ',knum,' iostat = ', iost
-                  WRITE(kout,*) ' we stop. verify the file ', cdfile
-                  WRITE(kout,*)
-               ENDIF
-               STOP '001'
-            ENDIF
-         ENDIF
-         
-      ELSE
-         
-         IF(ldwp) THEN
-            WRITE(kout,*)
-            WRITE(kout,*) ' ctlopn : invalid option, krequ = ', krequ
-            WRITE(kout,*) ' ~~~~~~   call for file ', cdfile
-            WRITE(kout,*)
-         ENDIF
-
-
-         STOP 'ctlopn invalid option'
-      ENDIF
-      
-   END SUBROUTINE ctlopn
Index: trunk/NEMOGCM/NEMO/OFF_SRC/domain.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OFF_SRC/domain.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OFF_SRC/domain.F90	(revision 2528)
@@ -0,0 +1,329 @@
+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
+
+   !                                    !!! ** Namelist namzgr_sco **
+   REAL(wp) ::   rn_sbot_min =  300.     ! minimum depth of s-bottom surface (>0) (m)
+   REAL(wp) ::   rn_sbot_max = 5250.     ! maximum depth of s-bottom surface (= ocean depth) (>0) (m)
+   REAL(wp) ::   rn_theta    =    6.0    ! surface control parameter (0<=rn_theta<=20)
+   REAL(wp) ::   rn_thetb    =    0.75   ! bottom control parameter  (0<=rn_thetb<= 1)
+   REAL(wp) ::   rn_rmax     =    0.15   ! maximum cut-off r-value allowed (0<rn_rmax<1)
+   LOGICAL  ::   ln_s_sigma  = .false.   ! use hybrid s-sigma -coordinate & stretching function fssig1 (ln_sco=T)
+   REAL(wp) ::   rn_bb       =    0.8    ! stretching parameter for song and haidvogel stretching
+   !                                     ! ( rn_bb=0; top only, rn_bb =1; top and bottom)
+   REAL(wp) ::   rn_hc       = 150.      ! Critical depth for s-sigma coordinates
+
+   !! * 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 ::   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
+      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
+      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
+      NAMELIST/namdom/ nn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh   ,   &
+         &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin,   &
+         &             rn_rdtmax, rn_rdth     , nn_baro     , nn_closea
+      NAMELIST/namcla/ nn_cla
+      !!----------------------------------------------------------------------
+
+      REWIND( numnam )              ! Namelist namrun : parameters of the run
+      READ  ( numnam, 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 )             ! Domain
+      READ  ( numnam, 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,*) '      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
+      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
+      nclosea   = nn_closea
+
+      REWIND( numnam )             ! Namelist cross land advection
+      READ  ( numnam, namcla )
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '   Namelist namcla'
+         WRITE(numout,*) '      cross land advection                 nn_cla    = ', nn_cla
+      ENDIF
+
+      IF( lk_mpp_rep .AND. nn_cla /= 0 )   CALL ctl_stop( ' Reproductibility tests (nbit_cmp=1) require n_cla = 0' )
+      !
+   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._0, e3._0)
+      !!              - 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
+      !!
+      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco
+      !!----------------------------------------------------------------------
+
+      REWIND ( numnam )                ! Read Namelist namzgr : vertical coordinate'
+      READ   ( numnam, 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
+      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 ( ioptio /= 1 )   CALL ctl_stop( ' none or several vertical coordinate options used' )
+
+   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: trunk/NEMOGCM/NEMO/OFF_SRC/dommsk.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OFF_SRC/dommsk.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OFF_SRC/dommsk.F90	(revision 2528)
@@ -0,0 +1,100 @@
+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 in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dom_msk    ! routine called by inidom.F90
+
+#if defined key_degrad
+   !! ------------------------------------------------
+   !! Degradation method
+   !! --------------------------------------------------
+   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk) ::   facvol  !! volume for degraded regions
+#endif
+
+   !! * 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, DIMENSION(jpi,jpj) ::  imsk   ! 2D workspace
+      !!---------------------------------------------------------------------
+      !
+      ! Interior domain mask (used for global sum)
+      ! --------------------
+      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
+      !
+   END SUBROUTINE dom_msk
+
+   !!======================================================================
+END MODULE dommsk
Index: trunk/NEMOGCM/NEMO/OFF_SRC/domrea.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OFF_SRC/domrea.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OFF_SRC/domrea.F90	(revision 2528)
@@ -0,0 +1,352 @@
+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
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   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
+   !!----------------------------------------------------------------------
+   USE dom_oce         ! ocean space and time domain
+   USE dommsk          ! domain: masks
+   USE lbclnk          ! lateral boundary condition - MPP exchanges
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dom_rea    ! routine called by inidom.F90
+   !!----------------------------------------------------------------------
+   !! NEMO/OFF 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dom_rea
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_rea  ***
+      !!                   
+      !! ** Purpose :  Read the NetCDF file(s) which contain(s) all the
+      !!      ocean domain informations (mesh and mask arrays). This (these)
+      !!      file(s) is (are) used for visualisation (SAXO software) and
+      !!      diagnostic computation.
+      !!
+      !! ** Method  :   Read in a file all the arrays generated in routines
+      !!      domhgr, domzgr, and dommsk. Note: the file contain depends on
+      !!      the vertical coord. used (z-coord, partial steps, s-coord)
+      !!                    nmsh = 1  :   'mesh_mask.nc' file
+      !!                         = 2  :   'mesh.nc' and mask.nc' files
+      !!                         = 3  :   'mesh_hgr.nc', 'mesh_zgr.nc' and
+      !!                                  'mask.nc' files
+      !!      For huge size domain, use option 2 or 3 depending on your 
+      !!      vertical coordinate.
+      !!
+      !! ** input file : 
+      !!      meshmask.nc  : domain size, horizontal grid-point position,
+      !!                     masks, depth and vertical scale factors
+      !!----------------------------------------------------------------------
+      USE iom
+      !!
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      INTEGER  ::   ik, inum0 , inum1 , inum2 , inum3 , inum4   ! local integers
+      REAL(wp) ::   zrefdep         ! local real
+      REAL(wp), DIMENSION(jpi,jpj) ::   zmbk, zprt, zprw   ! 2D workspace
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'dom_rea : read NetCDF mesh and mask information file(s)'
+      IF(lwp) WRITE(numout,*) '~~~~~~~'
+
+      zmbk(:,:) = 0._wp
+
+      SELECT CASE (nmsh)
+         !                                     ! ============================
+         CASE ( 1 )                            !  create 'mesh_mask.nc' file
+            !                                  ! ============================
+
+            IF(lwp) WRITE(numout,*) '          one file in "mesh_mask.nc" '
+            CALL iom_open( 'mesh_mask', inum0 )
+
+            inum2 = inum0                                            ! put all the informations
+            inum3 = inum0                                            ! in unit inum0
+            inum4 = inum0
+
+            !                                  ! ============================
+         CASE ( 2 )                            !  create 'mesh.nc' and 
+            !                                  !         'mask.nc' files
+            !                                  ! ============================
+
+            IF(lwp) WRITE(numout,*) '          two files in "mesh.nc" and "mask.nc" '
+            CALL iom_open( 'mesh', inum1 )
+            CALL iom_open( 'mask', inum2 )
+
+            inum3 = inum1                                            ! put mesh informations 
+            inum4 = inum1                                            ! in unit inum1 
+
+            !                                  ! ============================
+         CASE ( 3 )                            !  create 'mesh_hgr.nc'
+            !                                  !         'mesh_zgr.nc' and
+            !                                  !         'mask.nc'     files
+            !                                  ! ============================
+
+            IF(lwp) WRITE(numout,*) '          three files in "mesh_hgr.nc" , "mesh_zgr.nc" and "mask.nc" '
+            CALL iom_open( 'mesh_hgr', inum3 ) ! create 'mesh_hgr.nc'
+            CALL iom_open( 'mesh_zgr', inum4 ) ! create 'mesh_zgr.nc'
+            CALL iom_open( 'mask'    , inum2 ) ! create 'mask.nc'
+
+         END SELECT
+
+         !                                                         ! masks (inum2) 
+         CALL iom_get( inum2, jpdom_data, 'tmask', tmask )
+         CALL iom_get( inum2, jpdom_data, 'umask', umask )
+         CALL iom_get( inum2, jpdom_data, 'vmask', vmask )
+         CALL iom_get( inum2, jpdom_data, 'fmask', fmask )
+
+#if defined key_c1d
+         ! set umask and vmask equal tmask in 1D configuration
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '**********  1D configuration : set umask and vmask equal tmask ********'
+         IF(lwp) WRITE(numout,*) '**********                                                     ********'
+
+         umask(:,:,:) = tmask(:,:,:)
+         vmask(:,:,:) = tmask(:,:,:)
+#endif
+
+#if defined key_degrad
+         CALL iom_get( inum2, jpdom_data, 'facvolt', facvol )
+#endif
+
+         !                                                         ! horizontal mesh (inum3)
+         CALL iom_get( inum3, jpdom_data, 'glamt', glamt )
+         CALL iom_get( inum3, jpdom_data, 'glamu', glamu )
+         CALL iom_get( inum3, jpdom_data, 'glamv', glamv )
+         CALL iom_get( inum3, jpdom_data, 'glamf', glamf )
+
+         CALL iom_get( inum3, jpdom_data, 'gphit', gphit )
+         CALL iom_get( inum3, jpdom_data, 'gphiu', gphiu )
+         CALL iom_get( inum3, jpdom_data, 'gphiv', gphiv )
+         CALL iom_get( inum3, jpdom_data, 'gphif', gphif )
+
+         CALL iom_get( inum3, jpdom_data, 'e1t', e1t )
+         CALL iom_get( inum3, jpdom_data, 'e1u', e1u )
+         CALL iom_get( inum3, jpdom_data, 'e1v', e1v )
+         
+         CALL iom_get( inum3, jpdom_data, 'e2t', e2t )
+         CALL iom_get( inum3, jpdom_data, 'e2u', e2u )
+         CALL iom_get( inum3, jpdom_data, 'e2v', e2v )
+
+         CALL iom_get( inum3, jpdom_data, 'ff', ff )
+
+         CALL iom_get( inum4, jpdom_data, 'mbathy', zmbk )              ! number of ocean t-points
+         mbathy(:,:) = INT( zmbk(:,:) )
+         
+         CALL zgr_bot_level                                             ! mbk. arrays (deepest ocean t-, u- & v-points
+         !
+         IF( ln_sco ) THEN                                         ! s-coordinate
+            CALL iom_get( inum4, jpdom_data, 'hbatt', hbatt )
+            CALL iom_get( inum4, jpdom_data, 'hbatu', hbatu )
+            CALL iom_get( inum4, jpdom_data, 'hbatv', hbatv )
+            CALL iom_get( inum4, jpdom_data, 'hbatf', hbatf )
+            
+            CALL iom_get( inum4, jpdom_unknown, 'gsigt', gsigt ) ! scaling coef.
+            CALL iom_get( inum4, jpdom_unknown, 'gsigw', gsigw )
+            CALL iom_get( inum4, jpdom_unknown, 'gsi3w', gsi3w ) 
+            CALL iom_get( inum4, jpdom_unknown, 'esigt', esigt )
+            CALL iom_get( inum4, jpdom_unknown, 'esigw', esigw )
+
+            CALL iom_get( inum4, jpdom_data, 'e3t', e3t ) ! scale factors
+            CALL iom_get( inum4, jpdom_data, 'e3u', e3u )
+            CALL iom_get( inum4, jpdom_data, 'e3v', e3v )
+            CALL iom_get( inum4, jpdom_data, 'e3w', e3w )
+
+            CALL iom_get( inum4, jpdom_unknown, 'gdept_0', gdept_0 ) ! depth
+            CALL iom_get( inum4, jpdom_unknown, 'gdepw_0', gdepw_0 )
+         ENDIF
+
+ 
+         IF( ln_zps ) THEN                                           ! z-coordinate - partial steps
+            CALL iom_get( inum4, jpdom_unknown, 'gdept_0', gdept_0 )    ! reference depth
+            CALL iom_get( inum4, jpdom_unknown, 'gdepw_0', gdepw_0 )
+            CALL iom_get( inum4, jpdom_unknown, 'e3t_0'  , e3t_0   )    ! reference scale factors
+            CALL iom_get( inum4, jpdom_unknown, 'e3w_0'  , e3w_0   )
+            !
+            IF( nmsh <= 6 ) THEN                                        ! 3D vertical scale factors
+               CALL iom_get( inum4, jpdom_data, 'e3t', e3t )
+               CALL iom_get( inum4, jpdom_data, 'e3u', e3u )
+               CALL iom_get( inum4, jpdom_data, 'e3v', e3v )
+               CALL iom_get( inum4, jpdom_data, 'e3w', e3w )
+            ELSE                                                        ! 2D bottom scale factors
+               CALL iom_get( inum4, jpdom_data, 'e3t_ps', e3tp )
+               CALL iom_get( inum4, jpdom_data, 'e3w_ps', e3wp )
+               !                                                        ! deduces the 3D scale factors
+               DO jk = 1, jpk
+                  e3t(:,:,jk) = e3t_0(jk)                                     ! set to the ref. factors
+                  e3u(:,:,jk) = e3t_0(jk)
+                  e3v(:,:,jk) = e3t_0(jk)
+                  e3w(:,:,jk) = e3w_0(jk)
+               END DO
+               DO jj = 1,jpj                                                  ! adjust the deepest values
+                  DO ji = 1,jpi
+                     ik = mbkt(ji,jj)
+                     e3t(ji,jj,ik) = e3tp(ji,jj) * tmask(ji,jj,1) + e3t_0(1) * ( 1._wp - tmask(ji,jj,1) )
+                     e3w(ji,jj,ik) = e3wp(ji,jj) * tmask(ji,jj,1) + e3w_0(1) * ( 1._wp - tmask(ji,jj,1) )
+                  END DO
+               END DO
+               DO jk = 1,jpk                         ! Computed as the minimum of neighbooring scale factors
+                  DO jj = 1, jpjm1
+                     DO ji = 1, jpim1
+                        e3u(ji,jj,jk) = MIN( e3t(ji,jj,jk), e3t(ji+1,jj,jk) )
+                        e3v(ji,jj,jk) = MIN( e3t(ji,jj,jk), e3t(ji,jj+1,jk) )
+                     END DO
+                  END DO
+               END DO
+               CALL lbc_lnk( e3u , 'U', 1._wp )   ;   CALL lbc_lnk( e3uw, 'U', 1._wp )   ! lateral boundary conditions
+               CALL lbc_lnk( e3v , 'V', 1._wp )   ;   CALL lbc_lnk( e3vw, 'V', 1._wp )
+               !
+               DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries)
+                  WHERE( e3u(:,:,jk) == 0._wp )   e3u(:,:,jk) = e3t_0(jk)
+                  WHERE( e3v(:,:,jk) == 0._wp )   e3v(:,:,jk) = e3t_0(jk)
+               END DO
+            END IF
+
+            IF( iom_varid( inum4, 'gdept', ldstop = .FALSE. ) > 0 ) THEN   ! 3D depth of t- and w-level
+               CALL iom_get( inum4, jpdom_data, 'gdept', gdept )
+               CALL iom_get( inum4, jpdom_data, 'gdepw', gdepw )
+            ELSE                                                           ! 2D bottom depth
+               CALL iom_get( inum4, jpdom_data, 'hdept', zprt )
+               CALL iom_get( inum4, jpdom_data, 'hdepw', zprw )
+               !
+               DO jk = 1, jpk                                              ! deduces the 3D depth
+                  gdept(:,:,jk) = gdept_0(jk)
+                  gdepw(:,:,jk) = gdepw_0(jk)
+               END DO
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     ik = mbkt(ji,jj)
+                     IF( ik > 0 ) THEN
+                        gdepw(ji,jj,ik+1) = zprw(ji,jj)
+                        gdept(ji,jj,ik  ) = zprt(ji,jj)
+                        gdept(ji,jj,ik+1) = gdept(ji,jj,ik) + e3t(ji,jj,ik)
+                     ENDIF
+                  END DO
+               END DO
+            ENDIF
+            !
+         ENDIF
+
+         IF( ln_zco ) THEN           ! Vertical coordinates and scales factors
+            CALL iom_get( inum4, jpdom_unknown, 'gdept_0', gdept_0 ) ! depth
+            CALL iom_get( inum4, jpdom_unknown, 'gdepw_0', gdepw_0 )
+            CALL iom_get( inum4, jpdom_unknown, 'e3t_0'  , e3t_0   )
+            CALL iom_get( inum4, jpdom_unknown, 'e3w_0'  , e3w_0   )
+         ENDIF
+
+!!gm BUG in s-coordinate this does not work!
+      ! deepest/shallowest W level Above/Below ~10m
+      zrefdep = 10._wp - ( 0.1_wp * MINVAL(e3w_0) )                  ! ref. depth with tolerance (10% of minimum layer thickness)
+      nlb10 = MINLOC( gdepw_0, mask = gdepw_0 > zrefdep, dim = 1 )   ! shallowest W level Below ~10m
+      nla10 = nlb10 - 1                                              ! deepest    W level Above ~10m
+!!gm end bug
+
+      ! Control printing : Grid informations (if not restart)
+      ! ----------------
+
+      IF(lwp .AND. .NOT.ln_rstart ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '          longitude and e1 scale factors'
+         WRITE(numout,*) '          ------------------------------'
+         WRITE(numout,9300) ( ji, glamt(ji,1), glamu(ji,1),   &
+            glamv(ji,1), glamf(ji,1),   &
+            e1t(ji,1), e1u(ji,1),   &
+            e1v(ji,1), ji = 1, jpi,10)
+9300     FORMAT( 1x, i4, f8.2,1x, f8.2,1x, f8.2,1x, f8.2, 1x,    &
+            f19.10, 1x, f19.10, 1x, f19.10 )
+
+         WRITE(numout,*)
+         WRITE(numout,*) '          latitude and e2 scale factors'
+         WRITE(numout,*) '          -----------------------------'
+         WRITE(numout,9300) ( jj, gphit(1,jj), gphiu(1,jj),   &
+            &                     gphiv(1,jj), gphif(1,jj),   &
+            &                     e2t  (1,jj), e2u  (1,jj),   &
+            &                     e2v  (1,jj), jj = 1, jpj, 10 )
+      ENDIF
+
+
+      IF( nprint == 1 .AND. lwp ) THEN
+         WRITE(numout,*) '          e1u e2u '
+         CALL prihre( e1u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
+         CALL prihre( e2u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
+         WRITE(numout,*) '          e1v e2v  '
+         CALL prihre( e1v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
+         CALL prihre( e2v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
+      ENDIF
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '              Reference z-coordinate depth and scale factors:'
+         WRITE(numout, "(9x,' level   gdept    gdepw     e3t      e3w  ')" )
+         WRITE(numout, "(10x, i4, 4f9.2)" ) ( jk, gdept_0(jk), gdepw_0(jk), e3t_0(jk), e3w_0(jk), jk = 1, jpk )
+      ENDIF
+
+      DO jk = 1, jpk
+         IF( e3w_0  (jk) <= 0._wp .OR. e3t_0  (jk) <= 0._wp )   CALL ctl_stop( ' e3w_0 or e3t_0 =< 0 ' )
+         IF( gdepw_0(jk) <  0._wp .OR. gdept_0(jk) <  0._wp )   CALL ctl_stop( ' gdepw_0 or gdept_0 < 0 ' )
+      END DO
+      !                                     ! ============================
+      !                                     !        close the files 
+      !                                     ! ============================
+      SELECT CASE ( nmsh )
+         CASE ( 1 )                
+            CALL iom_close( inum0 )
+         CASE ( 2 )
+            CALL iom_close( inum1 )
+            CALL iom_close( inum2 )
+         CASE ( 3 )
+            CALL iom_close( inum2 )
+            CALL iom_close( inum3 )
+            CALL iom_close( inum4 )
+      END SELECT
+      !
+   END SUBROUTINE dom_rea
+
+
+   SUBROUTINE zgr_bot_level
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE zgr_bot_level  ***
+      !!
+      !! ** Purpose :   defines the vertical index of ocean bottom (mbk. arrays)
+      !!
+      !! ** Method  :   computes from mbathy with a minimum value of 1 over land
+      !!
+      !! ** Action  : - update mbathy: level bathymetry (in level index)
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj   ! dummy loop indices
+      REAL(wp), DIMENSION(jpi,jpj) ::   zmbk   ! 2D workspace 
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '    zgr_bot_level : ocean bottom k-index of T-, U-, V- and W-levels '
+      IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~'
+      !
+      mbkt(:,:) = MAX( mbathy(:,:) , 1 )    ! bottom k-index of T-level (=1 over land)
+      !
+      DO jj = 1, jpjm1                      ! bottom k-index of u- (v-) level
+         DO ji = 1, jpim1
+            mbku(ji,jj) = MIN(  mbkt(ji+1,jj  ) , mbkt(ji,jj)  )
+            mbkv(ji,jj) = MIN(  mbkt(ji  ,jj+1) , mbkt(ji,jj)  )
+         END DO
+      END DO
+      ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 
+      zmbk(:,:) = REAL( mbku(:,:), wp )   ;   CALL lbc_lnk(zmbk,'U',1.)   ;   mbku  (:,:) = MAX( INT( zmbk(:,:) ), 1 )
+      zmbk(:,:) = REAL( mbkv(:,:), wp )   ;   CALL lbc_lnk(zmbk,'V',1.)   ;   mbkv  (:,:) = MAX( INT( zmbk(:,:) ), 1 )
+      !
+   END SUBROUTINE zgr_bot_level
+
+   !!======================================================================
+END MODULE domrea
Index: trunk/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90	(revision 2528)
@@ -2,6 +2,16 @@
    !!======================================================================
    !!                       ***  MODULE  dtadyn  ***
-   !! OFFLINE : interpolation of the physical fields
-   !!=====================================================================
+   !! Off-line : interpolation of the physical fields
+   !!======================================================================
+   !! History :   OPA  ! 1992-01 (M. Imbard) Original code
+   !!             8.0  ! 1998-04 (L.Bopp MA Foujols) slopes for isopyc. 
+   !!              -   ! 1998-05 (L. Bopp) read output of coupled run
+   !!             8.2  ! 2001-01 (M. Levy et M. Benjelloul) add netcdf FORMAT
+   !!   NEMO      1.0  ! 2005-03 (O. Aumont and A. El Moussaoui) F90
+   !!              -   ! 2005-12 (C. Ethe) Adapted for DEGINT
+   !!             3.0  ! 2007-06 (C. Ethe) use of iom module
+   !!              -   ! 2007-09  (C. Ethe)  add swap_dyn_data
+   !!             3.3  ! 2010-11 (C. Ethe) Full reorganization of the off-line: phasing with the on-line
+   !!----------------------------------------------------------------------
 
    !!----------------------------------------------------------------------
@@ -9,104 +19,77 @@
    !!   dta_dyn      : Interpolation of the fields
    !!----------------------------------------------------------------------
-   !! * Modules used
    USE oce             ! ocean dynamics and tracers variables
-   USE dom_oce         ! ocean space and time domain variables
-   USE zdf_oce         ! ocean vertical physics
+   USE c1d             ! 1D configuration: lk_c1d
+   USE dom_oce         ! ocean domain: variables
+   USE zdf_oce         ! ocean vertical physics: variables
+   USE sbc_oce         ! surface module: variables
+   USE phycst          ! physical constants
+   USE trabbl          ! active tracer: bottom boundary layer
+   USE ldfslp          ! lateral diffusion: iso-neutral slopes
+   USE ldfeiv          ! eddy induced velocity coef. 
+   USE ldftra_oce      ! ocean tracer   lateral physics
+   USE zdfmxl          ! vertical physics: mixed layer depth
+   USE eosbn2          ! equation of state - Brunt Vaisala frequency
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE zpshde          ! z-coord. with partial steps: horizontal derivatives
    USE in_out_manager  ! I/O manager
-   USE phycst          ! physical constants
-   USE sbc_oce
-   USE ldfslp
-   USE ldfeiv          ! eddy induced velocity coef.      (ldf_eiv routine)
-   USE ldftra_oce      ! ocean tracer   lateral physics
-   USE zdfmxl
-   USE trabbl
-   USE eosbn2
-   USE zdfddm          ! vertical  physics: double diffusion
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE zpshde
+   USE iom             ! I/O library
    USE lib_mpp         ! distributed memory computing library
+   USE prtctl          !  print control
 
    IMPLICIT NONE
    PRIVATE
 
-   !! *  Routine accessibility
-   PUBLIC dta_dyn_init   ! called by opa.F90
-   PUBLIC dta_dyn        ! called by step.F90
-
-   LOGICAL , PUBLIC :: &
-      lperdyn = .TRUE. , & ! boolean for periodic fields or not
-      lfirdyn = .TRUE.     ! boolean for the first call or not
-
-   INTEGER , PUBLIC :: &
-      ndtadyn = 73 ,  & ! Number of dat in one year
-      ndtatot = 73 ,  & ! Number of data in the input field
-      nsptint = 1 ,   & ! type of spatial interpolation
-      nficdyn = 2       ! number of dynamical fields 
-
-   CHARACTER(len=45)  ::  &
-      cfile_grid_T = 'dyna_grid_T.nc', &   !: name of the grid_T file
-      cfile_grid_U = 'dyna_grid_U.nc', &   !: name of the grid_U file
-      cfile_grid_V = 'dyna_grid_V.nc', &   !: name of the grid_V file
-      cfile_grid_W = 'dyna_grid_W.nc'      !: name of the grid_W file
+   PUBLIC   dta_dyn_init   ! called by opa.F90
+   PUBLIC   dta_dyn        ! called by step.F90
+
+   LOGICAL, PUBLIC ::   lperdyn = .TRUE.   !: boolean for periodic fields or not
+   LOGICAL, PUBLIC ::   lfirdyn = .TRUE.   !: boolean for the first call or not
+
+   INTEGER, PUBLIC ::   ndtadyn = 73       !: Number of dat in one year
+   INTEGER, PUBLIC ::   ndtatot = 73       !: Number of data in the input field
+   INTEGER, PUBLIC ::   nsptint = 1        !: type of spatial interpolation
+
+   CHARACTER(len=45) ::   cfile_grid_T = 'dyna_grid_T.nc'   ! name of the grid_T file
+   CHARACTER(len=45) ::   cfile_grid_U = 'dyna_grid_U.nc'   ! name of the grid_U file
+   CHARACTER(len=45) ::   cfile_grid_V = 'dyna_grid_V.nc'   ! name of the grid_V file
+   CHARACTER(len=45) ::   cfile_grid_W = 'dyna_grid_W.nc'   ! name of the grid_W file
    
-   REAL(wp)      ::   &
-      rnspdta  ,       &  !: number of time step per 2 consecutives data
-      rnspdta2            !: rnspdta * 0.5
-
-   INTEGER ::     &
-      ndyn1, ndyn2 , &
-      nlecoff = 0  , & ! switch for the first read
-      numfl_t, numfl_u, &
-      numfl_v, numfl_w
-
-   REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   &
-      tdta   ,   & ! temperature at two consecutive times
-      sdta   ,   & ! salinity at two consecutive times
-      udta   ,   & ! zonal velocity at two consecutive times
-      vdta   ,   & ! meridional velocity at two consecutive times
-      wdta   ,   & ! vertical velocity at two consecutive times
-#if defined key_trc_diatrd
-      hdivdta,   & ! horizontal divergence
-#endif
-      avtdta       ! vertical diffusivity coefficient
-
-   REAL(wp), DIMENSION(jpi,jpj,2) ::       &
-      hmlddta,   & ! mixed layer depth at two consecutive times
-      wspddta,   & ! wind speed at two consecutive times
-      frlddta,   & ! sea-ice fraction at two consecutive times
-      empdta ,   & ! E-P at two consecutive times
-      qsrdta       ! short wave heat flux at two consecutive times
-
+   REAL(wp) ::   rnspdta    ! number of time step per 2 consecutives data
+   REAL(wp) ::   rnspdta2   ! rnspdta * 0.5
+
+   INTEGER ::   ndyn1, ndyn2    !
+   INTEGER ::   nlecoff = 0     ! switch for the first read
+   INTEGER ::   numfl_t, numfl_u, numfl_v, numfl_w
+
+   REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: tdta       ! temperature at two consecutive times
+   REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: sdta       ! salinity at two consecutive times
+   REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: udta       ! zonal velocity at two consecutive times
+   REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: vdta       ! meridional velocity at two consecutive times
+   REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: wdta       ! vertical velocity at two consecutive times
+   REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: avtdta     ! vertical diffusivity coefficient
+
+   REAL(wp), DIMENSION(jpi,jpj    ,2) :: hmlddta    ! mixed layer depth at two consecutive times
+   REAL(wp), DIMENSION(jpi,jpj    ,2) :: wspddta    ! wind speed at two consecutive times
+   REAL(wp), DIMENSION(jpi,jpj    ,2) :: frlddta    ! sea-ice fraction at two consecutive times
+   REAL(wp), DIMENSION(jpi,jpj    ,2) :: empdta     ! E-P at two consecutive times
+   REAL(wp), DIMENSION(jpi,jpj    ,2) :: qsrdta     ! short wave heat flux at two consecutive times
+   REAL(wp), DIMENSION(jpi,jpj    ,2) :: bblxdta    ! frequency of bbl in the x direction at 2 consecutive times 
+   REAL(wp), DIMENSION(jpi,jpj    ,2) :: bblydta    ! frequency of bbl in the y direction at 2 consecutive times 
+   LOGICAL :: l_offbbl
 #if defined key_ldfslp
-   REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   &
-      uslpdta ,  & ! zonal isopycnal slopes
-      vslpdta ,  & ! meridional isopycnal slopes
-      wslpidta , & ! zonal diapycnal slopes
-      wslpjdta     ! meridional diapycnal slopes
-#endif
-
-#if ! defined key_off_degrad &&  defined key_traldf_c2d
-   REAL(wp), DIMENSION(jpi,jpj,2) ::   &
-      ahtwdta      ! Lateral diffusivity
-# if defined key_trcldf_eiv 
-   REAL(wp), DIMENSION(jpi,jpj,2) ::   &
-      aeiwdta      ! G&M coefficient
+   REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: uslpdta    ! zonal isopycnal slopes
+   REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: vslpdta    ! meridional isopycnal slopes
+   REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: wslpidta   ! zonal diapycnal slopes
+   REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: wslpjdta   ! meridional diapycnal slopes
+#endif
+#if ! defined key_degrad &&  defined key_traldf_c2d && defined key_traldf_eiv 
+   REAL(wp), DIMENSION(jpi,jpj    ,2) :: aeiwdta    ! G&M coefficient
+#endif
+#if defined key_degrad
+   REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: ahtudta, ahtvdta, ahtwdta   ! Lateral diffusivity
+# if defined key_traldf_eiv
+   REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: aeiudta, aeivdta, aeiwdta   ! G&M coefficient
 # endif
-#endif
-
-#if defined key_off_degrad
-   REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   &
-      ahtudta, ahtvdta, ahtwdta  !  Lateral diffusivity
-# if defined key_trcldf_eiv
-   REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   &
-      aeiudta, aeivdta, aeiwdta  ! G&M coefficient
-# endif
-
-#endif
-
-#if defined key_trcbbl_dif   ||   defined key_trcbbl_adv
-   REAL(wp), DIMENSION(jpi,jpj,2) ::       &
-      bblxdta ,  & ! frequency of bbl in the x direction at 2 consecutive times
-      bblydta      ! frequency of bbl in the y direction at 2 consecutive times
 #endif
 
@@ -115,9 +98,8 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL  (2005)
-   !!   $Id$
-   !!   This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
+   !! NEMO/OFF 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -126,51 +108,23 @@
       !!                  ***  ROUTINE dta_dyn  ***
       !!
-      !! ** Purpose : Prepares dynamics and physics fields from an 
-      !!              OPA9 simulation  for an off-line simulation
-      !!               for passive tracer
+      !! ** Purpose :   Prepares dynamics and physics fields from an NEMO run
+      !!              for an off-line simulation of passive tracers
       !!
       !! ** Method : calculates the position of DATA to read READ DATA 
       !!             (example month changement) computes slopes IF needed
       !!             interpolates DATA IF needed
-      !!
-      !! ** History :
-      !!   ! original  : 92-01 (M. Imbard: sub domain)
-      !!   ! addition  : 98-04 (L.Bopp MA Foujols: slopes for isopyc.) 
-      !!   ! addition  : 98-05 (L. Bopp read output of coupled run)
-      !!   ! addition  : 05-03 (O. Aumont and A. El Moussaoui) F90
-      !!   ! addition  : 05-12 (C. Ethe) Adapted for DEGINT
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      INTEGER, INTENT( in ) ::   kt       ! ocean time-step index
-
-      !! * Local declarations
-      INTEGER ::   iper, iperm1, iswap, izt   
-
-      REAL(wp) :: zpdtan, zpdtpe, zdemi, zt
-      REAL(wp) :: zweigh
-
-      ! 0. Initialization
-      ! -----------------
-
-      IF( lfirdyn ) THEN
-         ! first time step MUST BE nit000
-         IF( kt /= nit000 ) THEN
-            IF (lwp) THEN 
-               WRITE (numout,*) ' kt MUST BE EQUAL to nit000. kt = ',kt ,' nit000 = ',nit000 
-              STOP 'dtadyn'
-            ENDIF
-          ENDIF 
-          ! Initialize the parameters of the interpolation
-          CALL dta_dyn_init
-      ENDIF
-
-      zt       = ( FLOAT (kt) + rnspdta2 ) / rnspdta
-      izt      = INT( zt )
-      zweigh   = zt - FLOAT( INT(zt) )
-
-      IF( lperdyn ) THEN
-         iperm1 = MOD( izt, ndtadyn )
-      ELSE
-         iperm1 = MOD( izt, ndtatot - 1 ) + 1
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !!
+      INTEGER  ::   iper, iperm1, iswap, izt   ! local integers 
+      REAL(wp) ::   zt, zweigh                 ! local scalars
+      !!----------------------------------------------------------------------
+
+      zt     = ( REAL(kt,wp) + rnspdta2 ) / rnspdta
+      izt    = INT( zt )
+      zweigh = zt - REAL( INT(zt), wp )
+
+      IF( lperdyn ) THEN   ;   iperm1 = MOD( izt, ndtadyn )
+      ELSE                 ;   iperm1 = MOD( izt, ndtatot - 1 ) + 1
       ENDIF
 
@@ -181,7 +135,6 @@
           ELSE 
               IF( lfirdyn ) THEN 
-                  IF (lwp) WRITE (numout,*) & 
-                      &   ' dynamic file is not periodic with or without interpolation  &
-                      &   we take the first value for the previous period iperm1 = 0  '
+                  IF(lwp) WRITE (numout,*) 'dta_dyn:  dynamic file is not periodic with or without interpolation    &
+                     &                                we take the first value for the previous period iperm1 = 0  '
               END IF
           END IF 
@@ -194,73 +147,60 @@
 
       IF( lfirdyn ) THEN
-         ! store the information of the period read
-         ndyn1 = iperm1
+         ndyn1 = iperm1         ! store the information of the period read
          ndyn2 = iper
          
-         IF (lwp) THEN
-            WRITE (numout,*) ' dynamics data read for the period ndyn1 =',ndyn1, &
-               &             ' and for the period ndyn2 = ',ndyn2
+         IF(lwp) THEN
+            WRITE (numout,*) ' dynamics data read for the period ndyn1 =', ndyn1,   &
+               &             ' and for the period ndyn2 = ', ndyn2
             WRITE (numout,*) ' time step is : ', kt
-            WRITE (numout,*) ' we have ndtadyn = ',ndtadyn,' records in the dynamic file for one year'
+            WRITE (numout,*) ' we have ndtadyn = ', ndtadyn, ' records in the dynamic file for one year'
          END IF
          !
-         IF( iperm1 /= 0 ) THEN         ! data read for the iperm1 period
-            CALL dynrea( kt, iperm1 ) 
-         ELSE 
-            CALL dynrea( kt, 1 )
-         ENDIF
+         CALL dynrea( kt, MAX( 1, iperm1) )           ! data read for the iperm1 period
          
-#if defined key_ldfslp
-         ! Computes slopes
-         ! Caution : here tn, sn and avt are used as workspace
-         tn (:,:,:) = tdta  (:,:,:,2)
-         sn (:,:,:) = sdta  (:,:,:,2)
-         avt(:,:,:) = avtdta(:,:,:,2)
+         IF( lk_ldfslp .AND. .NOT. lk_c1d ) THEN      ! Computes slopes (here tsn and avt are used as workspace)
+            tsn (:,:,:,jp_tem) = tdta  (:,:,:,2)
+            tsn (:,:,:,jp_sal) = sdta  (:,:,:,2)
+            avt(:,:,:)         = avtdta(:,:,:,2)
          
-         CALL eos( tn, sn, rhd, rhop )   ! Time-filtered in situ density 
-         CALL bn2( tn, sn, rn2 )         ! before Brunt-Vaisala frequency
-         IF( ln_zps )   &
-            &   CALL zps_hde( kt, tn , sn , rhd,  &  ! Partial steps: before Horizontal DErivative
-            &                 gtu, gsu, gru,  &  ! of t, s, rd at the bottom ocean level
-            &                 gtv, gsv, grv )
-         CALL zdf_mxl( kt )              ! mixed layer depth
-         CALL ldf_slp( kt, rhd, rn2 )
+            CALL eos( tsn, rhd, rhop )   ! Time-filtered in situ density 
+            CALL bn2( tsn, rn2 )         ! before Brunt-Vaisala frequency
+            IF( ln_zps )   &
+               &   CALL zps_hde( kt, jpts, tsn, gtsu, gtsv,  &  ! Partial steps: before Horizontal DErivative
+               &                           rhd, gru , grv   )    ! of t, s, rd at the bottom ocean level
+            CALL zdf_mxl( kt )           ! mixed layer depth
+            CALL ldf_slp( kt, rhd, rn2 )
          
-         uslpdta (:,:,:,2) = uslp (:,:,:)
-         vslpdta (:,:,:,2) = vslp (:,:,:)
-         wslpidta(:,:,:,2) = wslpi(:,:,:)
-         wslpjdta(:,:,:,2) = wslpj(:,:,:)
-#endif
-         
-         ! swap from record 2 to 1
-         CALL swap_dyn_data
-         
+            uslpdta (:,:,:,2) = uslp (:,:,:)
+            vslpdta (:,:,:,2) = vslp (:,:,:)
+            wslpidta(:,:,:,2) = wslpi(:,:,:)
+            wslpjdta(:,:,:,2) = wslpj(:,:,:)
+         END IF
+         !
+         CALL swap_dyn_data            ! swap from record 2 to 1
+         !
          iswap = 1        !  indicates swap
-         
-         CALL dynrea( kt, iper )    ! data read for the iper period
-         
-#if defined key_ldfslp
-         ! Computes slopes
-         ! Caution : here tn, sn and avt are used as workspace
-         tn (:,:,:) = tdta  (:,:,:,2)
-         sn (:,:,:) = sdta  (:,:,:,2)
-         avt(:,:,:) = avtdta(:,:,:,2)
-         
-         CALL eos( tn, sn, rhd, rhop )   ! Time-filtered in situ density 
-         CALL bn2( tn, sn, rn2 )         ! before Brunt-Vaisala frequency
-         IF( ln_zps )   &
-            &   CALL zps_hde( kt, tn , sn , rhd,  &  ! Partial steps: before Horizontal DErivative
-            &                 gtu, gsu, gru,  &  ! of t, s, rd at the bottom ocean level
-            &                 gtv, gsv, grv )
-         CALL zdf_mxl( kt )              ! mixed layer depth
-         CALL ldf_slp( kt, rhd, rn2 )
-         
-         uslpdta (:,:,:,2) = uslp (:,:,:)
-         vslpdta (:,:,:,2) = vslp (:,:,:)
-         wslpidta(:,:,:,2) = wslpi(:,:,:)
-         wslpjdta(:,:,:,2) = wslpj(:,:,:)
-#endif
-         !
-         lfirdyn=.FALSE.    ! trace the first call
+         !
+         CALL dynrea( kt, iper )       ! data read for the iper period
+         !
+         IF( lk_ldfslp .AND. .NOT. lk_c1d ) THEN      ! Computes slopes (here tsn and avt are used as workspace)
+            tsn (:,:,:,jp_tem) = tdta  (:,:,:,2)
+            tsn (:,:,:,jp_sal) = sdta  (:,:,:,2)
+            avt(:,:,:)         = avtdta(:,:,:,2)
+            !
+                           CALL eos( tsn, rhd, rhop )                   ! now in situ density 
+                           CALL bn2( tsn, rn2 )                         ! now Brunt-Vaisala frequency
+            IF( ln_zps )   CALL zps_hde( kt, jpts, tsn, gtsu, gtsv,  &  ! Partial steps: before Horizontal DErivative
+               &                                   rhd, gru , grv   )   ! of t, s, rd at the bottom ocean level
+                           CALL zdf_mxl( kt )                           ! mixed layer depth
+                           CALL ldf_slp( kt, rhd, rn2 )                 ! slope of iso-neutral surfaces
+            !
+            uslpdta (:,:,:,2) = uslp (:,:,:)
+            vslpdta (:,:,:,2) = vslp (:,:,:)
+            wslpidta(:,:,:,2) = wslpi(:,:,:)
+            wslpjdta(:,:,:,2) = wslpj(:,:,:)
+         END IF
+         !
+         lfirdyn = .FALSE.    ! trace the first call
       ENDIF
       !
@@ -269,7 +209,7 @@
       !
       IF( iperm1 /= ndyn1 ) THEN 
-
-         IF( iperm1 == 0. ) THEN
-            IF (lwp) THEN
+         !
+         IF( iperm1 == 0 ) THEN
+            IF(lwp) THEN
                WRITE (numout,*) ' dynamic file is not periodic with periodic interpolation'
                WRITE (numout,*) ' we take the last value for the last period '
@@ -280,41 +220,35 @@
          ENDIF
          !
-         ! We have to prepare a new read of data : swap from record 2 to 1
-         !
-         CALL swap_dyn_data
-
-         iswap = 1        !  indicates swap
-         
+         CALL swap_dyn_data         ! We have to prepare a new read of data : swap from record 2 to 1
+         !
+         iswap = 1                  !  indicates swap
+         !
          CALL dynrea( kt, iper )    ! data read for the iper period
-
-#if defined key_ldfslp
-         ! Computes slopes
-         ! Caution : here tn, sn and avt are used as workspace
-         tn (:,:,:) = tdta  (:,:,:,2)
-         sn (:,:,:) = sdta  (:,:,:,2)
-         avt(:,:,:) = avtdta(:,:,:,2)
-         
-         CALL eos( tn, sn, rhd, rhop )   ! Time-filtered in situ density 
-         CALL bn2( tn, sn, rn2 )         ! before Brunt-Vaisala frequency
-         IF( ln_zps )   &
-            &   CALL zps_hde( kt, tn , sn , rhd,  &  ! Partial steps: before Horizontal DErivative
-            &                 gtu, gsu, gru,  &  ! of t, s, rd at the bottom ocean level
-            &                 gtv, gsv, grv )
-         CALL zdf_mxl( kt )              ! mixed layer depth
-         CALL ldf_slp( kt, rhd, rn2 )
-         
-         uslpdta (:,:,:,2) = uslp (:,:,:)
-         vslpdta (:,:,:,2) = vslp (:,:,:)
-         wslpidta(:,:,:,2) = wslpi(:,:,:)
-         wslpjdta(:,:,:,2) = wslpj(:,:,:)
-#endif
-       
-         ! store the information of the period read
-         ndyn1 = ndyn2
+         !
+         IF( lk_ldfslp .AND. .NOT. lk_c1d ) THEN
+            ! Computes slopes. Caution : here tsn and avt are used as workspace
+            tsn(:,:,:,jp_tem) = tdta  (:,:,:,2)
+            tsn(:,:,:,jp_sal) = sdta  (:,:,:,2)
+            avt(:,:,:)        = avtdta(:,:,:,2)
+            !
+                           CALL eos( tsn, rhd, rhop )                   ! now in situ density 
+                           CALL bn2( tsn, rn2 )                         ! now Brunt-Vaisala frequency
+            IF( ln_zps )   CALL zps_hde( kt, jpts, tsn, gtsu, gtsv,  &  ! Partial steps: before Horizontal DErivative
+               &                                   rhd, gru , grv   )   ! of t, s, rd at the bottom ocean level
+            CALL zdf_mxl( kt )                                          ! mixed layer depth
+            CALL ldf_slp( kt, rhd, rn2 )                                ! slope of iso-neutral surfaces
+            !
+            uslpdta (:,:,:,2) = uslp (:,:,:)
+            vslpdta (:,:,:,2) = vslp (:,:,:)
+            wslpidta(:,:,:,2) = wslpi(:,:,:)
+            wslpjdta(:,:,:,2) = wslpj(:,:,:)
+         END IF
+         !
+         ndyn1 = ndyn2         ! store the information of the period read
          ndyn2 = iper
-
-         IF (lwp) THEN
-            WRITE (numout,*) ' dynamics data read for the period ndyn1 =',ndyn1, &
-               &             ' and for the period ndyn2 = ',ndyn2
+         !
+         IF(lwp) THEN
+            WRITE (numout,*) ' dynamics data read for the period ndyn1 =', ndyn1,   &
+               &             ' and for the period ndyn2 = ', ndyn2
             WRITE (numout,*) ' time step is : ', kt
          END IF
@@ -325,26 +259,41 @@
       !----------------------------------------     
 
-      IF( nsptint == 0 ) THEN   
-         ! No spatial interpolation, data are probably correct
-         ! We have to initialize data if we have changed the period         
-         CALL assign_dyn_data          
-      ELSE IF( nsptint == 1 ) THEN
-         ! linear interpolation
+      IF( nsptint == 0 ) THEN          ! No space interpolation, data are probably correct
+         !                             ! We have to initialize data if we have changed the period         
+         CALL assign_dyn_data
+      ELSEIF( nsptint == 1 ) THEN      ! linear interpolation
          CALL linear_interp_dyn_data( zweigh )
-      ELSE 
-         ! other interpolation
+      ELSE                             ! other interpolation
          WRITE (numout,*) ' this kind of interpolation do not exist at the moment : we stop'
          STOP 'dtadyn'         
       END IF
-      
-      ! In any case, we need rhop
-      CALL eos( tn, sn, rhd, rhop ) 
-      
-#if ! defined key_off_degrad && defined key_traldf_c2d
-      ! In case of 2D varying coefficients, we need aeiv and aeiu
-      IF( lk_traldf_eiv )   CALL ldf_eiv( kt )      ! eddy induced velocity coefficient
-#endif
-   
+      !
+      CALL eos( tsn, rhd, rhop )       ! In any case, we need rhop
+      !
+#if ! defined key_degrad && defined key_traldf_c2d
+      !                                ! In case of 2D varying coefficients, we need aeiv and aeiu
+      IF( lk_traldf_eiv )   CALL dta_eiv( kt )      ! eddy induced velocity coefficient
+#endif
+      !
+      IF( .NOT. l_offbbl ) THEN       ! Compute bbl coefficients if needed
+         tsb(:,:,:,:) = tsn(:,:,:,:)
+         CALL bbl( kt, 'TRC')
+      END IF
+      IF(ln_ctl) THEN
+         CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' tn      - : ', mask1=tmask, ovlap=1, kdim=jpk   )
+         CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_sal), clinfo1=' sn      - : ', mask1=tmask, ovlap=1, kdim=jpk   )
+         CALL prt_ctl(tab3d_1=un               , clinfo1=' un      - : ', mask1=tmask, ovlap=1, kdim=jpk   )
+         CALL prt_ctl(tab3d_1=vn               , clinfo1=' vn      - : ', mask1=tmask, ovlap=1, kdim=jpk   )
+         CALL prt_ctl(tab3d_1=wn               , clinfo1=' wn      - : ', mask1=tmask, ovlap=1, kdim=jpk   )
+         CALL prt_ctl(tab3d_1=avt              , clinfo1=' kz      - : ', mask1=tmask, ovlap=1, kdim=jpk   )
+         CALL prt_ctl(tab2d_1=fr_i             , clinfo1=' fr_i    - : ', mask1=tmask, ovlap=1 )
+         CALL prt_ctl(tab2d_1=hmld             , clinfo1=' hmld    - : ', mask1=tmask, ovlap=1 )
+         CALL prt_ctl(tab2d_1=emps             , clinfo1=' emps    - : ', mask1=tmask, ovlap=1 )
+         CALL prt_ctl(tab2d_1=wndm             , clinfo1=' wspd    - : ', mask1=tmask, ovlap=1 )
+         CALL prt_ctl(tab2d_1=qsr              , clinfo1=' qsr     - : ', mask1=tmask, ovlap=1 )
+      ENDIF
+      !
    END SUBROUTINE dta_dyn
+
 
    SUBROUTINE dynrea( kt, kenr )
@@ -354,48 +303,24 @@
       !! ** Purpose : READ dynamics fiels from OPA9 netcdf output
       !! 
-      !! ** Method : READ the kenr records of DATA and store in
-      !!             in udta(...,2), ....  
-      !! 
-      !! ** History : additions : M. Levy et M. Benjelloul jan 2001 
-      !!              (netcdf FORMAT) 
-      !!              05-03 (O. Aumont and A. El Moussaoui) F90
-      !!              06-07 : (C. Ethe) use of iom module
-      !!----------------------------------------------------------------------
-      !! * Modules used
-      USE iom
-
-      !! * Arguments
-      INTEGER, INTENT( in ) ::   kt, kenr       ! time index
-      !! * Local declarations
+      !! ** Method : READ the kenr records of DATA and store in udta(...,2), ....  
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt, kenr   ! time index
+      !!
       INTEGER ::  jkenr
-
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
-        zu, zv, zw, zt, zs, zavt ,   &     ! 3-D dynamical fields
-        zhdiv                              ! horizontal divergence
-
-      REAL(wp), DIMENSION(jpi,jpj) :: &
-         zemp, zqsr, zmld, zice, zwspd, &
-         ztaux, ztauy
-#if defined key_trcbbl_dif   ||   defined key_trcbbl_adv
-      REAL(wp), DIMENSION(jpi,jpj) :: zbblx, zbbly
-#endif
-
-#if ! defined key_off_degrad && defined key_traldf_c2d
-      REAL(wp), DIMENSION(jpi,jpj) :: zahtw 
-#   if defined key_trcldf_eiv
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zu, zv, zw, zt, zs, zavt , zhdiv              ! 3D workspace
+      REAL(wp), DIMENSION(jpi,jpj)     ::  zemp, zqsr, zmld, zice, zwspd, ztaux, ztauy   ! 2D workspace
+      REAL(wp), DIMENSION(jpi,jpj)     ::  zbblx, zbbly
+
+#if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv
       REAL(wp), DIMENSION(jpi,jpj) :: zaeiw 
-#  endif
-#endif
-
-#if defined key_off_degrad
-   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
-      zahtu, zahtv, zahtw  !  Lateral diffusivity
-# if defined key_trcldf_eiv
-   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
-      zaeiu, zaeiv, zaeiw  ! G&M coefficient
+#endif
+#if defined key_degrad
+   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zahtu, zahtv, zahtw  !  Lateral diffusivity
+# if defined key_traldf_eiv
+   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zaeiu, zaeiv, zaeiw  ! G&M coefficient
 # endif
 #endif
-
-      !---------------------------------------------------------------
+      !!----------------------------------------------------------------------
+
       ! 0. Initialization
       
@@ -407,7 +332,7 @@
       IF(lwp) THEN
          WRITE(numout,*)
-         WRITE(numout,*) 'Dynrea : reading dynamical fields, kenr = ', jkenr
-         WRITE(numout,*) ' ~~~~~~~'
-#if defined key_off_degrad
+         WRITE(numout,*) 'Dynrea : read dynamical fields, kenr = ', jkenr
+         WRITE(numout,*) '~~~~~~~'
+#if defined key_degrad
          WRITE(numout,*) ' Degraded fields'
 #endif
@@ -442,14 +367,12 @@
       CALL iom_get( numfl_u, jpdom_data, 'vozocrtx', zu   (:,:,:), jkenr )
       CALL iom_get( numfl_v, jpdom_data, 'vomecrty', zv   (:,:,:), jkenr )
-
-#if defined key_trcbbl_dif || defined key_trcbbl_adv
-      IF( iom_varid( numfl_u, 'sobblcox', ldstop = .FALSE. ) > 0  .AND. &
-      &   iom_varid( numfl_v, 'sobblcoy', ldstop = .FALSE. ) > 0 ) THEN
-         CALL iom_get( numfl_u, jpdom_data, 'sobblcox', zbblx(:,:), jkenr )
-         CALL iom_get( numfl_v, jpdom_data, 'sobblcoy', zbbly(:,:), jkenr )
-      ELSE
-         CALL bbl_sign( zt, zs, zbblx, zbbly )    
-      ENDIF
-#endif
+      IF( lk_trabbl .AND. .NOT. lk_c1d .AND. nn_bbl_ldf == 1 ) THEN
+         IF( iom_varid( numfl_u, 'sobblcox', ldstop = .FALSE. ) > 0  .AND. &
+         &   iom_varid( numfl_v, 'sobblcoy', ldstop = .FALSE. ) > 0 ) THEN
+             CALL iom_get( numfl_u, jpdom_data, 'sobblcox', zbblx(:,:), jkenr )
+             CALL iom_get( numfl_v, jpdom_data, 'sobblcoy', zbbly(:,:), jkenr )
+             l_offbbl = .TRUE.
+         ENDIF
+      ENDIF
 
       ! file grid-W
@@ -458,22 +381,19 @@
       CALL wzv( zu, zv, zw, zhdiv )
 
-# if defined key_zdfddm
-      CALL iom_get( numfl_w, jpdom_data, 'voddmavs', zavt (:,:,:), jkenr )
-#else
-      CALL iom_get( numfl_w, jpdom_data, 'votkeavt', zavt (:,:,:), jkenr )
-#endif 
-
-#if ! defined key_off_degrad && defined key_traldf_c2d
-      CALL iom_get( numfl_w, jpdom_data, 'soleahtw', zahtw (:,: ), jkenr )
-#  if   defined key_trcldf_eiv 
+      IF( iom_varid( numfl_w, 'voddmavs', ldstop = .FALSE. ) > 0 ) THEN          ! avs exist: it is used
+         CALL iom_get( numfl_w, jpdom_data, 'voddmavs', zavt (:,:,:), jkenr )
+      ELSE                                                                       ! no avs: use avt
+         CALL iom_get( numfl_w, jpdom_data, 'votkeavt', zavt (:,:,:), jkenr )
+      ENDIF
+
+#if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv 
       CALL iom_get( numfl_w, jpdom_data, 'soleaeiw', zaeiw (:,: ), jkenr )
-#  endif
-#endif
-
-#if defined key_off_degrad
+#endif
+
+#if defined key_degrad
       CALL iom_get( numfl_u, jpdom_data, 'vozoahtu', zahtu(:,:,:), jkenr )
       CALL iom_get( numfl_v, jpdom_data, 'vomeahtv', zahtv(:,:,:), jkenr )
       CALL iom_get( numfl_w, jpdom_data, 'voveahtw', zahtw(:,:,:), jkenr )
-#  if defined key_trcldf_eiv
+#  if defined key_traldf_eiv
       CALL iom_get( numfl_u, jpdom_data, 'vozoaeiu', zaeiu(:,:,:), jkenr )
       CALL iom_get( numfl_v, jpdom_data, 'vomeaeiv', zaeiv(:,:,:), jkenr )
@@ -486,24 +406,17 @@
       wdta(:,:,:,2) = zw(:,:,:) * tmask(:,:,:)
 
-#if defined key_trc_diatrd
-      hdivdta(:,:,:,2) = zhdiv(:,:,:) * tmask(:,:,:)
-#endif
-
       tdta(:,:,:,2)   = zt  (:,:,:) * tmask(:,:,:)
       sdta(:,:,:,2)   = zs  (:,:,:) * tmask(:,:,:)
       avtdta(:,:,:,2) = zavt(:,:,:) * tmask(:,:,:)
 
-#if ! defined key_off_degrad && defined key_traldf_c2d
-      ahtwdta(:,:,2)  = zahtw(:,:) * tmask(:,:,1)
-#if defined key_trcldf_eiv
+#if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv
       aeiwdta(:,:,2)  = zaeiw(:,:) * tmask(:,:,1)
 #endif
-#endif
-
-#if defined key_off_degrad
+
+#if defined key_degrad
         ahtudta(:,:,:,2) = zahtu(:,:,:) * umask(:,:,:)
         ahtvdta(:,:,:,2) = zahtv(:,:,:) * vmask(:,:,:)
         ahtwdta(:,:,:,2) = zahtw(:,:,:) * tmask(:,:,:)
-#  if defined key_trcldf_eiv
+#  if defined key_traldf_eiv
         aeiudta(:,:,:,2) = zaeiu(:,:,:) * umask(:,:,:)
         aeivdta(:,:,:,2) = zaeiv(:,:,:) * vmask(:,:,:)
@@ -519,13 +432,12 @@
       qsrdta (:,:,2)  = zqsr(:,:) * tmask(:,:,1)
       hmlddta(:,:,2)  = zmld(:,:) * tmask(:,:,1)
-      
-#if defined key_trcbbl_dif   ||   defined key_trcbbl_adv
-      bblxdta(:,:,2) = MAX( 0., zbblx(:,:) )
-      bblydta(:,:,2) = MAX( 0., zbbly(:,:) )
-
-      WHERE( bblxdta(:,:,2) > 2. ) bblxdta(:,:,2) = 0.
-      WHERE( bblydta(:,:,2) > 2. ) bblydta(:,:,2) = 0.
-#endif
-
+
+      IF( l_offbbl ) THEN 
+         bblxdta(:,:,2) = MAX( 0., zbblx(:,:) )
+         bblydta(:,:,2) = MAX( 0., zbbly(:,:) )
+         WHERE( bblxdta(:,:,2) > 2. ) bblxdta(:,:,2) = 0.
+         WHERE( bblydta(:,:,2) > 2. ) bblydta(:,:,2) = 0.
+      ENDIF
+      
       IF( kt == nitend ) THEN
          CALL iom_close ( numfl_t )
@@ -534,7 +446,8 @@
          CALL iom_close ( numfl_w )
       ENDIF
-      
+      !      
    END SUBROUTINE dynrea
 
+
    SUBROUTINE dta_dyn_init
       !!----------------------------------------------------------------------
@@ -544,18 +457,8 @@
       !!
       !! ** Method :
-      !!
-      !! History :
-      !!    ! original  : 92-01 (M. Imbard: sub domain)
-      !!    ! 98-04 (L.Bopp MA Foujols: slopes for isopyc.)
-      !!    ! 98-05 (L. Bopp read output of coupled run)
-      !!    ! 05-03 (O. Aumont and A. El Moussaoui) F90
-      !!----------------------------------------------------------------------
-      !! * Modules used
-
-      !! * Local declarations
-
+      !!----------------------------------------------------------------------
       REAL(wp) ::   znspyr   !: number of time step per year
-
-      NAMELIST/namdyn/ ndtadyn, ndtatot, nsptint, nficdyn, lperdyn,  &
+      !!
+      NAMELIST/namdyn/ ndtadyn, ndtatot, nsptint, lperdyn,  &
       &                cfile_grid_T, cfile_grid_U, cfile_grid_V, cfile_grid_W
       !!----------------------------------------------------------------------
@@ -564,9 +467,8 @@
       ! ======================================
 
-      ! Read Namelist namdyn : Lateral physics on tracers
-      REWIND( numnam )
+      REWIND( numnam )              ! Read Namelist namdyn : Lateral physics on tracers
       READ  ( numnam, namdyn )
 
-      IF(lwp) THEN
+      IF(lwp) THEN                  ! control print
          WRITE(numout,*)
          WRITE(numout,*) 'namdyn : offline dynamical selection'
@@ -577,5 +479,4 @@
          WRITE(numout,*) ' total number of elements in the FILE       ndtatot = ' , ndtatot
          WRITE(numout,*) ' type of interpolation                      nsptint = ' , nsptint
-         WRITE(numout,*) ' number of dynamics FILE                    nficdyn = ' , nficdyn
          WRITE(numout,*) ' loop on the same FILE                      lperdyn = ' , lperdyn
          WRITE(numout,*) '  '
@@ -586,11 +487,14 @@
          WRITE(numout,*) ' '
       ENDIF
-
+      !
       znspyr   = nyear_len(1) * rday / rdt  
       rnspdta  = znspyr / FLOAT( ndtadyn )
       rnspdta2 = rnspdta * 0.5 
-
+      !
+      CALL dta_dyn( nit000 )
+      !
    END SUBROUTINE dta_dyn_init
 
+
    SUBROUTINE wzv( pu, pv, pw, phdiv )
       !!----------------------------------------------------------------------
@@ -599,29 +503,20 @@
       !! ** Purpose :   Compute the now vertical velocity after the array swap
       !!
-      !! ** Method  :
-      !! ** Method  : - Divergence:
-      !!      - compute the now divergence given by :
-      !!         * z-coordinate
+      !! ** Method  : - compute the now divergence given by :
+      !!         * z-coordinate ONLY !!!!
       !!         hdiv = 1/(e1t*e2t) [ di(e2u  u) + dj(e1v  v) ]
       !!     - Using the incompressibility hypothesis, the vertical
       !!      velocity is computed by integrating the horizontal divergence
       !!      from the bottom to the surface.
-      !!        The boundary conditions are w=0 at the bottom (no flux) and,
-      !!      in regid-lid case, w=0 at the sea surface.
-      !!
-      !!
-      !! History :
-      !!   9.0  !  02-07  (G. Madec)  Vector optimization
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in  )   :: pu, pv    !:  horizontal velocities
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out )   :: pw        !:  verticla velocity
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) :: phdiv     !:  horizontal divergence
-
-      !! * Local declarations
+      !!        The boundary conditions are w=0 at the bottom (no flux).
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) :: pu, pv    !:  horizontal velocities
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) :: pw        !:  verticla velocity
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: phdiv     !:  horizontal divergence
+      !!
       INTEGER  ::  ji, jj, jk
       REAL(wp) ::  zu, zu1, zv, zv1, zet
-
-
+      !!----------------------------------------------------------------------
+      !
       ! Computation of vertical velocity using horizontal divergence
       phdiv(:,:,:) = 0.
@@ -629,11 +524,4 @@
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
-#if defined key_zco
-               zu  = pu(ji  ,jj  ,jk) * umask(ji  ,jj  ,jk) * e2u(ji  ,jj  )
-               zu1 = pu(ji-1,jj  ,jk) * umask(ji-1,jj  ,jk) * e2u(ji-1,jj  )
-               zv  = pv(ji  ,jj  ,jk) * vmask(ji  ,jj  ,jk) * e1v(ji  ,jj  )
-               zv1 = pv(ji  ,jj-1,jk) * vmask(ji  ,jj-1,jk) * e1v(ji  ,jj-1)
-               zet = 1. / ( e1t(ji,jj) * e2t(ji,jj) )
-#else
                zu  = pu(ji  ,jj  ,jk) * umask(ji  ,jj  ,jk) * e2u(ji  ,jj  ) * fse3u(ji  ,jj  ,jk)
                zu1 = pu(ji-1,jj  ,jk) * umask(ji-1,jj  ,jk) * e2u(ji-1,jj  ) * fse3u(ji-1,jj  ,jk)
@@ -641,21 +529,51 @@
                zv1 = pv(ji  ,jj-1,jk) * vmask(ji  ,jj-1,jk) * e1v(ji  ,jj-1) * fse3v(ji  ,jj-1,jk)
                zet = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-#endif
                phdiv(ji,jj,jk) = ( zu - zu1 + zv - zv1 ) * zet 
             END DO
          END DO
-      ENDDO
-
-      ! Lateral boundary conditions on phdiv
-      CALL lbc_lnk( phdiv, 'T', 1. )
-
-
+      END DO
+      CALL lbc_lnk( phdiv, 'T', 1. )      ! Lateral boundary conditions on phdiv
+      !
       ! computation of vertical velocity from the bottom
-      pw(:,:,jpk) = 0.
+      pw(:,:,jpk) = 0._wp
       DO jk = jpkm1, 1, -1
          pw(:,:,jk) = pw(:,:,jk+1) - fse3t(:,:,jk) * phdiv(:,:,jk)
       END DO
-
+      !
    END SUBROUTINE wzv
+
+
+   SUBROUTINE dta_eiv( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dta_eiv  ***
+      !!
+      !! ** Purpose :   Compute the eddy induced velocity coefficient from the
+      !!      growth rate of baroclinic instability.
+      !!
+      !! ** Method : Specific to the offline model. Computes the horizontal
+      !!             values from the vertical value
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt     ! ocean time-step inedx
+      !!
+      INTEGER ::   ji, jj           ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dta_eiv : eddy induced velocity coefficients'
+         IF(lwp) WRITE(numout,*) '~~~~~~~'
+      ENDIF
+      !
+      ! Average the diffusive coefficient at u- v- points
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            aeiu(ji,jj) = .5 * ( aeiw(ji,jj) + aeiw(ji+1,jj  ) )
+            aeiv(ji,jj) = .5 * ( aeiw(ji,jj) + aeiw(ji  ,jj+1) )
+         END DO
+      END DO
+      CALL lbc_lnk( aeiu, 'U', 1. )   ;   CALL lbc_lnk( aeiv, 'V', 1. )    ! lateral boundary condition
+      !
+   END SUBROUTINE dta_eiv
+
 
    SUBROUTINE tau2wnd( ptaux, ptauy, pwspd )
@@ -667,13 +585,11 @@
       !! ** Method  : |tau|=rhoa*Cd*|U|^2
       !!---------------------------------------------------------------------
-      !! * Arguments
-      REAL(wp), DIMENSION(jpi,jpj), INTENT( in  ) ::  &
-         ptaux, ptauy                              !: wind stress in i-j direction resp.
-      REAL(wp), DIMENSION(jpi,jpj), INTENT( out ) ::  &
-         pwspd                                     !: wind speed 
-      REAL(wp) ::   zrhoa  = 1.22         ! Air density kg/m3
-      REAL(wp) ::   zcdrag = 1.5e-3       ! drag coefficient
-      REAL(wp) ::   ztx, zty, ztau, zcoef ! temporary variables
-      INTEGER  ::   ji, jj                ! dummy indices
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   ptaux, ptauy   ! wind stress in i-j direction resp.
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   pwspd          ! wind speed
+      !! 
+      REAL(wp) ::   zrhoa  = 1.22_wp       ! Air density kg/m3
+      REAL(wp) ::   zcdrag = 1.5e-3_wp     ! drag coefficient
+      REAL(wp) ::   ztx, zty, ztau, zcoef  ! temporary variables
+      INTEGER  ::   ji, jj                 ! dummy indices
       !!---------------------------------------------------------------------
       zcoef = 1. / ( zrhoa * zcdrag )
@@ -689,185 +605,7 @@
       END DO
       CALL lbc_lnk( pwspd(:,:), 'T', 1. )
-
+      !
    END SUBROUTINE tau2wnd
 
-#if defined key_trcbbl_dif   ||   defined key_trcbbl_adv
-
-   SUBROUTINE bbl_sign( ptn, psn, pbblx, pbbly )
-      !!----------------------------------------------------------------------
-      !!                    ***  ROUTINE bbl_sign  ***
-      !!
-      !! ** Purpose :   Compute the sign of local gradient of density multiplied by the slope
-      !!                along the bottom slope gradient : grad( rho) * grad(h)
-      !!                Need to compute the diffusive bottom boundary layer
-      !!
-      !! ** Method  :   When the product grad( rho) * grad(h) < 0 (where grad
-      !!      is an along bottom slope gradient) an additional lateral diffu-
-      !!      sive trend along the bottom slope is added to the general tracer
-      !!      trend, otherwise nothing is done. See trcbbl.F90
-      !!
-      !!
-      !! History :
-      !!   9.0  !  02-07  (G. Madec)  Vector optimization
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in  ) ::  &
-         ptn             ,  &                           !: temperature 
-         psn                                            !: salinity 
-      REAL(wp), DIMENSION(jpi,jpj), INTENT( out ) ::  &
-         pbblx , pbbly                                  !: sign of bbl in i-j direction resp. 
-      
-      !! * Local declarations
-      INTEGER  ::   ji, jj                   ! dummy loop indices
-      INTEGER  ::   ik
-      REAL(wp) ::   &
-         ztx, zsx, zhx, zalbetx, zgdrhox,     &  ! temporary scalars
-         zty, zsy, zhy, zalbety, zgdrhoy 
-      REAL(wp), DIMENSION(jpi,jpj) ::    &
-        ztnb, zsnb, zdep
-      REAL(wp) ::    fsalbt, pft, pfs, pfh   ! statement function
-      !!----------------------------------------------------------------------
-      ! ratio alpha/beta
-      ! ================
-      !  fsalbt: ratio of thermal over saline expension coefficients
-      !       pft :  potential temperature in degrees celcius
-      !       pfs :  salinity anomaly (s-35) in psu
-      !       pfh :  depth in meters
-
-      fsalbt( pft, pfs, pfh ) =                                              &
-         ( ( ( -0.255019e-07 * pft + 0.298357e-05 ) * pft                    &
-                                   - 0.203814e-03 ) * pft                    &
-                                   + 0.170907e-01 ) * pft                    &
-                                   + 0.665157e-01                            &
-         +(-0.678662e-05 * pfs - 0.846960e-04 * pft + 0.378110e-02 ) * pfs   &
-         +  ( ( - 0.302285e-13 * pfh                                         &
-                - 0.251520e-11 * pfs                                         &
-                + 0.512857e-12 * pft * pft          ) * pfh                  &
-                                     - 0.164759e-06   * pfs                  &
-             +(   0.791325e-08 * pft - 0.933746e-06 ) * pft                  &
-                                     + 0.380374e-04 ) * pfh
-
-      ! 0. 2D fields of bottom temperature and salinity, and bottom slope
-      ! -----------------------------------------------------------------
-      ! mbathy= number of w-level, minimum value=1 (cf domrea.F90)
-#  if defined key_vectopt_loop
-      jj = 1
-      DO ji = 1, jpij   ! vector opt. (forced unrolling)
-#  else
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-#  endif
-            ik          =  MAX( mbathy(ji,jj) - 1, 1 )    ! vertical index of the bottom ocean T-level
-            ztnb(ji,jj) = ptn(ji,jj,ik) * tmask(ji,jj,1)  ! masked T and S at ocean bottom
-            zsnb(ji,jj) = psn(ji,jj,ik) * tmask(ji,jj,1)
-            zdep(ji,jj) = fsdept(ji,jj,ik)                ! depth of the ocean bottom T-level
-#  if ! defined key_vectopt_loop
-         END DO
-#  endif
-      END DO
-
-      !!----------------------------------------------------------------------
-      ! 1. Criteria of additional bottom diffusivity: grad(rho).grad(h)<0
-      ! --------------------------------------------
-      ! Sign of the local density gradient along the i- and j-slopes
-      ! multiplied by the slope of the ocean bottom
-
-      SELECT CASE ( neos )
-
-      CASE ( 0 )                 ! Jackett and McDougall (1994) formulation
-
-#  if defined key_vectopt_loop
-      jj = 1
-      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
-#  else
-      DO jj = 1, jpjm1
-         DO ji = 1, jpim1
-#  endif
-            ! temperature, salinity anomalie and depth
-            ztx = 0.5 * ( ztnb(ji,jj) + ztnb(ji+1,jj) )
-            zsx = 0.5 * ( zsnb(ji,jj) + zsnb(ji+1,jj) ) - 35.0
-            zhx = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) )
-            !
-            zty = 0.5 * ( ztnb(ji,jj+1) + ztnb(ji,jj) )
-            zsy = 0.5 * ( zsnb(ji,jj+1) + zsnb(ji,jj) ) - 35.0
-            zhy = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) )
-            ! masked ratio alpha/beta
-            zalbetx = fsalbt( ztx, zsx, zhx ) * umask(ji,jj,1)
-            zalbety = fsalbt( zty, zsy, zhy ) * vmask(ji,jj,1)
-            ! local density gradient along i-bathymetric slope
-            zgdrhox = zalbetx * ( ztnb(ji+1,jj) - ztnb(ji,jj) )   &
-                   -            ( zsnb(ji+1,jj) - zsnb(ji,jj) )
-            ! local density gradient along j-bathymetric slope
-            zgdrhoy = zalbety * ( ztnb(ji,jj+1) - ztnb(ji,jj) )   &
-                   -            ( zsnb(ji,jj+1) - zsnb(ji,jj) )
-            ! sign of local i-gradient of density multiplied by the i-slope
-            pbblx(ji,jj) = 0.5 - SIGN( 0.5, -zgdrhox * ( zdep(ji+1,jj) - zdep(ji,jj) ) )
-            ! sign of local j-gradient of density multiplied by the j-slope
-            pbbly(ji,jj) = 0.5 - SIGN( 0.5, -zgdrhoy * ( zdep(ji,jj+1) - zdep(ji,jj) ) )
-#  if ! defined key_vectopt_loop
-         END DO
-#  endif
-      END DO
-
-      CASE ( 1 )               ! Linear formulation function of temperature only
-                               !
-#  if defined key_vectopt_loop
-      jj = 1
-      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
-#  else
-      DO jj = 1, jpjm1
-         DO ji = 1, jpim1
-#  endif
-            ! local 'density/temperature' gradient along i-bathymetric slope
-            zgdrhox =  ztnb(ji+1,jj) - ztnb(ji,jj)
-            ! local density gradient along j-bathymetric slope
-            zgdrhoy =  ztnb(ji,jj+1) - ztnb(ji,jj)
-            ! sign of local i-gradient of density multiplied by the i-slope
-            pbblx(ji,jj) = 0.5 - SIGN( 0.5, -zgdrhox * ( zdep(ji+1,jj) - zdep(ji,jj) ) )
-            ! sign of local j-gradient of density multiplied by the j-slope
-            pbbly(ji,jj) = 0.5 - SIGN( 0.5, -zgdrhoy * ( zdep(ji,jj+1) - zdep(ji,jj) ) )
-#  if ! defined key_vectopt_loop
-         END DO
-#  endif
-      END DO
-
-      CASE ( 2 )               ! Linear formulation function of temperature and salinity
-
-#  if defined key_vectopt_loop
-      jj = 1
-      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
-#  else
-      DO jj = 1, jpjm1
-         DO ji = 1, jpim1
-#  endif     
-            ! local density gradient along i-bathymetric slope
-            zgdrhox = - ( rbeta*( zsnb(ji+1,jj) - zsnb(ji,jj) )   &
-                      -  ralpha*( ztnb(ji+1,jj) - ztnb(ji,jj) ) )
-            ! local density gradient along j-bathymetric slope
-            zgdrhoy = - ( rbeta*( zsnb(ji,jj+1) - zsnb(ji,jj) )   &
-                      -  ralpha*( ztnb(ji,jj+1) - ztnb(ji,jj) ) )
-            ! sign of local i-gradient of density multiplied by the i-slope
-            pbblx(ji,jj) = 0.5 - SIGN( 0.5, - zgdrhox * ( zdep(ji+1,jj) - zdep(ji,jj) ) )
-            ! sign of local j-gradient of density multiplied by the j-slope
-            pbbly(ji,jj) = 0.5 - SIGN( 0.5, -zgdrhoy * ( zdep(ji,jj+1) - zdep(ji,jj) ) )
-#  if ! defined key_vectopt_loop
-         END DO
-#  endif
-      END DO
-
-      CASE DEFAULT
-
-         WRITE(ctmp1,*) '          bad flag value for neos = ', neos
-         CALL ctl_stop(ctmp1)
-
-      END SELECT
-   
-      ! Lateral boundary conditions
-      CALL lbc_lnk( pbblx, 'U', 1. )
-      CALL lbc_lnk( pbbly, 'V', 1. )
-
-   END SUBROUTINE bbl_sign
-
-#endif
 
    SUBROUTINE swap_dyn_data
@@ -876,10 +614,6 @@
       !!
       !! ** Purpose :   swap array data
-      !!
-      !! History :
-      !!   9.0  !  07-09  (C. Ethe)
-      !!----------------------------------------------------------------------
-
-
+      !!----------------------------------------------------------------------
+      !
       ! swap from record 2 to 1
       tdta   (:,:,:,1) = tdta   (:,:,:,2)
@@ -889,9 +623,5 @@
       vdta   (:,:,:,1) = vdta   (:,:,:,2)
       wdta   (:,:,:,1) = wdta   (:,:,:,2)
-#if defined key_trc_diatrd
-      hdivdta(:,:,:,1) = hdivdta(:,:,:,2)
-#endif
-
-#if defined key_ldfslp
+#if defined key_ldfslp && ! defined key_c1d
       uslpdta (:,:,:,1) = uslpdta (:,:,:,2)
       vslpdta (:,:,:,1) = vslpdta (:,:,:,2)
@@ -904,17 +634,18 @@
       empdta (:,:,1) = empdta (:,:,2) 
       qsrdta (:,:,1) = qsrdta (:,:,2) 
-
-#if ! defined key_off_degrad && defined key_traldf_c2d
-      ahtwdta(:,:,1) = ahtwdta(:,:,2)
-#  if defined key_trcldf_eiv
+      IF( l_offbbl ) THEN
+         bblxdta(:,:,1) = bblxdta(:,:,2)
+         bblydta(:,:,1) = bblydta(:,:,2) 
+      ENDIF
+
+#if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv
       aeiwdta(:,:,1) = aeiwdta(:,:,2)
-#  endif
-#endif
-
-#if defined key_off_degrad
+#endif
+
+#if defined key_degrad
       ahtudta(:,:,:,1) = ahtudta(:,:,:,2)
       ahtvdta(:,:,:,1) = ahtvdta(:,:,:,2)
       ahtwdta(:,:,:,1) = ahtwdta(:,:,:,2)
-#  if defined key_trcldf_eiv
+#  if defined key_traldf_eiv
       aeiudta(:,:,:,1) = aeiudta(:,:,:,2)
       aeivdta(:,:,:,1) = aeivdta(:,:,:,2)
@@ -922,11 +653,7 @@
 #  endif
 #endif
-
-#if defined key_trcbbl_dif || defined key_trcbbl_adv
-      bblxdta(:,:,1) = bblxdta(:,:,2)
-      bblydta(:,:,1) = bblydta(:,:,2)
-#endif
-
+      !
    END SUBROUTINE swap_dyn_data
+
 
    SUBROUTINE assign_dyn_data
@@ -939,22 +666,13 @@
       !!----------------------------------------------------------------------
       
-      tn (:,:,:) = tdta  (:,:,:,2)
-      sn (:,:,:) = sdta  (:,:,:,2)
-      avt(:,:,:) = avtdta(:,:,:,2)
+      tsn(:,:,:,jp_tem) = tdta  (:,:,:,2)
+      tsn(:,:,:,jp_sal) = sdta  (:,:,:,2)
+      avt(:,:,:)        = avtdta(:,:,:,2)
       
       un (:,:,:) = udta  (:,:,:,2) 
       vn (:,:,:) = vdta  (:,:,:,2)
       wn (:,:,:) = wdta  (:,:,:,2)
-
-#if defined key_trc_diatrd
-      hdivn(:,:,:) = hdivdta(:,:,:,2)
-#endif
-
-#if defined key_zdfddm
-      avs(:,:,:)   = avtdta (:,:,:,2)
-#endif
-
-      
-#if defined key_ldfslp
+      
+#if defined key_ldfslp && ! defined key_c1d
       uslp (:,:,:) = uslpdta (:,:,:,2) 
       vslp (:,:,:) = vslpdta (:,:,:,2) 
@@ -969,42 +687,34 @@
       emps(:,:) = emp(:,:) 
       qsr (:,:) = qsrdta (:,:,2) 
-
-#if ! defined key_off_degrad && defined key_traldf_c2d    
-      ahtw(:,:) = ahtwdta(:,:,2)
-#  if defined key_trcldf_eiv
+      IF( l_offbbl ) THEN
+         ahu_bbl(:,:) = bblxdta(:,:,2)
+         ahv_bbl(:,:) = bblydta(:,:,2) 
+      ENDIF
+#if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv
       aeiw(:,:) = aeiwdta(:,:,2)
-#  endif
-#endif
-      
-#if defined key_off_degrad
+#endif
+      
+#if defined key_degrad
       ahtu(:,:,:) = ahtudta(:,:,:,2)
       ahtv(:,:,:) = ahtvdta(:,:,:,2)
       ahtw(:,:,:) = ahtwdta(:,:,:,2)
-#  if defined key_trcldf_eiv
+#  if defined key_traldf_eiv
       aeiu(:,:,:) = aeiudta(:,:,:,2)
       aeiv(:,:,:) = aeivdta(:,:,:,2)
       aeiw(:,:,:) = aeiwdta(:,:,:,2)
 #  endif
-      
-#endif
-      
-#if defined key_trcbbl_dif ||  defined key_trcbbl_adv
-      bblx(:,:) = bblxdta(:,:,2)
-      bbly(:,:) = bblydta(:,:,2)
-#endif
-
+#endif
+      !
    END SUBROUTINE assign_dyn_data
 
+
    SUBROUTINE linear_interp_dyn_data( pweigh )
       !!----------------------------------------------------------------------
-      !!                    ***  ROUTINE linear_interp_dyn_data  ***
+      !!               ***  ROUTINE linear_interp_dyn_data  ***
       !!
       !! ** Purpose :   linear interpolation of data
-      !!
-      !!----------------------------------------------------------------------
-      !! * Argument
-      REAL(wp), INTENT( in ) ::   pweigh       ! weigh
-
-      !! * Local declarations
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in) ::   pweigh   ! weigh
+      !!
       REAL(wp) :: zweighm1
       !!----------------------------------------------------------------------
@@ -1012,22 +722,13 @@
       zweighm1 = 1. - pweigh
       
-      tn (:,:,:) = zweighm1 * tdta  (:,:,:,1) + pweigh * tdta  (:,:,:,2)
-      sn (:,:,:) = zweighm1 * sdta  (:,:,:,1) + pweigh * sdta  (:,:,:,2)
-      avt(:,:,:) = zweighm1 * avtdta(:,:,:,1) + pweigh * avtdta(:,:,:,2)
+      tsn(:,:,:,jp_tem) = zweighm1 * tdta  (:,:,:,1) + pweigh * tdta  (:,:,:,2)
+      tsn(:,:,:,jp_sal) = zweighm1 * sdta  (:,:,:,1) + pweigh * sdta  (:,:,:,2)
+      avt(:,:,:)        = zweighm1 * avtdta(:,:,:,1) + pweigh * avtdta(:,:,:,2)
       
       un (:,:,:) = zweighm1 * udta  (:,:,:,1) + pweigh * udta  (:,:,:,2) 
       vn (:,:,:) = zweighm1 * vdta  (:,:,:,1) + pweigh * vdta  (:,:,:,2)
       wn (:,:,:) = zweighm1 * wdta  (:,:,:,1) + pweigh * wdta  (:,:,:,2)
-
-#if defined key_trc_diatrd
-      hdivn(:,:,:) = zweighm1 * hdivdta(:,:,:,1) + pweigh * hdivdta(:,:,:,2)
-#endif
-
-#if defined key_zdfddm
-      avs(:,:,:)   = zweighm1 * avtdta (:,:,:,1) + pweigh * avtdta (:,:,:,2)
-#endif
-
-      
-#if defined key_ldfslp
+      
+#if defined key_ldfslp && ! defined key_c1d
       uslp (:,:,:) = zweighm1 * uslpdta (:,:,:,1) + pweigh * uslpdta (:,:,:,2) 
       vslp (:,:,:) = zweighm1 * vslpdta (:,:,:,1) + pweigh * vslpdta (:,:,:,2) 
@@ -1042,17 +743,18 @@
       emps(:,:) = emp(:,:) 
       qsr (:,:) = zweighm1 * qsrdta (:,:,1) + pweigh  * qsrdta (:,:,2) 
-
-#if ! defined key_off_degrad && defined key_traldf_c2d    
-      ahtw(:,:) = zweighm1 * ahtwdta(:,:,1) + pweigh * ahtwdta(:,:,2)
-#  if defined key_trcldf_eiv
+      IF( l_offbbl ) THEN
+         ahu_bbl(:,:) = zweighm1 * bblxdta(:,:,1) +  pweigh  * bblxdta(:,:,2)
+         ahv_bbl(:,:) = zweighm1 * bblydta(:,:,1) +  pweigh  * bblydta(:,:,2)
+      ENDIF
+
+#if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv 
       aeiw(:,:) = zweighm1 * aeiwdta(:,:,1) + pweigh * aeiwdta(:,:,2)
-#  endif
-#endif
-      
-#if defined key_off_degrad
+#endif
+      
+#if defined key_degrad
       ahtu(:,:,:) = zweighm1 * ahtudta(:,:,:,1) + pweigh * ahtudta(:,:,:,2)
       ahtv(:,:,:) = zweighm1 * ahtvdta(:,:,:,1) + pweigh * ahtvdta(:,:,:,2)
       ahtw(:,:,:) = zweighm1 * ahtwdta(:,:,:,1) + pweigh * ahtwdta(:,:,:,2)
-#  if defined key_trcldf_eiv
+#  if defined key_traldf_eiv
       aeiu(:,:,:) = zweighm1 * aeiudta(:,:,:,1) + pweigh * aeiudta(:,:,:,2)
       aeiv(:,:,:) = zweighm1 * aeivdta(:,:,:,1) + pweigh * aeivdta(:,:,:,2)
@@ -1060,11 +762,7 @@
 #  endif
 #endif
-      
-#if defined key_trcbbl_dif   ||   defined key_trcbbl_adv
-      bblx(:,:) = zweighm1 * bblxdta(:,:,1) + pweigh * bblxdta(:,:,2)
-      bbly(:,:) = zweighm1 * bblydta(:,:,1) + pweigh * bblydta(:,:,2)
-#endif
-
+      !      
    END SUBROUTINE linear_interp_dyn_data
 
+   !!======================================================================
 END MODULE dtadyn
Index: trunk/NEMOGCM/NEMO/OFF_SRC/eosbn2.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OFF_SRC/eosbn2.F90	(revision 2527)
+++ 	(revision )
@@ -1,755 +1,0 @@
-MODULE eosbn2
-   !!==============================================================================
-   !!                       ***  MODULE  eosbn2  ***
-   !! Ocean diagnostic variable : equation of state - in situ and potential density
-   !!                                               - Brunt-Vaisala frequency 
-   !!==============================================================================
-   !! History :       !  89-03  (O. Marti)  Original code
-   !!            6.0  !  94-07  (G. Madec, M. Imbard)  add bn2
-   !!            6.0  !  94-08  (G. Madec)  Add Jackett & McDougall eos
-   !!            7.0  !  96-01  (G. Madec)  statement function for e3
-   !!            8.1  !  97-07  (G. Madec)  introduction of neos, OPA8.1
-   !!            8.1  !  97-07  (G. Madec)  density instead of volumic mass
-   !!                 !  99-02  (G. Madec, N. Grima) semi-implicit pressure gradient
-   !!                 !  01-09  (M. Ben Jelloul)  bugfix onlinear eos
-   !!            8.5  !  02-10  (G. Madec)  add eos_init
-   !!            8.5  !  02-11  (G. Madec, A. Bozec)  partial step, eos_insitu_2d
-   !!            9.0  !  03-08  (G. Madec)  F90, free form
-   !!            9.0  !  06-08  (G. Madec)  add tfreez function
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   eos            : generic interface of the equation of state
-   !!   eos_insitu     : Compute the in situ density
-   !!   eos_insitu_pot : Compute the insitu and surface referenced potential
-   !!                    volumic mass
-   !!   eos_insitu_2d  : Compute the in situ density for 2d fields
-   !!   eos_bn2        : Compute the Brunt-Vaisala frequency
-   !!   tfreez         : Compute the surface freezing temperature
-   !!   eos_init       : set eos parameters (namelist)
-   !!----------------------------------------------------------------------
-   USE dom_oce         ! ocean space and time domain
-   USE phycst          ! physical constants
-   USE in_out_manager  ! I/O manager
-   USE zdfddm          ! vertical physics: double diffusion
-   USE prtctl          ! Print control
-
-   IMPLICIT NONE
-   PRIVATE
-
-   !! * Interface 
-   INTERFACE eos
-      MODULE PROCEDURE eos_insitu, eos_insitu_pot, eos_insitu_2d
-   END INTERFACE 
-   INTERFACE bn2
-      MODULE PROCEDURE eos_bn2
-   END INTERFACE 
-
-   PUBLIC   eos        ! called by step, istate, tranpc and zpsgrd modules
-   PUBLIC   eos_init   ! called by istate module
-   PUBLIC   bn2        ! called by step module
-   PUBLIC   tfreez     ! called by sbcice_... modules
-
-   !!* Namelist (nameos)
-   INTEGER , PUBLIC ::   neos   = 0        !: = 0/1/2 type of eq. of state and Brunt-Vaisala frequ.
-   REAL(wp), PUBLIC ::   ralpha = 2.0e-4   !: thermal expension coeff. (linear equation of state)
-   REAL(wp), PUBLIC ::   rbeta  = 7.7e-4   !: saline  expension coeff. (linear equation of state)
-   
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2006) 
-   !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE eos_insitu( ptem, psal, prd )
-      !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE eos_insitu  ***
-      !! 
-      !! ** Purpose :   Compute the in situ density (ratio rho/rau0) from 
-      !!       potential temperature and salinity using an equation of state
-      !!       defined through the namelist parameter neos.
-      !!
-      !! ** Method  :   3 cases:
-      !!      neos = 0 : Jackett and McDougall (1994) equation of state.
-      !!         the in situ density is computed directly as a function of
-      !!         potential temperature relative to the surface (the opa t
-      !!         variable), salt and pressure (assuming no pressure variation
-      !!         along geopotential surfaces, i.e. the pressure p in decibars
-      !!         is approximated by the depth in meters.
-      !!              prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0
-      !!         with pressure                      p        decibars
-      !!              potential temperature         t        deg celsius
-      !!              salinity                      s        psu
-      !!              reference volumic mass        rau0     kg/m**3
-      !!              in situ volumic mass          rho      kg/m**3
-      !!              in situ density anomalie      prd      no units
-      !!         Check value: rho = 1060.93298 kg/m**3 for p=10000 dbar,
-      !!          t = 40 deg celcius, s=40 psu
-      !!      neos = 1 : linear equation of state function of temperature only
-      !!              prd(t) = 0.0285 - ralpha * t
-      !!      neos = 2 : linear equation of state function of temperature and
-      !!               salinity
-      !!              prd(t,s) = rbeta * s - ralpha * tn - 1.
-      !!      Note that no boundary condition problem occurs in this routine
-      !!      as (ptem,psal) are defined over the whole domain.
-      !!
-      !! ** Action  :   compute prd , the in situ density (no units)
-      !!
-      !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   ptem   ! potential temperature  [Celcius]
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   psal   ! salinity               [psu]
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   prd    ! in situ density 
-      !!
-      INTEGER ::  ji, jj, jk      ! dummy loop indices
-      REAL(wp) ::   &          
-         zt , zs , zh , zsr,   &  ! temporary scalars
-         zr1, zr2, zr3, zr4,   &  !    "         " 
-         zrhop, ze, zbw, zb,   &  !    "         "
-         zd , zc , zaw, za ,   &  !    "         "
-         zb1, za1, zkw, zk0       !    "         "
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zws   ! temporary workspace
-      !!----------------------------------------------------------------------
-
-      SELECT CASE ( neos )
-      !
-      CASE ( 0 )               ! Jackett and McDougall (1994) formulation
-         !
-!CDIR NOVERRCHK
-         zws(:,:,:) = SQRT( ABS( psal(:,:,:) ) )
-         !                                                ! ===============
-         DO jk = 1, jpkm1                                 ! Horizontal slab
-            !                                             ! ===============
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zt = ptem(ji,jj,jk)
-                  zs = psal(ji,jj,jk)
-                  ! depth
-                  zh = fsdept(ji,jj,jk)
-                  ! square root salinity
-                  zsr= zws(ji,jj,jk)
-                  ! compute volumic mass pure water at atm pressure
-                  zr1= ( ( ( ( 6.536332e-9*zt-1.120083e-6 )*zt+1.001685e-4)*zt   &
-                     -9.095290e-3 )*zt+6.793952e-2 )*zt+999.842594
-                  ! seawater volumic mass atm pressure
-                  zr2= ( ( ( 5.3875e-9*zt-8.2467e-7 ) *zt+7.6438e-5 ) *zt   &
-                     -4.0899e-3 ) *zt+0.824493
-                  zr3= ( -1.6546e-6*zt+1.0227e-4 ) *zt-5.72466e-3
-                  zr4= 4.8314e-4
-
-                  ! potential volumic mass (reference to the surface)
-                  zrhop= ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1
-
-                  ! add the compression terms
-                  ze = ( -3.508914e-8*zt-1.248266e-8 ) *zt-2.595994e-6
-                  zbw= (  1.296821e-6*zt-5.782165e-9 ) *zt+1.045941e-4
-                  zb = zbw + ze * zs
-
-                  zd = -2.042967e-2
-                  zc =   (-7.267926e-5*zt+2.598241e-3 ) *zt+0.1571896
-                  zaw= ( ( 5.939910e-6*zt+2.512549e-3 ) *zt-0.1028859 ) *zt - 4.721788
-                  za = ( zd*zsr + zc ) *zs + zaw
-
-                  zb1=   (-0.1909078*zt+7.390729 ) *zt-55.87545
-                  za1= ( ( 2.326469e-3*zt+1.553190)*zt-65.00517 ) *zt+1044.077
-                  zkw= ( ( (-1.361629e-4*zt-1.852732e-2 ) *zt-30.41638 ) *zt + 2098.925 ) *zt+190925.6
-                  zk0= ( zb1*zsr + za1 )*zs + zkw
-
-                  ! masked in situ density anomaly
-                  prd(ji,jj,jk) = (  zrhop / (  1.0 - zh / ( zk0 - zh * ( za - zh * zb ) )  )    &
-                     - rau0 ) / rau0 * tmask(ji,jj,jk)
-               END DO
-            END DO
-            !                                             ! ===============
-         END DO                                           !   End of slab
-         !                                                ! ===============
-         !
-      CASE ( 1 )               ! Linear formulation function of temperature only
-         !
-         !                                                ! ===============
-         DO jk = 1, jpkm1                                 ! Horizontal slab
-            !                                             ! ===============
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zt = ptem(ji,jj,jk)
-                  zs = psal(ji,jj,jk)
-                  !   ... density and potential volumic mass
-                  prd(ji,jj,jk) = ( 0.0285 - ralpha * zt ) * tmask(ji,jj,jk)
-               END DO
-            END DO
-            !                                             ! ===============
-         END DO                                           !   End of slab
-         !                                                ! ===============
-         !
-      CASE ( 2 )               ! Linear formulation function of temperature and salinity
-         !
-         !                                                ! ===============
-         DO jk = 1, jpkm1                                 ! Horizontal slab
-            !                                             ! ===============
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zt = ptem(ji,jj,jk)
-                  zs = psal(ji,jj,jk)
-                  !   ... density and potential volumic mass
-                  prd(ji,jj,jk) = (   rbeta  * zs - ralpha * zt ) * tmask(ji,jj,jk)
-               END DO
-            END DO
-            !                                             ! ===============
-         END DO                                           !   End of slab
-         !                                                ! ===============
-         !
-      CASE DEFAULT
-         !
-         WRITE(ctmp1,*) '          bad flag value for neos = ', neos
-         CALL ctl_stop( ctmp1 )
-         !
-      END SELECT
-      !
-      IF(ln_ctl)   CALL prt_ctl(tab3d_1=prd, clinfo1=' eos  : ', ovlap=1, kdim=jpk)
-      !
-   END SUBROUTINE eos_insitu
-
-
-   SUBROUTINE eos_insitu_pot( ptem, psal, prd, prhop )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE eos_insitu_pot  ***
-      !!           
-      !! ** Purpose :   Compute the in situ density (ratio rho/rau0) and the
-      !!      potential volumic mass (Kg/m3) from potential temperature and
-      !!      salinity fields using an equation of state defined through the 
-      !!     namelist parameter neos.
-      !!
-      !! ** Method  :
-      !!      neos = 0 : Jackett and McDougall (1994) equation of state.
-      !!         the in situ density is computed directly as a function of
-      !!         potential temperature relative to the surface (the opa t
-      !!         variable), salt and pressure (assuming no pressure variation
-      !!         along geopotential surfaces, i.e. the pressure p in decibars
-      !!         is approximated by the depth in meters.
-      !!              prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0
-      !!              rhop(t,s)  = rho(t,s,0)
-      !!         with pressure                      p        decibars
-      !!              potential temperature         t        deg celsius
-      !!              salinity                      s        psu
-      !!              reference volumic mass        rau0     kg/m**3
-      !!              in situ volumic mass          rho      kg/m**3
-      !!              in situ density anomalie      prd      no units
-      !!
-      !!         Check value: rho = 1060.93298 kg/m**3 for p=10000 dbar,
-      !!          t = 40 deg celcius, s=40 psu
-      !!
-      !!      neos = 1 : linear equation of state function of temperature only
-      !!              prd(t) = ( rho(t) - rau0 ) / rau0 = 0.028 - ralpha * t
-      !!              rhop(t,s)  = rho(t,s)
-      !!
-      !!      neos = 2 : linear equation of state function of temperature and
-      !!               salinity
-      !!              prd(t,s) = ( rho(t,s) - rau0 ) / rau0 
-      !!                       = rbeta * s - ralpha * tn - 1.
-      !!              rhop(t,s)  = rho(t,s)
-      !!      Note that no boundary condition problem occurs in this routine
-      !!      as (tn,sn) or (ta,sa) are defined over the whole domain.
-      !!
-      !! ** Action  : - prd  , the in situ density (no units)
-      !!              - prhop, the potential volumic mass (Kg/m3)
-      !!
-      !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994
-      !!                Brown and Campana, Mon. Weather Rev., 1978
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   ptem   ! potential temperature  [Celcius]
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   psal   ! salinity               [psu]
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   prd    ! in situ density 
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   prhop  ! potential density (surface referenced)
-
-      INTEGER  ::  ji, jj, jk                ! dummy loop indices
-      REAL(wp) ::   &             ! temporary scalars
-         zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw,   &
-         zb, zd, zc, zaw, za, zb1, za1, zkw, zk0
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zws
-      !!----------------------------------------------------------------------
-
-      SELECT CASE ( neos )
-      !
-      CASE ( 0 )               ! Jackett and McDougall (1994) formulation
-         !
-!CDIR NOVERRCHK
-         zws(:,:,:) = SQRT( ABS( psal(:,:,:) ) )
-         !                                                ! ===============
-         DO jk = 1, jpkm1                                 ! Horizontal slab
-            !                                             ! ===============
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zt = ptem(ji,jj,jk)
-                  zs = psal(ji,jj,jk)
-                  ! depth
-                  zh = fsdept(ji,jj,jk)
-                  ! square root salinity
-                  zsr= zws(ji,jj,jk)
-                  ! compute volumic mass pure water at atm pressure
-                  zr1= ( ( ( ( 6.536332e-9*zt-1.120083e-6 )*zt+1.001685e-4)*zt   &
-                     -9.095290e-3 )*zt+6.793952e-2 )*zt+999.842594
-                  ! seawater volumic mass atm pressure
-                  zr2= ( ( ( 5.3875e-9*zt-8.2467e-7 ) *zt+7.6438e-5 ) *zt   &
-                     -4.0899e-3 ) *zt+0.824493
-                  zr3= ( -1.6546e-6*zt+1.0227e-4 ) *zt-5.72466e-3
-                  zr4= 4.8314e-4
-
-                  ! potential volumic mass (reference to the surface)
-                  zrhop= ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1
-
-                  ! save potential volumic mass
-                  prhop(ji,jj,jk) = zrhop * tmask(ji,jj,jk)
-
-                  ! add the compression terms
-                  ze = ( -3.508914e-8*zt-1.248266e-8 ) *zt-2.595994e-6
-                  zbw= (  1.296821e-6*zt-5.782165e-9 ) *zt+1.045941e-4
-                  zb = zbw + ze * zs
-
-                  zd = -2.042967e-2
-                  zc =   (-7.267926e-5*zt+2.598241e-3 ) *zt+0.1571896
-                  zaw= ( ( 5.939910e-6*zt+2.512549e-3 ) *zt-0.1028859 ) *zt - 4.721788
-                  za = ( zd*zsr + zc ) *zs + zaw
-
-                  zb1=   (-0.1909078*zt+7.390729 ) *zt-55.87545
-                  za1= ( ( 2.326469e-3*zt+1.553190)*zt-65.00517 ) *zt+1044.077
-                  zkw= ( ( (-1.361629e-4*zt-1.852732e-2 ) *zt-30.41638 ) *zt + 2098.925 ) *zt+190925.6
-                  zk0= ( zb1*zsr + za1 )*zs + zkw
-
-                  ! masked in situ density anomaly
-                  prd(ji,jj,jk) = (  zrhop / (  1.0 - zh / ( zk0 - zh * ( za - zh * zb ) )  )    &
-                     - rau0 ) / rau0 * tmask(ji,jj,jk)
-               END DO
-            END DO
-            !                                             ! ===============
-         END DO                                           !   End of slab
-         !                                                ! ===============
-         !
-      CASE ( 1 )               ! Linear formulation function of temperature only
-         !
-         !                                                ! ===============
-         DO jk = 1, jpkm1                                 ! Horizontal slab
-            !                                             ! ===============
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zt = ptem(ji,jj,jk)
-                  zs = psal(ji,jj,jk)
-                  !   ... density and potential volumic mass
-                  prd  (ji,jj,jk) = ( 0.0285 - ralpha * zt )        * tmask(ji,jj,jk)
-                  prhop(ji,jj,jk) = ( rau0 * prd(ji,jj,jk) + rau0 ) * tmask(ji,jj,jk)
-               END DO
-            END DO
-            !                                             ! ===============
-         END DO                                           !   End of slab
-         !                                                ! ===============
-         !
-      CASE ( 2 )               ! Linear formulation function of temperature and salinity
-         !
-         !                                                ! ===============
-         DO jk = 1, jpkm1                                 ! Horizontal slab
-            !                                             ! ===============
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zt = ptem(ji,jj,jk)
-                  zs = psal(ji,jj,jk)
-                  !   ... density and potential volumic mass
-                  prd  (ji,jj,jk) = ( rbeta  * zs - ralpha * zt ) * tmask(ji,jj,jk)
-                  prhop(ji,jj,jk) = ( rau0 * prd(ji,jj,jk) + rau0 )    * tmask(ji,jj,jk)
-               END DO
-            END DO
-            !                                             ! ===============
-         END DO                                           !   End of slab
-         !                                                ! ===============
-         !
-      CASE DEFAULT
-         !
-         WRITE(ctmp1,*) '          bad flag value for neos = ', neos
-         CALL ctl_stop( ctmp1 )
-         !
-      END SELECT
-      !
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-p: ', tab3d_2=prhop, clinfo2=' pot : ', ovlap=1, kdim=jpk )
-      !
-   END SUBROUTINE eos_insitu_pot
-
-
-   SUBROUTINE eos_insitu_2d( ptem, psal, pdep, prd )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE eos_insitu_2d  ***
-      !!
-      !! ** Purpose :   Compute the in situ density (ratio rho/rau0) from 
-      !!      potential temperature and salinity using an equation of state
-      !!      defined through the namelist parameter neos. * 2D field case
-      !!
-      !! ** Method :
-      !!      neos = 0 : Jackett and McDougall (1994) equation of state.
-      !!         the in situ density is computed directly as a function of
-      !!         potential temperature relative to the surface (the opa t
-      !!         variable), salt and pressure (assuming no pressure variation
-      !!         along geopotential surfaces, i.e. the pressure p in decibars
-      !!         is approximated by the depth in meters.
-      !!              prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0
-      !!         with pressure                      p        decibars
-      !!              potential temperature         t        deg celsius
-      !!              salinity                      s        psu
-      !!              reference volumic mass        rau0     kg/m**3
-      !!              in situ volumic mass          rho      kg/m**3
-      !!              in situ density anomalie      prd      no units
-      !!         Check value: rho = 1060.93298 kg/m**3 for p=10000 dbar,
-      !!          t = 40 deg celcius, s=40 psu
-      !!      neos = 1 : linear equation of state function of temperature only
-      !!              prd(t) = 0.0285 - ralpha * t
-      !!      neos = 2 : linear equation of state function of temperature and
-      !!               salinity
-      !!              prd(t,s) = rbeta * s - ralpha * tn - 1.
-      !!      Note that no boundary condition problem occurs in this routine
-      !!      as (ptem,psal) are defined over the whole domain.
-      !!
-      !! ** Action  : - prd , the in situ density (no units)
-      !!
-      !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   ptem   ! potential temperature  [Celcius]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   psal   ! salinity               [psu]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   pdep   ! depth                  [m]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   prd    ! in situ density 
-      !!
-      INTEGER  ::  ji, jj                    ! dummy loop indices
-      REAL(wp) ::   &             ! temporary scalars
-         zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw,   &
-         zb, zd, zc, zaw, za, zb1, za1, zkw, zk0,               &
-         zmask
-      REAL(wp), DIMENSION(jpi,jpj) ::   zws
-      !!----------------------------------------------------------------------
-
-      prd(:,:) = 0.e0
-
-      SELECT CASE ( neos )
-      !
-      CASE ( 0 )               ! Jackett and McDougall (1994) formulation
-      !
-!CDIR NOVERRCHK
-         DO jj = 1, jpjm1
-!CDIR NOVERRCHK
-            DO ji = 1, fs_jpim1   ! vector opt.
-               zws(ji,jj) = SQRT( ABS( psal(ji,jj) ) )
-            END DO
-         END DO
-         !                                                ! ===============
-         DO jj = 1, jpjm1                                 ! Horizontal slab
-            !                                             ! ===============
-            DO ji = 1, fs_jpim1   ! vector opt.
-               zmask = tmask(ji,jj,1)      ! land/sea bottom mask = surf. mask
-
-               zt = ptem (ji,jj)            ! interpolated T
-               zs = psal (ji,jj)            ! interpolated S
-               zsr= zws(ji,jj)            ! square root of interpolated S
-               zh = pdep(ji,jj)            ! depth at the partial step level
-
-               ! compute volumic mass pure water at atm pressure
-               zr1 = ( ( ( ( 6.536332e-9*zt-1.120083e-6 )*zt+1.001685e-4)*zt   &
-                         -9.095290e-3 )*zt+6.793952e-2 )*zt+999.842594
-               ! seawater volumic mass atm pressure
-               zr2= ( ( ( 5.3875e-9*zt-8.2467e-7 )*zt+7.6438e-5 ) *zt   &
-                         -4.0899e-3 ) *zt+0.824493
-               zr3= ( -1.6546e-6*zt+1.0227e-4 ) *zt-5.72466e-3
-               zr4= 4.8314e-4
-
-               ! potential volumic mass (reference to the surface)
-               zrhop= ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1
-
-               ! add the compression terms
-               ze = ( -3.508914e-8*zt-1.248266e-8 ) *zt-2.595994e-6
-               zbw= (  1.296821e-6*zt-5.782165e-9 ) *zt+1.045941e-4
-               zb = zbw + ze * zs
-
-               zd = -2.042967e-2
-               zc =   (-7.267926e-5*zt+2.598241e-3 ) *zt+0.1571896
-               zaw= ( ( 5.939910e-6*zt+2.512549e-3 ) *zt-0.1028859 ) *zt -4.721788
-               za = ( zd*zsr + zc ) *zs + zaw
-
-               zb1=   (-0.1909078*zt+7.390729 ) *zt-55.87545
-               za1= ( ( 2.326469e-3*zt+1.553190)*zt-65.00517 ) *zt+1044.077
-               zkw= ( ( (-1.361629e-4*zt-1.852732e-2 ) *zt-30.41638 ) *zt   &
-                         +2098.925 ) *zt+190925.6
-               zk0= ( zb1*zsr + za1 )*zs + zkw
-
-               ! masked in situ density anomaly
-               prd(ji,jj) = ( zrhop / (  1.0 - zh / ( zk0 - zh * ( za - zh * zb ) )  ) - rau0 )   &
-                  &       / rau0 * zmask
-            END DO
-            !                                             ! ===============
-         END DO                                           !   End of slab
-         !                                                ! ===============
-         !
-      CASE ( 1 )               ! Linear formulation function of temperature only
-         !
-         !                                                ! ===============
-         DO jj = 1, jpjm1                                 ! Horizontal slab
-            !                                             ! ===============
-            DO ji = 1, fs_jpim1   ! vector opt.
-               prd(ji,jj) = ( 0.0285 - ralpha * ptem(ji,jj) ) * tmask(ji,jj,1)
-            END DO
-            !                                             ! ===============
-         END DO                                           !   End of slab
-         !                                                ! ===============
-         !
-      CASE ( 2 )               ! Linear formulation function of temperature and salinity
-         !
-         !                                                ! ===============
-         DO jj = 1, jpjm1                                 ! Horizontal slab
-            !                                             ! ===============
-            DO ji = 1, fs_jpim1   ! vector opt.
-               prd(ji,jj) = ( rbeta * psal(ji,jj) - ralpha * ptem(ji,jj) ) * tmask(ji,jj,1) 
-            END DO
-            !                                             ! ===============
-         END DO                                           !   End of slab
-         !                                                ! ===============
-         !
-      CASE DEFAULT
-         !
-         WRITE(ctmp1,*) '          bad flag value for neos = ', neos
-         CALL ctl_stop( ctmp1 )
-         !
-      END SELECT
-
-      IF(ln_ctl)   CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ' )
-      !
-   END SUBROUTINE eos_insitu_2d
-
-
-   SUBROUTINE eos_bn2( ptem, psal, pn2 )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE eos_bn2  ***
-      !!
-      !! ** Purpose :   Compute the local Brunt-Vaisala frequency at the time-
-      !!      step of the input arguments
-      !!      
-      !! ** Method :
-      !!       * neos = 0  : UNESCO sea water properties
-      !!         The brunt-vaisala frequency is computed using the polynomial
-      !!      polynomial expression of McDougall (1987):
-      !!            N^2 = grav * beta * ( alpha/beta*dk[ t ] - dk[ s ] )/e3w
-      !!      If lk_zdfddm=T, the heat/salt buoyancy flux ratio Rrau is
-      !!      computed and used in zdfddm module :
-      !!              Rrau = alpha/beta * ( dk[ t ] / dk[ s ] )
-      !!       * neos = 1  : linear equation of state (temperature only)
-      !!            N^2 = grav * ralpha * dk[ t ]/e3w
-      !!       * neos = 2  : linear equation of state (temperature & salinity)
-      !!            N^2 = grav * (ralpha * dk[ t ] - rbeta * dk[ s ] ) / e3w
-      !!      The use of potential density to compute N^2 introduces e r r o r
-      !!      in the sign of N^2 at great depths. We recommand the use of 
-      !!      neos = 0, except for academical studies.
-      !!        Macro-tasked on horizontal slab (jk-loop)
-      !!      N.B. N^2 is set to zero at the first level (JK=1) in inidtr
-      !!      and is never used at this level.
-      !!
-      !! ** Action  : - pn2 : the brunt-vaisala frequency
-      !!
-      !! References :   McDougall, J. Phys. Oceanogr., 17, 1950-1964, 1987.
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   ptem   ! potential temperature   [Celcius]
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   psal   ! salinity                [psu]
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   pn2    ! Brunt-Vaisala frequency [s-1]
-
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp) ::   zgde3w, zt, zs, zh,  &  ! temporary scalars 
-         &          zalbet, zbeta           !    "         "
-#if defined key_zdfddm
-      REAL(wp) ::   zds          ! temporary scalars
-#endif
-      !!----------------------------------------------------------------------
-
-      ! pn2 : first and last levels
-      ! ---------------------------
-      ! bn^2=0. at jk=1 and jpk set in inidtr.F : no computation
-
-
-      ! pn2 : interior points only (2=< jk =< jpkm1 )
-      ! -------------------------- 
-
-      SELECT CASE ( neos )
-      !
-      CASE ( 0 )               ! Jackett and McDougall (1994) formulation
-         !
-         !                                                ! ===============
-         DO jk = 2, jpkm1                                 ! Horizontal slab
-            !                                             ! ===============
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zgde3w = grav / fse3w(ji,jj,jk)
-                  zt = 0.5 * ( ptem(ji,jj,jk) + ptem(ji,jj,jk-1) )          ! potential temperature at w-point
-                  zs = 0.5 * ( psal(ji,jj,jk) + psal(ji,jj,jk-1) ) - 35.0   ! salinity anomaly (s-35) at w-point
-                  zh = fsdepw(ji,jj,jk)                                     ! depth in meters  at w-point
-
-                  zalbet = ( ( ( - 0.255019e-07 * zt + 0.298357e-05 ) * zt   &   ! ratio alpha/beta
-                     &                               - 0.203814e-03 ) * zt   &
-                     &                               + 0.170907e-01 ) * zt   &
-                     &   + 0.665157e-01                                      &
-                     &   +     ( - 0.678662e-05 * zs                         &
-                     &           - 0.846960e-04 * zt + 0.378110e-02 ) * zs   &
-                     &   +   ( ( - 0.302285e-13 * zh                         &
-                     &           - 0.251520e-11 * zs                         &
-                     &           + 0.512857e-12 * zt * zt           ) * zh   &
-                     &           - 0.164759e-06 * zs                         &
-                     &        +(   0.791325e-08 * zt - 0.933746e-06 ) * zt   &
-                     &                               + 0.380374e-04 ) * zh
-
-                  zbeta  = ( ( -0.415613e-09 * zt + 0.555579e-07 ) * zt      &   ! beta
-                     &                            - 0.301985e-05 ) * zt      &
-                     &   + 0.785567e-03                                      &
-                     &   + (     0.515032e-08 * zs                           &
-                     &         + 0.788212e-08 * zt - 0.356603e-06 ) * zs     &
-                     &   +(  (   0.121551e-17 * zh                           &
-                     &         - 0.602281e-15 * zs                           &
-                     &         - 0.175379e-14 * zt + 0.176621e-12 ) * zh     &
-                     &                             + 0.408195e-10   * zs     &
-                     &     + ( - 0.213127e-11 * zt + 0.192867e-09 ) * zt     &
-                     &                             - 0.121555e-07 ) * zh
-
-                  pn2(ji,jj,jk) = zgde3w * zbeta * tmask(ji,jj,jk)           &   ! N^2 
-                     &          * ( zalbet * ( ptem(ji,jj,jk-1) - ptem(ji,jj,jk) )   &
-                     &                     - ( psal(ji,jj,jk-1) - psal(ji,jj,jk) ) )
-#if defined key_zdfddm
-                  !                                                         !!bug **** caution a traiter zds=dk[S]= 0 !!!!
-                  zds = ( psal(ji,jj,jk-1) - psal(ji,jj,jk) )                    ! Rrau = (alpha / beta) (dk[t] / dk[s])
-                  IF ( ABS( zds) <= 1.e-20 ) zds = 1.e-20
-                  rrau(ji,jj,jk) = zalbet * ( ptem(ji,jj,jk-1) - ptem(ji,jj,jk) ) / zds
-#endif
-               END DO
-            END DO
-            !                                             ! ===============
-         END DO                                           !   End of slab
-         !                                                ! ===============
-         !
-      CASE ( 1 )               ! Linear formulation function of temperature only
-         !
-         !                                                ! ===============
-         DO jk = 2, jpkm1                                 ! Horizontal slab
-            !                                             ! ===============
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zgde3w = grav / fse3w(ji,jj,jk) * tmask(ji,jj,jk)
-                  pn2(ji,jj,jk) = zgde3w * ralpha * ( ptem(ji,jj,jk-1) - ptem(ji,jj,jk) )
-               END DO
-            END DO
-            !                                             ! ===============
-         END DO                                           !   End of slab
-         !                                                ! ===============
-         !
-      CASE ( 2 )               ! Linear formulation function of temperature and salinity
-         !
-         !                                                ! ===============
-         DO jk = 2, jpkm1                                 ! Horizontal slab
-            !                                             ! ===============
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zgde3w = grav / fse3w(ji,jj,jk) * tmask(ji,jj,jk)
-                  pn2(ji,jj,jk) = zgde3w * (  ralpha * ( ptem(ji,jj,jk-1) - ptem(ji,jj,jk) )   &
-                     &                      - rbeta  * ( psal(ji,jj,jk-1) - psal(ji,jj,jk) )  )
-               END DO
-            END DO
-#if defined key_zdfddm
-            !                                                ! Rrau = (alpha / beta) (dk[t] / dk[s])
-            zalbet = ralpha / rbeta
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zds = ( psal(ji,jj,jk-1) - psal(ji,jj,jk) )
-                  IF ( ABS( zds ) <= 1.e-20 ) zds = 1.e-20
-                  rrau(ji,jj,jk) = zalbet * ( ptem(ji,jj,jk-1) - ptem(ji,jj,jk) ) / zds
-               END DO
-            END DO
-#endif
-            !                                             ! ===============
-         END DO                                           !   End of slab
-         !                                                ! ===============
-         !
-      CASE DEFAULT
-         !
-         WRITE(ctmp1,*) '          bad flag value for neos = ', neos
-         CALL ctl_stop( ctmp1 )
-         !
-      END SELECT
-
-      IF(ln_ctl)   CALL prt_ctl(tab3d_1=pn2, clinfo1=' bn2  : ', ovlap=1, kdim=jpk)
-#if defined key_zdfddm
-      IF(ln_ctl)   CALL prt_ctl(tab3d_1=rrau, clinfo1=' rrau : ', ovlap=1, kdim=jpk)
-#endif
-      !
-   END SUBROUTINE eos_bn2
-
-
-   FUNCTION tfreez( psal ) RESULT( ptf )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE eos_init  ***
-      !!
-      !! ** Purpose :   Compute the sea surface freezing temperature [Celcius]
-      !!
-      !! ** Method  :   UNESCO freezing point at the surface (pressure = 0???)
-      !!       freezing point [Celcius]=(-.0575+1.710523e-3*sqrt(abs(s))-2.154996e-4*s)*s-7.53e-4*p
-      !!       checkvalue: tf= -2.588567 Celsius for s=40.0psu, p=500. decibars
-      !!
-      !! Reference  :   UNESCO tech. papers in the marine science no. 28. 1978
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   psal   ! salinity             [psu]
-      REAL(wp), DIMENSION(jpi,jpj)                ::   ptf    ! freezing temperature [Celcius]
-      !!----------------------------------------------------------------------
-      ptf(:,:) = ( - 0.0575 + 1.710523e-3 * SQRT( psal(:,:) )   &
-         &                  - 2.154996e-4 *       psal(:,:)   ) * psal(:,:)
-   END FUNCTION tfreez
-
-
-   SUBROUTINE eos_init
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE eos_init  ***
-      !!
-      !! ** Purpose :   initializations for the equation of state
-      !!
-      !! ** Method  :   Read the namelist nameos and control the parameters
-      !!----------------------------------------------------------------------
-      NAMELIST/nameos/ neos, ralpha, rbeta
-
-      REWIND( numnam )            ! Read Namelist nameos : equation of state
-      READ  ( numnam, nameos )
-
-      ! Control print
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'eos_init : equation of state'
-         WRITE(numout,*) '~~~~~~~~'
-         WRITE(numout,*) '          Namelist nameos : set eos parameters'
-         WRITE(numout,*) '             flag for eq. of state and N^2  neos   = ', neos
-         WRITE(numout,*) '             thermal exp. coef. (linear)    ralpha = ', ralpha
-         WRITE(numout,*) '             saline  exp. coef. (linear)    rbeta  = ', rbeta
-      ENDIF
-
-      SELECT CASE ( neos )
-
-      CASE ( 0 )               ! Jackett and McDougall (1994) formulation
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) '          use of Jackett & McDougall (1994) equation of state and'
-         IF(lwp) WRITE(numout,*) '                 McDougall (1987) Brunt-Vaisala frequency'
-         !
-      CASE ( 1 )               ! Linear formulation function of temperature only
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) '          use of linear eos rho(T) = rau0 * ( 1.0285 - ralpha * T )'
-         IF( lk_zdfddm ) CALL ctl_stop( '          double diffusive mixing parameterization requires',   &
-              &                         ' that T and S are used as state variables' )
-         !
-      CASE ( 2 )               ! Linear formulation function of temperature and salinity
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) '          use of linear eos rho(T,S) = rau0 * ( rbeta * S - ralpha * T )'
-         !
-      CASE DEFAULT             ! E R R O R in neos 
-         WRITE(ctmp1,*) '          bad flag value for neos = ', neos
-         CALL ctl_stop( ctmp1 )
-      END SELECT
-
-   END SUBROUTINE eos_init
-
-   !!======================================================================
-END MODULE eosbn2  
Index: trunk/NEMOGCM/NEMO/OFF_SRC/istate.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OFF_SRC/istate.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OFF_SRC/istate.F90	(revision 2528)
@@ -2,23 +2,19 @@
    !!======================================================================
    !!                     ***  MODULE  istate  ***
-   !! Ocean state   :  initial state setting
+   !! Ocean state   :  initial state setting, off-line case
    !!=====================================================================
+   !! History :  3.3  ! 2010-10  (C. Ethe)  original code
+   !!----------------------------------------------------------------------
 
    !!----------------------------------------------------------------------
-   !!   istate_init   : initial state setting
+   !!   istate_init   : initial state set to zero
    !!----------------------------------------------------------------------
-   !! * Modules used
    USE oce             ! ocean dynamics and active tracers 
    USE dom_oce         ! ocean space and time domain 
-   USE ldftra_oce      ! ocean active tracers: lateral physics
-   USE zdf_oce         ! ocean vertical physics
-   USE in_out_manager  ! I/O manager
-   USE phycst          ! physical constants
 
    IMPLICIT NONE
    PRIVATE
 
-   !! * Routine accessibility
-   PUBLIC istate_init   ! routine called by step.F90
+   PUBLIC   istate_init   ! routine called by step.F90
 
    !! * Substitutions
@@ -26,9 +22,8 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL  (2005)
-   !!   $Id$
-   !!   This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
-   !!----------------------------------------------------------------------
-
+   !! NEMO/OFF 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!---------------------------------------------------------------------
 CONTAINS
 
@@ -37,34 +32,18 @@
       !!                   ***  ROUTINE istate_init  ***
       !! 
-      !! ** Purpose :   Initialization of the dynamics and tracers.
-      !!
-      !! ** Method  :
-      !!
-      !! History :
-      !!   4.0  !  91-03  ()  Original code
-      !!        !  91-11  (G. Madec)
-      !!   9.0  !  03-09  (G. Madec)  F90: Free form, modules, orthogonality
+      !! ** Purpose :   Initialization to zero of the dynamics and tracers.
       !!----------------------------------------------------------------------
-      !! * Local declarations
-      !!----------------------------------------------------------------------
-
-
-      ! Initialization to zero
-      ! ----------------------
-
-      !     before fields       !       now fields        !      after fields       !
-      ;   un   (:,:,:) = 0.e0   ;   ua   (:,:,:) = 0.e0
-      ;   vn   (:,:,:) = 0.e0   ;   va   (:,:,:) = 0.e0
-      ;                         ;   wn   (:,:,:) = 0.e0   
-      ;   hdivn(:,:,:) = 0.e0   ;
-
-      ;   tn   (:,:,:) = 0.e0   ;   ta   (:,:,:) = 0.e0
-      ;   sn   (:,:,:) = 0.e0   ;   sa   (:,:,:) = 0.e0
-
+      !
+      !     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
 
Index: trunk/NEMOGCM/NEMO/OFF_SRC/lbclnk.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OFF_SRC/lbclnk.F90	(revision 2527)
+++ 	(revision )
@@ -1,714 +1,0 @@
-MODULE lbclnk
-   !!======================================================================
-   !!                       ***  MODULE  lbclnk  ***
-   !! Ocean        : lateral boundary conditions
-   !!=====================================================================
-#if   defined key_mpp_mpi   ||   defined key_mpp_shmem
-   !!----------------------------------------------------------------------
-   !!   'key_mpp_mpi'     OR      MPI massively parallel processing library
-   !!   'key_mpp_shmem'         SHMEM massively parallel processing library
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !!   lbc_lnk      : generic interface for mpp_lnk_3d and mpp_lnk_2d
-   !!                  routines defined in lib_mpp
-   !!   lbc_lnk_e    : generic interface for mpp_lnk_2d_e
-   !!                   routinee defined in lib_mpp
-   !!----------------------------------------------------------------------
-   !! * Modules used
-   USE lib_mpp          ! distributed memory computing library
-
-   INTERFACE lbc_lnk
-      MODULE PROCEDURE mpp_lnk_3d_gather, mpp_lnk_3d, mpp_lnk_2d
-   END INTERFACE
-
-   INTERFACE lbc_lnk_e
-      MODULE PROCEDURE mpp_lnk_2d_e
-   END INTERFACE
-
-   PUBLIC lbc_lnk       ! ocean lateral boundary conditions
-   PUBLIC lbc_lnk_e
-   !!----------------------------------------------------------------------
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option                              shared memory computing
-   !!----------------------------------------------------------------------
-   !!   lbc_lnk      : generic interface for lbc_lnk_3d and lbc_lnk_2d
-   !!   lbc_lnk_3d   : set the lateral boundary condition on a 3D variable
-   !!                  on OPA ocean mesh
-   !!   lbc_lnk_2d   : set the lateral boundary condition on a 2D variable
-   !!                  on OPA ocean mesh
-   !!----------------------------------------------------------------------
-   !! * Modules used
-   USE oce             ! ocean dynamics and tracers   
-   USE dom_oce         ! ocean space and time domain 
-   USE in_out_manager  ! I/O manager
-
-   IMPLICIT NONE
-   PRIVATE
-
-   INTERFACE lbc_lnk
-      MODULE PROCEDURE lbc_lnk_3d_gather, lbc_lnk_3d, lbc_lnk_2d
-   END INTERFACE
-
-   INTERFACE lbc_lnk_e
-      MODULE PROCEDURE lbc_lnk_2d
-   END INTERFACE
-
-   PUBLIC lbc_lnk       ! ocean/ice  lateral boundary conditions
-   PUBLIC  lbc_lnk_e 
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn )
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE lbc_lnk_3d_gather  ***
-      !!
-      !! ** Purpose :   set lateral boundary conditions (non mpp case)
-      !!
-      !! ** Method  :
-      !!
-      !! History :
-      !!        !  97-06  (G. Madec)  Original code
-      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      CHARACTER(len=1), INTENT( in ) ::   &
-         cd_type1, cd_type2       ! nature of pt3d grid-points
-         !             !   = T ,  U , V , F or W  gridpoints
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   &
-         pt3d1, pt3d2          ! 3D array on which the boundary condition is applied
-      REAL(wp), INTENT( in ) ::   &
-         psgn          ! control of the sign change
-         !             !   =-1 , the sign is changed if north fold boundary
-         !             !   = 1 , no sign change
-         !             !   = 0 , no sign change and > 0 required (use the inner
-         !             !         row/column if closed boundary)
-
-      
-      !! * Local declarations
-      INTEGER  ::   ji, jk
-      INTEGER  ::   ijt, iju
-      !!----------------------------------------------------------------------
-      !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-      !! $Id$ 
-      !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-      !!----------------------------------------------------------------------
-      
-      !                                                      ! ===============
-      DO jk = 1, jpk                                         ! Horizontal slab
-         !                                                   ! ===============
-
-         !                                     ! East-West boundaries
-         !                                     ! ====================
-         SELECT CASE ( nperio )
-
-         CASE ( 1 , 4 , 6 )                    ! * cyclic east-west
-            pt3d1( 1 ,:,jk) = pt3d1(jpim1,:,jk)          ! all points
-            pt3d1(jpi,:,jk) = pt3d1(  2  ,:,jk)
-            pt3d2( 1 ,:,jk) = pt3d2(jpim1,:,jk)          
-            pt3d2(jpi,:,jk) = pt3d2(  2  ,:,jk)
-
-         CASE DEFAULT                          ! * closed
-            SELECT CASE ( cd_type1 )
-            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
-               pt3d1( 1 ,:,jk) = 0.e0
-               pt3d1(jpi,:,jk) = 0.e0
-            CASE ( 'F' )                               ! F-point
-               pt3d1(jpi,:,jk) = 0.e0
-            END SELECT
-            SELECT CASE ( cd_type2 )
-            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
-               pt3d2( 1 ,:,jk) = 0.e0
-               pt3d2(jpi,:,jk) = 0.e0
-            CASE ( 'F' )                               ! F-point
-               pt3d2(jpi,:,jk) = 0.e0
-            END SELECT
-
-         END SELECT
-
-         !                                     ! North-South boundaries
-         !                                     ! ======================
-         SELECT CASE ( nperio )
-
-         CASE ( 2 )                            ! *  south symmetric
-
-            SELECT CASE ( cd_type1 )
-            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
-               pt3d1(:, 1 ,jk) = pt3d1(:,3,jk)
-               pt3d1(:,jpj,jk) = 0.e0
-            CASE ( 'V' , 'F' )                         ! V-, F-points
-               pt3d1(:, 1 ,jk) = psgn * pt3d1(:,2,jk)
-               pt3d1(:,jpj,jk) = 0.e0
-            END SELECT
-            SELECT CASE ( cd_type2 )
-            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
-               pt3d2(:, 1 ,jk) = pt3d2(:,3,jk)
-               pt3d2(:,jpj,jk) = 0.e0
-            CASE ( 'V' , 'F' )                         ! V-, F-points
-               pt3d2(:, 1 ,jk) = psgn * pt3d2(:,2,jk)
-               pt3d2(:,jpj,jk) = 0.e0
-            END SELECT
-
-         CASE ( 3 , 4 )                        ! *  North fold  T-point pivot
-
-            pt3d1( 1 ,jpj,jk) = 0.e0
-            pt3d1(jpi,jpj,jk) = 0.e0
-            pt3d2( 1 ,jpj,jk) = 0.e0
-            pt3d2(jpi,jpj,jk) = 0.e0
-
-            SELECT CASE ( cd_type1 )
-            CASE ( 'T' , 'W' )                         ! T-, W-point
-               DO ji = 2, jpi
-                  ijt = jpi-ji+2
-                  pt3d1(ji, 1 ,jk) = 0.e0
-                  pt3d1(ji,jpj,jk) = psgn * pt3d1(ijt,jpj-2,jk)
-               END DO
-               DO ji = jpi/2+1, jpi
-                  ijt = jpi-ji+2
-                  pt3d1(ji,jpjm1,jk) = psgn * pt3d1(ijt,jpjm1,jk)
-               END DO
-            CASE ( 'U' )                               ! U-point
-               DO ji = 1, jpi-1
-                  iju = jpi-ji+1
-                  pt3d1(ji, 1 ,jk) = 0.e0
-                  pt3d1(ji,jpj,jk) = psgn * pt3d1(iju,jpj-2,jk)
-               END DO
-               DO ji = jpi/2, jpi-1
-                  iju = jpi-ji+1
-                  pt3d1(ji,jpjm1,jk) = psgn * pt3d1(iju,jpjm1,jk)
-               END DO
-            CASE ( 'V' )                               ! V-point
-                  DO ji = 2, jpi
-                     ijt = jpi-ji+2
-                     pt3d1(ji,  1  ,jk) = 0.e0
-                     pt3d1(ji,jpj-1,jk) = psgn * pt3d1(ijt,jpj-2,jk)
-                     pt3d1(ji,jpj  ,jk) = psgn * pt3d1(ijt,jpj-3,jk)
-                  END DO
-            CASE ( 'F' )                               ! F-point
-                  DO ji = 1, jpi-1
-                     iju = jpi-ji+1
-                     pt3d1(ji,jpj-1,jk) = psgn * pt3d1(iju,jpj-2,jk)
-                     pt3d1(ji,jpj  ,jk) = psgn * pt3d1(iju,jpj-3,jk)
-                  END DO
-            END SELECT
-            SELECT CASE ( cd_type2 )
-            CASE ( 'T' , 'W' )                         ! T-, W-point
-               DO ji = 2, jpi
-                  ijt = jpi-ji+2
-                  pt3d2(ji, 1 ,jk) = 0.e0
-                  pt3d2(ji,jpj,jk) = psgn * pt3d2(ijt,jpj-2,jk)
-               END DO
-               DO ji = jpi/2+1, jpi
-                  ijt = jpi-ji+2
-                  pt3d2(ji,jpjm1,jk) = psgn * pt3d2(ijt,jpjm1,jk)
-               END DO
-            CASE ( 'U' )                               ! U-point
-               DO ji = 1, jpi-1
-                  iju = jpi-ji+1
-                  pt3d2(ji, 1 ,jk) = 0.e0
-                  pt3d2(ji,jpj,jk) = psgn * pt3d2(iju,jpj-2,jk)
-               END DO
-               DO ji = jpi/2, jpi-1
-                  iju = jpi-ji+1
-                  pt3d2(ji,jpjm1,jk) = psgn * pt3d2(iju,jpjm1,jk)
-               END DO
-            CASE ( 'V' )                               ! V-point
-                  DO ji = 2, jpi
-                     ijt = jpi-ji+2
-                     pt3d2(ji,  1  ,jk) = 0.e0
-                     pt3d2(ji,jpj-1,jk) = psgn * pt3d2(ijt,jpj-2,jk)
-                     pt3d2(ji,jpj  ,jk) = psgn * pt3d2(ijt,jpj-3,jk)
-                  END DO
-            CASE ( 'F' )                               ! F-point
-                  DO ji = 1, jpi-1
-                     iju = jpi-ji+1
-                     pt3d2(ji,jpj-1,jk) = psgn * pt3d2(iju,jpj-2,jk)
-                     pt3d2(ji,jpj  ,jk) = psgn * pt3d2(iju,jpj-3,jk)
-                  END DO
-            END SELECT
-
-         CASE ( 5 , 6 )                        ! *  North fold  F-point pivot
-
-            pt3d1( 1 ,jpj,jk) = 0.e0
-            pt3d1(jpi,jpj,jk) = 0.e0
-            pt3d2( 1 ,jpj,jk) = 0.e0
-            pt3d2(jpi,jpj,jk) = 0.e0
-
-            SELECT CASE ( cd_type1 )
-            CASE ( 'T' , 'W' )                         ! T-, W-point
-               DO ji = 1, jpi
-                  ijt = jpi-ji+1
-                  pt3d1(ji, 1 ,jk) = 0.e0
-                  pt3d1(ji,jpj,jk) = psgn * pt3d1(ijt,jpj-1,jk)
-               END DO
-            CASE ( 'U' )                               ! U-point
-                  DO ji = 1, jpi-1
-                     iju = jpi-ji
-                     pt3d1(ji, 1 ,jk) = 0.e0
-                     pt3d1(ji,jpj,jk) = psgn * pt3d1(iju,jpj-1,jk)
-                  END DO
-            CASE ( 'V' )                               ! V-point
-                  DO ji = 1, jpi
-                     ijt = jpi-ji+1
-                     pt3d1(ji, 1 ,jk) = 0.e0
-                     pt3d1(ji,jpj,jk) = psgn * pt3d1(ijt,jpj-2,jk)
-                  END DO
-                  DO ji = jpi/2+1, jpi
-                     ijt = jpi-ji+1
-                     pt3d1(ji,jpjm1,jk) = psgn * pt3d1(ijt,jpjm1,jk)
-                  END DO
-            CASE ( 'F' )                               ! F-point
-                  DO ji = 1, jpi-1
-                     iju = jpi-ji
-                     pt3d1(ji,jpj  ,jk) = psgn * pt3d1(iju,jpj-2,jk)
-                  END DO
-                  DO ji = jpi/2+1, jpi-1
-                     iju = jpi-ji
-                     pt3d1(ji,jpjm1,jk) = psgn * pt3d1(iju,jpjm1,jk)
-                  END DO
-            END SELECT
-            SELECT CASE ( cd_type2 )
-            CASE ( 'T' , 'W' )                         ! T-, W-point
-               DO ji = 1, jpi
-                  ijt = jpi-ji+1
-                  pt3d2(ji, 1 ,jk) = 0.e0
-                  pt3d2(ji,jpj,jk) = psgn * pt3d2(ijt,jpj-1,jk)
-               END DO
-            CASE ( 'U' )                               ! U-point
-                  DO ji = 1, jpi-1
-                     iju = jpi-ji
-                     pt3d2(ji, 1 ,jk) = 0.e0
-                     pt3d2(ji,jpj,jk) = psgn * pt3d2(iju,jpj-1,jk)
-                  END DO
-            CASE ( 'V' )                               ! V-point
-                  DO ji = 1, jpi
-                     ijt = jpi-ji+1
-                     pt3d2(ji, 1 ,jk) = 0.e0
-                     pt3d2(ji,jpj,jk) = psgn * pt3d2(ijt,jpj-2,jk)
-                  END DO
-                  DO ji = jpi/2+1, jpi
-                     ijt = jpi-ji+1
-                     pt3d2(ji,jpjm1,jk) = psgn * pt3d2(ijt,jpjm1,jk)
-                  END DO
-            CASE ( 'F' )                               ! F-point
-                  DO ji = 1, jpi-1
-                     iju = jpi-ji
-                     pt3d2(ji,jpj  ,jk) = psgn * pt3d2(iju,jpj-2,jk)
-                  END DO
-                  DO ji = jpi/2+1, jpi-1
-                     iju = jpi-ji
-                     pt3d2(ji,jpjm1,jk) = psgn * pt3d2(iju,jpjm1,jk)
-                  END DO
-            END SELECT
-
-         CASE DEFAULT                          ! *  closed
-
-            SELECT CASE ( cd_type1 )
-            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
-               pt3d1(:, 1 ,jk) = 0.e0
-               pt3d1(:,jpj,jk) = 0.e0
-            CASE ( 'F' )                               ! F-point
-               pt3d1(:,jpj,jk) = 0.e0
-            END SELECT
-            SELECT CASE ( cd_type2 )
-            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
-               pt3d2(:, 1 ,jk) = 0.e0
-               pt3d2(:,jpj,jk) = 0.e0
-            CASE ( 'F' )                               ! F-point
-               pt3d2(:,jpj,jk) = 0.e0
-            END SELECT
-
-         END SELECT
-         !                                                   ! ===============
-      END DO                                                 !   End of slab
-      !                                                      ! ===============
-
-   END SUBROUTINE lbc_lnk_3d_gather
-
-
-   SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp )
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE lbc_lnk_3d  ***
-      !!
-      !! ** Purpose :   set lateral boundary conditions (non mpp case)
-      !!
-      !! ** Method  :
-      !!
-      !! History :
-      !!        !  97-06  (G. Madec)  Original code
-      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      CHARACTER(len=1), INTENT( in ) ::   &
-         cd_type       ! nature of pt3d grid-points
-         !             !   = T ,  U , V , F or W  gridpoints
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   &
-         pt3d          ! 3D array on which the boundary condition is applied
-      REAL(wp), INTENT( in ) ::   &
-         psgn          ! control of the sign change
-         !             !   =-1 , the sign is changed if north fold boundary
-         !             !   = 1 , no sign change
-         !             !   = 0 , no sign change and > 0 required (use the inner
-         !             !         row/column if closed boundary)
-      CHARACTER(len=3), INTENT( in ), OPTIONAL ::    &
-         cd_mpp        ! fill the overlap area only (here do nothing)
-
-      !! * Local declarations
-      INTEGER  ::   ji, jk
-      INTEGER  ::   ijt, iju
-      !!----------------------------------------------------------------------
-      !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-      !! $Id$ 
-      !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-      !!----------------------------------------------------------------------
-
-      IF (PRESENT(cd_mpp)) THEN
-         ! only fill the overlap area and extra allows 
-         ! this is in mpp case. In this module, just do nothing
-      ELSE
-      
-      !                                                      ! ===============
-      DO jk = 1, jpk                                         ! Horizontal slab
-         !                                                   ! ===============
-
-         !                                     ! East-West boundaries
-         !                                     ! ====================
-         SELECT CASE ( nperio )
-
-         CASE ( 1 , 4 , 6 )                    ! * cyclic east-west
-            pt3d( 1 ,:,jk) = pt3d(jpim1,:,jk)          ! all points
-            pt3d(jpi,:,jk) = pt3d(  2  ,:,jk)
-
-         CASE DEFAULT                          ! * closed
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
-               pt3d( 1 ,:,jk) = 0.e0
-               pt3d(jpi,:,jk) = 0.e0
-            CASE ( 'F' )                               ! F-point
-               pt3d(jpi,:,jk) = 0.e0
-            END SELECT
-
-         END SELECT
-
-         !                                     ! North-South boundaries
-         !                                     ! ======================
-         SELECT CASE ( nperio )
-
-         CASE ( 2 )                            ! *  south symmetric
-
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
-               pt3d(:, 1 ,jk) = pt3d(:,3,jk)
-               pt3d(:,jpj,jk) = 0.e0
-            CASE ( 'V' , 'F' )                         ! V-, F-points
-               pt3d(:, 1 ,jk) = psgn * pt3d(:,2,jk)
-               pt3d(:,jpj,jk) = 0.e0
-            END SELECT
-
-         CASE ( 3 , 4 )                        ! *  North fold  T-point pivot
-
-            pt3d( 1 ,jpj,jk) = 0.e0
-            pt3d(jpi,jpj,jk) = 0.e0
-
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'W' )                         ! T-, W-point
-               DO ji = 2, jpi
-                  ijt = jpi-ji+2
-                  pt3d(ji, 1 ,jk) = 0.e0
-                  pt3d(ji,jpj,jk) = psgn * pt3d(ijt,jpj-2,jk)
-               END DO
-               DO ji = jpi/2+1, jpi
-                  ijt = jpi-ji+2
-                  pt3d(ji,jpjm1,jk) = psgn * pt3d(ijt,jpjm1,jk)
-               END DO
-            CASE ( 'U' )                               ! U-point
-               DO ji = 1, jpi-1
-                  iju = jpi-ji+1
-                  pt3d(ji, 1 ,jk) = 0.e0
-                  pt3d(ji,jpj,jk) = psgn * pt3d(iju,jpj-2,jk)
-               END DO
-               DO ji = jpi/2, jpi-1
-                  iju = jpi-ji+1
-                  pt3d(ji,jpjm1,jk) = psgn * pt3d(iju,jpjm1,jk)
-               END DO
-            CASE ( 'V' )                               ! V-point
-                  DO ji = 2, jpi
-                     ijt = jpi-ji+2
-                     pt3d(ji,  1  ,jk) = 0.e0
-                     pt3d(ji,jpj-1,jk) = psgn * pt3d(ijt,jpj-2,jk)
-                     pt3d(ji,jpj  ,jk) = psgn * pt3d(ijt,jpj-3,jk)
-                  END DO
-            CASE ( 'F' )                               ! F-point
-                  DO ji = 1, jpi-1
-                     iju = jpi-ji+1
-                     pt3d(ji,jpj-1,jk) = psgn * pt3d(iju,jpj-2,jk)
-                     pt3d(ji,jpj  ,jk) = psgn * pt3d(iju,jpj-3,jk)
-                  END DO
-            END SELECT
-
-         CASE ( 5 , 6 )                        ! *  North fold  F-point pivot
-
-            pt3d( 1 ,jpj,jk) = 0.e0
-            pt3d(jpi,jpj,jk) = 0.e0
-
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'W' )                         ! T-, W-point
-               DO ji = 1, jpi
-                  ijt = jpi-ji+1
-                  pt3d(ji, 1 ,jk) = 0.e0
-                  pt3d(ji,jpj,jk) = psgn * pt3d(ijt,jpj-1,jk)
-               END DO
-            CASE ( 'U' )                               ! U-point
-                  DO ji = 1, jpi-1
-                     iju = jpi-ji
-                     pt3d(ji, 1 ,jk) = 0.e0
-                     pt3d(ji,jpj,jk) = psgn * pt3d(iju,jpj-1,jk)
-                  END DO
-            CASE ( 'V' )                               ! V-point
-                  DO ji = 1, jpi
-                     ijt = jpi-ji+1
-                     pt3d(ji, 1 ,jk) = 0.e0
-                     pt3d(ji,jpj,jk) = psgn * pt3d(ijt,jpj-2,jk)
-                  END DO
-                  DO ji = jpi/2+1, jpi
-                     ijt = jpi-ji+1
-                     pt3d(ji,jpjm1,jk) = psgn * pt3d(ijt,jpjm1,jk)
-                  END DO
-            CASE ( 'F' )                               ! F-point
-                  DO ji = 1, jpi-1
-                     iju = jpi-ji
-                     pt3d(ji,jpj  ,jk) = psgn * pt3d(iju,jpj-2,jk)
-                  END DO
-                  DO ji = jpi/2+1, jpi-1
-                     iju = jpi-ji
-                     pt3d(ji,jpjm1,jk) = psgn * pt3d(iju,jpjm1,jk)
-                  END DO
-            END SELECT
-
-         CASE DEFAULT                          ! *  closed
-
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
-               pt3d(:, 1 ,jk) = 0.e0
-               pt3d(:,jpj,jk) = 0.e0
-            CASE ( 'F' )                               ! F-point
-               pt3d(:,jpj,jk) = 0.e0
-            END SELECT
-
-         END SELECT
-         !                                                   ! ===============
-      END DO                                                 !   End of slab
-      !                                                      ! ===============
-   ENDIF
-   END SUBROUTINE lbc_lnk_3d
-
-
-   SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp )
-      !!---------------------------------------------------------------------
-      !!                 ***  ROUTINE lbc_lnk_2d  ***
-      !!
-      !! ** Purpose :   set lateral boundary conditions (non mpp case)
-      !!
-      !! ** Method  :
-      !!
-      !! History :
-      !!        !  97-06  (G. Madec)  Original code
-      !!        !  01-05  (E. Durand)  correction
-      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      CHARACTER(len=1), INTENT( in ) ::   &
-         cd_type       ! nature of pt2d grid-point
-         !             !   = T , U , V , F or W  gridpoints
-         !             !   = I sea-ice U-V gridpoint (= F ocean grid point with indice shift)
-      REAL(wp), INTENT( in ) ::   &
-         psgn          ! control of the sign change
-         !             !   =-1 , the sign is modified following the type of b.c. used
-         !             !   = 1 , no sign change
-      REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) ::   &
-         pt2d          ! 2D array on which the boundary condition is applied
-      CHARACTER(len=3), INTENT( in ), OPTIONAL ::    &
-         cd_mpp        ! fill the overlap area only (here do nothing)
-
-      !! * Local declarations
-      INTEGER  ::   ji
-      INTEGER  ::   ijt, iju
-      !!----------------------------------------------------------------------
-      !!  OPA 8.5, LODYC-IPSL (2002)
-      !!----------------------------------------------------------------------
-
-      IF (PRESENT(cd_mpp)) THEN
-         ! only fill the overlap area and extra allows 
-         ! this is in mpp case. In this module, just do nothing
-      ELSE      
-      
-      !                                        ! East-West boundaries
-      !                                        ! ====================
-      SELECT CASE ( nperio )
-
-      CASE ( 1 , 4 , 6 )                       ! * cyclic east-west
-         pt2d( 1 ,:) = pt2d(jpim1,:)
-         pt2d(jpi,:) = pt2d(  2  ,:)
-
-      CASE DEFAULT                             ! * closed 
-         SELECT CASE ( cd_type )
-         CASE ( 'T' , 'U' , 'V' , 'W' )                ! T-, U-, V-, W-points
-            pt2d( 1 ,:) = 0.e0
-            pt2d(jpi,:) = 0.e0
-         CASE ( 'F' )                                  ! F-point, ice U-V point
-            pt2d(jpi,:) = 0.e0 
-         CASE ( 'I' )                                  ! F-point, ice U-V point
-            pt2d( 1 ,:) = 0.e0 
-            pt2d(jpi,:) = 0.e0 
-         END SELECT
-
-      END SELECT
-
-      !                                        ! North-South boundaries
-      !                                        ! ======================
-      SELECT CASE ( nperio )
-
-      CASE ( 2 )                               ! * South symmetric
-
-         SELECT CASE ( cd_type )
-         CASE ( 'T' , 'U' , 'W' )                      ! T-, U-, W-points
-            pt2d(:, 1 ) = pt2d(:,3)
-            pt2d(:,jpj) = 0.e0
-         CASE ( 'V' , 'F' , 'I' )                      ! V-, F-points, ice U-V point
-            pt2d(:, 1 ) = psgn * pt2d(:,2)
-            pt2d(:,jpj) = 0.e0
-         END SELECT
-
-      CASE ( 3 , 4 )                           ! * North fold  T-point pivot
-
-         pt2d( 1 , 1 ) = 0.e0        !!!!!  bug gm ??? !Edmee
-         pt2d( 1 ,jpj) = 0.e0
-         pt2d(jpi,jpj) = 0.e0
-
-         SELECT CASE ( cd_type )
-
-         CASE ( 'T' , 'W' )                            ! T-, W-point
-            DO ji = 2, jpi
-               ijt = jpi-ji+2
-               pt2d(ji, 1 ) = 0.e0
-               pt2d(ji,jpj) = psgn * pt2d(ijt,jpj-2)
-            END DO
-            DO ji = jpi/2+1, jpi
-               ijt = jpi-ji+2
-               pt2d(ji,jpjm1) = psgn * pt2d(ijt,jpjm1)
-            END DO
-
-         CASE ( 'U' )                                  ! U-point
-            DO ji = 1, jpi-1
-               iju = jpi-ji+1
-               pt2d(ji, 1 ) = 0.e0
-               pt2d(ji,jpj) = psgn * pt2d(iju,jpj-2)
-            END DO
-            DO ji = jpi/2, jpi-1
-               iju = jpi-ji+1
-               pt2d(ji,jpjm1) = psgn * pt2d(iju,jpjm1)
-            END DO
-
-         CASE ( 'V' )                                  ! V-point
-            DO ji = 2, jpi
-               ijt = jpi-ji+2
-               pt2d(ji, 1   ) = 0.e0
-               pt2d(ji,jpj-1) = psgn * pt2d(ijt,jpj-2)
-               pt2d(ji,jpj  ) = psgn * pt2d(ijt,jpj-3)
-            END DO
-
-         CASE ( 'F' )                                  ! F-point
-            DO ji = 1, jpi-1
-               iju = jpi - ji + 1
-               pt2d(ji,jpj-1) = psgn * pt2d(iju,jpj-2)
-               pt2d(ji,jpj  ) = psgn * pt2d(iju,jpj-3)
-            END DO
-
-         CASE ( 'I' )                                  ! ice U-V point
-            pt2d(:, 1 ) = 0.e0
-            pt2d(2,jpj) = psgn * pt2d(3,jpj-1)
-            DO ji = 3, jpi
-               iju = jpi - ji + 3
-               pt2d(ji,jpj) = psgn * pt2d(iju,jpj-1)
-            END DO
-
-         END SELECT
-
-      CASE ( 5 , 6 )                           ! * North fold  F-point pivot
-
-         pt2d( 1 , 1 ) = 0.e0           !!bug  ???
-         pt2d( 1 ,jpj) = 0.e0
-         pt2d(jpi,jpj) = 0.e0
-
-         SELECT CASE ( cd_type )
-
-         CASE ( 'T' , 'W' )                            ! T-, W-point
-            DO ji = 1, jpi
-               ijt = jpi-ji+1
-               pt2d(ji, 1 ) = 0.e0
-               pt2d(ji,jpj) = psgn * pt2d(ijt,jpj-1)
-            END DO
-
-         CASE ( 'U' )                                  ! U-point
-            DO ji = 1, jpi-1
-               iju = jpi-ji
-               pt2d(ji, 1 ) = 0.e0
-               pt2d(ji,jpj) = psgn * pt2d(iju,jpj-1)
-            END DO
-
-         CASE ( 'V' )                                  ! V-point
-            DO ji = 1, jpi
-               ijt = jpi-ji+1
-               pt2d(ji, 1 ) = 0.e0
-               pt2d(ji,jpj) = psgn * pt2d(ijt,jpj-2)
-            END DO
-            DO ji = jpi/2+1, jpi
-               ijt = jpi-ji+1
-               pt2d(ji,jpjm1) = psgn * pt2d(ijt,jpjm1)
-            END DO
-
-         CASE ( 'F' )                                  ! F-point
-            DO ji = 1, jpi-1
-               iju = jpi-ji
-               pt2d(ji,jpj  ) = psgn * pt2d(iju,jpj-2)
-            END DO
-            DO ji = jpi/2+1, jpi-1
-               iju = jpi-ji
-               pt2d(ji,jpjm1) = psgn * pt2d(iju,jpjm1)
-            END DO
-
-         CASE ( 'I' )                                  ! ice U-V point
-            pt2d( : , 1 ) = 0.e0
-            pt2d( 2 ,jpj) = 0.e0
-            DO ji = 2 , jpim1
-               ijt = jpi - ji + 2
-               pt2d(ji,jpj)= 0.5 * ( pt2d(ji,jpjm1) + psgn * pt2d(ijt,jpjm1) )
-            END DO
-
-         END SELECT
-
-      CASE DEFAULT                             ! * closed
-
-         SELECT CASE ( cd_type )
-         CASE ( 'T' , 'U' , 'V' , 'W' )                ! T-, U-, V-, W-points
-            pt2d(:, 1 ) = 0.e0
-            pt2d(:,jpj) = 0.e0
-         CASE ( 'F' )                                  ! F-point
-            pt2d(:,jpj) = 0.e0
-         CASE ( 'I' )                                  ! ice U-V point
-            pt2d(:, 1 ) = 0.e0
-            pt2d(:,jpj) = 0.e0
-         END SELECT
-
-      END SELECT
-
-      ENDIF
-      
-   END SUBROUTINE lbc_lnk_2d
-
-#endif
-
-   !!======================================================================
-END MODULE lbclnk
Index: trunk/NEMOGCM/NEMO/OFF_SRC/lib_cray.f90
===================================================================
--- trunk/NEMOGCM/NEMO/OFF_SRC/lib_cray.f90	(revision 2527)
+++ 	(revision )
@@ -1,60 +1,0 @@
-!  Cray subroutines or functions used by OPA model and possibly 
-!  not found on other platforms.
-!
-!  check their existence
-!  
-!  sdot
-!  wheneq
-!  saxpy
-!  isrchne
-!!----------------------------------------------------------------------
-!!  OPA 9.0 , LOCEAN-IPSL (2005) 
-!! $Id$ 
-!! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-!!----------------------------------------------------------------------
-     FUNCTION sdot( I, X, J, Y, K )
-        DIMENSION X(1), Y(1)
-        SDOT = 0.
-        DO N = 1, I
-        SDOT = SDOT + X(1+(N-1)*J) * Y(1+(N-1)*K)
-        END DO
-     END FUNCTION sdot
-!---------------------------------------------------------
-     SUBROUTINE wheneq ( i, x, j, t, ind, nn )
-        IMPLICIT NONE
-
-        INTEGER , INTENT (  in ) :: i, j
-        INTEGER , INTENT ( out ) :: nn
-        REAL    , INTENT (  in ), DIMENSION (1+(i-1)*j) :: x
-        REAL    , INTENT (  in ) :: t
-        INTEGER , INTENT ( out ), DIMENSION (1+(i-1)*j) :: ind
-        INTEGER :: n, k
-        nn = 0
-        DO n = 1, i
-          k = 1 + (n-1) * j
-          IF ( x ( k) == t ) THEN 
-              nn = nn + 1
-              ind (nn) = k
-          ENDIF
-        END DO 
-
-     END SUBROUTINE wheneq
-!---------------------------------------------------------
-     SUBROUTINE saxpy( I, A, X, J, Y, K )
-        DIMENSION X(1),Y(1)
-        DO N = 1, I
-           Y(1+(N-1)*K)=A*X(1+(N-1)*J)+Y(1+(N-1)*K)
-        END DO
-     END SUBROUTINE saxpy
-!---------------------------------------------------------
-     FUNCTION isrchne( K, X, I, B )
-        DIMENSION X(1)
-        DO N = 1, K
-           IF( X(1+(N-1)*I) /= B ) THEN
-              ISRCHNE = N
-              RETURN
-           ELSE
-              ISRCHNE = N + 1
-           ENDIF
-        END DO
-     END FUNCTION isrchne
Index: trunk/NEMOGCM/NEMO/OFF_SRC/lib_isml.f90
===================================================================
--- trunk/NEMOGCM/NEMO/OFF_SRC/lib_isml.f90	(revision 2527)
+++ 	(revision )
@@ -1,674 +1,0 @@
-!
-! subroutines for PCG or SOR solvers
-! (used if the ISML library is not available)
-!
-! linrg
-!   gauss
-!   vmov
-!   desremopt
-!   dtrsv
-!   dger
-!   xerbla
-!   lsame
-! folr (empty)
-!
-!!----------------------------------------------------------------------
-!!  OPA 9.0 , LOCEAN-IPSL (2005) 
-!! $Id$ 
-!! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-!!----------------------------------------------------------------------
-   SUBROUTINE linrg(kn,pa,klda,painv,kldainv)
-
-      !! compute inverse matrix
-
-      IMPLICIT NONE 
-      INTEGER kn,klda,kldainv
-      REAL (kind=8) ::   pa(kn,kn),painv(kn,kn)
-      REAL (kind=8) ::   zb(kn,kn)
-      REAL (kind=8) ::   zv(kn)
-      INTEGER iplin(kn)
-      INTEGER ji
-
-      IF( kn /= klda .OR. kn /= kldainv ) THEN 
-          write(0,*)'change your parameters'
-          STOP 
-      ENDIF 
-
-      CALL vmov( kn*kn, pa, painv )
-
-      CALL gauss( kn, painv, iplin, zv )
-
-      zb(:,:) = 0.e0   
-      DO ji = 1, kn
-        zb(ji,ji) = 1.e0
-        CALL desremopt( kn, painv, iplin, zb(1,ji), zb(1,ji), zv )
-      END DO 
-      CALL vmov( kn*kn, zb, painv )
-
-   END SUBROUTINE linrg
-!---------------------------------------------------------
-   SUBROUTINE gauss(kn,pa,kplin,pv)
-
-      IMPLICIT NONE 
-      INTEGER kn
-      INTEGER ji,jj,jk
-      INTEGER ik,ipp
-      REAL (kind=8) ::   pa(kn,kn),pv(kn)
-!!    REAL (kind=8) ::   zpivmax,zalpha
-      REAL (kind=8) ::   zalpha
-      INTEGER kplin(kn)
-      INTEGER isamax
-      EXTERNAL isamax
-
-!  factorisation de Gauss de la matrice a avec pivot partiel . 
-!  initialisation des pointeurs .
-      DO ji=1,kn
-        kplin(ji)=ji
-      END DO 
-      DO jk=1,kn-1
-!  recherche du pivot maximal .
-!!      ik=jk
-!!      zpivmax=dabs(pa(jk,jk))
-!!        DO ji=jk,kn
-!!          IF(dabs(pa(ji,jk)) > zpivmax) THEN 
-!!            zpivmax=dabs(pa(ji,jk))
-!!            ik=ji
-!!          ENDIF 
-!!        END DO 
-        ik=isamax( kn-jk+1, pa(jk,jk) )+jk-1
-!  permutation de la ligne jk et de la ligne ik .
-        IF(jk == 58) THEN
-            PRINT *,'matrix ',(pa(jk,ji),ji=1,kn)
-            PRINT *,' pivot ',ik,kplin(ik),kplin(jk)
-        ENDIF 
-        ipp=kplin(ik)
-        kplin(ik)=kplin(jk)
-        kplin(jk)=ipp
-        DO jj=1,kn
-          pv(jj)=pa(ik,jj)
-          pa(ik,jj)=pa(jk,jj)
-          pa(jk,jj)=pv(jj)
-        END DO 
-        IF(jk == 58) THEN
-            PRINT *,'matrix ',(pa(jk,ji),ji=1,kn)
-            PRINT *,' pivot ',ik,kplin(ik),kplin(jk)
-        ENDIF 
-!  calcul des coefficients de la colonne k ligne a ligne .
-        DO ji=jk+1,kn
-          IF(pa(jk,jk) == 0) THEN 
-              PRINT *,'probleme diagonale nulle',jk,pa(jk,jk)
-              pa(ji,jk)=pa(ji,jk)/1.E-20
-          ENDIF 
-          IF(pa(jk,jk) /= 0) pa(ji,jk)=pa(ji,jk)/pa(jk,jk)
-        END DO 
-!!        DO ji=jk+1,kn
-!!          DO jj=jk+1,kn
-!!            pa(ji,jj)=pa(ji,jj)-pa(ji,jk)*pa(jk,jj)
-!!          END DO 
-!!        END DO 
-        zalpha=-1.
-        CALL dger(kn-jk,kn-jk,zalpha,pa(jk+1,jk),1,pa(jk,jk+1),kn,   &
-            pa(jk+1,jk+1),kn)
-      END DO 
-
-   END SUBROUTINE gauss
-!---------------------------------------------------------
-   FUNCTION isamax( I, X )
-      DIMENSION X(I)
-      ISAMAX = 0
-      XMIN = -1e+50
-      DO N = 1, I
-         IF(ABS(X(N)) > XMIN ) THEN
-            XMIN = X(N)
-            ISAMAX = N
-         ENDIF
-      END DO
-   END FUNCTION isamax
-!---------------------------------------------------------
-   SUBROUTINE vmov(kn,px,py)
-
-      IMPLICIT NONE 
-      INTEGER kn
-      REAL (kind=8) ::   px(kn),py(kn)
-      INTEGER ji
-
-      DO ji=1,kn
-         py(ji)=px(ji)
-      END DO 
-
-   END SUBROUTINE vmov
-!---------------------------------------------------------
-   subroutine desremopt(n,a,plin,y,x,v)
-      implicit none
-      integer n,i,  j0
-!!    integer n,i,j,j0
-      real (kind=8) ::   a(n,n),x(n),y(n),v(n)
-      integer plin(n)
-!  descente remontee du systeme .
-!  initialisation du vecteur resultat .
-!  prise en compte de la permutation des lignes .
-      do i=1,n
-        v(i)=y(plin(i))
-      end do
-      do i=1,n
-        if(v(i) /= 0.) then
-          j0=i-1
-          goto 1
-        endif
-      end do
-1     continue
-!  descente du systeme L v = v , L est a diagonale unitaire .
-!!      do j=j0+1,n
-!!        do i=j+1,n
-!!          v(i)=v(i)-a(i,j)*v(j)
-!!        end do
-!!      end do
-      call dtrsv('L','N','U',n-j0,a(j0+1,j0+1),n,v(j0+1),1)
-!  remontee du systeme U v = v . 
-!!      do j=n,1,-1
-!!        v(j)=v(j)/a(j,j)
-!!        do i=1,j-1
-!!          v(i)=v(i)-a(i,j)*v(j)
-!!        end do
-!!      end do          
-      call dtrsv('U','N','N',n,a,n,v,1)
-!  prise en compte de la permutation des colonnes .
-      do i=1,n
-        x(i)=v(i)
-      end do
-
-   end SUBROUTINE desremopt
-!---------------------------------------------------------
-   SUBROUTINE DTRSV ( UPLO, TRANS, DIAG, N, A, LDA, X, INCX )
-!!    .. Scalar Arguments ..
-      INTEGER            INCX, LDA, N
-      CHARACTER (len=1) ::   DIAG, TRANS, UPLO
-!!    .. Array Arguments ..
-!     DOUBLE PRECISION   A( LDA, * ), X( * )
-      REAL (kind=8) ::     A( LDA, * ), X( * )
-!!    ..
-
-!! Purpose
-!! =======
-
-!! DTRSV  solves one of the systems of equations
-
-!!    A*x = b,   or   A'*x = b,
-
-!! where b and x are n element vectors and A is an n by n unit, or
-!! non-unit, upper or lower triangular matrix.
-
-!! No test for singularity or near-singularity is included in this
-!! routine. Such tests must be performed before calling this routine.
-
-!! Parameters
-!! ==========
-
-!! UPLO   - CHARACTER*1.
-!!          On entry, UPLO specifies whether the matrix is an upper or
-!!          lower triangular matrix as follows:
-
-!!             UPLO = 'U' or 'u'   A is an upper triangular matrix.
-
-!!             UPLO = 'L' or 'l'   A is a lower triangular matrix.
-
-!!          Unchanged on exit.
-
-!! TRANS  - CHARACTER*1.
-!!          On entry, TRANS specifies the equations to be solved as
-!!          follows:
-
-!!             TRANS = 'N' or 'n'   A*x = b.
-
-!!             TRANS = 'T' or 't'   A'*x = b.
-
-!!             TRANS = 'C' or 'c'   A'*x = b.
-
-!!          Unchanged on exit.
-
-!! DIAG   - CHARACTER*1.
-!!          On entry, DIAG specifies whether or not A is unit
-!!          triangular as follows:
-
-!!             DIAG = 'U' or 'u'   A is assumed to be unit triangular.
-
-!!             DIAG = 'N' or 'n'   A is not assumed to be unit
-!!                                 triangular.
-
-!!          Unchanged on exit.
-
-!! N      - INTEGER.
-!!          On entry, N specifies the order of the matrix A.
-!!          N must be at least zero.
-!!          Unchanged on exit.
-
-!! A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
-!!          Before entry with  UPLO = 'U' or 'u', the leading n by n
-!!          upper triangular part of the array A must contain the upper
-!!          triangular matrix and the strictly lower triangular part of
-!!          A is not referenced.
-!!          Before entry with UPLO = 'L' or 'l', the leading n by n
-!!          lower triangular part of the array A must contain the lower
-!!          triangular matrix and the strictly upper triangular part of
-!!          A is not referenced.
-!!          Note that when  DIAG = 'U' or 'u', the diagonal elements of
-!!          A are not referenced either, but are assumed to be unity.
-!!          Unchanged on exit.
-
-!! LDA    - INTEGER.
-!!          On entry, LDA specifies the first dimension of A as declared
-!!          in the calling (sub) program. LDA must be at least
-!!          max( 1, n ).
-!!          Unchanged on exit.
-
-!! X      - DOUBLE PRECISION array of dimension at least
-!!          ( 1 + ( n - 1 )*abs( INCX ) ).
-!!          Before entry, the incremented array X must contain the n
-!!          element right-hand side vector b. On exit, X is overwritten
-!!          with the solution vector x.
-
-!! INCX   - INTEGER.
-!!          On entry, INCX specifies the increment for the elements of
-!!          X. INCX must not be zero.
-!!          Unchanged on exit.
-
-
-!! Level 2 Blas routine.
-
-!! -- Written on 22-October-1986.
-!!    Jack Dongarra, Argonne National Lab.
-!!    Jeremy Du Croz, Nag Central Office.
-!!    Sven Hammarling, Nag Central Office.
-!!    Richard Hanson, Sandia National Labs.
-
-
-!!    .. Parameters ..
-!     DOUBLE PRECISION   ZERO
-!     PARAMETER        ( ZERO = 0.0D+0 )
-      REAL (kind=8) ::                 ZERO
-      PARAMETER        ( ZERO = 0.0 )
-!!    .. Local Scalars ..
-!     DOUBLE PRECISION   TEMP
-      REAL (kind=8) ::                 TEMP
-      INTEGER            I, INFO, IX, J, JX, KX
-      LOGICAL            NOUNIT
-!!    .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-!!    .. External Subroutines ..
-      EXTERNAL           XERBLA
-!!    .. Intrinsic Functions ..
-      INTRINSIC          MAX
-!!    ..
-!!    .. Executable Statements ..
-
-!!    Test the input parameters.
-
-      INFO = 0
-      IF     ( .NOT.LSAME( UPLO , 'U' ).AND.   &
-               .NOT.LSAME( UPLO , 'L' )      )THEN
-         INFO = 1
-      ELSE IF( .NOT.LSAME( TRANS, 'N' ).AND.   &
-               .NOT.LSAME( TRANS, 'T' ).AND.   &
-               .NOT.LSAME( TRANS, 'C' )      )THEN
-         INFO = 2
-      ELSE IF( .NOT.LSAME( DIAG , 'U' ).AND.   &
-               .NOT.LSAME( DIAG , 'N' )      )THEN
-         INFO = 3
-      ELSE IF( N < 0 )THEN
-         INFO = 4
-      ELSE IF( LDA < MAX( 1, N ) )THEN
-         INFO = 6
-      ELSE IF( INCX == 0 )THEN
-         INFO = 8
-      END IF
-      IF( INFO /= 0 )THEN
-         CALL XERBLA( 'DTRSV ', INFO )
-         RETURN
-      END IF
-
-!!    Quick return if possible.
-
-      IF( N == 0 )   RETURN
-
-      NOUNIT = LSAME( DIAG, 'N' )
-
-!!    Set up the start point in X if the increment is not unity. This
-!!    will be  ( N - 1 )*INCX  too small for descending loops.
-
-      IF( INCX <= 0 )THEN
-         KX = 1 - ( N - 1 )*INCX
-      ELSE IF( INCX /= 1 )THEN
-         KX = 1
-      END IF
-
-!!    Start the operations. In this version the elements of A are
-!!    accessed sequentially with one pass through A.
-
-      IF( LSAME( TRANS, 'N' ) )THEN
-
-!!       Form  x := inv( A )*x.
-
-         IF( LSAME( UPLO, 'U' ) )THEN
-            IF( INCX == 1 )THEN
-               DO 20, J = N, 1, -1
-                  IF( X( J ) /= ZERO )THEN
-                     IF( NOUNIT )   X( J ) = X( J )/A( J, J )
-                     TEMP = X( J )
-                     DO 10, I = J - 1, 1, -1
-                        X( I ) = X( I ) - TEMP*A( I, J )
-   10                CONTINUE
-                  END IF
-   20          CONTINUE
-            ELSE
-               JX = KX + ( N - 1 )*INCX
-               DO 40, J = N, 1, -1
-                  IF( X( JX ) /= ZERO )THEN
-                     IF( NOUNIT )  X( JX ) = X( JX )/A( J, J )
-                     TEMP = X( JX )
-                     IX   = JX
-                     DO 30, I = J - 1, 1, -1
-                        IX      = IX      - INCX
-                        X( IX ) = X( IX ) - TEMP*A( I, J )
-   30                CONTINUE
-                  END IF
-                  JX = JX - INCX
-   40          CONTINUE
-            END IF
-         ELSE
-            IF( INCX == 1 )THEN
-               DO 60, J = 1, N
-                  IF( X( J ) /= ZERO )THEN
-                     IF( NOUNIT )   X( J ) = X( J )/A( J, J )
-                     TEMP = X( J )
-                     DO 50, I = J + 1, N
-                        X( I ) = X( I ) - TEMP*A( I, J )
-   50                CONTINUE
-                  END IF
-   60          CONTINUE
-            ELSE
-               JX = KX
-               DO 80, J = 1, N
-                  IF( X( JX ) /= ZERO )THEN
-                     IF( NOUNIT )   X( JX ) = X( JX )/A( J, J )
-                     TEMP = X( JX )
-                     IX   = JX
-                     DO 70, I = J + 1, N
-                        IX      = IX      + INCX
-                        X( IX ) = X( IX ) - TEMP*A( I, J )
-   70                CONTINUE
-                  END IF
-                  JX = JX + INCX
-   80          CONTINUE
-            END IF
-         END IF
-      ELSE
-
-!!       Form  x := inv( A' )*x.
-
-         IF( LSAME( UPLO, 'U' ) )THEN
-            IF( INCX == 1 )THEN
-               DO 100, J = 1, N
-                  TEMP = X( J )
-                  DO 90, I = 1, J - 1
-                     TEMP = TEMP - A( I, J )*X( I )
-   90             CONTINUE
-                  IF( NOUNIT )   TEMP = TEMP/A( J, J )
-                  X( J ) = TEMP
-  100          CONTINUE
-            ELSE
-               JX = KX
-               DO 120, J = 1, N
-                  TEMP = X( JX )
-                  IX   = KX
-                  DO 110, I = 1, J - 1
-                     TEMP = TEMP - A( I, J )*X( IX )
-                     IX   = IX   + INCX
-  110             CONTINUE
-                  IF( NOUNIT )   TEMP = TEMP/A( J, J )
-                  X( JX ) = TEMP
-                  JX      = JX   + INCX
-  120          CONTINUE
-            END IF
-         ELSE
-            IF( INCX == 1 )THEN
-               DO 140, J = N, 1, -1
-                  TEMP = X( J )
-                  DO 130, I = N, J + 1, -1
-                     TEMP = TEMP - A( I, J )*X( I )
-  130             CONTINUE
-                  IF( NOUNIT )    TEMP = TEMP/A( J, J )
-                  X( J ) = TEMP
-  140          CONTINUE
-            ELSE
-               KX = KX + ( N - 1 )*INCX
-               JX = KX
-               DO 160, J = N, 1, -1
-                  TEMP = X( JX )
-                  IX   = KX
-                  DO 150, I = N, J + 1, -1
-                     TEMP = TEMP - A( I, J )*X( IX )
-                     IX   = IX   - INCX
-  150             CONTINUE
-                  IF( NOUNIT )    TEMP = TEMP/A( J, J )
-                  X( JX ) = TEMP
-                  JX      = JX   - INCX
-  160          CONTINUE
-            END IF
-         END IF
-      END IF
-
-   END SUBROUTINE DTRSV
-!---------------------------------------------------------
-   SUBROUTINE DGER  ( M, N, ALPHA, X, INCX, Y, INCY, A, LDA )
-!!    .. Scalar Arguments ..
-!     DOUBLE PRECISION   ALPHA
-      REAL (kind=8) ::                 ALPHA
-      INTEGER            INCX, INCY, LDA, M, N
-!!    .. Array Arguments ..
-!     DOUBLE PRECISION   A( LDA, * ), X( * ), Y( * )
-      REAL (kind=8) ::   A( LDA, * ), X( * ), Y( * )
-!!    ..
-
-!! Purpose
-!! =======
-
-!! DGER   performs the rank 1 operation
-
-!!    A := alpha*x*y' + A,
-
-!! where alpha is a scalar, x is an m element vector, y is an n element
-!! vector and A is an m by n matrix.
-
-!! Parameters
-!! ==========
-
-!! M      - INTEGER.
-!!          On entry, M specifies the number of rows of the matrix A.
-!!          M must be at least zero.
-!!          Unchanged on exit.
-
-!! N      - INTEGER.
-!!          On entry, N specifies the number of columns of the matrix A.
-!!          N must be at least zero.
-!!          Unchanged on exit.
-
-!! ALPHA  - DOUBLE PRECISION.
-!!          On entry, ALPHA specifies the scalar alpha.
-!!          Unchanged on exit.
-
-!! X      - DOUBLE PRECISION array of dimension at least
-!!          ( 1 + ( m - 1 )*abs( INCX ) ).
-!!          Before entry, the incremented array X must contain the m
-!!          element vector x.
-!!          Unchanged on exit.
-
-!! INCX   - INTEGER.
-!!          On entry, INCX specifies the increment for the elements of
-!!          X. INCX must not be zero.
-!!          Unchanged on exit.
-
-!! Y      - DOUBLE PRECISION array of dimension at least
-!!          ( 1 + ( n - 1 )*abs( INCY ) ).
-!!          Before entry, the incremented array Y must contain the n
-!!          element vector y.
-!!          Unchanged on exit.
-
-!! INCY   - INTEGER.
-!!          On entry, INCY specifies the increment for the elements of
-!!          Y. INCY must not be zero.
-!!          Unchanged on exit.
-
-!! A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
-!!          Before entry, the leading m by n part of the array A must
-!!          contain the matrix of coefficients. On exit, A is
-!!          overwritten by the updated matrix.
-
-!! LDA    - INTEGER.
-!!          On entry, LDA specifies the first dimension of A as declared
-!!          in the calling (sub) program. LDA must be at least
-!!          max( 1, m ).
-!!          Unchanged on exit.
-
-
-!! Level 2 Blas routine.
-
-!! -- Written on 22-October-1986.
-!!    Jack Dongarra, Argonne National Lab.
-!!    Jeremy Du Croz, Nag Central Office.
-!!    Sven Hammarling, Nag Central Office.
-!!    Richard Hanson, Sandia National Labs.
-
-
-!!    .. Parameters ..
-!     DOUBLE PRECISION   ZERO
-!     PARAMETER        ( ZERO = 0.0D+0 )
-      REAL (kind=8) ::                 ZERO
-      PARAMETER        ( ZERO = 0.0 )
-!!    .. Local Scalars ..
-!     DOUBLE PRECISION   TEMP
-      REAL (kind=8) ::                 TEMP
-      INTEGER            I, INFO, IX, J, JY, KX
-!!    .. External Subroutines ..
-      EXTERNAL           XERBLA
-!!    .. Intrinsic Functions ..
-      INTRINSIC          MAX
-!!    ..
-!!    .. Executable Statements ..
-
-!!    Test the input parameters.
-
-      INFO = 0
-      IF     ( M < 0 )THEN
-         INFO = 1
-      ELSE IF( N < 0 )THEN
-         INFO = 2
-      ELSE IF( INCX == 0 )THEN
-         INFO = 5
-      ELSE IF( INCY == 0 )THEN
-         INFO = 7
-      ELSE IF( LDA < MAX( 1, M ) )THEN
-         INFO = 9
-      END IF
-      IF( INFO /= 0 )THEN
-         CALL XERBLA( 'DGER  ', INFO )
-         RETURN
-      END IF
-
-!!    Quick return if possible.
-
-      IF( ( M == 0 ).OR.( N == 0 ).OR.( ALPHA == ZERO ) )   &
-         RETURN
-
-!!    Start the operations. In this version the elements of A are
-!!    accessed sequentially with one pass through A.
-
-      IF( INCY > 0 )THEN
-         JY = 1
-      ELSE
-         JY = 1 - ( N - 1 )*INCY
-      END IF
-      IF( INCX == 1 )THEN
-         DO 20, J = 1, N
-            IF( Y( JY ) /= ZERO )THEN
-               TEMP = ALPHA*Y( JY )
-               DO 10, I = 1, M
-                  A( I, J ) = A( I, J ) + X( I )*TEMP
-   10          CONTINUE
-            END IF
-            JY = JY + INCY
-   20    CONTINUE
-      ELSE
-         IF( INCX > 0 )THEN
-            KX = 1
-         ELSE
-            KX = 1 - ( M - 1 )*INCX
-         END IF
-         DO 40, J = 1, N
-            IF( Y( JY ) /= ZERO )THEN
-               TEMP = ALPHA*Y( JY )
-               IX   = KX
-               DO 30, I = 1, M
-                  A( I, J ) = A( I, J ) + X( IX )*TEMP
-                  IX        = IX        + INCX
-   30          CONTINUE
-            END IF
-            JY = JY + INCY
-   40    CONTINUE
-      END IF
-
-   END SUBROUTINE DGER
-!---------------------------------------------------------
-   SUBROUTINE XERBLA ( SRNAME, INFO )
-!!    ..    Scalar Arguments ..
-      INTEGER            INFO
-      CHARACTER (len=6) ::    SRNAME
-!!    ..
-
-!! Purpose
-!! =======
-
-!! XERBLA  is an error handler for the Level 2 BLAS routines.
-
-!! It is called by the Level 2 BLAS routines if an input parameter is
-!! invalid.
-
-!! Installers should consider modifying the STOP statement in order to
-!! call system-specific exception-handling facilities.
-
-!! Parameters
-!! ==========
-
-!! SRNAME - CHARACTER*6.
-!!          On entry, SRNAME specifies the name of the routine which
-!!          called XERBLA.
-
-!! INFO   - INTEGER.
-!!          On entry, INFO specifies the position of the invalid
-!!          parameter in the parameter-list of the calling routine.
-
-
-!! Auxiliary routine for Level 2 Blas.
-
-!! Written on 20-July-1986.
-
-!!    .. Executable Statements ..
-
-      WRITE (*,99999) SRNAME, INFO
-
-      STOP
-
-99999 FORMAT ( ' ** On entry to ', A6, ' parameter number ', I2,   &
-               ' had an illegal value' )
-
-   END SUBROUTINE XERBLA
-!-----------------------------------------------------------
-   FUNCTION lsame( c1, c2 )
-      logical lsame
-      CHARACTER (len=*), INTENT(in) ::   c1, c2
-      IF( c1 == c2 ) THEN
-          lsame=.TRUE.
-      ELSE
-          lsame=.FALSE.
-      ENDIF
-   END FUNCTION lsame
Index: trunk/NEMOGCM/NEMO/OFF_SRC/lib_mpp.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OFF_SRC/lib_mpp.F90	(revision 2527)
+++ 	(revision )
@@ -1,5560 +1,0 @@
-MODULE lib_mpp
-   !!======================================================================
-   !!                       ***  MODULE  lib_mpp  ***
-   !! Ocean numerics:  massively parallel processing librairy
-   !!=====================================================================
-#if   defined key_mpp_mpi   ||   defined key_mpp_shmem
-   !!----------------------------------------------------------------------
-   !!   'key_mpp_mpi'     OR      MPI massively parallel processing library
-   !!   'key_mpp_shmem'         SHMEM massively parallel processing library
-   !!----------------------------------------------------------------------
-   !!   mynode
-   !!   mpparent
-   !!   mppshmem
-   !!   mpp_lnk     : generic interface (defined in lbclnk) for :
-   !!                 mpp_lnk_2d, mpp_lnk_3d
-   !!   mpp_lnk_3d_gather :  Message passing manadgement for two 3D arrays
-   !!   mpp_lnk_e   : interface defined in lbclnk
-   !!   mpplnks
-   !!   mpprecv
-   !!   mppsend
-   !!   mppscatter
-   !!   mppgather
-   !!   mpp_isl    : generic inteface  for :
-   !!                mppisl_int , mppisl_a_int , mppisl_real, mppisl_a_real
-   !!   mpp_min    : generic interface for : 
-   !!                mppmin_int , mppmin_a_int , mppmin_real, mppmin_a_real
-   !!   mpp_max    : generic interface for :
-   !!                mppmax_int , mppmax_a_int , mppmax_real, mppmax_a_real
-   !!   mpp_sum    : generic interface for :
-   !!                mppsum_int , mppsum_a_int , mppsum_real, mppsum_a_real
-   !!   mpp_minloc
-   !!   mpp_maxloc
-   !!   mppsync
-   !!   mppstop
-   !!   mppobc     : variant of mpp_lnk for open boundaries
-   !!   mpp_ini_north
-   !!   mpp_lbc_north
-   !!   mpp_lbc_north_e : variant of mpp_lbc_north for extra outer halo (nsolv=4)
-   !!----------------------------------------------------------------------
-   !! History :
-   !!        !  94 (M. Guyon, J. Escobar, M. Imbard)  Original code
-   !!        !  97  (A.M. Treguier)  SHMEM additions
-   !!        !  98  (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI
-   !!   9.0  !  03  (J.-M. Molines, G. Madec)  F90, free form
-   !!        !  04  (R. Bourdalle Badie)  isend option in mpi
-   !!        !  05  (G. Madec, S. Masson)  npolj=5,6 F-point & ice cases
-   !!        !  05  (R. Redler) Replacement of MPI_COMM_WORLD except for MPI_Abort
-   !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!---------------------------------------------------------------------
-   !! * Modules used
-   USE dom_oce                    ! ocean space and time domain 
-   USE in_out_manager             ! I/O manager
-
-   IMPLICIT NONE
-
-   PRIVATE
-   PUBLIC  mynode, mpparent, mpp_isl, mpp_min, mpp_max, mpp_sum,  mpp_lbc_north
-   PUBLIC  mpp_lbc_north_e, mpp_minloc, mpp_maxloc, mpp_lnk_3d, mpp_lnk_2d, mpp_lnk_3d_gather, mpp_lnk_2d_e, mpplnks
-   PUBLIC  mpprecv, mppsend, mppscatter, mppgather, mppobc, mpp_ini_north, mppstop, mppsync, mpp_ini_ice, mpp_comm_free
-#if defined key_oasis3 || defined key_oasis4
-   PUBLIC  mppsize, mpprank
-#endif
-
-   !! * Interfaces
-   !! define generic interface for these routine as they are called sometimes
-   !!        with scalar arguments instead of array arguments, which causes problems
-   !!        for the compilation on AIX system as well as NEC and SGI. Ok on COMPACQ
-
-   INTERFACE mpp_isl
-      MODULE PROCEDURE mppisl_a_int, mppisl_int, mppisl_a_real, mppisl_real
-   END INTERFACE
-   INTERFACE mpp_min
-      MODULE PROCEDURE mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real
-   END INTERFACE
-   INTERFACE mpp_max
-      MODULE PROCEDURE mppmax_a_int, mppmax_int, mppmax_a_real, mppmax_real
-   END INTERFACE
-   INTERFACE mpp_sum
-      MODULE PROCEDURE mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real
-   END INTERFACE
-   INTERFACE mpp_lbc_north
-      MODULE PROCEDURE mpp_lbc_north_3d, mpp_lbc_north_2d 
-   END INTERFACE
-  INTERFACE mpp_minloc
-     MODULE PROCEDURE mpp_minloc2d ,mpp_minloc3d
-  END INTERFACE
-  INTERFACE mpp_maxloc
-     MODULE PROCEDURE mpp_maxloc2d ,mpp_maxloc3d
-  END INTERFACE
-
-
-   !! * Share module variables
-   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .TRUE.       !: mpp flag
-
-   !! The processor number is a required power of two : 1, 2, 4, 8, 16, 32, 64, 128, 256, 512, 1024,...
-   INTEGER, PARAMETER ::   &
-      nprocmax = 2**10     ! maximun dimension
-
-#if defined key_mpp_mpi
-   !! ========================= !!
-   !!  MPI  variable definition !!
-   !! ========================= !!
-!$AGRIF_DO_NOT_TREAT
-   INCLUDE mpif.h
-!$AGRIF_END_DO_NOT_TREAT
-
-   INTEGER ::   &
-      mppsize,  &  ! number of process
-      mpprank,  &  ! process number  [ 0 - size-1 ]
-      mpi_comm_opa ! opa local communicator
-
-   ! variables used in case of sea-ice
-   INTEGER, PUBLIC ::  &       !
-      ngrp_ice,        &       ! group ID for the ice processors (to compute rheology)
-      ncomm_ice,       &       ! communicator made by the processors with sea-ice
-      ndim_rank_ice,   &       ! number of 'ice' processors
-      n_ice_root               ! number (in the comm_ice) of proc 0 in the ice comm
-   INTEGER, DIMENSION(:), ALLOCATABLE ::   &
-      nrank_ice            ! dimension ndim_rank_north, number of the procs belonging to ncomm_north
-   ! variables used in case of north fold condition in mpp_mpi with jpni > 1
-   INTEGER ::      &       !
-      ngrp_world,  &       ! group ID for the world processors
-      ngrp_north,  &       ! group ID for the northern processors (to be fold)
-      ncomm_north, &       ! communicator made by the processors belonging to ngrp_north
-      ndim_rank_north, &   ! number of 'sea' processor in the northern line (can be /= jpni !)
-      njmppmax             ! value of njmpp for the processors of the northern line
-   INTEGER ::      &       !
-      north_root           ! number (in the comm_opa) of proc 0 in the northern comm
-   INTEGER, DIMENSION(:), ALLOCATABLE ::   &
-      nrank_north          ! dimension ndim_rank_north, number of the procs belonging to ncomm_north
-   CHARACTER (len=1) ::  &
-      c_mpi_send = 'S'     ! type od mpi send/recieve (S=standard, B=bsend, I=isend)
-   LOGICAL  ::           &
-      l_isend = .FALSE.    ! isend use indicator (T if c_mpi_send='I')
-   INTEGER ::            & ! size of the buffer in case of mpi_bsend 
-      nn_buffer = 0
-   REAL(kind=wp), ALLOCATABLE, DIMENSION(:) :: tampon  ! buffer in case of bsend
-
-#elif defined key_mpp_shmem
-   !! ========================= !!
-   !! SHMEM variable definition !!
-   !! ========================= !!
-#  include  <fpvm3.h>
-#  include <mpp/shmem.fh>
-
-   CHARACTER (len=80), PARAMETER ::   simfile    = 'pvm3_ndim'   ! file name
-   CHARACTER (len=47), PARAMETER ::   executable = 'opa'         ! executable name
-   CHARACTER, PARAMETER ::            opaall     = ""            ! group name (old def opaall*(*))
-
-   INTEGER, PARAMETER ::   & !! SHMEM control print
-      mynode_print   = 0,  &  ! flag for print, mynode   routine
-      mpprecv_print  = 0,  &  ! flag for print, mpprecv  routine
-      mppsend_print  = 0,  &  ! flag for print, mppsend  routine
-      mppsync_print  = 0,  &  ! flag for print, mppsync  routine
-      mppsum_print   = 0,  &  ! flag for print, mpp_sum  routine
-      mppisl_print   = 0,  &  ! flag for print, mpp_isl  routine
-      mppmin_print   = 0,  &  ! flag for print, mpp_min  routine
-      mppmax_print   = 0,  &  ! flag for print, mpp_max  routine
-      mpparent_print = 0      ! flag for print, mpparent routine
-
-   INTEGER, PARAMETER ::   & !! Variable definition
-      jpvmint = 21            ! ???
-
-   INTEGER, PARAMETER ::   & !! Maximum  dimension of array to sum on the processors
-      jpmsec   = 50000,    &  ! ???
-      jpmpplat =    30,    &  ! ???
-      jpmppsum = MAX( jpisl*jpisl, jpmpplat*jpk, jpmsec )   ! ???
-
-   INTEGER ::   &
-      npvm_ipas ,  &  ! pvm initialization flag
-      npvm_mytid,  &  ! pvm tid
-      npvm_me   ,  &  ! node number [ 0 - nproc-1 ]
-      npvm_nproc,  &  ! real number of nodes
-      npvm_inum       ! ???
-   INTEGER, DIMENSION(0:nprocmax-1) ::   &
-      npvm_tids       ! tids array [ 0 - nproc-1 ]
-
-   INTEGER ::   &
-      nt3d_ipas ,  &  ! pvm initialization flag
-      nt3d_mytid,  &  ! pvm tid
-      nt3d_me   ,  &  ! node number [ 0 - nproc-1 ]
-      nt3d_nproc      ! real number of nodes
-   INTEGER, DIMENSION(0:nprocmax-1) ::   &
-      nt3d_tids       ! tids array [ 0 - nproc-1 ]
-
-   !! real sum reduction
-   INTEGER, DIMENSION(SHMEM_REDUCE_SYNC_SIZE) ::   &
-       nrs1sync_shmem,   &  ! 
-       nrs2sync_shmem
-   REAL(wp), DIMENSION( MAX( SHMEM_REDUCE_MIN_WRKDATA_SIZE, jpmppsum/2+1 ) ) ::   &
-       wrs1wrk_shmem,    &  !
-       wrs2wrk_shmem        !
-   REAL(wp), DIMENSION(jpmppsum) ::   &
-       wrstab_shmem         !
-
-   !! minimum and maximum reduction
-   INTEGER, DIMENSION(SHMEM_REDUCE_SYNC_SIZE) ::   &
-       ni1sync_shmem,    &  ! 
-       ni2sync_shmem        ! 
-   REAL(wp), DIMENSION( MAX( SHMEM_REDUCE_MIN_WRKDATA_SIZE, jpmppsum/2+1 ) ) ::   &
-       wi1wrk_shmem,     &  !
-       wi2wrk_shmem
-   REAL(wp), DIMENSION(jpmppsum) ::   &
-       wintab_shmem,     &  ! 
-       wi1tab_shmem,     &  ! 
-       wi2tab_shmem         ! 
-       
-       !! value not equal zero for barotropic stream function around islands
-   INTEGER, DIMENSION(SHMEM_REDUCE_SYNC_SIZE) ::   &
-       ni11sync_shmem,   &  !
-       ni12sync_shmem,   &  !
-       ni21sync_shmem,   &  !
-       ni22sync_shmem       !
-   REAL(wp), DIMENSION( MAX( SHMEM_REDUCE_MIN_WRKDATA_SIZE, jpmppsum/2+1 ) ) ::   &
-       wi11wrk_shmem,    &  ! 
-       wi12wrk_shmem,    &  !
-       wi21wrk_shmem,    &  !
-       wi22wrk_shmem        !
-   REAL(wp), DIMENSION(jpmppsum) ::   &
-       wiltab_shmem ,    &  !
-       wi11tab_shmem,    &  !
-       wi12tab_shmem,    &  ! 
-       wi21tab_shmem,    &  ! 
-       wi22tab_shmem
-
-   INTEGER, DIMENSION( MAX( SHMEM_REDUCE_MIN_WRKDATA_SIZE, jpmppsum/2+1 ) ) ::   &
-       ni11wrk_shmem,    &  !
-       ni12wrk_shmem,    &  !
-       ni21wrk_shmem,    &  !
-       ni22wrk_shmem        !
-   INTEGER, DIMENSION(jpmppsum) ::   &
-       niitab_shmem ,    &  !
-       ni11tab_shmem,    &  !
-       ni12tab_shmem        !
-   INTEGER, DIMENSION(SHMEM_REDUCE_SYNC_SIZE) ::   &
-       nis1sync_shmem,   &  !
-       nis2sync_shmem       !
-   INTEGER, DIMENSION( MAX( SHMEM_REDUCE_MIN_WRKDATA_SIZE, jpmppsum/2+1 ) ) ::   &
-       nis1wrk_shmem,    &  ! 
-       nis2wrk_shmem        !
-   INTEGER, DIMENSION(jpmppsum) ::   &
-       nistab_shmem
-
-   !! integer sum reduction
-   INTEGER, DIMENSION(SHMEM_REDUCE_SYNC_SIZE) ::   &
-       nil1sync_shmem,   &  !
-       nil2sync_shmem       !
-   INTEGER, DIMENSION( MAX( SHMEM_REDUCE_MIN_WRKDATA_SIZE, jpmppsum/2+1 ) ) ::   &
-       nil1wrk_shmem,    &  !
-       nil2wrk_shmem        !
-   INTEGER, DIMENSION(jpmppsum) ::   &
-       niltab_shmem
-#endif
-
-   REAL(wp), DIMENSION(jpi,jprecj,jpk,2,2) ::   &
-       t4ns, t4sn  ! 3d message passing arrays north-south & south-north
-   REAL(wp), DIMENSION(jpj,jpreci,jpk,2,2) ::   &
-       t4ew, t4we  ! 3d message passing arrays east-west & west-east
-   REAL(wp), DIMENSION(jpi,jprecj,jpk,2,2) ::   &
-       t4p1, t4p2  ! 3d message passing arrays north fold
-   REAL(wp), DIMENSION(jpi,jprecj,jpk,2) ::   &
-       t3ns, t3sn  ! 3d message passing arrays north-south & south-north
-   REAL(wp), DIMENSION(jpj,jpreci,jpk,2) ::   &
-       t3ew, t3we  ! 3d message passing arrays east-west & west-east
-   REAL(wp), DIMENSION(jpi,jprecj,jpk,2) ::   &
-       t3p1, t3p2  ! 3d message passing arrays north fold
-   REAL(wp), DIMENSION(jpi,jprecj,2) ::   &
-       t2ns, t2sn  ! 2d message passing arrays north-south & south-north
-   REAL(wp), DIMENSION(jpj,jpreci,2) ::   &
-       t2ew, t2we  ! 2d message passing arrays east-west & west-east
-   REAL(wp), DIMENSION(jpi,jprecj,2) ::   &
-       t2p1, t2p2  ! 2d message passing arrays north fold
-   REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,jprecj+jpr2dj,2) ::   &
-       tr2ns, tr2sn  ! 2d message passing arrays north-south & south-north including extra outer halo
-   REAL(wp), DIMENSION(1-jpr2dj:jpj+jpr2dj,jpreci+jpr2di,2) ::   &
-       tr2ew, tr2we  ! 2d message passing arrays east-west & west-east including extra outer halo
-   !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!---------------------------------------------------------------------
-
-CONTAINS
-
-   FUNCTION mynode(localComm)
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mynode  ***
-      !!                    
-      !! ** Purpose :   Find processor unit
-      !!
-      !!----------------------------------------------------------------------
-#if defined key_mpp_mpi
-      !! * Local variables   (MPI version)
-      INTEGER ::   mynode, ierr, code
-      LOGICAL ::   mpi_was_called
-      INTEGER,OPTIONAL ::   localComm
-      NAMELIST/nammpp/ c_mpi_send, nn_buffer
-      !!----------------------------------------------------------------------
-
-      WRITE(numout,*)
-      WRITE(numout,*) 'mynode : mpi initialisation'
-      WRITE(numout,*) '~~~~~~ '
-      WRITE(numout,*)
-
-      ! Namelist namrun : parameters of the run
-      REWIND( numnam )
-      READ  ( numnam, nammpp )
-
-      WRITE(numout,*) '        Namelist nammpp'
-      WRITE(numout,*) '           mpi send type            c_mpi_send = ', c_mpi_send
-
-#if defined key_agrif
-      IF( Agrif_Root() ) THEN
-#endif
-!!bug RB : should be clean to use Agrif in coupled mode
-#if ! defined key_agrif
-         CALL mpi_initialized ( mpi_was_called, code )
-         IF( code /= MPI_SUCCESS ) THEN
-            CALL ctl_stop( ' lib_mpp: Error in routine mpi_initialized' )
-            CALL mpi_abort( mpi_comm_world, code, ierr )
-         ENDIF
-
-         IF( PRESENT(localComm) .and. mpi_was_called ) THEN
-            mpi_comm_opa = localComm
-            SELECT CASE ( c_mpi_send )
-            CASE ( 'S' )                ! Standard mpi send (blocking)
-               WRITE(numout,*) '           Standard blocking mpi send (send)'
-            CASE ( 'B' )                ! Buffer mpi send (blocking)
-               WRITE(numout,*) '           Buffer blocking mpi send (bsend)'
-               CALL mpi_init_opa( ierr ) 
-            CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
-               WRITE(numout,*) '           Immediate non-blocking send (isend)'
-               l_isend = .TRUE.
-            CASE DEFAULT
-               WRITE(numout,cform_err)
-               WRITE(numout,*) '           bad value for c_mpi_send = ', c_mpi_send
-               nstop = nstop + 1
-            END SELECT
-         ELSE IF ( PRESENT(localComm) .and. .not. mpi_was_called ) THEN
-            WRITE(numout,*) ' lib_mpp: You cannot provide a local communicator '
-            WRITE(numout,*) '          without calling MPI_Init before ! '
-         ELSE
-#endif
-            SELECT CASE ( c_mpi_send )
-            CASE ( 'S' )                ! Standard mpi send (blocking)
-               WRITE(numout,*) '           Standard blocking mpi send (send)'
-               CALL mpi_init( ierr )
-            CASE ( 'B' )                ! Buffer mpi send (blocking)
-               WRITE(numout,*) '           Buffer blocking mpi send (bsend)'
-               CALL mpi_init_opa( ierr )
-            CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
-               WRITE(numout,*) '           Immediate non-blocking send (isend)'
-               l_isend = .TRUE.
-               CALL mpi_init( ierr )
-            CASE DEFAULT
-               WRITE(ctmp1,*) '           bad value for c_mpi_send = ', c_mpi_send
-               CALL ctl_stop( ctmp1 )
-            END SELECT
-
-#if ! defined key_agrif
-            CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code)
-            IF( code /= MPI_SUCCESS ) THEN
-               CALL ctl_stop( ' lib_mpp: Error in routine mpi_comm_dup' )
-               CALL mpi_abort( mpi_comm_world, code, ierr )
-            ENDIF
-            !
-         ENDIF
-#endif
-#if defined key_agrif
-      ELSE
-         SELECT CASE ( c_mpi_send )
-         CASE ( 'S' )                ! Standard mpi send (blocking)
-            WRITE(numout,*) '           Standard blocking mpi send (send)'
-         CASE ( 'B' )                ! Buffer mpi send (blocking)
-            WRITE(numout,*) '           Buffer blocking mpi send (bsend)'
-         CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
-            WRITE(numout,*) '           Immediate non-blocking send (isend)'
-            l_isend = .TRUE.
-         CASE DEFAULT
-            WRITE(numout,cform_err)
-            WRITE(numout,*) '           bad value for c_mpi_send = ', c_mpi_send
-            nstop = nstop + 1
-         END SELECT
-      ENDIF
-
-      mpi_comm_opa = mpi_comm_world
-#endif
-        CALL mpi_comm_rank( mpi_comm_opa, mpprank, ierr )
-        CALL mpi_comm_size( mpi_comm_opa, mppsize, ierr )
-      mynode = mpprank
-#else
-      !! * Local variables   (SHMEM version)
-      INTEGER ::   mynode
-      INTEGER ::   &
-           imypid, imyhost, ji, info, iparent_tid
-      !!----------------------------------------------------------------------
-
-      IF( npvm_ipas /= nprocmax ) THEN
-         !         ---   first passage in mynode
-         !         -------------
-         !         enroll in pvm
-         !         -------------
-         CALL pvmfmytid( npvm_mytid )
-         IF( mynode_print /= 0 ) THEN
-            WRITE(numout,*) 'mynode, npvm_ipas =', npvm_ipas, ' nprocmax=', nprocmax
-            WRITE(numout,*) 'mynode, npvm_mytid=', npvm_mytid, ' after pvmfmytid'
-         ENDIF
-
-         !         ---------------------------------------------------------------
-         !         find out IF i am parent or child spawned processes have parents
-         !         ---------------------------------------------------------------
-         CALL mpparent( iparent_tid )
-         IF( mynode_print /= 0 ) THEN
-            WRITE(numout,*) 'mynode, npvm_mytid=', npvm_mytid,   &
-               &            ' after mpparent, npvm_tids(0) = ',   &
-               &            npvm_tids(0), ' iparent_tid=', iparent_tid
-         ENDIF
-         IF( iparent_tid < 0 )  THEN
-            WRITE(numout,*) 'mynode, npvm_mytid=', npvm_mytid,   &
-               &            ' after mpparent, npvm_tids(0) = ',   &
-               &            npvm_tids(0), ' iparent_tid=', iparent_tid
-            npvm_tids(0) = npvm_mytid
-            npvm_me = 0
-            IF( jpnij > nprocmax ) THEN
-               WRITE(ctmp1,*) 'npvm_mytid=', npvm_mytid, ' too great'
-               CALL ctl_stop( ctmp1 )
-
-            ELSE
-               npvm_nproc = jpnij
-            ENDIF
-
-            ! -------------------------
-            ! start up copies of myself
-            ! -------------------------
-            IF( npvm_nproc > 1 ) THEN
-               DO ji = 1, npvm_nproc-1
-                  npvm_tids(ji) = nt3d_tids(ji)
-               END DO
-               info=npvm_nproc-1
-  
-               IF( mynode_print /= 0 ) THEN
-                  WRITE(numout,*) 'mynode, npvm_mytid=',npvm_mytid,   &
-                     &            ' maitre=',executable,' info=', info   &
-                     &            ,' npvm_nproc=',npvm_nproc
-                  WRITE(numout,*) 'mynode, npvm_mytid=',npvm_mytid,   &
-                     &            ' npvm_tids ',(npvm_tids(ji),ji=0,npvm_nproc-1)
-               ENDIF
-
-               ! ---------------------------
-               ! multicast tids array to children
-               ! ---------------------------
-               CALL pvmfinitsend( pvmdefault, info )
-               CALL pvmfpack ( jpvmint, npvm_nproc, 1         , 1, info )
-               CALL pvmfpack ( jpvmint, npvm_tids , npvm_nproc, 1, info )
-               CALL pvmfmcast( npvm_nproc-1, npvm_tids(1), 10, info )
-            ENDIF
-         ELSE
-
-            ! ---------------------------------
-            ! receive the tids array and set me
-            ! ---------------------------------
-            IF( mynode_print /= 0 )   WRITE(numout,*) 'mynode, npvm_mytid=',npvm_mytid, ' pvmfrecv'
-            CALL pvmfrecv( iparent_tid, 10, info )
-            IF( mynode_print /= 0 )   WRITE(numout,*) 'mynode, npvm_mytid=',npvm_mytid, " fin pvmfrecv"
-            CALL pvmfunpack( jpvmint, npvm_nproc, 1         , 1, info )
-            CALL pvmfunpack( jpvmint, npvm_tids , npvm_nproc, 1, info )
-            IF( mynode_print /= 0 ) THEN
-               WRITE(numout,*) 'mynode, npvm_mytid=',npvm_mytid,   &
-                  &            ' esclave=', executable,' info=', info,' npvm_nproc=',npvm_nproc
-               WRITE(numout,*) 'mynode, npvm_mytid=', npvm_mytid,   &
-                  &            'npvm_tids', ( npvm_tids(ji), ji = 0, npvm_nproc-1 )
-            ENDIF
-            DO ji = 0, npvm_nproc-1
-               IF( npvm_mytid == npvm_tids(ji) ) npvm_me = ji
-            END DO
-         ENDIF
-
-         ! ------------------------------------------------------------
-         ! all nproc tasks are equal now
-         ! and can address each other by tids(0) thru tids(nproc-1)
-         ! for each process me => process number [0-(nproc-1)]
-         ! ------------------------------------------------------------
-         CALL pvmfjoingroup ( "bidon", info )
-         CALL pvmfbarrier   ( "bidon", npvm_nproc, info )
-         DO ji = 0, npvm_nproc-1
-            IF( ji == npvm_me ) THEN
-               CALL pvmfjoingroup ( opaall, npvm_inum )
-               IF( npvm_inum /= npvm_me )   WRITE(numout,*) 'mynode not arrived in the good order for opaall'
-            ENDIF
-            CALL pvmfbarrier( "bidon", npvm_nproc, info )
-         END DO
-         CALL pvmfbarrier( opaall, npvm_nproc, info )
-  
-      ELSE
-         ! ---   other passage in mynode
-      ENDIF
- 
-      npvm_ipas = nprocmax
-      mynode    = npvm_me
-      imypid    = npvm_mytid
-      imyhost   = npvm_tids(0)
-      IF( mynode_print /= 0 ) THEN
-         WRITE(numout,*)'mynode: npvm_mytid=', npvm_mytid, ' npvm_me=', npvm_me,   &
-            &           ' npvm_nproc=', npvm_nproc , ' npvm_ipas=', npvm_ipas
-      ENDIF
-#endif
-   END FUNCTION mynode
-
-
-   SUBROUTINE mpparent( kparent_tid )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpparent  ***
-      !!
-      !! ** Purpose :   use an pvmfparent routine for T3E (key_mpp_shmem)
-      !!              or  only return -1 (key_mpp_mpi)
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      INTEGER, INTENT(inout) ::   kparent_tid      ! ???
-  
-#if defined key_mpp_mpi
-      ! MPI version : retour -1
-
-      kparent_tid = -1
-
-#else
-      !! * Local variables   (SHMEN onto T3E version)
-      INTEGER ::   &
-           it3d_my_pe, LEADZ, ji, info
-  
-      CALL pvmfmytid( nt3d_mytid )
-      CALL pvmfgetpe( nt3d_mytid, it3d_my_pe )
-      IF( mpparent_print /= 0 ) THEN
-         WRITE(numout,*) 'mpparent: nt3d_mytid= ', nt3d_mytid ,' it3d_my_pe=',it3d_my_pe
-      ENDIF
-      IF( it3d_my_pe == 0 ) THEN
-         !-----------------------------------------------------------------!
-         !     process = 0 => receive other tids                           !
-         !-----------------------------------------------------------------!
-         kparent_tid = -1
-         IF(mpparent_print /= 0 ) THEN
-            WRITE(numout,*) 'mpparent, nt3d_mytid=',nt3d_mytid ,' kparent_tid=',kparent_tid
-         ENDIF
-         !          --- END receive dimension ---
-         IF( jpnij > nprocmax ) THEN
-            WRITE(ctmp1,*) 'mytid=',nt3d_mytid,' too great'
-            CALL ctl_stop( ctmp1 )
-         ELSE
-            nt3d_nproc =  jpnij
-         ENDIF
-         IF( mpparent_print /= 0 ) THEN
-            WRITE(numout,*) 'mpparent, nt3d_mytid=', nt3d_mytid , ' nt3d_nproc=', nt3d_nproc
-         ENDIF
-         !-------- receive tids from others process --------
-         DO ji = 1, nt3d_nproc-1
-            CALL pvmfrecv( ji , 100, info )
-            CALL pvmfunpack( jpvmint, nt3d_tids(ji), 1, 1, info )
-            IF( mpparent_print /= 0 ) THEN
-               WRITE(numout,*) 'mpparent, nt3d_mytid=', nt3d_mytid , ' receive=', nt3d_tids(ji), ' from = ', ji
-            ENDIF
-         END DO
-         nt3d_tids(0) = nt3d_mytid
-         IF( mpparent_print /= 0 ) THEN
-            WRITE(numout,*) 'mpparent, nt3d_mytid=', nt3d_mytid , ' nt3d_tids(ji) =', (nt3d_tids(ji),   &
-                 ji = 0, nt3d_nproc-1 )
-            WRITE(numout,*) 'mpparent, nt3d_mytid=', nt3d_mytid , ' kparent_tid=', kparent_tid
-         ENDIF
-
-      ELSE
-         !!----------------------------------------------------------------!
-         !     process <> 0 => send  other tids                            !
-         !!----------------------------------------------------------------!
-         kparent_tid = 0
-         CALL pvmfinitsend( pvmdataraw, info )
-         CALL pvmfpack( jpvmint, nt3d_mytid, 1, 1, info )
-         CALL pvmfsend( kparent_tid, 100, info )
-      ENDIF
-#endif
-
-   END SUBROUTINE mpparent
-
-#if defined key_mpp_shmem
-
-   SUBROUTINE mppshmem
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppshmem  ***
-      !!
-      !! ** Purpose :   SHMEM ROUTINE
-      !!
-      !!----------------------------------------------------------------------
-      nrs1sync_shmem = SHMEM_SYNC_VALUE
-      nrs2sync_shmem = SHMEM_SYNC_VALUE
-      nis1sync_shmem = SHMEM_SYNC_VALUE
-      nis2sync_shmem = SHMEM_SYNC_VALUE
-      nil1sync_shmem = SHMEM_SYNC_VALUE
-      nil2sync_shmem = SHMEM_SYNC_VALUE
-      ni11sync_shmem = SHMEM_SYNC_VALUE
-      ni12sync_shmem = SHMEM_SYNC_VALUE
-      ni21sync_shmem = SHMEM_SYNC_VALUE
-      ni22sync_shmem = SHMEM_SYNC_VALUE
-      CALL barrier()
-  
-   END SUBROUTINE mppshmem
-
-#endif
-
-   SUBROUTINE mpp_lnk_3d( ptab, cd_type, psgn, cd_mpp, pval )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_3d  ***
-      !!
-      !! ** Purpose :   Message passing manadgement
-      !!
-      !! ** Method  :   Use mppsend and mpprecv function for passing mask 
-      !!      between processors following neighboring subdomains.
-      !!            domain parameters
-      !!                    nlci   : first dimension of the local subdomain
-      !!                    nlcj   : second dimension of the local subdomain
-      !!                    nbondi : mark for "east-west local boundary"
-      !!                    nbondj : mark for "north-south local boundary"
-      !!                    noea   : number for local neighboring processors 
-      !!                    nowe   : number for local neighboring processors
-      !!                    noso   : number for local neighboring processors
-      !!                    nono   : number for local neighboring processors
-      !!
-      !! ** Action  :   ptab with update value at its periphery
-      !!
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      CHARACTER(len=1) , INTENT( in ) ::   &
-         cd_type       ! define the nature of ptab array grid-points
-         !             ! = T , U , V , F , W points
-         !             ! = S : T-point, north fold treatment ???
-         !             ! = G : F-point, north fold treatment ???
-      REAL(wp), INTENT( in ) ::   &
-         psgn          ! control of the sign change
-         !             !   = -1. , the sign is changed if north fold boundary
-         !             !   =  1. , the sign is kept  if north fold boundary
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   &
-         ptab          ! 3D array on which the boundary condition is applied
-      CHARACTER(len=3), INTENT( in ), OPTIONAL ::    &
-         cd_mpp        ! fill the overlap area only 
-      REAL(wp)        , INTENT(in   ), OPTIONAL           ::   pval      ! background value (used at closed boundaries)
-
-      !! * Local variables
-      INTEGER ::   ji, jj, jk, jl                        ! dummy loop indices
-      INTEGER ::   imigr, iihom, ijhom, iloc, ijt, iju   ! temporary integers
-      INTEGER ::   ml_req1, ml_req2, ml_err     ! for key_mpi_isend
-      INTEGER ::   ml_stat(MPI_STATUS_SIZE)     ! for key_mpi_isend
-      REAL(wp) ::   zland
-      !!----------------------------------------------------------------------
-
-      ! 1. standard boundary treatment
-      ! ------------------------------
-
-      IF( PRESENT( pval ) ) THEN      ! set land value (zero by default)
-         zland = pval
-      ELSE
-         zland = 0.e0
-      ENDIF
-
-      IF( PRESENT( cd_mpp ) ) THEN
-         DO jj = nlcj+1, jpj   ! only fill extra allows last line
-            ptab(1:nlci, jj, :) = ptab(1:nlci, nlej, :)
-         END DO
-         DO ji = nlci+1, jpi   ! only fill extra allows last column
-            ptab(ji    , : , :) = ptab(nlei  , :   , :)
-         END DO
-      ELSE      
-
-         !                                        ! East-West boundaries
-         !                                        ! ====================
-         IF( nbondi == 2 .AND.   &      ! Cyclic east-west
-            &   (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
-            ptab( 1 ,:,:) = ptab(jpim1,:,:)
-            ptab(jpi,:,:) = ptab(  2  ,:,:)
-
-         ELSE                           ! closed
-            SELECT CASE ( cd_type )
-            CASE ( 'T', 'U', 'V', 'W' )
-               ptab(     1       :jpreci,:,:) = zland
-               ptab(nlci-jpreci+1:jpi   ,:,:) = zland
-            CASE ( 'F' )
-               ptab(nlci-jpreci+1:jpi   ,:,:) = zland
-            END SELECT 
-         ENDIF
-
-         !                                        ! North-South boundaries
-         !                                        ! ======================
-         SELECT CASE ( cd_type )
-         CASE ( 'T', 'U', 'V', 'W' )
-            ptab(:,     1       :jprecj,:) = zland
-            ptab(:,nlcj-jprecj+1:jpj   ,:) = zland
-         CASE ( 'F' )
-            ptab(:,nlcj-jprecj+1:jpj   ,:) = zland
-         END SELECT
-     
-      ENDIF
-
-      ! 2. East and west directions exchange
-      ! ------------------------------------
-
-      ! 2.1 Read Dirichlet lateral conditions
-
-      SELECT CASE ( nbondi )
-      CASE ( -1, 0, 1 )    ! all exept 2 
-         iihom = nlci-nreci
-         DO jl = 1, jpreci
-            t3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)
-            t3we(:,jl,:,1) = ptab(iihom +jl,:,:)
-         END DO
-      END SELECT
-
-      ! 2.2 Migrations
-
-#if defined key_mpp_shmem
-      !! * SHMEM version
-
-      imigr = jpreci * jpj * jpk
-
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         CALL shmem_put( t3we(1,1,1,2), t3we(1,1,1,1), imigr, noea )
-      CASE ( 0 )
-         CALL shmem_put( t3ew(1,1,1,2), t3ew(1,1,1,1), imigr, nowe )
-         CALL shmem_put( t3we(1,1,1,2), t3we(1,1,1,1), imigr, noea )
-      CASE ( 1 )
-         CALL shmem_put( t3ew(1,1,1,2), t3ew(1,1,1,1), imigr, nowe )
-      END SELECT
-
-      CALL barrier()
-      CALL shmem_udcflush()
-
-#elif defined key_mpp_mpi
-      !! * Local variables   (MPI version)
-
-      imigr = jpreci * jpj * jpk
-
-      SELECT CASE ( nbondi ) 
-      CASE ( -1 )
-         CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req1 )
-         CALL mpprecv( 1, t3ew(1,1,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 )
-         CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req2 )
-         CALL mpprecv( 1, t3ew(1,1,1,2), imigr )
-         CALL mpprecv( 2, t3we(1,1,1,2), imigr )
-         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, t3ew(1,1,1,1), imigr, nowe, ml_req1 )
-         CALL mpprecv( 2, t3we(1,1,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
-#endif
-
-      ! 2.3 Write Dirichlet lateral conditions
-
-      iihom = nlci-jpreci
-
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         DO jl = 1, jpreci
-            ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)
-         END DO
-      CASE ( 0 ) 
-         DO jl = 1, jpreci
-            ptab(jl      ,:,:) = t3we(:,jl,:,2)
-            ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jpreci
-            ptab(jl      ,:,:) = t3we(:,jl,:,2)
-         END DO
-      END SELECT
-
-
-      ! 3. North and south directions
-      ! -----------------------------
-
-      ! 3.1 Read Dirichlet lateral conditions
-
-      IF( nbondj /= 2 ) THEN
-         ijhom = nlcj-nrecj
-         DO jl = 1, jprecj
-            t3sn(:,jl,:,1) = ptab(:,ijhom +jl,:)
-            t3ns(:,jl,:,1) = ptab(:,jprecj+jl,:)
-         END DO
-      ENDIF
-
-      ! 3.2 Migrations
-
-#if defined key_mpp_shmem
-      !! * SHMEM version
-
-      imigr = jprecj * jpi * jpk
-
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         CALL shmem_put( t3sn(1,1,1,2), t3sn(1,1,1,1), imigr, nono )
-      CASE ( 0 )
-         CALL shmem_put( t3ns(1,1,1,2), t3ns(1,1,1,1), imigr, noso )
-         CALL shmem_put( t3sn(1,1,1,2), t3sn(1,1,1,1), imigr, nono )
-      CASE ( 1 )
-         CALL shmem_put( t3ns(1,1,1,2), t3ns(1,1,1,1), imigr, noso )
-      END SELECT
-
-      CALL barrier()
-      CALL shmem_udcflush()
-
-#elif defined key_mpp_mpi
-      !! * Local variables   (MPI version)
-  
-      imigr=jprecj*jpi*jpk
-
-      SELECT CASE ( nbondj )     
-      CASE ( -1 )
-         CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req1 )
-         CALL mpprecv( 3, t3ns(1,1,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 )
-         CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req2 )
-         CALL mpprecv( 3, t3ns(1,1,1,2), imigr )
-         CALL mpprecv( 4, t3sn(1,1,1,2), imigr )
-         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, t3ns(1,1,1,1), imigr, noso, ml_req1 )
-         CALL mpprecv( 4, t3sn(1,1,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
-
-#endif
-
-      ! 3.3 Write Dirichlet lateral conditions
-
-      ijhom = nlcj-jprecj
-
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         DO jl = 1, jprecj
-            ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)
-         END DO
-      CASE ( 0 ) 
-         DO jl = 1, jprecj
-            ptab(:,jl      ,:) = t3sn(:,jl,:,2)
-            ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jprecj
-            ptab(:,jl,:) = t3sn(:,jl,:,2)
-         END DO
-      END SELECT
-
-
-      ! 4. north fold treatment
-      ! -----------------------
-
-      IF (PRESENT(cd_mpp)) THEN
-         ! No north fold treatment (it is assumed to be already OK)
-     
-      ELSE      
-
-      ! 4.1 treatment without exchange (jpni odd)
-      !     T-point pivot  
-
-      SELECT CASE ( jpni )
-
-      CASE ( 1 )  ! only one proc along I, no mpp exchange
-       
-         SELECT CASE ( npolj )
-  
-         CASE ( 3 , 4 )    ! T pivot
-            iloc = jpiglo - 2 * ( nimpp - 1 )
-
-            SELECT CASE ( cd_type )
-
-            CASE ( 'T' , 'S', 'W' )
-               DO jk = 1, jpk
-                  DO ji = 2, nlci
-                     ijt=iloc-ji+2
-                     ptab(ji,nlcj,jk) = psgn * ptab(ijt,nlcj-2,jk)
-                  END DO
-                  DO ji = nlci/2+1, nlci
-                     ijt=iloc-ji+2
-                     ptab(ji,nlcj-1,jk) = psgn * ptab(ijt,nlcj-1,jk)
-                  END DO
-               END DO
-
-            CASE ( 'U' )
-               DO jk = 1, jpk
-                  DO ji = 1, nlci-1
-                     iju=iloc-ji+1
-                     ptab(ji,nlcj,jk) = psgn * ptab(iju,nlcj-2,jk)
-                  END DO
-                  DO ji = nlci/2, nlci-1
-                     iju=iloc-ji+1
-                     ptab(ji,nlcj-1,jk) = psgn * ptab(iju,nlcj-1,jk)
-                  END DO
-               END DO
-
-            CASE ( 'V' )
-               DO jk = 1, jpk
-                  DO ji = 2, nlci
-                     ijt=iloc-ji+2
-                     ptab(ji,nlcj-1,jk) = psgn * ptab(ijt,nlcj-2,jk)
-                     ptab(ji,nlcj  ,jk) = psgn * ptab(ijt,nlcj-3,jk)
-                  END DO
-               END DO
-
-            CASE ( 'F', 'G' )
-               DO jk = 1, jpk
-                  DO ji = 1, nlci-1
-                     iju=iloc-ji+1
-                     ptab(ji,nlcj-1,jk) = psgn * ptab(iju,nlcj-2,jk)
-                     ptab(ji,nlcj  ,jk) = psgn * ptab(iju,nlcj-3,jk)
-                  END DO
-               END DO
-  
-          END SELECT
-       
-         CASE ( 5 , 6 ) ! F pivot
-            iloc=jpiglo-2*(nimpp-1)
-  
-            SELECT CASE ( cd_type )
-
-            CASE ( 'T' , 'S', 'W' )
-               DO jk = 1, jpk
-                  DO ji = 1, nlci
-                     ijt=iloc-ji+1
-                     ptab(ji,nlcj,jk) = psgn * ptab(ijt,nlcj-1,jk)
-                  END DO
-               END DO
-
-            CASE ( 'U' )
-               DO jk = 1, jpk
-                  DO ji = 1, nlci-1
-                     iju=iloc-ji
-                     ptab(ji,nlcj,jk) = psgn * ptab(iju,nlcj-1,jk)
-                  END DO
-               END DO
-
-            CASE ( 'V' )
-               DO jk = 1, jpk
-                  DO ji = 1, nlci
-                     ijt=iloc-ji+1
-                     ptab(ji,nlcj  ,jk) = psgn * ptab(ijt,nlcj-2,jk)
-                  END DO
-                  DO ji = nlci/2+1, nlci
-                     ijt=iloc-ji+1
-                     ptab(ji,nlcj-1,jk) = psgn * ptab(ijt,nlcj-1,jk)
-                  END DO
-               END DO
-
-            CASE ( 'F', 'G' )
-               DO jk = 1, jpk
-                  DO ji = 1, nlci-1
-                     iju=iloc-ji
-                     ptab(ji,nlcj,jk) = psgn * ptab(iju,nlcj-2,jk)
-                  END DO
-                  DO ji = nlci/2+1, nlci-1
-                     iju=iloc-ji
-                     ptab(ji,nlcj-1,jk) = psgn * ptab(iju,nlcj-1,jk)
-                  END DO
-               END DO
-            END SELECT  ! cd_type
-
-         END SELECT     !  npolj
-  
-      CASE DEFAULT ! more than 1 proc along I
-         IF ( npolj /= 0 ) CALL mpp_lbc_north (ptab, cd_type, psgn)  ! only for northern procs.
-
-      END SELECT ! jpni 
-
-      ENDIF
-      
-
-      ! 5. East and west directions exchange
-      ! ------------------------------------
-
-      SELECT CASE ( npolj )
-
-      CASE ( 3, 4, 5, 6 )
-
-         ! 5.1 Read Dirichlet lateral conditions
-
-         SELECT CASE ( nbondi )
-
-         CASE ( -1, 0, 1 )
-            iihom = nlci-nreci
-            DO jl = 1, jpreci
-               t3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)
-               t3we(:,jl,:,1) = ptab(iihom +jl,:,:)
-            END DO
-
-         END SELECT
-
-         ! 5.2 Migrations
-
-#if defined key_mpp_shmem
-         !! SHMEM version
-
-         imigr = jpreci * jpj * jpk
-
-         SELECT CASE ( nbondi )
-         CASE ( -1 )
-            CALL shmem_put( t3we(1,1,1,2), t3we(1,1,1,1), imigr, noea )
-         CASE ( 0 )
-            CALL shmem_put( t3ew(1,1,1,2), t3ew(1,1,1,1), imigr, nowe )
-            CALL shmem_put( t3we(1,1,1,2), t3we(1,1,1,1), imigr, noea )
-         CASE ( 1 )
-            CALL shmem_put( t3ew(1,1,1,2), t3ew(1,1,1,1), imigr, nowe )
-         END SELECT
-
-         CALL barrier()
-         CALL shmem_udcflush()
-
-#elif defined key_mpp_mpi
-         !! MPI version
-
-         imigr=jpreci*jpj*jpk
-  
-         SELECT CASE ( nbondi )
-         CASE ( -1 )
-            CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req1 )
-            CALL mpprecv( 1, t3ew(1,1,1,2), imigr )
-            IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-         CASE ( 0 )
-            CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 )
-            CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req2 )
-            CALL mpprecv( 1, t3ew(1,1,1,2), imigr )
-            CALL mpprecv( 2, t3we(1,1,1,2), imigr )
-            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, t3ew(1,1,1,1), imigr, nowe, ml_req1 )
-            CALL mpprecv( 2, t3we(1,1,1,2), imigr )
-            IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-         END SELECT
-#endif
-
-         ! 5.3 Write Dirichlet lateral conditions
-
-         iihom = nlci-jpreci
-
-         SELECT CASE ( nbondi)
-         CASE ( -1 )
-            DO jl = 1, jpreci
-               ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)
-            END DO
-         CASE ( 0 ) 
-            DO jl = 1, jpreci
-               ptab(jl      ,:,:) = t3we(:,jl,:,2)
-               ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)
-            END DO
-         CASE ( 1 )
-            DO jl = 1, jpreci
-               ptab(jl      ,:,:) = t3we(:,jl,:,2)
-            END DO
-         END SELECT
-
-      END SELECT    ! npolj 
-
-   END SUBROUTINE mpp_lnk_3d
-
-
-   SUBROUTINE mpp_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_2d  ***
-      !!                  
-      !! ** Purpose :   Message passing manadgement for 2d array
-      !!
-      !! ** 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
-      !!
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      CHARACTER(len=1) , INTENT( in ) ::   &
-         cd_type       ! define the nature of pt2d array grid-points
-         !             !  = T , U , V , F , W 
-         !             !  = S : T-point, north fold treatment
-         !             !  = G : F-point, north fold treatment
-         !             !  = I : sea-ice velocity at F-point with index shift
-      REAL(wp), INTENT( in ) ::   &
-         psgn          ! control of the sign change
-         !             !   = -1. , the sign is changed if north fold boundary
-         !             !   =  1. , the sign is kept  if north fold boundary
-      REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) ::   &
-         pt2d          ! 2D array on which the boundary condition is applied
-      CHARACTER(len=3), INTENT( in ), OPTIONAL ::    &
-         cd_mpp        ! fill the overlap area only 
-      REAL(wp)        , INTENT(in   ), OPTIONAL           ::   pval      ! background value (used at closed boundaries)
-
-      !! * Local variables
-      INTEGER  ::   ji, jj, jl      ! dummy loop indices
-      INTEGER  ::   &
-         imigr, iihom, ijhom,    &  ! temporary integers
-         iloc, ijt, iju             !    "          "
-      INTEGER  ::   ml_req1, ml_req2, ml_err     ! for key_mpi_isend
-      INTEGER  ::   ml_stat(MPI_STATUS_SIZE)     ! for key_mpi_isend
-      REAL(wp) ::   zland
-      !!----------------------------------------------------------------------
-
-      IF( PRESENT( pval ) ) THEN      ! set land value (zero by default)
-         zland = pval
-      ELSE
-         zland = 0.e0
-      ENDIF
-
-      ! 1. standard boundary treatment
-      ! ------------------------------
-      IF (PRESENT(cd_mpp)) THEN
-         DO jj = nlcj+1, jpj   ! only fill extra allows last line
-            pt2d(1:nlci, jj) = pt2d(1:nlci, nlej)
-         END DO
-         DO ji = nlci+1, jpi   ! only fill extra allows last column
-            pt2d(ji    , : ) = pt2d(nlei  , :   )
-         END DO     
-      ELSE      
-
-         !                                        ! East-West boundaries
-         !                                        ! ====================
-         IF( nbondi == 2 .AND.   &      ! Cyclic east-west
-            &    (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
-            pt2d( 1 ,:) = pt2d(jpim1,:)
-            pt2d(jpi,:) = pt2d(  2  ,:)
-
-         ELSE                           ! ... closed
-            SELECT CASE ( cd_type )
-            CASE ( 'T', 'U', 'V', 'W' , 'I' )
-               pt2d(     1       :jpreci,:) = zland
-               pt2d(nlci-jpreci+1:jpi   ,:) = zland
-            CASE ( 'F' )
-               pt2d(nlci-jpreci+1:jpi   ,:) = zland
-            END SELECT
-         ENDIF
-
-         !                                        ! North-South boundaries
-         !                                        ! ======================
-         SELECT CASE ( cd_type )
-         CASE ( 'T', 'U', 'V', 'W' , 'I' )
-            pt2d(:,     1       :jprecj) = zland
-            pt2d(:,nlcj-jprecj+1:jpj   ) = zland
-         CASE ( 'F' )
-            pt2d(:,nlcj-jprecj+1:jpj   ) = zland
-         END SELECT
-
-      ENDIF
-
-
-      ! 2. East and west directions
-      ! ---------------------------
-
-      ! 2.1 Read Dirichlet lateral conditions
-
-      SELECT CASE ( nbondi )
-      CASE ( -1, 0, 1 )    ! all except 2
-         iihom = nlci-nreci
-         DO jl = 1, jpreci
-            t2ew(:,jl,1) = pt2d(jpreci+jl,:)
-            t2we(:,jl,1) = pt2d(iihom +jl,:)
-         END DO
-      END SELECT
-
-      ! 2.2 Migrations
-
-#if defined key_mpp_shmem
-      !! * SHMEM version
-
-      imigr = jpreci * jpj
-
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         CALL shmem_put( t2we(1,1,2), t2we(1,1,1), imigr, noea )
-      CASE ( 0 )
-         CALL shmem_put( t2ew(1,1,2), t2ew(1,1,1), imigr, nowe )
-         CALL shmem_put( t2we(1,1,2), t2we(1,1,1), imigr, noea )
-      CASE ( 1 )
-         CALL shmem_put( t2ew(1,1,2), t2ew(1,1,1), imigr, nowe )
-      END SELECT
-
-      CALL barrier()
-      CALL shmem_udcflush()
-
-#elif defined key_mpp_mpi
-      !! * MPI version
-
-      imigr = jpreci * jpj
-
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 )
-         CALL mpprecv( 1, t2ew(1,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      CASE ( 0 )
-         CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )
-         CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 )
-         CALL mpprecv( 1, t2ew(1,1,2), imigr )
-         CALL mpprecv( 2, t2we(1,1,2), imigr )
-         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, t2ew(1,1,1), imigr, nowe, ml_req1 )
-         CALL mpprecv( 2, t2we(1,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      END SELECT
-
-#endif
-
-      ! 2.3 Write Dirichlet lateral conditions
-
-      iihom = nlci - jpreci
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         DO jl = 1, jpreci
-            pt2d(iihom+jl,:) = t2ew(:,jl,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jpreci
-            pt2d(jl      ,:) = t2we(:,jl,2)
-            pt2d(iihom+jl,:) = t2ew(:,jl,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jpreci
-            pt2d(jl      ,:) = t2we(:,jl,2)
-         END DO
-      END SELECT
-
-
-      ! 3. North and south directions
-      ! -----------------------------
-
-      ! 3.1 Read Dirichlet lateral conditions
-
-      IF( nbondj /= 2 ) THEN
-         ijhom = nlcj-nrecj
-         DO jl = 1, jprecj
-            t2sn(:,jl,1) = pt2d(:,ijhom +jl)
-            t2ns(:,jl,1) = pt2d(:,jprecj+jl)
-         END DO
-      ENDIF
-
-      ! 3.2 Migrations
-
-#if defined key_mpp_shmem
-      !! * SHMEM version
-
-      imigr = jprecj * jpi
-
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         CALL shmem_put( t2sn(1,1,2), t2sn(1,1,1), imigr, nono )
-      CASE ( 0 )
-         CALL shmem_put( t2ns(1,1,2), t2ns(1,1,1), imigr, noso )
-         CALL shmem_put( t2sn(1,1,2), t2sn(1,1,1), imigr, nono )
-      CASE ( 1 )
-         CALL shmem_put( t2ns(1,1,2), t2ns(1,1,1), imigr, noso )
-      END SELECT 
-      CALL barrier()
-      CALL shmem_udcflush()
-
-#elif defined key_mpp_mpi
-      !! * MPI version
-
-      imigr = jprecj * jpi
-
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 )
-         CALL mpprecv( 3, t2ns(1,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      CASE ( 0 )
-         CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )
-         CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 )
-         CALL mpprecv( 3, t2ns(1,1,2), imigr )
-         CALL mpprecv( 4, t2sn(1,1,2), imigr )
-         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, t2ns(1,1,1), imigr, noso, ml_req1 )
-         CALL mpprecv( 4, t2sn(1,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      END SELECT
-  
-#endif
-
-      ! 3.3 Write Dirichlet lateral conditions
-
-      ijhom = nlcj - jprecj
-
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         DO jl = 1, jprecj
-            pt2d(:,ijhom+jl) = t2ns(:,jl,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jprecj
-            pt2d(:,jl      ) = t2sn(:,jl,2)
-            pt2d(:,ijhom+jl) = t2ns(:,jl,2)
-         END DO
-      CASE ( 1 ) 
-         DO jl = 1, jprecj
-            pt2d(:,jl      ) = t2sn(:,jl,2)
-         END DO
-      END SELECT 
-  
-
-      ! 4. north fold treatment
-      ! -----------------------
-  
-      IF (PRESENT(cd_mpp)) THEN
-         ! No north fold treatment (it is assumed to be already OK)
-     
-      ELSE      
-
-      ! 4.1 treatment without exchange (jpni odd)
-      
-      SELECT CASE ( jpni )
-  
-      CASE ( 1 ) ! only one proc along I, no mpp exchange
-  
-         SELECT CASE ( npolj )
-  
-         CASE ( 3 , 4 )   !  T pivot
-            iloc = jpiglo - 2 * ( nimpp - 1 )
-  
-            SELECT CASE ( cd_type )
-  
-            CASE ( 'T' , 'S', 'W' )
-               DO ji = 2, nlci
-                  ijt=iloc-ji+2
-                  pt2d(ji,nlcj) = psgn * pt2d(ijt,nlcj-2)
-               END DO
-               DO ji = nlci/2+1, nlci
-                  ijt=iloc-ji+2
-                  pt2d(ji,nlcj-1) = psgn * pt2d(ijt,nlcj-1)
-               END DO
-  
-            CASE ( 'U' )
-               DO ji = 1, nlci-1
-                  iju=iloc-ji+1
-                  pt2d(ji,nlcj) = psgn * pt2d(iju,nlcj-2)
-               END DO
-               DO ji = nlci/2, nlci-1
-                  iju=iloc-ji+1
-                  pt2d(ji,nlcj-1) = psgn * pt2d(iju,nlcj-1)
-               END DO
-  
-            CASE ( 'V' )
-               DO ji = 2, nlci
-                  ijt=iloc-ji+2
-                  pt2d(ji,nlcj-1) = psgn * pt2d(ijt,nlcj-2)
-                  pt2d(ji,nlcj  ) = psgn * pt2d(ijt,nlcj-3)
-               END DO
-  
-            CASE ( 'F', 'G' )
-               DO ji = 1, nlci-1
-                  iju=iloc-ji+1
-                  pt2d(ji,nlcj-1) = psgn * pt2d(iju,nlcj-2)
-                  pt2d(ji,nlcj  ) = psgn * pt2d(iju,nlcj-3)
-               END DO
-  
-            CASE ( 'I' )                                  ! ice U-V point
-               pt2d(2,nlcj) = psgn * pt2d(3,nlcj-1)
-               DO ji = 3, nlci
-                  iju = iloc - ji + 3
-                  pt2d(ji,nlcj) = psgn * pt2d(iju,nlcj-1)
-               END DO
-  
-            END SELECT
-  
-         CASE ( 5 , 6 )                 ! F pivot
-            iloc=jpiglo-2*(nimpp-1)
-  
-            SELECT CASE (cd_type )
-  
-            CASE ( 'T', 'S', 'W' )
-               DO ji = 1, nlci
-                  ijt=iloc-ji+1
-                  pt2d(ji,nlcj) = psgn * pt2d(ijt,nlcj-1)
-               END DO
-  
-            CASE ( 'U' )
-               DO ji = 1, nlci-1
-                  iju=iloc-ji
-                  pt2d(ji,nlcj) = psgn * pt2d(iju,nlcj-1)
-               END DO
-
-            CASE ( 'V' )
-               DO ji = 1, nlci
-                  ijt=iloc-ji+1
-                  pt2d(ji,nlcj  ) = psgn * pt2d(ijt,nlcj-2)
-               END DO
-               DO ji = nlci/2+1, nlci
-                  ijt=iloc-ji+1
-                  pt2d(ji,nlcj-1) = psgn * pt2d(ijt,nlcj-1)
-               END DO
-  
-            CASE ( 'F', 'G' )
-               DO ji = 1, nlci-1
-                  iju=iloc-ji
-                  pt2d(ji,nlcj) = psgn * pt2d(iju,nlcj-2)
-               END DO
-               DO ji = nlci/2+1, nlci-1
-                  iju=iloc-ji
-                  pt2d(ji,nlcj-1) = psgn * pt2d(iju,nlcj-1)
-               END DO
-  
-            CASE ( 'I' )                                  ! ice U-V point
-               pt2d( 2 ,nlcj) = zland
-               DO ji = 2 , nlci-1
-                  ijt = iloc - ji + 2
-                  pt2d(ji,nlcj)= 0.5 * ( pt2d(ji,nlcj-1) + psgn * pt2d(ijt,nlcj-1) )
-               END DO
-  
-            END SELECT   ! cd_type
-  
-         END SELECT   ! npolj
-
-      CASE DEFAULT   ! more than 1 proc along I
-         IF( npolj /= 0 )   CALL mpp_lbc_north( pt2d, cd_type, psgn )   ! only for northern procs.
-
-      END SELECT   ! jpni
-
-      ENDIF
-
-      ! 5. East and west directions
-      ! ---------------------------
-
-      SELECT CASE ( npolj )
-
-      CASE ( 3, 4, 5, 6 )
-
-         ! 5.1 Read Dirichlet lateral conditions
-
-         SELECT CASE ( nbondi )
-         CASE ( -1, 0, 1 )
-            iihom = nlci-nreci
-            DO jl = 1, jpreci
-               DO jj = 1, jpj
-                  t2ew(jj,jl,1) = pt2d(jpreci+jl,jj)
-                  t2we(jj,jl,1) = pt2d(iihom +jl,jj)
-               END DO
-            END DO
-         END SELECT
-
-         ! 5.2 Migrations
-
-#if defined key_mpp_shmem
-         !! * SHMEM version
-
-         imigr=jpreci*jpj
-
-         SELECT CASE ( nbondi )
-         CASE ( -1 )
-            CALL shmem_put( t2we(1,1,2), t2we(1,1,1), imigr, noea )
-         CASE ( 0 )
-            CALL shmem_put( t2ew(1,1,2), t2ew(1,1,1), imigr, nowe )
-            CALL shmem_put( t2we(1,1,2), t2we(1,1,1), imigr, noea )
-         CASE ( 1 )
-            CALL shmem_put( t2ew(1,1,2), t2ew(1,1,1), imigr, nowe )
-         END SELECT
-
-         CALL barrier()
-         CALL shmem_udcflush()
-  
-#elif defined key_mpp_mpi
-         !! * MPI version
-  
-         imigr=jpreci*jpj
-  
-         SELECT CASE ( nbondi )
-         CASE ( -1 )
-            CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 )
-            CALL mpprecv( 1, t2ew(1,1,2), imigr )
-            IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-         CASE ( 0 )
-            CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )
-            CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 )
-            CALL mpprecv( 1, t2ew(1,1,2), imigr )
-            CALL mpprecv( 2, t2we(1,1,2), imigr )
-            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, t2ew(1,1,1), imigr, nowe, ml_req1 )
-            CALL mpprecv( 2, t2we(1,1,2), imigr )
-            IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-         END SELECT 
-#endif
-
-         ! 5.3 Write Dirichlet lateral conditions
-  
-         iihom = nlci - jpreci
-  
-         SELECT CASE ( nbondi )
-         CASE ( -1 )
-            DO jl = 1, jpreci
-               pt2d(iihom+jl,:) = t2ew(:,jl,2)
-            END DO
-         CASE ( 0 )
-            DO jl = 1, jpreci
-               pt2d(jl      ,:) = t2we(:,jl,2)
-               pt2d(iihom+jl,:) = t2ew(:,jl,2)
-            END DO
-         CASE ( 1 )
-            DO jl = 1, jpreci
-               pt2d(jl,:) = t2we(:,jl,2)
-            END DO
-         END SELECT 
-  
-      END SELECT   ! npolj
-  
-   END SUBROUTINE mpp_lnk_2d
-
-
-   SUBROUTINE mpp_lnk_3d_gather( ptab1, cd_type1, ptab2, cd_type2, psgn )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_3d_gather  ***
-      !!
-      !! ** Purpose :   Message passing manadgement for two 3D 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
-      !!
-      !! ** Action  :   ptab1 and ptab2  with update value at its periphery
-      !!
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      CHARACTER(len=1) , INTENT( in ) ::   &
-         cd_type1, cd_type2       ! define the nature of ptab array grid-points
-         !                        ! = T , U , V , F , W points
-         !                        ! = S : T-point, north fold treatment ???
-         !                        ! = G : F-point, north fold treatment ???
-      REAL(wp), INTENT( in ) ::   &
-         psgn          ! control of the sign change
-         !             !   = -1. , the sign is changed if north fold boundary
-         !             !   =  1. , the sign is kept  if north fold boundary
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   &
-         ptab1, ptab2             ! 3D array on which the boundary condition is applied
-
-      !! * Local variables
-      INTEGER ::   ji, jk, jl   ! dummy loop indices
-      INTEGER ::   imigr, iihom, ijhom, iloc, ijt, iju   ! temporary integers
-      INTEGER ::   ml_req1, ml_req2, ml_err     ! for key_mpi_isend
-      INTEGER ::   ml_stat(MPI_STATUS_SIZE)     ! for key_mpi_isend
-      !!----------------------------------------------------------------------
-
-      ! 1. standard boundary treatment
-      ! ------------------------------
-      !                                        ! East-West boundaries
-      !                                        ! ====================
-      IF( nbondi == 2 .AND.   &      ! Cyclic east-west
-         &   (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
-         ptab1( 1 ,:,:) = ptab1(jpim1,:,:)
-         ptab1(jpi,:,:) = ptab1(  2  ,:,:)
-         ptab2( 1 ,:,:) = ptab2(jpim1,:,:)
-         ptab2(jpi,:,:) = ptab2(  2  ,:,:)
-
-      ELSE                           ! closed
-         SELECT CASE ( cd_type1 )
-         CASE ( 'T', 'U', 'V', 'W' )
-            ptab1(     1       :jpreci,:,:) = 0.e0
-            ptab1(nlci-jpreci+1:jpi   ,:,:) = 0.e0
-         CASE ( 'F' )
-            ptab1(nlci-jpreci+1:jpi   ,:,:) = 0.e0
-         END SELECT 
-         SELECT CASE ( cd_type2 )
-         CASE ( 'T', 'U', 'V', 'W' )
-            ptab2(     1       :jpreci,:,:) = 0.e0
-            ptab2(nlci-jpreci+1:jpi   ,:,:) = 0.e0
-         CASE ( 'F' )
-            ptab2(nlci-jpreci+1:jpi   ,:,:) = 0.e0
-         END SELECT 
-      ENDIF
-
-      !                                        ! North-South boundaries
-      !                                        ! ======================
-      SELECT CASE ( cd_type1 )
-      CASE ( 'T', 'U', 'V', 'W' )
-         ptab1(:,     1       :jprecj,:) = 0.e0
-         ptab1(:,nlcj-jprecj+1:jpj   ,:) = 0.e0
-      CASE ( 'F' )
-         ptab1(:,nlcj-jprecj+1:jpj   ,:) = 0.e0
-      END SELECT
-
-      SELECT CASE ( cd_type2 )
-      CASE ( 'T', 'U', 'V', 'W' )
-         ptab2(:,     1       :jprecj,:) = 0.e0
-         ptab2(:,nlcj-jprecj+1:jpj   ,:) = 0.e0
-      CASE ( 'F' )
-         ptab2(:,nlcj-jprecj+1:jpj   ,:) = 0.e0
-      END SELECT
-
-
-      ! 2. East and west directions exchange
-      ! ------------------------------------
-
-      ! 2.1 Read Dirichlet lateral conditions
-
-      SELECT CASE ( nbondi )
-      CASE ( -1, 0, 1 )    ! all exept 2 
-         iihom = nlci-nreci
-         DO jl = 1, jpreci
-            t4ew(:,jl,:,1,1) = ptab1(jpreci+jl,:,:)
-            t4we(:,jl,:,1,1) = ptab1(iihom +jl,:,:)
-            t4ew(:,jl,:,2,1) = ptab2(jpreci+jl,:,:)
-            t4we(:,jl,:,2,1) = ptab2(iihom +jl,:,:)
-         END DO
-      END SELECT
-
-      ! 2.2 Migrations
-
-#if defined key_mpp_shmem
-      !! * SHMEM version
-
-      imigr = jpreci * jpj * jpk *2
-
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         CALL shmem_put( t4we(1,1,1,1,2), t4we(1,1,1,1,1), imigr, noea )
-      CASE ( 0 )
-         CALL shmem_put( t4ew(1,1,1,1,2), t4ew(1,1,1,1,1), imigr, nowe )
-         CALL shmem_put( t4we(1,1,1,1,2), t4we(1,1,1,1,1), imigr, noea )
-      CASE ( 1 )
-         CALL shmem_put( t4ew(1,1,1,1,2), t4ew(1,1,1,1,1), imigr, nowe )
-      END SELECT
-
-      CALL barrier()
-      CALL shmem_udcflush()
-
-#elif defined key_mpp_mpi
-      !! * Local variables   (MPI version)
-
-      imigr = jpreci * jpj * jpk *2
-
-      SELECT CASE ( nbondi ) 
-      CASE ( -1 )
-         CALL mppsend( 2, t4we(1,1,1,1,1), imigr, noea, ml_req1 )
-         CALL mpprecv( 1, t4ew(1,1,1,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         CALL mppsend( 1, t4ew(1,1,1,1,1), imigr, nowe, ml_req1 )
-         CALL mppsend( 2, t4we(1,1,1,1,1), imigr, noea, ml_req2 )
-         CALL mpprecv( 1, t4ew(1,1,1,1,2), imigr )
-         CALL mpprecv( 2, t4we(1,1,1,1,2), imigr )
-         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, t4ew(1,1,1,1,1), imigr, nowe, ml_req1 )
-         CALL mpprecv( 2, t4we(1,1,1,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
-#endif
-
-      ! 2.3 Write Dirichlet lateral conditions
-
-      iihom = nlci-jpreci
-
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         DO jl = 1, jpreci
-            ptab1(iihom+jl,:,:) = t4ew(:,jl,:,1,2)
-            ptab2(iihom+jl,:,:) = t4ew(:,jl,:,2,2)
-         END DO
-      CASE ( 0 ) 
-         DO jl = 1, jpreci
-            ptab1(jl      ,:,:) = t4we(:,jl,:,1,2)
-            ptab1(iihom+jl,:,:) = t4ew(:,jl,:,1,2)
-            ptab2(jl      ,:,:) = t4we(:,jl,:,2,2)
-            ptab2(iihom+jl,:,:) = t4ew(:,jl,:,2,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jpreci
-            ptab1(jl      ,:,:) = t4we(:,jl,:,1,2)
-            ptab2(jl      ,:,:) = t4we(:,jl,:,2,2)
-         END DO
-      END SELECT
-
-
-      ! 3. North and south directions
-      ! -----------------------------
-
-      ! 3.1 Read Dirichlet lateral conditions
-
-      IF( nbondj /= 2 ) THEN
-         ijhom = nlcj-nrecj
-         DO jl = 1, jprecj
-            t4sn(:,jl,:,1,1) = ptab1(:,ijhom +jl,:)
-            t4ns(:,jl,:,1,1) = ptab1(:,jprecj+jl,:)
-            t4sn(:,jl,:,2,1) = ptab2(:,ijhom +jl,:)
-            t4ns(:,jl,:,2,1) = ptab2(:,jprecj+jl,:)
-         END DO
-      ENDIF
-
-      ! 3.2 Migrations
-
-#if defined key_mpp_shmem
-      !! * SHMEM version
-
-      imigr = jprecj * jpi * jpk * 2
-
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         CALL shmem_put( t4sn(1,1,1,1,2), t4sn(1,1,1,1,1), imigr, nono )
-      CASE ( 0 )
-         CALL shmem_put( t4ns(1,1,1,1,2), t4ns(1,1,1,1,1), imigr, noso )
-         CALL shmem_put( t4sn(1,1,1,1,2), t4sn(1,1,1,1,1), imigr, nono )
-      CASE ( 1 )
-         CALL shmem_put( t4ns(1,1,1,1,2), t4ns(1,1,1,1;,1), imigr, noso )
-      END SELECT
-
-      CALL barrier()
-      CALL shmem_udcflush()
-
-#elif defined key_mpp_mpi
-      !! * Local variables   (MPI version)
-  
-      imigr=jprecj * jpi * jpk * 2
-
-      SELECT CASE ( nbondj )     
-      CASE ( -1 )
-         CALL mppsend( 4, t4sn(1,1,1,1,1), imigr, nono, ml_req1 )
-         CALL mpprecv( 3, t4ns(1,1,1,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         CALL mppsend( 3, t4ns(1,1,1,1,1), imigr, noso, ml_req1 )
-         CALL mppsend( 4, t4sn(1,1,1,1,1), imigr, nono, ml_req2 )
-         CALL mpprecv( 3, t4ns(1,1,1,1,2), imigr )
-         CALL mpprecv( 4, t4sn(1,1,1,1,2), imigr )
-         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, t4ns(1,1,1,1,1), imigr, noso, ml_req1 )
-         CALL mpprecv( 4, t4sn(1,1,1,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
-
-#endif
-
-      ! 3.3 Write Dirichlet lateral conditions
-
-      ijhom = nlcj-jprecj
-
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         DO jl = 1, jprecj
-            ptab1(:,ijhom+jl,:) = t4ns(:,jl,:,1,2)
-            ptab2(:,ijhom+jl,:) = t4ns(:,jl,:,2,2)
-         END DO
-      CASE ( 0 ) 
-         DO jl = 1, jprecj
-            ptab1(:,jl      ,:) = t4sn(:,jl,:,1,2)
-            ptab1(:,ijhom+jl,:) = t4ns(:,jl,:,1,2)
-            ptab2(:,jl      ,:) = t4sn(:,jl,:,2,2)
-            ptab2(:,ijhom+jl,:) = t4ns(:,jl,:,2,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jprecj
-            ptab1(:,jl,:) = t4sn(:,jl,:,1,2)
-            ptab2(:,jl,:) = t4sn(:,jl,:,2,2)
-         END DO
-      END SELECT
-
-
-      ! 4. north fold treatment
-      ! -----------------------
-
-      ! 4.1 treatment without exchange (jpni odd)
-      !     T-point pivot  
-
-      SELECT CASE ( jpni )
-
-      CASE ( 1 )  ! only one proc along I, no mpp exchange
-
-      SELECT CASE ( npolj )
-  
-         CASE ( 3 , 4 )    ! T pivot
-            iloc = jpiglo - 2 * ( nimpp - 1 )
-
-            SELECT CASE ( cd_type1 )
-
-            CASE ( 'T' , 'S', 'W' )
-               DO jk = 1, jpk
-                  DO ji = 2, nlci
-                     ijt=iloc-ji+2
-                     ptab1(ji,nlcj,jk) = psgn * ptab1(ijt,nlcj-2,jk)
-                  END DO
-                  DO ji = nlci/2+1, nlci
-                     ijt=iloc-ji+2
-                     ptab1(ji,nlcj-1,jk) = psgn * ptab1(ijt,nlcj-1,jk)
-                  END DO
-               END DO
-          
-            CASE ( 'U' )
-               DO jk = 1, jpk
-                  DO ji = 1, nlci-1
-                     iju=iloc-ji+1
-                     ptab1(ji,nlcj,jk) = psgn * ptab1(iju,nlcj-2,jk)
-                  END DO
-                  DO ji = nlci/2, nlci-1
-                     iju=iloc-ji+1
-                     ptab1(ji,nlcj-1,jk) = psgn * ptab1(iju,nlcj-1,jk)
-                  END DO
-               END DO
-
-            CASE ( 'V' )
-               DO jk = 1, jpk
-                  DO ji = 2, nlci
-                     ijt=iloc-ji+2
-                     ptab1(ji,nlcj-1,jk) = psgn * ptab1(ijt,nlcj-2,jk)
-                     ptab1(ji,nlcj  ,jk) = psgn * ptab1(ijt,nlcj-3,jk)
-                  END DO
-               END DO
-
-            CASE ( 'F', 'G' )
-               DO jk = 1, jpk
-                  DO ji = 1, nlci-1
-                     iju=iloc-ji+1
-                     ptab1(ji,nlcj-1,jk) = psgn * ptab1(iju,nlcj-2,jk)
-                     ptab1(ji,nlcj  ,jk) = psgn * ptab1(iju,nlcj-3,jk)
-                  END DO
-               END DO
-  
-            END SELECT
-            
-            SELECT CASE ( cd_type2 )
-
-            CASE ( 'T' , 'S', 'W' )
-               DO jk = 1, jpk
-                  DO ji = 2, nlci
-                     ijt=iloc-ji+2
-                     ptab2(ji,nlcj,jk) = psgn * ptab2(ijt,nlcj-2,jk)
-                  END DO
-                  DO ji = nlci/2+1, nlci
-                     ijt=iloc-ji+2
-                     ptab2(ji,nlcj-1,jk) = psgn * ptab2(ijt,nlcj-1,jk)
-                  END DO
-               END DO
-          
-            CASE ( 'U' )
-               DO jk = 1, jpk
-                  DO ji = 1, nlci-1
-                     iju=iloc-ji+1
-                     ptab2(ji,nlcj,jk) = psgn * ptab2(iju,nlcj-2,jk)
-                  END DO
-                  DO ji = nlci/2, nlci-1
-                     iju=iloc-ji+1
-                     ptab2(ji,nlcj-1,jk) = psgn * ptab2(iju,nlcj-1,jk)
-                  END DO
-               END DO
-
-            CASE ( 'V' )
-               DO jk = 1, jpk
-                  DO ji = 2, nlci
-                     ijt=iloc-ji+2
-                     ptab2(ji,nlcj-1,jk) = psgn * ptab2(ijt,nlcj-2,jk)
-                     ptab2(ji,nlcj  ,jk) = psgn * ptab2(ijt,nlcj-3,jk)
-                  END DO
-               END DO
-
-            CASE ( 'F', 'G' )
-               DO jk = 1, jpk
-                  DO ji = 1, nlci-1
-                     iju=iloc-ji+1
-                     ptab2(ji,nlcj-1,jk) = psgn * ptab2(iju,nlcj-2,jk)
-                     ptab2(ji,nlcj  ,jk) = psgn * ptab2(iju,nlcj-3,jk)
-                  END DO
-               END DO
-  
-          END SELECT
-       
-         CASE ( 5 , 6 ) ! F pivot
-            iloc=jpiglo-2*(nimpp-1)
-  
-            SELECT CASE ( cd_type1 )
-
-            CASE ( 'T' , 'S', 'W' )
-               DO jk = 1, jpk
-                  DO ji = 1, nlci
-                     ijt=iloc-ji+1
-                     ptab1(ji,nlcj,jk) = psgn * ptab1(ijt,nlcj-1,jk)
-                  END DO
-               END DO
-
-            CASE ( 'U' )
-               DO jk = 1, jpk
-                  DO ji = 1, nlci-1
-                     iju=iloc-ji
-                     ptab1(ji,nlcj,jk) = psgn * ptab1(iju,nlcj-1,jk)
-                  END DO
-               END DO
-
-            CASE ( 'V' )
-               DO jk = 1, jpk
-                  DO ji = 1, nlci
-                     ijt=iloc-ji+1
-                     ptab1(ji,nlcj  ,jk) = psgn * ptab1(ijt,nlcj-2,jk)
-                  END DO
-                  DO ji = nlci/2+1, nlci
-                     ijt=iloc-ji+1
-                     ptab1(ji,nlcj-1,jk) = psgn * ptab1(ijt,nlcj-1,jk)
-                  END DO
-               END DO
-
-            CASE ( 'F', 'G' )
-               DO jk = 1, jpk
-                  DO ji = 1, nlci-1
-                     iju=iloc-ji
-                     ptab1(ji,nlcj,jk) = psgn * ptab1(iju,nlcj-2,jk)
-                  END DO
-                  DO ji = nlci/2+1, nlci-1
-                     iju=iloc-ji
-                     ptab1(ji,nlcj-1,jk) = psgn * ptab1(iju,nlcj-1,jk)
-                  END DO
-               END DO
-            END SELECT  ! cd_type1
-
-            SELECT CASE ( cd_type2 )
-
-            CASE ( 'T' , 'S', 'W' )
-               DO jk = 1, jpk
-                  DO ji = 1, nlci
-                     ijt=iloc-ji+1
-                     ptab2(ji,nlcj,jk) = psgn * ptab2(ijt,nlcj-1,jk)
-                  END DO
-               END DO
-
-            CASE ( 'U' )
-               DO jk = 1, jpk
-                  DO ji = 1, nlci-1
-                     iju=iloc-ji
-                     ptab2(ji,nlcj,jk) = psgn * ptab2(iju,nlcj-1,jk)
-                  END DO
-               END DO
-
-            CASE ( 'V' )
-               DO jk = 1, jpk
-                  DO ji = 1, nlci
-                     ijt=iloc-ji+1
-                     ptab2(ji,nlcj  ,jk) = psgn * ptab2(ijt,nlcj-2,jk)
-                  END DO
-                  DO ji = nlci/2+1, nlci
-                     ijt=iloc-ji+1
-                     ptab2(ji,nlcj-1,jk) = psgn * ptab2(ijt,nlcj-1,jk)
-                  END DO
-               END DO
-
-            CASE ( 'F', 'G' )
-               DO jk = 1, jpk
-                  DO ji = 1, nlci-1
-                     iju=iloc-ji
-                     ptab2(ji,nlcj,jk) = psgn * ptab2(iju,nlcj-2,jk)
-                  END DO
-                  DO ji = nlci/2+1, nlci-1
-                     iju=iloc-ji
-                     ptab2(ji,nlcj-1,jk) = psgn * ptab2(iju,nlcj-1,jk)
-                  END DO
-               END DO
-
-            END SELECT  ! cd_type2
-
-         END SELECT     !  npolj
-  
-      CASE DEFAULT ! more than 1 proc along I
-         IF ( npolj /= 0 ) THEN
-            CALL mpp_lbc_north (ptab1, cd_type1, psgn)  ! only for northern procs.
-            CALL mpp_lbc_north (ptab2, cd_type2, psgn)  ! only for northern procs.
-         ENDIF
-
-      END SELECT ! jpni 
-
-
-      ! 5. East and west directions exchange
-      ! ------------------------------------
-
-      SELECT CASE ( npolj )
-
-      CASE ( 3, 4, 5, 6 )
-
-         ! 5.1 Read Dirichlet lateral conditions
-
-         SELECT CASE ( nbondi )
-
-         CASE ( -1, 0, 1 )
-            iihom = nlci-nreci
-            DO jl = 1, jpreci
-               t4ew(:,jl,:,1,1) = ptab1(jpreci+jl,:,:)
-               t4we(:,jl,:,1,1) = ptab1(iihom +jl,:,:)
-               t4ew(:,jl,:,2,1) = ptab2(jpreci+jl,:,:)
-               t4we(:,jl,:,2,1) = ptab2(iihom +jl,:,:)
-            END DO
-
-         END SELECT
-
-         ! 5.2 Migrations
-
-#if defined key_mpp_shmem
-         !! SHMEM version
-
-         imigr = jpreci * jpj * jpk * 2
-
-         SELECT CASE ( nbondi )
-         CASE ( -1 )
-            CALL shmem_put( t4we(1,1,1,1,2), t4we(1,1,1,1,1), imigr, noea )
-         CASE ( 0 )
-            CALL shmem_put( t4ew(1,1,1,1,2), t4ew(1,1,1,1,1), imigr, nowe )
-            CALL shmem_put( t4we(1,1,1,1,2), t4we(1,1,1,1,1), imigr, noea )
-         CASE ( 1 )
-            CALL shmem_put( t4ew(1,1,1,1,2), t4ew(1,1,1,1,1), imigr, nowe )
-         END SELECT
-
-         CALL barrier()
-         CALL shmem_udcflush()
-
-#elif defined key_mpp_mpi
-         !! MPI version
-
-         imigr = jpreci * jpj * jpk * 2
-  
-         SELECT CASE ( nbondi )
-         CASE ( -1 )
-            CALL mppsend( 2, t4we(1,1,1,1,1), imigr, noea, ml_req1 )
-            CALL mpprecv( 1, t4ew(1,1,1,1,2), imigr )
-            IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-         CASE ( 0 )
-            CALL mppsend( 1, t4ew(1,1,1,1,1), imigr, nowe, ml_req1 )
-            CALL mppsend( 2, t4we(1,1,1,1,1), imigr, noea, ml_req2 )
-            CALL mpprecv( 1, t4ew(1,1,1,1,2), imigr )
-            CALL mpprecv( 2, t4we(1,1,1,1,2), imigr )
-            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, t4ew(1,1,1,1,1), imigr, nowe, ml_req1 )
-            CALL mpprecv( 2, t4we(1,1,1,1,2), imigr )
-            IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-         END SELECT
-#endif
-
-         ! 5.3 Write Dirichlet lateral conditions
-
-         iihom = nlci-jpreci
-
-         SELECT CASE ( nbondi)
-         CASE ( -1 )
-            DO jl = 1, jpreci
-               ptab1(iihom+jl,:,:) = t4ew(:,jl,:,1,2)
-               ptab2(iihom+jl,:,:) = t4ew(:,jl,:,2,2)
-            END DO
-         CASE ( 0 ) 
-            DO jl = 1, jpreci
-               ptab1(jl      ,:,:) = t4we(:,jl,:,1,2)
-               ptab1(iihom+jl,:,:) = t4ew(:,jl,:,1,2)
-               ptab2(jl      ,:,:) = t4we(:,jl,:,2,2)
-               ptab2(iihom+jl,:,:) = t4ew(:,jl,:,2,2)
-            END DO
-         CASE ( 1 )
-            DO jl = 1, jpreci
-               ptab1(jl      ,:,:) = t4we(:,jl,:,1,2)
-               ptab2(jl      ,:,:) = t4we(:,jl,:,2,2)
-            END DO
-         END SELECT
-
-      END SELECT    ! npolj 
-
-   END SUBROUTINE mpp_lnk_3d_gather
-
-
-   SUBROUTINE mpp_lnk_2d_e( pt2d, cd_type, psgn )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_2d_e  ***
-      !!                  
-      !! ** Purpose :   Message passing manadgement for 2d array (with halo)
-      !!
-      !! ** 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
-      !!                    jpr2di : number of rows for extra outer halo
-      !!                    jpr2dj : number of columns for extra outer halo
-      !!                    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
-      !!   
-      !! History :
-      !!       
-      !!   9.0  !  05-09  (R. Benshila, G. Madec)  original code
-      !!
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      CHARACTER(len=1) , INTENT( in ) ::   &
-         cd_type       ! define the nature of pt2d array grid-points
-         !             !  = T , U , V , F , W 
-         !             !  = S : T-point, north fold treatment
-         !             !  = G : F-point, north fold treatment
-         !             !  = I : sea-ice velocity at F-point with index shift
-      REAL(wp), INTENT( in ) ::   &
-         psgn          ! control of the sign change
-         !             !   = -1. , the sign is changed if north fold boundary
-         !             !   =  1. , the sign is kept  if north fold boundary
-      REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj), INTENT( inout ) ::   &
-         pt2d          ! 2D array on which the boundary condition is applied
-
-      !! * Local variables
-      INTEGER  ::   ji, jl      ! dummy loop indices
-      INTEGER  ::   &
-         imigr, iihom, ijhom,    &  ! temporary integers
-         iloc, ijt, iju             !    "          "
-      INTEGER  ::   &
-         ipreci, iprecj             ! temporary integers
-      INTEGER  ::   ml_req1, ml_req2, ml_err     ! for isend
-      INTEGER  ::   ml_stat(MPI_STATUS_SIZE)     ! for isend
-     !!---------------------------------------------------------------------
-
-      ! take into account outer extra 2D overlap area
-      ipreci = jpreci + jpr2di
-      iprecj = jprecj + jpr2dj
-
-
-      ! 1. standard boundary treatment
-      ! ------------------------------
-
-      !                                        ! East-West boundaries
-      !                                        ! ====================
-      IF( nbondi == 2 .AND.   &      ! Cyclic east-west
-         &    (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
-         pt2d(1-jpr2di:     1    ,:) = pt2d(jpim1-jpr2di:  jpim1 ,:)
-         pt2d(   jpi  :jpi+jpr2di,:) = pt2d(     2      :2+jpr2di,:)
-
-      ELSE                           ! ... closed
-         SELECT CASE ( cd_type )
-         CASE ( 'T', 'U', 'V', 'W' , 'I' )
-            pt2d(  1-jpr2di   :jpreci    ,:) = 0.e0
-            pt2d(nlci-jpreci+1:jpi+jpr2di,:) = 0.e0
-         CASE ( 'F' )
-            pt2d(nlci-jpreci+1:jpi+jpr2di,:) = 0.e0
-         END SELECT
-      ENDIF
-
-      !                                        ! North-South boundaries
-      !                                        ! ======================
-      SELECT CASE ( cd_type )
-      CASE ( 'T', 'U', 'V', 'W' , 'I' )
-         pt2d(:,  1-jpr2dj   :  jprecj  ) = 0.e0
-         pt2d(:,nlcj-jprecj+1:jpj+jpr2dj) = 0.e0
-      CASE ( 'F' )
-         pt2d(:,nlcj-jprecj+1:jpj+jpr2dj) = 0.e0
-      END SELECT
-
-
-      ! 2. East and west directions
-      ! ---------------------------
-
-      ! 2.1 Read Dirichlet lateral conditions
-
-      SELECT CASE ( nbondi )
-      CASE ( -1, 0, 1 )    ! all except 2
-         iihom = nlci-nreci-jpr2di
-         DO jl = 1, ipreci
-            tr2ew(:,jl,1) = pt2d(jpreci+jl,:)
-            tr2we(:,jl,1) = pt2d(iihom +jl,:)
-         END DO
-      END SELECT
-
-      ! 2.2 Migrations
-
-#if defined key_mpp_shmem
-      !! * SHMEM version
-
-      imigr = ipreci * ( jpj + 2*jpr2dj)
-
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         CALL shmem_put( tr2we(1-jpr2dj,1,2), tr2we(1,1,1), imigr, noea )
-      CASE ( 0 )
-         CALL shmem_put( tr2ew(1-jpr2dj,1,2), tr2ew(1,1,1), imigr, nowe )
-         CALL shmem_put( tr2we(1-jpr2dj,1,2), tr2we(1,1,1), imigr, noea )
-      CASE ( 1 )
-         CALL shmem_put( tr2ew(1-jpr2dj,1,2), tr2ew(1,1,1), imigr, nowe )
-      END SELECT
-
-      CALL barrier()
-      CALL shmem_udcflush()
-
-#elif defined key_mpp_mpi
-      !! * MPI version
-
-      imigr = ipreci * ( jpj + 2*jpr2dj)
-
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         CALL mppsend( 2, tr2we(1-jpr2dj,1,1), imigr, noea, ml_req1 )
-         CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      CASE ( 0 )
-         CALL mppsend( 1, tr2ew(1-jpr2dj,1,1), imigr, nowe, ml_req1 )
-         CALL mppsend( 2, tr2we(1-jpr2dj,1,1), imigr, noea, ml_req2 )
-         CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr )
-         CALL mpprecv( 2, tr2we(1-jpr2dj,1,2), imigr )
-         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, tr2ew(1-jpr2dj,1,1), imigr, nowe, ml_req1 )
-         CALL mpprecv( 2, tr2we(1-jpr2dj,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      END SELECT
-
-#endif
-
-      ! 2.3 Write Dirichlet lateral conditions
-
-      iihom = nlci - jpreci
-
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         DO jl = 1, ipreci
-            pt2d(iihom+jl,:) = tr2ew(:,jl,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, ipreci
-            pt2d(jl-jpr2di,:) = tr2we(:,jl,2)
-            pt2d( iihom+jl,:) = tr2ew(:,jl,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, ipreci
-            pt2d(jl-jpr2di,:) = tr2we(:,jl,2)
-         END DO
-      END SELECT
-
-
-      ! 3. North and south directions
-      ! -----------------------------
-
-      ! 3.1 Read Dirichlet lateral conditions
-
-      IF( nbondj /= 2 ) THEN
-         ijhom = nlcj-nrecj-jpr2dj
-         DO jl = 1, iprecj
-            tr2sn(:,jl,1) = pt2d(:,ijhom +jl)
-            tr2ns(:,jl,1) = pt2d(:,jprecj+jl)
-         END DO
-      ENDIF
-
-      ! 3.2 Migrations
-
-#if defined key_mpp_shmem
-      !! * SHMEM version
-
-      imigr = iprecj * ( jpi + 2*jpr2di )
-
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         CALL shmem_put( tr2sn(1-jpr2di,1,2), tr2sn(1,1,1), imigr, nono )
-      CASE ( 0 )
-         CALL shmem_put( tr2ns(1-jpr2di,1,2), tr2ns(1,1,1), imigr, noso )
-         CALL shmem_put( tr2sn(1-jpr2di,1,2), tr2sn(1,1,1), imigr, nono )
-      CASE ( 1 )
-         CALL shmem_put( tr2ns(1-jpr2di,1,2), tr2ns(1,1,1), imigr, noso )
-      END SELECT 
-      CALL barrier()
-      CALL shmem_udcflush()
-
-#elif defined key_mpp_mpi
-      !! * MPI version
-
-      imigr = iprecj * ( jpi + 2*jpr2di )
-
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         CALL mppsend( 4, tr2sn(1-jpr2di,1,1), imigr, nono, ml_req1 )
-         CALL mpprecv( 3, tr2ns(1-jpr2di,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      CASE ( 0 )
-         CALL mppsend( 3, tr2ns(1-jpr2di,1,1), imigr, noso, ml_req1 )
-         CALL mppsend( 4, tr2sn(1-jpr2di,1,1), imigr, nono, ml_req2 )
-         CALL mpprecv( 3, tr2ns(1-jpr2di,1,2), imigr )
-         CALL mpprecv( 4, tr2sn(1-jpr2di,1,2), imigr )
-         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, tr2ns(1-jpr2di,1,1), imigr, noso, ml_req1 )
-         CALL mpprecv( 4, tr2sn(1-jpr2di,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      END SELECT
-  
-#endif
-
-      ! 3.3 Write Dirichlet lateral conditions
-
-      ijhom = nlcj - jprecj  
-
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         DO jl = 1, iprecj
-            pt2d(:,ijhom+jl) = tr2ns(:,jl,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, iprecj
-            pt2d(:,jl-jpr2dj) = tr2sn(:,jl,2)
-            pt2d(:,ijhom+jl ) = tr2ns(:,jl,2)
-         END DO
-      CASE ( 1 ) 
-         DO jl = 1, iprecj
-            pt2d(:,jl-jpr2dj) = tr2sn(:,jl,2)
-         END DO
-      END SELECT 
-  
-
-      ! 4. north fold treatment
-      ! -----------------------
-  
-      ! 4.1 treatment without exchange (jpni odd)
-      
-      SELECT CASE ( jpni )
-  
-      CASE ( 1 ) ! only one proc along I, no mpp exchange
-  
-         SELECT CASE ( npolj )
-  
-         CASE ( 3 , 4 )   !  T pivot
-            iloc = jpiglo - 2 * ( nimpp - 1 )
-  
-            SELECT CASE ( cd_type )
-  
-            CASE ( 'T', 'S', 'W' )
-               DO jl = 0, iprecj-1
-                  DO ji = 2-jpr2di, nlci+jpr2di
-                     ijt=iloc-ji+2
-                     pt2d(ji,nlcj+jl) = psgn * pt2d(ijt,nlcj-2-jl)
-                  END DO
-               END DO
-               DO ji = nlci/2+1, nlci+jpr2di
-                  ijt=iloc-ji+2
-                  pt2d(ji,nlcj-1) = psgn * pt2d(ijt,nlcj-1)
-               END DO
- 
-            CASE ( 'U' )
-               DO jl =0, iprecj-1
-                  DO ji = 1-jpr2di, nlci-1-jpr2di
-                     iju=iloc-ji+1
-                     pt2d(ji,nlcj+jl) = psgn * pt2d(iju,nlcj-2-jl)
-                  END DO
-               END DO
-               DO ji = nlci/2, nlci-1+jpr2di
-                  iju=iloc-ji+1
-                  pt2d(ji,nlcj-1) = psgn * pt2d(iju,nlcj-1)
-               END DO
-  
-            CASE ( 'V' )
-               DO jl = -1, iprecj-1
-                  DO ji = 2-jpr2di, nlci+jpr2di
-                     ijt=iloc-ji+2
-                     pt2d(ji,nlcj+jl) = psgn * pt2d(ijt,nlcj-3-jl)
-                  END DO
-               END DO
-  
-            CASE ( 'F', 'G' )
-               DO jl = -1, iprecj-1
-                  DO ji = 1-jpr2di, nlci-1+jpr2di
-                     iju=iloc-ji+1
-                     pt2d(ji,nlcj+jl) = psgn * pt2d(iju,nlcj-3-jl)
-                  END DO
-               END DO
-  
-            CASE ( 'I' )                                  ! ice U-V point
-               DO jl = 0, iprecj-1
-                  pt2d(2,nlcj+jl) = psgn * pt2d(3,nlcj-1-jl)
-                  DO ji = 3, nlci+jpr2di
-                     iju = iloc - ji + 3
-                     pt2d(ji,nlcj+jl) = psgn * pt2d(iju,nlcj-1-jl)
-                  END DO
-               END DO
-  
-            END SELECT
-  
-         CASE ( 5 , 6 )                 ! F pivot
-            iloc=jpiglo-2*(nimpp-1)
-  
-            SELECT CASE (cd_type )
-  
-            CASE ( 'T', 'S', 'W' )
-               DO jl = 0, iprecj-1
-                  DO ji = 1-jpr2di, nlci+jpr2di
-                     ijt=iloc-ji+1
-                     pt2d(ji,nlcj+jl) = psgn * pt2d(ijt,nlcj-1-jl)
-                  END DO
-               END DO
-  
-            CASE ( 'U' )
-               DO jl = 0, iprecj-1
-                  DO ji = 1-jpr2di, nlci-1+jpr2di
-                     iju=iloc-ji
-                     pt2d(ji,nlcj+jl) = psgn * pt2d(iju,nlcj-1-jl)
-                  END DO
-               END DO
- 
-            CASE ( 'V' )
-               DO jl = 0, iprecj-1
-                  DO ji = 1-jpr2di, nlci+jpr2di
-                     ijt=iloc-ji+1
-                     pt2d(ji,nlcj+jl) = psgn * pt2d(ijt,nlcj-2-jl)
-                  END DO
-               END DO 
-               DO ji = nlci/2+1, nlci+jpr2di
-                  ijt=iloc-ji+1
-                  pt2d(ji,nlcj-1) = psgn * pt2d(ijt,nlcj-1)
-               END DO
-  
-            CASE ( 'F', 'G' )
-               DO jl = 0, iprecj-1
-                  DO ji = 1-jpr2di, nlci-1+jpr2di
-                     iju=iloc-ji
-                     pt2d(ji,nlcj+jl) = psgn * pt2d(iju,nlcj-2-jl)
-                  END DO
-               END DO
-               DO ji = nlci/2+1, nlci-1+jpr2di
-                  iju=iloc-ji
-                  pt2d(ji,nlcj-1) = psgn * pt2d(iju,nlcj-1)
-               END DO
-  
-            CASE ( 'I' )                                  ! ice U-V point
-               pt2d( 2 ,nlcj) = 0.e0
-               DO jl = 0, iprecj-1
-                  DO ji = 2 , nlci-1+jpr2di
-                     ijt = iloc - ji + 2
-                     pt2d(ji,nlcj+jl)= 0.5 * ( pt2d(ji,nlcj-1-jl) + psgn * pt2d(ijt,nlcj-1-jl) )
-                  END DO
-               END DO
-  
-            END SELECT   ! cd_type
-  
-         END SELECT   ! npolj
-
-      CASE DEFAULT   ! more than 1 proc along I
-         IF( npolj /= 0 )   CALL mpp_lbc_north_e( pt2d, cd_type, psgn )   ! only for northern procs
-         
-      END SELECT   ! jpni
-
-
-      ! 5. East and west directions
-      ! ---------------------------
-
-      SELECT CASE ( npolj )
-
-      CASE ( 3, 4, 5, 6 )
-
-         ! 5.1 Read Dirichlet lateral conditions
-
-         SELECT CASE ( nbondi )
-         CASE ( -1, 0, 1 )
-            iihom = nlci-nreci-jpr2di
-            DO jl = 1, ipreci
-               tr2ew(:,jl,1) = pt2d(jpreci+jl,:)
-               tr2we(:,jl,1) = pt2d(iihom +jl,:)
-            END DO
-         END SELECT
-
-         ! 5.2 Migrations
-
-#if defined key_mpp_shmem
-         !! * SHMEM version
-
-         imigr = ipreci * ( jpj + 2*jpr2dj )
-
-         SELECT CASE ( nbondi )
-         CASE ( -1 )
-            CALL shmem_put( tr2we(1-jpr2dj,1,2), tr2we(1,1,1), imigr, noea )
-         CASE ( 0 )
-            CALL shmem_put( tr2ew(1-jpr2dj,1,2), tr2ew(1,1,1), imigr, nowe )
-            CALL shmem_put( tr2we(1-jpr2dj,1,2), tr2we(1,1,1), imigr, noea )
-         CASE ( 1 )
-            CALL shmem_put( tr2ew(1-jpr2dj,1,2), tr2ew(1,1,1), imigr, nowe )
-         END SELECT
-
-         CALL barrier()
-         CALL shmem_udcflush()
-  
-#elif defined key_mpp_mpi
-         !! * MPI version
-  
-         imigr=ipreci* ( jpj + 2*jpr2dj )
-  
-         SELECT CASE ( nbondi )
-         CASE ( -1 )
-            CALL mppsend( 2, tr2we(1-jpr2dj,1,1), imigr, noea, ml_req1 )
-            CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr )
-            IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-         CASE ( 0 )
-            CALL mppsend( 1, tr2ew(1-jpr2dj,1,1), imigr, nowe, ml_req1 )
-            CALL mppsend( 2, tr2we(1-jpr2dj,1,1), imigr, noea, ml_req2 )
-            CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr )
-            CALL mpprecv( 2, tr2we(1-jpr2dj,1,2), imigr )
-            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, tr2ew(1-jpr2dj,1,1), imigr, nowe, ml_req1 )
-            CALL mpprecv( 2, tr2we(1-jpr2dj,1,2), imigr )
-            IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-         END SELECT 
-#endif
-
-         ! 5.3 Write Dirichlet lateral conditions
-  
-         iihom = nlci - jpreci
-  
-         SELECT CASE ( nbondi )
-         CASE ( -1 )
-            DO jl = 1, ipreci
-               pt2d(iihom+jl,:) = tr2ew(:,jl,2)
-            END DO
-         CASE ( 0 )
-            DO jl = 1, ipreci
-               pt2d(jl- jpr2di,:) = tr2we(:,jl,2)
-               pt2d(iihom+jl,:) = tr2ew(:,jl,2)
-            END DO
-         CASE ( 1 )
-            DO jl = 1, ipreci
-               pt2d(jl-jpr2di,:) = tr2we(:,jl,2)
-            END DO
-         END SELECT 
-  
-      END SELECT   ! npolj
-  
-   END SUBROUTINE mpp_lnk_2d_e
-
-
-   SUBROUTINE mpplnks( ptab )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpplnks  ***
-      !!
-      !! ** Purpose :   Message passing manadgement for add 2d array local boundary
-      !!
-      !! ** 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
-      !!
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   &
-         ptab                     ! 2D array
-  
-      !! * Local variables
-      INTEGER ::   ji, jl         ! dummy loop indices
-      INTEGER ::   &
-         imigr, iihom, ijhom      ! temporary integers
-      INTEGER ::   ml_req1, ml_req2, ml_err     ! for key_mpi_isend
-      INTEGER ::   ml_stat(MPI_STATUS_SIZE)     ! for key_mpi_isend
-      !!----------------------------------------------------------------------
-
-
-      ! 1. north fold treatment
-      ! -----------------------
-
-      ! 1.1 treatment without exchange (jpni odd)
-  
-      SELECT CASE ( npolj )
-      CASE ( 4 )
-         DO ji = 1, nlci
-            ptab(ji,nlcj-2) = ptab(ji,nlcj-2) + t2p1(ji,1,1)
-         END DO
-      CASE ( 6 )
-         DO ji = 1, nlci
-            ptab(ji,nlcj-1) = ptab(ji,nlcj-1) + t2p1(ji,1,1)
-         END DO
-
-      ! 1.2 treatment with exchange (jpni greater than 1)
-      ! 
-      CASE ( 3 )
-#if defined key_mpp_shmem
-  
-         !! * SHMEN version
-  
-         imigr=jprecj*jpi
-  
-         CALL shmem_put(t2p1(1,1,2),t2p1(1,1,1),imigr,nono)
-         CALL barrier()
-         CALL shmem_udcflush()
-
-#  elif defined key_mpp_mpi
-       !! * MPI version
-
-       imigr=jprecj*jpi
-
-       CALL mppsend(3,t2p1(1,1,1),imigr,nono, ml_req1)
-       CALL mpprecv(3,t2p1(1,1,2),imigr)
-       IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-
-#endif      
-
-       ! Write north fold conditions
-
-       DO ji = 1, nlci
-          ptab(ji,nlcj-2) = ptab(ji,nlcj-2)+t2p1(ji,1,2)
-       END DO
-
-    CASE ( 5 )
-
-#if defined key_mpp_shmem
-
-       !! * SHMEN version
-
-       imigr=jprecj*jpi
-
-       CALL shmem_put(t2p1(1,1,2),t2p1(1,1,1),imigr,nono)
-       CALL barrier()
-       CALL shmem_udcflush()
-
-#  elif defined key_mpp_mpi
-       !! * Local variables   (MPI version)
-
-       imigr=jprecj*jpi
-
-       CALL mppsend(3,t2p1(1,1,1),imigr,nono, ml_req1)
-       CALL mpprecv(3,t2p1(1,1,2),imigr)
-       IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-
-#endif      
-
-       ! Write north fold conditions
-
-       DO ji = 1, nlci
-          ptab(ji,nlcj-1) = ptab(ji,nlcj-1)+t2p1(ji,1,2)
-       END DO
-
-    END SELECT
-
-
-    ! 2. East and west directions
-    ! ---------------------------
-
-    ! 2.1 Read Dirichlet lateral conditions
-
-    iihom = nlci-jpreci
-
-    SELECT CASE ( nbondi )
-
-    CASE ( -1, 0, 1 )  ! all except 2
-       DO jl = 1, jpreci
-             t2ew(:,jl,1) = ptab(  jl    ,:)
-             t2we(:,jl,1) = ptab(iihom+jl,:)
-       END DO
-    END SELECT
-
-    ! 2.2 Migrations
-
-#if defined key_mpp_shmem
-
-    !! * SHMEN version
-
-    imigr=jpreci*jpj
-
-    SELECT CASE ( nbondi )
-
-    CASE ( -1 )
-       CALL shmem_put(t2we(1,1,2),t2we(1,1,1),imigr,noea)
-
-    CASE ( 0 )
-       CALL shmem_put(t2ew(1,1,2),t2ew(1,1,1),imigr,nowe)
-       CALL shmem_put(t2we(1,1,2),t2we(1,1,1),imigr,noea)
-
-    CASE ( 1 )
-       CALL shmem_put(t2ew(1,1,2),t2ew(1,1,1),imigr,nowe)
-
-    END SELECT
-    CALL  barrier()
-    CALL  shmem_udcflush()
-
-#  elif defined key_mpp_mpi
-    !! * Local variables   (MPI version)
-
-    imigr=jpreci*jpj
-
-    SELECT CASE ( nbondi )
-
-    CASE ( -1 )
-       CALL mppsend(2,t2we(1,1,1),imigr,noea, ml_req1)
-       CALL mpprecv(1,t2ew(1,1,2),imigr)
-       IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-    CASE ( 0 )
-       CALL mppsend(1,t2ew(1,1,1),imigr,nowe, ml_req1)
-       CALL mppsend(2,t2we(1,1,1),imigr,noea, ml_req2)
-       CALL mpprecv(1,t2ew(1,1,2),imigr)
-       CALL mpprecv(2,t2we(1,1,2),imigr)
-       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,t2ew(1,1,1),imigr,nowe, ml_req1)
-       CALL mpprecv(2,t2we(1,1,2),imigr)
-       IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-
-    END SELECT
-
-#endif
-
-    ! 2.3 Write Dirichlet lateral conditions
-
-       iihom = nlci-nreci
-
-    SELECT CASE ( nbondi )
-
-    CASE ( -1 )
-       DO jl = 1, jpreci
-             ptab(iihom +jl,:) = ptab(iihom +jl,:)+t2ew(:,jl,2)
-       END DO
-
-    CASE ( 0 )
-       DO jl = 1, jpreci
-             ptab(jpreci+jl,:) = ptab(jpreci+jl,:)+t2we(:,jl,2)
-             ptab(iihom +jl,:) = ptab(iihom +jl,:)+t2ew(:,jl,2)
-       END DO
-
-    CASE ( 1 )
-       DO jl = 1, jpreci
-             ptab(jpreci+jl,:) = ptab(jpreci+jl,:)+t2we(:,jl,2)
-       END DO
-    END SELECT
-
-
-    ! 3. North and south directions
-    ! -----------------------------
-
-    ! 3.1 Read Dirichlet lateral conditions
-
-    ijhom = nlcj-jprecj
-
-    SELECT CASE ( nbondj )
-
-    CASE ( -1, 0, 1 )
-       DO jl = 1, jprecj
-             t2sn(:,jl,1) = ptab(:,ijhom+jl)
-             t2ns(:,jl,1) = ptab(:,   jl   )
-       END DO
-
-    END SELECT 
-
-    ! 3.2 Migrations
-
-#if defined key_mpp_shmem
-
-    !! * SHMEN version
-
-    imigr=jprecj*jpi
-
-    SELECT CASE ( nbondj )
-
-    CASE ( -1 )
-       CALL shmem_put(t2sn(1,1,2),t2sn(1,1,1),imigr,nono)
-
-    CASE ( 0 )
-       CALL shmem_put(t2ns(1,1,2),t2ns(1,1,1),imigr,noso)
-       CALL shmem_put(t2sn(1,1,2),t2sn(1,1,1),imigr,nono)
-
-    CASE ( 1 )
-       CALL shmem_put(t2ns(1,1,2),t2ns(1,1,1),imigr,noso)
-
-    END SELECT
-    CALL  barrier()
-    CALL  shmem_udcflush()
-
-#  elif defined key_mpp_mpi
-    !! * Local variables   (MPI version)
-
-    imigr=jprecj*jpi
-
-    SELECT CASE ( nbondj )
-
-    CASE ( -1 )
-       CALL mppsend(4,t2sn(1,1,1),imigr,nono, ml_req1)
-       CALL mpprecv(3,t2ns(1,1,2),imigr)
-       IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-
-    CASE ( 0 )
-       CALL mppsend(3,t2ns(1,1,1),imigr,noso, ml_req1)
-       CALL mppsend(4,t2sn(1,1,1),imigr,nono, ml_req2)
-       CALL mpprecv(3,t2ns(1,1,2),imigr)
-       CALL mpprecv(4,t2sn(1,1,2),imigr)
-       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,t2ns(1,1,1),imigr,noso, ml_req1)
-       CALL mpprecv(4,t2sn(1,1,2),imigr)
-       IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-    END SELECT
-
-#endif
-
-    ! 3.3 Write Dirichlet lateral conditions
-
-       ijhom = nlcj-nrecj
-
-    SELECT CASE ( nbondj )
-
-    CASE ( -1 )
-       DO jl = 1, jprecj
-             ptab(:,ijhom +jl) = ptab(:,ijhom +jl)+t2ns(:,jl,2)
-       END DO
-
-    CASE ( 0 )
-       DO jl = 1, jprecj
-             ptab(:,jprecj+jl) = ptab(:,jprecj+jl)+t2sn(:,jl,2)
-             ptab(:,ijhom +jl) = ptab(:,ijhom +jl)+t2ns(:,jl,2)
-       END DO
-
-    CASE ( 1 ) 
-       DO jl = 1, jprecj
-             ptab(:,jprecj+jl) = ptab(:,jprecj+jl)+t2sn(:,jl,2)
-       END DO
-
-    END SELECT
-
-  END SUBROUTINE mpplnks
-
-
-   SUBROUTINE mppsend( ktyp, pmess, kbytes, kdest, md_req)
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppsend  ***
-      !!                   
-      !! ** Purpose :   Send messag passing array
-      !!
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      REAL(wp), INTENT(inout) ::   pmess(*)       ! array of real
-      INTEGER , INTENT( in  ) ::   kbytes,     &  ! size of the array pmess
-         &                         kdest ,     &  ! receive process number
-         &                         ktyp,       &  ! Tag of the message
-         &                         md_req         ! Argument for isend
-      !!----------------------------------------------------------------------
-#if defined key_mpp_shmem
-      !! * SHMEM version  :    routine not used
-
-#elif defined key_mpp_mpi
-      !! * MPI version
-      INTEGER ::   iflag
-
-      SELECT CASE ( c_mpi_send )
-      CASE ( 'S' )                ! Standard mpi send (blocking)
-         CALL mpi_send ( pmess, kbytes, mpi_double_precision, kdest, ktyp,   &
-            &                          mpi_comm_opa, iflag )
-      CASE ( 'B' )                ! Buffer mpi send (blocking)
-         CALL mpi_bsend( pmess, kbytes, mpi_double_precision, kdest, ktyp,   &
-            &                          mpi_comm_opa, iflag )
-      CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
-         ! Be carefull, one more argument here : the mpi request identifier..
-         CALL mpi_isend( pmess, kbytes, mpi_double_precision, kdest, ktyp,   &
-            &                          mpi_comm_opa, md_req, iflag )
-      END SELECT
-#endif
-
-   END SUBROUTINE mppsend
-
-
-   SUBROUTINE mpprecv( ktyp, pmess, kbytes )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpprecv  ***
-      !!
-      !! ** Purpose :   Receive messag passing array
-      !!
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      REAL(wp), INTENT(inout) ::   pmess(*)       ! array of real
-      INTEGER , INTENT( in  ) ::   kbytes,     &  ! suze of the array pmess
-         &                         ktyp           ! Tag of the recevied message
-      !!----------------------------------------------------------------------
-#if defined key_mpp_shmem
-      !! * SHMEM version  :    routine not used
-
-#  elif defined key_mpp_mpi
-      !! * MPI version
-      INTEGER :: istatus(mpi_status_size)
-      INTEGER :: iflag
-
-      CALL mpi_recv( pmess, kbytes, mpi_double_precision, mpi_any_source, ktyp,   &
-         &                          mpi_comm_opa, istatus, iflag )
-#endif
-
-   END SUBROUTINE mpprecv
-
-
-   SUBROUTINE mppgather( ptab, kp, pio )
-      !!----------------------------------------------------------------------
-      !!                   ***  routine mppgather  ***
-      !!                   
-      !! ** Purpose :   Transfert between a local subdomain array and a work 
-      !!     array which is distributed following the vertical level.
-      !!
-      !! ** Method  :
-      !!
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      REAL(wp), DIMENSION(jpi,jpj),       INTENT( in  ) ::   ptab   ! subdomain input array
-      INTEGER ,                           INTENT( in  ) ::   kp     ! record length
-      REAL(wp), DIMENSION(jpi,jpj,jpnij), INTENT( out ) ::   pio    ! subdomain input array
-      !!---------------------------------------------------------------------
-#if defined key_mpp_shmem
-      !! * SHMEM version
-
-      CALL barrier()
-      CALL shmem_put( pio(1,1,npvm_me+1), ptab, jpi*jpj, kp )
-      CALL barrier()
-
-#elif defined key_mpp_mpi
-      !! * Local variables   (MPI version)
-      INTEGER :: itaille,ierror
-  
-      itaille=jpi*jpj
-      CALL mpi_gather( ptab, itaille, mpi_double_precision, pio, itaille,   &
-         &                            mpi_double_precision, kp , mpi_comm_opa, ierror ) 
-#endif
-
-   END SUBROUTINE mppgather
-
-
-   SUBROUTINE mppscatter( pio, kp, ptab )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppscatter  ***
-      !!
-      !! ** Purpose :   Transfert between awork array which is distributed 
-      !!      following the vertical level and the local subdomain array.
-      !!
-      !! ** Method :
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpnij)  ::  pio        ! output array
-      INTEGER                             ::   kp        ! Tag (not used with MPI
-      REAL(wp), DIMENSION(jpi,jpj)        ::  ptab       ! subdomain array input
-      !!---------------------------------------------------------------------
-#if defined key_mpp_shmem
-      !! * SHMEM version
-
-      CALL barrier()
-      CALL shmem_get( ptab, pio(1,1,npvm_me+1), jpi*jpj, kp )
-      CALL barrier()
-
-#  elif defined key_mpp_mpi
-      !! * Local variables   (MPI version)
-      INTEGER :: itaille, ierror
-  
-      itaille=jpi*jpj
-
-      CALL mpi_scatter( pio, itaille, mpi_double_precision, ptab, itaille,   &
-         &                            mpi_double_precision, kp, mpi_comm_opa, ierror )
-#endif
-
-   END SUBROUTINE mppscatter
-
-
-   SUBROUTINE mppisl_a_int( ktab, kdim )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppisl_a_int  ***
-      !!                   
-      !! ** Purpose :   Massively parallel processors
-      !!                Find the  non zero value
-      !!
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      INTEGER, INTENT( in  )                  ::   kdim       ! ???
-      INTEGER, INTENT(inout), DIMENSION(kdim) ::   ktab       ! ???
-  
-#if defined key_mpp_shmem
-      !! * Local variables   (SHMEM version)
-      INTEGER :: ji
-      INTEGER, SAVE :: ibool=0
-
-      IF( kdim > jpmppsum ) CALL ctl_stop( 'mppisl_a_int routine : kdim is too big', &
-           &                               'change jpmppsum dimension in mpp.h' )
-
-      DO ji = 1, kdim
-         niitab_shmem(ji) = ktab(ji)
-      END DO
-      CALL  barrier()
-      IF(ibool == 0 ) THEN 
-         CALL shmem_int8_min_to_all (ni11tab_shmem,niitab_shmem,kdim,0   &
-              ,0,N$PES,ni11wrk_shmem,ni11sync_shmem)
-         CALL shmem_int8_max_to_all (ni12tab_shmem,niitab_shmem,kdim,0   &
-              ,0,N$PES,ni12wrk_shmem,ni12sync_shmem)
-      ELSE
-         CALL shmem_int8_min_to_all (ni11tab_shmem,niitab_shmem,kdim,0   &
-              ,0,N$PES,ni21wrk_shmem,ni21sync_shmem)
-         CALL shmem_int8_max_to_all (ni12tab_shmem,niitab_shmem,kdim,0   &
-              ,0,N$PES,ni22wrk_shmem,ni22sync_shmem)
-      ENDIF
-      CALL  barrier()
-      ibool=ibool+1
-      ibool=MOD( ibool,2)
-      DO ji = 1, kdim
-         IF( ni11tab_shmem(ji) /= 0. ) THEN
-            ktab(ji) = ni11tab_shmem(ji)
-         ELSE
-            ktab(ji) = ni12tab_shmem(ji)
-         ENDIF
-      END DO
-  
-#  elif defined key_mpp_mpi
-      !! * Local variables   (MPI version)
-      LOGICAL  :: lcommute
-      INTEGER, DIMENSION(kdim) ::   iwork
-      INTEGER  :: mpi_isl,ierror
-  
-      lcommute = .TRUE.
-      CALL mpi_op_create( lc_isl, lcommute, mpi_isl, ierror )
-      CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer   &
-           , mpi_isl, mpi_comm_opa, ierror )
-      ktab(:) = iwork(:)
-#endif
-
-   END SUBROUTINE mppisl_a_int
-
-
-   SUBROUTINE mppisl_int( ktab )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppisl_int  ***
-      !!                   
-      !! ** Purpose :   Massively parallel processors
-      !!                Find the non zero value
-      !!
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      INTEGER , INTENT( inout ) ::   ktab        ! 
-
-#if defined key_mpp_shmem
-      !! * Local variables   (SHMEM version)
-      INTEGER, SAVE :: ibool=0
-
-      niitab_shmem(1) = ktab
-      CALL  barrier()
-      IF(ibool == 0 ) THEN 
-         CALL shmem_int8_min_to_all (ni11tab_shmem,niitab_shmem,1,0   &
-              ,0,N$PES,ni11wrk_shmem,ni11sync_shmem)
-         CALL shmem_int8_max_to_all (ni12tab_shmem,niitab_shmem,1,0   &
-              ,0,N$PES,ni12wrk_shmem,ni12sync_shmem)
-      ELSE
-         CALL shmem_int8_min_to_all (ni11tab_shmem,niitab_shmem,1,0   &
-              ,0,N$PES,ni21wrk_shmem,ni21sync_shmem)
-         CALL shmem_int8_max_to_all (ni12tab_shmem,niitab_shmem,1,0   &
-              ,0,N$PES,ni22wrk_shmem,ni22sync_shmem)
-      ENDIF
-      CALL  barrier()
-      ibool=ibool+1
-      ibool=MOD( ibool,2)
-      IF( ni11tab_shmem(1) /= 0. ) THEN
-         ktab = ni11tab_shmem(1)
-      ELSE
-         ktab = ni12tab_shmem(1)
-      ENDIF
-  
-#  elif defined key_mpp_mpi
-  
-      !! * Local variables   (MPI version)
-      LOGICAL :: lcommute
-      INTEGER :: mpi_isl,ierror
-      INTEGER ::   iwork
-  
-      lcommute = .TRUE.
-      CALL mpi_op_create(lc_isl,lcommute,mpi_isl,ierror)
-      CALL mpi_allreduce(ktab, iwork, 1,mpi_integer   &
-           ,mpi_isl,mpi_comm_opa,ierror)
-      ktab = iwork
-#endif
-
-   END SUBROUTINE mppisl_int
-
-
-   SUBROUTINE mppmax_a_int( ktab, kdim, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppmax_a_int  ***
-      !! 
-      !! ** Purpose :   Find maximum value in an integer layout array
-      !!
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      INTEGER , INTENT( in  )                  ::   kdim        ! size of array
-      INTEGER , INTENT(inout), DIMENSION(kdim) ::   ktab        ! input array
-      INTEGER , INTENT(in)   , OPTIONAL        ::   kcom  
-  
-#if defined key_mpp_shmem
-      !! * Local declarations    (SHMEM version)
-      INTEGER :: ji
-      INTEGER, SAVE :: ibool=0
-  
-      IF( kdim > jpmppsum ) CALL ctl_stop( 'mppmax_a_int routine : kdim is too big', &
-           &                               'change jpmppsum dimension in mpp.h' )
-  
-      DO ji = 1, kdim
-         niltab_shmem(ji) = ktab(ji)
-      END DO
-      CALL  barrier()
-      IF(ibool == 0 ) THEN 
-         CALL shmem_int8_max_to_all (niltab_shmem,niltab_shmem,kdim,0,0   &
-              ,N$PES,nil1wrk_shmem,nil1sync_shmem )
-      ELSE
-         CALL shmem_int8_max_to_all (niltab_shmem,niltab_shmem,kdim,0,0   &
-              ,N$PES,nil2wrk_shmem,nil2sync_shmem )
-      ENDIF
-      CALL  barrier()
-      ibool=ibool+1
-      ibool=MOD( ibool,2)
-      DO ji = 1, kdim
-         ktab(ji) = niltab_shmem(ji)
-      END DO
-  
-#  elif defined key_mpp_mpi
-  
-      !! * Local variables   (MPI version)
-      INTEGER :: ierror
-      INTEGER :: localcomm
-      INTEGER, DIMENSION(kdim) ::   iwork
-
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) ) localcomm = kcom
-  
-      CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer,   &
-           &                mpi_max, localcomm, ierror )
-  
-      ktab(:) = iwork(:)
-#endif
-
-   END SUBROUTINE mppmax_a_int
-
-
-   SUBROUTINE mppmax_int( ktab, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppmax_int  ***
-      !!
-      !! ** Purpose :
-      !!     Massively parallel processors
-      !!     Find maximum value in an integer layout array
-      !!
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      INTEGER, INTENT(inout) ::   ktab      ! ???
-      INTEGER, INTENT(in), OPTIONAL ::   kcom      ! ???
-  
-      !! * Local declarations
-
-#if defined key_mpp_shmem
-
-      !! * Local variables   (SHMEM version)
-      INTEGER :: ji
-      INTEGER, SAVE :: ibool=0
-  
-      niltab_shmem(1) = ktab
-      CALL  barrier()
-      IF(ibool == 0 ) THEN 
-         CALL shmem_int8_max_to_all (niltab_shmem,niltab_shmem, 1,0,0   &
-              ,N$PES,nil1wrk_shmem,nil1sync_shmem )
-      ELSE
-         CALL shmem_int8_max_to_all (niltab_shmem,niltab_shmem, 1,0,0   &
-              ,N$PES,nil2wrk_shmem,nil2sync_shmem )
-      ENDIF
-      CALL  barrier()
-      ibool=ibool+1
-      ibool=MOD( ibool,2)
-      ktab = niltab_shmem(1)
-  
-#  elif defined key_mpp_mpi
-
-      !! * Local variables   (MPI version)
-      INTEGER ::  ierror, iwork
-      INTEGER :: localcomm
-
-      localcomm = mpi_comm_opa 
-      IF( PRESENT(kcom) ) localcomm = kcom
-
-      CALL mpi_allreduce(ktab,iwork, 1,mpi_integer   &
-           &              ,mpi_max,localcomm,ierror)
-  
-      ktab = iwork
-#endif
-
-   END SUBROUTINE mppmax_int
-
-
-   SUBROUTINE mppmin_a_int( ktab, kdim, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppmin_a_int  ***
-      !! 
-      !! ** Purpose :   Find minimum value in an integer layout array
-      !!
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      INTEGER , INTENT( in  )                  ::   kdim        ! size of array
-      INTEGER , INTENT(inout), DIMENSION(kdim) ::   ktab        ! input array
-      INTEGER , INTENT( in  ), OPTIONAL        ::   kcom        ! input array
-  
-#if defined key_mpp_shmem
-      !! * Local declarations    (SHMEM version)
-      INTEGER :: ji
-      INTEGER, SAVE :: ibool=0
-  
-      IF( kdim > jpmppsum ) CALL ctl_stop( 'mppmin_a_int routine : kdim is too big', &
-           &                               'change jpmppsum dimension in mpp.h' )
-  
-      DO ji = 1, kdim
-         niltab_shmem(ji) = ktab(ji)
-      END DO
-      CALL  barrier()
-      IF(ibool == 0 ) THEN 
-         CALL shmem_int8_min_to_all (niltab_shmem,niltab_shmem,kdim,0,0   &
-              ,N$PES,nil1wrk_shmem,nil1sync_shmem )
-      ELSE
-         CALL shmem_int8_min_to_all (niltab_shmem,niltab_shmem,kdim,0,0   &
-              ,N$PES,nil2wrk_shmem,nil2sync_shmem )
-      ENDIF
-      CALL  barrier()
-      ibool=ibool+1
-      ibool=MOD( ibool,2)
-      DO ji = 1, kdim
-         ktab(ji) = niltab_shmem(ji)
-      END DO
-  
-#  elif defined key_mpp_mpi
-  
-      !! * Local variables   (MPI version)
-      INTEGER :: ierror
-      INTEGER :: localcomm
-      INTEGER, DIMENSION(kdim) ::   iwork
-  
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) ) localcomm = kcom
-
-      CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer,   &
-           &                mpi_min, localcomm, ierror )
-  
-      ktab(:) = iwork(:)
-#endif
-
-   END SUBROUTINE mppmin_a_int
-
-
-   SUBROUTINE mppmin_int( ktab )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppmin_int  ***
-      !!
-      !! ** Purpose :
-      !!     Massively parallel processors
-      !!     Find minimum value in an integer layout array
-      !!
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      INTEGER, INTENT(inout) ::   ktab      ! ???
-  
-      !! * Local declarations
-
-#if defined key_mpp_shmem
-
-      !! * Local variables   (SHMEM version)
-      INTEGER :: ji
-      INTEGER, SAVE :: ibool=0
-  
-      niltab_shmem(1) = ktab
-      CALL  barrier()
-      IF(ibool == 0 ) THEN 
-         CALL shmem_int8_min_to_all (niltab_shmem,niltab_shmem, 1,0,0   &
-              ,N$PES,nil1wrk_shmem,nil1sync_shmem )
-      ELSE
-         CALL shmem_int8_min_to_all (niltab_shmem,niltab_shmem, 1,0,0   &
-              ,N$PES,nil2wrk_shmem,nil2sync_shmem )
-      ENDIF
-      CALL  barrier()
-      ibool=ibool+1
-      ibool=MOD( ibool,2)
-      ktab = niltab_shmem(1)
-  
-#  elif defined key_mpp_mpi
-
-      !! * Local variables   (MPI version)
-      INTEGER ::  ierror, iwork
-  
-      CALL mpi_allreduce(ktab,iwork, 1,mpi_integer   &
-           &              ,mpi_min,mpi_comm_opa,ierror)
-  
-      ktab = iwork
-#endif
-
-   END SUBROUTINE mppmin_int
-
-
-   SUBROUTINE mppsum_a_int( ktab, kdim )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppsum_a_int  ***
-      !!                    
-      !! ** Purpose :   Massively parallel processors
-      !!                Global integer sum
-      !!
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      INTEGER, INTENT( in  )                   ::   kdim      ! ???
-      INTEGER, INTENT(inout), DIMENSION (kdim) ::   ktab      ! ???
-  
-#if defined key_mpp_shmem
-
-      !! * Local variables   (SHMEM version)
-      INTEGER :: ji
-      INTEGER, SAVE :: ibool=0
-
-      IF( kdim > jpmppsum ) CALL ctl_stop( 'mppsum_a_int routine : kdim is too big', &
-           &                               'change jpmppsum dimension in mpp.h' )
-
-      DO ji = 1, kdim
-         nistab_shmem(ji) = ktab(ji)
-      END DO
-      CALL  barrier()
-      IF(ibool == 0 ) THEN 
-         CALL shmem_int8_sum_to_all(nistab_shmem,nistab_shmem,kdim,0,0,   &
-              N$PES,nis1wrk_shmem,nis1sync_shmem)
-      ELSE
-         CALL shmem_int8_sum_to_all(nistab_shmem,nistab_shmem,kdim,0,0,   &
-              N$PES,nis2wrk_shmem,nis2sync_shmem)
-      ENDIF
-      CALL  barrier()
-      ibool = ibool + 1
-      ibool = MOD( ibool, 2 )
-      DO ji = 1, kdim
-         ktab(ji) = nistab_shmem(ji)
-      END DO
-  
-#  elif defined key_mpp_mpi
-
-      !! * Local variables   (MPI version)
-      INTEGER :: ierror
-      INTEGER, DIMENSION (kdim) ::  iwork
-  
-      CALL mpi_allreduce(ktab, iwork,kdim,mpi_integer   &
-           ,mpi_sum,mpi_comm_opa,ierror)
-  
-      ktab(:) = iwork(:)
-#endif
-
-   END SUBROUTINE mppsum_a_int
-
-
-  SUBROUTINE mppsum_int( ktab )
-    !!----------------------------------------------------------------------
-    !!                 ***  routine mppsum_int  ***
-    !!                  
-    !! ** Purpose :   Global integer sum
-    !!
-    !!----------------------------------------------------------------------
-    !! * Arguments
-    INTEGER, INTENT(inout) ::   ktab
-
-#if defined key_mpp_shmem
-
-    !! * Local variables   (SHMEM version)
-    INTEGER, SAVE :: ibool=0
-
-    nistab_shmem(1) = ktab
-    CALL  barrier()
-    IF(ibool == 0 ) THEN 
-       CALL shmem_int8_sum_to_all(nistab_shmem,nistab_shmem, 1,0,0,   &
-            N$PES,nis1wrk_shmem,nis1sync_shmem)
-    ELSE
-       CALL shmem_int8_sum_to_all(nistab_shmem,nistab_shmem, 1,0,0,   &
-            N$PES,nis2wrk_shmem,nis2sync_shmem)
-    ENDIF
-    CALL  barrier()
-    ibool=ibool+1
-    ibool=MOD( ibool,2)
-    ktab = nistab_shmem(1)
-
-#  elif defined key_mpp_mpi
-
-    !! * Local variables   (MPI version)
-    INTEGER :: ierror, iwork
-
-    CALL mpi_allreduce(ktab,iwork, 1,mpi_integer   &
-         ,mpi_sum,mpi_comm_opa,ierror)
-
-    ktab = iwork
-
-#endif
-
-  END SUBROUTINE mppsum_int
-
-
-  SUBROUTINE mppisl_a_real( ptab, kdim )
-    !!----------------------------------------------------------------------
-    !!                 ***  routine mppisl_a_real  ***
-    !!         
-    !! ** Purpose :   Massively parallel processors
-    !!           Find the non zero island barotropic stream function value
-    !!
-    !!   Modifications:
-    !!        !  93-09 (M. Imbard)
-    !!        !  96-05 (j. Escobar)
-    !!        !  98-05 (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI 
-    !!----------------------------------------------------------------------
-    INTEGER , INTENT( in  )                  ::   kdim      ! ???
-    REAL(wp), INTENT(inout), DIMENSION(kdim) ::   ptab      ! ???
-
-#if defined key_mpp_shmem
-
-    !! * Local variables   (SHMEM version)
-    INTEGER :: ji
-    INTEGER, SAVE :: ibool=0
-
-    IF( kdim > jpmppsum ) CALL ctl_stop( 'mppisl_a_real routine : kdim is too big', &
-         &                               'change jpmppsum dimension in mpp.h' )
-
-    DO ji = 1, kdim
-       wiltab_shmem(ji) = ptab(ji)
-    END DO
-    CALL  barrier()
-    IF(ibool == 0 ) THEN 
-       CALL shmem_real8_min_to_all (wi1tab_shmem,wiltab_shmem,kdim,0   &
-            ,0,N$PES,wi11wrk_shmem,ni11sync_shmem)
-       CALL shmem_real8_max_to_all (wi2tab_shmem,wiltab_shmem,kdim,0   &
-            ,0,N$PES,wi12wrk_shmem,ni12sync_shmem)
-    ELSE
-       CALL shmem_real8_min_to_all (wi1tab_shmem,wiltab_shmem,kdim,0   &
-            ,0,N$PES,wi21wrk_shmem,ni21sync_shmem)
-       CALL shmem_real8_max_to_all (wi2tab_shmem,wiltab_shmem,kdim,0   &
-            ,0,N$PES,wi22wrk_shmem,ni22sync_shmem)
-    ENDIF
-    CALL  barrier()
-    ibool=ibool+1
-    ibool=MOD( ibool,2)
-    DO ji = 1, kdim
-       IF(wi1tab_shmem(ji) /= 0. ) THEN
-          ptab(ji) = wi1tab_shmem(ji)
-       ELSE
-          ptab(ji) = wi2tab_shmem(ji)
-       ENDIF
-    END DO
-
-#  elif defined key_mpp_mpi
-
-    !! * Local variables   (MPI version)
-    LOGICAL ::   lcommute = .TRUE.
-    INTEGER ::   mpi_isl, ierror
-    REAL(wp), DIMENSION(kdim) ::  zwork
-
-    CALL mpi_op_create(lc_isl,lcommute,mpi_isl,ierror)
-    CALL mpi_allreduce(ptab, zwork,kdim,mpi_double_precision   &
-         ,mpi_isl,mpi_comm_opa,ierror)
-    ptab(:) = zwork(:)
-
-#endif
-
-  END SUBROUTINE mppisl_a_real
-
-
-   SUBROUTINE mppisl_real( ptab )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppisl_real  ***
-      !!                  
-      !! ** Purpose :   Massively parallel processors
-      !!       Find the  non zero island barotropic stream function value
-      !!
-      !!     Modifications:
-      !!        !  93-09 (M. Imbard)
-      !!        !  96-05 (j. Escobar)
-      !!        !  98-05 (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI 
-      !!----------------------------------------------------------------------
-      REAL(wp), INTENT(inout) ::   ptab
-
-#if defined key_mpp_shmem
-
-      !! * Local variables   (SHMEM version)
-      INTEGER, SAVE :: ibool=0
-
-      wiltab_shmem(1) = ptab
-      CALL  barrier()
-      IF(ibool == 0 ) THEN 
-         CALL shmem_real8_min_to_all (wi1tab_shmem,wiltab_shmem, 1,0   &
-            ,0,N$PES,wi11wrk_shmem,ni11sync_shmem)
-         CALL shmem_real8_max_to_all (wi2tab_shmem,wiltab_shmem, 1,0   &
-            ,0,N$PES,wi12wrk_shmem,ni12sync_shmem)
-      ELSE
-         CALL shmem_real8_min_to_all (wi1tab_shmem,wiltab_shmem, 1,0   &
-            ,0,N$PES,wi21wrk_shmem,ni21sync_shmem)
-         CALL shmem_real8_max_to_all (wi2tab_shmem,wiltab_shmem, 1,0   &
-            ,0,N$PES,wi22wrk_shmem,ni22sync_shmem)
-      ENDIF
-      CALL barrier()
-      ibool = ibool + 1
-      ibool = MOD( ibool, 2 )
-      IF( wi1tab_shmem(1) /= 0. ) THEN
-         ptab = wi1tab_shmem(1)
-      ELSE
-         ptab = wi2tab_shmem(1)
-      ENDIF
-
-#  elif defined key_mpp_mpi
-
-      !! * Local variables   (MPI version)
-      LOGICAL  ::   lcommute = .TRUE.
-      INTEGER  ::   mpi_isl, ierror
-      REAL(wp) ::   zwork
-
-      CALL mpi_op_create( lc_isl, lcommute, mpi_isl, ierror )
-      CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision,   &
-         &                                mpi_isl  , mpi_comm_opa, ierror )
-      ptab = zwork
-
-#endif
-
-   END SUBROUTINE mppisl_real
-
-
-  FUNCTION lc_isl( py, px, kdim )
-    INTEGER :: kdim
-    REAL(wp), DIMENSION(kdim) ::  px, py
-    INTEGER :: kdtatyp, ji
-    INTEGER :: lc_isl
-    DO ji = 1, kdim
-       IF( py(ji) /= 0. )   px(ji) = py(ji)
-    END DO
-    lc_isl=0
-
-  END FUNCTION lc_isl
-
-
-  SUBROUTINE mppmax_a_real( ptab, kdim, kcom )
-    !!----------------------------------------------------------------------
-    !!                 ***  routine mppmax_a_real  ***
-    !!                  
-    !! ** Purpose :   Maximum
-    !!
-    !!----------------------------------------------------------------------
-    !! * Arguments
-    INTEGER , INTENT( in  )                  ::   kdim
-    REAL(wp), INTENT(inout), DIMENSION(kdim) ::   ptab
-    INTEGER , INTENT( in  ), OPTIONAL        ::   kcom
-
-#if defined key_mpp_shmem
-
-    !! * Local variables   (SHMEM version)
-    INTEGER :: ji
-    INTEGER, SAVE :: ibool=0
-
-    IF( kdim > jpmppsum ) CALL ctl_stop( 'mppmax_a_real routine : kdim is too big', &
-         &                               'change jpmppsum dimension in mpp.h' )
-
-    DO ji = 1, kdim
-       wintab_shmem(ji) = ptab(ji)
-    END DO
-    CALL  barrier()
-    IF(ibool == 0 ) THEN 
-       CALL shmem_real8_max_to_all (wintab_shmem,wintab_shmem,kdim,0   &
-            ,0,N$PES,wi1wrk_shmem,ni1sync_shmem)
-    ELSE
-       CALL shmem_real8_max_to_all (wintab_shmem,wintab_shmem,kdim,0   &
-            ,0,N$PES,wi2wrk_shmem,ni2sync_shmem)
-    ENDIF
-    CALL  barrier()
-    ibool=ibool+1
-    ibool=MOD( ibool,2)
-    DO ji = 1, kdim
-       ptab(ji) = wintab_shmem(ji)
-    END DO
-
-#  elif defined key_mpp_mpi
-
-    !! * Local variables   (MPI version)
-    INTEGER :: ierror
-    INTEGER :: localcomm
-    REAL(wp), DIMENSION(kdim) ::  zwork
-
-    localcomm = mpi_comm_opa
-    IF( PRESENT(kcom) ) localcomm = kcom
-
-    CALL mpi_allreduce(ptab, zwork,kdim,mpi_double_precision   &
-         ,mpi_max,localcomm,ierror)
-    ptab(:) = zwork(:)
-
-#endif
-
-  END SUBROUTINE mppmax_a_real
-
-
-  SUBROUTINE mppmax_real( ptab, kcom )
-    !!----------------------------------------------------------------------
-    !!                  ***  routine mppmax_real  ***
-    !!                    
-    !! ** Purpose :   Maximum
-    !!
-    !!----------------------------------------------------------------------
-    !! * Arguments
-    REAL(wp), INTENT(inout) ::   ptab      ! ???
-    INTEGER , INTENT( in  ), OPTIONAL ::   kcom      ! ???
-
-#if defined key_mpp_shmem
-
-    !! * Local variables   (SHMEM version)
-    INTEGER, SAVE :: ibool=0
-
-    wintab_shmem(1) = ptab
-    CALL  barrier()
-    IF(ibool == 0 ) THEN 
-       CALL shmem_real8_max_to_all (wintab_shmem,wintab_shmem, 1,0   &
-            ,0,N$PES,wi1wrk_shmem,ni1sync_shmem)
-    ELSE
-       CALL shmem_real8_max_to_all (wintab_shmem,wintab_shmem, 1,0   &
-            ,0,N$PES,wi2wrk_shmem,ni2sync_shmem)
-    ENDIF
-    CALL  barrier()
-    ibool=ibool+1
-    ibool=MOD( ibool,2)
-    ptab = wintab_shmem(1)
-
-#  elif defined key_mpp_mpi
-
-    !! * Local variables   (MPI version)
-    INTEGER  ::   ierror
-    INTEGER  ::   localcomm
-    REAL(wp) ::   zwork
-
-    localcomm = mpi_comm_opa 
-    IF( PRESENT(kcom) ) localcomm = kcom
-
-    CALL mpi_allreduce( ptab, zwork  , 1             , mpi_double_precision,   &
-       &                      mpi_max, localcomm, ierror     )
-    ptab = zwork
-
-#endif
-
-  END SUBROUTINE mppmax_real
-
-
-  SUBROUTINE mppmin_a_real( ptab, kdim, kcom )
-    !!----------------------------------------------------------------------
-    !!                 ***  routine mppmin_a_real  ***
-    !!                  
-    !! ** Purpose :   Minimum
-    !!
-    !!-----------------------------------------------------------------------
-    !! * Arguments
-    INTEGER , INTENT( in  )                  ::   kdim
-    REAL(wp), INTENT(inout), DIMENSION(kdim) ::   ptab
-    INTEGER , INTENT( in  ), OPTIONAL        ::   kcom
-
-#if defined key_mpp_shmem
-
-    !! * Local variables   (SHMEM version)
-    INTEGER :: ji
-    INTEGER, SAVE :: ibool=0
-
-    IF( kdim > jpmppsum ) CALL ctl_stop( 'mpprmin routine : kdim is too big', &
-         &                               'change jpmppsum dimension in mpp.h' )
-
-    DO ji = 1, kdim
-       wintab_shmem(ji) = ptab(ji)
-    END DO
-    CALL  barrier()
-    IF(ibool == 0 ) THEN 
-       CALL shmem_real8_min_to_all (wintab_shmem,wintab_shmem,kdim,0   &
-            ,0,N$PES,wi1wrk_shmem,ni1sync_shmem)
-    ELSE
-       CALL shmem_real8_min_to_all (wintab_shmem,wintab_shmem,kdim,0   &
-            ,0,N$PES,wi2wrk_shmem,ni2sync_shmem)
-    ENDIF
-    CALL  barrier()
-    ibool=ibool+1
-    ibool=MOD( ibool,2)
-    DO ji = 1, kdim
-       ptab(ji) = wintab_shmem(ji)
-    END DO
-
-#  elif defined key_mpp_mpi
-
-    !! * Local variables   (MPI version)
-    INTEGER :: ierror
-    INTEGER :: localcomm 
-    REAL(wp), DIMENSION(kdim) ::   zwork
-
-    localcomm = mpi_comm_opa 
-    IF( PRESENT(kcom) ) localcomm = kcom
-
-    CALL mpi_allreduce(ptab, zwork,kdim,mpi_double_precision   &
-         ,mpi_min,localcomm,ierror)
-    ptab(:) = zwork(:)
-
-#endif
-
-  END SUBROUTINE mppmin_a_real
-
-
-  SUBROUTINE mppmin_real( ptab, kcom )
-    !!----------------------------------------------------------------------
-    !!                  ***  routine mppmin_real  ***
-    !! 
-    !! ** Purpose :   minimum in Massively Parallel Processing
-    !!                REAL scalar case
-    !!
-    !!-----------------------------------------------------------------------
-    !! * Arguments
-    REAL(wp), INTENT( inout ) ::   ptab        ! 
-    INTEGER , INTENT(  in   ), OPTIONAL :: kcom
-
-#if defined key_mpp_shmem
-
-    !! * Local variables   (SHMEM version)
-    INTEGER, SAVE :: ibool=0
-
-    wintab_shmem(1) = ptab
-    CALL  barrier()
-    IF(ibool == 0 ) THEN 
-       CALL shmem_real8_min_to_all (wintab_shmem,wintab_shmem, 1,0   &
-            ,0,N$PES,wi1wrk_shmem,ni1sync_shmem)
-    ELSE
-       CALL shmem_real8_min_to_all (wintab_shmem,wintab_shmem, 1,0   &
-            ,0,N$PES,wi2wrk_shmem,ni2sync_shmem)
-    ENDIF
-    CALL  barrier()
-    ibool=ibool+1
-    ibool=MOD( ibool,2)
-    ptab = wintab_shmem(1)
-
-#  elif defined key_mpp_mpi
-
-    !! * Local variables   (MPI version)
-    INTEGER  ::   ierror
-    REAL(wp) ::   zwork
-    INTEGER :: localcomm
-
-    localcomm = mpi_comm_opa 
-    IF( PRESENT(kcom) ) localcomm = kcom
-
-    CALL mpi_allreduce( ptab, zwork, 1,mpi_double_precision   &
-         &               ,mpi_min,localcomm,ierror)
-    ptab = zwork
-
-#endif
-
-  END SUBROUTINE mppmin_real
-
-
-  SUBROUTINE mppsum_a_real( ptab, kdim, kcom )
-    !!----------------------------------------------------------------------
-    !!                  ***  routine mppsum_a_real  ***
-    !! 
-    !! ** Purpose :   global sum in Massively Parallel Processing
-    !!                REAL ARRAY argument case
-    !!
-    !!-----------------------------------------------------------------------
-    INTEGER , INTENT( in )                     ::   kdim      ! size of ptab
-    REAL(wp), DIMENSION(kdim), INTENT( inout ) ::   ptab      ! input array
-    INTEGER , INTENT( in ), OPTIONAL           :: kcom
-
-#if defined key_mpp_shmem
-
-    !! * Local variables   (SHMEM version)
-    INTEGER :: ji
-    INTEGER, SAVE :: ibool=0
-
-    IF( kdim > jpmppsum ) CALL ctl_stop( 'mppsum_a_real routine : kdim is too big', &
-         &                               'change jpmppsum dimension in mpp.h' )
-
-    DO ji = 1, kdim
-       wrstab_shmem(ji) = ptab(ji)
-    END DO
-    CALL  barrier()
-    IF(ibool == 0 ) THEN 
-       CALL shmem_real8_sum_to_all (wrstab_shmem,wrstab_shmem,kdim,0   &
-            ,0,N$PES,wrs1wrk_shmem,nrs1sync_shmem )
-    ELSE
-       CALL shmem_real8_sum_to_all (wrstab_shmem,wrstab_shmem,kdim,0   &
-            ,0,N$PES,wrs2wrk_shmem,nrs2sync_shmem )
-    ENDIF
-    CALL  barrier()
-    ibool=ibool+1
-    ibool=MOD( ibool,2)
-    DO ji = 1, kdim
-       ptab(ji) = wrstab_shmem(ji)
-    END DO
-
-#  elif defined key_mpp_mpi
-
-    !! * Local variables   (MPI version)
-    INTEGER                   ::   ierror    ! temporary integer
-    INTEGER                   ::   localcomm 
-    REAL(wp), DIMENSION(kdim) ::   zwork     ! temporary workspace 
-    
-
-    localcomm = mpi_comm_opa 
-    IF( PRESENT(kcom) ) localcomm = kcom
-
-    CALL mpi_allreduce(ptab, zwork,kdim,mpi_double_precision   &
-         &              ,mpi_sum,localcomm,ierror)
-    ptab(:) = zwork(:)
-
-#endif
-
-  END SUBROUTINE mppsum_a_real
-
-
-  SUBROUTINE mppsum_real( ptab, kcom )
-    !!----------------------------------------------------------------------
-    !!                  ***  routine mppsum_real  ***
-    !!              
-    !! ** Purpose :   global sum in Massively Parallel Processing
-    !!                SCALAR argument case
-    !!
-    !!-----------------------------------------------------------------------
-    REAL(wp), INTENT(inout) ::   ptab        ! input scalar
-    INTEGER , INTENT( in  ), OPTIONAL :: kcom
-
-#if defined key_mpp_shmem
-
-    !! * Local variables   (SHMEM version)
-    INTEGER, SAVE :: ibool=0
-
-    wrstab_shmem(1) = ptab
-    CALL  barrier()
-    IF(ibool == 0 ) THEN 
-       CALL shmem_real8_sum_to_all (wrstab_shmem,wrstab_shmem, 1,0   &
-            ,0,N$PES,wrs1wrk_shmem,nrs1sync_shmem )
-    ELSE
-       CALL shmem_real8_sum_to_all (wrstab_shmem,wrstab_shmem, 1,0   &
-            ,0,N$PES,wrs2wrk_shmem,nrs2sync_shmem )
-    ENDIF
-    CALL  barrier()
-    ibool = ibool + 1
-    ibool = MOD( ibool, 2 )
-    ptab = wrstab_shmem(1)
-
-#  elif defined key_mpp_mpi
-
-    !! * Local variables   (MPI version)
-    INTEGER  ::   ierror
-    INTEGER  ::   localcomm 
-    REAL(wp) ::   zwork
-
-   localcomm = mpi_comm_opa 
-   IF( PRESENT(kcom) ) localcomm = kcom
- 
-   CALL mpi_allreduce(ptab, zwork, 1,mpi_double_precision   &
-         &              ,mpi_sum,localcomm,ierror)
-    ptab = zwork
-
-#endif
-
-  END SUBROUTINE mppsum_real
-
-  SUBROUTINE mpp_minloc2d(ptab, pmask, pmin, ki,kj )
-    !!------------------------------------------------------------------------
-    !!             ***  routine mpp_minloc  ***
-    !!
-    !! ** Purpose :  Compute the global minimum of an array ptab
-    !!              and also give its global position
-    !!
-    !! ** Method : Use MPI_ALLREDUCE with MPI_MINLOC
-    !!
-    !! ** Arguments : I : ptab =local 2D array
-    !!                O : pmin = global minimum
-    !!                O : ki,kj = global position of minimum
-    !!
-    !! ** Author : J.M. Molines 10/10/2004
-    !!--------------------------------------------------------------------------
-#ifdef key_mpp_shmem
-    CALL ctl_stop( ' mpp_minloc not yet available in SHMEM' )
-# elif key_mpp_mpi
-    !! * Arguments
-    REAL(wp), DIMENSION (jpi,jpj), INTENT (in)  :: ptab ,& ! Local 2D array
-         &                                         pmask   ! Local mask
-    REAL(wp)                     , INTENT (out) :: pmin    ! Global minimum of ptab
-    INTEGER                      , INTENT (out) :: ki,kj   ! index of minimum in global frame
-
-    !! * Local variables
-    REAL(wp) :: zmin   ! local minimum
-    REAL(wp) ,DIMENSION(2,1) :: zain, zaout
-    INTEGER, DIMENSION (2)  :: ilocs
-    INTEGER :: ierror
-
-
-    zmin  = MINVAL( ptab(:,:) , mask= pmask == 1.e0 )
-    ilocs = MINLOC( ptab(:,:) , mask= pmask == 1.e0 )
-
-    ki = ilocs(1) + nimpp - 1
-    kj = ilocs(2) + njmpp - 1
-
-    zain(1,:)=zmin
-    zain(2,:)=ki+10000.*kj
-
-    CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MINLOC,MPI_COMM_OPA,ierror)
-
-    pmin=zaout(1,1)
-    kj= INT(zaout(2,1)/10000.)
-    ki= INT(zaout(2,1) - 10000.*kj )
-#endif
-
-  END SUBROUTINE mpp_minloc2d
-
-
-  SUBROUTINE mpp_minloc3d(ptab, pmask, pmin, ki,kj ,kk)
-    !!------------------------------------------------------------------------
-    !!             ***  routine mpp_minloc  ***
-    !!
-    !! ** Purpose :  Compute the global minimum of an array ptab
-    !!              and also give its global position
-    !!
-    !! ** Method : Use MPI_ALLREDUCE with MPI_MINLOC
-    !!
-    !! ** Arguments : I : ptab =local 2D array
-    !!                O : pmin = global minimum
-    !!                O : ki,kj = global position of minimum
-    !!
-    !! ** Author : J.M. Molines 10/10/2004
-    !!--------------------------------------------------------------------------
-#ifdef key_mpp_shmem
-    CALL ctl_stop( ' mpp_minloc not yet available in SHMEM' )
-# elif key_mpp_mpi
-    !! * Arguments
-    REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT (in)  :: ptab ,& ! Local 2D array
-         &                                         pmask   ! Local mask
-    REAL(wp)                     , INTENT (out) :: pmin    ! Global minimum of ptab
-    INTEGER                      , INTENT (out) :: ki,kj,kk ! index of minimum in global frame
-
-    !! * Local variables
-    REAL(wp) :: zmin   ! local minimum
-    REAL(wp) ,DIMENSION(2,1) :: zain, zaout
-    INTEGER, DIMENSION (3)  :: ilocs
-    INTEGER :: ierror
-
-
-    zmin  = MINVAL( ptab(:,:,:) , mask= pmask == 1.e0 )
-    ilocs = MINLOC( ptab(:,:,:) , mask= pmask == 1.e0 )
-
-    ki = ilocs(1) + nimpp - 1
-    kj = ilocs(2) + njmpp - 1
-    kk = ilocs(3)
-
-    zain(1,:)=zmin
-    zain(2,:)=ki+10000.*kj+100000000.*kk
-
-    CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MINLOC,MPI_COMM_OPA,ierror)
-
-    pmin=zaout(1,1)
-    kk= INT(zaout(2,1)/100000000.)
-    kj= INT(zaout(2,1) - kk * 100000000. )/10000
-    ki= INT(zaout(2,1) - kk * 100000000. -kj * 10000. )
-#endif
-
-  END SUBROUTINE mpp_minloc3d
-
-
-  SUBROUTINE mpp_maxloc2d(ptab, pmask, pmax, ki,kj )
-    !!------------------------------------------------------------------------
-    !!             ***  routine mpp_maxloc  ***
-    !!
-    !! ** Purpose :  Compute the global maximum of an array ptab
-    !!              and also give its global position
-    !!
-    !! ** Method : Use MPI_ALLREDUCE with MPI_MINLOC
-    !!
-    !! ** Arguments : I : ptab =local 2D array
-    !!                O : pmax = global maximum
-    !!                O : ki,kj = global position of maximum
-    !!
-    !! ** Author : J.M. Molines 10/10/2004
-    !!--------------------------------------------------------------------------
-#ifdef key_mpp_shmem
-    CALL ctl_stop( ' mpp_maxloc not yet available in SHMEM' )
-# elif key_mpp_mpi
-    !! * Arguments
-    REAL(wp), DIMENSION (jpi,jpj), INTENT (in)  :: ptab ,& ! Local 2D array
-         &                                         pmask   ! Local mask
-    REAL(wp)                     , INTENT (out) :: pmax    ! Global maximum of ptab
-    INTEGER                      , INTENT (out) :: ki,kj   ! index of maximum in global frame
-
-    !! * Local variables
-    REAL(wp) :: zmax   ! local maximum
-    REAL(wp) ,DIMENSION(2,1) :: zain, zaout
-    INTEGER, DIMENSION (2)  :: ilocs
-    INTEGER :: ierror
-
-
-    zmax  = MAXVAL( ptab(:,:) , mask= pmask == 1.e0 )
-    ilocs = MAXLOC( ptab(:,:) , mask= pmask == 1.e0 )
-
-    ki = ilocs(1) + nimpp - 1
-    kj = ilocs(2) + njmpp - 1
-
-    zain(1,:)=zmax
-    zain(2,:)=ki+10000.*kj
-
-    CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MAXLOC,MPI_COMM_OPA,ierror)
-
-    pmax=zaout(1,1)
-    kj= INT(zaout(2,1)/10000.)
-    ki= INT(zaout(2,1) - 10000.*kj )
-#endif
-
-  END SUBROUTINE mpp_maxloc2d
-
-  SUBROUTINE mpp_maxloc3d(ptab, pmask, pmax, ki,kj,kk )
-    !!------------------------------------------------------------------------
-    !!             ***  routine mpp_maxloc  ***
-    !!
-    !! ** Purpose :  Compute the global maximum of an array ptab
-    !!              and also give its global position
-    !!
-    !! ** Method : Use MPI_ALLREDUCE with MPI_MINLOC
-    !!
-    !! ** Arguments : I : ptab =local 2D array
-    !!                O : pmax = global maximum
-    !!                O : ki,kj = global position of maximum
-    !!
-    !! ** Author : J.M. Molines 10/10/2004
-    !!--------------------------------------------------------------------------
-#ifdef key_mpp_shmem
-    CALL ctl_stop( ' mpp_maxloc not yet available in SHMEM' )
-# elif key_mpp_mpi
-    !! * Arguments
-    REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT (in)  :: ptab ,& ! Local 2D array
-         &                                         pmask   ! Local mask
-    REAL(wp)                     , INTENT (out) :: pmax    ! Global maximum of ptab
-    INTEGER                      , INTENT (out) :: ki,kj,kk   ! index of maximum in global frame
-
-    !! * Local variables
-    REAL(wp) :: zmax   ! local maximum
-    REAL(wp) ,DIMENSION(2,1) :: zain, zaout
-    INTEGER, DIMENSION (3)  :: ilocs
-    INTEGER :: ierror
-
-
-    zmax  = MAXVAL( ptab(:,:,:) , mask= pmask == 1.e0 )
-    ilocs = MAXLOC( ptab(:,:,:) , mask= pmask == 1.e0 )
-
-    ki = ilocs(1) + nimpp - 1
-    kj = ilocs(2) + njmpp - 1
-    kk = ilocs(3)
-
-    zain(1,:)=zmax
-    zain(2,:)=ki+10000.*kj+100000000.*kk
-
-    CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MAXLOC,MPI_COMM_OPA,ierror)
-
-    pmax=zaout(1,1)
-    kk= INT(zaout(2,1)/100000000.)
-    kj= INT(zaout(2,1) - kk * 100000000. )/10000
-    ki= INT(zaout(2,1) - kk * 100000000. -kj * 10000. )
-#endif
-
-  END SUBROUTINE mpp_maxloc3d
-
-  SUBROUTINE mppsync()
-    !!----------------------------------------------------------------------
-    !!                  ***  routine mppsync  ***
-    !!                   
-    !! ** Purpose :   Massively parallel processors, synchroneous
-    !!
-    !!-----------------------------------------------------------------------
-
-#if defined key_mpp_shmem
-
-    !! * Local variables   (SHMEM version)
-    CALL barrier()
-
-#  elif defined key_mpp_mpi
-
-    !! * Local variables   (MPI version)
-    INTEGER :: ierror
-
-    CALL mpi_barrier(mpi_comm_opa,ierror)
-
-#endif
-
-  END SUBROUTINE mppsync
-
-
-  SUBROUTINE mppstop
-    !!----------------------------------------------------------------------
-    !!                  ***  routine mppstop  ***
-    !!                   
-    !! ** purpose :   Stop massilively parallel processors method
-    !!
-    !!----------------------------------------------------------------------
-    !! * Local declarations
-    INTEGER ::   info
-    !!----------------------------------------------------------------------
-
-    ! 1. Mpp synchroneus
-    ! ------------------
-
-    CALL mppsync
-#if defined key_mpp_mpi
-    CALL mpi_finalize( info )
-#endif
-
-  END SUBROUTINE mppstop
-
-
-  SUBROUTINE mppobc( ptab, kd1, kd2, kl, kk, ktype, kij )
-    !!----------------------------------------------------------------------
-    !!                  ***  routine mppobc  ***
-    !! 
-    !! ** Purpose :   Message passing manadgement for open boundary
-    !!     conditions array
-    !!
-    !! ** 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
-    !!
-    !! History :
-    !!        !  98-07 (J.M. Molines) Open boundary conditions
-    !!----------------------------------------------------------------------
-    !! * Arguments
-    INTEGER , INTENT( in ) ::   &
-         kd1, kd2,   &  ! starting and ending indices
-         kl ,        &  ! index of open boundary
-         kk,         &  ! vertical dimension
-         ktype,      &  ! define north/south or east/west cdt
-         !              !  = 1  north/south  ;  = 2  east/west
-         kij            ! horizontal dimension
-    REAL(wp), DIMENSION(kij,kk), INTENT( inout )  ::   &
-         ptab           ! variable array
-
-    !! * Local variables
-    INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
-    INTEGER  ::   &
-         iipt0, iipt1, ilpt1,     &  ! temporary integers
-         ijpt0, ijpt1,            &  !    "          "
-         imigr, iihom, ijhom         !    "          "
-    INTEGER ::   ml_req1, ml_req2, ml_err     ! for key_mpi_isend
-    INTEGER ::   ml_stat(MPI_STATUS_SIZE)     ! for key_mpi_isend
-    REAL(wp), DIMENSION(jpi,jpj) ::   &
-         ztab                        ! temporary workspace
-    !!----------------------------------------------------------------------
-
-
-    ! boundary condition initialization
-    ! ---------------------------------
-
-    ztab(:,:) = 0.e0
-
-    IF( ktype==1 ) THEN                                  ! north/south boundaries
-       iipt0 = MAX( 1, MIN(kd1 - nimpp+1, nlci     ) )
-       iipt1 = MAX( 0, MIN(kd2 - nimpp+1, nlci - 1 ) )
-       ilpt1 = MAX( 1, MIN(kd2 - nimpp+1, nlci     ) )
-       ijpt0 = MAX( 1, MIN(kl  - njmpp+1, nlcj     ) )
-       ijpt1 = MAX( 0, MIN(kl  - njmpp+1, nlcj - 1 ) )
-    ELSEIF( ktype==2 ) THEN                              ! east/west boundaries
-       iipt0 = MAX( 1, MIN(kl  - nimpp+1, nlci     ) )
-       iipt1 = MAX( 0, MIN(kl  - nimpp+1, nlci - 1 ) )
-       ijpt0 = MAX( 1, MIN(kd1 - njmpp+1, nlcj     ) )
-       ijpt1 = MAX( 0, MIN(kd2 - njmpp+1, nlcj - 1 ) )
-       ilpt1 = MAX( 1, MIN(kd2 - njmpp+1, nlcj     ) )
-    ELSE
-       CALL ctl_stop( 'mppobc: bad ktype' )
-    ENDIF
-
-    DO jk = 1, kk
-       IF( ktype==1 ) THEN                               ! north/south boundaries
-          DO jj = ijpt0, ijpt1
-             DO ji = iipt0, iipt1
-                ztab(ji,jj) = ptab(ji,jk)
-             END DO
-          END DO
-       ELSEIF( ktype==2 ) THEN                           ! east/west boundaries
-          DO jj = ijpt0, ijpt1
-             DO ji = iipt0, iipt1
-                ztab(ji,jj) = ptab(jj,jk)
-             END DO
-          END DO
-       ENDIF
-
-
-       ! 1. East and west directions
-       ! ---------------------------
-
-       ! 1.1 Read Dirichlet lateral conditions
-
-       IF( nbondi /= 2 ) THEN
-          iihom = nlci-nreci
-
-          DO jl = 1, jpreci
-             t2ew(:,jl,1) = ztab(jpreci+jl,:)
-             t2we(:,jl,1) = ztab(iihom +jl,:)
-          END DO
-       ENDIF
-
-       ! 1.2 Migrations
-
-#if defined key_mpp_shmem
-       !! *  (SHMEM version)
-       imigr=jpreci*jpj*jpbyt
-
-       IF( nbondi == -1 ) THEN
-          CALL shmem_put( t2we(1,1,2), t2we(1,1,1), imigr/jpbyt, noea )
-       ELSEIF( nbondi == 0 ) THEN
-          CALL shmem_put( t2ew(1,1,2), t2ew(1,1,1), imigr/jpbyt, nowe )
-          CALL shmem_put( t2we(1,1,2), t2we(1,1,1), imigr/jpbyt, noea )
-       ELSEIF( nbondi == 1 ) THEN
-          CALL shmem_put( t2ew(1,1,2), t2ew(1,1,1), imigr/jpbyt, nowe )
-       ENDIF
-       CALL barrier()
-       CALL shmem_udcflush()
-
-#  elif key_mpp_mpi
-       !! * (MPI version)
-
-       imigr=jpreci*jpj
-
-       IF( nbondi == -1 ) THEN
-          CALL mppsend(2,t2we(1,1,1),imigr,noea, ml_req1)
-          CALL mpprecv(1,t2ew(1,1,2),imigr)
-          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-       ELSEIF( nbondi == 0 ) THEN
-          CALL mppsend(1,t2ew(1,1,1),imigr,nowe, ml_req1)
-          CALL mppsend(2,t2we(1,1,1),imigr,noea, ml_req2)
-          CALL mpprecv(1,t2ew(1,1,2),imigr)
-          CALL mpprecv(2,t2we(1,1,2),imigr)
-          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-          IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
-       ELSEIF( nbondi == 1 ) THEN
-          CALL mppsend(1,t2ew(1,1,1),imigr,nowe, ml_req1)
-          CALL mpprecv(2,t2we(1,1,2),imigr)
-          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-       ENDIF
-#endif
-
-
-       ! 1.3 Write Dirichlet lateral conditions
-
-       iihom = nlci-jpreci
-       IF( nbondi == 0 .OR. nbondi == 1 ) THEN
-          DO jl = 1, jpreci
-             ztab(jl,:) = t2we(:,jl,2)
-          END DO
-       ENDIF
-
-       IF( nbondi == -1 .OR. nbondi == 0 ) THEN
-          DO jl = 1, jpreci
-             ztab(iihom+jl,:) = t2ew(:,jl,2)
-          END DO
-       ENDIF
-
-
-       ! 2. North and south directions
-       ! -----------------------------
-
-       ! 2.1 Read Dirichlet lateral conditions
-
-       IF( nbondj /= 2 ) THEN
-          ijhom = nlcj-nrecj
-          DO jl = 1, jprecj
-             t2sn(:,jl,1) = ztab(:,ijhom +jl)
-             t2ns(:,jl,1) = ztab(:,jprecj+jl)
-          END DO
-       ENDIF
-
-       ! 2.2 Migrations
-
-#if defined key_mpp_shmem
-       !! * SHMEM version
-
-       imigr=jprecj*jpi*jpbyt
-
-       IF( nbondj == -1 ) THEN
-          CALL shmem_put( t2sn(1,1,2), t2sn(1,1,1), imigr/jpbyt, nono )
-       ELSEIF( nbondj == 0 ) THEN
-          CALL shmem_put( t2ns(1,1,2), t2ns(1,1,1), imigr/jpbyt, noso )
-          CALL shmem_put( t2sn(1,1,2), t2sn(1,1,1), imigr/jpbyt, nono )
-       ELSEIF( nbondj == 1 ) THEN
-          CALL shmem_put( t2ns(1,1,2), t2ns(1,1,1), imigr/jpbyt, noso )
-       ENDIF
-       CALL barrier()
-       CALL shmem_udcflush()
-
-#  elif key_mpp_mpi
-       !! * Local variables   (MPI version)
-
-       imigr=jprecj*jpi
-
-       IF( nbondj == -1 ) THEN
-          CALL mppsend(4,t2sn(1,1,1),imigr,nono, ml_req1)
-          CALL mpprecv(3,t2ns(1,1,2),imigr)
-          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-       ELSEIF( nbondj == 0 ) THEN
-          CALL mppsend(3,t2ns(1,1,1),imigr,noso, ml_req1)
-          CALL mppsend(4,t2sn(1,1,1),imigr,nono, ml_req2)
-          CALL mpprecv(3,t2ns(1,1,2),imigr)
-          CALL mpprecv(4,t2sn(1,1,2),imigr)
-          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-          IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
-       ELSEIF( nbondj == 1 ) THEN
-          CALL mppsend(3,t2ns(1,1,1),imigr,noso, ml_req1)
-          CALL mpprecv(4,t2sn(1,1,2),imigr)
-          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-       ENDIF
-
-#endif
-
-       ! 2.3 Write Dirichlet lateral conditions
-
-       ijhom = nlcj - jprecj
-       IF( nbondj == 0 .OR. nbondj == 1 ) THEN
-          DO jl = 1, jprecj
-             ztab(:,jl) = t2sn(:,jl,2)
-          END DO
-       ENDIF
-
-       IF( nbondj == 0 .OR. nbondj == -1 ) THEN
-          DO jl = 1, jprecj
-             ztab(:,ijhom+jl) = t2ns(:,jl,2)
-          END DO
-       ENDIF
-
-       IF( ktype==1 .AND. kd1 <= jpi+nimpp-1 .AND. nimpp <= kd2 ) THEN
-          ! north/south boundaries
-          DO jj = ijpt0,ijpt1
-             DO ji = iipt0,ilpt1
-                ptab(ji,jk) = ztab(ji,jj)  
-             END DO
-          END DO
-       ELSEIF( ktype==2 .AND. kd1 <= jpj+njmpp-1 .AND. njmpp <= kd2 ) THEN
-          ! east/west boundaries
-          DO jj = ijpt0,ilpt1
-             DO ji = iipt0,iipt1
-                ptab(jj,jk) = ztab(ji,jj) 
-             END DO
-          END DO
-       ENDIF
-
-    END DO
-
-  END SUBROUTINE mppobc
-
-  SUBROUTINE mpp_comm_free( kcom)
-
-     INTEGER, INTENT(in) :: kcom
-     INTEGER :: ierr
-
-     CALL MPI_COMM_FREE(kcom, ierr)
-
-  END SUBROUTINE mpp_comm_free
-
-
-  SUBROUTINE mpp_ini_ice(pindic)
-    !!----------------------------------------------------------------------
-    !!               ***  routine mpp_ini_ice  ***
-    !!
-    !! ** Purpose :   Initialize special communicator for ice areas
-    !!      condition together with global variables needed in the ddmpp folding
-    !!
-    !! ** Method  : - Look for ice processors in ice routines
-    !!              - Put their number in nrank_ice
-    !!              - Create groups for the world processors and the ice processors
-    !!              - Create a communicator for ice processors
-    !!
-    !! ** output
-    !!      njmppmax = njmpp for northern procs
-    !!      ndim_rank_ice = number of processors in the northern line
-    !!      nrank_north (ndim_rank_north) = number  of the northern procs.
-    !!      ngrp_world = group ID for the world processors
-    !!      ngrp_ice = group ID for the ice processors
-    !!      ncomm_ice = communicator for the ice procs.
-    !!      n_ice_root = number (in the world) of proc 0 in the ice comm.
-    !!
-    !! History :
-    !!        !  03-09 (J.M. Molines, MPI only )
-    !!----------------------------------------------------------------------
-#ifdef key_mpp_shmem
-    CALL ctl_stop( ' mpp_ini_ice not available in SHMEM' )
-# elif key_mpp_mpi
-    INTEGER, INTENT(in) :: pindic
-    INTEGER :: ierr
-    INTEGER :: jproc
-    INTEGER :: ii
-    INTEGER, DIMENSION(jpnij) :: kice
-    INTEGER, DIMENSION(jpnij) :: zwork
-    !!----------------------------------------------------------------------
-
-    ! Look for how many procs with sea-ice
-    !
-    kice = 0
-    DO jproc=1,jpnij
-       IF(jproc == narea .AND. pindic .GT. 0) THEN
-          kice(jproc) = 1    
-       ENDIF        
-    END DO
-
-    zwork = 0
-    CALL MPI_ALLREDUCE( kice, zwork,jpnij, mpi_integer,   &
-                       mpi_sum, mpi_comm_opa, ierr )
-    ndim_rank_ice = sum(zwork)          
-
-    ! Allocate the right size to nrank_north
-#if ! defined key_agrif
-    IF(ALLOCATED(nrank_ice)) DEALLOCATE(nrank_ice)
-#else
-    DEALLOCATE(nrank_ice)
-#endif
-
-    ALLOCATE(nrank_ice(ndim_rank_ice))
-
-    ii = 0     
-    nrank_ice = 0
-    DO jproc=1,jpnij
-       IF(zwork(jproc) == 1) THEN
-          ii = ii + 1
-          nrank_ice(ii) = jproc -1 
-       ENDIF        
-    END DO
-
-    ! Create the world group
-    CALL MPI_COMM_GROUP(mpi_comm_opa,ngrp_world,ierr)
-
-    ! Create the ice group from the world group
-    CALL MPI_GROUP_INCL(ngrp_world,ndim_rank_ice,nrank_ice,ngrp_ice,ierr)
-
-    ! Create the ice communicator , ie the pool of procs with sea-ice
-    CALL MPI_COMM_CREATE(mpi_comm_opa,ngrp_ice,ncomm_ice,ierr)
-
-    ! Find proc number in the world of proc 0 in the north
-    ! The following line seems to be useless, we just comment & keep it as reminder
-    ! CALL MPI_GROUP_TRANSLATE_RANKS(ngrp_ice,1,0,ngrp_world,n_ice_root,ierr)
-#endif
-
-  END SUBROUTINE mpp_ini_ice
-
-
-  SUBROUTINE mpp_ini_north
-    !!----------------------------------------------------------------------
-    !!               ***  routine mpp_ini_north  ***
-    !!
-    !! ** Purpose :   Initialize special communicator for north folding 
-    !!      condition together with global variables needed in the mpp folding
-    !!
-    !! ** Method  : - Look for northern processors
-    !!              - Put their number in nrank_north
-    !!              - Create groups for the world processors and the north processors
-    !!              - Create a communicator for northern processors
-    !!
-    !! ** output
-    !!      njmppmax = njmpp for northern procs
-    !!      ndim_rank_north = number of processors in the northern line
-    !!      nrank_north (ndim_rank_north) = number  of the northern procs.
-    !!      ngrp_world = group ID for the world processors
-    !!      ngrp_north = group ID for the northern processors
-    !!      ncomm_north = communicator for the northern procs.
-    !!      north_root = number (in the world) of proc 0 in the northern comm.
-    !!
-    !! History :
-    !!        !  03-09 (J.M. Molines, MPI only )
-    !!----------------------------------------------------------------------
-#ifdef key_mpp_shmem
-    CALL ctl_stop( ' mpp_ini_north not available in SHMEM' )
-# elif key_mpp_mpi
-    INTEGER :: ierr
-    INTEGER :: jproc
-    INTEGER :: ii,ji
-    !!----------------------------------------------------------------------
-
-    njmppmax=MAXVAL(njmppt)
-
-    ! Look for how many procs on the northern boundary
-    !
-    ndim_rank_north=0
-    DO jproc=1,jpnij
-       IF ( njmppt(jproc) == njmppmax ) THEN
-          ndim_rank_north = ndim_rank_north + 1
-       END IF
-    END DO
-
-
-    ! Allocate the right size to nrank_north
-    !
-    ALLOCATE(nrank_north(ndim_rank_north))
-
-    ! Fill the nrank_north array with proc. number of northern procs.
-    ! Note : the rank start at 0 in MPI
-    !
-    ii=0
-    DO ji = 1, jpnij
-       IF ( njmppt(ji) == njmppmax   ) THEN
-          ii=ii+1
-          nrank_north(ii)=ji-1
-       END IF
-    END DO
-    ! create the world group
-    !
-    CALL MPI_COMM_GROUP(mpi_comm_opa,ngrp_world,ierr)
-    !
-    ! Create the North group from the world group
-    CALL MPI_GROUP_INCL(ngrp_world,ndim_rank_north,nrank_north,ngrp_north,ierr)
-
-    ! Create the North communicator , ie the pool of procs in the north group
-    !
-    CALL MPI_COMM_CREATE(mpi_comm_opa,ngrp_north,ncomm_north,ierr)
-
-
-    ! find proc number in the world of proc 0 in the north
-    CALL MPI_GROUP_TRANSLATE_RANKS(ngrp_north,1,0,ngrp_world,north_root,ierr)
-#endif
-
-  END SUBROUTINE mpp_ini_north
-
-
-   SUBROUTINE mpp_lbc_north_3d ( pt3d, cd_type, psgn )
-      !!---------------------------------------------------------------------
-      !!                   ***  routine mpp_lbc_north_3d  ***
-      !!
-      !! ** Purpose :
-      !!      Ensure proper north fold horizontal bondary condition in mpp configuration
-      !!      in case of jpn1 > 1
-      !!
-      !! ** Method :
-      !!      Gather the 4 northern lines of the global domain on 1 processor and 
-      !!      apply lbc north-fold on this sub array. Then scatter the fold array 
-      !!      back to the processors.
-      !!
-      !! History :
-      !!   8.5  !  03-09  (J.M. Molines ) For mpp folding condition at north
-      !!                                  from lbc routine
-      !!   9.0  !  03-12  (J.M. Molines ) encapsulation into lib_mpp, coding rules of lbc_lnk
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      CHARACTER(len=1), INTENT( in ) ::   &
-         cd_type       ! nature of pt3d grid-points
-         !             !   = T ,  U , V , F or W  gridpoints
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   &
-         pt3d          ! 3D array on which the boundary condition is applied
-      REAL(wp), INTENT( in ) ::   &
-         psgn          ! control of the sign change
-         !             !   = -1. , the sign is changed if north fold boundary
-         !             !   =  1. , the sign is kept  if north fold boundary
-
-      !! * Local declarations
-      INTEGER :: ji, jj, jk, jr, jproc
-      INTEGER :: ierr
-      INTEGER :: ildi,ilei,iilb
-      INTEGER :: ijpj,ijpjm1,ij,ijt,iju
-      INTEGER :: itaille
-      REAL(wp), DIMENSION(jpiglo,4,jpk) :: ztab
-      REAL(wp), DIMENSION(jpi,4,jpk,jpni) :: znorthgloio
-      REAL(wp), DIMENSION(jpi,4,jpk) :: znorthloc
-      !!----------------------------------------------------------------------
-
-    ! If we get in this routine it s because : North fold condition and mpp with more
-    !   than one proc across i : we deal only with the North condition
-
-    ! 0. Sign setting
-    ! ---------------
-
-    ijpj=4
-    ijpjm1=3
-
-    ! put in znorthloc the last 4 jlines of pt3d
-    DO jk = 1, jpk 
-       DO jj = nlcj - ijpj +1, nlcj
-          ij = jj - nlcj + ijpj
-          znorthloc(:,ij,jk) = pt3d(:,jj,jk)
-       END DO
-    END DO
-
-
-    IF (npolj /= 0 ) THEN
-       ! Build in proc 0 of ncomm_north the znorthgloio
-       znorthgloio(:,:,:,:) = 0_wp
-
-#ifdef key_mpp_shmem
-       not done : compiler error
-#elif defined key_mpp_mpi
-       itaille=jpi*jpk*ijpj
-       CALL MPI_GATHER(znorthloc,itaille,MPI_DOUBLE_PRECISION,znorthgloio,itaille,MPI_DOUBLE_PRECISION,0,ncomm_north,ierr)
-#endif
-
-    ENDIF
-
-    IF (narea == north_root+1 ) THEN
-       ! recover the global north array
-       ztab(:,:,:) = 0_wp
-
-       DO jr = 1, ndim_rank_north
-          jproc = nrank_north(jr) + 1
-          ildi  = nldit (jproc)
-          ilei  = nleit (jproc)
-          iilb  = nimppt(jproc)
-          DO jk = 1, jpk 
-             DO jj = 1, 4
-                DO ji = ildi, ilei
-                   ztab(ji+iilb-1,jj,jk) = znorthgloio(ji,jj,jk,jr)
-                END DO
-             END DO
-          END DO
-       END DO
-
-
-       ! Horizontal slab
-       ! ===============
-
-       DO jk = 1, jpk 
-
-
-          ! 2. North-Fold boundary conditions
-          ! ----------------------------------
-
-          SELECT CASE ( npolj )
-
-          CASE ( 3, 4 )                       ! *  North fold  T-point pivot
-
-             ztab( 1    ,ijpj,jk) = 0.e0
-             ztab(jpiglo,ijpj,jk) = 0.e0
-
-             SELECT CASE ( cd_type )
-
-             CASE ( 'T' , 'S' , 'W' )                   ! T-, W-point
-                DO ji = 2, jpiglo
-                   ijt = jpiglo-ji+2
-                   ztab(ji,ijpj,jk) = psgn * ztab(ijt,ijpj-2,jk)
-                END DO
-                DO ji = jpiglo/2+1, jpiglo
-                   ijt = jpiglo-ji+2
-                   ztab(ji,ijpjm1,jk) = psgn * ztab(ijt,ijpjm1,jk)
-                END DO
-
-             CASE ( 'U' )                               ! U-point
-                DO ji = 1, jpiglo-1
-                   iju = jpiglo-ji+1
-                   ztab(ji,ijpj,jk) = psgn * ztab(iju,ijpj-2,jk)
-                END DO
-                DO ji = jpiglo/2, jpiglo-1
-                   iju = jpiglo-ji+1
-                   ztab(ji,ijpjm1,jk) = psgn * ztab(iju,ijpjm1,jk)
-                END DO
-
-             CASE ( 'V' )                               ! V-point
-                DO ji = 2, jpiglo
-                   ijt = jpiglo-ji+2
-                   ztab(ji,ijpj-1,jk) = psgn * ztab(ijt,ijpj-2,jk)
-                   ztab(ji,ijpj  ,jk) = psgn * ztab(ijt,ijpj-3,jk)
-                END DO
-
-             CASE ( 'F' , 'G' )                         ! F-point
-                DO ji = 1, jpiglo-1
-                   iju = jpiglo-ji+1
-                   ztab(ji,ijpj-1,jk) = psgn * ztab(iju,ijpj-2,jk)
-                   ztab(ji,ijpj  ,jk) = psgn * ztab(iju,ijpj-3,jk)
-                END DO
-
-             END SELECT
-
-          CASE ( 5, 6 )                        ! *  North fold  F-point pivot
-
-             ztab( 1    ,ijpj,jk) = 0.e0
-             ztab(jpiglo,ijpj,jk) = 0.e0
-
-             SELECT CASE ( cd_type )
-
-             CASE ( 'T' , 'S' , 'W' )                   ! T-, W-point
-                DO ji = 1, jpiglo
-                   ijt = jpiglo-ji+1
-                   ztab(ji,ijpj,jk) = psgn * ztab(ijt,ijpj-1,jk)
-                END DO
-
-             CASE ( 'U' )                               ! U-point
-                DO ji = 1, jpiglo-1
-                   iju = jpiglo-ji
-                   ztab(ji,ijpj,jk) = psgn * ztab(iju,ijpj-1,jk)
-                END DO
-
-             CASE ( 'V' )                               ! V-point
-                DO ji = 1, jpiglo
-                   ijt = jpiglo-ji+1
-                   ztab(ji,ijpj,jk) = psgn * ztab(ijt,ijpj-2,jk)
-                END DO
-                DO ji = jpiglo/2+1, jpiglo
-                   ijt = jpiglo-ji+1
-                   ztab(ji,ijpjm1,jk) = psgn * ztab(ijt,ijpjm1,jk)
-                END DO
-
-             CASE ( 'F' , 'G' )                         ! F-point
-                DO ji = 1, jpiglo-1
-                   iju = jpiglo-ji
-                   ztab(ji,ijpj  ,jk) = psgn * ztab(iju,ijpj-2,jk)
-                END DO
-                DO ji = jpiglo/2+1, jpiglo-1
-                   iju = jpiglo-ji
-                   ztab(ji,ijpjm1,jk) = psgn * ztab(iju,ijpjm1,jk)
-                END DO
-
-             END SELECT
-
-          CASE DEFAULT                           ! *  closed
-
-             SELECT CASE ( cd_type) 
-
-             CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
-                ztab(:, 1  ,jk) = 0.e0
-                ztab(:,ijpj,jk) = 0.e0
-
-             CASE ( 'F' )                               ! F-point
-                ztab(:,ijpj,jk) = 0.e0
-
-             END SELECT
-
-          END SELECT
-
-          !     End of slab
-          !     ===========
-
-       END DO
-
-       !! Scatter back to pt3d
-       DO jr = 1, ndim_rank_north
-          jproc=nrank_north(jr)+1
-          ildi=nldit (jproc)
-          ilei=nleit (jproc)
-          iilb=nimppt(jproc)
-          DO jk=  1, jpk
-             DO jj=1,ijpj
-                DO ji=ildi,ilei
-                   znorthgloio(ji,jj,jk,jr)=ztab(ji+iilb-1,jj,jk)
-                END DO
-             END DO
-          END DO
-       END DO
-
-    ENDIF      ! only done on proc 0 of ncomm_north
-
-#ifdef key_mpp_shmem
-    not done yet in shmem : compiler error
-#elif key_mpp_mpi
-    IF ( npolj /= 0 ) THEN
-       itaille=jpi*jpk*ijpj
-       CALL MPI_SCATTER(znorthgloio,itaille,MPI_DOUBLE_PRECISION,znorthloc,itaille,MPI_DOUBLE_PRECISION,0,ncomm_north,ierr)
-    ENDIF
-#endif
-
-    ! put in the last ijpj jlines of pt3d znorthloc
-    DO jk = 1 , jpk 
-       DO jj = nlcj - ijpj + 1 , nlcj
-          ij = jj - nlcj + ijpj
-          pt3d(:,jj,jk)= znorthloc(:,ij,jk)
-       END DO
-    END DO
-
-  END SUBROUTINE mpp_lbc_north_3d
-
-
-  SUBROUTINE mpp_lbc_north_2d ( pt2d, cd_type, psgn)
-    !!---------------------------------------------------------------------
-    !!                   ***  routine mpp_lbc_north_2d  ***
-    !!
-    !! ** Purpose :
-    !!      Ensure proper north fold horizontal bondary condition in mpp configuration
-    !!      in case of jpn1 > 1 (for 2d array )
-    !!
-    !! ** Method :
-    !!      Gather the 4 northern lines of the global domain on 1 processor and 
-    !!      apply lbc north-fold on this sub array. Then scatter the fold array 
-    !!      back to the processors.
-    !!
-    !! History :
-    !!   8.5  !  03-09  (J.M. Molines ) For mpp folding condition at north
-    !!                                  from lbc routine
-    !!   9.0  !  03-12  (J.M. Molines ) encapsulation into lib_mpp, coding rules of lbc_lnk
-    !!----------------------------------------------------------------------
-
-    !! * Arguments
-    CHARACTER(len=1), INTENT( in ) ::   &
-         cd_type       ! nature of pt2d grid-points
-    !             !   = T ,  U , V , F or W  gridpoints
-    REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) ::   &
-         pt2d          ! 2D array on which the boundary condition is applied
-    REAL(wp), INTENT( in ) ::   &
-         psgn          ! control of the sign change
-    !             !   = -1. , the sign is changed if north fold boundary
-    !             !   =  1. , the sign is kept  if north fold boundary
-
-
-    !! * Local declarations
-
-    INTEGER :: ji, jj,  jr, jproc
-    INTEGER :: ierr
-    INTEGER :: ildi,ilei,iilb
-    INTEGER :: ijpj,ijpjm1,ij,ijt,iju
-    INTEGER :: itaille
-
-    REAL(wp), DIMENSION(jpiglo,4) :: ztab
-    REAL(wp), DIMENSION(jpi,4,jpni) :: znorthgloio
-    REAL(wp), DIMENSION(jpi,4) :: znorthloc
-    !!----------------------------------------------------------------------
-    !!  OPA 8.5, LODYC-IPSL (2002)
-    !!----------------------------------------------------------------------
-    ! If we get in this routine it s because : North fold condition and mpp with more
-    !   than one proc across i : we deal only with the North condition
-
-    ! 0. Sign setting
-    ! ---------------
-
-    ijpj=4
-    ijpjm1=3
-
-
-    ! put in znorthloc the last 4 jlines of pt2d
-    DO jj = nlcj - ijpj +1, nlcj
-       ij = jj - nlcj + ijpj
-       znorthloc(:,ij)=pt2d(:,jj)
-    END DO
-
-    IF (npolj /= 0 ) THEN
-       ! Build in proc 0 of ncomm_north the znorthgloio
-       znorthgloio(:,:,:) = 0_wp
-#ifdef key_mpp_shmem
-       not done : compiler error
-#elif defined key_mpp_mpi
-       itaille=jpi*ijpj
-       CALL MPI_GATHER(znorthloc,itaille,MPI_DOUBLE_PRECISION,znorthgloio,itaille,MPI_DOUBLE_PRECISION,0,ncomm_north,ierr)
-#endif
-    ENDIF
-
-    IF (narea == north_root+1 ) THEN
-       ! recover the global north array
-       ztab(:,:) = 0_wp
-
-       DO jr = 1, ndim_rank_north
-          jproc=nrank_north(jr)+1
-          ildi=nldit (jproc)
-          ilei=nleit (jproc)
-          iilb=nimppt(jproc)
-          DO jj=1,4
-             DO ji=ildi,ilei
-                ztab(ji+iilb-1,jj)=znorthgloio(ji,jj,jr)
-             END DO
-          END DO
-       END DO
-
-
-       ! 2. North-Fold boundary conditions
-       ! ----------------------------------
-
-       SELECT CASE ( npolj )
-
-       CASE ( 3, 4 )                       ! *  North fold  T-point pivot
-
-          ztab( 1    ,ijpj) = 0.e0
-          ztab(jpiglo,ijpj) = 0.e0
-
-          SELECT CASE ( cd_type )
-
-          CASE ( 'T' , 'W' , 'S' )                         ! T-, W-point
-             DO ji = 2, jpiglo
-                ijt = jpiglo-ji+2
-                ztab(ji,ijpj) = psgn * ztab(ijt,ijpj-2)
-             END DO
-             DO ji = jpiglo/2+1, jpiglo
-                ijt = jpiglo-ji+2
-                ztab(ji,ijpjm1) = psgn * ztab(ijt,ijpjm1)
-             END DO
-
-          CASE ( 'U' )                                     ! U-point
-             DO ji = 1, jpiglo-1
-                iju = jpiglo-ji+1
-                ztab(ji,ijpj) = psgn * ztab(iju,ijpj-2)
-             END DO
-             DO ji = jpiglo/2, jpiglo-1
-                iju = jpiglo-ji+1
-                ztab(ji,ijpjm1) = psgn * ztab(iju,ijpjm1)
-             END DO
-
-          CASE ( 'V' )                                     ! V-point
-             DO ji = 2, jpiglo
-                ijt = jpiglo-ji+2
-                ztab(ji,ijpj-1) = psgn * ztab(ijt,ijpj-2)
-                ztab(ji,ijpj  ) = psgn * ztab(ijt,ijpj-3)
-             END DO
-
-          CASE ( 'F' , 'G' )                               ! F-point
-             DO ji = 1, jpiglo-1
-                iju = jpiglo-ji+1
-                ztab(ji,ijpj-1) = psgn * ztab(iju,ijpj-2)
-                ztab(ji,ijpj  ) = psgn * ztab(iju,ijpj-3)
-             END DO
-
-          CASE ( 'I' )                                     ! ice U-V point
-             ztab(2,ijpj) = psgn * ztab(3,ijpj-1)
-             DO ji = 3, jpiglo
-                iju = jpiglo - ji + 3
-                ztab(ji,ijpj) = psgn * ztab(iju,ijpj-1)
-             END DO
-
-          END SELECT
-
-       CASE ( 5, 6 )                        ! *  North fold  F-point pivot
-
-          ztab( 1 ,ijpj) = 0.e0
-          ztab(jpiglo,ijpj) = 0.e0
-
-          SELECT CASE ( cd_type )
-
-          CASE ( 'T' , 'W' ,'S' )                          ! T-, W-point
-             DO ji = 1, jpiglo
-                ijt = jpiglo-ji+1
-                ztab(ji,ijpj) = psgn * ztab(ijt,ijpj-1)
-             END DO
-
-          CASE ( 'U' )                                     ! U-point
-             DO ji = 1, jpiglo-1
-                iju = jpiglo-ji
-                ztab(ji,ijpj) = psgn * ztab(iju,ijpj-1)
-             END DO
-
-          CASE ( 'V' )                                     ! V-point
-             DO ji = 1, jpiglo
-                ijt = jpiglo-ji+1
-                ztab(ji,ijpj) = psgn * ztab(ijt,ijpj-2)
-             END DO
-             DO ji = jpiglo/2+1, jpiglo
-                ijt = jpiglo-ji+1
-                ztab(ji,ijpjm1) = psgn * ztab(ijt,ijpjm1)
-             END DO
-
-          CASE ( 'F' , 'G' )                               ! F-point
-             DO ji = 1, jpiglo-1
-                iju = jpiglo-ji
-                ztab(ji,ijpj  ) = psgn * ztab(iju,ijpj-2)
-             END DO
-             DO ji = jpiglo/2+1, jpiglo-1
-                iju = jpiglo-ji
-                ztab(ji,ijpjm1) = psgn * ztab(iju,ijpjm1)
-             END DO
-
-             CASE ( 'I' )                                  ! ice U-V point
-                ztab( 2 ,ijpj) = 0.e0
-                DO ji = 2 , jpiglo-1
-                   ijt = jpiglo - ji + 2
-                   ztab(ji,ijpj)= 0.5 * ( ztab(ji,ijpj-1) + psgn * ztab(ijt,ijpj-1) )
-                END DO
-
-          END SELECT
-
-       CASE DEFAULT                           ! *  closed : the code probably never go through
-
-            SELECT CASE ( cd_type) 
-  
-            CASE ( 'T' , 'U' , 'V' , 'W' )                 ! T-, U-, V-, W-points
-               ztab(:, 1 ) = 0.e0
-               ztab(:,ijpj) = 0.e0
-
-            CASE ( 'F' )                                   ! F-point
-               ztab(:,ijpj) = 0.e0
-
-            CASE ( 'I' )                                   ! ice U-V point
-               ztab(:, 1 ) = 0.e0
-               ztab(:,ijpj) = 0.e0
-
-            END SELECT
-
-         END SELECT
-
-         !     End of slab
-         !     ===========
-
-         !! Scatter back to pt2d
-         DO jr = 1, ndim_rank_north
-            jproc=nrank_north(jr)+1
-            ildi=nldit (jproc)
-            ilei=nleit (jproc)
-            iilb=nimppt(jproc)
-            DO jj=1,ijpj
-               DO ji=ildi,ilei
-                  znorthgloio(ji,jj,jr)=ztab(ji+iilb-1,jj)
-               END DO
-            END DO
-         END DO
-
-      ENDIF      ! only done on proc 0 of ncomm_north
-
-#ifdef key_mpp_shmem
-      not done yet in shmem : compiler error
-#elif key_mpp_mpi
-      IF ( npolj /= 0 ) THEN
-         itaille=jpi*ijpj
-         CALL MPI_SCATTER(znorthgloio,itaille,MPI_DOUBLE_PRECISION,znorthloc,itaille,MPI_DOUBLE_PRECISION,0,ncomm_north,ierr)
-      ENDIF
-#endif
-
-      ! put in the last ijpj jlines of pt2d znorthloc
-      DO jj = nlcj - ijpj + 1 , nlcj
-         ij = jj - nlcj + ijpj
-         pt2d(:,jj)= znorthloc(:,ij)
-      END DO
-
-   END SUBROUTINE mpp_lbc_north_2d
-
-
-   SUBROUTINE mpp_lbc_north_e ( pt2d, cd_type, psgn)
-    !!---------------------------------------------------------------------
-    !!                   ***  routine mpp_lbc_north_2d  ***
-    !!
-    !! ** Purpose :
-    !!      Ensure proper north fold horizontal bondary condition in mpp configuration
-    !!      in case of jpn1 > 1 (for 2d array with outer extra halo)
-    !!
-    !! ** Method :
-    !!      Gather the 4+2*jpr2dj northern lines of the global domain on 1 processor and 
-    !!      apply lbc north-fold on this sub array. Then scatter the fold array 
-    !!      back to the processors.
-    !!
-    !! History :
-    !!   8.5  !  03-09  (J.M. Molines ) For mpp folding condition at north
-    !!                                  from lbc routine
-    !!   9.0  !  03-12  (J.M. Molines ) encapsulation into lib_mpp, coding rules of lbc_lnk
-    !!   9.0  !  05-09  (R. Benshila )   adapt mpp_lbc_north_2d 
-    !!----------------------------------------------------------------------
-
-    !! * Arguments
-    CHARACTER(len=1), INTENT( in ) ::   &
-         cd_type       ! nature of pt2d grid-points
-    !             !   = T ,  U , V , F or W  gridpoints
-    REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj), INTENT( inout ) ::   &
-         pt2d          ! 2D array on which the boundary condition is applied
-    REAL(wp), INTENT( in ) ::   &
-         psgn          ! control of the sign change
-    !             !   = -1. , the sign is changed if north fold boundary
-    !             !   =  1. , the sign is kept  if north fold boundary
-
-
-    !! * Local declarations
-
-    INTEGER :: ji, jj,  jr, jproc, jl
-    INTEGER :: ierr
-    INTEGER :: ildi,ilei,iilb
-    INTEGER :: ijpj,ijpjm1,ij,ijt,iju, iprecj
-    INTEGER :: itaille
-
-    REAL(wp), DIMENSION(jpiglo,1-jpr2dj:4+jpr2dj) :: ztab
-    REAL(wp), DIMENSION(jpi,1-jpr2dj:4+jpr2dj,jpni) :: znorthgloio
-    REAL(wp), DIMENSION(jpi,1-jpr2dj:4+jpr2dj) :: znorthloc
-
-    ! If we get in this routine it s because : North fold condition and mpp with more
-    !   than one proc across i : we deal only with the North condition
-
-    ! 0. Sign setting
-    ! ---------------
-
-    ijpj=4
-    ijpjm1=3
-    iprecj = jpr2dj+jprecj
-
-    ! put in znorthloc the last 4 jlines of pt2d
-    DO jj = nlcj - ijpj + 1 - jpr2dj, nlcj +jpr2dj
-       ij = jj - nlcj + ijpj
-       znorthloc(:,ij)=pt2d(1:jpi,jj)
-    END DO
-
-    IF (npolj /= 0 ) THEN
-       ! Build in proc 0 of ncomm_north the znorthgloio
-       znorthgloio(:,:,:) = 0_wp
-#ifdef key_mpp_shmem
-       not done : compiler error
-#elif defined key_mpp_mpi
-       itaille=jpi*(ijpj+2*jpr2dj)
-       CALL MPI_GATHER(znorthloc(1,1-jpr2dj),itaille,MPI_DOUBLE_PRECISION, &
-                     & znorthgloio(1,1-jpr2dj,1),itaille,MPI_DOUBLE_PRECISION,0,ncomm_north,ierr)
-#endif
-    ENDIF
-
-    IF (narea == north_root+1 ) THEN
-       ! recover the global north array
-       ztab(:,:) = 0_wp
-
-       DO jr = 1, ndim_rank_north
-          jproc=nrank_north(jr)+1
-          ildi=nldit (jproc)
-          ilei=nleit (jproc)
-          iilb=nimppt(jproc)
-          DO jj=1-jpr2dj,ijpj+jpr2dj
-             DO ji=ildi,ilei
-                ztab(ji+iilb-1,jj)=znorthgloio(ji,jj,jr)
-             END DO
-          END DO
-       END DO
-
-
-       ! 2. North-Fold boundary conditions
-       ! ----------------------------------
-
-       SELECT CASE ( npolj )
-
-       CASE ( 3, 4 )                       ! *  North fold  T-point pivot
-
-          ztab( 1    ,ijpj:ijpj+jpr2dj) = 0.e0
-          ztab(jpiglo,ijpj:ijpj+jpr2dj) = 0.e0
-
-          SELECT CASE ( cd_type )
-
-          CASE ( 'T' , 'W' , 'S' )                         ! T-, W-point
-             DO jl =0, iprecj-1
-                DO ji = 2, jpiglo
-                   ijt = jpiglo-ji+2
-                   ztab(ji,ijpj+jl) = psgn * ztab(ijt,ijpj-2-jl)
-                END DO
-             END DO
-             DO ji = jpiglo/2+1, jpiglo
-                ijt = jpiglo-ji+2
-                ztab(ji,ijpjm1) = psgn * ztab(ijt,ijpjm1)
-             END DO
-
-          CASE ( 'U' )                                     ! U-point
-             DO jl =0, iprecj-1
-                DO ji = 1, jpiglo-1
-                   iju = jpiglo-ji+1
-                   ztab(ji,ijpj+jl) = psgn * ztab(iju,ijpj-2-jl)
-                END DO
-             END DO
-             DO ji = jpiglo/2, jpiglo-1
-                iju = jpiglo-ji+1
-                ztab(ji,ijpjm1) = psgn * ztab(iju,ijpjm1)
-             END DO
-
-          CASE ( 'V' )                                     ! V-point
-            DO jl =-1, iprecj-1
-               DO ji = 2, jpiglo
-                  ijt = jpiglo-ji+2
-                  ztab(ji,ijpj+jl) = psgn * ztab(ijt,ijpj-3-jl)
-               END DO
-            END DO
-
-          CASE ( 'F' , 'G' )                               ! F-point
-            DO jl =-1, iprecj-1
-               DO ji = 1, jpiglo-1
-                  iju = jpiglo-ji+1
-                  ztab(ji,ijpj+jl) = psgn * ztab(iju,ijpj-3-jl)
-               END DO
-             END DO
-
-          CASE ( 'I' )                                     ! ice U-V point
-             DO jl =0, iprecj-1
-                ztab(2,ijpj+jl) = psgn * ztab(3,ijpj-1+jl)
-                DO ji = 3, jpiglo
-                   iju = jpiglo - ji + 3
-                   ztab(ji,ijpj+jl) = psgn * ztab(iju,ijpj-1-jl)
-                END DO
-             END DO
-
-          END SELECT
-
-       CASE ( 5, 6 )                        ! *  North fold  F-point pivot
-
-          ztab( 1 ,ijpj:ijpj+jpr2dj) = 0.e0
-          ztab(jpiglo,ijpj:ijpj+jpr2dj) = 0.e0
-
-          SELECT CASE ( cd_type )
-
-          CASE ( 'T' , 'W' ,'S' )                          ! T-, W-point
-             DO jl = 0, iprecj-1
-                DO ji = 1, jpiglo
-                   ijt = jpiglo-ji+1
-                   ztab(ji,ijpj+jl) = psgn * ztab(ijt,ijpj-1-jl)
-                END DO
-             END DO
-
-          CASE ( 'U' )                                     ! U-point
-             DO jl = 0, iprecj-1
-                DO ji = 1, jpiglo-1
-                   iju = jpiglo-ji
-                   ztab(ji,ijpj+jl) = psgn * ztab(iju,ijpj-1-jl)
-                END DO
-             END DO
-
-          CASE ( 'V' )                                     ! V-point
-             DO jl = 0, iprecj-1
-                DO ji = 1, jpiglo
-                   ijt = jpiglo-ji+1
-                   ztab(ji,ijpj+jl) = psgn * ztab(ijt,ijpj-2-jl)
-                END DO
-             END DO
-             DO ji = jpiglo/2+1, jpiglo
-                ijt = jpiglo-ji+1
-                ztab(ji,ijpjm1) = psgn * ztab(ijt,ijpjm1)
-             END DO
-
-          CASE ( 'F' , 'G' )                               ! F-point
-             DO jl = 0, iprecj-1
-                DO ji = 1, jpiglo-1
-                   iju = jpiglo-ji
-                   ztab(ji,ijpj+jl) = psgn * ztab(iju,ijpj-2-jl)
-                END DO
-             END DO
-             DO ji = jpiglo/2+1, jpiglo-1
-                iju = jpiglo-ji
-                ztab(ji,ijpjm1) = psgn * ztab(iju,ijpjm1)
-             END DO
-
-             CASE ( 'I' )                                  ! ice U-V point
-                ztab( 2 ,ijpj:ijpj+jpr2dj) = 0.e0
-                DO jl = 0, jpr2dj
-                   DO ji = 2 , jpiglo-1
-                      ijt = jpiglo - ji + 2
-                      ztab(ji,ijpj+jl)= 0.5 * ( ztab(ji,ijpj-1-jl) + psgn * ztab(ijt,ijpj-1-jl) )
-                   END DO
-                END DO
-
-          END SELECT
-
-       CASE DEFAULT                           ! *  closed : the code probably never go through
-
-            SELECT CASE ( cd_type) 
-  
-            CASE ( 'T' , 'U' , 'V' , 'W' )                 ! T-, U-, V-, W-points
-               ztab(:, 1:1-jpr2dj     ) = 0.e0
-               ztab(:,ijpj:ijpj+jpr2dj) = 0.e0
-
-            CASE ( 'F' )                                   ! F-point
-               ztab(:,ijpj:ijpj+jpr2dj) = 0.e0
-
-            CASE ( 'I' )                                   ! ice U-V point
-               ztab(:, 1:1-jpr2dj     ) = 0.e0
-               ztab(:,ijpj:ijpj+jpr2dj) = 0.e0
-
-            END SELECT
-
-         END SELECT
-
-         !     End of slab
-         !     ===========
-
-         !! Scatter back to pt2d
-         DO jr = 1, ndim_rank_north
-            jproc=nrank_north(jr)+1
-            ildi=nldit (jproc)
-            ilei=nleit (jproc)
-            iilb=nimppt(jproc)
-            DO jj=1-jpr2dj,ijpj+jpr2dj
-               DO ji=ildi,ilei
-                  znorthgloio(ji,jj,jr)=ztab(ji+iilb-1,jj)
-               END DO
-            END DO
-         END DO
-
-      ENDIF      ! only done on proc 0 of ncomm_north
-
-#ifdef key_mpp_shmem
-      not done yet in shmem : compiler error
-#elif key_mpp_mpi
-      IF ( npolj /= 0 ) THEN
-         itaille=jpi*(ijpj+2*jpr2dj)
-         CALL MPI_SCATTER(znorthgloio(1,1-jpr2dj,1),itaille,MPI_DOUBLE_PRECISION, &
-                        & znorthloc(1,1-jpr2dj),itaille,MPI_DOUBLE_PRECISION,0,ncomm_north,ierr)
-      ENDIF
-#endif
-
-      ! put in the last ijpj jlines of pt2d znorthloc
-      DO jj = nlcj - ijpj  -jpr2dj + 1 , nlcj +jpr2dj
-         ij = jj - nlcj + ijpj 
-         pt2d(1:jpi,jj)= znorthloc(:,ij)
-      END DO
-
-   END SUBROUTINE mpp_lbc_north_e
-
-   SUBROUTINE mpi_init_opa(code)
-     !!---------------------------------------------------------------------
-     !!                   ***  routine mpp_init.opa  ***
-     !!
-     !! ** Purpose :: export and attach a MPI buffer for bsend
-     !!
-     !! ** Method  :: define buffer size in namelist, if 0 no buffer attachment
-     !!            but classical mpi_init
-     !! 
-     !! History :: 01/11 :: IDRIS initial version for IBM only  
-     !!            08/04 :: R. Benshila, generalisation
-     !!
-     !!---------------------------------------------------------------------
-
-      INTEGER                                 :: code, ierr
-      LOGICAL                                 :: mpi_was_called
- 
-      ! MPI initialization
-      CALL mpi_initialized(mpi_was_called, code)
-      IF ( code /= MPI_SUCCESS ) THEN
-        CALL ctl_stop( ' lib_mpp: Error in routine mpi_initialized' )
-        CALL mpi_abort( mpi_comm_world, code, ierr )
-      ENDIF
-
-      IF ( .NOT. mpi_was_called ) THEN
-         CALL mpi_init(code)
-         CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code)
-         IF ( code /= MPI_SUCCESS ) THEN
-            CALL ctl_stop( ' lib_mpp: Error in routine mpi_comm_dup' )
-            CALL mpi_abort( mpi_comm_world, code, ierr )
-         ENDIF
-      ENDIF
-
-      IF( nn_buffer > 0 ) THEN
-         IF ( lwp ) WRITE(numout,*) 'mpi_bsend, buffer allocation of  : ', nn_buffer
-
-         ! Buffer allocation and attachment
-         ALLOCATE(tampon(nn_buffer))
-         CALL mpi_buffer_attach(tampon,nn_buffer,code)
-      ENDIF
-
-   END SUBROUTINE mpi_init_opa
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default case:            Dummy module        share memory computing
-   !!----------------------------------------------------------------------
-   INTERFACE mpp_sum
-      MODULE PROCEDURE mpp_sum_a2s, mpp_sum_as, mpp_sum_ai, mpp_sum_s, mpp_sum_i
-   END INTERFACE
-   INTERFACE mpp_max
-      MODULE PROCEDURE mppmax_a_int, mppmax_int, mppmax_a_real, mppmax_real
-   END INTERFACE
-   INTERFACE mpp_min
-      MODULE PROCEDURE mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real
-   END INTERFACE
-   INTERFACE mpp_isl
-      MODULE PROCEDURE mppisl_a_int, mppisl_int, mppisl_a_real, mppisl_real
-   END INTERFACE
-   INTERFACE mppobc
-      MODULE PROCEDURE mppobc_1d, mppobc_2d, mppobc_3d, mppobc_4d
-   END INTERFACE
-  INTERFACE mpp_minloc
-     MODULE PROCEDURE mpp_minloc2d ,mpp_minloc3d
-  END INTERFACE
-  INTERFACE mpp_maxloc
-     MODULE PROCEDURE mpp_maxloc2d ,mpp_maxloc3d
-  END INTERFACE
-
-
-   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .FALSE.      !: mpp flag
-   INTEGER :: ncomm_ice
-
-CONTAINS
-
-   FUNCTION mynode(localComm) RESULT (function_value)
-      INTEGER, OPTIONAL :: localComm
-      function_value = 0
-   END FUNCTION mynode
-
-   SUBROUTINE mppsync                       ! Dummy routine
-   END SUBROUTINE mppsync
-
-   SUBROUTINE mpp_sum_as( parr, kdim, kcom )      ! Dummy routine
-      REAL   , DIMENSION(:) :: parr
-      INTEGER               :: kdim
-      INTEGER, OPTIONAL     :: kcom 
-      WRITE(*,*) 'mpp_sum_as: You should not have seen this print! error?', kdim, parr(1), kcom
-   END SUBROUTINE mpp_sum_as
-
-   SUBROUTINE mpp_sum_a2s( parr, kdim, kcom )      ! Dummy routine
-      REAL   , DIMENSION(:,:) :: parr
-      INTEGER               :: kdim
-      INTEGER, OPTIONAL     :: kcom 
-      WRITE(*,*) 'mpp_sum_a2s: You should not have seen this print! error?', kdim, parr(1,1), kcom
-   END SUBROUTINE mpp_sum_a2s
-
-   SUBROUTINE mpp_sum_ai( karr, kdim, kcom )      ! Dummy routine
-      INTEGER, DIMENSION(:) :: karr
-      INTEGER               :: kdim
-      INTEGER, OPTIONAL     :: kcom 
-      WRITE(*,*) 'mpp_sum_ai: You should not have seen this print! error?', kdim, karr(1), kcom
-   END SUBROUTINE mpp_sum_ai
-
-   SUBROUTINE mpp_sum_s( psca, kcom )            ! Dummy routine
-      REAL                  :: psca
-      INTEGER, OPTIONAL     :: kcom 
-      WRITE(*,*) 'mpp_sum_s: You should not have seen this print! error?', psca, kcom
-   END SUBROUTINE mpp_sum_s
-
-   SUBROUTINE mpp_sum_i( kint, kcom )            ! Dummy routine
-      integer               :: kint
-      INTEGER, OPTIONAL     :: kcom 
-      WRITE(*,*) 'mpp_sum_i: You should not have seen this print! error?', kint, kcom
-   END SUBROUTINE mpp_sum_i
-
-   SUBROUTINE mppmax_a_real( parr, kdim, kcom )
-      REAL   , DIMENSION(:) :: parr
-      INTEGER               :: kdim
-      INTEGER, OPTIONAL     :: kcom 
-      WRITE(*,*) 'mppmax_a_real: You should not have seen this print! error?', kdim, parr(1), kcom
-   END SUBROUTINE mppmax_a_real
-
-   SUBROUTINE mppmax_real( psca, kcom )
-      REAL                  :: psca
-      INTEGER, OPTIONAL     :: kcom 
-      WRITE(*,*) 'mppmax_real: You should not have seen this print! error?', psca, kcom
-   END SUBROUTINE mppmax_real
-
-   SUBROUTINE mppmin_a_real( parr, kdim, kcom )
-      REAL   , DIMENSION(:) :: parr
-      INTEGER               :: kdim
-      INTEGER, OPTIONAL     :: kcom 
-      WRITE(*,*) 'mppmin_a_real: You should not have seen this print! error?', kdim, parr(1), kcom
-   END SUBROUTINE mppmin_a_real
-
-   SUBROUTINE mppmin_real( psca, kcom )
-      REAL                  :: psca
-      INTEGER, OPTIONAL     :: kcom 
-      WRITE(*,*) 'mppmin_real: You should not have seen this print! error?', psca, kcom
-   END SUBROUTINE mppmin_real
-
-   SUBROUTINE mppmax_a_int( karr, kdim ,kcom)
-      INTEGER, DIMENSION(:) :: karr
-      INTEGER               :: kdim
-      INTEGER, OPTIONAL     :: kcom 
-      WRITE(*,*) 'mppmax_a_int: You should not have seen this print! error?', kdim, karr(1), kcom
-   END SUBROUTINE mppmax_a_int
-
-   SUBROUTINE mppmax_int( kint, kcom)
-      INTEGER               :: kint
-      INTEGER, OPTIONAL     :: kcom 
-      WRITE(*,*) 'mppmax_int: You should not have seen this print! error?', kint, kcom
-   END SUBROUTINE mppmax_int
-
-   SUBROUTINE mppmin_a_int( karr, kdim, kcom )
-      INTEGER, DIMENSION(:) :: karr
-      INTEGER               :: kdim
-      INTEGER, OPTIONAL     :: kcom 
-      WRITE(*,*) 'mppmin_a_int: You should not have seen this print! error?', kdim, karr(1), kcom
-   END SUBROUTINE mppmin_a_int
-
-   SUBROUTINE mppmin_int( kint, kcom )
-      INTEGER               :: kint
-      INTEGER, OPTIONAL     :: kcom 
-      WRITE(*,*) 'mppmin_int: You should not have seen this print! error?', kint, kcom
-   END SUBROUTINE mppmin_int
-
-   SUBROUTINE mppobc_1d( parr, kd1, kd2, kl, kk, ktype, kij )
-    INTEGER  ::   kd1, kd2, kl , kk, ktype, kij
-    REAL, DIMENSION(:) ::   parr           ! variable array
-      WRITE(*,*) 'mppobc: You should not have seen this print! error?',   &
-         &        parr(1), kd1, kd2, kl, kk, ktype, kij
-   END SUBROUTINE mppobc_1d
-
-   SUBROUTINE mppobc_2d( parr, kd1, kd2, kl, kk, ktype, kij )
-    INTEGER  ::   kd1, kd2, kl , kk, ktype, kij
-    REAL, DIMENSION(:,:) ::   parr           ! variable array
-      WRITE(*,*) 'mppobc: You should not have seen this print! error?',   &
-         &        parr(1,1), kd1, kd2, kl, kk, ktype, kij
-   END SUBROUTINE mppobc_2d
-
-   SUBROUTINE mppobc_3d( parr, kd1, kd2, kl, kk, ktype, kij )
-    INTEGER  ::   kd1, kd2, kl , kk, ktype, kij
-    REAL, DIMENSION(:,:,:) ::   parr           ! variable array
-      WRITE(*,*) 'mppobc: You should not have seen this print! error?',   &
-         &        parr(1,1,1), kd1, kd2, kl, kk, ktype, kij
-   END SUBROUTINE mppobc_3d
-
-   SUBROUTINE mppobc_4d( parr, kd1, kd2, kl, kk, ktype, kij )
-    INTEGER  ::   kd1, kd2, kl , kk, ktype, kij
-    REAL, DIMENSION(:,:,:,:) ::   parr           ! variable array
-      WRITE(*,*) 'mppobc: You should not have seen this print! error?',   &
-         &        parr(1,1,1,1), kd1, kd2, kl, kk, ktype, kij
-   END SUBROUTINE mppobc_4d
-
-
-   SUBROUTINE mpplnks( parr )            ! Dummy routine
-      REAL, DIMENSION(:,:) :: parr
-      WRITE(*,*) 'mpplnks: You should not have seen this print! error?', parr(1,1)
-   END SUBROUTINE mpplnks
-
-   SUBROUTINE mppisl_a_int( karr, kdim )
-      INTEGER, DIMENSION(:) :: karr
-      INTEGER               :: kdim
-      WRITE(*,*) 'mppisl_a_int: You should not have seen this print! error?', kdim, karr(1)
-   END SUBROUTINE mppisl_a_int
-
-   SUBROUTINE mppisl_int( kint )
-      INTEGER               :: kint
-      WRITE(*,*) 'mppisl_int: You should not have seen this print! error?', kint
-   END SUBROUTINE mppisl_int
-
-   SUBROUTINE mppisl_a_real( parr, kdim )
-      REAL   , DIMENSION(:) :: parr
-      INTEGER               :: kdim
-      WRITE(*,*) 'mppisl_a_real: You should not have seen this print! error?', kdim, parr(1)
-   END SUBROUTINE mppisl_a_real
-
-   SUBROUTINE mppisl_real( psca )
-      REAL                  :: psca
-      WRITE(*,*) 'mppisl_real: You should not have seen this print! error?', psca
-   END SUBROUTINE mppisl_real
-
-   SUBROUTINE mpp_minloc2d ( ptab, pmask, pmin, ki, kj )
-      REAL                   :: pmin
-      REAL , DIMENSION (:,:) :: ptab, pmask
-      INTEGER :: ki, kj
-      WRITE(*,*) 'mppisl_real: You should not have seen this print! error?', pmin, ki, kj
-      WRITE(*,*) '   "      ":             "                 "            ', ptab(1,1), pmask(1,1)
-   END SUBROUTINE mpp_minloc2d
-
-   SUBROUTINE mpp_minloc3d ( ptab, pmask, pmin, ki, kj, kk )
-      REAL                     :: pmin
-      REAL , DIMENSION (:,:,:) :: ptab, pmask
-      INTEGER :: ki, kj, kk
-      WRITE(*,*) 'mppisl_real: You should not have seen this print! error?', pmin, ki, kj, kk
-      WRITE(*,*) '   "      ":             "                 "            ', ptab(1,1,1), pmask(1,1,1)
-   END SUBROUTINE mpp_minloc3d
-
-   SUBROUTINE mpp_maxloc2d ( ptab, pmask, pmax, ki, kj )
-      REAL                   :: pmax
-      REAL , DIMENSION (:,:) :: ptab, pmask
-      INTEGER :: ki, kj
-      WRITE(*,*) 'mppisl_real: You should not have seen this print! error?', pmax, ki, kj
-      WRITE(*,*) '   "      ":             "                 "            ', ptab(1,1), pmask(1,1)
-   END SUBROUTINE mpp_maxloc2d
-
-   SUBROUTINE mpp_maxloc3d ( ptab, pmask, pmax, ki, kj, kk )
-      REAL                     :: pmax
-      REAL , DIMENSION (:,:,:) :: ptab, pmask
-      INTEGER :: ki, kj, kk
-      WRITE(*,*) 'mppisl_real: You should not have seen this print! error?', pmax, ki, kj, kk
-      WRITE(*,*) '   "      ":             "                 "            ', ptab(1,1,1), pmask(1,1,1)
-   END SUBROUTINE mpp_maxloc3d
-
-   SUBROUTINE mppstop
-      WRITE(*,*) 'mppstop: You should not have seen this print! error?'
-   END SUBROUTINE mppstop
-
-   SUBROUTINE mpp_ini_ice(kcom)
-      INTEGER :: kcom
-      WRITE(*,*) 'mpp_ini_ice: You should not have seen this print! error?',kcom
-   END SUBROUTINE mpp_ini_ice
-
-   SUBROUTINE mpp_comm_free(kcom)
-      INTEGER :: kcom
-      WRITE(*,*) 'mpp_comm_free: You should not have seen this print! error?',kcom
-   END SUBROUTINE mpp_comm_free
-
-#endif
-   !!----------------------------------------------------------------------
-END MODULE lib_mpp
Index: trunk/NEMOGCM/NEMO/OFF_SRC/lib_print.f90
===================================================================
--- trunk/NEMOGCM/NEMO/OFF_SRC/lib_print.f90	(revision 2527)
+++ 	(revision )
@@ -1,265 +1,0 @@
-MODULE lib_print
-   !!======================================================================
-   !!                    ***  MODULE  lib_print  ***
-   !! print librairy :  formated real and integer array print
-   !!=====================================================================
-      
-   !!----------------------------------------------------------------------
-   !!   prihin       : print an integer 2D horizontal field
-   !!   prihre       : print an real 2D horizontal field
-   !!   prizre       : print an real 2D vertical field
-   !!----------------------------------------------------------------------
-   !! * Mules used
-   USE par_kind      ! kind parameters
-
-   IMPLICIT NONE
-   PRIVATE
-
-   !! * Routine accessibility
-   PUBLIC prihin, prihre, prizre
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE prihin( ktab, ki   , kj   , kideb, kifin ,   &
-                      kind, kjdeb, kjfin, kjnd , kscale, kumout )
-      !!----------------------------------------------------------------------
-      !!                   ***  SUBROUTINE  prihre  ***
-      !!  
-      !! ** purpose :   Print an integer field
-      !!
-      !! ** method :   format of print is selected with the dummy argument kscale
-      !!
-      !! History :
-      !!        !  90-04 (0. Marti)  Original code
-      !!        !  92-02 (M. Imbard)
-      !!        !  03-07 (G. Madec)  F90, free form
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      INTEGER, INTENT( in ) ::   &
-         ki, kj,                 &  ! array dimensions
-         kideb, kifin, kind,     &  ! first and last index, increment for i 
-         kjdeb, kjfin, kjnd,     &  ! first and last index, increment for j
-         kscale,                 &  ! kscale=0 or > 5  print ktab with format i8
-      !                             !         kscale=1 print ktab with format i1
-      !                             !         kscale=2 print ktab with format i2
-      !                             !         kscale=3 print ktab with format i3
-      !                             !         kscale=4 print ktab with format i4
-      !                             !         kscale=5 print ktab with format i5
-         kumout                     ! unit in which print
-      INTEGER, DIMENSION(ki,kj), INTENT( in ) ::   &
-         ktab                       ! integer 2D array to be print
-
-      !! * local declarations
-      INTEGER ::   ji, jj, jn       ! dummy loop indices
-      INTEGER ::   isca, il1, il2   ! temporary integers
-      INTEGER ::   iind, ijnd       ! temporary integers
-
-      isca = 10
-      IF( kscale == 0 )   isca = 10
-      IF( kscale == 1 )   isca = 100
-      IF( kscale == 2 )   isca = 60
-      IF( kscale == 3 )   isca = 40
-      IF( kscale == 4 )   isca = 30
-      IF( kscale == 5 )   isca = 20
-
-      iind = MAX( 1, kind )
-      ijnd = MAX( 1, kjnd )
-
-      il1 = kideb
-
-      DO jn = 1, (kifin-kideb+1)/(iind*isca) + 1
-
-        IF( il1 > kifin ) RETURN
-        WRITE(kumout,'(/)')
-        il2 = il1+iind*(isca-1)
-        IF( il2 > kifin )   il2 = kifin
-
-        IF( kscale == 1 ) THEN
-            WRITE(kumout,'(4x,i14," to ",1i4," each ",1i4,/)') il1, il2, iind
-            DO jj = kjfin, kjdeb, -ijnd
-              WRITE (kumout,'(1x,i3,100i1)') jj, ( ktab(ji,jj), ji = il1, il2, iind )
-            END DO  
-        ELSEIF( kscale == 2 ) THEN
-            WRITE(kumout,'(4x,i14," to ",1i4," each ",1i4,/)')il1, il2, iind
-            DO jj = kjfin, kjdeb, -ijnd
-              WRITE (kumout,'(1x,i3,60i2)') jj, ( ktab(ji,jj), ji = il1, il2, iind )
-            END DO  
-        ELSEIF( kscale == 3 ) THEN
-            WRITE(kumout,'(4x,i14," to ",1i4," each ",1i4,/)')il1, il2, iind
-            DO jj = kjfin, kjdeb, -ijnd
-              WRITE (kumout,'(1x,i3,40i3)') jj, ( ktab(ji,jj), ji = il1, il2, iind )
-            END DO  
-        ELSEIF( kscale == 4 ) THEN
-            WRITE(kumout,'(4x,30i4,/)') ( ji, ji = il1, il2, iind )
-            DO jj = kjfin, kjdeb, -ijnd
-              WRITE (kumout,'(1x,i3,30i4)') jj, ( ktab(ji,jj), ji = il1, il2, iind )
-            END DO  
-        ELSEIF( kscale == 5 ) THEN
-            WRITE(kumout,'(4x,20i5,/)') ( ji, ji = il1, il2, iind )
-            DO jj = kjfin, kjdeb, -ijnd
-              WRITE (kumout,'(1x,i3,20i5)') jj, ( ktab(ji,jj), ji = il1, il2, iind )
-            END DO  
-        ELSE
-            WRITE(kumout,'(4x,10i8,/)') ( ji, ji = il1, il2, iind )
-            DO jj = kjfin, kjdeb, -ijnd
-              WRITE (kumout,'(1x,i3,10i8)') jj, ( ktab(ji,jj), ji = il1, il2, iind )
-            END DO  
-        ENDIF
-
-        il1 = il1 + iind * isca
-      END DO  
-
-   END SUBROUTINE prihin
-
-
-   SUBROUTINE prihre( ptab, ki   , kj   , kideb, kifin ,   &
-                      kind, kjdeb, kjfin, kjnd , pscale, kumout )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE prihre  ***
-      !!      
-      !! ** purpose :   Print a real field with the format 10e12.4 or 20f6.2
-      !!
-      !! ** method  :   the print format is selected with the pscale argument
-      !!
-      !! History :
-      !!   1.0  !  86-01  (P. Andrich)  Original code
-      !!        !  89-11  (C. Levy)
-      !!        !  92-02  (M. Imbard)
-      !!        !  92-06  (M. Imbard)
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      INTEGER, INTENT( in ) ::   &
-         ki, kj,                 &  ! array dimensions
-         kideb, kifin, kind,     &  ! first and last index, increment for i
-         kjdeb, kjfin, kjnd,     &  ! first and last index, increment for j
-         kumout                     ! unit in which print
-      REAL(wp), INTENT( in ) ::   &
-         pscale                     ! = 0  print        ptab with e13.5 format
-         !                          ! else print pscale*ptab with f6.2 format
-      REAL(wp), DIMENSION(ki,kj), INTENT( in ) ::   &
-         ptab                       ! integer 2D array to be print
-
-      !! * Local variables
-      INTEGER ::   ji, jj, jn       ! dummy loop indices
-      INTEGER ::   isca, il1, il2   ! temporary integers
-
-      isca = 10
-      IF( pscale /= 0. )   isca=20
-
-      il1 = kideb
-
-      DO jn = 1, (kifin-kideb+1)/(kind*isca) + 1
-
-        IF( il1 > kifin )   RETURN
-
-        WRITE(kumout,9100)
-
-        il2 = il1+kind*(isca-1)
-        IF(il2 > kifin) il2 = kifin
-        IF( pscale == 0.) THEN
-            WRITE(kumout,9101) ( ji, ji = il1, il2, kind )
-            DO jj = kjfin, kjdeb, -kjnd
-              WRITE(kumout,9102) jj, ( ptab(ji,jj), ji = il1, il2, kind )
-            END DO  
-        ELSE
-            WRITE(kumout,9103) ( ji, ji = il1, il2, kind )
-            DO jj = kjfin, kjdeb, -kjnd
-              WRITE(kumout,9104) jj, ( pscale*ptab(ji,jj), ji = il1, il2, kind )
-            END DO  
-        ENDIF
-        il1 = il1+kind*isca
-
-      END DO  
-
-      ! formats
- 9100 FORMAT(/)
- 9101 FORMAT(10i12, /)
- 9102 FORMAT(1x, i3, 10(1pe12.4))
- 9103 FORMAT(3x, 20i6, /)
- 9104 FORMAT(1x, i3, 1x, 20f6.2)
-
-   END SUBROUTINE prihre
-
-
-   SUBROUTINE prizre( ptab , ki   , kj   , kk   , kjcut ,   &
-                      kideb, kifin, kid  , kkdeb, kkfin ,   &
-                      kkd  , pscale, kumout )
-      !!----------------------------------------------------------------------
-      !!                      ***  ROUTINE prizre  ***
-      !!
-      !! ** purpose :   Print a vertical slab from a tridimentional real field
-      !!
-      !!   METHOD :
-      !! ** method  :   the print format is selected with the argument pscale
-      !!
-      !! History :
-      !!      original : 86-01 (o. Marti)
-      !!      addition : 92-02 (M. Imbard)
-      !!      addition : 92-06 (M. Imbard)
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      INTEGER, INTENT( in ) ::   &
-         ki, kj, kk,             &  ! array dimensions
-         kjcut,                  &  ! index j for the vertical slab
-         kideb, kifin, kid,      &  ! first and last index, increment for i
-         kkdeb, kkfin, kkd,      &  ! first and last index, increment for k
-         kumout                     ! unit in which print
-      REAL(wp), INTENT( in ) ::   &
-         pscale                     ! = 0  print        ptab with e12.4 format
-         !                          ! else print pscale*ptab with f6.2 format
-      REAL(wp), DIMENSION(ki,kj,kk), INTENT( in ) ::   &
-         ptab                       ! integer 3D array to be print
-
-      !! * Local variables
-      INTEGER ::   ji, jn, jk       ! dummy loop indices
-      INTEGER ::   isca, il1, il2   ! temporary integers
-      INTEGER ::   iind, iknd       !    "          "
-
-
-      iind = kid
-      iknd = kkd
-      isca = 10
-      IF( pscale /= 0.) isca = 20
-
-      IF (iind == 0) iind = 1
-      IF (iknd == 0) iknd = 1
-
-      il1 = kideb
-
-      DO jn = 1, (kifin-kideb+1)/(iind*isca) + 1
-
-        IF(il1 > kifin) RETURN
-        WRITE(kumout,9100)
-        il2 = il1+iind*(isca-1)
-        IF(il2 > kifin) il2 = kifin
-
-        IF( pscale == 0.) THEN
-            WRITE(kumout,9101) ( ji, ji = il1, il2, iind )
-            DO jk = kkdeb, kkfin, iknd
-              WRITE (kumout,9102) jk, ( ptab(ji,kjcut,jk), ji = il1, il2, iind )
-            END DO  
-        ELSE
-            WRITE (kumout,9103) ( ji, ji = il1, il2, iind )
-            DO jk = kkdeb, kkfin, iknd
-              WRITE(kumout,9104)jk, ( pscale*ptab(ji,kjcut,jk), ji = il1, il2, iind )
-            END DO  
-        ENDIF
-
-        il1 = il1+iind*isca
-      END DO      
-
- 9100 FORMAT(/)
- 9101 FORMAT(10i12, /)
- 9102 FORMAT(1x, i3, 10(1pe12.4))
- 9103 FORMAT(3x, 20i6, /)
- 9104 FORMAT(1x, i3, 1x, 20f6.1)
-
-      END SUBROUTINE prizre
-
-   !!======================================================================
-END MODULE lib_print
Index: trunk/NEMOGCM/NEMO/OFF_SRC/model.f90
===================================================================
--- trunk/NEMOGCM/NEMO/OFF_SRC/model.f90	(revision 2527)
+++ 	(revision )
@@ -1,21 +1,0 @@
-PROGRAM model
-   !!----------------------------------------------------------------------
-   !!                     ***  PROGRAM model  ***
-   !!
-   !! ** Purpose :   encapsulate the opa model so that opa can also be 
-   !!      called together with the adjoint and linear tangent models
-   !!
-   !! History :
-   !!   8.0  !  01-02  (M. Imbard, A. Weaver)  Original code
-   !!   9.0  !  03-10  (G. Madec) F90
-   !!----------------------------------------------------------------------
-   USE opa                  ! OPA system     (opa_model routine)
-   !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
-   !!----------------------------------------------------------------------
- 
-   CALL opa_model           ! OPA system
- 
-END PROGRAM model
Index: trunk/NEMOGCM/NEMO/OFF_SRC/module_example
===================================================================
--- trunk/NEMOGCM/NEMO/OFF_SRC/module_example	(revision 2527)
+++ 	(revision )
@@ -1,211 +1,0 @@
-MODULE exampl
-   !!======================================================================
-   !!                       ***  MODULE  example  ***
-   !! Ocean physics:  brief description of the purpose of the module
-   !!                 (please no more than 2 lines)
-   !!=====================================================================
-#if defined key_example
-   !!----------------------------------------------------------------------
-   !!   'key_example'  :                brief description of the key option
-   !!----------------------------------------------------------------------
-   !!   exa_mpl      : liste of module subroutine (caution, never use the
-   !!   exa_mpl_init : name of the module for a routine)
-   !!   exa_mpl_stp  : Please try to use 3 letter block for routine names
-   !!----------------------------------------------------------------------
-   !! * Modules used
-   USE module_name1            ! brief description of the used module
-   USE module_name2            ! ....
-
-   IMPLICIT NONE
-   PRIVATE
-
-   !! *  Routine accessibility
-   PUBLIC exa_mpl    ! routine called in xxx.F90 module
-
-   !! * Share Module variables
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  !:
-      var1    ,   &  !: var1 description (CAUTION always use !: to describe a 
-      !              !  PUBLIC variable simplify the search of where it is declared
-      var2           !: var2 description
-
-   !! * Module variables
-   INTEGER ::                 & !!! ** toto namelist (namtoto) **
-      nflag  =  1                ! default value of nflag 
-   REAL(wp) ::                & !!! ** toto namlist (namtoto) **
-      var3  = 2._wp / 9._wp      ! default value of var3
-   REAL(wp) ::   &  
-      var4          ! var4 description (local permanent variable)
-   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
-      tab1          ! coefficient used for horizontal smoothing
-
-   !! * Substitutions
-#  include "exampl_substitute.h90"
-   !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! or LIM 2.0 , UCL-LOCEAN-IPSL (2005)
-   !! or  TOP 1.0 , LOCEAN-IPSL (2005)
-   !! $Id$
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-# if defined key_autotasking
-   !!----------------------------------------------------------------------
-   !!   'key_autotasking'                              autotasking (j-slab)
-   !!----------------------------------------------------------------------
-#  include "exampl_autotsk.h90"
-
-# else
-   !!----------------------------------------------------------------------
-   !!   Default option :                           vector opt. (k-j-i loop)
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE exa_mpl( kt )
-      !!----------------------------------------------------------------------
-      !!                    ***  ROUTINE exa_mpl  ***
-      !!
-      !! ** Purpose :   Brief description of the routine
-      !!
-      !! ** Method  :   description of the methodoloy used to achieve the
-      !!      objectives of the routine. Be as clear as possible!
-      !!
-      !! ** Action  : - first action (share memory array/varible modified
-      !!                in this routine
-      !!              - second action .....
-      !!              - .....
-      !!
-      !! References :
-      !!   Give references if exist otherwise suppress these lines
-      !!
-      !! History :
-      !!   9.0  !  03-08  (Autor Names)  Original code
-      !!        !  02-08  (Author names)  brief description of modifications
-      !!----------------------------------------------------------------------
-      !! * Modules used
-      USE toto_module                ! description od the module
-
-      !! * arguments
-      INTEGER, INTENT( in  ) ::   &  
-         kt                          ! describe it!!!
-
-      !! * local declarations
-      INTEGER ::   ji, jj, jk        ! dummy loop arguments
-      INTEGER ::   &
-         itoto, itata,            &  ! temporary integers
-         ititi                       ! please do not forget the DOCTOR rule:
-         !                           ! local integer: name start with i
-      REAL(wp) ::   &
-         zmlmin, zbbrau,          &  ! temporary scalars
-         zfact1, zfact2, zfact3,  &  !    "         "
-         zbn2, zesurf,            &  ! local scalar: name start with z
-         zemxl                       !
-      REAL(wp), DIMENSION(jpi,jpk) ::   &
-         ztoto                       ! temporary workspace
-      !!--------------------------------------------------------------------
-
-
-
-      IF( kt == nit000  )   CALL exa_mpl_init    ! Initialization (first time-step only)
-
-      ! Local constant initialization
-      zmlmin = 1.e-8
-      zbbrau =  .5 * ebb / rau0
-      zfact1 = -.5 * rdt * efave
-      zfact2 = 1.5 * rdt * ediss
-      zfact3 = 0.5 * rdt * ediss
-
-
-      SELECT CASE ( npdl )
-
-      CASE ( 0 )           ! describe case 1
-         DO jk = 2, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  avmv(ji,jj,jk) = ....
-               END DO
-            END DO
-         END DO
-
-      CASE ( 1 )           ! describe case 2
-         DO jk = 2, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  avmv(ji,jj,jk) = ...
-               END DO
-            END DO
-         END DO
-
-      END SELECT
-
-      ! Lateral boundary conditions (avmu)   (unchanged sign)
-      CALL mpplnk2( avmu, 'U', 1. )
-
-   END SUBROUTINE exa_mpl
-
-# endif
-
-   SUBROUTINE exa_mpl_init
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE exa_mpl_init  ***
-      !!                   
-      !! ** Purpose :   initialization of ....
-      !!
-      !! ** Method  :   blah blah blah ...
-      !!
-      !! ** input   :   Namlist namexa
-      !!
-      !! ** Action  :   ...  
-      !!
-      !! history :
-      !!   9.0  !  03-08  (Autor Names)  Original code
-      !!----------------------------------------------------------------------
-      !! * local declarations
-      INTEGER ::   ji, jj, jk, jit   ! dummy loop indices
-
-      NAMELIST/namexa/ exa_v1, exa_v2, nexa_0  
-      !!----------------------------------------------------------------------
-
-      ! Read Namelist namexa : example parameters
-      REWIND ( numnam )
-      READ   ( numnam, namexa )
-
-
-      ! Control print
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'exa_mpl_init : example '
-         WRITE(numout,*) '~~~~~~~~~~~~'
-         WRITE(numout,*) '          Namelist namexa : set example parameters'
-         WRITE(numout,*) '             brief desciption               exa_v1  = ', exa_v1
-         WRITE(numout,*) '             brief desciption               exa_v1  = ', exa_v1
-         WRITE(numout,*) '             brief desciption               nexa_0  = ', nexa_0
-      ENDIF
-
-      ! Parameter control
-#if defined key_toto
-      IF(lwp) WRITE(numout,cform_err)
-      IF(lwp) WRITE(numout,*) '          this part and key_toto are incompatible'
-      nstop = nstop + 1
-#endif
-
-      ! Check nexa_0 values
-      IF( nexa_0 < 0 ) THEN
-         IF(lwp) WRITE(numout,cform_err)
-         IF(lwp) WRITE(numout,*) '          bad flag: nmxl is < 0 or > 3 '
-         nstop = nstop + 1
-      ENDIF
-
-   END SUBROUTINE exa_mpl_init
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option :                                       Empty module
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE exa_mpl              ! Empty routine
-   END SUBROUTINE exa_mpl
-#endif
-
-   !!======================================================================
-END MODULE exampl
Index: trunk/NEMOGCM/NEMO/OFF_SRC/mppini.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OFF_SRC/mppini.F90	(revision 2527)
+++ 	(revision )
@@ -1,557 +1,0 @@
-MODULE mppini
-   !!==============================================================================
-   !!                       ***  MODULE mppini   ***
-   !! Ocean initialization : distributed memory computing initialization
-   !!==============================================================================
-
-   !!----------------------------------------------------------------------
-   !!   mpp_init       : Lay out the global domain over processors
-   !!   mpp_init2      : Lay out the global domain over processors 
-   !!                    with land processor elimination
-   !!   mpp_init_ioispl: IOIPSL initialization in mpp
-   !!----------------------------------------------------------------------
-   !! * Modules used
-   USE dom_oce         ! ocean space and time domain 
-   USE in_out_manager  ! I/O Manager
-   USE sol_oce         ! ocean elliptic solver
-   USE lib_mpp         ! distribued memory computing library
-   USE ioipsl
-
-   IMPLICIT NONE
-   PRIVATE
-
-   !! * Routine accessibility
-   PUBLIC mpp_init       ! called by opa.F90
-   PUBLIC mpp_init2      ! called by opa.F90
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-   !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-#if ! defined key_mpp_mpi   &&   ! defined key_mpp_shmem
-   !!----------------------------------------------------------------------
-   !!   Default option :                            shared memory computing
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE mpp_init
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE mpp_init  ***
-      !!
-      !! ** Purpose :   Lay out the global domain over processors.
-      !!
-      !! ** Method  :   Shared memory computing, set the local processor
-      !!      variables to the value of the global domain
-      !!
-      !! History :
-      !!   9.0  !  04-01  (G. Madec, J.M. Molines)  F90 : free form, north fold jpni >1
-      !!----------------------------------------------------------------------
-      ! No mpp computation
-
-      nimpp  = 1
-      njmpp  = 1
-      nlci   = jpi
-      nlcj   = jpj
-      nldi   = 1
-      nldj   = 1
-      nlei   = jpi
-      nlej   = jpj
-      nperio = jperio
-      nbondi = 2
-      nbondj = 2
-      nidom  = FLIO_DOM_NONE
-
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'mpp_init(2) : NO massively parallel processing'
-         WRITE(numout,*) '~~~~~~~~~~~: '
-         WRITE(numout,*) '         nperio = ', nperio
-         WRITE(numout,*) '         npolj  = ', npolj
-         WRITE(numout,*) '         nimpp  = ', nimpp
-         WRITE(numout,*) '         njmpp  = ', njmpp
-      ENDIF
-
-      IF(  jpni /= 1 .OR. jpnj /= 1 .OR. jpnij /= 1 ) THEN
-          IF(lwp)WRITE(numout,cform_err)
-          IF(lwp)WRITE(numout,*) 'equality  jpni = jpnj = jpnij = 1 is not satisfied'
-          IF(lwp)WRITE(numout,*) 'the domain is lay out for distributed memory computing! '
-          nstop = nstop + 1
-      ENDIF
-
-   END SUBROUTINE mpp_init
-
-
-   SUBROUTINE mpp_init2 
-      CALL mpp_init                             ! same routine as mpp_init
-   END SUBROUTINE mpp_init2
-
-#else
-   !!----------------------------------------------------------------------
-   !!   'key_mpp_mpi'          OR         MPI massively parallel processing
-   !!   'key_mpp_shmem'                 SHMEM massively parallel processing
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE mpp_init
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE mpp_init  ***
-      !!                    
-      !! ** Purpose :   Lay out the global domain over processors.
-      !!
-      !! ** Method  :   Global domain is distributed in smaller local domains.
-      !!      Periodic condition is a function of the local domain position
-      !!      (global boundary or neighbouring domain) and of the global
-      !!      periodic
-      !!      Type :         jperio global periodic condition
-      !!                     nperio local  periodic condition
-      !!
-      !! ** Action  : - set domain parameters
-      !!                    nimpp     : longitudinal index 
-      !!                    njmpp     : latitudinal  index
-      !!                    nperio    : lateral condition type 
-      !!                    narea     : number for local area
-      !!                    nlci      : first dimension
-      !!                    nlcj      : second dimension
-      !!                    nbondi    : mark for "east-west local boundary"
-      !!                    nbondj    : mark for "north-south local boundary"
-      !!                    nproc     : number for local processor
-      !!                    noea      : number for local neighboring processor
-      !!                    nowe      : number for local neighboring processor
-      !!                    noso      : number for local neighboring processor
-      !!                    nono      : number for local neighboring processor
-      !!
-      !! History :
-      !!        !  94-11  (M. Guyon)  Original code
-      !!        !  95-04  (J. Escobar, M. Imbard)
-      !!        !  98-02  (M. Guyon)  FETI method
-      !!        !  98-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions
-      !!   8.5  !  02-08  (G. Madec)  F90 : free form
-      !!----------------------------------------------------------------------
-      !! * Local variables
-      INTEGER ::   ji, jj, jn               ! dummy loop indices
-      INTEGER ::   &
-         ii, ij, ifreq, il1, il2,        &  ! temporary integers
-         iresti, irestj, ijm1, imil,     &  !    "          "
-         inum                               ! temporary logical unit
-
-      INTEGER, DIMENSION(jpni,jpnj) ::   &
-         iimppt, ijmppt, ilcit, ilcjt       ! temporary workspace
-      REAL(wp) ::   zidom, zjdom            ! temporary scalars
-      !!----------------------------------------------------------------------
-
-#if defined key_mpp_shmem
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'mpp_init : Message Passing PVM T3E + SHMEM'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~'
-
-      CALL mppshmem                           ! Initialisation of shmem array
-
-#endif
-#if defined key_mpp_mpi
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'mpp_init : Message Passing MPI'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~'
-#endif
-
-
-      !  1. Dimension arrays for subdomains
-      ! -----------------------------------
-      !  Computation of local domain sizes ilcit() ilcjt()
-      !  These dimensions depend on global sizes jpni,jpnj and jpiglo,jpjglo
-      !  The subdomains are squares leeser than or equal to the global
-      !  dimensions divided by the number of processors minus the overlap
-      !  array (cf. par_oce.F90).
-      
-      nreci  = 2 * jpreci
-      nrecj  = 2 * jprecj
-      iresti = MOD( jpiglo - nreci , jpni )
-      irestj = MOD( jpjglo - nrecj , jpnj )
-
-      IF(  iresti == 0 )   iresti = jpni
-      DO jj = 1, jpnj
-         DO ji = 1, iresti
-            ilcit(ji,jj) = jpi
-         END DO
-         DO ji = iresti+1, jpni
-            ilcit(ji,jj) = jpi -1
-         END DO
-      END DO
-      
-      IF( irestj == 0 )   irestj = jpnj
-      DO ji = 1, jpni
-         DO jj = 1, irestj
-            ilcjt(ji,jj) = jpj
-         END DO
-         DO jj = irestj+1, jpnj
-            ilcjt(ji,jj) = jpj -1
-         END DO
-      END DO
-      
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) '           defines mpp subdomains'
-         WRITE(numout,*) '           ----------------------'
-         WRITE(numout,*) '              iresti=',iresti,' irestj=',irestj
-         WRITE(numout,*) '              jpni=',jpni,' jpnj=',jpnj
-         ifreq = 4
-         il1   = 1
-         DO jn = 1, (jpni-1)/ifreq+1
-            il2 = MIN( jpni, il1+ifreq-1 )
-            WRITE(numout,*)
-            WRITE(numout,9201) (ji,ji = il1,il2)
-            WRITE(numout,9200) ('***',ji = il1,il2-1)
-            DO jj = 1, jpnj
-               WRITE(numout,9203) ('   ',ji = il1,il2-1)
-               WRITE(numout,9202) jj, ( ilcit(ji,jj),ilcjt(ji,jj),ji = il1,il2 )
-               WRITE(numout,9203) ('   ',ji = il1,il2-1)
-               WRITE(numout,9200) ('***',ji = il1,il2-1)
-            END DO
-            il1 = il1+ifreq
-         END DO
- 9200    FORMAT('     ***',20('*************',a3))
- 9203    FORMAT('     *     ',20('         *   ',a3))
- 9201    FORMAT('        ',20('   ',i3,'          '))
- 9202    FORMAT(' ',i3,' *  ',20(i3,'  x',i3,'   *   '))
-      ENDIF
-
-      zidom = nreci
-      DO ji = 1, jpni
-         zidom = zidom + ilcit(ji,1) - nreci
-      END DO
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*)' sum ilcit(i,1) = ', zidom, ' jpiglo = ', jpiglo
-      
-      zjdom = nrecj
-      DO jj = 1, jpnj
-         zjdom = zjdom + ilcjt(1,jj) - nrecj
-      END DO
-      IF(lwp) WRITE(numout,*)' sum ilcit(1,j) = ', zjdom, ' jpjglo = ', jpjglo
-      IF(lwp) WRITE(numout,*)
-      
-
-      !  2. Index arrays for subdomains
-      ! -------------------------------
-      
-      iimppt(:,:) = 1
-      ijmppt(:,:) = 1
-      
-      IF( jpni > 1 ) THEN
-         DO jj = 1, jpnj
-            DO ji = 2, jpni
-               iimppt(ji,jj) = iimppt(ji-1,jj) + ilcit(ji-1,jj) - nreci
-            END DO
-         END DO
-      ENDIF
-
-      IF( jpnj > 1 ) THEN
-         DO jj = 2, jpnj
-            DO ji = 1, jpni
-               ijmppt(ji,jj) = ijmppt(ji,jj-1)+ilcjt(ji,jj-1)-nrecj
-            END DO
-         END DO
-      ENDIF
-      
-      ! 3. Subdomain description
-      ! ------------------------
-
-      DO jn = 1, jpnij
-         ii = 1 + MOD( jn-1, jpni )
-         ij = 1 + (jn-1) / jpni
-         nimppt(jn) = iimppt(ii,ij)
-         njmppt(jn) = ijmppt(ii,ij)
-         nlcit (jn) = ilcit (ii,ij)     
-         nlci       = nlcit (jn)     
-         nlcjt (jn) = ilcjt (ii,ij)     
-         nlcj       = nlcjt (jn)
-         nbondj = -1                                   ! general case
-         IF( jn   >  jpni          )   nbondj = 0      ! first row of processor
-         IF( jn   >  (jpnj-1)*jpni )   nbondj = 1      ! last  row of processor
-         IF( jpnj == 1             )   nbondj = 2      ! one processor only in j-direction
-         ibonjt(jn) = nbondj
-         
-         nbondi = 0                                    ! 
-         IF( MOD( jn, jpni ) == 1 )   nbondi = -1      !
-         IF( MOD( jn, jpni ) == 0 )   nbondi =  1      !
-         IF( jpni            == 1 )   nbondi =  2      ! one processor only in i-direction
-         ibonit(jn) = nbondi
-         
-         nldi =  1   + jpreci
-         nlei = nlci - jpreci
-         IF( nbondi == -1 .OR. nbondi == 2 )   nldi = 1
-         IF( nbondi ==  1 .OR. nbondi == 2 )   nlei = nlci
-         nldj =  1   + jprecj
-         nlej = nlcj - jprecj
-         IF( nbondj == -1 .OR. nbondj == 2 )   nldj = 1
-         IF( nbondj ==  1 .OR. nbondj == 2 )   nlej = nlcj
-         nldit(jn) = nldi
-         nleit(jn) = nlei
-         nldjt(jn) = nldj
-         nlejt(jn) = nlej
-      END DO
-      
-
-      ! 4. From global to local
-      ! -----------------------
-
-      nperio = 0
-      IF( jperio == 2 .AND. nbondj == -1 )   nperio = 2
-
-
-      ! 5. Subdomain neighbours
-      ! ----------------------
-
-      nproc = narea - 1
-      noso  = nproc - jpni
-      nowe  = nproc - 1
-      noea  = nproc + 1
-      nono  = nproc + jpni
-      ! great neighbours
-      npnw = nono - 1
-      npne = nono + 1
-      npsw = noso - 1
-      npse = noso + 1
-      nbsw = 1
-      nbnw = 1
-      IF( MOD( nproc, jpni ) == 0 ) THEN
-         nbsw = 0
-         nbnw = 0
-      ENDIF
-      nbse = 1
-      nbne = 1
-      IF( MOD( nproc, jpni ) == jpni-1 ) THEN
-         nbse = 0
-         nbne = 0
-      ENDIF
-      IF(nproc < jpni) THEN
-         nbsw = 0
-         nbse = 0
-      ENDIF
-      IF( nproc >= (jpnj-1)*jpni ) THEN
-         nbnw = 0
-         nbne = 0
-      ENDIF
-      nlcj = nlcjt(narea)  
-      nlci = nlcit(narea)  
-      nldi = nldit(narea)
-      nlei = nleit(narea)
-      nldj = nldjt(narea)
-      nlej = nlejt(narea)
-      nbondi = ibonit(narea)
-      nbondj = ibonjt(narea)
-      nimpp  = nimppt(narea)  
-      njmpp  = njmppt(narea)  
-
-     ! Save processor layout in layout.dat file 
-       IF (lwp) THEN
-        CALL ctlopn( inum, 'layout.dat', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL',   &
-           &         1, numout, .FALSE., 1 )
-        WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo
-        WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp'
-
-        DO  jn = 1, jpnij
-         WRITE(inum,'(9i5)') jn, nlcit(jn), nlcjt(jn), &
-                                      nldit(jn), nldjt(jn), &
-                                      nleit(jn), nlejt(jn), &
-                                      nimppt(jn), njmppt(jn)
-        END DO
-        CLOSE(inum)   
-      END IF
-
-
-      ! w a r n i n g  narea (zone) /= nproc (processors)!
-
-      IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
-         IF( jpni == 1 )THEN
-            nbondi = 2
-            nperio = 1
-         ELSE
-            nbondi = 0
-         ENDIF
-         IF( MOD( narea, jpni ) == 0 ) THEN
-            noea = nproc-(jpni-1)
-            npne = npne-jpni
-            npse = npse-jpni
-         ENDIF
-         IF( MOD( narea, jpni ) == 1 ) THEN
-            nowe = nproc+(jpni-1)
-            npnw = npnw+jpni
-            npsw = npsw+jpni
-         ENDIF
-         nbsw = 1
-         nbnw = 1
-         nbse = 1
-         nbne = 1
-         IF( nproc < jpni ) THEN
-            nbsw = 0
-            nbse = 0
-         ENDIF
-         IF( nproc >= (jpnj-1)*jpni ) THEN
-            nbnw = 0
-            nbne = 0
-         ENDIF
-      ENDIF
-      npolj = 0
-      IF( jperio == 3 .OR. jperio == 4 ) THEN
-         ijm1 = jpni*(jpnj-1)
-         imil = ijm1+(jpni+1)/2
-         IF( narea > ijm1 ) npolj = 3
-         IF( MOD(jpni,2) == 1 .AND. narea == imil ) npolj = 4
-         IF( npolj == 3 ) nono = jpni*jpnj-narea+ijm1
-      ENDIF
-      IF( jperio == 5 .OR. jperio == 6 ) THEN
-          ijm1 = jpni*(jpnj-1)
-          imil = ijm1+(jpni+1)/2
-          IF( narea > ijm1) npolj = 5
-          IF( MOD(jpni,2) == 1 .AND. narea == imil ) npolj = 6
-          IF( npolj == 5 ) nono = jpni*jpnj-narea+ijm1
-      ENDIF
-
-      ! FETI method
-
-      IF( nperio == 1 .AND. nsolv == 3 ) THEN 
-         
-         ! general case : Earth == infinite tube
-         
-         nbnw = 1
-         npnw = narea
-         nbne = 1
-         npne = narea
-         nbsw = 1
-         npsw = (narea-2)
-         nbse = 1
-         npse = (narea-2)
-         
-         ! REAL boundary condition
-         
-         IF( nbondj == -1 .OR. nbondj == 2 ) THEN 
-            nbsw = 0
-            nbse = 0
-         ENDIF
-         
-         IF( nbondj == -1 .OR. nbondj == 2 ) THEN 
-            nbsw = 0
-            nbse = 0
-         ENDIF
-         
-         IF( nbondj == 1  .OR. nbondj == 2 ) THEN 
-            nbnw = 0
-            nbne = 0
-         ENDIF
-      ENDIF
-
-      ! Periodicity : no corner if nbondi = 2 and nperio != 1
-
-      IF(lwp) THEN
-         WRITE(numout,*) ' nproc  = ', nproc
-         WRITE(numout,*) ' nowe   = ', nowe  , ' noea   =  ', noea
-         WRITE(numout,*) ' nono   = ', nono  , ' noso   =  ', noso
-         WRITE(numout,*) ' nbondi = ', nbondi
-         WRITE(numout,*) ' nbondj = ', nbondj
-         WRITE(numout,*) ' npolj  = ', npolj
-         WRITE(numout,*) ' nperio = ', nperio
-         WRITE(numout,*) ' nlci   = ', nlci
-         WRITE(numout,*) ' nlcj   = ', nlcj
-         WRITE(numout,*) ' nimpp  = ', nimpp
-         WRITE(numout,*) ' njmpp  = ', njmpp
-         WRITE(numout,*) ' nbse   = ', nbse  , ' npse   = ', npse
-         WRITE(numout,*) ' nbsw   = ', nbsw  , ' npsw   = ', npsw
-         WRITE(numout,*) ' nbne   = ', nbne  , ' npne   = ', npne
-         WRITE(numout,*) ' nbnw   = ', nbnw  , ' npnw   = ', npnw
-      ENDIF
-
-      IF( nperio == 1 .AND. jpni /= 1 )THEN
-         IF(lwp) WRITE(numout,cform_err)
-         IF(lwp) WRITE(numout,*) ' mpp_init: error on cyclicity'
-         nstop = nstop + 1
-      ENDIF
-
-      ! Prepare mpp north fold
-
-      IF (jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
-         CALL mpp_ini_north
-      END IF
-
-      ! Prepare NetCDF output file (if necessary)
-      CALL mpp_init_ioipsl
-
-   END SUBROUTINE mpp_init
-
-#  include "mppini_2.h90"
-
-# if defined key_dimgout
-   !!----------------------------------------------------------------------
-   !!   'key_dimgout'                  NO use of NetCDF files
-   !!----------------------------------------------------------------------
-   SUBROUTINE mpp_init_ioipsl       ! Dummy routine
-   END SUBROUTINE mpp_init_ioipsl  
-# else
-   SUBROUTINE mpp_init_ioipsl
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE mpp_init_ioipsl  ***
-      !!
-      !! ** Purpose :   
-      !!
-      !! ** Method  :   
-      !!
-      !! History :
-      !!   9.0  !  04-03  (G. Madec)  MPP-IOIPSL 
-      !!----------------------------------------------------------------------
-      !! Local declarations
-
-      INTEGER, DIMENSION(2) ::   &
-         iglo, iloc, iabsf, iabsl, ihals, ihale, idid
-      INTEGER ::   &
-         inbondi, inbondj
-      !!----------------------------------------------------------------------
-
-      ! The domain is splitted only horizontally along i- or/and j- direction
-      ! So we need at the most only 1D arrays with 2 elements
-      iglo(1) = jpiglo
-      iglo(2) = jpjglo
-      iloc(1) = nlci
-      iloc(2) = nlcj
-      iabsf(1) = nimppt(narea)
-      iabsf(2) = njmppt(narea)
-      iabsl(:) = iabsf(:) + iloc(:) - 1
-      ihals(1) = jpreci
-      ihals(2) = jprecj
-      ihale(1) = jpreci
-      ihale(2) = jprecj
-      idid(1) = 1
-      idid(2) = 2
-
-      inbondj = -1                                   ! general case
-      IF( narea   >  jpni          )   inbondj = 0      ! first row of processor
-      IF( narea   >  (jpnj-1)*jpni )   inbondj = 1      ! last  row of processor
-      IF( jpnj    == 1             )   inbondj = 2      ! one processor only in j-direction
-      IF( inbondj == -1 .OR. inbondj == 2 )   ihals(2) = 0
-      IF( inbondj ==  1 .OR. inbondj == 2 )   ihale(2) = 0
-         
-      inbondi = 0                                    ! 
-      IF( MOD( narea, jpni ) == 1 )   inbondi = -1      !
-      IF( MOD( narea, jpni ) == 0 )   inbondi =  1      !
-      IF( jpni               == 1 )   inbondi =  2      ! one processor only in i-direction
-      IF( inbondi == -1 .OR. inbondi == 2 )   ihals(1) = 0
-      IF( inbondi ==  1 .OR. inbondi == 2 )   ihale(1) = 0
-
-
-      IF(lwp) THEN
-          WRITE(numout,*) 'mpp_init_ioipsl :   iloc  = ', iloc (1), iloc (2)
-          WRITE(numout,*) '~~~~~~~~~~~~~~~     iabsf = ', iabsf(1), iabsf(2)
-          WRITE(numout,*) '                    ihals = ', ihals(1), ihals(2)
-          WRITE(numout,*) '                    ihale = ', ihale(1), ihale(2)
-      ENDIF
-
-      CALL flio_dom_set ( jpnij, nproc, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom)
-
-   END SUBROUTINE mpp_init_ioipsl  
-
-# endif
-#endif
-
-   !!======================================================================
-END MODULE mppini
Index: trunk/NEMOGCM/NEMO/OFF_SRC/mppini_2.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OFF_SRC/mppini_2.h90	(revision 2527)
+++ 	(revision )
@@ -1,566 +1,0 @@
-   SUBROUTINE mpp_init2
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE mpp_init2  ***
-      !!
-      !! * Purpose :   Lay out the global domain over processors.
-      !!     FOR USING THIS VERSION, A PREPROCESSING TRAITMENT IS RECOMMENDED
-      !!     FOR DEFINING BETTER CUTTING OUT.
-      !!       This routine is used with a the bathymetry file.
-      !!       In this version, the land processors are avoided and the adress
-      !!     processor (nproc, narea,noea, ...) are calculated again.
-      !!     The jpnij parameter can be lesser than jpni x jpnj
-      !!     and this jpnij parameter must be calculated before with an
-      !!     algoritmic preprocessing program.
-      !!
-      !! ** Method  :   Global domain is distributed in smaller local domains.
-      !!      Periodic condition is a function of the local domain position
-      !!      (global boundary or neighbouring domain) and of the global
-      !!      periodic
-      !!      Type :         jperio global periodic condition
-      !!                     nperio local  periodic condition
-      !!
-      !! ** Action :        nimpp     : longitudinal index 
-      !!                    njmpp     : latitudinal  index
-      !!                    nperio    : lateral condition type 
-      !!                    narea     : number for local area
-      !!                    nlci      : first dimension
-      !!                    nlcj      : second dimension
-      !!                    nproc     : number for local processor
-      !!                    noea      : number for local neighboring processor
-      !!                    nowe      : number for local neighboring processor
-      !!                    noso      : number for local neighboring processor
-      !!                    nono      : number for local neighboring processor
-      !!
-      !! History :
-      !!        !  94-11  (M. Guyon)  Original code
-      !!        !  95-04  (J. Escobar, M. Imbard)
-      !!        !  98-02  (M. Guyon)  FETI method
-      !!        !  98-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions
-      !!   9.0  !  04-01  (G. Madec, J.M Molines)  F90 : free form , north fold jpni > 1
-      !!----------------------------------------------------------------------
-      !! * Modules used
-      USE iom
-   
-      !! Local variables
-      INTEGER :: ji, jj, jn, jproc, jarea     ! dummy loop indices
-      INTEGER ::  inum                        ! temporary logical unit
-      INTEGER ::   &
-         ii, ij, ifreq, il1, il2,          &  ! temporary integers
-         icont, ili, ilj,                  &  !    "          "
-         isurf, ijm1, imil,                &  !    "          "
-         iino, ijno, iiso, ijso,           &  !    "          " 
-         iiea, ijea, iiwe, ijwe,           &  !    "          "
-         iinw, ijnw, iine, ijne,           &  !    "          "
-         iisw, ijsw, iise, ijse,           &  !    "          "
-         iresti, irestj, iproc                !    "          "
-      INTEGER, DIMENSION(jpnij) ::   &
-         iin, ijn          
-      INTEGER, DIMENSION(jpni,jpnj) ::   &
-         iimppt, ijmppt, ilci  , ilcj  ,   &  ! temporary workspace
-         ipproc, ibondj, ibondi, ipolj ,   &  !    "           "
-         ilei  , ilej  , ildi  , ildj  ,   &  !    "           "
-         ioea  , iowe  , ioso  , iono  ,   &  !    "           "
-         ione  , ionw  , iose  , iosw  ,   &  !    "           "
-         ibne  , ibnw  , ibse  , ibsw         !    "           "
-      INTEGER, DIMENSION(jpi,jpj) ::   &
-         imask                                ! temporary global workspace
-      REAL(wp), DIMENSION(jpi,jpj) ::   &
-         zdta                   ! temporary data workspace
-      REAL(wp) ::   zidom , zjdom          ! temporary scalars
-
-      !!----------------------------------------------------------------------
-      !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-      !! $Id$ 
-      !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
-      !!----------------------------------------------------------------------
-
-#if defined key_mpp_shmem
-      IF(lwp)WRITE(numout,*)
-      IF(lwp)WRITE(numout,*) 'mpp_init : Message Passing PVM T3E + SHMEM'
-      IF(lwp)WRITE(numout,*) '~~~~~~~~'
-      IF(lwp)WRITE(numout,*) ' '
-
-      CALL mppshmem     ! Initialisation of shmem array
-
-#endif
-#if defined key_mpp_mpi
-      IF(lwp)WRITE(numout,*)
-      IF(lwp)WRITE(numout,*) 'mpp_init : Message Passing MPI'
-      IF(lwp)WRITE(numout,*) '~~~~~~~~'
-      IF(lwp)WRITE(numout,*) ' '
-#endif
-
-      IF( jpni*jpnj < jpnij ) CALL ctl_stop( ' jpnij > jpni x jpnj impossible' )
-
-      ! 0. initialisation
-      ! -----------------
-
-      ! open the file
-      IF ( ln_zps ) THEN
-         CALL iom_open ( 'bathy_meter.nc', inum )   ! Meter bathy in case of partial steps
-         CALL iom_get ( inum, jpdom_data, 'Bathymetry' , zdta )
-      ELSE 
-         CALL iom_open ( 'bathy_level.nc', inum )   ! Level bathymetry
-         CALL iom_get ( inum, jpdom_data, 'Bathy_level', zdta )
-      ENDIF
-      CALL iom_close (inum)
-
-      ! land/sea mask over the global/zoom domain
-
-      imask(:,:)=1
-      WHERE ( zdta(:,:) <= 0. ) imask = 0
-
-      !  1. Dimension arrays for subdomains
-      ! -----------------------------------
-
-      !  Computation of local domain sizes ilci() ilcj()
-      !  These dimensions depend on global sizes jpni,jpnj and jpiglo,jpjglo
-      !  The subdomains are squares leeser than or equal to the global
-      !  dimensions divided by the number of processors minus the overlap
-      !  array.
-
-      nreci=2*jpreci
-      nrecj=2*jprecj
-      iresti = 1 + MOD( jpiglo - nreci -1 , jpni )
-      irestj = 1 + MOD( jpjglo - nrecj -1 , jpnj )
-
-      ilci(1:iresti      ,:) = jpi
-      ilci(iresti+1:jpni ,:) = jpi-1
-
-      ilcj(:,      1:irestj) = jpj
-      ilcj(:, irestj+1:jpnj) = jpj-1
-
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) ' mpp_init2: defines mpp subdomains'
-      IF(lwp) WRITE(numout,*) ' ~~~~~~  ----------------------'
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'iresti=',iresti,' irestj=',irestj
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'jpni=',jpni,' jpnj=',jpnj
-
-      zidom = nreci + sum(ilci(:,1) - nreci ) 
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*)' sum ilci(i,1)=',zidom,' jpiglo=',jpiglo
-
-      zjdom = nrecj + sum(ilcj(1,:) - nrecj ) 
-      IF(lwp) WRITE(numout,*) ' sum ilcj(1,j)=',zjdom,' jpjglo=',jpjglo
-      IF(lwp) WRITE(numout,*)
-
-
-      !  2. Index arrays for subdomains
-      ! -------------------------------
-
-      iimppt(:,:) = 1
-      ijmppt(:,:) = 1
-      ipproc(:,:) = -1
-
-      IF( jpni > 1 )THEN
-         DO jj = 1, jpnj
-            DO ji = 2, jpni
-               iimppt(ji,jj) = iimppt(ji-1,jj) + ilci(ji-1,jj) - nreci
-            END DO
-         END DO
-      ENDIF
-
-      IF( jpnj > 1 )THEN
-         DO jj = 2, jpnj
-            DO ji = 1, jpni
-               ijmppt(ji,jj) = ijmppt(ji,jj-1) + ilcj(ji,jj-1) - nrecj
-            END DO
-         END DO
-      ENDIF
-
-
-      ! 3. Subdomain description in the Regular Case
-      ! --------------------------------------------
-
-      nperio = 0
-      icont = -1
-      DO jarea = 1, jpni*jpnj
-         ii = 1 + MOD(jarea-1,jpni)
-         ij = 1 +    (jarea-1)/jpni
-         ili = ilci(ii,ij)
-         ilj = ilcj(ii,ij)
-
-         ibondj(ii,ij) = -1
-         IF( jarea >  jpni          )   ibondj(ii,ij) = 0
-         IF( jarea >  (jpnj-1)*jpni )   ibondj(ii,ij) = 1
-         IF( jpnj  == 1             )   ibondj(ii,ij) = 2
-
-         ibondi(ii,ij) = 0
-         IF( MOD(jarea,jpni) == 1 )   ibondi(ii,ij) = -1
-         IF( MOD(jarea,jpni) == 0 )   ibondi(ii,ij) =  1
-         IF( jpni            == 1 )   ibondi(ii,ij) =  2
-
-         ! 2.4 Subdomain neighbors
-
-         iproc = jarea - 1
-         ioso(ii,ij) = iproc - jpni
-         iowe(ii,ij) = iproc - 1
-         ioea(ii,ij) = iproc + 1
-         iono(ii,ij) = iproc + jpni
-         ildi(ii,ij) = 1 + jpreci
-         ilei(ii,ij) = ili -jpreci
-         ionw(ii,ij) = iono(ii,ij) - 1
-         ione(ii,ij) = iono(ii,ij) + 1
-         iosw(ii,ij) = ioso(ii,ij) - 1
-         iose(ii,ij) = ioso(ii,ij) + 1
-         ibsw(ii,ij) = 1
-         ibnw(ii,ij) = 1
-         IF( MOD(iproc,jpni) == 0 ) THEN
-            ibsw(ii,ij) = 0
-            ibnw(ii,ij) = 0
-         ENDIF
-         ibse(ii,ij) = 1
-         ibne(ii,ij) = 1
-         IF( MOD(iproc,jpni) == jpni-1 ) THEN
-            ibse(ii,ij) = 0
-            ibne(ii,ij) = 0
-         ENDIF
-         IF( iproc < jpni ) THEN
-            ibsw(ii,ij) = 0
-            ibse(ii,ij) = 0
-         ENDIF
-         IF( iproc >= (jpnj-1)*jpni ) THEN
-            ibnw(ii,ij) = 0
-            ibne(ii,ij) = 0
-         ENDIF
-         IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 ) ildi(ii,ij) = 1
-         IF( ibondi(ii,ij) ==  1 .OR. ibondi(ii,ij) == 2 ) ilei(ii,ij) = ili
-         ildj(ii,ij) =  1  + jprecj
-         ilej(ii,ij) = ilj - jprecj
-         IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) = 1
-         IF( ibondj(ii,ij) ==  1 .OR. ibondj(ii,ij) == 2 ) ilej(ii,ij) = ilj
-
-         ! warning ii*ij (zone) /= nproc (processors)!
-
-         IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
-            IF( jpni == 1 )THEN
-               ibondi(ii,ij) = 2
-               nperio = 1
-            ELSE
-               ibondi(ii,ij) = 0
-            ENDIF
-            IF( MOD(jarea,jpni) == 0 ) THEN
-               ioea(ii,ij) = iproc - (jpni-1)
-               ione(ii,ij) = ione(ii,ij) - jpni
-               iose(ii,ij) = iose(ii,ij) - jpni
-            ENDIF
-            IF( MOD(jarea,jpni) == 1 ) THEN
-               iowe(ii,ij) = iproc + jpni - 1
-               ionw(ii,ij) = ionw(ii,ij) + jpni
-               iosw(ii,ij) = iosw(ii,ij) + jpni 
-            ENDIF
-            ibsw(ii,ij) = 1
-            ibnw(ii,ij) = 1
-            ibse(ii,ij) = 1
-            ibne(ii,ij) = 1
-            IF( iproc < jpni ) THEN
-               ibsw(ii,ij) = 0
-               ibse(ii,ij) = 0
-            ENDIF
-            IF( iproc >= (jpnj-1)*jpni ) THEN
-               ibnw(ii,ij) = 0
-               ibne(ii,ij) = 0
-            ENDIF
-         ENDIF
-         ipolj(ii,ij) = 0
-         IF( jperio == 3 .OR. jperio == 4 ) THEN
-            ijm1 = jpni*(jpnj-1)
-            imil = ijm1+(jpni+1)/2
-            IF( jarea > ijm1 ) ipolj(ii,ij) = 3
-            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 4
-            IF( ipolj(ii,ij) == 3 ) iono(ii,ij) = jpni*jpnj-jarea+ijm1
-         ENDIF
-         IF( jperio == 5 .OR. jperio == 6 ) THEN
-            ijm1 = jpni*(jpnj-1)
-            imil = ijm1+(jpni+1)/2
-            IF( jarea > ijm1) ipolj(ii,ij) = 5
-            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 6
-            IF( ipolj(ii,ij) == 5) iono(ii,ij) = jpni*jpnj-jarea+ijm1
-         ENDIF
-
-         isurf = 0
-         DO jj = 1+jprecj, ilj-jprecj
-            DO  ji = 1+jpreci, ili-jpreci
-               IF( imask(ji, jj) == 1) isurf = isurf+1
-            END DO
-         END DO
-         IF(isurf /= 0) THEN
-            icont = icont + 1
-            ipproc(ii,ij) = icont
-            iin(icont+1) = ii
-            ijn(icont+1) = ij
-         ENDIF
-      END DO
-
-      ! Control
-      IF(icont+1 /= jpnij) THEN
-         WRITE(ctmp1,*) ' jpni =',jpni,' jpnj =',jpnj
-         WRITE(ctmp2,*) ' jpnij =',jpnij, '< jpni x jpnj' 
-         WRITE(ctmp3,*) ' ***********, mpp_init2 finds jpnij=',icont+1
-         CALL ctl_stop( ' Eliminate land processors algorithm', '', ctmp1, ctmp2, '', ctmp3 )
-      ENDIF
-
-      ! 4. Subdomain print
-      ! ------------------
-
-      IF(lwp) THEN
-         ifreq = 4
-         il1 = 1
-         DO jn = 1,(jpni-1)/ifreq+1
-            il2 = MIN(jpni,il1+ifreq-1)
-            WRITE(numout,*)
-            WRITE(numout,9401) (ji,ji=il1,il2)
-            WRITE(numout,9400) ('***',ji=il1,il2-1)
-            DO jj = 1, jpnj
-               ! WRITE(numout,9400)
-               WRITE(numout,9403) ('   ',ji=il1,il2-1)
-               WRITE(numout,9402) jj, (ilci(ji,jj),ilcj(ji,jj),ji=il1,il2)
-               WRITE(numout,9404) (ipproc(ji,jj),ji=il1,il2)
-               WRITE(numout,9403) ('   ',ji=il1,il2-1)
-               WRITE(numout,9400) ('***',ji=il1,il2-1)
-               ! WRITE(numout,9400)
-            END DO
-            il1 = il1+ifreq
-         END DO
- 9400     FORMAT('     ***',20('*************',a3))
- 9403     FORMAT('     *     ',20('         *   ',a3))
- 9401     FORMAT('        ',20('   ',i3,'          '))
- 9402     FORMAT(' ',i3,' *  ',20(i3,'  x',i3,'   *   '))
- 9404     FORMAT('     *  ',20('      ',i3,'   *   '))
-      ENDIF
-
-
-      ! 5. neighbour treatment
-      ! ----------------------
-
-      DO jarea = 1, jpni*jpnj
-         iproc = jarea-1
-         ii = 1 + MOD(jarea-1,jpni)
-         ij = 1 +    (jarea-1)/jpni
-         IF( ipproc(ii,ij) == -1 .AND. iono(ii,ij) >= 0   &
-            .AND. iono(ii,ij) <= jpni*jpnj-1 ) THEN
-            iino = 1 + MOD(iono(ii,ij),jpni)
-            ijno = 1 +    (iono(ii,ij))/jpni
-            IF( ibondj(iino,ijno) == 1 ) ibondj(iino,ijno)=2
-            IF( ibondj(iino,ijno) == 0 ) ibondj(iino,ijno) = -1
-         ENDIF
-         IF( ipproc(ii,ij) == -1 .AND. ioso(ii,ij) >= 0   &
-            .AND. ioso(ii,ij) <= jpni*jpnj-1 ) THEN
-            iiso = 1 + MOD(ioso(ii,ij),jpni)
-            ijso = 1 +    (ioso(ii,ij))/jpni
-            IF( ibondj(iiso,ijso) == -1 ) ibondj(iiso,ijso) = 2
-            IF( ibondj(iiso,ijso) ==  0 ) ibondj(iiso,ijso) = 1
-         ENDIF
-         IF( ipproc(ii,ij) == -1 .AND. ioea(ii,ij) >= 0   &
-            .AND. ioea(ii,ij) <= jpni*jpnj-1) THEN
-            iiea = 1 + MOD(ioea(ii,ij),jpni)
-            ijea = 1 +    (ioea(ii,ij))/jpni
-            IF( ibondi(iiea,ijea) == 1 ) ibondi(iiea,ijea) = 2
-            IF( ibondi(iiea,ijea) == 0 ) ibondi(iiea,ijea) = -1
-         ENDIF
-         IF( ipproc(ii,ij) == -1 .AND. iowe(ii,ij) >= 0   &
-            .AND. iowe(ii,ij) <= jpni*jpnj-1) THEN
-            iiwe = 1 + MOD(iowe(ii,ij),jpni)
-            ijwe = 1 +    (iowe(ii,ij))/jpni
-            IF( ibondi(iiwe,ijwe) == -1 ) ibondi(iiwe,ijwe) = 2
-            IF( ibondi(iiwe,ijwe) ==  0 ) ibondi(iiwe,ijwe) = 1
-         ENDIF
-         IF( ipproc(ii,ij) == -1 .AND. ibne(ii,ij) == 1 ) THEN
-            iine = 1 + MOD(ione(ii,ij),jpni)
-            ijne = 1 +    (ione(ii,ij))/jpni
-            IF( ibsw(iine,ijne) == 1 ) ibsw(iine,ijne) = 0
-         ENDIF
-         IF( ipproc(ii,ij) == -1 .AND. ibsw(ii,ij) == 1 ) THEN
-            iisw = 1 + MOD(iosw(ii,ij),jpni)
-            ijsw = 1 +    (iosw(ii,ij))/jpni
-            IF( ibne(iisw,ijsw) == 1 ) ibne(iisw,ijsw) = 0
-         ENDIF
-         IF( ipproc(ii,ij) == -1 .AND. ibnw(ii,ij) == 1 ) THEN
-            iinw = 1 + MOD(ionw(ii,ij),jpni)
-            ijnw = 1 +    (ionw(ii,ij))/jpni
-            IF( ibse(iinw,ijnw) == 1 ) ibse(iinw,ijnw)=0
-         ENDIF
-         IF( ipproc(ii,ij) == -1 .AND. ibse(ii,ij) == 1 ) THEN
-            iise = 1 + MOD(iose(ii,ij),jpni)
-            ijse = 1 +    (iose(ii,ij))/jpni
-            IF( ibnw(iise,ijse) == 1 ) ibnw(iise,ijse) = 0
-         ENDIF
-      END DO
-
-
-      ! 6. Change processor name
-      ! ------------------------
-
-      nproc = narea-1
-      ii = iin(narea)
-      ij = ijn(narea)
-      IF( ioso(ii,ij) >= 0 .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN 
-         iiso = 1 + MOD(ioso(ii,ij),jpni)
-         ijso = 1 +    (ioso(ii,ij))/jpni
-         noso = ipproc(iiso,ijso)
-      ENDIF
-      IF( iowe(ii,ij) >= 0 .AND. iowe(ii,ij) <= (jpni*jpnj-1) ) THEN 
-         iiwe = 1 + MOD(iowe(ii,ij),jpni)
-         ijwe = 1 +    (iowe(ii,ij))/jpni
-         nowe = ipproc(iiwe,ijwe)
-      ENDIF
-      IF( ioea(ii,ij) >= 0 .AND. ioea(ii,ij) <= (jpni*jpnj-1) ) THEN 
-         iiea = 1 + MOD(ioea(ii,ij),jpni)
-         ijea = 1 +    (ioea(ii,ij))/jpni
-         noea = ipproc(iiea,ijea)
-      ENDIF
-      IF( iono(ii,ij) >= 0 .AND. iono(ii,ij) <= (jpni*jpnj-1) ) THEN 
-         iino = 1 + MOD(iono(ii,ij),jpni)
-         ijno = 1 +    (iono(ii,ij))/jpni
-         nono = ipproc(iino,ijno)
-      ENDIF
-      IF( iose(ii,ij) >= 0 .AND. iose(ii,ij) <= (jpni*jpnj-1) ) THEN 
-         iise = 1 + MOD(iose(ii,ij),jpni)
-         ijse = 1 +    (iose(ii,ij))/jpni
-         npse = ipproc(iise,ijse)
-      ENDIF
-      IF( iosw(ii,ij) >= 0 .AND. iosw(ii,ij) <= (jpni*jpnj-1) ) THEN 
-         iisw = 1 + MOD(iosw(ii,ij),jpni)
-         ijsw = 1 +    (iosw(ii,ij))/jpni
-         npsw = ipproc(iisw,ijsw)
-      ENDIF
-      IF( ione(ii,ij) >= 0 .AND. ione(ii,ij) <= (jpni*jpnj-1) ) THEN 
-         iine = 1 + MOD(ione(ii,ij),jpni)
-         ijne = 1 +    (ione(ii,ij))/jpni
-         npne = ipproc(iine,ijne)
-      ENDIF
-      IF( ionw(ii,ij) >= 0 .AND. ionw(ii,ij) <= (jpni*jpnj-1) ) THEN 
-         iinw = 1 + MOD(ionw(ii,ij),jpni)
-         ijnw = 1 +    (ionw(ii,ij))/jpni
-         npnw = ipproc(iinw,ijnw)
-      ENDIF
-      nbnw = ibnw(ii,ij)
-      nbne = ibne(ii,ij)
-      nbsw = ibsw(ii,ij)
-      nbse = ibse(ii,ij)
-      nlcj = ilcj(ii,ij)  
-      nlci = ilci(ii,ij)  
-      nldi = ildi(ii,ij)
-      nlei = ilei(ii,ij)
-      nldj = ildj(ii,ij)
-      nlej = ilej(ii,ij)
-      nbondi = ibondi(ii,ij)
-      nbondj = ibondj(ii,ij)
-      nimpp = iimppt(ii,ij)  
-      njmpp = ijmppt(ii,ij)  
-      DO jproc = 1, jpnij
-         ii = iin(jproc)
-         ij = ijn(jproc)
-         nimppt(jproc) = iimppt(ii,ij)  
-         njmppt(jproc) = ijmppt(ii,ij)  
-         nlcjt(jproc) = ilcj(ii,ij)
-         nlcit(jproc) = ilci(ii,ij)
-         nldit(jproc) = ildi(ii,ij)
-         nleit(jproc) = ilei(ii,ij)
-         nldjt(jproc) = ildj(ii,ij)
-         nlejt(jproc) = ilej(ii,ij)
-      END DO
-
-      ! Save processor layout in ascii file
-      IF (lwp) THEN
-         CALL ctlopn( inum, 'layout.dat', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL',   &
-            &         1, numout, .FALSE., 1 )
-         WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo
-         WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp'
-
-        DO  jproc = 1, jpnij
-         WRITE(inum,'(9i5)') jproc, nlcit(jproc), nlcjt(jproc), &
-                                      nldit(jproc), nldjt(jproc), &
-                                      nleit(jproc), nlejt(jproc), &
-                                      nimppt(jproc), njmppt(jproc)
-        END DO
-        CLOSE(inum)   
-      END IF
-
-
-      ! FETI method
-
-      IF( nperio == 1 .AND. nsolv == 3 ) THEN 
-
-         ! general CASE : Earth == infinite tube
-
-         nbnw = 1
-         npnw = narea
-         nbne = 1
-         npne = narea
-         nbsw = 1
-         npsw = (narea-2)
-         nbse = 1
-         npse = (narea-2)
-
-         ! REAL boundary condition
-
-         IF( nbondj == -1 .OR. nbondj == 2 ) THEN 
-            nbsw = 0
-            nbse = 0
-         ENDIF
-
-         IF( nbondj == -1 .OR. nbondj == 2 ) THEN 
-            nbsw = 0
-            nbse = 0
-         ENDIF
-
-         IF( nbondj ==  1 .OR. nbondj == 2 ) THEN 
-            nbnw = 0
-            nbne = 0
-         ENDIF
-      ENDIF
-
-      IF( nperio == 1 .AND.jpni /= 1 ) CALL ctl_stop( ' mpp_init2:  error on cyclicity' )
-
-      ! Prepare mpp north fold
-
-      IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
-         CALL mpp_ini_north
-         IF(lwp) WRITE(numout,*) ' mpp_init2 : North fold boundary prepared for jpni >1'
-      ENDIF
-
-      ! Defined npolj, either 0, 3 , 4 , 5 , 6
-      ! In this case the important thing is that npolj /= 0
-      ! Because if we go through these line it is because jpni >1 and thus
-      ! we must use lbcnorthmpp, which tests only npolj =0 or npolj /= 0
-
-      npolj = 0
-      ij = ijn(narea)
-
-      IF( jperio == 3 .OR. jperio == 4 ) THEN
-         IF( ij == jpnj ) npolj = 3
-      ENDIF
-
-      IF( jperio == 5 .OR. jperio == 6 ) THEN
-         IF( ij == jpnj ) npolj = 5
-      ENDIF
-
-      ! Prepare NetCDF output file (if necessary)
-      CALL mpp_init_ioipsl
-
-      ! Periodicity : no corner if nbondi = 2 and nperio != 1
-
-      IF(lwp) THEN
-         WRITE(numout,*) ' nproc=  ',nproc
-         WRITE(numout,*) ' nowe=   ',nowe
-         WRITE(numout,*) ' noea=   ',noea
-         WRITE(numout,*) ' nono=   ',nono
-         WRITE(numout,*) ' noso=   ',noso
-         WRITE(numout,*) ' nbondi= ',nbondi
-         WRITE(numout,*) ' nbondj= ',nbondj
-         WRITE(numout,*) ' npolj=  ',npolj
-         WRITE(numout,*) ' nperio= ',nperio
-         WRITE(numout,*) ' nlci=   ',nlci
-         WRITE(numout,*) ' nlcj=   ',nlcj
-         WRITE(numout,*) ' nimpp=  ',nimpp
-         WRITE(numout,*) ' njmpp=  ',njmpp
-         WRITE(numout,*) ' nbse=   ',nbse,' npse= ',npse
-         WRITE(numout,*) ' nbsw=   ',nbsw,' npsw= ',npsw
-         WRITE(numout,*) ' nbne=   ',nbne,' npne= ',npne
-         WRITE(numout,*) ' nbnw=   ',nbnw,' npnw= ',npnw
-      ENDIF
-
-   END SUBROUTINE mpp_init2
Index: trunk/NEMOGCM/NEMO/OFF_SRC/oce.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OFF_SRC/oce.F90	(revision 2527)
+++ 	(revision )
@@ -1,42 +1,0 @@
-MODULE oce
-   !!======================================================================
-   !!                      ***  MODULE  oce  ***
-   !! Ocean        :  dynamics and active tracers defined in memory 
-   !!======================================================================
-   !! History :
-   !!   8.5  !  02-11  (G. Madec)  F90: Free form and module
-   !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL  (2005)
-   !!   $Id$
-   !!   This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
-   !!----------------------------------------------------------------------
-   !! * Modules used
-   USE par_oce      ! ocean parameters
-
-   IMPLICIT NONE
-   PRIVATE
-
-   !! dynamics and tracer fields
-   !! --------------------------
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &   !:
-      ! before !  now      !  after  !      ! the after trends becomes the fields
-      ! fields !  fields   !  trends !      ! only in dyn(tra)_zdf and dyn(tra)_nxt
-                  un       ,  ua     ,   &  !: i-horizontal velocity (m/s)
-                  vn       ,  va     ,   &  !: j-horizontal velocity (m/s)
-                  wn       ,             &  !: vertical velocity (m/s)
-                  hdivn    ,             &  !: horizontal divergence (1/s)
-                  tn       ,  ta     ,   &  !: potential temperature (celcius)
-                  sn       ,  sa            !: salinity (psu)
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &   !:
-      rhd ,                              &  !: in situ density anomalie rhd=(rho-rau0)/rau0 (no units)
-      rhop,                              &  !: potential volumic mass (kg/m3)
-      rn2                                   !: brunt-vaisala frequency (1/s2)
-
-   !! interpolated gradient
-   !! ---------------------
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &   !:
-      gtu, gsu, gru,      &  !: t-, s- and rd horizontal gradient at u- and 
-      gtv, gsv, grv          !: v-points at bottom ocean level 
-
-   !!----------------------------------------------------------------------
-END MODULE oce
Index: trunk/NEMOGCM/NEMO/OFF_SRC/opa.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OFF_SRC/opa.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OFF_SRC/opa.F90	(revision 2528)
@@ -1,33 +1,41 @@
 MODULE opa
-   !!==============================================================================
+   !!======================================================================
    !!                       ***  MODULE opa   ***
-   !! Ocean system   : OPA ocean dynamics (including on-line tracers and sea-ice)
-   !!==============================================================================
-
-   !!----------------------------------------------------------------------
-   !!   opa_model      : solve ocean dynamics, tracer and/or sea-ice
-   !!----------------------------------------------------------------------
-   !! * Modules used
+   !! Off-line Ocean   : passive tracer evolution, dynamics read in files
+   !!======================================================================
+   !! History :  3.3  ! 2010-05  (C. Ethe)  Full reorganization of the off-line: phasing with the on-line
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   opa_model      : off-line: solve ocean tracer only
+   !!   opa_init       : initialization of the opa model
+   !!   opa_ctl        : initialisation of algorithm flag 
+   !!   opa_closefile  : close remaining files
+   !!----------------------------------------------------------------------
    USE dom_oce         ! ocean space domain variables
    USE oce             ! dynamics and tracers variables
-   USE in_out_manager  ! I/O manager
-   USE lib_mpp         ! distributed memory computing
-
+   USE c1d             ! 1D configuration
    USE domcfg          ! domain configuration               (dom_cfg routine)
-   USE mppini          ! shared/distributed memory setting (mpp_init routine)
    USE domain          ! domain initialization             (dom_init routine)
    USE istate          ! initial state setting          (istate_init routine)
    USE eosbn2          ! equation of state            (eos bn2 routine)
-
-   ! ocean physics
-   USE ldftra          ! lateral diffusivity setting    (ldftra_init routine)
-   USE traqsr          ! solar radiation penetration   (tra_qsr_init routine)
-
+   !              ! ocean physics
+   USE ldftra          ! lateral diffusivity setting    (ldf_tra_init routine)
+   USE ldfslp          ! slopes of neutral surfaces     (ldf_slp_init routine)
+   USE traqsr          ! solar radiation penetration    (tra_qsr_init routine)
+   USE trabbl          ! bottom boundary layer          (tra_bbl_init routine)
+   USE zdfini          ! vertical physics: initialization
    USE phycst          ! physical constant                  (par_cst routine)
    USE dtadyn          ! Lecture and Interpolation of the dynamical fields
    USE trcini          ! Initilization of the passive tracers
-   USE step            ! OPA time-stepping                  (stp     routine)
-
-   USE iom
+   USE daymod          ! calendar                         (day     routine)
+   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
+   USE in_out_manager  ! I/O manager
+   USE mppini          ! shared/distributed memory setting (mpp_init routine)
+   USE lib_mpp         ! distributed memory computing
 #if defined key_iomput
    USE  mod_ioclient
@@ -36,18 +44,14 @@
    IMPLICIT NONE
    PRIVATE
-
-   !! * Module variables
-   CHARACTER (len=64) ::        &
-      cform_aaa="( /, 'AAAAAAAA', / ) "     ! flag for output listing
-
-   !! * Routine accessibility
-   PUBLIC opa_model      ! called by model.F90
-   PUBLIC opa_init
-   !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL  (2005)
-   !!   $Id$
-   !!   This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
-   !!----------------------------------------------------------------------
-
+   
+   PUBLIC   opa_model   ! called by model.F90
+
+   CHARACTER (len=64) ::   cform_aaa="( /, 'AAAAAAAA', / ) "   ! flag for output listing
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OFF 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
@@ -60,11 +64,11 @@
       !!
       !! ** Method  : - model general initialization
-      !!              - launch the time-stepping (stp routine)
-      !!
-      !! References :
-      !!      Madec, Delecluse,Imbard, and Levy, 1997: reference manual.
-      !!              internal report, IPSL.
-      !!----------------------------------------------------------------------
-      INTEGER ::   istp       ! time step index
+      !!              - launch the time-stepping (dta_dyn and trc_stp)
+      !!              - finalize the run by closing files and communications
+      !!
+      !! References : Madec, Delecluse,Imbard, and Levy, 1997:  internal report, IPSL.
+      !!              Madec, 2008, internal report, IPSL.
+      !!----------------------------------------------------------------------
+      INTEGER :: istp, indic       ! time step index
       !!----------------------------------------------------------------------
 
@@ -77,16 +81,24 @@
       IF( lk_mpp )   CALL mpp_max( nstop )
 
+      !                            !-----------------------!
+      !                            !==   time stepping   ==!
+      !                            !-----------------------!
       istp = nit000
          !
-      DO WHILE ( istp <= nitend .AND. nstop == 0 )
-         CALL stp( istp )
+      DO WHILE ( istp <= nitend .AND. nstop == 0 )    ! time stepping
+         !
+         IF( istp /= nit000 )   CALL day      ( istp )         ! Calendar (day was already called at nit000 in day_init)
+                                CALL iom_setkt( istp )         ! say to iom that we are at time step kstp
+                                CALL dta_dyn  ( istp )         ! Interpolation of the dynamical fields
+                                CALL trc_stp  ( istp )         ! time-stepping
+                                CALL stp_ctl  ( istp, indic )  ! Time loop: control and print
          istp = istp + 1
          IF( lk_mpp )   CALL mpp_max( nstop )
       END DO
-      !                                     ! ========= !
-      !                                     !  Job end  !
-      !                                     ! ========= !
-
-      IF(lwp) WRITE(numout,cform_aaa)       ! Flag AAAAAAA
+
+      !                            !------------------------!
+      !                            !==  finalize the run  ==!
+      !                            !------------------------!
+      IF(lwp) WRITE(numout,cform_aaa)                 ! Flag AAAAAAA
 
       IF( nstop /= 0 .AND. lwp ) THEN                 ! error print
@@ -94,7 +106,7 @@
          WRITE(numout,*) nstop, ' error have been found'
       ENDIF
-
+      !
       CALL opa_closefile
-
+      !
       IF( lk_mpp )   CALL mppstop                          ! Close all files (mpp)
       !
@@ -106,186 +118,140 @@
       !!                     ***  ROUTINE opa_init ***
       !!
-      !! ** Purpose :   opa solves the primitive equations on an orthogonal 
-      !!      curvilinear mesh on the sphere.
-      !!
-      !! ** Method  : - model general initialization
-      !!
-      !! References :
-      !!      Madec, Delecluse,Imbard, and Levy, 1997: reference manual.
-      !!              internal report, IPSL.
-      !!
-      !! History :
-      !!   4.0  !  90-10  (C. Levy, G. Madec)  Original code
-      !!   7.0  !  91-11  (M. Imbard, C. Levy, G. Madec)
-      !!   7.1  !  93-03  (M. Imbard, C. Levy, G. Madec, O. Marti,
-      !!                   M. Guyon, A. Lazar, P. Delecluse, C. Perigaud,
-      !!                   G. Caniaux, B. Colot, C. Maes ) release 7.1 
-      !!        !  92-06  (L.Terray) coupling implementation
-      !!        !  93-11  (M.A. Filiberti) IGLOO sea-ice 
-      !!   8.0  !  96-03  (M. Imbard, C. Levy, G. Madec, O. Marti,
-      !!                   M. Guyon, A. Lazar, P. Delecluse, L.Terray,
-      !!                   M.A. Filiberti, J. Vialar, A.M. Treguier,
-      !!                   M. Levy)  release 8.0
-      !!   8.1  !  97-06  (M. Imbard, G. Madec)
-      !!   8.2  !  99-11  (M. Imbard, H. Goosse)  LIM sea-ice model 
-      !!        !  99-12  (V. Thierry, A-M. Treguier, M. Imbard, M-A. Foujols)  OPEN-MP 
-      !!        !  00-07  (J-M Molines, M. Imbard)  Open Boundary Conditions  (CLIPPER)
-      !!   9.0  !  02-08  (G. Madec)  F90: Free form and modules
-      !!----------------------------------------------------------------------
-      !! * Local declarations
+      !! ** Purpose :   initialization of the opa model in off-line mode
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji            ! dummy loop indices
+      INTEGER ::   ilocal_comm   ! local integer
+      CHARACTER(len=80), DIMENSION(10) ::   cltxt = ''
+      !!
+      NAMELIST/namctl/ ln_ctl  , nn_print, nn_ictls, nn_ictle,   &
+         &             nn_isplt, nn_jsplt, nn_jctls, nn_jctle, nn_bench
+      !!----------------------------------------------------------------------
+      !
+      !                             ! open Namelist file     
+      CALL ctl_opn( numnam, 'namelist', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+      !
+      READ( numnam, namctl )        ! Namelist namctl : Control prints & Benchmark
+      !
+      !                             !--------------------------------------------!
+      !                             !  set communicator & select the local node  !
+      !                             !--------------------------------------------!
 #if defined key_iomput
-      INTEGER :: localComm
+      CALL init_ioclient( ilocal_comm )       ! nemo local communicator (used or not) given by the io_server
+      narea = mynode( cltxt, ilocal_comm )    ! Nodes selection
+#else
+      narea = mynode( cltxt )                 ! Nodes selection (control print return in cltxt)
 #endif
-      CHARACTER (len=20) ::   namelistname
-      CHARACTER (len=28) ::   file_out
-      NAMELIST/namctl/ ln_ctl, nprint, nictls, nictle,   &
-         &             isplt , jsplt , njctls, njctle, nbench
-
-      !!----------------------------------------------------------------------
-
-      ! Initializations
-      ! ===============
-
-      file_out = 'ocean.output'
-
-      ! open listing and namelist units
-      CALL ctlopn( numout, file_out, 'UNKNOWN', 'FORMATTED',   &
-         &         'SEQUENTIAL', 1, 6, .FALSE., 1 )
-
-      namelistname = 'namelist'
-      CALL ctlopn( numnam, namelistname, 'OLD', 'FORMATTED', 'SEQUENTIAL',   &
-         &         1, numout, .FALSE., 1 )
-
-      WRITE(numout,*)
-      WRITE(numout,*) '                 L O D Y C - I P S L'
-      WRITE(numout,*) '                     O P A model'
-      WRITE(numout,*) '            Ocean General Circulation Model'
-      WRITE(numout,*) '               version OPA 9.0  (2005) '
-      WRITE(numout,*)
-      WRITE(numout,*)
-
-      ! Namelist namctl : Control prints & Benchmark
-      REWIND( numnam )
-      READ  ( numnam, namctl )
-
-#if defined key_iomput
-      CALL init_ioclient(localcomm)
-      narea = mynode(localComm)
-#else
-      ! Nodes selection
-      narea = mynode()
+      narea = narea + 1                       ! mynode return the rank of proc (0 --> jpnij -1 )
+
+      lwp = (narea == 1) .OR. ln_ctl          ! control of all listing output print
+
+      IF(lwp) THEN                            ! open listing units
+         !
+         CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
+         !
+         WRITE(numout,*)
+         WRITE(numout,*) '         CNRS - NERC - Met OFFICE - MERCATOR-ocean'
+         WRITE(numout,*) '                       NEMO team'
+         WRITE(numout,*) '            Ocean General Circulation Model'
+         WRITE(numout,*) '                  version 3.3  (2010) '
+         WRITE(numout,*)
+         WRITE(numout,*)
+         DO ji = 1, SIZE(cltxt) 
+            IF( TRIM(cltxt(ji)) /= '' )   WRITE(numout,*) cltxt(ji)      ! control print of mynode
+         END DO
+         WRITE(numout,cform_aaa)                                         ! Flag AAAAAAA
+         !
+      ENDIF
+      !                             !--------------------------------!
+      !                             !  Model general initialization  !
+      !                             !--------------------------------!
+
+      CALL opa_ctl                           ! Control prints & Benchmark
+
+      !                                      ! Domain decomposition
+      IF( jpni*jpnj == jpnij ) THEN   ;   CALL mpp_init      ! standard cutting out
+      ELSE                            ;   CALL mpp_init2     ! eliminate land processors
+      ENDIF
+      !
+      !                                      ! General initialization
+                            CALL     phy_cst    ! Physical constants
+                            CALL     eos_init   ! Equation of state
+                            CALL     dom_cfg    ! Domain configuration
+                            CALL     dom_init   ! Domain
+                            CALL  istate_init   ! ocean initial state (Dynamics and tracers)
+
+      !                                     ! Ocean physics
+#if ! defined key_degrad
+                            CALL ldf_tra_init   ! Lateral ocean tracer physics
 #endif
-
-      ! Nodes selection
-      narea = narea + 1    ! mynode return the rank of proc (0 --> jpnij -1 )
-      lwp   = narea == 1
-
-      ! open additionnal listing
-      IF( ln_ctl )   THEN
-         IF( narea-1 > 0 )   THEN
-            WRITE(file_out,FMT="('ocean.output_',I4.4)") narea-1
-            CALL ctlopn( numout, file_out, 'UNKNOWN', 'FORMATTED',   &
-               &         'SEQUENTIAL', 1, numout, .FALSE., 1 )
-            lwp = .TRUE.
-            !
-            WRITE(numout,*)
-            WRITE(numout,*) '                 L O D Y C - I P S L'
-            WRITE(numout,*) '                     O P A model'
-            WRITE(numout,*) '            Ocean General Circulation Model'
-            WRITE(numout,*) '               version OPA 9.0  (2005) '
-            WRITE(numout,*) '                   MPI Ocean output '
-            WRITE(numout,*)
-            WRITE(numout,*)
-         ENDIF
-      ENDIF
-
-      CALL opa_flg                          ! Control prints & Benchmark
-
-      !                                     ! ============================== !
-      !                                     !  Model general initialization  !
-      !                                     ! ============================== !
+      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
+
+      !                                     ! Passive tracers
+                            CALL     trc_init   ! Passive tracers initialization
+      !                                     ! Dynamics
+                            CALL dta_dyn_init   ! Initialization for the dynamics
+                            CALL     iom_init       ! iom_put initialization
 
       IF(lwp) WRITE(numout,cform_aaa)       ! Flag AAAAAAA
-
-                                            ! Domain decomposition
-      IF( jpni * jpnj == jpnij ) THEN
-         CALL mpp_init                          ! standard cutting out
-      ELSE
-         CALL mpp_init2                         ! eliminate land processors
-      ENDIF
-      
-      CALL phy_cst                          ! Physical constants
-      CALL eos_init                         ! Equation of state
-      CALL dom_cfg                          ! Domain configuration
-      CALL dom_init                         ! Domain
-      CALL istate_init                      ! ocean initial state (Dynamics and tracers)
-      CALL trc_ini                           ! Passive tracers
-      CALL dta_dyn( nit000 )                 ! Initialization for the dynamics
-      CALL tra_qsr_init                         ! Solar radiation penetration
-#if ! defined key_off_degrad
-      CALL ldf_tra_init                         ! Lateral ocean tracer physics
-#endif 
-      CALL iom_init                         ! iom_put initialization
-
-      IF(lwp) WRITE(numout,cform_aaa)       ! Flag AAAAAAA
-
+      !
    END SUBROUTINE opa_init
 
-   SUBROUTINE opa_flg
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE opa  ***
-      !!
-      !! ** Purpose :   Initialize logical flags that control the choice of
-      !!      some algorithm or control print
-      !!
-      !! ** Method  :    Read in namilist namflg logical flags
-      !!
-      !! History :
-      !!   9.0  !  03-11  (G. Madec)  Original code
-      !!----------------------------------------------------------------------
-      !! * Local declarations
-
-      ! Parameter control and print
-      ! ---------------------------
-      IF(lwp) THEN
+
+   SUBROUTINE opa_ctl
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE opa_ctl  ***
+      !!
+      !! ** Purpose :   control print setting 
+      !!
+      !! ** Method  : - print namctl information and check some consistencies
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) THEN                  ! Parameter print
          WRITE(numout,*)
          WRITE(numout,*) 'opa_flg: Control prints & Benchmark'
          WRITE(numout,*) '~~~~~~~ '
-         WRITE(numout,*) '          Namelist namctl'
-         WRITE(numout,*) '             run control (for debugging)     ln_ctl    = ', ln_ctl
-         WRITE(numout,*) '             level of print                  nprint    = ', nprint
-         WRITE(numout,*) '             Start i indice for SUM control  nictls    = ', nictls
-         WRITE(numout,*) '             End i indice for SUM control    nictle    = ', nictle
-         WRITE(numout,*) '             Start j indice for SUM control  njctls    = ', njctls
-         WRITE(numout,*) '             End j indice for SUM control    njctle    = ', njctle
-         WRITE(numout,*) '             number of proc. following i     isplt     = ', isplt
-         WRITE(numout,*) '             number of proc. following j     jsplt     = ', jsplt
-         WRITE(numout,*) '             benchmark parameter (0/1)       nbench    = ', nbench
-      ENDIF
-
-      ! ... Control the sub-domain area indices for the control prints
-      IF( ln_ctl )   THEN
-         IF( lk_mpp )   THEN
-            ! the domain is forced to the real splitted domain in MPI
-            isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj
+         WRITE(numout,*) '   Namelist namctl'
+         WRITE(numout,*) '      run control (for debugging)     ln_ctl     = ', ln_ctl
+         WRITE(numout,*) '      level of print                  nn_print   = ', nn_print
+         WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls
+         WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle
+         WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls
+         WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle
+         WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt
+         WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt
+         WRITE(numout,*) '      benchmark parameter (0/1)       nn_bench   = ', nn_bench
+      ENDIF
+      !
+      nprint    = nn_print          ! convert DOCTOR namelist names into OLD names
+      nictls    = nn_ictls
+      nictle    = nn_ictle
+      njctls    = nn_jctls
+      njctle    = nn_jctle
+      isplt     = nn_isplt
+      jsplt     = nn_jsplt
+      nbench    = nn_bench
+      !                             ! Parameter control
+      !
+      IF( ln_ctl ) THEN                 ! sub-domain area indices for the control prints
+         IF( lk_mpp ) THEN
+            isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real splitted domain
          ELSE
             IF( isplt == 1 .AND. jsplt == 1  ) THEN
-               CALL ctl_warn( '          - isplt & jsplt are equal to 1',   &
-                    &         '          - the print control will be done over the whole domain' )
-            ENDIF
-
-            ! compute the total number of processors ijsplt
-            ijsplt = isplt*jsplt
+               CALL ctl_warn( ' - isplt & jsplt are equal to 1',   &
+                  &           ' - the print control will be done over the whole domain' )
+            ENDIF
+            ijsplt = isplt * jsplt            ! total number of processors ijsplt
          ENDIF
-
          IF(lwp) WRITE(numout,*)'          - The total number of processors over which the'
          IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt
-
-         ! Control the indices used for the SUM control
-         IF( nictls+nictle+njctls+njctle == 0 )   THEN
-            ! the print control is done over the default area
+         !
+         !                              ! indices used for the SUM control
+         IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area
             lsp_area = .FALSE.
-         ELSE
-            ! the print control is done over a specific  area
+         ELSE                                             ! print control done over a specific  area
             lsp_area = .TRUE.
             IF( nictls < 1 .OR. nictls > jpiglo )   THEN
@@ -293,34 +259,33 @@
                nictls = 1
             ENDIF
-
             IF( nictle < 1 .OR. nictle > jpiglo )   THEN
                CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )
                nictle = jpiglo
             ENDIF
-
             IF( njctls < 1 .OR. njctls > jpjglo )   THEN
                CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )
                njctls = 1
             ENDIF
-
             IF( njctle < 1 .OR. njctle > jpjglo )   THEN
                CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )
                njctle = jpjglo
             ENDIF
-
-         ENDIF          ! IF( nictls+nictle+njctls+njctle == 0 )
-       ENDIF            ! IF(ln_ctl)
-
-      IF( nbench == 1 )   THEN
+         ENDIF
+      ENDIF
+      !
+      IF( nbench == 1 )   THEN            ! Benchmark 
          SELECT CASE ( cp_cfg )
-         CASE ( 'gyre' )
-            CALL ctl_warn( '          The Benchmark is activated ' )
-         CASE DEFAULT
-            CALL ctl_stop( '          The Benchmark is based on the GYRE configuration: key_gyre must &
-               &                      be used or set nbench = 0' )
+         CASE ( 'gyre' )   ;   CALL ctl_warn( ' The Benchmark is activated ' )
+         CASE DEFAULT      ;   CALL ctl_stop( ' The Benchmark is based on the GYRE configuration:',   &
+            &                                 ' key_gyre must be used or set nbench = 0' )
          END SELECT
       ENDIF
-
-   END SUBROUTINE opa_flg
+      !
+      IF( lk_c1d .AND. .NOT.lk_iomput )   CALL ctl_stop( 'opa_ctl: The 1D configuration must be used ',   &
+         &                                               'with the IOM Input/Output manager. '        ,   &
+         &                                               'Compile with key_iomput enabled' )
+      !
+   END SUBROUTINE opa_ctl
+
 
    SUBROUTINE opa_closefile
@@ -329,24 +294,15 @@
       !!
       !! ** Purpose :   Close the files
-      !!
-      !! ** Method  :
-      !!
-      !! History :
-      !!   9.0  !  05-01  (O. Le Galloudec)  Original code
-      !!----------------------------------------------------------------------
-      !!----------------------------------------------------------------------
-
+      !!----------------------------------------------------------------------
+      !
       IF ( lk_mpp ) CALL mppsync
-
-      ! 1. Unit close
-      ! -------------
-
-      CLOSE( numnam )           ! namelist
-      CLOSE( numout )           ! standard model output file
-
-      IF(lwp) CLOSE( numstp )   ! time-step file
-
-      CALL iom_close            ! close all input/output files
-
+      !
+      CALL iom_close                                 ! close all input/output files managed by iom_*
+      !
+      IF( numstp     /= -1 )   CLOSE( numstp     )   ! time-step file
+      IF( numnam     /= -1 )   CLOSE( numnam     )   ! oce namelist
+      IF( numout     /=  6 )   CLOSE( numout     )   ! standard model output file
+      numout = 6                                     ! redefine numout in case it is used after this point...
+      !
    END SUBROUTINE opa_closefile
 
Index: trunk/NEMOGCM/NEMO/OFF_SRC/par_EEL_R2.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OFF_SRC/par_EEL_R2.h90	(revision 2527)
+++ 	(revision )
@@ -1,87 +1,0 @@
-   !!---------------------------------------------------------------------
-   !!                     ***  par_EEL_R2.h90  ***
-   !!   Ocean Domain : 2 km resolution Channel (EEL_R2 configuration)
-   !!---------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-   CHARACTER (len=16), PARAMETER ::   &  !:
-      cp_cfg = "eel"            !: name of the configuration
-   INTEGER, PARAMETER ::     &  !:
-      jp_cfg = 2   ,         &  !: resolution of the configuration (km)
-
-      ! data size              !!! * size of all the input files *
-      jpidta  = 83,          &  !: 1st horizontal dimension ( >= jpi )
-      jpjdta  = 242,         &  !: 2nd    "            "    ( >= jpj )
-      jpkdta  = 30,          &  !: number of levels         ( >= jpk )
-
-      ! global domain size     !!! * full domain *
-      jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i
-      jpjglo  = jpjdta,      &  !: 2nd    "                  "    --> j
-      jpk     = jpkdta,      &  !: number of vertical levels
-      ! zoom starting position
-      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
-      jpjzoom =   1   ,      &  !: in data indices
-
-      ! Domain characteristics
-      jperio  =     1 ,      &  !: lateral cond. type (between 0 and 6)
-      jpisl   =     1 ,      &  !: number of islands
-      jpnisl  = jpiglo          !: maximum number of points per island
-
-   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
-   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
-   REAL(wp), PARAMETER ::   &  !:
-      pp_not_used       = 999999._wp  , & !: ???
-      pp_to_be_computed =      0._wp      !: ???
-   !!
-   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
-   !!
-   INTEGER,PARAMETER   ::    & !:
-      jphgr_msh = 3            !: type of horizontal mesh
-      !                        ! = 0 curvilinear coordinate on the sphere
-      !                        !     read in coordinate.nc file
-      !                        ! = 1 geographical mesh on the sphere
-      !                        !     with regular grid-spacing
-      !                        ! = 2 f-plane with regular grid-spacing
-      !                        ! = 3 beta-plane with regular grid-spacing
-      !                        ! = 4 Mercator grid with T/U point at the equator  with
-      !                        !     isotropic resolution (e1_deg)
-
-      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
-      !   The mercator grid starts only approximately at gphi0 because
-      !   of the constraint that the equator be a T point.
-   REAL(wp) ,PARAMETER ::     &  !:
-      ppglam0  =    0.0_wp,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
-      ppgphi0  =   35.0_wp,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
-      !                          ! latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
-      ppe1_deg = pp_not_used ,   &  !: zonal      grid-spacing (degrees)
-      ppe2_deg = pp_not_used ,   &  !: meridional grid-spacing (degrees)
-      !
-      ppe1_m   = 2000.0_wp,   &  !: zonal      grid-spacing (meters )
-      ppe2_m   = 2000.0_wp       !: meridional grid-spacing (meters )
-   !!
-   !!  Coefficients associated with the vertical coordinate system
-   !!
-
-   REAL(wp), PARAMETER  ::       &  !:
-      &     ppsur = -2033.194295283385_wp   ,  &  !: Computed in domzgr
-      &     ppa0  =  155.8325369664153_wp   ,  &  !:
-      &     ppa1  =  146.3615918601890_wp   ,  &  !:
-      !
-      &     ppkth =  17.28520372419791_wp   ,  &  !: (non dimensional): gives the approximate
-      !                                           !: layer number above which  stretching will
-      !                                           !: be maximum. Usually of order jpk/2.
-      &     ppacr =  5.000000000000000_wp         !: (non dimensional): stretching factor
-      !                                           !: for the grid. The highest zacr, the smallest
-      !                                           !: the stretching.
-
-   !!
-   !!  If both ppa0 ppa1 and ppsur are specified to 0, then
-   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
-   !!
-   REAL(wp), PARAMETER ::        &
-      &     ppdzmin = pp_not_used           ,  &  !: (meters) vertical thickness of the top layer
-      &     pphmax  = pp_not_used                 !: (meters) Maximum depth of the ocean gdepw(jpk)
-   !!---------------------------------------------------------------------
Index: trunk/NEMOGCM/NEMO/OFF_SRC/par_EEL_R5.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OFF_SRC/par_EEL_R5.h90	(revision 2527)
+++ 	(revision )
@@ -1,86 +1,0 @@
-   !!---------------------------------------------------------------------
-   !!                     ***  par_EEL_R5.h90  ***   
-   !!   Ocean Domain : 5 km resolution Channel (EEL_R5 configuration)
-   !!---------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-   CHARACTER (len=16), PARAMETER ::   &  !:
-      cp_cfg = "eel"            !: name of the configuration
-   INTEGER, PARAMETER ::     &  !:
-      jp_cfg = 5      ,      &  !: resolution of the configuration (km)
-
-      ! data size              !!! * size of all the input files
-      jpidta  = 202   ,      &  !: first horizontal dimension > or = to jpi
-      jpjdta  = 104   ,      &  !: second                     > or = to jpj
-      jpkdta  =  40   ,      &  !: number of levels           > or = to jpk
-
-      ! total domain size      !!! * full domain *
-      jpiglo  = jpidta,      &  !: first  dimension of global domain --> i
-      jpjglo  = jpjdta,      &  !: second dimension of global domain --> j
-      jpk     = jpkdta,      &  !: number of vertical levels
-      ! zoom starting position
-      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
-      jpjzoom =   1   ,      &  !: in data indices
-
-      ! Domain characteristics
-      jperio  =   0   ,      &  !: lateral cond. type (between 0 and 6)
-      jpisl   =   1   ,      &  !: number of islands
-      jpnisl  = jpiglo          !: maximum number of points per island
-
-   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
-   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
-   REAL(wp), PARAMETER ::   &  !:
-      pp_not_used       = 999999._wp ,  &  !:
-      pp_to_be_computed =      0._wp       !:
-
-   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
-
-   INTEGER,PARAMETER   ::    & !:
-      jphgr_msh = 2            !: type of horizontal mesh
-      !                        ! = 0 curvilinear coordinate on the sphere
-      !                        !     read in coordinate.nc file
-      !                        ! = 1 geographical mesh on the sphere
-      !                        !     with regular grid-spacing
-      !                        ! = 2 f-plane with regular grid-spacing
-      !                        ! = 3 beta-plane with regular grid-spacing
-      !                        ! = 4 Mercator grid with T/U point at the equator  with
-      !                        !     isotropic resolution (e1_deg)
-
-      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
-      !   The mercator grid starts only approximately at gphi0 because
-      !   of the constraint that the equator be a T point.
-   REAL(wp) ,PARAMETER ::     &  !:
-      ppglam0  =    0.0_wp,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
-      ppgphi0  =   35.0_wp,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
-      !                          ! latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
-      ppe1_deg = pp_not_used,   &  !: zonal      grid-spacing (degrees)
-      ppe2_deg = pp_not_used,   &  !: meridional grid-spacing (degrees)
-      !
-      ppe1_m   = 5000.0_wp,   &  !: zonal      grid-spacing (meters)
-      ppe2_m   = 5000.0_wp       !: meridional grid-spacing (meters)
-   !!
-   !!  Coefficients associated with the vertical coordinate system
-   !!
-   REAL(wp), PARAMETER  ::       &   !:
-      &     ppsur = pp_to_be_computed       ,  &  !: Computed in domzgr, set ppdzmin, pphmax below
-      &     ppa0  = pp_to_be_computed       ,  &  !:
-      &     ppa1  = pp_to_be_computed       ,  &  !:
-      !
-      &     ppkth = 20._wp                  ,  &  !: (non dimensional): gives the approximate
-      !                                           !: layer number above which  stretching will
-      !                                           !: be maximum. Usually of order jpk/2.
-      &     ppacr = 16.00000000000_wp             !: (non dimensional): stretching factor
-      !                                           !: for the grid. The highest zacr, the smallest
-      !                                           !: the stretching.
-
-   !!
-   !!  If both ppa0 ppa1 and ppsur are specified to 0, then
-   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
-   !!
-   REAL(wp), PARAMETER ::        &  !:
-      &     ppdzmin = 120._wp               ,  &  !: (meters) vertical thickness of the top layer
-      &     pphmax  = 4000._wp                    !: (meters) Maximum depth of the ocean gdepw(jpk)
-   !!---------------------------------------------------------------------
Index: trunk/NEMOGCM/NEMO/OFF_SRC/par_EEL_R6.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OFF_SRC/par_EEL_R6.h90	(revision 2527)
+++ 	(revision )
@@ -1,86 +1,0 @@
-   !!---------------------------------------------------------------------
-   !!                     ***  par_EEL_R6.h90  ***   
-   !!   Ocean Domain : 6 km resolution Channel (EEL_R6 configuration)
-   !!---------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-   CHARACTER (len=16), PARAMETER ::   &  !:
-      cp_cfg = "eel"            !: name of the configuration
-   INTEGER, PARAMETER ::     &  !:
-      jp_cfg = 6      ,      &  !: resolution of the configuration (km)
-
-      ! data size              !!! * size of all the input files *
-      jpidta  = 29,          &  !: 1st lateral dimension ( >= jpi )
-      jpjdta  = 83,          &  !: 2nd    "         "    ( >= jpj )
-      jpkdta  = 30,          &  !: number of levels      ( >= jpk )
-
-      ! global domain size     !!! * full domain *
-      jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i
-      jpjglo  = jpjdta,      &  !: 2nd    "                  "    --> j
-      jpk     = jpkdta,      &  !: number of vertical levels
-      ! starting position of the zoom
-      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
-      jpjzoom =   1   ,      &  !: in data domain indices
-
-      ! Domain characteristics
-      jperio  =      1,      &  !: lateral cond. type (between 0 and 6)
-      jpisl   =      1,      &  !: number of islands
-      jpnisl  = jpiglo          !: maximum number of points per island
-
-   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
-   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
-   REAL(wp), PARAMETER ::   &  !:
-      pp_not_used       = 999999._wp ,  &  !: ???
-      pp_to_be_computed =      0._wp       !: ???
-
-   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
-
-   INTEGER,PARAMETER   ::    & !:
-      jphgr_msh = 3            !: type of horizontal mesh
-      !                        ! = 0 curvilinear coordinate on the sphere
-      !                        !     read in coordinate.nc file
-      !                        ! = 1 geographical mesh on the sphere
-      !                        !     with regular grid-spacing
-      !                        ! = 2 f-plane with regular grid-spacing
-      !                        ! = 3 beta-plane with regular grid-spacing
-      !                        ! = 4 Mercator grid with T/U point at the equator  with
-      !                        !     isotropic resolution (e1_deg)
-
-      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
-      !   The mercator grid starts only approximately at gphi0 because
-      !   of the constraint that the equator be a T point.
-   REAL(wp) ,PARAMETER ::     &  !:
-      ppglam0  =    0.0_wp,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
-      ppgphi0  =   35.0_wp,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
-      !                          !  latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
-      ppe1_deg = pp_not_used,   &  !: zonal      grid-spacing (degrees)
-      ppe2_deg = pp_not_used,   &  !: meridional grid-spacing (degrees)
-      !
-      ppe1_m   = 6000.0_wp,   &  !: zonal      grid-spacing (meters )
-      ppe2_m   = 6000.0_wp       !: meridional grid-spacing (meters )
-
-   !!  Coefficients associated with the vertical coordinate system
-
-   REAL(wp), PARAMETER  ::       &  !:
-      &     ppsur = -2033.194295283385_wp   ,  &  !: Computed in domzgr
-      &     ppa0  =  155.8325369664153_wp   ,  &  !:
-      &     ppa1  =  146.3615918601890_wp   ,  &  !:
-      !
-      &     ppkth =  17.28520372419791_wp   ,  &  !: (non dimensional): gives the approximate
-      !                                           !: layer number above which  stretching will
-      !                                           !: be maximum. Usually of order jpk/2.
-      &     ppacr =  5.000000000000000_wp         !: (non dimensional): stretching factor
-      !                                           !: for the grid. The highest zacr, the smallest
-      !                                           !: the stretching.
-
-
-   !!  If both ppa0 ppa1 and ppsur are specified to 0, then
-   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
-   !!
-   REAL(wp), PARAMETER ::        &  !:
-      &     ppdzmin = pp_not_used           ,  &  !: (meters) vertical thickness of the top layer
-      &     pphmax  = pp_not_used                 !: (meters) Maximum depth of the ocean gdepw(jpk)
-   !!---------------------------------------------------------------------
Index: trunk/NEMOGCM/NEMO/OFF_SRC/par_GYRE.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OFF_SRC/par_GYRE.h90	(revision 2527)
+++ 	(revision )
@@ -1,91 +1,0 @@
-   !!---------------------------------------------------------------------
-   !!                     ***  par_GYRE.h90  ***
-   !!   Ocean Domain : GYRE configuration at 1/jp_cfg degree resolution 
-   !!---------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-   CHARACTER (len=16), PARAMETER ::   &  !:
-      cp_cfg = "gyre"           !: name of the configuration
-   INTEGER, PARAMETER ::     &  !:
-      jp_cfg =  1   ,        &  !: 
-
-      ! data size              !!! * size of all the input files *
-      jpidta  = 30*jp_cfg+2, &  !: 1st horizontal dimension ( >= jpi )
-      jpjdta  = 20*jp_cfg+2, &  !: 2nd    "            "    ( >= jpj )
-      jpkdta  = 101,         &  !: number of levels         ( >= jpk )
-
-      ! global domain size     !!! * full domain *
-      jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i
-      jpjglo  = jpjdta,      &  !: 2nd    "                  "    --> j
-      jpk     = jpkdta,      &  !: number of vertical levels
-      ! zoom starting position
-      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
-      jpjzoom =   1   ,      &  !: in data indices
-
-      ! Domain characteristics
-      jperio  =     0 ,      &  !: lateral cond. type (between 0 and 6)
-      jpisl   =     1 ,      &  !: number of islands
-      jpnisl  = jpiglo          !: maximum number of points per island
-
-   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
-   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
-   REAL(wp), PARAMETER ::   &  !:
-      pp_not_used       = 999999._wp  , & !: ???
-      pp_to_be_computed =      0._wp      !: ???
-   !!
-   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
-   !!
-   INTEGER,PARAMETER   ::    & !:
-      jphgr_msh = 5            !: type of horizontal mesh
-      !                        ! = 0 curvilinear coordinate on the sphere
-      !                        !     read in coordinate.nc file
-      !                        ! = 1 geographical mesh on the sphere
-      !                        !     with regular grid-spacing
-      !                        ! = 2 f-plane with regular grid-spacing
-      !                        ! = 3 beta-plane with regular grid-spacing
-      !                        ! = 4 Mercator grid with T/U point at the equator  with
-      !                        !     isotropic resolution (e1_deg)
-      !                        ! =5  beta-plane with regular grid-spacing and rotated domain (GYRE configuration)
-
-      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
-      !   The mercator grid starts only approximately at gphi0 because
-      !   of the constraint that the equator be a T point.
-   REAL(wp) ,PARAMETER ::     &  !:
-      ppglam0  =    0.0_wp,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
-      ppgphi0  =   29.0_wp,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
-      !                          ! latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
-      ppe1_deg = pp_not_used ,   &  !: zonal      grid-spacing (degrees)
-      ppe2_deg = pp_not_used ,   &  !: meridional grid-spacing (degrees)
-      !
-      ppe1_m   = pp_not_used,    &  !: zonal      grid-spacing (meters )
-      ppe2_m   = pp_not_used        !: meridional grid-spacing (meters )
-   !!
-   !!  Coefficients associated with the vertical coordinate system
-   !!
-
-   REAL(wp), PARAMETER  ::       &  !:
-      &     ppsur = 0.e0      ,  &  !: Computed in domzgr
-      &     ppa0  = 0.e0      ,  &  !:
-      &     ppa1  = 0.e0      ,  &  !:
-      !
-      &     ppkth =  17.28520372419791_wp   ,  &  !: (non dimensional): gives the approximate
-      !                                           !    layer number above which  stretching will
-      !                                           !    be maximum. Usually of order jpk/2.
-      &     ppacr =  5.000000000000000_wp         !: (non dimensional): stretching factor
-      !                                           !    for the grid. The highest zacr, the smallest
-      !                                           !    the stretching.
-
-   !!
-   !!  If all ppa0 ppa1 and ppsur are specified to 0, then
-   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
-   !!
-   REAL(wp), PARAMETER ::        &  !:
-      &     ppdzmin = 1.0e0   ,  &  !: (meters): depth of the top (first) model layer
-      !                             !            depth of second "w" level
-      &     pphmax  = 5000.         !: (meters): maximum depth of the ocean
-      !                             !            depth of the last "w" level
-
-   !!---------------------------------------------------------------------
Index: trunk/NEMOGCM/NEMO/OFF_SRC/par_ORCA_R025.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OFF_SRC/par_ORCA_R025.h90	(revision 2527)
+++ 	(revision )
@@ -1,83 +1,0 @@
-   !!---------------------------------------------------------------------
-   !!                     ***  par_ORCA_R025.h90  ***  
-   !!   Ocean Domain : 0.25 degrees resolution global ocean
-   !!                  (0RCA_R025 configuration)
-   !!---------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-   CHARACTER (len=16), PARAMETER ::   &
-      cp_cfg = "orca"           !: name of the configuration
-   INTEGER, PARAMETER ::     &
-      jp_cfg = 025  ,        &  !: resolution of the configuration (degrees)
-      ! Original data size
-      jpidta  = 1442,        &  !: first horizontal dimension > or = to jpi
-      jpjdta  = 1021,        &  !: second                     > or = to jpj
-      jpkdta  = 46 ,         &  !: number of levels           > or = to jpk
-      ! total domain matrix size
-      jpiglo  = jpidta,      &  !: first  dimension of global domain --> i
-      jpjglo  = jpjdta,      &  !: second dimension of global domain --> j
-      jpk     = jpkdta,      &  !: number of vertical levels
-      ! starting position of the zoom
-      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
-      jpjzoom =   1   ,      &  !: in data indices
-      ! Domain characteristics
-      jperio  =    4  ,      &  !: lateral cond. type (between 0 and 6)
-      jpisl   =  150  ,      &  !: number of islands
-      jpnisl  = 3000            !: maximum number of points per island
-
-   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
-   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
-   REAL,PARAMETER      ::  pp_not_used = 999999_wp , &
-      &                    pp_to_be_computed = 0._wp
-   !!
-   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
-   !!
-   INTEGER, PARAMETER ::     & !
-      jphgr_msh = 0            !: type of horizontal mesh
-      !                        !  = 0 curvilinear coordinate on the sphere
-      !                        !      read in coordinate.nc file
-      !                        !  = 1 geographical mesh on the sphere
-      !                        !      with regular grid-spacing
-      !                        !  = 2 f-plane with regular grid-spacing
-      !                        !  = 3 beta-plane with regular grid-spacing
-      !                        !  = 4 Mercator grid with T/U point at the equator  with
-      !                        !      isotropic resolution (e1_deg)
-
-      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
-      !   The mercator grid starts only approximately at gphi0 because
-      !   of the constraint that the equator be a T point.
-   REAL(wp), PARAMETER ::       &  !
-      ppglam0  = pp_not_used,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
-      ppgphi0  = pp_not_used,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
-      !                            !  latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
-      ppe1_deg = pp_not_used,   &  !: zonal      grid-spacing (degrees)
-      ppe2_deg = pp_not_used,   &  !: meridional grid-spacing (degrees)
-      !
-      ppe1_m   = pp_not_used,   &  !: zonal      grid-spacing (meters )
-      ppe2_m   = pp_not_used       !: meridional grid-spacing (meters )
-
-   !!  Coefficients associated with the vertical coordinate system
-
-   REAL(wp), PARAMETER  ::       &
-      &     ppsur = pp_to_be_computed ,  &  !: Computed in domzgr, set ppdzmin and pphmax below
-      &     ppa0  = pp_to_be_computed ,  &  !:    "           "
-      &     ppa1  = pp_to_be_computed ,  &  !:    "           "
-      !
-      &     ppkth =  23.563_wp        ,  &  !: (non dimensional): gives the approximate
-      !                                     !: layer number above which  stretching will
-      !                                     !: be maximum. Usually of order jpk/2.
-      &     ppacr =    9.00000000000_wp     !: (non dimensional): stretching factor
-      !                                     !: for the grid. The highest zacr, the smallest
-      !                                     !: the stretching.
-
-   !!
-   !!  If both ppa0 ppa1 and ppsur are specified to 0, then
-   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
-   !!
-   REAL(wp), PARAMETER ::        &
-      &     ppdzmin = 6._wp           ,  &  !: (meters) vertical thickness of the top layer
-      &     pphmax  = 5750._wp              !: (meters) Maximum depth of the ocean gdepw(jpk)
-   !!---------------------------------------------------------------------
Index: trunk/NEMOGCM/NEMO/OFF_SRC/par_ORCA_R05.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OFF_SRC/par_ORCA_R05.h90	(revision 2527)
+++ 	(revision )
@@ -1,115 +1,0 @@
-   !!---------------------------------------------------------------------
-   !!                     ***  par_ORCA_R05.h90  ***  
-   !!   Ocean Domain : 0.5 degrees resolution global ocean
-   !!                  (0RCA_R05 configuration)
-   !!---------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-   CHARACTER (len=16), PARAMETER ::   &
-      cp_cfg = "orca"           !: name of the configuration
-   INTEGER, PARAMETER ::     &
-      jp_cfg = 05  ,         &  !: resolution of the configuration (degrees)
-
-      ! data size              !!! * size of all the input files *
-      jpidta  = 722,         &  !: 1st lateral dimension > or = to jpiglo
-      jpjdta  = 511,         &  !: 2nd   "         "     > or = to jpjglo
-      jpkdta  =  31,         &  !: number of levels      > or = to jpkglo
-
-#if defined key_antarctic
-      ! zoom domain size       !!! * antarctic zoom *
-      jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i
-      jpjglo  = 187   ,      &  !: 2nd     "                 "    --> j 
-      jpk     = jpkdta,      &  !: number of vertical levels
-      ! starting position of the zoom
-      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
-      jpjzoom =   1   ,      &  !: in data domain indices
-      ! Domain characteristics
-      jperio  =   1   ,      &  !: lateral cond. type (between 0 and 6)
-      jpisl   =   1   ,      &  !: number of islands
-      jpnisl  =   1             !: maximum number of points per island
-
-#elif defined key_arctic
-      ! zoom domain size       !!! *  arctic zoom  *
-      jpiglo  = 562,         &  !: 1st dimension of global domain --> i
-      jpjglo  = jpjdta-301+1,&  !: 2nd     "                 "    --> j
-      jpk     = jpkdta,      &  !: number of vertical levels
-      ! zoom starting position
-      jpizoom =  81   ,      &  !: left bottom (i,j) indices of the zoom
-      jpjzoom = 301   ,      &  !: in data domain indices
-      ! Domain characteristics
-      jperio  =   5   ,      &  !: lateral cond. type (between 0 and 6)
-      jpisl   =   1   ,      &  !: number of islands
-      jpnisl  =   1             !: maximum number of points per island
-
-#else
-      ! global domain size     !!! * full domain *
-      jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i
-      jpjglo  = jpjdta,      &  !: 2nd     "                 "    --> j
-      jpk     = jpkdta,      &  !: number of vertical levels
-      ! zoom starting position    
-      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
-      jpjzoom =   1   ,      &  !: in data domain indices
-      ! Domain characteristics
-      jperio  =    6  ,      &  !: lateral cond. type (between 0 and 6)
-      jpisl   =   79  ,      &  !: number of islands
-      jpnisl  = 2000            !: maximum number of points per island
-#endif
-
-   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
-   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
-   REAL(wp), PARAMETER ::   &
-      pp_not_used       = 999999._wp , &  !:
-      pp_to_be_computed = 0._wp          !:
-
-   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
-
-   INTEGER, PARAMETER   ::   & !
-      jphgr_msh = 0            !: type of horizontal mesh
-      !                        !  = 0 curvilinear coordinate on the sphere
-      !                        !      read in coordinate.nc file
-      !                        !  = 1 geographical mesh on the sphere
-      !                        !      with regular grid-spacing
-      !                        !  = 2 f-plane with regular grid-spacing
-      !                        !  = 3 beta-plane with regular grid-spacing
-      !                        !  = 4 Mercator grid with T/U point at the equator  with
-      !                        !      isotropic resolution (e1_deg)
-
-      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
-      !   The mercator grid starts only approximately at gphi0 because
-      !   of the constraint that the equator be a T point.
-   REAL(wp) , PARAMETER ::      &  !
-      ppglam0  = pp_not_used,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
-      ppgphi0  = pp_not_used,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
-      !                            ! latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
-      ppe1_deg = pp_not_used,   &  !: zonal      grid-spacing (degrees)
-      ppe2_deg = pp_not_used,   &  !: meridional grid-spacing (degrees)
-      !
-      ppe1_m   = pp_not_used,   &  !: zonal      grid-spacing (meters )
-      ppe2_m   = pp_not_used       !: meridional grid-spacing (meters )
-
-   !!
-   !! Vertical grid parameter for domzgr
-   !! =====================================
-   !!
-   REAL(wp), PARAMETER  ::       &
-      &     ppsur = -4762.96143546300_wp    ,  &  !: ORCA r4, r2 and r05 coefficients
-      &     ppa0  =   255.58049070440_wp    ,  &  !: (default coefficients)
-      &     ppa1  =   245.58132232490_wp    ,  &  !:
-      &     ppkth =    21.43336197938_wp    ,  &  !: (non dimensional): gives the approximate
-      !                                           !: layer number above which  stretching will
-      !                                           !: be maximum. Usually of order jpk/2.
-      &     ppacr =     3.00000000000_wp          !: (non dimensional): stretching factor
-      !                                           !: for the grid. The highest zacr, the smallest
-      !                                           !: the stretching.
-
-   !!
-   !!  If both ppa0 ppa1 and ppsur are specified to 0, then
-   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
-   !!
-   REAL(wp), PARAMETER ::        &
-      &     ppdzmin = pp_not_used           ,  &  !: (meters) vertical thickness of the top layer
-      &     pphmax  = pp_not_used                 !: (meters) Maximum depth of the ocean gdepw(jpk)
-   !!---------------------------------------------------------------------
Index: trunk/NEMOGCM/NEMO/OFF_SRC/par_ORCA_R2.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OFF_SRC/par_ORCA_R2.h90	(revision 2527)
+++ 	(revision )
@@ -1,139 +1,0 @@
-   !!---------------------------------------------------------------------
-   !!                     ***  par_ORCA_R2.h90  ***  
-   !!   Ocean Domain : 2 degrees resolution global ocean
-   !!                  (0RCA_R2 configuration)
-   !!---------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-   CHARACTER (len=16), PARAMETER ::    &  
-      cp_cfg = "orca"           !: name of the configuration 
-   INTEGER, PARAMETER ::     &
-      jp_cfg = 2,            &  !: resolution of the configuration (degrees)
-
-      ! data size              !!! * size of all input files *
-      jpidta  = 182,         &  !: 1st lateral dimension ( >= jpiglo )
-      jpjdta  = 149,         &  !: 2nd    "       "      ( >= jpjglo )
-      jpkdta  = 31,          &  !: number of levels      ( >= jpk    )
-
-#if defined key_antarctic
-      ! zoom domain size       !!! *  antarctic zoom  * 
-      jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i
-      jpjglo  = 50,          &  !: 2nd    "                  "    --> j
-      jpk     = jpkdta,      &  !: number of vertical levels
-      ! zoom starting position
-      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
-      jpjzoom =   1   ,      &  !: in data domain indices
-      ! Domain characteristics
-      jperio  =   1   ,      &  !: lateral cond. type (between 0 and 6)
-      jpisl   =   3   ,      &  !: number of islands
-      jpnisl  = 400             !: maximum number of points per island
-
-#elif defined key_arctic
-      ! zoom domain size       !!! *  arctic zoom  *
-      jpiglo  = 142   ,      &  !: 1st dimension of global domain --> i
-      jpjglo  = jpjdta-97+1, &  !: 2nd    "                  "    --> j
-      jpk     = jpkdta,      &  !: number of vertical levels
-      ! zoom starting position 
-      jpizoom =  21   ,      &  !: left bottom (i,j) indices of the zoom
-      jpjzoom =  97   ,      &  !: in data domain indices
-      ! Domain characteristics
-      jperio  =   3   ,      &  !: lateral cond. type (between 0 and 6)
-      jpisl   =   7   ,      &  !: number of islands
-      jpnisl  = 400             !: maximum number of points per island
-
-#elif defined key_c1d
-      ! global domain size     !!! *  global domain  *
-      jpiglo  = 3     ,      &  !: 1st dimension of global domain --> i
-      jpjglo  = 3     ,      &  !: 2nd    "                  "    --> j
-      jpk     = jpkdta,      &  !: number of vertical levels
-      ! starting position of the zoom 
-      ! jpizoom =   61   ,    &  !: left bottom (i,j) indices of the zoom
-      ! jpjzoom =   133  ,    &  !: in data domain indices (160W,75N)
-      ! jpizoom =   61   ,    &  !: left bottom (i,j) indices of the zoom
-      ! jpjzoom =   110  ,    &  !: in data domain indices (160W,50N)
-      ! jpizoom =   61   ,    &  !: left bottom (i,j) indices of the zoom
-      ! jpjzoom =   97   ,    &  !: in data domain indices (160W,30N)
-      ! jpizoom =   61   ,    &  !: left bottom (i,j) indices of the zoom
-      ! jpjzoom =   86   ,    &  !: in data domain indices (160W,10N)
-      ! jpizoom =   61   ,    &  !: left bottom (i,j) indices of the zoom
-      ! jpjzoom =   49   ,    &  !: in data domain indices (160W,30S)
-      ! jpizoom =   61   ,    &  !: left bottom (i,j) indices of the zoom
-      ! jpjzoom =   27   ,    &  !: in data domain indices (160W,60S)
-      jpizoom =   61   ,    &  !: left bottom (i,j) indices of the zoom
-      jpjzoom =    7   ,    &  !: in data domain indices (160W,75S)
-      ! Domain characteristics
-      jperio  =   0   ,      &  !: lateral cond. type (between 0 and 6)
-      jpisl   =  18   ,      &  !: number of islands
-      jpnisl  = 800             !: maximum number of points per island
-#else
-      ! global domain size     !!! *  global domain  *
-      jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i
-      jpjglo  = jpjdta,      &  !: 2nd    "                  "    --> j
-      jpk     = jpkdta,      &  !: number of vertical levels
-      ! starting position of the zoom 
-      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
-      jpjzoom =   1   ,      &  !: in data domain indices
-      ! Domain characteristics
-      jperio  =   4   ,      &  !: lateral cond. type (between 0 and 6)
-      jpisl   =  18   ,      &  !: number of islands
-      jpnisl  = 800             !: maximum number of points per island
-#endif
-
-   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
-   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
-   REAL(wp), PARAMETER ::   &
-      pp_not_used       = 999999_wp , &  !:
-      pp_to_be_computed = 0._wp          !:
-
-   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
-
-   INTEGER,PARAMETER   ::    & !
-      jphgr_msh = 0            !: type of horizontal mesh
-      !                        !  = 0 curvilinear coordinate on the sphere
-      !                        !      read in coordinate.nc file
-      !                        !  = 1 geographical mesh on the sphere
-      !                        !      with regular grid-spacing
-      !                        !  = 2 f-plane with regular grid-spacing
-      !                        !  = 3 beta-plane with regular grid-spacing
-      !                        !  = 4 Mercator grid with T/U point at the equator  with
-      !                        !      isotropic resolution (e1_deg)
-
-      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
-      !   The mercator grid starts only approximately at gphi0 because
-      !   of the constraint that the equator be a T point.
-   REAL(wp) ,PARAMETER ::       &  !
-      ppglam0  = pp_not_used,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
-      ppgphi0  = pp_not_used,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
-      !                            !  latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
-      ppe1_deg = pp_not_used,   &  !: zonal      grid-spacing (degrees)
-      ppe2_deg = pp_not_used,   &  !: meridional grid-spacing (degrees)
-      !
-      ppe1_m   = pp_not_used,   &  !: zonal      grid-spacing (meters )
-      ppe2_m   = pp_not_used       !: meridional grid-spacing (meters )
-
-   !!
-   !! Vertical grid parameter for domzgr
-   !! ==================================
-   !!
-   REAL(wp), PARAMETER  ::       &
-      &     ppsur = -4762.96143546300_wp    ,  &  !: ORCA r4, r2 and r05 coefficients
-      &     ppa0  =   255.58049070440_wp    ,  &  !: (default coefficients)
-      &     ppa1  =   245.58132232490_wp    ,  &  !:
-      &     ppkth =    21.43336197938_wp    ,  &  !: (non dimensional): gives the approximate
-      !                                           !: layer number above which  stretching will
-      !                                           !: be maximum. Usually of order jpk/2.
-      &     ppacr =     3.00000000000_wp          !: (non dimensional): stretching factor
-      !                                           !: for the grid. The highest zacr, the smallest
-      !                                           !: the stretching.
-
-   !!
-   !!  If both ppa0 ppa1 and ppsur are specified to 0, then
-   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
-   !!
-   REAL(wp), PARAMETER ::        &
-      &     ppdzmin = pp_not_used           ,  &  !: (meters) vertical thickness of the top layer
-      &     pphmax  = pp_not_used                 !: (meters) Maximum depth of the ocean gdepw(jpk)
-   !!---------------------------------------------------------------------
Index: trunk/NEMOGCM/NEMO/OFF_SRC/par_ORCA_R4.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OFF_SRC/par_ORCA_R4.h90	(revision 2527)
+++ 	(revision )
@@ -1,83 +1,0 @@
-   !!---------------------------------------------------------------------
-   !!                     ***  par_ORCA_R4.h90  ***   
-   !!   Ocean Domain : 4 degrees resolution global ocean
-   !!                  (0RCA_R4 configuration)
-   !!---------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-   CHARACTER (len=16), PARAMETER ::    &
-      cp_cfg = "orca"           !: name of the configuration
-   INTEGER, PARAMETER ::     &
-      jp_cfg = 4      ,      &  !: resolution of the configuration (degrees)
-      ! Original data size
-      jpidta  =  92   ,      &  !: first horizontal dimension > or = to jpi
-      jpjdta  =  76   ,      &  !: second                     > or = to jpj
-      jpkdta  =  31   ,      &  !: number of levels           > or = to jpk
-      ! global domain matrix size
-      jpiglo  = jpidta,      &  !: first  dimension of global domain --> i
-      jpjglo  = jpjdta,      &  !: second dimension of global domain --> j
-      jpk     = jpkdta,      &  !: number of vertical levels
-      ! starting position of the zoom
-      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
-      jpjzoom =   1   ,      &  !: in data indices
-      ! Domain characteristics
-      jperio  =   4   ,      &  !: lateral cond. type (between 0 and 6)
-      jpisl   =  11   ,      &  !: number of islands
-      jpnisl  = 800             !: maximum number of points per island
-
-   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
-   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
-   REAL(wp), PARAMETER ::   &
-      pp_not_used       = 999999_wp , &  !:
-      pp_to_be_computed = 0._wp          !:
-
-   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
-   INTEGER, PARAMETER ::     & !
-      jphgr_msh = 0            !: type of horizontal mesh
-      !                        ! = 0 curvilinear coordinate on the sphere
-      !                        !     read in coordinate.nc file
-      !                        ! = 1 geographical mesh on the sphere
-      !                        !     with regular grid-spacing
-      !                        ! = 2 f-plane with regular grid-spacing
-      !                        ! = 3 beta-plane with regular grid-spacing
-      !                        ! = 4 Mercator grid with T/U point at the equator  with
-      !                        !     isotropic resolution (e1_deg)
-
-      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
-      !   The mercator grid starts only approximately at gphi0 because
-      !   of the constraint that the equator be a T point.
-   REAL(wp) , PARAMETER ::      &  !
-      ppglam0  = pp_not_used,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
-      ppgphi0  = pp_not_used,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
-      !                            ! latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
-      ppe1_deg = pp_not_used,   &  !: zonal      grid-spacing (degrees)
-      ppe2_deg = pp_not_used,   &  !: meridional grid-spacing (degrees)
-      !
-      ppe1_m   = pp_not_used,   &  !: zonal      grid-spacing (meters )
-      ppe2_m   = pp_not_used       !: meridional grid-spacing (meters )
-
-
-   !! Vertical grid parameter for domzgr
-   !! ==================================
-
-   REAL(wp), PARAMETER  ::       &
-      &     ppsur = -4762.96143546300_wp    ,  &  !: ORCA r4, r2 and r05 coefficients
-      &     ppa0  =   255.58049070440_wp    ,  &  !: (default coefficients)
-      &     ppa1  =   245.58132232490_wp    ,  &  !:
-      &     ppkth =    21.43336197938_wp    ,  &  !: (non dimensional): gives the approximate
-      !                                           !: layer number above which  stretching will
-      !                                           !: be maximum. Usually of order jpk/2.
-      &     ppacr =     3.00000000000_wp          !: (non dimensional): stretching factor
-      !                                           !: for the grid. The highest zacr, the smallest
-      !                                           !: the stretching.
-
-   !!  If both ppa0 ppa1 and ppsur are specified to 0, then
-   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
-
-   REAL(wp), PARAMETER ::        &
-      &     ppdzmin = pp_not_used           ,  &  !: (meters) vertical thickness of the top layer
-      &     pphmax  = pp_not_used                 !: (meters) Maximum depth of the ocean gdepw(jpk)
-   !!---------------------------------------------------------------------
Index: trunk/NEMOGCM/NEMO/OFF_SRC/par_kind.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OFF_SRC/par_kind.F90	(revision 2527)
+++ 	(revision )
@@ -1,39 +1,0 @@
-MODULE par_kind
-   !!======================================================================
-   !!                   ***  MODULE par_kind  ***
-   !! Ocean :  define the kind of real for the whole model
-   !!======================================================================
-   !! History :
-   !!   8.5   02/06  (G. Madec)  Original code
-   !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-
-   IMPLICIT NONE
-   PRIVATE
-
-   INTEGER, PUBLIC, PARAMETER ::    &  !:
-      jpbyt   = 8       ,           &  !: real size for mpp communications
-      jpbytda = 4       ,           &  !: real size in input data files 4 or 8
-      jpbi3e  = 4                      !: real size for T3E
-
-   ! Number model from which the SELECTED_*_KIND are requested:
-   !             4 byte REAL       8 byte REAL
-   ! CRAY:           -            precision = 13
-   !                              exponent = 2465
-   ! IEEE:      precision = 6     precision = 15
-   !            exponent = 37     exponent = 307
-
-   INTEGER, PUBLIC, PARAMETER ::        &  !: Floating point section
-      sp = SELECTED_REAL_KIND( 6, 37),  &  !: single precision (real 4)
-      dp = SELECTED_REAL_KIND(12,307),  &  !: double precision (real 8)
-      wp = dp                              !: working precision
-
-   INTEGER, PUBLIC, PARAMETER ::        &  !: Integer section
-      i4 = SELECTED_INT_KIND(9) ,       &  !: single precision (integer 4)
-      i8 = SELECTED_INT_KIND(14)           !: double precision (integer 8)
-
-!!----------------------------------------------------------------------
-END MODULE par_kind
Index: trunk/NEMOGCM/NEMO/OFF_SRC/par_oce.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OFF_SRC/par_oce.F90	(revision 2527)
+++ 	(revision )
@@ -1,199 +1,0 @@
-MODULE par_oce
-   !!======================================================================
-   !!                        ***  par_oce  ***
-   !! Ocean :   set the ocean parameters
-   !!======================================================================
-   !! History :
-   !!   4.0  !  91     (Imbard, Levy, Madec)  Original code
-   !!   9.0  !  04-01  (G. Madec, J.-M. Molines)  Free form and module
-   !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
-   !!----------------------------------------------------------------------
-   !! * Modules used
-   USE par_kind          ! kind parameters
-
-   IMPLICIT NONE
-   PUBLIC
-
-   !!----------------------------------------------------------------------
-   !!   Domain decomposition
-   !!----------------------------------------------------------------------
-   !! * if we dont use massively parallel computer (parameters jpni=jpnj=1)
-   !!      so jpiglo=jpi and jpjglo=jpj
-
-   INTEGER, PUBLIC, PARAMETER ::    &  !:
-      jpni   = 1,                   &  !: number of processors following i 
-      jpnj   = 1,                   &  !: number of processors following j
-      jpnij  = 1,                   &  !: nb of local domain = nb of processors 
-      !                                !  ( <= jpni x jpnj )
-      jpr2di = 0,                   &  !: number of columns for extra outer halo 
-      jpr2dj = 0,                   &  !: number of rows    for extra outer halo 
-      jpreci = 1,                   &  !: number of columns for overlap 
-      jprecj = 1                       !: number of rows    for overlap 
-
-   !! Ocean Domain sizes
-   !! ------------------
-   !!   data           domain   (jpidta,jpjdta)
-   !!   global or zoom domain   (jpiglo,jpjglo)
-   !!   local          domain   ( jpi  , jpj  )
-   
-#if   defined key_orca_r4
-   !!---------------------------------------------------------------------
-   !!   'key_orca_r4'   :                           global ocean : ORCA R4
-   !!---------------------------------------------------------------------
-#             include "par_ORCA_R4.h90"
-#elif defined key_orca_r2
-   !!---------------------------------------------------------------------
-   !!   'key_orca_r2'   :                           global ocean : ORCA R4
-   !!---------------------------------------------------------------------
-#             include "par_ORCA_R2.h90"
-#elif defined key_orca_r05
-   !!---------------------------------------------------------------------
-   !!   'key_orca_r05'  :                          global ocean : ORCA R05
-   !!---------------------------------------------------------------------
-#             include "par_ORCA_R05.h90"
-#elif defined key_orca_r025
-   !!---------------------------------------------------------------------
-   !!   'key_orca_r025' :                         global ocean : ORCA R025
-   !!---------------------------------------------------------------------
-#             include "par_ORCA_R025.h90"
-#elif defined key_eel_r2
-   !!---------------------------------------------------------------------
-   !!   'key_eel_r2'    :                                 channel : EEL R2
-   !!---------------------------------------------------------------------
-#             include "par_EEL_R2.h90"
-#elif defined key_eel_r5
-   !!---------------------------------------------------------------------
-   !!   'key_eel_r5'    :                                 channel : EEL R5
-   !!---------------------------------------------------------------------
-#             include "par_EEL_R5.h90"
-#elif defined key_eel_r6
-   !!---------------------------------------------------------------------
-   !!   'key_eel_r6'    :                                 channel : EEL R6
-   !!---------------------------------------------------------------------
-#             include "par_EEL_R6.h90"
-#elif defined key_gyre
-   !!---------------------------------------------------------------------
-   !!   'key_gyre'      :                        mid-latitude basin : GYRE
-   !!---------------------------------------------------------------------
-#             include "par_GYRE.h90"
-#else
-   !!---------------------------------------------------------------------
-   !!   default option  :                               small closed basin
-   !!---------------------------------------------------------------------
-   CHARACTER(len=16), PUBLIC, PARAMETER ::   &  !:
-      cp_cfg = "default"               !: name of the configuration
-   INTEGER, PARAMETER ::            &  !:
-      jp_cfg = 0  ,                 &  !: resolution of the configuration
-
-      ! data size                     !!! * size of all input files *
-      jpidta  = 10,                 &  !: 1st lateral dimension ( >= jpi )
-      jpjdta  = 12,                 &  !: 2nd    "         "    ( >= jpj )
-      jpkdta  = 31,                 &  !: number of levels      ( >= jpk )
-
-      ! global or zoom domain size    !!! * computational domain *
-      jpiglo  = jpidta,             &  !: 1st dimension of global domain --> i
-      jpjglo  = jpjdta,             &  !: 2nd    "                  "    --> j
-      jpk     = jpkdta,             &  !: number of vertical levels
-      ! zoom starting position 
-      jpizoom =   1   ,             &  !: left bottom (i,j) indices of the zoom
-      jpjzoom =   1   ,             &  !: in data domain indices
-
-      ! Domain characteristics
-      jperio  =  0,                 &  !: lateral cond. type (between 0 and 6)
-         !                             !  = 0 closed
-         !                             !  = 1 cyclic East-West
-         !                             !  = 2 equatorial symmetric
-         !                             !  = 3 North fold T-point pivot
-         !                             !  = 4 cyclic East-West AND North fold T-point pivot
-         !                             !  = 5 North fold F-point pivot
-         !                             !  = 6 cyclic East-West AND North fold F-point pivot
-      jpisl   =  0,                 &  !: number of islands (rigid-lid only)
-      jpnisl  =  0                     !: maximum number of points per island
-
-      !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
-      !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
-      REAL(wp), PARAMETER ::   &  !:
-         pp_not_used       = 999999._wp , &  !:
-         pp_to_be_computed = 999999._wp      !:
-
-
-   !! Horizontal grid parameters for domhgr
-   !! =====================================
-
-   INTEGER, PUBLIC, PARAMETER   ::   &  !:
-      jphgr_msh = 0            !: type of horizontal mesh
-      !                        !  = 0 curvilinear coordinate on the sphere
-      !                        !      read in coordinate.nc file
-      !                        !  = 1 geographical mesh on the sphere
-      !                        !      with regular grid-spacing
-      !                        !  = 2 f-plane with regular grid-spacing
-      !                        !  = 3 beta-plane with regular grid-spacing
-      !                        !  = 4 Mercator grid with T/U point at the equator  with
-      !                        !      isotropic resolution (e1_deg)
-
-   REAL(wp) , PUBLIC, PARAMETER ::   &   !:
-      ppglam0  =    0.0_wp,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
-      ppgphi0  =  -35.0_wp,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
-      !                          !  latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
-      ppe1_deg =    1.0_wp,   &  !: zonal      grid-spacing (degrees)
-      ppe2_deg =    0.5_wp,   &  !: meridional grid-spacing (degrees)
-      ppe1_m   = 5000.0_wp,   &  !: zonal      grid-spacing (degrees)
-      ppe2_m   = 5000.0_wp       !: meridional grid-spacing (degrees)
-
-   !! Vertical grid parameter for domzgr
-   !! ==================================
-
-   REAL(wp), PUBLIC, PARAMETER  ::   &  !:
-      &     ppsur = -4762.96143546300_wp ,  &  !: ORCA r4, r2 and r05 coefficients
-      &     ppa0  =   255.58049070440_wp ,  &  !: (default coefficients)
-      &     ppa1  =   245.58132232490_wp ,  &  !:
-      &     ppkth =    21.43336197938_wp ,  &  !:
-      &     ppacr =     3.00000000000_wp       !:
-
-   !!  If both ppa0 ppa1 and ppsur are specified to 0, then
-   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
-
-   REAL(wp), PUBLIC, PARAMETER ::   &  !:
-      &     ppdzmin = 10._wp             ,  &  !: Minimum vertical spacing
-      &     pphmax  = 5000._wp                 !: Maximum depth
-
-   !!---------------------------------------------------------------------
-#endif
-
-   !!---------------------------------------------------------------------
-   !! Domain Matrix size
-   !!---------------------------------------------------------------------
-   INTEGER, PUBLIC, PARAMETER ::   &  !:
-      jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ,   &  !: first  dimension
-      jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ,   &  !: second dimension
-      jpim1 = jpi-1,                                             &  !: inner domain indices
-      jpjm1 = jpj-1,                                             &  !:   "            "
-      jpkm1 = jpk-1,                                             &  !:   "            "
-      jpij  = jpi*jpj                                               !:  jpi x jpj
-
-   !!---------------------------------------------------------------------
-   !! Optimization/control flags
-   !!---------------------------------------------------------------------
-#if defined key_esopa
-   LOGICAL, PUBLIC, PARAMETER ::   lk_esopa     = .TRUE.   !: flag to activate the all options
-#else
-   LOGICAL, PUBLIC, PARAMETER ::   lk_esopa     = .FALSE.  !: flag to activate the all options
-#endif
-
-#if defined key_vectopt_memory
-   LOGICAL, PUBLIC, PARAMETER ::   lk_vopt_mem  = .TRUE.   !: vector optimization flag
-#else
-   LOGICAL, PUBLIC, PARAMETER ::   lk_vopt_mem  = .FALSE.  !: vector optimization flag
-#endif
-
-#if defined key_vectopt_loop
-   LOGICAL, PUBLIC, PARAMETER ::   lk_vopt_loop = .TRUE.   !: vector optimization flag
-#else
-   LOGICAL, PUBLIC, PARAMETER ::   lk_vopt_loop = .FALSE.  !: vector optimization flag
-#endif
-
-   !!======================================================================
-END MODULE par_oce
Index: trunk/NEMOGCM/NEMO/OFF_SRC/prtctl.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OFF_SRC/prtctl.F90	(revision 2527)
+++ 	(revision )
@@ -1,575 +1,0 @@
-MODULE prtctl
-   !!==============================================================================
-   !!                       ***  MODULE prtctl   ***
-   !! Ocean system   : print all SUM trends for each processor domain
-   !!==============================================================================
-   USE dom_oce          ! ocean space and time domain variables
-   USE in_out_manager   ! I/O manager
-   USE lib_mpp          ! distributed memory computing
-
-   IMPLICIT NONE
-   PRIVATE
-
-   !! * Module declaration
-   INTEGER, DIMENSION(:), ALLOCATABLE :: numid
-   INTEGER, DIMENSION(:), ALLOCATABLE, SAVE ::   &  !:
-      nlditl , nldjtl ,   &  !: first, last indoor index for each i-domain
-      nleitl , nlejtl ,   &  !: first, last indoor index for each j-domain
-      nimpptl, njmpptl,   &  !: i-, j-indexes for each processor
-      nlcitl , nlcjtl ,   &  !: dimensions of every subdomain
-      ibonitl, ibonjtl
-
-   REAL(wp), DIMENSION(:), ALLOCATABLE ::   &  !:
-      t_ctll , s_ctll ,   &  !: previous trend values
-      u_ctll , v_ctll
-
-   INTEGER ::   ktime        !: time step
-
-   !! * Routine accessibility
-   PUBLIC prt_ctl         ! called by all subroutines
-   PUBLIC prt_ctl_info    ! called by all subroutines
-   PUBLIC prt_ctl_init    ! called by opa.F90
-   !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-
-
-CONTAINS
-
-   SUBROUTINE prt_ctl (tab2d_1, tab3d_1, mask1, clinfo1, tab2d_2, tab3d_2, mask2, clinfo2, ovlap, kdim, clinfo3)
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE prt_ctl  ***
-      !!
-      !! ** Purpose : - print sum control of 2D or 3D arrays over the same area 
-      !!                in mono and mpp case. This way can be usefull when
-      !!                debugging a new parametrization in mono or mpp. 
-      !!
-      !! ** Method  : 2 possibilities exist when setting the ln_ctl parameter to
-      !!                .true. in the ocean namelist:
-      !!              - to debug a MPI run .vs. a mono-processor one; 
-      !!                the control print will be done over each sub-domain.
-      !!                The nictl[se] and njctl[se] parameters in the namelist must 
-      !!                be set to zero and [ij]splt to the corresponding splitted
-      !!                domain in MPI along respectively i-, j- directions.
-      !!              - to debug a mono-processor run over the whole domain/a specific area; 
-      !!                in the first case the nictl[se] and njctl[se] parameters must be set
-      !!                to zero else to the indices of the area to be controled. In both cases
-      !!                isplt and jsplt must be set to 1.
-      !!              - All arguments of the above calling sequence are optional so their
-      !!                name must be explicitly typed if used. For instance if the 3D
-      !!                array tn(:,:,:) must be passed through the prt_ctl subroutine, 
-      !!                it must looks like: CALL prt_ctl(tab3d_1=tn).
-      !!
-      !!                    tab2d_1 : first 2D array
-      !!                    tab3d_1 : first 3D array
-      !!                    mask1   : mask (3D) to apply to the tab[23]d_1 array
-      !!                    clinfo1 : information about the tab[23]d_1 array
-      !!                    tab2d_2 : second 2D array
-      !!                    tab3d_2 : second 3D array
-      !!                    mask2   : mask (3D) to apply to the tab[23]d_2 array
-      !!                    clinfo2 : information about the tab[23]d_2 array
-      !!                    ovlap   : overlap value
-      !!                    kdim    : k- direction for 3D arrays 
-      !!                    clinfo3 : additional information 
-      !!
-      !! History :
-      !!   9.0  !  05-07  (C. Talandier) original code
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      REAL(wp), DIMENSION(:,:)  , INTENT(in), OPTIONAL :: tab2d_1
-      REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL :: tab3d_1
-      REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL :: mask1
-      CHARACTER (len=*)         , INTENT(in), OPTIONAL :: clinfo1
-      REAL(wp), DIMENSION(:,:)  , INTENT(in), OPTIONAL :: tab2d_2
-      REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL :: tab3d_2
-      REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL :: mask2
-      CHARACTER (len=*)         , INTENT(in), OPTIONAL :: clinfo2
-      INTEGER                   , INTENT(in), OPTIONAL :: ovlap
-      INTEGER                   , INTENT(in), OPTIONAL :: kdim
-      CHARACTER (len=*)         , INTENT(in), OPTIONAL :: clinfo3
-
-      !! * Local declarations
-      INTEGER :: overlap, jn, sind, eind, kdir,j_id
-      CHARACTER (len=15) :: cl2
-      REAL(wp) :: zsum1, zsum2, zvctl1, zvctl2
-      REAL(wp), DIMENSION(jpi,jpj) :: ztab2d_1, ztab2d_2
-      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask1, zmask2, ztab3d_1, ztab3d_2
-      !!----------------------------------------------------------------------
-
-      ! Arrays, scalars initialization 
-      overlap   = 0
-      kdir      = jpkm1
-      cl2       = ''
-      zsum1     = 0.e0
-      zsum2     = 0.e0
-      zvctl1    = 0.e0
-      zvctl2    = 0.e0
-      ztab2d_1(:,:)   = 0.e0
-      ztab2d_2(:,:)   = 0.e0
-      ztab3d_1(:,:,:) = 0.e0
-      ztab3d_2(:,:,:) = 0.e0
-      zmask1  (:,:,:) = 1.e0
-      zmask2  (:,:,:) = 1.e0
-
-      ! Control of optional arguments
-      IF( PRESENT(clinfo2) )  cl2            = clinfo2
-      IF( PRESENT(ovlap)   )  overlap        = ovlap
-      IF( PRESENT(kdim)    )  kdir           = kdim
-      IF( PRESENT(tab2d_1) )  ztab2d_1(:,:)  = tab2d_1(:,:)
-      IF( PRESENT(tab2d_2) )  ztab2d_2(:,:)  = tab2d_2(:,:)
-      IF( PRESENT(tab3d_1) )  ztab3d_1(:,:,:)= tab3d_1(:,:,:)
-      IF( PRESENT(tab3d_2) )  ztab3d_2(:,:,:)= tab3d_2(:,:,:)
-      IF( PRESENT(mask1)   )  zmask1  (:,:,:)= mask1  (:,:,:)
-      IF( PRESENT(mask2)   )  zmask2  (:,:,:)= mask2  (:,:,:)
-
-      IF( lk_mpp )   THEN
-         ! processor number
-         sind = narea
-         eind = narea
-      ELSE
-         ! processors total number
-         sind = 1
-         eind = ijsplt
-      ENDIF
-
-      ! Loop over each sub-domain, i.e. the total number of processors ijsplt
-      DO jn = sind, eind
-         ! Set logical unit
-         j_id = numid(jn - narea + 1)
-         ! Set indices for the SUM control
-         IF( .NOT. lsp_area ) THEN
-            IF (lk_mpp )   THEN
-               nictls = MAX( 1, nlditl(jn) - overlap )
-               nictle = nleitl(jn) + overlap * MIN( 1, nlcitl(jn) - nleitl(jn)) 
-               njctls = MAX( 1, nldjtl(jn) - overlap )
-               njctle = nlejtl(jn) + overlap * MIN( 1, nlcjtl(jn) - nlejtl(jn))
-               ! Do not take into account the bound of the domain
-               IF( ibonitl(jn) == -1 .OR. ibonitl(jn) == 2 ) nictls = MAX(2, nictls)
-               IF( ibonjtl(jn) == -1 .OR. ibonjtl(jn) == 2 ) njctls = MAX(2, njctls)
-               IF( ibonitl(jn) ==  1 .OR. ibonitl(jn) == 2 ) nictle = MIN(nictle, nleitl(jn) - 1)
-               IF( ibonjtl(jn) ==  1 .OR. ibonjtl(jn) == 2 ) njctle = MIN(njctle, nlejtl(jn) - 1)
-            ELSE
-               nictls = MAX( 1, nimpptl(jn) + nlditl(jn) - 1 - overlap )
-               nictle = nimpptl(jn) + nleitl(jn) - 1 + overlap * MIN( 1, nlcitl(jn) - nleitl(jn) ) 
-               njctls = MAX( 1, njmpptl(jn) + nldjtl(jn) - 1 - overlap )
-               njctle = njmpptl(jn) + nlejtl(jn) - 1 + overlap * MIN( 1, nlcjtl(jn) - nlejtl(jn) ) 
-               ! Do not take into account the bound of the domain
-               IF( ibonitl(jn) == -1 .OR. ibonitl(jn) == 2 ) nictls = MAX(2, nictls)
-               IF( ibonjtl(jn) == -1 .OR. ibonjtl(jn) == 2 ) njctls = MAX(2, njctls)
-               IF( ibonitl(jn) ==  1 .OR. ibonitl(jn) == 2 ) nictle = MIN(nictle, nimpptl(jn) + nleitl(jn) - 2)
-               IF( ibonjtl(jn) ==  1 .OR. ibonjtl(jn) == 2 ) njctle = MIN(njctle, njmpptl(jn) + nlejtl(jn) - 2)
-            ENDIF
-         ENDIF
-
-         IF ( clinfo3 == 'tra' )  THEN
-             zvctl1 = t_ctll(jn)
-             zvctl2 = s_ctll(jn)
-         ELSEIF ( clinfo3 == 'dyn' )   THEN
-             zvctl1 = u_ctll(jn)
-             zvctl2 = v_ctll(jn)
-         ENDIF
-
-         ! Compute the sum control
-         ! 2D arrays
-         IF( PRESENT(tab2d_1) )   THEN
-            zsum1 = SUM( ztab2d_1(nictls:nictle,njctls:njctle)*zmask1(nictls:nictle,njctls:njctle,1) )
-            zsum2 = SUM( ztab2d_2(nictls:nictle,njctls:njctle)*zmask2(nictls:nictle,njctls:njctle,1) )
-         ENDIF
-
-         ! 3D arrays
-         IF( PRESENT(tab3d_1) )   THEN
-            zsum1 = SUM( ztab3d_1(nictls:nictle,njctls:njctle,1:kdir)*zmask1(nictls:nictle,njctls:njctle,1:kdir) )
-            zsum2 = SUM( ztab3d_2(nictls:nictle,njctls:njctle,1:kdir)*zmask2(nictls:nictle,njctls:njctle,1:kdir) )
-         ENDIF
-
-         ! Print the result
-         IF( PRESENT(clinfo3) )   THEN
-            WRITE(j_id,FMT='(a,D23.16,3x,a,D23.16)')clinfo1, zsum1-zvctl1, cl2, zsum2-zvctl2
-            SELECT CASE( clinfo3 )
-            CASE ( 'tra-ta' ) 
-               t_ctll(jn) = zsum1
-            CASE ( 'tra' ) 
-                t_ctll(jn) = zsum1
-                s_ctll(jn) = zsum2
-            CASE ( 'dyn' ) 
-                u_ctll(jn) = zsum1
-                v_ctll(jn) = zsum2 
-            END SELECT
-         ELSEIF ( PRESENT(clinfo2) .OR. PRESENT(tab2d_2) .OR. PRESENT(tab3d_2) )   THEN
-            WRITE(j_id,FMT='(a,D23.16,3x,a,D23.16)')clinfo1, zsum1, cl2, zsum2
-         ELSE
-            WRITE(j_id,FMT='(a,D23.16)')clinfo1, zsum1
-         ENDIF
-
-      ENDDO
-
-   END SUBROUTINE prt_ctl
-
-
-   SUBROUTINE prt_ctl_info (clinfo1, ivar1, clinfo2, ivar2, itime)
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE prt_ctl_info  ***
-      !!
-      !! ** Purpose : - print information without any computation
-      !!
-      !! ** Action  : - input arguments
-      !!                    clinfo1 : information about the ivar1
-      !!                    ivar1   : value to print
-      !!                    clinfo2 : information about the ivar2
-      !!                    ivar2   : value to print
-      !!
-      !! History :
-      !!   9.0  !  05-07  (C. Talandier) original code
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      CHARACTER (len=*), INTENT(in) ::   clinfo1
-      INTEGER          , INTENT(in), OPTIONAL ::   ivar1
-      CHARACTER (len=*), INTENT(in), OPTIONAL ::   clinfo2
-      INTEGER          , INTENT(in), OPTIONAL ::   ivar2
-      INTEGER          , INTENT(in), OPTIONAL ::   itime
-
-      !! * Local declarations
-      INTEGER :: jn, sind, eind, iltime, j_id
-      !!----------------------------------------------------------------------
-
-      IF( lk_mpp )   THEN
-         ! processor number
-         sind = narea
-         eind = narea
-      ELSE
-         ! total number of processors
-         sind = 1
-         eind = ijsplt
-      ENDIF
-
-      ! Set to zero arrays at each new time step
-      IF( PRESENT(itime) )   THEN
-         iltime = itime
-         IF( iltime > ktime )   THEN
-            t_ctll(:) = 0.e0   ;   s_ctll(:) = 0.e0
-            u_ctll(:) = 0.e0   ;   v_ctll(:) = 0.e0
-            ktime = iltime
-         ENDIF
-      ENDIF
-
-      ! Loop over each sub-domain, i.e. number of processors ijsplt
-      DO jn = sind, eind
-         
-         ! Set logical unit
-         j_id = numid(jn - narea + 1)
-
-         IF( PRESENT(ivar1) .AND. PRESENT(clinfo2) .AND. PRESENT(ivar2) )   THEN
-            WRITE(j_id,*)clinfo1, ivar1, clinfo2, ivar2
-         ELSEIF ( PRESENT(ivar1) .AND. PRESENT(clinfo2) .AND. .NOT. PRESENT(ivar2) )   THEN
-            WRITE(j_id,*)clinfo1, ivar1, clinfo2
-         ELSEIF ( PRESENT(ivar1) .AND. .NOT. PRESENT(clinfo2) .AND. PRESENT(ivar2) )   THEN
-            WRITE(j_id,*)clinfo1, ivar1, ivar2
-         ELSEIF ( PRESENT(ivar1) .AND. .NOT. PRESENT(clinfo2) .AND. .NOT. PRESENT(ivar2) )   THEN
-            WRITE(j_id,*)clinfo1, ivar1
-         ELSE
-            WRITE(j_id,*)clinfo1
-         ENDIF
-
-      ENDDO
-
-
-      END SUBROUTINE prt_ctl_info
-
-   SUBROUTINE prt_ctl_init
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE prt_ctl_init  ***
-      !!
-      !! ** Purpose :   open ASCII files & compute indices
-      !!
-      !! History :
-      !!   9.0  !  05-07  (C. Talandier) original code
-      !!----------------------------------------------------------------------
-      !! * Local declarations
-      INTEGER ::   jn, sind, eind, j_id
-      CHARACTER (len=28) :: clfile_out
-      CHARACTER (len=23) :: clb_name
-      CHARACTER (len=19) :: cl_run
-      !!----------------------------------------------------------------------
-
-      ! Allocate arrays
-      ALLOCATE(nlditl (ijsplt))
-      ALLOCATE(nldjtl (ijsplt))
-      ALLOCATE(nleitl (ijsplt))
-      ALLOCATE(nlejtl (ijsplt))
-      ALLOCATE(nimpptl(ijsplt))
-      ALLOCATE(njmpptl(ijsplt))
-      ALLOCATE(nlcitl (ijsplt))
-      ALLOCATE(nlcjtl (ijsplt))
-      ALLOCATE(t_ctll (ijsplt))
-      ALLOCATE(s_ctll (ijsplt))
-      ALLOCATE(u_ctll (ijsplt))
-      ALLOCATE(v_ctll (ijsplt))
-      ALLOCATE(ibonitl(ijsplt))
-      ALLOCATE(ibonjtl(ijsplt))
-
-      ! Initialization 
-      t_ctll(:)=0.e0
-      s_ctll(:)=0.e0
-      u_ctll(:)=0.e0
-      v_ctll(:)=0.e0
-      ktime = 1
-
-      IF( lk_mpp ) THEN
-         sind = narea
-         eind = narea
-         clb_name = "('mpp.output_',I4.4)"
-         cl_run = 'MULTI processor run'
-         ! use indices for each area computed by mpp_init subroutine
-         nlditl(:) = nldit(:) 
-         nleitl(:) = nleit(:) 
-         nldjtl(:) = nldjt(:) 
-         nlejtl(:) = nlejt(:) 
-         !
-         nimpptl(:) = nimppt(:)
-         njmpptl(:) = njmppt(:)
-         !
-         nlcitl(:) = nlcit(:)
-         nlcjtl(:) = nlcjt(:)
-         !
-         ibonitl(:) = ibonit(:)
-         ibonjtl(:) = ibonjt(:)
-      ELSE
-         sind = 1
-         eind = ijsplt
-         clb_name = "('mono.output_',I4.4)"
-         cl_run = 'MONO processor run '
-         ! compute indices for each area as done in mpp_init subroutine
-         CALL sub_dom
-      ENDIF
-
-      ALLOCATE(numid(eind-sind+1))
-
-      DO jn = sind, eind
-         WRITE(clfile_out,FMT=clb_name) jn-1
-         CALL ctlopn( numid(jn -narea + 1), clfile_out, 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL',   &
-            &         1, numout, .FALSE., 1 )
-         j_id = numid(jn -narea + 1)
-         WRITE(j_id,*)
-         WRITE(j_id,*) '                 L O D Y C - I P S L'
-         WRITE(j_id,*) '                     O P A model'
-         WRITE(j_id,*) '            Ocean General Circulation Model'
-         WRITE(j_id,*) '               version OPA 9.0  (2005) '
-         WRITE(j_id,*)
-         WRITE(j_id,*) '                   PROC number: ', jn
-         WRITE(j_id,*)
-         WRITE(j_id,FMT="(19x,a20)")cl_run
-
-         ! Print the SUM control indices
-         IF( .NOT. lsp_area )   THEN
-            nictls = nimpptl(jn) + nlditl(jn) - 1
-            nictle = nimpptl(jn) + nleitl(jn) - 1
-            njctls = njmpptl(jn) + nldjtl(jn) - 1
-            njctle = njmpptl(jn) + nlejtl(jn) - 1
-         ENDIF
-         WRITE(j_id,*) 
-         WRITE(j_id,*) 'prt_ctl :  Sum control indices'
-         WRITE(j_id,*) '~~~~~~~'
-         WRITE(j_id,*)
-         WRITE(j_id,9000)'                                nlej   = ', nlejtl(jn), '              '
-         WRITE(j_id,9000)'                  ------------- njctle = ', njctle, ' -------------'
-         WRITE(j_id,9001)'                  |                                       |'
-         WRITE(j_id,9001)'                  |                                       |'
-         WRITE(j_id,9001)'                  |                                       |'
-         WRITE(j_id,9002)'           nictls = ', nictls,  '                           nictle = ', nictle
-         WRITE(j_id,9002)'           nldi   = ', nlditl(jn),  '                           nlei   = ', nleitl(jn)
-         WRITE(j_id,9001)'                  |                                       |'
-         WRITE(j_id,9001)'                  |                                       |'
-         WRITE(j_id,9001)'                  |                                       |'
-         WRITE(j_id,9004)'  njmpp  = ',njmpptl(jn),'   ------------- njctls = ', njctls, ' -------------'
-         WRITE(j_id,9003)'           nimpp  = ', nimpptl(jn), '        nldj   = ', nldjtl(jn), '              '
-         WRITE(j_id,*)
-         WRITE(j_id,*)
-
-9000     FORMAT(a41,i4.4,a14)
-9001     FORMAT(a59)
-9002     FORMAT(a20,i4.4,a36,i3.3)
-9003     FORMAT(a20,i4.4,a17,i4.4)
-9004     FORMAT(a11,i4.4,a26,i4.4,a14)
-      ENDDO
-
-   END SUBROUTINE prt_ctl_init
-
-
-   SUBROUTINE sub_dom
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE sub_dom  ***
-      !!                    
-      !! ** Purpose :   Lay out the global domain over processors. 
-      !!                CAUTION: 
-      !!                This part has been extracted from the mpp_init
-      !!                subroutine and names of variables/arrays have been 
-      !!                slightly changed to avoid confusion but the computation
-      !!                is exactly the same. Any modification about indices of
-      !!                each sub-domain in the mppini.F90 module should be reported 
-      !!                here.
-      !!
-      !! ** Method  :   Global domain is distributed in smaller local domains.
-      !!                Periodic condition is a function of the local domain position
-      !!                (global boundary or neighbouring domain) and of the global
-      !!                periodic
-      !!                Type :         jperio global periodic condition
-      !!                               nperio local  periodic condition
-      !!
-      !! ** Action  : - set domain parameters
-      !!                    nimpp     : longitudinal index 
-      !!                    njmpp     : latitudinal  index
-      !!                    nperio    : lateral condition type 
-      !!                    narea     : number for local area
-      !!                    nlcil      : first dimension
-      !!                    nlcjl      : second dimension
-      !!                    nbondil    : mark for "east-west local boundary"
-      !!                    nbondjl    : mark for "north-south local boundary"
-      !!
-      !! History :
-      !!        !  94-11  (M. Guyon)  Original code
-      !!        !  95-04  (J. Escobar, M. Imbard)
-      !!        !  98-02  (M. Guyon)  FETI method
-      !!        !  98-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions
-      !!   8.5  !  02-08  (G. Madec)  F90 : free form
-      !!----------------------------------------------------------------------
-      !! * Local variables
-      INTEGER ::   ji, jj, jn               ! dummy loop indices
-      INTEGER ::   &
-         ii, ij,                         &  ! temporary integers
-         irestil, irestjl,               &  !    "          "
-         ijpi  , ijpj, nlcil,            &  ! temporary logical unit
-         nlcjl , nbondil, nbondjl,       &
-         nrecil, nrecjl, nldil, nleil, nldjl, nlejl
-
-      INTEGER, DIMENSION(:,:), ALLOCATABLE ::   &
-         iimpptl, ijmpptl, ilcitl, ilcjtl       ! temporary workspace
-      REAL(wp) ::   zidom, zjdom            ! temporary scalars
-      !!----------------------------------------------------------------------
-
-      !  1. Dimension arrays for subdomains
-      ! -----------------------------------
-      !  Computation of local domain sizes ilcitl() ilcjtl()
-      !  These dimensions depend on global sizes isplt,jsplt and jpiglo,jpjglo
-      !  The subdomains are squares leeser than or equal to the global
-      !  dimensions divided by the number of processors minus the overlap
-      !  array (cf. par_oce.F90).
-
-      ijpi = ( jpiglo-2*jpreci + (isplt-1) ) / isplt + 2*jpreci
-      ijpj = ( jpjglo-2*jprecj + (jsplt-1) ) / jsplt + 2*jprecj
-
-      ALLOCATE(ilcitl (isplt,jsplt))
-      ALLOCATE(ilcjtl (isplt,jsplt))
-
-      nrecil  = 2 * jpreci
-      nrecjl  = 2 * jprecj
-      irestil = MOD( jpiglo - nrecil , isplt )
-      irestjl = MOD( jpjglo - nrecjl , jsplt )
-
-      IF(  irestil == 0 )   irestil = isplt
-      DO jj = 1, jsplt
-         DO ji = 1, irestil
-            ilcitl(ji,jj) = ijpi
-         END DO
-         DO ji = irestil+1, isplt
-            ilcitl(ji,jj) = ijpi -1
-         END DO
-      END DO
-      
-      IF( irestjl == 0 )   irestjl = jsplt
-      DO ji = 1, isplt
-         DO jj = 1, irestjl
-            ilcjtl(ji,jj) = ijpj
-         END DO
-         DO jj = irestjl+1, jsplt
-            ilcjtl(ji,jj) = ijpj -1
-         END DO
-      END DO
-      
-      zidom = nrecil
-      DO ji = 1, isplt
-         zidom = zidom + ilcitl(ji,1) - nrecil
-      END DO
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*)' sum ilcitl(i,1) = ', zidom, ' jpiglo = ', jpiglo
-      
-      zjdom = nrecjl
-      DO jj = 1, jsplt
-         zjdom = zjdom + ilcjtl(1,jj) - nrecjl
-      END DO
-      IF(lwp) WRITE(numout,*)' sum ilcitl(1,j) = ', zjdom, ' jpjglo = ', jpjglo
-      IF(lwp) WRITE(numout,*)
-      
-
-      !  2. Index arrays for subdomains
-      ! -------------------------------
-
-      ALLOCATE(iimpptl(isplt,jsplt))
-      ALLOCATE(ijmpptl(isplt,jsplt))
-      
-      iimpptl(:,:) = 1
-      ijmpptl(:,:) = 1
-      
-      IF( isplt > 1 ) THEN
-         DO jj = 1, jsplt
-            DO ji = 2, isplt
-               iimpptl(ji,jj) = iimpptl(ji-1,jj) + ilcitl(ji-1,jj) - nrecil
-            END DO
-         END DO
-      ENDIF
-
-      IF( jsplt > 1 ) THEN
-         DO jj = 2, jsplt
-            DO ji = 1, isplt
-               ijmpptl(ji,jj) = ijmpptl(ji,jj-1)+ilcjtl(ji,jj-1)-nrecjl
-            END DO
-         END DO
-      ENDIF
-      
-      ! 3. Subdomain description
-      ! ------------------------
-
-      DO jn = 1, ijsplt
-         ii = 1 + MOD( jn-1, isplt )
-         ij = 1 + (jn-1) / isplt
-         nimpptl(jn) = iimpptl(ii,ij)
-         njmpptl(jn) = ijmpptl(ii,ij)
-         nlcitl (jn) = ilcitl (ii,ij)     
-         nlcil       = nlcitl (jn)     
-         nlcjtl (jn) = ilcjtl (ii,ij)     
-         nlcjl       = nlcjtl (jn)
-         nbondjl = -1                                    ! general case
-         IF( jn   >  isplt          )   nbondjl = 0      ! first row of processor
-         IF( jn   >  (jsplt-1)*isplt )  nbondjl = 1     ! last  row of processor
-         IF( jsplt == 1             )   nbondjl = 2      ! one processor only in j-direction
-         ibonjtl(jn) = nbondjl
-         
-         nbondil = 0                                     ! 
-         IF( MOD( jn, isplt ) == 1 )   nbondil = -1      !
-         IF( MOD( jn, isplt ) == 0 )   nbondil =  1      !
-         IF( isplt            == 1 )   nbondil =  2      ! one processor only in i-direction
-         ibonitl(jn) = nbondil
-         
-         nldil =  1   + jpreci
-         nleil = nlcil - jpreci
-         IF( nbondil == -1 .OR. nbondil == 2 )   nldil = 1
-         IF( nbondil ==  1 .OR. nbondil == 2 )   nleil = nlcil
-         nldjl =  1   + jprecj
-         nlejl = nlcjl - jprecj
-         IF( nbondjl == -1 .OR. nbondjl == 2 )   nldjl = 1
-         IF( nbondjl ==  1 .OR. nbondjl == 2 )   nlejl = nlcjl
-         nlditl(jn) = nldil
-         nleitl(jn) = nleil
-         nldjtl(jn) = nldjl
-         nlejtl(jn) = nlejl
-      END DO
-
-      DEALLOCATE(iimpptl)
-      DEALLOCATE(ijmpptl)
-      DEALLOCATE(ilcitl)
-      DEALLOCATE(ilcjtl)
-
-   END SUBROUTINE sub_dom
-
-END MODULE prtctl
Index: trunk/NEMOGCM/NEMO/OFF_SRC/step.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OFF_SRC/step.F90	(revision 2527)
+++ 	(revision )
@@ -1,94 +1,0 @@
-MODULE step
-   !!======================================================================
-   !!                       ***  MODULE step  ***
-   !! Time-stepping    : manager of the ocean, tracer and ice time stepping
-   !!======================================================================
-
-   !!----------------------------------------------------------------------
-   !!   stp            : OPA system time-stepping
-   !!----------------------------------------------------------------------
-   !! * Modules used
-   USE oce             ! ocean dynamics and tracers variables
-   USE dom_oce         ! ocean space and time domain variables 
-   USE zdf_oce         ! ocean vertical physics variables
-   USE ldftra_oce
-   USE in_out_manager  ! I/O manager
-   USE lbclnk
-   USE trcdia
-   USE daymod          ! calendar                         (day     routine)
-   USE trcstp          ! passive tracer time-stepping      (trc_stp routine)
-   USE dtadyn          ! Lecture and interpolation of the dynamical fields
-   USE eosbn2          ! equation of state                (eos_bn2 routine)
-   USE trcrst          ! restart for passive tracers
-   USE stpctl          ! time stepping control            (stp_ctl routine)
-   USE iom
-
-   IMPLICIT NONE
-   PRIVATE
-
-   !! * Routine accessibility
-   PUBLIC stp            ! called by opa.F90
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-   !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005)
-   !! $Id$
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE stp( kstp )
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE stp  ***
-      !!                      
-      !! ** Purpose : - Time stepping of OPA (momentum and active tracer eqs.)
-      !!              - Time stepping of LIM (dynamic and thermodynamic eqs.)
-      !!              - Tme stepping  of TRC (passive tracer eqs.)
-      !! 
-      !! ** Method  : -1- Update forcings and data  
-      !!              -2- Update ocean physics 
-      !!              -3- Compute the t and s trends 
-      !!              -4- Update t and s 
-      !!              -5- Compute the momentum trends
-      !!              -6- Update the horizontal velocity
-      !!              -7- Compute the diagnostics variables (rd,N2, div,cur,w)
-      !!              -8- Outputs and diagnostics
-      !!
-      !! History :
-      !!        !  91-03  ()  Original code
-      !!        !  91-11  (G. Madec)
-      !!        !  92-06  (M. Imbard)  add a first output record
-      !!        !  96-04  (G. Madec)  introduction of dynspg
-      !!        !  96-04  (M.A. Foujols)  introduction of passive tracer
-      !!   8.0  !  97-06  (G. Madec)  new architecture of call
-      !!   8.2  !  97-06  (G. Madec, M. Imbard, G. Roullet)  free surface
-      !!   8.2  !  99-02  (G. Madec, N. Grima)  hpg implicit
-      !!   8.2  !  00-07  (J-M Molines, M. Imbard)  Open Bondary Conditions
-      !!   9.0  !  02-06  (G. Madec)  free form, suppress macro-tasking
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      INTEGER, INTENT( in ) ::   kstp   ! ocean time-step index
-      !! ---------------------------------------------------------------------
-
-      IF( kstp /= nit000 )   CALL day( kstp )         ! Calendar (day was already called at nit000 in day_init)
-
-      IF( lk_iomput ) CALL iom_setkt( kstp )       ! say to iom that we are at time step kstp
-
-      CALL dta_dyn( kstp )         ! Interpolation of the dynamical fields
-
-      CALL trc_stp( kstp )         ! time-stepping
-
-
-      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-      ! Control, diagnostics and outputs
-      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-      !                                            ! Time loop: control and print
-       CALL stp_ctl( kstp )
-
-
-   END SUBROUTINE stp
-
-   !!======================================================================
-END MODULE step
Index: trunk/NEMOGCM/NEMO/OFF_SRC/stpctl.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OFF_SRC/stpctl.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OFF_SRC/stpctl.F90	(revision 2528)
@@ -1,12 +1,17 @@
 MODULE stpctl
-   !!==============================================================================
+   !!======================================================================
    !!                       ***  MODULE  stpctl  ***
-   !! Ocean run control :  gross check of the ocean time stepping
-   !!==============================================================================
+   !! 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
    !!----------------------------------------------------------------------
-   !! * Modules used
    USE oce             ! ocean dynamics and tracers variables
    USE dom_oce         ! ocean space and time domain variables 
@@ -18,11 +23,14 @@
    PRIVATE
 
-   !! * Accessibility
-   PUBLIC stp_ctl           ! routine called by step.F90
+   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 )
+   SUBROUTINE stp_ctl( kt, kindic )
       !!----------------------------------------------------------------------
       !!                    ***  ROUTINE stp_ctl  ***
@@ -31,24 +39,11 @@
       !!
       !! ** Method  : - Save the time step in numstp
-      !!              - Print it each 50 time steps
-      !!              - Print solver statistics in numsol 
-      !!              - Stop the run IF problem for the solver ( indec < 0 )
       !!
-      !! History :
-      !!        !  91-03  ()
-      !!        !  91-11  (G. Madec)
-      !!        !  92-06  (M. Imbard)
-      !!        !  97-06  (A.M. Treguier)
-      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
+      !! ** Actions :   'time.step' file containing the last ocean time-step
       !!----------------------------------------------------------------------
-      !! * Arguments
-      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
-
+      INTEGER, INTENT(in   ) ::   kt      ! ocean time-step index
+      INTEGER, INTENT(inout) ::   kindic  ! indicator of solver convergence
       !!----------------------------------------------------------------------
-      !!   OPA 9.0 , LOCEAN-IPSL  (2005)
-      !!   $Id$
-      !!   This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
-      !!----------------------------------------------------------------------
-
+      !
       IF( kt == nit000 .AND. lwp ) THEN
          WRITE(numout,*)
@@ -56,14 +51,10 @@
          WRITE(numout,*) '~~~~~~~'
          ! open time.step file
-         CALL ctlopn( numstp, 'time.step', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, 1 )
+         CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
       ENDIF
-
-      ! save the current time step in numstp
-      ! ------------------------------------
-      IF(lwp) WRITE(numstp,9100) kt
-      IF(lwp) REWIND(numstp)
-9100  FORMAT(1x, i8)
-
-
+      !
+      IF(lwp) WRITE ( numstp, '(1x, i8)' )   kt      !* save the current time step in numstp
+      IF(lwp) REWIND( numstp )                       !  --------------------------
+      !
    END SUBROUTINE stp_ctl
 
Index: trunk/NEMOGCM/NEMO/OFF_SRC/trc_oce.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OFF_SRC/trc_oce.F90	(revision 2527)
+++ 	(revision )
@@ -1,229 +1,0 @@
-MODULE trc_oce
-   !!======================================================================
-   !!                      ***  MODULE  trc_oce  ***
-   !! Ocean passive tracer  :  share SMS/Ocean variables
-   !!======================================================================
-   !! History :  1.0  !  2004-03  (C. Ethe)  Original code
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   trc_oce_rgb : tabulated attenuation coefficients for RGB light penetration         
-   !!----------------------------------------------------------------------
-   USE par_oce
-   USE in_out_manager  ! I/O manager
-   USE dom_oce         ! ocean space and time domain
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   trc_oce_rgb        ! routine called by traqsr.F90
-   PUBLIC   trc_oce_rgb_read   ! routine called by traqsr.F90
-   PUBLIC   trc_oce_ext_lev    ! function called by traqsr.F90 at least
-   
-   REAL(wp), PUBLIC , DIMENSION(jpi,jpj,jpk) ::   etot3   !: light absortion coefficient
-
-#if defined key_top && defined key_pisces
-   !!----------------------------------------------------------------------
-   !!   'key_top'   &   'key_pisces'                       PISCES bio-model          
-   !!----------------------------------------------------------------------
-   LOGICAL, PUBLIC, PARAMETER ::   lk_qsr_bio = .TRUE.   !: bio-model light absorption flag
-#else
-   !!----------------------------------------------------------------------
-   !! Default option                          No bio-model light absorption      
-   !!----------------------------------------------------------------------
-   LOGICAL, PUBLIC, PARAMETER ::   lk_qsr_bio = .FALSE.   !: bio-model light absorption flag
-#endif
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
-   !! $Id: trc_oce.F90 1834 2010-04-14 11:54:19Z cetlod $ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE trc_oce_rgb( prgb )
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE p4z_opt_init  ***
-      !!
-      !! ** Purpose :   Initialization of of the optical scheme
-      !!
-      !! ** Method  :   Set a look up table for the optical coefficients
-      !!                i.e. the attenuation coefficient for R-G-B light 
-      !!                tabulated in Chlorophyll class (from JM Andre)
-      !!
-      !! ** Action  :   prgb(3,61) tabulated R-G-B attenuation coef. 
-      !!
-      !! Reference  : Lengaigne et al. 2007, Clim. Dyn., V28, 5, 503-516.
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(3,61), INTENT(out) ::   prgb   ! tabulated attenuation coefficient
-      !!
-      INTEGER  ::   jc     ! dummy loop indice
-      INTEGER  ::   irgb   ! temporary integer
-      REAL(wp) ::   zchl   ! temporary scalar
-      REAL(wp), DIMENSION(4,61) ::   zrgb   ! tabulated attenuation coefficient (formerly read in 'kRGB61.txt')
-      !!----------------------------------------------------------------------
-      !
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'trc_oce_rgb : Initialisation of the optical look-up table'
-         WRITE(numout,*) '~~~~~~~~~~~ '
-      ENDIF
-      !
-      !  Chlorophyll        !     Blue attenuation     !     Green attenuation    !     Red attenuation      !
-      zrgb(1, 1) =  0.010   ;   zrgb(2, 1) = 0.01618   ;   zrgb(3, 1) = 0.07464   ;   zrgb(4, 1) = 0.37807
-      zrgb(1, 2) =  0.011   ;   zrgb(2, 2) = 0.01654   ;   zrgb(3, 2) = 0.07480   ;   zrgb(4, 2) = 0.37823
-      zrgb(1, 3) =  0.013   ;   zrgb(2, 3) = 0.01693   ;   zrgb(3, 3) = 0.07499   ;   zrgb(4, 3) = 0.37840
-      zrgb(1, 4) =  0.014   ;   zrgb(2, 4) = 0.01736   ;   zrgb(3, 4) = 0.07518   ;   zrgb(4, 4) = 0.37859
-      zrgb(1, 5) =  0.016   ;   zrgb(2, 5) = 0.01782   ;   zrgb(3, 5) = 0.07539   ;   zrgb(4, 5) = 0.37879
-      zrgb(1, 6) =  0.018   ;   zrgb(2, 6) = 0.01831   ;   zrgb(3, 6) = 0.07562   ;   zrgb(4, 6) = 0.37900
-      zrgb(1, 7) =  0.020   ;   zrgb(2, 7) = 0.01885   ;   zrgb(3, 7) = 0.07586   ;   zrgb(4, 7) = 0.37923
-      zrgb(1, 8) =  0.022   ;   zrgb(2, 8) = 0.01943   ;   zrgb(3, 8) = 0.07613   ;   zrgb(4, 8) = 0.37948
-      zrgb(1, 9) =  0.025   ;   zrgb(2, 9) = 0.02005   ;   zrgb(3, 9) = 0.07641   ;   zrgb(4, 9) = 0.37976
-      zrgb(1,10) =  0.028   ;   zrgb(2,10) = 0.02073   ;   zrgb(3,10) = 0.07672   ;   zrgb(4,10) = 0.38005
-      zrgb(1,11) =  0.032   ;   zrgb(2,11) = 0.02146   ;   zrgb(3,11) = 0.07705   ;   zrgb(4,11) = 0.38036
-      zrgb(1,12) =  0.035   ;   zrgb(2,12) = 0.02224   ;   zrgb(3,12) = 0.07741   ;   zrgb(4,12) = 0.38070
-      zrgb(1,13) =  0.040   ;   zrgb(2,13) = 0.02310   ;   zrgb(3,13) = 0.07780   ;   zrgb(4,13) = 0.38107
-      zrgb(1,14) =  0.045   ;   zrgb(2,14) = 0.02402   ;   zrgb(3,14) = 0.07821   ;   zrgb(4,14) = 0.38146
-      zrgb(1,15) =  0.050   ;   zrgb(2,15) = 0.02501   ;   zrgb(3,15) = 0.07866   ;   zrgb(4,15) = 0.38189
-      zrgb(1,16) =  0.056   ;   zrgb(2,16) = 0.02608   ;   zrgb(3,16) = 0.07914   ;   zrgb(4,16) = 0.38235
-      zrgb(1,17) =  0.063   ;   zrgb(2,17) = 0.02724   ;   zrgb(3,17) = 0.07967   ;   zrgb(4,17) = 0.38285
-      zrgb(1,18) =  0.071   ;   zrgb(2,18) = 0.02849   ;   zrgb(3,18) = 0.08023   ;   zrgb(4,18) = 0.38338
-      zrgb(1,19) =  0.079   ;   zrgb(2,19) = 0.02984   ;   zrgb(3,19) = 0.08083   ;   zrgb(4,19) = 0.38396
-      zrgb(1,20) =  0.089   ;   zrgb(2,20) = 0.03131   ;   zrgb(3,20) = 0.08149   ;   zrgb(4,20) = 0.38458
-      zrgb(1,21) =  0.100   ;   zrgb(2,21) = 0.03288   ;   zrgb(3,21) = 0.08219   ;   zrgb(4,21) = 0.38526
-      zrgb(1,22) =  0.112   ;   zrgb(2,22) = 0.03459   ;   zrgb(3,22) = 0.08295   ;   zrgb(4,22) = 0.38598
-      zrgb(1,23) =  0.126   ;   zrgb(2,23) = 0.03643   ;   zrgb(3,23) = 0.08377   ;   zrgb(4,23) = 0.38676
-      zrgb(1,24) =  0.141   ;   zrgb(2,24) = 0.03842   ;   zrgb(3,24) = 0.08466   ;   zrgb(4,24) = 0.38761
-      zrgb(1,25) =  0.158   ;   zrgb(2,25) = 0.04057   ;   zrgb(3,25) = 0.08561   ;   zrgb(4,25) = 0.38852
-      zrgb(1,26) =  0.178   ;   zrgb(2,26) = 0.04289   ;   zrgb(3,26) = 0.08664   ;   zrgb(4,26) = 0.38950
-      zrgb(1,27) =  0.200   ;   zrgb(2,27) = 0.04540   ;   zrgb(3,27) = 0.08775   ;   zrgb(4,27) = 0.39056
-      zrgb(1,28) =  0.224   ;   zrgb(2,28) = 0.04811   ;   zrgb(3,28) = 0.08894   ;   zrgb(4,28) = 0.39171
-      zrgb(1,29) =  0.251   ;   zrgb(2,29) = 0.05103   ;   zrgb(3,29) = 0.09023   ;   zrgb(4,29) = 0.39294
-      zrgb(1,30) =  0.282   ;   zrgb(2,30) = 0.05420   ;   zrgb(3,30) = 0.09162   ;   zrgb(4,30) = 0.39428
-      zrgb(1,31) =  0.316   ;   zrgb(2,31) = 0.05761   ;   zrgb(3,31) = 0.09312   ;   zrgb(4,31) = 0.39572
-      zrgb(1,32) =  0.355   ;   zrgb(2,32) = 0.06130   ;   zrgb(3,32) = 0.09474   ;   zrgb(4,32) = 0.39727
-      zrgb(1,33) =  0.398   ;   zrgb(2,33) = 0.06529   ;   zrgb(3,33) = 0.09649   ;   zrgb(4,33) = 0.39894
-      zrgb(1,34) =  0.447   ;   zrgb(2,34) = 0.06959   ;   zrgb(3,34) = 0.09837   ;   zrgb(4,34) = 0.40075
-      zrgb(1,35) =  0.501   ;   zrgb(2,35) = 0.07424   ;   zrgb(3,35) = 0.10040   ;   zrgb(4,35) = 0.40270
-      zrgb(1,36) =  0.562   ;   zrgb(2,36) = 0.07927   ;   zrgb(3,36) = 0.10259   ;   zrgb(4,36) = 0.40480
-      zrgb(1,37) =  0.631   ;   zrgb(2,37) = 0.08470   ;   zrgb(3,37) = 0.10495   ;   zrgb(4,37) = 0.40707
-      zrgb(1,38) =  0.708   ;   zrgb(2,38) = 0.09056   ;   zrgb(3,38) = 0.10749   ;   zrgb(4,38) = 0.40952
-      zrgb(1,39) =  0.794   ;   zrgb(2,39) = 0.09690   ;   zrgb(3,39) = 0.11024   ;   zrgb(4,39) = 0.41216
-      zrgb(1,40) =  0.891   ;   zrgb(2,40) = 0.10374   ;   zrgb(3,40) = 0.11320   ;   zrgb(4,40) = 0.41502
-      zrgb(1,41) =  1.000   ;   zrgb(2,41) = 0.11114   ;   zrgb(3,41) = 0.11639   ;   zrgb(4,41) = 0.41809
-      zrgb(1,42) =  1.122   ;   zrgb(2,42) = 0.11912   ;   zrgb(3,42) = 0.11984   ;   zrgb(4,42) = 0.42142
-      zrgb(1,43) =  1.259   ;   zrgb(2,43) = 0.12775   ;   zrgb(3,43) = 0.12356   ;   zrgb(4,43) = 0.42500
-      zrgb(1,44) =  1.413   ;   zrgb(2,44) = 0.13707   ;   zrgb(3,44) = 0.12757   ;   zrgb(4,44) = 0.42887
-      zrgb(1,45) =  1.585   ;   zrgb(2,45) = 0.14715   ;   zrgb(3,45) = 0.13189   ;   zrgb(4,45) = 0.43304
-      zrgb(1,46) =  1.778   ;   zrgb(2,46) = 0.15803   ;   zrgb(3,46) = 0.13655   ;   zrgb(4,46) = 0.43754
-      zrgb(1,47) =  1.995   ;   zrgb(2,47) = 0.16978   ;   zrgb(3,47) = 0.14158   ;   zrgb(4,47) = 0.44240
-      zrgb(1,48) =  2.239   ;   zrgb(2,48) = 0.18248   ;   zrgb(3,48) = 0.14701   ;   zrgb(4,48) = 0.44765
-      zrgb(1,49) =  2.512   ;   zrgb(2,49) = 0.19620   ;   zrgb(3,49) = 0.15286   ;   zrgb(4,49) = 0.45331
-      zrgb(1,50) =  2.818   ;   zrgb(2,50) = 0.21102   ;   zrgb(3,50) = 0.15918   ;   zrgb(4,50) = 0.45942
-      zrgb(1,51) =  3.162   ;   zrgb(2,51) = 0.22703   ;   zrgb(3,51) = 0.16599   ;   zrgb(4,51) = 0.46601
-      zrgb(1,52) =  3.548   ;   zrgb(2,52) = 0.24433   ;   zrgb(3,52) = 0.17334   ;   zrgb(4,52) = 0.47313
-      zrgb(1,53) =  3.981   ;   zrgb(2,53) = 0.26301   ;   zrgb(3,53) = 0.18126   ;   zrgb(4,53) = 0.48080
-      zrgb(1,54) =  4.467   ;   zrgb(2,54) = 0.28320   ;   zrgb(3,54) = 0.18981   ;   zrgb(4,54) = 0.48909
-      zrgb(1,55) =  5.012   ;   zrgb(2,55) = 0.30502   ;   zrgb(3,55) = 0.19903   ;   zrgb(4,55) = 0.49803
-      zrgb(1,56) =  5.623   ;   zrgb(2,56) = 0.32858   ;   zrgb(3,56) = 0.20898   ;   zrgb(4,56) = 0.50768
-      zrgb(1,57) =  6.310   ;   zrgb(2,57) = 0.35404   ;   zrgb(3,57) = 0.21971   ;   zrgb(4,57) = 0.51810
-      zrgb(1,58) =  7.079   ;   zrgb(2,58) = 0.38154   ;   zrgb(3,58) = 0.23129   ;   zrgb(4,58) = 0.52934
-      zrgb(1,59) =  7.943   ;   zrgb(2,59) = 0.41125   ;   zrgb(3,59) = 0.24378   ;   zrgb(4,59) = 0.54147
-      zrgb(1,60) =  8.912   ;   zrgb(2,60) = 0.44336   ;   zrgb(3,60) = 0.25725   ;   zrgb(4,60) = 0.55457
-      zrgb(1,61) = 10.000   ;   zrgb(2,61) = 0.47804   ;   zrgb(3,61) = 0.27178   ;   zrgb(4,61) = 0.56870
-      !
-      prgb(:,:) = zrgb(2:4,:)
-      !
-      DO jc = 1, 61                         ! check
-         zchl = zrgb(1,jc)
-         irgb = NINT( 41 + 20.* LOG10( zchl ) + 1.e-15 )
-         IF(lwp) WRITE(numout,*) '    jc =', jc, '  Chl = ', zchl, '  irgb = ', irgb
-         IF( irgb /= jc ) THEN
-            IF(lwp) WRITE(numout,*) '    jc =', jc, '  Chl = ', zchl, '  Chl class = ', irgb
-            CALL ctl_stop( 'trc_oce_rgb : inconsistency in Chl tabulated attenuation coeff.' )
-         ENDIF
-      END DO
-      !
-   END SUBROUTINE trc_oce_rgb
-
-
-   SUBROUTINE trc_oce_rgb_read( prgb )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE p4z_opt_init  ***
-      !!
-      !! ** Purpose :   Initialization of of the optical scheme
-      !!
-      !! ** Method  :   read the look up table for the optical coefficients
-      !!
-      !! ** input   :   xkrgb(61) precomputed array corresponding to the  
-      !!                          attenuation coefficient (from JM Andre)
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(3,61), INTENT(out) ::   prgb   ! tabulated attenuation coefficient
-      !!
-      INTEGER  ::   jchl, jband   ! dummy loop indices
-      INTEGER  ::   numlight
-      REAL(wp) ::   zchl
-      CHARACTER(LEN=20) :: clname
-      !!----------------------------------------------------------------------
-      !
-      clname = 'kRGB61.txt' 
-      CALL ctlopn( numlight, clname, 'OLD', 'FORMATTED', 'SEQUENTIAL', 1, numout, .TRUE., 1 )
-      DO jchl = 1, 61
-         READ(numlight,*) zchl, ( prgb(jband,jchl), jband=1,3 )
-      END DO
-      CLOSE( numlight )
-      !
-      IF(lwp) THEN                         ! control print
-         WRITE(numout,*)
-         WRITE(numout,*) ' trc_oce_rgb_read : optical look-up table read in kRGB61.txt file'
-         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~'
-      ENDIF
-      !
-   END SUBROUTINE trc_oce_rgb_read
-
-
-   FUNCTION trc_oce_ext_lev( prldex, pqsr_frc ) RESULT( pjl )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE trc_oce_ext_lev  ***
-      !!       
-      !! ** Purpose :   compute max. level for light penetration
-      !!          
-      !! ** Method  :   the function provides the level at which irradiance 
-      !!                becomes negligible (i.e. = 1.e-15 W/m2) for 3 or 2 bands light
-      !!                penetration: I(z) = pqsr_frc * EXP(hext/prldex) = 1.e-15 W/m2
-      !!                # prldex is the longest depth of extinction:
-      !!                   - prldex = 23 m (2 bands case)
-      !!                   - prldex = 62 m (3 bands case: blue waveband & 0.01 mg/m2 for the chlorophyll)
-      !!                # pqsr_frc is the fraction of solar radiation which penetrates,
-      !!                considering Qsr=240 W/m2 and rn_abs = 0.58:
-      !!                   - pqsr_frc = Qsr * (1-rn_abs)   = 1.00e2 W/m2 (2 bands case)
-      !!                   - pqsr_frc = Qsr * (1-rn_abs)/3 = 0.33e2 W/m2 (3 bands case & equi-partition)
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), INTENT(in) ::   prldex    ! longest depth of extinction
-      REAL(wp), INTENT(in) ::   pqsr_frc  ! frac. solar radiation which penetrates 
-      !!
-      INTEGER  ::   jk, pjl            ! levels
-      REAL(wp) ::   zhext              ! deepest level till which light penetrates
-      REAL(wp) ::   zprec = 15._wp     ! precision to reach -LOG10(1.e-15)
-      REAL(wp) ::   zem                ! temporary scalar 
-      !!----------------------------------------------------------------------
-      !
-      ! It is not necessary to compute anything bellow the following depth
-      zhext = prldex * ( LOG(10.e0) * zprec + LOG(pqsr_frc) )
-     
-      ! Level of light extinction
-      pjl = jpkm1
-      DO jk = jpkm1, 1, -1
-         zem = MAXVAL( fsdepw(:,:,jk+1) * tmask(:,:,jk) )
-         IF( zem >= zhext )   pjl = jk                       ! last T-level reached by Qsr
-      END DO
-      !
-   END FUNCTION trc_oce_ext_lev
-
-
-   !!======================================================================
-END MODULE trc_oce
Index: trunk/NEMOGCM/NEMO/OFF_SRC/vectopt_loop_substitute.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OFF_SRC/vectopt_loop_substitute.h90	(revision 2527)
+++ 	(revision )
@@ -1,18 +1,0 @@
-   !!----------------------------------------------------------------------
-   !!                   ***  vectopt_loop_substitute  ***
-   !!----------------------------------------------------------------------
-   !! ** purpose :   substitute the inner loop starting and inding indices 
-   !!      to allow unrolling of do-loop using CPP macro.
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-#if defined key_vectopt_loop
-#  define fs_2     1
-#  define fs_jpim1 jpi
-#else
-#  define fs_2     2
-#  define fs_jpim1 jpim1
-#endif
Index: trunk/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90	(revision 2528)
@@ -0,0 +1,841 @@
+MODULE asminc
+   !!======================================================================
+   !!                       ***  MODULE asminc  ***
+   !! Assimilation increment : Apply an increment generated by data
+   !!                          assimilation
+   !!======================================================================
+   !! History :       ! 2007-03  (M. Martin)  Met Office version
+   !!                 ! 2007-04  (A. Weaver)  calc_date original code
+   !!                 ! 2007-04  (A. Weaver)  Merge with OPAVAR/NEMOVAR
+   !!   NEMO     3.3  ! 2010-05  (D. Lea)  Update to work with NEMO v3.2
+   !!             -   ! 2010-05  (D. Lea)  add calc_month_len routine based on day_init 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   'key_asminc' : Switch on the assimilation increment interface
+   !!----------------------------------------------------------------------
+   !!   asm_inc_init : Initialize the increment arrays and IAU weights
+   !!   calc_date    : Compute the calendar date YYYYMMDD on a given step
+   !!   tra_asm_inc  : Apply the tracer (T and S) increments
+   !!   dyn_asm_inc  : Apply the dynamic (u and v) increments
+   !!   ssh_asm_inc  : Apply the SSH increment
+   !!----------------------------------------------------------------------
+   USE in_out_manager   ! I/O manager
+   USE par_oce          ! Ocean space and time domain variables
+   USE dom_oce          ! Ocean space and time domain
+   USE oce              ! Dynamics and active tracers defined in memory
+   USE divcur           ! Horizontal divergence and relative vorticity
+   USE eosbn2           ! Equation of state - in situ and potential density
+   USE zpshde           ! Partial step : Horizontal Derivative
+   USE iom              ! Library to read input files
+   USE asmpar           ! Parameters for the assmilation interface
+   USE c1d              ! 1D initialization
+
+   IMPLICIT NONE
+   PRIVATE
+   
+   PUBLIC   asm_inc_init   !: Initialize the increment arrays and IAU weights
+   PUBLIC   calc_date      !: Compute the calendar date YYYYMMDD on a given step
+   PUBLIC   tra_asm_inc    !: Apply the tracer (T and S) increments
+   PUBLIC   dyn_asm_inc    !: Apply the dynamic (u and v) increments
+   PUBLIC   ssh_asm_inc    !: Apply the SSH increment
+
+#if defined key_asminc
+    LOGICAL, PUBLIC, PARAMETER :: lk_asminc = .TRUE.   !: Logical switch for assimilation increment interface
+#else
+    LOGICAL, PUBLIC, PARAMETER :: lk_asminc = .FALSE.  !: No assimilation increments
+#endif
+   LOGICAL, PUBLIC :: ln_bkgwri = .FALSE. !: No output of the background state fields
+   LOGICAL, PUBLIC :: ln_trjwri = .FALSE. !: No output of the state trajectory fields
+   LOGICAL, PUBLIC :: ln_asmiau = .FALSE. !: No applying forcing with an assimilation increment
+   LOGICAL, PUBLIC :: ln_asmdin = .FALSE. !: No direct initialization
+   LOGICAL, PUBLIC :: ln_trainc = .FALSE. !: No tracer (T and S) assimilation increments
+   LOGICAL, PUBLIC :: ln_dyninc = .FALSE. !: No dynamics (u and v) assimilation increments
+   LOGICAL, PUBLIC :: ln_sshinc = .FALSE. !: No sea surface height assimilation increment
+   LOGICAL, PUBLIC :: ln_salfix = .FALSE. !: Apply minimum salinity check
+
+   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::   t_bkg   , s_bkg      !: Background temperature and salinity
+   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::   u_bkg   , v_bkg      !: Background u- & v- velocity components
+   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::   t_bkginc, s_bkginc   !: Increment to the background T & S
+   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::   u_bkginc, v_bkginc   !: Increment to the u- & v-components 
+   REAL(wp), PUBLIC, DIMENSION(:)    , ALLOCATABLE ::   wgtiau               !: IAU weights for each time step
+#if defined key_asminc
+   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   ssh_iau           !: IAU-weighted sea surface height increment
+#endif
+   !                                !!! time steps relative to the cycle interval [0,nitend-nit000-1]
+   INTEGER , PUBLIC ::   nitbkg      !: Time step of the background state used in the Jb term
+   INTEGER , PUBLIC ::   nitdin      !: Time step of the background state for direct initialization
+   INTEGER , PUBLIC ::   nitiaustr   !: Time step of the start of the IAU interval 
+   INTEGER , PUBLIC ::   nitiaufin   !: Time step of the end of the IAU interval
+   ! 
+   INTEGER , PUBLIC ::   niaufn      !: Type of IAU weighing function: = 0   Constant weighting
+   !                                 !: = 1   Linear hat-like, centred in middle of IAU interval 
+   REAL(wp), PUBLIC ::   salfixmin   !: Ensure that the salinity is larger than this  value if (ln_salfix)
+
+   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   ssh_bkg, ssh_bkginc   ! Background sea surface height and its increment
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE asm_inc_init
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE asm_inc_init  ***
+      !!          
+      !! ** Purpose : Initialize the assimilation increment and IAU weights.
+      !!
+      !! ** Method  : Initialize the assimilation increment and IAU weights.
+      !!
+      !! ** Action  : 
+      !!----------------------------------------------------------------------
+      INTEGER :: jt
+      INTEGER :: imid
+      INTEGER :: inum
+      INTEGER :: iiauper         ! Number of time steps in the IAU period
+      INTEGER :: icycper         ! Number of time steps in the cycle
+      INTEGER :: iitend_date     ! Date YYYYMMDD of final time step
+      INTEGER :: iitbkg_date     ! Date YYYYMMDD of background time step for Jb term
+      INTEGER :: iitdin_date     ! Date YYYYMMDD of background time step for DI
+      INTEGER :: iitiaustr_date  ! Date YYYYMMDD of IAU interval start time step
+      INTEGER :: iitiaufin_date  ! Date YYYYMMDD of IAU interval final time step
+
+      REAL(wp) :: znorm        ! Normalization factor for IAU weights
+      REAL(wp) :: ztotwgt      ! Value of time-integrated IAU weights 
+                               ! (should be equal to one)
+      REAL(wp) :: z_inc_dateb  ! Start date of interval on which increment is valid
+      REAL(wp) :: z_inc_datef  ! End date of interval on which increment is valid
+      REAL(wp) :: zdate_bkg    ! Date in background state file for DI
+      REAL(wp) :: zdate_inc    ! Time axis in increments file
+      !!
+      NAMELIST/nam_asminc/ ln_bkgwri, ln_trjwri,                           &
+         &                 ln_trainc, ln_dyninc, ln_sshinc,                &
+         &                 ln_asmdin, ln_asmiau,                           &
+         &                 nitbkg, nitdin, nitiaustr, nitiaufin, niaufn,   &
+         &                 nittrjfrq, ln_salfix, salfixmin
+      !!----------------------------------------------------------------------
+
+      !-----------------------------------------------------------------------
+      ! Read Namelist nam_asminc : assimilation increment interface
+      !-----------------------------------------------------------------------
+
+      ! Set default values
+      ln_bkgwri = .FALSE.
+      ln_trjwri = .FALSE.
+      ln_trainc = .FALSE.
+      ln_dyninc = .FALSE.
+      ln_sshinc = .FALSE.
+      ln_asmdin = .FALSE.
+      ln_asmiau = .TRUE.
+      ln_salfix = .FALSE.
+      salfixmin = -9999
+      nitbkg    = 0
+      nitdin    = 0      
+      nitiaustr = 1
+      nitiaufin = 150      ! = 10 days with ORCA2
+      niaufn    = 0
+      nittrjfrq = 1
+
+      REWIND ( numnam )
+      READ   ( numnam, nam_asminc )
+
+      ! Control print
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'asm_inc_init : Assimilation increment initialization :'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namasm : set assimilation increment parameters'
+         WRITE(numout,*) '      Logical switch for writing out background state          ln_bkgwri = ', ln_bkgwri
+         WRITE(numout,*) '      Logical switch for writing out state trajectory          ln_trjwri = ', ln_trjwri
+         WRITE(numout,*) '      Logical switch for applying tracer increments            ln_trainc = ', ln_trainc
+         WRITE(numout,*) '      Logical switch for applying velocity increments          ln_dyninc = ', ln_dyninc
+         WRITE(numout,*) '      Logical switch for applying SSH increments               ln_sshinc = ', ln_sshinc
+         WRITE(numout,*) '      Logical switch for Direct Initialization (DI)            ln_asmdin = ', ln_asmdin
+         WRITE(numout,*) '      Logical switch for Incremental Analysis Updating (IAU)   ln_asmiau = ', ln_asmiau
+         WRITE(numout,*) '      Timestep of background in [0,nitend-nit000-1]            nitbkg    = ', nitbkg
+         WRITE(numout,*) '      Timestep of background for DI in [0,nitend-nit000-1]     nitdin    = ', nitdin
+         WRITE(numout,*) '      Timestep of start of IAU interval in [0,nitend-nit000-1] nitiaustr = ', nitiaustr
+         WRITE(numout,*) '      Timestep of end of IAU interval in [0,nitend-nit000-1]   nitiaufin = ', nitiaufin
+         WRITE(numout,*) '      Type of IAU weighting function                           niaufn    = ', niaufn
+         WRITE(numout,*) '      Frequency of trajectory output for 4D-VAR                nittrjfrq = ', nittrjfrq
+         WRITE(numout,*) '      Logical switch for ensuring that the sa > salfixmin      ln_salfix = ', ln_salfix
+         WRITE(numout,*) '      Minimum salinity after applying the increments           salfixmin = ', salfixmin
+      ENDIF
+
+      nitbkg_r    = nitbkg    + nit000 - 1  ! Background time referenced to nit000
+      nitdin_r    = nitdin    + nit000 - 1  ! Background time for DI referenced to nit000
+      nitiaustr_r = nitiaustr + nit000 - 1  ! Start of IAU interval referenced to nit000
+      nitiaufin_r = nitiaufin + nit000 - 1  ! End of IAU interval referenced to nit000
+
+      iiauper = nitiaufin_r - nitiaustr_r + 1  ! IAU interval length
+      icycper = nitend      - nit000      + 1  ! Cycle interval length
+
+      ! Date of final time step
+      CALL calc_date( nit000, nitend, ndate0, iitend_date )
+
+      ! Background time for Jb referenced to ndate0
+      CALL calc_date( nit000, nitbkg_r, ndate0, iitbkg_date )
+
+      ! Background time for DI referenced to ndate0
+      CALL calc_date( nit000, nitdin_r, ndate0, iitdin_date )
+
+      ! IAU start time referenced to ndate0
+      CALL calc_date( nit000, nitiaustr_r, ndate0, iitiaustr_date )
+
+      ! IAU end time referenced to ndate0
+      CALL calc_date( nit000, nitiaufin_r, ndate0, iitiaufin_date )
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '   Time steps referenced to current cycle:'
+         WRITE(numout,*) '       iitrst      = ', nit000 - 1
+         WRITE(numout,*) '       nit000      = ', nit000
+         WRITE(numout,*) '       nitend      = ', nitend
+         WRITE(numout,*) '       nitbkg_r    = ', nitbkg_r
+         WRITE(numout,*) '       nitdin_r    = ', nitdin_r
+         WRITE(numout,*) '       nitiaustr_r = ', nitiaustr_r
+         WRITE(numout,*) '       nitiaufin_r = ', nitiaufin_r
+         WRITE(numout,*) '       nittrjfrq   = ', nittrjfrq
+         WRITE(numout,*)
+         WRITE(numout,*) '   Dates referenced to current cycle:'
+         WRITE(numout,*) '       ndastp         = ', ndastp
+         WRITE(numout,*) '       ndate0         = ', ndate0
+         WRITE(numout,*) '       iitend_date    = ', iitend_date
+         WRITE(numout,*) '       iitbkg_date    = ', iitbkg_date
+         WRITE(numout,*) '       iitdin_date    = ', iitdin_date
+         WRITE(numout,*) '       iitiaustr_date = ', iitiaustr_date
+         WRITE(numout,*) '       iitiaufin_date = ', iitiaufin_date
+      ENDIF
+
+      IF ( nacc /= 0 ) &
+         & CALL ctl_stop( ' nacc /= 0 and key_asminc :',  &
+         &                ' Assimilation increments have only been implemented', &
+         &                ' for synchronous time stepping' )
+
+      IF ( ( ln_asmdin ).AND.( ln_asmiau ) )   &
+         & CALL ctl_stop( ' ln_asmdin and ln_asmiau :', &
+         &                ' Choose Direct Initialization OR Incremental Analysis Updating')
+
+      IF (      ( ( .NOT. ln_asmdin ).AND.( .NOT. ln_asmiau ) ) &
+           .AND.( ( ln_trainc ).OR.( ln_dyninc ).OR.( ln_sshinc ) ) ) &
+         & CALL ctl_stop( ' One or more of ln_trainc, ln_dyninc and ln_sshinc is set to .true.', &
+         &                ' but ln_asmdin and ln_asmiau are both set to .false. :', &
+         &                ' Inconsistent options')
+
+      IF ( ( ln_bkgwri ).AND.( ( ln_asmdin ).OR.( ln_asmiau ) ) )  &
+         & CALL ctl_stop( ' ln_bkgwri and either ln_asmdin or ln_asmiau are set to .true.:', &
+         &                ' The background state must be written before applying the increments')
+
+      IF ( ( niaufn /= 0 ).AND.( niaufn /= 1 ) ) &
+         & CALL ctl_stop( ' niaufn /= 0 or niaufn /=1 :',  &
+         &                ' Type IAU weighting function is invalid')
+
+      IF ( ( .NOT. ln_trainc ).AND.( .NOT. ln_dyninc ).AND.( .NOT. ln_sshinc ) &
+         &                     )  &
+         & CALL ctl_warn( ' ln_trainc, ln_dyninc and ln_sshinc are set to .false. :', &
+         &                ' The assimilation increments are not applied')
+
+      IF ( ( ln_asmiau ).AND.( nitiaustr == nitiaufin ) ) &
+         & CALL ctl_stop( ' nitiaustr = nitiaufin :',  &
+         &                ' IAU interval is of zero length')
+
+      IF ( ( ln_asmiau ).AND.( ( nitiaustr_r < nit000 ).OR.( nitiaufin_r > nitend ) ) ) &
+         & CALL ctl_stop( ' nitiaustr or nitiaufin :',  &
+         &                ' IAU starting or final time step is outside the cycle interval', &
+         &                 ' Valid range nit000 to nitend')
+
+      IF ( ( nitbkg_r < nit000 - 1 ).OR.( nitbkg_r > nitend ) ) &
+         & CALL ctl_stop( ' nitbkg :',  &
+         &                ' Background time step is outside the cycle interval')
+
+      IF ( ( nitdin_r < nit000 - 1 ).OR.( nitdin_r > nitend ) ) &
+         & CALL ctl_stop( ' nitdin :',  &
+         &                ' Background time step for Direct Initialization is outside', &
+         &                ' the cycle interval')
+
+      IF ( nstop > 0 ) RETURN       ! if there are any errors then go no further
+
+      !--------------------------------------------------------------------
+      ! Initialize the Incremental Analysis Updating weighting function
+      !--------------------------------------------------------------------
+
+      IF ( ln_asmiau ) THEN
+
+         ALLOCATE( wgtiau( icycper ) )
+
+         wgtiau(:) = 0.0
+
+         IF ( niaufn == 0 ) THEN
+
+            !---------------------------------------------------------
+            ! Constant IAU forcing 
+            !---------------------------------------------------------
+
+            DO jt = 1, iiauper
+               wgtiau(jt+nitiaustr-1) = 1.0 / REAL( iiauper )
+            END DO
+
+         ELSEIF ( niaufn == 1 ) THEN
+
+            !---------------------------------------------------------
+            ! Linear hat-like, centred in middle of IAU interval 
+            !---------------------------------------------------------
+
+            ! Compute the normalization factor
+            znorm = 0.0
+            IF ( MOD( iiauper, 2 ) == 0 ) THEN  ! Even number of time steps in IAU interval
+               imid = iiauper / 2 
+               DO jt = 1, imid
+                  znorm = znorm + REAL( jt )
+               END DO
+               znorm = 2.0 * znorm
+            ELSE                               ! Odd number of time steps in IAU interval
+               imid = ( iiauper + 1 ) / 2        
+               DO jt = 1, imid - 1
+                  znorm = znorm + REAL( jt )
+               END DO
+               znorm = 2.0 * znorm + REAL( imid )
+            ENDIF
+            znorm = 1.0 / znorm
+
+            DO jt = 1, imid - 1
+               wgtiau(jt+nitiaustr-1) = REAL( jt ) * znorm
+            END DO
+            DO jt = imid, iiauper
+               wgtiau(jt+nitiaustr-1) = REAL( iiauper - jt + 1 ) * znorm
+            END DO
+
+         ENDIF
+
+         ! Test that the integral of the weights over the weighting interval equals 1
+          IF(lwp) THEN
+             WRITE(numout,*)
+             WRITE(numout,*) 'asm_inc_init : IAU weights'
+             WRITE(numout,*) '~~~~~~~~~~~~'
+             WRITE(numout,*) '             time step         IAU  weight'
+             WRITE(numout,*) '             =========     ====================='
+             ztotwgt = 0.0
+             DO jt = 1, icycper
+                ztotwgt = ztotwgt + wgtiau(jt)
+                WRITE(numout,*) '         ', jt, '       ', wgtiau(jt) 
+             END DO   
+             WRITE(numout,*) '         ==================================='
+             WRITE(numout,*) '         Time-integrated weight = ', ztotwgt
+             WRITE(numout,*) '         ==================================='
+          ENDIF
+         
+      ENDIF
+
+      !--------------------------------------------------------------------
+      ! Allocate and initialize the increment arrays
+      !--------------------------------------------------------------------
+
+      ALLOCATE( t_bkginc(jpi,jpj,jpk) )
+      ALLOCATE( s_bkginc(jpi,jpj,jpk) )
+      ALLOCATE( u_bkginc(jpi,jpj,jpk) )
+      ALLOCATE( v_bkginc(jpi,jpj,jpk) )
+      ALLOCATE( ssh_bkginc(jpi,jpj)   )
+#if defined key_asminc
+      ALLOCATE( ssh_iau(jpi,jpj)      )
+#endif
+      t_bkginc(:,:,:) = 0.0
+      s_bkginc(:,:,:) = 0.0
+      u_bkginc(:,:,:) = 0.0
+      v_bkginc(:,:,:) = 0.0
+      ssh_bkginc(:,:) = 0.0
+#if defined key_asminc
+      ssh_iau(:,:)    = 0.0
+#endif
+      IF ( ( ln_trainc ).OR.( ln_dyninc ).OR.( ln_sshinc ) ) THEN
+
+         !--------------------------------------------------------------------
+         ! Read the increments from file
+         !--------------------------------------------------------------------
+
+         CALL iom_open( c_asminc, inum )
+
+         CALL iom_get( inum, 'time', zdate_inc ) 
+
+         CALL iom_get( inum, 'z_inc_dateb', z_inc_dateb )
+         CALL iom_get( inum, 'z_inc_datef', z_inc_datef )
+         z_inc_dateb = zdate_inc
+         z_inc_datef = zdate_inc
+
+         IF(lwp) THEN
+            WRITE(numout,*) 
+            WRITE(numout,*) 'asm_inc_init : Assimilation increments valid ', &
+               &            ' between dates ', NINT( z_inc_dateb ),' and ',  &
+               &            NINT( z_inc_datef )
+            WRITE(numout,*) '~~~~~~~~~~~~'
+         ENDIF
+
+         IF (     ( NINT( z_inc_dateb ) < ndastp      ) &
+            & .OR.( NINT( z_inc_datef ) > iitend_date ) ) &
+            & CALL ctl_warn( ' Validity time of assimilation increments is ', &
+            &                ' outside the assimilation interval' )
+
+         IF ( ( ln_asmdin ).AND.( NINT( zdate_inc ) /= iitdin_date ) ) &
+            & CALL ctl_warn( ' Validity time of assimilation increments does ', &
+            &                ' not agree with Direct Initialization time' )
+
+         IF ( ln_trainc ) THEN   
+            CALL iom_get( inum, jpdom_autoglo, 'bckint', t_bkginc, 1 )
+            CALL iom_get( inum, jpdom_autoglo, 'bckins', s_bkginc, 1 )
+            ! Apply the masks
+            t_bkginc(:,:,:) = t_bkginc(:,:,:) * tmask(:,:,:)
+            s_bkginc(:,:,:) = s_bkginc(:,:,:) * tmask(:,:,:)
+            ! Set missing increments to 0.0 rather than 1e+20
+            ! to allow for differences in masks
+            WHERE( ABS( t_bkginc(:,:,:) ) > 1.0e+10 ) t_bkginc(:,:,:) = 0.0
+            WHERE( ABS( s_bkginc(:,:,:) ) > 1.0e+10 ) s_bkginc(:,:,:) = 0.0
+         ENDIF
+
+         IF ( ln_dyninc ) THEN   
+            CALL iom_get( inum, jpdom_autoglo, 'bckinu', u_bkginc, 1 )              
+            CALL iom_get( inum, jpdom_autoglo, 'bckinv', v_bkginc, 1 )              
+            ! Apply the masks
+            u_bkginc(:,:,:) = u_bkginc(:,:,:) * umask(:,:,:)
+            v_bkginc(:,:,:) = v_bkginc(:,:,:) * vmask(:,:,:)
+            ! Set missing increments to 0.0 rather than 1e+20
+            ! to allow for differences in masks
+            WHERE( ABS( u_bkginc(:,:,:) ) > 1.0e+10 ) u_bkginc(:,:,:) = 0.0
+            WHERE( ABS( v_bkginc(:,:,:) ) > 1.0e+10 ) v_bkginc(:,:,:) = 0.0
+         ENDIF
+        
+         IF ( ln_sshinc ) THEN
+            CALL iom_get( inum, jpdom_autoglo, 'bckineta', ssh_bkginc, 1 )
+            ! Apply the masks
+            ssh_bkginc(:,:) = ssh_bkginc(:,:) * tmask(:,:,1)
+            ! Set missing increments to 0.0 rather than 1e+20
+            ! to allow for differences in masks
+            WHERE( ABS( ssh_bkginc(:,:) ) > 1.0e+10 ) ssh_bkginc(:,:) = 0.0
+         ENDIF
+
+         CALL iom_close( inum )
+ 
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Allocate and initialize the background state arrays
+      !-----------------------------------------------------------------------
+
+      IF ( ln_asmdin ) THEN
+
+         ALLOCATE( t_bkg(jpi,jpj,jpk) )
+         ALLOCATE( s_bkg(jpi,jpj,jpk) )
+         ALLOCATE( u_bkg(jpi,jpj,jpk) )
+         ALLOCATE( v_bkg(jpi,jpj,jpk) )
+         ALLOCATE( ssh_bkg(jpi,jpj)   )
+
+         t_bkg(:,:,:) = 0.0
+         s_bkg(:,:,:) = 0.0
+         u_bkg(:,:,:) = 0.0
+         v_bkg(:,:,:) = 0.0
+         ssh_bkg(:,:) = 0.0
+
+         !--------------------------------------------------------------------
+         ! Read from file the background state at analysis time
+         !--------------------------------------------------------------------
+
+         CALL iom_open( c_asmdin, inum )
+
+         CALL iom_get( inum, 'zdate', zdate_bkg ) 
+        
+         IF(lwp) THEN
+            WRITE(numout,*) 
+            WRITE(numout,*) 'asm_inc_init : Assimilation background state valid at : ', &
+               &  NINT( zdate_bkg )
+            WRITE(numout,*) '~~~~~~~~~~~~'
+         ENDIF
+
+         IF ( NINT( zdate_bkg ) /= iitdin_date ) &
+            & CALL ctl_warn( ' Validity time of assimilation background state does', &
+            &                ' not agree with Direct Initialization time' )
+
+         IF ( ln_trainc ) THEN   
+            CALL iom_get( inum, jpdom_autoglo, 'tn', t_bkg )
+            CALL iom_get( inum, jpdom_autoglo, 'sn', s_bkg )
+            t_bkg(:,:,:) = t_bkg(:,:,:) * tmask(:,:,:)
+            s_bkg(:,:,:) = s_bkg(:,:,:) * tmask(:,:,:)
+         ENDIF
+
+         IF ( ln_dyninc ) THEN   
+            CALL iom_get( inum, jpdom_autoglo, 'un', u_bkg )
+            CALL iom_get( inum, jpdom_autoglo, 'vn', v_bkg )
+            u_bkg(:,:,:) = u_bkg(:,:,:) * umask(:,:,:)
+            v_bkg(:,:,:) = v_bkg(:,:,:) * vmask(:,:,:)
+         ENDIF
+        
+         IF ( ln_sshinc ) THEN
+            CALL iom_get( inum, jpdom_autoglo, 'sshn', ssh_bkg )
+            ssh_bkg(:,:) = ssh_bkg(:,:) * tmask(:,:,1)
+         ENDIF
+
+         CALL iom_close( inum )
+
+      ENDIF
+      !
+   END SUBROUTINE asm_inc_init
+
+
+   SUBROUTINE calc_date( kit000, kt, kdate0, kdate )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE calc_date  ***
+      !!          
+      !! ** Purpose : Compute the calendar date YYYYMMDD at a given time step.
+      !!
+      !! ** Method  : Compute the calendar date YYYYMMDD at a given time step.
+      !!
+      !! ** Action  : 
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(IN) :: kit000  ! Initial time step
+      INTEGER, INTENT(IN) :: kt      ! Current time step referenced to kit000
+      INTEGER, INTENT(IN) :: kdate0  ! Initial date
+      INTEGER, INTENT(OUT) :: kdate  ! Current date reference to kdate0
+      !
+      INTEGER :: iyea0    ! Initial year
+      INTEGER :: imon0    ! Initial month
+      INTEGER :: iday0    ! Initial day
+      INTEGER :: iyea     ! Current year
+      INTEGER :: imon     ! Current month
+      INTEGER :: iday     ! Current day
+      INTEGER :: idaystp  ! Number of days between initial and current date
+      INTEGER :: idaycnt  ! Day counter
+
+      INTEGER, DIMENSION(12) ::   imonth_len    !: length in days of the months of the current year
+
+      !-----------------------------------------------------------------------
+      ! Compute the calendar date YYYYMMDD
+      !-----------------------------------------------------------------------
+
+      ! Initial date
+      iyea0 =   kdate0 / 10000
+      imon0 = ( kdate0 - ( iyea0 * 10000 ) ) / 100
+      iday0 =   kdate0 - ( iyea0 * 10000 ) - ( imon0 * 100 ) 
+
+      ! Check that kt >= kit000 - 1
+      IF ( kt < kit000 - 1 ) CALL ctl_stop( ' kt must be >= kit000 - 1')
+
+      ! If kt = kit000 - 1 then set the date to the restart date
+      IF ( kt == kit000 - 1 ) THEN
+
+         kdate = ndastp
+         RETURN
+
+      ENDIF
+
+      ! Compute the number of days from the initial date
+      idaystp = INT( REAL( kt - kit000 ) * rdt / 86400. )
+   
+      iday    = iday0
+      imon    = imon0
+      iyea    = iyea0
+      idaycnt = 0
+
+      CALL calc_month_len( iyea, imonth_len )
+
+      DO WHILE ( idaycnt < idaystp )
+         iday = iday + 1
+         IF ( iday > imonth_len(imon) )  THEN
+            iday = 1
+            imon = imon + 1
+         ENDIF
+         IF ( imon > 12 ) THEN
+            imon = 1
+            iyea = iyea + 1
+            CALL calc_month_len( iyea, imonth_len )  ! update month lengths
+         ENDIF                 
+         idaycnt = idaycnt + 1
+      END DO
+      !
+      kdate = iyea * 10000 + imon * 100 + iday
+      !
+   END SUBROUTINE
+
+
+   SUBROUTINE calc_month_len( iyear, imonth_len )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE calc_month_len  ***
+      !!          
+      !! ** Purpose : Compute the number of days in a months given a year.
+      !!
+      !! ** Method  : 
+      !!----------------------------------------------------------------------
+      INTEGER, DIMENSION(12) ::   imonth_len    !: length in days of the months of the current year
+      INTEGER :: iyear         !: year
+      !!----------------------------------------------------------------------
+      !
+      ! length of the month of the current year (from nleapy, read in namelist)
+      IF ( nleapy < 2 ) THEN 
+         imonth_len(:) = (/ 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /)
+         IF ( nleapy == 1 ) THEN   ! we are using calendar with leap years
+            IF ( MOD(iyear, 4) == 0 .AND. ( MOD(iyear, 400) == 0 .OR. MOD(iyear, 100) /= 0 ) ) THEN
+               imonth_len(2) = 29
+            ENDIF
+         ENDIF
+      ELSE
+         imonth_len(:) = nleapy   ! all months with nleapy days per year
+      ENDIF
+      !
+   END SUBROUTINE
+
+
+   SUBROUTINE tra_asm_inc( kt )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE tra_asm_inc  ***
+      !!          
+      !! ** Purpose : Apply the tracer (T and S) assimilation increments
+      !!
+      !! ** Method  : Direct initialization or Incremental Analysis Updating
+      !!
+      !! ** Action  : 
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(IN) :: kt               ! Current time step
+      !
+      INTEGER :: ji,jj,jk
+      INTEGER :: it
+      REAL(wp) :: zincwgt  ! IAU weight for current time step
+      !!----------------------------------------------------------------------
+
+      IF ( ln_asmiau ) THEN
+
+         !--------------------------------------------------------------------
+         ! Incremental Analysis Updating
+         !--------------------------------------------------------------------
+
+         IF ( ( kt >= nitiaustr_r ).AND.( kt <= nitiaufin_r ) ) THEN
+
+            it = kt - nit000 + 1
+            zincwgt = wgtiau(it) / rdt   ! IAU weight for the current time step
+
+            IF(lwp) THEN
+               WRITE(numout,*) 
+               WRITE(numout,*) 'tra_asm_inc : Tracer IAU at time step = ', &
+                  &  kt,' with IAU weight = ', wgtiau(it)
+               WRITE(numout,*) '~~~~~~~~~~~~'
+            ENDIF
+
+            ! Update the tracer tendencies
+            DO jk = 1, jpkm1
+               tsa(:,:,jk,jp_tem) = tsa(:,:,jk,jp_tem) + t_bkginc(:,:,jk) * zincwgt  
+               tsa(:,:,jk,jp_sal) = tsa(:,:,jk,jp_sal) + s_bkginc(:,:,jk) * zincwgt
+            END DO
+
+            ! Salinity fix
+            IF (ln_salfix) THEN
+               DO jk = 1, jpkm1
+                  DO jj = 1, jpj
+                     DO ji= 1, jpi
+                        tsa(ji,jj,jk,jp_sal) = MAX( tsa(ji,jj,jk,jp_sal), salfixmin )
+                     END DO
+                  END DO
+               END DO
+            ENDIF
+
+         ENDIF
+
+         IF ( kt == nitiaufin_r + 1  ) THEN   ! For bias crcn to work
+            DEALLOCATE( t_bkginc )
+            DEALLOCATE( s_bkginc )
+         ENDIF
+
+
+      ELSEIF ( ln_asmdin ) THEN
+
+         !--------------------------------------------------------------------
+         ! Direct Initialization
+         !--------------------------------------------------------------------
+            
+         IF ( kt == nitdin_r ) THEN
+
+            neuler = 0  ! Force Euler forward step
+
+            ! Initialize the now fields with the background + increment
+            tsn(:,:,:,jp_tem) = t_bkg(:,:,:) + t_bkginc(:,:,:)   
+            tsn(:,:,:,jp_sal) = s_bkg(:,:,:) + s_bkginc(:,:,:)   
+
+            ! Optional salinity fix
+            IF (ln_salfix) THEN
+               DO jk = 1, jpkm1
+                  DO jj = 1, jpj
+                     DO ji= 1, jpi
+                        tsn(ji,jj,jk,jp_sal) = MAX( tsn(ji,jj,jk,jp_sal), salfixmin )
+                     END DO
+                  END DO
+               END DO
+            ENDIF
+
+            tsb(:,:,:,:) = tsn(:,:,:,:)                        ! Update before fields
+
+            CALL eos( tsb, rhd, rhop )                ! Before potential and in situ densities
+         
+            IF( ln_zps .AND. .NOT. lk_c1d ) &
+               &  CALL zps_hde( nit000, jpts, tsb,   &  ! Partial steps: before horizontal derivative
+               &                gtsu, gtsv, rhd,        &  ! of T, S, rd at the bottom ocean level
+               &                gru , grv )
+
+            DEALLOCATE( t_bkginc )
+            DEALLOCATE( s_bkginc )
+            DEALLOCATE( t_bkg    )
+            DEALLOCATE( s_bkg    )
+         ENDIF
+         !  
+      ENDIF
+      !
+   END SUBROUTINE tra_asm_inc
+
+
+   SUBROUTINE dyn_asm_inc( kt )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE dyn_asm_inc  ***
+      !!          
+      !! ** Purpose : Apply the dynamics (u and v) assimilation increments.
+      !!
+      !! ** Method  : Direct initialization or Incremental Analysis Updating.
+      !!
+      !! ** Action  : 
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(IN) :: kt   ! Current time step
+      !
+      INTEGER :: jk
+      INTEGER :: it
+      REAL(wp) :: zincwgt  ! IAU weight for current time step
+      !!----------------------------------------------------------------------
+
+      IF ( ln_asmiau ) THEN
+
+         !--------------------------------------------------------------------
+         ! Incremental Analysis Updating
+         !--------------------------------------------------------------------
+
+         IF ( ( kt >= nitiaustr_r ).AND.( kt <= nitiaufin_r ) ) THEN
+
+            it = kt - nit000 + 1
+            zincwgt = wgtiau(it) / rdt   ! IAU weight for the current time step
+
+            IF(lwp) THEN
+               WRITE(numout,*) 
+               WRITE(numout,*) 'dyn_asm_inc : Dynamics IAU at time step = ', &
+                  &  kt,' with IAU weight = ', wgtiau(it)
+               WRITE(numout,*) '~~~~~~~~~~~~'
+            ENDIF
+
+            ! Update the dynamic tendencies
+            DO jk = 1, jpkm1
+               ua(:,:,jk) = ua(:,:,jk) + u_bkginc(:,:,jk) * zincwgt
+               va(:,:,jk) = va(:,:,jk) + v_bkginc(:,:,jk) * zincwgt
+            END DO
+           
+            IF ( kt == nitiaufin_r ) THEN
+               DEALLOCATE( u_bkginc )
+               DEALLOCATE( v_bkginc )
+            ENDIF
+
+         ENDIF
+
+      ELSEIF ( ln_asmdin ) THEN 
+
+         !--------------------------------------------------------------------
+         ! Direct Initialization
+         !--------------------------------------------------------------------
+         
+         IF ( kt == nitdin_r ) THEN
+
+            neuler = 0                    ! Force Euler forward step
+
+            ! Initialize the now fields with the background + increment
+            un(:,:,:) = u_bkg(:,:,:) + u_bkginc(:,:,:)
+            vn(:,:,:) = v_bkg(:,:,:) + v_bkginc(:,:,:)  
+
+            ub(:,:,:) = un(:,:,:)         ! Update before fields
+            vb(:,:,:) = vn(:,:,:)
+ 
+            CALL div_cur( kt )            ! Compute divergence and curl for now fields
+
+            rotb (:,:,:) = rotn (:,:,:)   ! Update before fields
+            hdivb(:,:,:) = hdivn(:,:,:)
+
+            DEALLOCATE( u_bkg    )
+            DEALLOCATE( v_bkg    )
+            DEALLOCATE( u_bkginc )
+            DEALLOCATE( v_bkginc )
+         ENDIF
+         !
+      ENDIF
+      !
+   END SUBROUTINE dyn_asm_inc
+
+
+   SUBROUTINE ssh_asm_inc( kt )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE ssh_asm_inc  ***
+      !!          
+      !! ** Purpose : Apply the sea surface height assimilation increment.
+      !!
+      !! ** Method  : Direct initialization or Incremental Analysis Updating.
+      !!
+      !! ** Action  : 
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(IN) :: kt   ! Current time step
+      !
+      INTEGER :: it
+      REAL(wp) :: zincwgt  ! IAU weight for current time step
+      !!----------------------------------------------------------------------
+
+      IF ( ln_asmiau ) THEN
+
+         !--------------------------------------------------------------------
+         ! Incremental Analysis Updating
+         !--------------------------------------------------------------------
+
+         IF ( ( kt >= nitiaustr_r ).AND.( kt <= nitiaufin_r ) ) THEN
+
+            it = kt - nit000 + 1
+            zincwgt = wgtiau(it) / rdt   ! IAU weight for the current time step
+
+            IF(lwp) THEN
+               WRITE(numout,*) 
+               WRITE(numout,*) 'ssh_asm_inc : SSH IAU at time step = ', &
+                  &  kt,' with IAU weight = ', wgtiau(it)
+               WRITE(numout,*) '~~~~~~~~~~~~'
+            ENDIF
+
+            ! Save the tendency associated with the IAU weighted SSH increment
+            ! (applied in dynspg.*)
+#if defined key_asminc
+            ssh_iau(:,:) = ssh_bkginc(:,:) * zincwgt
+#endif
+            IF ( kt == nitiaufin_r ) THEN
+               DEALLOCATE( ssh_bkginc )
+            ENDIF
+
+         ENDIF
+
+      ELSEIF ( ln_asmdin ) THEN
+
+         !--------------------------------------------------------------------
+         ! Direct Initialization
+         !--------------------------------------------------------------------
+
+         IF ( kt == nitdin_r ) THEN
+
+            neuler = 0                    ! Force Euler forward step
+
+            ! Initialize the now fields the background + increment
+            sshn(:,:) = ssh_bkg(:,:) + ssh_bkginc(:,:)  
+
+            sshb(:,:) = sshn(:,:)         ! Update before fields
+
+            DEALLOCATE( ssh_bkg    )
+            DEALLOCATE( ssh_bkginc )
+
+         ENDIF
+         !
+      ENDIF
+      !
+   END SUBROUTINE ssh_asm_inc
+
+   !!======================================================================
+END MODULE asminc
Index: trunk/NEMOGCM/NEMO/OPA_SRC/ASM/asmpar.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/ASM/asmpar.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/ASM/asmpar.F90	(revision 2528)
@@ -0,0 +1,38 @@
+MODULE asmpar
+   !!======================================================================
+   !!                       ***  MODULE asmpar  ***
+   !! Assimilation increment : Parameters for assimilation interface
+   !!======================================================================
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   !! * Shared Modules variables
+   CHARACTER (LEN=40), PUBLIC, PARAMETER :: &
+      & c_asmbkg = 'assim_background_state_Jb',  & !: Filename for storing the 
+                                                   !: background state for use 
+                                                   !: in the Jb term
+      & c_asmdin = 'assim_background_state_DI',  & !: Filename for storing the 
+                                                   !: background state for direct 
+                                                   !: initialization
+      & c_asmtrj = 'assim_trj',                  & !: Filename for storing the 
+                                                   !: reference trajectory
+      & c_asminc = 'assim_background_increments'   !: Filename for storing the 
+                                                   !: increments to the background
+                                                   !: state
+
+   INTEGER, PUBLIC :: nitbkg_r      !: Background time step referenced to nit000
+   INTEGER, PUBLIC :: nitdin_r      !: Direct Initialization time step referenced to nit000
+   INTEGER, PUBLIC :: nitiaustr_r   !: IAU starting time step referenced to nit000
+   INTEGER, PUBLIC :: nitiaufin_r   !: IAU final time step referenced to nit000
+   INTEGER, PUBLIC :: nittrjfrq     !: Frequency of trajectory output for 4D-VAR
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+END MODULE asmpar
Index: trunk/NEMOGCM/NEMO/OPA_SRC/ASM/asmtrj.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/ASM/asmtrj.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/ASM/asmtrj.F90	(revision 2528)
@@ -0,0 +1,250 @@
+MODULE asmtrj
+   !!======================================================================
+   !!                       ***  MODULE asmtrj  ***
+   !! Assimilation trajectory interface: Write to file the background state and the model state trajectory
+   !!======================================================================
+   !! History :       ! 2007-03 (M. Martin)  Met. Office version
+   !!                 ! 2007-04 (A. Weaver)  asm_trj_wri, original code
+   !!                 ! 2007-03 (K. Mogensen)  Adapt to NEMOVAR and use IOM instead of IOIPSL
+   !!                 ! 2007-04 (A. Weaver)  Name change (formally asmbkg.F90). Distinguish
+   !!                                        background states in Jb term and at analysis time.
+   !!                                        Include state trajectory routine (currently empty)
+   !!                 ! 2007-07 (A. Weaver)  Add tke_rst and flt_rst for case nitbkg=0 
+   !!                 ! 2009-03 (F. Vigilant)  Add hmlp (zdfmxl) for no tracer nmldp=2 
+   !!                 ! 2009-06 (F. Vigilant) asm_trj_wri: special case when kt=nit000-1
+   !!                 ! 2009-07 (F. Vigilant) asm_trj_wri: add computation of eiv at restart
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   'key_asminc' : Switch on the assimilation increment interface
+   !!----------------------------------------------------------------------
+   !!   asm_bkg_wri  : Write out the background state
+   !!   asm_trj_wri  : Write out the model state trajectory (used with 4D-Var)
+   !!----------------------------------------------------------------------
+   USE oce                ! Dynamics and active tracers defined in memory
+   USE sbc_oce            ! Ocean surface boundary conditions
+   USE zdf_oce            ! Vertical mixing variables
+   USE zdfddm             ! Double diffusion mixing parameterization
+   USE ldftra_oce         ! Lateral tracer mixing coefficient defined in memory
+   USE ldfslp             ! Slopes of neutral surfaces
+   USE tradmp             ! Tracer damping
+#if defined key_zdftke
+   USE zdftke             ! TKE vertical physics
+#endif
+   USE eosbn2             ! Equation of state (eos_bn2 routine)
+   USE zdfmxl             ! Mixed layer depth
+   USE dom_oce, ONLY :   ndastp
+   USE sol_oce, ONLY :   gcx   ! Solver variables defined in memory
+   USE in_out_manager     ! I/O manager
+   USE iom                ! I/O module
+   USE asmpar             ! Parameters for the assmilation interface
+   USE zdfmxl             ! mixed layer depth
+#if defined key_traldf_c2d
+   USE ldfeiv             ! eddy induced velocity coef.      (ldf_eiv routine)
+#endif
+
+   IMPLICIT NONE
+   PRIVATE
+   
+   PUBLIC   asm_bkg_wri   !: Write out the background state
+   PUBLIC   asm_trj_wri   !: Write out the background state
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE asm_bkg_wri( kt )
+      !!-----------------------------------------------------------------------
+      !!                  ***  ROUTINE asm_bkg_wri ***
+      !!
+      !! ** Purpose : Write to file the background state for later use in the
+      !!              inner loop of data assimilation or for direct initialization
+      !!              in the outer loop.
+      !!
+      !! ** Method  : Write out the background state for use in the Jb term
+      !!              in the cost function and for use with direct initialization
+      !!              at analysis time.
+      !!-----------------------------------------------------------------------
+      INTEGER, INTENT( IN ) :: kt               ! Current time-step
+      !
+      CHARACTER (LEN=50) :: cl_asmbkg
+      CHARACTER (LEN=50) :: cl_asmdin
+      LOGICAL :: llok          ! Check if file exists
+      INTEGER :: inum          ! File unit number
+      REAL(wp) :: zdate        ! Date
+      !!-----------------------------------------------------------------------
+
+      !                                !-------------------------------------------
+      IF( kt == nitbkg_r ) THEN        ! Write out background at time step nitbkg_r
+         !                             !-----------------------------------========
+         !
+         WRITE(cl_asmbkg, FMT='(A,".nc")' ) TRIM( c_asmbkg )
+         cl_asmbkg = TRIM( cl_asmbkg )
+         INQUIRE( FILE = cl_asmbkg, EXIST = llok )
+         !
+         IF( .NOT. llok ) THEN
+            IF(lwp) WRITE(numout,*) ' Setting up assimilation background file '// TRIM( c_asmbkg )
+            !
+            !                                      ! Define the output file        
+            CALL iom_open( c_asmbkg, inum, ldwrt = .TRUE., kiolib = jprstlib)
+            !
+            IF( nitbkg_r == nit000 - 1 ) THEN      ! Treat special case when nitbkg = 0
+               zdate = REAL( ndastp )
+#if defined key_zdftke
+               ! lk_zdftke=T :   Read turbulent kinetic energy ( en )
+               IF(lwp) WRITE(numout,*) ' Reading TKE (en) from restart...'
+               CALL tke_rst( nit000, 'READ' )               ! lk_zdftke=T :   Read turbulent kinetic energy ( en )
+
+#endif
+            ELSE
+               zdate = REAL( ndastp )
+            ENDIF
+            !
+            !                                      ! Write the information
+            CALL iom_rstput( kt, nitbkg_r, inum, 'rdastp' , zdate   )
+            CALL iom_rstput( kt, nitbkg_r, inum, 'un'     , un      )
+            CALL iom_rstput( kt, nitbkg_r, inum, 'vn'     , vn      )
+            CALL iom_rstput( kt, nitbkg_r, inum, 'tn'     , tn      )
+            CALL iom_rstput( kt, nitbkg_r, inum, 'sn'     , sn      )
+            CALL iom_rstput( kt, nitbkg_r, inum, 'sshn'   , sshn    )
+#if defined key_zdftke
+            CALL iom_rstput( kt, nitbkg_r, inum, 'en'     , en      )
+#endif
+            CALL iom_rstput( kt, nitbkg_r, inum, 'gcx'    , gcx     )
+            !
+            CALL iom_close( inum )
+         ENDIF
+         !
+      ENDIF
+
+      !                                !-------------------------------------------
+      IF( kt == nitdin_r ) THEN        ! Write out background at time step nitdin_r
+         !                             !-----------------------------------========
+         !
+         WRITE(cl_asmdin, FMT='(A,".nc")' ) TRIM( c_asmdin )
+         cl_asmdin = TRIM( cl_asmdin )
+         INQUIRE( FILE = cl_asmdin, EXIST = llok )
+         !
+         IF( .NOT. llok ) THEN
+            IF(lwp) WRITE(numout,*) ' Setting up assimilation background file '// TRIM( c_asmdin )
+            !
+            !                                      ! Define the output file        
+            CALL iom_open( c_asmdin, inum, ldwrt = .TRUE., kiolib = jprstlib)
+            !
+            IF( nitdin_r == nit000 - 1 ) THEN      ! Treat special case when nitbkg = 0
+
+               zdate = REAL( ndastp )
+            ELSE
+               zdate = REAL( ndastp )
+            ENDIF
+            !
+            !                                      ! Write the information
+            CALL iom_rstput( kt, nitdin_r, inum, 'rdastp' , zdate   )
+            CALL iom_rstput( kt, nitdin_r, inum, 'un'     , un      )
+            CALL iom_rstput( kt, nitdin_r, inum, 'vn'     , vn      )
+            CALL iom_rstput( kt, nitdin_r, inum, 'tn'     , tn      )
+            CALL iom_rstput( kt, nitdin_r, inum, 'sn'     , sn      )
+            CALL iom_rstput( kt, nitdin_r, inum, 'sshn'   , sshn    )
+            !
+            CALL iom_close( inum )
+         ENDIF
+         !
+      ENDIF
+      !                    
+   END SUBROUTINE asm_bkg_wri
+
+
+   SUBROUTINE asm_trj_wri( kt )
+      !!-----------------------------------------------------------------------
+      !!                  ***  ROUTINE asm_trj_wri ***
+      !!
+      !! ** Purpose :   Write to file the model state trajectory for use with 4D-Var.
+      !!-----------------------------------------------------------------------
+      INTEGER, INTENT( IN ) :: kt             ! Current time-step
+      !
+      INTEGER :: inum                  ! File unit number
+      INTEGER :: it
+      CHARACTER (LEN=50) :: cl_asmtrj
+      REAL(wp) :: zdate            ! Date
+      !!-----------------------------------------------------------------------
+
+      !------------------------------------------------------------------------
+      ! Write a single file for each trajectory time step
+      !------------------------------------------------------------------------
+      IF( ( MOD( kt - nit000 + 1, nittrjfrq ) == 0 ) .OR. ( kt == nitend ) ) THEN
+         
+         IF( kt == nit000 - 1 ) THEN         ! Treat special case when kt = nit000-1
+            !
+#if defined key_zdftke
+            IF(lwp) WRITE(numout,*) ' Computing  zdf_tke coeff. form restart...'
+            ! Compute the vertical eddy viscosity and diffusivity coefficients
+            CALL zdf_tke( nit000 )
+#endif
+#if defined key_zdfddm
+            IF(lwp) WRITE(numout,*) ' Computing zdf_ddm coeff. from restart...'
+            ! Compute the vertical eddy viscosity and diffusivity coefficients (salt effect)
+            CALL zdf_ddm( nit000 )
+#endif
+            IF(lwp) WRITE(numout,*) ' Computing zdf_mxl coeff. from restart...'
+            ! Compute the turbocline depth and the mixed layer depth
+            CALL zdf_mxl( nit000 ) 
+#if defined key_ldfslp
+            IF(lwp) WRITE(numout,*) ' Compute the slopes of neutral surface...'
+            CALL bn2( tsb, rn2 ) 
+            CALL ldf_slp( nit000, rhd, rn2 )
+#endif
+#if defined key_traldf_c2d
+            IF(lwp) WRITE(numout,*) ' Computing ldf_eiv coeff. from restart...'
+            ! Compute eddy induced velocity coefficient
+            IF( lk_traldf_eiv )   CALL ldf_eiv( nit000 )
+#endif
+         ENDIF
+         !
+         it = kt - nit000 + 1
+         !
+         !                                   ! Define the output file        
+         WRITE(cl_asmtrj, FMT='(A,A,I5.5)' ) TRIM( c_asmtrj ), '_', it
+         cl_asmtrj = TRIM( cl_asmtrj )
+         CALL iom_open( cl_asmtrj, inum, ldwrt = .TRUE., kiolib = jprstlib)
+         !
+         !                                   ! Output trajectory fields
+         CALL iom_rstput( it, it, inum, 'emp'   , emp    )
+         CALL iom_rstput( it, it, inum, 'emps'  , emps   )
+         CALL iom_rstput( it, it, inum, 'un'    , un     )
+         CALL iom_rstput( it, it, inum, 'vn'    , vn     )
+         CALL iom_rstput( it, it, inum, 'tn'    , tn     )
+         CALL iom_rstput( it, it, inum, 'sn'    , sn     )
+         CALL iom_rstput( it, it, inum, 'avmu'  , avmu   )
+         CALL iom_rstput( it, it, inum, 'avmv'  , avmv   )
+         CALL iom_rstput( it, it, inum, 'avt'   , avt    )
+#if defined key_ldfslp
+         CALL iom_rstput( it, it, inum, 'uslp'  , uslp   )
+         CALL iom_rstput( it, it, inum, 'vslp'  , vslp   )
+         CALL iom_rstput( it, it, inum, 'wslpi' , wslpi  )
+         CALL iom_rstput( it, it, inum, 'wslpj' , wslpj  )
+#endif
+#if defined key_zdfddm
+         CALL iom_rstput( it, it, inum, 'avs'   , avs    )
+#endif
+         CALL iom_rstput( it, it, inum, 'ta'    , ta     )
+         CALL iom_rstput( it, it, inum, 'sa'    , sa     )
+         CALL iom_rstput( it, it, inum, 'tb'    , tb     )
+         CALL iom_rstput( it, it, inum, 'sb'    , sb     )
+#if defined key_tradmp
+         CALL iom_rstput( it, it, inum, 'strdmp', strdmp )
+         CALL iom_rstput( it, it, inum, 'hmlp'  , hmlp   )
+#endif
+         CALL iom_rstput( it, it, inum, 'aeiu'  , aeiu   )
+         CALL iom_rstput( it, it, inum, 'aeiv'  , aeiv   )
+         CALL iom_rstput( it, it, inum, 'aeiw'  , aeiw   )
+         !
+         CALL iom_close( inum )
+      ENDIF
+      !
+   END SUBROUTINE asm_trj_wri
+
+   !!======================================================================
+END MODULE asmtrj
Index: trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90	(revision 2528)
@@ -6,4 +6,5 @@
    !! History :  1.0  !  2001-05  (J. Chanut, A. Sellar)  Original code
    !!            3.0  !  2008-04  (NEMO team)  add in the reference version     
+   !!            3.3  !  2010-09  (D. Storkey) add ice boundary conditions
    !!----------------------------------------------------------------------
 #if defined key_bdy 
@@ -20,26 +21,26 @@
    !! Namelist variables
    !!----------------------------------------------------------------------
-   CHARACTER(len=80) ::   filbdy_mask        !: Name of unstruct. bdy mask file
-   CHARACTER(len=80) ::   filbdy_data_T      !: Name of unstruct. bdy data file at T points
-   CHARACTER(len=80) ::   filbdy_data_U      !: Name of unstruct. bdy data file at U points
-   CHARACTER(len=80) ::   filbdy_data_V      !: Name of unstruct. bdy data file at V points
-   CHARACTER(len=80) ::   filbdy_data_bt_T   !: Name of unstruct. bdy data file at T points for barotropic variables
-   CHARACTER(len=80) ::   filbdy_data_bt_U   !: Name of unstruct. bdy data file at U points for barotropic variables
-   CHARACTER(len=80) ::   filbdy_data_bt_V   !: Name of unstruct. bdy data file at V points for barotropic variables
+   CHARACTER(len=80) ::   cn_mask        !: Name of unstruct. bdy mask file
+   CHARACTER(len=80) ::   cn_dta_frs_T   !: Name of unstruct. bdy data file at T points for FRS conditions
+   CHARACTER(len=80) ::   cn_dta_frs_U   !: Name of unstruct. bdy data file at U points for FRS conditions
+   CHARACTER(len=80) ::   cn_dta_frs_V   !: Name of unstruct. bdy data file at V points for FRS conditions
+   CHARACTER(len=80) ::   cn_dta_fla_T   !: Name of unstruct. bdy data file at T points for Flather scheme
+   CHARACTER(len=80) ::   cn_dta_fla_U   !: Name of unstruct. bdy data file at U points for Flather scheme
+   CHARACTER(len=80) ::   cn_dta_fla_V   !: Name of unstruct. bdy data file at V points for Flather scheme
    !
-   LOGICAL ::   ln_bdy_tides = .false.  !: =T apply tidal harmonic forcing along open boundaries
-   LOGICAL ::   ln_bdy_vol  = .false.   !: =T volume correction             
-   LOGICAL ::   ln_bdy_mask = .false.   !: =T read bdymask from file
-   LOGICAL ::   ln_bdy_clim = .false.   !: if true, we assume that bdy data files contain 
+   LOGICAL ::   ln_tides = .false.    !: =T apply tidal harmonic forcing along open boundaries
+   LOGICAL ::   ln_vol  = .false.     !: =T volume correction             
+   LOGICAL ::   ln_mask = .false.     !: =T read bdymask from file
+   LOGICAL ::   ln_clim = .false.     !: if true, we assume that bdy data files contain 
    !                                    !  1 time dump  (-->bdy forcing will be constant) 
    !                                    !  or 12 months (-->bdy forcing will be cyclic) 
-   LOGICAL ::   ln_bdy_dyn_fla  = .false. !: =T Flather boundary conditions on barotropic velocities
-   LOGICAL ::   ln_bdy_dyn_frs  = .false. !: =T FRS boundary conditions on velocities
-   LOGICAL ::   ln_bdy_tra_frs  = .false. !: =T FRS boundary conditions on tracers (T and S)
-   LOGICAL ::   ln_bdy_ice_frs  = .false. !: =T FRS boundary conditions on seaice (leads fraction, ice depth, snow depth)
+   LOGICAL ::   ln_dyn_fla  = .false. !: =T Flather boundary conditions on barotropic velocities
+   LOGICAL ::   ln_dyn_frs  = .false. !: =T FRS boundary conditions on velocities
+   LOGICAL ::   ln_tra_frs  = .false. !: =T FRS boundary conditions on tracers (T and S)
+   LOGICAL ::   ln_ice_frs  = .false. !: =T FRS boundary conditions on seaice (leads fraction, ice depth, snow depth)
    !
-   INTEGER ::   nb_rimwidth = 7         !: boundary rim width
-   INTEGER ::   nbdy_dta    = 1	        !: = 0 use the initial state as bdy dta or = 1 read it in a NetCDF file
-   INTEGER ::   volbdy      = 1         !: = 0 the total volume will have the variability of the surface Flux E-P 
+   INTEGER ::   nn_rimwidth = 7         !: boundary rim width
+   INTEGER ::   nn_dtactl   = 1	        !: = 0 use the initial state as bdy dta or = 1 read it in a NetCDF file
+   INTEGER ::   nn_volctl   = 1         !: = 0 the total volume will have the variability of the surface Flux E-P 
    !                                    !  = 1 the volume will be constant during all the integration.
 
@@ -54,7 +55,7 @@
    !! Unstructured open boundary data variables
    !!----------------------------------------------------------------------
-   INTEGER, DIMENSION(jpbgrd) ::   nblen                  !: Size of bdy data on a proc for each grid type
-   INTEGER, DIMENSION(jpbgrd) ::   nblenrim               !: Size of bdy data on a proc for first rim ind
-   INTEGER, DIMENSION(jpbgrd) ::   nblendta               !: Size of bdy data in file
+   INTEGER, DIMENSION(jpbgrd) ::   nblen    = 0           !: Size of bdy data on a proc for each grid type
+   INTEGER, DIMENSION(jpbgrd) ::   nblenrim = 0           !: Size of bdy data on a proc for first rim ind
+   INTEGER, DIMENSION(jpbgrd) ::   nblendta = 0           !: Size of bdy data in file
 
    INTEGER, DIMENSION(jpbdim,jpbgrd) ::   nbi, nbj        !: i and j indices of bdy dta
@@ -73,4 +74,9 @@
    REAL(wp), DIMENSION(jpbdim) ::   sshtide               !: Tidal boundary array : SSH
    REAL(wp), DIMENSION(jpbdim) ::   utide, vtide          !: Tidal boundary array : U and V
+#if defined key_lim2
+   REAL(wp), DIMENSION(jpbdim) ::  &
+      frld_bdy, hicif_bdy,  & !: Now clim of ice leads fraction, ice  
+      hsnif_bdy               !: thickness and snow thickness
+#endif
 
 #else
@@ -78,11 +84,11 @@
    !!   Dummy module                NO Unstructured Open Boundary Condition
    !!----------------------------------------------------------------------
-   LOGICAL ::   ln_bdy_tides = .false.  !: =T apply tidal harmonic forcing along open boundaries
+   LOGICAL ::   ln_tides = .false.  !: =T apply tidal harmonic forcing along open boundaries
 #endif
 
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!======================================================================
 END MODULE bdy_oce
Index: trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_par.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_par.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_par.F90	(revision 2528)
@@ -6,6 +6,7 @@
    !! History :  1.0  !  2005-01  (J. Chanut, A. Sellar)  Original code
    !!            3.0  !  2008-04  (NEMO team)  add in the reference version
+   !!            3.3  !  2010-09  (D. Storkey and E. O'Dea) update for Shelf configurations
    !!----------------------------------------------------------------------
-#if defined key_bdy
+#if defined   key_bdy
    !!----------------------------------------------------------------------
    !!   'key_bdy' :                    Unstructured Open Boundary Condition
@@ -15,10 +16,9 @@
    PUBLIC
 
-
-   LOGICAL, PUBLIC, PARAMETER ::   lk_bdy  = .TRUE.  !: Unstructured Ocean Boundary Condition flag
-   INTEGER, PUBLIC, PARAMETER ::   jpbdta  = 5000    !: Max length of bdy field in file
-   INTEGER, PUBLIC, PARAMETER ::   jpbdim  = 5000    !: Max length of bdy field on a processor
-   INTEGER, PUBLIC, PARAMETER ::   jpbtime = 1000    !: Max number of time dumps per file
-   INTEGER, PUBLIC, PARAMETER ::   jpbgrd  = 3	     !: Number of horizontal grid types used  (T, u, v, f)
+   LOGICAL, PUBLIC, PARAMETER ::   lk_bdy  = .TRUE.   !: Unstructured Ocean Boundary Condition flag
+   INTEGER, PUBLIC, PARAMETER ::   jpbdta  = 20000    !: Max length of bdy field in file
+   INTEGER, PUBLIC, PARAMETER ::   jpbdim  = 20000    !: Max length of bdy field on a processor
+   INTEGER, PUBLIC, PARAMETER ::   jpbtime = 1000     !: Max number of time dumps per file
+   INTEGER, PUBLIC, PARAMETER ::   jpbgrd  = 6	      !: Number of horizontal grid types used  (T, u, v, f)
 #else
    !!----------------------------------------------------------------------
@@ -29,7 +29,7 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!======================================================================
 END MODULE bdy_par
Index: trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90	(revision 2528)
@@ -6,6 +6,8 @@
    !! History :  1.0  !  2005-01  (J. Chanut, A. Sellar)  Original code
    !!             -   !  2007-01  (D. Storkey) Update to use IOM module
-   !!             -   !  2007-07  (D. Storkey) add bdy_dta_bt
+   !!             -   !  2007-07  (D. Storkey) add bdy_dta_fla
    !!            3.0  !  2008-04  (NEMO team)  add in the reference version
+   !!            3.3  !  2010-09  (E.O'Dea) modifications for Shelf configurations 
+   !!            3.3  !  2010-09  (D.Storkey) add ice boundary conditions
    !!----------------------------------------------------------------------
 #if defined key_bdy
@@ -13,7 +15,6 @@
    !!   'key_bdy'                     Unstructured Open Boundary Conditions
    !!----------------------------------------------------------------------
-   !!   bdy_dta    : read u, v, t, s data along open boundaries
-   !!   bdy_dta_bt : read depth-mean velocities and elevation along open
-   !!                boundaries        
+   !!   bdy_dta_frs    : read u, v, t, s data along open boundaries
+   !!   bdy_dta_fla : read depth-mean velocities and elevation along open boundaries        
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and tracers
@@ -25,38 +26,46 @@
    USE ioipsl
    USE in_out_manager  ! I/O logical units
+#if defined key_lim2
+   USE ice_2
+#endif
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   bdy_dta      ! routines called by step.F90
-   PUBLIC   bdy_dta_bt 
-
-   INTEGER ::   numbdyt, numbdyu, numbdyv                      !: logical units for T-, U-, & V-points data file, resp.
-   INTEGER ::   ntimes_bdy                                     !: exact number of time dumps in data files
-   INTEGER ::   nbdy_b, nbdy_a                                 !: record of bdy data file for before and after model time step
-   INTEGER ::   numbdyt_bt, numbdyu_bt, numbdyv_bt             !: logical unit for T-, U- & V-points data file, resp.
-   INTEGER ::   ntimes_bdy_bt                                  !: exact number of time dumps in data files
-   INTEGER ::   nbdy_b_bt, nbdy_a_bt                           !: record of bdy data file for before and after model time step
-
-   INTEGER, DIMENSION (jpbtime) ::   istep, istep_bt           !: time array in seconds in each data file
-
-   REAL(wp) ::  zoffset                                        !: time offset between time origin in file & start time of model run
-
-   REAL(wp), DIMENSION(jpbdim,jpk,2) ::   tbdydta, sbdydta     !: time interpolated values of T and S bdy data   
-   REAL(wp), DIMENSION(jpbdim,jpk,2) ::   ubdydta, vbdydta     !: time interpolated values of U and V bdy data 
-   REAL(wp), DIMENSION(jpbdim,2)     ::   ubtbdydta, vbtbdydta !: Arrays used for time interpolation of bdy data   
-   REAL(wp), DIMENSION(jpbdim,2)     ::   sshbdydta            !: bdy data of ssh
+   PUBLIC   bdy_dta_frs      ! routines called by step.F90
+   PUBLIC   bdy_dta_fla 
+
+   INTEGER ::   numbdyt, numbdyu, numbdyv                      ! logical units for T-, U-, & V-points data file, resp.
+   INTEGER ::   ntimes_bdy                                     ! exact number of time dumps in data files
+   INTEGER ::   nbdy_b, nbdy_a                                 ! record of bdy data file for before and after time step
+   INTEGER ::   numbdyt_bt, numbdyu_bt, numbdyv_bt             ! logical unit for T-, U- & V-points data file, resp.
+   INTEGER ::   ntimes_bdy_bt                                  ! exact number of time dumps in data files
+   INTEGER ::   nbdy_b_bt, nbdy_a_bt                           ! record of bdy data file for before and after time step
+
+   INTEGER, DIMENSION (jpbtime) ::   istep, istep_bt           ! time array in seconds in each data file
+
+   REAL(wp) ::  zoffset                                        ! time offset between time origin in file & start time of model run
+
+   REAL(wp), DIMENSION(jpbdim,jpk,2) ::   tbdydta, sbdydta     ! time interpolated values of T and S bdy data   
+   REAL(wp), DIMENSION(jpbdim,jpk,2) ::   ubdydta, vbdydta     ! time interpolated values of U and V bdy data 
+   REAL(wp), DIMENSION(jpbdim,2)     ::   ubtbdydta, vbtbdydta ! Arrays used for time interpolation of bdy data   
+   REAL(wp), DIMENSION(jpbdim,2)     ::   sshbdydta            ! bdy data of ssh
+
+#if defined key_lim2
+   REAL(wp), DIMENSION(jpbdim,2)     ::   frld_bdydta          ! }
+   REAL(wp), DIMENSION(jpbdim,2)     ::   hicif_bdydta         ! } Arrays used for time interp. of ice bdy data 
+   REAL(wp), DIMENSION(jpbdim,2)     ::   hsnif_bdydta         ! }
+#endif
 
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
-   SUBROUTINE bdy_dta( kt )
+   SUBROUTINE bdy_dta_frs( kt )
       !!----------------------------------------------------------------------
-      !!                   ***  SUBROUTINE bdy_dta  ***
+      !!                   ***  SUBROUTINE bdy_dta_frs  ***
       !!                    
       !! ** Purpose :   Read unstructured boundary data for FRS condition.
@@ -67,5 +76,5 @@
       !!                the file. If so read it in. Time interpolate.
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt                             ! ocean time-step index (for timesplitting option, otherwise zero)
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index (for timesplitting option, otherwise zero)
       !!
       CHARACTER(LEN=80), DIMENSION(3) ::   clfile               ! names of input files
@@ -79,5 +88,5 @@
       INTEGER ::   itimer, totime
       INTEGER ::   ii, ij                                       ! array addresses
-      INTEGER ::   ipi, ipj, ipk, inum                          ! temporary integers (NetCDF read)
+      INTEGER ::   ipi, ipj, ipk, inum                          ! local integers (NetCDF read)
       INTEGER ::   iyear0, imonth0, iday0
       INTEGER ::   ihours0, iminutes0, isec0
@@ -91,6 +100,7 @@
       !!---------------------------------------------------------------------------
 
-      IF( ln_bdy_dyn_frs .OR. ln_bdy_tra_frs ) THEN  ! If these are both false then this routine 
-                                                     ! does nothing.
+
+      IF( ln_dyn_frs .OR. ln_tra_frs    &
+         &               .OR. ln_ice_frs ) THEN  ! If these are both false then this routine does nothing
 
       ! -------------------- !
@@ -102,5 +112,6 @@
       ! Some time variables for monthly climatological forcing:
       ! *******************************************************
- !!gm  here  use directely daymod variables
+
+!!gm  here  use directely daymod calendar variables
  
       iman = INT( raamo )      ! Number of months in a year
@@ -121,6 +132,6 @@
          !                                             !-------------------!
          istep(:) = 0
-         nbdy_b    = 0
-         nbdy_a    = 0
+         nbdy_b   = 0
+         nbdy_a   = 0
 
          ! Get time information from bdy data file
@@ -128,12 +139,12 @@
 
          IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*)    'bdy_dta : Initialize unstructured boundary data'
+         IF(lwp) WRITE(numout,*)    'bdy_dta_frs : Initialize unstructured boundary data'
          IF(lwp) WRITE(numout,*)    '~~~~~~~' 
 
-         IF     ( nbdy_dta == 0 ) THEN
+         IF     ( nn_dtactl == 0 ) THEN
             !
             IF(lwp) WRITE(numout,*) '          Bdy data are taken from initial conditions'
             !
-         ELSEIF (nbdy_dta == 1) THEN
+         ELSEIF (nn_dtactl == 1) THEN
             !
             IF(lwp) WRITE(numout,*) '          Bdy data are read in netcdf files'
@@ -144,16 +155,14 @@
             !                                                 ! necessary time dumps in file are included
             !
-            clfile(1) = filbdy_data_T
-            clfile(2) = filbdy_data_U
-            clfile(3) = filbdy_data_V
+            clfile(1) = cn_dta_frs_T
+            clfile(2) = cn_dta_frs_U
+            clfile(3) = cn_dta_frs_V
             !                                                  
             ! how many files are we to read in?
             igrd_start = 1
             igrd_end   = 3
-            IF(.NOT. ln_bdy_tra_frs .AND. .NOT. ln_bdy_ice_frs) THEN
-               ! No T-grid file.
+            IF(.NOT. ln_tra_frs .AND. .NOT. ln_ice_frs) THEN       ! No T-grid file.
                igrd_start = 2
-            ELSEIF ( .NOT. ln_bdy_dyn_frs ) THEN
-               ! No U-grid or V-grid file.
+            ELSEIF ( .NOT. ln_dyn_frs ) THEN                           ! No U-grid or V-grid file.
                igrd_end   = 1         
             ENDIF
@@ -165,10 +174,7 @@
 
                SELECT CASE( igrd )
-                  CASE (1) 
-                     numbdyt = inum
-                  CASE (2) 
-                     numbdyu = inum
-                  CASE (3) 
-                     numbdyv = inum
+                  CASE (1)   ;   numbdyt = inum
+                  CASE (2)   ;   numbdyu = inum
+                  CASE (3)   ;   numbdyv = inum
                END SELECT
 
@@ -196,5 +202,5 @@
                IF(lwp) WRITE(numout,*) 'offset: ',zoffset
                IF(lwp) WRITE(numout,*) 'totime: ',totime
-               IF(lwp) WRITE(numout,*) 'zstepr: ',zstepr
+               IF(lwp) WRITE(numout,*) 'zstepr: ',zstepr(1:ntimes_bdy)
 
                ! Check that there are not too many times in the file. 
@@ -205,11 +211,10 @@
 
                ! Check that time array increases:
-        
                it = 1
-               DO WHILE( zstepr(it+1) > zstepr(it) .AND. it /= ntimes_bdy - 1 )
-                 it = it + 1
+               DO WHILE( zstepr(it+1) > zstepr(it) .AND. it /= ntimes_bdy - 1 ) 
+                  it = it + 1
                END DO
-
-               IF( it.NE.ntimes_bdy-1 .AND. ntimes_bdy > 1 ) THEN
+               !
+               IF( it /= ntimes_bdy-1 .AND. ntimes_bdy > 1 ) THEN
                      WRITE(ctmp1,*) 'Check file: ', clfile(igrd)
                      CALL ctl_stop( 'Time array in unstructured boundary data files',   &
@@ -227,17 +232,21 @@
                END IF
                !
-               IF    ( igrd == 1 ) THEN
-                 ntimes_bdyt = ntimes_bdy
-                 zoffsett = zoffset
-                 istept(:) = INT( zstepr(:) + zoffset )
-               ELSEIF(igrd == 2 ) THEN
-                 ntimes_bdyu = ntimes_bdy
-                 zoffsetu = zoffset
-                 istepu(:) = INT( zstepr(:) + zoffset )
-               ELSEIF(igrd == 3 ) THEN
-                 ntimes_bdyv = ntimes_bdy
-                 zoffsetv = zoffset
-                 istepv(:) = INT( zstepr(:) + zoffset )
-               ENDIF
+               SELECT CASE( igrd )
+                  CASE (1)
+                    ntimes_bdyt = ntimes_bdy
+                    zoffsett = zoffset
+                    istept(:) = INT( zstepr(:) + zoffset )
+                    numbdyt = inum
+                  CASE (2)
+                    ntimes_bdyu = ntimes_bdy
+                    zoffsetu = zoffset
+                    istepu(:) = INT( zstepr(:) + zoffset )
+                    numbdyu = inum
+                  CASE (3)
+                    ntimes_bdyv = ntimes_bdy
+                    zoffsetv = zoffset
+                    istepv(:) = INT( zstepr(:) + zoffset )
+                    numbdyv = inum
+               END SELECT
                !
             END DO                                         ! end loop over T, U & V grid 
@@ -259,19 +268,17 @@
             ENDIF
 
-            IF( igrd_start == 1 ) THEN
-               istep(:) = istept(:)
-            ELSE
-               istep(:) = istepu(:)
+            IF( igrd_start == 1 ) THEN   ;   istep(:) = istept(:)
+            ELSE                         ;   istep(:) = istepu(:)
             ENDIF
 
             ! Check number of time dumps:              
-            IF( ntimes_bdy == 1 .AND. .NOT. ln_bdy_clim ) THEN
+            IF( ntimes_bdy == 1 .AND. .NOT. ln_clim ) THEN
               CALL ctl_stop( 'There is only one time dump in data files',   &
-                 &           'Choose ln_bdy_clim=.true. in namelist for constant bdy forcing.' )
+                 &           'Choose ln_clim=.true. in namelist for constant bdy forcing.' )
             ENDIF
 
-            IF( ln_bdy_clim ) THEN
+            IF( ln_clim ) THEN
               IF( ntimes_bdy /= 1 .AND. ntimes_bdy /= 12 ) THEN
-                 CALL ctl_stop( 'For climatological boundary forcing (ln_bdy_clim=.true.),',   &
+                 CALL ctl_stop( 'For climatological boundary forcing (ln_clim=.true.),',   &
                     &           'bdy data files must contain 1 or 12 time dumps.' )
               ELSEIF( ntimes_bdy ==  1 ) THEN
@@ -287,56 +294,66 @@
             it = 1
             DO WHILE( istep(it+1) <= 0 .AND. it <= ntimes_bdy - 1 )
-              it = it + 1
+               it = it + 1
             END DO
             nbdy_b = it
             !
-            WRITE(numout,*) 'Time offset is ',zoffset
-            WRITE(numout,*) 'First record to read is ',nbdy_b
-
-         ENDIF ! endif (nbdy_dta == 1)
-
-
-         ! 1.2  Read first record in file if necessary (ie if nbdy_dta == 1)
+            IF(lwp) WRITE(numout,*) 'Time offset is ',zoffset
+            IF(lwp) WRITE(numout,*) 'First record to read is ',nbdy_b
+
+         ENDIF ! endif (nn_dtactl == 1)
+
+
+         ! 1.2  Read first record in file if necessary (ie if nn_dtactl == 1)
          ! *****************************************************************
 
-         IF( nbdy_dta == 0) THEN      ! boundary data arrays are filled with initial conditions
+         IF( nn_dtactl == 0 ) THEN      ! boundary data arrays are filled with initial conditions
             !
-            IF (ln_bdy_tra_frs) THEN
-              igrd = 1            ! T-points data 
-              DO ib = 1, nblen(igrd)
-                ii = nbi(ib,igrd)
-                ij = nbj(ib,igrd)
-                DO ik = 1, jpkm1
-                  tbdy(ib,ik) = tn(ii, ij, ik)
-                  sbdy(ib,ik) = sn(ii, ij, ik)
-                ENDDO
-              END DO
+            IF (ln_tra_frs) THEN
+               igrd = 1            ! T-points data 
+               DO ib = 1, nblen(igrd)
+                  ii = nbi(ib,igrd)
+                  ij = nbj(ib,igrd)
+                  DO ik = 1, jpkm1
+                     tbdy(ib,ik) = tn(ii,ij,ik)
+                     sbdy(ib,ik) = sn(ii,ij,ik)
+                  END DO
+               END DO
             ENDIF
 
-            IF(ln_bdy_dyn_frs) THEN
-              igrd = 2            ! U-points data 
-              DO ib = 1, nblen(igrd)
-                ii = nbi(ib,igrd)
-                ij = nbj(ib,igrd)
-                DO ik = 1, jpkm1
-                  ubdy(ib,ik) = un(ii, ij, ik)
-                ENDDO
-              END DO
-
-              igrd = 3            ! V-points data 
-              DO ib = 1, nblen(igrd)            
-                ii = nbi(ib,igrd)
-                ij = nbj(ib,igrd)
-                DO ik = 1, jpkm1
-                  vbdy(ib,ik) = vn(ii, ij, ik)
-                ENDDO
-              END DO
+            IF(ln_dyn_frs) THEN
+               igrd = 2            ! U-points data 
+               DO ib = 1, nblen(igrd)
+                  ii = nbi(ib,igrd)
+                  ij = nbj(ib,igrd)
+                  DO ik = 1, jpkm1
+                     ubdy(ib,ik) = un(ii, ij, ik)
+                  END DO
+               END DO
+               !
+               igrd = 3            ! V-points data 
+               DO ib = 1, nblen(igrd)            
+                  ii = nbi(ib,igrd)
+                  ij = nbj(ib,igrd)
+                  DO ik = 1, jpkm1
+                     vbdy(ib,ik) = vn(ii, ij, ik)
+                  END DO
+               END DO
             ENDIF
             !
-         ELSEIF( nbdy_dta == 1 ) THEN    ! Set first record in the climatological case:   
+#if defined key_lim2
+            IF( ln_ice_frs ) THEN
+               igrd = 1            ! T-points data
+               DO ib = 1, nblen(igrd)
+                  frld_bdy (ib) =  frld(nbi(ib,igrd), nbj(ib,igrd))
+                  hicif_bdy(ib) = hicif(nbi(ib,igrd), nbj(ib,igrd))
+                  hsnif_bdy(ib) = hsnif(nbi(ib,igrd), nbj(ib,igrd))
+               END DO
+            ENDIF
+#endif
+         ELSEIF( nn_dtactl == 1 ) THEN    ! Set first record in the climatological case:   
             !
-            IF( ln_bdy_clim .AND. ntimes_bdy == 1 ) THEN
+            IF( ln_clim .AND. ntimes_bdy == 1 ) THEN
                nbdy_a = 1
-            ELSEIF( ln_bdy_clim .AND. ntimes_bdy == iman ) THEN
+            ELSEIF( ln_clim .AND. ntimes_bdy == iman ) THEN
                nbdy_b = 0
                nbdy_a = imois
@@ -351,5 +368,6 @@
             ipi  = nblendta(igrd)
 
-            IF(ln_bdy_tra_frs) THEN
+            IF(ln_tra_frs) THEN
+               !
                igrd = 1                                           ! Temperature
                IF( nblendta(igrd) <=  0 ) THEN 
@@ -357,8 +375,8 @@
                   nblendta(igrd) = iom_file(numbdyt)%dimsz(1,idvar)
                ENDIF
-               WRITE(numout,*) 'Dim size for votemper is ', nblendta(igrd)
+               IF(lwp) WRITE(numout,*) 'Dim size for votemper is ', nblendta(igrd)
                ipi = nblendta(igrd)
                CALL iom_get ( numbdyt, jpdom_unknown, 'votemper', zdta(1:ipi,1:ipj,1:ipk), nbdy_a )
-
+               !
                DO ib = 1, nblen(igrd)
                   DO ik = 1, jpkm1
@@ -372,8 +390,8 @@
                   nblendta(igrd) = iom_file(numbdyt)%dimsz(1,idvar)
                ENDIF
-               WRITE(numout,*) 'Dim size for vosaline is ', nblendta(igrd)
+               IF(lwp) WRITE(numout,*) 'Dim size for vosaline is ', nblendta(igrd)
                ipi = nblendta(igrd)
                CALL iom_get ( numbdyt, jpdom_unknown, 'vosaline', zdta(1:ipi,1:ipj,1:ipk), nbdy_a )
-
+               !
                DO ib = 1, nblen(igrd)
                   DO ik = 1, jpkm1
@@ -381,8 +399,8 @@
                   END DO
                END DO
-            ENDIF  ! ln_bdy_tra_frs
+            ENDIF  ! ln_tra_frs
  
-            IF(ln_bdy_dyn_frs) THEN
-
+            IF( ln_dyn_frs ) THEN
+               !
                igrd = 2                                           ! u-velocity
                IF ( nblendta(igrd) .le. 0 ) THEN 
@@ -390,5 +408,5 @@
                  nblendta(igrd) = iom_file(numbdyu)%dimsz(1,idvar)
                ENDIF
-               WRITE(numout,*) 'Dim size for vozocrtx is ', nblendta(igrd)
+               IF(lwp) WRITE(numout,*) 'Dim size for vozocrtx is ', nblendta(igrd)
                ipi = nblendta(igrd)
                CALL iom_get ( numbdyu, jpdom_unknown,'vozocrtx',zdta(1:ipi,1:ipj,1:ipk),nbdy_a )
@@ -404,5 +422,5 @@
                  nblendta(igrd) = iom_file(numbdyv)%dimsz(1,idvar)
                ENDIF
-               WRITE(numout,*) 'Dim size for vomecrty is ', nblendta(igrd)
+               IF(lwp) WRITE(numout,*) 'Dim size for vomecrty is ', nblendta(igrd)
                ipi = nblendta(igrd)
                CALL iom_get ( numbdyv, jpdom_unknown,'vomecrty',zdta(1:ipi,1:ipj,1:ipk),nbdy_a )
@@ -412,95 +430,144 @@
                   END DO
                END DO
-            ENDIF ! ln_bdy_dyn_frs
-
-
-            IF ((.NOT.ln_bdy_clim) .AND. (istep(1) > 0)) THEN
-               ! First data time is after start of run
-               ! Put first value in both time levels
-               nbdy_b = nbdy_a
-               IF(ln_bdy_tra_frs) THEN
+            ENDIF ! ln_dyn_frs
+
+#if defined key_lim2
+            IF( ln_ice_frs ) THEN
+              !
+              igrd=1                                              ! leads fraction
+              IF(lwp) WRITE(numout,*) 'Dim size for ildsconc is ',nblendta(igrd)
+              ipi=nblendta(igrd)
+              CALL iom_get ( numbdyt, jpdom_unknown,'ildsconc',zdta(1:ipi,:,1),nbdy_a )
+              DO ib=1, nblen(igrd)
+                frld_bdydta(ib,2) =  zdta(nbmap(ib,igrd),1,1)
+              END DO
+              !
+              igrd=1                                              ! ice thickness
+              IF(lwp) WRITE(numout,*) 'Dim size for iicethic is ',nblendta(igrd)
+              ipi=nblendta(igrd)
+              CALL iom_get ( numbdyt, jpdom_unknown,'iicethic',zdta(1:ipi,:,1),nbdy_a )
+              DO ib=1, nblen(igrd)
+                hicif_bdydta(ib,2) =  zdta(nbmap(ib,igrd),1,1)
+              END DO
+              !
+              igrd=1                                              ! snow thickness
+              IF(lwp) WRITE(numout,*) 'Dim size for isnowthi is ',nblendta(igrd)
+              ipi=nblendta(igrd)
+              CALL iom_get ( numbdyt, jpdom_unknown,'isnowthi',zdta(1:ipi,:,1),nbdy_a )
+              DO ib=1, nblen(igrd)
+                hsnif_bdydta(ib,2) =  zdta(nbmap(ib,igrd),1,1)
+              END DO
+            ENDIF ! just if ln_ice_frs is set
+#endif
+
+            IF( .NOT.ln_clim .AND. istep(1) > 0 ) THEN     ! First data time is after start of run
+               nbdy_b = nbdy_a                                 ! Put first value in both time levels
+               IF( ln_tra_frs ) THEN
                  tbdydta(:,:,1) = tbdydta(:,:,2)
                  sbdydta(:,:,1) = sbdydta(:,:,2)
                ENDIF
-               IF(ln_bdy_dyn_frs) THEN
+               IF( ln_dyn_frs ) THEN
                  ubdydta(:,:,1) = ubdydta(:,:,2)
                  vbdydta(:,:,1) = vbdydta(:,:,2)
                ENDIF
+#if defined key_lim2
+               IF( ln_ice_frs ) THEN
+                  frld_bdydta (:,1) =  frld_bdydta(:,2)
+                  hicif_bdydta(:,1) = hicif_bdydta(:,2)
+                  hsnif_bdydta(:,1) = hsnif_bdydta(:,2)
+               ENDIF
+#endif
             END IF
-
-         END IF ! nbdy_dta == 0/1
+            !
+         END IF   ! nn_dtactl == 0/1
  
          ! In the case of constant boundary forcing fill bdy arrays once for all
-         IF ((ln_bdy_clim).AND.(ntimes_bdy==1)) THEN
-            IF(ln_bdy_tra_frs) THEN
-              tbdy  (:,:) = tbdydta  (:,:,2)
-              sbdy  (:,:) = sbdydta  (:,:,2)
+         IF( ln_clim .AND. ntimes_bdy == 1 ) THEN
+            IF( ln_tra_frs ) THEN
+               tbdy  (:,:) = tbdydta  (:,:,2)
+               sbdy  (:,:) = sbdydta  (:,:,2)
             ENDIF
-            IF(ln_bdy_dyn_frs) THEN
-              ubdy  (:,:) = ubdydta  (:,:,2)
-              vbdy  (:,:) = vbdydta  (:,:,2)
+            IF( ln_dyn_frs) THEN
+               ubdy  (:,:) = ubdydta  (:,:,2)
+               vbdy  (:,:) = vbdydta  (:,:,2)
             ENDIF
-
-            IF(ln_bdy_tra_frs .or. ln_bdy_ice_frs) CALL iom_close( numbdyt )
-            IF(ln_bdy_dyn_frs) CALL iom_close( numbdyu )
-            IF(ln_bdy_dyn_frs) CALL iom_close( numbdyv )
+#if defined key_lim2
+            IF( ln_ice_frs ) THEN
+               frld_bdy (:) = frld_bdydta (:,2)
+               hicif_bdy(:) = hicif_bdydta(:,2)
+               hsnif_bdy(:) = hsnif_bdydta(:,2)
+            ENDIF
+#endif
+
+            IF( ln_tra_frs .OR. ln_ice_frs) CALL iom_close( numbdyt )
+            IF( ln_dyn_frs                    ) CALL iom_close( numbdyu )
+            IF( ln_dyn_frs                    ) CALL iom_close( numbdyv )
          END IF
-
+         !
       ENDIF                                            ! End if nit000
 
 
       !                                                !---------------------!
-      !                                                !  at each time step  !
-      !                                                !---------------------!
-
-      IF( nbdy_dta == 1 .AND. ntimes_bdy > 1 ) THEN 
-         !
+      IF( nn_dtactl == 1 .AND. ntimes_bdy > 1 ) THEN    !  at each time step  !
+         !                                             !---------------------!
          ! Read one more record if necessary
          !**********************************
 
-        IF( ln_bdy_clim .AND. imois /= nbdy_b ) THEN      ! remember that nbdy_b=0 for kt=nit000
-           nbdy_b = imois
-           nbdy_a = imois + 1
-           nbdy_b = MOD( nbdy_b, iman )   ;   IF( nbdy_b == 0 ) nbdy_b = iman
-           nbdy_a = MOD( nbdy_a, iman )   ;   IF( nbdy_a == 0 ) nbdy_a = iman
-           lect=.true.
-        ELSEIF( .NOT.ln_bdy_clim .AND. itimer >= istep(nbdy_a) ) THEN
-
-           IF ( nbdy_a < ntimes_bdy ) THEN
-              nbdy_b = nbdy_a
-              nbdy_a = nbdy_a + 1
-              lect  =.true.
-           ELSE
-              ! We have reached the end of the file
-              ! put the last data time into both time levels
-              nbdy_b = nbdy_a
-              IF(ln_bdy_tra_frs) THEN
-                tbdydta(:,:,1) =  tbdydta(:,:,2)
-                sbdydta(:,:,1) =  sbdydta(:,:,2)
-              ENDIF
-              IF(ln_bdy_dyn_frs) THEN
-                ubdydta(:,:,1) =  ubdydta(:,:,2)
-                vbdydta(:,:,1) =  vbdydta(:,:,2)
-              ENDIF
+         IF( ln_clim .AND. imois /= nbdy_b ) THEN      ! remember that nbdy_b=0 for kt=nit000
+            nbdy_b = imois
+            nbdy_a = imois + 1
+            nbdy_b = MOD( nbdy_b, iman )   ;   IF( nbdy_b == 0 ) nbdy_b = iman
+            nbdy_a = MOD( nbdy_a, iman )   ;   IF( nbdy_a == 0 ) nbdy_a = iman
+            lect=.true.
+         ELSEIF( .NOT.ln_clim .AND. itimer >= istep(nbdy_a) ) THEN
+
+            IF( nbdy_a < ntimes_bdy ) THEN
+               nbdy_b = nbdy_a
+               nbdy_a = nbdy_a + 1
+               lect  =.true.
+            ELSE
+               ! We have reached the end of the file
+               ! put the last data time into both time levels
+               nbdy_b = nbdy_a
+               IF(ln_tra_frs) THEN
+                  tbdydta(:,:,1) =  tbdydta(:,:,2)
+                  sbdydta(:,:,1) =  sbdydta(:,:,2)
+               ENDIF
+               IF(ln_dyn_frs) THEN
+                  ubdydta(:,:,1) =  ubdydta(:,:,2)
+                  vbdydta(:,:,1) =  vbdydta(:,:,2)
+               ENDIF
+#if defined key_lim2
+               IF(ln_ice_frs) THEN
+                  frld_bdydta (:,1) =  frld_bdydta (:,2)
+                  hicif_bdydta(:,1) =  hicif_bdydta(:,2)
+                  hsnif_bdydta(:,1) =  hsnif_bdydta(:,2)
+               ENDIF
+#endif
             END IF ! nbdy_a < ntimes_bdy
-
+            !
         END IF
          
-        IF( lect ) THEN
-           ! Swap arrays
-           IF(ln_bdy_tra_frs) THEN
+        IF( lect ) THEN           ! Swap arrays
+           IF( ln_tra_frs ) THEN
              tbdydta(:,:,1) =  tbdydta(:,:,2)
              sbdydta(:,:,1) =  sbdydta(:,:,2)
            ENDIF
-           IF(ln_bdy_dyn_frs) THEN
+           IF( ln_dyn_frs ) THEN
              ubdydta(:,:,1) =  ubdydta(:,:,2)
              vbdydta(:,:,1) =  vbdydta(:,:,2)
            ENDIF
- 
+#if defined key_lim2
+           IF( ln_ice_frs ) THEN
+             frld_bdydta (:,1) =  frld_bdydta (:,2)
+             hicif_bdydta(:,1) =  hicif_bdydta(:,2)
+             hsnif_bdydta(:,1) =  hsnif_bdydta(:,2)
+           ENDIF
+#endif 
            ! read another set
            ipj  = 1
            ipk  = jpk
 
-           IF(ln_bdy_tra_frs) THEN
+           IF( ln_tra_frs ) THEN
               ! 
               igrd = 1                                   ! temperature
@@ -521,7 +588,7 @@
                  END DO
               END DO
-           ENDIF ! ln_bdy_tra_frs
-
-           IF(ln_bdy_dyn_frs) THEN
+           ENDIF ! ln_tra_frs
+
+           IF(ln_dyn_frs) THEN
               !
               igrd = 2                                   ! u-velocity
@@ -542,10 +609,35 @@
                  END DO
               END DO
-           ENDIF ! ln_bdy_dyn_frs
-
+           ENDIF ! ln_dyn_frs
            !
-           IF(lwp) WRITE(numout,*) 'bdy_dta : first record file used nbdy_b ',nbdy_b
+#if defined key_lim2
+           IF(ln_ice_frs) THEN
+             !
+             igrd = 1                                    ! ice concentration
+             ipi=nblendta(igrd)
+             CALL iom_get ( numbdyt, jpdom_unknown,'ildsconc',zdta(1:ipi,:,1),nbdy_a )
+             DO ib=1, nblen(igrd)
+               frld_bdydta(ib,2) =  zdta( nbmap(ib,igrd), 1, 1 )
+             END DO
+             !
+             igrd=1                                      ! ice thickness
+             ipi=nblendta(igrd)
+             CALL iom_get ( numbdyt, jpdom_unknown,'iicethic',zdta(1:ipi,:,1),nbdy_a )
+             DO ib=1, nblen(igrd)
+               hicif_bdydta(ib,2) =  zdta( nbmap(ib,igrd), 1, 1 )
+             END DO
+             !
+             igrd=1                                      ! snow thickness
+             ipi=nblendta(igrd)
+             CALL iom_get ( numbdyt, jpdom_unknown,'isnowthi',zdta(1:ipi,:,1),nbdy_a )
+             DO ib=1, nblen(igrd)
+               hsnif_bdydta(ib,2) =  zdta( nbmap(ib,igrd), 1, 1 )
+             END DO
+           ENDIF ! ln_ice_frs
+#endif
+           !
+           IF(lwp) WRITE(numout,*) 'bdy_dta_frs : first record file used nbdy_b ',nbdy_b
            IF(lwp) WRITE(numout,*) '~~~~~~~~  last  record file used nbdy_a ',nbdy_a
-           IF (.NOT.ln_bdy_clim) THEN
+           IF (.NOT.ln_clim) THEN
               IF(lwp) WRITE(numout,*) 'first  record time (s): ', istep(nbdy_b)
               IF(lwp) WRITE(numout,*) 'model time (s)        : ', itimer
@@ -559,9 +651,11 @@
        ! ********************
        ! 
-       IF( ln_bdy_clim ) THEN   ;   zxy = REAL( nday                  , wp ) / REAL( nmonth_len(nbdy_b), wp ) + 0.5 - i15
-       ELSE                     ;   zxy = REAL( istep(nbdy_b) - itimer, wp ) / REAL( istep(nbdy_b) - istep(nbdy_a), wp )
+       IF( ln_clim ) THEN   ;   zxy = REAL( nday                   ) / REAL( nmonth_len(nbdy_b) ) + 0.5 - i15
+       ELSEIF( istep(nbdy_b) == istep(nbdy_a) ) THEN 
+                                    zxy = 0.0_wp
+       ELSE                     ;   zxy = REAL( istep(nbdy_b) - itimer ) / REAL( istep(nbdy_b) - istep(nbdy_a) )
        END IF
 
-          IF(ln_bdy_tra_frs) THEN
+          IF(ln_tra_frs) THEN
              igrd = 1                                   ! temperature & salinity
              DO ib = 1, nblen(igrd)
@@ -573,5 +667,5 @@
           ENDIF
 
-          IF(ln_bdy_dyn_frs) THEN
+          IF(ln_dyn_frs) THEN
              igrd = 2                                   ! u-velocity
              DO ib = 1, nblen(igrd)
@@ -589,5 +683,16 @@
           ENDIF
 
-      END IF                       !end if ((nbdy_dta==1).AND.(ntimes_bdy>1))
+#if defined key_lim2
+          IF(ln_ice_frs) THEN
+            igrd=1
+            DO ib=1, nblen(igrd)
+               frld_bdy(ib) = zxy *  frld_bdydta(ib,2) + (1.-zxy) *  frld_bdydta(ib,1)
+              hicif_bdy(ib) = zxy * hicif_bdydta(ib,2) + (1.-zxy) * hicif_bdydta(ib,1)
+              hsnif_bdy(ib) = zxy * hsnif_bdydta(ib,2) + (1.-zxy) * hsnif_bdydta(ib,1)
+            END DO
+          ENDIF ! just if ln_ice_frs is true
+#endif
+
+      END IF                       !end if ((nn_dtactl==1).AND.(ntimes_bdy>1))
     
 
@@ -596,17 +701,17 @@
       !                                                !---------------------!
       IF( kt == nitend ) THEN
-          IF(ln_bdy_tra_frs .or. ln_bdy_ice_frs) CALL iom_close( numbdyt )              ! Closing of the 3 files
-          IF(ln_bdy_dyn_frs) CALL iom_close( numbdyu )
-          IF(ln_bdy_dyn_frs) CALL iom_close( numbdyv )
+          IF(ln_tra_frs .or. ln_ice_frs) CALL iom_close( numbdyt )              ! Closing of the 3 files
+          IF(ln_dyn_frs) CALL iom_close( numbdyu )
+          IF(ln_dyn_frs) CALL iom_close( numbdyv )
       ENDIF
       !
-      ENDIF ! ln_bdy_dyn_frs .OR. ln_bdy_tra_frs
-
-   END SUBROUTINE bdy_dta
-
-
-   SUBROUTINE bdy_dta_bt( kt, jit )
+      ENDIF ! ln_dyn_frs .OR. ln_tra_frs
+      !
+   END SUBROUTINE bdy_dta_frs
+
+
+   SUBROUTINE bdy_dta_fla( kt, jit, icycl )
       !!---------------------------------------------------------------------------
-      !!                      ***  SUBROUTINE bdy_dta_bt  ***
+      !!                      ***  SUBROUTINE bdy_dta_fla  ***
       !!                    
       !! ** Purpose :   Read unstructured boundary data for Flather condition
@@ -620,4 +725,5 @@
       INTEGER, INTENT( in ) ::   kt          ! ocean time-step index
       INTEGER, INTENT( in ) ::   jit         ! barotropic time step index
+      INTEGER, INTENT( in ) ::   icycl       ! number of cycles need for final file close
       !                                      ! (for timesplitting option, otherwise zero)
       !!
@@ -639,10 +745,10 @@
       REAL(wp), DIMENSION(jpbtime)      ::   zstepr             ! REAL time array from data files
       REAL(wp), DIMENSION(jpbdta,1)     ::   zdta               ! temporary array for data fields
-      CHARACTER(LEN=80), DIMENSION(3)   ::   clfile
+      CHARACTER(LEN=80), DIMENSION(6)   ::   clfile
       CHARACTER(LEN=70 )                ::   clunits            ! units attribute of time coordinate
       !!---------------------------------------------------------------------------
 
-!!gm   add here the same style as in bdy_dta
-!!gm      clearly bdy_dta_bt and bdy_dta  can be combined...   
+!!gm   add here the same style as in bdy_dta_frs
+!!gm      clearly bdy_dta_fla and bdy_dta_frs  can be combined...   
 !!gm      too many things duplicated in the read of data...   simplification can be done
 
@@ -671,5 +777,5 @@
       itimer = itimer + jit*rdt/REAL(nn_baro,wp)      ! in non-climatological case
 
-      IF ( ln_bdy_tides ) THEN
+      IF ( ln_tides ) THEN
 
          ! -------------------------------------!
@@ -681,5 +787,5 @@
       ENDIF
 
-      IF ( ln_bdy_dyn_fla ) THEN
+      IF ( ln_dyn_fla ) THEN
 
          ! -------------------------------------!
@@ -688,5 +794,5 @@
 
       !                                                !-------------------!
-      IF( kt == nit000 ) THEN                          !  First call only  !
+      IF( kt == nit000 .and. jit ==2 ) THEN            !  First call only  !
          !                                             !-------------------!
          istep_bt(:) = 0
@@ -698,11 +804,11 @@
 
         IF(lwp) WRITE(numout,*)
-        IF(lwp) WRITE(numout,*)    'bdy_dta_bt :Initialize unstructured boundary data for barotropic variables.'
+        IF(lwp) WRITE(numout,*)    'bdy_dta_fla :Initialize unstructured boundary data for barotropic variables.'
         IF(lwp) WRITE(numout,*)    '~~~~~~~' 
 
-        IF( nbdy_dta == 0 ) THEN
+        IF( nn_dtactl == 0 ) THEN
           IF(lwp) WRITE(numout,*)  'Bdy data are taken from initial conditions'
 
-        ELSEIF (nbdy_dta == 1) THEN
+        ELSEIF (nn_dtactl == 1) THEN
           IF(lwp) WRITE(numout,*)  'Bdy data are read in netcdf files'
 
@@ -712,20 +818,20 @@
                                                      ! necessary time dumps in file are included
 
-          clfile(1) = filbdy_data_bt_T
-          clfile(2) = filbdy_data_bt_U
-          clfile(3) = filbdy_data_bt_V
-
-          DO igrd = 1,3
+          clfile(4) = cn_dta_fla_T
+          clfile(5) = cn_dta_fla_U
+          clfile(6) = cn_dta_fla_V
+
+          DO igrd = 4,6
 
             CALL iom_open( clfile(igrd), inum )
-            CALL iom_gettime( inum, zstepr, kntime=ntimes_bdy, cdunits=clunits ) 
+            CALL iom_gettime( inum, zstepr, kntime=ntimes_bdy_bt, cdunits=clunits ) 
 
             SELECT CASE( igrd )
-               CASE (1) 
-                  numbdyt = inum
-               CASE (2) 
-                  numbdyu = inum
-               CASE (3) 
-                  numbdyv = inum
+               CASE (4) 
+                  numbdyt_bt = inum
+               CASE (5) 
+                  numbdyu_bt = inum
+               CASE (6) 
+                  numbdyv_bt = inum
             END SELECT
 
@@ -757,5 +863,5 @@
 
             ! Check that time array increases (or interp will fail):
-            DO it = 2, ntimes_bdy
+            DO it = 2, ntimes_bdy_bt
                IF ( zstepr(it-1) >= zstepr(it) ) THEN
                   CALL ctl_stop('Time array in unstructured boundary data file', &
@@ -766,5 +872,5 @@
             END DO
 
-            IF ( .NOT. ln_bdy_clim ) THEN
+            IF ( .NOT. ln_clim ) THEN
                ! Check that times in file span model run time:
 
@@ -778,38 +884,30 @@
                ! The same applies to the last time level: see setting of lect below.
 
-               IF ( ntimes_bdy == 1 ) CALL ctl_stop( &
+               IF ( ntimes_bdy_bt == 1 ) CALL ctl_stop( &
                     'There is only one time dump in data files', &
-                    'Set ln_bdy_clim=.true. in namelist for constant bdy forcing.' )
+                    'Set ln_clim=.true. in namelist for constant bdy forcing.' )
 
                zinterval_s = zstepr(2) - zstepr(1)
-               zinterval_e = zstepr(ntimes_bdy) - zstepr(ntimes_bdy-1)
-
-               IF ( zstepr(1) - zinterval_s / 2.0 > 0 ) THEN	          
-                  IF(lwp) WRITE(numout,*) 'First bdy time relative to nit000:', zstepr(1)
-                  IF(lwp) WRITE(numout,*) 'Interval between first two times: ', zinterval_s
-                  CALL ctl_stop( 'First data time is after start of run', & 
-                       'by more than half a meaning period', &
-                       'Check file: ' // TRIM(clfile(igrd)) )
+               zinterval_e = zstepr(ntimes_bdy_bt) - zstepr(ntimes_bdy_bt-1)
+
+               IF( zstepr(1) + zoffset > 0 ) THEN
+                     WRITE(ctmp1,*) 'Check file: ', clfile(igrd)
+                     CALL ctl_stop( 'First time dump in bdy file is after model initial time', ctmp1 )
                END IF
-
-               IF ( zstepr(ntimes_bdy) + zinterval_e / 2.0 < totime ) THEN
-                  IF(lwp) WRITE(numout,*) 'Last bdy time relative to nit000:', zstepr(ntimes_bdy)
-                  IF(lwp) WRITE(numout,*) 'Interval between last two times: ', zinterval_e
-                  CALL ctl_stop( 'Last data time is before end of run', & 
-                       'by more than half a meaning period', &
-                       'Check file: ' // TRIM(clfile(igrd))  )
+               IF( zstepr(ntimes_bdy_bt) + zoffset < totime ) THEN
+                     WRITE(ctmp1,*) 'Check file: ', clfile(igrd)
+                     CALL ctl_stop( 'Last time dump in bdy file is before model final time', ctmp1 )
                END IF
-
-            END IF ! .NOT. ln_bdy_clim
-
-            IF ( igrd .EQ. 1) THEN
+            END IF ! .NOT. ln_clim
+
+            IF ( igrd .EQ. 4) THEN
               ntimes_bdyt = ntimes_bdy_bt
               zoffsett = zoffset
               istept(:) = INT( zstepr(:) + zoffset )
-            ELSE IF (igrd .EQ. 2) THEN
+            ELSE IF (igrd .EQ. 5) THEN
               ntimes_bdyu = ntimes_bdy_bt
               zoffsetu = zoffset
               istepu(:) = INT( zstepr(:) + zoffset )
-            ELSE IF (igrd .EQ. 3) THEN
+            ELSE IF (igrd .EQ. 6) THEN
               ntimes_bdyv = ntimes_bdy_bt
               zoffsetv = zoffset
@@ -840,5 +938,5 @@
 
       ! Check number of time dumps:              
-          IF (ln_bdy_clim) THEN
+          IF (ln_clim) THEN
             SELECT CASE ( ntimes_bdy_bt )
             CASE( 1 )
@@ -852,5 +950,5 @@
             CASE DEFAULT
               CALL ctl_stop( &
-                'For climatological boundary forcing (ln_bdy_clim=.true.),',&
+                'For climatological boundary forcing (ln_clim=.true.),',&
                 'bdy data files must contain 1 or 12 time dumps.' )
             END SELECT
@@ -865,35 +963,35 @@
           nbdy_b_bt = it
 
-          WRITE(numout,*) 'Time offset is ',zoffset
-          WRITE(numout,*) 'First record to read is ',nbdy_b_bt
-
-        ENDIF ! endif (nbdy_dta == 1)
-
-      ! 1.2  Read first record in file if necessary (ie if nbdy_dta == 1)
+          IF(lwp) WRITE(numout,*) 'Time offset is ',zoffset
+          IF(lwp) WRITE(numout,*) 'First record to read is ',nbdy_b_bt
+
+        ENDIF ! endif (nn_dtactl == 1)
+
+      ! 1.2  Read first record in file if necessary (ie if nn_dtactl == 1)
       ! *****************************************************************
 
-        IF ( nbdy_dta == 0) THEN
+        IF ( nn_dtactl == 0) THEN
           ! boundary data arrays are filled with initial conditions
-          igrd = 2            ! U-points data 
+          igrd = 5            ! U-points data 
           DO ib = 1, nblen(igrd)              
             ubtbdy(ib) = un(nbi(ib,igrd), nbj(ib,igrd), 1)
           END DO
 
-          igrd = 3            ! V-points data 
+          igrd = 6            ! V-points data 
           DO ib = 1, nblen(igrd)              
             vbtbdy(ib) = vn(nbi(ib,igrd), nbj(ib,igrd), 1)
           END DO
 
-          igrd = 1            ! T-points data 
+          igrd = 4            ! T-points data 
           DO ib = 1, nblen(igrd)              
             sshbdy(ib) = sshn(nbi(ib,igrd), nbj(ib,igrd))
           END DO
 
-        ELSEIF (nbdy_dta == 1) THEN
+        ELSEIF (nn_dtactl == 1) THEN
  
         ! Set first record in the climatological case:   
-          IF ((ln_bdy_clim).AND.(ntimes_bdy_bt==1)) THEN
+          IF ((ln_clim).AND.(ntimes_bdy_bt==1)) THEN
             nbdy_a_bt = 1
-          ELSEIF ((ln_bdy_clim).AND.(ntimes_bdy_bt==iman)) THEN
+          ELSEIF ((ln_clim).AND.(ntimes_bdy_bt==iman)) THEN
             nbdy_b_bt = 0
             nbdy_a_bt = imois
@@ -904,15 +1002,15 @@
          ! Open Netcdf files:
 
-          CALL iom_open ( filbdy_data_bt_T, numbdyt_bt )
-          CALL iom_open ( filbdy_data_bt_U, numbdyu_bt )
-          CALL iom_open ( filbdy_data_bt_V, numbdyv_bt )
+          CALL iom_open ( cn_dta_fla_T, numbdyt_bt )
+          CALL iom_open ( cn_dta_fla_U, numbdyu_bt )
+          CALL iom_open ( cn_dta_fla_V, numbdyv_bt )
 
          ! Read first record:
           ipj=1
-          igrd=1
+          igrd=4
           ipi=nblendta(igrd)
 
           ! ssh
-          igrd=1
+          igrd=4
           IF ( nblendta(igrd) .le. 0 ) THEN 
             idvar = iom_varid( numbdyt_bt,'sossheig' )
@@ -929,5 +1027,5 @@
  
           ! u-velocity
-          igrd=2
+          igrd=5
           IF ( nblendta(igrd) .le. 0 ) THEN 
             idvar = iom_varid( numbdyu_bt,'vobtcrtx' )
@@ -944,5 +1042,5 @@
 
           ! v-velocity
-          igrd=3
+          igrd=6
           IF ( nblendta(igrd) .le. 0 ) THEN 
             idvar = iom_varid( numbdyv_bt,'vobtcrty' )
@@ -961,5 +1059,5 @@
  
         ! In the case of constant boundary forcing fill bdy arrays once for all
-        IF ((ln_bdy_clim).AND.(ntimes_bdy_bt==1)) THEN
+        IF ((ln_clim).AND.(ntimes_bdy_bt==1)) THEN
 
           ubtbdy  (:) = ubtbdydta  (:,2)
@@ -979,10 +1077,10 @@
       ! -------------------- !
 
-      IF ((nbdy_dta==1).AND.(ntimes_bdy_bt>1)) THEN 
+      IF ((nn_dtactl==1).AND.(ntimes_bdy_bt>1)) THEN 
 
       ! 2.1 Read one more record if necessary
       !**************************************
 
-        IF ( (ln_bdy_clim).AND.(imois/=nbdy_b_bt) ) THEN ! remember that nbdy_b_bt=0 for kt=nit000
+        IF ( (ln_clim).AND.(imois/=nbdy_b_bt) ) THEN ! remember that nbdy_b_bt=0 for kt=nit000
          nbdy_b_bt = imois
          nbdy_a_bt = imois+1
@@ -993,5 +1091,5 @@
          lect=.true.
 
-        ELSEIF ((.NOT.ln_bdy_clim).AND.(itimer >= istep_bt(nbdy_a_bt))) THEN
+        ELSEIF ((.NOT.ln_clim).AND.(itimer >= istep_bt(nbdy_a_bt))) THEN
           nbdy_b_bt=nbdy_a_bt
           nbdy_a_bt=nbdy_a_bt+1
@@ -1010,10 +1108,10 @@
           ipj=1
           ipk=jpk
-          igrd=1
+          igrd=4
           ipi=nblendta(igrd)
 
           
           ! ssh
-          igrd=1
+          igrd=4
           ipi=nblendta(igrd)
 
@@ -1025,5 +1123,5 @@
 
           ! u-velocity
-          igrd=2
+          igrd=5
           ipi=nblendta(igrd)
 
@@ -1035,5 +1133,5 @@
 
           ! v-velocity
-          igrd=3
+          igrd=6
           ipi=nblendta(igrd)
 
@@ -1045,7 +1143,7 @@
 
 
-         IF(lwp) WRITE(numout,*) 'bdy_dta : first record file used nbdy_b_bt ',nbdy_b_bt
+         IF(lwp) WRITE(numout,*) 'bdy_dta_fla : first record file used nbdy_b_bt ',nbdy_b_bt
          IF(lwp) WRITE(numout,*) '~~~~~~~~  last  record file used nbdy_a_bt ',nbdy_a_bt
-         IF (.NOT.ln_bdy_clim) THEN
+         IF (.NOT.ln_clim) THEN
            IF(lwp) WRITE(numout,*) 'first  record time (s): ', istep_bt(nbdy_b_bt)
            IF(lwp) WRITE(numout,*) 'model time (s)        : ', itimer
@@ -1058,5 +1156,5 @@
       ! ***************************
     
-        IF (ln_bdy_clim) THEN
+        IF (ln_clim) THEN
           zxy = REAL( nday, wp ) / REAL( nmonth_len(nbdy_b_bt), wp ) + 0.5 - i15
         ELSE          
@@ -1064,5 +1162,5 @@
         END IF
 
-          igrd=1
+          igrd=4
           DO ib=1, nblen(igrd)
             sshbdy(ib) = zxy      * sshbdydta(ib,2) + &
@@ -1070,5 +1168,5 @@
           END DO
 
-          igrd=2
+          igrd=5
           DO ib=1, nblen(igrd)
             ubtbdy(ib) = zxy      * ubtbdydta(ib,2) + &
@@ -1076,5 +1174,5 @@
           END DO
 
-          igrd=3
+          igrd=6
           DO ib=1, nblen(igrd)
             vbtbdy(ib) = zxy      * vbtbdydta(ib,2) + &
@@ -1083,5 +1181,5 @@
 
 
-      END IF !end if ((nbdy_dta==1).AND.(ntimes_bdy_bt>1))
+      END IF !end if ((nn_dtactl==1).AND.(ntimes_bdy_bt>1))
     
       ! ------------------- !
@@ -1090,5 +1188,5 @@
 
       ! Closing of the 3 files
-      IF( kt == nitend ) THEN
+      IF( kt == nitend   .and. jit == icycl ) THEN
           CALL iom_close( numbdyt_bt )
           CALL iom_close( numbdyu_bt )
@@ -1096,7 +1194,7 @@
       ENDIF
 
-      ENDIF ! ln_bdy_dyn_frs
-
-      END SUBROUTINE bdy_dta_bt
+      ENDIF ! ln_dyn_frs
+
+      END SUBROUTINE bdy_dta_fla
 
 
@@ -1106,10 +1204,10 @@
    !!----------------------------------------------------------------------
 CONTAINS
-   SUBROUTINE bdy_dta( kt )              ! Empty routine
-      WRITE(*,*) 'bdy_dta: You should not have seen this print! error?', kt
-   END SUBROUTINE bdy_dta
-   SUBROUTINE bdy_dta_bt( kt, kit )      ! Empty routine
-      WRITE(*,*) 'bdy_dta: You should not have seen this print! error?', kt, kit
-   END SUBROUTINE bdy_dta_bt
+   SUBROUTINE bdy_dta_frs( kt )              ! Empty routine
+      WRITE(*,*) 'bdy_dta_frs: You should not have seen this print! error?', kt
+   END SUBROUTINE bdy_dta_frs
+   SUBROUTINE bdy_dta_fla( kt, kit, icycle )      ! Empty routine
+      WRITE(*,*) 'bdy_dta_frs: You should not have seen this print! error?', kt, kit
+   END SUBROUTINE bdy_dta_fla
 #endif
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90	(revision 2528)
@@ -8,4 +8,6 @@
    !!            3.0  !  2008-04  (NEMO team)  add in the reference version
    !!            3.2  !  2008-04  (R. Benshila) consider velocity instead of transport 
+   !!            3.3  !  2010-09  (E.O'Dea) modifications for Shelf configurations 
+   !!            3.3  !  2010-09  (D.Storkey) add ice boundary conditions
    !!----------------------------------------------------------------------
 #if defined key_bdy 
@@ -34,9 +36,8 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -54,47 +55,51 @@
       INTEGER, INTENT( in ) ::   kt   ! Main time step counter
       !!
-      INTEGER  ::   ib, ik, igrd      ! dummy loop indices
-      INTEGER  ::   ii, ij            ! 2D addresses
-      REAL(wp) ::   zwgt              ! boundary weight
+      INTEGER  ::   jb, jk         ! dummy loop indices
+      INTEGER  ::   ii, ij, igrd   ! local integers
+      REAL(wp) ::   zwgt           ! boundary weight
       !!----------------------------------------------------------------------
       !
-      IF(ln_bdy_dyn_frs) THEN ! If this is false, then this routine does nothing. 
-
+      IF(ln_dyn_frs) THEN       ! If this is false, then this routine does nothing. 
+         !
          IF( kt == nit000 ) THEN
             IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) 'bdy_dyn : Flow Relaxation Scheme on momentum'
+            IF(lwp) WRITE(numout,*) 'bdy_dyn_frs : Flow Relaxation Scheme on momentum'
             IF(lwp) WRITE(numout,*) '~~~~~~~'
          ENDIF
          !
          igrd = 2                      ! Relaxation of zonal velocity
-         DO ib = 1, nblen(igrd)
-            DO ik = 1, jpkm1
-               ii = nbi(ib,igrd)
-               ij = nbj(ib,igrd)
-               zwgt = nbw(ib,igrd)
-               ua(ii,ij,ik) = ( ua(ii,ij,ik) * ( 1.- zwgt ) + ubdy(ib,ik) * zwgt ) * umask(ii,ij,ik)
+         DO jb = 1, nblen(igrd)
+            DO jk = 1, jpkm1
+               ii   = nbi(jb,igrd)
+               ij   = nbj(jb,igrd)
+               zwgt = nbw(jb,igrd)
+               ua(ii,ij,jk) = ( ua(ii,ij,jk) * ( 1.- zwgt ) + ubdy(jb,jk) * zwgt ) * umask(ii,ij,jk)
             END DO
          END DO
          !
          igrd = 3                      ! Relaxation of meridional velocity
-         DO ib = 1, nblen(igrd)
-            DO ik = 1, jpkm1
-               ii = nbi(ib,igrd)
-               ij = nbj(ib,igrd)
-               zwgt = nbw(ib,igrd)
-               va(ii,ij,ik) = ( va(ii,ij,ik) * ( 1.- zwgt ) + vbdy(ib,ik) * zwgt ) * vmask(ii,ij,ik)
+         DO jb = 1, nblen(igrd)
+            DO jk = 1, jpkm1
+               ii   = nbi(jb,igrd)
+               ij   = nbj(jb,igrd)
+               zwgt = nbw(jb,igrd)
+               va(ii,ij,jk) = ( va(ii,ij,jk) * ( 1.- zwgt ) + vbdy(jb,jk) * zwgt ) * vmask(ii,ij,jk)
             END DO
          END DO 
+         CALL lbc_lnk( ua, 'U', -1. )   ;   CALL lbc_lnk( va, 'V', -1. )   ! Boundary points should be updated
          !
-         CALL lbc_lnk( ua, 'U', -1. )   ! Boundary points should be updated
-         CALL lbc_lnk( va, 'V', -1. )   !
-         !
-      ENDIF ! ln_bdy_dyn_frs
-
+      ENDIF ! ln_dyn_frs
+      !
    END SUBROUTINE bdy_dyn_frs
 
 
-#if defined key_dynspg_exp || defined key_dynspg_ts
+# if defined   key_dynspg_exp   ||   defined key_dynspg_ts
+   !!----------------------------------------------------------------------
+   !!   'key_dynspg_exp'        OR              explicit sea surface height
+   !!   'key_dynspg_ts '                  split-explicit sea surface height
+   !!----------------------------------------------------------------------
+   
 !! Option to use Flather with dynspg_flt not coded yet...
+
    SUBROUTINE bdy_dyn_fla( pssh )
       !!----------------------------------------------------------------------
@@ -102,5 +107,5 @@
       !!             
       !!              - Apply Flather boundary conditions on normal barotropic velocities 
-      !!                (ln_bdy_dyn_fla=.true. or ln_bdy_tides=.true.)
+      !!                (ln_dyn_fla=.true. or ln_tides=.true.)
       !!
       !! ** WARNINGS about FLATHER implementation:
@@ -119,5 +124,5 @@
       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pssh
 
-      INTEGER  ::   ib, igrd                         ! dummy loop indices
+      INTEGER  ::   jb, igrd                         ! dummy loop indices
       INTEGER  ::   ii, ij, iim1, iip1, ijm1, ijp1   ! 2D addresses
       REAL(wp) ::   zcorr                            ! Flather correction
@@ -129,44 +134,46 @@
       ! ---------------------------------! 
      
-      IF(ln_bdy_dyn_fla .OR. ln_bdy_tides) THEN ! If these are both false, then this routine does nothing. 
+      IF(ln_dyn_fla .OR. ln_tides) THEN ! If these are both false, then this routine does nothing. 
 
          ! Fill temporary array with ssh data (here spgu):
-         igrd = 1
+         igrd = 4
          spgu(:,:) = 0.0
-         DO ib = 1, nblenrim(igrd)
-            ii = nbi(ib,igrd)
-            ij = nbj(ib,igrd)
-            IF( ln_bdy_dyn_fla ) spgu(ii, ij) = sshbdy(ib)
-            IF( ln_bdy_tides )   spgu(ii, ij) = spgu(ii, ij) + sshtide(ib)
+         DO jb = 1, nblenrim(igrd)
+            ii = nbi(jb,igrd)
+            ij = nbj(jb,igrd)
+            IF( ln_dyn_fla ) spgu(ii, ij) = sshbdy(jb)
+            IF( ln_tides )   spgu(ii, ij) = spgu(ii, ij) + sshtide(jb)
          END DO
          !
-         igrd = 2      ! Flather bc on u-velocity; 
+         igrd = 5      ! Flather bc on u-velocity; 
          !             ! remember that flagu=-1 if normal velocity direction is outward
          !             ! I think we should rather use after ssh ?
-         DO ib = 1, nblenrim(igrd)
-            ii  = nbi(ib,igrd)
-            ij  = nbj(ib,igrd) 
-            iim1 = ii + MAX( 0, INT( flagu(ib) ) )   ! T pts i-indice inside the boundary
-            iip1 = ii - MIN( 0, INT( flagu(ib) ) )   ! T pts i-indice outside the boundary 
+         DO jb = 1, nblenrim(igrd)
+            ii  = nbi(jb,igrd)
+            ij  = nbj(jb,igrd) 
+            iim1 = ii + MAX( 0, INT( flagu(jb) ) )   ! T pts i-indice inside the boundary
+            iip1 = ii - MIN( 0, INT( flagu(jb) ) )   ! T pts i-indice outside the boundary 
             !
-            zcorr = - flagu(ib) * SQRT( grav * hur_e(ii, ij) ) * ( pssh(iim1, ij) - spgu(iip1,ij) )
-            zforc = ubtbdy(ib) + utide(ib)
+            zcorr = - flagu(jb) * SQRT( grav * hur_e(ii, ij) ) * ( pssh(iim1, ij) - spgu(iip1,ij) )
+            zforc = ubtbdy(jb) + utide(jb)
             ua_e(ii,ij) = zforc + zcorr * umask(ii,ij,1) 
          END DO
          !
-         igrd = 3      ! Flather bc on v-velocity
+         igrd = 6      ! Flather bc on v-velocity
          !             ! remember that flagv=-1 if normal velocity direction is outward
-         DO ib = 1, nblenrim(igrd)
-            ii  = nbi(ib,igrd)
-            ij  = nbj(ib,igrd) 
-            ijm1 = ij + MAX( 0, INT( flagv(ib) ) )   ! T pts j-indice inside the boundary
-            ijp1 = ij - MIN( 0, INT( flagv(ib) ) )   ! T pts j-indice outside the boundary 
+         DO jb = 1, nblenrim(igrd)
+            ii  = nbi(jb,igrd)
+            ij  = nbj(jb,igrd) 
+            ijm1 = ij + MAX( 0, INT( flagv(jb) ) )   ! T pts j-indice inside the boundary
+            ijp1 = ij - MIN( 0, INT( flagv(jb) ) )   ! T pts j-indice outside the boundary 
             !
-            zcorr = - flagv(ib) * SQRT( grav * hvr_e(ii, ij) ) * ( pssh(ii, ijm1) - spgu(ii,ijp1) )
-            zforc = vbtbdy(ib) + vtide(ib)
+            zcorr = - flagv(jb) * SQRT( grav * hvr_e(ii, ij) ) * ( pssh(ii, ijm1) - spgu(ii,ijp1) )
+            zforc = vbtbdy(jb) + vtide(jb)
             va_e(ii,ij) = zforc + zcorr * vmask(ii,ij,1)
          END DO
+         CALL lbc_lnk( ua_e, 'U', -1. )   ! Boundary points should be updated
+         CALL lbc_lnk( va_e, 'V', -1. )   !
          !
-      ENDIF ! ln_bdy_dyn_fla .or. ln_bdy_tides
+      ENDIF ! ln_dyn_fla .or. ln_tides
       !
    END SUBROUTINE bdy_dyn_fla
Index: trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice.F90	(revision 2528)
@@ -0,0 +1,84 @@
+MODULE bdyice
+   !!======================================================================
+   !!                       ***  MODULE  bdyice  ***
+   !! Unstructured Open Boundary Cond. :  Flow Relaxation Scheme applied sea-ice
+   !!======================================================================
+   !!  History :  3.3  !  2010-09 (D. Storkey)  Original code
+   !!----------------------------------------------------------------------
+#if defined   key_bdy   &&   defined key_lim2
+   !!----------------------------------------------------------------------
+   !!   'key_bdy'            and                 Unstructured Open Boundary Conditions
+   !!   'key_lim2'                                                 LIM-2 sea ice model
+   !!----------------------------------------------------------------------
+   !!   bdy_ice_frs        : Relaxation of tracers on unstructured open boundaries
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+   USE ice_2           ! LIM_2 ice variables
+   USE dom_oce         ! ocean space and time domain variables 
+   USE bdy_oce         ! ocean open boundary conditions
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE in_out_manager  ! write to numout file
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   bdy_ice_frs    ! routine called in sbcmod
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE bdy_ice_frs( kt )
+      !!------------------------------------------------------------------------------
+      !!                 ***  SUBROUTINE bdy_ice_frs  ***
+      !!                    
+      !! ** Purpose : Apply the Flow Relaxation Scheme for sea-ice fields in the case 
+      !!              of unstructured open boundaries. Currently only tested for LIM2.
+      !! 
+      !! Reference : Engedahl H., 1995: Use of the flow relaxation scheme in a three-
+      !!             dimensional baroclinic ocean model with realistic topography. Tellus, 365-382.
+      !!------------------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt   ! model time step index
+      !!
+      INTEGER  ::   jb, jk, jgrd   ! dummy loop indices
+      INTEGER  ::   ii, ij         ! local scalar
+      REAL(wp) ::   zwgt, zwgt1    ! local scalar
+      !!------------------------------------------------------------------------------
+      !
+      jgrd = 1      ! Everything is at T-points here
+      !
+      IF( ln_ice_frs ) THEN     ! update ice fields by relaxation at the boundary
+         DO jb = 1, nblen(jgrd)
+            DO jk = 1, jpkm1
+               ii    = nbi(jb,jgrd)
+               ij    = nbj(jb,jgrd)
+               zwgt  = nbw(jb,jgrd)
+               zwgt1 = 1.e0 - nbw(jb,jgrd)
+               frld (ii,ij) = ( frld (ii,ij) * zwgt1 + frld_bdy (jb) * zwgt ) * tmask(ii,ij,1)     ! Leads fraction 
+               hicif(ii,ij) = ( hicif(ii,ij) * zwgt1 + hicif_bdy(jb) * zwgt ) * tmask(ii,ij,1)     ! Ice depth 
+               hsnif(ii,ij) = ( hsnif(ii,ij) * zwgt1 + hsnif_bdy(jb) * zwgt ) * tmask(ii,ij,1)     ! Snow depth
+            END DO
+         END DO 
+         CALL lbc_lnk( frld, 'T', 1. )                                         ! lateral boundary conditions
+         CALL lbc_lnk( hicif, 'T', 1. )   ;   CALL lbc_lnk( hsnif, 'T', 1. )
+         !
+      ELSE                          ! we have called this routine without ln_ice_frs not set
+         IF( kt == nit000 )   CALL ctl_warn( 'E R R O R (possible) called bdy_ice_frs when ln_ice_frs is false?' )
+      ENDIF
+      !      
+   END SUBROUTINE bdy_ice_frs
+#else
+   !!---------------------------------------------------------------------------------
+   !!   Default option                                                    Empty module
+   !!---------------------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE bdy_ice_frs( kt )      ! Empty routine
+      WRITE(*,*) 'bdy_ice_frs: You should not have seen this print! error?', kt
+   END SUBROUTINE bdy_ice_frs
+#endif
+
+   !!=================================================================================
+END MODULE bdyice
Index: trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90	(revision 2528)
@@ -8,4 +8,6 @@
    !!             -   !  2007-01  (D. Storkey) Tidal forcing
    !!            3.0  !  2008-04  (NEMO team)  add in the reference version
+   !!            3.3  !  2010-09  (E.O'Dea) updates for Shelf configurations
+   !!            3.3  !  2010-09  (D.Storkey) add ice boundary conditions
    !!----------------------------------------------------------------------
 #if defined key_bdy
@@ -17,4 +19,5 @@
    USE oce             ! ocean dynamics and tracers variables
    USE dom_oce         ! ocean space and time domain
+   USE obc_par         ! ocean open boundary conditions
    USE bdy_oce         ! unstructured open boundary conditions
    USE bdytides        ! tides at open boundaries initialization (tide_init routine)
@@ -30,9 +33,8 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!---------------------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
    
@@ -48,5 +50,4 @@
       !!
       !! ** Input   :  bdy_init.nc, input file for unstructured open boundaries
-      !!
       !!----------------------------------------------------------------------      
       INTEGER ::   ii, ij, ik, igrd, ib, ir   ! dummy loop indices
@@ -54,6 +55,6 @@
       INTEGER ::   ib_len, ibr_max
       INTEGER ::   iw, ie, is, in 
-      INTEGER ::   inum                 ! temporary logical unit
-      INTEGER ::   id_dummy             ! temporary integers
+      INTEGER ::   inum                 ! local logical unit
+      INTEGER ::   id_dummy             ! local integers
       INTEGER ::   igrd_start, igrd_end ! start and end of loops on igrd
       INTEGER, DIMENSION (2)             ::   kdimsz
@@ -63,10 +64,11 @@
       REAL(wp) , DIMENSION(jpidta,jpjdta) ::   zmask           ! global domain mask
       REAL(wp) , DIMENSION(jpbdta,1)      ::   zdta            ! temporary array 
-      CHARACTER(LEN=80),DIMENSION(3)      ::   clfile
+      CHARACTER(LEN=80),DIMENSION(6)      ::   clfile
       !!
-      NAMELIST/nambdy/filbdy_mask, filbdy_data_T, filbdy_data_U, filbdy_data_V,          &
-         &            ln_bdy_tides, ln_bdy_clim, ln_bdy_vol, ln_bdy_mask,                &
-         &            ln_bdy_dyn_fla, ln_bdy_dyn_frs, ln_bdy_tra_frs,                    &
-         &            nbdy_dta   , nb_rimwidth  , volbdy
+      NAMELIST/nambdy/cn_mask, cn_dta_frs_T, cn_dta_frs_U, cn_dta_frs_V,          &
+         &            cn_dta_fla_T, cn_dta_fla_U, cn_dta_fla_V,              &
+         &            ln_tides, ln_clim, ln_vol, ln_mask,                &
+         &            ln_dyn_fla, ln_dyn_frs, ln_tra_frs,ln_ice_frs,     &
+         &            nn_dtactl, nn_rimwidth, nn_volctl
       !!----------------------------------------------------------------------
 
@@ -75,80 +77,71 @@
       IF(lwp) WRITE(numout,*) '~~~~~~~~'
       !
-      IF( jperio /= 0 ) CALL ctl_stop( 'Cyclic or symmetric,',   &
-           ' and unstructured open boundary condition are not compatible' )
-
-#if defined key_obc
-      CALL ctl_stop( 'Straight open boundaries,',   &
-           ' and unstructured open boundaries are not compatible' )
-#endif
-
-      ! Read namelist parameters
+      IF( jperio /= 0 )   CALL ctl_stop( 'Cyclic or symmetric,',   &
+         &                               ' and unstructured open boundary condition are not compatible' )
+
+      IF( lk_obc      )   CALL ctl_stop( 'Straight open boundaries,',   &
+         &                               ' and unstructured open boundaries are not compatible' )
+
       ! ---------------------------
-      REWIND( numnam )
+      REWIND( numnam )                    ! Read namelist parameters
       READ  ( numnam, nambdy )
 
-      ! control prints
+      !                                   ! control prints
       IF(lwp) WRITE(numout,*) '         nambdy'
 
-      ! Check nbdy_dta value
-      IF(lwp) WRITE(numout,*) 'nbdy_dta =', nbdy_dta      
-      IF(lwp) WRITE(numout,*) ' '
-      SELECT CASE( nbdy_dta )
-      CASE( 0 )
-        IF(lwp) WRITE(numout,*) '         initial state used for bdy data'        
-      CASE( 1 )
-        IF(lwp) WRITE(numout,*) '         boundary data taken from file'
-      CASE DEFAULT
-        CALL ctl_stop( 'nbdy_dta must be 0 or 1' )
+      !                                         ! check type of data used (nn_dtactl value)
+      IF(lwp) WRITE(numout,*) 'nn_dtactl =', nn_dtactl      
+      IF(lwp) WRITE(numout,*)
+      SELECT CASE( nn_dtactl )                   ! 
+      CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      initial state used for bdy data'        
+      CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      boundary data taken from file'
+      CASE DEFAULT   ;   CALL ctl_stop( 'nn_dtactl must be 0 or 1' )
       END SELECT
 
-      IF(lwp) WRITE(numout,*) ' '
-      IF(lwp) WRITE(numout,*) 'Boundary rim width for the FRS nb_rimwidth = ', nb_rimwidth
-
-      IF(lwp) WRITE(numout,*) ' '
-      IF(lwp) WRITE(numout,*) '         volbdy = ', volbdy
-
-      IF (ln_bdy_vol) THEN
-        SELECT CASE ( volbdy ) ! Check volbdy value
-        CASE( 1 )
-          IF(lwp) WRITE(numout,*) '         The total volume will be constant'
-        CASE( 0 )
-          IF(lwp) WRITE(numout,*) '         The total volume will vary according'
-          IF(lwp) WRITE(numout,*) '         to the surface E-P flux'
-        CASE DEFAULT
-          CALL ctl_stop( 'volbdy must be 0 or 1' )
-        END SELECT
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'Boundary rim width for the FRS nn_rimwidth = ', nn_rimwidth
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '      nn_volctl = ', nn_volctl
+
+      IF( ln_vol ) THEN                     ! check volume conservation (nn_volctl value)
+         SELECT CASE ( nn_volctl )
+         CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      The total volume will be constant'
+         CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      The total volume will vary according to the surface E-P flux'
+         CASE DEFAULT   ;   CALL ctl_stop( 'nn_volctl must be 0 or 1' )
+         END SELECT
+         IF(lwp) WRITE(numout,*)
       ELSE
-        IF(lwp) WRITE(numout,*) 'No volume correction with unstructured open boundaries'
-        IF(lwp) WRITE(numout,*) ' '
-      ENDIF
-
-      IF (ln_bdy_tides) THEN
-        IF(lwp) WRITE(numout,*) ' '
+         IF(lwp) WRITE(numout,*) 'No volume correction with unstructured open boundaries'
+         IF(lwp) WRITE(numout,*)
+      ENDIF
+
+      IF( ln_tides ) THEN
         IF(lwp) WRITE(numout,*) 'Tidal harmonic forcing at unstructured open boundaries'
-        IF(lwp) WRITE(numout,*) ' '
-      ENDIF
-
-      IF (ln_bdy_dyn_fla) THEN
-        IF(lwp) WRITE(numout,*) ' '
+        IF(lwp) WRITE(numout,*)
+      ENDIF
+
+      IF( ln_dyn_fla ) THEN
         IF(lwp) WRITE(numout,*) 'Flather condition on U, V at unstructured open boundaries'
-        IF(lwp) WRITE(numout,*) ' '
-      ENDIF
-
-      IF (ln_bdy_dyn_frs) THEN
-        IF(lwp) WRITE(numout,*) ' '
+        IF(lwp) WRITE(numout,*)
+      ENDIF
+
+      IF( ln_dyn_frs ) THEN
         IF(lwp) WRITE(numout,*) 'FRS condition on U and V at unstructured open boundaries'
-        IF(lwp) WRITE(numout,*) ' '
-      ENDIF
-
-      IF (ln_bdy_tra_frs) THEN
-        IF(lwp) WRITE(numout,*) ' '
+        IF(lwp) WRITE(numout,*)
+      ENDIF
+
+      IF( ln_tra_frs ) THEN
         IF(lwp) WRITE(numout,*) 'FRS condition on T & S fields at unstructured open boundaries'
-        IF(lwp) WRITE(numout,*) ' '
-      ENDIF
-
-      ! Read tides namelist 
-      ! ------------------------
-      IF( ln_bdy_tides )   CALL tide_init
+        IF(lwp) WRITE(numout,*)
+      ENDIF
+
+      IF( ln_ice_frs ) THEN
+        IF(lwp) WRITE(numout,*) 'FRS condition on ice fields at unstructured open boundaries'
+        IF(lwp) WRITE(numout,*)
+      ENDIF
+
+      IF( ln_tides )   CALL tide_init      ! Read tides namelist 
+
 
       ! Read arrays defining unstructured open boundaries
@@ -160,9 +153,9 @@
       !          = 0  elsewhere   
  
-      IF( cp_cfg == "eel" .AND. jp_cfg == 5 ) THEN
+      IF( cp_cfg == "eel" .AND. jp_cfg == 5 ) THEN          ! EEL configuration at 5km resolution
          zmask(         :                ,:) = 0.e0
          zmask(jpizoom+1:jpizoom+jpiglo-2,:) = 1.e0          
-      ELSE IF ( ln_bdy_mask ) THEN
-         CALL iom_open( filbdy_mask, inum )
+      ELSE IF( ln_mask ) THEN
+         CALL iom_open( cn_mask, inum )
          CALL iom_get ( inum, jpdom_data, 'bdy_msk', zmask(:,:) )
          CALL iom_close( inum )
@@ -171,6 +164,5 @@
       ENDIF
 
-      ! Save mask over local domain      
-      DO ij = 1, nlcj
+      DO ij = 1, nlcj      ! Save mask over local domain      
          DO ii = 1, nlci
             bdytmask(ii,ij) = zmask( mig(ii), mjg(ij) )
@@ -187,8 +179,6 @@
          END DO
       END DO
-
-      ! Lateral boundary conditions
-      CALL lbc_lnk( bdyumask(:,:), 'U', 1. )
-      CALL lbc_lnk( bdyvmask(:,:), 'V', 1. )
+      CALL lbc_lnk( bdyumask(:,:), 'U', 1. )   ;   CALL lbc_lnk( bdyvmask(:,:), 'V', 1. )      ! Lateral boundary cond.
+
 
       ! Read discrete distance and mapping indices
@@ -200,18 +190,16 @@
       IF( cp_cfg == "eel" .AND. jp_cfg == 5 ) THEN
          icount = 0
-         ! Define west boundary (from ii=2 to ii=1+nb_rimwidth):
-         DO ir = 1, nb_rimwidth         
+         DO ir = 1, nn_rimwidth                  ! Define west boundary (from ii=2 to ii=1+nn_rimwidth):
             DO ij = 3, jpjglo-2
-               icount=icount+1
+               icount = icount + 1
                nbidta(icount,:) = ir + 1 + (jpizoom-1)
-               nbjdta(icount,:) = ij + (jpjzoom-1) 
+               nbjdta(icount,:) = ij     + (jpjzoom-1) 
                nbrdta(icount,:) = ir
             END DO
          END DO
-
-         ! Define east boundary (from ii=jpiglo-1 to ii=jpiglo-nb_rimwidth):
-         DO ir=1,nb_rimwidth         
+         !
+         DO ir = 1, nn_rimwidth                  ! Define east boundary (from ii=jpiglo-1 to ii=jpiglo-nn_rimwidth):
             DO ij=3,jpjglo-2
-               icount=icount+1
+               icount = icount + 1
                nbidta(icount,:) = jpiglo-ir + (jpizoom-1)
                nbidta(icount,2) = jpiglo-ir-1 + (jpizoom-1) ! special case for u points
@@ -220,30 +208,42 @@
             END DO
          END DO
-            
+         !       
       ELSE            ! Read indices and distances in unstructured boundary data files 
-
-         IF( ln_bdy_tides ) THEN 
-            ! Read tides input files for preference in case there are
-            ! no bdydata files. 
-            clfile(1) = TRIM(filtide)//TRIM(tide_cpt(1))//'_grid_T.nc'
-            clfile(2) = TRIM(filtide)//TRIM(tide_cpt(1))//'_grid_U.nc'
-            clfile(3) = TRIM(filtide)//TRIM(tide_cpt(1))//'_grid_V.nc'
-         ELSE
-            clfile(1) = filbdy_data_T
-            clfile(2) = filbdy_data_U
-            clfile(3) = filbdy_data_V
+         !
+         IF( ln_tides ) THEN             ! Read tides input files for preference in case there are no bdydata files
+            clfile(4) = TRIM(filtide)//TRIM(tide_cpt(1))//'_grid_T.nc'
+            clfile(5) = TRIM(filtide)//TRIM(tide_cpt(1))//'_grid_U.nc'
+            clfile(6) = TRIM(filtide)//TRIM(tide_cpt(1))//'_grid_V.nc'
+         ENDIF
+         IF( ln_dyn_fla .AND. .NOT. ln_tides ) THEN 
+            clfile(4) = cn_dta_fla_T
+            clfile(5) = cn_dta_fla_U
+            clfile(6) = cn_dta_fla_V
+         ENDIF
+
+         IF( ln_tra_frs ) THEN 
+            clfile(1) = cn_dta_frs_T
+            IF( .NOT. ln_dyn_frs ) THEN 
+               clfile(2) = cn_dta_frs_T     ! Dummy read re read T file for sake of 6 files
+               clfile(3) = cn_dta_frs_T     !
+            ENDIF
          ENDIF          
-
-         ! how many files are we to read in?
-         igrd_start = 1
-         igrd_end   = 3
-         IF(.NOT. ln_bdy_tides ) THEN
-            IF(.NOT. (ln_bdy_dyn_fla) .AND..NOT. (ln_bdy_tra_frs)) THEN
-               ! No T-grid file.
-               igrd_start = 2
-            ELSEIF ( .NOT. ln_bdy_dyn_frs .AND..NOT. ln_bdy_dyn_fla ) THEN
-               ! No U-grid or V-grid file.
-               igrd_end   = 1         
-            ENDIF
+         IF( ln_dyn_frs ) THEN 
+            IF( .NOT. ln_tra_frs )   clfile(1) = cn_dta_frs_U      ! Dummy Read 
+            clfile(2) = cn_dta_frs_U
+            clfile(3) = cn_dta_frs_V 
+         ENDIF
+
+         !                                   ! how many files are we to read in?
+         IF(ln_tides .OR. ln_dyn_fla)   igrd_start = 4
+         !
+         IF(ln_tra_frs    ) THEN   ;   igrd_start = 1
+         ELSEIF(ln_dyn_frs) THEN   ;   igrd_start = 2
+         ENDIF
+         !
+         IF( ln_tra_frs   )   igrd_end = 1
+         !
+         IF(ln_dyn_fla .OR. ln_tides) THEN   ;   igrd_end = 6
+         ELSEIF( ln_dyn_frs             ) THEN   ;   igrd_end = 3
          ENDIF
 
@@ -251,10 +251,8 @@
             CALL iom_open( clfile(igrd), inum )
             id_dummy = iom_varid( inum, 'nbidta', kdimsz=kdimsz )  
-            WRITE(numout,*) 'kdimsz : ',kdimsz
+            IF(lwp) WRITE(numout,*) 'kdimsz : ',kdimsz
             ib_len = kdimsz(1)
-            IF( ib_len > jpbdta) CALL ctl_stop(          &
-                'Boundary data array in file too long.', &
-                'File :', TRIM(clfile(igrd)),            &
-                'increase parameter jpbdta.' )
+            IF( ib_len > jpbdta)   CALL ctl_stop(  'Boundary data array in file too long.',                  &
+                &                                  'File :', TRIM(clfile(igrd)),'increase parameter jpbdta.' )
 
             CALL iom_get( inum, jpdom_unknown, 'nbidta', zdta(1:ib_len,:) )
@@ -264,19 +262,19 @@
             CALL iom_get( inum, jpdom_unknown, 'nbjdta', zdta(1:ib_len,:) )
             DO ii = 1,ib_len
-              nbjdta(ii,igrd) = INT( zdta(ii,1) )
-            END DO
-            CALL iom_get ( inum, jpdom_unknown, 'nbrdta', zdta(1:ib_len,:) )
+               nbjdta(ii,igrd) = INT( zdta(ii,1) )
+            END DO
+            CALL iom_get( inum, jpdom_unknown, 'nbrdta', zdta(1:ib_len,:) )
             DO ii = 1,ib_len
-              nbrdta(ii,igrd) = INT( zdta(ii,1) )
+               nbrdta(ii,igrd) = INT( zdta(ii,1) )
             END DO
             CALL iom_close( inum )
 
-            ! Check that rimwidth in file is big enough:
-            ibr_max = MAXVAL( nbrdta(:,igrd) )
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) ' Maximum rimwidth in file is ', ibr_max
-            IF(lwp) WRITE(numout,*) ' nb_rimwidth from namelist is ', nb_rimwidth
-            IF (ibr_max < nb_rimwidth) CALL ctl_stop( &
-                'nb_rimwidth is larger than maximum rimwidth in file' )
+            IF( igrd < 4) THEN            ! Check that rimwidth in file is big enough for Frs case(barotropic is one):
+               ibr_max = MAXVAL( nbrdta(:,igrd) )
+               IF(lwp) WRITE(numout,*)
+               IF(lwp) WRITE(numout,*) ' Maximum rimwidth in file is ', ibr_max
+               IF(lwp) WRITE(numout,*) ' nn_rimwidth from namelist is ', nn_rimwidth
+               IF (ibr_max < nn_rimwidth)   CALL ctl_stop( 'nn_rimwidth is larger than maximum rimwidth in file' )
+            ENDIF !Check igrd < 4
             !
          END DO
@@ -293,19 +291,19 @@
 
       DO igrd = igrd_start, igrd_end
-        icount  = 0
-        icountr = 0
-        nblen(igrd) = 0
-        nblenrim(igrd) = 0
-        nblendta(igrd) = 0
-        DO ir=1, nb_rimwidth
-          DO ib = 1, jpbdta
-          ! check if point is in local domain and equals ir
-            IF(  nbidta(ib,igrd) >= iw .AND. nbidta(ib,igrd) <= ie .AND.   &
-               & nbjdta(ib,igrd) >= is .AND. nbjdta(ib,igrd) <= in .AND.   &
-               & nbrdta(ib,igrd) == ir  ) THEN
-               !
-               icount = icount  + 1
-               !
-               IF( ir == 1 )   icountr = icountr+1
+         icount  = 0
+         icountr = 0
+         nblen   (igrd) = 0
+         nblenrim(igrd) = 0
+         nblendta(igrd) = 0
+         DO ir=1, nn_rimwidth
+            DO ib = 1, jpbdta
+               ! check if point is in local domain and equals ir
+               IF(  nbidta(ib,igrd) >= iw .AND. nbidta(ib,igrd) <= ie .AND.   &
+                  & nbjdta(ib,igrd) >= is .AND. nbjdta(ib,igrd) <= in .AND.   &
+                  & nbrdta(ib,igrd) == ir  ) THEN
+                  !
+                  icount = icount  + 1
+                  !
+                  IF( ir == 1 )   icountr = icountr+1
                   IF (icount > jpbdim) THEN
                      IF(lwp) WRITE(numout,*) 'bdy_ini: jpbdim too small'
@@ -328,10 +326,7 @@
       DO igrd = igrd_start, igrd_end
          DO ib = 1, nblen(igrd)
-            ! tanh formulation
-            nbw(ib,igrd) = 1.- TANH( FLOAT( nbr(ib,igrd) - 1 ) *0.5 )
-            ! quadratic
-!           nbw(ib,igrd) = (FLOAT(nb_rimwidth+1-nbr(ib,igrd))/FLOAT(nb_rimwidth))**2
-            ! linear
-!           nbw(ib,igrd) =  FLOAT(nb_rimwidth+1-nbr(ib,igrd))/FLOAT(nb_rimwidth)
+            nbw(ib,igrd) = 1.- TANH( FLOAT( nbr(ib,igrd) - 1 ) *0.5 )                     ! tanh formulation
+!           nbw(ib,igrd) = (FLOAT(nn_rimwidth+1-nbr(ib,igrd))/FLOAT(nn_rimwidth))**2      ! quadratic
+!           nbw(ib,igrd) =  FLOAT(nn_rimwidth+1-nbr(ib,igrd))/FLOAT(nn_rimwidth)          ! linear
          END DO
       END DO 
@@ -384,10 +379,8 @@
 
       ! Lateral boundary conditions
-      CALL lbc_lnk( fmask        , 'F', 1. )
-      CALL lbc_lnk( bdytmask(:,:), 'T', 1. )
-      CALL lbc_lnk( bdyumask(:,:), 'U', 1. )
-      CALL lbc_lnk( bdyvmask(:,:), 'V', 1. )
-
-      IF( ln_bdy_vol .OR. ln_bdy_dyn_fla ) THEN      ! Indices and directions of rim velocity components
+      CALL lbc_lnk( fmask        , 'F', 1. )   ;   CALL lbc_lnk( bdytmask(:,:), 'T', 1. )
+      CALL lbc_lnk( bdyumask(:,:), 'U', 1. )   ;   CALL lbc_lnk( bdyvmask(:,:), 'V', 1. )
+
+      IF( ln_vol .OR. ln_dyn_fla ) THEN      ! Indices and directions of rim velocity components
          !
          !flagu = -1 : u component is normal to the dynamical boundary but its direction is outward
@@ -437,7 +430,6 @@
       ! Compute total lateral surface for volume correction:
       ! ----------------------------------------------------
- 
       bdysurftot = 0.e0 
-      IF( ln_bdy_vol ) THEN  
+      IF( ln_vol ) THEN  
          igrd = 2      ! Lateral surface at U-points
          DO ib = 1, nblenrim(igrd)
@@ -455,5 +447,5 @@
                &                    * tmask_i(nbi(ib,igrd),nbj(ib,igrd)+1)
          END DO
-
+         !
          IF( lk_mpp )   CALL mpp_sum( bdysurftot )      ! sum over the global domain
       END IF   
@@ -468,8 +460,13 @@
       ubtbdy(:) = 0.e0
       vbtbdy(:) = 0.e0
+#if defined key_lim2
+      frld_bdy(:) = 0.e0
+      hicif_bdy(:) = 0.e0
+      hsnif_bdy(:) = 0.e0
+#endif
 
       ! Read in tidal constituents and adjust for model start time
       ! ----------------------------------------------------------
-      IF( ln_bdy_tides )   CALL tide_data
+      IF( ln_tides )   CALL tide_data
       !
    END SUBROUTINE bdy_init
Index: trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90	(revision 2528)
@@ -7,4 +7,5 @@
    !!            2.3  !  2008-01  (J.Holt)  Add date correction. Origins POLCOMS v6.3 2007
    !!            3.0  !  2008-04  (NEMO team)  add in the reference version
+   !!            3.3  !  2010-09  (D.Storkey and E.O'Dea)  bug fixes
    !!----------------------------------------------------------------------
 #if defined key_bdy
@@ -31,4 +32,5 @@
    USE bdy_par         ! Unstructured boundary parameters
    USE bdy_oce         ! ocean open boundary conditions
+   USE daymod          ! calendar
 
    IMPLICIT NONE
@@ -39,25 +41,23 @@
    PUBLIC   tide_update   ! routine called in bdydyn
 
-   LOGICAL, PUBLIC            ::   ln_tide_date            !: =T correct tide phases and amplitude for model start date
-
-   INTEGER, PARAMETER ::   jptides_max = 15      !: Max number of tidal contituents
-   INTEGER            ::   ntide                 !: Actual number of tidal constituents
+   LOGICAL, PUBLIC            ::   ln_tide_date          !: =T correct tide phases and amplitude for model start date
+   INTEGER, PUBLIC, PARAMETER ::   jptides_max = 15      !: Max number of tidal contituents
+   INTEGER, PUBLIC            ::   ntide                 !: Actual number of tidal constituents
 
    CHARACTER(len=80), PUBLIC                         ::   filtide    !: Filename root for tidal input files
    CHARACTER(len= 4), PUBLIC, DIMENSION(jptides_max) ::   tide_cpt   !: Names of tidal components used.
 
-   INTEGER , DIMENSION(jptides_max) ::   nindx        !: ???
-   REAL(wp), DIMENSION(jptides_max) ::   tide_speed   !: Phase speed of tidal constituent (deg/hr)
+   INTEGER , PUBLIC, DIMENSION(jptides_max) ::   nindx        !: ???
+   REAL(wp), PUBLIC, DIMENSION(jptides_max) ::   tide_speed   !: Phase speed of tidal constituent (deg/hr)
    
-   REAL(wp), DIMENSION(jpbdim,jptides_max)  ::   ssh1, ssh2   !: Tidal constituents : SSH
-   REAL(wp), DIMENSION(jpbdim,jptides_max)  ::   u1  , u2     !: Tidal constituents : U
-   REAL(wp), DIMENSION(jpbdim,jptides_max)  ::   v1  , v2     !: Tidal constituents : V
+   REAL(wp), DIMENSION(jpbdim,jptides_max)  ::   ssh1, ssh2   ! Tidal constituents : SSH
+   REAL(wp), DIMENSION(jpbdim,jptides_max)  ::   u1  , u2     ! Tidal constituents : U
+   REAL(wp), DIMENSION(jpbdim,jptides_max)  ::   v1  , v2     ! Tidal constituents : V
    
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -87,9 +87,11 @@
       !                                               ! Count number of components specified
       ntide = jptides_max
-      itide = 1
-      DO WHILE( tide_cpt(itide) /= '' )
-         ntide = itide
-         itide = itide + 1
+      DO itide = 1, jptides_max
+        IF( tide_cpt(itide) == '' ) THEN
+           ntide = itide-1
+           exit
+        ENDIF
       END DO
+
       !                                               ! find constituents in standard list
       DO itide = 1, ntide
@@ -145,5 +147,5 @@
       CHARACTER(len=80) :: clfile         ! full file name for tidal input file 
       INTEGER ::   ipi, ipj, inum, idvar  ! temporary integers (netcdf read)
-      INTEGER, DIMENSION(3) :: lendta=0   ! length of data in the file (note may be different from nblendta!)
+      INTEGER, DIMENSION(6) :: lendta=0   ! length of data in the file (note may be different from nblendta!)
       REAL(wp) ::  z_arg, z_atde, z_btde, z1t, z2t           
       REAL(wp), DIMENSION(jpbdta,1) ::   zdta   ! temporary array for data fields
@@ -161,5 +163,5 @@
          IF(lwp) WRITE(numout,*) 'Reading data from file ', clfile
          CALL iom_open( clfile, inum )
-         igrd = 1
+         igrd = 4
          IF( nblendta(igrd) <= 0 ) THEN 
             idvar = iom_varid( inum,'z1' )
@@ -183,5 +185,5 @@
          IF(lwp) WRITE(numout,*) 'Reading data from file ', clfile
          CALL iom_open( clfile, inum )
-         igrd = 2
+         igrd = 5
          IF( lendta(igrd) <= 0 ) THEN 
             idvar = iom_varid( inum,'u1' )
@@ -204,5 +206,5 @@
          if(lwp) write(numout,*) 'Reading data from file ', clfile
          CALL iom_open( clfile, inum )
-         igrd = 3
+         igrd = 6
          IF( lendta(igrd) <= 0 ) THEN 
             idvar = iom_varid( inum,'v1' )
@@ -252,5 +254,5 @@
             ENDIF
             !                                         !  elevation         
-            igrd = 1
+            igrd = 4
             DO ib = 1, nblenrim(igrd)                
                z1t = z_atde * ssh1(ib,itide) + z_btde * ssh2(ib,itide)
@@ -260,5 +262,5 @@
             END DO
             !                                         !  u       
-            igrd = 2
+            igrd = 5
             DO ib = 1, nblenrim(igrd)                
                z1t = z_atde * u1(ib,itide) + z_btde * u2(ib,itide)
@@ -268,5 +270,5 @@
             END DO
             !                                         !  v       
-            igrd = 3
+            igrd = 6
             DO ib = 1, nblenrim(igrd)                
                z1t = z_atde * v1(ib,itide) + z_btde * v2(ib,itide)
@@ -320,15 +322,15 @@
       !
       DO itide = 1, ntide
-         igrd=1                              ! SSH on tracer grid.
+         igrd=4                              ! SSH on tracer grid.
          DO ib = 1, nblenrim(igrd)
             sshtide(ib) =sshtide(ib)+ ssh1(ib,itide)*z_cost(itide) + ssh2(ib,itide)*z_sist(itide)
             !    if(lwp) write(numout,*) 'z',ib,itide,sshtide(ib), ssh1(ib,itide),ssh2(ib,itide)
          END DO
-         igrd=2                              ! U grid
+         igrd=5                              ! U grid
          DO ib=1, nblenrim(igrd)
             utide(ib) = utide(ib)+ u1(ib,itide)*z_cost(itide) + u2(ib,itide)*z_sist(itide)
             !    if(lwp) write(numout,*) 'u',ib,itide,utide(ib), u1(ib,itide),u2(ib,itide)
          END DO
-         igrd=3                              ! V grid
+         igrd=6                              ! V grid
          DO ib=1, nblenrim(igrd)
             vtide(ib) = vtide(ib)+ v1(ib,itide)*z_cost(itide) + v2(ib,itide)*z_sist(itide)
Index: trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90	(revision 2528)
@@ -11,5 +11,5 @@
    !!   'key_bdy'                     Unstructured Open Boundary Conditions
    !!----------------------------------------------------------------------
-   !!   bdy_tra        : Relaxation of tracers on unstructured open boundaries
+   !!   bdy_tra_frs        : Relaxation of tracers on unstructured open boundaries
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and tracers variables
@@ -22,17 +22,16 @@
    PRIVATE
 
-   PUBLIC bdy_tra     ! routine called in tranxt.F90 
+   PUBLIC bdy_tra_frs     ! routine called in tranxt.F90 
 
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
-   SUBROUTINE bdy_tra( kt )
+   SUBROUTINE bdy_tra_frs( kt )
       !!----------------------------------------------------------------------
-      !!                 ***  SUBROUTINE bdy_tra  ***
+      !!                 ***  SUBROUTINE bdy_tra_frs  ***
       !!                    
       !! ** Purpose : Apply the Flow Relaxation Scheme for tracers in the  
@@ -48,29 +47,28 @@
       !!----------------------------------------------------------------------
       !
-      IF(ln_bdy_tra_frs) THEN ! If this is false, then this routine does nothing. 
-
-      IF( kt == nit000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'bdy_tra : Flow Relaxation Scheme for tracers'
-         IF(lwp) WRITE(numout,*) '~~~~~~~'
-      ENDIF
+      IF(ln_tra_frs) THEN       ! If this is false, then this routine does nothing. 
+         !
+         IF( kt == nit000 ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'bdy_tra_frs : Flow Relaxation Scheme for tracers'
+            IF(lwp) WRITE(numout,*) '~~~~~~~'
+         ENDIF
+         !
+         igrd = 1                       ! Everything is at T-points here
+         DO ib = 1, nblen(igrd)
+            DO ik = 1, jpkm1
+               ii = nbi(ib,igrd)
+               ij = nbj(ib,igrd)
+               zwgt = nbw(ib,igrd)
+               ta(ii,ij,ik) = ( ta(ii,ij,ik) * (1.-zwgt) + tbdy(ib,ik) * zwgt ) * tmask(ii,ij,ik)         
+               sa(ii,ij,ik) = ( sa(ii,ij,ik) * (1.-zwgt) + sbdy(ib,ik) * zwgt ) * tmask(ii,ij,ik)
+            END DO
+         END DO 
+         !
+         CALL lbc_lnk( ta, 'T', 1. )   ; CALL lbc_lnk( sa, 'T', 1. )    ! Boundary points should be updated
+         !
+      ENDIF ! ln_tra_frs
       !
-      igrd = 1                       ! Everything is at T-points here
-      DO ib = 1, nblen(igrd)
-         DO ik = 1, jpkm1
-            ii = nbi(ib,igrd)
-            ij = nbj(ib,igrd)
-            zwgt = nbw(ib,igrd)
-            ta(ii,ij,ik) = ( ta(ii,ij,ik) * (1.-zwgt) + tbdy(ib,ik) * zwgt ) * tmask(ii,ij,ik)         
-            sa(ii,ij,ik) = ( sa(ii,ij,ik) * (1.-zwgt) + sbdy(ib,ik) * zwgt ) * tmask(ii,ij,ik)
-        END DO
-      END DO 
-      !
-      CALL lbc_lnk( ta, 'T', 1. )   ! Boundary points should be updated
-      CALL lbc_lnk( sa, 'T', 1. )   !
-      !
-      ENDIF ! ln_bdy_tra_frs
-
-   END SUBROUTINE bdy_tra
+   END SUBROUTINE bdy_tra_frs
    
 #else
@@ -79,7 +77,7 @@
    !!----------------------------------------------------------------------
 CONTAINS
-   SUBROUTINE bdy_tra(kt)      ! Empty routine
-      WRITE(*,*) 'bdy_tra: You should not have seen this print! error?', kt
-   END SUBROUTINE bdy_tra
+   SUBROUTINE bdy_tra_frs(kt)      ! Empty routine
+      WRITE(*,*) 'bdy_tra_frs: You should not have seen this print! error?', kt
+   END SUBROUTINE bdy_tra_frs
 #endif
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90	(revision 2528)
@@ -11,5 +11,5 @@
 #if   defined key_bdy   &&   defined key_dynspg_flt
    !!----------------------------------------------------------------------
-   !!   'key_bdy'            and      unstructured open boundary conditions
+   !!   'key_bdy'            AND      unstructured open boundary conditions
    !!   'key_dynspg_flt'                              filtered free surface
    !!----------------------------------------------------------------------
@@ -30,9 +30,8 @@
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -62,10 +61,10 @@
       !!            zero (z_cflxemp=0) to calculate the correction velocity. So
       !!            it will only balance the flux through open boundaries.
-      !!            (set volbdy to 0 in tne namelist for this option)
+      !!            (set nn_volctl to 0 in tne namelist for this option)
       !!         2/ The volume is constant even with E-P flux. In this case
       !!            the correction velocity must balance both the flux 
       !!            through open boundaries and the ones through the free
       !!            surface. 
-      !!            (set volbdy to 1 in tne namelist for this option)
+      !!            (set nn_volctl to 1 in tne namelist for this option)
       !!----------------------------------------------------------------------
       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
@@ -73,6 +72,8 @@
       INTEGER  ::   ji, jj, jk, jb, jgrd
       INTEGER  ::   ii, ij
-      REAL(wp) ::   zubtpecor, z_cflxemp, ztranst, zraur
+      REAL(wp) ::   zubtpecor, z_cflxemp, ztranst
       !!-----------------------------------------------------------------------------
+
+      IF( ln_vol ) THEN
 
       IF( kt == nit000 ) THEN 
@@ -84,11 +85,9 @@
       ! Calculate the cumulate surface Flux z_cflxemp (m3/s) over all the domain
       ! -----------------------------------------------------------------------
-      z_cflxemp = 0.e0
-      zraur = 1.e0 / rau0
-      z_cflxemp = SUM ( emp(:,:) * bdytmask(:,:) * e1t(:,:) * e2t(:,:) * zraur )
-      IF( lk_mpp )   CALL mpp_sum( z_cflxemp )   ! sum over the global domain
+      z_cflxemp = SUM ( ( emp(:,:)-rnf(:,:) ) * bdytmask(:,:) * e1t(:,:) * e2t(:,:) ) / rau0
+      IF( lk_mpp )   CALL mpp_sum( z_cflxemp )     ! sum over the global domain
 
-      ! Barotropic velocity through the unstructured open boundary
-      ! ----------------------------------------------------------
+      ! Transport through the unstructured open boundary
+      ! ------------------------------------------------
       zubtpecor = 0.e0
       jgrd = 2                               ! cumulate u component contribution first 
@@ -112,6 +111,6 @@
       ! The normal velocity correction
       ! ------------------------------
-      IF (volbdy==1) THEN   ;   zubtpecor = ( zubtpecor - z_cflxemp) / bdysurftot 
-      ELSE                  ;   zubtpecor =   zubtpecor             / bdysurftot
+      IF( nn_volctl==1 ) THEN   ;   zubtpecor = ( zubtpecor - z_cflxemp) / bdysurftot 
+      ELSE                   ;   zubtpecor =   zubtpecor             / bdysurftot
       END IF
 
@@ -141,5 +140,4 @@
       ! Check the cumulated transport through unstructured OBC once barotropic velocities corrected
       ! ------------------------------------------------------
-
       IF( lwp .AND. MOD( kt, nwrite ) == 0) THEN
          IF(lwp) WRITE(numout,*)
@@ -152,4 +150,6 @@
       END IF 
       !
+      END IF ! ln_vol
+
    END SUBROUTINE bdy_vol
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/C1D/c1d.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/C1D/c1d.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/C1D/c1d.F90	(revision 2528)
@@ -0,0 +1,24 @@
+MODULE c1d
+   !!======================================================================
+   !!                     ***  MODULE  c1d  ***
+   !! Ocean domain  :  1D configuration
+   !!=====================================================================
+   !! History :   2.0  !  2004-09  (C. Ethe)  Original code
+   !!             3.0  !  2008-04 (G. Madec)  adaptation to SBC
+   !!----------------------------------------------------------------------
+
+   IMPLICIT NONE
+   PRIVATE
+
+#if defined key_c1d
+   LOGICAL, PUBLIC, PARAMETER ::   lk_c1d = .TRUE.    !: 1D config. flag activated
+#else
+   LOGICAL, PUBLIC, PARAMETER ::   lk_c1d = .FALSE.   !: 1D config. flag de-activated
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/C1D 3.3 , NEMO Consortium (2010)
+   !! $Id: c1d.F90 2382 2010-11-13 13:08:12Z gm $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE c1d
Index: trunk/NEMOGCM/NEMO/OPA_SRC/C1D/dyncor_c1d.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/C1D/dyncor_c1d.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/C1D/dyncor_c1d.F90	(revision 2528)
@@ -0,0 +1,125 @@
+MODULE dyncor_c1d
+   !!======================================================================
+   !!                     ***  MODULE  dyncor_c1d  ***
+   !! Ocean Dynamics :   Coriolis term in 1D configuration
+   !!=====================================================================
+   !! History :  2.0  !  2004-09  (C. Ethe)  Original code
+   !!            3.0  !  2008-04  (G. Madec)  style only
+   !!----------------------------------------------------------------------
+#if defined key_c1d
+   !!----------------------------------------------------------------------
+   !!   'key_c1d'                                          1D Configuration
+   !!----------------------------------------------------------------------
+   !!   cor_c1d      : Coriolis factor at T-point (1D configuration)
+   !!   dyn_cor_c1d  : vorticity trend due to Coriolis at T-point
+   !!----------------------------------------------------------------------
+   USE oce               ! ocean dynamics and tracers
+   USE dom_oce           ! ocean space and time domain
+   USE phycst            ! physical constants
+   USE in_out_manager    ! I/O manager
+   USE prtctl            ! Print control
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   cor_c1d      ! routine called by OPA.F90
+   PUBLIC   dyn_cor_c1d  ! routine called by step1d.F90
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/C1D 3.3 , NEMO Consortium (2010)
+   !! $Id: dyncor_c1d.F90 2382 2010-11-13 13:08:12Z gm $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE cor_c1d
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE cor_c1d  ***
+      !! 
+      !! ** Purpose : set the Coriolis factor at T-point
+      !!----------------------------------------------------------------------
+      REAL(wp) ::   zphi0, zbeta, zf0         !  temporary scalars
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'cor_c1d : Coriolis factor at T-point'
+      IF(lwp) WRITE(numout,*) '~~~~~~~'
+
+      SELECT CASE( jphgr_msh )   ! type of horizontal mesh
+      !
+      CASE ( 0, 1, 4 )               ! mesh on the sphere
+         ff(:,:) = 2. * omega * SIN( rad * gphit(:,:) ) 
+         !
+      CASE ( 2 )                     ! f-plane at ppgphi0 
+         ff(:,:) = 2. * omega * SIN( rad * ppgphi0 )
+         IF(lwp) WRITE(numout,*) '          f-plane: Coriolis parameter = constant = ', ff(1,1)
+         !
+      CASE ( 3 )                     ! beta-plane
+         zbeta   = 2. * omega * COS( rad * ppgphi0 ) / ra                     ! beta at latitude ppgphi0
+         zphi0   = ppgphi0 - FLOAT( jpjglo/2) * ppe2_m *1.e-3  / ( ra * rad ) ! latitude of the first row F-points
+         zf0     = 2. * omega * SIN( rad * zphi0 )                            ! compute f0 1st point south
+         ff(:,:) = ( zf0  + zbeta * gphit(:,:) * 1.e+3 )                      ! f = f0 +beta* y ( y=0 at south)
+         IF(lwp) WRITE(numout,*) '          Beta-plane: Beta parameter = constant = ', ff(1,1)
+         IF(lwp) WRITE(numout,*) '                      Coriolis parameter varies from ', ff(1,1),' to ', ff(1,jpj)
+         !
+      CASE ( 5 )                     ! beta-plane and rotated domain
+         zbeta = 2. * omega * COS( rad * ppgphi0 ) / ra                     ! beta at latitude ppgphi0
+         zphi0 = 15.e0                                                      ! latitude of the first row F-points
+         zf0   = 2. * omega * SIN( rad * zphi0 )                            ! compute f0 1st point south
+         ff(:,:) = ( zf0 + zbeta * ABS( gphit(:,:) - zphi0 ) * rad * ra )   ! f = f0 +beta* y ( y=0 at south)
+         IF(lwp) WRITE(numout,*) '          Beta-plane: Beta parameter = constant = ', ff(1,1)
+         IF(lwp) WRITE(numout,*) '                      Coriolis parameter varies from ', ff(1,1),' to ', ff(1,jpj)
+         !
+      END SELECT
+      !
+   END SUBROUTINE cor_c1d
+
+
+   SUBROUTINE dyn_cor_c1d( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE dyn_cor_c1d  ***
+      !! 
+      !! ** Purpose :   Compute the now Coriolis trend and add it to 
+      !!               the general trend of the momentum equation in 1D case.
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      !!
+      INTEGER ::   ji, jj, jk         ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_cor_c1d : total vorticity trend in 1D'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+      ENDIF
+      !
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ua(ji,jj,jk) = ua(ji,jj,jk) + ff(ji,jj) * vn(ji,jj,jk)
+               va(ji,jj,jk) = va(ji,jj,jk) - ff(ji,jj) * un(ji,jj,jk)
+            END DO
+         END DO
+      END DO   
+      !
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' cor  - Ua: ', mask1=umask,  &
+         &                       tab3d_2=va, clinfo2=' Va: '       , mask2=vmask )
+      !
+   END SUBROUTINE dyn_cor_c1d
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default key                                     NO 1D Configuration
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE cor_c1d              ! Empty routine
+   END SUBROUTINE cor_c1d   
+   SUBROUTINE dyn_cor_c1d ( kt )      ! Empty routine
+      WRITE(*,*) 'dyn_cor_c1d: You should not have seen this print! error?', kt
+   END SUBROUTINE dyn_cor_c1d
+#endif
+
+   !!=====================================================================
+END MODULE dyncor_c1d
Index: trunk/NEMOGCM/NEMO/OPA_SRC/C1D/dynnxt_c1d.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/C1D/dynnxt_c1d.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/C1D/dynnxt_c1d.F90	(revision 2528)
@@ -0,0 +1,103 @@
+MODULE dynnxt_c1d
+   !!======================================================================
+   !!                       ***  MODULE  dynnxt_c1d  ***
+   !! Ocean dynamics: time stepping in 1D configuration
+   !!======================================================================
+   !! History :  2.0  !  2004-10  (C. Ethe)  Original code from dynnxt.F90
+   !!            3.0  !  2008-04  (G.madec)  Style only
+   !!----------------------------------------------------------------------
+#if defined key_c1d
+   !!----------------------------------------------------------------------
+   !!   'key_c1d'                                          1D Configuration
+   !!----------------------------------------------------------------------  
+   !!   dyn_nxt_c1d : update the horizontal velocity from the momentum trend
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! lateral boundary condition (or mpp link)
+   USE prtctl          ! Print control
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC dyn_nxt_c1d                ! routine called by step.F90
+   !!----------------------------------------------------------------------
+   !! NEMO/C1D 3.3 , NEMO Consortium (2010)
+   !! $Id: dynnxt_c1d.F90 2382 2010-11-13 13:08:12Z gm $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dyn_nxt_c1d ( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_nxt_c1d  ***
+      !!                   
+      !! ** Purpose :   Compute the after horizontal velocity from the momentum trend.
+      !!
+      !! ** Method  :   Apply lateral boundary conditions on the trends (ua,va) 
+      !!      through calls to routine lbc_lnk.
+      !!      After velocity is compute using a leap-frog scheme environment:
+      !!         (ua,va) = (ub,vb) + 2 rdt (ua,va)
+      !!      Time filter applied on now horizontal velocity to avoid the
+      !!      divergence of two consecutive time-steps and swap of dynamics
+      !!      arrays to start the next time step:
+      !!         (ub,vb) = (un,vn) + atfp [ (ub,vb) + (ua,va) - 2 (un,vn) ]
+      !!         (un,vn) = (ua,va) 
+      !!
+      !! ** Action : - Update ub,vb arrays, the before horizontal velocity
+      !!             - Update un,vn arrays, the now horizontal velocity
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+      !!
+      INTEGER  ::   jk           ! dummy loop indices
+      REAL(wp) ::   z2dt         ! temporary scalar
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_nxt_c1d : time stepping on 1D configuation'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+
+      z2dt = 2._wp * rdt                                                   ! Local constant initialization
+      IF( neuler == 0 .AND. kt == nit000 )  z2dt = rdt
+
+      CALL lbc_lnk( ua, 'U', -1. )   ;   CALL lbc_lnk( va, 'V', -1. )      ! Lateral boundary conditions
+
+      DO jk = 1, jpkm1                                                     ! Next Velocity
+         ua(:,:,jk) = ( ub(:,:,jk) + z2dt * ua(:,:,jk) ) * umask(:,:,jk)
+         va(:,:,jk) = ( vb(:,:,jk) + z2dt * va(:,:,jk) ) * vmask(:,:,jk)
+      END DO 
+ 
+      DO jk = 1, jpkm1                                                     ! Time filter and swap of dynamics arrays
+         IF( neuler == 0 .AND. kt == nit000 ) THEN                               ! Euler (forward) time stepping
+             ub(:,:,jk) = un(:,:,jk)
+             vb(:,:,jk) = vn(:,:,jk)
+             un(:,:,jk) = ua(:,:,jk)
+             vn(:,:,jk) = va(:,:,jk)
+         ELSE                                                                    ! Leap-frog time stepping
+             ub(:,:,jk) = atfp * ( ub(:,:,jk) + ua(:,:,jk) ) + atfp1 * un(:,:,jk)
+             vb(:,:,jk) = atfp * ( vb(:,:,jk) + va(:,:,jk) ) + atfp1 * vn(:,:,jk)
+             un(:,:,jk) = ua(:,:,jk)
+             vn(:,:,jk) = va(:,:,jk)
+         ENDIF
+      END DO
+
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=un, clinfo1=' nxt_c1d  - Un: ', mask1=umask,   &
+         &                       tab3d_2=vn, clinfo2=' Vn: '           , mask2=vmask )
+      !
+   END SUBROUTINE dyn_nxt_c1d
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default key                                     NO 1D Config
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE dyn_nxt_c1d ( kt )
+      WRITE(*,*) 'dyn_nxt_c1d: You should not have seen this print! error?', kt
+   END SUBROUTINE dyn_nxt_c1d
+#endif
+
+   !!======================================================================
+END MODULE dynnxt_c1d
Index: trunk/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90	(revision 2528)
@@ -0,0 +1,161 @@
+MODULE step_c1d
+   !!======================================================================
+   !!                       ***  MODULE step_c1d  ***
+   !! Time-stepping    : manager of the ocean, tracer and ice time stepping - c1d case
+   !!======================================================================
+   !! History :   2.0  !  2004-04  (C. Ethe)  adapted from step.F90 for C1D
+   !!             3.0  !  2008-04  (G. Madec)  redo the adaptation to include SBC
+   !!----------------------------------------------------------------------
+#if defined key_c1d
+   !!----------------------------------------------------------------------
+   !!   'key_c1d'                                       1D Configuration
+   !!----------------------------------------------------------------------  
+   !!   stp_c1d        : NEMO system time-stepping in c1d case
+   !!----------------------------------------------------------------------
+   USE step_oce         ! time stepping definition modules 
+#if defined key_top
+   USE trcstp           ! passive tracer time-stepping      (trc_stp routine)
+#endif
+   USE dyncor_c1d      ! Coriolis term (c1d case)         (dyn_cor_1d     )
+   USE dynnxt_c1d      ! time-stepping                    (dyn_nxt routine)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC stp_c1d      ! called by opa.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "zdfddm_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/C1D 3.3 , NEMO Consortium (2010)
+   !! $Id: step_c1d.F90 2382 2010-11-13 13:08:12Z gm $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE stp_c1d( kstp )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE stp_c1d  ***
+      !!                      
+      !! ** Purpose :  - Time stepping of SBC including LIM (dynamic and thermodynamic eqs.)
+      !!               - Time stepping of OPA (momentum and active tracer eqs.)
+      !!               - Time stepping of TOP (passive tracer eqs.)
+      !! 
+      !! ** Method  : -1- Update forcings and data  
+      !!              -2- Update vertical ocean physics 
+      !!              -3- Compute the t and s trends 
+      !!              -4- Update t and s 
+      !!              -5- Compute the momentum trends
+      !!              -6- Update the horizontal velocity
+      !!              -7- Compute the diagnostics variables (rd,N2, div,cur,w)
+      !!              -8- Outputs and diagnostics
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kstp   ! ocean time-step index
+      INTEGER ::   jk       ! dummy loop indice
+      INTEGER ::   indic    ! error indicator if < 0
+      !! ---------------------------------------------------------------------
+
+                             indic = 0                ! reset to no error condition
+      IF( kstp /= nit000 )   CALL day( kstp )         ! Calendar (day was already called at nit000 in day_init)
+                             CALL iom_setkt( kstp )   ! say to iom that we are at time step kstp
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Update data, open boundaries, surface boundary condition (including sea-ice)
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      IF( lk_dtatem  )   CALL dta_tem( kstp )         ! update 3D temperature data
+      IF( lk_dtasal  )   CALL dta_sal( kstp )         ! update 3D salinity data
+                         CALL sbc    ( kstp )         ! Sea Boundary Condition (including sea-ice)
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Ocean physics update                (ua, va, ta, sa used as workspace)
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                         CALL bn2( tsb, rn2b )        ! before Brunt-Vaisala frequency
+                         CALL bn2( tsn, rn2  )        ! now    Brunt-Vaisala frequency
+      !  VERTICAL PHYSICS   
+                         CALL zdf_bfr( kstp )         ! bottom friction
+      !                                               ! Vertical eddy viscosity and diffusivity coefficients
+      IF( lk_zdfric  )   CALL zdf_ric( kstp )            ! Richardson number dependent Kz
+      IF( lk_zdftke  )   CALL zdf_tke( kstp )            ! TKE closure scheme for Kz
+      IF( lk_zdfgls  )   CALL zdf_gls( kstp )            ! GLS closure scheme for Kz
+      IF( lk_zdfkpp  )   CALL zdf_kpp( kstp )            ! KPP closure scheme for Kz
+      IF( lk_zdfcst  )   THEN                            ! Constant Kz (reset avt, avm[uv] to the background value)
+         avt (:,:,:) = rn_avt0 * tmask(:,:,:)
+         avmu(:,:,:) = rn_avm0 * umask(:,:,:)
+         avmv(:,:,:) = rn_avm0 * vmask(:,:,:)
+      ENDIF
+
+      IF( ln_rnf_mouth ) THEN                         ! increase diffusivity at rivers mouths
+         DO jk = 2, nkrnf   ;   avt(:,:,jk) = avt(:,:,jk) + 2.e0 * rn_avt_rnf * rnfmsk(:,:)   ;   END DO
+      ENDIF
+      IF( ln_zdfevd  )   CALL zdf_evd( kstp )         ! enhanced vertical eddy diffusivity
+
+      IF( lk_zdftmx  )   CALL zdf_tmx( kstp )         ! tidal vertical mixing
+
+      IF( lk_zdfddm .AND. .NOT. lk_zdfkpp )   &
+         &               CALL zdf_ddm( kstp )         ! double diffusive mixing
+         
+                         CALL zdf_mxl( kstp )         ! mixed layer depth
+
+                                                      ! write tke information in the restart file
+      IF( lrst_oce .AND. lk_zdftke )   CALL tke_rst( kstp, 'WRITE' )
+                                                      ! write gls information in the restart file
+      IF( lrst_oce .AND. lk_zdfgls )   CALL gls_rst( kstp, 'WRITE' )
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! diagnostics and outputs             (ua, va, ta, sa used as workspace)
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                         CALL dia_wri( kstp )       ! ocean model: outputs
+
+#if defined key_top
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Passive Tracer Model
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                         CALL trc_stp( kstp )            ! time-stepping
+#endif
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Active tracers                              (ua, va used as workspace)
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                             tsa(:,:,:,:) = 0.e0                ! set tracer trends to zero
+
+                             CALL tra_sbc    ( kstp )        ! surface boundary condition
+      IF( ln_traqsr      )   CALL tra_qsr    ( kstp )        ! penetrative solar radiation qsr
+      IF( lk_zdfkpp      )   CALL tra_kpp    ( kstp )        ! KPP non-local tracer fluxes
+                             CALL tra_zdf    ( kstp )        ! vertical mixing
+                             CALL tra_nxt    ( kstp )        ! tracer fields at next time step
+      IF( ln_zdfnpc      )   CALL tra_npc    ( kstp )        ! applied non penetrative convective adjustment on (t,s)
+                             CALL eos( tsb, rhd, rhop )      ! now (swap=before) in situ density for dynhpg module
+                             CALL tra_unswap                 ! udate T & S 3D arrays  (to be suppressed)
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Dynamics                                    (ta, sa used as workspace)
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                               ua(:,:,:) = 0.e0               ! set dynamics trends to zero
+                               va(:,:,:) = 0.e0
+
+                               CALL dyn_cor_c1d( kstp )       ! vorticity term including Coriolis
+                               CALL dyn_zdf    ( kstp )       ! vertical diffusion
+                               CALL dyn_nxt_c1d( kstp )       ! lateral velocity at next time step
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Control and restarts
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                                 CALL stp_ctl( kstp, indic )
+      IF( kstp == nit000     )   CALL iom_close( numror )             ! close input  ocean restart file
+      IF( lrst_oce           )   CALL rst_write  ( kstp )             ! write output ocean restart file
+      !
+   END SUBROUTINE stp_c1d
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default key                                            NO 1D Config
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE stp_c1d ( kt )      ! dummy routine
+      WRITE(*,*) 'stp_c1d: You should not have seen this print! error?', kt
+   END SUBROUTINE stp_c1d
+#endif
+
+   !!======================================================================
+END MODULE step_c1d
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90	(revision 2528)
@@ -4,5 +4,6 @@
    !! AR5 diagnostics
    !!======================================================================
-   !! History : 3.2  !  2009-11  (S. Masson)  Original code
+   !! History :  3.2  !  2009-11  (S. Masson)  Original code
+   !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA
    !!----------------------------------------------------------------------
 #if defined key_diaar5
@@ -10,11 +11,10 @@
    !!   'key_diaar5'  :                           activate ar5 diagnotics
    !!----------------------------------------------------------------------
-   !!   exa_mpl       : liste of module subroutine (caution, never use the
-   !!   exa_mpl_init  : name of the module for a routine)
-   !!   exa_mpl_stp   : Please try to use 3 letter block for routine names
+   !!   dia_ar5       : AR5 diagnostics
+   !!   dia_ar5_init  : initialisation of AR5 diagnostics
    !!----------------------------------------------------------------------
    USE oce            ! ocean dynamics and active tracers 
    USE dom_oce        ! ocean space and time domain
-   USE eosbn2          ! equation of state                (eos_bn2 routine)
+   USE eosbn2         ! equation of state                (eos_bn2 routine)
    USE lib_mpp        ! distribued memory computing library
    USE iom            ! I/O manager library
@@ -23,22 +23,22 @@
    PRIVATE
 
-   PUBLIC   dia_ar5   ! routine called in step.F90 module
+   PUBLIC   dia_ar5        ! routine called in step.F90 module
+   PUBLIC   dia_ar5_init   ! routine called in opa.F90 module
 
    LOGICAL, PUBLIC, PARAMETER :: lk_diaar5 = .TRUE.   ! coupled flag
 
-   REAL(wp)                         ::   vol0               ! ocean volume (interior domain)
-   REAL(wp)                         ::   area_tot           ! total ocean surface (interior domain)
-   REAL(wp), DIMENSION(jpi,jpj    ) ::   area               ! cell surface (interior domain)
-   REAL(wp), DIMENSION(jpi,jpj    ) ::   thick0             ! ocean thickness (interior domain)
-   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   sn0                ! initial salinity
+   REAL(wp)                         ::   vol0         ! ocean volume (interior domain)
+   REAL(wp)                         ::   area_tot     ! total ocean surface (interior domain)
+   REAL(wp), DIMENSION(jpi,jpj    ) ::   area         ! cell surface (interior domain)
+   REAL(wp), DIMENSION(jpi,jpj    ) ::   thick0       ! ocean thickness (interior domain)
+   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   sn0          ! initial salinity
       
    !! * Substitutions
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
@@ -47,16 +47,6 @@
       !!                    ***  ROUTINE dia_ar5  ***
       !!
-      !! ** Purpose :   Brief description of the routine
+      !! ** Purpose :   compute and output some AR5 diagnostics
       !!
-      !! ** Method  :   description of the methodoloy used to achieve the
-      !!                objectives of the routine. Be as clear as possible!
-      !!
-      !! ** Action  : - first action (share memory array/varible modified
-      !!                in this routine
-      !!              - second action .....
-      !!              - .....
-      !!
-      !! References :   Author et al., Short_name_review, Year
-      !!                Give references if exist otherwise suppress these lines
       !!----------------------------------------------------------------------
       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
@@ -66,7 +56,6 @@
       REAL(wp), DIMENSION(jpi,jpj    ) ::   zarea_ssh, zbotpres
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zrhd, zrhop
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) ::   ztsn
       !!--------------------------------------------------------------------
-
-      IF( kt == nit000  )   CALL dia_ar5_init   ! Initialization (first time-step only)
 
       CALL iom_put( 'cellthc', fse3t(:,:,:) )
@@ -83,11 +72,13 @@
 
       !                                         ! thermosteric ssh
-      CALL eos( tn, sn0, zrhd )                       ! now in situ density using initial salinity
-      !
-      zbotpres(:,:) = 0.e0                            ! no atmospheric surface pressure, levitating sea-ice
+      ztsn(:,:,:,jp_tem) = tn (:,:,:)
+      ztsn(:,:,:,jp_sal) = sn0(:,:,:)
+      CALL eos( ztsn, zrhd )                       ! now in situ density using initial salinity
+      !
+      zbotpres(:,:) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice
       DO jk = 1, jpkm1
          zbotpres(:,:) = zbotpres(:,:) + fse3t(:,:,jk) * zrhd(:,:,jk)
       END DO
-      IF( .NOT. lk_vvl )   zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1)
+      IF( .NOT.lk_vvl )   zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1)
       !                                         
       zarho = SUM( area(:,:) * zbotpres(:,:) ) 
@@ -97,13 +88,13 @@
       
       !                                         ! steric sea surface height
-      CALL eos( tn, sn, zrhd, zrhop )                 ! now in situ and potential density
-      zrhop(:,:,jpk) = 0.e0
+      CALL eos( tsn, zrhd, zrhop )                 ! now in situ and potential density
+      zrhop(:,:,jpk) = 0._wp
       CALL iom_put( 'rhop', zrhop )
       !
-      zbotpres(:,:) = 0.e0                            ! no atmospheric surface pressure, levitating sea-ice
+      zbotpres(:,:) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice
       DO jk = 1, jpkm1
          zbotpres(:,:) = zbotpres(:,:) + fse3t(:,:,jk) * zrhd(:,:,jk)
       END DO
-      IF( .NOT. lk_vvl )   zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1)
+      IF( .NOT.lk_vvl )   zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1)
       !    
       zarho = SUM( area(:,:) * zbotpres(:,:) ) 
@@ -113,23 +104,23 @@
       
       !                                         ! ocean bottom pressure
-      zztmp = rau0 * grav * 1.e-4                     ! recover pressure from pressure anomaly and cover to dbar = 1.e4 Pa
+      zztmp = rau0 * grav * 1.e-4_wp               ! recover pressure from pressure anomaly and cover to dbar = 1.e4 Pa
       zbotpres(:,:) = zztmp * ( zbotpres(:,:) + sshn(:,:) + thick0(:,:) )
       CALL iom_put( 'botpres', zbotpres )
 
       !                                         ! Mean density anomalie, temperature and salinity
-      ztemp = 0.e0
-      zsal  = 0.e0
+      ztemp = 0._wp
+      zsal  = 0._wp
       DO jk = 1, jpkm1
          DO jj = 1, jpj
             DO ji = 1, jpi
                zztmp = area(ji,jj) * fse3t(ji,jj,jk)
-               ztemp = ztemp + zztmp * tn  (ji,jj,jk)
-               zsal  = zsal  + zztmp * sn  (ji,jj,jk)
+               ztemp = ztemp + zztmp * tn(ji,jj,jk)
+               zsal  = zsal  + zztmp * sn(ji,jj,jk)
             END DO
          END DO
       END DO
-      IF( .NOT. lk_vvl ) THEN
-         ztemp = ztemp + SUM( zarea_ssh(:,:) * tn  (:,:,1) )
-         zsal  = zsal  + SUM( zarea_ssh(:,:) * sn  (:,:,1) )
+      IF( .NOT.lk_vvl ) THEN
+         ztemp = ztemp + SUM( zarea_ssh(:,:) * tn(:,:,1) )
+         zsal  = zsal  + SUM( zarea_ssh(:,:) * sn(:,:,1) )
       ENDIF
       IF( lk_mpp ) THEN  
@@ -153,11 +144,5 @@
       !!                  ***  ROUTINE dia_ar5_init  ***
       !!                   
-      !! ** Purpose :   initialization of ....
-      !!
-      !! ** Method  :   blah blah blah ...
-      !!
-      !! ** input   :   Namlist namexa
-      !!
-      !! ** Action  :   ...  
+      !! ** Purpose :   initialization for AR5 diagnostic computation
       !!----------------------------------------------------------------------
       INTEGER  ::   inum
@@ -172,6 +157,6 @@
       area_tot = SUM( area(:,:) )   ;   IF( lk_mpp )   CALL mpp_sum( area_tot )
 
-      vol0        = 0.e0
-      thick0(:,:) = 0.e0
+      vol0        = 0._wp
+      thick0(:,:) = 0._wp
       DO jk = 1, jpkm1
          vol0        = vol0        + SUM( area (:,:) * tmask(:,:,jk) * fse3t_0(:,:,jk) )
@@ -184,13 +169,13 @@
       CALL iom_get  ( inum, jpdom_data, 'vosaline', zsaldta(:,:,:,2), 12 )
       CALL iom_close( inum )
-      sn0(:,:,:) = 0.5 * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) )        
-      sn0(:,:,:) = sn0(:,:,:)*tmask(:,:,:)
+      sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) )        
+      sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:)
       IF( ln_zps ) THEN               ! z-coord. partial steps
          DO jj = 1, jpj               ! interpolation of salinity at the last ocean level (i.e. the partial step)
             DO ji = 1, jpi
-               ik = mbathy(ji,jj) - 1
-               IF( ik > 2 ) THEN
+               ik = mbkt(ji,jj)
+               IF( ik > 1 ) THEN
                   zztmp = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) )
-                  sn0(ji,jj,ik) = (1.-zztmp) * sn0(ji,jj,ik) + zztmp * sn0(ji,jj,ik-1)
+                  sn0(ji,jj,ik) = ( 1._wp - zztmp ) * sn0(ji,jj,ik) + zztmp * sn0(ji,jj,ik-1)
                ENDIF
             END DO
@@ -204,11 +189,10 @@
    !!   Default option :                                         NO diaar5
    !!----------------------------------------------------------------------
-
    LOGICAL, PUBLIC, PARAMETER :: lk_diaar5 = .FALSE.   ! coupled flag
-
 CONTAINS
-
+   SUBROUTINE dia_ar5_init    ! Dummy routine
+   END SUBROUTINE dia_ar5_init
    SUBROUTINE dia_ar5( kt )   ! Empty routine
-      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+      INTEGER ::   kt
       WRITE(*,*) 'dia_ar5: You should not have seen this print! error?', kt
    END SUBROUTINE dia_ar5
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diadimg.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diadimg.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diadimg.F90	(revision 2528)
@@ -20,8 +20,9 @@
    !! * Substitutions
 #  include "domzgr_substitute.h90"
-   !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Header$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90	(revision 2528)
@@ -8,7 +8,7 @@
    !!            9.0  !  05-11  (V. Garnier) Surface pressure gradient organization
    !!----------------------------------------------------------------------
-#if ( defined key_orca_r2 || defined  key_orca_r4 )  && ! defined key_coupled
-   !!----------------------------------------------------------------------
-   !!   "key_orca_r2 or 4"
+#if (  defined key_orca_r1 || defined key_orca_r2 || defined  key_orca_r4 ) && ! defined key_coupled
+   !!----------------------------------------------------------------------
+   !!   "key_orca_r1 or 2 or 4"
    !!----------------------------------------------------------------------
    !!----------------------------------------------------------------------
@@ -30,5 +30,5 @@
    LOGICAL, PUBLIC, PARAMETER ::   lk_diafwb = .TRUE.    !: fresh water budget flag
 
-   REAL(wp)               ::   a_emp ,          &
+   REAL(wp)               ::   a_fwf ,          &
       &                        a_sshb, a_sshn, a_salb, a_saln
    REAL(wp), DIMENSION(4) ::   a_flxi, a_flxo, a_temi, a_temo, a_sali, a_salo
@@ -38,7 +38,7 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2006) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -59,5 +59,5 @@
       REAL(wp) ::  ztemi(4), ztemo(4), zsali(4), zsalo(4), zflxi(4), zflxo(4)
       REAL(wp) ::  zt, zs, zu  
-      REAL(wp) ::  zsm0, zempnew
+      REAL(wp) ::  zsm0, zfwfnew
       !!----------------------------------------------------------------------
 
@@ -65,9 +65,9 @@
       zsm0 = 34.72654
 
-      ! To compute emp mean value mean emp
+      ! To compute fwf mean value mean fwf
 
       IF( kt == nit000 ) THEN
 
-         a_emp    = 0.e0
+         a_fwf    = 0.e0
          a_sshb   = 0.e0 ! valeur de ssh au debut de la simulation
          a_salb   = 0.e0 ! valeur de sal au debut de la simulation
@@ -87,6 +87,6 @@
       ENDIF
       
-      a_emp    = SUM( e1t(:,:) * e2t(:,:) * emp   (:,:) * tmask_i(:,:) )
-      IF( lk_mpp )   CALL mpp_sum( a_emp    )       ! sum over the global domain
+      a_fwf    = SUM( e1t(:,:) * e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * tmask_i(:,:) ) 
+      IF( lk_mpp )   CALL mpp_sum( a_fwf    )       ! sum over the global domain
 
       IF( kt == nitend ) THEN
@@ -95,5 +95,5 @@
          zarea = 0.e0
          zvol  = 0.e0
-         zempnew = 0.e0
+         zfwfnew = 0.e0
          ! Mean sea level at nitend
          a_sshn = SUM( e1t(:,:) * e2t(:,:) * sshn(:,:) * tmask_i(:,:) )
@@ -115,8 +115,8 @@
          
          ! Conversion in m3
-         a_emp    = a_emp * rdttra(1) * 1.e-3 
+         a_fwf    = a_fwf * rdttra(1) * 1.e-3 
          
-         ! emp correction to bring back the mean ssh to zero
-         zempnew = a_sshn / ( ( nitend - nit000 + 1 ) * rdt ) * 1.e3 / zarea
+         ! fwf correction to bring back the mean ssh to zero
+         zfwfnew = a_sshn / ( ( nitend - nit000 + 1 ) * rdt ) * 1.e3 / zarea
 
       ENDIF
@@ -162,4 +162,9 @@
             ii0 = 140   ;   ii1 = 140
             ij0 = 102   ;   ij1 = 102
+            !                                        ! =======================
+         CASE ( 1 )                                  !  ORCA_R1 configurations
+            !                                        ! =======================
+            ii0 = 283   ;   ii1 = 283
+            ij0 = 200   ;   ij1 = 200
             !                                        ! =======================
          CASE DEFAULT                                !    ORCA R05 or R025
@@ -204,4 +209,9 @@
             ii0 = 137   ;   ii1 = 137
             ij0 = 101   ;   ij1 = 102
+            !                                        ! =======================
+         CASE ( 1 )                                  !  ORCA_R1 configurations
+            !                                        ! =======================
+            ii0 = 282   ;   ii1 = 282
+            ij0 = 200   ;   ij1 = 200
             !                                        ! =======================
          CASE DEFAULT                                !    ORCA R05 or R025
@@ -247,4 +257,9 @@
             ij0 = 88    ;   ij1 = 88 
             !                                        ! =======================
+         CASE ( 1 )                                  !  ORCA_R1 configurations
+            !                                        ! =======================
+            ii0 = 331   ;   ii1 = 331
+            ij0 = 176   ;   ij1 = 176
+            !                                        ! =======================
          CASE DEFAULT                                !    ORCA R05 or R025
             !                                        ! =======================
@@ -289,4 +304,9 @@
             ij0 = 116   ;   ij1 = 116
             !                                        ! =======================
+         CASE ( 1 )                                  !  ORCA_R1 configurations
+            !                                        ! =======================
+            ii0 = 297   ;   ii1 = 297 
+            ij0 = 230   ;   ij1 = 230
+            !                                        ! =======================
          CASE DEFAULT                                !    ORCA R05 or R025
             !                                        ! =======================
@@ -362,5 +382,5 @@
          WRITE(inum,*)
          WRITE(inum,*)    'Net freshwater budget '
-         WRITE(inum,9010) '  emp    = ',a_emp,   ' m3 =', a_emp   /(FLOAT(nitend-nit000+1)*rdttra(1)) * 1.e-6,' Sv'
+         WRITE(inum,9010) '  fwf    = ',a_fwf,   ' m3 =', a_fwf   /(FLOAT(nitend-nit000+1)*rdttra(1)) * 1.e-6,' Sv'
          WRITE(inum,*)
          WRITE(inum,9010) '  zarea =',zarea
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diagap.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diagap.F90	(revision 2527)
+++ 	(revision )
@@ -1,267 +1,0 @@
-MODULE diagap
-   !!======================================================================
-   !!                       ***  MODULE  diagap  ***
-   !! Ocean diagnostics : computation of model-data tracer gap
-   !!======================================================================
-   !! History :  OPA  ! 1991-10  (G. Madec)  Original code
-   !!            7.0  ! 1992-07  (M. Imbard)  Add variance and mpp staff
-   !!   NEMO     1.0  ! 2002-07  (G. Madec)  Free form, F90
-   !!----------------------------------------------------------------------
-#if defined key_diagap
-   !!----------------------------------------------------------------------
-   !!   'key_diagap' :                           model-data gap diagnostics
-   !!----------------------------------------------------------------------
-   !!   dia_gap      : model and data level mean temperature and salinity
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers
-   USE dom_oce         ! ocean space and time domain
-   USE in_out_manager  ! I/O manager
-   USE dtatem          ! ???
-   USE dtasal          ! ???
-   USE dianam          ! build name of file (routine)
-   USE lib_mpp         ! distributed memory computing library
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   dia_gap    ! called in step.F90 module
-
-   LOGICAL, PUBLIC, PARAMETER ::   lk_diagap = .TRUE.   !: model-data diagnostics flag
-
-   !                         !!* Namelist namgap : model-data gap
-   INTEGER ::   nn_gap = 15   ! time step frequency
-   INTEGER ::   nn_prg = 15   ! switch for control print
-
-   INTEGER ::   numgap                      ! logical unit for differences diagnostic
-   INTEGER ::   nhoridg, ndepidg, ndex(1)   ! netcdf files and index common
-
-   REAL(wp) ::   vol                        ! total ocean volume
-
-   REAL(wp), DIMENSION(jpk) ::   volk , volkr   ! level ocean volume and its inverse
-   REAL(wp), DIMENSION(jpk) ::   tdtag, sdtag   ! level mean data temperature & salinity
-   REAL(wp), DIMENSION(jpk) ::   tmodg, smodg   ! level mean model temperature & salinity
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE dia_gap( kt )
-      !!----------------------------------------------------------------------
-      !!                ***  ROUTINE dia_gap  ***
-      !!
-      !! ** Purpose :   Compute model and data level mean T and S profiles
-      !!              and output it in numgap (NetCDF or direct access file)
-      !!
-      !! ** Method :   tracers (model) : tn, sn
-      !!               tracers (data)  : t_dta, s_dta
-      !!               difference between model and data tracers
-      !!               variance between model and data tracers
-      !!
-      !! ** Action  :   output in file numgap
-      !!----------------------------------------------------------------------
-      USE ioipsl
-      !!
-      INTEGER, INTENT(in) ::   kt           ! ocean time-step index
-      !!
-      INTEGER ::   ji, jj, jk   ! dummy loop indices
-      INTEGER ::   it, itmod    ! time step indices
-      CHARACTER (len=40) ::   clhstnam
-      CHARACTER (len=40) ::   clop
-      REAL(wp) ::   zbt, zdt    ! temporary scalar
-      REAL(wp) ::   zsto, zout, zmax, zjulian
-      REAL(wp), DIMENSION(jpi) ::   zfoo
-      REAL(wp), DIMENSION(jpj) ::   zloo
-      !!
-      NAMELIST/namgap/ nn_gap, nn_prg
-      !!----------------------------------------------------------------------
-
-      ! 0. initialization
-      ! -----------------
-      zdt = rdt
-      IF( nacc == 1 )   zdt = rdtmin
-
-      IF( kt == nit000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'dia_gap : level mean model-data gap'
-         IF(lwp) WRITE(numout,*) '~~~~~~~'
-
-         REWIND( numnam )            ! Read diagap parameters in namelist namgap
-         READ( numnam, namgap )
-
-         IF(lwp) WRITE(numout,*) '          time step frequency for gap     nn_gap  = ',nn_gap
-         IF(lwp) WRITE(numout,*) '          switch for control print gap    nn_prg  = ',nn_prg
-
-         ! horizontal slab volume (tmask_i to take into account only interior ocean domain)
-         volk(:) = 0.e0
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) * tmask_i(ji,jj)
-                  volk(jk) = volk(jk) + tmask(ji,jj,jk) * zbt
-               END DO
-            END DO
-         END DO
-         IF( lk_mpp )   CALL mpp_sum( volk, jpk )   ! sum over the global domain
-
-         volkr(:) = 0.e0
-         DO jk = 1, jpk
-            IF( volk(jk) /= 0.e0 )   volkr(jk) = 1.e0 / volk(jk)
-         END DO
-         IF(lwp) THEN
-            WRITE(numout,*)
-            WRITE(numout,*) '     volume of each horizontal slab (km3) :'
-            DO jk = 1, jpkm1
-               WRITE(numout,9010) jk, volk(jk) * 1.e-9
-            END DO
-         ENDIF
-9010     FORMAT( 9X, 'level ', i3, f15.3 )
-
-         ! basin volume
-         vol = 0.e0
-         DO jk = 1, jpkm1
-            vol = vol + volk(jk)
-         END DO
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) '     basin volume : ',vol*1.e-9, '  km3'
-
-         ! OPEN netcdf file 
-
-         ! Define frequency of output and means
-         zsto = nn_gap * zdt
-         IF( ln_mskland )   THEN   ;   clop = "ave(only(x))"   ! put 1.e+20 on land (very expensive!!)
-         ELSE                      ;   clop = "ave(x)"         ! no use of the mask value (require less cpu time)
-         ENDIF
-         zout = nn_gap * zdt
-         zmax = FLOAT( nitend - nit000 + 1 ) * zdt
-         zfoo(1:jpi) = 0.e0
-         zloo(1:jpj) = 0.e0
-
-         ! Compute julian date from starting date of the run
-
-         CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian )
-         zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment
-
-         CALL dia_nam( clhstnam, nn_gap, 'diagap' )
-         IF(lwp) WRITE(numout,*) 'Name of diagap NETCDF file ', clhstnam
-         ! Horizontal grid : zphi()
-         CALL histbeg( clhstnam, 1, zfoo, 1, zloo,   &
-                       1, 1, 1, 1, nit000-1, zjulian, zdt, nhoridg, numgap, domain_id=nidom )
-         ! Vertical grids : gdept, gdepw
-         CALL histvert( numgap, "deptht", "Vertical T levels",   &
-                         "m", jpk, gdept_0, ndepidg, "down" )
-
-         ! define fields to be stored
-         ! mo(temp/sali)(da/mo/va): mean ocean temperature/salinity data/model/differences
-
-          CALL histdef( numgap, "motempda", "Mean Data Temperature","C",   &
-                        1, 1, nhoridg, jpk, 1, jpk, ndepidg, 32, clop,   &
-                        zsto,zout )
-          CALL histdef(numgap, "mosalida", "Mean Data Salinity","PSU",   &
-                        1, 1, nhoridg, jpk, 1, jpk, ndepidg, 32, clop,   &
-                        zsto,zout )
-          CALL histdef(numgap, "motempmo", "Mean Model Temperature","C",   &
-                        1, 1, nhoridg, jpk, 1, jpk, ndepidg, 32, clop,   &
-                        zsto,zout )
-          CALL histdef(numgap, "mosalimo", "Mean Model Salinity","PSU",   &
-                        1, 1, nhoridg, jpk, 1, jpk, ndepidg, 32, clop,   &
-                        zsto,zout )
-          CALL histend( numgap )
-          ndex(1) = 0
-      ENDIF
-
-
-      ! 1. horizontal averaged
-      ! ----------------------
-
-      itmod = kt - nit000 + 1       ! define time axis
-      it = kt 
-      IF( MOD( itmod, nn_gap ) == 0 ) THEN
-
-         ! initialization
-         tdtag(:) = 0.e0
-         sdtag(:) = 0.e0
-         tmodg(:) = 0.e0
-         smodg(:) = 0.e0
-         
-         !  c a u t i o n  : use of tmask_i : average over the interior domain only
-         
-         ! sum
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj
-              DO ji = 1, jpi
-                zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) * tmask_i(ji,jj)
-                tdtag(jk) = tdtag(jk) + zbt * t_dta(ji,jj,jk) * volkr(jk)
-                sdtag(jk) = sdtag(jk) + zbt * s_dta(ji,jj,jk) * volkr(jk)
-                tmodg(jk) = tmodg(jk) + zbt * tn  (ji,jj,jk) * volkr(jk)
-                smodg(jk) = smodg(jk) + zbt * sn  (ji,jj,jk) * volkr(jk)
-              END DO  
-            END DO  
-         END DO
-
-         ! 2. Basin averaged
-         ! -----------------
-         DO jk = 1, jpkm1
-            tdtag(jpk) = tdtag(jpk) + tdtag(jk) * volk(jk) / vol
-            sdtag(jpk) = sdtag(jpk) + sdtag(jk) * volk(jk) / vol
-            tmodg(jpk) = tmodg(jpk) + tmodg(jk) * volk(jk) / vol
-            smodg(jpk) = smodg(jpk) + smodg(jk) * volk(jk) / vol
-         END DO  
-          IF( lk_mpp)   CALL mpp_sum( tdtag, jpk )   ! sum over the global domain
-          IF( lk_mpp)   CALL mpp_sum( sdtag, jpk )
-          IF( lk_mpp)   CALL mpp_sum( tmodg, jpk )
-          IF( lk_mpp)   CALL mpp_sum( smodg, jpk )
-
-          ! 3.  Averaged output in file numgap
-          ! ----------------------------======
-          IF( MOD( itmod, nn_prg ) == 0 ) THEN
-              IF(lwp) THEN
-                  WRITE(numout,*) 'dia_gap: time step = ', kt, 'model - data'
-                  WRITE(numout,9300)
-                  DO jk = 1, jpk
-                    WRITE(numout,9310) tdtag(jk), tmodg(jk), tdtag(jk) - tmodg(jk), jk, fsdept(1,1,jk),   &
-                       &               sdtag(jk), smodg(jk), sdtag(jk) - smodg(jk)
-                  END DO  
-              ENDIF
-          ENDIF
-
- 9300     FORMAT('  T-data  T-model    diff.   level  depth    S-data  S-model    diff.' )
- 9310     FORMAT( 3(f8.3,1x),i5,f9.0,2x,3(f8.3,1x) )
-
-          ! Output in file numgap
-
-          ! Netcdf write
-
-          IF (lwp ) THEN   ! Ok even in mpp after the call to mpp_sum
-             CALL histwrite( numgap, "motempda", it, tdtag, jpk, ndex )
-             CALL histwrite( numgap, "mosalida", it, sdtag, jpk, ndex )
-             CALL histwrite( numgap, "motempmo", it, tmodg, jpk, ndex )
-             CALL histwrite( numgap, "mosalimo", it, smodg, jpk, ndex )
-          END IF
-      ENDIF
-
-      ! Closing numgap file
-      IF( kt == nitend ) THEN
-         CALL histclo( numgap )      !   Netcdf file
-      ENDIF 
-      !
-   END SUBROUTINE dia_gap
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option :                                       Dummy module
-   !!----------------------------------------------------------------------
-   LOGICAL, PUBLIC, PARAMETER ::   lk_diagap = .FALSE.    !: diagap flag
-CONTAINS
-   SUBROUTINE dia_gap( kt )           ! Dummy routine
-      WRITE(*,*) 'dia_gap: You should not have seen this print! error?', kt
-   END SUBROUTINE dia_gap
-#endif
-
-   !!======================================================================
-END MODULE diagap
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diahdy.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diahdy.F90	(revision 2527)
+++ 	(revision )
@@ -1,267 +1,0 @@
-MODULE diahdy
-   !!======================================================================
-   !!                       ***  MODULE  diahdy  ***
-   !! Ocean diagnostics : computation the dynamical heigh
-   !!======================================================================
-#if   defined key_diahdy   ||   defined key_esopa
-   !!----------------------------------------------------------------------
-   !!   'key_diahdy' :                          dynamical heigh diagnostics
-   !!----------------------------------------------------------------------
-   !!   dia_hdy      : dynamical heigh computation
-   !!----------------------------------------------------------------------
-   !! * Modules used
-   USE oce             ! ocean dynamics and tracers
-   USE dom_oce         ! ocean space and time domain
-   USE phycst          ! physical constants
-   USE in_out_manager  ! I/O manager
-
-   IMPLICIT NONE
-   PRIVATE
-
-   !! * Routine accessibility
-   PUBLIC dia_hdy     ! called in step.F90 module
-
-   !! * Shared module variables
-   LOGICAL, PUBLIC, PARAMETER ::   lk_diahdy = .TRUE.   !: dynamical heigh flag
-
-   !! * Module variables
-   REAL(wp), DIMENSION(jpk) ::   &
-      rhosp         ! ???
-
-   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
-      hdy           ! dynamical heigh
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-   !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-
-CONTAINS
-   
-   SUBROUTINE dia_hdy ( kt )
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE dia_hdy  ***
-      !!
-      !! ** Purpose :   Computes the dynamical heigh
-      !!
-      !! ** Method  : Millero + Poisson
-      !!
-      !! References : 
-      !!	A. E. Gill, atmosphere-ocean dynamics 7.7 pp 215
-      !!
-      !! History :
-      !!        !  9x-xx (P. Delecluse, C. Perigaud)  Original code
-      !!        !  93-10  (C. Perigaud)  a trapezoidal vertical integration 
-      !!                                 consistent WITH the code
-      !!        !  93-12  (G. Madec M. Imbard)
-      !!        !  96-03  (N. Ferry)  integration at t-points
-      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
-
-      !! * Local declarations
-      INTEGER :: ji, jj, jk
-      INTEGER :: ihdsup, ik
-
-      REAL(wp) :: zgdsup, za, zb, zciint, zfacto, zhd
-      REAL(wp) :: zp, zh, zt, zs, zxk, zq, zsr, zr1, zr2, zr3, zr4
-      REAL(wp) :: ze, zbw, zc, zd, zaw, zb1, za1, zkw, zk0
-      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zsva
-      REAL(wp), DIMENSION(jpk)         :: zwkx, zwky, zwkz
-      REAL(wp) :: fsatg
-      REAL(wp) :: pfps, pfpt, pfphp  
-
-      ! Adiabatic laspse rate fsatg, defined as the change of temperature
-      ! per unit pressure for adiabatic change of pressure of an element
-      ! of seawater (bryden,h.,1973,deep-sea res.,20,401-408).
-      ! units:
-      !      pressure        pfphp    decibars
-      !      temperature     pfpt     deg celsius (ipts-68)
-      !      salinity        pfps     (ipss-78)
-      !      adiabatic       fsatg    deg. c/decibar
-      ! checkvalue: atg=3.255976e-4 c/dbar for pfps=40 (ipss-78),
-      ! pfpt=40 deg c, pfphp=10000 decibars
-      
-      fsatg(pfps,pfpt,pfphp)   &
-         = (((-2.1687e-16*pfpt+1.8676e-14)*pfpt-4.6206e-13)*pfphp    &
-         +((2.7759e-12*pfpt-1.1351e-10)*(pfps-35.)+((-5.4481e-14*pfpt    &
-         +8.733e-12)*pfpt-6.7795e-10)*pfpt+1.8741e-8))*pfphp    &
-         +(-4.2393e-8*pfpt+1.8932e-6)*(pfps-35.)    &
-         +((6.6228e-10*pfpt-6.836e-8)*pfpt+8.5258e-6)*pfpt+3.5803e-5
-      !!----------------------------------------------------------------------
-
-      ! 1. height dynamic
-      ! -----------------
-      ! depth for reference
-
-      zgdsup = 1500.
-      
-      ! below for hdyn levitus
-      
-      IF( kt == nit000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'dia_hdy : computation of dynamical heigh'
-         IF(lwp) WRITE(numout,*) '~~~~~~~'
-         IF( .NOT. ln_zco )   &
-              &   CALL ctl_stop( '          ln_zps or ln_sco, Dynamical height diagnostics not yet implemented' )
-         DO jk = 1, jpk
-            IF( gdepw_0(jk) > zgdsup ) GOTO 110
-         END DO
-         IF(lwp) WRITE(numout,*)'problem zgdsup greater than gdepw(jpk)'
-         STOP 'dia_hdy'
-110      CONTINUE
-         ihdsup = jk - 1
-         IF(lwp) WRITE(numout,*)' ihdsup = ', ihdsup
-
-         ! Interpolation coefficients for zgdsup-gdepw(ihdsup) layer
-
-         za = gdepw_0(ihdsup  )
-         zb = gdepw_0(ihdsup+1)
-         IF( za > zgdsup .OR. zb < zgdsup ) THEN
-            IF(lwp) WRITE(numout,*) za, zb, ihdsup, zgdsup
-            IF(lwp) WRITE(numout,*) ' bad ihdsup'
-            STOP
-         ENDIF
-         
-         zciint = (zgdsup - za) / (zb - za)
-
-         ! Computes the specific volume reference in situ temperature
-         
-         DO jk = 1, jpk
-            zp = 0.e0
-            zh = gdept_0(jk)
-            zt = 0.e0
-            zs = 35.
-            zxk= zh * fsatg( zs, zt, zp )
-            zt = zt + 0.5 * zxk
-            zq = zxk
-            zp = zp + 0.5 * zh
-            zxk= zh*fsatg( zs, zt, zp )
-            zt = zt + 0.29289322 * ( zxk - zq )
-            zq = 0.58578644 * zxk + 0.121320344 * zq
-            zxk= zh * fsatg( zs, zt, zp )
-            zt = zt + 1.707106781 * ( zxk - zq )
-            zq = 3.414213562 * zxk - 4.121320344 * zq
-            zp = zp + 0.5 * zh
-            zxk= zh * fsatg( zs, zt, zp )
-            zwkx(jk) = zt + ( zxk - 2.0 * zq ) / 6.0
-         END DO
-
-         ! In situ density (add the compression terms)
-
-         DO jk = 1, jpk
-            zt = zwkx(jk)
-            zs = 35.
-            ! square root salinity
-            zsr = sqrt( abs( zs ) )
-            zwky(jk) = zsr
-            ! compute density pure water at atm pressure
-            zr1= ((((6.536332e-9*zt-1.120083e-6)*zt+1.001685e-4)*zt   &
-               -9.095290e-3)*zt+6.793952e-2)*zt+999.842594
-            ! seawater density atm pressure
-            zr2= (((5.3875e-9*zt-8.2467e-7)*zt+7.6438e-5)*zt   &
-               -4.0899e-3)*zt+8.24493e-1
-            zr3= (-1.6546e-6*zt+1.0227e-4)*zt-5.72466e-3
-            zr4= 4.8314e-4
-            zwkz(jk)= (zr4*zs + zr3*zsr + zr2)*zs + zr1
-         END DO
-
-         DO jk = 1, jpk
-            zt = zwkx(jk)
-            zs = 35.
-            zsr= zwky(jk)
-            zh = gdept_0(jk)
-
-            ze = ( 9.1697e-11*zt+2.0816e-9 ) *zt-9.9348e-8
-            zbw= ( 5.2787e-9*zt-6.12293e-7 ) * zt+8.50935e-6
-            zb = zbw + ze * zs
-
-            zd = 1.91075e-4
-            zc = (-1.6078e-6*zt-1.0981e-5)*zt+2.2838e-3
-            zaw= ((-5.77905e-7*zt+1.16092e-4)*zt+1.43713e-3)*zt+3.239908
-            za = ( zd*zsr + zc)*zs + zaw
-
-            zb1= (-5.3009e-3*zt+1.6483e-1)*zt+7.944e-1
-            za1= ((-6.1670e-4*zt+1.09987e-1)*zt-6.03459)*zt+546.746
-            zkw= (((-5.155288e-4*zt+1.360477e-1)*zt-23.27105)*zt   &
-                +1484.206)*zt+196522.1
-            zk0= (zb1*zsr + za1)*zs + zkw
-            ! evaluate pressure polynomial
-            zwkz(jk) = zwkz(jk) / ( 1.0 - zh / ( zk0+zh*(za+zb*zh) ) )
-         END DO
-
-         DO jk = 1, jpk
-            rhosp(jk) = zwkz(jk)
-         END DO
-      ENDIF
-
-      ! Computes the specific volume anomaly
-
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( tmask(ji,jj,jk) /= 0. ) THEN
-                  zsva(ji,jj,jk) = ( rau0*rhd(ji,jj,jk)+rau0 -rhosp(jk) ) / rhosp(jk)
-               ELSE
-                  zsva(ji,jj,jk)=0.
-               ENDIF
-            END DO
-         END DO
-      END DO
-
-      ! zfacto coefficient to cmg
-      
-      ! zfacto= 1.  e+2
-      !           mg->cmg
-      zfacto = 1.0 * 1.e2
-      
-      ! Fisrt compute at depth ik=ihdsup
-      
-      ik = ihdsup
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            zhd = zfacto * zciint * e3t_0(ik) * zsva(ji,jj,ik)
-            hdy(ji,jj,ik) = zhd * tmask(ji,jj,ik) * tmask(ji,jj,ik-1)
-         END DO
-      END DO
-      
-      ! Then compute other terms except level jk=1
-      
-      DO jk = ihdsup-1, 2, -1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zhd = hdy(ji,jj,jk+1) + zfacto * e3t_0(jk) * zsva(ji,jj,jk)
-               hdy(ji,jj,jk) = zhd * tmask(ji,jj,jk) * tmask(ji,jj,jk-1)
-            END DO
-         END DO
-      END DO
-      
-      ! Then compute other the last layer term jk=1
-      
-      ik = 1
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            zhd = hdy(ji,jj,ik+1) + zfacto * e3t_0(ik) * zsva(ji,jj,ik)
-            hdy(ji,jj,ik) = zhd * tmask(ji,jj,ik)
-         END DO
-      END DO
-
-   END SUBROUTINE dia_hdy
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option :                       NO dynamic heigh diagnostics
-   !!----------------------------------------------------------------------
-   LOGICAL, PUBLIC, PARAMETER ::   lk_diahdy = .FALSE.   !: dynamical heigh flag
-CONTAINS
-   SUBROUTINE dia_hdy( kt )               ! Empty routine
-      WRITE(*,*) 'diahdy: You should not have seen this print! error?', kt
-   END SUBROUTINE dia_hdy
-#endif
-
-   !!======================================================================
-END MODULE diahdy
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90	(revision 2528)
@@ -0,0 +1,265 @@
+MODULE diahsb
+   !!======================================================================
+   !!                       ***  MODULE  diahsb  ***
+   !! Ocean diagnostics: Heat, salt and volume budgets
+   !!======================================================================
+   !! History :  3.3  ! 2010-09  (M. Leclair)  Original code 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE sbc_oce         ! surface thermohaline fluxes
+   USE in_out_manager  ! I/O manager
+   USE domvvl          ! vertical scale factors
+   USE traqsr          ! penetrative solar radiation
+   USE trabbc          ! bottom boundary condition 
+   USE lib_mpp         ! distributed memory computing library
+   USE trabbc          ! bottom boundary condition
+   USE bdy_par         ! (for lk_bdy)
+   USE obc_par         ! (for lk_obc)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dia_hsb        ! routine called by step.F90
+   PUBLIC   dia_hsb_init   ! routine called by opa.F90
+
+   LOGICAL, PUBLIC ::   ln_diahsb  = .FALSE.   !: check the heat and salt budgets
+
+   INTEGER                                 ::   numhsb                           !
+   REAL(dp)                                ::   surf_tot   , vol_tot             !
+   REAL(dp)                                ::   frc_t      , frc_s     , frc_v   ! global forcing trends
+   REAL(dp)                                ::   fact1                            ! conversion factors
+   REAL(dp)                                ::   fact21    , fact22               !     -         -
+   REAL(dp)                                ::   fact31    , fact32               !     -         -
+   REAL(dp), DIMENSION(:,:)  , ALLOCATABLE ::   surf      , ssh_ini              !
+   REAL(dp), DIMENSION(:,:,:), ALLOCATABLE ::   hc_loc_ini, sc_loc_ini, e3t_ini  !
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE dia_hsb( kt )
+      !!---------------------------------------------------------------------------
+      !!                  ***  ROUTINE dia_hsb  ***
+      !!     
+      !! ** Purpose: Compute the ocean global heat content, salt content and volume conservation
+      !!	
+      !! ** Method : - Compute the deviation of heat content, salt content and volume
+      !!	            at the current time step from their values at nit000
+      !!	            - Compute the contribution of forcing and remove it from these deviations
+      !!
+      !! ** Action : Write the results in the 'heat_salt_volume_budgets.txt' ASCII file
+      !!---------------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !!
+      INTEGER    ::   jk                          ! dummy loop indice
+      REAL(dp)   ::   zdiff_hc    , zdiff_sc      ! heat and salt content variations
+      REAL(dp)   ::   zdiff_v1    , zdiff_v2      ! volume variation
+      REAL(dp)   ::   z1_rau0                     ! local scalars
+      REAL(dp)   ::   zdeltat                     !    -     -
+      REAL(dp)   ::   z_frc_trd_t , z_frc_trd_s   !    -     -
+      REAL(dp)   ::   z_frc_trd_v                 !    -     -
+      !!---------------------------------------------------------------------------
+
+      ! ------------------------- !
+      ! 1 - Trends due to forcing !
+      ! ------------------------- !
+      z1_rau0 = 1.e0 / rau0
+      z_frc_trd_v = z1_rau0 * SUM( - ( emp(:,:) - rnf(:,:) ) * surf(:,:) )     ! volume fluxes
+      z_frc_trd_t =           SUM( sbc_tsc(:,:,jp_tem) * surf(:,:) )     ! heat fluxes
+      z_frc_trd_s =           SUM( sbc_tsc(:,:,jp_sal) * surf(:,:) )     ! salt fluxes
+      ! Add penetrative solar radiation
+      IF( ln_traqsr )   z_frc_trd_t = z_frc_trd_t + ro0cpr * SUM( qsr     (:,:) * surf(:,:) )
+      ! Add geothermal heat flux
+      IF( ln_trabbc )   z_frc_trd_t = z_frc_trd_t + ro0cpr * SUM( qgh_trd0(:,:) * surf(:,:) )
+      IF( lk_mpp ) THEN
+         CALL mpp_sum( z_frc_trd_v )
+         CALL mpp_sum( z_frc_trd_t )
+      ENDIF
+      frc_v = frc_v + z_frc_trd_v * rdt
+      frc_t = frc_t + z_frc_trd_t * rdt
+      frc_s = frc_s + z_frc_trd_s * rdt
+
+      ! ----------------------- !
+      ! 2 -  Content variations !
+      ! ----------------------- !
+      zdiff_v2 = 0.d0
+      zdiff_hc = 0.d0
+      zdiff_sc = 0.d0
+      ! volume variation (calculated with ssh)
+      zdiff_v1 = SUM( surf(:,:) * tmask(:,:,1) * ( sshn(:,:) - ssh_ini(:,:) ) )
+      DO jk = 1, jpkm1
+         ! volume variation (calculated with scale factors)
+         zdiff_v2 = zdiff_v2 + SUM( surf(:,:) * tmask(:,:,jk)   &
+            &                       * ( fse3t_n(:,:,jk)         &
+            &                           - e3t_ini(:,:,jk) ) )
+         ! heat content variation
+         zdiff_hc = zdiff_hc + SUM( surf(:,:) * tmask(:,:,jk)          &
+            &                       * ( fse3t_n(:,:,jk) * tn(:,:,jk)   &
+            &                           - hc_loc_ini(:,:,jk) ) )
+         ! salt content variation
+         zdiff_sc = zdiff_sc + SUM( surf(:,:) * tmask(:,:,jk)          &
+            &                       * ( fse3t_n(:,:,jk) * sn(:,:,jk)   &
+            &                           - sc_loc_ini(:,:,jk) ) )
+      ENDDO
+
+      IF( lk_mpp ) THEN
+         CALL mpp_sum( zdiff_hc )
+         CALL mpp_sum( zdiff_sc )
+         CALL mpp_sum( zdiff_v1 )
+         CALL mpp_sum( zdiff_v2 )
+      ENDIF
+
+      ! Substract forcing from heat content, salt content and volume variations
+      zdiff_v1 = zdiff_v1 - frc_v
+      zdiff_v2 = zdiff_v2 - frc_v
+      zdiff_hc = zdiff_hc - frc_t
+      zdiff_sc = zdiff_sc - frc_s
+      
+      ! ----------------------- !
+      ! 3 - Diagnostics writing !
+      ! ----------------------- !
+      zdeltat  = 1.e0 / ( ( kt - nit000 + 1 ) * rdt )
+      WRITE(numhsb , 9020) kt , zdiff_hc / vol_tot , zdiff_hc * fact1  * zdeltat,                                &
+         &                      zdiff_sc / vol_tot , zdiff_sc * fact21 * zdeltat, zdiff_sc * fact22 * zdeltat,   &
+         &                      zdiff_v1           , zdiff_v1 * fact31 * zdeltat, zdiff_v1 * fact32 * zdeltat,   &
+         &                      zdiff_v2           , zdiff_v2 * fact31 * zdeltat, zdiff_v2 * fact32 * zdeltat
+
+      IF ( kt == nitend ) CLOSE( numhsb )
+
+9020  FORMAT(I5,11D15.7)
+      !
+   END SUBROUTINE dia_hsb
+
+
+   SUBROUTINE dia_hsb_init
+      !!---------------------------------------------------------------------------
+      !!                  ***  ROUTINE dia_hsb  ***
+      !!     
+      !! ** Purpose: Initialization for the heat salt volume budgets
+      !!	
+      !! ** Method : Compute initial heat content, salt content and volume
+      !!
+      !! ** Action : - Compute initial heat content, salt content and volume
+      !!             - Initialize forcing trends
+      !!             - Compute coefficients for conversion
+      !!---------------------------------------------------------------------------
+      CHARACTER (len=32) ::   cl_name  ! output file name
+      INTEGER            ::   jk       ! dummy loop indice
+      INTEGER            ::   ierror   ! local integer
+      !!
+      NAMELIST/namhsb/ ln_diahsb
+      !!----------------------------------------------------------------------
+      !
+      REWIND ( numnam )              ! Read Namelist namhsb 
+      READ   ( numnam, namhsb )
+      !
+      IF(lwp) THEN                   ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dia_hsb_init : check the heat and salt budgets'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namhsb : set hsb parameters'
+         WRITE(numout,*) '      Switch for hsb diagnostic (T) or not (F)  ln_diahsb  = ', ln_diahsb
+      ENDIF
+
+      IF( .NOT. ln_diahsb )   RETURN
+
+      ! ------------------- !
+      ! 1 - Allocate memory !
+      ! ------------------- !
+      ALLOCATE( hc_loc_ini(jpi,jpj,jpk), STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' )   ;   RETURN
+      ENDIF
+      ALLOCATE( sc_loc_ini(jpi,jpj,jpk), STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_hsb: unable to allocate sc_loc_ini' )   ;   RETURN
+      ENDIF
+      ALLOCATE( e3t_ini(jpi,jpj,jpk)   , STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_hsb: unable to allocate e3t_ini' )      ;   RETURN
+      ENDIF
+      ALLOCATE( surf(jpi,jpj)          , STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_hsb: unable to allocate surf' )         ;   RETURN
+      ENDIF
+      ALLOCATE( ssh_ini(jpi,jpj)       , STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_hsb: unable to allocate ssh_ini' )      ;   RETURN
+      ENDIF
+
+      ! ----------------------------------------------- !
+      ! 2 - Time independant variables and file opening !
+      ! ----------------------------------------------- !
+      WRITE(numout,*) "dia_hsb: heat salt volume budgets activated"
+      WRITE(numout,*) "~~~~~~~  output written in the 'heat_salt_volume_budgets.txt' ASCII file"
+      IF( lk_obc .OR. lk_bdy) THEN
+         CALL ctl_warn( 'dia_hsb does not take open boundary fluxes into account' )         
+      ENDIF
+      cl_name    = 'heat_salt_volume_budgets.txt'                         ! name of output file
+      surf(:,:) = e1t(:,:) * e2t(:,:) * tmask(:,:,1) * tmask_i(:,:)      ! masked surface grid cell area
+      surf_tot  = SUM( surf(:,:) )                                       ! total ocean surface area
+      vol_tot   = 0.d0                                                   ! total ocean volume
+      DO jk = 1, jpkm1
+         vol_tot  = vol_tot + SUM( surf(:,:) * tmask(:,:,jk)     &
+            &                      * fse3t_n(:,:,jk)         )
+      END DO
+      IF( lk_mpp ) THEN 
+         CALL mpp_sum( vol_tot )
+         CALL mpp_sum( surf_tot )
+      ENDIF
+
+      CALL ctl_opn( numhsb , cl_name , 'UNKNOWN' , 'FORMATTED' , 'SEQUENTIAL' , 1 , numout , lwp , 1 )
+      !                   12345678901234567890123456789012345678901234567890123456789012345678901234567890 -> 80
+      WRITE( numhsb, 9010 ) "kt   |     heat content budget     |            salt content budget             ",   &
+         !                                                   123456789012345678901234567890123456789012345 -> 45
+         &                                                  "|            volume budget (ssh)             ",   &
+         !                                                   678901234567890123456789012345678901234567890 -> 45
+         &                                                  "|            volume budget (e3t)             "
+      WRITE( numhsb, 9010 ) "     |      [C]         [W/m2]     |     [psu]        [mmm/s]          [SV]     ",   &
+         &                                                  "|     [m3]         [mmm/s]          [SV]     ",   &
+         &                                                  "|     [m3]         [mmm/s]          [SV]     "
+
+      ! --------------- !
+      ! 3 - Conversions ! (factors will be multiplied by duration afterwards)
+      ! --------------- !
+
+      ! heat content variation   =>   equivalent heat flux:
+      fact1  = rau0 * rcp / surf_tot                                         ! [C*m3]   ->  [W/m2]
+      ! salt content variation   =>   equivalent EMP and equivalent "flow": 
+      fact21 = 1.e3  / ( soce * surf_tot )                                   ! [psu*m3] ->  [mm/s]
+      fact22 = 1.e-6 / soce                                                  ! [psu*m3] ->  [Sv]
+      ! volume variation         =>   equivalent EMP and equivalent "flow":
+      fact31 = 1.e3  / surf_tot                                              ! [m3]     ->  [mm/s]
+      fact32 = 1.e-6                                                         ! [m3]     ->  [SV]
+
+      ! ---------------------------------- !
+      ! 4 - initial conservation variables !
+      ! ---------------------------------- !
+      ssh_ini(:,:) = sshn(:,:)                               ! initial ssh
+      DO jk = 1, jpk
+         e3t_ini   (:,:,jk) = fse3t_n(:,:,jk)                ! initial vertical scale factors
+         hc_loc_ini(:,:,jk) = tn(:,:,jk) * fse3t_n(:,:,jk)   ! initial heat content
+         sc_loc_ini(:,:,jk) = sn(:,:,jk) * fse3t_n(:,:,jk)   ! initial salt content
+      END DO
+      frc_v = 0.d0                                           ! volume       trend due to forcing
+      frc_t = 0.d0                                           ! heat content   -    -   -    -   
+      frc_s = 0.d0                                           ! salt content   -    -   -    -         
+      !
+9010  FORMAT(A80,A45,A45)
+      !
+   END SUBROUTINE dia_hsb_init
+
+   !!======================================================================
+END MODULE diahsb
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90	(revision 2528)
@@ -11,5 +11,4 @@
    !!   NEMO     3.2  !  2009-07  (S. Masson) hc300 bugfix + cleaning + add new diag
    !!----------------------------------------------------------------------
-
 #if   defined key_diahth   ||   defined key_esopa
    !!----------------------------------------------------------------------
@@ -18,18 +17,15 @@
    !!   dia_hth      : Compute varius diagnostics associated with the mixed layer
    !!----------------------------------------------------------------------
-   !! * Modules used
    USE oce             ! ocean dynamics and tracers
    USE dom_oce         ! ocean space and time domain
    USE phycst          ! physical constants
    USE in_out_manager  ! I/O manager
-   USE iom
+   USE iom             ! I/O library
 
    IMPLICIT NONE
    PRIVATE
 
-   !! * Routine accessibility
-   PUBLIC dia_hth    ! routine called by step.F90
-
-   !! * Shared module variables
+   PUBLIC   dia_hth    ! routine called by step.F90
+
    LOGICAL , PUBLIC, PARAMETER          ::   lk_diahth = .TRUE.   !: thermocline-20d depths flag
    ! note: following variables should move to local variables once iom_put is always used 
@@ -42,9 +38,8 @@
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
@@ -68,10 +63,9 @@
       !!
       !! ** Method : 
-      !!
       !!-------------------------------------------------------------------
       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
       !!
       INTEGER                          ::   ji, jj, jk            ! dummy loop arguments
-      INTEGER                          ::   iid, iif, ilevel      ! temporary integers
+      INTEGER                          ::   iid, ilevel           ! temporary integers
       INTEGER, DIMENSION(jpi,jpj)      ::   ik20, ik28            ! levels
       REAL(wp)                         ::   zavt5 = 5.e-4_wp      ! Kz criterion for the turbocline depth
@@ -103,7 +97,7 @@
 
       ! initialization
-      ztinv  (:,:) = 0.e0_wp  
-      zdepinv(:,:) = 0.e0_wp  
-      zmaxdzT(:,:) = 0.e0_wp  
+      ztinv  (:,:) = 0._wp  
+      zdepinv(:,:) = 0._wp  
+      zmaxdzT(:,:) = 0._wp  
       DO jj = 1, jpj
          DO ji = 1, jpi
@@ -128,6 +122,6 @@
       ! Preliminary computation
       ! computation of zdelr = (dr/dT)(T,S,10m)*(-0.2 degC)
-      DO jj=1, jpj
-         DO ji=1, jpi
+      DO jj = 1, jpj
+         DO ji = 1, jpi
             IF( tmask(ji,jj,nla10) == 1. ) THEN
                zu  =  1779.50 + 11.250*tn(ji,jj,nla10) - 3.80*sn(ji,jj,nla10) - 0.0745*tn(ji,jj,nla10)*tn(ji,jj,nla10)   &
@@ -139,5 +133,5 @@
                zdelr(ji,jj) = ztem2 * (1000.*(zut*zv - zvt*zu)/zw)
             ELSE
-               zdelr(ji,jj) = 0.e0
+               zdelr(ji,jj) = 0._wp
             ENDIF
          END DO
@@ -153,5 +147,5 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-
+               !
                zzdep = fsdepw(ji,jj,jk)
                zztmp = ( tn(ji,jj,jk-1) - tn(ji,jj,jk) ) / zzdep * tmask(ji,jj,jk)   ! vertical gradient of temperature (dT/dz)
@@ -189,7 +183,7 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-
+               !
                zzdep = fsdepw(ji,jj,jk) * tmask(ji,jj,1)
-
+               !
                zztmp = tn(ji,jj,nla10) - tn(ji,jj,jk)                  ! - delta T(10m)
                IF( ABS(zztmp) > ztem2 )      zabs2   (ji,jj) = zzdep   ! abs > 0.2
@@ -203,5 +197,5 @@
                IF( zztmp > zrho3        )    zrho10_3(ji,jj) = zzdep   ! > 0.03
                IF( zztmp > zdelr(ji,jj) )    zpycn   (ji,jj) = zzdep   ! > equi. delta T(10m) - 0.2
-
+               !
             END DO
          END DO
@@ -237,32 +231,27 @@
       DO jj = 1, jpj
          DO ji = 1, jpi
-
-            iif = mbathy(ji,jj)
-            zzdep = fsdepw(ji,jj,iif)
-
+            !
+            zzdep = fsdepw(ji,jj,mbkt(ji,jj)+1)       ! depth of the oean bottom
+            !
             iid = ik20(ji,jj)
             IF( iid /= 1 ) THEN 
-               ! linear interpolation
-               zztmp =      fsdept(ji,jj,iid  )   &
+               zztmp =      fsdept(ji,jj,iid  )   &                     ! linear interpolation
                   &  + (    fsdept(ji,jj,iid+1) - fsdept(ji,jj,iid)                       )   &
                   &  * ( 20.*tmask(ji,jj,iid+1) -     tn(ji,jj,iid)                       )   &
                   &  / (        tn(ji,jj,iid+1) -     tn(ji,jj,iid) + (1.-tmask(ji,jj,1)) )
-               ! bound by the ocean depth, minimum value, first T-point depth
-               hd20(ji,jj) = MIN( zztmp*tmask(ji,jj,1), zzdep)
+               hd20(ji,jj) = MIN( zztmp , zzdep) * tmask(ji,jj,1)       ! bound by the ocean depth
             ELSE 
-               hd20(ji,jj)=0.
+               hd20(ji,jj) = 0._wp
             ENDIF
-
+            !
             iid = ik28(ji,jj)
             IF( iid /= 1 ) THEN 
-               ! linear interpolation
-               zztmp =      fsdept(ji,jj,iid  )   &
+               zztmp =      fsdept(ji,jj,iid  )   &                     ! linear interpolation
                   &  + (    fsdept(ji,jj,iid+1) - fsdept(ji,jj,iid)                       )   &
                   &  * ( 28.*tmask(ji,jj,iid+1) -     tn(ji,jj,iid)                       )   &
                   &  / (        tn(ji,jj,iid+1) -     tn(ji,jj,iid) + (1.-tmask(ji,jj,1)) )
-               ! bound by the ocean depth, minimum value, first T-point depth
-               hd28(ji,jj) = MIN( zztmp*tmask(ji,jj,1), zzdep )
+               hd28(ji,jj) = MIN( zztmp , zzdep ) * tmask(ji,jj,1)      ! bound by the ocean depth
             ELSE 
-               hd28(ji,jj) = 0.
+               hd28(ji,jj) = 0._wp
             ENDIF
 
@@ -277,6 +266,6 @@
 
       ! find ilevel with (ilevel+1) the deepest W-level above 300m (we assume we can use e3t_0 to do this search...)
-      ilevel = 0
-      zthick_0 = 0.e0_wp
+      ilevel   = 0
+      zthick_0 = 0._wp
       DO jk = 1, jpkm1                      
          zthick_0 = zthick_0 + e3t_0(jk)
@@ -284,5 +273,5 @@
       END DO
       ! surface boundary condition
-      IF( lk_vvl ) THEN   ;   zthick(:,:) = 0.e0_wp     ;   htc3(:,:) = 0.e0_wp                                   
+      IF( lk_vvl ) THEN   ;   zthick(:,:) = 0._wp       ;   htc3(:,:) = 0._wp                                   
       ELSE                ;   zthick(:,:) = sshn(:,:)   ;   htc3(:,:) = tn(:,:,jk) * sshn(:,:) * tmask(:,:,jk)   
       ENDIF
@@ -303,6 +292,5 @@
       htc3(:,:) = zcoef * htc3(:,:)
       CALL iom_put( "hc300", htc3 )      ! first 300m heat content
-
-
+      !
    END SUBROUTINE dia_hth
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DIA/dianam.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DIA/dianam.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DIA/dianam.F90	(revision 2528)
@@ -23,7 +23,7 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90	(revision 2528)
@@ -6,5 +6,6 @@
    !! History :  1.0  ! 2003-09  (C. Talandier, G. Madec)  Original code
    !!            2.0  ! 2006-01  (A. Biastoch)  Allow sub-basins computation
-   !!            3.2  ! 2003-03  (O. Marti, S. Flavoni) Add fields
+   !!            3.2  ! 2010-03  (O. Marti, S. Flavoni) Add fields
+   !!            3.3  ! 2010-10  (G. Madec)  dynamical allocation
    !!----------------------------------------------------------------------
 
@@ -15,17 +16,17 @@
    !!   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: ptr_vj_3d, ptr_vj_2d
+   !!   ptr_vj       : "zonal" and vertical sum computation of a "meridional" flux array
+   !!                   (Generic interface to ptr_vj_3d, ptr_vj_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
-   USE ioipsl         
-   USE in_out_manager
-   USE lib_mpp
-   USE lbclnk
+   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
 
    IMPLICIT NONE
@@ -46,63 +47,37 @@
    LOGICAL , PUBLIC ::   ln_diaznl  = .FALSE.   !: Add zonal means and meridional stream functions
    LOGICAL , PUBLIC ::   ln_ptrcomp = .FALSE.   !: Add decomposition : overturning (and gyre, soon ...)
-   INTEGER , PUBLIC ::   nf_ptr     = 15        !: frequency of ptr computation
-   INTEGER , PUBLIC ::   nf_ptr_wri = 15        !: frequency of ptr outputs
-
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   abasin, pbasin, ibasin, dbasin, sbasin   !: Sub basin masks
-
-   !                                                               !!! poleward heat and salt transport
-   REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_adv    , pst_adv       !: advection
-   REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_ldf    , pst_ldf       !: lateral diffusion
-   REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_ove_glo, pst_ove_glo   !: global       overturning
-   REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_ove_atl, pst_ove_atl   !: Atlantic     overturning
-   REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_ove_pac, pst_ove_pac   !: Pacific      overturning
-   REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_ove_ind, pst_ove_ind   !: Indian       overturning
-   REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_ove_ipc, pst_ove_ipc   !: Indo-Pacific overturning
-   REAL(wp), PUBLIC, DIMENSION(jpj) ::   ht_glo, ht_atl, ht_ind, ht_pac, ht_ipc   !: heat
-   REAL(wp), PUBLIC, DIMENSION(jpj) ::   st_glo, st_atl, st_ind, st_pac, st_ipc   !: salt
-
-   INTEGER ::   niter
-   INTEGER ::   nidom_ptr
-   INTEGER ::   numptr                                              !: logical unit for Poleward TRansports
-
-   REAL(wp), DIMENSION(jpj,jpk) ::   tn_jk_glo  , sn_jk_glo       ! global       i-mean temperature and salinity
-   REAL(wp), DIMENSION(jpj,jpk) ::   tn_jk_atl  , sn_jk_atl       ! Atlantic               -              -
-   REAL(wp), DIMENSION(jpj,jpk) ::   tn_jk_pac  , sn_jk_pac       ! Pacific                -              -
-   REAL(wp), DIMENSION(jpj,jpk) ::   tn_jk_ind  , sn_jk_ind       ! Indian                 -              -
-   REAL(wp), DIMENSION(jpj,jpk) ::   tn_jk_ipc  , sn_jk_ipc       ! Indo-Pacific           -              -
-   REAL(wp), DIMENSION(jpj,jpk) ::   v_msf_glo                    ! global       "meridional" Stream-Function
-   REAL(wp), DIMENSION(jpj,jpk) ::   v_msf_atl                    ! Atlantic               -              -
-   REAL(wp), DIMENSION(jpj,jpk) ::   v_msf_pac                    ! Pacific                -              -
-   REAL(wp), DIMENSION(jpj,jpk) ::   v_msf_ind                    ! Indian                 -              -
-   REAL(wp), DIMENSION(jpj,jpk) ::   v_msf_ipc                    ! Indo-Pacific           -              -
-   REAL(wp), DIMENSION(jpj,jpk) ::   surf_jk_glo, surf_jk_r_glo   ! surface of global       i-section and its inverse
-   REAL(wp), DIMENSION(jpj,jpk) ::   surf_jk_atl, surf_jk_r_atl   ! surface of Atlantic          -              -
-   REAL(wp), DIMENSION(jpj,jpk) ::   surf_jk_pac, surf_jk_r_pac   ! surface of Pacific           -              -
-   REAL(wp), DIMENSION(jpj,jpk) ::   surf_jk_ind, surf_jk_r_ind   ! surface of Indian            -              -
-   REAL(wp), DIMENSION(jpj,jpk) ::   surf_jk_ipc, surf_jk_r_ipc   ! surface of Indo-Pacific      -              -
-#if defined key_diaeiv
-   !                                                               !!! eddy induced velocity (bolus)
-   REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_eiv_glo, pst_eiv_glo   !: global       poleward heat and salt bolus advection
-   REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_eiv_atl, pst_eiv_atl   !: Atlantic         -                           -
-   REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_eiv_pac, pst_eiv_pac   !: Pacific          -                           -
-   REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_eiv_ind, pst_eiv_ind   !: Indian           -                           -
-   REAL(wp), PUBLIC, DIMENSION(jpj) ::   pht_eiv_ipc, pst_eiv_ipc   !: Indo-Pacific     -                           -
-
-   REAL(wp), DIMENSION(jpj,jpk) ::   v_msf_eiv_glo   ! global       "meridional" bolus Stream-Function
-   REAL(wp), DIMENSION(jpj,jpk) ::   v_msf_eiv_atl   ! Atlantic          -                   -
-   REAL(wp), DIMENSION(jpj,jpk) ::   v_msf_eiv_pac   ! Pacific           -                   -
-   REAL(wp), DIMENSION(jpj,jpk) ::   v_msf_eiv_ind   ! Indian            -                   -
-   REAL(wp), DIMENSION(jpj,jpk) ::   v_msf_eiv_ipc   ! Indo-Pacific      -                   -
-#endif
- 
+   INTEGER , PUBLIC ::   nn_fptr    = 15        !: frequency of ptr computation  [time step]
+   INTEGER , PUBLIC ::   nn_fwri    = 15        !: frequency of ptr outputs      [time step]
+
+   REAL(wp), PUBLIC, DIMENSION(:), ALLOCATABLE ::   htr_adv, htr_ldf, htr_ove   !: Heat TRansports (adv, diff, overturn.)
+   REAL(wp), PUBLIC, DIMENSION(:), ALLOCATABLE ::   str_adv, str_ldf, str_ove   !: Salt TRansports (adv, diff, overturn.)
+   
+   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   btmsk                  ! T-point basin interior masks
+   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   btm30                  ! mask out Southern Ocean (=0 south of 30°S)
+   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   htr  , str             ! adv heat and salt transports (approx)
+   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   tn_jk, sn_jk , v_msf   ! i-mean T and S, j-Stream-Function
+   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   sjk  , r1_sjk          ! i-mean i-k-surface and its inverse        
+#if defined key_diaeiv
+   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   htr_eiv, str_eiv   ! bolus adv heat ans salt transports    ('key_diaeiv')
+   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   v_msf_eiv          ! bolus j-streamfuction                 ('key_diaeiv')
+#endif
+
+   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) 
+
+   REAL(wp) ::   rc_sv    = 1.e-6_wp   ! conversion from m3/s to Sverdrup
+   REAL(wp) ::   rc_pwatt = 1.e-15_wp  ! conversion from W    to PW (further x rau0 x Cp)
+   REAL(wp) ::   rc_ggram = 1.e-6_wp   ! conversion from g    to Pg
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -111,6 +86,5 @@
       !!                    ***  ROUTINE ptr_vj_3d  ***
       !!
-      !! ** Purpose :   "zonal" and vertical sum computation of a "meridional"
-      !!              flux array
+      !! ** Purpose :   i-k sum computation of a j-flux array
       !!
       !! ** Method  : - i-k sum of pva using the interior 2D vmask (vmask_i).
@@ -127,5 +101,5 @@
       !
       ijpj = jpj
-      p_fval(:) = 0.e0
+      p_fval(:) = 0._wp
       DO jk = 1, jpkm1
          DO jj = 2, jpjm1
@@ -137,5 +111,5 @@
       !
 #if defined key_mpp_mpi
-      CALL mpp_sum( p_fval, ijpj, ncomm_znl)     !!bug  I presume
+      CALL mpp_sum( p_fval, ijpj, ncomm_znl)
 #endif
       !
@@ -147,6 +121,5 @@
       !!                    ***  ROUTINE ptr_vj_2d  ***
       !!
-      !! ** Purpose :   "zonal" and vertical sum computation of a "meridional"
-      !!      flux array
+      !! ** Purpose :   "zonal" and vertical sum computation of a i-flux array
       !!
       !! ** Method  : - i-k sum of pva using the interior 2D vmask (vmask_i).
@@ -163,5 +136,5 @@
       ! 
       ijpj = jpj
-      p_fval(:) = 0.e0
+      p_fval(:) = 0._wp
       DO jj = 2, jpjm1
          DO ji = nldi, nlei   ! No vector optimisation here. Better use a mask ?
@@ -171,5 +144,5 @@
       !
 #if defined key_mpp_mpi
-      CALL mpp_sum( p_fval, ijpj, ncomm_znl )     !!bug  I presume
+      CALL mpp_sum( p_fval, ijpj, ncomm_znl )
 #endif
       ! 
@@ -177,17 +150,17 @@
 
 
-   FUNCTION ptr_vjk( pva, bmask )   RESULT ( p_fval )
+   FUNCTION ptr_vjk( pva, pmsk )   RESULT ( p_fval )
       !!----------------------------------------------------------------------
       !!                    ***  ROUTINE ptr_vjk  ***
       !!
-      !! ** Purpose :   "zonal" sum computation of a "meridional" flux array
+      !! ** 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*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 ::   bmask   ! Optional 2D basin mask
+      !!              pva is supposed to be a masked flux (i.e. * vmask)
+      !!
+      !! ** Action  : - p_fval: i-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
@@ -200,13 +173,12 @@
       !!--------------------------------------------------------------------
       !
-      p_fval(:,:) = 0.e0
-      !
-      IF( PRESENT( bmask ) ) THEN 
+      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)   &
-                     &                                          * tmask_i(ji,jj) * bmask(ji,jj)
+                  p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk) * pmsk(ji,jj)
                END DO
             END DO
@@ -216,6 +188,5 @@
             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)
+                  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
@@ -233,18 +204,16 @@
 
 
-   FUNCTION ptr_tjk( pta, bmask )   RESULT ( p_fval )
+   FUNCTION ptr_tjk( pta, pmsk )   RESULT ( p_fval )
       !!----------------------------------------------------------------------
       !!                    ***  ROUTINE ptr_tjk  ***
       !!
-      !! ** Purpose :   "zonal" mean computation of a tracer field
+      !! ** Purpose :   i-sum computation of e1t*e3t * a tracer field
       !!
       !! ** Method  : - i-sum of mj(pta) using tmask
-      !!      multiplied by the inverse of the surface of the "zonal" ocean
-      !!      section
-      !!
-      !! ** Action  : - p_fval: i-k-mean poleward flux of pta
+      !!
+      !! ** 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), OPTIONAL :: bmask ! Optional 2D basin mask
+      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj)     ::   pmsk   ! Optional 2D basin mask
       !!
       INTEGER                     ::   ji, jj, jk   ! dummy loop arguments
@@ -257,33 +226,17 @@
       !!-------------------------------------------------------------------- 
       !
-      p_fval(:,:) = 0.e0
-      IF (PRESENT (bmask)) THEN 
-         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)   &
-                     &                          * tmask_i(ji,jj)                 &
-                     &                          * bmask(ji,jj)
-               END DO
+      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
-      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)                  &
-                     &                          * e1t(ji,jj) * fse3t(ji,jj,jk)   &
-                     &                          * tmask_i(ji,jj)
-               END DO
-            END DO
-         END DO
-      END IF
-      p_fval(:,:) = p_fval(:,:) * 0.5
+      END DO
 #if defined key_mpp_mpi
       ish(1) = jpj*jpk   ;   ish2(1) = jpj   ;   ish2(2) = jpk
       zwork(:)= RESHAPE( p_fval, ish )
       CALL mpp_sum( zwork, jpj*jpk, ncomm_znl )
-      p_fval(:,:)= RESHAPE(zwork,ish2)
+      p_fval(:,:)= RESHAPE( zwork, ish2 )
 #endif
       !
@@ -295,195 +248,94 @@
       !!                  ***  ROUTINE dia_ptr  ***
       !!----------------------------------------------------------------------
+      USE oce,     vt  =>   ua   ! use ua as workspace
+      USE oce,     vs  =>   ua   ! use ua as workspace
+      !!
       INTEGER, INTENT(in) ::   kt   ! ocean time step index
-      !!
-      INTEGER  ::   jk, jj, ji   ! dummy loop
-      REAL(wp) ::   zsverdrup    ! conversion from m3/s to Sverdrup
-      REAL(wp) ::   zpwatt       ! conversion from W    to PW
-      REAL(wp) ::   zggram       ! conversion from g    to Pg
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   vt, vs   ! 3D workspace
-      !!----------------------------------------------------------------------
-
-      IF( kt == nit000 .OR. MOD( kt, nf_ptr ) == 0 )   THEN
-
-         IF ( MOD( kt, nf_ptr ) == 0 ) THEN 
-
-            zsverdrup = 1.e-6
-            zpwatt    = 1.e-15
-            zggram    = 1.e-6
-
-            IF ( ln_diaznl ) THEN
-               ! "zonal" mean temperature and salinity at V-points
-               tn_jk_glo(:,:) = ptr_tjk( tn(:,:,:) ) * surf_jk_r_glo(:,:)
-               sn_jk_glo(:,:) = ptr_tjk( sn(:,:,:) ) * surf_jk_r_glo(:,:)
-
-               IF (ln_subbas) THEN 
-                  tn_jk_atl(:,:) = ptr_tjk( tn(:,:,:), abasin(:,:) ) * surf_jk_r_atl(:,:)
-                  sn_jk_atl(:,:) = ptr_tjk( sn(:,:,:), abasin(:,:) ) * surf_jk_r_atl(:,:)
-                  tn_jk_pac(:,:) = ptr_tjk( tn(:,:,:), pbasin(:,:) ) * surf_jk_r_pac(:,:)
-                  sn_jk_pac(:,:) = ptr_tjk( sn(:,:,:), pbasin(:,:) ) * surf_jk_r_pac(:,:)
-                  tn_jk_ind(:,:) = ptr_tjk( tn(:,:,:), ibasin(:,:) ) * surf_jk_r_ind(:,:)
-                  sn_jk_ind(:,:) = ptr_tjk( sn(:,:,:), ibasin(:,:) ) * surf_jk_r_ind(:,:)
-                  tn_jk_ipc(:,:) = ptr_tjk( tn(:,:,:), dbasin(:,:) ) * surf_jk_r_ipc(:,:)
-                  sn_jk_ipc(:,:) = ptr_tjk( sn(:,:,:), dbasin(:,:) ) * surf_jk_r_ipc(:,:)
-               ENDIF
-            ENDIF
-
-            !--------------------------------------------------------
-            ! overturning calculation:
-
-            ! horizontal integral and vertical dz 
-
-#if defined key_diaeiv
-            v_msf_glo(:,:) = ptr_vjk( vn(:,:,:)+v_eiv(:,:,:) ) 
-            IF( ln_subbas .AND. ln_diaznl ) THEN
-               v_msf_atl(:,:) = ptr_vjk( vn(:,:,:)+v_eiv(:,:,:), abasin(:,:)*sbasin(:,:) ) 
-               v_msf_pac(:,:) = ptr_vjk( vn(:,:,:)+v_eiv(:,:,:), pbasin(:,:)*sbasin(:,:) ) 
-               v_msf_ind(:,:) = ptr_vjk( vn(:,:,:)+v_eiv(:,:,:), ibasin(:,:)*sbasin(:,:) ) 
-               v_msf_ipc(:,:) = ptr_vjk( vn(:,:,:)+v_eiv(:,:,:), dbasin(:,:)*sbasin(:,:) ) 
-            ENDIF
-#else
-            v_msf_glo(:,:) = ptr_vjk( vn(:,:,:) ) 
-            IF( ln_subbas .AND. ln_diaznl ) THEN
-               v_msf_atl(:,:) = ptr_vjk( vn(:,:,:), abasin(:,:)*sbasin(:,:) ) 
-               v_msf_pac(:,:) = ptr_vjk( vn(:,:,:), pbasin(:,:)*sbasin(:,:) ) 
-               v_msf_ind(:,:) = ptr_vjk( vn(:,:,:), ibasin(:,:)*sbasin(:,:) ) 
-               v_msf_ipc(:,:) = ptr_vjk( vn(:,:,:), dbasin(:,:)*sbasin(:,:) ) 
-            ENDIF
-#endif
-
-#if defined key_diaeiv
-            v_msf_eiv_glo(:,:) = ptr_vjk( v_eiv(:,:,:) )
-            IF (ln_subbas ) THEN 
-               v_msf_eiv_atl(:,:) = ptr_vjk( v_eiv(:,:,:), abasin(:,:)*sbasin(:,:) )
-               v_msf_eiv_pac(:,:) = ptr_vjk( v_eiv(:,:,:), pbasin(:,:)*sbasin(:,:) )
-               v_msf_eiv_ind(:,:) = ptr_vjk( v_eiv(:,:,:), ibasin(:,:)*sbasin(:,:) )
-               v_msf_eiv_ipc(:,:) = ptr_vjk( v_eiv(:,:,:), dbasin(:,:)*sbasin(:,:) )
-            END IF
-#endif
-
-            ! Transports
-            ! T times V on T points (include bolus velocities)
-#if defined key_diaeiv 
-            DO jj = 2, jpj
-               DO ji = 1, jpi
-                  vt(ji,jj,:) = tn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) + u_eiv(ji,jj,:) + u_eiv(ji,jj-1,:) )*0.5
-                  vs(ji,jj,:) = sn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) + v_eiv(ji,jj,:) + v_eiv(ji,jj-1,:) )*0.5
-               END DO
-            END DO
-#else
-            DO jj = 2, jpj
-               DO ji = 1, jpi
-                  vt(ji,jj,:) = tn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) )*0.5
-                  vs(ji,jj,:) = sn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) )*0.5
-               END DO
-            END DO
-#endif 
-            CALL lbc_lnk( vs, 'V', -1. )   ;   CALL lbc_lnk( vt, 'V', -1. )
-
-            ht_glo(:) = SUM( ptr_vjk( vt(:,:,:)), 2 )
-            st_glo(:) = SUM( ptr_vjk( vs(:,:,:)), 2 )
-
-            IF ( ln_subbas ) THEN 
-               ht_atl(:) = SUM( ptr_vjk( vt (:,:,:), abasin(:,:)*sbasin(:,:)), 2 )
-               ht_pac(:) = SUM( ptr_vjk( vt (:,:,:), pbasin(:,:)*sbasin(:,:)), 2 )
-               ht_ind(:) = SUM( ptr_vjk( vt (:,:,:), ibasin(:,:)*sbasin(:,:)), 2 )
-               ht_ipc(:) = SUM( ptr_vjk( vt (:,:,:), dbasin(:,:)*sbasin(:,:)), 2 )
-               st_atl(:) = SUM( ptr_vjk( vs (:,:,:), abasin(:,:)*sbasin(:,:)), 2 )
-               st_pac(:) = SUM( ptr_vjk( vs (:,:,:), pbasin(:,:)*sbasin(:,:)), 2 )
-               st_ind(:) = SUM( ptr_vjk( vs (:,:,:), ibasin(:,:)*sbasin(:,:)), 2 )
-               st_ipc(:) = SUM( ptr_vjk( vs (:,:,:), dbasin(:,:)*sbasin(:,:)), 2 )
-            ENDIF
-
-            ! poleward tracer transports: 
-            ! overturning components:
-            IF ( ln_ptrcomp ) THEN 
-               pht_ove_glo(:) = SUM( v_msf_glo(:,:) * tn_jk_glo(:,:), 2 )   ! SUM over jk
-               pst_ove_glo(:) = SUM( v_msf_glo(:,:) * sn_jk_glo(:,:), 2 )  
-               IF ( ln_subbas ) THEN 
-                  pht_ove_atl(:) = SUM( v_msf_atl(:,:) * tn_jk_atl(:,:), 2 )   ! SUM over jk
-                  pst_ove_atl(:) = SUM( v_msf_atl(:,:) * sn_jk_atl(:,:), 2 )  
-                  pht_ove_pac(:) = SUM( v_msf_pac(:,:) * tn_jk_pac(:,:), 2 )   ! SUM over jk
-                  pst_ove_pac(:) = SUM( v_msf_pac(:,:) * sn_jk_pac(:,:), 2 )  
-                  pht_ove_ind(:) = SUM( v_msf_ind(:,:) * tn_jk_ind(:,:), 2 )   ! SUM over jk
-                  pst_ove_ind(:) = SUM( v_msf_ind(:,:) * sn_jk_ind(:,:), 2 )  
-                  pht_ove_ipc(:) = SUM( v_msf_ipc(:,:) * tn_jk_ipc(:,:), 2 )   ! SUM over jk
-                  pst_ove_ipc(:) = SUM( v_msf_ipc(:,:) * sn_jk_ipc(:,:), 2 )  
-               END IF
-            END IF
-
-            ! Bolus component
-#if defined key_diaeiv
-            pht_eiv_glo(:) = SUM( v_msf_eiv_glo(:,:) * tn_jk_glo(:,:), 2 )   ! SUM over jk
-            pst_eiv_glo(:) = SUM( v_msf_eiv_glo(:,:) * sn_jk_glo(:,:), 2 )   ! SUM over jk
-            IF ( ln_subbas ) THEN 
-               pht_eiv_atl(:) = SUM( v_msf_eiv_glo(:,:) * tn_jk_atl(:,:), 2 )   ! SUM over jk
-               pst_eiv_atl(:) = SUM( v_msf_eiv_glo(:,:) * sn_jk_atl(:,:), 2 )   ! SUM over jk
-               pht_eiv_pac(:) = SUM( v_msf_eiv_pac(:,:) * tn_jk_pac(:,:), 2 )   ! SUM over jk
-               pst_eiv_pac(:) = SUM( v_msf_eiv_pac(:,:) * sn_jk_pac(:,:), 2 )   ! SUM over jk
-               pht_eiv_ind(:) = SUM( v_msf_eiv_ind(:,:) * tn_jk_ind(:,:), 2 )   ! SUM over jk
-               pst_eiv_ind(:) = SUM( v_msf_eiv_ind(:,:) * sn_jk_ind(:,:), 2 )   ! SUM over jk
-               pht_eiv_ipc(:) = SUM( v_msf_eiv_ipc(:,:) * tn_jk_ipc(:,:), 2 )   ! SUM over jk
-               pst_eiv_ipc(:) = SUM( v_msf_eiv_ipc(:,:) * sn_jk_ipc(:,:), 2 )   ! SUM over jk
-            ENDIF
-#endif
-
-            ! conversion in PW and G g
-            zpwatt = zpwatt * rau0 * rcp
-            pht_adv(:) = pht_adv(:) * zpwatt  
-            pht_ldf(:) = pht_ldf(:) * zpwatt
-            pst_adv(:) = pst_adv(:) * zggram
-            pst_ldf(:) = pst_ldf(:) * zggram
-            IF ( ln_ptrcomp ) THEN 
-               pht_ove_glo(:) = pht_ove_glo(:) * zpwatt
-               pst_ove_glo(:) = pst_ove_glo(:) * zggram
-            END IF
-#if defined key_diaeiv
-            pht_eiv_glo(:) = pht_eiv_glo(:) * zpwatt
-            pst_eiv_glo(:) = pst_eiv_glo(:) * zggram
-#endif
-            IF( ln_subbas ) THEN
-               ht_atl(:) = ht_atl(:) * zpwatt
-               ht_pac(:) = ht_pac(:) * zpwatt
-               ht_ind(:) = ht_ind(:) * zpwatt
-               ht_ipc(:) = ht_ipc(:) * zpwatt
-               st_atl(:) = st_atl(:) * zggram 
-               st_pac(:) = st_pac(:) * zggram
-               st_ind(:) = st_ind(:) * zggram
-               st_ipc(:) = st_ipc(:) * zggram
-            ENDIF
-
-            ! "Meridional" Stream-Function
-            DO jk = 2,jpk 
-               v_msf_glo(:,jk) = v_msf_glo(:,jk-1) + v_msf_glo(:,jk)
-            END DO
-            v_msf_glo(:,:) = v_msf_glo(:,:) * zsverdrup
-#if defined key_diaeiv
-            ! Bolus "Meridional" Stream-Function
-            DO jk = 2,jpk
-               v_msf_eiv_glo(:,jk) = v_msf_eiv_glo(:,jk-1) + v_msf_eiv_glo(:,jk)
-            END DO
-            v_msf_eiv_glo(:,:) = v_msf_eiv_glo(:,:) * zsverdrup
-            IF ( ln_subbas ) THEN 
-               DO jk = 2,jpk
-                  v_msf_eiv_atl(:,jk) = v_msf_eiv_atl(:,jk-1) + v_msf_eiv_atl(:,jk)
-                  v_msf_eiv_pac(:,jk) = v_msf_eiv_pac(:,jk-1) + v_msf_eiv_pac(:,jk)
-                  v_msf_eiv_ind(:,jk) = v_msf_eiv_ind(:,jk-1) + v_msf_eiv_ind(:,jk)
-                  v_msf_eiv_ipc(:,jk) = v_msf_eiv_ipc(:,jk-1) + v_msf_eiv_ipc(:,jk)
+      !
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::   zv               ! local scalar
+      !!----------------------------------------------------------------------
+      !
+      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( tn(:,:,:), btmsk(:,:,jn) ) * r1_sjk(:,:,jn)
                END DO
             ENDIF
-#endif
             !
-            IF( ln_subbas .AND. ln_diaznl ) THEN
-               DO jk = 2,jpk 
-                  v_msf_atl(:,jk) = v_msf_atl(:,jk-1) + v_msf_atl(:,jk)
-                  v_msf_pac(:,jk) = v_msf_pac(:,jk-1) + v_msf_pac(:,jk)
-                  v_msf_ind(:,jk) = v_msf_ind(:,jk-1) + v_msf_ind(:,jk)
-                  v_msf_ipc(:,jk) = v_msf_ipc(:,jk-1) + v_msf_ipc(:,jk)
+            !                          ! 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  ( tn*mj[vn+v_eiv] )
+            vt(:,:,jpk) = 0._wp   ;   vs(:,:,jpk) = 0._wp
+            DO jk= 1, jpkm1
+               DO jj = 2, jpj
+                  DO ji = 1, jpi
+#if defined key_diaeiv 
+                     zv = ( vn(ji,jj,jk) + vn(ji,jj-1,jk) + u_eiv(ji,jj,jk) + u_eiv(ji,jj-1,jk) ) * 0.5_wp
+#else
+                     zv = ( vn(ji,jj,jk) + vn(ji,jj-1,jk) ) * 0.5_wp
+#endif 
+                     vt(:,jj,jk) = zv * tn(:,jj,jk)
+                     vs(:,jj,jk) = zv * sn(:,jj,jk)
+                  END DO
                END DO
-               v_msf_atl(:,:) = v_msf_atl(:,:) * zsverdrup
-               v_msf_pac(:,:) = v_msf_pac(:,:) * zsverdrup
-               v_msf_ind(:,:) = v_msf_ind(:,:) * zsverdrup
-               v_msf_ipc(:,:) = v_msf_ipc(:,:) * zsverdrup
-            ENDIF
+            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
+            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
          !
@@ -503,71 +355,87 @@
       !! ** Purpose :   Initialization, namelist read
       !!----------------------------------------------------------------------
-      INTEGER ::   inum       ! temporary logical unit
+      INTEGER ::   jn           ! dummy loop indices 
+      INTEGER ::   inum, ierr   ! local integers
 #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, nf_ptr, nf_ptr_wri
-      !!----------------------------------------------------------------------
-
-      REWIND ( numnam )              ! Read Namelist namptr : poleward transport parameters
-      READ   ( numnam, namptr )
-
-      IF(lwp) THEN                   ! Control print
+      NAMELIST/namptr/ ln_diaptr, ln_diaznl, ln_subbas, ln_ptrcomp, nn_fptr, nn_fwri
+      !!----------------------------------------------------------------------
+
+      REWIND( numnam )                 ! Read Namelist namptr : poleward transport parameters
+      READ  ( numnam, namptr )
+
+      IF(lwp) THEN                     ! Control print
          WRITE(numout,*)
          WRITE(numout,*) 'dia_ptr_init : poleward transport and msf initialization'
          WRITE(numout,*) '~~~~~~~~~~~~'
          WRITE(numout,*) '   Namelist namptr : set ptr parameters'
-         WRITE(numout,*) '      Switch for ptr diagnostic (T) or not (F)  ln_diaptr  = ', ln_diaptr
-         WRITE(numout,*) '      Atl/Pac/Ind basins computation            ln_subbas  = ', ln_subbas
-         WRITE(numout,*) '      Frequency of computation                  nf_ptr     = ', nf_ptr
-         WRITE(numout,*) '      Frequency of outputs                      nf_ptr_wri = ', nf_ptr_wri
+         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( .NOT. ln_diaptr )   RETURN
-      
-      IF( lk_mpp )   CALL mpp_ini_znl      ! Define MPI communicator for zonal sum
-
-      IF( ln_subbas ) THEN                 ! load sub-basin mask
-         CALL iom_open( 'subbasins', inum )
-         CALL iom_get( inum, jpdom_data, 'atlmsk', abasin )      ! Atlantic basin
-         CALL iom_get( inum, jpdom_data, 'pacmsk', pbasin )      ! Pacific basin
-         CALL iom_get( inum, jpdom_data, 'indmsk', ibasin )      ! Indian basin
-         CALL iom_close( inum )
-         dbasin(:,:) = MAX ( pbasin(:,:), ibasin(:,:) )
-         sbasin(:,:) = tmask (:,:,1)
-         WHERE ( gphit (:,:) < -30.e0) sbasin(:,:) = 0.e0
+      IF( ln_subbas ) THEN   ;   nptr = 5       ! Global, Atlantic, Pacific, Indian, Indo-Pacific
+      ELSE                   ;   nptr = 1       ! Global only
+      ENDIF
+
+      rc_pwatt = rc_pwatt * rau0 * rcp          ! conversion from K.s-1 to PetaWatt
+
+      IF( .NOT. ln_diaptr ) THEN       ! diaptr not used
+        RETURN
+      ELSE                             ! Allocate the diaptr arrays
+         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  )
+         !
+         IF( ierr > 0 ) THEN
+            CALL ctl_stop( 'dia_ptr_init : unable to allocate standard arrays' )   ;   RETURN
+         ENDIF
+#if defined key_diaeiv
+!!       IF( lk_diaeiv )   &              ! eddy induced velocity arrays
+            ALLOCATE( htr_eiv(jpj,nptr) , str_eiv(jpj,nptr) , v_msf_eiv(jpj,jpk,nptr) , STAT=ierr )
+         !
+         IF( ierr > 0 ) THEN
+            CALL ctl_stop( 'dia_ptr_init : unable to allocate eiv arrays' )   ;   RETURN
+         ENDIF
+#endif
       ENDIF
       
-!!gm CAUTION : this is only valid in fixed volume case !
-
-      ! inverse of the ocean "zonal" v-point section
-      surf_jk_glo(:,:) = ptr_tjk( tmask(:,:,:) )
-      surf_jk_r_glo(:,:) = 0.e0
-      WHERE( surf_jk_glo(:,:) /= 0.e0 )   surf_jk_r_glo(:,:) = 1.e0 / surf_jk_glo(:,:)
+      IF( lk_mpp )   CALL mpp_ini_znl     ! Define MPI communicator for zonal sum
+
+      IF( ln_subbas ) THEN                ! load sub-basin mask
+         CALL iom_open( 'subbasins', inum )
+         CALL iom_get( inum, jpdom_data, 'atlmsk', btmsk(:,:,2) )   ! Atlantic basin
+         CALL iom_get( inum, jpdom_data, 'pacmsk', btmsk(:,:,3) )   ! Pacific  basin
+         CALL iom_get( inum, jpdom_data, 'indmsk', btmsk(:,:,4) )   ! Indian   basin
+         CALL iom_close( inum )
+         btmsk(:,:,5) = MAX ( btmsk(:,:,3), btmsk(:,:,4) )          ! Indo-Pacific basin
+         WHERE( gphit(:,:) < -30._wp)   ;   btm30(:,:) = 0._wp      ! mask out Southern Ocean
+         ELSE WHERE                     ;   btm30(:,:) = tmask(:,:,1)
+         END WHERE
+      ENDIF
+      btmsk(:,:,1) = tmask_i(:,:)                                   ! global ocean
       
-      IF (ln_subbas) THEN
-         surf_jk_atl(:,:) = ptr_tjk( tmask (:,:,:), abasin(:,:) )
-         surf_jk_r_atl(:,:) = 0.e0
-         WHERE( surf_jk_atl(:,:) /= 0.e0 )   surf_jk_r_atl(:,:) = 1.e0 / surf_jk_atl(:,:)
-         !
-         surf_jk_pac(:,:) = ptr_tjk( tmask (:,:,:), pbasin(:,:) )
-         surf_jk_r_pac(:,:) = 0.e0
-         WHERE( surf_jk_pac(:,:) /= 0.e0 )   surf_jk_r_pac(:,:) = 1.e0 / surf_jk_pac(:,:)
-         ! 
-         surf_jk_ind(:,:) = ptr_tjk( tmask (:,:,:), ibasin(:,:) )
-         surf_jk_r_ind(:,:) = 0.e0
-         WHERE( surf_jk_ind(:,:) /= 0.e0 )   surf_jk_r_ind(:,:) = 1.e0 / surf_jk_ind(:,:)
-         !
-         surf_jk_ipc(:,:) = ptr_tjk( tmask (:,:,:), dbasin(:,:) )
-         surf_jk_r_ipc(:,:) = 0.e0
-         WHERE( surf_jk_ipc(:,:) /= 0.e0 )   surf_jk_r_ipc(:,:) = 1.e0 / surf_jk_ipc(:,:)
-      END IF
-
+      DO jn = 1, nptr
+         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
 
 #if defined key_mpp_mpi 
-      iglo (1) = jpjglo
+      iglo (1) = jpjglo                   ! MPP case using MPI  ('key_mpp_mpi')
       iloc (1) = nlcj
       iabsf(1) = njmppt(narea)
@@ -576,14 +444,5 @@
       ihale(1) = nlcj - nlej
       idid (1) = 2
-
-!-$$      IF(lwp) THEN
-!-$$          WRITE(numout,*)
-!-$$          WRITE(numout,*) 'dia_ptr_init :   iloc  = ', iloc 
-!-$$          WRITE(numout,*) '~~~~~~~~~~~~     iabsf = ', iabsf
-!-$$          WRITE(numout,*) '                 ihals = ', ihals
-!-$$          WRITE(numout,*) '                 ihale = ', ihale
-!-$$      ENDIF 
-
-      CALL flio_dom_set ( jpnj, nproc/jpni, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom_ptr)
+      CALL flio_dom_set( jpnj, nproc/jpni, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom_ptr )
 #else
       nidom_ptr = FLIO_DOM_NONE
@@ -610,5 +469,5 @@
       INTEGER, SAVE, DIMENSION (jpj*jpk) ::         ndex_atl_30  , ndex_pac_30  , ndex_ind_30  , ndex_ipc_30
       INTEGER, SAVE, DIMENSION (jpj)     :: ndex_h, ndex_h_atl_30, ndex_h_pac_30, ndex_h_ind_30, ndex_h_ipc_30
-
+      !!
       CHARACTER (len=40)       ::   clhstnam, clop, clop_once, cl_comment   ! temporary names
       INTEGER                  ::   iline, it, itmod, ji, jj, jk            !
@@ -622,34 +481,25 @@
 
       ! define time axis
-      it    = kt / nf_ptr
+      it    = kt / nn_fptr
       itmod = kt - nit000 + 1
       
-!-$$      IF(lwp) THEN
-!-$$         WRITE(numout,*)
-!-$$         WRITE(numout,*) 'dia_ptr_wri : kt = ', kt, 'it = ', it, ' itmod = ', itmod, ' niter = ', niter
-!-$$         WRITE(numout,*) '~~~~~~~~~~~~'
-!-$$      ENDIF
-
       ! Initialization
       ! --------------
       IF( kt == nit000 ) THEN
-
-         niter = (nit000 - 1) / nf_ptr
-
-!-$$         IF(lwp) THEN
-!-$$            WRITE(numout,*)
-!-$$            WRITE(numout,*) 'dia_ptr_wri : poleward transport and msf writing: initialization , niter = ', niter
-!-$$            WRITE(numout,*) '~~~~~~~~~~~~'
-!-$$         ENDIF
-
+         niter = ( nit000 - 1 ) / nn_fptr
          zdt = rdt
          IF( nacc == 1 )   zdt = rdtmin
-
-         ! Reference latitude
+         !
+         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
@@ -657,5 +507,5 @@
             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(:) = 0.e0
+            zphi(:) = 0._wp
             DO ji = mi0(iline), mi1(iline) 
                zphi(:) = gphiv(ji,:)         ! if iline is in the local domain
@@ -663,14 +513,14 @@
                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)))/2.
-                     zphi( jj ) = MIN( zphi(jj), 90.)
+                     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.5e0
+                     zphi( jj ) = 88.5_wp
                   END DO
                   DO jj = mj0(jpjdta  ), mj1(jpjdta  ) 
-                     zphi( jj ) = 89.5e0
+                     zphi( jj ) = 89.5_wp
                   END DO
                END IF
@@ -680,5 +530,4 @@
             CALL mpp_sum( zphi, jpj, ncomm_znl )        
 #endif
-
             !                                        ! =======================
          ELSE                                        !   OTHER configurations 
@@ -690,5 +539,5 @@
          ! Work only on westmost processor (will not work if mppini2 is used)
 #if defined key_mpp_mpi
-         IF ( l_znl_root ) THEN 
+         IF( l_znl_root ) THEN 
 #endif
             !
@@ -696,5 +545,5 @@
             ! ----------------
             ! Define frequency of output and means
-            zsto = nf_ptr * zdt
+            zsto = nn_fptr * zdt
             IF( ln_mskland )   THEN    ! put 1.e+20 on land (very expensive!!)
                clop      = "ave(only(x))"
@@ -705,6 +554,6 @@
             ENDIF
 
-            zout = nf_ptr_wri * zdt
-            zfoo(:) = 0.e0
+            zout = nn_fwri * zdt
+            zfoo(:) = 0._wp
 
             ! Compute julian date from starting date of the run
@@ -716,5 +565,5 @@
             ! Requested by IPSL people, use by their postpro...
             IF(lwp) THEN
-               CALL dia_nam( clhstnam, nf_ptr_wri,' ' )
+               CALL dia_nam( clhstnam, nn_fwri,' ' )
                CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
                WRITE(inum,*) clhstnam
@@ -723,45 +572,43 @@
 #endif
 
-            CALL dia_nam( clhstnam, nf_ptr_wri, 'diaptr' )
+            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*nf_ptr, nhoridz, numptr, domain_id=nidom_ptr)
+               1, 1, 1, jpj, niter, zjulian, zdt*nn_fptr, nhoridz, numptr, domain_id=nidom_ptr)
             ! Vertical grids : gdept_0, gdepw_0
             CALL histvert( numptr, "deptht", "Vertical T levels",   &
-               "m", jpk, gdept_0, ndepidzt, "down" )
+               &                   "m", jpk, gdept_0, ndepidzt, "down" )
             CALL histvert( numptr, "depthw", "Vertical W levels",   &
-               "m", jpk, gdepw_0, ndepidzw, "down" )
+               &                   "m", jpk, gdepw_0, ndepidzw, "down" )
 
             !
-            CALL wheneq ( jpj*jpk, MIN(surf_jk_glo(:,:), 1.e0), 1, 1., ndex  , ndim  )      ! Lat-Depth
-            CALL wheneq ( jpj    , MIN(surf_jk_glo(:,1), 1.e0), 1, 1., ndex_h, ndim_h )     ! Lat
-
-            IF (ln_subbas) THEN
-               z_1 (:,1) = 1.0e0
-               WHERE ( gphit (jpi/2,:) .LT. -30 ) z_1 (:,1) = 0.e0
+            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)
+                  z_1(:,jk) = z_1(:,1)
                END DO
-
-               CALL wheneq ( jpj*jpk, MIN(surf_jk_atl(:,:)         , 1.e0), 1, 1., ndex_atl     , ndim_atl      ) ! Lat-Depth
-               CALL wheneq ( jpj*jpk, MIN(surf_jk_atl(:,:)*z_1(:,:), 1.e0), 1, 1., ndex_atl_30  , ndim_atl_30   ) ! Lat-Depth
-               CALL wheneq ( jpj    , MIN(surf_jk_atl(:,1)*z_1(:,1), 1.e0), 1, 1., ndex_h_atl_30, ndim_h_atl_30 ) ! Lat
-
-               CALL wheneq ( jpj*jpk, MIN(surf_jk_pac(:,:)         , 1.e0), 1, 1., ndex_pac     , ndim_pac      ) ! Lat-Depth
-               CALL wheneq ( jpj*jpk, MIN(surf_jk_pac(:,:)*z_1(:,:), 1.e0), 1, 1., ndex_pac_30  , ndim_pac_30   ) ! Lat-Depth
-               CALL wheneq ( jpj    , MIN(surf_jk_pac(:,1)*z_1(:,1), 1.e0), 1, 1., ndex_h_pac_30, ndim_h_pac_30 ) ! Lat
-
-               CALL wheneq ( jpj*jpk, MIN(surf_jk_ind(:,:)         , 1.e0), 1, 1., ndex_ind     , ndim_ind      ) ! Lat-Depth
-               CALL wheneq ( jpj*jpk, MIN(surf_jk_ind(:,:)*z_1(:,:), 1.e0), 1, 1., ndex_ind_30  , ndim_ind_30   ) ! Lat-Depth
-               CALL wheneq ( jpj    , MIN(surf_jk_ind(:,1)*z_1(:,1), 1.e0), 1, 1., ndex_h_ind_30, ndim_h_ind_30 ) ! Lat
-
-               CALL wheneq ( jpj*jpk, MIN(surf_jk_ipc(:,:)         , 1.e0), 1, 1., ndex_ipc     , ndim_ipc      ) ! Lat-Depth
-               CALL wheneq ( jpj*jpk, MIN(surf_jk_ipc(:,:)*z_1(:,:), 1.e0), 1, 1., ndex_ipc_30  , ndim_ipc_30   ) ! Lat-Depth
-               CALL wheneq ( jpj    , MIN(surf_jk_ipc(:,1)*z_1(:,1), 1.e0), 1, 1., ndex_h_ipc_30, ndim_h_ipc_30 ) ! Lat
-
+               !                       ! 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
@@ -772,5 +619,5 @@
             !  Zonal mean T and S
 
-            IF ( ln_diaznl ) THEN 
+            IF( ln_diaznl ) THEN 
                CALL histdef( numptr, "zotemglo", "Zonal Mean Temperature","C" ,   &
                   1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
@@ -888,76 +735,67 @@
 
 #if defined key_mpp_mpi
-      IF( MOD( itmod, nf_ptr ) == 0 .AND. l_znl_root ) THEN
+      IF( MOD( itmod, nn_fptr ) == 0 .AND. l_znl_root ) THEN
 #else
-      IF( MOD( itmod, nf_ptr ) == 0  ) THEN
+      IF( MOD( itmod, nn_fptr ) == 0  ) THEN
 #endif
          niter = niter + 1
 
-!-$$         IF(lwp) THEN
-!-$$            WRITE(numout,*)
-!-$$            WRITE(numout,*) 'dia_ptr_wri : write Poleward Transports at time-step : kt = ', kt, &
-!-$$               & 'it = ', it, ' itmod = ', itmod, ' niter = ', niter
-!-$$            WRITE(numout,*) '~~~~~~~~~~'
-!-$$            WRITE(numout,*)
-!-$$         ENDIF
-
-         IF (ln_diaznl ) THEN 
-            CALL histwrite( numptr, "zosrfglo", niter, surf_jk_glo , ndim, ndex )
-            CALL histwrite( numptr, "zotemglo", niter, tn_jk_glo  , ndim, ndex )
-            CALL histwrite( numptr, "zosalglo", niter, sn_jk_glo  , ndim, ndex )
+         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, surf_jk_atl, ndim_atl, ndex_atl )
-               CALL histwrite( numptr, "zosrfpac", niter, surf_jk_pac, ndim_pac, ndex_pac )
-               CALL histwrite( numptr, "zosrfind", niter, surf_jk_ind, ndim_ind, ndex_ind )
-               CALL histwrite( numptr, "zosrfipc", niter, surf_jk_ipc, ndim_ipc, ndex_ipc )
-
-               CALL histwrite( numptr, "zotematl", niter, tn_jk_atl  , ndim_atl, ndex_atl )
-               CALL histwrite( numptr, "zosalatl", niter, sn_jk_atl  , ndim_atl, ndex_atl )
-               CALL histwrite( numptr, "zotempac", niter, tn_jk_pac  , ndim_pac, ndex_pac )
-               CALL histwrite( numptr, "zosalpac", niter, sn_jk_pac  , ndim_pac, ndex_pac )
-               CALL histwrite( numptr, "zotemind", niter, tn_jk_ind  , ndim_ind, ndex_ind )
-               CALL histwrite( numptr, "zosalind", niter, sn_jk_ind  , ndim_ind, ndex_ind )
-               CALL histwrite( numptr, "zotemipc", niter, tn_jk_ipc  , ndim_ipc, ndex_ipc )
-               CALL histwrite( numptr, "zosalipc", niter, sn_jk_ipc  , ndim_ipc, ndex_ipc )
+               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_glo, ndim, ndex )
+         CALL histwrite( numptr, "zomsfglo", niter, v_msf(:,:,1), ndim, ndex )
          IF( ln_subbas .AND. ln_diaznl ) THEN
-            CALL histwrite( numptr, "zomsfatl", niter, v_msf_atl , ndim_atl_30, ndex_atl_30 )
-            CALL histwrite( numptr, "zomsfpac", niter, v_msf_pac , ndim_pac_30, ndex_pac_30 )
-            CALL histwrite( numptr, "zomsfind", niter, v_msf_ind , ndim_ind_30, ndex_ind_30 )
-            CALL histwrite( numptr, "zomsfipc", niter, v_msf_ipc , ndim_ipc_30, ndex_ipc_30 )
+            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_glo, ndim  , ndex   )
-#endif
-
+         CALL histwrite( numptr, "zomsfeiv", niter, v_msf_eiv(:,:,1), ndim  , ndex   )
+#endif
 
          ! heat transport outputs:
          IF( ln_subbas ) THEN
-            CALL histwrite( numptr, "sohtatl", niter, ht_atl  , ndim_h_atl_30, ndex_h_atl_30 )
-            CALL histwrite( numptr, "sohtpac", niter, ht_pac  , ndim_h_pac_30, ndex_h_pac_30 )
-            CALL histwrite( numptr, "sohtind", niter, ht_ind  , ndim_h_ind_30, ndex_h_ind_30 )
-            CALL histwrite( numptr, "sohtipc", niter, ht_ipc  , ndim_h_ipc_30, ndex_h_ipc_30 )
-            CALL histwrite( numptr, "sostatl", niter, st_atl  , ndim_h_atl_30, ndex_h_atl_30 )
-            CALL histwrite( numptr, "sostpac", niter, st_pac  , ndim_h_pac_30, ndex_h_pac_30 )
-            CALL histwrite( numptr, "sostind", niter, st_ind  , ndim_h_ind_30, ndex_h_ind_30 )
-            CALL histwrite( numptr, "sostipc", niter, st_ipc  , ndim_h_ipc_30, ndex_h_ipc_30 )
+            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, pht_adv     , ndim_h, ndex_h )
-         CALL histwrite( numptr, "sophtldf", niter, pht_ldf     , ndim_h, ndex_h )
-         CALL histwrite( numptr, "sopstadv", niter, pst_adv     , ndim_h, ndex_h )
-         CALL histwrite( numptr, "sopstldf", niter, pst_ldf     , ndim_h, ndex_h )
-         IF ( ln_ptrcomp ) THEN 
-            CALL histwrite( numptr, "sopstove", niter, pst_ove_glo , ndim_h, ndex_h )
-            CALL histwrite( numptr, "sophtove", niter, pht_ove_glo , ndim_h, ndex_h )
+         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, pht_eiv_glo  , ndim_h, ndex_h )
-         CALL histwrite( numptr, "sopsteiv", niter, pst_eiv_glo  , ndim_h, ndex_h )
+         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
          !
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90	(revision 2528)
@@ -4,7 +4,23 @@
    !! Ocean diagnostics :  write ocean output files
    !!=====================================================================
-
-   !!----------------------------------------------------------------------
-   !! * Modules used
+   !! History :  OPA  ! 1991-03  (M.-A. Foujols)  Original code
+   !!            4.0  ! 1991-11  (G. Madec)
+   !!                 ! 1992-06  (M. Imbard)  correction restart file
+   !!                 ! 1992-07  (M. Imbard)  split into diawri and rstwri
+   !!                 ! 1993-03  (M. Imbard)  suppress writibm
+   !!                 ! 1998-01  (C. Levy)  NETCDF format using ioipsl INTERFACE
+   !!                 ! 1999-02  (E. Guilyardi)  name of netCDF files + variables
+   !!            8.2  ! 2000-06  (M. Imbard)  Original code (diabort.F)
+   !!   NEMO     1.0  ! 2002-06  (A.Bozec, E. Durand)  Original code (diainit.F)
+   !!             -   ! 2002-09  (G. Madec)  F90: Free form and module
+   !!             -   ! 2002-12  (G. Madec)  merge of diabort and diainit, F90
+   !!                 ! 2005-11  (V. Garnier) Surface pressure gradient organization
+   !!            3.2  ! 2008-11  (B. Lemaire) creation from old diawri
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dia_wri       : create the standart output files
+   !!   dia_wri_state : create an output NetCDF file for a single instantaeous ocean state and forcing fields
+   !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and tracers 
    USE dom_oce         ! ocean space and time domain
@@ -30,22 +46,20 @@
    USE limwri_2 
 #endif
+   USE dtatem
+   USE dtasal
+
    IMPLICIT NONE
    PRIVATE
 
-   !! * Accessibility
-   PUBLIC dia_wri                 ! routines called by step.F90
-   PUBLIC dia_wri_state
-
-   !! * Module variables
-   INTEGER ::   &
-      nid_T, nz_T, nh_T, ndim_T, ndim_hT,      &   ! grid_T file
-      nid_U, nz_U, nh_U, ndim_U, ndim_hU,      &   ! grid_U file
-      nid_V, nz_V, nh_V, ndim_V, ndim_hV,      &   ! grid_V file
-      nid_W, nz_W, nh_W,                       &   ! grid_W file
-      ndex(1)                                      ! ???
-   INTEGER, DIMENSION(jpi*jpj) ::   &
-      ndex_hT, ndex_hU, ndex_hV
-   INTEGER, DIMENSION(jpi*jpj*jpk) ::   &
-      ndex_T, ndex_U, ndex_V
+   PUBLIC   dia_wri                 ! routines called by step.F90
+   PUBLIC   dia_wri_state
+
+   INTEGER ::   nid_T, nz_T, nh_T, ndim_T, ndim_hT   ! grid_T file
+   INTEGER ::   nid_U, nz_U, nh_U, ndim_U, ndim_hU   ! grid_U file
+   INTEGER ::   nid_V, nz_V, nh_V, ndim_V, ndim_hV   ! grid_V file
+   INTEGER ::   nid_W, nz_W, nh_W                    ! grid_W file
+   INTEGER ::   ndex(1)                              ! ???
+   INTEGER, DIMENSION(jpi*jpj)     ::   ndex_hT, ndex_hU, ndex_hV
+   INTEGER, DIMENSION(jpi*jpj*jpk) ::   ndex_T, ndex_U, ndex_V
 
    !! * Substitutions
@@ -54,14 +68,13 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
 #if defined key_dimgout
    !!----------------------------------------------------------------------
-   !!   dia_wri       : create the dimg direct access output file (mpp)
+   !!   'key_dimgout'                                      DIMG output file
    !!----------------------------------------------------------------------
 #   include "diawri_dimg.h90"
@@ -71,9 +84,8 @@
    !!   Default option                                   NetCDF output file
    !!----------------------------------------------------------------------
-   !!   dia_wri       : create the standart NetCDF output files
-   !!   dia_wri_state : create an output NetCDF file for a single
-   !!                   instantaeous ocean state and forcing fields
-   !!----------------------------------------------------------------------
 # if defined key_iomput
+   !!----------------------------------------------------------------------
+   !!   'key_iomput'                                        use IOM library
+   !!----------------------------------------------------------------------
    SUBROUTINE dia_wri( kt )
       !!---------------------------------------------------------------------
@@ -84,7 +96,4 @@
       !!
       !! ** Method  :  use iom_put
-      !!
-      !! History :
-      !!   3.2  !  05-11  (B. Lemaire) creation from old diawri
       !!----------------------------------------------------------------------
       USE oce, ONLY :   z3d => ta   ! use ta as 3D workspace
@@ -165,8 +174,12 @@
          CALL iom_put( "v_heattr", z2d )                  !  heat transport in i-direction
       ENDIF
-
+      !
    END SUBROUTINE dia_wri
 
 #else
+   !!----------------------------------------------------------------------
+   !!   Default option                                  use IOIPSL  library
+   !!----------------------------------------------------------------------
+
    SUBROUTINE dia_wri( kt )
       !!---------------------------------------------------------------------
@@ -180,32 +193,13 @@
       !!      At each time step call histdef to compute the mean if ncessary
       !!      Each nwrite time step, output the instantaneous or mean fields
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
       !!
-      !! History :
-      !!        !  91-03  (M.-A. Foujols)  Original code
-      !!        !  91-11  (G. Madec)
-      !!        !  92-06  (M. Imbard)  correction restart file
-      !!        !  92-07  (M. Imbard)  split into diawri and rstwri
-      !!        !  93-03  (M. Imbard)  suppress writibm
-      !!        !  98-01  (C. Levy)  NETCDF format using ioipsl INTERFACE
-      !!        !  99-02  (E. Guilyardi)  name of netCDF files + variables
-      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
-      !!   9.0  !  05-11  (V. Garnier) Surface pressure gradient organization
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
-
-      !! * Local declarations
-      LOGICAL ::   ll_print = .FALSE.    ! =T print and flush numout
-      CHARACTER (len=40) ::           &
-         clhstnam, clop, clmx            ! temporary names
-      INTEGER ::   inum = 11             ! temporary logical unit
-      INTEGER ::   &
-         iimi, iima, ipk, it, itmod,  &  ! temporary integers
-         ijmi, ijma                      !    "          "
-      REAL(wp) ::   &
-         zsto, zout, zmax,            &  ! temporary scalars
-         zjulian, zdt                    !    "         "
-      REAL(wp), DIMENSION(jpi,jpj) :: &
-         zw2d                            ! temporary workspace
+      LOGICAL ::   ll_print = .FALSE.                        ! =T print and flush numout
+      CHARACTER (len=40) ::   clhstnam, clop, clmx           ! local names
+      INTEGER  ::   inum = 11                                ! temporary logical unit
+      INTEGER  ::   iimi, iima, ipk, it, itmod, ijmi, ijma   ! local integers
+      REAL(wp) ::   zsto, zout, zmax, zjulian, zdt           ! local scalars
+      REAL(wp), DIMENSION(jpi,jpj) ::   zw2d                 ! 2D workspace
       !!----------------------------------------------------------------------
       !
@@ -279,5 +273,5 @@
          CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit
             &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
-            &          nit000-1, zjulian, zdt, nh_T, nid_T, domain_id=nidom )
+            &          nit000-1, zjulian, zdt, nh_T, nid_T, domain_id=nidom, snc4chunks=snc4set )
          CALL histvert( nid_T, "deptht", "Vertical T levels",      &  ! Vertical grid: gdept
             &           "m", ipk, gdept_0, nz_T, "down" )
@@ -292,5 +286,5 @@
          CALL histbeg( clhstnam, jpi, glamu, jpj, gphiu,           &  ! Horizontal grid: glamu and gphiu
             &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
-            &          nit000-1, zjulian, zdt, nh_U, nid_U, domain_id=nidom )
+            &          nit000-1, zjulian, zdt, nh_U, nid_U, domain_id=nidom, snc4chunks=snc4set )
          CALL histvert( nid_U, "depthu", "Vertical U levels",      &  ! Vertical grid: gdept
             &           "m", ipk, gdept_0, nz_U, "down" )
@@ -305,5 +299,5 @@
          CALL histbeg( clhstnam, jpi, glamv, jpj, gphiv,           &  ! Horizontal grid: glamv and gphiv
             &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
-            &          nit000-1, zjulian, zdt, nh_V, nid_V, domain_id=nidom )
+            &          nit000-1, zjulian, zdt, nh_V, nid_V, domain_id=nidom, snc4chunks=snc4set )
          CALL histvert( nid_V, "depthv", "Vertical V levels",      &  ! Vertical grid : gdept
             &          "m", ipk, gdept_0, nz_V, "down" )
@@ -318,5 +312,5 @@
          CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit
             &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
-            &          nit000-1, zjulian, zdt, nh_W, nid_W, domain_id=nidom )
+            &          nit000-1, zjulian, zdt, nh_W, nid_W, domain_id=nidom, snc4chunks=snc4set )
          CALL histvert( nid_W, "depthw", "Vertical W levels",      &  ! Vertical grid: gdepw
             &          "m", ipk, gdepw_0, nz_W, "down" )
@@ -346,11 +340,11 @@
 !!$            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
 !!$#endif
-         CALL histdef( nid_T, "sowaflup", "Net Upward Water Flux"              , "Kg/m2/s",   &  ! emp
+         CALL histdef( nid_T, "sowaflup", "Net Upward Water Flux"              , "Kg/m2/s",   &  ! (emp-rnf)
             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
 !!$         CALL histdef( nid_T, "sorunoff", "Runoffs"                            , "Kg/m2/s",   &  ! runoffs
 !!$            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
-         CALL histdef( nid_T, "sowaflcd", "concentration/dilution water flux"  , "kg/m2/s",   &  ! emps
-            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
-         CALL histdef( nid_T, "sosalflx", "Surface Salt Flux"                  , "Kg/m2/s",   &  ! emps * sn
+         CALL histdef( nid_T, "sowaflcd", "concentration/dilution water flux"  , "kg/m2/s",   &  ! (emps-rnf)
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "sosalflx", "Surface Salt Flux"                  , "Kg/m2/s",   &  ! (emps-rnf) * sn
             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
          CALL histdef( nid_T, "sohefldo", "Net Downward Heat Flux"             , "W/m2"   ,   &  ! qns + qsr
@@ -383,8 +377,4 @@
             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
          CALL histdef( nid_T, "sosafldp", "Surface salt flux: Damping"         , "Kg/m2/s",   &  ! erp * sn
-            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
-#endif
-#if defined key_diaspr
-         CALL histdef( nid_T, "sosurfps", "Surface Pressure"                   , "cm"     ,   &  ! sp
             &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
 #endif
@@ -414,5 +404,5 @@
 #endif 
 
-         CALL histend( nid_T )
+         CALL histend( nid_T, snc4chunks=snc4set )
 
          !                                                                                      !!! nid_U : 3D
@@ -427,5 +417,5 @@
             &          jpi, jpj, nh_U, 1  , 1, 1  , - 99, 32, clop, zsto, zout )
 
-         CALL histend( nid_U )
+         CALL histend( nid_U, snc4chunks=snc4set )
 
          !                                                                                      !!! nid_V : 3D
@@ -440,5 +430,5 @@
             &          jpi, jpj, nh_V, 1  , 1, 1  , - 99, 32, clop, zsto, zout )
 
-         CALL histend( nid_V )
+         CALL histend( nid_V, snc4chunks=snc4set )
 
          !                                                                                      !!! nid_W : 3D
@@ -468,5 +458,5 @@
 #endif
 
-         CALL histend( nid_W )
+         CALL histend( nid_W, snc4chunks=snc4set )
 
          IF(lwp) WRITE(numout,*)
@@ -498,8 +488,8 @@
 !!$      CALL histwrite( nid_T, "sowaflep", it, fmass(:,:)    , ndim_hT, ndex_hT )   ! atmos=>ocean water flux
 !!$#endif
-      CALL histwrite( nid_T, "sowaflup", it, emp           , ndim_hT, ndex_hT )   ! upward water flux
+      CALL histwrite( nid_T, "sowaflup", it, ( emp-rnf )   , ndim_hT, ndex_hT )   ! upward water flux
 !!$      CALL histwrite( nid_T, "sorunoff", it, runoff        , ndim_hT, ndex_hT )   ! runoff
-      CALL histwrite( nid_T, "sowaflcd", it, emps          , ndim_hT, ndex_hT )   ! c/d water flux
-      zw2d(:,:) = emps(:,:) * sn(:,:,1) * tmask(:,:,1)
+      CALL histwrite( nid_T, "sowaflcd", it, ( emps-rnf )  , ndim_hT, ndex_hT )   ! c/d water flux
+      zw2d(:,:) = ( emps(:,:) - rnf(:,:) ) * sn(:,:,1) * tmask(:,:,1)
       CALL histwrite( nid_T, "sosalflx", it, zw2d          , ndim_hT, ndex_hT )   ! c/d salt flux
       CALL histwrite( nid_T, "sohefldo", it, qns + qsr     , ndim_hT, ndex_hT )   ! total heat flux
@@ -521,8 +511,5 @@
       CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping
 #endif
-#if defined key_diaspr
-      CALL histwrite( nid_T, "sosurfps", it, gps           , ndim_hT, ndex_hT )   ! surface pressure
-#endif
-         zw2d(:,:) = FLOAT( nmln(:,:) ) * tmask(:,:,1)
+      zw2d(:,:) = FLOAT( nmln(:,:) ) * tmask(:,:,1)
       CALL histwrite( nid_T, "sobowlin", it, zw2d          , ndim_hT, ndex_hT )   ! ???
 
@@ -583,5 +570,5 @@
          CALL histclo( nid_W )
       ENDIF
-
+      !
    END SUBROUTINE dia_wri
 # endif
@@ -601,25 +588,13 @@
       !!      File 'output.init.nc'  is created if ninist = 1 (namelist)
       !!      File 'output.abort.nc' is created in case of abnormal job end
-      !!
-      !! History :
-      !!   8.2  !  00-06  (M. Imbard)  Original code (diabort.F)
-      !!   8.5  !  02-06  (A.Bozec, E. Durand)  Original code (diainit.F)
-      !!   9.0  !  02-12  (G. Madec)  merge of diabort and diainit, F90
-      !!    "   !  05-11  (V. Garnier) Surface pressure gradient organization
       !!----------------------------------------------------------------------
-      !! * Arguments
       CHARACTER (len=* ), INTENT( in ) ::   cdfile_name      ! name of the file created
       INTEGER           , INTENT( in ) ::   kt               ! ocean time-step index
-
-      !! * Local declarations
+      !! 
       CHARACTER (len=32) :: clname
       CHARACTER (len=40) :: clop
-      INTEGER  ::   &
-         id_i , nz_i, nh_i       
-      INTEGER, DIMENSION(1) ::   &
-         idex             ! temprary workspace
-      REAL(wp) ::   &
-         zsto, zout, zmax,   &
-         zjulian, zdt
+      INTEGER  ::   id_i , nz_i, nh_i       
+      INTEGER, DIMENSION(1) ::   idex             ! local workspace
+      REAL(wp) ::   zsto, zout, zmax, zjulian, zdt
       !!----------------------------------------------------------------------
 
@@ -649,5 +624,5 @@
       zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment
       CALL histbeg( clname, jpi, glamt, jpj, gphit,   &
-          1, jpi, 1, jpj, nit000-1, zjulian, zdt, nh_i, id_i, domain_id=nidom )          ! Horizontal grid : glamt and gphit
+          1, jpi, 1, jpj, nit000-1, zjulian, zdt, nh_i, id_i, domain_id=nidom, snc4chunks=snc4set ) ! Horizontal grid : glamt and gphit
       CALL histvert( id_i, "deptht", "Vertical T levels",   &    ! Vertical grid : gdept
           "m", jpk, gdept_0, nz_i, "down")
@@ -683,5 +658,5 @@
       CALL lim_wri_state_2( kt, id_i, nh_i )
 #else
-      CALL histend( id_i )
+      CALL histend( id_i, snc4chunks=snc4set )
 #endif
 
@@ -700,5 +675,5 @@
       CALL histwrite( id_i, "vomecrty", kt, vn       , jpi*jpj*jpk, idex )    ! now j-velocity
       CALL histwrite( id_i, "vovecrtz", kt, wn       , jpi*jpj*jpk, idex )    ! now k-velocity
-      CALL histwrite( id_i, "sowaflup", kt, emp      , jpi*jpj    , idex )    ! freshwater budget
+      CALL histwrite( id_i, "sowaflup", kt, (emp-rnf), jpi*jpj    , idex )    ! freshwater budget
       CALL histwrite( id_i, "sohefldo", kt, qsr + qns, jpi*jpj    , idex )    ! total heat flux
       CALL histwrite( id_i, "soshfldo", kt, qsr      , jpi*jpj    , idex )    ! solar heat flux
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diawri_dimg.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diawri_dimg.h90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diawri_dimg.h90	(revision 2528)
@@ -2,10 +2,10 @@
   !!                        ***  diawri_dimg.h90  ***
   !!----------------------------------------------------------------------
-  !!   OPA 9.0 , LOCEAN-IPSL (2005) 
-  !! $Id$
-  !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+  !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+  !! $Id $
+  !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
   !!----------------------------------------------------------------------
 
-  SUBROUTINE dia_wri (kt)
+  SUBROUTINE dia_wri( kt )
     !!----------------------------------------------------------------------
     !!           *** routine dia_wri ***
@@ -42,5 +42,5 @@
     !!  level 2:  vtau(:,:) * vmask(:,:,1) meridional stress in N. m-2
     !!  level 3:  qsr + qns                total heat flux (W/m2)
-    !!  level 4:  emp (:,:)               E-P flux (mm/day)
+    !!  level 4:  ( emp (:,:)-rnf(:,:) )   E-P flux (mm/day)
     !!  level 5:  tb  (:,:,1)-sst          model SST -forcing sst (degree C) ! deprecated
     !!  level 6:  bsfb(:,:)		   streamfunction (m**3/s)
@@ -54,5 +54,5 @@
     !!  level 14: qct(:,:)                 equivalent flux due to treshold SST
     !!  level 15: fbt(:,:)                 feedback term .
-    !!  level 16: emps(:,:)                concentration/dilution water flux
+    !!  level 16: ( emps(:,:) - rnf(:,:) ) concentration/dilution water flux
     !!  level 17: fsalt(:,:)               Ice=>ocean net freshwater
     !!  level 18: gps(:,:)                 the surface pressure (m).
@@ -60,25 +60,14 @@
     !!  level 20: spgv(:,:)                the surface pressure gradient in Y direction.
     !! 
-    !! History 
-    !!      original  : 91-03 ()
-    !!      additions : 91-11 (G. Madec)
-    !!      additions : 92-06 (M. Imbard) correction restart file
-    !!      additions : 92-07 (M. Imbard) split into diawri and rstwri
-    !!      additions : 93-03 (M. Imbard) suppress writibm
-    !!      additions : 94-12 (M. Imbard) acces direct files
-    !!      additions : 97-2002 ( Clipper Group ) dimg files
-    !!                  dec 2003 ( J.M. Molines) f90, mpp output for OPA9.0
-    !!   9.0  !  05-05  (S. Theetten) add emps fsalt move gps spgu spgv 2 lines below
-    !!   9.0  !  05-11  (V. Garnier) Surface pressure gradient organization
+    !! History:  OPA  ! 1997-02 ( Clipper Group ) dimg files
+    !!            -   ! 2003-12 ( J.M. Molines) f90, mpp output for OPA9.0
+    !!   NEMO    1.0  ! 2005-05  (S. Theetten) add emps fsalt move gps spgu spgv 2 lines below
+    !!            -   ! 2005-11  (V. Garnier) Surface pressure gradient organization
     !!----------------------------------------------------------------------
-    !! * modules used
     USE lib_mpp
-
-    !! * Arguments
+    !!
     INTEGER ,INTENT(in) :: kt
-
-    !! * local declarations
+    !!
     INTEGER :: inbsel, jk
-!!  INTEGER :: iwrite
     INTEGER :: iyear,imon,iday
     INTEGER, SAVE :: nmoyct 
@@ -101,23 +90,15 @@
     CHARACTER(LEN=80) :: clmode
     CHARACTER(LEN= 4) :: clver
+    !!----------------------------------------------------------------------
     !
     !  Initialization
     !  ---------------
     !
-#ifdef key_diaspr
-    inbsel = 20
-#else
     inbsel = 17
-#endif
-#if defined key_flx_core
-    inbsel = 23
-#endif
-
-    IF( inbsel >  jpk) THEN
-       IF( lwp) WRITE(numout,*)  &
-            ' STOP inbsel =',inbsel,' is larger than jpk=',jpk
+
+    IF( inbsel >  jpk ) THEN
+       IF(lwp) WRITE(numout,*)  ' STOP inbsel =',inbsel,' is larger than jpk=',jpk
        STOP
     ENDIF
-
 
     iyear = ndastp/10000
@@ -167,5 +148,5 @@
        fsel(:,:,2 ) = fsel(:,:,2 ) + vtau(:,:) * vmask(:,:,1)
        fsel(:,:,3 ) = fsel(:,:,3 ) + qsr (:,:) + qns  (:,:) 
-       fsel(:,:,4 ) = fsel(:,:,4 ) + emp (:,:)
+       fsel(:,:,4 ) = fsel(:,:,4 ) + ( emp(:,:)-rnf(:,:) ) 
        !        fsel(:,:,5 ) = fsel(:,:,5 ) + tb  (:,:,1)  !RB not used
        fsel(:,:,6 ) = fsel(:,:,6 ) + sshn(:,:) 
@@ -179,8 +160,5 @@
        !        fsel(:,:,14) = fsel(:,:,14) + qct(:,:)
        !        fsel(:,:,15) = fsel(:,:,15) + fbt(:,:)
-       fsel(:,:,16) = fsel(:,:,16) + emps(:,:)
-#ifdef key_diaspr   
-       fsel(:,:,18) = fsel(:,:,18) + gps(:,:)/g 
-#endif
+       fsel(:,:,16) = fsel(:,:,16) + ( emps(:,:)-rnf(:,:) ) 
        !
        ! Output of dynamics and tracer fields and selected fields
@@ -210,9 +188,4 @@
           ! computed from the averaged gradients.
           !
-#ifdef key_diaspr
-          fsel(:,:,18)= gps(:,:)/g
-          fsel(:,:,19)= spgu(:,:)
-          fsel(:,:,20)= spgv(:,:)
-#endif
           ! mask mean field with tmask except utau vtau (1,2)
           DO jk=3,inbsel
@@ -242,5 +215,5 @@
           fsel(:,:,2 ) = vtau(:,:) * vmask(:,:,1)
           fsel(:,:,3 ) = (qsr (:,:) + qns (:,:)) * tmask(:,:,1)
-          fsel(:,:,4 ) = emp (:,:) * tmask(:,:,1)
+          fsel(:,:,4 ) = ( emp(:,:)-rnf(:,:) ) * tmask(:,:,1) 
           !         fsel(:,:,5 ) = (tb  (:,:,1) - sf_sst(1)%fnow(:,:) ) *tmask(:,:,1) !RB not used
 
@@ -255,10 +228,5 @@
           !         fsel(:,:,14) =  qct(:,:)
           !         fsel(:,:,15) =  fbt(:,:)
-          fsel(:,:,16) =  emps(:,:) * tmask(:,:,1)
-#ifdef key_diaspr           
-          fsel(:,:,18) =      gps(:,:) /g
-          fsel(:,:,19) =      spgu(:,:)
-          fsel(:,:,20) =      spgv(:,:)
-#endif
+          fsel(:,:,16) = ( emps(:,:)-rnf(:,:) ) * tmask(:,:,1) 
           !
           !         qct(:,:) = 0._wp
@@ -383,4 +351,4 @@
     !
 9000 FORMAT(a,"_",a,"_y",i4.4,"m",i2.2,"d",i2.2,".dimgproc")
-
+    !
   END SUBROUTINE dia_wri
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90	(revision 2528)
@@ -44,7 +44,7 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2006) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -180,5 +180,6 @@
       INTEGER                     ::   ji, jj, jc, jn   ! dummy loop indices
       REAL(wp)                    ::   zze2
-      REAL(wp), DIMENSION (jpncs) ::   zemp
+      REAL(wp), DIMENSION (jpncs) ::   zfwf 
+ 
       !!----------------------------------------------------------------------
       !
@@ -216,18 +217,18 @@
       !                                                   !--------------------!
       !                                                   !  update emp, emps  !
-      zemp = 0.e0                                         !--------------------!
+      zfwf = 0.e0                                         !--------------------!
       DO jc = 1, jpncs
          DO jj = ncsj1(jc), ncsj2(jc)
             DO ji = ncsi1(jc), ncsi2(jc)
-               zemp(jc) = zemp(jc) + e1t(ji,jj) * e2t(ji,jj) * emp(ji,jj) * tmask_i(ji,jj)
+               zfwf(jc) = zfwf(jc) + e1t(ji,jj) * e2t(ji,jj) * ( emp(ji,jj)-rnf(ji,jj) ) * tmask_i(ji,jj) 
             END DO  
          END DO 
       END DO
-      IF( lk_mpp )   CALL mpp_sum ( zemp(:) , jpncs )       ! mpp: sum over all the global domain
+      IF( lk_mpp )   CALL mpp_sum ( zfwf(:) , jpncs )       ! mpp: sum over all the global domain
 
       IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN      ! Black Sea case for ORCA_R2 configuration
-         zze2    = ( zemp(3) + zemp(4) ) / 2.
-         zemp(3) = zze2
-         zemp(4) = zze2
+         zze2    = ( zfwf(3) + zfwf(4) ) / 2.
+         zfwf(3) = zze2
+         zfwf(4) = zze2
       ENDIF
 
@@ -236,9 +237,9 @@
          IF( ncstt(jc) == 0 ) THEN 
             ! water/evap excess is shared by all open ocean
-            emp (:,:) = emp (:,:) + zemp(jc) / surf(jpncs+1)
-            emps(:,:) = emps(:,:) + zemp(jc) / surf(jpncs+1)
+            emp (:,:) = emp (:,:) + zfwf(jc) / surf(jpncs+1)
+            emps(:,:) = emps(:,:) + zfwf(jc) / surf(jpncs+1)
          ELSEIF( ncstt(jc) == 1 ) THEN 
             ! Excess water in open sea, at outflow location, excess evap shared
-            IF ( zemp(jc) <= 0.e0 ) THEN 
+            IF ( zfwf(jc) <= 0.e0 ) THEN 
                 DO jn = 1, ncsnr(jc)
                   ji = mi0(ncsir(jc,jn))
@@ -246,13 +247,13 @@
                   IF (      ji > 1 .AND. ji < jpi   &
                       .AND. jj > 1 .AND. jj < jpj ) THEN 
-                      emp (ji,jj) = emp (ji,jj) + zemp(jc) /   &
+                      emp (ji,jj) = emp (ji,jj) + zfwf(jc) /   &
                          (FLOAT(ncsnr(jc)) * e1t(ji,jj) * e2t(ji,jj))
-                      emps(ji,jj) = emps(ji,jj) + zemp(jc) /   &
+                      emps(ji,jj) = emps(ji,jj) + zfwf(jc) /   &
                           (FLOAT(ncsnr(jc)) * e1t(ji,jj) * e2t(ji,jj))
                   END IF 
                 END DO 
             ELSE 
-                emp (:,:) = emp (:,:) + zemp(jc) / surf(jpncs+1)
-                emps(:,:) = emps(:,:) + zemp(jc) / surf(jpncs+1)
+                emp (:,:) = emp (:,:) + zfwf(jc) / surf(jpncs+1)
+                emps(:,:) = emps(:,:) + zfwf(jc) / surf(jpncs+1)
             ENDIF
          ELSEIF( ncstt(jc) == 2 ) THEN 
@@ -263,7 +264,7 @@
                   ji = mi0(ncsir(jc,jn))
                   jj = mj0(ncsjr(jc,jn)) ! Location of outflow in open ocean
-                  emp (ji,jj) = emp (ji,jj) + zemp(jc)   &
+                  emp (ji,jj) = emp (ji,jj) + zfwf(jc)   &
                       / (FLOAT(ncsnr(jc)) *  e1t(ji,jj) * e2t(ji,jj) )
-                  emps(ji,jj) = emps(ji,jj) + zemp(jc)   &
+                  emps(ji,jj) = emps(ji,jj) + zfwf(jc)   &
                       / (FLOAT(ncsnr(jc)) *  e1t(ji,jj) * e2t(ji,jj) )
                 END DO 
@@ -273,6 +274,6 @@
          DO jj = ncsj1(jc), ncsj2(jc)
             DO ji = ncsi1(jc), ncsi2(jc)
-               emp (ji,jj) = emp (ji,jj) - zemp(jc) / surf(jc)
-               emps(ji,jj) = emps(ji,jj) - zemp(jc) / surf(jc)
+               emp (ji,jj) = emp (ji,jj) - zfwf(jc) / surf(jc)
+               emps(ji,jj) = emps(ji,jj) - zfwf(jc) / surf(jc)
             END DO  
          END DO 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90	(revision 2528)
@@ -33,4 +33,5 @@
    USE prtctl          ! Print control
    USE restart         ! 
+   USE trc_oce, ONLY : lk_offline ! offline flag
 
    IMPLICIT NONE
@@ -43,7 +44,7 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -67,4 +68,7 @@
       !!              - nmonth_len, nyear_len, nmonth_half, nmonth_end through day_mth
       !!----------------------------------------------------------------------
+      INTEGER :: inbday, idweek
+      REAL(wp) :: zjul
+      !!----------------------------------------------------------------------
 
       ! all calendar staff is based on the fact that MOD( rday, rdttra(1) ) == 0
@@ -77,5 +81,5 @@
       ndt05   = NINT(0.5 * rdttra(1))
 
-      CALL day_rst( nit000, 'READ' ) 
+      IF( .NOT. lk_offline ) CALL day_rst( nit000, 'READ' ) 
 
       ! set the calandar from ndastp (read in restart file and namelist)
@@ -105,13 +109,19 @@
       ! day since january 1st
       nday_year = nday + SUM( nmonth_len(1:nmonth - 1) )
-      
-      ! number of seconds since the beginning of current year/month at the middle of the time-step
+
+      !compute number of days between last monday and today      
+      CALL ymds2ju( 1900, 01, 01, 0.0, zjul )  ! compute julian day value of 01.01.1900 (our reference that was a Monday)
+      inbday = NINT(fjulday - zjul)            ! compute nb day between  01.01.1900 and current day  
+      idweek = MOD(inbday, 7)                  ! compute nb day between last monday and current day  
+
+      ! number of seconds since the beginning of current year/month/week/day at the middle of the time-step
       nsec_year  = nday_year * nsecd - ndt05   ! 1 time step before the middle of the first time step
       nsec_month = nday      * nsecd - ndt05   ! because day will be called at the beginning of step
+      nsec_week  = idweek    * nsecd - ndt05
       nsec_day   =             nsecd - ndt05
 
       ! 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 = ',   &
-           &                   nyear, '/', nmonth, '/', nday, '  nsec_day:', nsec_day
+           &                   nyear, '/', nmonth, '/', nday, '  nsec_day:', nsec_day, '  nsec_week:', nsec_week
 
       ! Up to now, calendar parameters are related to the end of previous run (nit000-1)
@@ -200,4 +210,5 @@
       nsec_year  = nsec_year  + ndt 
       nsec_month = nsec_month + ndt                 
+      nsec_week  = nsec_week  + ndt
       nsec_day   = nsec_day   + ndt                
       adatrj  = adatrj  + rdttra(1) / rday
@@ -206,5 +217,5 @@
       IF( ABS(adatrj  - REAL(NINT(adatrj ),wp)) < zprec )   adatrj  = REAL(NINT(adatrj ),wp)   ! avoid truncation error
       
-      IF( nsec_day > nsecd ) THEN                        ! NEW day
+      IF( nsec_day > nsecd ) THEN                       ! New day
          !
          nday      = nday + 1
@@ -212,9 +223,9 @@
          nsec_day  = ndt05
          !
-         IF( nday == nmonth_len(nmonth) + 1 ) THEN      ! NEW month
+         IF( nday == nmonth_len(nmonth) + 1 ) THEN      ! New month
             nday   = 1
             nmonth = nmonth + 1
             nsec_month = ndt05
-            IF( nmonth == 13 ) THEN                     ! NEW year
+            IF( nmonth == 13 ) THEN                     ! New year
                nyear     = nyear + 1
                nmonth    = 1
@@ -226,11 +237,16 @@
          ENDIF
          !
-         ndastp = nyear * 10000 + nmonth * 100 + nday   ! NEW date
+         ndastp = nyear * 10000 + nmonth * 100 + nday   ! New date
+         !
+         !compute first day of the year in julian days
+         CALL ymds2ju( nyear, 01, 01, 0.0, fjulstartyear )
          !
          IF(lwp) WRITE(numout,'(a,i8,a,i4.4,a,i2.2,a,i2.2,a,i3.3)') '======>> time-step =', kt,   &
               &   '      New day, DATE Y/M/D = ', nyear, '/', nmonth, '/', nday, '      nday_year = ', nday_year
          IF(lwp) WRITE(numout,'(a,i8,a,i7,a,i5)') '         nsec_year = ', nsec_year,   &
-              &   '   nsec_month = ', nsec_month, '   nsec_day = ', nsec_day
-      ENDIF
+              &   '   nsec_month = ', nsec_month, '   nsec_day = ', nsec_day, '   nsec_week = ', nsec_week
+      ENDIF
+
+      IF( nsec_week > 7*nsecd )   nsec_week = ndt05     ! New week
       
       IF(ln_ctl) THEN
@@ -239,6 +255,6 @@
       ENDIF
 
-      CALL rst_opn( kt )                                ! Open the restart file if needed and control lrst_oce
-      IF( lrst_oce )   CALL day_rst( kt, 'WRITE' )      ! write day restart information
+      IF( .NOT. lk_offline ) CALL rst_opn( kt )               ! Open the restart file if needed and control lrst_oce
+      IF( lrst_oce         ) CALL day_rst( kt, 'WRITE' )      ! write day restart information
       !
    END SUBROUTINE day
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90	(revision 2528)
@@ -6,8 +6,5 @@
    !!======================================================================
    !! History :  1.0  ! 2005-10  (A. Beckmann, G. Madec)  reactivate s-coordinate 
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!            3.3  ! 2010-11  (G. Madec) add mbk. arrays associated to the deepest ocean level
    !!----------------------------------------------------------------------
    USE par_oce      ! ocean parameters
@@ -21,32 +18,33 @@
    !! ----------------------------
    !                                              !!* Namelist namdom : time & space domain *
-   INTEGER , PUBLIC ::   nn_bathy     =  0         !: = 0/1 ,compute/read the bathymetry file
-   REAL(wp), PUBLIC ::   rn_e3zps_min = 5.0_wp     !: miminum thickness for partial steps (meters)
-   REAL(wp), PUBLIC ::   rn_e3zps_rat = 0.1_wp     !: minimum thickness ration for partial steps
-   INTEGER , PUBLIC ::   nn_msh       = 0          !: = 1 create a mesh-mask file
-   INTEGER , PUBLIC ::   nn_acc       = 0          !: = 0/1 use of the acceleration of convergence technique
-   REAL(wp), PUBLIC ::   rn_atfp      = 0.1_wp     !: asselin time filter parameter
+   INTEGER , PUBLIC ::   nn_bathy     =    0       !: = 0/1 ,compute/read the bathymetry file
+   REAL(wp), PUBLIC ::   rn_hmin      =   -3.0_wp  !: minimum ocean depth (>0) or minimum number of ocean levels (<0)
+   REAL(wp), PUBLIC ::   rn_e3zps_min =    5.0_wp  !: miminum thickness for partial steps (meters)
+   REAL(wp), PUBLIC ::   rn_e3zps_rat =    0.1_wp  !: minimum thickness ration for partial steps
+   INTEGER , PUBLIC ::   nn_msh       =    0       !: = 1 create a mesh-mask file
+   INTEGER , PUBLIC ::   nn_acc       =    0       !: = 0/1 use of the acceleration of convergence technique
+   REAL(wp), PUBLIC ::   rn_atfp      =    0.1_wp  !: asselin time filter parameter
    REAL(wp), PUBLIC ::   rn_rdt       = 3600._wp   !: time step for the dynamics (and tracer if nacc=0)
    REAL(wp), PUBLIC ::   rn_rdtmin    = 3600._wp   !: minimum time step on tracers
    REAL(wp), PUBLIC ::   rn_rdtmax    = 3600._wp   !: maximum time step on tracers
    REAL(wp), PUBLIC ::   rn_rdth      =  800._wp   !: depth variation of tracer step
-   INTEGER , PUBLIC ::   nn_baro      = 64         !: number of barotropic time steps (key_dynspg_ts)
-   INTEGER , PUBLIC ::   nn_closea    =  0         !: =0 suppress closed sea/lake from the ORCA domain or not (=1)
-
-   !                                          ! old non-DOCTOR names still used in the model
-   INTEGER , PUBLIC ::   ntopo                !: = 0/1 ,compute/read the bathymetry file
-   REAL(wp), PUBLIC ::   e3zps_min            !: miminum thickness for partial steps (meters)
-   REAL(wp), PUBLIC ::   e3zps_rat            !: minimum thickness ration for partial steps
-   INTEGER , PUBLIC ::   nmsh                 !: = 1 create a mesh-mask file
-   INTEGER , PUBLIC ::   nacc                 !: = 0/1 use of the acceleration of convergence technique
-   REAL(wp), PUBLIC ::   atfp                 !: asselin time filter parameter
-   REAL(wp), PUBLIC ::   rdt                  !: time step for the dynamics (and tracer if nacc=0)
-   REAL(wp), PUBLIC ::   rdtmin               !: minimum time step on tracers
-   REAL(wp), PUBLIC ::   rdtmax               !: maximum time step on tracers
-   REAL(wp), PUBLIC ::   rdth                 !: depth variation of tracer step
-   INTEGER , PUBLIC ::   nclosea              !: =0 suppress closed sea/lake from the ORCA domain or not (=1)
-
-
-   !                                         !!! associated variables
+   INTEGER , PUBLIC ::   nn_baro      =   64       !: number of barotropic time steps (key_dynspg_ts)
+   INTEGER , PUBLIC ::   nn_closea    =    0       !: =0 suppress closed sea/lake from the ORCA domain or not (=1)
+
+   !                                    !! old non-DOCTOR names still used in the model
+   INTEGER , PUBLIC ::   ntopo           !: = 0/1 ,compute/read the bathymetry file
+   REAL(wp), PUBLIC ::   e3zps_min       !: miminum thickness for partial steps (meters)
+   REAL(wp), PUBLIC ::   e3zps_rat       !: minimum thickness ration for partial steps
+   INTEGER , PUBLIC ::   nmsh            !: = 1 create a mesh-mask file
+   INTEGER , PUBLIC ::   nacc            !: = 0/1 use of the acceleration of convergence technique
+   REAL(wp), PUBLIC ::   atfp            !: asselin time filter parameter
+   REAL(wp), PUBLIC ::   rdt             !: time step for the dynamics (and tracer if nacc=0)
+   REAL(wp), PUBLIC ::   rdtmin          !: minimum time step on tracers
+   REAL(wp), PUBLIC ::   rdtmax          !: maximum time step on tracers
+   REAL(wp), PUBLIC ::   rdth            !: depth variation of tracer step
+   INTEGER , PUBLIC ::   nclosea         !: =0 suppress closed sea/lake from the ORCA domain or not (=1)
+
+
+   !                                                  !!! associated variables
    INTEGER , PUBLIC                 ::   neuler  = 0   !: restart euler forward option (0=Euler)
    REAL(wp), PUBLIC                 ::   atfp1         !: asselin time filter coeff. (atfp1= 1-2*atfp)
@@ -55,7 +53,4 @@
    !                                         !!* Namelist namcla : cross land advection
    INTEGER, PUBLIC ::   nn_cla = 0            !: =1 cross land advection for exchanges through some straits (ORCA2)
-
-   !                                          ! old non-DOCTOR names still used in the model
-   INTEGER, PUBLIC ::   n_cla = 0             !: =1 cross land advection for exchanges through some straits (ORCA2)
 
    !!----------------------------------------------------------------------
@@ -120,8 +115,4 @@
    LOGICAL, PUBLIC ::   ln_zps     =  .FALSE.   !: z-coordinate - partial step
    LOGICAL, PUBLIC ::   ln_sco     =  .FALSE.   !: s-coordinate or hybrid z-s coordinate
-#if defined key_zco
-   LOGICAL, PUBLIC, PARAMETER ::   lk_zco = .TRUE.    !: z-coordinate flag (1D arrays)
-#else
-   LOGICAL, PUBLIC, PARAMETER ::   lk_zco = .FALSE.   !: z-coordinate flag (3D arrays)
 
    !! All coordinates
@@ -133,5 +124,4 @@
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   e3vw            !: analytical vertical scale factors at  VW--
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   e3w   , e3uw    !:                                        W--UW  points (m)
-#endif
 #if defined key_vvl
    LOGICAL, PUBLIC, PARAMETER ::   lk_vvl = .TRUE.    !: variable grid flag
@@ -145,4 +135,6 @@
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   e3vw_1             !: analytical vertical scale factors at  VW--
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   e3w_1  , e3uw_1    !:                                       W--UW  points (m)
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   e3t_b              !: before         -      -      -    -   T      points (m)
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   e3u_b  , e3v_b     !:   -            -      -      -    -   U--V   points (m)
 #else
    LOGICAL, PUBLIC, PARAMETER ::   lk_vvl = .FALSE.   !: fixed grid flag
@@ -159,5 +151,4 @@
    REAL(wp), PUBLIC, DIMENSION(jpk)     ::   gdept_0, gdepw_0   !: reference depth of t- and w-points (m)
    REAL(wp), PUBLIC, DIMENSION(jpk)     ::   e3t_0  , e3w_0     !: reference vertical scale factors at T- and W-pts (m)
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hdept  , hdepw     !: ocean bottom depth at T and W points
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   e3tp   , e3wp      !: ocean bottom level thickness at T and W points
 
@@ -172,18 +163,20 @@
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   scosrf, scobot   !: ocean surface and bottom topographies 
    !                                                          !  (if deviating from coordinate surfaces in HYBRID)
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hifv  , hiff     !: interface depth between stretching    at  V--F
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hift  , hifu     !: and quasi-uniform spacing                 T--U  points (m)
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hifv  , hiff     !: interface depth between stretching at  V--F
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hift  , hifu     !: and quasi-uniform spacing              T--U  points (m)
 
    !!----------------------------------------------------------------------
    !! masks, bathymetry
    !! ---------------------------------------------------------------------
-   INTEGER , PUBLIC, DIMENSION(jpi,jpj) ::   mbathy    !: number of ocean level (=0, 1, ... , jpk-1)
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   bathy     !: ocean depth (meters)
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   tmask_i   !: interior domain T-point mask
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   bmask     !: land/ocean mask of barotropic stream function
-
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   tmask, umask, vmask, fmask   !: land/ocean mask at T-, U-, V- and F-points
-
-   REAL(wp), PUBLIC, DIMENSION(jpiglo) ::   tpol, fpol          !: north fold mask (nperio= 3 or 4)
+   INTEGER , PUBLIC, DIMENSION(jpi,jpj) ::   mbathy       !: number of ocean level (=0, 1, ... , jpk-1)
+   INTEGER , PUBLIC, DIMENSION(jpi,jpj) ::   mbkt         !: vertical index of the bottom last T- ocean level
+   INTEGER , PUBLIC, DIMENSION(jpi,jpj) ::   mbku, mbkv   !: vertical index of the bottom last U- and W- ocean level
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   bathy        !: ocean depth (meters)
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   tmask_i      !: interior domain T-point mask
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   bmask        !: land/ocean mask of barotropic stream function
+
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   tmask, umask, vmask, fmask   !: land/ocean mask at T-, U-, V- and F-pts
+
+   REAL(wp), PUBLIC, DIMENSION(jpiglo) ::   tpol, fpol          !: north fold mask (jperio= 3 or 4)
 
 #if defined key_noslip_accurate
@@ -195,15 +188,17 @@
    !! calendar variables
    !! ---------------------------------------------------------------------
-   INTEGER , PUBLIC ::   nyear       !: current year
-   INTEGER , PUBLIC ::   nmonth      !: current month
-   INTEGER , PUBLIC ::   nday        !: current day of the month
-   INTEGER , PUBLIC ::   ndastp      !: time step date in yyyymmdd format
-   INTEGER , PUBLIC ::   nday_year   !: current day counted from jan 1st of the current year
-   INTEGER , PUBLIC ::   nsec_year   !: current time step counted in second since 00h jan 1st of the current year
-   INTEGER , PUBLIC ::   nsec_month  !: current time step counted in second since 00h 1st day of the current month
-   INTEGER , PUBLIC ::   nsec_day    !: current time step counted in second since 00h of the current day
-   REAL(wp), PUBLIC ::   fjulday     !: julian day 
-   REAL(wp), PUBLIC ::   adatrj      !: number of elapsed days since the begining of the whole simulation
-   !                                 !: (cumulative duration of previous runs that may have used different time-step size)
+   INTEGER , PUBLIC ::   nyear         !: current year
+   INTEGER , PUBLIC ::   nmonth        !: current month
+   INTEGER , PUBLIC ::   nday          !: current day of the month
+   INTEGER , PUBLIC ::   ndastp        !: time step date in yyyymmdd format
+   INTEGER , PUBLIC ::   nday_year     !: current day counted from jan 1st of the current year
+   INTEGER , PUBLIC ::   nsec_year     !: current time step counted in second since 00h jan 1st of the current year
+   INTEGER , PUBLIC ::   nsec_month    !: current time step counted in second since 00h 1st day of the current month
+   INTEGER , PUBLIC ::   nsec_week     !: current time step counted in second since 00h of last monday
+   INTEGER , PUBLIC ::   nsec_day      !: current time step counted in second since 00h of the current day
+   REAL(wp), PUBLIC ::   fjulday       !: current julian day 
+   REAL(wp), PUBLIC ::   fjulstartyear !: first day of the current year in julian days
+   REAL(wp), PUBLIC ::   adatrj        !: number of elapsed days since the begining of the whole simulation
+   !                                   !: (cumulative duration of previous runs that may have used different time-step size)
    INTEGER , PUBLIC, DIMENSION(0: 1) ::   nyear_len     !: length in days of the previous/current year
    INTEGER , PUBLIC, DIMENSION(0:13) ::   nmonth_len    !: length in days of the months of the current year
@@ -213,4 +208,12 @@
 
    !!----------------------------------------------------------------------
+   !! mpp reproducibility
+   !!----------------------------------------------------------------------
+#if defined key_mpp_rep
+   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp_rep = .TRUE.    !: agrif flag
+#else
+   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp_rep = .FALSE.   !: agrif flag
+#endif
+   !!----------------------------------------------------------------------
    !! agrif domain
    !!----------------------------------------------------------------------
@@ -229,5 +232,8 @@
    END FUNCTION Agrif_CFixed
 #endif
-
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!======================================================================
 END MODULE dom_oce
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90	(revision 2528)
@@ -11,4 +11,5 @@
    !!   NEMO     1.0  !  2002-08  (G. Madec)  F90: Free form and module
    !!            2.0  !  2005-11  (V. Garnier) Surface pressure gradient organization
+   !!            3.3  !  2010-11  (G. Madec)  initialisation in C1D configuration
    !!----------------------------------------------------------------------
    
@@ -18,6 +19,6 @@
    !!   dom_ctl        : control print for the ocean domain
    !!----------------------------------------------------------------------
-   USE oce             ! 
-   USE dom_oce         ! ocean space and time domain
+   USE oce             ! ocean variables
+   USE dom_oce         ! domain: ocean
    USE sbc_oce         ! surface boundary condition: ocean
    USE phycst          ! physical constants
@@ -32,4 +33,6 @@
    USE domwri          ! domain: write the meshmask file
    USE domvvl          ! variable volume
+   USE c1d             ! 1D vertical configuration
+   USE dyncor_c1d      ! Coriolis term (c1d case)         (cor_c1d routine)
 
    IMPLICIT NONE
@@ -41,9 +44,8 @@
 #  include "domzgr_substitute.h90"
    !!-------------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software is governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence        (NEMOGCM/NEMO_CeCILL.txt)
    !!-------------------------------------------------------------------------
-
 CONTAINS
 
@@ -62,4 +64,5 @@
       !!              - dom_stp: defined the model time step
       !!              - dom_wri: create the meshmask file if nmsh=1
+      !!              - 1D configuration, move Coriolis, u and v at T-point
       !!----------------------------------------------------------------------
       INTEGER ::   jk                ! dummy loop argument
@@ -79,4 +82,10 @@
                              CALL dom_msk      ! Masks
       IF( lk_vvl         )   CALL dom_vvl      ! Vertical variable mesh
+      !
+      IF( lk_c1d ) THEN                        ! 1D configuration 
+         CALL cor_c1d                          ! Coriolis set at T-point
+         umask(:,:,:) = tmask(:,:,:)           ! U, V moved at T-point
+         vmask(:,:,:) = tmask(:,:,:)
+      END IF
       !
       hu(:,:) = 0.e0                           ! Ocean depth at U- and V-points
@@ -106,4 +115,5 @@
       !!              - namdom namelist
       !!              - namcla namelist
+      !!              - namnc4 namelist   ! "key_netcdf4" only
       !!----------------------------------------------------------------------
       USE ioipsl
@@ -111,8 +121,11 @@
          &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock ,   &
          &             nn_write, ln_dimgnnn, ln_mskland  , ln_clobber   , nn_chunksz
-      NAMELIST/namdom/ nn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh   ,   &
-         &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin,   &
+      NAMELIST/namdom/ nn_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
       NAMELIST/namcla/ nn_cla
+#if defined key_netcdf4
+      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
+#endif
       !!----------------------------------------------------------------------
 
@@ -166,19 +179,23 @@
       ENDIF
 
+#if defined key_agrif
       IF( Agrif_Root() ) THEN
-         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
-      ENDIF
-
-      REWIND( numnam )             ! Namelist namdom : space & time domain (bathymetry, mesh, timestep)
+#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 )              ! Namelist namdom : space & time domain (bathymetry, mesh, timestep)
       READ  ( numnam, namdom )
 
@@ -187,11 +204,13 @@
          WRITE(numout,*) '   Namelist namdom : space & time domain'
          WRITE(numout,*) '      flag read/compute bathymetry      nn_bathy     = ', nn_bathy
+         WRITE(numout,*) '      min depth of the ocean    (>0) or    rn_hmin   = ', rn_hmin
+         WRITE(numout,*) '      min number of ocean level (<0)       '
          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,*) '           = 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
@@ -216,5 +235,5 @@
       nclosea   = nn_closea
 
-      REWIND( numnam )             ! Namelist cross land advection
+      REWIND( numnam )              ! Namelist cross land advection
       READ  ( numnam, namcla )
       IF(lwp) THEN
@@ -224,7 +243,26 @@
       ENDIF
 
-      n_cla = nn_cla                ! conversion DOCTOR names into model names (this should disappear soon)
-
-      IF( nbit_cmp == 1 .AND. n_cla /= 0 )   CALL ctl_stop( ' Reproductibility tests (nbit_cmp=1) require n_cla = 0' )
+#if defined key_netcdf4
+      !                             ! NetCDF 4 case   ("key_netcdf4" defined)
+      REWIND( numnam )                    ! Namelist namnc4 : netcdf4 chunking parameters
+      READ  ( numnam, 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
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domcfg.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domcfg.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domcfg.F90	(revision 2528)
@@ -24,5 +24,5 @@
    !! NEMO/OPA 3.2 , LODYC-IPSL  (2009)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90	(revision 2528)
@@ -4,43 +4,37 @@
    !! Ocean initialization : domain initialization
    !!==============================================================================
-   !! History :       !  88-03  (G. Madec)
-   !!                 !  91-11  (G. Madec)
-   !!                 !  92-06  (M. Imbard)
-   !!                 !  96-01  (G. Madec)  terrain following coordinates
-   !!                 !  97-02  (G. Madec)  print mesh informations
-   !!                 !  99-11  (M. Imbard) NetCDF format with IO-IPSL
-   !!                 !  00-08  (D. Ludicone) Reduced section at Bab el Mandeb
-   !!                 !  01-09  (M. Levy)  eel config: grid in km, beta-plane
-   !!            8.5  !  02-08  (G. Madec)  F90: Free form and module, namelist
-   !!            9.0  !  04-01  (A.M. Treguier, J.M. Molines) Case 4 (Mercator mesh)
-   !!                           use of parameters in par_CONFIG-Rxx.h90, not in namelist
-   !!                 !  04-05  (A. Koch-Larrouy) Add Gyre configuration 
+   !! History :  OPA  ! 1988-03  (G. Madec) Original code
+   !!            7.0  ! 1996-01  (G. Madec)  terrain following coordinates
+   !!            8.0  ! 1997-02  (G. Madec)  print mesh informations
+   !!            8.1  ! 1999-11  (M. Imbard) NetCDF format with IO-IPSL
+   !!            8.2  ! 2000-08  (D. Ludicone) Reduced section at Bab el Mandeb
+   !!             -   ! 2001-09  (M. Levy)  eel config: grid in km, beta-plane
+   !!  NEMO      1.0  ! 2002-08  (G. Madec)  F90: Free form and module, namelist
+   !!             -   ! 2004-01  (A.M. Treguier, J.M. Molines) Case 4 (Mercator mesh)
+   !!                            use of parameters in par_CONFIG-Rxx.h90, not in namelist
+   !!             -   ! 2004-05  (A. Koch-Larrouy) Add Gyre configuration 
    !!----------------------------------------------------------------------
 
    !!----------------------------------------------------------------------
-   !!   dom_hgr        : initialize the horizontal mesh 
-   !!   hgr_read       : read "coordinate" NetCDF file 
+   !!   dom_hgr       : initialize the horizontal mesh 
+   !!   hgr_read      : read "coordinate" NetCDF file 
    !!----------------------------------------------------------------------
-   !! * Modules used
-   USE dom_oce         ! ocean space and time domain
-   USE phycst          ! physical constants
-   USE in_out_manager  ! I/O manager
-   USE lib_mpp
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constants
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
 
    IMPLICIT NONE
    PRIVATE
 
-   !! * Module variables
-   REAL(wp) ::   glam0, gphi0           ! variables corresponding to parameters
-      !                                 ! ppglam0 ppgphi0 set in par_oce
-
-   !! * Routine accessibility
-   PUBLIC dom_hgr        ! called by domain.F90
+   REAL(wp) ::   glam0, gphi0   ! variables corresponding to parameters ppglam0 ppgphi0 set in par_oce
+
+   PUBLIC   dom_hgr   ! called by domain.F90
+
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -100,15 +94,13 @@
       !!                Madec, Imbard, 1996, Clim. Dyn.
       !!----------------------------------------------------------------------
-      INTEGER  ::   ji, jj              ! dummy loop indices
-      INTEGER  ::   ii0, ii1, ij0, ij1  ! temporary integers
-      INTEGER  ::   ijeq                ! index of equator T point (used in case 4)
-      REAL(wp) ::   &
-         zti, zui, zvi, zfi,         &  ! temporary scalars
-         ztj, zuj, zvj, zfj,         &  !
-         zphi0, zbeta, znorme,       &  !
-         zarg, zf0, zminff, zmaxff
-      REAL(wp) ::   &
-         zlam1, zcos_alpha, zim1 , zjm1 , ze1, ze1deg,   &
-         zphi1, zsin_alpha, zim05, zjm05
+      INTEGER  ::   ji, jj               ! dummy loop indices
+      INTEGER  ::   ii0, ii1, ij0, ij1   ! temporary integers
+      INTEGER  ::   ijeq                 ! index of equator T point (used in case 4)
+      REAL(wp) ::   zti, zui, zvi, zfi   ! local scalars
+      REAL(wp) ::   ztj, zuj, zvj, zfj   !   -      -
+      REAL(wp) ::   zphi0, zbeta, znorme !
+      REAL(wp) ::   zarg, zf0, zminff, zmaxff
+      REAL(wp) ::   zlam1, zcos_alpha, zim1 , zjm1 , ze1, ze1deg
+      REAL(wp) ::   zphi1, zsin_alpha, zim05, zjm05
       !!----------------------------------------------------------------------
 
@@ -138,5 +130,5 @@
          IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration
             !                                             ! =====================
-            IF( n_cla == 0 ) THEN
+            IF( nn_cla == 0 ) THEN
                !
                ii0 = 139   ;   ii1 = 140        ! Gibraltar Strait (e2u = 20 km)
@@ -157,4 +149,56 @@
             IF(lwp) WRITE(numout,*)
             IF(lwp) WRITE(numout,*) '             orca_r2: Danish Straits : e2u reduced to 10 km'
+            !
+         ENDIF
+
+            !                                             ! =====================
+         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
+            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
+            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
+            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
+            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
+            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
+            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
+            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
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '             orca_r1: E Halmahera : e1v reduced to 50 km'
+
+            !
+
+            !
+            !
+            !
             !
          ENDIF
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90	(revision 2528)
@@ -5,12 +5,12 @@
    !!======================================================================
    !! History :  OPA  ! 1987-07  (G. Madec)  Original code
-   !!             -   ! 1993-03  (M. Guyon)  symetrical conditions (M. Guyon)
-   !!             -   ! 1996-01  (G. Madec)  suppression of common work arrays
+   !!            6.0  ! 1993-03  (M. Guyon)  symetrical conditions (M. Guyon)
+   !!            7.0  ! 1996-01  (G. Madec)  suppression of common work arrays
    !!             -   ! 1996-05  (G. Madec)  mask computed from tmask and sup-
    !!                 !                      pression of the double computation of bmask
-   !!             -   ! 1997-02  (G. Madec)  mesh information put in domhgr.F
-   !!             -   ! 1997-07  (G. Madec)  modification of mbathy and fmask
+   !!            8.0  ! 1997-02  (G. Madec)  mesh information put in domhgr.F
+   !!            8.1  ! 1997-07  (G. Madec)  modification of mbathy and fmask
    !!             -   ! 1998-05  (G. Roullet)  free surface
-   !!             -   ! 2000-03  (G. Madec)  no slip accurate
+   !!            8.2  ! 2000-03  (G. Madec)  no slip accurate
    !!             -   ! 2001-09  (J.-M. Molines)  Open boundaries
    !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90: Free form and module
@@ -44,7 +44,6 @@
    !! NEMO/OPA 3.2 , LODYC-IPSL  (2009)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
    
@@ -56,5 +55,4 @@
       !!      zontal velocity points (u & v), vorticity points (f) and baro-
       !!      tropic stream function  points (b).
-      !!        Set mbathy to the number of non-zero w-levels of a water column
       !!
       !! ** Method  :   The ocean/land mask is computed from the basin bathy-
@@ -73,7 +71,10 @@
       !!                   or mbathy(ji+1,jj)  or mbathy(ji+1,jj+1) =< 0
       !!                1. IF mbathy( ji ,jj) and mbathy( ji ,jj+1)
-      !!                and mbathy(ji+1,jj) and mbathy(ji+1,jj+1) >= jk.
+      !!                  and mbathy(ji+1,jj) and mbathy(ji+1,jj+1) >= jk.
       !!      b-point : the same definition as for f-point of the first ocean
       !!                level (surface level) but with 0 along coastlines.
+      !!      tmask_i : interior ocean mask at t-point, i.e. excluding duplicated
+      !!                rows/lines due to cyclic or North Fold boundaries as well
+      !!                as MPP halos.
       !!
       !!        The lateral friction is set through the value of fmask along
@@ -99,8 +100,4 @@
       !!        - bmask is  set to 0 on the open boundaries.
       !!
-      !!      Set mbathy to the number of non-zero w-levels of a water column
-      !!                  mbathy = min( mbathy, 1 ) + 1
-      !!      (note that the minimum value of mbathy is 2).
-      !!
       !! ** Action :   tmask    : land/ocean mask at t-point (=0. or 1.)
       !!               umask    : land/ocean mask at u-point (=0. or 1.)
@@ -110,5 +107,5 @@
       !!               bmask    : land/ocean mask at barotropic stream
       !!                          function point (=0. or 1.) and set to 0 along lateral boundaries
-      !!               mbathy   : number of non-zero w-levels 
+      !!               tmask_i  : interior ocean mask
       !!----------------------------------------------------------------------
       INTEGER  ::   ji, jj, jk      ! dummy loop indices
@@ -132,5 +129,5 @@
       ENDIF
 
-      IF     (      rn_shlat == 0.               ) THEN   ;   IF(lwp) WRITE(numout,*) '   ocean lateral free-slip '
+      IF     (      rn_shlat == 0.               ) THEN   ;   IF(lwp) WRITE(numout,*) '   ocean lateral  free-slip '
       ELSEIF (      rn_shlat == 2.               ) THEN   ;   IF(lwp) WRITE(numout,*) '   ocean lateral  no-slip '
       ELSEIF ( 0. < rn_shlat .AND. rn_shlat < 2. ) THEN   ;   IF(lwp) WRITE(numout,*) '   ocean lateral  partial-slip '
@@ -145,9 +142,9 @@
       ! N.B. tmask has already the right boundary conditions since mbathy is ok
       !
-      tmask(:,:,:) = 0.e0
+      tmask(:,:,:) = 0._wp
       DO jk = 1, jpk
          DO jj = 1, jpj
             DO ji = 1, jpi
-               IF( REAL( mbathy(ji,jj) - jk ) +.1 >= 0.e0 )   tmask(ji,jj,jk) = 1.e0
+               IF( REAL( mbathy(ji,jj) - jk, wp ) + 0.1_wp >= 0._wp )   tmask(ji,jj,jk) = 1._wp
             END DO  
          END DO  
@@ -160,5 +157,5 @@
             ij0 =  87   ;   ij1 =  88
             ii0 = 160   ;   ii1 = 161
-            tmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 0.e0
+            tmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 0._wp
          ELSE
             IF(lwp) WRITE(numout,*)
@@ -182,16 +179,16 @@
       ijl = nlcj - jprecj + 1
 
-      tmask_i( 1 :iif,   :   ) = 0.e0      ! first columns
-      tmask_i(iil:jpi,   :   ) = 0.e0      ! last  columns (including mpp extra columns)
-      tmask_i(   :   , 1 :ijf) = 0.e0      ! first rows
-      tmask_i(   :   ,ijl:jpj) = 0.e0      ! last  rows (including mpp extra rows)
+      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.e0 
-      fpol(1:jpiglo) = 1.e0
+      tpol(1:jpiglo) = 1._wp 
+      fpol(1:jpiglo) = 1._wp
       IF( jperio == 3 .OR. jperio == 4 ) THEN      ! T-point pivot
-         tpol(jpiglo/2+1:jpiglo) = 0.e0
-         fpol(     1    :jpiglo) = 0.e0
+         tpol(jpiglo/2+1:jpiglo) = 0._wp
+         fpol(     1    :jpiglo) = 0._wp
          IF( mjg(nlej) == jpjglo ) THEN                  ! only half of the nlcj-1 row
             DO ji = iif+1, iil-1
@@ -201,6 +198,6 @@
       ENDIF
       IF( jperio == 5 .OR. jperio == 6 ) THEN      ! F-point pivot
-         tpol(     1    :jpiglo) = 0.e0
-         fpol(jpiglo/2+1:jpiglo) = 0.e0
+         tpol(     1    :jpiglo) = 0._wp
+         fpol(jpiglo/2+1:jpiglo) = 0._wp
       ENDIF
 
@@ -219,7 +216,7 @@
          END DO
       END DO
-      CALL lbc_lnk( umask, 'U', 1. )      ! Lateral boundary conditions
-      CALL lbc_lnk( vmask, 'V', 1. )
-      CALL lbc_lnk( fmask, 'F', 1. )
+      CALL lbc_lnk( umask, 'U', 1._wp )      ! Lateral boundary conditions
+      CALL lbc_lnk( vmask, 'V', 1._wp )
+      CALL lbc_lnk( fmask, 'F', 1._wp )
 
 
@@ -231,9 +228,9 @@
       !                                    ! cyclic east-west : bmask must be set to 0. on rows 1 and jpi
       IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN
-         bmask( 1 ,:) = 0.e0
-         bmask(jpi,:) = 0.e0
+         bmask( 1 ,:) = 0._wp
+         bmask(jpi,:) = 0._wp
       ENDIF
       IF( nperio == 2 ) THEN               ! south symmetric :  bmask must be set to 0. on row 1
-         bmask(:, 1 ) = 0.e0
+         bmask(:, 1 ) = 0._wp
       ENDIF
       !                                    ! north fold : 
@@ -242,17 +239,17 @@
             ii = ji + nimpp - 1
             bmask(ji,jpj-1) = bmask(ji,jpj-1) * tpol(ii)
-            bmask(ji,jpj  ) = 0.e0
+            bmask(ji,jpj  ) = 0._wp
          END DO
       ENDIF
       IF( nperio == 5 .OR. nperio == 6 ) THEN   ! F-pt pivot and T-pt elliptic eq. : bmask set to 0. on row jpj
-         bmask(:,jpj) = 0.e0
+         bmask(:,jpj) = 0._wp
       ENDIF
       !
       IF( lk_mpp ) THEN                    ! mpp specificities
          !                                      ! bmask is set to zero on the overlap region
-         IF( nbondi /= -1 .AND. nbondi /= 2 )   bmask(  1 :jpreci,:) = 0.e0
-         IF( nbondi /=  1 .AND. nbondi /= 2 )   bmask(nlci:jpi   ,:) = 0.e0
-         IF( nbondj /= -1 .AND. nbondj /= 2 )   bmask(:,  1 :jprecj) = 0.e0
-         IF( nbondj /=  1 .AND. nbondj /= 2 )   bmask(:,nlcj:jpj   ) = 0.e0
+         IF( nbondi /= -1 .AND. nbondi /= 2 )   bmask(  1 :jpreci,:) = 0._wp
+         IF( nbondi /=  1 .AND. nbondi /= 2 )   bmask(nlci:jpi   ,:) = 0._wp
+         IF( nbondj /= -1 .AND. nbondj /= 2 )   bmask(:,  1 :jprecj) = 0._wp
+         IF( nbondj /=  1 .AND. nbondj /= 2 )   bmask(:,nlcj:jpj   ) = 0._wp
          !
          IF( npolj == 3 .OR. npolj == 4 ) THEN  ! north fold : bmask must be set to 0. on rows jpj-1 and jpj
@@ -260,10 +257,10 @@
                ii = ji + nimpp - 1
                bmask(ji,nlcj-1) = bmask(ji,nlcj-1) * tpol(ii)
-               bmask(ji,nlcj  ) = 0.e0
+               bmask(ji,nlcj  ) = 0._wp
             END DO
          ENDIF
          IF( npolj == 5 .OR. npolj == 6 ) THEN  ! F-pt pivot and T-pt elliptic eq. : bmask set to 0. on row jpj
             DO ji = 1, nlci
-               bmask(ji,nlcj  ) = 0.e0
+               bmask(ji,nlcj  ) = 0._wp
             END DO
          ENDIF
@@ -282,24 +279,24 @@
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               IF( fmask(ji,jj,jk) == 0. ) THEN
-                  fmask(ji,jj,jk) = rn_shlat * MIN( 1., MAX( zwf(ji+1,jj), zwf(ji,jj+1),   &
-                     &                                       zwf(ji-1,jj), zwf(ji,jj-1)  )  )
+               IF( fmask(ji,jj,jk) == 0._wp ) THEN
+                  fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1),   &
+                     &                                           zwf(ji-1,jj), zwf(ji,jj-1)  )  )
                ENDIF
             END DO
          END DO
          DO jj = 2, jpjm1
-            IF( fmask(1,jj,jk) == 0. ) THEN
-               fmask(1  ,jj,jk) = rn_shlat * MIN( 1., MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) )
-            ENDIF
-            IF( fmask(jpi,jj,jk) == 0. ) THEN
-               fmask(jpi,jj,jk) = rn_shlat * MIN( 1., MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) )
+            IF( fmask(1,jj,jk) == 0._wp ) THEN
+               fmask(1  ,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) )
+            ENDIF
+            IF( fmask(jpi,jj,jk) == 0._wp ) THEN
+               fmask(jpi,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) )
             ENDIF
          END DO         
          DO ji = 2, jpim1
-            IF( fmask(ji,1,jk) == 0. ) THEN
-               fmask(ji, 1 ,jk) = rn_shlat * MIN( 1., MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) )
-            ENDIF
-            IF( fmask(ji,jpj,jk) == 0. ) THEN
-               fmask(ji,jpj,jk) = rn_shlat * MIN( 1., MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) )
+            IF( fmask(ji,1,jk) == 0._wp ) THEN
+               fmask(ji, 1 ,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) )
+            ENDIF
+            IF( fmask(ji,jpj,jk) == 0._wp ) THEN
+               fmask(ji,jpj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) )
             ENDIF
          END DO
@@ -308,39 +305,68 @@
       IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN   ! ORCA_R2 configuration
          !                                                 ! Increased lateral friction near of some straits
-         IF( n_cla == 0 ) THEN
+         IF( nn_cla == 0 ) THEN
             !                                ! Gibraltar strait  : partial slip (fmask=0.5)
             ij0 = 101   ;   ij1 = 101
-            ii0 = 139   ;   ii1 = 140   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.5e0
+            ii0 = 139   ;   ii1 = 140   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.5_wp
             ij0 = 102   ;   ij1 = 102
-            ii0 = 139   ;   ii1 = 140   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.5e0
+            ii0 = 139   ;   ii1 = 140   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.5_wp
             !
             !                                ! Bab el Mandeb : partial slip (fmask=1)
             ij0 =  87   ;   ij1 =  88
-            ii0 = 160   ;   ii1 = 160   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  1.e0
+            ii0 = 160   ;   ii1 = 160   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  1._wp
             ij0 =  88   ;   ij1 =  88
-            ii0 = 159   ;   ii1 = 159   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  1.e0
+            ii0 = 159   ;   ii1 = 159   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  1._wp
             !
          ENDIF
-
          !                                ! Danish straits  : strong slip (fmask > 2)
 ! We keep this as an example but it is instable in this case 
 !         ij0 = 115   ;   ij1 = 115
-!         ii0 = 145   ;   ii1 = 146   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4.0e0
+!         ii0 = 145   ;   ii1 = 146   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4._wp
 !         ij0 = 116   ;   ij1 = 116
-!         ii0 = 145   ;   ii1 = 146   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4.0e0
+!         ii0 = 145   ;   ii1 = 146   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4._wp
          !
       ENDIF
       !
-      CALL lbc_lnk( fmask, 'F', 1. )      ! Lateral boundary conditions on fmask
-
-      
-      ! Mbathy set to the number of w-level (minimum value 2)
-      ! -----------------------------------
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            mbathy(ji,jj) = MAX( 1, mbathy(ji,jj) ) + 1
-         END DO
-      END DO
-      
+      IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN   ! ORCA R1 configuration
+         !                                                 ! Increased lateral friction near of some straits
+         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  
+
+         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  
+
+         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  
+
+         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  
+
+         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  
+
+         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  
+
+         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  
+
+         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  
+         !
+      ENDIF
+      !
+      CALL lbc_lnk( fmask, 'F', 1._wp )      ! Lateral boundary conditions on fmask
+
+            
       IF( nprint == 1 .AND. lwp ) THEN      ! Control print
          imsk(:,:) = INT( tmask_i(:,:) )
@@ -385,5 +411,5 @@
          imsk(:,:) = INT( bmask(:,:) )
          CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1,   &
-               &                           1, jpj, 1, 1, numout )
+            &                              1, jpj, 1, 1, numout )
       ENDIF
       !
@@ -404,5 +430,4 @@
       !!
       !! ** Action :
-      !!
       !!----------------------------------------------------------------------
       INTEGER  :: ji, jj, jk, jl      ! dummy loop indices
@@ -448,5 +473,5 @@
                zaa = tmask(ji  ,jj,jk) + tmask(ji  ,jj+1,jk)   &
                   &+ tmask(ji+1,jj,jk) + tmask(ji+1,jj+1,jk)
-               IF( ABS(zaa-3.) <= 0.1 )   fmask(ji,jj,jk) = 1.
+               IF( ABS(zaa-3._wp) <= 0.1_wp )   fmask(ji,jj,jk) = 1._wp
             END DO
          END DO
@@ -461,5 +486,5 @@
             DO ji = 2, jpim1
                zaa = tmask(ji+1,jj,jk) + tmask(ji+1,jj+1,jk)
-               IF( ABS(zaa-2.) <= 0.1 .AND. fmask(ji,jj,jk) == 0 ) THEN
+               IF( ABS(zaa-2._wp) <= 0.1_wp .AND. fmask(ji,jj,jk) == 0._wp ) THEN
                   inw = inw + 1
                   nicoa(inw,1,jk) = ji
@@ -468,5 +493,5 @@
                ENDIF
                zaa = tmask(ji,jj,jk) + tmask(ji,jj+1,jk)
-               IF( ABS(zaa-2.) <= 0.1 .AND. fmask(ji,jj,jk) == 0 ) THEN
+               IF( ABS(zaa-2._wp) <= 0.1_wp .AND. fmask(ji,jj,jk) == 0._wp ) THEN
                   ine = ine + 1
                   nicoa(ine,2,jk) = ji
@@ -488,5 +513,5 @@
             DO ji =2, jpim1
                zaa = tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk)
-               IF( ABS(zaa-2.) <= 0.1 .AND. fmask(ji,jj,jk) == 0 ) THEN
+               IF( ABS(zaa-2._wp) <= 0.1_wp .AND. fmask(ji,jj,jk) == 0._wp ) THEN
                   ins = ins + 1
                   nicoa(ins,3,jk) = ji
@@ -495,5 +520,5 @@
                ENDIF
                zaa = tmask(ji+1,jj,jk) + tmask(ji,jj,jk)
-               IF( ABS(zaa-2.) <= 0.1 .AND. fmask(ji,jj,jk) == 0 ) THEN
+               IF( ABS(zaa-2._wp) <= 0.1_wp .AND. fmask(ji,jj,jk) == 0._wp ) THEN
                   inn = inn + 1
                   nicoa(inn,4,jk) = ji
@@ -524,6 +549,6 @@
       iind = 0
       ijnd = 0
-      IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) iind = 2
-      IF( nperio == 3 .OR. nperio == 4 .OR. nperio == 5 .OR. nperio == 6 ) ijnd = 2
+      IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 )   iind = 2
+      IF( nperio == 3 .OR. nperio == 4 .OR. nperio == 5 .OR. nperio == 6 )   ijnd = 2
       DO jk = 1, jpk
          DO jl = 1, npcoa(1,jk)
@@ -551,10 +576,10 @@
             ENDIF
          END DO
-         DO jl=1,npcoa(4,jk)
+         DO jl = 1, npcoa(4,jk)
             IF( njcoa(jl,4,jk)-2 < 1) THEN
-               ierror=ierror+1
-               icoord(ierror,1)=nicoa(jl,4,jk)
-               icoord(ierror,2)=njcoa(jl,4,jk)
-               icoord(ierror,3)=jk
+               ierror=ierror + 1
+               icoord(ierror,1) = nicoa(jl,4,jk)
+               icoord(ierror,2) = njcoa(jl,4,jk)
+               icoord(ierror,3) = jk
             ENDIF
          END DO
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domngb.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domngb.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domngb.F90	(revision 2528)
@@ -19,7 +19,7 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2008) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domstp.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domstp.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domstp.F90	(revision 2528)
@@ -27,7 +27,7 @@
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90	(revision 2528)
@@ -36,7 +36,7 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -51,5 +51,7 @@
       !!----------------------------------------------------------------------
       INTEGER  ::   ji, jj, jk
-      REAL(wp) ::   zcoefu, zcoefv, zcoeff
+      REAL(wp) ::   zcoefu , zcoefv   , zcoeff                   ! temporary scalars
+      REAL(wp) ::   zv_t_ij, zv_t_ip1j, zv_t_ijp1, zv_t_ip1jp1   !     -        -
+      REAL(wp), DIMENSION(jpi,jpj) ::  zs_t, zs_u_1, zs_v_1      !     -     2D workspace
       !!----------------------------------------------------------------------
 
@@ -60,31 +62,15 @@
       ENDIF
 
-      IF( lk_zco )   CALL ctl_stop( 'dom_vvl : key_zco is incompatible with variable volume option key_vvl')
 
-      IF( ln_zco) THEN
-         DO jk = 1, jpk
-            gdept(:,:,jk) = gdept_0(jk)
-            gdepw(:,:,jk) = gdepw_0(jk)
-            gdep3w(:,:,jk) = gdepw_0(jk)
-            e3t (:,:,jk) = e3t_0(jk)
-            e3u (:,:,jk) = e3t_0(jk)
-            e3v (:,:,jk) = e3t_0(jk)
-            e3f (:,:,jk) = e3t_0(jk)
-            e3w (:,:,jk) = e3w_0(jk)
-            e3uw(:,:,jk) = e3w_0(jk)
-            e3vw(:,:,jk) = e3w_0(jk)
-         END DO
-      ELSE
-         fsdept(:,:,:) = gdept (:,:,:)
-         fsdepw(:,:,:) = gdepw (:,:,:)
-         fsde3w(:,:,:) = gdep3w(:,:,:)
-         fse3t (:,:,:) = e3t   (:,:,:)
-         fse3u (:,:,:) = e3u   (:,:,:)
-         fse3v (:,:,:) = e3v   (:,:,:)
-         fse3f (:,:,:) = e3f   (:,:,:)
-         fse3w (:,:,:) = e3w   (:,:,:)
-         fse3uw(:,:,:) = e3uw  (:,:,:)
-         fse3vw(:,:,:) = e3vw  (:,:,:)
-      ENDIF
+      fsdept(:,:,:) = gdept (:,:,:)
+      fsdepw(:,:,:) = gdepw (:,:,:)
+      fsde3w(:,:,:) = gdep3w(:,:,:)
+      fse3t (:,:,:) = e3t   (:,:,:)
+      fse3u (:,:,:) = e3u   (:,:,:)
+      fse3v (:,:,:) = e3v   (:,:,:)
+      fse3f (:,:,:) = e3f   (:,:,:)
+      fse3w (:,:,:) = e3w   (:,:,:)
+      fse3uw(:,:,:) = e3uw  (:,:,:)
+      fse3vw(:,:,:) = e3vw  (:,:,:)
 
       !                                 !==  mu computation  ==!
@@ -130,44 +116,55 @@
          hv_0(:,:) = hv_0(:,:) + fse3v_0(:,:,jk) * vmask(:,:,jk)
       END DO
+      
+      ! surface at t-points and inverse surface at (u/v)-points used in surface averaging computations
+      ! for ssh and scale factors
+      zs_t  (:,:) =       e1t(:,:) * e2t(:,:)
+      zs_u_1(:,:) = 0.5 / e1u(:,:) * e2u(:,:)
+      zs_v_1(:,:) = 0.5 / e1v(:,:) * e2v(:,:)
 
       DO jj = 1, jpjm1                          ! initialise before and now Sea Surface Height at u-, v-, f-points
          DO ji = 1, jpim1   ! NO vector opt.
-            zcoefu = 0.5  * umask(ji,jj,1) / ( e1u(ji,jj) * e2u(ji,jj) )
-            zcoefv = 0.5  * vmask(ji,jj,1) / ( e1v(ji,jj) * e2v(ji,jj) )
-            zcoeff = 0.25 * umask(ji,jj,1) * umask(ji,jj+1,1)
-            sshu_b(ji,jj) = zcoefu * ( e1t(ji  ,jj) * e2t(ji  ,jj) * sshb(ji  ,jj)     &
-               &                     + e1t(ji+1,jj) * e2t(ji+1,jj) * sshb(ji+1,jj) )   
-            sshv_b(ji,jj) = zcoefv * ( e1t(ji,jj  ) * e2t(ji,jj  ) * sshb(ji,jj  )     &
-               &                     + e1t(ji,jj+1) * e2t(ji,jj+1) * sshb(ji,jj+1) )   
-            sshf_b(ji,jj) = zcoeff * ( sshb(ji  ,jj) + sshb(ji  ,jj+1)                 &
-               &                     + sshb(ji+1,jj) + sshb(ji+1,jj+1) )               
-            sshu_n(ji,jj) = zcoefu * ( e1t(ji  ,jj) * e2t(ji  ,jj) * sshn(ji  ,jj)     &
-               &                     + e1t(ji+1,jj) * e2t(ji+1,jj) * sshn(ji+1,jj) )   
-            sshv_n(ji,jj) = zcoefv * ( e1t(ji,jj  ) * e2t(ji,jj  ) * sshn(ji,jj  )     & 
-               &                     + e1t(ji,jj+1) * e2t(ji,jj+1) * sshn(ji,jj+1) )     
-            sshf_n(ji,jj) = zcoeff * ( sshn(ji  ,jj) + sshn(ji  ,jj+1)                 &
-               &                     + sshn(ji+1,jj) + sshn(ji+1,jj+1) )               
+            zcoefu = umask(ji,jj,1) * zs_u_1(ji,jj)
+            zcoefv = vmask(ji,jj,1) * zs_v_1(ji,jj)
+            zcoeff = 0.5 * umask(ji,jj,1) * umask(ji,jj+1,1) / ( e1f(ji,jj) * e2f(ji,jj) )
+            ! before fields
+            zv_t_ij       = zs_t(ji  ,jj  ) * sshb(ji  ,jj  )
+            zv_t_ip1j     = zs_t(ji+1,jj  ) * sshb(ji+1,jj  )
+            zv_t_ijp1     = zs_t(ji  ,jj+1) * sshb(ji  ,jj+1)
+            sshu_b(ji,jj) = zcoefu * ( zv_t_ij + zv_t_ip1j )
+            sshv_b(ji,jj) = zcoefv * ( zv_t_ij + zv_t_ijp1 )
+            ! now fields
+            zv_t_ij       = zs_t(ji  ,jj  ) * sshn(ji  ,jj  )
+            zv_t_ip1j     = zs_t(ji+1,jj  ) * sshn(ji+1,jj  )
+            zv_t_ijp1     = zs_t(ji  ,jj+1) * sshn(ji  ,jj+1)
+            zv_t_ip1jp1   = zs_t(ji  ,jj+1) * sshn(ji  ,jj+1)
+            sshu_n(ji,jj) = zcoefu * ( zv_t_ij + zv_t_ip1j )
+            sshv_n(ji,jj) = zcoefv * ( zv_t_ij + zv_t_ijp1 )
+            sshf_n(ji,jj) = zcoeff * ( zv_t_ij + zv_t_ip1j + zv_t_ijp1 + zv_t_ip1jp1 )
          END DO
       END DO
-      CALL lbc_lnk( sshu_b, 'U', 1. )   ;   CALL lbc_lnk( sshu_n, 'U', 1. )      ! lateral boundary conditions
-      CALL lbc_lnk( sshv_b, 'V', 1. )   ;   CALL lbc_lnk( sshv_n, 'V', 1. )
-      CALL lbc_lnk( sshf_b, 'F', 1. )   ;   CALL lbc_lnk( sshf_n, 'F', 1. )
+      CALL lbc_lnk( sshu_n, 'U', 1. )   ;   CALL lbc_lnk( sshu_b, 'U', 1. )      ! lateral boundary conditions
+      CALL lbc_lnk( sshv_n, 'V', 1. )   ;   CALL lbc_lnk( sshv_b, 'V', 1. )
+      CALL lbc_lnk( sshf_n, 'F', 1. )
+
+                                                ! initialise before scale factors at (u/v)-points
+      ! Scale factor anomaly at (u/v)-points: surface averaging of scale factor at t-points
+      DO jk = 1, jpkm1
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               zv_t_ij           = zs_t(ji  ,jj  ) * fse3t_b(ji  ,jj  ,jk)
+               zv_t_ip1j         = zs_t(ji+1,jj  ) * fse3t_b(ji+1,jj  ,jk)
+               zv_t_ijp1         = zs_t(ji  ,jj+1) * fse3t_b(ji  ,jj+1,jk)
+               fse3u_b(ji,jj,jk) = umask(ji,jj,jk) * ( zs_u_1(ji,jj) * ( zv_t_ij + zv_t_ip1j ) - fse3u_0(ji,jj,jk) )
+               fse3v_b(ji,jj,jk) = vmask(ji,jj,jk) * ( zs_v_1(ji,jj) * ( zv_t_ij + zv_t_ijp1 ) - fse3v_0(ji,jj,jk) )
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( fse3u_b(:,:,:), 'U', 1. )               ! lateral boundary conditions
+      CALL lbc_lnk( fse3v_b(:,:,:), 'V', 1. )
+      ! Add initial scale factor to scale factor anomaly
+      fse3u_b(:,:,:) = fse3u_b(:,:,:) + fse3u_0(:,:,:)
+      fse3v_b(:,:,:) = fse3v_b(:,:,:) + fse3v_0(:,:,:)
       !
-         DO jk = 1, jpkm1
-            fsdept(:,:,jk) = fsdept_n(:,:,jk)          ! now local depths stored in fsdep. arrays
-            fsdepw(:,:,jk) = fsdepw_n(:,:,jk)
-            fsde3w(:,:,jk) = fsde3w_n(:,:,jk)
-            !
-            fse3t (:,:,jk) = fse3t_n (:,:,jk)          ! vertical scale factors stored in fse3. arrays
-            fse3u (:,:,jk) = fse3u_n (:,:,jk)
-            fse3v (:,:,jk) = fse3v_n (:,:,jk)
-            fse3f (:,:,jk) = fse3f_n (:,:,jk)
-            fse3w (:,:,jk) = fse3w_n (:,:,jk)
-            fse3uw(:,:,jk) = fse3uw_n(:,:,jk)
-            fse3vw(:,:,jk) = fse3vw_n(:,:,jk)
-         END DO
-
-
-
    END SUBROUTINE dom_vvl
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90	(revision 2528)
@@ -4,4 +4,8 @@
    !! Ocean initialization : write the ocean domain mesh ask file(s)
    !!======================================================================
+   !! History :  OPA  ! 1997-02  (G. Madec)  Original code
+   !!            8.1  ! 1999-11  (M. Imbard)  NetCDF FORMAT with IOIPSL
+   !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90 and several file
+   !!----------------------------------------------------------------------
 
    !!----------------------------------------------------------------------
@@ -11,10 +15,9 @@
    !!                         = 3  :   mesh_hgr, mesh_zgr and mask
    !!----------------------------------------------------------------------
-   !! * Modules used
    USE dom_oce         ! ocean space and time domain
-   USE in_out_manager
-   USE iom
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE lib_mpp
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O library
+   USE lbclnk          ! lateral boundary conditions - mpp exchanges
+   USE lib_mpp         ! MPP library
 
    IMPLICIT NONE
@@ -26,9 +29,8 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
@@ -54,32 +56,25 @@
       !!      if     nmsh <= 3: write full 3D arrays for e3[tuvw] and gdep[tuvw]
       !!      if 3 < nmsh <= 6: write full 3D arrays for e3[tuvw] and 2D arrays 
-      !!                        corresponding to the depth of the bottom points hdep[tw]
+      !!                        corresponding to the depth of the bottom t- and w-points
       !!      if 6 < nmsh <= 9: write 2D arrays corresponding to the depth and the
-      !!                        thickness of the bottom points hdep[tw] and e3[tw]_ps
-      !!
-      !! ** output file : 
-      !!      meshmask.nc  : domain size, horizontal grid-point position,
-      !!                     masks, depth and vertical scale factors
-      !!
-      !! History :
-      !!        !  97-02  (G. Madec)  Original code
-      !!        !  99-11  (M. Imbard)  NetCDF FORMAT with IOIPSL
-      !!   9.0  !  02-08  (G. Madec)  F90 and several file
-      !!----------------------------------------------------------------------
-      INTEGER                          ::   inum0    ! temprary units for 'mesh_mask.nc' file
-      INTEGER                          ::   inum1    ! temprary units for 'mesh.nc'      file
-      INTEGER                          ::   inum2    ! temprary units for 'mask.nc'      file
-      INTEGER                          ::   inum3    ! temprary units for 'mesh_hgr.nc'  file
-      INTEGER                          ::   inum4    ! temprary units for 'mesh_zgr.nc'  file
-      INTEGER                          ::   ji, jj, jk, ik
-      REAL(wp), DIMENSION(jpi,jpj)     ::   zprt     ! temporary array for bathymetry 
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdepu    ! 3D depth of U point
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdepv    ! 3D depth of V point
-      CHARACTER(len=21)                ::   clnam0   ! filename (mesh and mask informations)
-      CHARACTER(len=21)                ::   clnam1   ! filename (mesh informations)
-      CHARACTER(len=21)                ::   clnam2   ! filename (mask informations)
-      CHARACTER(len=21)                ::   clnam3   ! filename (horizontal mesh informations)
-      CHARACTER(len=21)                ::   clnam4   ! filename (vertical   mesh informations)
-      !!----------------------------------------------------------------------
+      !!                        thickness (e3[tw]_ps) of the bottom points 
+      !!
+      !! ** output file :   meshmask.nc  : domain size, horizontal grid-point position,
+      !!                                   masks, depth and vertical scale factors
+      !!----------------------------------------------------------------------
+      INTEGER           ::   inum0    ! temprary units for 'mesh_mask.nc' file
+      INTEGER           ::   inum1    ! temprary units for 'mesh.nc'      file
+      INTEGER           ::   inum2    ! temprary units for 'mask.nc'      file
+      INTEGER           ::   inum3    ! temprary units for 'mesh_hgr.nc'  file
+      INTEGER           ::   inum4    ! temprary units for 'mesh_zgr.nc'  file
+      CHARACTER(len=21) ::   clnam0   ! filename (mesh and mask informations)
+      CHARACTER(len=21) ::   clnam1   ! filename (mesh informations)
+      CHARACTER(len=21) ::   clnam2   ! filename (mask informations)
+      CHARACTER(len=21) ::   clnam3   ! filename (horizontal mesh informations)
+      CHARACTER(len=21) ::   clnam4   ! filename (vertical   mesh informations)
+      INTEGER           ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp), DIMENSION(jpi,jpj)     ::   zprt , zprw    ! 2D workspace
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdepu, zdepv   ! 3D workspace
+     !!----------------------------------------------------------------------
 
       IF(lwp) WRITE(numout,*)
@@ -118,5 +113,5 @@
          CALL iom_open( TRIM(clnam3), inum3, ldwrt = .TRUE., kiolib = jprstlib )
          CALL iom_open( TRIM(clnam4), inum4, ldwrt = .TRUE., kiolib = jprstlib )
-         
+         !
       END SELECT
       
@@ -160,13 +155,8 @@
       CALL iom_rstput( 0, 0, inum3, 'ff', ff, ktype = jp_r8 )           !    ! coriolis factor
       
-!       note that mbathy has been modified in dommsk or in solver.
-!       it is the number of non-zero "w" levels in the water, and the minimum 
-!       value (on land) is 2. We define zprt as the number of "T" points in the ocean 
-!       at any location, and zero on land. 
-!
-      zprt = tmask(:,:,1)*(mbathy-1)
-      CALL iom_rstput( 0, 0, inum4, 'mbathy', zprt, ktype = jp_i2 )
+      ! note that mbkt is set to 1 over land ==> use surface tmask
+      zprt(:,:) = tmask(:,:,1) * REAL( mbkt(:,:) , wp )
+      CALL iom_rstput( 0, 0, inum4, 'mbathy', zprt, ktype = jp_i2 )     !    ! nb of ocean T-points
             
-#if ! defined key_zco
       IF( ln_sco ) THEN                                         ! s-coordinate
          CALL iom_rstput( 0, 0, inum4, 'hbatt', hbatt )         !    ! depth
@@ -174,5 +164,5 @@
          CALL iom_rstput( 0, 0, inum4, 'hbatv', hbatv )
          CALL iom_rstput( 0, 0, inum4, 'hbatf', hbatf )
-         
+         !
          CALL iom_rstput( 0, 0, inum4, 'gsigt', gsigt )         !    ! scaling coef.
          CALL iom_rstput( 0, 0, inum4, 'gsigw', gsigw )  
@@ -180,10 +170,10 @@
          CALL iom_rstput( 0, 0, inum4, 'esigt', esigt )
          CALL iom_rstput( 0, 0, inum4, 'esigw', esigw )
-         
+         !
          CALL iom_rstput( 0, 0, inum4, 'e3t', e3t )             !    ! scale factors
          CALL iom_rstput( 0, 0, inum4, 'e3u', e3u )
          CALL iom_rstput( 0, 0, inum4, 'e3v', e3v )
          CALL iom_rstput( 0, 0, inum4, 'e3w', e3w )
-         
+         !
          CALL iom_rstput( 0, 0, inum4, 'gdept_0' , gdept_0 )    !    ! stretched system
          CALL iom_rstput( 0, 0, inum4, 'gdepw_0' , gdepw_0 )
@@ -191,5 +181,5 @@
       
       IF( ln_zps ) THEN                                         ! z-coordinate - partial steps
-
+         !
          IF( nmsh <= 6 ) THEN                                   !    ! 3D vertical scale factors
             CALL iom_rstput( 0, 0, inum4, 'e3t', e3t )         
@@ -197,21 +187,25 @@
             CALL iom_rstput( 0, 0, inum4, 'e3v', e3v )
             CALL iom_rstput( 0, 0, inum4, 'e3w', e3w )
-         ELSE                                                   !    ! 2D bottom scale factors
-            DO jj = 1,jpj   ;   DO ji = 1,jpi
-               ik = NINT( zprt(ji,jj) )   ! take care that mbathy is not what you think it is here !
-               IF ( ik /= 0 ) THEN   ;   e3tp(ji,jj) = e3t(ji,jj,ik)   ;   e3wp(ji,jj) = e3w(ji,jj,ik)
-               ELSE                  ;   e3tp(ji,jj) = 0.              ;   e3wp(ji,jj) = 0.
-               ENDIF
-            END DO   ;   END DO
+         ELSE                                                   !    ! 2D masked bottom ocean scale factors
+            DO jj = 1,jpj   
+               DO ji = 1,jpi
+                  e3tp(ji,jj) = e3t(ji,jj,mbkt(ji,jj)) * tmask(ji,jj,1)
+                  e3wp(ji,jj) = e3w(ji,jj,mbkt(ji,jj)) * tmask(ji,jj,1)
+               END DO
+            END DO
             CALL iom_rstput( 0, 0, inum4, 'e3t_ps', e3tp )      
             CALL iom_rstput( 0, 0, inum4, 'e3w_ps', e3wp )
          END IF
-
+         !
          IF( nmsh <= 3 ) THEN                                   !    ! 3D depth
             CALL iom_rstput( 0, 0, inum4, 'gdept', gdept, ktype = jp_r4 )     
-            DO jk = 1,jpk   ;   DO jj = 1, jpjm1   ;   DO ji = 1, fs_jpim1   ! vector opt.
-               zdepu(ji,jj,jk) = MIN( gdept(ji,jj,jk), gdept(ji+1,jj  ,jk) )
-               zdepv(ji,jj,jk) = MIN( gdept(ji,jj,jk), gdept(ji  ,jj+1,jk) )
-            END DO   ;   END DO   ;   END DO
+            DO jk = 1,jpk   
+               DO jj = 1, jpjm1   
+                  DO ji = 1, fs_jpim1   ! vector opt.
+                     zdepu(ji,jj,jk) = MIN( gdept(ji,jj,jk) , gdept(ji+1,jj  ,jk) )
+                     zdepv(ji,jj,jk) = MIN( gdept(ji,jj,jk) , gdept(ji  ,jj+1,jk) )
+                  END DO   
+               END DO   
+            END DO
             CALL lbc_lnk( zdepu, 'U', 1. )   ;   CALL lbc_lnk( zdepv, 'V', 1. ) 
             CALL iom_rstput( 0, 0, inum4, 'gdepu', zdepu, ktype = jp_r4 )
@@ -219,14 +213,14 @@
             CALL iom_rstput( 0, 0, inum4, 'gdepw', gdepw, ktype = jp_r4 )
          ELSE                                                   !    ! 2D bottom depth
-            DO jj = 1,jpj   ;   DO ji = 1,jpi
-               ik = NINT( zprt(ji,jj) )   ! take care that mbathy is not what you think it is here !
-               IF ( ik /= 0 ) THEN   ;   hdept(ji,jj) = gdept(ji,jj,ik)   ;   hdepw(ji,jj) = gdepw(ji,jj,ik+1)
-               ELSE                  ;   hdept(ji,jj) = 0.                ;   hdepw(ji,jj) = 0.
-               ENDIF
-            END DO   ;   END DO
-            CALL iom_rstput( 0, 0, inum4, 'hdept' , hdept, ktype = jp_r4 )     
-            CALL iom_rstput( 0, 0, inum4, 'hdepw' , hdepw, ktype = jp_r4 ) 
+            DO jj = 1,jpj   
+               DO ji = 1,jpi
+                  zprt(ji,jj) = gdept(ji,jj,mbkt(ji,jj)  ) * tmask(ji,jj,1)
+                  zprw(ji,jj) = gdepw(ji,jj,mbkt(ji,jj)+1) * tmask(ji,jj,1)
+               END DO
+            END DO
+            CALL iom_rstput( 0, 0, inum4, 'hdept', zprt, ktype = jp_r4 )     
+            CALL iom_rstput( 0, 0, inum4, 'hdepw', zprw, ktype = jp_r4 ) 
          ENDIF
-
+         !
          CALL iom_rstput( 0, 0, inum4, 'gdept_0', gdept_0 )     !    ! reference z-coord.
          CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0 )
@@ -234,6 +228,4 @@
          CALL iom_rstput( 0, 0, inum4, 'e3w_0'  , e3w_0   )
       ENDIF
-      
-#endif
       
       IF( ln_zco ) THEN
@@ -258,5 +250,5 @@
          CALL iom_close( inum4 )
       END SELECT
-      
+      !
    END SUBROUTINE dom_wri
 
@@ -270,9 +262,8 @@
       !! ** Method  :   1) aplly lbc_lnk on an array with different values for each element
       !!                2) check which elements have been changed
-      !!
       !!----------------------------------------------------------------------
       CHARACTER(len=1)            , INTENT(in   ) ::  cdgrd   ! 
       REAL(wp), DIMENSION(jpi,jpj)                ::  puniq   ! 
-
+      !
       REAL(wp), DIMENSION(jpi,jpj  ) ::  ztstref   ! array with different values for each element 
       REAL(wp)                       ::  zshift    ! shift value link to the process number
@@ -280,21 +271,20 @@
       INTEGER                        ::  ji        ! dummy loop indices
       !!----------------------------------------------------------------------
-
+      !
       ! build an array with different values for each element 
       ! in mpp: make sure that these values are different even between process
       ! -> apply a shift value according to the process number
       zshift = jpi * jpj * ( narea - 1 )
-      ztstref(:,:) = RESHAPE( (/ (zshift + REAL(ji, wp), ji = 1, jpi*jpj) /), (/ jpi, jpj /) )
-   
+      ztstref(:,:) = RESHAPE( (/ (zshift + REAL(ji,wp), ji = 1, jpi*jpj) /), (/ jpi, jpj /) )
+      !
       puniq(:,:) = ztstref(:,:)                   ! default definition
       CALL lbc_lnk( puniq, cdgrd, 1. )            ! apply boundary conditions
       lldbl(:,:,1) = puniq(:,:) == ztstref(:,:)   ! check which values have been changed 
-      
+      !
       puniq(:,:) = 1.                             ! default definition
       ! fill only the inner part of the cpu with llbl converted into real 
-      puniq(nldi:nlei,nldj:nlej) = REAL(COUNT( lldbl(nldi:nlei,nldj:nlej,:), dim = 3 ), wp)
-
+      puniq(nldi:nlei,nldj:nlej) = REAL( COUNT( lldbl(nldi:nlei,nldj:nlej,:), dim = 3 ) , wp )
+      !
    END FUNCTION dom_uniq
-
 
    !!======================================================================
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90	(revision 2528)
@@ -7,6 +7,6 @@
    !!                 ! 1997-07  (G. Madec)  lbc_lnk call
    !!                 ! 1997-04  (J.-O. Beismann) 
-   !!            8.5  ! 2002-09 (A. Bozec, G. Madec)  F90: Free form and module
-   !!             -   ! 2002-09 (A. de Miranda)  rigid-lid + islands
+   !!            8.5  ! 2002-09  (A. Bozec, G. Madec)  F90: Free form and module
+   !!             -   ! 2002-09  (A. de Miranda)  rigid-lid + islands
    !!  NEMO      1.0  ! 2003-08  (G. Madec)  F90: Free form and module
    !!             -   ! 2005-10  (A. Beckmann)  modifications for hybrid s-ccordinates & new stretching function
@@ -14,4 +14,5 @@
    !!            3.0  ! 2008-06  (G. Madec)  insertion of domzgr_zps.h90 & conding style
    !!            3.2  ! 2009-07  (R. Benshila) Suppression of rigid-lid option
+   !!            3.3  ! 2010-11  (G. Madec) add mbk. arrays associated to the deepest ocean level
    !!----------------------------------------------------------------------
 
@@ -21,4 +22,5 @@
    !!       zgr_bat_zoom : modify the bathymetry field if zoom domain
    !!       zgr_bat_ctl  : check the bathymetry files
+   !!       zgr_bot_level: deepest ocean level for t-, u, and v-points
    !!       zgr_z        : reference z-coordinate 
    !!       zgr_zco      : z-coordinate 
@@ -28,28 +30,28 @@
    !!       dfssig       : derivative of the sigma coordinate function    !!gm  (currently missing!)
    !!---------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers
-   USE dom_oce         ! ocean space and time domain
-   USE in_out_manager  ! I/O manager
-   USE lib_mpp         ! distributed memory computing library
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE closea          ! closed seas
-   USE c1d             ! 1D configuration
+   USE oce               ! ocean variables
+   USE dom_oce           ! ocean domain
+   USE closea            ! closed seas
+   USE c1d               ! 1D vertical configuration
+   USE in_out_manager    ! I/O manager
+   USE iom               ! I/O library
+   USE lbclnk            ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp           ! distributed memory computing library
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   dom_zgr    ! called by dom_init.F90
-
-!!gm   DOCTOR name for the namelist parameter...
-   !                                    !!! ** Namelist namzgr_sco **
-   REAL(wp) ::   rn_sbot_min =  300.     ! minimum depth of s-bottom surface (>0) (m)
-   REAL(wp) ::   rn_sbot_max = 5250.     ! maximum depth of s-bottom surface (= ocean depth) (>0) (m)
-   REAL(wp) ::   rn_theta    =    6.0    ! surface control parameter (0<=rn_theta<=20)
-   REAL(wp) ::   rn_thetb    =    0.75   ! bottom control parameter  (0<=rn_thetb<= 1)
-   REAL(wp) ::   rn_rmax     =    0.15   ! maximum cut-off r-value allowed (0<rn_rmax<1)
-   LOGICAL  ::   ln_s_sigma  = .false.   ! use hybrid s-sigma -coordinate & stretching function fssig1 (ln_sco=T)
-   REAL(wp) ::   rn_bb       =    0.8    ! stretching parameter for song and haidvogel stretching
-   !                                     ! ( rn_bb=0; top only, rn_bb =1; top and bottom)
-   REAL(wp) ::   rn_hc       = 150.      ! Critical depth for s-sigma coordinates
+   PUBLIC   dom_zgr      ! called by dom_init.F90
+
+   !                                       !!* Namelist namzgr_sco *
+   REAL(wp) ::   rn_sbot_min =  300._wp     ! minimum depth of s-bottom surface (>0) (m)
+   REAL(wp) ::   rn_sbot_max = 5250._wp     ! maximum depth of s-bottom surface (= ocean depth) (>0) (m)
+   REAL(wp) ::   rn_theta    =    6.00_wp   ! surface control parameter (0<=rn_theta<=20)
+   REAL(wp) ::   rn_thetb    =    0.75_wp   ! bottom control parameter  (0<=rn_thetb<= 1)
+   REAL(wp) ::   rn_rmax     =    0.15_wp   ! maximum cut-off r-value allowed (0<rn_rmax<1)
+   LOGICAL  ::   ln_s_sigma  = .false.      ! use hybrid s-sigma -coordinate & stretching function fssig1 (ln_sco=T)
+   REAL(wp) ::   rn_bb       =    0.80_wp   ! stretching parameter for song and haidvogel stretching
+   !                                        ! ( rn_bb=0; top only, rn_bb =1; top and bottom)
+   REAL(wp) ::   rn_hc       =  150._wp     ! Critical depth for s-sigma coordinates
  
    !! * Substitutions
@@ -57,9 +59,8 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS       
 
@@ -75,5 +76,5 @@
       !!              - vertical coordinate (gdep., e3.) depending on the 
       !!                coordinate chosen :
-      !!                   ln_zco=T   z-coordinate   (forced if lk_zco)
+      !!                   ln_zco=T   z-coordinate   
       !!                   ln_zps=T   z-coordinate with partial steps
       !!                   ln_zco=T   s-coordinate 
@@ -82,10 +83,10 @@
       !!----------------------------------------------------------------------
       INTEGER ::   ioptio = 0   ! temporary integer
-      !!
+      !
       NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco
       !!----------------------------------------------------------------------
 
-      REWIND ( numnam )                ! Read Namelist namzgr : vertical coordinate'
-      READ   ( numnam, namzgr )
+      REWIND( numnam )                 ! Read Namelist namzgr : vertical coordinate'
+      READ  ( numnam, namzgr )
 
       IF(lwp) THEN                     ! Control print
@@ -103,25 +104,21 @@
       IF( ln_zps ) ioptio = ioptio + 1
       IF( ln_sco ) ioptio = ioptio + 1
-      IF ( ioptio /= 1 )   CALL ctl_stop( ' none or several vertical coordinate options used' )
-      IF( lk_zco ) THEN
-          IF(lwp) WRITE(numout,*) '          z-coordinate with reduced incore memory requirement'
-          IF( ln_zps .OR. ln_sco )   CALL ctl_stop( ' reduced memory with zps or sco option is impossible' )
-      ENDIF
-
+      IF( ioptio /= 1 )   CALL ctl_stop( ' none or several vertical coordinate options used' )
+      !
       ! Build the vertical coordinate system
       ! ------------------------------------
-                     CALL zgr_z        ! Reference z-coordinate system (always called)
-                     CALL zgr_bat      ! Bathymetry fields (levels and meters)
-      IF( ln_zco )   CALL zgr_zco      ! z-coordinate
-      IF( ln_zps )   CALL zgr_zps      ! Partial step z-coordinate
-      IF( ln_sco )   CALL zgr_sco      ! s-coordinate or hybrid z-s coordinate
-      !
-     ! final adjustment of mbathy & check
-     ! -----------------------------------
-     IF( lzoom       )   CALL zgr_bat_zoom     ! correct mbathy in case of zoom subdomain
-     IF( .NOT.lk_c1d )   CALL zgr_bat_ctl      ! check bathymetry (mbathy) and suppress isoated ocean points
-
-
-!!bug gm control print:
+                          CALL zgr_z            ! Reference z-coordinate system (always called)
+                          CALL zgr_bat          ! Bathymetry fields (levels and meters)
+      IF( ln_zco      )   CALL zgr_zco          ! z-coordinate
+      IF( ln_zps      )   CALL zgr_zps          ! Partial step z-coordinate
+      IF( ln_sco      )   CALL zgr_sco          ! s-coordinate or hybrid z-s coordinate
+      !
+      ! final adjustment of mbathy & check 
+      ! -----------------------------------
+      IF( lzoom       )   CALL zgr_bat_zoom     ! correct mbathy in case of zoom subdomain
+      IF( .NOT.lk_c1d )   CALL zgr_bat_ctl      ! check bathymetry (mbathy) and suppress isoated ocean points
+                          CALL zgr_bot_level    ! deepest ocean level for t-, u- and v-points
+      !
+      !
       IF( nprint == 1 .AND. lwp )   THEN
          WRITE(numout,*) ' MIN val mbathy ', MINVAL( mbathy(:,:) ), ' MAX ', MAXVAL( mbathy(:,:) )
@@ -140,6 +137,5 @@
             &                   ' w ',   MAXVAL( fse3w(:,:,:) )
       ENDIF
-!!!bug gm
-
+      !
    END SUBROUTINE dom_zgr
 
@@ -171,4 +167,5 @@
       REAL(wp) ::   zacr, zdzmin, zhmax    ! par_CONFIG_Rxx.h90
       REAL(wp) ::   zrefdep                ! depth of the reference level (~10m)
+      REAL(wp) ::   za2, zkth2, zacr2      ! Values for optional double tanh function set from parameters 
       !!----------------------------------------------------------------------
 
@@ -177,8 +174,8 @@
        zkth = ppkth       ;   zacr = ppacr
        zdzmin = ppdzmin   ;   zhmax = pphmax
+       zkth2 = ppkth2     ;   zacr2 = ppacr2   ! optional (ldbletanh=T) double tanh parameters
 
       ! If ppa1 and ppa0 and ppsur are et to pp_to_be_computed
       !  za0, za1, zsur are computed from ppdzmin , pphmax, ppkth, ppacr
-      !
       IF(   ppa1  == pp_to_be_computed  .AND.  &
          &  ppa0  == pp_to_be_computed  .AND.  &
@@ -192,4 +189,5 @@
       ELSE
          za1 = ppa1 ;       za0 = ppa0 ;          zsur = ppsur
+         za2 = ppa2                            ! optional (ldbletanh=T) double tanh parameter
       ENDIF
 
@@ -198,10 +196,10 @@
          WRITE(numout,*) '    zgr_z   : Reference vertical z-coordinates'
          WRITE(numout,*) '    ~~~~~~~'
-         IF(  ppkth == 0. ) THEN              
+         IF(  ppkth == 0._wp ) THEN              
               WRITE(numout,*) '            Uniform grid with ',jpk-1,' layers'
               WRITE(numout,*) '            Total depth    :', zhmax
               WRITE(numout,*) '            Layer thickness:', zhmax/(jpk-1)
          ELSE
-            IF( ppa1 == 0. .AND. ppa0 == 0. .AND. ppsur == 0. ) THEN
+            IF( ppa1 == 0._wp .AND. ppa0 == 0._wp .AND. ppsur == 0._wp ) THEN
                WRITE(numout,*) '         zsur, za0, za1 computed from '
                WRITE(numout,*) '                 zdzmin = ', zdzmin
@@ -214,4 +212,9 @@
             WRITE(numout,*) '                 zkth = ', zkth
             WRITE(numout,*) '                 zacr = ', zacr
+            IF( ldbletanh ) THEN
+               WRITE(numout,*) ' (Double tanh    za2  = ', za2
+               WRITE(numout,*) '  parameters)    zkth2= ', zkth2
+               WRITE(numout,*) '                 zacr2= ', zacr2
+            ENDIF
          ENDIF
       ENDIF
@@ -220,9 +223,9 @@
       ! Reference z-coordinate (depth - scale factor at T- and W-points)
       ! ======================
-      IF( ppkth == 0.e0 ) THEN            !  uniform vertical grid       
+      IF( ppkth == 0._wp ) THEN            !  uniform vertical grid       
          za1 = zhmax / FLOAT(jpk-1) 
          DO jk = 1, jpk
             zw = FLOAT( jk )
-            zt = FLOAT( jk ) + 0.5
+            zt = FLOAT( jk ) + 0.5_wp
             gdepw_0(jk) = ( zw - 1 ) * za1
             gdept_0(jk) = ( zt - 1 ) * za1
@@ -231,20 +234,36 @@
          END DO
       ELSE                                ! Madec & Imbard 1996 function
-         DO jk = 1, jpk
-            zw = FLOAT( jk )
-            zt = FLOAT( jk ) + 0.5
-            gdepw_0(jk) = ( zsur + za0 * zw + za1 * zacr * LOG ( COSH( (zw-zkth) / zacr ) )  )
-            gdept_0(jk) = ( zsur + za0 * zt + za1 * zacr * LOG ( COSH( (zt-zkth) / zacr ) )  )
-            e3w_0  (jk) =          za0      + za1        * TANH(       (zw-zkth) / zacr   )
-            e3t_0  (jk) =          za0      + za1        * TANH(       (zt-zkth) / zacr   )
-         END DO
-         gdepw_0(1) = 0.e0                     ! force first w-level to be exactly at zero
+         IF( .NOT. ldbletanh ) THEN
+            DO jk = 1, jpk
+               zw = REAL( jk , wp )
+               zt = REAL( jk , wp ) + 0.5_wp
+               gdepw_0(jk) = ( zsur + za0 * zw + za1 * zacr * LOG ( COSH( (zw-zkth) / zacr ) )  )
+               gdept_0(jk) = ( zsur + za0 * zt + za1 * zacr * LOG ( COSH( (zt-zkth) / zacr ) )  )
+               e3w_0  (jk) =          za0      + za1        * TANH(       (zw-zkth) / zacr   )
+               e3t_0  (jk) =          za0      + za1        * TANH(       (zt-zkth) / zacr   )
+            END DO
+         ELSE
+            DO jk = 1, jpk
+               zw = FLOAT( jk )
+               zt = FLOAT( jk ) + 0.5_wp
+               ! Double tanh function
+               gdepw_0(jk) = ( zsur + za0 * zw + za1 * zacr * LOG ( COSH( (zw-zkth ) / zacr  ) )    &
+                  &                            + za2 * zacr2* LOG ( COSH( (zw-zkth2) / zacr2 ) )  )
+               gdept_0(jk) = ( zsur + za0 * zt + za1 * zacr * LOG ( COSH( (zt-zkth ) / zacr  ) )    &
+                  &                            + za2 * zacr2* LOG ( COSH( (zt-zkth2) / zacr2 ) )  )
+               e3w_0  (jk) =          za0      + za1        * TANH(       (zw-zkth ) / zacr  )    &
+                  &                            + za2        * TANH(       (zw-zkth2) / zacr2 )
+               e3t_0  (jk) =          za0      + za1        * TANH(       (zt-zkth ) / zacr  )    &
+                  &                            + za2        * TANH(       (zt-zkth2) / zacr2 )
+            END DO
+         ENDIF
+         gdepw_0(1) = 0._wp                    ! force first w-level to be exactly at zero
       ENDIF
 
 !!gm BUG in s-coordinate this does not work!
-      ! deepest/shallowest W level Above/Bellow ~10m
-      zrefdep = 10. - ( 0.1*MINVAL(e3w_0) )                          ! ref. depth with tolerance (10% of minimum layer thickness)
-      nlb10 = MINLOC( gdepw_0, mask = gdepw_0 > zrefdep, dim = 1 )   ! shallowest W level Bellow ~10m
-      nla10 = nlb10 - 1                                              ! deepest    W level Above  ~10m
+      ! deepest/shallowest W level Above/Below ~10m
+      zrefdep = 10._wp - 0.1_wp * MINVAL( e3w_0 )                    ! ref. depth with tolerance (10% of minimum layer thickness)
+      nlb10 = MINLOC( gdepw_0, mask = gdepw_0 > zrefdep, dim = 1 )   ! shallowest W level Below ~10m
+      nla10 = nlb10 - 1                                              ! deepest    W level Above ~10m
 !!gm end bug
 
@@ -256,6 +275,6 @@
       ENDIF
       DO jk = 1, jpk                      ! control positivity
-         IF( e3w_0  (jk) <= 0.e0 .OR. e3t_0  (jk) <= 0.e0 )   CALL ctl_stop( ' e3w or e3t =< 0 '    )
-         IF( gdepw_0(jk) <  0.e0 .OR. gdept_0(jk) <  0.e0 )   CALL ctl_stop( ' gdepw or gdept < 0 ' )
+         IF( e3w_0  (jk) <= 0._wp .OR. e3t_0  (jk) <= 0._wp )   CALL ctl_stop( 'dom:zgr_z: e3w or e3t =< 0 '    )
+         IF( gdepw_0(jk) <  0._wp .OR. gdept_0(jk) <  0._wp )   CALL ctl_stop( 'dom:zgr_z: gdepw or gdept < 0 ' )
       END DO
       !
@@ -289,19 +308,14 @@
       !!      ntopo= 1 :   mbathy is read in 'bathy_level.nc' NetCDF file
       !!                   bathy  is read in 'bathy_meter.nc' NetCDF file
-      !!      C A U T I O N : mbathy will be modified during the initializa-
-      !!      tion phase to become the number of non-zero w-levels of a water
-      !!      column, with a minimum value of 1.
       !!
       !! ** Action  : - mbathy: level bathymetry (in level index)
       !!              - bathy : meter bathymetry (in meters)
       !!----------------------------------------------------------------------
-      USE iom
-      !!
       INTEGER  ::   ji, jj, jl, jk            ! dummy loop indices
       INTEGER  ::   inum                      ! temporary logical unit
       INTEGER  ::   ii_bump, ij_bump, ih      ! bump center position
-      INTEGER  ::   ii0, ii1, ij0, ij1        ! indices
+      INTEGER  ::   ii0, ii1, ij0, ij1, ik    ! local indices
       REAL(wp) ::   r_bump , h_bump , h_oce   ! bump characteristics 
-      REAL(wp) ::   zi     , zj     , zh      ! temporary scalars
+      REAL(wp) ::   zi, zj, zh, zhmin         ! local scalars
       INTEGER , DIMENSION(jpidta,jpjdta) ::   idta   ! global domain integer data
       REAL(wp), DIMENSION(jpidta,jpjdta) ::   zdta   ! global domain scalar data
@@ -328,6 +342,6 @@
             ii_bump = jpidta / 2                           ! i-index of the bump center
             ij_bump = jpjdta / 2                           ! j-index of the bump center
-            r_bump  = 50000.e0                             ! bump radius (meters)       
-            h_bump  = 2700.e0                              ! bump height (meters)
+            r_bump  = 50000._wp                            ! bump radius (meters)       
+            h_bump  =  2700._wp                            ! bump height (meters)
             h_oce   = gdepw_0(jpk)                         ! background ocean depth (meters)
             IF(lwp) WRITE(numout,*) '            bump characteristics: '
@@ -350,9 +364,5 @@
                idta(:,:) = jpkm1
                DO jk = 1, jpkm1
-                  DO jj = 1, jpjdta
-                     DO ji = 1, jpidta
-                        IF( gdept_0(jk) < zdta(ji,jj) .AND. zdta(ji,jj) <= gdept_0(jk+1) )   idta(ji,jj) = jk
-                     END DO
-                  END DO
+                  WHERE( gdept_0(jk) < zdta(:,:) .AND. zdta(:,:) <= gdept_0(jk+1) )   idta(:,:) = jk
                END DO
             ENDIF
@@ -361,13 +371,13 @@
          !                                            ! Caution : idta on the global domain: use of jperio, not nperio
          IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
-            idta( :    , 1    ) = -1                ;      zdta( :    , 1    ) = -1.e0
-            idta( :    ,jpjdta) =  0                ;      zdta( :    ,jpjdta) =  0.e0
+            idta( :    , 1    ) = -1                ;      zdta( :    , 1    ) = -1._wp
+            idta( :    ,jpjdta) =  0                ;      zdta( :    ,jpjdta) =  0._wp
          ELSEIF( jperio == 2 ) THEN
             idta( :    , 1    ) = idta( : ,  3  )   ;      zdta( :    , 1    ) = zdta( : ,  3  )
-            idta( :    ,jpjdta) = 0                 ;      zdta( :    ,jpjdta) =  0.e0
-            idta( 1    , :    ) = 0                 ;      zdta( 1    , :    ) =  0.e0
-            idta(jpidta, :    ) = 0                 ;      zdta(jpidta, :    ) =  0.e0
+            idta( :    ,jpjdta) = 0                 ;      zdta( :    ,jpjdta) =  0._wp
+            idta( 1    , :    ) = 0                 ;      zdta( 1    , :    ) =  0._wp
+            idta(jpidta, :    ) = 0                 ;      zdta(jpidta, :    ) =  0._wp
          ELSE
-            ih = 0                                  ;      zh = 0.e0
+            ih = 0                                  ;      zh = 0._wp
             IF( ln_sco )   ih = jpkm1               ;      IF( ln_sco )   zh = h_oce
             idta( :    , 1    ) = ih                ;      zdta( :    , 1    ) =  zh
@@ -379,5 +389,5 @@
          !                                            ! local domain level and meter bathymetries (mbathy,bathy)
          mbathy(:,:) = 0                                   ! set to zero extra halo points
-         bathy (:,:) = 0.e0                                ! (require for mpp case)
+         bathy (:,:) = 0._wp                               ! (require for mpp case)
          DO jj = 1, nlcj                                   ! interior values
             DO ji = 1, nlci
@@ -392,13 +402,12 @@
          !
          IF( ln_zco )   THEN                          ! zco : read level bathymetry 
-            CALL iom_open( 'bathy_level.nc', inum )  
-            CALL iom_get ( inum, jpdom_data, 'Bathy_level', bathy )
-            CALL iom_close (inum)
+            CALL iom_open ( 'bathy_level.nc', inum )  
+            CALL iom_get  ( inum, jpdom_data, 'Bathy_level', bathy )
+            CALL iom_close( inum )
             mbathy(:,:) = INT( bathy(:,:) )
             !                                                ! =====================
             IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration
                !                                             ! =====================
-               IF( n_cla == 0 ) THEN
-                  !
+               IF( nn_cla == 0 ) THEN
                   ii0 = 140   ;   ii1 = 140                  ! Gibraltar Strait open 
                   ij0 = 102   ;   ij1 = 102                  ! (Thomson, Ocean Modelling, 1995)
@@ -409,5 +418,5 @@
                   END DO
                   IF(lwp) WRITE(numout,*)
-                  IF(lwp) WRITE(numout,*) '             orca_r2: Gibraltar strait open at i=',ii0,' j=',ij0
+                  IF(lwp) WRITE(numout,*) '      orca_r2: Gibraltar strait open at i=',ii0,' j=',ij0
                   !
                   ii0 = 160   ;   ii1 = 160                  ! Bab el mandeb Strait open
@@ -419,6 +428,5 @@
                   END DO
                   IF(lwp) WRITE(numout,*)
-                  IF(lwp) WRITE(numout,*) '             orca_r2: Bab el Mandeb strait open at i=',ii0,' j=',ij0
-                  !
+                  IF(lwp) WRITE(numout,*) '      orca_r2: Bab el Mandeb strait open at i=',ii0,' j=',ij0
                ENDIF
                !
@@ -427,32 +435,42 @@
          ENDIF
          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 )
-            CALL iom_close (inum)
+            CALL iom_open ( 'bathy_meter.nc', inum ) 
+            CALL iom_get  ( inum, jpdom_data, 'Bathymetry', bathy )
+            CALL iom_close( inum )
             !                                                ! =====================
-           IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration
-              !                                             ! =====================
-              IF( n_cla == 0 ) THEN
-                 !
-                 ii0 = 140   ;   ii1 = 140                  ! Gibraltar Strait open 
-                 ij0 = 102   ;   ij1 = 102                  ! (Thomson, Ocean Modelling, 1995)
+            IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN    ! ORCA R1 configuration
+               ii0 = 142   ;   ii1 = 142                     ! =====================
+               ij0 =  51   ;   ij1 =  53                     
+               DO ji = mi0(ii0), mi1(ii1)                    ! Close Halmera Strait
+                  DO jj = mj0(ij0), mj1(ij1)
+                     bathy(ji,jj) = 0._wp
+                  END DO
+               END DO
+               IF(lwp) WRITE(numout,*)
+               IF(lwp) WRITE(numout,*) '      orca_r1: Halmera strait closed at i=',ii0,' j=',ij0,'->',ij1
+            ENDIF
+            !                                                ! =====================
+            IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration
+               !                                             ! =====================
+              IF( nn_cla == 0 ) THEN
+                 ii0 = 140   ;   ii1 = 140                   ! Gibraltar Strait open 
+                 ij0 = 102   ;   ij1 = 102                   ! (Thomson, Ocean Modelling, 1995)
                  DO ji = mi0(ii0), mi1(ii1)
                     DO jj = mj0(ij0), mj1(ij1)
-                       bathy(ji,jj) = 284.e0
+                       bathy(ji,jj) = 284._wp
                     END DO
                  END DO
                  IF(lwp) WRITE(numout,*)
-                 IF(lwp) WRITE(numout,*) '             orca_r2: Gibraltar strait open at i=',ii0,' j=',ij0
+                 IF(lwp) WRITE(numout,*) '      orca_r2: Gibraltar strait open at i=',ii0,' j=',ij0
                  !
-                 ii0 = 160   ;   ii1 = 160                  ! Bab el mandeb Strait open
-                 ij0 = 88    ;   ij1 = 88                   ! (Thomson, Ocean Modelling, 1995)
+                 ii0 = 160   ;   ii1 = 160                   ! Bab el mandeb Strait open
+                 ij0 = 88    ;   ij1 = 88                    ! (Thomson, Ocean Modelling, 1995)
                  DO ji = mi0(ii0), mi1(ii1)
                     DO jj = mj0(ij0), mj1(ij1)
-                       bathy(ji,jj) = 137.e0
+                       bathy(ji,jj) = 137._wp
                     END DO
                  END DO
                  IF(lwp) WRITE(numout,*)
                  IF(lwp) WRITE(numout,*) '             orca_r2: Bab el Mandeb strait open at i=',ii0,' j=',ij0
-                 !
               ENDIF
               !
@@ -473,16 +491,22 @@
                DO ji = ncsi1(jl), ncsi2(jl)
                   mbathy(ji,jj) = 0                   ! suppress closed seas and lakes from bathymetry
-                  bathy (ji,jj) = 0.e0                
+                  bathy (ji,jj) = 0._wp               
                END DO
             END DO
          END DO
       ENDIF
-#if defined key_orca_lev10
-      !                                               ! ================= !
-      mbathy(:,:) = 10 * mbathy(:,:)                  !   key_orca_lev10  !
-      !                                               ! ================= !
-      IF( ln_zps .OR. ln_sco )   CALL ctl_stop( ' CAUTION: 300 levels only with level bathymetry' )
-#endif
-      !                         
+      !
+      !                                               ! =========================== !
+      !                                               !     set a minimum depth     !
+      !                                               ! =========================== !
+      IF( rn_hmin < 0._wp ) THEN    ;   ik = INT( rn_hmin ) + 1                                    ! from a nb of level
+      ELSE                          ;   ik = MINLOC( gdepw_0, mask = gdepw_0 > rn_hmin, dim = 1 )  ! from a depth
+      ENDIF
+      zhmin = gdepw_0(ik+1)                                                         ! minimum depth = ik+1 w-levels 
+      WHERE( bathy(:,:) <= 0._wp )   ;   bathy(:,:) = 0._wp                         ! min=0     over the lands
+      ELSE WHERE                     ;   bathy(:,:) = MIN(  zhmin , bathy(:,:)  )   ! min=zhmin over the oceans
+      END WHERE
+      IF(lwp) write(numout,*) 'Minimum ocean depth: ', zhmin, ' minimum number of ocean levels : ', ik
+      !
    END SUBROUTINE zgr_bat
 
@@ -601,5 +625,5 @@
       IF( lk_mpp ) THEN
          zbathy(:,:) = FLOAT( mbathy(:,:) )
-         CALL lbc_lnk( zbathy, 'T', 1. )
+         CALL lbc_lnk( zbathy, 'T', 1._wp )
          mbathy(:,:) = INT( zbathy(:,:) )
       ENDIF
@@ -641,5 +665,5 @@
          !   ... mono- or macro-tasking: T-point, >0, 2D array, no slab
          zbathy(:,:) = FLOAT( mbathy(:,:) )
-         CALL lbc_lnk( zbathy, 'T', 1. )
+         CALL lbc_lnk( zbathy, 'T', 1._wp )
          mbathy(:,:) = INT( zbathy(:,:) )
       ENDIF
@@ -672,4 +696,39 @@
 
 
+   SUBROUTINE zgr_bot_level
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE zgr_bot_level  ***
+      !!
+      !! ** Purpose :   defines the vertical index of ocean bottom (mbk. arrays)
+      !!
+      !! ** Method  :   computes from mbathy with a minimum value of 1 over land
+      !!
+      !! ** Action  :   mbkt, mbku, mbkv :   vertical indices of the deeptest 
+      !!                                     ocean level at t-, u- & v-points
+      !!                                     (min value = 1 over land)
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj   ! dummy loop indices
+      REAL(wp), DIMENSION(jpi,jpj) ::   zmbk   ! 2D workspace 
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '    zgr_bot_level : ocean bottom k-index of T-, U-, V- and W-levels '
+      IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~'
+      !
+      mbkt(:,:) = MAX( mbathy(:,:) , 1 )    ! bottom k-index of T-level (=1 over land)
+      !                                     ! bottom k-index of W-level = mbkt+1
+      DO jj = 1, jpjm1                      ! bottom k-index of u- (v-) level
+         DO ji = 1, jpim1
+            mbku(ji,jj) = MIN(  mbkt(ji+1,jj  ) , mbkt(ji,jj)  )
+            mbkv(ji,jj) = MIN(  mbkt(ji  ,jj+1) , mbkt(ji,jj)  )
+         END DO
+      END DO
+      ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 
+      zmbk(:,:) = REAL( mbku(:,:), wp )   ;   CALL lbc_lnk(zmbk,'U',1.)   ;   mbku  (:,:) = MAX( INT( zmbk(:,:) ), 1 )
+      zmbk(:,:) = REAL( mbkv(:,:), wp )   ;   CALL lbc_lnk(zmbk,'V',1.)   ;   mbkv  (:,:) = MAX( INT( zmbk(:,:) ), 1 )
+      !
+   END SUBROUTINE zgr_bot_level
+
+
    SUBROUTINE zgr_zco
       !!----------------------------------------------------------------------
@@ -678,39 +737,24 @@
       !! ** Purpose :   define the z-coordinate system
       !!
-      !! ** Method  :   set 3D coord. arrays to reference 1D array if lk_zco=T
+      !! ** Method  :   set 3D coord. arrays to reference 1D array 
       !!----------------------------------------------------------------------
       INTEGER  ::   jk
       !!----------------------------------------------------------------------
       !
-      IF( .NOT.lk_zco ) THEN
-         DO jk = 1, jpk
-            fsdept(:,:,jk) = gdept_0(jk)
-            fsdepw(:,:,jk) = gdepw_0(jk)
-            fsde3w(:,:,jk) = gdepw_0(jk)
-            fse3t (:,:,jk) = e3t_0(jk)
-            fse3u (:,:,jk) = e3t_0(jk)
-            fse3v (:,:,jk) = e3t_0(jk)
-            fse3f (:,:,jk) = e3t_0(jk)
-            fse3w (:,:,jk) = e3w_0(jk)
-            fse3uw(:,:,jk) = e3w_0(jk)
-            fse3vw(:,:,jk) = e3w_0(jk)
-         END DO
-      ENDIF
+      DO jk = 1, jpk
+         fsdept(:,:,jk) = gdept_0(jk)
+         fsdepw(:,:,jk) = gdepw_0(jk)
+         fsde3w(:,:,jk) = gdepw_0(jk)
+         fse3t (:,:,jk) = e3t_0(jk)
+         fse3u (:,:,jk) = e3t_0(jk)
+         fse3v (:,:,jk) = e3t_0(jk)
+         fse3f (:,:,jk) = e3t_0(jk)
+         fse3w (:,:,jk) = e3w_0(jk)
+         fse3uw(:,:,jk) = e3w_0(jk)
+         fse3vw(:,:,jk) = e3w_0(jk)
+      END DO
       !
    END SUBROUTINE zgr_zco
 
-#if defined key_zco
-   !!----------------------------------------------------------------------
-   !!   'key_zco' :                                              "pure" zco (gdep & e3 are 1D arrays)
-   !!----------------------------------------------------------------------
-   SUBROUTINE zgr_zps      ! Empty routine
-   END SUBROUTINE zgr_zps
-   SUBROUTINE zgr_sco      ! Empty routine
-   END SUBROUTINE zgr_sco
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option :                      zco, zps and/or sco available (gedp & e3 are 3D arrays)
-   !!----------------------------------------------------------------------
 
    SUBROUTINE zgr_zps
@@ -764,6 +808,7 @@
       REAL(wp) ::   ze3tp , ze3wp    ! Last ocean level thickness at T- and W-points
       REAL(wp) ::   zdepwp, zdepth   ! Ajusted ocean depth to avoid too small e3t
-      REAL(wp) ::   zmax, zmin       ! Maximum and minimum depth
+      REAL(wp) ::   zmax             ! Maximum depth
       REAL(wp) ::   zdiff            ! temporary scalar
+      REAL(wp) ::   zrefdep          ! temporary scalar
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zprt   ! 3D workspace
       !!---------------------------------------------------------------------
@@ -774,6 +819,6 @@
       IF(lwp) WRITE(numout,*) '              mbathy is recomputed : bathy_level file is NOT used'
 
-      ll_print=.FALSE.                     ! Local variable for debugging
-!!    ll_print=.TRUE.
+      ll_print = .FALSE.                   ! Local variable for debugging
+!!    ll_print = .TRUE.
       
       IF(lwp .AND. ll_print) THEN          ! control print of the ocean depth
@@ -786,21 +831,9 @@
       ! bathymetry in level (from bathy_meter)
       ! ===================
-      zmax = gdepw_0(jpk) + e3t_0(jpk)     ! maximum depth (i.e. the last ocean level thickness <= 2*e3t_0(jpkm1) )
-      zmin = gdepw_0(4)                    ! minimum depth = 3 levels
-
-      mbathy(:,:) = jpkm1                  ! initialize mbathy to the maximum ocean level available
-
-      !                                    ! storage of land and island's number (zera and negative values) in mbathy
-      WHERE( bathy(:,:) <= 0. )   mbathy(:,:) = INT( bathy(:,:) )
-
-      ! bounded value of bathy
-!!gm  bathy(:,:) = MIN(  zmax,  MAX( bathy(:,:), zmin )  )     !!gm : simpler   as zmin is > 0
-      DO jj = 1, jpj
-         DO ji= 1, jpi
-            IF( bathy(ji,jj) <= 0. ) THEN   ;   bathy(ji,jj) = 0.e0
-            ELSE                            ;   bathy(ji,jj) = MIN(  zmax,  MAX( bathy(ji,jj), zmin )  )
-            ENDIF
-         END DO
-      END DO
+      zmax = gdepw_0(jpk) + e3t_0(jpk)          ! maximum depth (i.e. the last ocean level thickness <= 2*e3t_0(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)
@@ -810,9 +843,5 @@
       DO jk = jpkm1, 1, -1
          zdepth = gdepw_0(jk) + MIN( e3zps_min, e3t_0(jk)*e3zps_rat )
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               IF( 0. < bathy(ji,jj) .AND. bathy(ji,jj) <= zdepth )   mbathy(ji,jj) = jk-1
-            END DO
-         END DO
+         WHERE( 0._wp < bathy(:,:) .AND. bathy(:,:) <= zdepth )   mbathy(:,:) = jk-1
       END DO
 
@@ -824,6 +853,4 @@
          e3w  (:,:,jk) = e3w_0  (jk)
       END DO
-      hdept(:,:) = gdept(:,:,2 )
-      hdepw(:,:) = gdepw(:,:,3 )     
       ! 
       DO jj = 1, jpj
@@ -835,5 +862,5 @@
                   zdepwp = bathy(ji,jj)
                   ze3tp  = bathy(ji,jj) - gdepw_0(ik)
-                  ze3wp = 0.5 * e3w_0(ik) * ( 1. + ( ze3tp/e3t_0(ik) ) )
+                  ze3wp = 0.5_wp * e3w_0(ik) * ( 1._wp + ( ze3tp/e3t_0(ik) ) )
                   e3t(ji,jj,ik  ) = ze3tp
                   e3t(ji,jj,ik+1) = ze3tp
@@ -855,6 +882,6 @@
                   e3t  (ji,jj,ik) = e3t_0  (ik) * ( gdepw  (ji,jj,ik+1) - gdepw_0(ik) )   & 
                      &                          / ( gdepw_0(      ik+1) - gdepw_0(ik) ) 
-                  e3w  (ji,jj,ik) = 0.5 * ( gdepw(ji,jj,ik+1) + gdepw_0(ik+1) - 2.*gdepw_0(ik) )   &
-                     &                  * ( e3w_0(ik) / ( gdepw_0(ik+1) - gdepw_0(ik) ) )
+                  e3w  (ji,jj,ik) = 0.5_wp * ( gdepw(ji,jj,ik+1) + gdepw_0(ik+1) - 2._wp * gdepw_0(ik) )   &
+                     &                     * ( e3w_0(ik) / ( gdepw_0(ik+1) - gdepw_0(ik) ) )
                   !       ... on ik+1
                   e3w  (ji,jj,ik+1) = e3t  (ji,jj,ik)
@@ -871,11 +898,9 @@
             ik = mbathy(ji,jj)
             IF( ik > 0 ) THEN               ! ocean point only
-               hdept(ji,jj) = gdept(ji,jj,ik  )
-               hdepw(ji,jj) = gdepw(ji,jj,ik+1)
                e3tp (ji,jj) = e3t(ji,jj,ik  )
                e3wp (ji,jj) = e3w(ji,jj,ik  )
                ! test
                zdiff= gdepw(ji,jj,ik+1) - gdept(ji,jj,ik  )
-               IF( zdiff <= 0. .AND. lwp ) THEN 
+               IF( zdiff <= 0._wp .AND. lwp ) THEN 
                   it = it + 1
                   WRITE(numout,*) ' it      = ', it, ' ik      = ', ik, ' (i,j) = ', ji, jj
@@ -890,14 +915,14 @@
       ! Scale factors and depth at U-, V-, UW and VW-points
       DO jk = 1, jpk                        ! initialisation to z-scale factors
-         e3u (:,:,jk)  = e3t_0(jk)
-         e3v (:,:,jk)  = e3t_0(jk)
-         e3uw(:,:,jk)  = e3w_0(jk)
-         e3vw(:,:,jk)  = e3w_0(jk)
+         e3u (:,:,jk) = e3t_0(jk)
+         e3v (:,:,jk) = e3t_0(jk)
+         e3uw(:,:,jk) = e3w_0(jk)
+         e3vw(:,:,jk) = e3w_0(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 (ji,jj,jk) = MIN( e3t(ji,jj,jk), e3t(ji+1,jj,jk))
-               e3v (ji,jj,jk) = MIN( e3t(ji,jj,jk), e3t(ji,jj+1,jk))
+               e3u (ji,jj,jk) = MIN( e3t(ji,jj,jk), e3t(ji+1,jj,jk) )
+               e3v (ji,jj,jk) = MIN( e3t(ji,jj,jk), e3t(ji,jj+1,jk) )
                e3uw(ji,jj,jk) = MIN( e3w(ji,jj,jk), e3w(ji+1,jj,jk) )
                e3vw(ji,jj,jk) = MIN( e3w(ji,jj,jk), e3w(ji,jj+1,jk) )
@@ -905,18 +930,17 @@
          END DO
       END DO
-      !                                     ! Boundary conditions
-      CALL lbc_lnk( e3u , 'U', 1. )   ;   CALL lbc_lnk( e3uw, 'U', 1. )
-      CALL lbc_lnk( e3v , 'V', 1. )   ;   CALL lbc_lnk( e3vw, 'V', 1. )
+      CALL lbc_lnk( e3u , 'U', 1._wp )   ;   CALL lbc_lnk( e3uw, 'U', 1._wp )   ! lateral boundary conditions
+      CALL lbc_lnk( e3v , 'V', 1._wp )   ;   CALL lbc_lnk( e3vw, 'V', 1._wp )
       !
       DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries)
-         WHERE( e3u (:,:,jk) == 0.e0 )   e3u (:,:,jk) = e3t_0(jk)
-         WHERE( e3v (:,:,jk) == 0.e0 )   e3v (:,:,jk) = e3t_0(jk)
-         WHERE( e3uw(:,:,jk) == 0.e0 )   e3uw(:,:,jk) = e3w_0(jk)
-         WHERE( e3vw(:,:,jk) == 0.e0 )   e3vw(:,:,jk) = e3w_0(jk)
+         WHERE( e3u (:,:,jk) == 0._wp )   e3u (:,:,jk) = e3t_0(jk)
+         WHERE( e3v (:,:,jk) == 0._wp )   e3v (:,:,jk) = e3t_0(jk)
+         WHERE( e3uw(:,:,jk) == 0._wp )   e3uw(:,:,jk) = e3w_0(jk)
+         WHERE( e3vw(:,:,jk) == 0._wp )   e3vw(:,:,jk) = e3w_0(jk)
       END DO
       
       ! Scale factor at F-point
       DO jk = 1, jpk                        ! initialisation to z-scale factors
-         e3f (:,:,jk) = e3t_0(jk)
+         e3f(:,:,jk) = e3t_0(jk)
       END DO
       DO jk = 1, jpk                        ! Computed as the minimum of neighbooring V-scale factors
@@ -927,8 +951,8 @@
          END DO
       END DO
-      CALL lbc_lnk( e3f, 'F', 1. )          ! Boundary conditions
+      CALL lbc_lnk( e3f, 'F', 1._wp )       ! Lateral boundary conditions
       !
       DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries)
-         WHERE( e3f(:,:,jk) == 0.e0 )   e3f(:,:,jk) = e3t_0(jk)
+         WHERE( e3f(:,:,jk) == 0._wp )   e3f(:,:,jk) = e3t_0(jk)
       END DO
 !!gm  bug ? :  must be a do loop with mj0,mj1
@@ -941,15 +965,15 @@
 
       ! Control of the sign
-      IF( MINVAL( e3t  (:,:,:) ) <= 0.e0 )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3t   <= 0' )
-      IF( MINVAL( e3w  (:,:,:) ) <= 0.e0 )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3w   <= 0' )
-      IF( MINVAL( gdept(:,:,:) ) <  0.e0 )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdepw <  0' )
-      IF( MINVAL( gdepw(:,:,:) ) <  0.e0 )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdepw <  0' )
+      IF( MINVAL( e3t  (:,:,:) ) <= 0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3t   <= 0' )
+      IF( MINVAL( e3w  (:,:,:) ) <= 0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3w   <= 0' )
+      IF( MINVAL( gdept(:,:,:) ) <  0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdepw <  0' )
+      IF( MINVAL( gdepw(:,:,:) ) <  0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdepw <  0' )
      
       ! Compute gdep3w (vertical sum of e3w)
-      gdep3w(:,:,1) = 0.5 * e3w(:,:,1)
+      gdep3w(:,:,1) = 0.5_wp * e3w(:,:,1)
       DO jk = 2, jpk
          gdep3w(:,:,jk) = gdep3w(:,:,jk-1) + e3w(:,:,jk) 
       END DO
-          
+        
       !                                               ! ================= !
       IF(lwp .AND. ll_print) THEN                     !   Control print   !
@@ -979,5 +1003,5 @@
          WRITE(numout,*) 'domzgr gdep3w(mbathy)'   ;   CALL prihre(zprt(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
       ENDIF  
-      !                                     
+      !
    END SUBROUTINE zgr_zps
 
@@ -993,16 +1017,14 @@
       !!                T-points at integer values (between 1 and jpk)
       !!                W-points at integer values - 1/2 (between 0.5 and jpk-0.5)
-      !!
-      !! Reference  :   ???
-      !!----------------------------------------------------------------------
-      REAL(wp), INTENT(in   ) ::   pk   ! continuous "k" coordinate
-      REAL(wp)                ::   pf   ! sigma value
-      !!----------------------------------------------------------------------
-      !
-      pf =   (   TANH( rn_theta * ( -(pk-0.5) / REAL(jpkm1) + rn_thetb )  )      &
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in) ::   pk   ! continuous "k" coordinate
+      REAL(wp)             ::   pf   ! sigma value
+      !!----------------------------------------------------------------------
+      !
+      pf =   (   TANH( rn_theta * ( -(pk-0.5_wp) / REAL(jpkm1) + rn_thetb )  )   &
          &     - TANH( rn_thetb * rn_theta                                )  )   &
-         & * (   COSH( rn_theta                           )                   &
-         &     + COSH( rn_theta * ( 2.e0 * rn_thetb - 1.e0 ) )  )                &
-         & / ( 2.e0 * SINH( rn_theta ) )
+         & * (   COSH( rn_theta                           )                      &
+         &     + COSH( rn_theta * ( 2._wp * rn_thetb - 1._wp ) )  )              &
+         & / ( 2._wp * SINH( rn_theta ) )
       !
    END FUNCTION fssig
@@ -1019,18 +1041,16 @@
       !!                T-points at integer values (between 1 and jpk)
       !!                W-points at integer values - 1/2 (between 0.5 and jpk-0.5)
-      !!
-      !! Reference  :   ???
-      !!----------------------------------------------------------------------
-      REAL(wp), INTENT(in   ) ::   pk1   ! continuous "k" coordinate
-      REAL(wp), INTENT(in   ) ::   pbb   ! Stretching coefficient
-      REAL(wp)                ::   pf1   ! sigma value
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in) ::   pk1   ! continuous "k" coordinate
+      REAL(wp), INTENT(in) ::   pbb   ! Stretching coefficient
+      REAL(wp)             ::   pf1   ! sigma value
       !!----------------------------------------------------------------------
       !
       IF ( rn_theta == 0 ) then      ! uniform sigma
-         pf1 = -(pk1-0.5) / REAL( jpkm1 )
+         pf1 = - ( pk1 - 0.5_wp ) / REAL( jpkm1 )
       ELSE                        ! stretched sigma
-         pf1 =   (1.0-pbb) * (sinh( rn_theta*(-(pk1-0.5)/REAL(jpkm1)) ) ) / sinh(rn_theta) + &
-            &    pbb * ( (tanh( rn_theta*( (-(pk1-0.5)/REAL(jpkm1)) + 0.5) ) - tanh(0.5*rn_theta) ) / &
-            &    (2*tanh(0.5*rn_theta) ) )
+         pf1 =   ( 1._wp - pbb ) * ( SINH( rn_theta*(-(pk1-0.5_wp)/REAL(jpkm1)) ) ) / SINH( rn_theta )              &
+            &  + pbb * (  (TANH( rn_theta*( (-(pk1-0.5_wp)/REAL(jpkm1)) + 0.5_wp) ) - TANH( 0.5_wp * rn_theta )  )  &
+            &        / ( 2._wp * TANH( 0.5_wp * rn_theta ) )  )
       ENDIF
       !
@@ -1109,8 +1129,8 @@
       ENDIF
 
-      gsigw3  = 0.0d0   ;   gsigt3  = 0.0d0   ; gsi3w3 = 0.0d0
-      esigt3  = 0.0d0   ;   esigw3  = 0.0d0 
-      esigtu3 = 0.0d0   ;   esigtv3 = 0.0d0   ; esigtf3 = 0.0d0
-      esigwu3 = 0.0d0   ;   esigwv3 = 0.0d0
+      gsigw3  = 0._wp   ;   gsigt3  = 0._wp   ;   gsi3w3  = 0._wp
+      esigt3  = 0._wp   ;   esigw3  = 0._wp 
+      esigtu3 = 0._wp   ;   esigtv3 = 0._wp   ;   esigtf3 = 0._wp
+      esigwu3 = 0._wp   ;   esigwv3 = 0._wp
 
       hift(:,:) = rn_sbot_min                     ! set the minimum depth for the s-coordinate
@@ -1124,5 +1144,5 @@
       DO jj = 1, jpj
          DO ji = 1, jpi
-           IF (bathy(ji,jj) .gt. 0.0) THEN
+           IF( bathy(ji,jj) > 0._wp ) THEN
               bathy(ji,jj) = MAX( rn_sbot_min, bathy(ji,jj) )
            ENDIF
@@ -1140,15 +1160,15 @@
       ! 
       ! Smooth the bathymetry (if required)
-      scosrf(:,:) = 0.e0              ! ocean surface depth (here zero: no under ice-shelf sea)
+      scosrf(:,:) = 0._wp             ! ocean surface depth (here zero: no under ice-shelf sea)
       scobot(:,:) = bathy(:,:)        ! ocean bottom  depth
       !
       jl = 0
-      zrmax = 1.e0
+      zrmax = 1._wp
       !                                                     ! ================ !
-      DO WHILE ( jl <= 10000 .AND. zrmax > rn_rmax )          !  Iterative loop  !
+      DO WHILE( jl <= 10000 .AND. zrmax > rn_rmax )         !  Iterative loop  !
          !                                                  ! ================ !
          jl = jl + 1
-         zrmax = 0.e0
-         zmsk(:,:) = 0.e0
+         zrmax = 0._wp
+         zmsk(:,:) = 0._wp
          DO jj = 1, nlcj
             DO ji = 1, nlci
@@ -1158,13 +1178,13 @@
                zrj(ji,jj) = ABS( zenv(ji  ,ijp1) - zenv(ji,jj) ) / ( zenv(ji  ,ijp1) + zenv(ji,jj) )
                zrmax = MAX( zrmax, zri(ji,jj), zrj(ji,jj) )
-               IF( zri(ji,jj) > rn_rmax )   zmsk(ji  ,jj  ) = 1.0
-               IF( zri(ji,jj) > rn_rmax )   zmsk(iip1,jj  ) = 1.0
-               IF( zrj(ji,jj) > rn_rmax )   zmsk(ji  ,jj  ) = 1.0
-               IF( zrj(ji,jj) > rn_rmax )   zmsk(ji  ,ijp1) = 1.0
+               IF( zri(ji,jj) > rn_rmax )   zmsk(ji  ,jj  ) = 1._wp
+               IF( zri(ji,jj) > rn_rmax )   zmsk(iip1,jj  ) = 1._wp
+               IF( zrj(ji,jj) > rn_rmax )   zmsk(ji  ,jj  ) = 1._wp
+               IF( zrj(ji,jj) > rn_rmax )   zmsk(ji  ,ijp1) = 1._wp
             END DO
          END DO
          IF( lk_mpp )   CALL mpp_max( zrmax )   ! max over the global domain
          ! lateral boundary condition on zmsk: keep 1 along closed boundary (use of MAX)
-         ztmp(:,:) = zmsk(:,:)   ;   CALL lbc_lnk( zmsk, 'T', 1. )
+         ztmp(:,:) = zmsk(:,:)   ;   CALL lbc_lnk( zmsk, 'T', 1._wp )
          DO jj = 1, nlcj
             DO ji = 1, nlci
@@ -1181,12 +1201,12 @@
                iim1 = MAX( ji-1,  1  )      ! first line (ji=nlci)
                ijm1 = MAX( jj-1,  1  )      ! first raw  (jj=nlcj)
-               IF( zmsk(ji,jj) == 1.0 ) THEN
+               IF( zmsk(ji,jj) == 1._wp ) THEN
                   ztmp(ji,jj) =   (                                                                                   &
              &      zenv(iim1,ijp1)*zmsk(iim1,ijp1) + zenv(ji,ijp1)*zmsk(ji,ijp1) + zenv(iip1,ijp1)*zmsk(iip1,ijp1)   &
-             &    + zenv(iim1,jj  )*zmsk(iim1,jj  ) + zenv(ji,jj  )*    2.e0      + zenv(iip1,jj  )*zmsk(iip1,jj  )   &
+             &    + zenv(iim1,jj  )*zmsk(iim1,jj  ) + zenv(ji,jj  )*    2._wp     + zenv(iip1,jj  )*zmsk(iip1,jj  )   &
              &    + zenv(iim1,ijm1)*zmsk(iim1,ijm1) + zenv(ji,ijm1)*zmsk(ji,ijm1) + zenv(iip1,ijm1)*zmsk(iip1,ijm1)   &
              &                    ) / (                                                                               &
              &                      zmsk(iim1,ijp1) +               zmsk(ji,ijp1) +                 zmsk(iip1,ijp1)   &
-             &    +                 zmsk(iim1,jj  ) +                   2.e0      +                 zmsk(iip1,jj  )   &
+             &    +                 zmsk(iim1,jj  ) +                   2._wp     +                 zmsk(iip1,jj  )   &
              &    +                 zmsk(iim1,ijm1) +               zmsk(ji,ijm1) +                 zmsk(iip1,ijm1)   &
              &                        )
@@ -1197,13 +1217,13 @@
          DO jj = 1, nlcj
             DO ji = 1, nlci
-               IF( zmsk(ji,jj) == 1.0 )   zenv(ji,jj) = MAX( ztmp(ji,jj), bathy(ji,jj) )
+               IF( zmsk(ji,jj) == 1._wp )   zenv(ji,jj) = MAX( ztmp(ji,jj), bathy(ji,jj) )
             END DO
          END DO
          !
          ! Apply lateral boundary condition   CAUTION: kept the value when the lbc field is zero
-         ztmp(:,:) = zenv(:,:)   ;   CALL lbc_lnk( zenv, 'T', 1. )
+         ztmp(:,:) = zenv(:,:)   ;   CALL lbc_lnk( zenv, 'T', 1._wp )
          DO jj = 1, nlcj
             DO ji = 1, nlci
-               IF( zenv(ji,jj) == 0.e0 )   zenv(ji,jj) = ztmp(ji,jj)
+               IF( zenv(ji,jj) == 0._wp )   zenv(ji,jj) = ztmp(ji,jj)
             END DO
          END DO
@@ -1214,10 +1234,10 @@
       !                                        ! envelop bathymetry saved in hbatt
       hbatt(:,:) = zenv(:,:) 
-      IF( MINVAL( gphit(:,:) ) * MAXVAL( gphit(:,:) ) <= 0.e0 ) THEN
+      IF( MINVAL( gphit(:,:) ) * MAXVAL( gphit(:,:) ) <= 0._wp ) THEN
          CALL ctl_warn( ' s-coordinates are tapered in vicinity of the Equator' )
          DO jj = 1, jpj
             DO ji = 1, jpi
-               ztaper = EXP( -(gphit(ji,jj)/8)**2 )
-               hbatt(ji,jj) = rn_sbot_max * ztaper + hbatt(ji,jj) * (1.-ztaper)
+               ztaper = EXP( -(gphit(ji,jj)/8._wp)**2 )
+               hbatt(ji,jj) = rn_sbot_max * ztaper + hbatt(ji,jj) * ( 1._wp - ztaper )
             END DO
          END DO
@@ -1228,5 +1248,5 @@
          WRITE(numout,*) ' domzgr: hbatt field; ocean depth in meters'
          WRITE(numout,*)
-         CALL prihre( hbatt(1,1), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 0., numout )
+         CALL prihre( hbatt(1,1), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 0._wp, numout )
          IF( nprint == 1 )   THEN        
             WRITE(numout,*) ' bathy  MAX ', MAXVAL( bathy(:,:) ), ' MIN ', MINVAL( bathy(:,:) )
@@ -1247,8 +1267,8 @@
       DO jj = 1, jpjm1
         DO ji = 1, jpim1   ! NO vector opt.
-           hbatu(ji,jj) = 0.5 * ( hbatt(ji  ,jj) + hbatt(ji+1,jj  ) )
-           hbatv(ji,jj) = 0.5 * ( hbatt(ji  ,jj) + hbatt(ji  ,jj+1) )
-           hbatf(ji,jj) = 0.25* ( hbatt(ji  ,jj) + hbatt(ji  ,jj+1)   &
-              &                 + hbatt(ji+1,jj) + hbatt(ji+1,jj+1) )
+           hbatu(ji,jj) = 0.50_wp * ( hbatt(ji  ,jj) + hbatt(ji+1,jj  ) )
+           hbatv(ji,jj) = 0.50_wp * ( hbatt(ji  ,jj) + hbatt(ji  ,jj+1) )
+           hbatf(ji,jj) = 0.25_wp * ( hbatt(ji  ,jj) + hbatt(ji  ,jj+1)   &
+              &                     + hbatt(ji+1,jj) + hbatt(ji+1,jj+1) )
         END DO
       END DO
@@ -1256,28 +1276,28 @@
       ! Apply lateral boundary condition
 !!gm  ! CAUTION: retain non zero value in the initial file this should be OK for orca cfg, not for EEL
-      zhbat(:,:) = hbatu(:,:)   ;   CALL lbc_lnk( hbatu, 'U', 1. )
+      zhbat(:,:) = hbatu(:,:)   ;   CALL lbc_lnk( hbatu, 'U', 1._wp )
       DO jj = 1, jpj
          DO ji = 1, jpi
-            IF( hbatu(ji,jj) == 0.e0 ) THEN
-               IF( zhbat(ji,jj) == 0.e0 )   hbatu(ji,jj) = rn_sbot_min
-               IF( zhbat(ji,jj) /= 0.e0 )   hbatu(ji,jj) = zhbat(ji,jj)
+            IF( hbatu(ji,jj) == 0._wp ) THEN
+               IF( zhbat(ji,jj) == 0._wp )   hbatu(ji,jj) = rn_sbot_min
+               IF( zhbat(ji,jj) /= 0._wp )   hbatu(ji,jj) = zhbat(ji,jj)
             ENDIF
          END DO
       END DO
-      zhbat(:,:) = hbatv(:,:)   ;   CALL lbc_lnk( hbatv, 'V', 1. )
+      zhbat(:,:) = hbatv(:,:)   ;   CALL lbc_lnk( hbatv, 'V', 1._wp )
       DO jj = 1, jpj
          DO ji = 1, jpi
-            IF( hbatv(ji,jj) == 0.e0 ) THEN
-               IF( zhbat(ji,jj) == 0.e0 )   hbatv(ji,jj) = rn_sbot_min
-               IF( zhbat(ji,jj) /= 0.e0 )   hbatv(ji,jj) = zhbat(ji,jj)
+            IF( hbatv(ji,jj) == 0._wp ) THEN
+               IF( zhbat(ji,jj) == 0._wp )   hbatv(ji,jj) = rn_sbot_min
+               IF( zhbat(ji,jj) /= 0._wp )   hbatv(ji,jj) = zhbat(ji,jj)
             ENDIF
          END DO
       END DO
-      zhbat(:,:) = hbatf(:,:)   ;   CALL lbc_lnk( hbatf, 'F', 1. )
+      zhbat(:,:) = hbatf(:,:)   ;   CALL lbc_lnk( hbatf, 'F', 1._wp )
       DO jj = 1, jpj
          DO ji = 1, jpi
-            IF( hbatf(ji,jj) == 0.e0 ) THEN
-               IF( zhbat(ji,jj) == 0.e0 )   hbatf(ji,jj) = rn_sbot_min
-               IF( zhbat(ji,jj) /= 0.e0 )   hbatf(ji,jj) = zhbat(ji,jj)
+            IF( hbatf(ji,jj) == 0._wp ) THEN
+               IF( zhbat(ji,jj) == 0._wp )   hbatf(ji,jj) = rn_sbot_min
+               IF( zhbat(ji,jj) /= 0._wp )   hbatf(ji,jj) = zhbat(ji,jj)
             ENDIF
          END DO
@@ -1313,81 +1333,77 @@
             DO jj = 1, jpj
 
-             IF (hbatt(ji,jj).GT.rn_hc) THEN !deep water, stretched sigma
+               IF( hbatt(ji,jj) > rn_hc ) THEN    !deep water, stretched sigma
+                  DO jk = 1, jpk
+                     gsigw3(ji,jj,jk) = -fssig1( REAL(jk,wp)-0.5_wp, rn_bb )
+                     gsigt3(ji,jj,jk) = -fssig1( REAL(jk,wp)       , rn_bb )
+                  END DO
+               ELSE ! shallow water, uniform sigma
+                  DO jk = 1, jpk
+                     gsigw3(ji,jj,jk) =   REAL(jk-1,wp)            / REAL(jpk-1,wp)
+                     gsigt3(ji,jj,jk) = ( REAL(jk-1,wp) + 0.5_wp ) / REAL(jpk-1,wp)
+                  END DO
+               ENDIF
+               IF( nprint == 1 .AND. lwp )   WRITE(numout,*) 'gsigw3 1 jpk    ', gsigw3(ji,jj,1), gsigw3(ji,jj,jpk)
+               !
+               DO jk = 1, jpkm1
+                  esigt3(ji,jj,jk  ) = gsigw3(ji,jj,jk+1) - gsigw3(ji,jj,jk)
+                  esigw3(ji,jj,jk+1) = gsigt3(ji,jj,jk+1) - gsigt3(ji,jj,jk)
+               END DO
+               esigw3(ji,jj,1  ) = 2._wp * ( gsigt3(ji,jj,1  ) - gsigw3(ji,jj,1  ) )
+               esigt3(ji,jj,jpk) = 2._wp * ( gsigt3(ji,jj,jpk) - gsigw3(ji,jj,jpk) )
+               !
+               ! Coefficients for vertical depth as the sum of e3w scale factors
+               gsi3w3(ji,jj,1) = 0.5_wp * esigw3(ji,jj,1)
+               DO jk = 2, jpk
+                  gsi3w3(ji,jj,jk) = gsi3w3(ji,jj,jk-1) + esigw3(ji,jj,jk)
+               END DO
+               !
                DO jk = 1, jpk
-                  gsigw3(ji,jj,jk) = -fssig1( REAL(jk,wp)-0.5_wp, rn_bb )
-                  gsigt3(ji,jj,jk) = -fssig1( REAL(jk,wp)       , rn_bb )
+                  zcoeft = ( REAL(jk,wp) - 0.5_wp ) / REAL(jpkm1,wp)
+                  zcoefw = ( REAL(jk,wp) - 1.0_wp ) / REAL(jpkm1,wp)
+                  gdept (ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*gsigt3(ji,jj,jk)+rn_hc*zcoeft )
+                  gdepw (ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*gsigw3(ji,jj,jk)+rn_hc*zcoefw )
+                  gdep3w(ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*gsi3w3(ji,jj,jk)+rn_hc*zcoeft )
                END DO
-             ELSE ! shallow water, uniform sigma
+               !
+            END DO   ! for all jj's
+         END DO    ! for all ji's
+
+         DO ji = 1, jpi
+            DO jj = 1, jpj
                DO jk = 1, jpk
-                 gsigw3(ji,jj,jk) =  REAL(jk-1,wp)     /REAL(jpk-1,wp)
-                 gsigt3(ji,jj,jk) = (REAL(jk-1,wp)+0.5)/REAL(jpk-1,wp)
+                  esigtu3(ji,jj,jk) = ( hbatt(ji,jj)*esigt3(ji,jj,jk)+hbatt(ji+1,jj)*esigt3(ji+1,jj,jk) )   &
+                     &              / ( hbatt(ji,jj)+hbatt(ji+1,jj) )
+                  esigtv3(ji,jj,jk) = ( hbatt(ji,jj)*esigt3(ji,jj,jk)+hbatt(ji,jj+1)*esigt3(ji,jj+1,jk) )   &
+                     &              / ( hbatt(ji,jj)+hbatt(ji,jj+1) )
+                  esigtf3(ji,jj,jk) = ( hbatt(ji,jj)*esigt3(ji,jj,jk)+hbatt(ji+1,jj)*esigt3(ji+1,jj,jk)     &
+                     &                + hbatt(ji,jj+1)*esigt3(ji,jj+1,jk)+hbatt(ji+1,jj+1)*esigt3(ji+1,jj+1,jk) )   &
+                     &              / ( hbatt(ji,jj)+hbatt(ji+1,jj)+hbatt(ji,jj+1)+hbatt(ji+1,jj+1) )
+                  esigwu3(ji,jj,jk) = ( hbatt(ji,jj)*esigw3(ji,jj,jk)+hbatt(ji+1,jj)*esigw3(ji+1,jj,jk) )   &
+                     &              / ( hbatt(ji,jj)+hbatt(ji+1,jj) )
+                  esigwv3(ji,jj,jk) = ( hbatt(ji,jj)*esigw3(ji,jj,jk)+hbatt(ji,jj+1)*esigw3(ji,jj+1,jk) )   &
+                     &              / ( hbatt(ji,jj)+hbatt(ji,jj+1) )
+                  !
+                  e3t(ji,jj,jk) = ( (hbatt(ji,jj)-rn_hc)*esigt3 (ji,jj,jk) + rn_hc/FLOAT(jpkm1) )
+                  e3u(ji,jj,jk) = ( (hbatu(ji,jj)-rn_hc)*esigtu3(ji,jj,jk) + rn_hc/FLOAT(jpkm1) )
+                  e3v(ji,jj,jk) = ( (hbatv(ji,jj)-rn_hc)*esigtv3(ji,jj,jk) + rn_hc/FLOAT(jpkm1) )
+                  e3f(ji,jj,jk) = ( (hbatf(ji,jj)-rn_hc)*esigtf3(ji,jj,jk) + rn_hc/FLOAT(jpkm1) )
+                  !
+                  e3w (ji,jj,jk) = ( (hbatt(ji,jj)-rn_hc)*esigw3 (ji,jj,jk) + rn_hc/FLOAT(jpkm1) )
+                  e3uw(ji,jj,jk) = ( (hbatu(ji,jj)-rn_hc)*esigwu3(ji,jj,jk) + rn_hc/FLOAT(jpkm1) )
+                  e3vw(ji,jj,jk) = ( (hbatv(ji,jj)-rn_hc)*esigwv3(ji,jj,jk) + rn_hc/FLOAT(jpkm1) )
                END DO
-             ENDIF
-             IF( nprint == 1 .AND. lwp ) WRITE(numout,*) 'gsigw3 1 jpk    ', gsigw3(ji,jj,1), gsigw3(ji,jj,jpk)
-
-
-             DO jk = 1, jpkm1
-                esigt3(ji,jj,jk) = gsigw3(ji,jj,jk+1) - gsigw3(ji,jj,jk)
-                esigw3(ji,jj,jk+1) = gsigt3(ji,jj,jk+1) - gsigt3(ji,jj,jk)
-             END DO
-             esigw3(ji,jj,1  ) = 2.0_wp * (gsigt3(ji,jj,1  ) - gsigw3(ji,jj,1  ))
-             esigt3(ji,jj,jpk) = 2.0_wp * (gsigt3(ji,jj,jpk) - gsigw3(ji,jj,jpk))
-
-             ! Coefficients for vertical depth as the sum of e3w scale factors
-             gsi3w3(ji,jj,1) = 0.5 * esigw3(ji,jj,1)
-             DO jk = 2, jpk
-                gsi3w3(ji,jj,jk) = gsi3w3(ji,jj,jk-1) + esigw3(ji,jj,jk)
-             END DO
-
-             DO jk = 1, jpk
-                zcoeft = ( REAL(jk,wp) - 0.5 ) / REAL(jpkm1,wp)
-                zcoefw = ( REAL(jk,wp) - 1.0 ) / REAL(jpkm1,wp)
-                gdept (ji,jj,jk) = (scosrf(ji,jj)+(hbatt(ji,jj)-rn_hc)*gsigt3(ji,jj,jk)+rn_hc*zcoeft)
-                gdepw (ji,jj,jk) = (scosrf(ji,jj)+(hbatt(ji,jj)-rn_hc)*gsigw3(ji,jj,jk)+rn_hc*zcoefw)
-                gdep3w(ji,jj,jk) = (scosrf(ji,jj)+(hbatt(ji,jj)-rn_hc)*gsi3w3(ji,jj,jk)+rn_hc*zcoeft)
-             END DO
-
-           ENDDO   ! for all jj's
-         ENDDO    ! for all ji's
-
-
-         DO ji=1,jpi
-           DO jj=1,jpj
-
-             DO jk = 1, jpk
-                esigtu3(ji,jj,jk) = ( hbatt(ji,jj)*esigt3(ji,jj,jk)+hbatt(ji+1,jj)*esigt3(ji+1,jj,jk) ) / &
-                                   ( hbatt(ji,jj)+hbatt(ji+1,jj) )
-                esigtv3(ji,jj,jk) = ( hbatt(ji,jj)*esigt3(ji,jj,jk)+hbatt(ji,jj+1)*esigt3(ji,jj+1,jk) ) / &
-                                   ( hbatt(ji,jj)+hbatt(ji,jj+1) )
-                esigtf3(ji,jj,jk) = ( hbatt(ji,jj)*esigt3(ji,jj,jk)+hbatt(ji+1,jj)*esigt3(ji+1,jj,jk) +  &
-                                     hbatt(ji,jj+1)*esigt3(ji,jj+1,jk)+hbatt(ji+1,jj+1)*esigt3(ji+1,jj+1,jk) ) / &
-                                   ( hbatt(ji,jj)+hbatt(ji+1,jj)+hbatt(ji,jj+1)+hbatt(ji+1,jj+1) )
-                esigwu3(ji,jj,jk) = ( hbatt(ji,jj)*esigw3(ji,jj,jk)+hbatt(ji+1,jj)*esigw3(ji+1,jj,jk) ) / &
-                                   ( hbatt(ji,jj)+hbatt(ji+1,jj) )
-                esigwv3(ji,jj,jk) = ( hbatt(ji,jj)*esigw3(ji,jj,jk)+hbatt(ji,jj+1)*esigw3(ji,jj+1,jk) ) / &
-                                   ( hbatt(ji,jj)+hbatt(ji,jj+1) )
-
-                e3t(ji,jj,jk)=((hbatt(ji,jj)-rn_hc)*esigt3(ji,jj,jk) + rn_hc/FLOAT(jpkm1))
-                e3u(ji,jj,jk)=((hbatu(ji,jj)-rn_hc)*esigtu3(ji,jj,jk) + rn_hc/FLOAT(jpkm1))
-                e3v(ji,jj,jk)=((hbatv(ji,jj)-rn_hc)*esigtv3(ji,jj,jk) + rn_hc/FLOAT(jpkm1))
-                e3f(ji,jj,jk)=((hbatf(ji,jj)-rn_hc)*esigtf3(ji,jj,jk) + rn_hc/FLOAT(jpkm1))
-                !
-                e3w (ji,jj,jk)=((hbatt(ji,jj)-rn_hc)*esigw3(ji,jj,jk) + rn_hc/FLOAT(jpkm1))
-                e3uw(ji,jj,jk)=((hbatu(ji,jj)-rn_hc)*esigwu3(ji,jj,jk) + rn_hc/FLOAT(jpkm1))
-                e3vw(ji,jj,jk)=((hbatv(ji,jj)-rn_hc)*esigwv3(ji,jj,jk) + rn_hc/FLOAT(jpkm1))
-             END DO
-
-           ENDDO
-         ENDDO
-
+            END DO
+         END DO
+         !
       ELSE   ! not ln_s_sigma
-
+         !
          DO jk = 1, jpk
            gsigw(jk) = -fssig( REAL(jk,wp)-0.5_wp )
-           gsigt(jk) = -fssig( REAL(jk,wp)     )
-         END DO
-         IF( nprint == 1 .AND. lwp ) WRITE(numout,*) 'gsigw 1 jpk    ', gsigw(1), gsigw(jpk)
+           gsigt(jk) = -fssig( REAL(jk,wp)        )
+         END DO
+         IF( nprint == 1 .AND. lwp )   WRITE(numout,*) 'gsigw 1 jpk    ', gsigw(1), gsigw(jpk)
          !
-     ! Coefficients for vertical scale factors at w-, t- levels
+         ! Coefficients for vertical scale factors at w-, t- levels
 !!gm bug :  define it from analytical function, not like juste bellow....
 !!gm        or betteroffer the 2 possibilities....
@@ -1396,6 +1412,6 @@
             esigw(jk+1) = gsigt(jk+1) - gsigt(jk)
          END DO
-         esigw( 1 ) = 2.0_wp * (gsigt(1) - gsigw(1)) 
-         esigt(jpk) = 2.0_wp * (gsigt(jpk) - gsigw(jpk))
+         esigw( 1 ) = 2._wp * ( gsigt(1  ) - gsigw(1  ) ) 
+         esigt(jpk) = 2._wp * ( gsigt(jpk) - gsigw(jpk) )
 
 !!gm  original form
@@ -1407,5 +1423,5 @@
          !
          ! Coefficients for vertical depth as the sum of e3w scale factors
-         gsi3w(1) = 0.5 * esigw(1)
+         gsi3w(1) = 0.5_wp * esigw(1)
          DO jk = 2, jpk
             gsi3w(jk) = gsi3w(jk-1) + esigw(jk)
@@ -1413,9 +1429,9 @@
 !!gm: depuw, depvw can be suppressed (modif in ldfslp) and depw=dep3w can be set (save 3 3D arrays)
          DO jk = 1, jpk
-            zcoeft = ( FLOAT(jk) - 0.5 ) / FLOAT(jpkm1)
-            zcoefw = ( FLOAT(jk) - 1.0 ) / FLOAT(jpkm1)
-            gdept (:,:,jk) = (scosrf(:,:)+(hbatt(:,:)-hift(:,:))*gsigt(jk)+hift(:,:)*zcoeft)
-            gdepw (:,:,jk) = (scosrf(:,:)+(hbatt(:,:)-hift(:,:))*gsigw(jk)+hift(:,:)*zcoefw)
-            gdep3w(:,:,jk) = (scosrf(:,:)+(hbatt(:,:)-hift(:,:))*gsi3w(jk)+hift(:,:)*zcoeft)
+            zcoeft = ( REAL(jk,wp) - 0.5_wp ) / REAL(jpkm1,wp)
+            zcoefw = ( REAL(jk,wp) - 1.0_wp ) / REAL(jpkm1,wp)
+            gdept (:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*gsigt(jk) + hift(:,:)*zcoeft )
+            gdepw (:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*gsigw(jk) + hift(:,:)*zcoefw )
+            gdep3w(:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*gsi3w(jk) + hift(:,:)*zcoeft )
          END DO
 !!gm: e3uw, e3vw can be suppressed  (modif in dynzdf, dynzdf_iso, zdfbfr) (save 2 3D arrays)
@@ -1423,16 +1439,16 @@
             DO ji = 1, jpi
                DO jk = 1, jpk
-                 e3t(ji,jj,jk)=((hbatt(ji,jj)-hift(ji,jj))*esigt(jk) + hift(ji,jj)/FLOAT(jpkm1))
-                 e3u(ji,jj,jk)=((hbatu(ji,jj)-hifu(ji,jj))*esigt(jk) + hifu(ji,jj)/FLOAT(jpkm1))
-                 e3v(ji,jj,jk)=((hbatv(ji,jj)-hifv(ji,jj))*esigt(jk) + hifv(ji,jj)/FLOAT(jpkm1))
-                 e3f(ji,jj,jk)=((hbatf(ji,jj)-hiff(ji,jj))*esigt(jk) + hiff(ji,jj)/FLOAT(jpkm1))
+                 e3t(ji,jj,jk) = ( (hbatt(ji,jj)-hift(ji,jj))*esigt(jk) + hift(ji,jj)/REAL(jpkm1,wp) )
+                 e3u(ji,jj,jk) = ( (hbatu(ji,jj)-hifu(ji,jj))*esigt(jk) + hifu(ji,jj)/REAL(jpkm1,wp) )
+                 e3v(ji,jj,jk) = ( (hbatv(ji,jj)-hifv(ji,jj))*esigt(jk) + hifv(ji,jj)/REAL(jpkm1,wp) )
+                 e3f(ji,jj,jk) = ( (hbatf(ji,jj)-hiff(ji,jj))*esigt(jk) + hiff(ji,jj)/REAL(jpkm1,wp) )
                  !
-                 e3w (ji,jj,jk)=((hbatt(ji,jj)-hift(ji,jj))*esigw(jk) + hift(ji,jj)/FLOAT(jpkm1))
-                 e3uw(ji,jj,jk)=((hbatu(ji,jj)-hifu(ji,jj))*esigw(jk) + hifu(ji,jj)/FLOAT(jpkm1))
-                 e3vw(ji,jj,jk)=((hbatv(ji,jj)-hifv(ji,jj))*esigw(jk) + hifv(ji,jj)/FLOAT(jpkm1))
+                 e3w (ji,jj,jk) = ( (hbatt(ji,jj)-hift(ji,jj))*esigw(jk) + hift(ji,jj)/REAL(jpkm1,wp) )
+                 e3uw(ji,jj,jk) = ( (hbatu(ji,jj)-hifu(ji,jj))*esigw(jk) + hifu(ji,jj)/REAL(jpkm1,wp) )
+                 e3vw(ji,jj,jk) = ( (hbatv(ji,jj)-hifv(ji,jj))*esigw(jk) + hifv(ji,jj)/REAL(jpkm1,wp) )
                END DO
             END DO
          END DO
-
+         !
       ENDIF ! ln_s_sigma
 
@@ -1457,5 +1473,5 @@
             DO jk = 1, jpkm1
                IF( scobot(ji,jj) >= fsdept(ji,jj,jk) )   mbathy(ji,jj) = MAX( 2, jk )
-               IF( scobot(ji,jj) == 0.e0             )   mbathy(ji,jj) = 0
+               IF( scobot(ji,jj) == 0._wp            )   mbathy(ji,jj) = 0
             END DO
          END DO
@@ -1463,5 +1479,4 @@
       IF( nprint == 1 .AND. lwp ) WRITE(numout,*) ' MIN val mbathy h90 ', MINVAL( mbathy(:,:) ),   &
          &                                                       ' MAX ', MAXVAL( mbathy(:,:) )
-
 
       !                                               ! =============
@@ -1523,9 +1538,9 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               IF( fse3w(ji,jj,jk) <= 0. .OR. fse3t(ji,jj,jk) <= 0. ) THEN
+               IF( fse3w(ji,jj,jk) <= 0._wp .OR. fse3t(ji,jj,jk) <= 0._wp ) THEN
                   WRITE(ctmp1,*) 'zgr_sco :   e3w   or e3t   =< 0  at point (i,j,k)= ', ji, jj, jk
                   CALL ctl_stop( ctmp1 )
                ENDIF
-               IF( fsdepw(ji,jj,jk) < 0. .OR. fsdept(ji,jj,jk) < 0. ) THEN
+               IF( fsdepw(ji,jj,jk) < 0._wp .OR. fsdept(ji,jj,jk) < 0._wp ) THEN
                   WRITE(ctmp1,*) 'zgr_sco :   gdepw or gdept =< 0  at point (i,j,k)= ', ji, jj, jk
                   CALL ctl_stop( ctmp1 )
@@ -1538,5 +1553,4 @@
    END SUBROUTINE zgr_sco
 
-#endif
 
    !!======================================================================
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr_substitute.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr_substitute.h90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr_substitute.h90	(revision 2528)
@@ -8,17 +8,4 @@
    !!            3.1  !  2009-02  (G. Madec, M. Leclair)  pure z* coordinate
    !!----------------------------------------------------------------------
-#if defined key_zco
-! reference for pure z-coordinate (1D - no i,j and time dependency)
-#   define  fsdept_0(i,j,k)  gdept_0(k)
-#   define  fsdepw_0(i,j,k)  gdepw_0(k)
-#   define  fsde3w_0(i,j,k)  gdepw_0(k)
-#   define  fse3t_0(i,j,k)   e3t_0(k)
-#   define  fse3u_0(i,j,k)   e3t_0(k)
-#   define  fse3v_0(i,j,k)   e3t_0(k)
-#   define  fse3f_0(i,j,k)   e3t_0(k)
-#   define  fse3w_0(i,j,k)   e3w_0(k)
-#   define  fse3uw_0(i,j,k)  e3w_0(k)
-#   define  fse3vw_0(i,j,k)  e3w_0(k)
-#else
 ! reference for s- or zps-coordinate (3D no time dependency)
 #   define  fsdept_0(i,j,k)  gdept(i,j,k)
@@ -32,5 +19,4 @@
 #   define  fse3uw_0(i,j,k)  e3uw(i,j,k)
 #   define  fse3vw_0(i,j,k)  e3vw(i,j,k)
-#endif
 #if defined key_vvl
 ! s* or z*-coordinate (3D + time dependency) + use of additional now arrays (..._1)
@@ -46,12 +32,7 @@
 #   define  fse3vw(i,j,k)  e3vw_1(i,j,k)
 
-#   define  fsdept_b(i,j,k)  (fsdept_0(i,j,k)*(1.+sshb(i,j)*mut(i,j,k)))
-#   define  fsdepw_b(i,j,k)  (fsdepw_0(i,j,k)*(1.+sshb(i,j)*mut(i,j,k)))
-#   define  fsde3w_b(i,j,k)  (fsde3w_0(i,j,k)*(1.+sshb(i,j)*mut(i,j,k))-sshb(i,j))
-#   define  fse3t_b(i,j,k)   (fse3t_0(i,j,k)*(1.+sshb(i,j)*mut(i,j,k)))
-#   define  fse3u_b(i,j,k)   (fse3u_0(i,j,k)*(1.+sshu_b(i,j)*muu(i,j,k)))
-#   define  fse3v_b(i,j,k)   (fse3v_0(i,j,k)*(1.+sshv_b(i,j)*muv(i,j,k)))
-#   define  fse3f_b(i,j,k)   (fse3f_0(i,j,k)*(1.+sshf_b(i,j)*muf(i,j,k)))
-#   define  fse3w_b(i,j,k)   (fse3w_0(i,j,k)*(1.+sshb(i,j)*mut(i,j,k)))
+#   define  fse3t_b(i,j,k)   e3t_b(i,j,k)
+#   define  fse3u_b(i,j,k)   e3u_b(i,j,k)
+#   define  fse3v_b(i,j,k)   e3v_b(i,j,k)
 #   define  fse3uw_b(i,j,k)  (fse3uw_0(i,j,k)*(1.+sshu_b(i,j)*muu(i,j,k)))
 #   define  fse3vw_b(i,j,k)  (fse3vw_0(i,j,k)*(1.+sshv_b(i,j)*muv(i,j,k)))
@@ -70,14 +51,7 @@
 #   define  fse3t_m(i,j,k)   (fse3t_0(i,j,k)*(1.+ssh_m(i,j)*mut(i,j,k)))
 
-#   define  fsdept_a(i,j,k)  (fsdept_0(i,j,k)*(1.+ssha(i,j)*mut(i,j,k)))
-#   define  fsdepw_a(i,j,k)  (fsdepw_0(i,j,k)*(1.+ssha(i,j)*mut(i,j,k)))
-#   define  fsde3w_a(i,j,k)  (fsde3w_0(i,j,k)*(1.+ssha(i,j)*mut(i,j,k))-ssha(i,j))
 #   define  fse3t_a(i,j,k)   (fse3t_0(i,j,k)*(1.+ssha(i,j)*mut(i,j,k)))
 #   define  fse3u_a(i,j,k)   (fse3u_0(i,j,k)*(1.+sshu_a(i,j)*muu(i,j,k)))
 #   define  fse3v_a(i,j,k)   (fse3v_0(i,j,k)*(1.+sshv_a(i,j)*muv(i,j,k)))
-#   define  fse3f_a(i,j,k)   (fse3f_0(i,j,k)*(1.+sshf_a(i,j)*muf(i,j,k)))
-#   define  fse3w_a(i,j,k)   (fse3w_0(i,j,k)*(1.+ssha(i,j)*mut(i,j,k)))
-#   define  fse3uw_a(i,j,k)  (fse3uw_0(i,j,k)*(1.+sshu_a(i,j)*muu(i,j,k)))
-#   define  fse3vw_a(i,j,k)  (fse3vw_0(i,j,k)*(1.+sshv_a(i,j)*muv(i,j,k)))
 
 #else
@@ -94,12 +68,7 @@
 #   define  fse3vw(i,j,k)  fse3vw_0(i,j,k)
 
-#   define  fsdept_b(i,j,k)  fsdept_0(i,j,k)
-#   define  fsdepw_b(i,j,k)  fsdepw_0(i,j,k)
-#   define  fsde3w_b(i,j,k)  fsde3w_0(i,j,k)
 #   define  fse3t_b(i,j,k)   fse3t_0(i,j,k)
 #   define  fse3u_b(i,j,k)   fse3u_0(i,j,k)
 #   define  fse3v_b(i,j,k)   fse3v_0(i,j,k)
-#   define  fse3f_b(i,j,k)   fse3f_0(i,j,k)
-#   define  fse3w_b(i,j,k)   fse3w_0(i,j,k)
 #   define  fse3uw_b(i,j,k)  fse3uw_0(i,j,k)
 #   define  fse3vw_b(i,j,k)  fse3vw_0(i,j,k)
@@ -118,18 +87,11 @@
 #   define  fse3t_m(i,j,k)   fse3t_0(i,j,k)
 
-#   define  fsdept_a(i,j,k)  fsdept_0(i,j,k)
-#   define  fsdepw_a(i,j,k)  fsdepw_0(i,j,k)
-#   define  fsde3w_a(i,j,k)  fsde3w_0(i,j,k)
 #   define  fse3t_a(i,j,k)   fse3t_0(i,j,k)
 #   define  fse3u_a(i,j,k)   fse3u_0(i,j,k)
 #   define  fse3v_a(i,j,k)   fse3v_0(i,j,k)
-#   define  fse3f_a(i,j,k)   fse3f_0(i,j,k)
-#   define  fse3w_a(i,j,k)   fse3w_0(i,j,k)
-#   define  fse3uw_a(i,j,k)  fse3uw_0(i,j,k)
-#   define  fse3vw_a(i,j,k)  fse3vw_0(i,j,k)
 #endif
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90	(revision 2528)
@@ -0,0 +1,556 @@
+MODULE istate
+   !!======================================================================
+   !!                     ***  MODULE  istate  ***
+   !! Ocean state   :  initial state setting
+   !!=====================================================================
+   !! History :  OPA  !  1989-12  (P. Andrich)  Original code
+   !!            5.0  !  1991-11  (G. Madec)  rewritting
+   !!            6.0  !  1996-01  (G. Madec)  terrain following coordinates
+   !!            8.0  !  2001-09  (M. Levy, M. Ben Jelloul)  istate_eel
+   !!            8.0  !  2001-09  (M. Levy, M. Ben Jelloul)  istate_uvg
+   !!   NEMO     1.0  !  2003-08  (G. Madec, C. Talandier)  F90: Free form, modules + EEL R5
+   !!             -   !  2004-05  (A. Koch-Larrouy)  istate_gyre 
+   !!            2.0  !  2006-07  (S. Masson)  distributed restart using iom
+   !!            3.3  !  2010-10  (C. Ethe) merge TRC-TRA
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   istate_init   : initial state setting
+   !!   istate_tem    : analytical profile for initial Temperature
+   !!   istate_sal    : analytical profile for initial Salinity
+   !!   istate_eel    : initial state setting of EEL R5 configuration
+   !!   istate_gyre   : initial state setting of GYRE configuration
+   !!   istate_uvg    : initial velocity in geostropic balance
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and active tracers 
+   USE dom_oce         ! ocean space and time domain 
+   USE daymod          ! calendar
+   USE eosbn2          ! eq. of state, Brunt Vaisala frequency (eos     routine)
+   USE ldftra_oce      ! ocean active tracers: lateral physics
+   USE zdf_oce         ! ocean vertical physics
+   USE phycst          ! physical constants
+   USE dtatem          ! temperature data                 (dta_tem routine)
+   USE dtasal          ! salinity data                    (dta_sal routine)
+   USE restart         ! ocean restart                   (rst_read routine)
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O library
+   USE zpshde          ! partial step: hor. derivative (zps_hde routine)
+   USE eosbn2          ! equation of state            (eos bn2 routine)
+   USE domvvl          ! varying vertical mesh
+   USE dynspg_oce      ! pressure gradient schemes
+   USE dynspg_flt      ! pressure gradient schemes
+   USE dynspg_exp      ! pressure gradient schemes
+   USE dynspg_ts       ! pressure gradient schemes
+   USE traswp          ! Swap arrays                      (tra_swp routine)
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   istate_init   ! routine called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE istate_init
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE istate_init  ***
+      !! 
+      !! ** Purpose :   Initialization of the dynamics and tracer fields.
+      !!----------------------------------------------------------------------
+      ! - ML - needed for initialization of e3t_b
+      INTEGER  ::  jk     ! dummy loop indice
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'istate_ini : Initialization of the dynamics and tracers'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+
+      rhd  (:,:,:) = 0.e0
+      rhop (:,:,:) = 0.e0
+      rn2  (:,:,:) = 0.e0 
+      ta   (:,:,:) = 0.e0    
+      sa   (:,:,:) = 0.e0
+
+      IF( ln_rstart ) THEN                    ! Restart from a file
+         !                                    ! -------------------
+         neuler = 1                              ! Set time-step indicator at nit000 (leap-frog)
+         CALL rst_read                           ! Read the restart file
+         CALL tra_swap                           ! swap 3D arrays (t,s)  in a 4D array (ts)
+         CALL day_init                           ! model calendar (using both namelist and restart infos)
+      ELSE
+         !                                    ! Start from rest
+         !                                    ! ---------------
+         numror = 0                              ! define numror = 0 -> no restart file to read
+         neuler = 0                              ! Set time-step indicator at nit000 (euler forward)
+         CALL day_init                           ! model calendar (using both namelist and restart infos)
+         !                                       ! Initialization of ocean to zero
+         !   before fields     !       now fields     
+         sshb (:,:)   = 0.e0   ;   sshn (:,:)   = 0.e0
+         ub   (:,:,:) = 0.e0   ;   un   (:,:,:) = 0.e0
+         vb   (:,:,:) = 0.e0   ;   vn   (:,:,:) = 0.e0  
+         rotb (:,:,:) = 0.e0   ;   rotn (:,:,:) = 0.e0
+         hdivb(:,:,:) = 0.e0   ;   hdivn(:,:,:) = 0.e0
+         !
+         IF( cp_cfg == 'eel' ) THEN
+            CALL istate_eel                      ! EEL   configuration : start from pre-defined U,V T-S fields
+         ELSEIF( cp_cfg == 'gyre' ) THEN         
+            CALL istate_gyre                     ! GYRE  configuration : start from pre-defined T-S fields
+         ELSE
+            !                                    ! Other configurations: Initial T-S fields
+#if defined key_dtatem
+            CALL dta_tem( nit000 )                  ! read 3D temperature data
+            tb(:,:,:) = t_dta(:,:,:)   ;   tn(:,:,:) = t_dta(:,:,:)
+            
+#else
+            IF(lwp) WRITE(numout,*)                 ! analytical temperature profile
+            IF(lwp) WRITE(numout,*)'             Temperature initialization using an analytic profile'
+            CALL istate_tem
+#endif
+#if defined key_dtasal
+            CALL dta_sal( nit000 )                  ! read 3D salinity data
+            sb(:,:,:) = s_dta(:,:,:)   ;   sn(:,:,:) = s_dta(:,:,:)
+#else
+            ! No salinity data
+            IF(lwp)WRITE(numout,*)                  ! analytical salinity profile
+            IF(lwp)WRITE(numout,*)'             Salinity initialisation using a constant value'
+            CALL istate_sal
+#endif
+         ENDIF
+         !
+         CALL tra_swap                     ! swap 3D arrays (tb,sb,tn,sn)  in a 4D array
+         CALL eos( tsb, rhd, rhop )        ! before potential and in situ densities
+#if ! defined key_c1d
+         IF( ln_zps )   CALL zps_hde( nit000, jpts, tsb, gtsu, gtsv,  & ! zps: before hor. gradient
+            &                                       rhd, gru , grv  )   ! of t,s,rd at ocean bottom
+#endif
+         !   
+         ! - ML - sshn could be modified by istate_eel, so that initialization of fse3t_b is done here
+         IF( lk_vvl ) THEN
+            DO jk = 1, jpk
+               fse3t_b(:,:,jk) = fse3t_n(:,:,jk)
+            ENDDO
+         ENDIF
+         ! 
+      ENDIF
+      !
+      IF( lk_agrif ) THEN                  ! read free surface arrays in restart file
+         IF( ln_rstart ) THEN
+            IF( lk_dynspg_flt )   CALL flt_rst( nit000, 'READ' )      ! read or initialize the following fields
+            !                                                         ! gcx, gcxb for agrif_opa_init
+         ENDIF                                                        ! explicit case not coded yet with AGRIF
+      ENDIF
+      !
+   END SUBROUTINE istate_init
+
+
+   SUBROUTINE istate_tem
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE istate_tem  ***
+      !!   
+      !! ** Purpose :   Intialization of the temperature field with an 
+      !!      analytical profile or a file (i.e. in EEL configuration)
+      !!
+      !! ** Method  :   Use Philander analytic profile of temperature
+      !!
+      !! References :  Philander ???
+      !!----------------------------------------------------------------------
+      INTEGER :: ji, jj, jk
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'istate_tem : initial temperature profile'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+      !
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               tn(ji,jj,jk) = (  ( ( 7.5 - 0.*ABS(gphit(ji,jj))/30. )   &
+                  &               *( 1.-TANH((fsdept(ji,jj,jk)-80.)/30.) )   &
+                  &            + 10.*(5000.-fsdept(ji,jj,jk))/5000.)  ) * tmask(ji,jj,jk)
+               tb(ji,jj,jk) = tn(ji,jj,jk)
+          END DO
+        END DO
+      END DO
+      !
+      IF(lwp) CALL prizre( tn    , jpi   , jpj   , jpk   , jpj/2 ,   &
+         &                 1     , jpi   , 5     , 1     , jpk   ,   &
+         &                 1     , 1.    , numout                  )
+      !
+   END SUBROUTINE istate_tem
+
+
+   SUBROUTINE istate_sal
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE istate_sal  ***
+      !!
+      !! ** Purpose :   Intialize the salinity field with an analytic profile
+      !!
+      !! ** Method  :   Use to a constant value 35.5
+      !!              
+      !! ** Action  :   Initialize sn and sb
+      !!----------------------------------------------------------------------
+      REAL(wp) ::   zsal = 35.50_wp
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'istate_sal : initial salinity : ', zsal
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+      !
+      sn(:,:,:) = zsal * tmask(:,:,:)
+      sb(:,:,:) = sn(:,:,:)
+      !
+   END SUBROUTINE istate_sal
+
+
+   SUBROUTINE istate_eel
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE istate_eel  ***
+      !! 
+      !! ** Purpose :   Initialization of the dynamics and tracers for EEL R5
+      !!      configuration (channel with or without a topographic bump)
+      !!
+      !! ** Method  : - set temprature field
+      !!              - set salinity field
+      !!              - set velocity field including horizontal divergence
+      !!                and relative vorticity fields
+      !!----------------------------------------------------------------------
+      USE divcur     ! hor. divergence & rel. vorticity      (div_cur routine)
+      USE iom
+ 
+      INTEGER  ::   inum              ! temporary logical unit
+      INTEGER  ::   ji, jj, jk        ! dummy loop indices
+      INTEGER  ::   ijloc
+      REAL(wp) ::   zh1, zh2, zslope, zcst, zfcor   ! temporary scalars
+      REAL(wp) ::   zt1  = 15._wp                   ! surface temperature value (EEL R5)
+      REAL(wp) ::   zt2  =  5._wp                   ! bottom  temperature value (EEL R5)
+      REAL(wp) ::   zsal = 35.0_wp                  ! constant salinity (EEL R2, R5 and R6)
+      REAL(wp) ::   zueel = 0.1_wp                  ! constant uniform zonal velocity (EEL R5)
+      REAL(wp), DIMENSION(jpiglo,jpjglo) ::   zssh  ! initial ssh over the global domain
+      !!----------------------------------------------------------------------
+
+      SELECT CASE ( jp_cfg ) 
+         !                                              ! ====================
+         CASE ( 5 )                                     ! EEL R5 configuration
+            !                                           ! ====================
+            !
+            ! set temperature field with a linear profile
+            ! -------------------------------------------
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'istate_eel : EEL R5: linear temperature profile'
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+            !
+            zh1 = gdept_0(  1  )
+            zh2 = gdept_0(jpkm1)
+            !
+            zslope = ( zt1 - zt2 ) / ( zh1 - zh2 )
+            zcst   = ( zt1 * ( zh1 - zh2) - ( zt1 - zt2 ) * zh1 ) / ( zh1 - zh2 )
+            !
+            DO jk = 1, jpk
+               tn(:,:,jk) = ( zt2 + zt1 * exp( - fsdept(:,:,jk) / 1000 ) ) * tmask(:,:,jk)
+               tb(:,:,jk) = tn(:,:,jk)
+            END DO
+            !
+            IF(lwp) CALL prizre( tn    , jpi   , jpj   , jpk   , jpj/2 ,   &
+               &                 1     , jpi   , 5     , 1     , jpk   ,   &
+               &                 1     , 1.    , numout                  )
+            !
+            ! set salinity field to a constant value
+            ! --------------------------------------
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'istate_eel : EEL R5: constant salinity field, S = ', zsal
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+            !
+            sn(:,:,:) = zsal * tmask(:,:,:)
+            sb(:,:,:) = sn(:,:,:)
+            !
+            ! set the dynamics: U,V, hdiv, rot (and ssh if necessary)
+            ! ----------------
+            ! Start EEL5 configuration with barotropic geostrophic velocities 
+            ! according the sshb and sshn SSH imposed.
+            ! we assume a uniform grid (hence the use of e1t(1,1) for delta_y)
+            ! we use the Coriolis frequency at mid-channel.   
+            ub(:,:,:) = zueel * umask(:,:,:)
+            un(:,:,:) = ub(:,:,:)
+            ijloc = mj0(INT(jpjglo-1)/2)
+            zfcor = ff(1,ijloc)
+            !
+            DO jj = 1, jpjglo
+               zssh(:,jj) = - (FLOAT(jj)- FLOAT(jpjglo-1)/2.)*zueel*e1t(1,1)*zfcor/grav 
+            END DO
+            !
+            IF(lwp) THEN
+               WRITE(numout,*) ' Uniform zonal velocity for EEL R5:',zueel
+               WRITE(numout,*) ' Geostrophic SSH profile as a function of y:'
+               WRITE(numout,'(12(1x,f6.2))') zssh(1,:)
+            ENDIF
+            !
+            DO jj = 1, nlcj
+               DO ji = 1, nlci
+                  sshb(ji,jj) = zssh( mig(ji) , mjg(jj) ) * tmask(ji,jj,1)
+               END DO
+            END DO
+            sshb(nlci+1:jpi,      :   ) = 0.e0      ! set to zero extra mpp columns
+            sshb(      :   ,nlcj+1:jpj) = 0.e0      ! set to zero extra mpp rows
+            !
+            sshn(:,:) = sshb(:,:)                   ! set now ssh to the before value
+            !
+            IF( nn_rstssh /= 0 ) THEN  
+               nn_rstssh = 0                        ! hand-made initilization of ssh 
+               CALL ctl_warn( 'istate_eel: force nn_rstssh = 0' )
+            ENDIF
+            !
+            CALL div_cur( nit000 )                  ! horizontal divergence and relative vorticity (curl)
+            ! N.B. the vertical velocity will be computed from the horizontal divergence field
+            ! in istate by a call to wzv routine
+
+
+            !                                     ! ==========================
+         CASE ( 2 , 6 )                           ! EEL R2 or R6 configuration
+            !                                     ! ==========================
+            !
+            ! set temperature field with a NetCDF file
+            ! ----------------------------------------
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'istate_eel : EEL R2 or R6: read initial temperature in a NetCDF file'
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+            !
+            CALL iom_open ( 'eel.initemp', inum )
+            CALL iom_get ( inum, jpdom_data, 'initemp', tb ) ! read before temprature (tb)
+            CALL iom_close( inum )
+            !
+            tn(:,:,:) = tb(:,:,:)                            ! set nox temperature to tb
+            !
+            IF(lwp) CALL prizre( tn    , jpi   , jpj   , jpk   , jpj/2 ,   &
+               &                 1     , jpi   , 5     , 1     , jpk   ,   &
+               &                 1     , 1.    , numout                  )
+            !
+            ! set salinity field to a constant value
+            ! --------------------------------------
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'istate_eel : EEL R5: constant salinity field, S = ', zsal
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+            !
+            sn(:,:,:) = zsal * tmask(:,:,:)
+            sb(:,:,:) = sn(:,:,:)
+            !
+            !                                    ! ===========================
+         CASE DEFAULT                            ! NONE existing configuration
+            !                                    ! ===========================
+            WRITE(ctmp1,*) 'EEL with a ', jp_cfg,' km resolution is not coded'
+            CALL ctl_stop( ctmp1 )
+            !
+      END SELECT
+      !
+   END SUBROUTINE istate_eel
+
+
+   SUBROUTINE istate_gyre
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE istate_gyre  ***
+      !! 
+      !! ** Purpose :   Initialization of the dynamics and tracers for GYRE
+      !!      configuration (double gyre with rotated domain)
+      !!
+      !! ** Method  : - set temprature field
+      !!              - set salinity field
+      !!----------------------------------------------------------------------
+      INTEGER :: ji, jj, jk  ! dummy loop indices
+      INTEGER            ::   inum          ! temporary logical unit
+      INTEGER, PARAMETER ::   ntsinit = 0   ! (0/1) (analytical/input data files) T&S initialization
+      !!----------------------------------------------------------------------
+
+      SELECT CASE ( ntsinit)
+
+      CASE ( 0 )                  ! analytical T/S profil deduced from LEVITUS
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'istate_gyre : initial analytical T and S profil deduced from LEVITUS '
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+
+         DO jk = 1, jpk
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  tn(ji,jj,jk) = (  16. - 12. * TANH( (fsdept(ji,jj,jk) - 400) / 700 )         )   &
+                       &           * (-TANH( (500-fsdept(ji,jj,jk)) / 150 ) + 1) / 2               &
+                       &       + (      15. * ( 1. - TANH( (fsdept(ji,jj,jk)-50.) / 1500.) )       &
+                       &                - 1.4 * TANH((fsdept(ji,jj,jk)-100.) / 100.)               &    
+                       &                + 7.  * (1500. - fsdept(ji,jj,jk)) / 1500.             )   & 
+                       &           * (-TANH( (fsdept(ji,jj,jk) - 500) / 150) + 1) / 2
+                  tn(ji,jj,jk) = tn(ji,jj,jk) * tmask(ji,jj,jk)
+                  tb(ji,jj,jk) = tn(ji,jj,jk)
+
+                  sn(ji,jj,jk) =  (  36.25 - 1.13 * TANH( (fsdept(ji,jj,jk) - 305) / 460 )  )  &
+                     &              * (-TANH((500 - fsdept(ji,jj,jk)) / 150) + 1) / 2          &
+                     &          + (  35.55 + 1.25 * (5000. - fsdept(ji,jj,jk)) / 5000.         &
+                     &                - 1.62 * TANH( (fsdept(ji,jj,jk) - 60.  ) / 650. )       &
+                     &                + 0.2  * TANH( (fsdept(ji,jj,jk) - 35.  ) / 100. )       &
+                     &                + 0.2  * TANH( (fsdept(ji,jj,jk) - 1000.) / 5000.)    )  &
+                     &              * (-TANH((fsdept(ji,jj,jk) - 500) / 150) + 1) / 2 
+                  sn(ji,jj,jk) = sn(ji,jj,jk) * tmask(ji,jj,jk)
+                  sb(ji,jj,jk) = sn(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+
+      CASE ( 1 )                  ! T/S data fields read in dta_tem.nc/data_sal.nc files
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'istate_gyre : initial T and S read from dta_tem.nc/data_sal.nc files'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+         IF(lwp) WRITE(numout,*) '              NetCDF FORMAT'
+
+         ! Read temperature field
+         ! ----------------------
+         CALL iom_open ( 'data_tem', inum )
+         CALL iom_get ( inum, jpdom_data, 'votemper', tn ) 
+         CALL iom_close( inum )
+
+         tn(:,:,:) = tn(:,:,:) * tmask(:,:,:) 
+         tb(:,:,:) = tn(:,:,:)
+
+         ! Read salinity field
+         ! -------------------
+         CALL iom_open ( 'data_sal', inum )
+         CALL iom_get ( inum, jpdom_data, 'vosaline', sn ) 
+         CALL iom_close( inum )
+
+         sn(:,:,:)  = sn(:,:,:) * tmask(:,:,:) 
+         sb(:,:,:)  = sn(:,:,:)
+
+      END SELECT
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '              Initial temperature and salinity profiles:'
+         WRITE(numout, "(9x,' level   gdept_0   temperature   salinity   ')" )
+         WRITE(numout, "(10x, i4, 3f10.2)" ) ( jk, gdept_0(jk), tn(2,2,jk), sn(2,2,jk), jk = 1, jpk )
+      ENDIF
+
+   END SUBROUTINE istate_gyre
+
+
+   SUBROUTINE istate_uvg
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE istate_uvg  ***
+      !!
+      !! ** Purpose :   Compute the geostrophic velocities from (tn,sn) fields
+      !!
+      !! ** Method  :   Using the hydrostatic hypothesis the now hydrostatic 
+      !!      pressure is computed by integrating the in-situ density from the
+      !!      surface to the bottom.
+      !!                 p=integral [ rau*g dz ]
+      !!----------------------------------------------------------------------
+      USE dynspg          ! surface pressure gradient             (dyn_spg routine)
+      USE divcur          ! hor. divergence & rel. vorticity      (div_cur routine)
+      USE lbclnk          ! ocean lateral boundary condition (or mpp link)
+
+      INTEGER ::   ji, jj, jk        ! dummy loop indices
+      INTEGER ::   indic             ! ???
+      REAL(wp) ::   zmsv, zphv, zmsu, zphu, zalfg     ! temporary scalars
+      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zprn     ! workspace
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*) 
+      IF(lwp) WRITE(numout,*) 'istate_uvg : Start from Geostrophy'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+
+      ! Compute the now hydrostatic pressure
+      ! ------------------------------------
+
+      zalfg = 0.5 * grav * rau0
+      
+      zprn(:,:,1) = zalfg * fse3w(:,:,1) * ( 1 + rhd(:,:,1) )       ! Surface value
+
+      DO jk = 2, jpkm1                                              ! Vertical integration from the surface
+         zprn(:,:,jk) = zprn(:,:,jk-1)   &
+            &         + zalfg * fse3w(:,:,jk) * ( 2. + rhd(:,:,jk) + rhd(:,:,jk-1) )
+      END DO  
+
+      ! Compute geostrophic balance
+      ! ---------------------------
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vertor opt.
+               zmsv = 1. / MAX(  umask(ji-1,jj+1,jk) + umask(ji  ,jj+1,jk)   &
+                               + umask(ji-1,jj  ,jk) + umask(ji  ,jj  ,jk) , 1.  )
+               zphv = ( zprn(ji  ,jj+1,jk) - zprn(ji-1,jj+1,jk) ) * umask(ji-1,jj+1,jk) / e1u(ji-1,jj+1)   &
+                    + ( zprn(ji+1,jj+1,jk) - zprn(ji  ,jj+1,jk) ) * umask(ji  ,jj+1,jk) / e1u(ji  ,jj+1)   &
+                    + ( zprn(ji  ,jj  ,jk) - zprn(ji-1,jj  ,jk) ) * umask(ji-1,jj  ,jk) / e1u(ji-1,jj  )   &
+                    + ( zprn(ji+1,jj  ,jk) - zprn(ji  ,jj  ,jk) ) * umask(ji  ,jj  ,jk) / e1u(ji  ,jj  )
+               zphv = 1. / rau0 * zphv * zmsv * vmask(ji,jj,jk)
+
+               zmsu = 1. / MAX(  vmask(ji+1,jj  ,jk) + vmask(ji  ,jj  ,jk)   &
+                               + vmask(ji+1,jj-1,jk) + vmask(ji  ,jj-1,jk) , 1.  )
+               zphu = ( zprn(ji+1,jj+1,jk) - zprn(ji+1,jj  ,jk) ) * vmask(ji+1,jj  ,jk) / e2v(ji+1,jj  )   &
+                    + ( zprn(ji  ,jj+1,jk) - zprn(ji  ,jj  ,jk) ) * vmask(ji  ,jj  ,jk) / e2v(ji  ,jj  )   &
+                    + ( zprn(ji+1,jj  ,jk) - zprn(ji+1,jj-1,jk) ) * vmask(ji+1,jj-1,jk) / e2v(ji+1,jj-1)   &
+                    + ( zprn(ji  ,jj  ,jk) - zprn(ji  ,jj-1,jk) ) * vmask(ji  ,jj-1,jk) / e2v(ji  ,jj-1)
+               zphu = 1. / rau0 * zphu * zmsu * umask(ji,jj,jk)
+
+               ! Compute the geostrophic velocities
+               un(ji,jj,jk) = -2. * zphu / ( ff(ji,jj) + ff(ji  ,jj-1) )
+               vn(ji,jj,jk) =  2. * zphv / ( ff(ji,jj) + ff(ji-1,jj  ) )
+            END DO
+         END DO
+      END DO
+
+      IF(lwp) WRITE(numout,*) '         we force to zero bottom velocity'
+
+      ! Susbtract the bottom velocity (level jpk-1 for flat bottom case)
+      ! to have a zero bottom velocity
+
+      DO jk = 1, jpkm1
+         un(:,:,jk) = ( un(:,:,jk) - un(:,:,jpkm1) ) * umask(:,:,jk)
+         vn(:,:,jk) = ( vn(:,:,jk) - vn(:,:,jpkm1) ) * vmask(:,:,jk)
+      END DO
+
+      CALL lbc_lnk( un, 'U', -1. )
+      CALL lbc_lnk( vn, 'V', -1. )
+      
+      ub(:,:,:) = un(:,:,:)
+      vb(:,:,:) = vn(:,:,:)
+      
+      ! WARNING !!!!!
+      ! after initializing u and v, we need to calculate the initial streamfunction bsf.
+      ! Otherwise, only the trend will be computed and the model will blow up (inconsistency).
+      ! to do that, we call dyn_spg with a special trick:
+      ! we fill ua and va with the velocities divided by dt, and the streamfunction will be brought to the
+      ! right value assuming the velocities have been set up in one time step.
+      ! we then set bsfd to zero (first guess for next step is d(psi)/dt = 0.)
+      !  sets up s false trend to calculate the barotropic streamfunction.
+
+      ua(:,:,:) = ub(:,:,:) / rdt
+      va(:,:,:) = vb(:,:,:) / rdt
+
+      ! calls dyn_spg. we assume euler time step, starting from rest.
+      indic = 0
+      CALL dyn_spg( nit000, indic )       ! surface pressure gradient
+
+      ! the new velocity is ua*rdt
+
+      CALL lbc_lnk( ua, 'U', -1. )
+      CALL lbc_lnk( va, 'V', -1. )
+
+      ub(:,:,:) = ua(:,:,:) * rdt
+      vb(:,:,:) = va(:,:,:) * rdt
+      ua(:,:,:) = 0.e0
+      va(:,:,:) = 0.e0
+      un(:,:,:) = ub(:,:,:)
+      vn(:,:,:) = vb(:,:,:)
+       
+      ! Compute the divergence and curl
+
+      CALL div_cur( nit000 )            ! now horizontal divergence and curl
+
+      hdivb(:,:,:) = hdivn(:,:,:)       ! set the before to the now value
+      rotb (:,:,:) = rotn (:,:,:)       ! set the before to the now value
+      !
+   END SUBROUTINE istate_uvg
+
+   !!=====================================================================
+END MODULE istate
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90	(revision 2528)
@@ -81,7 +81,7 @@
    REAL(wp), PUBLIC ::   stefan  =   5.67e-8_wp   !: Stefan-Boltzmann constant 
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
    
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DTA/dtasal.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DTA/dtasal.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DTA/dtasal.F90	(revision 2528)
@@ -4,4 +4,10 @@
    !! Ocean data  :  read ocean salinity data from monthly atlas data
    !!=====================================================================
+   !! History :  OPA  ! 1991-03  ()  Original code
+   !!             -   ! 1992-07  (M. Imbard)
+   !!            8.0  ! 1999-10  (M.A. Foujols, M. Imbard)  NetCDF FORMAT 
+   !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module 
+   !!            3.3  ! 2010-10  (C. Bricaud, S. Masson)  use of fldread
+   !!----------------------------------------------------------------------
 #if defined key_dtasal   ||   defined key_esopa
    !!----------------------------------------------------------------------
@@ -10,298 +16,199 @@
    !!   dta_sal      : read ocean salinity data
    !!----------------------------------------------------------------------
-   !! * Modules used
    USE oce             ! ocean dynamics and tracers
    USE dom_oce         ! ocean space and time domain
+   USE fldread         ! read input fields
    USE in_out_manager  ! I/O manager
    USE phycst          ! physical constants
-#if defined key_orca_lev10
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-#endif
 
    IMPLICIT NONE
    PRIVATE
 
-   !! * Routine accessibility
-   PUBLIC dta_sal   ! called by step.F90 and inidta.F90
+   PUBLIC   dta_sal   ! called by step.F90 and inidta.F90
    
-   !! * Shared module variables
    LOGICAL , PUBLIC, PARAMETER ::   lk_dtasal = .TRUE.    !: salinity data flag
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  !:
-      s_dta       !: salinity data at given time-step
-
-   !! * Module variables
-   INTEGER ::   &
-      numsdt,           &  !: logical unit for data salinity
-      nsal1, nsal2         ! first and second record used
-   REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   &
-      saldta    ! salinity data at two consecutive times
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   s_dta    !: salinity data at given time-step
+
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_sal       ! structure of input SST (file informations, fields read)
 
    !! * Substitutions
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
-   !!----------------------------------------------------------------------
-   !!   Default option:                                         NetCDF file
-   !!----------------------------------------------------------------------
-
    SUBROUTINE dta_sal( kt )
-     !!----------------------------------------------------------------------
-     !!                   ***  ROUTINE dta_sal  ***
-     !!        
-     !! ** Purpose :   Reads monthly salinity data
-     !!             
-     !! ** Method  : - Read on unit numsdt the monthly salinity data interpo-
-     !!     lated onto the model grid.
-     !!              - At each time step, a linear interpolation is applied
-     !!     between two monthly values.
-     !!
-     !! History :
-     !!        !  91-03  ()  Original code
-     !!        !  92-07  (M. Imbard)
-     !!   9.0  !  02-06  (G. Madec)  F90: Free form and module 
-     !!----------------------------------------------------------------------
-     !! * Modules used
-     USE iom
-     
-     !! * Arguments
-     INTEGER, INTENT(in) ::   kt             ! ocean time step
-     
-     !! * Local declarations
-     
-     INTEGER ::   ji, jj, jk, jl, jkk   ! dummy loop indicies
-     INTEGER ::   &
-          imois, iman, i15, ik           ! temporary integers
-#  if defined key_tradmp
-     INTEGER ::   &
-          il0, il1, ii0, ii1, ij0, ij1   ! temporary integers         
-# endif
-     REAL(wp) ::   zxy, zl
-#if defined key_orca_lev10
-     REAL(wp), DIMENSION(jpi,jpj,jpkdta,2) :: zsal
-     INTEGER   :: ikr, ikw, ikt, jjk
-     REAL(wp)  :: zfac
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE dta_sal  ***
+      !!        
+      !! ** Purpose :   Reads monthly salinity data
+      !!             
+      !! ** Method  : - Read on unit numsdt the monthly salinity data interpo-
+      !!                lated onto the model grid.
+      !!              - At each time step, a linear interpolation is applied
+      !!                between two monthly values.
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt             ! ocean time step
+      !
+      INTEGER ::   ji, jj, jk, jl, jkk            ! dummy loop indicies
+      INTEGER ::   ik, ierror                     ! temporary integers
+#if defined key_tradmp
+      INTEGER ::   il0, il1, ii0, ii1, ij0, ij1   ! temporary integers
 #endif
-     REAL(wp), DIMENSION(jpk,2) ::   &
-          zsaldta            ! auxiliary array for interpolation
-     !!----------------------------------------------------------------------
-     
-     ! 0. Initialization
-     ! -----------------
-     
-     iman  = INT( raamo )
-!!! better but change the results     i15 = INT( 2*FLOAT( nday ) / ( FLOAT( nobis(nmonth) ) + 0.5 ) )
-     i15   = nday / 16
-     imois = nmonth + i15 - 1
-     IF( imois == 0 ) imois = iman
-     
-     ! 1. First call kt=nit000
-     ! -----------------------
-     
-     IF( kt == nit000 ) THEN
-        
-        nsal1 = 0   ! initializations
-        IF(lwp) WRITE(numout,*) ' dta_sal : monthly salinity data in NetCDF file'
-        CALL iom_open ( 'data_1m_salinity_nomask', numsdt ) 
-        
-     ENDIF
-     
-     
-     ! 2. Read monthly file
-     ! -------------------
-     
-     IF( kt == nit000 .OR. imois /= nsal1 ) THEN
-        
-        ! 2.1 Calendar computation
-        
-        nsal1 = imois        ! first file record used 
-        nsal2 = nsal1 + 1    ! last  file record used
-        nsal1 = MOD( nsal1, iman )
-        IF( nsal1 == 0 ) nsal1 = iman
-        nsal2 = MOD( nsal2, iman )
-        IF( nsal2 == 0 ) nsal2 = iman
-        IF(lwp) WRITE(numout,*) 'first record file used nsal1 ', nsal1
-        IF(lwp) WRITE(numout,*) 'last  record file used nsal2 ', nsal2
-        
-        ! 2.3 Read monthly salinity data Levitus 
-        
-#if defined key_orca_lev10
-        if (ln_zps) stop
-        zsal(:,:,:,:) = 0.
-        CALL iom_get (numsdt,jpdom_data,'vosaline',zsal(:,:,:,1),nsal1)
-        CALL iom_get (numsdt,jpdom_data,'vosaline',zsal(:,:,:,2),nsal2)
-#else
-        CALL iom_get (numsdt,jpdom_data,'vosaline',saldta(:,:,:,1),nsal1)
-        CALL iom_get (numsdt,jpdom_data,'vosaline',saldta(:,:,:,2),nsal2)
-#endif
-        
-        IF(lwp) THEN
-           WRITE(numout,*)
-           WRITE(numout,*) ' read Levitus salinity ok'
-           WRITE(numout,*)
-        ENDIF
-        
+      REAL(wp)::   zl
+      REAL(wp), DIMENSION(jpk) :: zsaldta         ! auxiliary array for interpolation
+      CHARACTER(len=100)       :: cn_dir          ! Root directory for location of ssr files
+      TYPE(FLD_N)              :: sn_sal
+      LOGICAL , SAVE           :: linit_sal = .FALSE.
+      !!
+      NAMELIST/namdta_sal/   cn_dir, sn_sal
+      !!----------------------------------------------------------------------
+     
+      ! 1. Initialization
+      ! -----------------------
+     
+      IF( kt == nit000 .AND. ( .NOT. linit_sal ) ) THEN
+        
+         !                         ! set file information
+         cn_dir = './'             ! directory in which the model is executed
+         ! ... default values (NB: frequency positive => hours, negative => months)
+         !            !   file    ! frequency ! variable ! time intep !  clim   ! 'yearly' or ! weights  ! rotation   !
+         !            !   name    !  (hours)  !  name    !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      !
+         sn_sal = FLD_N( 'salinity',  -1.     ,'vosaline',  .false.   , .true.  ,  'monthly'  , ''       , ''         )
+
+         REWIND ( numnam )         ! read in namlist namdta_sal 
+         READ( numnam, namdta_sal ) 
+
+         IF(lwp) THEN              ! control print
+            WRITE(numout,*)
+            WRITE(numout,*) 'dta_sal : Salinity Climatology '
+            WRITE(numout,*) '~~~~~~~ '
+         ENDIF
+         ALLOCATE( sf_sal(1), STAT=ierror )
+         IF( ierror > 0 ) THEN
+             CALL ctl_stop( 'dta_sal: unable to allocate sf_sal structure' )   ;   RETURN
+         ENDIF
+                                ALLOCATE( sf_sal(1)%fnow(jpi,jpj,jpk)   )
+         IF( sn_sal%ln_tint )   ALLOCATE( sf_sal(1)%fdta(jpi,jpj,jpk,2) )
+         !                         ! fill sf_sal with sn_sal and control print
+         CALL fld_fill( sf_sal, (/ sn_sal /), cn_dir, 'dta_sal', 'Salinity data', 'namdta_sal' )
+         linit_sal = .TRUE.        
+      ENDIF
+     
+      ! 2. Read monthly file
+      ! -------------------
+     
+      CALL fld_read( kt, 1, sf_sal )
+
+      IF( lwp .AND. kt == nit000 ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) ' read Levitus salinity ok'
+         WRITE(numout,*)
+      ENDIF
+
 #if defined key_tradmp
-        IF( cp_cfg == "orca"  .AND. jp_cfg == 2 ) THEN
+      IF( cp_cfg == "orca"  .AND. jp_cfg == 2 ) THEN     !  ORCA_R2 configuration
+         !
+         ij0 = 101   ;   ij1 = 109
+         ii0 = 141   ;   ii1 = 155   
+         DO jj = mj0(ij0), mj1(ij1)                  ! Reduced salinity in the Alboran Sea
+            DO ji = mi0(ii0), mi1(ii1)
+               sf_sal(1)%fnow(ji,jj,13:13) = sf_sal(1)%fnow(ji,jj,13:13) - 0.15
+               sf_sal(1)%fnow(ji,jj,14:15) = sf_sal(1)%fnow(ji,jj,14:15) - 0.25
+               sf_sal(1)%fnow(ji,jj,16:17) = sf_sal(1)%fnow(ji,jj,16:17) - 0.30
+               sf_sal(1)%fnow(ji,jj,18:25) = sf_sal(1)%fnow(ji,jj,18:25) - 0.35
+            END DO
+         END DO
+         !
+         IF( nn_cla == 1 ) THEN 
+            !                                         ! New salinity profile at Gibraltar
+            il0 = 138   ;   il1 = 138   
+            ij0 = 101   ;   ij1 = 102
+            ii0 = 139   ;   ii1 = 139   
+            DO jl = mi0(il0), mi1(il1)
+               DO jj = mj0(ij0), mj1(ij1)
+                  DO ji = mi0(ii0), mi1(ii1)
+                        sf_sal(1)%fnow(ji,jj,:) = sf_sal(1)%fnow(jl,jj,:)
+                  END DO
+               END DO
+            END DO
+            !                                         ! New salinity profile at Bab el Mandeb
+            il0 = 164   ;   il1 = 164   
+            ij0 =  87   ;   ij1 =  88
+            ii0 = 161   ;   ii1 = 163   
+            DO jl = mi0(il0), mi1(il1)
+               DO jj = mj0(ij0), mj1(ij1)
+                  DO ji = mi0(ii0), mi1(ii1)
+                     sf_sal(1)%fnow(ji,jj,:) = sf_sal(1)%fnow(jl,jj,:)
+                  END DO
+               END DO
+            END DO
+            !
+         ENDIF
+            !
+      ENDIF
+#endif   
+        
+      s_dta(:,:,:)=sf_sal(1)%fnow(:,:,:)
+        
+      IF( ln_sco ) THEN
+         DO jj = 1, jpj                  ! interpolation of salinites
+            DO ji = 1, jpi
+               DO jk = 1, jpk
+                  zl=fsdept_0(ji,jj,jk)
+                  IF(zl < gdept_0(1)  ) zsaldta(jk) =  s_dta(ji,jj,1    ) 
+                  IF(zl > gdept_0(jpk)) zsaldta(jk) =  s_dta(ji,jj,jpkm1) 
+                  DO jkk = 1, jpkm1
+                     IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN
+                          zsaldta(jk) = s_dta(ji,jj,jkk)                                 &
+                                     &           + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk))      &
+                                     &                              *(s_dta(ji,jj,jkk+1) - s_dta(ji,jj,jkk))
+                     ENDIF
+                  END DO
+               END DO
+               DO jk = 1, jpkm1
+                  s_dta(ji,jj,jk) = zsaldta(jk) 
+               END DO
+               s_dta(ji,jj,jpk) = 0.0 
+            END DO
+         END DO
            
-           !                                        ! =======================
-           !                                        !  ORCA_R2 configuration
-           !                                        ! =======================
-           ij0 = 101   ;   ij1 = 109
-           ii0 = 141   ;   ii1 = 155   
-           DO jj = mj0(ij0), mj1(ij1)                  ! Reduced salinity in the Alboran Sea
-              DO ji = mi0(ii0), mi1(ii1)
-#if defined key_orca_lev10
-                 zsal  (ji,jj,13:13,:) = zsal  (ji,jj,13:13,:) - 0.15
-                 zsal  (ji,jj,14:15,:) = zsal  (ji,jj,14:15,:) - 0.25
-                 zsal  (ji,jj,16:17,:) = zsal  (ji,jj,16:17,:) - 0.30
-                 zsal  (ji,jj,18:25,:) = zsal  (ji,jj,18:25,:) - 0.35
-#else
-                 saldta(ji,jj,13:13,:) = saldta(ji,jj,13:13,:) - 0.15
-                 saldta(ji,jj,14:15,:) = saldta(ji,jj,14:15,:) - 0.25
-                 saldta(ji,jj,16:17,:) = saldta(ji,jj,16:17,:) - 0.30
-                 saldta(ji,jj,18:25,:) = saldta(ji,jj,18:25,:) - 0.35
-#endif
-              END DO
-           END DO
-
-           IF( n_cla == 1 ) THEN 
-              !                                         ! New salinity profile at Gibraltar
-              il0 = 138   ;   il1 = 138   
-              ij0 = 101   ;   ij1 = 102
-              ii0 = 139   ;   ii1 = 139   
-              DO jl = mi0(il0), mi1(il1)
-                 DO jj = mj0(ij0), mj1(ij1)
-                    DO ji = mi0(ii0), mi1(ii1)
-#if defined key_orca_lev10
-                       zsal  (ji,jj,:,:) = zsal  (jl,jj,:,:)
-#else
-                       saldta(ji,jj,:,:) = saldta(jl,jj,:,:)
-#endif
-                    END DO
-                 END DO
-              END DO
-              !                                         ! New salinity profile at Bab el Mandeb
-              il0 = 164   ;   il1 = 164   
-              ij0 =  87   ;   ij1 =  88
-              ii0 = 161   ;   ii1 = 163   
-              DO jl = mi0(il0), mi1(il1)
-                 DO jj = mj0(ij0), mj1(ij1)
-                    DO ji = mi0(ii0), mi1(ii1)
-#if defined key_orca_lev10
-                       zsal  (ji,jj,:,:) = zsal  (jl,jj,:,:)
-#else
-                       saldta(ji,jj,:,:) = saldta(jl,jj,:,:)
-#endif
-                    END DO
-                 END DO
-              END DO
-              !
-           ENDIF
-           !
-        ENDIF
-#endif   
-        
-#if defined key_orca_lev10
-        !  interpolate from 31 to 301 level the zsal field result in saldta
-        DO jl = 1, 2
-           DO jjk = 1, 5
-              saldta(:,:,jjk,jl) = zsal(:,:,1,jl)
-           ENDDO
-           DO jk = 1, jpk - 20, 10
-              ikr = INT( jk / 10 ) + 1
-              ikw = (ikr-1) * 10 + 1
-              ikt = ikw + 5
-              DO jjk = ikt , ikt + 9
-                 zfac = ( gdept_0(jjk) - gdepw_0(ikt) ) / ( gdepw_0(ikt+10) - gdepw_0(ikt) )
-                 saldta(:,:,jjk,jl) = zsal(:,:,ikr,jl) + ( zsal(:,:,ikr+1,jl) - zsal(:,:,ikr,jl) ) * zfac
-              END DO
-           END DO
-           DO jjk = jpk-5, jpk
-              saldta(:,:,jjk,jl) = zsal(:,:,jpkdta-1,jl)
-           END DO
-           ! fill the overlap areas
-           CALL lbc_lnk (saldta(:,:,:,jl),'Z',-999.,'no0')
-        END DO
-        
-#endif
-        
-        IF( ln_sco ) THEN
-           DO jl = 1, 2
-              DO jj = 1, jpj                  ! interpolation of salinites
-                 DO ji = 1, jpi
-                    DO jk = 1, jpk
-                       zl=fsdept_0(ji,jj,jk)
-                       IF(zl <  gdept_0(1)) zsaldta(jk,jl) =  saldta(ji,jj,1,jl)
-                       IF(zl >  gdept_0(jpk)) zsaldta(jk,jl) =  saldta(ji,jj,jpkm1,jl)
-                       DO jkk = 1, jpkm1
-                          IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN
-                             zsaldta(jk,jl) = saldta(ji,jj,jkk,jl)                                  &
-                                  &           + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk))       &
-                                  &                              *(saldta(ji,jj,jkk+1,jl) - saldta(ji,jj,jkk,jl))
-                          ENDIF
-                       END DO
-                    END DO
-                    DO jk = 1, jpkm1
-                       saldta(ji,jj,jk,jl) = zsaldta(jk,jl)
-                    END DO
-                    saldta(ji,jj,jpk,jl) = 0.0
-                 END DO
-              END DO
-           END DO
-           
-           IF(lwp) WRITE(numout,*)
-           IF(lwp) WRITE(numout,*) ' Levitus salinity data interpolated to s-coordinate'
-           IF(lwp) WRITE(numout,*)
-           
-        ELSE
-           !                                  ! Mask
-           DO jl = 1, 2
-              saldta(:,:,:,jl) = saldta(:,:,:,jl)*tmask(:,:,:)
-              saldta(:,:,jpk,jl) = 0.
-              IF( ln_zps ) THEN               ! z-coord. partial steps
-                 DO jj = 1, jpj               ! interpolation of salinity at the last ocean level (i.e. the partial step)
-                    DO ji = 1, jpi
-                       ik = mbathy(ji,jj) - 1
-                       IF( ik > 2 ) THEN
-                          zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) )
-                          saldta(ji,jj,ik,jl) = (1.-zl) * saldta(ji,jj,ik,jl) +zl * saldta(ji,jj,ik-1,jl)
-                       ENDIF
-                    END DO
-                 END DO
-              ENDIF
-           END DO
-        ENDIF
-        
-        
-        IF(lwp) THEN
-           WRITE(numout,*)' salinity Levitus month ',nsal1,nsal2
-           WRITE(numout,*)
-           WRITE(numout,*) ' Levitus month = ',nsal1,'  level = 1'
-           CALL prihre(saldta(:,:,1,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout)
-           WRITE(numout,*) ' Levitus month = ',nsal1,'  level = ',jpk/2
-           CALL prihre(saldta(:,:,jpk/2,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout)
-           WRITE(numout,*) ' Levitus month = ',nsal1,'  level = ',jpkm1
-           CALL prihre(saldta(:,:,jpkm1,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout)
-        ENDIF
-     ENDIF
-     
-     
-     ! 3. At every time step compute salinity data
-     ! -------------------------------------------
-     
-     zxy = FLOAT(nday + 15 - 30*i15)/30.
-     s_dta(:,:,:) = ( 1.- zxy ) * saldta(:,:,:,1) + zxy * saldta(:,:,:,2)
-     
-     ! Close the file
-     ! --------------
-     
-     IF( kt == nitend )   CALL iom_close (numsdt)
-
+         IF( lwp .AND. kt==nn_it000 ) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' Levitus salinity data interpolated to s-coordinate'
+            WRITE(numout,*)
+         ENDIF
+
+      ELSE
+         !                                  ! Mask
+         s_dta(:,:,:) = s_dta(:,:,:) * tmask(:,:,:)
+         s_dta(:,:,jpk) = 0.e0
+         IF( ln_zps ) THEN               ! z-coord. partial steps
+            DO jj = 1, jpj               ! interpolation of salinity at the last ocean level (i.e. the partial step)
+               DO ji = 1, jpi
+                  ik = mbkt(ji,jj)
+                  IF( ik > 1 ) THEN
+                     zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) )
+                     s_dta(ji,jj,ik) = (1.-zl) * s_dta(ji,jj,ik) + zl * s_dta(ji,jj,ik-1)
+                  ENDIF
+               END DO
+            END DO
+         ENDIF
+      ENDIF
+        
+      IF( lwp .AND. kt == nit000 ) THEN
+         WRITE(numout,*)' salinity Levitus '
+         WRITE(numout,*)
+         WRITE(numout,*)'  level = 1'
+         CALL prihre(s_dta(:,:,1),    jpi,jpj,1,jpi,20,1,jpj,20,1.,numout)
+         WRITE(numout,*)'  level = ',jpk/2
+         CALL prihre(s_dta(:,:,jpk/2),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout)           
+         WRITE(numout,*) '  level = ',jpkm1
+         CALL prihre(s_dta(:,:,jpkm1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout)
+      ENDIF
+      !
    END SUBROUTINE dta_sal
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DTA/dtatem.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DTA/dtatem.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DTA/dtatem.F90	(revision 2528)
@@ -4,4 +4,10 @@
    !! Ocean data  :  read ocean temperature data from monthly atlas data
    !!=====================================================================
+   !! History :  OPA  ! 1991-03  ()  Original code
+   !!             -   ! 1992-07  (M. Imbard)
+   !!            8.0  ! 1999-10  (M.A. Foujols, M. Imbard)  NetCDF FORMAT 
+   !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module 
+   !!            3.3  ! 2010-10  (C. Bricaud, S. Masson)  use of fldread
+   !!----------------------------------------------------------------------
 #if defined key_dtatem   ||   defined key_esopa
    !!----------------------------------------------------------------------
@@ -10,43 +16,28 @@
    !!   dta_tem      : read ocean temperature data
    !!---l-------------------------------------------------------------------
-   !! * Modules used
    USE oce             ! ocean dynamics and tracers
    USE dom_oce         ! ocean space and time domain
+   USE fldread         ! read input fields
    USE in_out_manager  ! I/O manager
    USE phycst          ! physical constants
-#if defined key_orca_lev10
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-#endif
+
    IMPLICIT NONE
    PRIVATE
 
-   !! * Routine accessibility
-   PUBLIC dta_tem   ! called by step.F90 and inidta.F90
-
-   !! * Shared module variables
+   PUBLIC   dta_tem    ! called by step.F90 and inidta.F90
+
    LOGICAL , PUBLIC, PARAMETER ::   lk_dtatem = .TRUE.   !: temperature data flag
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  !:
-      t_dta             !: temperature data at given time-step
-
-   !! * Module variables
-   INTEGER ::   &
-      numtdt,        &  !: logical unit for data temperature
-      ntem1, ntem2  ! first and second record used
-   REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   &
-      temdta            ! temperature data at two consecutive times
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::  t_dta    !: temperature data at given time-step
+
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_tem      ! structure of input SST (file informations, fields read)
 
    !! * Substitutions
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
-
-   !!----------------------------------------------------------------------
-   !!   Default case                                            NetCDF file
-   !!----------------------------------------------------------------------
 
    SUBROUTINE dta_tem( kt )
@@ -66,258 +57,173 @@
       !!
       !! ** Action  :   define t_dta array at time-step kt
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt     ! ocean time-step
+      !
+      INTEGER ::   ji, jj, jk, jl, jkk            ! dummy loop indicies
+      INTEGER ::   ik, ierror                     ! temporary integers
+#if defined key_tradmp
+      INTEGER ::   il0, il1, ii0, ii1, ij0, ij1   ! temporary integers
+#endif
+      REAL(wp)::   zl
+      REAL(wp), DIMENSION(jpk) ::   ztemdta            ! auxiliary array for interpolation
+      !
+      CHARACTER(len=100)       ::   cn_dir             ! Root directory for location of ssr files
+      TYPE(FLD_N)              ::   sn_tem
+      LOGICAL , SAVE           ::   linit_tem = .FALSE.
       !!
-      !! History :
-      !!        !  91-03  ()  Original code
-      !!        !  92-07  (M. Imbard)
-      !!        !  99-10  (M.A. Foujols, M. Imbard)  NetCDF FORMAT 
-      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
+      NAMELIST/namdta_tem/   cn_dir, sn_tem
       !!----------------------------------------------------------------------
-      !! * Modules used
-      USE iom
-
-      !! * Arguments
-      INTEGER, INTENT( in ) ::   kt     ! ocean time-step
-
-      !! * Local declarations
-      INTEGER ::   ji, jj, jl, jk, jkk       ! dummy loop indicies
-      INTEGER ::   &
-         imois, iman, i15 , ik      ! temporary integers
-#  if defined key_tradmp
-      INTEGER ::   &
-         il0, il1, ii0, ii1, ij0, ij1   ! temporary integers
-# endif
-      REAL(wp) ::   zxy, zl
-#if defined key_orca_lev10
-      REAL(wp), DIMENSION(jpi,jpj,jpkdta,2) :: ztem
-      INTEGER   :: ikr, ikw, ikt, jjk 
-      REAL(wp)  :: zfac
-#endif
-      REAL(wp), DIMENSION(jpk,2) ::   &
-         ztemdta            ! auxiliary array for interpolation
-      !!----------------------------------------------------------------------
-      
-      ! 0. Initialization
-      ! -----------------
-      
-      iman  = INT( raamo )
-!!! better but change the results     i15 = INT( 2*FLOAT( nday ) / ( FLOAT( nobis(nmonth) ) + 0.5 ) )
-      i15   = nday / 16
-      imois = nmonth + i15 - 1
-      IF( imois == 0 ) imois = iman
-      
-      ! 1. First call kt=nit000
+ 
+      ! 1. Initialization 
       ! -----------------------
       
-      IF( kt == nit000 ) THEN
-         
-         ntem1= 0   ! initializations
-         IF(lwp) WRITE(numout,*) ' dta_tem : Levitus monthly fields'
-         CALL iom_open ( 'data_1m_potential_temperature_nomask', numtdt ) 
-         
-      ENDIF
-      
+      IF( kt == nit000 .AND. (.NOT. linit_tem ) ) THEN
+
+         !                   ! set file information
+         cn_dir = './'       ! directory in which the model is executed
+         ! ... default values (NB: frequency positive => hours, negative => months)
+         !            !   file    ! frequency ! variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation !
+         !            !   name    !  (hours)  !  name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs    !
+         sn_tem = FLD_N( 'temperature',  -1.  , 'votemper',  .false.   , .true.  ,  'yearly'   , ''       , ''       )
+
+         REWIND( numnam )          ! read in namlist namdta_tem 
+         READ( numnam, namdta_tem ) 
+
+         IF(lwp) THEN              ! control print
+            WRITE(numout,*)
+            WRITE(numout,*) 'dta_tem : Temperature Climatology '
+            WRITE(numout,*) '~~~~~~~ '
+         ENDIF
+         ALLOCATE( sf_tem(1), STAT=ierror )
+         IF( ierror > 0 ) THEN
+             CALL ctl_stop( 'dta_tem: unable to allocate sf_tem structure' )   ;   RETURN
+         ENDIF
+                                ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpk)   )
+         IF( sn_tem%ln_tint )   ALLOCATE( sf_tem(1)%fdta(jpi,jpj,jpk,2) )
+         !                         ! fill sf_tem with sn_tem and control print
+         CALL fld_fill( sf_tem, (/ sn_tem /), cn_dir, 'dta_tem', 'Temperature data', 'namdta_tem' )
+         linit_tem = .TRUE.
+         !
+      ENDIF
       
       ! 2. Read monthly file
       ! -------------------
-      
-      IF( kt == nit000 .OR. imois /= ntem1 ) THEN
-         
-         ! Calendar computation
-         
-         ntem1 = imois        ! first file record used 
-         ntem2 = ntem1 + 1    ! last  file record used
-         ntem1 = MOD( ntem1, iman )
-         IF( ntem1 == 0 )   ntem1 = iman
-         ntem2 = MOD( ntem2, iman )
-         IF( ntem2 == 0 )   ntem2 = iman
-         IF(lwp) WRITE(numout,*) 'first record file used ntem1 ', ntem1
-         IF(lwp) WRITE(numout,*) 'last  record file used ntem2 ', ntem2
-         
-         ! Read monthly temperature data Levitus 
-         
-#if defined key_orca_lev10
-         if (ln_zps) stop
-         ztem(:,:,:,:) = 0.
-         CALL iom_get (numtdt,jpdom_data,'votemper',ztem(:,:,:,1),ntem1)
-         CALL iom_get (numtdt,jpdom_data,'votemper',ztem(:,:,:,2),ntem2)
-#else         
-         CALL iom_get (numtdt,jpdom_data,'votemper',temdta(:,:,:,1),ntem1)
-         CALL iom_get (numtdt,jpdom_data,'votemper',temdta(:,:,:,2),ntem2)
+         
+      CALL fld_read( kt, 1, sf_tem )
+       
+      IF( lwp .AND. kt == nit000 )THEN 
+         WRITE(numout,*)
+         WRITE(numout,*) ' read Levitus temperature ok'
+         WRITE(numout,*)
+      ENDIF
+         
+#if defined key_tradmp
+      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN      !  ORCA_R2 configuration
+         !
+         ij0 = 101   ;   ij1 = 109
+         ii0 = 141   ;   ii1 = 155
+         DO jj = mj0(ij0), mj1(ij1)                      ! Reduced temperature in the Alboran Sea
+            DO ji = mi0(ii0), mi1(ii1)
+               sf_tem(1)%fnow(ji,jj, 13:13 ) = sf_tem(1)%fnow(ji,jj, 13:13 ) - 0.20
+               sf_tem(1)%fnow(ji,jj, 14:15 ) = sf_tem(1)%fnow(ji,jj, 14:15 ) - 0.35  
+               sf_tem(1)%fnow(ji,jj, 16:25 ) = sf_tem(1)%fnow(ji,jj, 16:25 ) - 0.40
+            END DO
+         END DO
+         !
+         IF( nn_cla == 1 ) THEN 
+            !                                         ! New temperature profile at Gibraltar
+            il0 = 138   ;   il1 = 138
+            ij0 = 101   ;   ij1 = 102
+            ii0 = 139   ;   ii1 = 139
+            DO jl = mi0(il0), mi1(il1)
+               DO jj = mj0(ij0), mj1(ij1)
+                  DO ji = mi0(ii0), mi1(ii1)
+                     sf_tem(1)%fnow(ji,jj,:) = sf_tem(1)%fnow(jl,jj,:)
+                  END DO
+               END DO
+            END DO
+            !                                         ! New temperature profile at Bab el Mandeb
+            il0 = 164   ;   il1 = 164
+            ij0 =  87   ;   ij1 =  88
+            ii0 = 161   ;   ii1 = 163
+            DO jl = mi0(il0), mi1(il1)
+               DO jj = mj0(ij0), mj1(ij1)
+                  DO ji = mi0(ii0), mi1(ii1)
+                     sf_tem(1)%fnow(ji,jj,:) = sf_tem(1)%fnow(jl,jj,:)
+                  END DO
+               END DO
+            END DO
+         ELSE
+            !                                         ! Reduced temperature at Red Sea
+            ij0 =  87   ;   ij1 =  96
+            ii0 = 148   ;   ii1 = 160
+            sf_tem(1)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 ) = 7.0
+            sf_tem(1)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 ) = 6.5
+            sf_tem(1)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 ) = 6.0
+         ENDIF
+            !
+      ENDIF
 #endif
          
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) ' read Levitus temperature ok'
-         IF(lwp) WRITE(numout,*)
-         
-#if defined key_tradmp
-         IF( cp_cfg == "orca"  .AND. jp_cfg == 2 ) THEN
+      t_dta(:,:,:) = sf_tem(1)%fnow(:,:,:) 
+         
+      IF( ln_sco ) THEN
+         DO jj = 1, jpj                  ! interpolation of temperatures
+            DO ji = 1, jpi
+               DO jk = 1, jpk
+                  zl=fsdept_0(ji,jj,jk)
+                  IF(zl < gdept_0(1))   ztemdta(jk) =  t_dta(ji,jj,1)
+                  IF(zl > gdept_0(jpk)) ztemdta(jk) =  t_dta(ji,jj,jpkm1) 
+                  DO jkk = 1, jpkm1
+                     IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN
+                        ztemdta(jk) = t_dta(ji,jj,jkk)                                 &
+                                  &    + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk))  &
+                                  &    * (t_dta(ji,jj,jkk+1) - t_dta(ji,jj,jkk))
+                     ENDIF
+                  END DO
+               END DO
+               DO jk = 1, jpkm1
+                  t_dta(ji,jj,jk) = ztemdta(jk)
+               END DO
+               t_dta(ji,jj,jpk) = 0.0
+            END DO
+         END DO
             
-            !                                        ! =======================
-            !                                        !  ORCA_R2 configuration
-            !                                        ! ======================= 
-            ij0 = 101   ;   ij1 = 109
-            ii0 = 141   ;   ii1 = 155
-            DO jj = mj0(ij0), mj1(ij1)                      ! Reduced temperature in the Alboran Sea
-               DO ji = mi0(ii0), mi1(ii1)
-#if defined key_orca_lev10
-                  ztem(  ji,jj, 13:13 ,:) = ztem  (ji,jj, 13:13 ,:) - 0.20
-                  ztem  (ji,jj, 14:15 ,:) = ztem  (ji,jj, 14:15 ,:) - 0.35
-                  ztem  (ji,jj, 16:25 ,:) = ztem  (ji,jj, 16:25 ,:) - 0.40
-#else
-                  temdta(ji,jj, 13:13 ,:) = temdta(ji,jj, 13:13 ,:) - 0.20
-                  temdta(ji,jj, 14:15 ,:) = temdta(ji,jj, 14:15 ,:) - 0.35
-                  temdta(ji,jj, 16:25 ,:) = temdta(ji,jj, 16:25 ,:) - 0.40
-#endif
-               END DO
-            END DO
+         IF( lwp .AND. kt == nit000 )THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' Levitus temperature data interpolated to s-coordinate'
+            WRITE(numout,*)
+         ENDIF
             
-            IF( n_cla == 1 ) THEN 
-               !                                         ! New temperature profile at Gibraltar
-               il0 = 138   ;   il1 = 138
-               ij0 = 101   ;   ij1 = 102
-               ii0 = 139   ;   ii1 = 139
-               DO jl = mi0(il0), mi1(il1)
-                  DO jj = mj0(ij0), mj1(ij1)
-                     DO ji = mi0(ii0), mi1(ii1)
-#if defined key_orca_lev10
-                        ztem  (ji,jj,:,:) = ztem  (jl,jj,:,:)
-#else
-                        temdta(ji,jj,:,:) = temdta(jl,jj,:,:)
-#endif
-                     END DO
-                  END DO
-               END DO
-               !                                         ! New temperature profile at Bab el Mandeb
-               il0 = 164   ;   il1 = 164
-               ij0 =  87   ;   ij1 =  88
-               ii0 = 161   ;   ii1 = 163
-               DO jl = mi0(il0), mi1(il1)
-                  DO jj = mj0(ij0), mj1(ij1)
-                     DO ji = mi0(ii0), mi1(ii1)
-#if defined key_orca_lev10
-                        ztem  (ji,jj,:,:) = ztem  (jl,jj,:,:)
-#else
-                        temdta(ji,jj,:,:) = temdta(jl,jj,:,:)
-#endif
-                     END DO
-                  END DO
-               END DO
-               !
-            ELSE
-               !                                         ! Reduced temperature at Red Sea
-               ij0 =  87   ;   ij1 =  96
-               ii0 = 148   ;   ii1 = 160
-#if defined key_orca_lev10
-               ztem  ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 , : ) = 7.0 
-               ztem  ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 , : ) = 6.5 
-               ztem  ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 , : ) = 6.0
-#else
-               temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 , : ) = 7.0 
-               temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 , : ) = 6.5 
-               temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 , : ) = 6.0
-#endif
-            ENDIF
-            !
-         ENDIF
-#endif
-         
-#if defined key_orca_lev10
-         ! interpolate from 31 to 301 level the ztem field result in temdta
-         DO jl = 1, 2
-            DO jjk = 1, 5
-               temdta(:,:,jjk,jl) = ztem(:,:,1,jl)
-            END DO
-            DO jk = 1, jpk-20,10
-               ik = jk+5
-               ikr =  INT(jk/10) + 1
-               ikw =  (ikr-1) *10 + 1
-               ikt =  ikw + 5
-               DO jjk=ikt,ikt+9
-                  zfac = ( gdept_0(jjk   ) - gdepw_0(ikt) ) / ( gdepw_0(ikt+10) - gdepw_0(ikt) )
-                  temdta(:,:,jjk,jl) = ztem(:,:,ikr,jl) + ( ztem(:,:,ikr+1,jl) - ztem(:,:,ikr,jl) ) * zfac
-               END DO
-            END DO
-            DO jjk = jpk-5, jpk
-               temdta(:,:,jjk,jl) = ztem(:,:,jpkdta-1,jl)
-            END DO
-            ! fill the overlap areas
-            CALL lbc_lnk (temdta(:,:,:,jl),'Z',-999.,'no0')
-         END DO
-#endif
-         
-         IF( ln_sco ) THEN
-            DO jl = 1, 2
-               DO jj = 1, jpj                  ! interpolation of temperatures
-                  DO ji = 1, jpi
-                     DO jk = 1, jpk
-                        zl=fsdept_0(ji,jj,jk)
-                        IF(zl < gdept_0(1)) ztemdta(jk,jl) =  temdta(ji,jj,1,jl)
-                        IF(zl > gdept_0(jpk)) ztemdta(jk,jl) =  temdta(ji,jj,jpkm1,jl)
-                        DO jkk = 1, jpkm1
-                           IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN
-                              ztemdta(jk,jl) = temdta(ji,jj,jkk,jl)                                 &
-                                   &           + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk))      &
-                                   &                              *(temdta(ji,jj,jkk+1,jl) - temdta(ji,jj,jkk,jl))
-                           ENDIF
-                        END DO
-                     END DO
-                     DO jk = 1, jpkm1
-                        temdta(ji,jj,jk,jl) = ztemdta(jk,jl)
-                     END DO
-                     temdta(ji,jj,jpk,jl) = 0.0
-                  END DO
-               END DO
-            END DO
-            
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) ' Levitus temperature data interpolated to s-coordinate'
-            IF(lwp) WRITE(numout,*)
-            
-         ELSE
-            
-            !                                  ! Mask
-            DO jl = 1, 2
-               temdta(:,:,:,jl) = temdta(:,:,:,jl) * tmask(:,:,:)
-               temdta(:,:,jpk,jl) = 0.
-               IF( ln_zps ) THEN                ! z-coord. with partial steps
-                  DO jj = 1, jpj                  ! interpolation of temperature at the last level
-                     DO ji = 1, jpi
-                        ik = mbathy(ji,jj) - 1
-                        IF( ik > 2 ) THEN
-                           zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) )
-                           temdta(ji,jj,ik,jl) = (1.-zl) * temdta(ji,jj,ik,jl) + zl * temdta(ji,jj,ik-1,jl)
-                        ENDIF
-                     END DO
-                  END DO
-               ENDIF
-            END DO
-            
-         ENDIF
-         
-         IF(lwp) THEN
-            WRITE(numout,*) ' temperature Levitus month ', ntem1, ntem2
-            WRITE(numout,*)
-            WRITE(numout,*) ' Levitus month = ', ntem1, '  level = 1'
-            CALL prihre( temdta(:,:,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
-            WRITE(numout,*) ' Levitus month = ', ntem1, '  level = ', jpk/2
-            CALL prihre( temdta(:,:,jpk/2,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
-            WRITE(numout,*) ' Levitus month = ',ntem1,'  level = ', jpkm1
-            CALL prihre( temdta(:,:,jpkm1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
-         ENDIF
-      ENDIF
-      
-      
-      ! 2. At every time step compute temperature data
-      ! ----------------------------------------------
-      
-      zxy = FLOAT( nday + 15 - 30 * i15 ) / 30.
-      t_dta(:,:,:) = (1.-zxy) * temdta(:,:,:,1) + zxy * temdta(:,:,:,2)
-      
-      ! Close the file
-      ! --------------
-      
-      IF( kt == nitend )   CALL iom_close (numtdt)
-      
-    END SUBROUTINE dta_tem
+      ELSE
+         !                                  ! Mask
+         t_dta(:,:,:  ) = t_dta(:,:,:) * tmask(:,:,:)
+         t_dta(:,:,jpk) = 0.
+         IF( ln_zps ) THEN                ! z-coord. with partial steps
+            DO jj = 1, jpj                ! interpolation of temperature at the last level
+               DO ji = 1, jpi
+                  ik = mbkt(ji,jj)
+                  IF( ik > 1 ) THEN
+                     zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) )
+                     t_dta(ji,jj,ik) = (1.-zl) * t_dta(ji,jj,ik) + zl * t_dta(ji,jj,ik-1)
+                  ENDIF
+               END DO
+            END DO
+         ENDIF
+         !
+      ENDIF
+         
+      IF( lwp .AND. kt == nit000 ) THEN
+         WRITE(numout,*) ' temperature Levitus '
+         WRITE(numout,*)
+         WRITE(numout,*)'  level = 1'
+         CALL prihre( t_dta(:,:,1    ), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
+         WRITE(numout,*)'  level = ', jpk/2
+         CALL prihre( t_dta(:,:,jpk/2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
+         WRITE(numout,*)'  level = ', jpkm1
+         CALL prihre( t_dta(:,:,jpkm1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
+      ENDIF
+      !
+   END SUBROUTINE dta_tem
 
 #else
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90	(revision 2528)
@@ -4,4 +4,18 @@
    !! Ocean diagnostic variable : horizontal divergence and relative vorticity
    !!==============================================================================
+   !! History :  OPA  ! 1987-06  (P. Andrich, D. L Hostis)  Original code
+   !!            4.0  ! 1991-11  (G. Madec)
+   !!            6.0  ! 1993-03  (M. Guyon)  symetrical conditions
+   !!            7.0  ! 1996-01  (G. Madec)  s-coordinates
+   !!            8.0  ! 1997-06  (G. Madec)  lateral boundary cond., lbc
+   !!            8.1  ! 1997-08  (J.M. Molines)  Open boundaries
+   !!            8.2  ! 2000-03  (G. Madec)  no slip accurate
+   !!  NEMO      1.0  ! 2002-09  (G. Madec, E. Durand)  Free form, F90
+   !!             -   ! 2005-01  (J. Chanut) Unstructured open boundaries
+   !!             -   ! 2003-08  (G. Madec)  merged of cur and div, free form, F90
+   !!             -   ! 2005-01  (J. Chanut, A. Sellar) unstructured open boundaries
+   !!            3.3  ! 2010-09  (D.Storkey and E.O'Dea) bug fixes for BDY module
+   !!             -   ! 2010-10  (R. Furner, G. Madec) runoff and cla added directly here
+   !!----------------------------------------------------------------------
 
    !!----------------------------------------------------------------------
@@ -9,10 +23,11 @@
    !!                vorticity fields
    !!----------------------------------------------------------------------
-   !! * Modules used
    USE oce             ! ocean dynamics and tracers
    USE dom_oce         ! ocean space and time domain
+   USE sbc_oce, ONLY : ln_rnf   ! surface boundary condition: ocean
+   USE sbcrnf          ! river runoff 
+   USE obc_oce         ! ocean lateral open boundary condition
+   USE cla             ! cross land advection             (cla_div routine)
    USE in_out_manager  ! I/O manager
-   USE obc_oce         ! ocean lateral open boundary condition
-   USE bdy_oce	       ! Unstructured open boundaries variables
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
 
@@ -20,6 +35,5 @@
    PRIVATE
 
-   !! * Accessibility
-   PUBLIC div_cur    ! routine called by step.F90 and istate.F90
+   PUBLIC   div_cur    ! routine called by step.F90 and istate.F90
 
    !! * Substitutions
@@ -27,9 +41,8 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
@@ -47,14 +60,11 @@
       !!      vorticity at before and now time-step
       !!
-      !! ** Method  : 
-      !!      I.  divergence :
+      !! ** Method  : I.  divergence :
       !!         - save the divergence computed at the previous time-step
       !!      (note that the Asselin filter has not been applied on hdivb)
       !!         - compute the now divergence given by :
       !!         hdivn = 1/(e1t*e2t*e3t) ( di[e2u*e3u un] + dj[e1v*e3v vn] )
-      !!      Note: if lk_zco=T, e3u=e3v=e3t, they are simplified in the
-      !!      above expression
-      !!         - apply lateral boundary conditions on hdivn 
-      !!      II. vorticity :
+      !!      correct hdiv with runoff inflow (div_rnf) and cross land flow (div_cla) 
+      !!              II. vorticity :
       !!         - save the curl computed at the previous time-step
       !!            rotb = rotn
@@ -62,6 +72,4 @@
       !!         - compute the now curl in tensorial formalism:
       !!            rotn = 1/(e1f*e2f) ( di[e2v vn] - dj[e1u un] )
-      !!         - apply lateral boundary conditions on rotn through a call
-      !!      of lbc_lnk routine.
       !!         - Coastal boundary condition: 'key_noslip_accurate' defined,
       !!      the no-slip boundary condition is computed using Schchepetkin
@@ -69,22 +77,15 @@
       !!      For example, along east coast, the one-sided finite difference
       !!      approximation used for di[v] is:
-      !!         di[e2v vn] =  1/(e1f*e2f)
-      !!                    * ( (e2v vn)(i) + (e2v vn)(i-1) + (e2v vn)(i-2) )
+      !!         di[e2v vn] =  1/(e1f*e2f) * ( (e2v vn)(i) + (e2v vn)(i-1) + (e2v vn)(i-2) )
       !!
       !! ** Action  : - update hdivb, hdivn, the before & now hor. divergence
       !!              - update rotb , rotn , the before & now rel. vorticity
-      !!
-      !! History :
-      !!   8.2  !  00-03  (G. Madec)  no slip accurate
-      !!   9.0  !  03-08  (G. Madec)  merged of cur and div, free form, F90
-      !!        !  05-01  (J. Chanut, A. Sellar) unstructured open boundaries
-      !!----------------------------------------------------------------------
-      !! * Arguments
+      !!----------------------------------------------------------------------
       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
-      
-      !! * Local declarations
+      !
       INTEGER ::   ji, jj, jk     ! dummy loop indices
       INTEGER ::   ii, ij, jl     ! temporary integer
       INTEGER ::   ijt, iju       ! temporary integer
+      REAL(wp) ::  zraur, zdep
       REAL(wp), DIMENSION(   jpi  ,1:jpj+2) ::   zwu   ! workspace
       REAL(wp), DIMENSION(-1:jpi+2,  jpj  ) ::   zwv   ! workspace
@@ -100,8 +101,8 @@
       DO jk = 1, jpkm1                                 ! Horizontal slab
          !                                             ! ===============
-
+         !
          hdivb(:,:,jk) = hdivn(:,:,jk)    ! time swap of div arrays
          rotb (:,:,jk) = rotn (:,:,jk)    ! time swap of rot arrays
-
+         !
          !                                             ! --------
          ! Horizontal divergence                       !   div
@@ -109,14 +110,8 @@
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
-#if defined key_zco
-               hdivn(ji,jj,jk) = (  e2u(ji,jj) * un(ji,jj,jk) - e2u(ji-1,jj  ) * un(ji-1,jj  ,jk)      &
-                  &               + e1v(ji,jj) * vn(ji,jj,jk) - e1v(ji  ,jj-1) * vn(ji  ,jj-1,jk)  )   &
-                  &            / ( e1t(ji,jj) * e2t(ji,jj) )
-#else
                hdivn(ji,jj,jk) =   &
                   (  e2u(ji,jj)*fse3u(ji,jj,jk) * un(ji,jj,jk) - e2u(ji-1,jj  )*fse3u(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)       &
                    + e1v(ji,jj)*fse3v(ji,jj,jk) * vn(ji,jj,jk) - e1v(ji  ,jj-1)*fse3v(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)  )    &
                   / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-#endif
             END DO
          END DO
@@ -131,12 +126,4 @@
             IF( lp_obc_south )   hdivn(nis0  :nis1  ,njs0  :njs1  ,jk) = 0.e0      ! south
          ENDIF
-#endif         
-#if defined key_bdy
-         ! unstructured open boundaries (div must be zero behind the open boundary)
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               hdivn(ji,jj,jk)=hdivn(ji,jj,jk)*bdytmask(ji,jj)
-            END DO
-         END DO
 #endif         
          IF( .NOT. AGRIF_Root() ) THEN
@@ -210,6 +197,5 @@
             DO ji = 1, fs_jpim1   ! vector opt.
                rotn(ji,jj,jk) = (  zwv(ji+1,jj  ) - zwv(ji,jj)      &
-                                 - zwu(ji  ,jj+1) + zwu(ji,jj)  )   &
-                              * fmask(ji,jj,jk) / ( e1f(ji,jj)*e2f(ji,jj) )
+                  &              - zwu(ji  ,jj+1) + zwu(ji,jj)  ) * fmask(ji,jj,jk) / ( e1f(ji,jj)*e2f(ji,jj) )
             END DO
          END DO
@@ -240,14 +226,15 @@
                * ( -4. * zwu(ii,ij) + zwu(ii,ij-1) - 0.2 * zwu(ii,ij-2) )
          END DO
-
          !                                             ! ===============
       END DO                                           !   End of slab
       !                                                ! ===============
+
+      IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )          ! runoffs (update hdivn field)
+      IF( nn_cla == 1 )   CALL cla_div    ( kt )             ! Cross Land Advection (Update Hor. divergence)
       
       ! 4. Lateral boundary conditions on hdivn and rotn
       ! ---------------------------------=======---======
-      CALL lbc_lnk( hdivn, 'T', 1. )     ! T-point, no sign change
-      CALL lbc_lnk( rotn , 'F', 1. )     ! F-point, no sign change
-
+      CALL lbc_lnk( hdivn, 'T', 1. )   ;   CALL lbc_lnk( rotn , 'F', 1. )    ! lateral boundary cond. (no sign change)
+      !
    END SUBROUTINE div_cur
    
@@ -269,7 +256,5 @@
       !!      - compute the now divergence given by :
       !!         hdivn = 1/(e1t*e2t*e3t) ( di[e2u*e3u un] + dj[e1v*e3v vn] )
-      !!      Note: if lk_zco=T, e3u=e3v=e3t, they are simplified in the 
-      !!      above expression
-      !!      - apply lateral boundary conditions on hdivn 
+      !!      correct hdiv with runoff inflow (div_rnf) and cross land flow (div_cla) 
       !!              - Relavtive Vorticity :
       !!      - save the curl computed at the previous time-step (rotb = rotn)
@@ -277,6 +262,4 @@
       !!      - compute the now curl in tensorial formalism:
       !!            rotn = 1/(e1f*e2f) ( di[e2v vn] - dj[e1u un] )
-      !!      - apply lateral boundary conditions on rotn through a call to
-      !!      routine lbc_lnk routine.
       !!      Note: Coastal boundary condition: lateral friction set through
       !!      the value of fmask along the coast (see dommsk.F90) and shlat
@@ -285,20 +268,9 @@
       !! ** Action  : - update hdivb, hdivn, the before & now hor. divergence
       !!              - update rotb , rotn , the before & now rel. vorticity
-      !!
-      !! History :
-      !!   1.0  !  87-06  (P. Andrich, D. L Hostis)  Original code
-      !!   4.0  !  91-11  (G. Madec)
-      !!   6.0  !  93-03  (M. Guyon)  symetrical conditions
-      !!   7.0  !  96-01  (G. Madec)  s-coordinates
-      !!   8.0  !  97-06  (G. Madec)  lateral boundary cond., lbc
-      !!   8.1  !  97-08  (J.M. Molines)  Open boundaries
-      !!   9.0  !  02-09  (G. Madec, E. Durand)  Free form, F90
-      !!        !  05-01  (J. Chanut) Unstructured open boundaries
-      !!----------------------------------------------------------------------
-      !! * Arguments
+      !!----------------------------------------------------------------------
       INTEGER, INTENT( in ) ::   kt     ! ocean time-step index
-      
-      !! * Local declarations
+      !
       INTEGER  ::   ji, jj, jk          ! dummy loop indices
+      REAL(wp) ::  zraur, zdep
       !!----------------------------------------------------------------------
 
@@ -312,8 +284,8 @@
       DO jk = 1, jpkm1                                 ! Horizontal slab
          !                                             ! ===============
-
+         !
          hdivb(:,:,jk) = hdivn(:,:,jk)    ! time swap of div arrays
          rotb (:,:,jk) = rotn (:,:,jk)    ! time swap of rot arrays
-
+         !
          !                                             ! --------
          ! Horizontal divergence                       !   div 
@@ -321,14 +293,8 @@
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
-#if defined key_zco
-               hdivn(ji,jj,jk) = (  e2u(ji,jj) * un(ji,jj,jk) - e2u(ji-1,jj  ) * un(ji-1,jj  ,jk)      &
-                  &               + e1v(ji,jj) * vn(ji,jj,jk) - e1v(ji  ,jj-1) * vn(ji  ,jj-1,jk)  )   & 
-                  / ( e1t(ji,jj) * e2t(ji,jj) )
-#else
                hdivn(ji,jj,jk) =   &
-                  (  e2u(ji,jj)*fse3u(ji,jj,jk) * un(ji,jj,jk) - e2u(ji-1,jj  )*fse3u(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)       &
-                   + e1v(ji,jj)*fse3v(ji,jj,jk) * vn(ji,jj,jk) - e1v(ji  ,jj-1)*fse3v(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)  )    &
+                  (  e2u(ji,jj)*fse3u(ji,jj,jk) * un(ji,jj,jk) - e2u(ji-1,jj)*fse3u(ji-1,jj,jk) * un(ji-1,jj,jk)       &
+                   + e1v(ji,jj)*fse3v(ji,jj,jk) * vn(ji,jj,jk) - e1v(ji,jj-1)*fse3v(ji,jj-1,jk) * vn(ji,jj-1,jk)  )    &
                   / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-#endif
             END DO  
          END DO  
@@ -344,12 +310,4 @@
          ENDIF
 #endif         
-#if defined key_bdy
-         ! unstructured open boundaries (div must be zero behind the open boundary)
-         DO jj = 1, jpj
-           DO ji = 1, jpi
-             hdivn(ji,jj,jk)=hdivn(ji,jj,jk)*bdytmask(ji,jj)
-           END DO
-         END DO
-#endif        
          IF( .NOT. AGRIF_Root() ) THEN
             IF ((nbondi ==  1).OR.(nbondi == 2)) hdivn(nlci-1 , :     ,jk) = 0.e0      ! east
@@ -372,10 +330,12 @@
       END DO                                           !   End of slab
       !                                                ! ===============
-      
+
+      IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )          ! runoffs (update hdivn field)
+      IF( nn_cla == 1 )   CALL cla_div    ( kt )             ! Cross Land Advection (update hdivn field)
+
       ! 4. Lateral boundary conditions on hdivn and rotn
       ! ---------------------------------=======---======
-      CALL lbc_lnk( hdivn, 'T', 1. )       ! T-point, no sign change
-      CALL lbc_lnk( rotn , 'F', 1. )       ! F-point, no sign change
-
+      CALL lbc_lnk( hdivn, 'T', 1. )   ;   CALL lbc_lnk( rotn , 'F', 1. )     ! lateral boundary cond. (no sign change)
+      !
    END SUBROUTINE div_cur
    
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90	(revision 2528)
@@ -4,10 +4,11 @@
    !! Ocean active tracers:  advection scheme control
    !!==============================================================================
-   !! History :  9.0  !  06-11  (G. Madec)  Original code
+   !! History :  1.0  !  2006-11  (G. Madec)  Original code
+   !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase
    !!----------------------------------------------------------------------
 
    !!----------------------------------------------------------------------
    !!   dyn_adv      : compute the momentum advection trend 
-   !!   dyn_adv_ctl  : control the different options of advection scheme
+   !!   dyn_adv_init : control the different options of advection scheme
    !!----------------------------------------------------------------------
    USE dom_oce         ! ocean space and time domain
@@ -22,9 +23,10 @@
    PRIVATE
 
-   PUBLIC dyn_adv     ! routine called by step module
+   PUBLIC dyn_adv       ! routine called by step module
+   PUBLIC dyn_adv_init  ! routine called by opa module
  
-   LOGICAL, PUBLIC ::   ln_dynadv_vec  = .TRUE.    ! vector form flag
-   LOGICAL, PUBLIC ::   ln_dynadv_cen2 = .FALSE.   ! flux form - 2nd order centered scheme flag
-   LOGICAL, PUBLIC ::   ln_dynadv_ubs  = .FALSE.   ! flux form - 3rd order UBS scheme flag
+   LOGICAL, PUBLIC ::   ln_dynadv_vec  = .TRUE.    !: vector form flag
+   LOGICAL, PUBLIC ::   ln_dynadv_cen2 = .FALSE.   !: flux form - 2nd order centered scheme flag
+   LOGICAL, PUBLIC ::   ln_dynadv_ubs  = .FALSE.   !: flux form - 3rd order UBS scheme flag
    
    INTEGER ::   nadv   ! choice of the formulation and scheme for the advection
@@ -34,7 +36,7 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2006) 
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -56,6 +58,4 @@
       !!----------------------------------------------------------------------
       !
-      IF( kt == nit000 )   CALL dyn_adv_ctl          ! initialisation & control of options
-
       SELECT CASE ( nadv )                     ! compute advection trend and add it to general trend
       CASE ( 0 )     
@@ -77,7 +77,7 @@
 
    
-   SUBROUTINE dyn_adv_ctl
+   SUBROUTINE dyn_adv_init
       !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE dyn_adv_ctl  ***
+      !!                  ***  ROUTINE dyn_adv_init  ***
       !!                
       !! ** Purpose :   Control the consistency between namelist options for 
@@ -85,5 +85,5 @@
       !!----------------------------------------------------------------------
       INTEGER ::   ioptio
-
+      !!
       NAMELIST/namdyn_adv/ ln_dynadv_vec, ln_dynadv_cen2 , ln_dynadv_ubs
       !!----------------------------------------------------------------------
@@ -94,5 +94,5 @@
       IF(lwp) THEN                    ! Namelist print
          WRITE(numout,*)
-         WRITE(numout,*) 'dyn_adv_ctl : choice/control of the momentum advection scheme'
+         WRITE(numout,*) 'dyn_adv_init : choice/control of the momentum advection scheme'
          WRITE(numout,*) '~~~~~~~~~~~'
          WRITE(numout,*) '       Namelist namdyn_adv : chose a advection formulation & scheme for momentum'
@@ -124,5 +124,5 @@
       ENDIF
       !
-   END SUBROUTINE dyn_adv_ctl
+   END SUBROUTINE dyn_adv_init
 
   !!======================================================================
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90	(revision 2528)
@@ -31,5 +31,5 @@
    !! NEMO/OPA 3.2 , LODYC-IPSL  (2009)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90	(revision 2528)
@@ -36,5 +36,5 @@
    !! NEMO/OPA 3.2 , LODYC-IPSL  (2009)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90	(revision 2528)
@@ -4,5 +4,5 @@
    !! Ocean dynamics :  bottom friction component of the momentum mixing trend
    !!==============================================================================
-   !! History :  9.0  !  2008-11  (A. C. Coward)  Original code
+   !! History :  3.2  ! 2008-11  (A. C. Coward)  Original code
    !!----------------------------------------------------------------------
 
@@ -13,5 +13,4 @@
    USE dom_oce         ! ocean space and time domain variables 
    USE zdf_oce         ! ocean vertical physics variables
-   USE zdfbfr          ! bottom friction
 
    USE trdmod          ! ocean active dynamics and tracers trends 
@@ -30,9 +29,8 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
-   !! $Id: dynzdf.F90 1152 2008-06-26 14:11:13Z rblod $
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
    
@@ -45,20 +43,18 @@
       !! ** Action  :   (ua,va)   momentum trend increased by bottom friction trend
       !!---------------------------------------------------------------------
-      USE oce, ONLY :   ztrdu => ta   ! use ta as 3D workspace
-      USE oce, ONLY :   ztrdv => sa   ! use sa as 3D workspace
+      USE oce, ONLY :   ztrduv => tsa   ! use tsa as 4D workspace
       !!
       INTEGER, INTENT(in) ::   kt   ! ocean time-step index
       !! 
-      INTEGER  ::   ji, jj          ! dummy loop indexes
-      INTEGER  ::   ikbu  , ikbv    ! temporary integers
-      INTEGER  ::   ikbum1, ikbvm1  !    -          -
-      REAL(wp) ::   zinv, zbfru, zbfrv   ! temporary scalar
+      INTEGER  ::   ji, jj       ! dummy loop indexes
+      INTEGER  ::   ikbu, ikbv   ! local integers
+      REAL(wp) ::   zm1_2dt      ! local scalar
       !!---------------------------------------------------------------------
       !
-      zinv = -1. / ( 2.*rdt )
+      zm1_2dt = - 1._wp / ( 2._wp * rdt )
 
       IF( l_trddyn )   THEN                      ! temporary save of ua and va trends
-         ztrdu(:,:,:) = ua(:,:,:)
-         ztrdv(:,:,:) = va(:,:,:)
+         ztrduv(:,:,:,1) = ua(:,:,:)
+         ztrduv(:,:,:,2) = va(:,:,:)
       ENDIF
 
@@ -70,16 +66,10 @@
          DO ji = 2, jpim1
 # endif
-            ikbu = MIN( mbathy(ji+1,jj), mbathy(ji,jj) )
-            ikbv = MIN( mbathy(ji,jj+1), mbathy(ji,jj) )
-            ikbum1 = MAX( ikbu-1, 1 )
-            ikbvm1 = MAX( ikbv-1, 1 )
+            ikbu = mbku(ji,jj)          ! deepest ocean u- & v-levels
+            ikbv = mbkv(ji,jj)
             !
-            ! Apply stability criteria on absolute value  : Min abs(bfr) => Max (bfr)
-            zbfru = MAX( bfrua(ji,jj), fse3u(ji,jj,ikbum1)*zinv )
-            zbfrv = MAX( bfrva(ji,jj), fse3v(ji,jj,ikbvm1)*zinv )
-            !
-            ua(ji,jj,ikbum1) = ua(ji,jj,ikbum1) + zbfru * ub(ji,jj,ikbum1) / fse3u(ji,jj,ikbum1)
-            va(ji,jj,ikbvm1) = va(ji,jj,ikbvm1) + zbfrv * vb(ji,jj,ikbvm1) / fse3v(ji,jj,ikbvm1)
-            !
+            ! Apply stability criteria on absolute value  : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt)
+            ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX(  bfrua(ji,jj) / fse3u(ji,jj,ikbu) , zm1_2dt  ) * ub(ji,jj,ikbu)
+            va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX(  bfrua(ji,jj) / fse3v(ji,jj,ikbu) , zm1_2dt  ) * vb(ji,jj,ikbv)
          END DO
       END DO
@@ -87,7 +77,7 @@
       !
       IF( l_trddyn )   THEN                      ! save the vertical diffusive trends for further diagnostics
-         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
-         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
-         CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_bfr, 'DYN', kt )
+         ztrduv(:,:,:,1) = ua(:,:,:) - ztrduv(:,:,:,1)
+         ztrduv(:,:,:,2) = va(:,:,:) - ztrduv(:,:,:,2)
+         CALL trd_mod( ztrduv(:,:,:,1), ztrduv(:,:,:,2), jpdyn_trd_bfr, 'DYN', kt )
       ENDIF
       !                                          ! print mean trends (used for debugging)
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90	(revision 2528)
@@ -4,13 +4,14 @@
    !! Ocean dynamics:  hydrostatic pressure gradient trend
    !!======================================================================
-   !! History :  1.0  !  87-09  (P. Andrich, M.-A. Foujols)  hpg_zco: Original code
-   !!            5.0  !  91-11  (G. Madec)
-   !!            7.0  !  96-01  (G. Madec)  hpg_sco: Original code for s-coordinates
-   !!            8.0  !  97-05  (G. Madec)  split dynber into dynkeg and dynhpg
-   !!            8.5  !  02-07  (G. Madec)  F90: Free form and module
-   !!            8.5  !  02-08  (A. Bozec)  hpg_zps: Original code
-   !!            9.0  !  05-10  (A. Beckmann, B.W. An)  various s-coordinate options
-   !!                           Original code for hpg_ctl, hpg_hel hpg_wdj, hpg_djc, hpg_rot 
-   !!            9.0  !  05-11  (G. Madec) style & small optimisation
+   !! History :  OPA  !  1987-09  (P. Andrich, M.-A. Foujols)  hpg_zco: Original code
+   !!            5.0  !  1991-11  (G. Madec)
+   !!            7.0  !  1996-01  (G. Madec)  hpg_sco: Original code for s-coordinates
+   !!            8.0  !  1997-05  (G. Madec)  split dynber into dynkeg and dynhpg
+   !!            8.5  !  2002-07  (G. Madec)  F90: Free form and module
+   !!            8.5  !  2002-08  (A. Bozec)  hpg_zps: Original code
+   !!   NEMO     1.0  !  2005-10  (A. Beckmann, B.W. An)  various s-coordinate options
+   !!                 !         Original code for hpg_ctl, hpg_hel hpg_wdj, hpg_djc, hpg_rot 
+   !!             -   !  2005-11  (G. Madec) style & small optimisation
+   !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase
    !!----------------------------------------------------------------------
 
@@ -18,5 +19,5 @@
    !!   dyn_hpg      : update the momentum trend with the now horizontal
    !!                  gradient of the hydrostatic pressure
-   !!       hpg_ctl  : initialisation and control of options
+   !!   dyn_hpg_init : initialisation and control of options
    !!       hpg_zco  : z-coordinate scheme
    !!       hpg_zps  : z-coordinate plus partial steps (interpolation)
@@ -39,5 +40,6 @@
    PRIVATE
 
-   PUBLIC   dyn_hpg    ! routine called by step module
+   PUBLIC   dyn_hpg        ! routine called by step module
+   PUBLIC   dyn_hpg_init   ! routine called by opa module
 
    !                                              !!* Namelist namdyn_hpg : hydrostatic pressure gradient 
@@ -49,5 +51,5 @@
    LOGICAL , PUBLIC ::   ln_hpg_djc    = .FALSE.   !: s-coordinate (Density Jacobian with Cubic polynomial)
    LOGICAL , PUBLIC ::   ln_hpg_rot    = .FALSE.   !: s-coordinate (ROTated axes scheme)
-   REAL(wp), PUBLIC ::   rn_gamma      = 0.e0      !: weighting coefficient
+   REAL(wp), PUBLIC ::   rn_gamma      = 0._wp     !: weighting coefficient
    LOGICAL , PUBLIC ::   ln_dynhpg_imp = .FALSE.   !: semi-implicite hpg flag
 
@@ -58,9 +60,8 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -79,12 +80,10 @@
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztrdu, ztrdv   ! 3D temporary workspace
       !!----------------------------------------------------------------------
-   
-      IF( kt == nit000 )   CALL hpg_ctl      ! initialisation & control of options
-
+      !
       IF( l_trddyn ) THEN                    ! Temporary saving of ua and va trends (l_trddyn)
          ztrdu(:,:,:) = ua(:,:,:)  
          ztrdv(:,:,:) = va(:,:,:) 
       ENDIF      
-
+      !
       SELECT CASE ( nhpg )      ! Hydrastatic pressure gradient computation
       CASE (  0 )   ;   CALL hpg_zco    ( kt )      ! z-coordinate
@@ -96,5 +95,5 @@
       CASE (  6 )   ;   CALL hpg_rot    ( kt )      ! s-coordinate (ROTated axes scheme)
       END SELECT
-
+      !
       IF( l_trddyn ) THEN      ! save the hydrostatic pressure gradient trends for momentum trend diagnostics
          ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
@@ -109,7 +108,7 @@
 
 
-   SUBROUTINE hpg_ctl
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE hpg_ctl  ***
+   SUBROUTINE dyn_hpg_init
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE dyn_hpg_init  ***
       !!
       !! ** Purpose :   initializations for the hydrostatic pressure gradient
@@ -121,16 +120,15 @@
       INTEGER ::   ioptio = 0      ! temporary integer
       !!
-!     NAMELIST/namdyn_hpg/ ln_hpg_zco   , ln_hpg_zps   , ln_hpg_sco, ln_hpg_hel,   &
-!        &                 ln_hpg_wdj   , ln_hpg_djc   , ln_hpg_rot, rn_gamma  ,   &
-!        &                 ln_dynhpg_imp
-      !!----------------------------------------------------------------------
-
-!     REWIND ( numnam )               ! Namelist namdyn_hpg : already read in opa.F90 module
-!     READ   ( numnam, namdyn_hpg )
-
-      IF(lwp) THEN                    ! Control print
+      NAMELIST/namdyn_hpg/ ln_hpg_zco, ln_hpg_zps, ln_hpg_sco, ln_hpg_hel,    &
+         &                 ln_hpg_wdj, ln_hpg_djc, ln_hpg_rot, rn_gamma  , ln_dynhpg_imp
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnam )               ! Read Namelist namdyn_hpg
+      READ  ( numnam, namdyn_hpg )
+      !
+      IF(lwp) THEN                   ! Control print
          WRITE(numout,*)
-         WRITE(numout,*) 'dyn_hpg : hydrostatic pressure gradient'
-         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,*) 'dyn_hpg_init : hydrostatic pressure gradient initialisation'
+         WRITE(numout,*) '~~~~~~~~~~~~'
          WRITE(numout,*) '   Namelist namdyn_hpg : choice of hpg scheme'
          WRITE(numout,*) '      z-coord. - full steps                             ln_hpg_zco    = ', ln_hpg_zco
@@ -144,9 +142,8 @@
          WRITE(numout,*) '      time stepping: centered (F) or semi-implicit (T)  ln_dynhpg_imp = ', ln_dynhpg_imp
       ENDIF
-
-      IF( lk_vvl .AND. .NOT. ln_hpg_sco )   THEN
-         CALL ctl_stop( 'hpg_ctl : variable volume key_vvl compatible only with the standard jacobian formulation hpg_sco')
-      ENDIF
-
+      !
+      IF( lk_vvl .AND. .NOT. ln_hpg_sco )   &
+         &   CALL ctl_stop( 'dyn_hpg_init : variable volume key_vvl require the standard jacobian formulation hpg_sco')
+      !
       !                               ! Set nhpg from ln_hpg_... flags
       IF( ln_hpg_zco )   nhpg = 0
@@ -157,5 +154,5 @@
       IF( ln_hpg_djc )   nhpg = 5
       IF( ln_hpg_rot )   nhpg = 6
-
+      !
       !                               ! Consitency check
       ioptio = 0 
@@ -168,7 +165,6 @@
       IF( ln_hpg_rot )   ioptio = ioptio + 1
       IF ( ioptio /= 1 )   CALL ctl_stop( ' NO or several hydrostatic pressure gradient options used' )
-
-      !
-   END SUBROUTINE hpg_ctl
+      !
+   END SUBROUTINE dyn_hpg_init
 
 
@@ -205,5 +201,5 @@
       
       ! Local constant initialization 
-      zcoef0 = - grav * 0.5
+      zcoef0 = - grav * 0.5_wp
 
       ! Surface value
@@ -268,7 +264,7 @@
 
       ! Local constant initialization
-      zcoef0 = - grav * 0.5
-
-      !  Surface value
+      zcoef0 = - grav * 0.5_wp
+
+      !  Surface value (also valid in partial step case)
       DO jj = 2, jpjm1
          DO ji = fs_2, fs_jpim1   ! vector opt.
@@ -303,5 +299,5 @@
       END DO
 
-      ! partial steps correction at the last level  (new gradient with  intgrd.F)
+      ! partial steps correction at the last level  (use gru & grv computed in zpshde.F90)
 # if defined key_vectopt_loop
          jj = 1
@@ -311,27 +307,19 @@
          DO ji = 2, jpim1
 # endif
-            iku = MIN ( mbathy(ji,jj), mbathy(ji+1,jj) ) - 1
-            ikv = MIN ( mbathy(ji,jj), mbathy(ji,jj+1) ) - 1
+            iku = mbku(ji,jj)
+            ikv = mbkv(ji,jj)
             zcoef2 = zcoef0 * MIN( fse3w(ji,jj,iku), fse3w(ji+1,jj  ,iku) )
             zcoef3 = zcoef0 * MIN( fse3w(ji,jj,ikv), fse3w(ji  ,jj+1,ikv) )
-            ! on i-direction
-            IF ( iku > 2 ) THEN
-               ! subtract old value
-               ua(ji,jj,iku) = ua(ji,jj,iku) - zhpi(ji,jj,iku)
-               ! compute the new one
-               zhpi (ji,jj,iku) = zhpi(ji,jj,iku-1)   &
-                  + zcoef2 * ( rhd(ji+1,jj,iku-1) - rhd(ji,jj,iku-1) + gru(ji,jj) ) / e1u(ji,jj)
-               ! add the new one to the general momentum trend
-               ua(ji,jj,iku) = ua(ji,jj,iku) + zhpi(ji,jj,iku)
+            IF( iku > 1 ) THEN            ! on i-direction (level 2 or more)
+               ua  (ji,jj,iku) = ua(ji,jj,iku) - zhpi(ji,jj,iku)         ! subtract old value
+               zhpi(ji,jj,iku) = zhpi(ji,jj,iku-1)                   &   ! compute the new one
+                  &            + zcoef2 * ( rhd(ji+1,jj,iku-1) - rhd(ji,jj,iku-1) + gru(ji,jj) ) / e1u(ji,jj)
+               ua  (ji,jj,iku) = ua(ji,jj,iku) + zhpi(ji,jj,iku)         ! add the new one to the general momentum trend
             ENDIF
-            ! on j-direction
-            IF ( ikv > 2 ) THEN
-               ! subtract old value
-               va(ji,jj,ikv) = va(ji,jj,ikv) - zhpj(ji,jj,ikv)
-               ! compute the new one
-               zhpj (ji,jj,ikv) = zhpj(ji,jj,ikv-1)   &
-                  + zcoef3 * ( rhd(ji,jj+1,ikv-1) - rhd(ji,jj,ikv-1) + grv(ji,jj) ) / e2v(ji,jj)
-               ! add the new one to the general momentum trend
-               va(ji,jj,ikv) = va(ji,jj,ikv) + zhpj(ji,jj,ikv)
+            IF( ikv > 1 ) THEN            ! on j-direction (level 2 or more)
+               va  (ji,jj,ikv) = va(ji,jj,ikv) - zhpj(ji,jj,ikv)         ! subtract old value
+               zhpj(ji,jj,ikv) = zhpj(ji,jj,ikv-1)                   &   ! compute the new one
+                  &            + zcoef3 * ( rhd(ji,jj+1,ikv-1) - rhd(ji,jj,ikv-1) + grv(ji,jj) ) / e2v(ji,jj)
+               va  (ji,jj,ikv) = va(ji,jj,ikv) + zhpj(ji,jj,ikv)         ! add the new one to the general momentum trend
             ENDIF
 # if ! defined key_vectopt_loop
@@ -377,8 +365,8 @@
 
       ! Local constant initialization
-      zcoef0 = - grav * 0.5
+      zcoef0 = - grav * 0.5_wp
       ! To use density and not density anomaly
-      IF ( lk_vvl ) THEN   ;     znad = 1.            ! Variable volume
-      ELSE                 ;     znad = 0.e0          ! Fixed volume
+      IF ( lk_vvl ) THEN   ;     znad = 1._wp          ! Variable volume
+      ELSE                 ;     znad = 0._wp         ! Fixed volume
       ENDIF
 
@@ -392,7 +380,7 @@
                &                                  - 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*znad )   &
+            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*znad )   &
+            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
@@ -414,7 +402,7 @@
                   &              - 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*znad )   &
+               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*znad )   &
+               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
@@ -463,5 +451,5 @@
 
       ! Local constant initialization
-      zcoef0 = - grav * 0.5
+      zcoef0 = - grav * 0.5_wp
  
       ! Surface value
@@ -495,7 +483,7 @@
                   &                                     -fse3t(ji  ,jj,jk-1) * rhd(ji  ,jj,jk-1) )
                zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) &
-                  &           +  zcoef0 / e2v(ji,jj) * ( fse3t(ji,jj+1,jk  ) * rhd(ji,jj+1,jk)   &
+                  &           +  zcoef0 / e2v(ji,jj) * ( fse3t(ji,jj+1,jk  ) * rhd(ji,jj+1,jk)     &
                   &                                     -fse3t(ji,jj  ,jk  ) * rhd(ji,jj,  jk)   ) &
-                  &           +  zcoef0 / e2v(ji,jj) * ( fse3t(ji,jj+1,jk-1) * rhd(ji,jj+1,jk-1) &
+                  &           +  zcoef0 / e2v(ji,jj) * ( fse3t(ji,jj+1,jk-1) * rhd(ji,jj+1,jk-1)   &
                   &                                     -fse3t(ji,jj  ,jk-1) * rhd(ji,jj,  jk-1) )
                ! s-coordinate pressure gradient correction
@@ -541,7 +529,7 @@
 
       ! Local constant initialization
-      zcoef0 = - grav * 0.5
-      zalph  = 0.5 - rn_gamma    ! weighting coefficients (alpha=0.5-rn_gamma
-      zbeta  = 0.5 + rn_gamma    !                        (beta =1-alpha=0.5+rn_gamma
+      zcoef0 = - grav * 0.5_wp
+      zalph  = 0.5_wp - rn_gamma    ! weighting coefficients (alpha=0.5-rn_gamma
+      zbeta  = 0.5_wp + rn_gamma    !                        (beta =1-alpha=0.5+rn_gamma
 
       ! Surface value (no ponderation)
@@ -626,7 +614,7 @@
 
       ! Local constant initialization
-      zcoef0 = - grav * 0.5
-      z1_10  = 1.0 / 10.0
-      z1_12  = 1.0 / 12.0
+      zcoef0 = - grav * 0.5_wp
+      z1_10  = 1._wp / 10._wp
+      z1_12  = 1._wp / 12._wp
 
       !----------------------------------------------------------------------------------------
@@ -660,48 +648,48 @@
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               cffw = 2.0 * drhoz(ji  ,jj  ,jk) * drhoz(ji,jj,jk-1)
-
-               cffu = 2.0 * drhox(ji+1,jj  ,jk) * drhox(ji,jj,jk  )
-               cffx = 2.0 * dzx  (ji+1,jj  ,jk) * dzx  (ji,jj,jk  )
+               cffw = 2._wp * drhoz(ji  ,jj  ,jk) * drhoz(ji,jj,jk-1)
+
+               cffu = 2._wp * drhox(ji+1,jj  ,jk) * drhox(ji,jj,jk  )
+               cffx = 2._wp * dzx  (ji+1,jj  ,jk) * dzx  (ji,jj,jk  )
   
-               cffv = 2.0 * drhoy(ji  ,jj+1,jk) * drhoy(ji,jj,jk  )
-               cffy = 2.0 * dzy  (ji  ,jj+1,jk) * dzy  (ji,jj,jk  )
+               cffv = 2._wp * drhoy(ji  ,jj+1,jk) * drhoy(ji,jj,jk  )
+               cffy = 2._wp * dzy  (ji  ,jj+1,jk) * dzy  (ji,jj,jk  )
 
                IF( cffw > zep) THEN
-                  drhow(ji,jj,jk) = 2.0 *   drhoz(ji,jj,jk) * drhoz(ji,jj,jk-1)   &
-                     &                  / ( drhoz(ji,jj,jk) + drhoz(ji,jj,jk-1) )
+                  drhow(ji,jj,jk) = 2._wp *   drhoz(ji,jj,jk) * drhoz(ji,jj,jk-1)   &
+                     &                    / ( drhoz(ji,jj,jk) + drhoz(ji,jj,jk-1) )
                ELSE
-                  drhow(ji,jj,jk) = 0.e0
+                  drhow(ji,jj,jk) = 0._wp
                ENDIF
 
-               dzw(ji,jj,jk) = 2.0 *   dzz(ji,jj,jk) * dzz(ji,jj,jk-1)   &
-                  &                / ( dzz(ji,jj,jk) + dzz(ji,jj,jk-1) )
+               dzw(ji,jj,jk) = 2._wp *   dzz(ji,jj,jk) * dzz(ji,jj,jk-1)   &
+                  &                  / ( dzz(ji,jj,jk) + dzz(ji,jj,jk-1) )
 
                IF( cffu > zep ) THEN
-                  drhou(ji,jj,jk) = 2.0 *   drhox(ji+1,jj,jk) * drhox(ji,jj,jk)   &
-                     &                  / ( drhox(ji+1,jj,jk) + drhox(ji,jj,jk) )
+                  drhou(ji,jj,jk) = 2._wp *   drhox(ji+1,jj,jk) * drhox(ji,jj,jk)   &
+                     &                    / ( drhox(ji+1,jj,jk) + drhox(ji,jj,jk) )
                ELSE
-                  drhou(ji,jj,jk ) = 0.e0
+                  drhou(ji,jj,jk ) = 0._wp
                ENDIF
 
                IF( cffx > zep ) THEN
-                  dzu(ji,jj,jk) = 2.0*dzx(ji+1,jj,jk)*dzx(ji,jj,jk)   &
-                     &            /(dzx(ji+1,jj,jk)+dzx(ji,jj,jk))
+                  dzu(ji,jj,jk) = 2._wp *   dzx(ji+1,jj,jk) * dzx(ji,jj,jk)   &
+                     &                  / ( dzx(ji+1,jj,jk) + dzx(ji,jj,jk) )
                ELSE
-                  dzu(ji,jj,jk) = 0.e0
+                  dzu(ji,jj,jk) = 0._wp
                ENDIF
 
                IF( cffv > zep ) THEN
-                  drhov(ji,jj,jk) = 2.0 *   drhoy(ji,jj+1,jk) * drhoy(ji,jj,jk)   &
-                     &                  / ( drhoy(ji,jj+1,jk) + drhoy(ji,jj,jk) )
+                  drhov(ji,jj,jk) = 2._wp *   drhoy(ji,jj+1,jk) * drhoy(ji,jj,jk)   &
+                     &                    / ( drhoy(ji,jj+1,jk) + drhoy(ji,jj,jk) )
                ELSE
-                  drhov(ji,jj,jk) = 0.e0
+                  drhov(ji,jj,jk) = 0._wp
                ENDIF
 
                IF( cffy > zep ) THEN
-                  dzv(ji,jj,jk) = 2.0 *   dzy(ji,jj+1,jk) * dzy(ji,jj,jk)   &
-                     &                / ( dzy(ji,jj+1,jk) + dzy(ji,jj,jk) )
+                  dzv(ji,jj,jk) = 2._wp *   dzy(ji,jj+1,jk) * dzy(ji,jj,jk)   &
+                     &                  / ( dzy(ji,jj+1,jk) + dzy(ji,jj,jk) )
                ELSE
-                  dzv(ji,jj,jk) = 0.e0
+                  dzv(ji,jj,jk) = 0._wp
                ENDIF
 
@@ -713,11 +701,11 @@
       ! apply boundary conditions at top and bottom using 5.36-5.37
       !----------------------------------------------------------------------------------
-      drhow(:,:, 1 ) = 1.5 * ( drhoz(:,:, 2 ) - drhoz(:,:,  1  ) ) - 0.5 * drhow(:,:,  2  )
-      drhou(:,:, 1 ) = 1.5 * ( drhox(:,:, 2 ) - drhox(:,:,  1  ) ) - 0.5 * drhou(:,:,  2  )
-      drhov(:,:, 1 ) = 1.5 * ( drhoy(:,:, 2 ) - drhoy(:,:,  1  ) ) - 0.5 * drhov(:,:,  2  )
-
-      drhow(:,:,jpk) = 1.5 * ( drhoz(:,:,jpk) - drhoz(:,:,jpkm1) ) - 0.5 * drhow(:,:,jpkm1)
-      drhou(:,:,jpk) = 1.5 * ( drhox(:,:,jpk) - drhox(:,:,jpkm1) ) - 0.5 * drhou(:,:,jpkm1)
-      drhov(:,:,jpk) = 1.5 * ( drhoy(:,:,jpk) - drhoy(:,:,jpkm1) ) - 0.5 * drhov(:,:,jpkm1)
+      drhow(:,:, 1 ) = 1.5_wp * ( drhoz(:,:, 2 ) - drhoz(:,:,  1  ) ) - 0.5_wp * drhow(:,:,  2  )
+      drhou(:,:, 1 ) = 1.5_wp * ( drhox(:,:, 2 ) - drhox(:,:,  1  ) ) - 0.5_wp * drhou(:,:,  2  )
+      drhov(:,:, 1 ) = 1.5_wp * ( drhoy(:,:, 2 ) - drhoy(:,:,  1  ) ) - 0.5_wp * drhov(:,:,  2  )
+
+      drhow(:,:,jpk) = 1.5_wp * ( drhoz(:,:,jpk) - drhoz(:,:,jpkm1) ) - 0.5_wp * drhow(:,:,jpkm1)
+      drhou(:,:,jpk) = 1.5_wp * ( drhox(:,:,jpk) - drhox(:,:,jpkm1) ) - 0.5_wp * drhou(:,:,jpkm1)
+      drhov(:,:,jpk) = 1.5_wp * ( drhoy(:,:,jpk) - drhoy(:,:,jpkm1) ) - 0.5_wp * drhov(:,:,jpkm1)
 
 
@@ -731,9 +719,9 @@
       DO jj = 2, jpjm1
          DO ji = fs_2, fs_jpim1   ! vector opt.
-            rho_k(ji,jj,1) = -grav * ( fse3w(ji,jj,1) - fsde3w(ji,jj,1) )            &
-               &                   * (  rhd(ji,jj,1)                                 &
-               &                     + 0.5 * ( rhd(ji,jj,2) - rhd(ji,jj,1) )         &
-               &                           * ( fse3w (ji,jj,1) - fsde3w(ji,jj,1) )   &
-               &                           / ( fsde3w(ji,jj,2) - fsde3w(ji,jj,1) )  ) 
+            rho_k(ji,jj,1) = -grav * ( fse3w(ji,jj,1) - fsde3w(ji,jj,1) )               &
+               &                   * (  rhd(ji,jj,1)                                    &
+               &                     + 0.5_wp * ( rhd(ji,jj,2) - rhd(ji,jj,1) )         &
+               &                              * ( fse3w (ji,jj,1) - fsde3w(ji,jj,1) )   &
+               &                              / ( fsde3w(ji,jj,2) - fsde3w(ji,jj,1) )  ) 
          END DO
       END DO
@@ -847,7 +835,7 @@
       !  Local constant initialization
       ! -------------------------------
-      zcoef0 = - grav * 0.5
-      zforg  = 0.95e0
-      zfrot  = 1.e0 - zforg
+      zcoef0 = - grav * 0.5_wp
+      zforg  = 0.95_wp
+      zfrot  = 1._wp - zforg
 
       ! inverse of the distance between 2 diagonal T-points (defined at F-point) (here zcoef0/distance)
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90	(revision 2528)
@@ -27,7 +27,7 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90	(revision 2528)
@@ -8,6 +8,6 @@
 
    !!----------------------------------------------------------------------
-   !!   dyn_ldf     : update the dynamics trend with the lateral diffusion
-   !!   dyn_ldf_ctl : initialization, namelist read, and parameters control
+   !!   dyn_ldf      : update the dynamics trend with the lateral diffusion
+   !!   dyn_ldf_init : initialization, namelist read, and parameters control
    !!----------------------------------------------------------------------
    USE oce            ! ocean dynamics and tracers
@@ -30,15 +30,16 @@
    PRIVATE
 
-   PUBLIC   dyn_ldf   ! called by step module 
-
-   INTEGER ::   nldf = 0   ! type of lateral diffusion used defined from ln_dynldf_... namlist logicals)
+   PUBLIC   dyn_ldf       ! called by step module 
+   PUBLIC   dyn_ldf_init  ! called by opa  module 
+
+   INTEGER ::   nldf = -2   ! type of lateral diffusion used defined from ln_dynldf_... namlist logicals)
 
    !! * Substitutions
 #  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
-   !!---------------------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -55,6 +56,4 @@
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztrdu, ztrdv   ! 3D workspace
       !!----------------------------------------------------------------------
-
-      IF( kt == nit000 )   CALL dyn_ldf_ctl      ! initialisation & control of options
 
       IF( l_trddyn )   THEN                      ! temporary save of ta and sa trends
@@ -69,4 +68,10 @@
       CASE ( 2 )    ;   CALL dyn_ldf_bilap  ( kt )      ! iso-level bilaplacian
       CASE ( 3 )    ;   CALL dyn_ldf_bilapg ( kt )      ! s-coord. horizontal bilaplacian
+      CASE ( 4 )                                        ! iso-level laplacian + bilaplacian
+         CALL dyn_ldf_lap    ( kt )
+         CALL dyn_ldf_bilap  ( kt )
+      CASE ( 5 )                                        ! rotated laplacian + bilaplacian (s-coord)
+         CALL dyn_ldf_iso    ( kt )
+         CALL dyn_ldf_bilapg ( kt )
       !
       CASE ( -1 )                                       ! esopa: test all possibility with control print
@@ -83,4 +88,11 @@
                         CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf3 - Ua: ', mask1=umask,   &
             &                         tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+      !
+      CASE ( -2 )                                       ! neither laplacian nor bilaplacian schemes used
+         IF( kt == nit000 ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'dyn_ldf : no lateral diffusion on momentum setup'
+            IF(lwp) WRITE(numout,*) '~~~~~~~ '
+         ENDIF
       END SELECT
 
@@ -97,7 +109,7 @@
 
 
-   SUBROUTINE dyn_ldf_ctl
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE dyn_ldf_ctl  ***
+   SUBROUTINE dyn_ldf_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_ldf_init  ***
       !! 
       !! ** Purpose :   initializations of the horizontal ocean dynamics physics
@@ -110,5 +122,5 @@
       IF(lwp) THEN                        ! Namelist print
          WRITE(numout,*)
-         WRITE(numout,*) 'dyn_ldf_ctl : Choice of the lateral diffusive operator on dynamics'
+         WRITE(numout,*) 'dyn_ldf_init : Choice of the lateral diffusive operator on dynamics'
          WRITE(numout,*) '~~~~~~~~~~~'
          WRITE(numout,*) '       Namelist nam_dynldf : set lateral mixing parameters (type, direction, coefficients)'
@@ -124,5 +136,5 @@
       IF( ln_dynldf_lap   )   ioptio = ioptio + 1
       IF( ln_dynldf_bilap )   ioptio = ioptio + 1
-      IF( ioptio /= 1 ) CALL ctl_stop( '          use ONE of the 2 lap/bilap operator type on dynamics' )
+      IF( ioptio <  1 ) CALL ctl_warn( '          neither laplacian nor bilaplacian operator set for dynamics' )
       ioptio = 0
       IF( ln_dynldf_level )   ioptio = ioptio + 1
@@ -144,5 +156,5 @@
             IF ( ln_dynldf_iso   )   nldf = 1      ! isoneutral (   rotation)
          ENDIF
-         IF ( ln_sco ) THEN             ! z-coordinate
+         IF ( ln_sco ) THEN             ! s-coordinate
             IF ( ln_dynldf_level )   nldf = 0      ! iso-level  (no rotation)
             IF ( ln_dynldf_hor   )   nldf = 1      ! horizontal (   rotation)
@@ -162,5 +174,5 @@
             IF ( ln_dynldf_iso   )   ierr = 2      ! isoneutral (   rotation)
          ENDIF
-         IF ( ln_sco ) THEN             ! z-coordinate
+         IF ( ln_sco ) THEN             ! s-coordinate
             IF ( ln_dynldf_level )   nldf = 2      ! iso-level  (no rotation)
             IF ( ln_dynldf_hor   )   nldf = 3      ! horizontal (   rotation)
@@ -169,4 +181,22 @@
       ENDIF
       
+      IF( ln_dynldf_lap .AND. ln_dynldf_bilap ) THEN  ! mixed laplacian and bilaplacian operators
+         IF ( ln_zco ) THEN                ! z-coordinate
+            IF ( ln_dynldf_level )   nldf = 4      ! iso-level  (no rotation)
+            IF ( ln_dynldf_hor   )   nldf = 4      ! horizontal (no rotation)
+            IF ( ln_dynldf_iso   )   ierr = 2      ! isoneutral (   rotation)
+         ENDIF
+         IF ( ln_zps ) THEN             ! z-coordinate
+            IF ( ln_dynldf_level )   ierr = 1      ! iso-level not allowed 
+            IF ( ln_dynldf_hor   )   nldf = 4      ! horizontal (no rotation)
+            IF ( ln_dynldf_iso   )   ierr = 2      ! isoneutral (   rotation)
+         ENDIF
+         IF ( ln_sco ) THEN             ! s-coordinate
+            IF ( ln_dynldf_level )   nldf = 4      ! iso-level  (no rotation)
+            IF ( ln_dynldf_hor   )   nldf = 5      ! horizontal (   rotation)
+            IF ( ln_dynldf_iso   )   ierr = 2      ! isoneutral (   rotation)
+         ENDIF
+      ENDIF
+
       IF( lk_esopa )                 nldf = -1     ! esopa test
 
@@ -179,12 +209,15 @@
       IF(lwp) THEN
          WRITE(numout,*)
+         IF( nldf == -2 )   WRITE(numout,*) '              neither laplacian nor bilaplacian schemes used'
          IF( nldf == -1 )   WRITE(numout,*) '              ESOPA test All scheme used'
          IF( nldf ==  0 )   WRITE(numout,*) '              laplacian operator'
-         IF( nldf ==  1 )   WRITE(numout,*) '              Rotated laplacian operator'
+         IF( nldf ==  1 )   WRITE(numout,*) '              rotated laplacian operator'
          IF( nldf ==  2 )   WRITE(numout,*) '              bilaplacian operator'
-         IF( nldf ==  3 )   WRITE(numout,*) '              Rotated bilaplacian'
-      ENDIF
-      !
-   END SUBROUTINE dyn_ldf_ctl
+         IF( nldf ==  3 )   WRITE(numout,*) '              rotated bilaplacian'
+         IF( nldf ==  4 )   WRITE(numout,*) '              laplacian and bilaplacian operators'
+         IF( nldf ==  5 )   WRITE(numout,*) '              rotated laplacian and bilaplacian operators'
+      ENDIF
+      !
+   END SUBROUTINE dyn_ldf_init
 
    !!======================================================================
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilap.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilap.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilap.F90	(revision 2528)
@@ -29,7 +29,7 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -162,9 +162,5 @@
                zuf(ji,jj,jk) = fmask(ji,jj,jk) * (  zcv(ji+1,jj  ) - zcv(ji,jj)      &
                   &                            - zcu(ji  ,jj+1) + zcu(ji,jj)  )   &
-#if defined key_zco
-                  &                         / ( e1f(ji,jj)*e2f(ji,jj) )
-#else
                   &       * fse3f(ji,jj,jk) / ( e1f(ji,jj)*e2f(ji,jj) )
-#endif
             END DO  
          END DO  
@@ -173,11 +169,6 @@
          DO jj = 1, jpjm1
             DO ji = 1, fs_jpim1   ! vector opt.
-#if defined key_zco
-               zlu(ji,jj,jk) = e2u(ji,jj) * zlu(ji,jj,jk)
-               zlv(ji,jj,jk) = e1v(ji,jj) * zlv(ji,jj,jk)
-#else
                zlu(ji,jj,jk) = e2u(ji,jj) * fse3u(ji,jj,jk) * zlu(ji,jj,jk)
                zlv(ji,jj,jk) = e1v(ji,jj) * fse3v(ji,jj,jk) * zlv(ji,jj,jk)
-#endif
             END DO
          END DO
@@ -186,9 +177,5 @@
          DO jj = 2, jpj
             DO ji = fs_2, jpi   ! vector opt.
-#if defined key_zco
-               zbt = e1t(ji,jj) * e2t(ji,jj)
-#else
                zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
-#endif
                zut(ji,jj,jk) = (  zlu(ji,jj,jk) - zlu(ji-1,jj  ,jk)   &
                   &             + zlv(ji,jj,jk) - zlv(ji  ,jj-1,jk) ) / zbt
@@ -210,11 +197,6 @@
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
-#if defined key_zco
-               ze2u = e2u(ji,jj)
-               ze2v = e1v(ji,jj)
-#else
                ze2u = e2u(ji,jj) * fse3u(ji,jj,jk)
                ze2v = e1v(ji,jj) * fse3v(ji,jj,jk)
-#endif
                ! horizontal biharmonic diffusive trends
                zua = - ( zuf(ji  ,jj,jk) - zuf(ji,jj-1,jk) ) / ze2u   &
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90	(revision 2528)
@@ -34,7 +34,7 @@
 #  include "ldfdyn_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90	(revision 2528)
@@ -36,7 +36,7 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap.F90	(revision 2528)
@@ -30,7 +30,7 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -50,5 +50,4 @@
       !!         difu = 1/e1u di[ahmt hdivb] - 1/(e2u*e3u) dj-1[e3f ahmf rotb]
       !!         difv = 1/e2v dj[ahmt hdivb] + 1/(e1v*e3v) di-1[e3f ahmf rotb]
-      !!      If lk_zco=T, e3f=e3u=e3v, the vertical scale factor are simplified
       !!      in the rotational part of the diffusion.
       !!      Add this before trend to the general trend (ua,va):
@@ -78,5 +77,5 @@
       IF( kt == nit000 ) THEN
          IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'dyn_ldf : iso-level harmonic (laplacien) operator'
+         IF(lwp) WRITE(numout,*) 'dyn_ldf : iso-level harmonic (laplacian) operator'
          IF(lwp) WRITE(numout,*) '~~~~~~~ '
       ENDIF
@@ -87,14 +86,4 @@
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
-#if defined key_zco
-               ! horizontal diffusive trends
-               ze2u = rotb (ji,jj,jk)*fsahmf(ji,jj,jk)
-               ze1v = hdivb(ji,jj,jk)*fsahmt(ji,jj,jk)
-               zua = - ( ze2u - rotb (ji,jj-1,jk)*fsahmf(ji,jj-1,jk)                   ) / e2u(ji,jj)   &
-                     + ( hdivb(ji+1,jj,jk)*fsahmt(ji+1,jj,jk) - ze1v                   ) / e1u(ji,jj)
-
-               zva = + ( ze2u - rotb (ji-1,jj,jk)*fsahmf(ji-1,jj,jk)                   ) / e1v(ji,jj)   &
-                     + ( hdivb(ji,jj+1,jk)*fsahmt(ji,jj+1,jk) - ze1v                   ) / e2v(ji,jj)
-#else
                ze2u = rotb (ji,jj,jk)*fsahmf(ji,jj,jk)*fse3f(ji,jj,jk)
                ze1v = hdivb(ji,jj,jk)*fsahmt(ji,jj,jk)
@@ -105,5 +94,4 @@
                zva = + ( ze2u - rotb (ji-1,jj,jk)*fsahmf(ji-1,jj,jk)*fse3f(ji-1,jj,jk) ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )   &
                      + ( hdivb(ji,jj+1,jk)*fsahmt(ji,jj+1,jk) - ze1v                   ) / e2v(ji,jj)
-#endif
 
                ! add it to the general momentum trends
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90	(revision 2528)
@@ -15,4 +15,5 @@
    !!            2.3  !  2007-07  (D. Storkey) Calls to BDY routines. 
    !!            3.2  !  2009-06  (G. Madec, R.Benshila)  re-introduce the vvl option
+   !!            3.3  !  2010-09  (D. Storkey, E.O'Dea) Bug fix for BDY module
    !!-------------------------------------------------------------------------
   
@@ -22,4 +23,6 @@
    USE oce             ! ocean dynamics and tracers
    USE dom_oce         ! ocean space and time domain
+   USE sbc_oce         ! Surface boundary condition: ocean fields
+   USE phycst          ! physical constants
    USE dynspg_oce      ! type of surface pressure gradient
    USE dynadv          ! dynamics: vector invariant versus flux form
@@ -32,8 +35,10 @@
    USE bdydta          ! unstructured open boundary conditions
    USE bdydyn          ! unstructured open boundary conditions
-   USE agrif_opa_interp
    USE in_out_manager  ! I/O manager
    USE lbclnk          ! lateral boundary condition (or mpp link)
    USE prtctl          ! Print control
+#if defined key_agrif
+   USE agrif_opa_interp
+#endif
 
    IMPLICIT NONE
@@ -45,7 +50,7 @@
 #  include "domzgr_substitute.h90"
    !!-------------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software is governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!-------------------------------------------------------------------------
 
@@ -86,4 +91,6 @@
       !!               un,vn   now horizontal velocity of next time-step
       !!----------------------------------------------------------------------
+      USE oce, ONLY :   ze3u_f => ta   ! use ta as 3D workspace
+      USE oce, ONLY :   ze3v_f => sa   ! use sa as 3D workspace
       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
       !!
@@ -94,7 +101,9 @@
       REAL(wp) ::   zue3a , zue3n , zue3b    ! temporary scalar
       REAL(wp) ::   zve3a , zve3n , zve3b    !    -         -
-      REAL(wp) ::   ze3u_b, ze3u_n, ze3u_a   !    -         -
-      REAL(wp) ::   ze3v_b, ze3v_n, ze3v_a   !    -         - 
       REAL(wp) ::   zuf   , zvf              !    -         - 
+      REAL(wp) ::   zec                      !    -         - 
+      REAL(wp) ::   zv_t_ij  , zv_t_ip1j     !     -        -
+      REAL(wp) ::   zv_t_ijp1                !     -        -
+      REAL(wp), DIMENSION(jpi,jpj) ::  zs_t, zs_u_1, zs_v_1      ! temporary 2D workspace
       !!----------------------------------------------------------------------
 
@@ -145,5 +154,5 @@
 # if defined key_obc
       !                                !* OBC open boundaries
-      IF( lk_obc )   CALL obc_dyn( kt )
+      CALL obc_dyn( kt )
       !
       IF ( lk_dynspg_exp .OR. lk_dynspg_ts ) THEN
@@ -164,35 +173,6 @@
 # elif defined key_bdy 
       !                                !* BDY open boundaries
-      !RB all this part should be in a specific routine
       IF( lk_dynspg_exp .OR. lk_dynspg_ts ) THEN       ! except for filtered option
-         !
          CALL bdy_dyn_frs( kt )
-         !
-         IF( ln_bdy_dyn_fla ) THEN
-            ua_e(:,:) = 0.e0
-            va_e(:,:) = 0.e0
-            ! Set these variables for use in bdy_dyn_fla
-            hur_e(:,:) = hur(:,:)
-            hvr_e(:,:) = hvr(:,:)
-            DO jk = 1, jpkm1   !! Vertically integrated momentum trends
-               ua_e(:,:) = ua_e(:,:) + fse3u(:,:,jk) * umask(:,:,jk) * ua(:,:,jk)
-               va_e(:,:) = va_e(:,:) + fse3v(:,:,jk) * vmask(:,:,jk) * va(:,:,jk)
-            END DO
-            ua_e(:,:) = ua_e(:,:) * hur(:,:)
-            va_e(:,:) = va_e(:,:) * hvr(:,:)
-            DO jk = 1 , jpkm1
-               ua(:,:,jk) = ua(:,:,jk) - ua_e(:,:)
-               va(:,:,jk) = va(:,:,jk) - va_e(:,:)
-            END DO
-            CALL bdy_dta_bt( kt+1, 0)
-            CALL bdy_dyn_fla( sshn_b )
-            CALL lbc_lnk( ua_e, 'U', -1. )   ! Boundary points should be updated
-            CALL lbc_lnk( va_e, 'V', -1. )   !
-            DO jk = 1 , jpkm1
-               ua(:,:,jk) = ( ua(:,:,jk) + ua_e(:,:) ) * umask(:,:,jk)
-               va(:,:,jk) = ( va(:,:,jk) + va_e(:,:) ) * vmask(:,:,jk)
-            END DO
-         ENDIF
-         !
       ENDIF
 # endif
@@ -211,10 +191,12 @@
          END DO
       ELSE                                             !* Leap-Frog : Asselin filter and swap
-         IF( ln_dynadv_vec .OR. .NOT. lk_vvl ) THEN          ! applied on velocity
+         !                                ! =============!
+         IF( .NOT. lk_vvl ) THEN          ! Fixed volume !
+            !                             ! =============!
             DO jk = 1, jpkm1                              
                DO jj = 1, jpj
                   DO ji = 1, jpi    
-                     zuf = atfp * ( ub(ji,jj,jk) + ua(ji,jj,jk) ) + atfp1 * un(ji,jj,jk)
-                     zvf = atfp * ( vb(ji,jj,jk) + va(ji,jj,jk) ) + atfp1 * vn(ji,jj,jk)
+                     zuf = un(ji,jj,jk) + atfp * ( ub(ji,jj,jk) - 2.e0 * un(ji,jj,jk) + ua(ji,jj,jk) )
+                     zvf = vn(ji,jj,jk) + atfp * ( vb(ji,jj,jk) - 2.e0 * vn(ji,jj,jk) + va(ji,jj,jk) )
                      !
                      ub(ji,jj,jk) = zuf                      ! ub <-- filtered velocity
@@ -225,35 +207,110 @@
                END DO
             END DO
-         ELSE                                                ! applied on thickness weighted velocity
+            !                             ! ================!
+         ELSE                             ! Variable volume !
+            !                             ! ================!
+            ! Before scale factor at t-points
+            ! -------------------------------
             DO jk = 1, jpkm1
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     ze3u_a = fse3u_a(ji,jj,jk)
-                     ze3v_a = fse3v_a(ji,jj,jk)
-                     ze3u_n = fse3u_n(ji,jj,jk)
-                     ze3v_n = fse3v_n(ji,jj,jk)
-                     ze3u_b = fse3u_b(ji,jj,jk)
-                     ze3v_b = fse3v_b(ji,jj,jk)
-                     !
-                     zue3a = ua(ji,jj,jk) * ze3u_a
-                     zve3a = va(ji,jj,jk) * ze3v_a
-                     zue3n = un(ji,jj,jk) * ze3u_n
-                     zve3n = vn(ji,jj,jk) * ze3v_n
-                     zue3b = ub(ji,jj,jk) * ze3u_b
-                     zve3b = vb(ji,jj,jk) * ze3v_b
-                     !
-                     zuf  = ( atfp  * ( zue3b  + zue3a  ) + atfp1 * zue3n  )   &
-                        & / ( atfp  * ( ze3u_b + ze3u_a ) + atfp1 * ze3u_n ) * umask(ji,jj,jk)
-                     zvf  = ( atfp  * ( zve3b  + zve3a  ) + atfp1 * zve3n  )   &
-                        & / ( atfp  * ( ze3v_b + ze3v_a ) + atfp1 * ze3v_n ) * vmask(ji,jj,jk)
-                     !
-                     ub(ji,jj,jk) = zuf                      ! ub <-- filtered velocity
-                     vb(ji,jj,jk) = zvf
-                     un(ji,jj,jk) = ua(ji,jj,jk)             ! un <-- ua
-                     vn(ji,jj,jk) = va(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
+               fse3t_b(:,:,jk) = fse3t_n(:,:,jk)                                   &
+                  &              + atfp * (  fse3t_b(:,:,jk) + fse3t_a(:,:,jk)     &
+                  &                         - 2.e0 * fse3t_n(:,:,jk)            )
+            ENDDO
+            ! Add volume filter correction only at the first level of t-point scale factors
+            zec = atfp * rdt / rau0
+            fse3t_b(:,:,1) = fse3t_b(:,:,1) - zec * ( emp_b(:,:) - emp(:,:) ) * tmask(:,:,1)
+            ! surface at t-points and inverse surface at (u/v)-points used in surface averaging computations
+            zs_t  (:,:) =       e1t(:,:) * e2t(:,:)
+            zs_u_1(:,:) = 0.5 / e1u(:,:) * e2u(:,:)
+            zs_v_1(:,:) = 0.5 / e1v(:,:) * e2v(:,:)
+            !
+            IF( ln_dynadv_vec ) THEN
+               ! Before scale factor at (u/v)-points
+               ! -----------------------------------
+               ! Scale factor anomaly at (u/v)-points: surface averaging of scale factor at t-points
+               DO jk = 1, jpkm1
+                  DO jj = 1, jpjm1
+                     DO ji = 1, jpim1
+                        zv_t_ij           = zs_t(ji  ,jj  ) * fse3t_b(ji  ,jj  ,jk)
+                        zv_t_ip1j         = zs_t(ji+1,jj  ) * fse3t_b(ji+1,jj  ,jk)
+                        zv_t_ijp1         = zs_t(ji  ,jj+1) * fse3t_b(ji  ,jj+1,jk)
+                        fse3u_b(ji,jj,jk) = umask(ji,jj,jk) * ( zs_u_1(ji,jj) * ( zv_t_ij + zv_t_ip1j ) - fse3u_0(ji,jj,jk) )
+                        fse3v_b(ji,jj,jk) = vmask(ji,jj,jk) * ( zs_v_1(ji,jj) * ( zv_t_ij + zv_t_ijp1 ) - fse3v_0(ji,jj,jk) )
+                     END DO
+                  END DO
+               END DO
+               ! lateral boundary conditions
+               CALL lbc_lnk( fse3u_b(:,:,:), 'U', 1. )
+               CALL lbc_lnk( fse3v_b(:,:,:), 'V', 1. )
+               ! Add initial scale factor to scale factor anomaly
+               fse3u_b(:,:,:) = fse3u_b(:,:,:) + fse3u_0(:,:,:)
+               fse3v_b(:,:,:) = fse3v_b(:,:,:) + fse3v_0(:,:,:)
+               ! Leap-Frog - Asselin filter and swap: applied on velocity
+               ! -----------------------------------
+               DO jk = 1, jpkm1
+                  DO jj = 1, jpj
+                     DO ji = 1, jpi
+                        zuf = un(ji,jj,jk) + atfp * ( ub(ji,jj,jk) - 2.e0 * un(ji,jj,jk) + ua(ji,jj,jk) )
+                        zvf = vn(ji,jj,jk) + atfp * ( vb(ji,jj,jk) - 2.e0 * vn(ji,jj,jk) + va(ji,jj,jk) )
+                        !
+                        ub(ji,jj,jk) = zuf                      ! ub <-- filtered velocity
+                        vb(ji,jj,jk) = zvf
+                        un(ji,jj,jk) = ua(ji,jj,jk)             ! un <-- ua
+                        vn(ji,jj,jk) = va(ji,jj,jk)
+                     END DO
+                  END DO
+               END DO
+               !
+            ELSE
+               ! Temporary filered scale factor at (u/v)-points (will become before scale factor)
+               !-----------------------------------------------
+               ! Scale factor anomaly at (u/v)-points: surface averaging of scale factor at t-points
+               DO jk = 1, jpkm1
+                  DO jj = 1, jpjm1
+                     DO ji = 1, jpim1
+                        zv_t_ij          = zs_t(ji  ,jj  ) * fse3t_b(ji  ,jj  ,jk)
+                        zv_t_ip1j        = zs_t(ji+1,jj  ) * fse3t_b(ji+1,jj  ,jk)
+                        zv_t_ijp1        = zs_t(ji  ,jj+1) * fse3t_b(ji  ,jj+1,jk)
+                        ze3u_f(ji,jj,jk) = umask(ji,jj,jk) * ( zs_u_1(ji,jj) * ( zv_t_ij + zv_t_ip1j ) - fse3u_0(ji,jj,jk) )
+                        ze3v_f(ji,jj,jk) = vmask(ji,jj,jk) * ( zs_v_1(ji,jj) * ( zv_t_ij + zv_t_ijp1 ) - fse3v_0(ji,jj,jk) )
+                     END DO
+                  END DO
+               END DO
+               ! lateral boundary conditions
+               CALL lbc_lnk( ze3u_f, 'U', 1. )
+               CALL lbc_lnk( ze3v_f, 'V', 1. )
+               ! Add initial scale factor to scale factor anomaly
+               ze3u_f(:,:,:) = ze3u_f(:,:,:) + fse3u_0(:,:,:)
+               ze3v_f(:,:,:) = ze3v_f(:,:,:) + fse3v_0(:,:,:)
+               ! Leap-Frog - Asselin filter and swap: applied on thickness weighted velocity
+               ! -----------------------------------             ===========================
+               DO jk = 1, jpkm1
+                  DO jj = 1, jpj
+                     DO ji = 1, jpim1
+                        zue3a = ua(ji,jj,jk) * fse3u_a(ji,jj,jk)
+                        zve3a = va(ji,jj,jk) * fse3v_a(ji,jj,jk)
+                        zue3n = un(ji,jj,jk) * fse3u_n(ji,jj,jk)
+                        zve3n = vn(ji,jj,jk) * fse3v_n(ji,jj,jk)
+                        zue3b = ub(ji,jj,jk) * fse3u_b(ji,jj,jk)
+                        zve3b = vb(ji,jj,jk) * fse3v_b(ji,jj,jk)
+                        !
+                        zuf  = ( zue3n + atfp * ( zue3b - 2.e0 * zue3n  + zue3a ) ) / ze3u_f(ji,jj,jk)
+                        zvf  = ( zve3n + atfp * ( zve3b - 2.e0 * zve3n  + zve3a ) ) / ze3v_f(ji,jj,jk)
+                        !
+                        ub(ji,jj,jk) = zuf                      ! ub <-- filtered velocity
+                        vb(ji,jj,jk) = zvf
+                        un(ji,jj,jk) = ua(ji,jj,jk)             ! un <-- ua
+                        vn(ji,jj,jk) = va(ji,jj,jk)
+                     END DO
+                  END DO
+               END DO
+               fse3u_b(:,:,:) = ze3u_f(:,:,:)                   ! e3u_b <-- filtered scale factor
+               fse3v_b(:,:,:) = ze3v_f(:,:,:)
+               CALL lbc_lnk( ub, 'U', -1. )                     ! lateral boundary conditions
+               CALL lbc_lnk( vb, 'V', -1. )
+            ENDIF
+            !
          ENDIF
+         !
       ENDIF
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90	(revision 2528)
@@ -15,17 +15,22 @@
    USE dom_oce        ! ocean space and time domain variables
    USE obc_oce        ! ocean open boundary conditions
+   USE sbc_oce        ! surface boundary condition: ocean
+   USE sbcapr         ! surface boundary condition: atmospheric pressure
    USE dynspg_oce     ! surface pressure gradient variables
    USE dynspg_exp     ! surface pressure gradient     (dyn_spg_exp routine)
    USE dynspg_ts      ! surface pressure gradient     (dyn_spg_ts  routine)
    USE dynspg_flt     ! surface pressure gradient     (dyn_spg_flt routine)
+   USE dynadv         ! dynamics: vector invariant versus flux form
    USE trdmod         ! ocean dynamics trends
    USE trdmod_oce     ! ocean variables trends
    USE prtctl         ! Print control                     (prt_ctl routine)
    USE in_out_manager ! I/O manager
+   USE phycst         ! physical constants
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   dyn_spg   ! routine called by step module
+   PUBLIC   dyn_spg        ! routine called by step module
+   PUBLIC   dyn_spg_init   ! routine called by opa module
 
    INTEGER ::   nspg = 0   ! type of surface pressure gradient scheme defined from lk_dynspg_... 
@@ -37,5 +42,5 @@
    !! NEMO/OPA 3.2 , LODYC-IPSL  (2009)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -47,5 +52,6 @@
       !!
       !! ** Purpose :   achieve the momentum time stepping by computing the
-      !!              last trend, the surface pressure gradient, and performing
+      !!              last trend, the surface pressure gradient including the 
+      !!              atmospheric pressure forcing (ln_apr_dyn=T), and performing
       !!              the Leap-Frog integration.
       !!gm              In the current version only the filtered solution provide
@@ -57,4 +63,11 @@
       !!              - split-explicit computation: a time splitting technique is used
       !!
+      !!              ln_apr_dyn=T : the atmospheric pressure forcing is applied 
+      !!             as the gradient of the inverse barometer ssh:
+      !!                apgu = - 1/rau0 di[apr] = 0.5*grav di[ssh_ib+ssh_ibb]
+      !!                apgv = - 1/rau0 dj[apr] = 0.5*grav dj[ssh_ib+ssh_ibb]
+      !!             Note that as all external forcing a time averaging over a two rdt
+      !!             period is used to prevent the divergence of odd and even time step.
+      !!
       !! N.B. : When key_esopa is used all the scheme are tested, regardless 
       !!        of the physical meaning of the results. 
@@ -63,5 +76,6 @@
       INTEGER, INTENT(  out) ::   kindic   ! solver flag
       !!
-      REAL(wp) ::   z2dt   ! temporary scalar
+      INTEGER  ::   ji, jj, jk                             ! dummy loop indices
+      REAL(wp) ::   z2dt, zg_2                             ! temporary scalar
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztrdu, ztrdv   ! 3D workspace
       !!----------------------------------------------------------------------
@@ -74,10 +88,29 @@
 
 
-      IF( kt == nit000 )   CALL dyn_spg_ctl      ! initialisation & control of options
-
       IF( l_trddyn )   THEN                      ! temporary save of ta and sa trends
          ztrdu(:,:,:) = ua(:,:,:)
          ztrdv(:,:,:) = va(:,:,:)
       ENDIF
+
+      IF( ln_apr_dyn ) THEN                   !==  Atmospheric pressure gradient  ==!
+         zg_2 = grav * 0.5
+         DO jj = 2, jpjm1                          ! gradient of Patm using inverse barometer ssh
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               spgu(ji,jj) =  zg_2 * (  ssh_ib (ji+1,jj) - ssh_ib (ji,jj)    &
+                  &                   + ssh_ibb(ji+1,jj) - ssh_ibb(ji,jj)  ) /e1u(ji,jj)
+               spgv(ji,jj) =  zg_2 * (  ssh_ib (ji,jj+1) - ssh_ib (ji,jj)    &
+                  &                   + ssh_ibb(ji,jj+1) - ssh_ib (ji,jj)  ) /e2v(ji,jj)
+            END DO
+         END DO
+         DO jk = 1, jpkm1                          ! Add the apg to the general trend
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ua(ji,jj,jk) = ua(ji,jj,jk) + spgu(ji,jj)
+                  va(ji,jj,jk) = va(ji,jj,jk) + spgv(ji,jj)
+               END DO
+            END DO
+         END DO
+      ENDIF
+
 
       SELECT CASE ( nspg )                       ! compute surf. pressure gradient trend and add it to the general trend
@@ -119,7 +152,7 @@
 
 
-   SUBROUTINE dyn_spg_ctl
+   SUBROUTINE dyn_spg_init
       !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE dyn_spg_ctl  ***
+      !!                  ***  ROUTINE dyn_spg_init  ***
       !!                
       !! ** Purpose :   Control the consistency between cpp options for 
@@ -131,5 +164,5 @@
       IF(lwp) THEN             ! Control print
          WRITE(numout,*)
-         WRITE(numout,*) 'dyn_spg_ctl : choice of the surface pressure gradient scheme'
+         WRITE(numout,*) 'dyn_spg_init : choice of the surface pressure gradient scheme'
          WRITE(numout,*) '~~~~~~~~~~~'
          WRITE(numout,*) '     Explicit free surface                  lk_dynspg_exp = ', lk_dynspg_exp
@@ -164,6 +197,10 @@
       !                        ! Control of timestep choice
       IF( lk_dynspg_ts .OR. lk_dynspg_exp ) THEN
-         IF( n_cla == 1 )   &
-           &   CALL ctl_stop( ' Crossland advection not implemented for this free surface formulation ' )
+         IF( nn_cla == 1 )   CALL ctl_stop( 'Crossland advection not implemented for this free surface formulation' )
+      ENDIF
+
+      !                        ! Control of momentum formulation
+      IF( lk_dynspg_ts .AND. lk_vvl ) THEN
+         IF( .NOT.ln_dynadv_vec )   CALL ctl_stop( 'Flux form not implemented for this free surface formulation' )
       ENDIF
 
@@ -178,5 +215,5 @@
 #endif
       !
-   END SUBROUTINE dyn_spg_ctl
+   END SUBROUTINE dyn_spg_init
 
   !!======================================================================
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90	(revision 2528)
@@ -38,7 +38,7 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90	(revision 2528)
@@ -39,12 +39,15 @@
    USE bdydyn          ! Unstructured open boundaries condition (bdy_dyn routine) 
    USE bdyvol          ! Unstructured open boundaries condition (bdy_vol routine)
-   USE cla_dynspg      ! cross land advection
+   USE cla             ! cross land advection
    USE in_out_manager  ! I/O manager
    USE lib_mpp         ! distributed memory computing library
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
    USE prtctl          ! Print control
-   USE agrif_opa_interp
    USE iom
    USE restart         ! only for lrst_oce
+   USE lib_fortran
+#if defined key_agrif
+   USE agrif_opa_interp
+#endif
 
    IMPLICIT NONE
@@ -58,7 +61,7 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -85,7 +88,7 @@
       !!         where (spgu,spgv) are given by:
       !!            spgu = vertical sum[ e3u (ub+ 2 rdt ua ) ]
-      !!                 - grav 2 rdt hu /e1u di[sshn + emp]
+      !!                 - grav 2 rdt hu /e1u di[sshn + (emp-rnf)]
       !!            spgv = vertical sum[ e3v (vb+ 2 rdt va) ]
-      !!                 - grav 2 rdt hv /e2v dj[sshn + emp]
+      !!                 - grav 2 rdt hv /e2v dj[sshn + (emp-rnf)]
       !!         and define the first guess from previous computation :
       !!            zbtd = btda
@@ -186,22 +189,15 @@
 
 #if defined key_obc
-      IF( lk_obc )   CALL obc_dyn( kt )   ! Update velocities on each open boundary with the radiation algorithm
-      IF( lk_obc )   CALL obc_vol( kt )   ! Correction of the barotropic componant velocity to control the volume of the system
+      CALL obc_dyn( kt )      ! Update velocities on each open boundary with the radiation algorithm
+      CALL obc_vol( kt )      ! Correction of the barotropic componant velocity to control the volume of the system
 #endif
 #if defined key_bdy
-      ! Update velocities on unstructured boundary using the Flow Relaxation Scheme
-      CALL bdy_dyn_frs( kt )
-
-      IF (ln_bdy_vol) THEN
-      ! Correction of the barotropic component velocity to control the volume of the system
-        CALL bdy_vol( kt )
-      ENDIF
+      CALL bdy_dyn_frs( kt )       ! Update velocities on unstructured boundary using the Flow Relaxation Scheme
+      CALL bdy_vol( kt )           ! Correction of the barotropic component velocity to control the volume of the system
 #endif
 #if defined key_agrif
       CALL Agrif_dyn( kt )    ! Update velocities on each coarse/fine interfaces 
 #endif
-#if defined key_orca_r2
-      IF( n_cla == 1 )   CALL dyn_spg_cla( kt )      ! Cross Land Advection (update (ua,va))
-#endif
+      IF( nn_cla == 1 )   CALL cla_dynspg( kt )      ! Cross Land Advection (update (ua,va))
 
       ! compute the next vertically averaged velocity (effect of the additional force not included)
@@ -281,6 +277,5 @@
       ! ------------------
       rnorme =0.e0
-      rnorme = SUM( gcb(1:jpi,1:jpj) * gcdmat(1:jpi,1:jpj) * gcb(1:jpi,1:jpj) * bmask(:,:) )
-      IF( lk_mpp )   CALL mpp_sum( rnorme )   ! sum over the global domain
+      rnorme = GLOB_SUM( gcb(1:jpi,1:jpj) * gcdmat(1:jpi,1:jpj) * gcb(1:jpi,1:jpj) * bmask(:,:) )
 
       epsr = eps * eps * rnorme
@@ -315,11 +310,6 @@
 #if defined key_obc
             ! caution : grad D = 0 along open boundaries
-            IF( Agrif_Root() ) THEN
-               spgu(ji,jj) = z2dt * ztdgu * obcumask(ji,jj)
-               spgv(ji,jj) = z2dt * ztdgv * obcvmask(ji,jj)
-            ELSE
-               spgu(ji,jj) = z2dt * ztdgu
-               spgv(ji,jj) = z2dt * ztdgv
-            ENDIF
+            spgu(ji,jj) = z2dt * ztdgu * obcumask(ji,jj)
+            spgv(ji,jj) = z2dt * ztdgv * obcvmask(ji,jj)
 #elif defined key_bdy
             ! caution : grad D = 0 along open boundaries
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_oce.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_oce.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_oce.F90	(revision 2528)
@@ -44,5 +44,5 @@
    !! NEMO/OPA 3.2 , LODYC-IPSL  (2009)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!======================================================================
 END MODULE dynspg_oce
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90	(revision 2528)
@@ -7,4 +7,5 @@
    !!              -   ! 2008-01  (R. Benshila)  change averaging method
    !!             3.2  ! 2009-07  (R. Benshila, G. Madec) Complete revisit associated to vvl reactivation
+   !!             3.3  ! 2010-09  (D. Storkey, E. O'Dea) update for BDY for Shelf configurations
   !!---------------------------------------------------------------------
 #if defined key_dynspg_ts   ||   defined key_esopa
@@ -50,5 +51,7 @@
    REAL(wp), DIMENSION(jpi,jpj) ::  ftsw, ftse   ! (only used with een vorticity scheme)
 
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   un_b, vn_b   ! averaged velocity
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   un_b, vn_b   ! now    averaged velocity
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ub_b, vb_b   ! before averaged velocity
+
 
    !! * Substitutions
@@ -56,7 +59,7 @@
 #  include "vectopt_loop_substitute.h90"
    !!-------------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software is governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!-------------------------------------------------------------------------
 
@@ -81,8 +84,8 @@
       !!          momentum and continuity integration. Barotropic former 
       !!          variables are time averaging over the full barotropic cycle
-      !!          (= 2 * baroclinic time step) and saved in zuX_b 
-      !!          and zvX_b (X specifying after, now or before).
+      !!          (= 2 * baroclinic time step) and saved in uX_b 
+      !!          and vX_b (X specifying after, now or before).
       !!      -3- The new general trend becomes :
-      !!          ua = ua - sum_k(ua)/H + ( ua_e - sum_k(ub) )
+      !!          ua = ua - sum_k(ua)/H + ( un_b - ub_b )
       !!
       !! ** Action : - Update (ua,va) with the surf. pressure gradient trend
@@ -93,6 +96,5 @@
       !!
       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
-      INTEGER  ::   icycle                           ! temporary integers
-      INTEGER  ::   ikbu, ikbv, ikbum1, ikbvm1       !   -          -
+      INTEGER  ::   icycle           ! temporary scalar
 
       REAL(wp) ::   zraur, zcoef, z2dt_e, z2dt_b     ! temporary scalars
@@ -108,6 +110,6 @@
       REAL(wp), DIMENSION(jpi,jpj) ::   zsshun_e, zsshvn_e   ! 2D workspace
       !!
-      REAL(wp), DIMENSION(jpi,jpj) ::   zcu, zwx, zua, zun, zub   ! 2D workspace
-      REAL(wp), DIMENSION(jpi,jpj) ::   zcv, zwy, zva, zvn, zvb   !  -      -
+      REAL(wp), DIMENSION(jpi,jpj) ::   zcu, zwx, zua, zun   ! 2D workspace
+      REAL(wp), DIMENSION(jpi,jpj) ::   zcv, zwy, zva, zvn   !  -      -
       REAL(wp), DIMENSION(jpi,jpj) ::   zun_e, zub_e, zu_sum      ! 2D workspace
       REAL(wp), DIMENSION(jpi,jpj) ::   zvn_e, zvb_e, zv_sum      !  -      -
@@ -160,6 +162,6 @@
       !                                   !* e3*d/dt(Ua), e3*Ub, e3*Vn (Vertically integrated)
       !                                   ! --------------------------
-      zua(:,:) = 0.e0   ;   zun(:,:) = 0.e0   ;   zub(:,:) = 0.e0
-      zva(:,:) = 0.e0   ;   zvn(:,:) = 0.e0   ;   zvb(:,:) = 0.e0
+      zua(:,:) = 0.e0   ;   zun(:,:) = 0.e0 
+      zva(:,:) = 0.e0   ;   zvn(:,:) = 0.e0 
       !
       DO jk = 1, jpkm1
@@ -177,7 +179,4 @@
                zun(ji,jj) = zun(ji,jj) + fse3u  (ji,jj,jk) * un(ji,jj,jk)
                zvn(ji,jj) = zvn(ji,jj) + fse3v  (ji,jj,jk) * vn(ji,jj,jk)               
-               !                                                                              ! before velocity
-               zub(ji,jj) = zub(ji,jj) + fse3u_b(ji,jj,jk) * ub(ji,jj,jk) 
-               zvb(ji,jj) = zvb(ji,jj) + fse3v_b(ji,jj,jk) * vb(ji,jj,jk)
             END DO
          END DO
@@ -265,15 +264,9 @@
          DO ji = 2, jpim1
 # endif
-            ikbu = MIN( mbathy(ji+1,jj), mbathy(ji,jj) )
-            ikbv = MIN( mbathy(ji,jj+1), mbathy(ji,jj) )
-            ikbum1 = MAX( ikbu-1, 1 )
-            ikbvm1 = MAX( ikbv-1, 1 )
-
-            !
             ! Apply stability criteria for bottom friction
-            !RBbug for vvl and external mode we may need to
-            ! use varying fse3
-            zbfru  (ji,jj) = MAX( bfrua(ji,jj), fse3u(ji,jj,ikbum1)*zcoef )
-            zbfrv  (ji,jj) = MAX( bfrva(ji,jj), fse3v(ji,jj,ikbvm1)*zcoef )
+            !RBbug for vvl and external mode we may need to use varying fse3
+            !!gm  Rq: the bottom e3 present the smallest variation, the use of e3u_0 is not a big approx.
+            zbfru(ji,jj) = MAX(  bfrua(ji,jj) , fse3u(ji,jj,mbku(ji,jj)) * zcoef  )
+            zbfrv(ji,jj) = MAX(  bfrva(ji,jj) , fse3v(ji,jj,mbkv(ji,jj)) * zcoef  )
          END DO
       END DO
@@ -282,7 +275,7 @@
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               zua(ji,jj) = zua(ji,jj) - zbfru(ji,jj) * zub(ji,jj)   &
+               zua(ji,jj) = zua(ji,jj) - zbfru(ji,jj) * ub_b(ji,jj)   &
                   &       / ( hu_0(ji,jj) + sshu_b(ji,jj) + 1.e0 - umask(ji,jj,1) )
-               zva(ji,jj) = zva(ji,jj) - zbfrv(ji,jj) * zvb(ji,jj)   &
+               zva(ji,jj) = zva(ji,jj) - zbfrv(ji,jj) * vb_b(ji,jj)   &
                   &       / ( hv_0(ji,jj) + sshv_b(ji,jj) + 1.e0 - vmask(ji,jj,1) )
             END DO
@@ -291,6 +284,6 @@
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               zua(ji,jj) = zua(ji,jj) - zbfru(ji,jj) * zub(ji,jj) * hur(ji,jj)
-               zva(ji,jj) = zva(ji,jj) - zbfrv(ji,jj) * zvb(ji,jj) * hvr(ji,jj)
+               zua(ji,jj) = zua(ji,jj) - zbfru(ji,jj) * ub_b(ji,jj) * hur(ji,jj)
+               zva(ji,jj) = zva(ji,jj) - zbfrv(ji,jj) * vb_b(ji,jj) * hvr(ji,jj)
             END DO
          END DO
@@ -302,11 +295,4 @@
       zva(:,:) = zva(:,:) * hvr(:,:)
       !
-      IF( lk_vvl ) THEN
-         zub(:,:) = zub(:,:) * umask(:,:,1) / ( hu_0(:,:) + sshu_b(:,:) + 1.e0 - umask(:,:,1) )
-         zvb(:,:) = zvb(:,:) * vmask(:,:,1) / ( hv_0(:,:) + sshv_b(:,:) + 1.e0 - vmask(:,:,1) )
-      ELSE
-         zub(:,:) = zub(:,:) * hur(:,:)
-         zvb(:,:) = zvb(:,:) * hvr(:,:)
-      ENDIF
 
       ! -----------------------------------------------------------------------
@@ -354,6 +340,6 @@
          !                                                !* Update the forcing (OBC, BDY and tides)
          !                                                !  ------------------
-         IF( lk_obc                     )   CALL obc_dta_bt( kt, jn   )
-         IF( lk_bdy  .OR.  ln_bdy_tides )   CALL bdy_dta_bt( kt, jn+1 )
+         IF( lk_obc )   CALL obc_dta_bt ( kt, jn   )
+         IF( lk_bdy )   CALL bdy_dta_fla( kt, jn+1, icycle )
 
          !                                                !* after ssh_e
@@ -382,5 +368,5 @@
          DO jj = 2, jpjm1                                      ! leap-frog on ssh_e
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               ssha_e(ji,jj) = ( zsshb_e(ji,jj) - z2dt_e * ( zraur * emp(ji,jj) + zhdiv(ji,jj) ) ) * tmask(ji,jj,1)
+               ssha_e(ji,jj) = ( zsshb_e(ji,jj) - z2dt_e * ( zraur * ( emp(ji,jj)-rnf(ji,jj) ) + zhdiv(ji,jj) ) ) * tmask(ji,jj,1) 
             END DO
          END DO
@@ -478,6 +464,6 @@
          !                                                      !         - Correct the velocity
 
-         IF( lk_obc                   )   CALL obc_fla_ts
-         IF( lk_bdy .OR. ln_bdy_tides )   CALL bdy_dyn_fla( sshn_e ) 
+         IF( lk_obc               )   CALL obc_fla_ts
+         IF( lk_bdy .OR. ln_tides )   CALL bdy_dyn_fla( sshn_e ) 
          !
          CALL lbc_lnk( ua_e  , 'U', -1. )                      ! local domain boundaries 
@@ -545,13 +531,17 @@
       !                                   !* Time average ==> after barotropic u, v, ssh
       zcoef =  1.e0 / ( 2 * nn_baro  + 1 ) 
-      un_b  (:,:) = zcoef * zu_sum  (:,:) 
-      vn_b  (:,:) = zcoef * zv_sum  (:,:) 
-      sshn_b(:,:) = zcoef * zssh_sum(:,:) 
+      zu_sum(:,:) = zcoef * zu_sum  (:,:) 
+      zv_sum(:,:) = zcoef * zv_sum  (:,:) 
       ! 
       !                                   !* update the general momentum trend
       DO jk=1,jpkm1
-         ua(:,:,jk) = ua(:,:,jk) + ( un_b(:,:) - zub(:,:) ) / z2dt_b
-         va(:,:,jk) = va(:,:,jk) + ( vn_b(:,:) - zvb(:,:) ) / z2dt_b
+         ua(:,:,jk) = ua(:,:,jk) + ( zu_sum(:,:) - ub_b(:,:) ) / z2dt_b
+         va(:,:,jk) = va(:,:,jk) + ( zv_sum(:,:) - vb_b(:,:) ) / z2dt_b
       END DO
+      ub_b (:,:) = un_b(:,:)
+      vb_b (:,:) = vn_b(:,:)
+      un_b  (:,:) =  zu_sum(:,:) 
+      vn_b  (:,:) =  zv_sum(:,:) 
+      sshn_b(:,:) = zcoef * zssh_sum(:,:) 
       !
       !                                   !* write time-spliting arrays in the restart
@@ -598,4 +588,37 @@
             vn_b (:,:) = vn_b(:,:) * hvr(:,:)
          ENDIF
+
+         ! Vertically integrated velocity (before)
+         IF (neuler/=0) THEN
+            ub_b (:,:) = 0.e0
+            vb_b (:,:) = 0.e0
+
+            ! vertical sum
+            IF( lk_vopt_loop ) THEN          ! vector opt., forced unroll
+               DO jk = 1, jpkm1
+                  DO ji = 1, jpij
+                     ub_b(ji,1) = ub_b(ji,1) + fse3u_b(ji,1,jk) * ub(ji,1,jk)
+                     vb_b(ji,1) = vb_b(ji,1) + fse3v_b(ji,1,jk) * vb(ji,1,jk)
+                  END DO
+               END DO
+            ELSE                             ! No  vector opt.
+               DO jk = 1, jpkm1
+                  ub_b(:,:) = ub_b(:,:) + fse3u_b(:,:,jk) * ub(:,:,jk)
+                  vb_b(:,:) = vb_b(:,:) + fse3v_b(:,:,jk) * vb(:,:,jk)
+               END DO
+            ENDIF
+
+            IF( lk_vvl ) THEN
+               ub_b (:,:) = ub_b(:,:) * umask(:,:,1) / ( hu_0(:,:) + sshu_b(:,:) + 1.e0 - umask(:,:,1) )
+               vb_b (:,:) = vb_b(:,:) * vmask(:,:,1) / ( hv_0(:,:) + sshv_b(:,:) + 1.e0 - vmask(:,:,1) )
+            ELSE
+               ub_b(:,:) = ub_b(:,:) * hur(:,:)
+               vb_b(:,:) = vb_b(:,:) * hvr(:,:)
+            ENDIF
+         ELSE                                 ! neuler==0
+            ub_b (:,:) = un_b (:,:)
+            vb_b (:,:) = vn_b (:,:)
+         ENDIF
+
          IF( iom_varid( numror, 'sshn_b', ldstop = .FALSE. ) > 0 ) THEN
             CALL iom_get( numror, jpdom_autoglo, 'sshn_b' , sshn_b (:,:) )   ! filtered extrenal ssh
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90	(revision 2528)
@@ -14,13 +14,14 @@
    !!            2.0  !  2006-11  (G. Madec)  flux form advection: add metric term
    !!            3.2  !  2009-04  (R. Benshila)  vvl: correction of een scheme
+   !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase
    !!----------------------------------------------------------------------
 
    !!----------------------------------------------------------------------
-   !!   dyn_vor     : Update the momentum trend with the vorticity trend
-   !!       vor_ens : enstrophy conserving scheme       (ln_dynvor_ens=T)
-   !!       vor_ene : energy conserving scheme          (ln_dynvor_ene=T)
-   !!       vor_mix : mixed enstrophy/energy conserving (ln_dynvor_mix=T)
-   !!       vor_een : energy and enstrophy conserving   (ln_dynvor_een=T)
-   !!       vor_ctl : set and control of the different vorticity option
+   !!   dyn_vor      : Update the momentum trend with the vorticity trend
+   !!       vor_ens  : enstrophy conserving scheme       (ln_dynvor_ens=T)
+   !!       vor_ene  : energy conserving scheme          (ln_dynvor_ene=T)
+   !!       vor_mix  : mixed enstrophy/energy conserving (ln_dynvor_mix=T)
+   !!       vor_een  : energy and enstrophy conserving   (ln_dynvor_een=T)
+   !!   dyn_vor_init : set and control of the different vorticity option
    !!----------------------------------------------------------------------
    USE oce            ! ocean dynamics and tracers
@@ -36,5 +37,6 @@
    PRIVATE
 
-   PUBLIC   dyn_vor   ! routine called by step.F90
+   PUBLIC   dyn_vor        ! routine called by step.F90
+   PUBLIC   dyn_vor_init   ! routine called by opa.F90
 
    !                                             !!* Namelist namdyn_vor: vorticity term
@@ -53,7 +55,7 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3,2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -74,6 +76,4 @@
       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
       !!----------------------------------------------------------------------
-
-      IF( kt == nit000 )   CALL vor_ctl          ! initialisation & control of options
 
       !                                          ! vorticity term 
@@ -637,7 +637,7 @@
 
 
-   SUBROUTINE vor_ctl
+   SUBROUTINE dyn_vor_init
       !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE vor_ctl  ***
+      !!                  ***  ROUTINE dyn_vor_init  ***
       !!
       !! ** Purpose :   Control the consistency between cpp options for
@@ -653,6 +653,6 @@
       IF(lwp) THEN                    ! Namelist print
          WRITE(numout,*)
-         WRITE(numout,*) 'dyn:vor_ctl : vorticity term : read namelist and control the consistency'
-         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*) 'dyn_vor_init : vorticity term : read namelist and control the consistency'
+         WRITE(numout,*) '~~~~~~~~~~~~'
          WRITE(numout,*) '        Namelist namdyn_vor : oice of the vorticity term scheme'
          WRITE(numout,*) '           energy    conserving scheme                ln_dynvor_ene = ', ln_dynvor_ene
@@ -700,5 +700,5 @@
       ENDIF
       !
-   END SUBROUTINE vor_ctl
+   END SUBROUTINE dyn_vor_init
 
    !!==============================================================================
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90	(revision 2528)
@@ -31,7 +31,7 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90	(revision 2528)
@@ -4,10 +4,11 @@
    !! Ocean dynamics :  vertical component of the momentum mixing trend
    !!==============================================================================
-   !! History :  9.0  !  05-11  (G. Madec)  Original code
+   !! History :  1.0  !  2005-11  (G. Madec)  Original code
+   !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase
    !!----------------------------------------------------------------------
 
    !!----------------------------------------------------------------------
    !!   dyn_zdf      : Update the momentum trend with the vertical diffusion
-   !!       zdf_ctl  : initializations of the vertical diffusion scheme
+   !!   dyn_zdf_init : initializations of the vertical diffusion scheme
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and tracers variables
@@ -27,11 +28,9 @@
    PRIVATE
 
-   PUBLIC   dyn_zdf    !  routine called by step.F90
+   PUBLIC   dyn_zdf       !  routine called by step.F90
+   PUBLIC   dyn_zdf_init  !  routine called by opa.F90
 
-   INTEGER  ::   nzdf = 0              ! type vertical diffusion algorithm used 
-      !                                ! defined from ln_zdf...  namlist logicals)
-
-   REAL(wp) ::   r2dt                  ! time-step, = 2 rdttra
-      !                                ! except at nit000 (=rdttra) if neuler=0
+   INTEGER  ::   nzdf = 0   ! type vertical diffusion algorithm used, defined from ln_zdf... namlist logicals
+   REAL(wp) ::   r2dt       ! time-step, = 2 rdttra except at nit000 (=rdttra) if neuler=0
 
    !! * Substitutions
@@ -40,7 +39,7 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -58,9 +57,7 @@
       !!---------------------------------------------------------------------
 
-      IF( kt == nit000 )   CALL zdf_ctl          ! initialisation & control of options
-
       !                                          ! set time step
-      IF( neuler == 0 .AND. kt == nit000    ) THEN   ;   r2dt =      rdt      ! = rdtra (restarting with Euler time stepping)
-      ELSEIF(               kt <= nit000 + 1) THEN   ;   r2dt = 2. * rdt      ! = 2 rdttra (leapfrog)
+      IF( neuler == 0 .AND. kt == nit000     ) THEN   ;   r2dt =      rdt   ! = rdtra (restart with Euler time stepping)
+      ELSEIF(               kt <= nit000 + 1 ) THEN   ;   r2dt = 2. * rdt   ! = 2 rdttra (leapfrog)
       ENDIF
 
@@ -72,12 +69,12 @@
       SELECT CASE ( nzdf )                       ! compute lateral mixing trend and add it to the general trend
       !
-      CASE ( 0 )   ;   CALL dyn_zdf_exp    ( kt, r2dt )      ! explicit scheme
-      CASE ( 1 )   ;   CALL dyn_zdf_imp    ( kt, r2dt )      ! implicit scheme
+      CASE ( 0 )   ;   CALL dyn_zdf_exp( kt, r2dt )      ! explicit scheme
+      CASE ( 1 )   ;   CALL dyn_zdf_imp( kt, r2dt )      ! implicit scheme
       !
       CASE ( -1 )                                      ! esopa: test all possibility with control print
-                       CALL dyn_zdf_exp    ( kt, r2dt )
+                       CALL dyn_zdf_exp( kt, r2dt )
                        CALL prt_ctl( tab3d_1=ua, clinfo1=' zdf0 - Ua: ', mask1=umask,               &
             &                        tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
-                       CALL dyn_zdf_imp    ( kt, r2dt )
+                       CALL dyn_zdf_imp( kt, r2dt )
                        CALL prt_ctl( tab3d_1=ua, clinfo1=' zdf1 - Ua: ', mask1=umask,               &
             &                        tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
@@ -96,7 +93,7 @@
 
 
-   SUBROUTINE zdf_ctl
+   SUBROUTINE dyn_zdf_init
       !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE zdf_ctl  ***
+      !!                 ***  ROUTINE dyn_zdf_init  ***
       !!
       !! ** Purpose :   initializations of the vertical diffusion scheme
@@ -105,24 +102,24 @@
       !!                explicit (time-splitting) scheme if ln_zdfexp=T
       !!----------------------------------------------------------------------
-      USE zdftke_old
       USE zdftke
+      USE zdfgls
       USE zdfkpp
       !!----------------------------------------------------------------------
-
+      !
       ! Choice from ln_zdfexp read in namelist in zdfini
       IF( ln_zdfexp ) THEN   ;   nzdf = 0           ! use explicit scheme
       ELSE                   ;   nzdf = 1           ! use implicit scheme
       ENDIF
-
+      !
       ! Force implicit schemes
-      IF( lk_zdftke_old .OR. lk_zdftke .OR. lk_zdfkpp )   nzdf = 1   ! TKE or KPP physics
-      IF( ln_dynldf_iso                               )   nzdf = 1   ! iso-neutral lateral physics
-      IF( ln_dynldf_hor .AND. ln_sco                  )   nzdf = 1   ! horizontal lateral physics in s-coordinate
-
+      IF( lk_zdftke .OR. lk_zdfgls .OR. lk_zdfkpp )   nzdf = 1   ! TKE, GLS or KPP physics
+      IF( ln_dynldf_iso                           )   nzdf = 1   ! iso-neutral lateral physics
+      IF( ln_dynldf_hor .AND. ln_sco              )   nzdf = 1   ! horizontal lateral physics in s-coordinate
+      !
       IF( lk_esopa )    nzdf = -1                   ! Esopa key: All schemes used
-
+      !
       IF(lwp) THEN                                  ! Print the choice
          WRITE(numout,*)
-         WRITE(numout,*) 'dyn:zdf_ctl : vertical dynamics physics scheme'
+         WRITE(numout,*) 'dyn_zdf_init : vertical dynamics physics scheme'
          WRITE(numout,*) '~~~~~~~~~~~'
          IF( nzdf == -1 )   WRITE(numout,*) '              ESOPA test All scheme used'
@@ -131,5 +128,5 @@
       ENDIF
       !
-   END SUBROUTINE zdf_ctl
+   END SUBROUTINE dyn_zdf_init
 
    !!==============================================================================
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_exp.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_exp.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_exp.F90	(revision 2528)
@@ -4,7 +4,8 @@
    !! Ocean dynamics:  vertical component(s) of the momentum mixing trend
    !!==============================================================================
-   !! History :      !  90-10  (B. Blanke)  Original code
-   !!                !  97-05  (G. Madec)  vertical component of isopycnal
-   !!           8.5  !  02-08  (G. Madec)  F90: Free form and module
+   !! History :  OPA  !  1990-10  (B. Blanke)  Original code
+   !!            8.0  !  1997-05  (G. Madec)  vertical component of isopycnal
+   !!   NEMO     1.0  !  1002-08  (G. Madec)  F90: Free form and module
+   !!            3.3  !  2010-04  (M. Leclair, G. Madec)  Forcing averaged over 2 time steps
    !!----------------------------------------------------------------------
 
@@ -13,5 +14,4 @@
    !!                  sion using an explicit time-stepping scheme.
    !!----------------------------------------------------------------------
-   !! * Modules used
    USE oce             ! ocean dynamics and tracers
    USE dom_oce         ! ocean space and time domain
@@ -24,6 +24,5 @@
    PRIVATE
 
-   !! * Routine accessibility
-   PUBLIC dyn_zdf_exp    ! called by step.F90
+   PUBLIC   dyn_zdf_exp   ! called by step.F90
 
    !! * Substitutions
@@ -31,7 +30,7 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -47,5 +46,5 @@
       !!      technique. The vertical diffusion of momentum is given by:
       !!         diffu = dz( avmu dz(u) ) = 1/e3u dk+1( avmu/e3uw dk(ub) )
-      !!      Surface boundary conditions: wind stress input
+      !!      Surface boundary conditions: wind stress input (averaged over kt-1/2 & kt+1/2)
       !!      Bottom boundary conditions : bottom stress (cf zdfbfr.F90)
       !!      Add this trend to the general trend ua :
@@ -54,37 +53,29 @@
       !! ** Action : - Update (ua,va) with the vertical diffusive trend
       !!---------------------------------------------------------------------
-      !! * Arguments
-      INTEGER , INTENT( in ) ::   kt                           ! ocean time-step index
-      REAL(wp), INTENT( in ) ::   p2dt                         ! time-step 
-
-      !! * Local declarations
-      INTEGER ::   ji, jj, jk, jl                              ! dummy loop indices
-      REAL(wp) ::   zrau0r, zlavmr, zua, zva                   ! temporary scalars
-      REAL(wp), DIMENSION(jpi,jpk) ::   zwx, zwy, zwz, zww     ! temporary workspace arrays
+      INTEGER , INTENT(in) ::   kt     ! ocean time-step index
+      REAL(wp), INTENT(in) ::   p2dt   ! time-step 
+      !!
+      INTEGER ::   ji, jj, jk, jl                            ! dummy loop indices
+      REAL(wp) ::   zrau0r, zlavmr, zua, zva                 ! temporary scalars
+      REAL(wp), DIMENSION(jpi,jpk) ::   zwx, zwy, zwz, zww   ! 2D workspace
       !!----------------------------------------------------------------------
 
       IF( kt == nit000 ) THEN
          IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'dyn_zdf_exp : vertical momentum diffusion explicit operator'
+         IF(lwp) WRITE(numout,*) 'dyn_zdf_exp : vertical momentum diffusion - explicit operator'
          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ '
       ENDIF
 
-      ! Local constant initialization
-      ! -----------------------------
-      zrau0r = 1. / rau0                                   ! inverse of the reference density
-      zlavmr = 1. / float( nn_zdfexp )                      ! inverse of the number of sub time step
+      zrau0r = 1. / rau0                              ! Local constant initialization
+      zlavmr = 1. / REAL( nn_zdfexp )
 
-      !                                                ! ===============
-      DO jj = 2, jpjm1                                 !  Vertical slab
-         !                                             ! ===============
-
-         ! Surface boundary condition
-         DO ji = 2, jpim1
-            zwy(ji,1) = utau(ji,jj) * zrau0r
-            zww(ji,1) = vtau(ji,jj) * zrau0r
+      !                                               ! ===============
+      DO jj = 2, jpjm1                                !  Vertical slab
+         !                                            ! ===============
+         DO ji = 2, jpim1         ! Surface boundary condition
+            zwy(ji,1) = ( utau_b(ji,jj) + utau(ji,jj) ) * zrau0r
+            zww(ji,1) = ( vtau_b(ji,jj) + vtau(ji,jj) ) * zrau0r
          END DO  
-
-         ! Initialization of x, z and contingently trends array
-         DO jk = 1, jpk
+         DO jk = 1, jpk         ! Initialization of x, z and contingently trends array
             DO ji = 2, jpim1
                zwx(ji,jk) = ub(ji,jj,jk)
@@ -92,10 +83,8 @@
             END DO  
          END DO  
-
-         ! Time splitting loop
-         DO jl = 1, nn_zdfexp
-
-            ! First vertical derivative
-            DO jk = 2, jpk
+         !
+         DO jl = 1, nn_zdfexp     ! Time splitting loop
+            !
+            DO jk = 2, jpk            ! First vertical derivative
                DO ji = 2, jpim1
                   zwy(ji,jk) = avmu(ji,jj,jk) * ( zwx(ji,jk-1) - zwx(ji,jk) ) / fse3uw(ji,jj,jk) 
@@ -103,24 +92,20 @@
                END DO  
             END DO  
-
-            ! Second vertical derivative and trend estimation at kt+l*rdt/nn_zdfexp
-            DO jk = 1, jpkm1
+            DO jk = 1, jpkm1          ! Second vertical derivative and trend estimation at kt+l*rdt/nn_zdfexp
                DO ji = 2, jpim1
-                  zua = zlavmr*( zwy(ji,jk) - zwy(ji,jk+1) ) / fse3u(ji,jj,jk)
-                  zva = zlavmr*( zww(ji,jk) - zww(ji,jk+1) ) / fse3v(ji,jj,jk)
+                  zua = zlavmr * ( zwy(ji,jk) - zwy(ji,jk+1) ) / fse3u(ji,jj,jk)
+                  zva = zlavmr * ( zww(ji,jk) - zww(ji,jk+1) ) / fse3v(ji,jj,jk)
                   ua(ji,jj,jk) = ua(ji,jj,jk) + zua
                   va(ji,jj,jk) = va(ji,jj,jk) + zva
-
-                  zwx(ji,jk) = zwx(ji,jk) + p2dt*zua*umask(ji,jj,jk)
-                  zwz(ji,jk) = zwz(ji,jk) + p2dt*zva*vmask(ji,jj,jk)
+                  !
+                  zwx(ji,jk) = zwx(ji,jk) + p2dt * zua * umask(ji,jj,jk)
+                  zwz(ji,jk) = zwz(ji,jk) + p2dt * zva * vmask(ji,jj,jk)
                END DO  
             END DO  
-
+            !
          END DO  
-
-         !                                             ! ===============
-      END DO                                           !   End of slab
-      !                                                ! ===============
-
+         !                                            ! ===============
+      END DO                                          !   End of slab
+      !                                               ! ===============
    END SUBROUTINE dyn_zdf_exp
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90	(revision 2528)
@@ -4,7 +4,8 @@
    !! Ocean dynamics:  vertical component(s) of the momentum mixing trend
    !!==============================================================================
-   !! History :      !  90-10  (B. Blanke)  Original code
-   !!                !  97-05  (G. Madec)  vertical component of isopycnal
-   !!           8.5  !  02-08  (G. Madec)  F90: Free form and module
+   !! History :  OPA  !  1990-10  (B. Blanke)  Original code
+   !!            8.0  !  1997-05  (G. Madec)  vertical component of isopycnal
+   !!   NEMO     1.0  !  2002-08  (G. Madec)  F90: Free form and module
+   !!            3.3  !  2010-04  (M. Leclair, G. Madec)  Forcing averaged over 2 time steps
    !!----------------------------------------------------------------------
 
@@ -13,9 +14,4 @@
    !!                  sion using a implicit time-stepping.
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-   !! * Modules used
    USE oce             ! ocean dynamics and tracers
    USE dom_oce         ! ocean space and time domain
@@ -28,6 +24,5 @@
    PRIVATE
 
-   !! * Routine accessibility
-   PUBLIC dyn_zdf_imp    ! called by step.F90
+   PUBLIC   dyn_zdf_imp   ! called by step.F90
 
    !! * Substitutions
@@ -35,11 +30,9 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
-
 
    SUBROUTINE dyn_zdf_imp( kt, p2dt )
@@ -54,25 +47,21 @@
       !!             dz( avmu dz(u) ) = 1/e3u dk+1( avmu/e3uw dk(ua) )
       !!      backward time stepping
-      !!      Surface boundary conditions: wind stress input
+      !!      Surface boundary conditions: wind stress input (averaged over kt-1/2 & kt+1/2)
       !!      Bottom boundary conditions : bottom stress (cf zdfbfr.F)
       !!      Add this trend to the general trend ua :
       !!         ua = ua + dz( avmu dz(u) )
       !!
-      !! ** Action : - Update (ua,va) arrays with the after vertical diffusive
-      !!               mixing trend.
+      !! ** Action : - Update (ua,va) arrays with the after vertical diffusive mixing trend.
       !!---------------------------------------------------------------------
-      !! * Modules used
-      USE oce, ONLY :  zwd   => ta,   &                ! use ta as workspace
-                       zws   => sa                     ! use sa as workspace
-
-      !! * Arguments
-      INTEGER , INTENT( in ) ::   kt                   ! ocean time-step index
-      REAL(wp), INTENT( in ) ::  p2dt                  ! vertical profile of tracer time-step
-
-      !! * Local declarations
-      INTEGER ::   ji, jj, jk                          ! dummy loop indices
-      REAL(wp) ::   zrau0r, z2dtf, zcoef, zzws, zrhs   ! temporary scalars
-      REAL(wp) ::   zzwi                               ! temporary scalars
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwi        ! temporary workspace arrays
+      USE oce, ONLY :  zwd   => ta      ! use ta as workspace
+      USE oce, ONLY :  zws   => sa      ! use sa as workspace
+      !!
+      INTEGER , INTENT( in ) ::   kt    ! ocean time-step index
+      REAL(wp), INTENT( in ) ::  p2dt   ! vertical profile of tracer time-step
+      !!
+      INTEGER  ::   ji, jj, jk             ! dummy loop indices
+      REAL(wp) ::   z1_p2dt, zcoef         ! temporary scalars
+      REAL(wp) ::   zzwi, zzws, zrhs       ! temporary scalars
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwi        ! 3D workspace
       !!----------------------------------------------------------------------
 
@@ -85,5 +74,5 @@
       ! 0. Local constant initialization
       ! --------------------------------
-      zrau0r = 1. / rau0      ! inverse of the reference density
+      z1_p2dt = 1._wp / p2dt      ! inverse of the timestep
 
       ! 1. Vertical diffusion on u
@@ -95,22 +84,21 @@
       ! friction velocity in dyn_bfr using values from the previous timestep. There
       ! is no need to include these in the implicit calculation.
-      DO jk = 1, jpkm1
+      !
+      DO jk = 1, jpkm1        ! Matrix
          DO jj = 2, jpjm1 
             DO ji = fs_2, fs_jpim1   ! vector opt.
                zcoef = - p2dt / fse3u(ji,jj,jk)
-               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. - zwi(ji,jj,jk) - zzws
-            END DO
-         END DO
-      END DO
-
-      ! Surface boudary conditions
-      DO jj = 2, jpjm1 
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            zwi(ji,jj,1) = 0.
-            zwd(ji,jj,1) = 1. - zws(ji,jj,1)
+               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
+            END DO
+         END DO
+      END DO
+      DO jj = 2, jpjm1        ! Surface boudary conditions
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            zwi(ji,jj,1) = 0._wp
+            zwd(ji,jj,1) = 1._wp - zws(ji,jj,1)
          END DO
       END DO
@@ -130,7 +118,6 @@
       !   The solution (the after velocity) is in ua
       !-----------------------------------------------------------------------
-
-      ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)
-      DO jk = 2, jpkm1
+      !
+      DO jk = 2, jpkm1        !==  First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)  ==
          DO jj = 2, jpjm1   
             DO ji = fs_2, fs_jpim1   ! vector opt.
@@ -139,14 +126,9 @@
          END DO
       END DO
-
-      ! second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1
-      DO jj = 2, jpjm1   
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-!!! change les resultats (derniers digit, pas significativement + rapide 1* de moins)
-!!!         ua(ji,jj,1) = ub(ji,jj,1)  &
-!!!                      + p2dt * ( ua(ji,jj,1) + utau(ji,jj) / ( fse3u(ji,jj,1)*rau0 ) )
-            z2dtf = p2dt / ( fse3u(ji,jj,1)*rau0 )
-            ua(ji,jj,1) = ub(ji,jj,1)  &
-                         + p2dt *  ua(ji,jj,1) + z2dtf * utau(ji,jj)
+      !
+      DO jj = 2, jpjm1        !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  ==
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            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       )  )
          END DO
       END DO
@@ -159,7 +141,6 @@
          END DO
       END DO
-
-      ! thrid recurrence : SOLk = ( Lk - Uk * Ek+1 ) / Dk
-      DO jj = 2, jpjm1   
+      !
+      DO jj = 2, jpjm1        !==  thrid recurrence : SOLk = ( Lk - Uk * Ek+1 ) / Dk  ==
          DO ji = fs_2, fs_jpim1   ! vector opt.
             ua(ji,jj,jpkm1) = ua(ji,jj,jpkm1) / zwd(ji,jj,jpkm1)
@@ -169,5 +150,5 @@
          DO jj = 2, jpjm1   
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               ua(ji,jj,jk) =( ua(ji,jj,jk) - zws(ji,jj,jk) * ua(ji,jj,jk+1) ) / zwd(ji,jj,jk)
+               ua(ji,jj,jk) = ( ua(ji,jj,jk) - zws(ji,jj,jk) * ua(ji,jj,jk+1) ) / zwd(ji,jj,jk)
             END DO
          END DO
@@ -178,5 +159,5 @@
          DO jj = 2, jpjm1   
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               ua(ji,jj,jk) = ( ua(ji,jj,jk) - ub(ji,jj,jk) ) / p2dt
+               ua(ji,jj,jk) = ( ua(ji,jj,jk) - ub(ji,jj,jk) ) * z1_p2dt
             END DO
          END DO
@@ -192,22 +173,21 @@
       ! friction velocity in dyn_bfr using values from the previous timestep. There
       ! is no need to include these in the implicit calculation.
-      DO jk = 1, jpkm1
+      !
+      DO jk = 1, jpkm1        ! Matrix
          DO jj = 2, jpjm1   
             DO ji = fs_2, fs_jpim1   ! vector opt.
                zcoef = -p2dt / fse3v(ji,jj,jk)
-               zzwi          = zcoef * avmv(ji,jj,jk  ) / fse3vw(ji,jj,jk  )
+               zzwi          = zcoef * avmv (ji,jj,jk  ) / fse3vw(ji,jj,jk  )
                zwi(ji,jj,jk) =  zzwi * vmask(ji,jj,jk)
-               zzws       = zcoef * avmv(ji,jj,jk+1) / fse3vw(ji,jj,jk+1)
+               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. - zwi(ji,jj,jk) - zzws
-            END DO
-         END DO
-      END DO
-
-      ! Surface boudary conditions
-      DO jj = 2, jpjm1   
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            zwi(ji,jj,1) = 0.e0
-            zwd(ji,jj,1) = 1. - zws(ji,jj,1)
+               zwd(ji,jj,jk) = 1._wp - zwi(ji,jj,jk) - zzws
+            END DO
+         END DO
+      END DO
+      DO jj = 2, jpjm1        ! Surface boudary conditions
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            zwi(ji,jj,1) = 0._wp
+            zwd(ji,jj,1) = 1._wp - zws(ji,jj,1)
          END DO
       END DO
@@ -223,12 +203,10 @@
       !        (  0    0    0   zwik zwdk )( zwxk ) ( zwyk )
       !
-      !   m is decomposed in the product of an upper and lower triangular
-      !   matrix
+      !   m is decomposed in the product of an upper and lower triangular matrix
       !   The 3 diagonal terms are in 2d arrays: zwd, zws, zwi
       !   The solution (after velocity) is in 2d array va
       !-----------------------------------------------------------------------
-
-      ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)
-      DO jk = 2, jpkm1
+      !
+      DO jk = 2, jpkm1        !==  First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)  ==
          DO jj = 2, jpjm1   
             DO ji = fs_2, fs_jpim1   ! vector opt.
@@ -237,14 +215,9 @@
          END DO
       END DO
-
-      ! second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-!!! change les resultats (derniers digit, pas significativement + rapide 1* de moins)
-!!!         va(ji,jj,1) = vb(ji,jj,1)  &
-!!!                      + p2dt * ( va(ji,jj,1) + vtau(ji,jj) / ( fse3v(ji,jj,1)*rau0 ) )
-            z2dtf = p2dt / ( fse3v(ji,jj,1)*rau0 )
-            va(ji,jj,1) = vb(ji,jj,1)  &
-                         + p2dt * va(ji,jj,1) + z2dtf * vtau(ji,jj)
+      !
+      DO jj = 2, jpjm1        !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  ==
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            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       )  )
          END DO
       END DO
@@ -257,7 +230,6 @@
          END DO
       END DO
-
-      ! thrid recurrence : SOLk = ( Lk - Uk * SOLk+1 ) / Dk
-      DO jj = 2, jpjm1   
+      !
+      DO jj = 2, jpjm1        !==  thrid recurrence : SOLk = ( Lk - Uk * SOLk+1 ) / Dk  ==
          DO ji = fs_2, fs_jpim1   ! vector opt.
             va(ji,jj,jpkm1) = va(ji,jj,jpkm1) / zwd(ji,jj,jpkm1)
@@ -267,5 +239,5 @@
          DO jj = 2, jpjm1   
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               va(ji,jj,jk) =( va(ji,jj,jk) - zws(ji,jj,jk) * va(ji,jj,jk+1) ) / zwd(ji,jj,jk)
+               va(ji,jj,jk) = ( va(ji,jj,jk) - zws(ji,jj,jk) * va(ji,jj,jk+1) ) / zwd(ji,jj,jk)
             END DO
          END DO
@@ -276,9 +248,9 @@
          DO jj = 2, jpjm1   
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               va(ji,jj,jk) = ( va(ji,jj,jk) - vb(ji,jj,jk) ) / p2dt
-            END DO
-         END DO
-      END DO
-
+               va(ji,jj,jk) = ( va(ji,jj,jk) - vb(ji,jj,jk) ) * z1_p2dt
+            END DO
+         END DO
+      END DO
+      !
    END SUBROUTINE dyn_zdf_imp
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90	(revision 2528)
@@ -5,4 +5,7 @@
    !!==============================================================================
    !! History :  3.1  !  2009-02  (G. Madec, M. Leclair)  Original code
+   !!            3.3  !  2010-04  (M. Leclair, G. Madec)  modified LF-RA 
+   !!             -   !  2010-05  (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface
+   !!             -   !  2010-09  (D.Storkey and E.O'Dea) bug fixes for BDY module
    !!----------------------------------------------------------------------
 
@@ -16,5 +19,4 @@
    USE domvvl          ! Variable volume
    USE divcur          ! hor. divergence and curl      (div & cur routines)
-   USE cla_div         ! cross land: hor. divergence      (div_cla routine)
    USE iom             ! I/O library
    USE restart         ! only for lrst_oce
@@ -25,8 +27,15 @@
    USE obc_par         ! open boundary cond. parameter
    USE obc_oce
+   USE bdy_oce
    USE diaar5, ONLY :   lk_diaar5
    USE iom
+   USE sbcrnf, ONLY  : h_rnf, nk_rnf  ! River runoff 
+#if defined key_agrif
+   USE agrif_opa_update
    USE agrif_opa_interp
-   USE agrif_opa_update
+#endif
+#if defined key_asminc   
+   USE asminc          ! Assimilation increment
+#endif
 
    IMPLICIT NONE
@@ -39,9 +48,8 @@
 #  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -55,7 +63,5 @@
       !!              and update the now vertical coordinate (lk_vvl=T).
       !!
-      !! ** Method  : -
-      !!
-      !!              - Using the incompressibility hypothesis, the vertical 
+      !! ** Method  : - Using the incompressibility hypothesis, the vertical 
       !!      velocity is computed by integrating the horizontal divergence  
       !!      from the bottom to the surface minus the scale factor evolution.
@@ -64,7 +70,8 @@
       !! ** action  :   ssha    : after sea surface height
       !!                wn      : now vertical velocity
-      !! if lk_vvl=T:   sshu_a, sshv_a, sshf_a  : after sea surface height
-      !!                          at u-, v-, f-point s
-      !!                hu, hv, hur, hvr : ocean depth and its inverse at u-,v-points
+      !!                sshu_a, sshv_a, sshf_a  : after sea surface height (lk_vvl=T)
+      !!                hu, hv, hur, hvr        : ocean depth and its inverse at u-,v-points
+      !!
+      !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling.
       !!----------------------------------------------------------------------
       USE oce, ONLY :   z3d => ta   ! use ta as 3D workspace
@@ -74,5 +81,5 @@
       INTEGER  ::   ji, jj, jk      ! dummy loop indices
       REAL(wp) ::   zcoefu, zcoefv, zcoeff      ! temporary scalars
-      REAL(wp) ::   z2dt, zraur     ! temporary scalars
+      REAL(wp) ::   z2dt, z1_2dt, z1_rau0       ! temporary scalars
       REAL(wp), DIMENSION(jpi,jpj) ::   zhdiv       ! 2D workspace
       REAL(wp), DIMENSION(jpi,jpj) ::   z2d         ! 2D workspace
@@ -80,4 +87,5 @@
 
       IF( kt == nit000 ) THEN
+         !
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) 'ssh_wzv : after sea surface height and now vertical velocity '
@@ -96,30 +104,34 @@
                   sshv_b(ji,jj) = zcoefv * ( e1t(ji,jj  ) * e2t(ji,jj  ) * sshb(ji,jj  )     &
                      &                     + e1t(ji,jj+1) * e2t(ji,jj+1) * sshb(ji,jj+1) )
-                  sshf_b(ji,jj) = zcoeff * ( sshb(ji  ,jj) + sshb(ji  ,jj+1)                 &
-                     &                     + sshb(ji+1,jj) + sshb(ji+1,jj+1) )
                   sshu_n(ji,jj) = zcoefu * ( e1t(ji  ,jj) * e2t(ji  ,jj) * sshn(ji  ,jj)     &
                      &                     + e1t(ji+1,jj) * e2t(ji+1,jj) * sshn(ji+1,jj) )
                   sshv_n(ji,jj) = zcoefv * ( e1t(ji,jj  ) * e2t(ji,jj  ) * sshn(ji,jj  )     &
                      &                     + e1t(ji,jj+1) * e2t(ji,jj+1) * sshn(ji,jj+1) )
-                  sshf_n(ji,jj) = zcoeff * ( sshn(ji  ,jj) + sshn(ji  ,jj+1)                 &
-                     &                     + sshn(ji+1,jj) + sshn(ji+1,jj+1) )
                END DO
             END DO
             CALL lbc_lnk( sshu_b, 'U', 1. )   ;   CALL lbc_lnk( sshu_n, 'U', 1. )
             CALL lbc_lnk( sshv_b, 'V', 1. )   ;   CALL lbc_lnk( sshv_n, 'V', 1. )
-            CALL lbc_lnk( sshf_b, 'F', 1. )   ;   CALL lbc_lnk( sshf_n, 'F', 1. )
+            DO jj = 1, jpjm1
+               DO ji = 1, jpim1      ! NO Vector Opt.
+                  sshf_n(ji,jj) = 0.5  * umask(ji,jj,1) * umask(ji,jj+1,1)                   &
+                       &               / ( e1f(ji,jj  ) * e2f(ji,jj  ) )                     &
+                       &               * ( e1u(ji,jj  ) * e2u(ji,jj  ) * sshu_n(ji,jj  )     &
+                       &                 + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) )
+               END DO
+            END DO
+            CALL lbc_lnk( sshf_n, 'F', 1. )
          ENDIF
          !
       ENDIF
 
-      !                                           !------------------------------!
-      IF( lk_vvl ) THEN                           !  Update Now Vertical coord.  !   (only in vvl case)
-      !                                           !------------------------------!
+      !                                           !------------------------------------------!
+      IF( lk_vvl ) THEN                           !  Regridding: Update Now Vertical coord.  !   (only in vvl case)
+         !                                        !------------------------------------------!
          DO jk = 1, jpkm1
-            fsdept(:,:,jk) = fsdept_n(:,:,jk)          ! now local depths stored in fsdep. arrays
+            fsdept(:,:,jk) = fsdept_n(:,:,jk)         ! now local depths stored in fsdep. arrays
             fsdepw(:,:,jk) = fsdepw_n(:,:,jk)
             fsde3w(:,:,jk) = fsde3w_n(:,:,jk)
             !
-            fse3t (:,:,jk) = fse3t_n (:,:,jk)          ! vertical scale factors stored in fse3. arrays
+            fse3t (:,:,jk) = fse3t_n (:,:,jk)         ! vertical scale factors stored in fse3. arrays
             fse3u (:,:,jk) = fse3u_n (:,:,jk)
             fse3v (:,:,jk) = fse3v_n (:,:,jk)
@@ -129,21 +141,17 @@
             fse3vw(:,:,jk) = fse3vw_n(:,:,jk)
          END DO
-         !                                             ! now ocean depth (at u- and v-points)
-         hu(:,:) = hu_0(:,:) + sshu_n(:,:)
+         !
+         hu(:,:) = hu_0(:,:) + sshu_n(:,:)            ! now ocean depth (at u- and v-points)
          hv(:,:) = hv_0(:,:) + sshv_n(:,:)
-         !                                             ! now masked inverse of the ocean depth (at u- and v-points)
+         !                                            ! now masked inverse of the ocean depth (at u- and v-points)
          hur(:,:) = umask(:,:,1) / ( hu(:,:) + 1.e0 - umask(:,:,1) )
          hvr(:,:) = vmask(:,:,1) / ( hv(:,:) + 1.e0 - vmask(:,:,1) )
-         !
-      ENDIF
-
-                         CALL div_cur( kt )            ! Horizontal divergence & Relative vorticity
-      IF( n_cla == 1 )   CALL div_cla( kt )            ! Cross Land Advection (Update Hor. divergence)
-
-      ! set time step size (Euler/Leapfrog)
-      z2dt = 2. * rdt 
+         ! 
+      ENDIF
+      !
+      CALL div_cur( kt )                              ! Horizontal divergence & Relative vorticity
+      !
+      z2dt = 2. * rdt                                 ! set time step size (Euler/Leapfrog)
       IF( neuler == 0 .AND. kt == nit000 )   z2dt =rdt
-
-      zraur = 1. / rau0
 
       !                                           !------------------------------!
@@ -154,7 +162,10 @@
         zhdiv(:,:) = zhdiv(:,:) + fse3t(:,:,jk) * hdivn(:,:,jk)
       END DO
-
       !                                                ! Sea surface elevation time stepping
-      ssha(:,:) = (  sshb(:,:) - z2dt * ( zraur * emp(:,:) + zhdiv(:,:) )  ) * tmask(:,:,1)
+      ! In forward Euler time stepping case, the same formulation as in the leap-frog case can be used
+      ! because emp_b field is initialized with the vlaues of emp field. Hence, 0.5 * ( emp + emp_b ) = emp
+      z1_rau0 = 0.5 / rau0
+      ssha(:,:) = (  sshb(:,:) - z2dt * ( z1_rau0 * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) )  ) &
+      &                      * tmask(:,:,1)
 
 #if defined key_agrif
@@ -162,8 +173,12 @@
 #endif
 #if defined key_obc
-      IF ( Agrif_Root() ) THEN 
+      IF( Agrif_Root() ) THEN 
          ssha(:,:) = ssha(:,:) * obctmsk(:,:)
-         CALL lbc_lnk( ssha, 'T', 1. )  ! absolutly compulsory !! (jmm)
-      ENDIF
+         CALL lbc_lnk( ssha, 'T', 1. )                ! absolutly compulsory !! (jmm)
+      ENDIF
+#endif
+#if defined key_bdy
+      ssha(:,:) = ssha(:,:) * bdytmask(:,:)
+      CALL lbc_lnk( ssha, 'T', 1. ) 
 #endif
 
@@ -178,35 +193,49 @@
                   &                                  * ( e1t(ji,jj  ) * e2t(ji,jj  ) * ssha(ji,jj  )     &
                   &                                    + e1t(ji,jj+1) * e2t(ji,jj+1) * ssha(ji,jj+1) )
-               sshf_a(ji,jj) = 0.25 * umask(ji,jj,1) * umask (ji,jj+1,1)                                 & 
-                  &                                  * ( ssha(ji  ,jj) + ssha(ji  ,jj+1)                 &
-                  &                                    + ssha(ji+1,jj) + ssha(ji+1,jj+1) )
             END DO
          END DO
-         CALL lbc_lnk( sshu_a, 'U', 1. )               ! Boundaries conditions
+         ! Boundaries conditions
+         CALL lbc_lnk( sshu_a, 'U', 1. )
          CALL lbc_lnk( sshv_a, 'V', 1. )
-         CALL lbc_lnk( sshf_a, 'F', 1. )
-      ENDIF
+      ENDIF
+! Include the IAU weighted SSH increment
+#if defined key_asminc
+      IF( ( lk_asminc ).AND.( ln_sshinc ).AND.( ln_asmiau ) ) THEN
+         CALL ssh_asm_inc( kt )
+         ssha(:,:) = ssha(:,:) + z2dt * ssh_iau(:,:)
+      ENDIF
+#endif
 
       !                                           !------------------------------!
       !                                           !     Now Vertical Velocity    !
       !                                           !------------------------------!
-      !                                                ! integrate from the bottom the hor. divergence
-      DO jk = jpkm1, 1, -1
-         wn(:,:,jk) = wn(:,:,jk+1) -    fse3t_n(:,:,jk) * hdivn(:,:,jk)   &
-              &                    - (  fse3t_a(:,:,jk)                   &
-              &                       - fse3t_b(:,:,jk) ) * tmask(:,:,jk) / z2dt
+      z1_2dt = 1.e0 / z2dt
+      DO jk = jpkm1, 1, -1                             ! integrate from the bottom the hor. divergence
+         ! - ML - need 3 lines here because replacement of fse3t by its expression yields too long lines otherwise
+         wn(:,:,jk) = wn(:,:,jk+1) -    fse3t_n(:,:,jk) * hdivn(:,:,jk)        &
+            &                      - (  fse3t_a(:,:,jk) - fse3t_b(:,:,jk) )    &
+            &                         * tmask(:,:,jk) * z1_2dt
+#if defined key_bdy
+         wn(:,:,jk) = wn(:,:,jk) * bdytmask(:,:)
+#endif
       END DO
-      !
+
+      !                                           !------------------------------!
+      !                                           !           outputs            !
+      !                                           !------------------------------!
       CALL iom_put( "woce", wn                    )   ! vertical velocity
       CALL iom_put( "ssh" , sshn                  )   ! sea surface height
       CALL iom_put( "ssh2", sshn(:,:) * sshn(:,:) )   ! square of sea surface height
-      IF( lk_diaar5 ) THEN
+      IF( lk_diaar5 ) THEN                            ! vertical mass transport & its square value
+         ! Caution: in the VVL case, it only correponds to the baroclinic mass transport.
          z2d(:,:) = rau0 * e1t(:,:) * e2t(:,:)
          DO jk = 1, jpk
             z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:)
          END DO
-         CALL iom_put( "w_masstr" , z3d                     )   !           vertical mass transport
-         CALL iom_put( "w_masstr2", z3d(:,:,:) * z3d(:,:,:) )   ! square of vertical mass transport
-      ENDIF
+         CALL iom_put( "w_masstr" , z3d                     )  
+         CALL iom_put( "w_masstr2", z3d(:,:,:) * z3d(:,:,:) )
+      ENDIF
+      !
+      IF(ln_ctl)   CALL prt_ctl( tab2d_1=ssha, clinfo1=' ssha  - : ', mask1=tmask, ovlap=1 )
       !
    END SUBROUTINE ssh_wzv
@@ -221,14 +250,19 @@
       !!              ssha  already computed in ssh_wzv  
       !!
-      !! ** Method  : - apply Asselin time fiter to now ssh and swap :
-      !!             sshn = ssha + atfp * ( sshb -2 sshn + ssha )
-      !!             sshn = ssha
+      !! ** Method  : - apply Asselin time fiter to now ssh (excluding the forcing
+      !!              from the filter, see Leclair and Madec 2010) and swap :
+      !!                sshn = ssha + atfp * ( sshb -2 sshn + ssha )
+      !!                            - atfp * rdt * ( emp_b - emp ) / rau0
+      !!                sshn = ssha
       !!
       !! ** action  : - sshb, sshn   : before & now sea surface height
       !!                               ready for the next time step
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
-      !!
-      INTEGER  ::   ji, jj               ! dummy loop indices
+      !!
+      !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling.
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !!
+      INTEGER  ::   ji, jj   ! dummy loop indices
+      REAL(wp) ::   zec      ! temporary scalar
       !!----------------------------------------------------------------------
 
@@ -239,31 +273,65 @@
       ENDIF
 
-      ! Time filter and swap of the ssh
-      ! -------------------------------
-
-      IF( lk_vvl ) THEN      ! Variable volume levels :   ssh at t-, u-, v, f-points
-         !                   ! ---------------------- !
+      !                       !--------------------------!
+      IF( lk_vvl ) THEN       !  Variable volume levels  !
+         !                    !--------------------------!
+         !
+         ! ssh at t-, u-, v, f-points
+         !===========================
          IF( neuler == 0 .AND. kt == nit000 ) THEN      ! Euler time-stepping at first time-step : no filter
             sshn  (:,:) = ssha  (:,:)                        ! now <-- after  (before already = now)
             sshu_n(:,:) = sshu_a(:,:)
             sshv_n(:,:) = sshv_a(:,:)
-            sshf_n(:,:) = sshf_a(:,:)
+            DO jj = 1, jpjm1
+               DO ji = 1, jpim1      ! NO Vector Opt.
+                  sshf_n(ji,jj) = 0.5  * umask(ji,jj,1) * umask(ji,jj+1,1)                   &
+                     &               / ( e1f(ji,jj  ) * e2f(ji,jj  ) )                     &
+                     &               * ( e1u(ji,jj  ) * e2u(ji,jj  ) * sshu_n(ji,jj  )     &
+                     &                 + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) )
+               END DO
+            END DO
+            ! Boundaries conditions
+            CALL lbc_lnk( sshf_n, 'F', 1. )
          ELSE                                           ! Leap-Frog time-stepping: Asselin filter + swap
+            zec = atfp * rdt / rau0
             DO jj = 1, jpj
                DO ji = 1, jpi                                ! before <-- now filtered
-                  sshb  (ji,jj) = sshn(ji,jj)   + atfp * ( sshb  (ji,jj) - 2 * sshn  (ji,jj) + ssha  (ji,jj) )
-                  sshu_b(ji,jj) = sshu_n(ji,jj) + atfp * ( sshu_b(ji,jj) - 2 * sshu_n(ji,jj) + sshu_a(ji,jj) )
-                  sshv_b(ji,jj) = sshv_n(ji,jj) + atfp * ( sshv_b(ji,jj) - 2 * sshv_n(ji,jj) + sshv_a(ji,jj) )
-                  sshf_b(ji,jj) = sshf_n(ji,jj) + atfp * ( sshf_b(ji,jj) - 2 * sshf_n(ji,jj) + sshf_a(ji,jj) )
+                  sshb  (ji,jj) = sshn  (ji,jj) + atfp * ( sshb(ji,jj) - 2 * sshn(ji,jj) + ssha(ji,jj) )   &
+                     &                          - zec  * ( emp_b(ji,jj) - emp(ji,jj) ) * tmask(ji,jj,1)
                   sshn  (ji,jj) = ssha  (ji,jj)              ! now <-- after
                   sshu_n(ji,jj) = sshu_a(ji,jj)
                   sshv_n(ji,jj) = sshv_a(ji,jj)
-                  sshf_n(ji,jj) = sshf_a(ji,jj)
-               END DO
-            END DO
+               END DO
+            END DO
+            DO jj = 1, jpjm1
+               DO ji = 1, jpim1      ! NO Vector Opt.
+                  sshf_n(ji,jj) = 0.5  * umask(ji,jj,1) * umask(ji,jj+1,1)                 &
+                     &               / ( e1f(ji,jj  ) * e2f(ji,jj  ) )                     &
+                     &               * ( e1u(ji,jj  ) * e2u(ji,jj  ) * sshu_n(ji,jj  )     &
+                     &                 + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) )
+               END DO
+            END DO
+            ! Boundaries conditions
+            CALL lbc_lnk( sshf_n, 'F', 1. )
+            DO jj = 1, jpjm1
+               DO ji = 1, jpim1      ! NO Vector Opt.
+                  sshu_b(ji,jj) = 0.5  * umask(ji,jj,1) / ( e1u(ji  ,jj) * e2u(ji  ,jj) )                   &
+                     &                                  * ( e1t(ji  ,jj) * e2t(ji  ,jj) * sshb(ji  ,jj)     &
+                     &                                    + e1t(ji+1,jj) * e2t(ji+1,jj) * sshb(ji+1,jj) )
+                  sshv_b(ji,jj) = 0.5  * vmask(ji,jj,1) / ( e1v(ji,jj  ) * e2v(ji,jj  ) )                   &
+                     &                                  * ( e1t(ji,jj  ) * e2t(ji,jj  ) * sshb(ji,jj  )     &
+                     &                                    + e1t(ji,jj+1) * e2t(ji,jj+1) * sshb(ji,jj+1) )
+               END DO
+            END DO
+            ! Boundaries conditions
+            CALL lbc_lnk( sshu_b, 'U', 1. )
+            CALL lbc_lnk( sshv_b, 'V', 1. )
          ENDIF
-         !
-      ELSE                   ! fixed levels :   ssh at t-point only
-         !                   ! ------------ !
+         !                    !--------------------------!
+      ELSE                    !        fixed levels      !
+         !                    !--------------------------!
+         !
+         ! ssh at t-point only
+         !====================
          IF( neuler == 0 .AND. kt == nit000 ) THEN      ! Euler time-stepping at first time-step : no filter
             sshn(:,:) = ssha(:,:)                            ! now <-- after  (before already = now)
@@ -272,5 +340,5 @@
             DO jj = 1, jpj
                DO ji = 1, jpi                                ! before <-- now filtered
-                  sshb(ji,jj) = sshn(ji,jj) + atfp * ( sshb(ji,jj) - 2 * sshn(ji,jj) + ssha(ji,jj) )    
+                  sshb(ji,jj) = sshn(ji,jj) + atfp * ( sshb(ji,jj) - 2 * sshn(ji,jj) + ssha(ji,jj) )
                   sshn(ji,jj) = ssha(ji,jj)                  ! now <-- after
                END DO
@@ -280,10 +348,10 @@
       ENDIF
       !
+      ! Update velocity at AGRIF zoom boundaries
 #if defined key_agrif
-      ! Update velocity at AGRIF zoom boundaries
-      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 )
+      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 )
       !
    END SUBROUTINE ssh_nxt
Index: trunk/NEMOGCM/NEMO/OPA_SRC/FLO/flo4rk.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/FLO/flo4rk.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/FLO/flo4rk.F90	(revision 2528)
@@ -11,5 +11,4 @@
    !!   flo_interp     : interpolation
    !!----------------------------------------------------------------------
-   !! * Modules used
    USE flo_oce         ! ocean drifting floats
    USE oce             ! ocean dynamics and tracers
@@ -20,21 +19,20 @@
    PRIVATE
 
-   !! * Accessibility
-   PUBLIC flo_4rk      ! routine called by floats.F90
-
-   !! * Module variables
-   REAL(wp), DIMENSION (4) ::   &   ! RK4 and Lagrange interpolation
-      tcoef1 = (/  1.0  ,  0.5  ,  0.5  ,  0.0  /) ,  &  ! coeffients  for 
-      tcoef2 = (/  0.0  ,  0.5  ,  0.5  ,  1.0  /) ,  &  ! lagrangian interp.
-      scoef2 = (/  1.0  ,  2.0  ,  2.0  ,  1.0  /) ,  &  ! RK4 coefficients
-      rcoef  = (/-1./6. , 1./2. ,-1./2. , 1./6. /)       ! ???
-   REAL(wp), DIMENSION (3) ::   &
-      scoef1 = (/ .5, .5, 1. /)       ! compute position with interpolated
-   !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
+   PUBLIC   flo_4rk    ! routine called by floats.F90
+
+   !                                   ! RK4 and Lagrange interpolation coefficients
+   REAL(wp), DIMENSION (4) ::   tcoef1 = (/  1.0  ,  0.5  ,  0.5  ,  0.0  /)   ! 
+   REAL(wp), DIMENSION (4) ::   tcoef2 = (/  0.0  ,  0.5  ,  0.5  ,  1.0  /)   !
+   REAL(wp), DIMENSION (4) ::   scoef2 = (/  1.0  ,  2.0  ,  2.0  ,  1.0  /)   !
+   REAL(wp), DIMENSION (4) ::   rcoef  = (/-1./6. , 1./2. ,-1./2. , 1./6. /)   !
+   REAL(wp), DIMENSION (3) ::   scoef1 = (/  0.5  ,  0.5  ,  1.0  /)           !
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
@@ -50,17 +48,11 @@
       !!         We need to know the velocity field, the old positions of the
       !!       floats and the grid defined on the domain.
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
       !!
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      INTEGER, INTENT(in) ::   kt     ! ocean time-step index
-
-      !! * Local declarations
       INTEGER ::  jfl, jind           ! dummy loop indices
-      REAL(wp), DIMENSION ( jpnfl)  ::   &
-         zgifl, zgjfl, zgkfl,   &     ! index RK  positions
-         zufl, zvfl, zwfl             ! interpolated velocity at the
-      ! float position 
-      REAL(wp), DIMENSION ( jpnfl, 4 )  ::    &
-         zrkxfl, zrkyfl, zrkzfl       ! RK coefficients
+      REAL(wp), DIMENSION(jpnfl)   ::   zgifl , zgjfl , zgkfl    ! index RK  positions
+      REAL(wp), DIMENSION(jpnfl)   ::   zufl  , zvfl  , zwfl     ! interpolated velocity at the float position 
+      REAL(wp), DIMENSION(jpnfl,4) ::   zrkxfl, zrkyfl, zrkzfl   ! RK coefficients
       !!---------------------------------------------------------------------
     
@@ -127,11 +119,10 @@
       END DO
        
-      DO  jind = 1, 4
-         
+      DO  jind = 1, 4         
+      
          ! for each step we compute the compute the velocity with Lagrange interpolation
-         CALL flo_interp(zgifl,zgjfl,zgkfl,zufl,zvfl,zwfl,jind)
+         CALL flo_interp( zgifl, zgjfl, zgkfl, zufl, zvfl, zwfl, jind )
          
          ! computation of Runge-Kutta factor
-         
          DO jfl = 1, jpnfl
             zrkxfl(jfl,jind) = rdt*zufl(jfl)
@@ -154,10 +145,10 @@
          END DO
       END DO
-
+      !
    END SUBROUTINE flo_4rk
 
 
    SUBROUTINE flo_interp( pxt , pyt , pzt ,      &
-      &                   pufl, pvfl, pwfl, kind )
+      &                   pufl, pvfl, pwfl, ki )
       !!----------------------------------------------------------------------
       !!                ***  ROUTINE flointerp  ***
@@ -169,28 +160,21 @@
       !!      compute velocity at the date and the position we need to
       !!      integrated with RK method.
+      !!----------------------------------------------------------------------
+      REAL(wp) , DIMENSION(jpnfl), INTENT(in   ) ::   pxt , pyt , pzt    ! position of the float
+      REAL(wp) , DIMENSION(jpnfl), INTENT(  out) ::   pufl, pvfl, pwfl   ! velocity at this position
+      INTEGER                    , INTENT(in   ) ::   ki                 !
       !!
-      !!----------------------------------------------------------------------
-      !! * Local declarations
-      INTEGER ::   &
-         kind,   &
-         jfl, jind1, jind2, jind3,   &
-         zsumu, zsumv, zsumw
-      INTEGER , DIMENSION  ( jpnfl  ) ::   &
-         iilu, ijlu, iklu,     &           ! nearest neighbour INDEX-u
-         iilv, ijlv, iklv,     &           ! nearest neighbour INDEX-v
-         iilw, ijlw, iklw                  ! nearest neighbour INDEX-w
-      INTEGER , DIMENSION  ( jpnfl, 4  ) ::   &
-         iidu, ijdu, ikdu,    &            ! 64 nearest neighbour INDEX-u
-         iidv, ijdv, ikdv,    &            ! 64 nearest neighbour INDEX-v
-         iidw, ijdw, ikdw                  ! 64 nearest neighbour INDEX-w
-      REAL(wp) , DIMENSION  ( jpnfl  ) ::   &
-         pxt , pyt , pzt,     &            ! position of the float
-         pufl, pvfl, pwfl                  ! velocity at this position
-      REAL(wp) , DIMENSION  ( jpnfl, 4, 4, 4 ) ::   &
-         ztufl, ztvfl, ztwfl               ! velocity at choosen time step
-      REAL(wp) , DIMENSION  ( jpnfl, 4 ) ::   &
-         zlagxu, zlagyu, zlagzu,   &       ! Lagrange  coefficients
-         zlagxv, zlagyv, zlagzv,   &
-         zlagxw, zlagyw, zlagzw
+      INTEGER  ::   jfl, jind1, jind2, jind3   ! dummy loop indices
+      REAL(wp) ::   zsumu, zsumv, zsumw        ! local scalar
+      INTEGER , DIMENSION(jpnfl)   ::   iilu, ijlu, iklu   ! nearest neighbour INDEX-u
+      INTEGER , DIMENSION(jpnfl)   ::   iilv, ijlv, iklv   ! nearest neighbour INDEX-v
+      INTEGER , DIMENSION(jpnfl)   ::   iilw, ijlw, iklw   ! nearest neighbour INDEX-w
+      INTEGER , DIMENSION(jpnfl,4) ::   iidu, ijdu, ikdu   ! 64 nearest neighbour INDEX-u
+      INTEGER , DIMENSION(jpnfl,4) ::   iidv, ijdv, ikdv   ! 64 nearest neighbour INDEX-v
+      INTEGER , DIMENSION(jpnfl,4) ::   iidw, ijdw, ikdw   ! 64 nearest neighbour INDEX-w
+      REAL(wp) , DIMENSION(jpnfl,4,4,4) ::   ztufl , ztvfl , ztwfl   ! velocity at choosen time step
+      REAL(wp) , DIMENSION(jpnfl,4)     ::   zlagxu, zlagyu, zlagzu   ! Lagrange  coefficients
+      REAL(wp) , DIMENSION(jpnfl,4)     ::   zlagxv, zlagyv, zlagzv   !    -           -
+      REAL(wp) , DIMENSION(jpnfl,4)     ::   zlagxw, zlagyw, zlagzw   !    -           -
       !!---------------------------------------------------------------------
       
@@ -208,31 +192,22 @@
          DO jfl = 1, jpnfl
             !  i-direction
-            IF( iilu(jfl) <= 2 ) THEN
-               iidu(jfl,jind1) = jind1
-            ELSE
-               IF( iilu(jfl) >= jpi-1 ) THEN
-                  iidu(jfl,jind1) = jpi + jind1 - 4
-               ELSE
-                  iidu(jfl,jind1) = iilu(jfl) + jind1 - 2
+            IF( iilu(jfl) <= 2 ) THEN          ;   iidu(jfl,jind1) = jind1
+            ELSE
+               IF( iilu(jfl) >= jpi-1 ) THEN   ;   iidu(jfl,jind1) = jpi       + jind1 - 4
+               ELSE                            ;   iidu(jfl,jind1) = iilu(jfl) + jind1 - 2
                ENDIF
             ENDIF
             !  j-direction
-            IF( ijlu(jfl) <= 2 ) THEN
-               ijdu(jfl,jind1) = jind1
-            ELSE
-               IF( ijlu(jfl) >= jpj-1 ) THEN
-                  ijdu(jfl,jind1) = jpj + jind1 - 4
-               ELSE
-                  ijdu(jfl,jind1) = ijlu(jfl) + jind1 - 2
+            IF( ijlu(jfl) <= 2 ) THEN          ;   ijdu(jfl,jind1) = jind1
+            ELSE
+               IF( ijlu(jfl) >= jpj-1 ) THEN   ;   ijdu(jfl,jind1) = jpj       + jind1 - 4
+               ELSE                            ;   ijdu(jfl,jind1) = ijlu(jfl) + jind1 - 2
                ENDIF
             ENDIF
             ! k-direction
-            IF( iklu(jfl) <= 2 ) THEN
-               ikdu(jfl,jind1) = jind1
-            ELSE
-               IF( iklu(jfl) >= jpk-1 ) THEN
-                  ikdu(jfl,jind1) = jpk + jind1 - 4
-               ELSE
-                  ikdu(jfl,jind1) = iklu(jfl) + jind1 - 2
+            IF( iklu(jfl) <= 2 ) THEN          ;   ikdu(jfl,jind1) = jind1
+            ELSE
+               IF( iklu(jfl) >= jpk-1 ) THEN   ;   ikdu(jfl,jind1) = jpk + jind1 - 4
+               ELSE                            ;   ikdu(jfl,jind1) = iklu(jfl) + jind1 - 2
                ENDIF
             ENDIF
@@ -241,5 +216,4 @@
       
       ! Lagrange coefficients
-      
       DO jfl = 1, jpnfl
          DO jind1 = 1, 4
@@ -249,5 +223,4 @@
          END DO
       END DO
-      
       DO jind1 = 1, 4
          DO jind2 = 1, 4
@@ -269,6 +242,6 @@
                DO jind3 = 1, 4
                   ztufl(jfl,jind1,jind2,jind3) =   &
-                     &   (  tcoef1(kind) * ub(iidu(jfl,jind1),ijdu(jfl,jind2),ikdu(jfl,jind3)) +   &
-                     &      tcoef2(kind) * un(iidu(jfl,jind1),ijdu(jfl,jind2),ikdu(jfl,jind3)) )   &
+                     &   (  tcoef1(ki) * ub(iidu(jfl,jind1),ijdu(jfl,jind2),ikdu(jfl,jind3)) +   &
+                     &      tcoef2(ki) * un(iidu(jfl,jind1),ijdu(jfl,jind2),ikdu(jfl,jind3)) )   &
                      &      / e1u(iidu(jfl,jind1),ijdu(jfl,jind2)) 
                END DO
@@ -301,31 +274,22 @@
          DO jfl = 1, jpnfl
             ! i-direction
-            IF( iilv(jfl) <= 2 ) THEN
-               iidv(jfl,jind1) = jind1
-            ELSE
-               IF( iilv(jfl) >= jpi-1 ) THEN
-                  iidv(jfl,jind1) = jpi + jind1 - 4
-               ELSE
-                  iidv(jfl,jind1) = iilv(jfl) + jind1 - 2
+            IF( iilv(jfl) <= 2 ) THEN          ;   iidv(jfl,jind1) = jind1
+            ELSE
+               IF( iilv(jfl) >= jpi-1 ) THEN   ;   iidv(jfl,jind1) = jpi       + jind1 - 4
+               ELSE                            ;   iidv(jfl,jind1) = iilv(jfl) + jind1 - 2
                ENDIF
             ENDIF
             ! j-direction
-            IF( ijlv(jfl) <= 2 ) THEN
-               ijdv(jfl,jind1) = jind1
-            ELSE
-               IF( ijlv(jfl) >= jpj-1 ) THEN
-                  ijdv(jfl,jind1) = jpj + jind1 - 4
-               ELSE
-                  ijdv(jfl,jind1) = ijlv(jfl) + jind1 - 2
+            IF( ijlv(jfl) <= 2 ) THEN          ;   ijdv(jfl,jind1) = jind1
+            ELSE
+               IF( ijlv(jfl) >= jpj-1 ) THEN   ;   ijdv(jfl,jind1) = jpj       + jind1 - 4
+               ELSE                            ;   ijdv(jfl,jind1) = ijlv(jfl) + jind1 - 2
                ENDIF
             ENDIF
             ! k-direction
-            IF( iklv(jfl) <= 2 ) THEN
-               ikdv(jfl,jind1) = jind1
-            ELSE
-               IF( iklv(jfl) >= jpk-1 ) THEN
-                  ikdv(jfl,jind1) = jpk + jind1 - 4
-               ELSE
-                  ikdv(jfl,jind1) = iklv(jfl) + jind1 - 2
+            IF( iklv(jfl) <= 2 ) THEN          ;   ikdv(jfl,jind1) = jind1
+            ELSE
+               IF( iklv(jfl) >= jpk-1 ) THEN   ;   ikdv(jfl,jind1) = jpk + jind1 - 4
+               ELSE                            ;   ikdv(jfl,jind1) = iklv(jfl) + jind1 - 2
                ENDIF
             ENDIF
@@ -347,7 +311,7 @@
             DO jfl = 1, jpnfl
                IF( jind1 /= jind2 ) THEN
-                  zlagxv(jfl,jind1)= zlagxv(jfl,jind1)*(pxt(jfl) - (float(iidv(jfl,jind2))) )
+                  zlagxv(jfl,jind1)= zlagxv(jfl,jind1)*(pxt(jfl) - (float(iidv(jfl,jind2))   ) )
                   zlagyv(jfl,jind1)= zlagyv(jfl,jind1)*(pyt(jfl) - (float(ijdv(jfl,jind2))+.5) )
-                  zlagzv(jfl,jind1)= zlagzv(jfl,jind1)*(pzt(jfl) - (float(ikdv(jfl,jind2))) )
+                  zlagzv(jfl,jind1)= zlagzv(jfl,jind1)*(pzt(jfl) - (float(ikdv(jfl,jind2))   ) )
                ENDIF
             END DO
@@ -362,6 +326,6 @@
                DO jind3 = 1 ,4
                   ztvfl(jfl,jind1,jind2,jind3)=   &
-                     &   ( tcoef1(kind) * vb(iidv(jfl,jind1),ijdv(jfl,jind2),ikdv(jfl,jind3))  +   &
-                     &     tcoef2(kind) * vn(iidv(jfl,jind1),ijdv(jfl,jind2),ikdv(jfl,jind3)) )    & 
+                     &   ( tcoef1(ki) * vb(iidv(jfl,jind1),ijdv(jfl,jind2),ikdv(jfl,jind3))  +   &
+                     &     tcoef2(ki) * vn(iidv(jfl,jind1),ijdv(jfl,jind2),ikdv(jfl,jind3)) )    & 
                      &     / e2v(iidv(jfl,jind1),ijdv(jfl,jind2))
                END DO
@@ -385,7 +349,7 @@
       ! nearest neightboring point for computation of w 
       DO jfl = 1, jpnfl
-         iilw(jfl) = INT(pxt(jfl))
-         ijlw(jfl) = INT(pyt(jfl))
-         iklw(jfl) = INT(pzt(jfl)+.5)
+         iilw(jfl) = INT( pxt(jfl)   )
+         ijlw(jfl) = INT( pyt(jfl)   )
+         iklw(jfl) = INT( pzt(jfl)+.5)
       END DO
       
@@ -394,44 +358,32 @@
          DO jfl = 1, jpnfl
             ! i-direction
-            IF( iilw(jfl) <= 2 ) THEN
-               iidw(jfl,jind1) = jind1
-            ELSE
-               IF( iilw(jfl) >= jpi-1 ) THEN
-                  iidw(jfl,jind1) = jpi + jind1 - 4
-               ELSE
-                  iidw(jfl,jind1) = iilw(jfl) + jind1 - 2
+            IF( iilw(jfl) <= 2 ) THEN          ;   iidw(jfl,jind1) = jind1
+            ELSE
+               IF( iilw(jfl) >= jpi-1 ) THEN   ;   iidw(jfl,jind1) = jpi       + jind1 - 4
+               ELSE                            ;   iidw(jfl,jind1) = iilw(jfl) + jind1 - 2
                ENDIF
             ENDIF
             ! j-direction
-            IF( ijlw(jfl) <= 2 ) THEN
-               ijdw(jfl,jind1) = jind1
-            ELSE
-               IF( ijlw(jfl) >= jpj-1 ) THEN
-                  ijdw(jfl,jind1) = jpj + jind1 - 4
-               ELSE
-                  ijdw(jfl,jind1) = ijlw(jfl) + jind1 - 2
+            IF( ijlw(jfl) <= 2 ) THEN          ;   ijdw(jfl,jind1) = jind1
+            ELSE
+               IF( ijlw(jfl) >= jpj-1 ) THEN   ;   ijdw(jfl,jind1) = jpj       + jind1 - 4
+               ELSE                            ;   ijdw(jfl,jind1) = ijlw(jfl) + jind1 - 2
                ENDIF
             ENDIF
             ! k-direction
-            IF( iklw(jfl) <= 2 ) THEN
-               ikdw(jfl,jind1) = jind1
-            ELSE
-               IF( iklw(jfl) >= jpk-1 ) THEN
-                  ikdw(jfl,jind1) = jpk + jind1 - 4
-               ELSE
-                  ikdw(jfl,jind1) = iklw(jfl) + jind1 - 2
-               ENDIF
-            ENDIF
-         END DO
-      END DO
-      DO jind1 = 1, 4
-         DO jfl = 1, jpnfl
-            IF( iklw(jfl) <= 2 ) THEN
-               ikdw(jfl,jind1) = jind1
-            ELSE
-               IF( iklw(jfl) >= jpk-1 ) THEN
-                  ikdw(jfl,jind1) = jpk + jind1 - 4
-               ELSE
-                  ikdw(jfl,jind1) = iklw(jfl) + jind1 - 2
+            IF( iklw(jfl) <= 2 ) THEN          ;   ikdw(jfl,jind1) = jind1
+            ELSE
+               IF( iklw(jfl) >= jpk-1 ) THEN   ;   ikdw(jfl,jind1) = jpk       + jind1 - 4
+               ELSE                            ;   ikdw(jfl,jind1) = iklw(jfl) + jind1 - 2
+               ENDIF
+            ENDIF
+         END DO
+      END DO
+      DO jind1 = 1, 4
+         DO jfl = 1, jpnfl
+            IF( iklw(jfl) <= 2 ) THEN          ;   ikdw(jfl,jind1) = jind1
+            ELSE
+               IF( iklw(jfl) >= jpk-1 ) THEN   ;   ikdw(jfl,jind1) = jpk       + jind1 - 4
+               ELSE                            ;   ikdw(jfl,jind1) = iklw(jfl) + jind1 - 2
                ENDIF
             ENDIF
@@ -440,5 +392,4 @@
       
       ! Lagrange coefficients  for w interpolation
-      
       DO jfl = 1, jpnfl
          DO jind1 = 1, 4
@@ -448,11 +399,10 @@
          END DO
       END DO
-       
       DO jind1 = 1, 4
          DO jind2 = 1, 4
             DO jfl = 1, jpnfl
                IF( jind1 /= jind2 ) THEN
-                  zlagxw(jfl,jind1) = zlagxw(jfl,jind1) * (pxt(jfl) - (float(iidw(jfl,jind2))) )
-                  zlagyw(jfl,jind1) = zlagyw(jfl,jind1) * (pyt(jfl) - (float(ijdw(jfl,jind2))) )
+                  zlagxw(jfl,jind1) = zlagxw(jfl,jind1) * (pxt(jfl) - (float(iidw(jfl,jind2))   ) )
+                  zlagyw(jfl,jind1) = zlagyw(jfl,jind1) * (pyt(jfl) - (float(ijdw(jfl,jind2))   ) )
                   zlagzw(jfl,jind1) = zlagzw(jfl,jind1) * (pzt(jfl) - (float(ikdw(jfl,jind2))-.5) )
                ENDIF
@@ -462,5 +412,4 @@
       
       ! velocity w  when we compute at middle time step
-      
       DO jfl = 1, jpnfl
          DO jind1 = 1, 4
@@ -468,13 +417,12 @@
                DO jind3 = 1, 4
                   ztwfl(jfl,jind1,jind2,jind3)=   &
-                     &   ( tcoef1(kind) * wb(iidw(jfl,jind1),ijdw(jfl,jind2),ikdw(jfl,jind3))+   &
-                     &     tcoef2(kind) * wn(iidw(jfl,jind1),ijdw(jfl,jind2),ikdw(jfl,jind3)) )  &
-!!bug e3w instead of fse3 
-                     &   / e3w(ikdw(jfl,jind3))
+                     &   ( tcoef1(ki) * wb(iidw(jfl,jind1),ijdw(jfl,jind2),ikdw(jfl,jind3))+   &
+                     &     tcoef2(ki) * wn(iidw(jfl,jind1),ijdw(jfl,jind2),ikdw(jfl,jind3)) )  &
+                     &   / fse3w(iidw(jfl,jind1),ijdw(jfl,jind2),ikdw(jfl,jind3))
                END DO
             END DO
          END DO
          
-         zsumw=0.
+         zsumw = 0.e0
          DO jind1 = 1, 4
             DO jind2 = 1, 4
@@ -487,14 +435,11 @@
          pwfl(jfl) = zsumw
       END DO
-      
+      !   
    END SUBROUTINE flo_interp
 
 #  else
    !!----------------------------------------------------------------------
-   !!   Default option                                         Empty module
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE flo_4rk                 ! Empty routine
-   END SUBROUTINE flo_4rk
+   !!   No floats                                              Dummy module
+   !!----------------------------------------------------------------------
 #endif
    
Index: trunk/NEMOGCM/NEMO/OPA_SRC/FLO/flo_oce.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/FLO/flo_oce.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/FLO/flo_oce.F90	(revision 2528)
@@ -20,24 +20,24 @@
    !! float parameters
    !! ----------------
-   INTEGER, PUBLIC, PARAMETER ::   jpnfl     = 23 ,                !: total number of floats during the run
-   INTEGER, PUBLIC, PARAMETER ::   jpnnewflo =  0 ,                !: number of floats added in a new run
+   INTEGER, PUBLIC, PARAMETER ::   jpnfl     = 23                  !: total number of floats during the run
+   INTEGER, PUBLIC, PARAMETER ::   jpnnewflo =  0                  !: number of floats added in a new run
    INTEGER, PUBLIC, PARAMETER ::   jpnrstflo = jpnfl - jpnnewflo   !: number of floats for the restart
 
    !! float variables
    !! ---------------
-   INTEGER, PUBLIC, DIMENSION(jpnfl)  ::   nisobfl   !: =0 for a isobar float , =1 for a float following the w velocity
-   INTEGER, PUBLIC, DIMENSION(jpnfl)  ::   ngrpfl    !: number to identify searcher group
+   INTEGER , PUBLIC, DIMENSION(jpnfl) ::   nisobfl   !: =0 for a isobar float , =1 for a float following the w velocity
+   INTEGER , PUBLIC, DIMENSION(jpnfl) ::   ngrpfl    !: number to identify searcher group
 
-   REAL(wp), PUBLIC, DIMENSION(jpnfl) ::   flxx , flyy , flzz    !: longitude, latitude, depth of float (decimal degree, m >0)
+   REAL(wp), PUBLIC, DIMENSION(jpnfl) ::   flxx , flyy , flzz    !: long, lat, depth of float (decimal degree, m >0)
    REAL(wp), PUBLIC, DIMENSION(jpnfl) ::   tpifl, tpjfl, tpkfl   !: (i,j,k) indices of float position
 
-   REAL(wp), PUBLIC, DIMENSION(jpi, jpj, jpk) ::   wb            !: vertical velocity at previous time step (m s-1).
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   wb              !: vertical velocity at previous time step (m s-1).
    
-   !                                  !!! * namelist namflo : langrangian floats *
+   !                                            !!! * namelist namflo : langrangian floats *
    LOGICAL, PUBLIC  ::   ln_rstflo  = .FALSE.    !: T/F float restart 
    LOGICAL, PUBLIC  ::   ln_argo    = .FALSE.    !: T/F argo type floats
    LOGICAL, PUBLIC  ::   ln_flork4  = .FALSE.    !: T/F 4th order Runge-Kutta
-   INTEGER, PUBLIC  ::   nn_writefl = 150       !: frequency of float output file 
-   INTEGER, PUBLIC  ::   nn_stockfl = 450       !: frequency of float restart file
+   INTEGER, PUBLIC  ::   nn_writefl = 150        !: frequency of float output file 
+   INTEGER, PUBLIC  ::   nn_stockfl = 450        !: frequency of float restart file
 
 #else
@@ -49,7 +49,7 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!======================================================================
 END MODULE flo_oce
Index: trunk/NEMOGCM/NEMO/OPA_SRC/FLO/floats.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/FLO/floats.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/FLO/floats.F90	(revision 2528)
@@ -14,4 +14,5 @@
    !!   flo_init  : initialization of float trajectories computation
    !!----------------------------------------------------------------------
+   USE oce             ! ocean variables
    USE flo_oce         ! floats variables
    USE lib_mpp         ! distributed memory computing
@@ -20,4 +21,5 @@
    USE flo4rk          ! Trajectories, Runge Kutta scheme (flo_4rk routine)
    USE floblk          ! Trajectories, Blanke scheme      (flo_blk routine)
+   USE in_out_manager  ! I/O manager
 
    IMPLICIT NONE
@@ -25,11 +27,11 @@
 
    PUBLIC   flo_stp    ! routine called by step.F90
+   PUBLIC   flo_init   ! routine called by opa.F90
 
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -52,6 +54,4 @@
          IF(lwp) WRITE(numout,*) 'flo_stp : call floats routine '
          IF(lwp) WRITE(numout,*) '~~~~~~~'
-
-         CALL flo_init           ! read the namelist of floats             
 
          CALL flo_dom            ! compute/read initial position of floats
@@ -80,6 +80,4 @@
       !! ** Purpose :   Read the namelist of floats
       !!----------------------------------------------------------------------
-      USE ioipsl
-      !!
       NAMELIST/namflo/ ln_rstflo, nn_writefl, nn_stockfl, ln_argo, ln_flork4 
       !!---------------------------------------------------------------------
@@ -91,9 +89,9 @@
          WRITE(numout,*)
          WRITE(numout,*) '         Namelist floats :'
-         WRITE(numout,*) '            restart                          ln_rstflo = ', ln_rstflo
-         WRITE(numout,*) '            frequency of float output file   nn_writefl  = ', nn_writefl
-         WRITE(numout,*) '            frequency of float restart file  nn_stockfl  = ', nn_stockfl
-         WRITE(numout,*) '            Argo type floats                 ln_argo   = ', ln_argo
-         WRITE(numout,*) '            Computation of T trajectories    ln_flork4 = ', ln_flork4
+         WRITE(numout,*) '            restart                          ln_rstflo  = ', ln_rstflo
+         WRITE(numout,*) '            frequency of float output file   nn_writefl = ', nn_writefl
+         WRITE(numout,*) '            frequency of float restart file  nn_stockfl = ', nn_stockfl
+         WRITE(numout,*) '            Argo type floats                 ln_argo    = ', ln_argo
+         WRITE(numout,*) '            Computation of T trajectories    ln_flork4  = ', ln_flork4
       ENDIF
       !
@@ -108,4 +106,6 @@
       WRITE(*,*) 'flo_stp: You should not have seen this print! error?', kt
    END SUBROUTINE flo_stp
+   SUBROUTINE flo_init          ! Empty routine
+   END SUBROUTINE flo_init
 #endif
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/FLO/floblk.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/FLO/floblk.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/FLO/floblk.F90	(revision 2528)
@@ -8,9 +8,6 @@
    !!   'key_floats'                                     float trajectories
    !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
    !!    flotblk     : compute float trajectories with Blanke algorithme
    !!----------------------------------------------------------------------
-   !! * Modules used
    USE flo_oce         ! ocean drifting floats
    USE oce             ! ocean dynamics and tracers
@@ -23,15 +20,13 @@
    PRIVATE
 
-   !! * Accessibility
-   PUBLIC flo_blk      ! routine called by floats.F90
+   PUBLIC   flo_blk    ! routine called by floats.F90
 
    !! * Substitutions
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
@@ -46,10 +41,7 @@
       !!      algorithm. We need to know the velocity field, the old positions
       !!      of the floats and the grid defined on the domain.
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in  ) ::   kt ! ocean time step
       !!
-      !!----------------------------------------------------------------------
-      !! * arguments
-      INTEGER, INTENT( in  ) ::   kt ! ocean time step
-
-      !! * Local declarations
       INTEGER :: jfl              ! dummy loop arguments
       INTEGER :: ind, ifin, iloop
@@ -78,6 +70,5 @@
          zsurfz,                    &     ! surface of the face of the mesh 
          zind
-      REAL(wp), DIMENSION ( 2 )  ::   &
-         zsurfx, zsurfy                   ! surface of the face of the mesh
+      REAL(wp), DIMENSION ( 2 )  ::   zsurfx, zsurfy   ! surface of the face of the mesh
       !!---------------------------------------------------------------------
       
@@ -111,5 +102,5 @@
       iloop = 0
 222   DO jfl = 1, jpnfl
-# if   defined key_mpp_mpi   ||   defined key_mpp_shmem
+# if   defined key_mpp_mpi
          IF( (iil(jfl) >= (mig(nldi)-jpizoom+1)) .AND. (iil(jfl) <= (mig(nlei)-jpizoom+1)) .AND.   &
              (ijl(jfl) >= (mjg(nldj)-jpjzoom+1)) .AND. (ijl(jfl) <= (mjg(nlej)-jpjzoom+1)) ) THEN
@@ -327,5 +318,5 @@
             ! reinitialisation of the age of FLOAT
             zagefl(jfl) = zagenewfl(jfl)
-# if   defined key_mpp_mpi   ||   defined key_mpp_shmem
+# if   defined key_mpp_mpi
          ELSE
             ! we put zgifl, zgjfl, zgkfl, zagefl
@@ -413,5 +404,5 @@
          GO TO 222
       ENDIF
-
+      !
    END SUBROUTINE flo_blk
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/FLO/flodom.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/FLO/flodom.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/FLO/flodom.F90	(revision 2528)
@@ -4,4 +4,6 @@
    !! Ocean floats :   domain
    !!======================================================================
+   !! History :  OPA  ! 1998-07 (Y.Drillet, CLIPPER)  Original code
+   !!----------------------------------------------------------------------
 #if   defined key_floats   ||   defined key_esopa
    !!----------------------------------------------------------------------
@@ -12,5 +14,4 @@
    !!   dstnce         : compute distance between face mesh and floats 
    !!----------------------------------------------------------------------
-   !! * Modules used
    USE oce             ! ocean dynamics and tracers
    USE dom_oce         ! ocean space and time domain
@@ -20,17 +21,15 @@
 
    IMPLICIT NONE
-
-   !! * Accessibility
-   PRIVATE  dstnce
-   PUBLIC flo_dom     ! routine called by floats.F90
+   PRIVATE
+
+   PUBLIC   flo_dom    ! routine called by floats.F90
 
    !! * Substitutions
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
@@ -42,17 +41,14 @@
       !!
       !!  ** Method  :   We put the floats  in the domain with the latitude,
-      !!       the longitude (degree) and the depth (m).
-      !!
+      !!               the longitude (degree) and the depth (m).
       !!----------------------------------------------------------------------      
-      !! * Local declarations
-      LOGICAL  :: llinmesh
-      INTEGER  :: ji, jj, jk               ! DO loop index on 3 directions
-      INTEGER  :: jfl, jfl1                ! number of floats   
-      INTEGER  :: inum                     ! logical unit for file read
-      INTEGER, DIMENSION ( jpnfl    )  ::   &
-         iimfl, ijmfl, ikmfl,    &          ! index mesh of floats
-         idomfl,  ivtest, ihtest
-      REAL(wp) :: zdxab, zdyad
-      REAL(wp), DIMENSION ( jpnnewflo+1 )  :: zgifl, zgjfl,  zgkfl
+      LOGICAL  ::   llinmesh
+      INTEGER  ::   ji, jj, jk   ! DO loop index on 3 directions
+      INTEGER  ::   jfl, jfl1    ! number of floats   
+      INTEGER  ::   inum         ! logical unit for file read
+      INTEGER, DIMENSION(jpnfl) ::   iimfl, ijmfl, ikmfl       ! index mesh of floats
+      INTEGER, DIMENSION(jpnfl) ::   idomfl,  ivtest, ihtest   !   -             -
+      REAL(wp) ::   zdxab, zdyad
+      REAL(wp), DIMENSION(jpnnewflo+1)  :: zgifl, zgjfl,  zgkfl
       !!---------------------------------------------------------------------
       
@@ -102,5 +98,5 @@
                ivtest(jfl) = 0
                ikmfl(jfl) = 0
-# if   defined key_mpp_mpi   ||   defined key_mpp_shmem
+# if   defined key_mpp_mpi
                DO ji = MAX(nldi,2), nlei
                   DO jj = MAX(nldj,2), nlej   ! NO vector opt.
@@ -139,5 +135,5 @@
             
             ! A zero in the sum of the arrays "ihtest" and "ivtest"             
-# if   defined key_mpp_mpi   ||   defined key_mpp_shmem
+# if   defined key_mpp_mpi
             CALL mpp_sum(ihtest,jpnfl)
             CALL mpp_sum(ivtest,jpnfl)
@@ -233,5 +229,5 @@
             ivtest(jfl) = 0
             ikmfl(jfl) = 0
-# if   defined key_mpp_mpi   ||   defined key_mpp_shmem
+# if   defined key_mpp_mpi
             DO ji = MAX(nldi,2), nlei
                DO jj = MAX(nldj,2), nlej   ! NO vector opt.
@@ -357,9 +353,5 @@
       !!
       !! ** Method  : 
-      !!
-      !! History :
-      !!   8.0  !  98-07 (Y.Drillet)  Original code
       !!----------------------------------------------------------------------
-      !! * Arguments
       REAL(wp) ::   &
          pax, pay, pbx, pby,    &     ! ???
@@ -368,15 +360,13 @@
          ptx, pty                     ! ???
       LOGICAL ::  ldinmesh            ! ???
-
-      !! * local declarations
-      REAL(wp) ::   &
-         zabt, zbct, zcdt, zdat, zabpt, zbcpt, zcdpt, zdapt,  &
-         psax,psay,psbx,psby,psx,psy
-      REAL(wp) ::  fsline                ! Statement function
-
-      !! * Substitutions
-      fsline(psax, psay, psbx, psby, psx, psy) = psy  * ( psbx - psax )   &
-                                               - psx  * ( psby - psay )   &
-                                               + psax *   psby - psay * psbx
+      !!
+      REAL(wp) ::   zabt, zbct, zcdt, zdat, zabpt, zbcpt, zcdpt, zdapt
+      !!---------------------------------------------------------------------
+      !! Statement function
+      REAL(wp) ::   fsline
+      REAL(wp) ::   psax, psay, psbx, psby, psx, psy
+      fsline( psax, psay, psbx, psby, psx, psy ) = psy  * ( psbx - psax )   &
+         &                                       - psx  * ( psby - psay )   &
+         &                                       + psax *   psby - psay * psbx
       !!---------------------------------------------------------------------
       
@@ -411,5 +401,5 @@
          ldinmesh=.FALSE.
       ENDIF
-
+      !
    END SUBROUTINE findmesh
 
@@ -422,14 +412,11 @@
       !!                points
       !! ** Method  : 
-      !!         
       !!----------------------------------------------------------------------
-      !! * Arguments
       REAL(wp), INTENT(in) ::   pla1, phi1, pla2, phi2   ! ???
-
-      !! * Local variables
+      !!
       REAL(wp) ::   dly1, dly2, dlx1, dlx2, dlx, dls, dld, dpi
       REAL(wp) ::   dstnce
       !!---------------------------------------------------------------------
-      
+      !
       dpi  = 2.* ASIN(1.)
       dls  = dpi / 180.
@@ -438,12 +425,12 @@
       dlx1 = pla1 * dls
       dlx2 = pla2 * dls
-
+      !
       dlx = SIN(dly1) * SIN(dly2) + COS(dly1) * COS(dly2) * COS(dlx2-dlx1)
- 
+      !
       IF( ABS(dlx) > 1.0 ) dlx = 1.0
-
+      !
       dld = ATAN(DSQRT( ( 1-dlx )/( 1+dlx ) )) * 222.24 / dls
       dstnce = dld * 1000.
-
+      !
    END FUNCTION dstnce
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90	(revision 2528)
@@ -8,5 +8,4 @@
    !!   NEMO      1.0  ! 2002-11  (G. Madec, A. Bozec)  F90: Free form and module
    !!----------------------------------------------------------------------
-
 #if   defined key_floats   ||   defined key_esopa
    !!----------------------------------------------------------------------
@@ -32,9 +31,8 @@
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
@@ -52,12 +50,11 @@
       CHARACTER (len=21) ::  clname
       INTEGER ::   inum   ! temporary logical unit for restart file
-      INTEGER ::   iafl, ibfl, icfl, ia1fl, ib1fl, ic1fl, jfl, irecflo,   &
+      INTEGER ::   iafl, ibfl, icfl, ia1fl, ib1fl, ic1fl, jfl, irecflo
       INTEGER ::   iafloc, ibfloc, ia1floc, ib1floc, iafln, ibfln
       INTEGER  ::    ic, jc , jpn
-      INTEGER, DIMENSION ( jpnij )  :: iproc
-
-      REAL(wp) :: zafl,zbfl,zcfl,zdtj
-      REAL(wp) :: zxxu, zxxu_01,zxxu_10, zxxu_11
-      REAL(wp), DIMENSION (jpk,jpnfl) :: ztemp, zsal
+      INTEGER, DIMENSION ( jpnij )  ::   iproc
+      REAL(wp) ::   zafl,zbfl,zcfl,zdtj
+      REAL(wp) ::   zxxu, zxxu_01,zxxu_10, zxxu_11
+      REAL(wp), DIMENSION (jpk,jpnfl) ::   ztemp, zsal   ! 2D workspace
       !!---------------------------------------------------------------------
       
@@ -74,5 +71,4 @@
          ! open the file numflo 
          CALL ctl_opn( numflo, 'trajec_float', 'REPLACE', 'UNFORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
-         !      REWIND numflo
 
          IF( kt == nit000 ) THEN
@@ -80,5 +76,5 @@
             IF(lwp) WRITE(numflo)cexper,no,irecflo,jpnfl,nn_writefl
          ENDIF
-         zdtj = rdt / 86400.      !!bug   use of 86400 instead of the phycst parameter
+         zdtj = rdt / 86400._wp
 
          ! translation of index position in geographical position
@@ -195,5 +191,5 @@
       !         iafln=NINT(tpifl(jfl))
       !         ibfln=NINT(tpjfl(jfl))
-      !# if defined key_mpp_mpi   ||   defined key_mpp_shmem
+      !# if defined key_mpp_mpi   
       !        IF ( (iafl >= (mig(nldi)-jpizoom+1)) .AND.
       !     $       (iafl <= (mig(nlei)-jpizoom+1)) .AND.
@@ -214,5 +210,5 @@
       !         ztemp(jfl)=tn(iafloc,ibfloc,jk)
       !         zsal(jfl)=sn(iaflo!,ibfloc,jk)
-      !# if defined key_mpp_mpi   ||   defined key_mpp_shmem
+      !# if defined key_mpp_mpi   
       !        ELSE
       !         ztemp(jfl) = 0.
@@ -298,5 +294,5 @@
 
       IF( kt == nitend )   CLOSE( numflo ) 
-    
+      !
    END SUBROUTINE flo_wri
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90	(revision 2528)
@@ -9,4 +9,5 @@
    !!             3.0  !  2008-06  (G. Madec)   add ctmp4 to ctmp10
    !!             3.2  !  2009-08  (S. MAsson)  add new ctl_opn
+   !!             3.3  !  2010-10  (A. Coward)  add NetCDF4 usage
    !!----------------------------------------------------------------------
 
@@ -16,7 +17,7 @@
    !!   getunit    : give the index of an unused logical unit
    !!----------------------------------------------------------------------
-   USE par_kind        ! kind definition
-   USE par_oce         ! ocean parameter
-   USE lib_print       ! formated print library
+   USE par_oce       ! ocean parameter
+   USE lib_print     ! formated print library
+   USE nc4interface  ! NetCDF4 interface
 
    IMPLICIT NONE
@@ -26,91 +27,112 @@
    !!                   namrun namelist parameters
    !!----------------------------------------------------------------------
-   CHARACTER(len=16)  ::   cn_exp        = "exp0"      !: experiment name used for output filename
-   CHARACTER(len=32)  ::   cn_ocerst_in  = "restart"   !: suffix of ocean restart name (input)
-   CHARACTER(len=32)  ::   cn_ocerst_out = "restart"   !: suffix of ocean restart name (output)
-   LOGICAL            ::   ln_rstart     = .FALSE.     !: start from (F) rest or (T) a restart file
-   INTEGER            ::   nn_no         = 0           !: job number
-   INTEGER            ::   nn_rstctl     = 0           !: control of the time step (0, 1 or 2)
-   INTEGER            ::   nn_rstssh     = 0           !: hand made initilization of ssh or not (1/0)
-   INTEGER            ::   nn_it000      = 1           !: index of the first time step
-   INTEGER            ::   nn_itend      = 10          !: index of the last time step
-   INTEGER            ::   nn_date0      = 961115      !: initial calendar date aammjj
-   INTEGER            ::   nn_leapy      = 0           !: Leap year calendar flag (0/1 or 30)
-   INTEGER            ::   nn_istate     = 0           !: initial state output flag (0/1)
-   INTEGER            ::   nn_write      =   10        !: model standard output frequency
-   INTEGER            ::   nn_stock      =   10        !: restart file frequency
-   LOGICAL            ::   ln_dimgnnn    = .FALSE.     !: type of dimgout. (F): 1 file for all proc
+   CHARACTER(lc) ::   cn_exp        = "exp0"      !: experiment name used for output filename
+   CHARACTER(lc) ::   cn_ocerst_in  = "restart"   !: suffix of ocean restart name (input)
+   CHARACTER(lc) ::   cn_ocerst_out = "restart"   !: suffix of ocean restart name (output)
+   LOGICAL       ::   ln_rstart     = .FALSE.     !: start from (F) rest or (T) a restart file
+   INTEGER       ::   nn_no         = 0           !: job number
+   INTEGER       ::   nn_rstctl     = 0           !: control of the time step (0, 1 or 2)
+   INTEGER       ::   nn_rstssh     = 0           !: hand made initilization of ssh or not (1/0)
+   INTEGER       ::   nn_it000      = 1           !: index of the first time step
+   INTEGER       ::   nn_itend      = 10          !: index of the last time step
+   INTEGER       ::   nn_date0      = 961115      !: initial calendar date aammjj
+   INTEGER       ::   nn_leapy      = 0           !: Leap year calendar flag (0/1 or 30)
+   INTEGER       ::   nn_istate     = 0           !: initial state output flag (0/1)
+   INTEGER       ::   nn_write      =   10        !: model standard output frequency
+   INTEGER       ::   nn_stock      =   10        !: restart file frequency
+   LOGICAL       ::   ln_dimgnnn    = .FALSE.     !: type of dimgout. (F): 1 file for all proc
                                                        !:                  (T): 1 file per proc
-   LOGICAL            ::   ln_mskland    = .FALSE.     !: mask land points in NetCDF outputs (costly: + ~15%)
-   LOGICAL            ::   ln_clobber    = .FALSE.     !: clobber (overwrite) an existing file
-   INTEGER            ::   nn_chunksz    = 0           !: chunksize (bytes) for NetCDF file (working only with iom_nf90 routines)
+   LOGICAL       ::   ln_mskland    = .FALSE.     !: mask land points in NetCDF outputs (costly: + ~15%)
+   LOGICAL       ::   ln_clobber    = .FALSE.     !: clobber (overwrite) an existing file
+   INTEGER       ::   nn_chunksz    = 0           !: chunksize (bytes) for NetCDF file (works only with iom_nf90 routines)
+#if defined key_netcdf4
+   !!----------------------------------------------------------------------
+   !!                   namnc4 namelist parameters                         (key_netcdf4)
+   !!----------------------------------------------------------------------
+   ! The following four values determine the partitioning of the output fields
+   ! into netcdf4 chunks. They are unrelated to the nn_chunk_sz setting which is
+   ! for runtime optimisation. The individual netcdf4 chunks can be optionally 
+   ! gzipped (recommended) leading to significant reductions in I/O volumes 
+   !                                   !!!**  variables only used with iom_nf90 routines and key_netcdf4 **
+   INTEGER ::   nn_nchunks_i = 1        !: number of chunks required in the i-dimension 
+   INTEGER ::   nn_nchunks_j = 1        !: number of chunks required in the j-dimension 
+   INTEGER ::   nn_nchunks_k = 1        !: number of chunks required in the k-dimension 
+   INTEGER ::   nn_nchunks_t = 1        !: number of chunks required in the t-dimension 
+   LOGICAL ::   ln_nc4zip    = .TRUE.   !: netcdf4 usage: (T) chunk and compress output using the HDF5 sublayers of netcdf4
+   !                                    !                 (F) ignore chunking request and use the netcdf4 library 
+   !                                    !                     to produce netcdf3-compatible files 
+#endif
+!$AGRIF_DO_NOT_TREAT
+   TYPE(snc4_ctl)     :: snc4set        !: netcdf4 chunking control structure (always needed for decision making)
+!$AGRIF_END_DO_NOT_TREAT
+
 
    !! conversion of DOCTOR norm namelist name into model name
    !! (this should disappear in a near futur)
 
-   CHARACTER(len=16)  ::   cexper                      !: experiment name used for output filename
-   INTEGER            ::   no                          !: job number
-   INTEGER            ::   nrstdt                      !: control of the time step (0, 1 or 2)
-   INTEGER            ::   nit000                      !: index of the first time step
-   INTEGER            ::   nitend                      !: index of the last time step
-   INTEGER            ::   ndate0                      !: initial calendar date aammjj
-   INTEGER            ::   nleapy                      !: Leap year calendar flag (0/1 or 30)
-   INTEGER            ::   ninist                      !: initial state output flag (0/1)
-   INTEGER            ::   nwrite                      !: model standard output frequency
-   INTEGER            ::   nstock                      !: restart file frequency
+   CHARACTER(lc) ::   cexper                      !: experiment name used for output filename
+   INTEGER       ::   no                          !: job number
+   INTEGER       ::   nrstdt                      !: control of the time step (0, 1 or 2)
+   INTEGER       ::   nit000                      !: index of the first time step
+   INTEGER       ::   nitend                      !: index of the last time step
+   INTEGER       ::   ndate0                      !: initial calendar date aammjj
+   INTEGER       ::   nleapy                      !: Leap year calendar flag (0/1 or 30)
+   INTEGER       ::   ninist                      !: initial state output flag (0/1)
+   INTEGER       ::   nwrite                      !: model standard output frequency
+   INTEGER       ::   nstock                      !: restart file frequency
 
    !!----------------------------------------------------------------------
    !! was in restart but moved here because of the OFF line... better solution should be found...
    !!----------------------------------------------------------------------
-   INTEGER            ::   nitrst                 !: time step at which restart file should be written
+   INTEGER ::   nitrst   !: time step at which restart file should be written
 
    !!----------------------------------------------------------------------
    !!                    output monitoring
    !!----------------------------------------------------------------------
-   LOGICAL            ::   ln_ctl     = .FALSE.   !: run control for debugging
-   INTEGER            ::   nn_print     =    0    !: level of print (0 no print)
-   INTEGER            ::   nn_ictls     =    0    !: Start i indice for the SUM control
-   INTEGER            ::   nn_ictle     =    0    !: End   i indice for the SUM control
-   INTEGER            ::   nn_jctls     =    0    !: Start j indice for the SUM control
-   INTEGER            ::   nn_jctle     =    0    !: End   j indice for the SUM control
-   INTEGER            ::   nn_isplt     =    1    !: number of processors following i
-   INTEGER            ::   nn_jsplt     =    1    !: number of processors following j
-   INTEGER            ::   nn_bench     =    0    !: benchmark parameter (0/1)
-   INTEGER            ::   nn_bit_cmp   =    0    !: bit reproducibility  (0/1)
-
-   !                                              !: OLD namelist names
-   INTEGER ::   nprint, nictls, nictle, njctls, njctle, isplt, jsplt, nbench, nbit_cmp   
-
-   INTEGER            ::   ijsplt     =    1      !: nb of local domain = nb of processors
+   LOGICAL ::   ln_ctl     = .FALSE.   !: run control for debugging
+   INTEGER ::   nn_print     =    0    !: level of print (0 no print)
+   INTEGER ::   nn_ictls     =    0    !: Start i indice for the SUM control
+   INTEGER ::   nn_ictle     =    0    !: End   i indice for the SUM control
+   INTEGER ::   nn_jctls     =    0    !: Start j indice for the SUM control
+   INTEGER ::   nn_jctle     =    0    !: End   j indice for the SUM control
+   INTEGER ::   nn_isplt     =    1    !: number of processors following i
+   INTEGER ::   nn_jsplt     =    1    !: number of processors following j
+   INTEGER ::   nn_bench     =    0    !: benchmark parameter (0/1)
+   INTEGER ::   nn_bit_cmp   =    0    !: bit reproducibility  (0/1)
+
+   !                                          
+   INTEGER ::   nprint, nictls, nictle, njctls, njctle, isplt, jsplt, nbench    !: OLD namelist names
+
+   INTEGER ::   ijsplt     =    1      !: nb of local domain = nb of processors
 
    !!----------------------------------------------------------------------
    !!                        logical units
    !!----------------------------------------------------------------------
-   INTEGER            ::   numstp     =   -1      !: logical unit for time step
-   INTEGER            ::   numout     =    6      !: logical unit for output print
-   INTEGER            ::   numnam     =   -1      !: logical unit for namelist
-   INTEGER            ::   numnam_ice =   -1      !: logical unit for ice namelist
-   INTEGER            ::   numevo_ice =   -1      !: logical unit for ice variables (temp. evolution)
-   INTEGER            ::   numsol     =   -1      !: logical unit for solver statistics
+   INTEGER ::   numstp     =   -1      !: logical unit for time step
+   INTEGER ::   numout     =    6      !: logical unit for output print
+   INTEGER ::   numnam     =   -1      !: logical unit for namelist
+   INTEGER ::   numnam_ice =   -1      !: logical unit for ice namelist
+   INTEGER ::   numevo_ice =   -1      !: logical unit for ice variables (temp. evolution)
+   INTEGER ::   numsol     =   -1      !: logical unit for solver statistics
 
    !!----------------------------------------------------------------------
    !!                          Run control  
    !!----------------------------------------------------------------------
-   INTEGER            ::   nstop = 0                !: error flag (=number of reason for a premature stop run)
-   INTEGER            ::   nwarn = 0                !: warning flag (=number of warning found during the run)
-   CHARACTER(len=200) ::   ctmp1, ctmp2, ctmp3      !: temporary characters 1 to 3
-   CHARACTER(len=200) ::   ctmp4, ctmp5, ctmp6      !: temporary characters 4 to 6
-   CHARACTER(len=200) ::   ctmp7, ctmp8, ctmp9      !: temporary characters 7 to 9
-   CHARACTER(len=200) ::   ctmp10                   !: temporary character 10
-   CHARACTER (len=64) ::   cform_err = "(/,' ===>>> : E R R O R',     /,'         ===========',/)"       !:
-   CHARACTER (len=64) ::   cform_war = "(/,' ===>>> : W A R N I N G', /,'         ===============',/)"   !:
-   LOGICAL            ::   lwp      = .FALSE.       !: boolean : true on the 1st processor only
-   LOGICAL            ::   lsp_area = .TRUE.        !: to make a control print over a specific area
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
+   INTEGER       ::   nstop = 0             !: error flag (=number of reason for a premature stop run)
+   INTEGER       ::   nwarn = 0             !: warning flag (=number of warning found during the run)
+   CHARACTER(lc) ::   ctmp1, ctmp2, ctmp3   !: temporary characters 1 to 3
+   CHARACTER(lc) ::   ctmp4, ctmp5, ctmp6   !: temporary characters 4 to 6
+   CHARACTER(lc) ::   ctmp7, ctmp8, ctmp9   !: temporary characters 7 to 9
+   CHARACTER(lc) ::   ctmp10                !: temporary character 10
+   CHARACTER(lc) ::   cform_err = "(/,' ===>>> : E R R O R',     /,'         ===========',/)"       !:
+   CHARACTER(lc) ::   cform_war = "(/,' ===>>> : W A R N I N G', /,'         ===============',/)"   !:
+   LOGICAL       ::   lwp      = .FALSE.    !: boolean : true on the 1st processor only
+   LOGICAL       ::   lsp_area = .TRUE.     !: to make a control print over a specific area
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
@@ -129,5 +151,5 @@
       nstop = nstop + 1 
       IF(lwp) THEN
-         WRITE(numout,"(/,' ===>>> : E R R O R',     /,'         ===========',/)") 
+         WRITE(numout,cform_err)
          IF( PRESENT(cd1 ) ) WRITE(numout,*) cd1
          IF( PRESENT(cd2 ) ) WRITE(numout,*) cd2
@@ -163,5 +185,5 @@
       nwarn = nwarn + 1 
       IF(lwp) THEN
-         WRITE(numout,"(/,' ===>>> : W A R N I N G', /,'         ===============',/)") 
+         WRITE(numout,cform_war)
          IF( PRESENT(cd1 ) ) WRITE(numout,*) cd1
          IF( PRESENT(cd2 ) ) WRITE(numout,*) cd2
@@ -180,5 +202,5 @@
 
 
-   SUBROUTINE ctl_opn ( knum, cdfile, cdstat, cdform, cdacce, klengh, kout, ldwp, karea )
+   SUBROUTINE ctl_opn( knum, cdfile, cdstat, cdform, cdacce, klengh, kout, ldwp, karea )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE ctl_opn  ***
@@ -187,10 +209,5 @@
       !!
       !! ** Method  :   Fortan open
-      !!
-      !! History :
-      !!        !  1995-12  (G. Madec)  Original code
-      !!   8.5  !  2002-06  (G. Madec)  F90: Free form and module
-      !!----------------------------------------------------------------------
-
+      !!----------------------------------------------------------------------
       INTEGER          , INTENT(  out) ::   knum      ! logical unit to open
       CHARACTER(len=*) , INTENT(in   ) ::   cdfile    ! file name to open
@@ -205,4 +222,5 @@
       CHARACTER(len=80) ::   clfile
       INTEGER           ::   iost
+      !!----------------------------------------------------------------------
 
       ! adapt filename
Index: trunk/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90	(revision 2528)
@@ -44,4 +44,5 @@
 #endif
    PUBLIC iom_init, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_gettime, iom_rstput, iom_put
+   PUBLIC iom_getatt
 
    PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d
@@ -54,4 +55,7 @@
    INTERFACE iom_get
       MODULE PROCEDURE iom_g0d, iom_g1d, iom_g2d, iom_g3d
+   END INTERFACE
+   INTERFACE iom_getatt
+      MODULE PROCEDURE iom_g0d_intatt
    END INTERFACE
    INTERFACE iom_rstput
@@ -68,7 +72,7 @@
 
    !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2006)
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -824,4 +828,26 @@
       !
    END SUBROUTINE iom_gettime
+
+
+   !!----------------------------------------------------------------------
+   !!                   INTERFACE iom_getatt
+   !!----------------------------------------------------------------------
+   SUBROUTINE iom_g0d_intatt( kiomid, cdatt, pvar )
+      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file
+      CHARACTER(len=*), INTENT(in   )                 ::   cdatt     ! Name of the attribute
+      INTEGER         , INTENT(  out)                 ::   pvar      ! read field
+      !
+      IF( kiomid > 0 ) THEN
+         IF( iom_file(kiomid)%nfid > 0 ) THEN
+            SELECT CASE (iom_file(kiomid)%iolib)
+            CASE (jpioipsl )   ;   CALL ctl_stop('iom_getatt: only nf90 available')
+            CASE (jpnf90   )   ;   CALL iom_nf90_getatt( kiomid, cdatt, pvar )
+            CASE (jprstdimg)   ;   CALL ctl_stop('iom_getatt: only nf90 available')
+            CASE DEFAULT    
+               CALL ctl_stop( 'iom_g0d_att: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
+            END SELECT
+         ENDIF
+      ENDIF
+   END SUBROUTINE iom_g0d_intatt
 
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90	(revision 2528)
@@ -8,7 +8,7 @@
    !!--------------------------------------------------------------------
    !!---------------------------------------------------------------------------------
-   !! OPA 9.0 , LOCEAN-IPSL (2006) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!---------------------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/IOM/iom_ioipsl.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/IOM/iom_ioipsl.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/IOM/iom_ioipsl.F90	(revision 2528)
@@ -35,7 +35,7 @@
    END INTERFACE
    !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2006)
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90	(revision 2528)
@@ -28,15 +28,20 @@
 
    PUBLIC iom_nf90_open, iom_nf90_close, iom_nf90_varid, iom_nf90_get, iom_nf90_gettime, iom_nf90_rstput
+   PUBLIC iom_nf90_getatt
 
    INTERFACE iom_nf90_get
       MODULE PROCEDURE iom_nf90_g0d, iom_nf90_g123d
+   END INTERFACE
+   INTERFACE iom_nf90_getatt
+      MODULE PROCEDURE iom_nf90_intatt
    END INTERFACE
    INTERFACE iom_nf90_rstput
       MODULE PROCEDURE iom_nf90_rp0123d
    END INTERFACE
+
    !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2006)
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -63,5 +68,6 @@
       INTEGER            ::   jl               ! loop variable
       INTEGER            ::   ichunk           ! temporary storage of nn_chunksz
-      INTEGER            ::   imode            ! creation mode flag: NF90_CLOBBER or NF90_NOCLOBBER
+      INTEGER            ::   imode            ! creation mode flag: NF90_CLOBBER or NF90_NOCLOBBER or NF90_HDF5
+      INTEGER            ::   ihdf5            ! local variable for retrieval of value for NF90_HDF5
       LOGICAL            ::   llclobber        ! local definition of ln_clobber
       !---------------------------------------------------------------------
@@ -78,5 +84,9 @@
          IF( ldwrt ) THEN  ! ... in write mode
             IF(lwp) WRITE(numout,*) TRIM(clinfo)//' open existing file: '//TRIM(cdname)//' in WRITE mode'
-            CALL iom_nf90_check(NF90_OPEN( TRIM(cdname), NF90_WRITE  , if90id, chunksize = ichunk ), clinfo)
+            IF( snc4set%luse ) THEN
+               CALL iom_nf90_check(NF90_OPEN( TRIM(cdname), NF90_WRITE  , if90id ), clinfo)
+            ELSE
+               CALL iom_nf90_check(NF90_OPEN( TRIM(cdname), NF90_WRITE  , if90id, chunksize = ichunk ), clinfo)
+            ENDIF
             CALL iom_nf90_check(NF90_SET_FILL( if90id, NF90_NOFILL, idmy                          ), clinfo)
          ELSE              ! ... in read mode
@@ -97,5 +107,14 @@
             ELSE                   ;   imode = IOR( NF90_64BIT_OFFSET, NF90_NOCLOBBER ) 
             ENDIF
-            CALL iom_nf90_check(NF90_CREATE( TRIM(cdname), imode, if90id, chunksize = ichunk ), clinfo)
+            IF( snc4set%luse ) THEN
+               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' creating file: '//TRIM(cdname)//' in hdf5 (netcdf4) mode'
+               CALL GET_NF90_SYMBOL("NF90_HDF5", ihdf5)
+               IF( llclobber ) THEN   ;   imode = IOR(ihdf5, NF90_CLOBBER)
+               ELSE                   ;   imode = IOR(ihdf5, NF90_NOCLOBBER)
+               ENDIF
+               CALL iom_nf90_check(NF90_CREATE( TRIM(cdname), imode, if90id ), clinfo)
+            ELSE
+               CALL iom_nf90_check(NF90_CREATE( TRIM(cdname), imode, if90id, chunksize = ichunk ), clinfo)
+            ENDIF
             CALL iom_nf90_check(NF90_SET_FILL( if90id, NF90_NOFILL, idmy                     ), clinfo)
             ! define dimensions
@@ -288,4 +307,32 @@
 
 
+   SUBROUTINE iom_nf90_intatt( kiomid, cdatt, pvar )
+      !!-----------------------------------------------------------------------
+      !!                  ***  ROUTINE  iom_nf90_intatt  ***
+      !!
+      !! ** Purpose : read an integer attribute with NF90
+      !!-----------------------------------------------------------------------
+      INTEGER         , INTENT(in   ) ::   kiomid   ! Identifier of the file
+      CHARACTER(len=*), INTENT(in   ) ::   cdatt    ! attribute name
+      INTEGER         , INTENT(  out) ::   pvar     ! read field
+      !
+      INTEGER                         ::   if90id   ! temporary integer
+      LOGICAL                         ::   llok     ! temporary logical
+      CHARACTER(LEN=100)              ::   clinfo   ! info character
+      !---------------------------------------------------------------------
+      ! 
+      if90id = iom_file(kiomid)%nfid
+      llok = NF90_Inquire_attribute(if90id, NF90_GLOBAL, cdatt) == nf90_noerr
+      IF( llok) THEN
+         clinfo = 'iom_nf90_getatt, file: '//TRIM(iom_file(kiomid)%name)//', att: '//TRIM(cdatt)
+         CALL iom_nf90_check(NF90_GET_ATT(if90id, NF90_GLOBAL, cdatt, values=pvar), clinfo)
+      ELSE
+         CALL ctl_warn('iom_nf90_getatt: no attribute '//cdatt//' found')
+         pvar = -999
+      ENDIF
+      ! 
+   END SUBROUTINE iom_nf90_intatt
+
+
    SUBROUTINE iom_nf90_gettime( kiomid, kvid, ptime, cdunits, cdcalendar )
       !!--------------------------------------------------------------------
@@ -346,4 +393,11 @@
       INTEGER               :: idmy                 ! dummy variable
       INTEGER               :: itype                ! variable type
+      INTEGER, DIMENSION(4) :: ichunksz             ! NetCDF4 chunk sizes. Will be computed using
+                                                    ! nn_nchunks_[i,j,k,t] namelist parameters
+      INTEGER               :: ichunkalg, ishuffle,&
+                               ideflate, ideflate_level
+                                                    ! NetCDF4 internally fixed parameters
+      LOGICAL               :: lchunk               ! logical switch to activate chunking and compression
+                                                    ! when appropriate (currently chunking is applied to 4d fields only)
       !---------------------------------------------------------------------
       !
@@ -376,4 +430,11 @@
       ! ===============
       IF( kvid <= 0 ) THEN
+         !
+         ! NetCDF4 chunking and compression fixed settings
+         ichunkalg = 0
+         ishuffle = 1
+         ideflate = 1
+         ideflate_level = 1
+         !
          idvar = iom_file(kiomid)%nvars + 1
          ! are we in define mode?
@@ -406,4 +467,6 @@
                  &                            iom_file(kiomid)%nvid(idvar) ), clinfo)
          ENDIF
+         lchunk = .false.
+         IF( snc4set%luse .AND. idims.eq.4 ) lchunk = .true.
          ! update informations structure related the new variable we want to add...
          iom_file(kiomid)%nvars         = idvar
@@ -417,5 +480,18 @@
          DO jd = 1, idims
             CALL iom_nf90_check(NF90_INQUIRE_DIMENSION( if90id, idimid(jd), len = iom_file(kiomid)%dimsz(jd,idvar) ), clinfo)
+            IF ( lchunk ) ichunksz(jd) = iom_file(kiomid)%dimsz(jd,idvar)
          END DO
+         IF ( lchunk ) THEN
+            ! Calculate chunk sizes by partitioning each dimension as requested in namnc4 namelist
+            ! Disallow very small chunk sizes and prevent chunk sizes larger than each individual dimension
+            ichunksz(1) = MIN( ichunksz(1),MAX( (ichunksz(1)-1)/snc4set%ni + 1 ,16 ) ) ! Suggested default nc4set%ni=4
+            ichunksz(2) = MIN( ichunksz(2),MAX( (ichunksz(2)-1)/snc4set%nj + 1 ,16 ) ) ! Suggested default nc4set%nj=2
+            ichunksz(3) = MIN( ichunksz(3),MAX( (ichunksz(3)-1)/snc4set%nk + 1 , 1 ) ) ! Suggested default nc4set%nk=6
+            ichunksz(4) = 1                                                            ! Do not allow chunks to span the
+                                                                                       ! unlimited dimension
+            CALL iom_nf90_check(SET_NF90_DEF_VAR_CHUNKING(if90id, idvar, ichunkalg, ichunksz), clinfo)
+            CALL iom_nf90_check(SET_NF90_DEF_VAR_DEFLATE(if90id, idvar, ishuffle, ideflate, ideflate_level), clinfo)
+            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' chunked ok. Chunks sizes: ', ichunksz
+         ENDIF
          IF(lwp) WRITE(numout,*) TRIM(clinfo)//' defined ok'
       ELSE
@@ -497,5 +573,4 @@
    END SUBROUTINE iom_nf90_check
 
-
    !!======================================================================
 END MODULE iom_nf90
Index: trunk/NEMOGCM/NEMO/OPA_SRC/IOM/iom_rstdimg.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/IOM/iom_rstdimg.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/IOM/iom_rstdimg.F90	(revision 2528)
@@ -35,7 +35,7 @@
       
    !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2006)
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90	(revision 2528)
@@ -31,7 +31,7 @@
    PUBLIC prt_ctl_init    ! called by opa.F90
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90	(revision 2528)
@@ -4,8 +4,9 @@
    !! Ocean restart :  write the ocean restart file
    !!======================================================================
-   !! History :        !  99-11  (M. Imbard)  Original code
-   !!             8.5  !  02-08  (G. Madec)  F90: Free form
-   !!             9.0  !  05-11  (V. Garnier) Surface pressure gradient organization
-   !!             9.0  !  06-07  (S. Masson)  use IOM for restart
+   !! History :  OPA  !  1999-11  (M. Imbard)  Original code
+   !!   NEMO     1.0  !  2002-08  (G. Madec)  F90: Free form
+   !!            2.0  !  2006-07  (S. Masson)  use IOM for restart
+   !!            3.3  !  2010-04  (M. Leclair, G. Madec)  modified LF-RA
+   !!            - -  !  2010-10  (C. Ethe, G. Madec) TRC-TRA merge (T-S in 4D)
    !!----------------------------------------------------------------------
 
@@ -15,15 +16,13 @@
    !!   rst_read   : read the ocean restart file
    !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers 
    USE dom_oce         ! ocean space and time domain
-   USE oce             ! ocean dynamics and tracers 
    USE phycst          ! physical constants
    USE in_out_manager  ! I/O manager
    USE iom             ! I/O module
-   USE c1d             ! re-initialization of u-v mask for the 1D configuration
-   USE zpshde          ! partial step: hor. derivative (zps_hde routine)
    USE eosbn2          ! equation of state            (eos bn2 routine)
-   USE zdfddm          ! double diffusion mixing 
-   USE zdfmxl          ! mixed layer depth
    USE trdmld_oce      ! ocean active mixed layer tracers trends variables
+   USE domvvl          ! variable volume
+   USE traswp          ! swap from 4D T-S to 3D T & S and vice versa
 
    IMPLICIT NONE
@@ -34,15 +33,15 @@
    PUBLIC   rst_read   ! routine called by opa  module
 
-   LOGICAL, PUBLIC ::   lrst_oce =  .FALSE.       !: logical to control the oce restart write 
-   INTEGER, PUBLIC ::   numror, numrow            !: logical unit for cean restart (read and write)
+   LOGICAL, PUBLIC ::   lrst_oce =  .FALSE.   !: logical to control the oce restart write 
+   INTEGER, PUBLIC ::   numror, numrow        !: logical unit for cean restart (read and write)
 
    !! * Substitutions
+#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2006) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
@@ -88,9 +87,10 @@
             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
             ENDIF
          ENDIF
-
+         !
          CALL iom_open( clname, numrow, ldwrt = .TRUE., kiolib = jprstlib )
          lrst_oce = .TRUE.
@@ -107,33 +107,32 @@
       !!
       !! ** Method  :   Write in numrow when kt == nitrst in NetCDF
-      !!      file, save fields which are necessary for restart
+      !!              file, save fields which are necessary for restart
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt   ! ocean time-step
       !!----------------------------------------------------------------------
 
-      CALL iom_rstput( kt, nitrst, numrow, 'rdt'    , rdt       )   ! dynamics time step
-      CALL iom_rstput( kt, nitrst, numrow, 'rdttra1', rdttra(1) )   ! surface tracer time step
-
-      CALL iom_rstput( kt, nitrst, numrow, 'ub'     , ub      )     ! before fields
-      CALL iom_rstput( kt, nitrst, numrow, 'vb'     , vb      )
-      CALL iom_rstput( kt, nitrst, numrow, 'tb'     , tb      )
-      CALL iom_rstput( kt, nitrst, numrow, 'sb'     , sb      )
-      CALL iom_rstput( kt, nitrst, numrow, 'rotb'   , rotb    )
-      CALL iom_rstput( kt, nitrst, numrow, 'hdivb'  , hdivb   )
-      CALL iom_rstput( kt, nitrst, numrow, 'sshb'   , sshb    )
-      !
-      CALL iom_rstput( kt, nitrst, numrow, 'un'     , un      )     ! now fields
-      CALL iom_rstput( kt, nitrst, numrow, 'vn'     , vn      )
-      CALL iom_rstput( kt, nitrst, numrow, 'tn'     , tn      )
-      CALL iom_rstput( kt, nitrst, numrow, 'sn'     , sn      )
-      CALL iom_rstput( kt, nitrst, numrow, 'rotn'   , rotn    )
-      CALL iom_rstput( kt, nitrst, numrow, 'hdivn'  , hdivn   )
-      CALL iom_rstput( kt, nitrst, numrow, 'sshn'   , sshn    )
-
-      CALL iom_rstput( kt, nitrst, numrow, 'rhop'   , rhop    )
+                     CALL iom_rstput( kt, nitrst, numrow, 'rdt'    , rdt       )   ! dynamics time step
+                     CALL iom_rstput( kt, nitrst, numrow, 'rdttra1', rdttra(1) )   ! surface tracer time step
+
+                     CALL iom_rstput( kt, nitrst, numrow, 'ub'     , ub        )     ! before fields
+                     CALL iom_rstput( kt, nitrst, numrow, 'vb'     , vb        )
+                     CALL iom_rstput( kt, nitrst, numrow, 'tb'     , tb        )
+                     CALL iom_rstput( kt, nitrst, numrow, 'sb'     , sb        )
+                     CALL iom_rstput( kt, nitrst, numrow, 'rotb'   , rotb      )
+                     CALL iom_rstput( kt, nitrst, numrow, 'hdivb'  , hdivb     )
+                     CALL iom_rstput( kt, nitrst, numrow, 'sshb'   , sshb      )
+      IF( lk_vvl )   CALL iom_rstput( kt, nitrst, numrow, 'fse3t_b', fse3t_b(:,:,:) )
+                     !
+                     CALL iom_rstput( kt, nitrst, numrow, 'un'     , un        )     ! now fields
+                     CALL iom_rstput( kt, nitrst, numrow, 'vn'     , vn        )
+                     CALL iom_rstput( kt, nitrst, numrow, 'tn'     , tn        )
+                     CALL iom_rstput( kt, nitrst, numrow, 'sn'     , sn        )
+                     CALL iom_rstput( kt, nitrst, numrow, 'rotn'   , rotn      )
+                     CALL iom_rstput( kt, nitrst, numrow, 'hdivn'  , hdivn     )
+                     CALL iom_rstput( kt, nitrst, numrow, 'sshn'   , sshn      )
+                     CALL iom_rstput( kt, nitrst, numrow, 'rhop'   , rhop      )
 #if defined key_zdfkpp
-      CALL iom_rstput( kt, nitrst, numrow, 'rhd'  , rhd   )
+                     CALL iom_rstput( kt, nitrst, numrow, 'rhd'    , rhd       )
 #endif
-
       IF( kt == nitrst ) THEN
          CALL iom_close( numrow )     ! close the restart file (only at last time step)
@@ -153,5 +152,5 @@
       !!----------------------------------------------------------------------
       REAL(wp) ::   zrdt, zrdttra1
-      INTEGER  ::   jlibalt = jprstlib
+      INTEGER  ::   jk, jlibalt = jprstlib
       LOGICAL  ::   llok
       !!----------------------------------------------------------------------
@@ -163,4 +162,5 @@
          CASE ( jprstdimg )   ;   WRITE(numout,*) 'rst_read : read oce binary restart file'
          END SELECT
+         IF ( snc4set%luse )      WRITE(numout,*) 'rst_read : configured with NetCDF4 support'
          WRITE(numout,*) '~~~~~~~~'
       ENDIF
@@ -184,29 +184,30 @@
       ENDIF
       ! 
-      CALL iom_get( numror, jpdom_autoglo, 'ub'   , ub    )        ! before fields
-      CALL iom_get( numror, jpdom_autoglo, 'vb'   , vb    )
-      CALL iom_get( numror, jpdom_autoglo, 'tb'   , tb    )
-      CALL iom_get( numror, jpdom_autoglo, 'sb'   , sb    )
-      CALL iom_get( numror, jpdom_autoglo, 'rotb' , rotb  )
-      CALL iom_get( numror, jpdom_autoglo, 'hdivb', hdivb )
-      CALL iom_get( numror, jpdom_autoglo, 'sshb' , sshb  )
-      !
-      CALL iom_get( numror, jpdom_autoglo, 'un'   , un    )        ! now    fields
-      CALL iom_get( numror, jpdom_autoglo, 'vn'   , vn    )
-      CALL iom_get( numror, jpdom_autoglo, 'tn'   , tn    )
-      CALL iom_get( numror, jpdom_autoglo, 'sn'   , sn    )
-      CALL iom_get( numror, jpdom_autoglo, 'rotn' , rotn  )
-      CALL iom_get( numror, jpdom_autoglo, 'hdivn', hdivn )
-      CALL iom_get( numror, jpdom_autoglo, 'sshn' , sshn  )
-
-      CALL iom_get( numror, jpdom_autoglo, 'rhop' , rhop  )        ! now    potential density
+                     CALL iom_get( numror, jpdom_autoglo, 'ub'     , ub      )   ! before fields
+                     CALL iom_get( numror, jpdom_autoglo, 'vb'     , vb      )
+                     CALL iom_get( numror, jpdom_autoglo, 'tb'     , tb      )
+                     CALL iom_get( numror, jpdom_autoglo, 'sb'     , sb      )
+                     CALL iom_get( numror, jpdom_autoglo, 'rotb'   , rotb    )
+                     CALL iom_get( numror, jpdom_autoglo, 'hdivb'  , hdivb   )
+                     CALL iom_get( numror, jpdom_autoglo, 'sshb'   , sshb    )
+      IF( lk_vvl )   CALL iom_get( numror, jpdom_autoglo, 'fse3t_b', fse3t_b(:,:,:) )
+                     !
+                     CALL iom_get( numror, jpdom_autoglo, 'un'     , un      )   ! now    fields
+                     CALL iom_get( numror, jpdom_autoglo, 'vn'     , vn      )
+                     CALL iom_get( numror, jpdom_autoglo, 'tn'     , tn      )
+                     CALL iom_get( numror, jpdom_autoglo, 'sn'     , sn      )
+                     CALL iom_get( numror, jpdom_autoglo, 'rotn'   , rotn    )
+                     CALL iom_get( numror, jpdom_autoglo, 'hdivn'  , hdivn   )
+                     CALL iom_get( numror, jpdom_autoglo, 'sshn'   , sshn    )
+                     CALL iom_get( numror, jpdom_autoglo, 'rhop'   , rhop    )   ! now    potential density
 #if defined key_zdfkpp
       IF( iom_varid( numror, 'rhd', ldstop = .FALSE. ) > 0 ) THEN
-         CALL iom_get( numror, jpdom_autoglo, 'rhd' , rhd  )       ! now    in situ density anomaly
+                     CALL iom_get( numror, jpdom_autoglo, 'rhd'    , rhd     )   ! now    in situ density anomaly
       ELSE
-         CALL eos( tn, sn, rhd )   ! compute rhd
+                     CALL tra_swap
+                     CALL eos( tsn, rhd )   ! compute rhd
       ENDIF
 #endif
-
+      !
       IF( neuler == 0 ) THEN                                  ! Euler restart (neuler=0)
          tb   (:,:,:) = tn   (:,:,:)                             ! all before fields set to now values
@@ -217,4 +218,9 @@
          hdivb(:,:,:) = hdivn(:,:,:)
          sshb (:,:)   = sshn (:,:)
+         IF( lk_vvl ) THEN
+            DO jk = 1, jpk
+               fse3t_b(:,:,jk) = fse3t_n(:,:,jk)
+            END DO
+         ENDIF
       ENDIF
       !
Index: trunk/NEMOGCM/NEMO/OPA_SRC/LBC/cla.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/LBC/cla.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/LBC/cla.F90	(revision 2528)
@@ -0,0 +1,742 @@
+MODULE cla
+   !!======================================================================
+   !!                    ***  MODULE  cla  ***
+   !! Cross Land Advection : specific update of the horizontal divergence,
+   !!                        tracer trends and after velocity
+   !!
+   !!                 ---   Specific to ORCA_R2   ---
+   !!
+   !!======================================================================
+   !! History :  1.0  ! 2002-11 (A. Bozec)  Original code
+   !!            3.2  ! 2009-07 (G. Madec)  merge cla, cla_div, tra_cla, cla_dynspg
+   !!                 !                     and correct a mpp bug reported by A.R. Porter
+   !!----------------------------------------------------------------------
+#if defined key_orca_r2
+   !!----------------------------------------------------------------------
+   !!   'key_orca_r2'                                 global ocean model R2
+   !!----------------------------------------------------------------------
+   !!   cla_div           : update of horizontal divergence at cla straits
+   !!   tra_cla           : update of tracers at cla straits
+   !!   cla_dynspg        : update of after horizontal velocities at cla straits
+   !!   cla_init          : initialisation - control check
+   !!   cla_bab_el_mandeb : cross land advection for Bab-el-mandeb strait
+   !!   cla_gibraltar     : cross land advection for Gibraltar strait
+   !!   cla_hormuz        : cross land advection for Hormuz strait
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE sbc_oce        ! surface boundary condition: ocean
+   USE dynspg_oce     ! ocean dynamics: surface pressure gradient variables
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! distributed memory computing library
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+
+   IMPLICIT NONE
+   PRIVATE
+   
+   PUBLIC   cla_init     ! routine called by opa.F90
+   PUBLIC   cla_div      ! routine called by divcur.F90
+   PUBLIC   cla_traadv   ! routine called by traadv.F90
+   PUBLIC   cla_dynspg   ! routine called by dynspg_flt.F90
+
+   INTEGER  ::   nbab, ngib, nhor   ! presence or not of required grid-point on local domain
+   !                                ! for Bab-el-Mandeb, Gibraltar, and Hormuz straits
+   
+   !                                                              !!! profile of hdiv for some straits
+   REAL(wp), DIMENSION (jpk) ::   hdiv_139_101, hdiv_139_101_kt    ! Gibraltar     strait, fixed & time evolving part (i,j)=(172,101)
+   REAL(wp), DIMENSION (jpk) ::   hdiv_139_102                     ! Gibraltar     strait, fixed part only            (i,j)=(139,102)
+   REAL(wp), DIMENSION (jpk) ::   hdiv_141_102, hdiv_141_102_kt    ! Gibraltar     strait, fixed & time evolving part (i,j)=(141,102)
+   REAL(wp), DIMENSION (jpk) ::   hdiv_161_88 , hdiv_161_88_kt     ! Bab-el-Mandeb strait, fixed & time evolving part (i,j)=(161,88)
+   REAL(wp), DIMENSION (jpk) ::   hdiv_161_87                      ! Bab-el-Mandeb strait, fixed part only            (i,j)=(161,87)
+   REAL(wp), DIMENSION (jpk) ::   hdiv_160_89 , hdiv_160_89_kt     ! Bab-el-Mandeb strait, fixed & time evolving part (i,j)=(160,89)
+   REAL(wp), DIMENSION (jpk) ::   hdiv_172_94                      ! Hormuz        strait, fixed part only            (i,j)=(172, 94)
+
+   REAL(wp), DIMENSION (jpk) ::   t_171_94_hor, s_171_94_hor       ! Temperature, salinity in the Hormuz strait
+   
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE cla_div( kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE div_cla  ***
+      !!
+      !! ** Purpose :   update the horizontal divergence of the velocity field
+      !!              at some straits ( Gibraltar, Bab el Mandeb and Hormuz ).
+      !!
+      !! ** Method  : - first time-step: initialisation of cla
+      !!              - all   time-step: using imposed transport at each strait, 
+      !!              the now horizontal divergence is updated
+      !!
+      !! ** Action  :   phdivn   updted now horizontal divergence at cla straits
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+      !!----------------------------------------------------------------------
+      !     
+      IF( kt == nit000 ) THEN
+         !
+         CALL cla_init                                        ! control check 
+         !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'div_cla : cross land advection on hdiv '
+         IF(lwp) WRITE(numout,*) '~~~~~~~~'
+         !
+         IF( nbab == 1 )   CALL cla_bab_el_mandeb('ini')    ! Bab el Mandeb ( Red Sea - Indian ocean )
+         IF( ngib == 1 )   CALL cla_gibraltar    ('ini')    ! Gibraltar strait (Med Sea - Atlantic ocean)
+         IF( nhor == 1 )   CALL cla_hormuz       ('ini')    ! Hormuz Strait ( Persian Gulf - Indian ocean )
+         !
+      ENDIF                           
+      !
+      IF( nbab == 1    )   CALL cla_bab_el_mandeb('div')    ! Bab el Mandeb ( Red Sea - Indian ocean )
+      IF( ngib == 1    )   CALL cla_gibraltar    ('div')    ! Gibraltar strait (Med Sea - Atlantic ocean)
+      IF( nhor == 1    )   CALL cla_hormuz       ('div')    ! Hormuz Strait ( Persian Gulf - Indian ocean )
+      !
+!!gm  lbc useless here, no?
+!!gm      CALL lbc_lnk( hdivn, 'T', 1. )                    ! Lateral boundary conditions on hdivn
+      !
+   END SUBROUTINE cla_div
+   
+   
+   SUBROUTINE cla_traadv( kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE tra_cla  ***
+      !!                   
+      !! ** Purpose :   Update the now trend due to the advection of tracers
+      !!      and add it to the general trend of passive tracer equations
+      !!      at some straits ( Bab el Mandeb, Gibraltar, Hormuz ).
+      !!
+      !! ** Method  :   using both imposed transport at each strait and T & S
+      !!              budget, the now tracer trends is updated
+      !!
+      !! ** Action  :   (ta,sa)   updated now tracer trends at cla straits
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 ) THEN 
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_cla : cross land advection on tracers '
+         IF(lwp) WRITE(numout,*) '~~~~~~~~'
+      ENDIF
+      !
+      IF( nbab == 1    )   CALL cla_bab_el_mandeb('tra')      ! Bab el Mandeb strait
+      IF( ngib == 1    )   CALL cla_gibraltar    ('tra')      ! Gibraltar strait
+      IF( nhor == 1    )   CALL cla_hormuz       ('tra')      ! Hormuz Strait ( Persian Gulf)
+      !
+   END SUBROUTINE cla_traadv
+
+   
+   SUBROUTINE cla_dynspg( kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE cla_dynspg  ***
+      !!                   
+      !! ** Purpose :   Update the after velocity at some straits 
+      !!              (Bab el Mandeb, Gibraltar, Hormuz).
+      !!
+      !! ** Method  :   required to compute the filtered surface pressure gradient 
+      !!
+      !! ** Action  :   (ua,va)   after velocity at the cla straits
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 ) THEN 
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'cla_dynspg : cross land advection on (ua,va) '
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+      ENDIF
+      !
+      IF( nbab == 1    )   CALL cla_bab_el_mandeb('spg')      ! Bab el Mandeb strait
+      IF( ngib == 1    )   CALL cla_gibraltar    ('spg')      ! Gibraltar strait
+      IF( nhor == 1    )   CALL cla_hormuz       ('spg')      ! Hormuz Strait ( Persian Gulf)
+      !
+!!gm lbc is needed here, not?
+!!gm      CALL lbc_lnk( hdivn, 'U', -1. )   ;   CALL lbc_lnk( hdivn, 'V', -1. )      ! Lateral boundary conditions 
+      !
+   END SUBROUTINE cla_dynspg
+
+
+   SUBROUTINE cla_init
+      !! -------------------------------------------------------------------
+      !!                   ***  ROUTINE cla_init  ***
+      !!           
+      !! ** Purpose :   control check for mpp computation  
+      !!
+      !! ** Method  : - All the strait grid-points must be inside one of the 
+      !!              local domain interior for the cla advection to work
+      !!              properly in mpp (i.e. inside (2:jpim1,2:jpjm1) ).
+      !!              Define the corresponding indicators (nbab, ngib, nhor)
+      !!              - The profiles of cross-land fluxes are currently hard
+      !!              coded for L31 levels. Stop if jpk/=31
+      !!
+      !! ** Action  :   nbab, ngib, nhor   strait inside the local domain or not
+      !!---------------------------------------------------------------------
+      REAL(wp) ::   ztemp
+      !!---------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'cla_init : cross land advection initialisation '
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~'
+      !
+      IF( .NOT.lk_dynspg_flt )   CALL ctl_stop( 'cla_init: Cross Land Advection works only with lk_dynspg_flt=T ' )
+      !
+      IF( lk_vvl    )   CALL ctl_stop( 'cla_init: Cross Land Advection does not work with lk_vvl=T option' )
+      !
+      IF( jpk /= 31 )   CALL ctl_stop( 'cla_init: Cross Land Advection hard coded for ORCA_R2_L31' )
+      !
+      !                                        _|_______|_______|_
+      !                                     89  |       |///////|  
+      !                                        _|_______|_______|_
+      ! ------------------------ !          88  |///////|       | 
+      !   Bab el Mandeb strait   !             _|_______|_______|_
+      ! ------------------------ !          87  |///////|       | 
+      !                                        _|_______|_______|_
+      !                                         |  160  |  161  |  
+      !
+      ! The 6 Bab el Mandeb grid-points must be inside one of the interior of the
+      ! local domain for the cla advection to work properly (i.e. (2:jpim1,2:jpjm1)
+      nbab = 0
+      IF(  ( 1 <= mj0( 88) .AND. mj1( 89) <= jpj ) .AND.    &  !* (161,89), (161,88) and (161,88) on the local pocessor
+         & ( 1 <= mi0(160) .AND. mi1(161) <= jpi )       )    nbab = 1 
+      !
+      ! test if there is no local domain that includes all required grid-points
+      ztemp = REAL( nbab )
+      IF( lk_mpp )   CALL mpp_sum( ztemp )      ! sum with other processors value
+      IF( ztemp == 0 ) THEN                     ! Only 2 points in each direction, this should never be a problem
+         CALL ctl_stop( ' cross land advection at Bab-el_Mandeb does not work with your processor cutting: change it' )
+      ENDIF
+      !                                        ___________________________
+      ! ------------------------ !         102  |       |///////|       |
+      !     Gibraltar strait     !             _|_______|_______|_______|_
+      ! ------------------------ !         101  |       |///////|       |
+      !                                        _|_______|_______|_______|_ 
+      !                                         |  139  |  140  |  141  |
+      !
+      ! The 6 Gibraltar grid-points must be inside one of the interior of the
+      ! local domain for the cla advection to work properly (i.e. (2:jpim1,2:jpjm1)
+      ngib = 0
+      IF(  ( 2 <= mj0(101) .AND. mj1(102) <= jpjm1 ) .AND.    &  !* (139:141,101:102) on the local pocessor
+         & ( 2 <= mi0(139) .AND. mi1(141) <= jpim1 )       )    ngib = 1 
+      !
+      ! test if there is no local domain that includes all required grid-points
+      ztemp = REAL( ngib )
+      IF( lk_mpp )   CALL mpp_sum( ztemp )      ! sum with other processors value
+      IF( ztemp == 0 ) THEN                     ! 3 points in i-direction, this may be a problem with some cutting
+           CALL ctl_stop( ' cross land advection at Gibraltar does not work with your processor cutting: change it' )
+      ENDIF
+      !                                        _______________
+      ! ------------------------ !          94  |/////|     | 
+      !       Hormuz strait      !             _|_____|_____|_
+      ! ------------------------ !                171   172     
+      !           
+      ! The 2 Hormuz grid-points must be inside one of the interior of the
+      ! local domain for the cla advection to work properly (i.e. (2:jpim1,2:jpjm1)
+      nhor = 0
+      IF(    2 <= mj0( 94) .AND. mj1( 94) <= jpjm1  .AND.  & 
+         &   2 <= mi0(171) .AND. mi1(172) <= jpim1         )   nhor = 1 
+      !
+      ! test if there is no local domain that includes all required grid-points
+      ztemp = REAL( nhor )
+      IF( lk_mpp )   CALL mpp_sum( ztemp )      ! sum with other processors value
+      IF( ztemp == 0 ) THEN                     ! 3 points in i-direction, this may be a problem with some cutting
+           CALL ctl_stop( ' cross land advection at Hormuz does not work with your processor cutting: change it' )
+      ENDIF
+      !
+   END SUBROUTINE cla_init
+
+
+   SUBROUTINE cla_bab_el_mandeb( cd_td )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE cla_bab_el_mandeb  ***
+      !!       
+      !! ** Purpose :   update the now horizontal divergence, the tracer tendancy
+      !!              and the after velocity in vicinity of Bab el Mandeb ( Red Sea - Indian ocean).
+      !!
+      !! ** Method  :   compute the exchanges at each side of the strait :
+      !!
+      !!       surf. zio_flow
+      !! (+ balance of emp) /\  |\\\\\\\\\\\|
+      !!                    ||  |\\\\\\\\\\\|  
+      !!    deep zio_flow   ||  |\\\\\\\\\\\|  
+      !!            |  ||   ||  |\\\\\\\\\\\|  
+      !!        89  |  ||   ||  |\\\\\\\\\\\|  
+      !!            |__\/_v_||__|____________ 
+      !!            !\\\\\\\\\\\|          surf. zio_flow
+      !!            |\\\\\\\\\\\|<===    (+ balance of emp)
+      !!            |\\\\\\\\\\\u
+      !!        88  |\\\\\\\\\\\|<---      deep  zrecirc (upper+deep at 2 different levels)
+      !!            |___________|__________   
+      !!            !\\\\\\\\\\\|         
+      !!            |\\\\\\\\\\\| ---\     deep  zrecirc (upper+deep) 
+      !!        87  !\\\\\\\\\\\u ===/   + deep  zio_flow   (all at the same level)
+      !!            !\\\\\\\\\\\|  
+      !!            !___________|__________ 
+      !!                160         161
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(len=1), INTENT(in) ::   cd_td   ! ='div' update the divergence
+      !                                         ! ='tra' update the tracers
+      !                                         ! ='spg' update after velocity
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zemp_red     ! temporary scalar
+      REAL(wp) ::   zio_flow, zrecirc_upp, zrecirc_mid, zrecirc_bot
+      !!---------------------------------------------------------------------
+      !
+      SELECT CASE( cd_td ) 
+      !                     ! ---------------- !
+      CASE( 'ini' )         !  initialisation  ! 
+         !                  ! ---------------- ! 
+         !                                   
+         zio_flow    = 0.4e6                       ! imposed in/out flow
+         zrecirc_upp = 0.2e6                       ! imposed upper recirculation water
+         zrecirc_bot = 0.5e6                       ! imposed bottom  recirculation water
+
+         hdiv_161_88(:) = 0.e0                     ! (161,88) Gulf of Aden side, north point
+         hdiv_161_87(:) = 0.e0                     ! (161,87) Gulf of Aden side, south point
+         hdiv_160_89(:) = 0.e0                     ! (160,89) Red sea side
+
+         DO jj = mj0(88), mj1(88)              !** profile of hdiv at (161,88)   (Gulf of Aden side, north point)
+            DO ji = mi0(161), mi1(161)         !------------------------------
+               DO jk = 1, 8                        ! surface in/out flow   (Ind -> Red)   (div >0)
+                  hdiv_161_88(jk) = + zio_flow / ( 8. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               END DO
+               !                                   ! recirculation water   (Ind -> Red)   (div >0)
+               hdiv_161_88(20) =                 + zrecirc_upp   / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,20) )
+               hdiv_161_88(21) = + ( zrecirc_bot - zrecirc_upp ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,21) )
+            END DO
+         END DO
+         !
+         DO jj = mj0(87), mj1(87)              !** profile of hdiv at (161,88)   (Gulf of Aden side, south point)
+            DO ji = mi0(161), mi1(161)         !------------------------------
+               !                                   ! deep out flow + recirculation   (Red -> Ind)   (div <0)
+               hdiv_161_87(21) = - ( zio_flow + zrecirc_bot ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,21) )
+            END DO
+         END DO
+         !
+         DO jj = mj0(89), mj1(89)              !** profile of hdiv at (161,88)   (Red sea side)
+            DO ji = mi0(160), mi1(160)         !------------------------------
+               DO jk = 1, 8                        ! surface inflow    (Ind -> Red)   (div <0)
+                  hdiv_160_89(jk) = - zio_flow / ( 8. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               END DO
+               !                                   ! deep    outflow   (Red -> Ind)   (div >0)
+               hdiv_160_89(16)    = + zio_flow / (      e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,16) )
+            END DO
+         END DO
+         !                  ! ---------------- !
+      CASE( 'div' )         !   update hdivn   ! (call by divcur module)
+         !                  ! ---------=====-- ! 
+         !                                     !** emp on the Red Sea   (div >0) 
+         zemp_red = 0.e0                       !---------------------
+         DO jj = mj0(87), mj1(96)                  ! sum over the Red sea
+            DO ji = mi0(148), mi1(160) 
+               zemp_red = zemp_red + emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj)
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mpp_sum( zemp_red )   ! sum with other processors value
+         zemp_red = zemp_red * 1.e-3               ! convert in m3
+         !
+         !                                     !** Correct hdivn (including emp adjustment)
+         !                                     !-------------------------------------------
+         DO jj = mj0(88), mj1(88)                  !* profile of hdiv at (161,88)   (Gulf of Aden side, north point)
+            DO ji = mi0(161), mi1(161) 
+               hdiv_161_88_kt(:) = hdiv_161_88(:)
+               DO jk = 1, 8                              ! increase the inflow from the Indian   (div >0) 
+                  hdiv_161_88_kt(jk) = hdiv_161_88(jk) + zemp_red / (8. * e2u(ji,jj) * fse3u(ji,jj,jk) )
+               END DO
+               hdivn(ji,jj,:) = hdivn(ji,jj,:) + hdiv_161_88_kt(:)
+            END DO
+         END DO
+         DO jj = mj0(87), mj1(87)                  !* profile of divergence at (161,87)   (Gulf of Aden side, south point)
+            DO ji = mi0(161), mi1(161) 
+               hdivn(ji,jj,:) = hdivn(ji,jj,:) + hdiv_161_87(:)
+            END DO
+         END DO
+         DO jj = mj0(89), mj1(89)                  !* profile of divergence at (160,89)   (Red sea side)
+            DO ji = mi0(160), mi1(160) 
+               hdiv_160_89_kt(:) = hdiv_160_89(:)
+               DO jk = 1, 18                              ! increase the inflow from the Indian   (div <0) 
+                  hdiv_160_89_kt(jk) = hdiv_160_89(jk) - zemp_red / (10. * e1v(ji,jj) * fse3v(ji,jj,jk) )
+               END DO
+               hdivn(ji, jj,:) = hdivn(ji, jj,:) + hdiv_160_89_kt(:)
+            END DO
+         END DO
+         !                  ! ---------------- !
+      CASE( 'tra' )         !  update (ta,sa)  ! (call by traadv module)
+         !                  ! --------=======- !
+         !
+         DO jj = mj0(88), mj1(88)              !** (161,88)   (Gulf of Aden side, north point)
+            DO ji = mi0(161), mi1(161) 
+               DO jk = 1, jpkm1                         ! surf inflow + reciculation (from Gulf of Aden)
+                  ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_161_88_kt(jk) * tn(ji,jj,jk)
+                  sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_161_88_kt(jk) * sn(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         DO jj = mj0(87), mj1(87)              !** (161,87)   (Gulf of Aden side, south point)
+            DO ji = mi0(161), mi1(161) 
+               jk =  21                                 ! deep outflow + recirulation (combined flux)
+               ta(ji,jj,jk) = ta(ji,jj,jk) + hdiv_161_88(20) * tn(ji  ,jj+1,20)   &  ! upper recirculation from Gulf of Aden
+                  &                        + hdiv_161_88(21) * tn(ji  ,jj+1,21)   &  ! deep  recirculation from Gulf of Aden
+                  &                        + hdiv_160_89(16) * tn(ji-1,jj+2,16)      ! deep inflow from Red sea
+               sa(ji,jj,jk) = sa(ji,jj,jk) + hdiv_161_88(20) * sn(ji  ,jj+1,20)   &
+                  &                        + hdiv_161_88(21) * sn(ji  ,jj+1,21)   &
+                  &                        + hdiv_160_89(16) * sn(ji-1,jj+2,16)   
+            END DO
+         END DO
+         DO jj = mj0(89), mj1(89)              !** (161,88)   (Red sea side)
+            DO ji = mi0(160), mi1(160)
+               DO jk = 1, 14                            ! surface inflow (from Gulf of Aden)
+                  ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_160_89_kt(jk) * tn(ji+1,jj-1,jk)
+                  sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_160_89_kt(jk) * sn(ji+1,jj-1,jk)
+               END DO
+               !                                        ! deep    outflow (from Red sea)
+               ta(ji,jj,16) = ta(ji,jj,16) - hdiv_160_89(jk) * tn(ji,jj,jk)
+               sa(ji,jj,16) = sa(ji,jj,16) - hdiv_160_89(jk) * sn(ji,jj,jk)
+            END DO
+         END DO
+         !
+         !                  ! ---------------- !
+      CASE( 'spg' )         !  update (ua,va)  ! (call by dynspg module)
+         !                  ! --------=======- !
+         ! at this stage, (ua,va) are the after velocity, not the tendancy
+         ! compute the velocity from the divergence at T-point
+         !
+         DO jj = mj0(88), mj1(88)              !** (160,88)   (Gulf of Aden side, north point)
+            DO ji = mi0(160), mi1(160)                   ! 160, not 161 as it is a U-point) 
+               ua(ji,jj,:) = - hdiv_161_88_kt(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) )   &
+                  &                              * e2u(ji,jj) * fse3u(ji,jj,:)
+            END DO
+         END DO
+         DO jj = mj0(87), mj1(87)              !** (160,87)   (Gulf of Aden side, south point)
+            DO ji = mi0(160), mi1(160)                   ! 160, not 161 as it is a U-point) 
+               ua(ji,jj,:) = - hdiv_161_87(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) )   &
+                  &                           * e2u(ji,jj) * fse3u(ji,jj,:)
+            END DO
+         END DO
+         DO jj = mj0(88), mj1(88)              !** profile of divergence at (160,89)   (Red sea side)
+            DO ji = mi0(160), mi1(160)                   ! 88, not 89 as it is a V-point)
+               va(ji,jj,:) = - hdiv_160_89_kt(:) / ( e1t(ji,jj+1) * e2t(ji,jj+1) * fse3t(ji,jj+1,:) )   &
+                  &                              * e1v(ji,jj) * fse3v(ji,jj,:)
+            END DO
+         END DO
+      END SELECT
+      !
+   END SUBROUTINE cla_bab_el_mandeb
+   
+
+   SUBROUTINE cla_gibraltar( cd_td )
+      !! -------------------------------------------------------------------
+      !!                 ***  ROUTINE cla_gibraltar  ***
+      !!        
+      !! ** Purpose :   update the now horizontal divergence, the tracer 
+      !!              tendancyand the after velocity in vicinity of Gibraltar 
+      !!              strait ( Persian Gulf - Indian ocean ).
+      !!
+      !! ** Method :
+      !!                     _______________________            
+      !!      deep  zio_flow /====|///////|====> surf. zio_flow
+      !!    + deep  zrecirc  \----|///////|     (+balance of emp)
+      !! 102                      u///////u
+      !!      mid.  recicul    <--|///////|<==== deep  zio_flow
+      !!                     _____|_______|_____  
+      !!      surf. zio_flow ====>|///////|       
+      !!    (+balance of emp)     |///////|
+      !! 101                      u///////|             
+      !!      mid.  recicul    -->|///////|               Caution: zrecirc split into 
+      !!      deep  zrecirc  ---->|///////|                  upper & bottom recirculation
+      !!                   _______|_______|_______ 
+      !!                     139     140     141  
+      !!
+      !!---------------------------------------------------------------------
+      CHARACTER(len=1), INTENT(in) ::   cd_td   ! ='div' update the divergence
+      !                                         ! ='tra' update the tracers
+      !                                         ! ='spg' update after velocity
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zemp_med     ! temporary scalar
+      REAL(wp) ::   zio_flow, zrecirc_upp, zrecirc_mid, zrecirc_bot
+      !!---------------------------------------------------------------------
+      !
+      SELECT CASE( cd_td ) 
+      !                     ! ---------------- !
+      CASE( 'ini' )         !  initialisation  ! 
+         !                  ! ---------------- ! 
+         !                                     !** initialization of the velocity
+         hdiv_139_101(:) = 0.e0                     !  139,101 (Atlantic side, south point)
+         hdiv_139_102(:) = 0.e0                     !  139,102 (Atlantic side, north point)
+         hdiv_141_102(:) = 0.e0                     !  141,102 (Med sea  side)
+            
+         !                                     !** imposed transport
+         zio_flow    = 0.8e6                        ! inflow surface  water
+         zrecirc_mid = 0.7e6                        ! middle recirculation water
+         zrecirc_upp = 2.5e6                        ! upper  recirculation water
+         zrecirc_bot = 3.5e6                        ! bottom recirculation water
+         !
+         DO jj = mj0(101), mj1(101)            !** profile of hdiv at 139,101 (Atlantic side, south point)
+            DO ji = mi0(139), mi1(139)         !-----------------------------
+               DO jk = 1, 14                        ! surface in/out flow (Atl -> Med)   (div >0)
+                  hdiv_139_101(jk) = + zio_flow / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               END DO
+               DO jk = 15, 20                       ! middle  reciculation (Atl 101 -> Atl 102)   (div >0)   
+                  hdiv_139_101(jk) = + zrecirc_mid / ( 6. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               END DO
+               !                                    ! upper reciculation (Atl 101 -> Atl 101)   (div >0)
+               hdiv_139_101(21) =               + zrecirc_upp / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               !
+               !                                    ! upper & bottom reciculation (Atl 101 -> Atl 101 & 102)   (div >0)
+               hdiv_139_101(22) = ( zrecirc_bot - zrecirc_upp ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+            END DO
+         END DO
+         DO jj = mj0(102), mj1(102)            !** profile of hdiv at 139,102 (Atlantic side, north point)
+            DO ji = mi0(139), mi1(139)         !-----------------------------
+               DO jk = 15, 20                       ! middle reciculation (Atl 101 -> Atl 102)   (div <0)                
+                  hdiv_139_102(jk) = - zrecirc_mid / ( 6. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               END DO
+               !                                    ! outflow of Mediterranean sea + deep recirculation   (div <0) 
+               hdiv_139_102(22) = - ( zio_flow + zrecirc_bot ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+            END DO
+         END DO
+         DO jj = mj0(102), mj1(102)            !** velocity profile at 141,102  (Med sea side)
+            DO ji = mi0(141), mi1(141)         !------------------------------
+               DO  jk = 1, 14                       ! surface inflow in the Med     (div <0)
+                  hdiv_141_102(jk) = - zio_flow / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               END DO
+               !                                    ! deep    outflow toward the Atlantic    (div >0) 
+               hdiv_141_102(21)    = + zio_flow / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+            END DO
+         END DO
+         !                  ! ---------------- !
+      CASE( 'div' )         !   update hdivn   ! (call by divcur module)
+         !                  ! ---------=====-- ! 
+         !                                     !** emp on the Mediterranean Sea  (div >0) 
+         zemp_med = 0.e0                       !-------------------------------
+         DO jj = mj0(96), mj1(110)                  ! sum over the Med sea
+            DO ji = mi0(141),mi1(181)
+               zemp_med = zemp_med + emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj) 
+            END DO
+         END DO
+         DO jj = mj0(96), mj1(96)                   ! minus 2 points in Red Sea 
+            DO ji = mi0(148),mi1(148)
+               zemp_med = zemp_med - emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj)
+            END DO
+            DO ji = mi0(149),mi1(149)
+               zemp_med = zemp_med - emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj)
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mpp_sum( zemp_med )    ! sum with other processors value
+         zemp_med = zemp_med * 1.e-3                ! convert in m3
+         !
+         !                                     !** Correct hdivn (including emp adjustment)
+         !                                     !-------------------------------------------
+         DO jj = mj0(101), mj1(101)                 !* 139,101 (Atlantic side, south point)
+            DO ji = mi0(139), mi1(139) 
+               hdiv_139_101_kt(:) = hdiv_139_101(:)      
+               DO jk = 1, 14                              ! increase the inflow from the Atlantic   (div >0) 
+                  hdiv_139_101_kt(jk) = hdiv_139_101(jk) + zemp_med / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               END DO
+               hdivn(ji, jj,:) = hdivn(ji, jj,:) + hdiv_139_101_kt(:)
+            END DO
+         END DO
+         DO jj = mj0(102), mj1(102)                 !* 139,102 (Atlantic side, north point)
+            DO ji = mi0(139), mi1(139) 
+               hdivn(ji,jj,:) = hdivn(ji,jj,:) + hdiv_139_102(:)
+            END DO
+         END DO
+         DO jj = mj0(102), mj1(102)                 !* 141,102 (Med side)
+            DO ji = mi0(141), mi1(141) 
+               hdiv_141_102(:) = hdiv_141_102(:)
+               DO jk = 1, 14                              ! increase the inflow from the Atlantic   (div <0)
+                  hdiv_141_102_kt(jk) = hdiv_141_102(jk) - zemp_med / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               END DO
+               hdivn(ji, jj,:) = hdivn(ji, jj,:) + hdiv_141_102_kt(:)
+            END DO
+         END DO
+         !                  ! ---------------- !
+      CASE( 'tra' )         !  update (ta,sa)  ! (call by traadv module)
+         !                  ! --------=======- !
+         !
+         DO jj = mj0(101), mj1(101)            !** 139,101 (Atlantic side, south point)   (div >0)
+            DO ji = mi0(139), mi1(139) 
+               DO jk = 1, jpkm1                         ! surf inflow + mid. & bottom reciculation (from Atlantic)	
+                  ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_139_101_kt(jk) * tn(ji,jj,jk)
+                  sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_139_101_kt(jk) * sn(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !
+         DO jj = mj0(102), mj1(102)            !** 139,102 (Atlantic side, north point)   (div <0)
+            DO ji = mi0(139), mi1(139) 
+               DO jk = 15, 20                            ! middle  reciculation (Atl 101 -> Atl 102)   (div <0)
+                  ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_139_102(jk) * tn(ji,jj-1,jk)  ! middle Atlantic recirculation
+                  sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_139_102(jk) * sn(ji,jj-1,jk)
+               END DO
+               !                                         ! upper & bottom Atl. reciculation (Atl 101 -> Atl 102) - (div <0)
+               !                                         ! deep Med flow                    (Med 102 -> Atl 102) - (div <0)
+               ta(ji,jj,22) = ta(ji,jj,22) + hdiv_141_102(21) * tn(ji+2,jj  ,21)   &  ! deep Med flow  
+                  &                        + hdiv_139_101(21) * tn(ji  ,jj-1,21)   &  ! upper  Atlantic recirculation  
+                  &                        + hdiv_139_101(22) * tn(ji  ,jj-1,22)      ! bottom Atlantic recirculation  
+               sa(ji,jj,22) = sa(ji,jj,22) + hdiv_141_102(21) * sn(ji+2,jj  ,21)   &
+                  &                        + hdiv_139_101(21) * sn(ji  ,jj-1,21)   &
+                  &                        + hdiv_139_101(22) * sn(ji  ,jj-1,22) 
+            END DO
+         END DO
+         DO jj = mj0(102), mj1(102)                 !* 141,102 (Med side)   (div <0)
+            DO ji = mi0(141), mi1(141) 
+               DO jk = 1, 14                             ! surface flow from Atlantic to Med sea
+                  ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_141_102_kt(jk) * tn(ji-2,jj-1,jk)
+                  sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_141_102_kt(jk) * sn(ji-2,jj-1,jk)
+               END DO
+               !                                         ! deeper flow from Med sea to Atlantic
+               ta(ji,jj,21) = ta(ji,jj,21) - hdiv_141_102(21) * tn(ji,jj,21)
+               sa(ji,jj,21) = sa(ji,jj,21) - hdiv_141_102(21) * sn(ji,jj,21)
+            END DO
+         END DO
+         !                  ! ---------------- !
+      CASE( 'spg' )         !  update (ua,va)  ! (call by dynspg module)
+         !                  ! --------=======- !
+         ! at this stage, (ua,va) are the after velocity, not the tendancy
+         ! compute the velocity from the divergence at T-point
+         !
+         DO jj = mj0(101), mj1(101)            !** 139,101 (Atlantic side, south point)
+            DO ji = mi0(139), mi1(139)                    ! div >0 => ua >0, same sign
+               ua(ji,jj,:) = hdiv_139_101_kt(:) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,:) )   &
+                  &                             * e2u(ji,jj) * fse3u(ji,jj,:)
+            END DO
+         END DO
+         DO jj = mj0(102), mj1(102)            !** 139,102 (Atlantic side, north point)
+            DO ji = mi0(139), mi1(139)                    ! div <0 => ua <0, same sign
+               ua(ji,jj,:) = hdiv_139_102(:) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,:) )   &
+                  &                          * e2u(ji,jj) * fse3u(ji,jj,:)   
+            END DO
+         END DO
+         DO jj = mj0(102), mj1(102)            !** 140,102 (Med side) (140 not 141 as it is a U-point)
+            DO ji = mi0(140), mi1(140)                    ! div >0 => ua <0, opposite sign
+               ua(ji,jj,:) = - hdiv_141_102(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) )   &
+                  &                            * e2u(ji,jj) * fse3u(ji,jj,:)
+            END DO
+         END DO
+         !
+      END SELECT
+      !
+   END SUBROUTINE cla_gibraltar
+
+
+   SUBROUTINE cla_hormuz( cd_td )
+      !! -------------------------------------------------------------------
+      !!                   ***  ROUTINE div_hormuz  ***
+      !!              
+      !! ** Purpose :   update the now horizontal divergence, the tracer 
+      !!              tendancyand the after velocity in vicinity of Hormuz 
+      !!              strait ( Persian Gulf - Indian ocean ).
+      !!
+      !! ** Method  :   Hormuz strait
+      !!            ______________   
+      !!            |/////|<==      surface inflow
+      !!        94  |/////|     
+      !!            |/////|==>      deep    outflow
+      !!            |_____|_______
+      !!              171    172     
+      !!---------------------------------------------------------------------
+      CHARACTER(len=1), INTENT(in) ::   cd_td   ! ='ini' initialisation
+      !!                                        ! ='div' update the divergence
+      !!                                        ! ='tra' update the tracers
+      !!                                        ! ='spg' update after velocity
+      !!
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zio_flow     ! temporary scalar
+      !!---------------------------------------------------------------------
+      !
+      SELECT CASE( cd_td ) 
+      !                     ! ---------------- !
+      CASE( 'ini' )         !  initialisation  ! 
+         !                  ! ---------------- ! 
+         !                                     !** profile of horizontal divergence due to cross-land advection
+         zio_flow  = 1.e6                          ! imposed in/out flow
+         !
+         hdiv_172_94(:) = 0.e0         
+         !
+         DO jj = mj0(94), mj1(94)                  ! in/out flow at (i,j) = (172,94)
+            DO ji = mi0(172), mi1(172) 
+               DO jk = 1, 8                            ! surface inflow  (Indian ocean to Persian Gulf) (div<0)
+                  hdiv_172_94(jk) = - ( zio_flow / 8.e0 * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               END DO
+               DO jk = 16, 18                          ! deep    outflow (Persian Gulf to Indian ocean) (div>0)
+                  hdiv_172_94(jk) = + ( zio_flow / 3.e0 * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               END DO
+            END DO
+         END DO
+         !                                     !** T & S profile in the Hormuz strait (use in deep outflow)
+         !      Temperature       and         Salinity
+         t_171_94_hor(:)  = 0.e0   ;   s_171_94_hor(:)  = 0.e0
+         t_171_94_hor(16) = 18.4   ;   s_171_94_hor(16) = 36.27
+         t_171_94_hor(17) = 17.8   ;   s_171_94_hor(17) = 36.4
+         t_171_94_hor(18) = 16.    ;   s_171_94_hor(18) = 36.27
+         !
+         !                  ! ---------------- !
+      CASE( 'div' )         !   update hdivn   ! (call by divcur module)
+         !                  ! ---------=====-- ! 
+         !                                   
+         DO jj = mj0(94), mj1(94)              !** 172,94 (Indian ocean side)
+            DO ji = mi0(172), mi1(172) 
+               hdivn(ji,jj,:) = hdivn(ji,jj,:) + hdiv_172_94(:)
+            END DO
+         END DO
+         !                  ! ---------------- !
+      CASE( 'tra' )         !  update (ta,sa)  ! (call by traadv module)
+         !                  ! --------=======- !
+         !                          
+         DO jj = mj0(94), mj1(94)              !** 172,94 (Indian ocean side)
+            DO ji = mi0(172), mi1(172) 
+               DO jk = 1, 8                          ! surface inflow   (Indian ocean to Persian Gulf) (div<0)
+                  ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_172_94(jk) * tn(ji,jj,jk) 
+                  sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_172_94(jk) * sn(ji,jj,jk) 
+               END DO
+               DO jk = 16, 18                        ! deep outflow     (Persian Gulf to Indian ocean) (div>0)
+                  ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_172_94(jk) * t_171_94_hor(jk)
+                  sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_172_94(jk) * s_171_94_hor(jk)
+               END DO
+            END DO
+         END DO
+         !                  ! ---------------- !
+      CASE( 'spg' )         !  update (ua,va)  ! (call by dynspg module)
+         !                  ! --------=======- !
+         ! No barotropic flow through Hormuz strait
+         ! at this stage, (ua,va) are the after velocity, not the tendancy
+         ! compute the velocity from the divergence at T-point
+         DO jj = mj0(94), mj1(94)              !** 171,94 (Indian ocean side) (171 not 172 as it is the western U-point)
+            DO ji = mi0(171), mi1(171)                ! div >0 => ua >0, opposite sign
+               ua(ji,jj,:) = - hdiv_172_94(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) )   &
+                  &                           * e2u(ji,jj) * fse3u(ji,jj,:)
+            END DO
+         END DO
+         !
+      END SELECT
+      !
+   END SUBROUTINE cla_hormuz
+   
+#else
+   !!----------------------------------------------------------------------
+   !!   Default key                                            Dummy module
+   !!----------------------------------------------------------------------
+   USE in_out_manager ! I/O manager
+CONTAINS
+   SUBROUTINE cla_init
+      CALL ctl_stop( 'cla_init: Cross Land Advection hard coded for ORCA_R2 with 31 levels' )
+   END SUBROUTINE cla_init
+   SUBROUTINE cla_div( kt )
+      WRITE(*,*) 'cla_div: You should have not see this print! error?', kt
+   END SUBROUTINE cla_div
+   SUBROUTINE cla_traadv( kt ) 
+      WRITE(*,*) 'cla_traadv: You should have not see this print! error?', kt
+   END SUBROUTINE cla_traadv
+   SUBROUTINE cla_dynspg( kt ) 
+      WRITE(*,*) 'dyn_spg_cla: You should have not see this print! error?', kt
+   END SUBROUTINE cla_dynspg
+#endif
+   
+   !!======================================================================
+END MODULE cla
Index: trunk/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90	(revision 2528)
@@ -0,0 +1,275 @@
+MODULE lbclnk
+   !!======================================================================
+   !!                       ***  MODULE  lbclnk  ***
+   !! Ocean        : lateral boundary conditions
+   !!=====================================================================
+   !! History :  OPA  ! 1997-06  (G. Madec)     Original code
+   !!   NEMO     1.0  ! 2002-09  (G. Madec)     F90: Free form and module
+   !!            3.2  ! 2009-03  (R. Benshila)  External north fold treatment  
+   !!----------------------------------------------------------------------
+#if   defined key_mpp_mpi
+   !!----------------------------------------------------------------------
+   !!   'key_mpp_mpi'             MPI massively parallel processing library
+   !!----------------------------------------------------------------------
+   !!   lbc_lnk      : generic interface for mpp_lnk_3d and mpp_lnk_2d routines defined in lib_mpp
+   !!   lbc_lnk_e    : generic interface for mpp_lnk_2d_e routine defined in lib_mpp
+   !!----------------------------------------------------------------------
+   USE lib_mpp          ! distributed memory computing library
+
+   INTERFACE lbc_lnk
+      MODULE PROCEDURE mpp_lnk_3d_gather, mpp_lnk_3d, mpp_lnk_2d
+   END INTERFACE
+
+   INTERFACE lbc_lnk_e
+      MODULE PROCEDURE mpp_lnk_2d_e
+   END INTERFACE
+
+   PUBLIC lbc_lnk       ! ocean lateral boundary conditions
+   PUBLIC lbc_lnk_e
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                              shared memory computing
+   !!----------------------------------------------------------------------
+   !!   lbc_lnk      : generic interface for lbc_lnk_3d and lbc_lnk_2d
+   !!   lbc_lnk_3d   : set the lateral boundary condition on a 3D variable on ocean mesh
+   !!   lbc_lnk_2d   : set the lateral boundary condition on a 2D variable on ocean mesh
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers   
+   USE dom_oce         ! ocean space and time domain 
+   USE in_out_manager  ! I/O manager
+   USE lbcnfd          ! north fold
+
+   IMPLICIT NONE
+   PRIVATE
+
+   INTERFACE lbc_lnk
+      MODULE PROCEDURE lbc_lnk_3d_gather, lbc_lnk_3d, lbc_lnk_2d
+   END INTERFACE
+
+   INTERFACE lbc_lnk_e
+      MODULE PROCEDURE lbc_lnk_2d
+   END INTERFACE
+
+   PUBLIC   lbc_lnk       ! ocean/ice  lateral boundary conditions
+   PUBLIC   lbc_lnk_e 
+   
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE lbc_lnk_3d_gather  ***
+      !!
+      !! ** Purpose :   set lateral boundary conditions on two 3D arrays (non mpp case)
+      !!
+      !! ** Method  :   psign = -1 :    change the sign across the north fold
+      !!                      =  1 : no change of the sign across the north fold
+      !!                      =  0 : no change of the sign across the north fold and
+      !!                             strict positivity preserved: use inner row/column
+      !!                             for closed boundaries.
+      !!----------------------------------------------------------------------
+      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1, cd_type2   ! nature of pt3d grid-points
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d1   , pt3d2      ! 3D array on which the lbc is applied
+      REAL(wp)                        , INTENT(in   ) ::   psgn                 ! control of the sign 
+      !!----------------------------------------------------------------------
+      !
+      CALL lbc_lnk_3d( pt3d1, cd_type1, psgn)
+      CALL lbc_lnk_3d( pt3d2, cd_type2, psgn)
+      !
+   END SUBROUTINE lbc_lnk_3d_gather
+
+
+   SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp, pval )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE lbc_lnk_3d  ***
+      !!
+      !! ** Purpose :   set lateral boundary conditions on a 3D array (non mpp case)
+      !!
+      !! ** Method  :   psign = -1 :    change the sign across the north fold
+      !!                      =  1 : no change of the sign across the north fold
+      !!                      =  0 : no change of the sign across the north fold and
+      !!                             strict positivity preserved: use inner row/column
+      !!                             for closed boundaries.
+      !!----------------------------------------------------------------------
+      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied
+      REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign 
+      CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
+      REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
+      !!
+      REAL(wp) ::   zland
+      !!----------------------------------------------------------------------
+
+      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default)
+      ELSE                         ;   zland = 0.e0
+      ENDIF
+
+
+      IF( PRESENT( cd_mpp ) ) THEN
+         ! only fill the overlap area and extra allows 
+         ! this is in mpp case. In this module, just do nothing
+      ELSE
+         !
+         !                                     !  East-West boundaries
+         !                                     ! ======================
+         SELECT CASE ( nperio )
+         !
+         CASE ( 1 , 4 , 6 )                       !**  cyclic east-west
+            pt3d( 1 ,:,:) = pt3d(jpim1,:,:)            ! all points
+            pt3d(jpi,:,:) = pt3d(  2  ,:,:)
+            !
+         CASE DEFAULT                             !**  East closed  --  West closed
+            SELECT CASE ( cd_type )
+            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
+               pt3d( 1 ,:,:) = zland
+               pt3d(jpi,:,:) = zland
+            CASE ( 'F' )                               ! F-point
+               pt3d(jpi,:,:) = zland
+            END SELECT
+            !
+         END SELECT
+         !
+         !                                     ! North-South boundaries
+         !                                     ! ======================
+         SELECT CASE ( nperio )
+         !
+         CASE ( 2 )                               !**  South symmetric  --  North closed
+            SELECT CASE ( cd_type )
+            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
+               pt3d(:, 1 ,:) = pt3d(:,3,:)
+               pt3d(:,jpj,:) = zland
+            CASE ( 'V' , 'F' )                         ! V-, F-points
+               pt3d(:, 1 ,:) = psgn * pt3d(:,2,:)
+               pt3d(:,jpj,:) = zland
+            END SELECT
+            !
+         CASE ( 3 , 4 , 5 , 6 )                   !**  North fold  T or F-point pivot  --  South closed
+            SELECT CASE ( cd_type )                    ! South : closed
+            CASE ( 'T' , 'U' , 'V' , 'W' , 'I' )             ! all points except F-point
+               pt3d(:, 1 ,:) = zland
+            END SELECT
+            !                                          ! North fold
+            pt3d( 1 ,jpj,:) = zland
+            pt3d(jpi,jpj,:) = zland
+            CALL lbc_nfd( pt3d(:,:,:), cd_type, psgn )
+            !
+         CASE DEFAULT                             !**  North closed  --  South closed
+            SELECT CASE ( cd_type )
+            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
+               pt3d(:, 1 ,:) = zland
+               pt3d(:,jpj,:) = zland
+            CASE ( 'F' )                               ! F-point
+               pt3d(:,jpj,:) = zland
+            END SELECT
+            !
+         END SELECT
+         !
+      ENDIF
+      !
+   END SUBROUTINE lbc_lnk_3d
+
+
+   SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval )
+      !!---------------------------------------------------------------------
+      !!                 ***  ROUTINE lbc_lnk_2d  ***
+      !!
+      !! ** Purpose :   set lateral boundary conditions on a 2D array (non mpp case)
+      !!
+      !! ** Method  :   psign = -1 :    change the sign across the north fold
+      !!                      =  1 : no change of the sign across the north fold
+      !!                      =  0 : no change of the sign across the north fold and
+      !!                             strict positivity preserved: use inner row/column
+      !!                             for closed boundaries.
+      !!----------------------------------------------------------------------
+      CHARACTER(len=1)            , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied
+      REAL(wp)                    , INTENT(in   )           ::   psgn      ! control of the sign 
+      CHARACTER(len=3)            , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
+      REAL(wp)                    , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
+      !!
+      REAL(wp) ::   zland
+      !!----------------------------------------------------------------------
+
+      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default)
+      ELSE                         ;   zland = 0.e0
+      ENDIF
+
+      IF (PRESENT(cd_mpp)) THEN
+         ! only fill the overlap area and extra allows 
+         ! this is in mpp case. In this module, just do nothing
+      ELSE      
+         !
+         !                                     ! East-West boundaries
+         !                                     ! ====================
+         SELECT CASE ( nperio )
+         !
+         CASE ( 1 , 4 , 6 )                       !** cyclic east-west
+            pt2d( 1 ,:) = pt2d(jpim1,:)               ! all points
+            pt2d(jpi,:) = pt2d(  2  ,:)
+            !
+         CASE DEFAULT                             !** East closed  --  West closed
+            SELECT CASE ( cd_type )
+            CASE ( 'T' , 'U' , 'V' , 'W' )            ! T-, U-, V-, W-points
+               pt2d( 1 ,:) = zland
+               pt2d(jpi,:) = zland
+            CASE ( 'F' )                              ! F-point
+               pt2d(jpi,:) = zland
+            END SELECT
+            !
+         END SELECT
+         !
+         !                                     ! North-South boundaries
+         !                                     ! ======================
+         SELECT CASE ( nperio )
+         !
+         CASE ( 2 )                               !**  South symmetric  --  North closed
+            SELECT CASE ( cd_type )
+            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
+               pt2d(:, 1 ) = pt2d(:,3)
+               pt2d(:,jpj) = zland
+            CASE ( 'V' , 'F' )                         ! V-, F-points
+               pt2d(:, 1 ) = psgn * pt2d(:,2)
+               pt2d(:,jpj) = zland
+            END SELECT
+            !
+         CASE ( 3 , 4 , 5 , 6 )                   !**  North fold  T or F-point pivot  --  South closed
+            SELECT CASE ( cd_type )                    ! South : closed
+            CASE ( 'T' , 'U' , 'V' , 'W' , 'I' )             ! all points except F-point
+               pt2d(:, 1 ) = zland
+            END SELECT
+            !                                          ! North fold
+            pt2d( 1 ,1  ) = zland 
+            pt2d( 1 ,jpj) = zland 
+            pt2d(jpi,jpj) = zland
+            CALL lbc_nfd( pt2d(:,:), cd_type, psgn )
+            !
+         CASE DEFAULT                             !**  North closed  --  South closed
+            SELECT CASE ( cd_type )
+            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
+               pt2d(:, 1 ) = zland
+               pt2d(:,jpj) = zland
+            CASE ( 'F' )                               ! F-point
+               pt2d(:,jpj) = zland
+            END SELECT
+            !
+         END SELECT
+         !
+      ENDIF
+      !    
+   END SUBROUTINE lbc_lnk_2d
+
+#endif
+
+   !!======================================================================
+END MODULE lbclnk
Index: trunk/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90	(revision 2528)
@@ -0,0 +1,308 @@
+MODULE lbcnfd
+   !!======================================================================
+   !!                       ***  MODULE  lbcnfd  ***
+   !! Ocean        : north fold  boundary conditions
+   !!======================================================================
+   !! History :  3.2  ! 2009-03  (R. Benshila)  Original code 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   lbc_nfd       : generic interface for lbc_nfd_3d and lbc_nfd_2d routines
+   !!   lbc_nfd_3d    : lateral boundary condition: North fold treatment for a 3D arrays   (lbc_nfd)
+   !!   lbc_nfd_2d    : lateral boundary condition: North fold treatment for a 2D arrays   (lbc_nfd)
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers   
+   USE dom_oce        ! ocean space and time domain 
+   USE in_out_manager ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   INTERFACE lbc_nfd
+      MODULE PROCEDURE   lbc_nfd_3d, lbc_nfd_2d
+   END INTERFACE
+
+   PUBLIC   lbc_nfd   ! north fold conditions
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lbc_nfd_3d( pt3d, cd_type, psgn )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine lbc_nfd_3d  ***
+      !!
+      !! ** Purpose :   3D lateral boundary condition : North fold treatment
+      !!              without processor exchanges. 
+      !!
+      !! ** Method  :   
+      !!
+      !! ** Action  :   pt3d with updated values along the north fold
+      !!----------------------------------------------------------------------
+      CHARACTER(len=1)          , INTENT(in   ) ::   cd_type   ! define the nature of ptab array grid-points
+      !                                                        !   = T , U , V , F , W points
+      REAL(wp)                  , INTENT(in   ) ::   psgn      ! control of the sign change
+      !                                                        !   = -1. , the sign is changed if north fold boundary
+      !                                                        !   =  1. , the sign is kept  if north fold boundary
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pt3d      ! 3D array on which the boundary condition is applied
+      !
+      INTEGER  ::   ji, jk
+      INTEGER  ::   ijt, iju, ijpj, ijpjm1
+      !!----------------------------------------------------------------------
+
+      SELECT CASE ( jpni )
+      CASE ( 1 )     ;   ijpj = nlcj      ! 1 proc only  along the i-direction
+      CASE DEFAULT   ;   ijpj = 4         ! several proc along the i-direction
+      END SELECT
+      ijpjm1 = ijpj-1
+
+      DO jk = 1, jpk
+         !
+         SELECT CASE ( npolj )
+         !
+         CASE ( 3 , 4 )                        ! *  North fold  T-point pivot
+            !
+            SELECT CASE ( cd_type )
+            CASE ( 'T' , 'W' )                         ! T-, W-point
+               DO ji = 2, jpiglo
+                  ijt = jpiglo-ji+2
+                  pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-2,jk)
+               END DO
+               DO ji = jpiglo/2+1, jpiglo
+                  ijt = jpiglo-ji+2
+                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(ijt,ijpjm1,jk)
+               END DO
+            CASE ( 'U' )                               ! U-point
+               DO ji = 1, jpiglo-1
+                  iju = jpiglo-ji+1
+                  pt3d(ji,ijpj,jk) = psgn * pt3d(iju,ijpj-2,jk)
+               END DO
+               DO ji = jpiglo/2, jpiglo-1
+                  iju = jpiglo-ji+1
+                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(iju,ijpjm1,jk)
+               END DO
+            CASE ( 'V' )                               ! V-point
+               DO ji = 2, jpiglo
+                  ijt = jpiglo-ji+2
+                  pt3d(ji,ijpj-1,jk) = psgn * pt3d(ijt,ijpj-2,jk)
+                  pt3d(ji,ijpj  ,jk) = psgn * pt3d(ijt,ijpj-3,jk)
+               END DO
+            CASE ( 'F' )                               ! F-point
+               DO ji = 1, jpiglo-1
+                  iju = jpiglo-ji+1
+                  pt3d(ji,ijpj-1,jk) = psgn * pt3d(iju,ijpj-2,jk)
+                  pt3d(ji,ijpj  ,jk) = psgn * pt3d(iju,ijpj-3,jk)
+               END DO
+            END SELECT
+            !
+         CASE ( 5 , 6 )                        ! *  North fold  F-point pivot
+            !
+            SELECT CASE ( cd_type )
+            CASE ( 'T' , 'W' )                         ! T-, W-point
+               DO ji = 1, jpiglo
+                  ijt = jpiglo-ji+1
+                  pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-1,jk)
+               END DO
+            CASE ( 'U' )                               ! U-point
+               DO ji = 1, jpiglo-1
+                  iju = jpiglo-ji
+                  pt3d(ji,ijpj,jk) = psgn * pt3d(iju,ijpj-1,jk)
+               END DO
+            CASE ( 'V' )                               ! V-point
+               DO ji = 1, jpiglo
+                  ijt = jpiglo-ji+1
+                  pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-2,jk)
+               END DO
+               DO ji = jpiglo/2+1, jpiglo
+                  ijt = jpiglo-ji+1
+                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(ijt,ijpjm1,jk)
+               END DO
+            CASE ( 'F' )                               ! F-point
+               DO ji = 1, jpiglo-1
+                  iju = jpiglo-ji
+                  pt3d(ji,ijpj  ,jk) = psgn * pt3d(iju,ijpj-2,jk)
+               END DO
+               DO ji = jpiglo/2+1, jpiglo-1
+                  iju = jpiglo-ji
+                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(iju,ijpjm1,jk)
+               END DO
+            END SELECT
+            !
+         CASE DEFAULT                           ! *  closed : the code probably never go through
+            !
+            SELECT CASE ( cd_type)
+            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
+               pt3d(:, 1  ,jk) = 0.e0
+               pt3d(:,ijpj,jk) = 0.e0
+            CASE ( 'F' )                               ! F-point
+               pt3d(:,ijpj,jk) = 0.e0
+            END SELECT
+            !
+         END SELECT     !  npolj
+         !
+      END DO
+      !
+   END SUBROUTINE lbc_nfd_3d
+
+
+   SUBROUTINE lbc_nfd_2d( pt2d, cd_type, psgn, pr2dj )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine lbc_nfd_2d  ***
+      !!
+      !! ** Purpose :   2D lateral boundary condition : North fold treatment
+      !!       without processor exchanges. 
+      !!
+      !! ** Method  :   
+      !!
+      !! ** Action  :   pt2d with updated values along the north fold
+      !!----------------------------------------------------------------------
+      CHARACTER(len=1)        , INTENT(in   ) ::   cd_type   ! define the nature of ptab array grid-points
+      !                                                      ! = T , U , V , F , W points
+      REAL(wp)                , INTENT(in   ) ::   psgn      ! control of the sign change
+      !                                                      !   = -1. , the sign is changed if north fold boundary
+      !                                                      !   =  1. , the sign is kept  if north fold boundary
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2d      ! 2D array on which the boundary condition is applied
+      INTEGER , OPTIONAL      , INTENT(in   ) ::   pr2dj     ! number of additional halos
+      !
+      INTEGER  ::   ji, jl, ipr2dj
+      INTEGER  ::   ijt, iju, ijpj, ijpjm1
+      !!----------------------------------------------------------------------
+
+      SELECT CASE ( jpni )
+      CASE ( 1 )     ;   ijpj = nlcj      ! 1 proc only  along the i-direction
+      CASE DEFAULT   ;   ijpj = 4         ! several proc along the i-direction
+      END SELECT
+      !
+      IF( PRESENT(pr2dj) ) THEN           ! use of additional halos
+         ipr2dj = pr2dj
+         IF( jpni > 1 )   ijpj = ijpj + ipr2dj
+      ELSE
+         ipr2dj = 0 
+      ENDIF
+      !
+      ijpjm1 = ijpj-1
+
+
+      SELECT CASE ( npolj )
+      !
+      CASE ( 3, 4 )                       ! *  North fold  T-point pivot
+         !
+         SELECT CASE ( cd_type )
+         !
+         CASE ( 'T' , 'W' )                               ! T- , W-points
+            DO jl = 0, ipr2dj
+               DO ji = 2, jpiglo
+                  ijt=jpiglo-ji+2
+                  pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-2-jl)
+               END DO
+            END DO
+            DO ji = jpiglo/2+1, jpiglo
+               ijt=jpiglo-ji+2
+               pt2d(ji,ijpj-1) = psgn * pt2d(ijt,ijpj-1)
+            END DO
+         CASE ( 'U' )                                     ! U-point
+            DO jl = 0, ipr2dj
+               DO ji = 1, jpiglo-1
+                  iju = jpiglo-ji+1
+                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-2-jl)
+               END DO
+            END DO
+            DO ji = jpiglo/2, jpiglo-1
+               iju = jpiglo-ji+1
+               pt2d(ji,ijpjm1) = psgn * pt2d(iju,ijpjm1)
+            END DO
+         CASE ( 'V' )                                     ! V-point
+            DO jl = -1, ipr2dj
+               DO ji = 2, jpiglo
+                  ijt = jpiglo-ji+2
+                  pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-3-jl)
+               END DO
+            END DO
+         CASE ( 'F' )                                     ! F-point
+            DO jl = -1, ipr2dj
+               DO ji = 1, jpiglo-1
+                  iju = jpiglo-ji+1
+                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-3-jl)
+               END DO
+            END DO
+         CASE ( 'I' )                                     ! ice U-V point (I-point)
+            DO jl = 0, ipr2dj
+               pt2d(2,ijpj+jl) = psgn * pt2d(3,ijpj-1+jl)
+               DO ji = 3, jpiglo
+                  iju = jpiglo - ji + 3
+                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl)
+               END DO
+            END DO
+         END SELECT
+         !
+      CASE ( 5, 6 )                        ! *  North fold  F-point pivot
+         !
+         SELECT CASE ( cd_type )
+         CASE ( 'T' , 'W' )                               ! T-, W-point
+            DO jl = 0, ipr2dj
+               DO ji = 1, jpiglo
+                  ijt = jpiglo-ji+1
+                  pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-1-jl)
+               END DO
+            END DO
+         CASE ( 'U' )                                     ! U-point
+            DO jl = 0, ipr2dj
+               DO ji = 1, jpiglo-1
+                  iju = jpiglo-ji
+                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl)
+               END DO
+            END DO
+         CASE ( 'V' )                                     ! V-point
+            DO jl = 0, ipr2dj
+               DO ji = 1, jpiglo
+                  ijt = jpiglo-ji+1
+                  pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-2-jl)
+               END DO
+            END DO
+            DO ji = jpiglo/2+1, jpiglo
+               ijt = jpiglo-ji+1
+               pt2d(ji,ijpjm1) = psgn * pt2d(ijt,ijpjm1)
+            END DO
+         CASE ( 'F' )                               ! F-point
+            DO jl = 0, ipr2dj
+               DO ji = 1, jpiglo-1
+                  iju = jpiglo-ji
+                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-2-jl)
+               END DO
+            END DO
+            DO ji = jpiglo/2+1, jpiglo-1
+               iju = jpiglo-ji
+               pt2d(ji,ijpjm1) = psgn * pt2d(iju,ijpjm1)
+            END DO
+         CASE ( 'I' )                                  ! ice U-V point (I-point)
+            pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0.e0
+            DO jl = 0, ipr2dj
+               DO ji = 2 , jpiglo-1
+                  ijt = jpiglo - ji + 2
+                  pt2d(ji,ijpj+jl)= 0.5 * ( pt2d(ji,ijpj-1-jl) + psgn * pt2d(ijt,ijpj-1-jl) )
+               END DO
+            END DO
+         END SELECT
+         !
+      CASE DEFAULT                           ! *  closed : the code probably never go through
+         !
+         SELECT CASE ( cd_type)
+         CASE ( 'T' , 'U' , 'V' , 'W' )                 ! T-, U-, V-, W-points
+            pt2d(:, 1:1-ipr2dj     ) = 0.e0
+            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
+         CASE ( 'F' )                                   ! F-point
+            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
+         CASE ( 'I' )                                   ! ice U-V point
+            pt2d(:, 1:1-ipr2dj     ) = 0.e0
+            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
+         END SELECT
+         !
+      END SELECT
+      !
+   END SUBROUTINE lbc_nfd_2d
+
+   !!======================================================================
+END MODULE lbcnfd
Index: trunk/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90	(revision 2528)
@@ -0,0 +1,2577 @@
+MODULE lib_mpp
+   !!======================================================================
+   !!                       ***  MODULE  lib_mpp  ***
+   !! Ocean numerics:  massively parallel processing library
+   !!=====================================================================
+   !! History :  OPA  !  1994  (M. Guyon, J. Escobar, M. Imbard)  Original code
+   !!            7.0  !  1997  (A.M. Treguier)  SHMEM additions
+   !!            8.0  !  1998  (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI
+   !!                 !  1998  (J.M. Molines) Open boundary conditions
+   !!   NEMO     1.0  !  2003  (J.-M. Molines, G. Madec)  F90, free form
+   !!                 !  2003  (J.M. Molines) add mpp_ini_north(_3d,_2d)
+   !!             -   !  2004  (R. Bourdalle Badie)  isend option in mpi
+   !!                 !  2004  (J.M. Molines) minloc, maxloc
+   !!             -   !  2005  (G. Madec, S. Masson)  npolj=5,6 F-point & ice cases
+   !!             -   !  2005  (R. Redler) Replacement of MPI_COMM_WORLD except for MPI_Abort
+   !!             -   !  2005  (R. Benshila, G. Madec)  add extra halo case
+   !!             -   !  2008  (R. Benshila) add mpp_ini_ice
+   !!            3.2  !  2009  (R. Benshila) SHMEM suppression, north fold in lbc_nfd
+   !!            3.2  !  2009  (O. Marti)    add mpp_ini_znl 
+   !!----------------------------------------------------------------------
+#if   defined key_mpp_mpi  
+   !!----------------------------------------------------------------------
+   !!   'key_mpp_mpi'             MPI massively parallel processing library
+   !!----------------------------------------------------------------------
+   !!   mynode      : indentify the processor unit
+   !!   mpp_lnk     : interface (defined in lbclnk) for message passing of 2d or 3d arrays (mpp_lnk_2d, mpp_lnk_3d)
+   !!   mpp_lnk_3d_gather :  Message passing manadgement for two 3D arrays
+   !!   mpp_lnk_e   : interface (defined in lbclnk) for message passing of 2d array with extra halo (mpp_lnk_2d_e)
+   !!   mpprecv     :
+   !!   mppsend     :   SUBROUTINE mpp_ini_znl
+   !!   mppscatter  :
+   !!   mppgather   :
+   !!   mpp_min     : generic interface for mppmin_int , mppmin_a_int , mppmin_real, mppmin_a_real
+   !!   mpp_max     : generic interface for mppmax_int , mppmax_a_int , mppmax_real, mppmax_a_real
+   !!   mpp_sum     : generic interface for mppsum_int , mppsum_a_int , mppsum_real, mppsum_a_real
+   !!   mpp_minloc  :
+   !!   mpp_maxloc  :
+   !!   mppsync     :
+   !!   mppstop     :
+   !!   mppobc      : variant of mpp_lnk for open boundary condition
+   !!   mpp_ini_north : initialisation of north fold
+   !!   mpp_lbc_north : north fold processors gathering
+   !!   mpp_lbc_north_e : variant of mpp_lbc_north for extra outer halo
+   !!----------------------------------------------------------------------
+   !! History :
+   !!        !  94 (M. Guyon, J. Escobar, M. Imbard)  Original code
+   !!        !  97  (A.M. Treguier)  SHMEM additions
+   !!        !  98  (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI
+   !!   9.0  !  03  (J.-M. Molines, G. Madec)  F90, free form
+   !!        !  04  (R. Bourdalle Badie)  isend option in mpi
+   !!        !  05  (G. Madec, S. Masson)  npolj=5,6 F-point & ice cases
+   !!        !  05  (R. Redler) Replacement of MPI_COMM_WORLD except for MPI_Abort
+   !!        !  09  (R. Benshila) SHMEM suppression, north fold in lbc_nfd
+   !!----------------------------------------------------------------------
+   USE dom_oce                    ! ocean space and time domain 
+   USE in_out_manager             ! I/O manager
+   USE lbcnfd                     ! north fold treatment
+
+   IMPLICIT NONE
+   PRIVATE
+   
+   PUBLIC   mynode, mppstop, mppsync, mpp_comm_free
+   PUBLIC   mpp_ini_north, mpp_lbc_north, mpp_lbc_north_e
+   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   mppobc, mpp_ini_ice, mpp_ini_znl
+
+   !! * Interfaces
+   !! define generic interface for these routine as they are called sometimes
+   !! with scalar arguments instead of array arguments, which causes problems
+   !! for the compilation on AIX system as well as NEC and SGI. Ok on COMPACQ
+   INTERFACE mpp_min
+      MODULE PROCEDURE mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real
+   END INTERFACE
+   INTERFACE mpp_max
+      MODULE PROCEDURE mppmax_a_int, mppmax_int, mppmax_a_real, mppmax_real
+   END INTERFACE
+   INTERFACE mpp_sum
+# if defined key_mpp_rep
+      MODULE PROCEDURE mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real, &
+                       mppsum_realdd, mppsum_a_realdd
+# else
+      MODULE PROCEDURE mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real
+# endif
+   END INTERFACE
+   INTERFACE mpp_lbc_north
+      MODULE PROCEDURE mpp_lbc_north_3d, mpp_lbc_north_2d 
+   END INTERFACE
+   INTERFACE mpp_minloc
+      MODULE PROCEDURE mpp_minloc2d ,mpp_minloc3d
+   END INTERFACE
+   INTERFACE mpp_maxloc
+      MODULE PROCEDURE mpp_maxloc2d ,mpp_maxloc3d
+   END INTERFACE
+   
+   !! ========================= !!
+   !!  MPI  variable definition !!
+   !! ========================= !!
+!$AGRIF_DO_NOT_TREAT
+   INCLUDE 'mpif.h'
+!$AGRIF_END_DO_NOT_TREAT
+   
+   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .TRUE.    !: mpp flag
+
+   INTEGER, PARAMETER         ::   nprocmax = 2**10   ! maximun dimension (required to be a power of 2)
+   
+   INTEGER ::   mppsize        ! number of process
+   INTEGER ::   mpprank        ! process number  [ 0 - size-1 ]
+!$AGRIF_DO_NOT_TREAT
+   INTEGER, PUBLIC ::   mpi_comm_opa   ! opa local communicator
+!$AGRIF_END_DO_NOT_TREAT
+
+# if defined key_mpp_rep
+   INTEGER :: MPI_SUMDD
+# endif
+
+   ! variables used in case of sea-ice
+   INTEGER, PUBLIC ::   ncomm_ice       !: communicator made by the processors with sea-ice
+   INTEGER ::   ngrp_ice        !  group ID for the ice processors (for rheology)
+   INTEGER ::   ndim_rank_ice   !  number of 'ice' processors
+   INTEGER ::   n_ice_root      !  number (in the comm_ice) of proc 0 in the ice comm
+   INTEGER, DIMENSION(:), ALLOCATABLE ::   nrank_ice     ! dimension ndim_rank_ice
+
+   ! variables used for zonal integration
+   INTEGER, PUBLIC ::   ncomm_znl       !: communicator made by the processors on the same zonal average
+   LOGICAL, PUBLIC ::   l_znl_root      ! True on the 'left'most processor on the same row
+   INTEGER ::   ngrp_znl        ! group ID for the znl processors
+   INTEGER ::   ndim_rank_znl   ! number of processors on the same zonal average
+   INTEGER, DIMENSION(:), ALLOCATABLE ::   nrank_znl  ! dimension ndim_rank_znl, number of the procs into the same znl domain
+   
+   ! North fold condition in mpp_mpi with jpni > 1
+   INTEGER ::   ngrp_world        ! group ID for the world processors
+   INTEGER ::   ngrp_opa          ! group ID for the opa processors
+   INTEGER ::   ngrp_north        ! group ID for the northern processors (to be fold)
+   INTEGER ::   ncomm_north       ! communicator made by the processors belonging to ngrp_north
+   INTEGER ::   ndim_rank_north   ! number of 'sea' processor in the northern line (can be /= jpni !)
+   INTEGER ::   njmppmax          ! value of njmpp for the processors of the northern line
+   INTEGER ::   north_root        ! number (in the comm_opa) of proc 0 in the northern comm
+   INTEGER, DIMENSION(:), ALLOCATABLE ::   nrank_north   ! dimension ndim_rank_north
+
+   ! Type of send : standard, buffered, immediate
+   CHARACTER(len=1) ::   cn_mpi_send = 'S'    ! type od mpi send/recieve (S=standard, B=bsend, I=isend)
+   LOGICAL          ::   l_isend = .FALSE.   ! isend use indicator (T if cn_mpi_send='I')
+   INTEGER          ::   nn_buffer = 0       ! size of the buffer in case of mpi_bsend 
+      
+   REAL(wp), ALLOCATABLE, DIMENSION(:) :: tampon  ! buffer in case of bsend
+
+   ! message passing arrays
+   REAL(wp), DIMENSION(jpi,jprecj,jpk,2,2) ::   t4ns, t4sn   ! 2 x 3d for north-south & south-north
+   REAL(wp), DIMENSION(jpj,jpreci,jpk,2,2) ::   t4ew, t4we   ! 2 x 3d for east-west & west-east
+   REAL(wp), DIMENSION(jpi,jprecj,jpk,2,2) ::   t4p1, t4p2   ! 2 x 3d for north fold
+   REAL(wp), DIMENSION(jpi,jprecj,jpk,2)   ::   t3ns, t3sn   ! 3d for north-south & south-north
+   REAL(wp), DIMENSION(jpj,jpreci,jpk,2)   ::   t3ew, t3we   ! 3d for east-west & west-east
+   REAL(wp), DIMENSION(jpi,jprecj,jpk,2)   ::   t3p1, t3p2   ! 3d for north fold
+   REAL(wp), DIMENSION(jpi,jprecj,2)       ::   t2ns, t2sn   ! 2d for north-south & south-north
+   REAL(wp), DIMENSION(jpj,jpreci,2)       ::   t2ew, t2we   ! 2d for east-west & west-east
+   REAL(wp), DIMENSION(jpi,jprecj,2)       ::   t2p1, t2p2   ! 2d for north fold
+   REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,jprecj+jpr2dj,2) ::   tr2ns, tr2sn  ! 2d for north-south & south-north + extra outer halo
+   REAL(wp), DIMENSION(1-jpr2dj:jpj+jpr2dj,jpreci+jpr2di,2) ::   tr2ew, tr2we  ! 2d for east-west   & west-east   + extra outer halo
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   FUNCTION mynode(ldtxt, localComm)
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mynode  ***
+      !!                    
+      !! ** Purpose :   Find processor unit
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt 
+      INTEGER, OPTIONAL            , INTENT(in   ) ::   localComm
+      INTEGER ::   mynode, ierr, code, ji, ii
+      LOGICAL ::   mpi_was_called
+      
+      NAMELIST/nammpp/ cn_mpi_send, nn_buffer
+      !!----------------------------------------------------------------------
+      !
+      ii = 1
+      WRITE(ldtxt(ii),*)                                                                          ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) 'mynode : mpi initialisation'                                            ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '~~~~~~ '                                                                ;   ii = ii + 1
+      !
+      REWIND( numnam )               ! Namelist namrun : parameters of the run
+      READ  ( numnam, nammpp )
+      !                              ! control print
+      WRITE(ldtxt(ii),*) '   Namelist nammpp'                                                     ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '      mpi send type                      cn_mpi_send = ', cn_mpi_send   ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '      size in bytes of exported buffer   nn_buffer   = ', nn_buffer     ;   ii = ii + 1
+
+      CALL mpi_initialized ( mpi_was_called, code )
+      IF( code /= MPI_SUCCESS ) THEN
+         DO ji = 1, SIZE(ldtxt) 
+            IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode
+         END DO         
+         WRITE(*, cform_err)
+         WRITE(*, *) 'lib_mpp: Error in routine mpi_initialized'
+         CALL mpi_abort( mpi_comm_world, code, ierr )
+      ENDIF
+
+      IF( mpi_was_called ) THEN
+         !
+         SELECT CASE ( cn_mpi_send )
+         CASE ( 'S' )                ! Standard mpi send (blocking)
+            WRITE(ldtxt(ii),*) '           Standard blocking mpi send (send)'                     ;   ii = ii + 1
+         CASE ( 'B' )                ! Buffer mpi send (blocking)
+            WRITE(ldtxt(ii),*) '           Buffer blocking mpi send (bsend)'                      ;   ii = ii + 1
+            IF( Agrif_Root() )   CALL mpi_init_opa( ldtxt, ii, ierr ) 
+         CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
+            WRITE(ldtxt(ii),*) '           Immediate non-blocking send (isend)'                   ;   ii = ii + 1
+            l_isend = .TRUE.
+         CASE DEFAULT
+            WRITE(ldtxt(ii),cform_err)                                                            ;   ii = ii + 1
+            WRITE(ldtxt(ii),*) '           bad value for cn_mpi_send = ', cn_mpi_send             ;   ii = ii + 1
+            nstop = nstop + 1
+         END SELECT
+      ELSE IF ( PRESENT(localComm) .and. .not. mpi_was_called ) THEN
+         WRITE(ldtxt(ii),*) ' lib_mpp: You cannot provide a local communicator '                  ;   ii = ii + 1
+         WRITE(ldtxt(ii),*) '          without calling MPI_Init before ! '                        ;   ii = ii + 1
+         nstop = nstop + 1
+      ELSE
+         SELECT CASE ( cn_mpi_send )
+         CASE ( 'S' )                ! Standard mpi send (blocking)
+            WRITE(ldtxt(ii),*) '           Standard blocking mpi send (send)'                     ;   ii = ii + 1
+            CALL mpi_init( ierr )
+         CASE ( 'B' )                ! Buffer mpi send (blocking)
+            WRITE(ldtxt(ii),*) '           Buffer blocking mpi send (bsend)'                      ;   ii = ii + 1
+            IF( Agrif_Root() )   CALL mpi_init_opa( ldtxt, ii, ierr )
+         CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
+            WRITE(ldtxt(ii),*) '           Immediate non-blocking send (isend)'                   ;   ii = ii + 1
+            l_isend = .TRUE.
+            CALL mpi_init( ierr )
+         CASE DEFAULT
+            WRITE(ldtxt(ii),cform_err)                                                            ;   ii = ii + 1
+            WRITE(ldtxt(ii),*) '           bad value for cn_mpi_send = ', cn_mpi_send             ;   ii = ii + 1
+            nstop = nstop + 1
+         END SELECT
+         !
+      ENDIF
+
+      IF( PRESENT(localComm) ) THEN 
+         IF( Agrif_Root() ) THEN
+            mpi_comm_opa = localComm
+         ENDIF
+      ELSE
+         CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code)
+         IF( code /= MPI_SUCCESS ) THEN
+            DO ji = 1, SIZE(ldtxt) 
+               IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode
+            END DO
+            WRITE(*, cform_err)
+            WRITE(*, *) ' lib_mpp: Error in routine mpi_comm_dup'
+            CALL mpi_abort( mpi_comm_world, code, ierr )
+         ENDIF
+      ENDIF 
+
+      CALL mpi_comm_rank( mpi_comm_opa, mpprank, ierr )
+      CALL mpi_comm_size( mpi_comm_opa, mppsize, ierr )
+      mynode = mpprank
+      ! 
+#if defined key_mpp_rep
+      CALL MPI_OP_CREATE(DDPDD_MPI, .TRUE., MPI_SUMDD, ierr)
+#endif
+      !
+   END FUNCTION mynode
+
+
+   SUBROUTINE mpp_lnk_3d( ptab, cd_type, psgn, cd_mpp, pval )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_3d  ***
+      !!
+      !! ** Purpose :   Message passing manadgement
+      !!
+      !! ** Method  :   Use mppsend and mpprecv function for passing mask 
+      !!      between processors following neighboring subdomains.
+      !!            domain parameters
+      !!                    nlci   : first dimension of the local subdomain
+      !!                    nlcj   : second dimension of the local subdomain
+      !!                    nbondi : mark for "east-west local boundary"
+      !!                    nbondj : mark for "north-south local boundary"
+      !!                    noea   : number for local neighboring processors 
+      !!                    nowe   : number for local neighboring processors
+      !!                    noso   : number for local neighboring processors
+      !!                    nono   : number for local neighboring processors
+      !!
+      !! ** Action  :   ptab with update value at its periphery
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied
+      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
+      !                                                             ! = T , U , V , F , W points
+      REAL(wp)                        , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
+      !                                                             ! =  1. , the sign is kept
+      CHARACTER(len=3), OPTIONAL      , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only 
+      REAL(wp)        , OPTIONAL      , INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
+      !!
+      INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices
+      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
+      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
+      REAL(wp) ::   zland
+      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
+      !!----------------------------------------------------------------------
+
+      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
+      ELSE                         ;   zland = 0.e0      ! zero by default
+      ENDIF
+
+      ! 1. standard boundary treatment
+      ! ------------------------------
+      IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values
+         !
+         ! WARNING ptab is defined only between nld and nle
+         DO jk = 1, jpk
+            DO jj = nlcj+1, jpj                 ! added line(s)   (inner only)
+               ptab(nldi  :nlei  , jj          ,jk) = ptab(nldi:nlei,     nlej,jk)   
+               ptab(1     :nldi-1, jj          ,jk) = ptab(nldi     ,     nlej,jk)
+               ptab(nlei+1:nlci  , jj          ,jk) = ptab(     nlei,     nlej,jk)
+            END DO
+            DO ji = nlci+1, jpi                 ! added column(s) (full)
+               ptab(ji           ,nldj  :nlej  ,jk) = ptab(     nlei,nldj:nlej,jk)
+               ptab(ji           ,1     :nldj-1,jk) = ptab(     nlei,nldj     ,jk)
+               ptab(ji           ,nlej+1:jpj   ,jk) = ptab(     nlei,     nlej,jk)
+            END DO
+         END DO
+         !
+      ELSE                              ! standard close or cyclic treatment 
+         !
+         !                                   ! East-West boundaries
+         !                                        !* Cyclic east-west
+         IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
+            ptab( 1 ,:,:) = ptab(jpim1,:,:)
+            ptab(jpi,:,:) = ptab(  2  ,:,:)
+         ELSE                                     !* closed
+            IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:,:) = zland    ! south except F-point
+                                         ptab(nlci-jpreci+1:jpi   ,:,:) = zland    ! north
+         ENDIF
+         !                                   ! North-South boundaries (always closed)
+         IF( .NOT. cd_type == 'F' )   ptab(:,     1       :jprecj,:) = zland       ! south except F-point
+                                      ptab(:,nlcj-jprecj+1:jpj   ,:) = zland       ! north
+         !
+      ENDIF
+
+      ! 2. East and west directions exchange
+      ! ------------------------------------
+      ! we play with the neigbours AND the row number because of the periodicity 
+      !
+      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
+            t3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)
+            t3we(:,jl,:,1) = ptab(iihom +jl,:,:)
+         END DO
+      END SELECT  
+      !
+      !                           ! Migrations
+      imigr = jpreci * jpj * jpk
+      !
+      SELECT CASE ( nbondi ) 
+      CASE ( -1 )
+         CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, t3ew(1,1,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, t3ew(1,1,1,2), imigr )
+         CALL mpprecv( 2, t3we(1,1,1,2), imigr )
+         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, t3ew(1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, t3we(1,1,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      iihom = nlci-jpreci
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         DO jl = 1, jpreci
+            ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)
+         END DO
+      CASE ( 0 ) 
+         DO jl = 1, jpreci
+            ptab(jl      ,:,:) = t3we(:,jl,:,2)
+            ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jpreci
+            ptab(jl      ,:,:) = t3we(:,jl,:,2)
+         END DO
+      END SELECT
+
+
+      ! 3. North and south directions
+      ! -----------------------------
+      ! always closed : we play only with the neigbours
+      !
+      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
+         ijhom = nlcj-nrecj
+         DO jl = 1, jprecj
+            t3sn(:,jl,:,1) = ptab(:,ijhom +jl,:)
+            t3ns(:,jl,:,1) = ptab(:,jprecj+jl,:)
+         END DO
+      ENDIF
+      !
+      !                           ! Migrations
+      imigr = jprecj * jpi * jpk
+      !
+      SELECT CASE ( nbondj )     
+      CASE ( -1 )
+         CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, t3ns(1,1,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, t3ns(1,1,1,2), imigr )
+         CALL mpprecv( 4, t3sn(1,1,1,2), imigr )
+         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, t3ns(1,1,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, t3sn(1,1,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      ijhom = nlcj-jprecj
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         DO jl = 1, jprecj
+            ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)
+         END DO
+      CASE ( 0 ) 
+         DO jl = 1, jprecj
+            ptab(:,jl      ,:) = t3sn(:,jl,:,2)
+            ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jprecj
+            ptab(:,jl,:) = t3sn(:,jl,:,2)
+         END DO
+      END SELECT
+
+
+      ! 4. north fold treatment
+      ! -----------------------
+      !
+      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
+         !
+         SELECT CASE ( jpni )
+         CASE ( 1 )     ;   CALL lbc_nfd      ( ptab, cd_type, psgn )   ! only 1 northern proc, no mpp
+         CASE DEFAULT   ;   CALL mpp_lbc_north( ptab, cd_type, psgn )   ! for all northern procs.
+         END SELECT
+         !
+      ENDIF
+      !
+   END SUBROUTINE mpp_lnk_3d
+
+
+   SUBROUTINE mpp_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_2d  ***
+      !!                  
+      !! ** Purpose :   Message passing manadgement for 2d array
+      !!
+      !! ** Method  :   Use mppsend and mpprecv function for passing mask 
+      !!      between processors following neighboring subdomains.
+      !!            domain parameters
+      !!                    nlci   : first dimension of the local subdomain
+      !!                    nlcj   : second dimension of the local subdomain
+      !!                    nbondi : mark for "east-west local boundary"
+      !!                    nbondj : mark for "north-south local boundary"
+      !!                    noea   : number for local neighboring processors 
+      !!                    nowe   : number for local neighboring processors
+      !!                    noso   : number for local neighboring processors
+      !!                    nono   : number for local neighboring processors
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d     ! 2D array on which the boundary condition is applied
+      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
+      !                                                         ! = T , U , V , F , W and I points
+      REAL(wp)                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
+      !                                                         ! =  1. , the sign is kept
+      CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only 
+      REAL(wp)        , OPTIONAL  , INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
+      !!
+      INTEGER  ::   ji, jj, jl   ! dummy loop indices
+      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
+      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
+      REAL(wp) ::   zland
+      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
+      !!----------------------------------------------------------------------
+
+      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
+      ELSE                         ;   zland = 0.e0      ! zero by default
+      ENDIF
+
+      ! 1. standard boundary treatment
+      ! ------------------------------
+      !
+      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(nldi  :nlei  , jj          ) = pt2d(nldi:nlei,     nlej)   
+            pt2d(1     :nldi-1, jj          ) = pt2d(nldi     ,     nlej)
+            pt2d(nlei+1:nlci  , jj          ) = pt2d(     nlei,     nlej)
+         END DO
+         DO ji = nlci+1, jpi                 ! added column(s) (full)
+            pt2d(ji           ,nldj  :nlej  ) = pt2d(     nlei,nldj:nlej)
+            pt2d(ji           ,1     :nldj-1) = pt2d(     nlei,nldj     )
+            pt2d(ji           ,nlej+1:jpj   ) = 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( 1 ,:) = pt2d(jpim1,:)                                    ! west
+            pt2d(jpi,:) = pt2d(  2  ,:)                                    ! east
+         ELSE                                     ! closed
+            IF( .NOT. cd_type == 'F' )   pt2d(     1       :jpreci,:) = zland    ! south except F-point
+                                         pt2d(nlci-jpreci+1:jpi   ,:) = zland    ! north
+         ENDIF
+         !                                   ! North-South boundaries (always closed)
+            IF( .NOT. cd_type == 'F' )   pt2d(:,     1       :jprecj) = zland    !south except F-point
+                                         pt2d(:,nlcj-jprecj+1:jpj   ) = zland    ! north
+         !
+      ENDIF
+
+      ! 2. East and west directions exchange
+      ! ------------------------------------
+      ! we play with the neigbours AND the row number because of the periodicity 
+      !
+      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
+            t2ew(:,jl,1) = pt2d(jpreci+jl,:)
+            t2we(:,jl,1) = pt2d(iihom +jl,:)
+         END DO
+      END SELECT
+      !
+      !                           ! Migrations
+      imigr = jpreci * jpj
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, t2ew(1,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, t2ew(1,1,2), imigr )
+         CALL mpprecv( 2, t2we(1,1,2), imigr )
+         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, t2ew(1,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, t2we(1,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      iihom = nlci - jpreci
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         DO jl = 1, jpreci
+            pt2d(iihom+jl,:) = t2ew(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jpreci
+            pt2d(jl      ,:) = t2we(:,jl,2)
+            pt2d(iihom+jl,:) = t2ew(:,jl,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jpreci
+            pt2d(jl      ,:) = t2we(:,jl,2)
+         END DO
+      END SELECT
+
+
+      ! 3. North and south directions
+      ! -----------------------------
+      ! always closed : we play only with the neigbours
+      !
+      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
+         ijhom = nlcj-nrecj
+         DO jl = 1, jprecj
+            t2sn(:,jl,1) = pt2d(:,ijhom +jl)
+            t2ns(:,jl,1) = pt2d(:,jprecj+jl)
+         END DO
+      ENDIF
+      !
+      !                           ! Migrations
+      imigr = jprecj * jpi
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, t2ns(1,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, t2ns(1,1,2), imigr )
+         CALL mpprecv( 4, t2sn(1,1,2), imigr )
+         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, t2ns(1,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, t2sn(1,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      ijhom = nlcj - jprecj
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         DO jl = 1, jprecj
+            pt2d(:,ijhom+jl) = t2ns(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jprecj
+            pt2d(:,jl      ) = t2sn(:,jl,2)
+            pt2d(:,ijhom+jl) = t2ns(:,jl,2)
+         END DO
+      CASE ( 1 ) 
+         DO jl = 1, jprecj
+            pt2d(:,jl      ) = t2sn(:,jl,2)
+         END DO
+      END SELECT
+
+
+      ! 4. north fold treatment
+      ! -----------------------
+      !
+      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
+         !
+         SELECT CASE ( jpni )
+         CASE ( 1 )     ;   CALL lbc_nfd      ( pt2d, cd_type, psgn )   ! only 1 northern proc, no mpp
+         CASE DEFAULT   ;   CALL mpp_lbc_north( pt2d, cd_type, psgn )   ! for all northern procs.
+         END SELECT
+         !
+      ENDIF
+      !
+   END SUBROUTINE mpp_lnk_2d
+
+
+   SUBROUTINE mpp_lnk_3d_gather( ptab1, cd_type1, ptab2, cd_type2, psgn )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_3d_gather  ***
+      !!
+      !! ** Purpose :   Message passing manadgement for two 3D 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
+      !!
+      !! ** Action  :   ptab1 and ptab2  with update value at its periphery
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab1     ! first and second 3D array on which 
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab2     ! the boundary condition is applied
+      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1  ! nature of ptab1 and ptab2 arrays 
+      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type2  ! i.e. grid-points = T , U , V , F or W points
+      REAL(wp)                        , INTENT(in   ) ::   psgn      ! =-1 the sign change across the north fold boundary
+      !!                                                             ! =  1. , the sign is kept
+      INTEGER  ::   jl   ! dummy loop indices
+      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
+      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
+      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
+      !!----------------------------------------------------------------------
+
+      ! 1. standard boundary treatment
+      ! ------------------------------
+      !                                      ! East-West boundaries
+      !                                           !* Cyclic east-west
+      IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
+         ptab1( 1 ,:,:) = ptab1(jpim1,:,:)
+         ptab1(jpi,:,:) = ptab1(  2  ,:,:)
+         ptab2( 1 ,:,:) = ptab2(jpim1,:,:)
+         ptab2(jpi,:,:) = ptab2(  2  ,:,:)
+      ELSE                                        !* closed
+         IF( .NOT. cd_type1 == 'F' )   ptab1(     1       :jpreci,:,:) = 0.e0    ! south except at F-point
+         IF( .NOT. cd_type2 == 'F' )   ptab2(     1       :jpreci,:,:) = 0.e0
+                                       ptab1(nlci-jpreci+1:jpi   ,:,:) = 0.e0    ! north
+                                       ptab2(nlci-jpreci+1:jpi   ,:,:) = 0.e0
+      ENDIF
+
+      
+      !                                      ! North-South boundaries
+      IF( .NOT. cd_type1 == 'F' )   ptab1(:,     1       :jprecj,:) = 0.e0    ! south except at F-point
+      IF( .NOT. cd_type2 == 'F' )   ptab2(:,     1       :jprecj,:) = 0.e0
+                                    ptab1(:,nlcj-jprecj+1:jpj   ,:) = 0.e0    ! north
+                                    ptab2(:,nlcj-jprecj+1:jpj   ,:) = 0.e0
+
+
+      ! 2. East and west directions exchange
+      ! ------------------------------------
+      ! we play with the neigbours AND the row number because of the periodicity 
+      !
+      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
+            t4ew(:,jl,:,1,1) = ptab1(jpreci+jl,:,:)
+            t4we(:,jl,:,1,1) = ptab1(iihom +jl,:,:)
+            t4ew(:,jl,:,2,1) = ptab2(jpreci+jl,:,:)
+            t4we(:,jl,:,2,1) = ptab2(iihom +jl,:,:)
+         END DO
+      END SELECT
+      !
+      !                           ! Migrations
+      imigr = jpreci * jpj * jpk *2
+      !
+      SELECT CASE ( nbondi ) 
+      CASE ( -1 )
+         CALL mppsend( 2, t4we(1,1,1,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, t4ew(1,1,1,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, t4ew(1,1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, t4we(1,1,1,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, t4ew(1,1,1,1,2), imigr )
+         CALL mpprecv( 2, t4we(1,1,1,1,2), imigr )
+         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, t4ew(1,1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, t4we(1,1,1,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      iihom = nlci - jpreci
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         DO jl = 1, jpreci
+            ptab1(iihom+jl,:,:) = t4ew(:,jl,:,1,2)
+            ptab2(iihom+jl,:,:) = t4ew(:,jl,:,2,2)
+         END DO
+      CASE ( 0 ) 
+         DO jl = 1, jpreci
+            ptab1(jl      ,:,:) = t4we(:,jl,:,1,2)
+            ptab1(iihom+jl,:,:) = t4ew(:,jl,:,1,2)
+            ptab2(jl      ,:,:) = t4we(:,jl,:,2,2)
+            ptab2(iihom+jl,:,:) = t4ew(:,jl,:,2,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jpreci
+            ptab1(jl      ,:,:) = t4we(:,jl,:,1,2)
+            ptab2(jl      ,:,:) = t4we(:,jl,:,2,2)
+         END DO
+      END SELECT
+
+
+      ! 3. North and south directions
+      ! -----------------------------
+      ! always closed : we play only with the neigbours
+      !
+      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
+         ijhom = nlcj - nrecj
+         DO jl = 1, jprecj
+            t4sn(:,jl,:,1,1) = ptab1(:,ijhom +jl,:)
+            t4ns(:,jl,:,1,1) = ptab1(:,jprecj+jl,:)
+            t4sn(:,jl,:,2,1) = ptab2(:,ijhom +jl,:)
+            t4ns(:,jl,:,2,1) = ptab2(:,jprecj+jl,:)
+         END DO
+      ENDIF
+      !
+      !                           ! Migrations
+      imigr = jprecj * jpi * jpk * 2
+      !
+      SELECT CASE ( nbondj )     
+      CASE ( -1 )
+         CALL mppsend( 4, t4sn(1,1,1,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, t4ns(1,1,1,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         CALL mppsend( 3, t4ns(1,1,1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, t4sn(1,1,1,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, t4ns(1,1,1,1,2), imigr )
+         CALL mpprecv( 4, t4sn(1,1,1,1,2), imigr )
+         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, t4ns(1,1,1,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, t4sn(1,1,1,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      ijhom = nlcj - jprecj
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         DO jl = 1, jprecj
+            ptab1(:,ijhom+jl,:) = t4ns(:,jl,:,1,2)
+            ptab2(:,ijhom+jl,:) = t4ns(:,jl,:,2,2)
+         END DO
+      CASE ( 0 ) 
+         DO jl = 1, jprecj
+            ptab1(:,jl      ,:) = t4sn(:,jl,:,1,2)
+            ptab1(:,ijhom+jl,:) = t4ns(:,jl,:,1,2)
+            ptab2(:,jl      ,:) = t4sn(:,jl,:,2,2)
+            ptab2(:,ijhom+jl,:) = t4ns(:,jl,:,2,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jprecj
+            ptab1(:,jl,:) = t4sn(:,jl,:,1,2)
+            ptab2(:,jl,:) = t4sn(:,jl,:,2,2)
+         END DO
+      END SELECT
+
+
+      ! 4. north fold treatment
+      ! -----------------------
+      IF( npolj /= 0 ) THEN
+         !
+         SELECT CASE ( jpni )
+         CASE ( 1 )                                           
+            CALL lbc_nfd      ( ptab1, cd_type1, psgn )   ! only for northern procs.
+            CALL lbc_nfd      ( ptab2, cd_type2, psgn )
+         CASE DEFAULT
+            CALL mpp_lbc_north( ptab1, cd_type1, psgn )   ! for all northern procs.
+            CALL mpp_lbc_north (ptab2, cd_type2, psgn)
+         END SELECT 
+         !
+      ENDIF
+      !
+   END SUBROUTINE mpp_lnk_3d_gather
+
+
+   SUBROUTINE mpp_lnk_2d_e( pt2d, cd_type, psgn )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_2d_e  ***
+      !!                  
+      !! ** Purpose :   Message passing manadgement for 2d array (with halo)
+      !!
+      !! ** 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
+      !!                    jpr2di : number of rows for extra outer halo
+      !!                    jpr2dj : number of columns for extra outer halo
+      !!                    nbondi : mark for "east-west local boundary"
+      !!                    nbondj : mark for "north-south local boundary"
+      !!                    noea   : number for local neighboring processors 
+      !!                    nowe   : number for local neighboring processors
+      !!                    noso   : number for local neighboring processors
+      !!                    nono   : number for local neighboring processors
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj), INTENT(inout) ::   pt2d     ! 2D array with extra halo
+      CHARACTER(len=1)                                            , INTENT(in   ) ::   cd_type  ! nature of ptab array grid-points
+      !                                                                                         ! = T , U , V , F , W and I points
+      REAL(wp)                                                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the
+      !!                                                                                        ! north boundary, =  1. otherwise
+      INTEGER  ::   jl   ! dummy loop indices
+      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
+      INTEGER  ::   ipreci, iprecj             ! temporary integers
+      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
+      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
+      !!----------------------------------------------------------------------
+
+      ipreci = jpreci + jpr2di      ! take into account outer extra 2D overlap area
+      iprecj = jprecj + jpr2dj
+
+
+      ! 1. standard boundary treatment
+      ! ------------------------------
+      ! Order matters Here !!!!
+      !
+      !                                      !* North-South boundaries (always colsed)
+      IF( .NOT. cd_type == 'F' )   pt2d(:,  1-jpr2dj   :  jprecj  ) = 0.e0    ! south except at F-point
+                                   pt2d(:,nlcj-jprecj+1:jpj+jpr2dj) = 0.e0    ! north
+                                
+      !                                      ! East-West boundaries
+      !                                           !* Cyclic east-west
+      IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
+         pt2d(1-jpr2di:     1    ,:) = pt2d(jpim1-jpr2di:  jpim1 ,:)       ! east
+         pt2d(   jpi  :jpi+jpr2di,:) = pt2d(     2      :2+jpr2di,:)       ! west
+         !
+      ELSE                                        !* closed
+         IF( .NOT. cd_type == 'F' )   pt2d(  1-jpr2di   :jpreci    ,:) = 0.e0    ! south except at F-point
+                                      pt2d(nlci-jpreci+1:jpi+jpr2di,:) = 0.e0    ! north
+      ENDIF
+      !
+
+      ! north fold treatment
+      ! -----------------------
+      IF( npolj /= 0 ) THEN
+         !
+         SELECT CASE ( jpni )
+         CASE ( 1 )     ;   CALL lbc_nfd        ( pt2d(1:jpi,1:jpj+jpr2dj), cd_type, psgn, pr2dj=jpr2dj )
+         CASE DEFAULT   ;   CALL mpp_lbc_north_e( pt2d                    , cd_type, psgn               )
+         END SELECT 
+         !
+      ENDIF
+
+      ! 2. East and west directions exchange
+      ! ------------------------------------
+      ! we play with the neigbours AND the row number because of the periodicity 
+      !
+      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
+      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
+         iihom = nlci-nreci-jpr2di
+         DO jl = 1, ipreci
+            tr2ew(:,jl,1) = pt2d(jpreci+jl,:)
+            tr2we(:,jl,1) = pt2d(iihom +jl,:)
+         END DO
+      END SELECT
+      !
+      !                           ! Migrations
+      imigr = ipreci * ( jpj + 2*jpr2dj)
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         CALL mppsend( 2, tr2we(1-jpr2dj,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, tr2ew(1-jpr2dj,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, tr2we(1-jpr2dj,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr )
+         CALL mpprecv( 2, tr2we(1-jpr2dj,1,2), imigr )
+         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, tr2ew(1-jpr2dj,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, tr2we(1-jpr2dj,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      iihom = nlci - jpreci
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         DO jl = 1, ipreci
+            pt2d(iihom+jl,:) = tr2ew(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, ipreci
+            pt2d(jl-jpr2di,:) = tr2we(:,jl,2)
+            pt2d( iihom+jl,:) = tr2ew(:,jl,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, ipreci
+            pt2d(jl-jpr2di,:) = tr2we(:,jl,2)
+         END DO
+      END SELECT
+
+
+      ! 3. North and south directions
+      ! -----------------------------
+      ! always closed : we play only with the neigbours
+      !
+      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
+         ijhom = nlcj-nrecj-jpr2dj
+         DO jl = 1, iprecj
+            tr2sn(:,jl,1) = pt2d(:,ijhom +jl)
+            tr2ns(:,jl,1) = pt2d(:,jprecj+jl)
+         END DO
+      ENDIF
+      !
+      !                           ! Migrations
+      imigr = iprecj * ( jpi + 2*jpr2di )
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         CALL mppsend( 4, tr2sn(1-jpr2di,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, tr2ns(1-jpr2di,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 3, tr2ns(1-jpr2di,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, tr2sn(1-jpr2di,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, tr2ns(1-jpr2di,1,2), imigr )
+         CALL mpprecv( 4, tr2sn(1-jpr2di,1,2), imigr )
+         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, tr2ns(1-jpr2di,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, tr2sn(1-jpr2di,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      ijhom = nlcj - jprecj  
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         DO jl = 1, iprecj
+            pt2d(:,ijhom+jl) = tr2ns(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, iprecj
+            pt2d(:,jl-jpr2dj) = tr2sn(:,jl,2)
+            pt2d(:,ijhom+jl ) = tr2ns(:,jl,2)
+         END DO
+      CASE ( 1 ) 
+         DO jl = 1, iprecj
+            pt2d(:,jl-jpr2dj) = tr2sn(:,jl,2)
+         END DO
+      END SELECT
+
+   END SUBROUTINE mpp_lnk_2d_e
+
+
+   SUBROUTINE mppsend( ktyp, pmess, kbytes, kdest, md_req )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppsend  ***
+      !!                   
+      !! ** Purpose :   Send messag passing array
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(inout) ::   pmess(*)   ! array of real
+      INTEGER , INTENT(in   ) ::   kbytes     ! size of the array pmess
+      INTEGER , INTENT(in   ) ::   kdest      ! receive process number
+      INTEGER , INTENT(in   ) ::   ktyp       ! tag of the message
+      INTEGER , INTENT(in   ) ::   md_req     ! argument for isend
+      !!
+      INTEGER ::   iflag
+      !!----------------------------------------------------------------------
+      !
+      SELECT CASE ( cn_mpi_send )
+      CASE ( 'S' )                ! Standard mpi send (blocking)
+         CALL mpi_send ( pmess, kbytes, mpi_double_precision, kdest , ktyp, mpi_comm_opa        , iflag )
+      CASE ( 'B' )                ! Buffer mpi send (blocking)
+         CALL mpi_bsend( pmess, kbytes, mpi_double_precision, kdest , ktyp, mpi_comm_opa        , iflag )
+      CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
+         ! be carefull, one more argument here : the mpi request identifier..
+         CALL mpi_isend( pmess, kbytes, mpi_double_precision, kdest , ktyp, mpi_comm_opa, md_req, iflag )
+      END SELECT
+      !
+   END SUBROUTINE mppsend
+
+
+   SUBROUTINE mpprecv( ktyp, pmess, kbytes )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpprecv  ***
+      !!
+      !! ** Purpose :   Receive messag passing array
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(inout) ::   pmess(*)   ! array of real
+      INTEGER , INTENT(in   ) ::   kbytes     ! suze of the array pmess
+      INTEGER , INTENT(in   ) ::   ktyp       ! Tag of the recevied message
+      !!
+      INTEGER :: istatus(mpi_status_size)
+      INTEGER :: iflag
+      !!----------------------------------------------------------------------
+      !
+      CALL mpi_recv( pmess, kbytes, mpi_double_precision, mpi_any_source, ktyp, mpi_comm_opa, istatus, iflag )
+      !
+   END SUBROUTINE mpprecv
+
+
+   SUBROUTINE mppgather( ptab, kp, pio )
+      !!----------------------------------------------------------------------
+      !!                   ***  routine mppgather  ***
+      !!                   
+      !! ** Purpose :   Transfert between a local subdomain array and a work 
+      !!     array which is distributed following the vertical level.
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj),       INTENT(in   ) ::   ptab   ! subdomain input array
+      INTEGER ,                           INTENT(in   ) ::   kp     ! record length
+      REAL(wp), DIMENSION(jpi,jpj,jpnij), INTENT(  out) ::   pio    ! subdomain input array
+      !!
+      INTEGER :: itaille, ierror   ! temporary integer
+      !!---------------------------------------------------------------------
+      !
+      itaille = jpi * jpj
+      CALL mpi_gather( ptab, itaille, mpi_double_precision, pio, itaille     ,   &
+         &                            mpi_double_precision, kp , mpi_comm_opa, ierror ) 
+      !
+   END SUBROUTINE mppgather
+
+
+   SUBROUTINE mppscatter( pio, kp, ptab )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppscatter  ***
+      !!
+      !! ** Purpose :   Transfert between awork array which is distributed 
+      !!      following the vertical level and the local subdomain array.
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpnij)  ::  pio        ! output array
+      INTEGER                             ::   kp        ! Tag (not used with MPI
+      REAL(wp), DIMENSION(jpi,jpj)        ::  ptab       ! subdomain array input
+      !!
+      INTEGER :: itaille, ierror   ! temporary integer
+      !!---------------------------------------------------------------------
+      !
+      itaille=jpi*jpj
+      !
+      CALL mpi_scatter( pio, itaille, mpi_double_precision, ptab, itaille     ,   &
+         &                            mpi_double_precision, kp  , mpi_comm_opa, ierror )
+      !
+   END SUBROUTINE mppscatter
+
+
+   SUBROUTINE mppmax_a_int( ktab, kdim, kcom )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppmax_a_int  ***
+      !! 
+      !! ** Purpose :   Find maximum value in an integer layout array
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER , INTENT(in   )                  ::   kdim   ! size of array
+      INTEGER , INTENT(inout), DIMENSION(kdim) ::   ktab   ! input array
+      INTEGER , INTENT(in   ), OPTIONAL        ::   kcom   ! 
+      !!
+      INTEGER :: ierror, localcomm   ! temporary integer
+      INTEGER, DIMENSION(kdim) ::   iwork
+      !!----------------------------------------------------------------------
+      !
+      localcomm = mpi_comm_opa
+      IF( PRESENT(kcom) )   localcomm = kcom
+      !
+      CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer, mpi_max, localcomm, ierror )
+      !
+      ktab(:) = iwork(:)
+      !
+   END SUBROUTINE mppmax_a_int
+
+
+   SUBROUTINE mppmax_int( ktab, kcom )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppmax_int  ***
+      !!
+      !! ** Purpose :   Find maximum value in an integer layout array
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(inout)           ::   ktab      ! ???
+      INTEGER, INTENT(in   ), OPTIONAL ::   kcom      ! ???
+      !! 
+      INTEGER ::   ierror, iwork, localcomm   ! temporary integer
+      !!----------------------------------------------------------------------
+      !
+      localcomm = mpi_comm_opa 
+      IF( PRESENT(kcom) )   localcomm = kcom
+      !
+      CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_max, localcomm, ierror)
+      !
+      ktab = iwork
+      !
+   END SUBROUTINE mppmax_int
+
+
+   SUBROUTINE mppmin_a_int( ktab, kdim, kcom )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppmin_a_int  ***
+      !! 
+      !! ** Purpose :   Find minimum value in an integer layout array
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER , INTENT( in  )                  ::   kdim        ! size of array
+      INTEGER , INTENT(inout), DIMENSION(kdim) ::   ktab        ! input array
+      INTEGER , INTENT( in  ), OPTIONAL        ::   kcom        ! input array
+      !!
+      INTEGER ::   ierror, localcomm   ! temporary integer
+      INTEGER, DIMENSION(kdim) ::   iwork
+      !!----------------------------------------------------------------------
+      !
+      localcomm = mpi_comm_opa
+      IF( PRESENT(kcom) )   localcomm = kcom
+      !
+      CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer, mpi_min, localcomm, ierror )
+      !
+      ktab(:) = iwork(:)
+      !
+   END SUBROUTINE mppmin_a_int
+
+
+   SUBROUTINE mppmin_int( ktab, kcom )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppmin_int  ***
+      !!
+      !! ** Purpose :   Find minimum value in an integer layout array
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(inout) ::   ktab      ! ???
+      INTEGER , INTENT( in  ), OPTIONAL        ::   kcom        ! input array
+      !!
+      INTEGER ::  ierror, iwork, localcomm
+      !!----------------------------------------------------------------------
+      !
+      localcomm = mpi_comm_opa
+      IF( PRESENT(kcom) )   localcomm = kcom
+      !
+     CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_min, localcomm, ierror )
+      !
+      ktab = iwork
+      !
+   END SUBROUTINE mppmin_int
+
+
+   SUBROUTINE mppsum_a_int( ktab, kdim )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppsum_a_int  ***
+      !!                    
+      !! ** Purpose :   Global integer sum, 1D array case
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in   )                   ::   kdim      ! ???
+      INTEGER, INTENT(inout), DIMENSION (kdim) ::   ktab      ! ???
+      !!
+      INTEGER :: ierror
+      INTEGER, DIMENSION (kdim) ::  iwork
+      !!----------------------------------------------------------------------
+      !
+      CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer, mpi_sum, mpi_comm_opa, ierror )
+      !
+      ktab(:) = iwork(:)
+      !
+   END SUBROUTINE mppsum_a_int
+
+
+   SUBROUTINE mppsum_int( ktab )
+      !!----------------------------------------------------------------------
+      !!                 ***  routine mppsum_int  ***
+      !!                  
+      !! ** Purpose :   Global integer sum
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(inout) ::   ktab
+      !! 
+      INTEGER :: ierror, iwork
+      !!----------------------------------------------------------------------
+      !
+      CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_sum, mpi_comm_opa, ierror )
+      !
+      ktab = iwork
+      !
+   END SUBROUTINE mppsum_int
+
+
+   SUBROUTINE mppmax_a_real( ptab, kdim, kcom )
+      !!----------------------------------------------------------------------
+      !!                 ***  routine mppmax_a_real  ***
+      !!                  
+      !! ** Purpose :   Maximum
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER , INTENT(in   )                  ::   kdim
+      REAL(wp), INTENT(inout), DIMENSION(kdim) ::   ptab
+      INTEGER , INTENT(in   ), OPTIONAL        ::   kcom
+      !!
+      INTEGER :: ierror, localcomm
+      REAL(wp), DIMENSION(kdim) ::  zwork
+      !!----------------------------------------------------------------------
+      !
+      localcomm = mpi_comm_opa
+      IF( PRESENT(kcom) ) localcomm = kcom
+      !
+      CALL mpi_allreduce( ptab, zwork, kdim, mpi_double_precision, mpi_max, localcomm, ierror )
+      ptab(:) = zwork(:)
+      !
+   END SUBROUTINE mppmax_a_real
+
+
+   SUBROUTINE mppmax_real( ptab, kcom )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppmax_real  ***
+      !!                    
+      !! ** Purpose :   Maximum
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(inout)           ::   ptab   ! ???
+      INTEGER , INTENT(in   ), OPTIONAL ::   kcom   ! ???
+      !!
+      INTEGER  ::   ierror, localcomm
+      REAL(wp) ::   zwork
+      !!----------------------------------------------------------------------
+      !
+      localcomm = mpi_comm_opa 
+      IF( PRESENT(kcom) )   localcomm = kcom
+      !
+      CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision, mpi_max, localcomm, ierror )
+      ptab = zwork
+      !
+   END SUBROUTINE mppmax_real
+
+
+   SUBROUTINE mppmin_a_real( ptab, kdim, kcom )
+      !!----------------------------------------------------------------------
+      !!                 ***  routine mppmin_a_real  ***
+      !!                  
+      !! ** Purpose :   Minimum of REAL, array case
+      !!
+      !!-----------------------------------------------------------------------
+      INTEGER , INTENT(in   )                  ::   kdim
+      REAL(wp), INTENT(inout), DIMENSION(kdim) ::   ptab
+      INTEGER , INTENT(in   ), OPTIONAL        ::   kcom
+      !!
+      INTEGER :: ierror, localcomm
+      REAL(wp), DIMENSION(kdim) ::   zwork
+      !!-----------------------------------------------------------------------
+      !
+      localcomm = mpi_comm_opa 
+      IF( PRESENT(kcom) ) localcomm = kcom
+      !
+      CALL mpi_allreduce( ptab, zwork, kdim, mpi_double_precision, mpi_min, localcomm, ierror )
+      ptab(:) = zwork(:)
+      !
+   END SUBROUTINE mppmin_a_real
+
+
+   SUBROUTINE mppmin_real( ptab, kcom )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppmin_real  ***
+      !! 
+      !! ** Purpose :   minimum of REAL, scalar case
+      !!
+      !!-----------------------------------------------------------------------
+      REAL(wp), INTENT(inout)           ::   ptab        ! 
+      INTEGER , INTENT(in   ), OPTIONAL :: kcom
+      !!
+      INTEGER  ::   ierror
+      REAL(wp) ::   zwork
+      INTEGER :: localcomm
+      !!-----------------------------------------------------------------------
+      !
+      localcomm = mpi_comm_opa 
+      IF( PRESENT(kcom) )   localcomm = kcom
+      !
+      CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision, mpi_min, localcomm, ierror )
+      ptab = zwork
+      !
+   END SUBROUTINE mppmin_real
+
+
+   SUBROUTINE mppsum_a_real( ptab, kdim, kcom )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppsum_a_real  ***
+      !! 
+      !! ** Purpose :   global sum, REAL ARRAY argument case
+      !!
+      !!-----------------------------------------------------------------------
+      INTEGER , INTENT( in )                     ::   kdim      ! size of ptab
+      REAL(wp), DIMENSION(kdim), INTENT( inout ) ::   ptab      ! input array
+      INTEGER , INTENT( in ), OPTIONAL           :: kcom
+      !!
+      INTEGER                   ::   ierror    ! temporary integer
+      INTEGER                   ::   localcomm 
+      REAL(wp), DIMENSION(kdim) ::   zwork     ! temporary workspace 
+      !!-----------------------------------------------------------------------
+      !
+      localcomm = mpi_comm_opa 
+      IF( PRESENT(kcom) )   localcomm = kcom
+      !
+      CALL mpi_allreduce( ptab, zwork, kdim, mpi_double_precision, mpi_sum, localcomm, ierror )
+      ptab(:) = zwork(:)
+      !
+   END SUBROUTINE mppsum_a_real
+
+
+   SUBROUTINE mppsum_real( ptab, kcom )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppsum_real  ***
+      !!              
+      !! ** Purpose :   global sum, SCALAR argument case
+      !!
+      !!-----------------------------------------------------------------------
+      REAL(wp), INTENT(inout)           ::   ptab   ! input scalar
+      INTEGER , INTENT(in   ), OPTIONAL ::   kcom
+      !!
+      INTEGER  ::   ierror, localcomm 
+      REAL(wp) ::   zwork
+      !!-----------------------------------------------------------------------
+      !
+      localcomm = mpi_comm_opa 
+      IF( PRESENT(kcom) ) localcomm = kcom
+      !
+      CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision, mpi_sum, localcomm, ierror )
+      ptab = zwork
+      !
+   END SUBROUTINE mppsum_real
+
+# if defined key_mpp_rep
+   SUBROUTINE mppsum_realdd( ytab, kcom )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppsum_realdd ***
+      !!
+      !! ** Purpose :   global sum in Massively Parallel Processing
+      !!                SCALAR argument case for double-double precision
+      !!
+      !!-----------------------------------------------------------------------
+      COMPLEX(wp), INTENT(inout)         :: ytab    ! input scalar
+      INTEGER , INTENT( in  ), OPTIONAL :: kcom
+
+      !! * Local variables   (MPI version)
+      INTEGER  ::    ierror
+      INTEGER  ::   localcomm
+      COMPLEX(wp) :: zwork
+
+      localcomm = mpi_comm_opa
+      IF( PRESENT(kcom) ) localcomm = kcom
+
+      ! reduce local sums into global sum
+      CALL MPI_ALLREDUCE (ytab, zwork, 1, MPI_DOUBLE_COMPLEX, &
+                       MPI_SUMDD,localcomm,ierror)
+      ytab = zwork
+
+   END SUBROUTINE mppsum_realdd
+  
+  
+   SUBROUTINE mppsum_a_realdd( ytab, kdim, kcom )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppsum_a_realdd  ***
+      !!
+      !! ** Purpose :   global sum in Massively Parallel Processing
+      !!                COMPLEX ARRAY case for double-double precision
+      !!
+      !!-----------------------------------------------------------------------
+      INTEGER , INTENT( in )                        ::   kdim      ! size of ytab
+      COMPLEX(wp), DIMENSION(kdim), INTENT( inout ) ::   ytab      ! input array
+      INTEGER , INTENT( in  ), OPTIONAL :: kcom
+
+      !! * Local variables   (MPI version)
+      INTEGER                      :: ierror    ! temporary integer
+      INTEGER                      ::   localcomm
+      COMPLEX(wp), DIMENSION(kdim) :: zwork     ! temporary workspace
+
+      localcomm = mpi_comm_opa
+      IF( PRESENT(kcom) ) localcomm = kcom
+
+      CALL MPI_ALLREDUCE (ytab, zwork, kdim, MPI_DOUBLE_COMPLEX, &
+                       MPI_SUMDD,localcomm,ierror)
+      ytab(:) = zwork(:)
+
+   END SUBROUTINE mppsum_a_realdd
+# endif   
+   
+   SUBROUTINE mpp_minloc2d( ptab, pmask, pmin, ki,kj )
+      !!------------------------------------------------------------------------
+      !!             ***  routine mpp_minloc  ***
+      !!
+      !! ** Purpose :   Compute the global minimum of an array ptab
+      !!              and also give its global position
+      !!
+      !! ** Method  :   Use MPI_ALLREDUCE with MPI_MINLOC
+      !!
+      !!--------------------------------------------------------------------------
+      REAL(wp), DIMENSION (jpi,jpj), INTENT(in   ) ::   ptab    ! Local 2D array
+      REAL(wp), DIMENSION (jpi,jpj), INTENT(in   ) ::   pmask   ! Local mask
+      REAL(wp)                     , INTENT(  out) ::   pmin    ! Global minimum of ptab
+      INTEGER                      , INTENT(  out) ::   ki, kj   ! index of minimum in global frame
+      !!
+      INTEGER , DIMENSION(2)   ::   ilocs
+      INTEGER :: ierror
+      REAL(wp) ::   zmin   ! local minimum
+      REAL(wp), DIMENSION(2,1) ::   zain, zaout
+      !!-----------------------------------------------------------------------
+      !
+      zmin  = MINVAL( ptab(:,:) , mask= pmask == 1.e0 )
+      ilocs = MINLOC( ptab(:,:) , mask= pmask == 1.e0 )
+      !
+      ki = ilocs(1) + nimpp - 1
+      kj = ilocs(2) + njmpp - 1
+      !
+      zain(1,:)=zmin
+      zain(2,:)=ki+10000.*kj
+      !
+      CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MINLOC,MPI_COMM_OPA,ierror)
+      !
+      pmin = zaout(1,1)
+      kj = INT(zaout(2,1)/10000.)
+      ki = INT(zaout(2,1) - 10000.*kj )
+      !
+   END SUBROUTINE mpp_minloc2d
+
+
+   SUBROUTINE mpp_minloc3d( ptab, pmask, pmin, ki, kj ,kk)
+      !!------------------------------------------------------------------------
+      !!             ***  routine mpp_minloc  ***
+      !!
+      !! ** Purpose :   Compute the global minimum of an array ptab
+      !!              and also give its global position
+      !!
+      !! ** Method  :   Use MPI_ALLREDUCE with MPI_MINLOC
+      !!
+      !!--------------------------------------------------------------------------
+      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   ptab         ! Local 2D array
+      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pmask        ! Local mask
+      REAL(wp)                         , INTENT(  out) ::   pmin         ! Global minimum of ptab
+      INTEGER                          , INTENT(  out) ::   ki, kj, kk   ! index of minimum in global frame
+      !!
+      INTEGER  ::   ierror
+      REAL(wp) ::   zmin     ! local minimum
+      INTEGER , DIMENSION(3)   ::   ilocs
+      REAL(wp), DIMENSION(2,1) ::   zain, zaout
+      !!-----------------------------------------------------------------------
+      !
+      zmin  = MINVAL( ptab(:,:,:) , mask= pmask == 1.e0 )
+      ilocs = MINLOC( ptab(:,:,:) , mask= pmask == 1.e0 )
+      !
+      ki = ilocs(1) + nimpp - 1
+      kj = ilocs(2) + njmpp - 1
+      kk = ilocs(3)
+      !
+      zain(1,:)=zmin
+      zain(2,:)=ki+10000.*kj+100000000.*kk
+      !
+      CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MINLOC,MPI_COMM_OPA,ierror)
+      !
+      pmin = zaout(1,1)
+      kk   = INT( zaout(2,1) / 100000000. )
+      kj   = INT( zaout(2,1) - kk * 100000000. ) / 10000
+      ki   = INT( zaout(2,1) - kk * 100000000. -kj * 10000. )
+      !
+   END SUBROUTINE mpp_minloc3d
+
+
+   SUBROUTINE mpp_maxloc2d( ptab, pmask, pmax, ki, kj )
+      !!------------------------------------------------------------------------
+      !!             ***  routine mpp_maxloc  ***
+      !!
+      !! ** Purpose :   Compute the global maximum of an array ptab
+      !!              and also give its global position
+      !!
+      !! ** Method  :   Use MPI_ALLREDUCE with MPI_MINLOC
+      !!
+      !!--------------------------------------------------------------------------
+      REAL(wp), DIMENSION (jpi,jpj), INTENT(in   ) ::   ptab     ! Local 2D array
+      REAL(wp), DIMENSION (jpi,jpj), INTENT(in   ) ::   pmask    ! Local mask
+      REAL(wp)                     , INTENT(  out) ::   pmax     ! Global maximum of ptab
+      INTEGER                      , INTENT(  out) ::   ki, kj   ! index of maximum in global frame
+      !!  
+      INTEGER  :: ierror
+      INTEGER, DIMENSION (2)   ::   ilocs
+      REAL(wp) :: zmax   ! local maximum
+      REAL(wp), DIMENSION(2,1) ::   zain, zaout
+      !!-----------------------------------------------------------------------
+      !
+      zmax  = MAXVAL( ptab(:,:) , mask= pmask == 1.e0 )
+      ilocs = MAXLOC( ptab(:,:) , mask= pmask == 1.e0 )
+      !
+      ki = ilocs(1) + nimpp - 1
+      kj = ilocs(2) + njmpp - 1
+      !
+      zain(1,:) = zmax
+      zain(2,:) = ki + 10000. * kj
+      !
+      CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MAXLOC,MPI_COMM_OPA,ierror)
+      !
+      pmax = zaout(1,1)
+      kj   = INT( zaout(2,1) / 10000.     )
+      ki   = INT( zaout(2,1) - 10000.* kj )
+      !
+   END SUBROUTINE mpp_maxloc2d
+
+
+   SUBROUTINE mpp_maxloc3d( ptab, pmask, pmax, ki, kj, kk )
+      !!------------------------------------------------------------------------
+      !!             ***  routine mpp_maxloc  ***
+      !!
+      !! ** Purpose :  Compute the global maximum of an array ptab
+      !!              and also give its global position
+      !!
+      !! ** Method : Use MPI_ALLREDUCE with MPI_MINLOC
+      !!
+      !!--------------------------------------------------------------------------
+      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   ptab         ! Local 2D array
+      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pmask        ! Local mask
+      REAL(wp)                         , INTENT(  out) ::   pmax         ! Global maximum of ptab
+      INTEGER                          , INTENT(  out) ::   ki, kj, kk   ! index of maximum in global frame
+      !!   
+      REAL(wp) :: zmax   ! local maximum
+      REAL(wp), DIMENSION(2,1) ::   zain, zaout
+      INTEGER , DIMENSION(3)   ::   ilocs
+      INTEGER :: ierror
+      !!-----------------------------------------------------------------------
+      !
+      zmax  = MAXVAL( ptab(:,:,:) , mask= pmask == 1.e0 )
+      ilocs = MAXLOC( ptab(:,:,:) , mask= pmask == 1.e0 )
+      !
+      ki = ilocs(1) + nimpp - 1
+      kj = ilocs(2) + njmpp - 1
+      kk = ilocs(3)
+      !
+      zain(1,:)=zmax
+      zain(2,:)=ki+10000.*kj+100000000.*kk
+      !
+      CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MAXLOC,MPI_COMM_OPA,ierror)
+      !
+      pmax = zaout(1,1)
+      kk   = INT( zaout(2,1) / 100000000. )
+      kj   = INT( zaout(2,1) - kk * 100000000. ) / 10000
+      ki   = INT( zaout(2,1) - kk * 100000000. -kj * 10000. )
+      !
+   END SUBROUTINE mpp_maxloc3d
+
+
+   SUBROUTINE mppsync()
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppsync  ***
+      !!                   
+      !! ** Purpose :   Massively parallel processors, synchroneous
+      !!
+      !!-----------------------------------------------------------------------
+      INTEGER :: ierror
+      !!-----------------------------------------------------------------------
+      !
+      CALL mpi_barrier( mpi_comm_opa, ierror )
+      !
+   END SUBROUTINE mppsync
+
+
+   SUBROUTINE mppstop
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppstop  ***
+      !!                   
+      !! ** purpose :   Stop massilively parallel processors method
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER ::   info
+      !!----------------------------------------------------------------------
+      !
+      CALL mppsync
+      CALL mpi_finalize( info )
+      !
+   END SUBROUTINE mppstop
+
+
+   SUBROUTINE mppobc( ptab, kd1, kd2, kl, kk, ktype, kij )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppobc  ***
+      !! 
+      !! ** Purpose :   Message passing manadgement for open boundary
+      !!     conditions array
+      !!
+      !! ** 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 , INTENT(in   )                     ::   kd1, kd2   ! starting and ending indices
+      INTEGER , INTENT(in   )                     ::   kl         ! index of open boundary
+      INTEGER , INTENT(in   )                     ::   kk         ! vertical dimension
+      INTEGER , INTENT(in   )                     ::   ktype      ! define north/south or east/west cdt
+      !                                                           !  = 1  north/south  ;  = 2  east/west
+      INTEGER , INTENT(in   )                     ::   kij        ! horizontal dimension
+      REAL(wp), INTENT(inout), DIMENSION(kij,kk)  ::   ptab       ! variable array
+      !! 
+      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
+      INTEGER  ::   iipt0, iipt1, ilpt1   ! temporary integers
+      INTEGER  ::   ijpt0, ijpt1          !    -          -
+      INTEGER  ::   imigr, iihom, ijhom   !    -          -
+      INTEGER ::   ml_req1, ml_req2, ml_err    ! for key_mpi_isend
+      INTEGER ::   ml_stat(MPI_STATUS_SIZE)    ! for key_mpi_isend
+      REAL(wp), DIMENSION(jpi,jpj) ::   ztab   ! temporary workspace
+      !!----------------------------------------------------------------------
+
+      ! boundary condition initialization
+      ! ---------------------------------
+      ztab(:,:) = 0.e0
+      !
+      IF( ktype==1 ) THEN                                  ! north/south boundaries
+         iipt0 = MAX( 1, MIN(kd1 - nimpp+1, nlci     ) )
+         iipt1 = MAX( 0, MIN(kd2 - nimpp+1, nlci - 1 ) )
+         ilpt1 = MAX( 1, MIN(kd2 - nimpp+1, nlci     ) )
+         ijpt0 = MAX( 1, MIN(kl  - njmpp+1, nlcj     ) )
+         ijpt1 = MAX( 0, MIN(kl  - njmpp+1, nlcj - 1 ) )
+      ELSEIF( ktype==2 ) THEN                              ! east/west boundaries
+         iipt0 = MAX( 1, MIN(kl  - nimpp+1, nlci     ) )
+         iipt1 = MAX( 0, MIN(kl  - nimpp+1, nlci - 1 ) )
+         ijpt0 = MAX( 1, MIN(kd1 - njmpp+1, nlcj     ) )
+         ijpt1 = MAX( 0, MIN(kd2 - njmpp+1, nlcj - 1 ) )
+         ilpt1 = MAX( 1, MIN(kd2 - njmpp+1, nlcj     ) )
+      ELSE
+         CALL ctl_stop( 'mppobc: bad ktype' )
+      ENDIF
+      
+      ! Communication level by level
+      ! ----------------------------
+!!gm Remark : this is very time consumming!!!
+      !                                         ! ------------------------ !
+      DO jk = 1, kk                             !   Loop over the levels   !
+         !                                      ! ------------------------ !
+         !
+         IF( ktype == 1 ) THEN                               ! north/south boundaries
+            DO jj = ijpt0, ijpt1
+               DO ji = iipt0, iipt1
+                  ztab(ji,jj) = ptab(ji,jk)
+               END DO
+            END DO
+         ELSEIF( ktype == 2 ) THEN                           ! east/west boundaries
+            DO jj = ijpt0, ijpt1
+               DO ji = iipt0, iipt1
+                  ztab(ji,jj) = ptab(jj,jk)
+               END DO
+            END DO
+         ENDIF
+
+
+         ! 1. East and west directions
+         ! ---------------------------
+         !
+         IF( nbondi /= 2 ) THEN         ! Read Dirichlet lateral conditions
+            iihom = nlci-nreci
+            DO jl = 1, jpreci
+               t2ew(:,jl,1) = ztab(jpreci+jl,:)
+               t2we(:,jl,1) = ztab(iihom +jl,:)
+            END DO
+         ENDIF
+         !
+         !                              ! Migrations
+         imigr=jpreci*jpj
+         !
+         IF( nbondi == -1 ) THEN
+            CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 )
+            CALL mpprecv( 1, t2ew(1,1,2), imigr )
+            IF(l_isend)   CALL mpi_wait( ml_req1, ml_stat, ml_err )
+         ELSEIF( nbondi == 0 ) THEN
+            CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )
+            CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 )
+            CALL mpprecv( 1, t2ew(1,1,2), imigr )
+            CALL mpprecv( 2, t2we(1,1,2), imigr )
+            IF(l_isend)   CALL mpi_wait( ml_req1, ml_stat, ml_err )
+            IF(l_isend)   CALL mpi_wait( ml_req2, ml_stat, ml_err )
+         ELSEIF( nbondi == 1 ) THEN
+            CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )
+            CALL mpprecv( 2, t2we(1,1,2), imigr )
+            IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err )
+         ENDIF
+         !
+         !                              ! Write Dirichlet lateral conditions
+         iihom = nlci-jpreci
+         !
+         IF( nbondi == 0 .OR. nbondi == 1 ) THEN
+            DO jl = 1, jpreci
+               ztab(jl,:) = t2we(:,jl,2)
+            END DO
+         ENDIF
+         IF( nbondi == -1 .OR. nbondi == 0 ) THEN
+            DO jl = 1, jpreci
+               ztab(iihom+jl,:) = t2ew(:,jl,2)
+            END DO
+         ENDIF
+
+
+         ! 2. North and south directions
+         ! -----------------------------
+         !
+         IF( nbondj /= 2 ) THEN         ! Read Dirichlet lateral conditions
+            ijhom = nlcj-nrecj
+            DO jl = 1, jprecj
+               t2sn(:,jl,1) = ztab(:,ijhom +jl)
+               t2ns(:,jl,1) = ztab(:,jprecj+jl)
+            END DO
+         ENDIF
+         !
+         !                              ! Migrations
+         imigr = jprecj * jpi
+         !
+         IF( nbondj == -1 ) THEN
+            CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 )
+            CALL mpprecv( 3, t2ns(1,1,2), imigr )
+            IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err )
+         ELSEIF( nbondj == 0 ) THEN
+            CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )
+            CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 )
+            CALL mpprecv( 3, t2ns(1,1,2), imigr )
+            CALL mpprecv( 4, t2sn(1,1,2), imigr )
+            IF( l_isend )   CALL mpi_wait( ml_req1, ml_stat, ml_err )
+            IF( l_isend )   CALL mpi_wait( ml_req2, ml_stat, ml_err )
+         ELSEIF( nbondj == 1 ) THEN
+            CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )
+            CALL mpprecv( 4, t2sn(1,1,2), imigr)
+            IF( l_isend )   CALL mpi_wait( ml_req1, ml_stat, ml_err )
+         ENDIF
+         !
+         !                              ! Write Dirichlet lateral conditions
+         ijhom = nlcj - jprecj
+         IF( nbondj == 0 .OR. nbondj == 1 ) THEN
+            DO jl = 1, jprecj
+               ztab(:,jl) = t2sn(:,jl,2)
+            END DO
+         ENDIF
+         IF( nbondj == 0 .OR. nbondj == -1 ) THEN
+            DO jl = 1, jprecj
+               ztab(:,ijhom+jl) = t2ns(:,jl,2)
+            END DO
+         ENDIF
+         IF( ktype==1 .AND. kd1 <= jpi+nimpp-1 .AND. nimpp <= kd2 ) THEN
+            DO jj = ijpt0, ijpt1            ! north/south boundaries
+               DO ji = iipt0,ilpt1
+                  ptab(ji,jk) = ztab(ji,jj)  
+               END DO
+            END DO
+         ELSEIF( ktype==2 .AND. kd1 <= jpj+njmpp-1 .AND. njmpp <= kd2 ) THEN
+            DO jj = ijpt0, ilpt1            ! east/west boundaries
+               DO ji = iipt0,iipt1
+                  ptab(jj,jk) = ztab(ji,jj) 
+               END DO
+            END DO
+         ENDIF
+         !
+      END DO
+      !
+   END SUBROUTINE mppobc
+   
+
+   SUBROUTINE mpp_comm_free( kcom )
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kcom
+      !!
+      INTEGER :: ierr
+      !!----------------------------------------------------------------------
+      !
+      CALL MPI_COMM_FREE(kcom, ierr)
+      !
+   END SUBROUTINE mpp_comm_free
+
+
+   SUBROUTINE mpp_ini_ice( pindic )
+      !!----------------------------------------------------------------------
+      !!               ***  routine mpp_ini_ice  ***
+      !!
+      !! ** Purpose :   Initialize special communicator for ice areas
+      !!      condition together with global variables needed in the ddmpp folding
+      !!
+      !! ** Method  : - Look for ice processors in ice routines
+      !!              - Put their number in nrank_ice
+      !!              - Create groups for the world processors and the ice processors
+      !!              - Create a communicator for ice processors
+      !!
+      !! ** output
+      !!      njmppmax = njmpp for northern procs
+      !!      ndim_rank_ice = number of processors with ice
+      !!      nrank_ice (ndim_rank_ice) = ice processors
+      !!      ngrp_world = group ID for the world processors
+      !!      ngrp_ice = group ID for the ice processors
+      !!      ncomm_ice = communicator for the ice procs.
+      !!      n_ice_root = number (in the world) of proc 0 in the ice comm.
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) :: pindic
+      !!
+      INTEGER :: ierr
+      INTEGER :: jjproc
+      INTEGER :: ii
+      INTEGER, DIMENSION(jpnij) :: kice
+      INTEGER, DIMENSION(jpnij) :: zwork
+      !!----------------------------------------------------------------------
+      !
+      ! Look for how many procs with sea-ice
+      !
+      kice = 0
+      DO jjproc = 1, jpnij
+         IF( jjproc == narea .AND. pindic .GT. 0 )   kice(jjproc) = 1    
+      END DO
+      !
+      zwork = 0
+      CALL MPI_ALLREDUCE( kice, zwork, jpnij, mpi_integer, mpi_sum, mpi_comm_opa, ierr )
+      ndim_rank_ice = SUM( zwork )          
+
+      ! Allocate the right size to nrank_north
+#if ! defined key_agrif
+      IF( ALLOCATED ( nrank_ice ) )   DEALLOCATE( nrank_ice )
+#else
+      IF( ASSOCIATED( nrank_ice ) )   DEALLOCATE( nrank_ice )
+#endif
+      ALLOCATE( nrank_ice(ndim_rank_ice) )
+      !
+      ii = 0     
+      nrank_ice = 0
+      DO jjproc = 1, jpnij
+         IF( zwork(jjproc) == 1) THEN
+            ii = ii + 1
+            nrank_ice(ii) = jjproc -1 
+         ENDIF
+      END DO
+
+      ! Create the world group
+      CALL MPI_COMM_GROUP( mpi_comm_opa, ngrp_world, ierr )
+
+      ! Create the ice group from the world group
+      CALL MPI_GROUP_INCL( ngrp_world, ndim_rank_ice, nrank_ice, ngrp_ice, ierr )
+
+      ! Create the ice communicator , ie the pool of procs with sea-ice
+      CALL MPI_COMM_CREATE( mpi_comm_opa, ngrp_ice, ncomm_ice, ierr )
+
+      ! Find proc number in the world of proc 0 in the north
+      ! The following line seems to be useless, we just comment & keep it as reminder
+      ! CALL MPI_GROUP_TRANSLATE_RANKS(ngrp_ice,1,0,ngrp_world,n_ice_root,ierr)
+      !
+   END SUBROUTINE mpp_ini_ice
+
+
+   SUBROUTINE mpp_ini_znl
+      !!----------------------------------------------------------------------
+      !!               ***  routine mpp_ini_znl  ***
+      !!
+      !! ** Purpose :   Initialize special communicator for computing zonal sum
+      !!
+      !! ** Method  : - Look for processors in the same row
+      !!              - Put their number in nrank_znl
+      !!              - Create group for the znl processors
+      !!              - Create a communicator for znl processors
+      !!              - Determine if processor should write znl files
+      !!
+      !! ** output
+      !!      ndim_rank_znl = number of processors on the same row
+      !!      ngrp_znl = group ID for the znl processors
+      !!      ncomm_znl = communicator for the ice procs.
+      !!      n_znl_root = number (in the world) of proc 0 in the ice comm.
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER :: ierr
+      INTEGER :: jproc
+      INTEGER :: ii
+      INTEGER, DIMENSION(jpnij) :: kwork
+      !
+      !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ngrp_world     : ', ngrp_world
+      !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - mpi_comm_world : ', mpi_comm_world
+      !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - mpi_comm_opa   : ', mpi_comm_opa
+      !
+      IF ( jpnj == 1 ) THEN
+         ngrp_znl  = ngrp_world
+         ncomm_znl = mpi_comm_opa
+      ELSE
+         !
+         CALL MPI_ALLGATHER ( njmpp, 1, mpi_integer, kwork, 1, mpi_integer, mpi_comm_opa, ierr )
+         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - kwork pour njmpp : ', kwork
+         !-$$        CALL flush(numout)
+         !
+         ! Count number of processors on the same row
+         ndim_rank_znl = 0
+         DO jproc=1,jpnij
+            IF ( kwork(jproc) == njmpp ) THEN
+               ndim_rank_znl = ndim_rank_znl + 1
+            ENDIF
+         END DO
+         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ndim_rank_znl : ', ndim_rank_znl
+         !-$$        CALL flush(numout)
+         ! Allocate the right size to nrank_znl
+#if ! defined key_agrif
+         IF (ALLOCATED (nrank_znl)) DEALLOCATE(nrank_znl)
+#else
+         IF (ASSOCIATED(nrank_znl)) DEALLOCATE(nrank_znl)
+#endif
+         ALLOCATE(nrank_znl(ndim_rank_znl))
+         ii = 0     
+         nrank_znl (:) = 0
+         DO jproc=1,jpnij
+            IF ( kwork(jproc) == njmpp) THEN
+               ii = ii + 1
+               nrank_znl(ii) = jproc -1 
+            ENDIF
+         END DO
+         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - nrank_znl : ', nrank_znl
+         !-$$        CALL flush(numout)
+
+         ! Create the opa group
+         CALL MPI_COMM_GROUP(mpi_comm_opa,ngrp_opa,ierr)
+         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ngrp_opa : ', ngrp_opa
+         !-$$        CALL flush(numout)
+
+         ! Create the znl group from the opa group
+         CALL MPI_GROUP_INCL  ( ngrp_opa, ndim_rank_znl, nrank_znl, ngrp_znl, ierr )
+         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ngrp_znl ', ngrp_znl
+         !-$$        CALL flush(numout)
+
+         ! Create the znl communicator from the opa communicator, ie the pool of procs in the same row
+         CALL MPI_COMM_CREATE ( mpi_comm_opa, ngrp_znl, ncomm_znl, ierr )
+         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ncomm_znl ', ncomm_znl
+         !-$$        CALL flush(numout)
+         !
+      END IF
+
+      ! Determines if processor if the first (starting from i=1) on the row
+      IF ( jpni == 1 ) THEN 
+         l_znl_root = .TRUE.
+      ELSE
+         l_znl_root = .FALSE.
+         kwork (1) = nimpp
+         CALL mpp_min ( kwork(1), kcom = ncomm_znl)
+         IF ( nimpp == kwork(1)) l_znl_root = .TRUE.
+      END IF
+
+   END SUBROUTINE mpp_ini_znl
+
+
+   SUBROUTINE mpp_ini_north
+      !!----------------------------------------------------------------------
+      !!               ***  routine mpp_ini_north  ***
+      !!
+      !! ** Purpose :   Initialize special communicator for north folding 
+      !!      condition together with global variables needed in the mpp folding
+      !!
+      !! ** Method  : - Look for northern processors
+      !!              - Put their number in nrank_north
+      !!              - Create groups for the world processors and the north processors
+      !!              - Create a communicator for northern processors
+      !!
+      !! ** output
+      !!      njmppmax = njmpp for northern procs
+      !!      ndim_rank_north = number of processors in the northern line
+      !!      nrank_north (ndim_rank_north) = number  of the northern procs.
+      !!      ngrp_world = group ID for the world processors
+      !!      ngrp_north = group ID for the northern processors
+      !!      ncomm_north = communicator for the northern procs.
+      !!      north_root = number (in the world) of proc 0 in the northern comm.
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER ::   ierr
+      INTEGER ::   jjproc
+      INTEGER ::   ii, ji
+      !!----------------------------------------------------------------------
+      !
+      njmppmax = MAXVAL( njmppt )
+      !
+      ! Look for how many procs on the northern boundary
+      ndim_rank_north = 0
+      DO jjproc = 1, jpnij
+         IF( njmppt(jjproc) == njmppmax )   ndim_rank_north = ndim_rank_north + 1
+      END DO
+      !
+      ! Allocate the right size to nrank_north
+#if ! defined key_agrif
+      IF (ALLOCATED (nrank_north)) DEALLOCATE(nrank_north)
+#else
+      IF (ASSOCIATED(nrank_north)) DEALLOCATE(nrank_north)
+#endif
+      ALLOCATE( nrank_north(ndim_rank_north) )
+
+      ! Fill the nrank_north array with proc. number of northern procs.
+      ! Note : the rank start at 0 in MPI
+      ii = 0
+      DO ji = 1, jpnij
+         IF ( njmppt(ji) == njmppmax   ) THEN
+            ii=ii+1
+            nrank_north(ii)=ji-1
+         END IF
+      END DO
+      !
+      ! create the world group
+      CALL MPI_COMM_GROUP( mpi_comm_opa, ngrp_world, ierr )
+      !
+      ! Create the North group from the world group
+      CALL MPI_GROUP_INCL( ngrp_world, ndim_rank_north, nrank_north, ngrp_north, ierr )
+      !
+      ! Create the North communicator , ie the pool of procs in the north group
+      CALL MPI_COMM_CREATE( mpi_comm_opa, ngrp_north, ncomm_north, ierr )
+      !
+   END SUBROUTINE mpp_ini_north
+
+
+   SUBROUTINE mpp_lbc_north_3d( pt3d, cd_type, psgn )
+      !!---------------------------------------------------------------------
+      !!                   ***  routine mpp_lbc_north_3d  ***
+      !!
+      !! ** Purpose :   Ensure proper north fold horizontal bondary condition 
+      !!              in mpp configuration in case of jpn1 > 1
+      !!
+      !! ** Method  :   North fold condition and mpp with more than one proc
+      !!              in i-direction require a specific treatment. We gather 
+      !!              the 4 northern lines of the global domain on 1 processor
+      !!              and apply lbc north-fold on this sub array. Then we
+      !!              scatter the north fold array back to the processors.
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d      ! 3D array on which the b.c. is applied
+      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
+      !                                                              !   = T ,  U , V , F or W  gridpoints
+      REAL(wp)                        , INTENT(in   ) ::   psgn      ! = -1. the sign change across the north fold 
+      !!                                                             ! =  1. , the sign is kept
+      INTEGER ::   ji, jj, jr
+      INTEGER ::   ierr, itaille, ildi, ilei, iilb
+      INTEGER ::   ijpj, ijpjm1, ij, iproc
+      REAL(wp), DIMENSION(jpiglo,4,jpk)      ::   ztab
+      REAL(wp), DIMENSION(jpi   ,4,jpk)      ::   znorthloc
+      REAL(wp), DIMENSION(jpi   ,4,jpk,jpni) ::   znorthgloio
+      !!----------------------------------------------------------------------
+      !   
+      ijpj   = 4
+      ijpjm1 = 3
+      ztab(:,:,:) = 0.e0
+      !
+      DO jj = nlcj - ijpj +1, nlcj          ! put in znorthloc the last 4 jlines of pt3d
+         ij = jj - nlcj + ijpj
+         znorthloc(:,ij,:) = pt3d(:,jj,:)
+      END DO
+      !
+      !                                     ! Build in procs of ncomm_north the znorthgloio
+      itaille = jpi * jpk * ijpj
+      CALL MPI_ALLGATHER( znorthloc  , itaille, MPI_DOUBLE_PRECISION,                &
+         &                znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
+      !
+      !                                     ! recover the global north array
+      DO jr = 1, ndim_rank_north
+         iproc = nrank_north(jr) + 1
+         ildi  = nldit (iproc)
+         ilei  = nleit (iproc)
+         iilb  = nimppt(iproc)
+         DO jj = 1, 4
+            DO ji = ildi, ilei
+               ztab(ji+iilb-1,jj,:) = znorthgloio(ji,jj,:,jr)
+            END DO
+         END DO
+      END DO
+      !
+      CALL lbc_nfd( ztab, cd_type, psgn )   ! North fold boundary condition
+      !
+      DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt3d
+         ij = jj - nlcj + ijpj
+         DO ji= 1, nlci
+            pt3d(ji,jj,:) = ztab(ji+nimpp-1,ij,:)
+         END DO
+      END DO
+      !
+   END SUBROUTINE mpp_lbc_north_3d
+
+
+   SUBROUTINE mpp_lbc_north_2d( pt2d, cd_type, psgn)
+      !!---------------------------------------------------------------------
+      !!                   ***  routine mpp_lbc_north_2d  ***
+      !!
+      !! ** Purpose :   Ensure proper north fold horizontal bondary condition 
+      !!              in mpp configuration in case of jpn1 > 1 (for 2d array )
+      !!
+      !! ** Method  :   North fold condition and mpp with more than one proc
+      !!              in i-direction require a specific treatment. We gather 
+      !!              the 4 northern lines of the global domain on 1 processor
+      !!              and apply lbc north-fold on this sub array. Then we
+      !!              scatter the north fold array back to the processors.
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d      ! 3D array on which the b.c. is applied
+      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
+      !                                                          !   = T ,  U , V , F or W  gridpoints
+      REAL(wp)                    , INTENT(in   ) ::   psgn      ! = -1. the sign change across the north fold 
+      !!                                                             ! =  1. , the sign is kept
+      INTEGER ::   ji, jj, jr
+      INTEGER ::   ierr, itaille, ildi, ilei, iilb
+      INTEGER ::   ijpj, ijpjm1, ij, iproc
+      REAL(wp), DIMENSION(jpiglo,4)      ::   ztab
+      REAL(wp), DIMENSION(jpi   ,4)      ::   znorthloc
+      REAL(wp), DIMENSION(jpi   ,4,jpni) ::   znorthgloio
+      !!----------------------------------------------------------------------
+      !
+      ijpj   = 4
+      ijpjm1 = 3
+      ztab(:,:) = 0.e0
+      !
+      DO jj = nlcj-ijpj+1, nlcj             ! put in znorthloc the last 4 jlines of pt2d
+         ij = jj - nlcj + ijpj
+         znorthloc(:,ij) = pt2d(:,jj)
+      END DO
+
+      !                                     ! Build in procs of ncomm_north the znorthgloio
+      itaille = jpi * ijpj
+      CALL MPI_ALLGATHER( znorthloc  , itaille, MPI_DOUBLE_PRECISION,        &
+         &                znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
+      !
+      DO jr = 1, ndim_rank_north            ! recover the global north array
+         iproc = nrank_north(jr) + 1
+         ildi=nldit (iproc)
+         ilei=nleit (iproc)
+         iilb=nimppt(iproc)
+         DO jj = 1, 4
+            DO ji = ildi, ilei
+               ztab(ji+iilb-1,jj) = znorthgloio(ji,jj,jr)
+            END DO
+         END DO
+      END DO
+      !
+      CALL lbc_nfd( ztab, cd_type, psgn )   ! North fold boundary condition
+      !
+      !
+      DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt2d
+         ij = jj - nlcj + ijpj
+         DO ji = 1, nlci
+            pt2d(ji,jj) = ztab(ji+nimpp-1,ij)
+         END DO
+      END DO
+      !
+   END SUBROUTINE mpp_lbc_north_2d
+
+
+   SUBROUTINE mpp_lbc_north_e( pt2d, cd_type, psgn)
+      !!---------------------------------------------------------------------
+      !!                   ***  routine mpp_lbc_north_2d  ***
+      !!
+      !! ** Purpose :   Ensure proper north fold horizontal bondary condition 
+      !!              in mpp configuration in case of jpn1 > 1 and for 2d 
+      !!              array with outer extra halo
+      !!
+      !! ** Method  :   North fold condition and mpp with more than one proc
+      !!              in i-direction require a specific treatment. We gather 
+      !!              the 4+2*jpr2dj northern lines of the global domain on 1 
+      !!              processor and apply lbc north-fold on this sub array. 
+      !!              Then we scatter the north fold array back to the processors.
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj), INTENT(inout) ::   pt2d     ! 2D array with extra halo
+      CHARACTER(len=1)                                            , INTENT(in   ) ::   cd_type  ! nature of pt3d grid-points
+      !                                                                                         !   = T ,  U , V , F or W -points
+      REAL(wp)                                                    , INTENT(in   ) ::   psgn     ! = -1. the sign change across the  
+      !!                                                                                        ! north fold, =  1. otherwise
+      INTEGER ::   ji, jj, jr
+      INTEGER ::   ierr, itaille, ildi, ilei, iilb
+      INTEGER ::   ijpj, ij, iproc
+      REAL(wp), DIMENSION(jpiglo,4+2*jpr2dj)      ::   ztab
+      REAL(wp), DIMENSION(jpi   ,4+2*jpr2dj)      ::   znorthloc
+      REAL(wp), DIMENSION(jpi   ,4+2*jpr2dj,jpni) ::   znorthgloio
+      !!----------------------------------------------------------------------
+      !
+      ijpj=4
+      ztab(:,:) = 0.e0
+
+      ij=0
+      ! put in znorthloc the last 4 jlines of pt2d
+      DO jj = nlcj - ijpj + 1 - jpr2dj, nlcj +jpr2dj
+         ij = ij + 1
+         DO ji = 1, jpi
+            znorthloc(ji,ij)=pt2d(ji,jj)
+         END DO
+      END DO
+      !
+      itaille = jpi * ( ijpj + 2 * jpr2dj )
+      CALL MPI_ALLGATHER( znorthloc(1,1)    , itaille, MPI_DOUBLE_PRECISION,    &
+         &                znorthgloio(1,1,1), itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
+      !
+      DO jr = 1, ndim_rank_north            ! recover the global north array
+         iproc = nrank_north(jr) + 1
+         ildi = nldit (iproc)
+         ilei = nleit (iproc)
+         iilb = nimppt(iproc)
+         DO jj = 1, ijpj+2*jpr2dj
+            DO ji = ildi, ilei
+               ztab(ji+iilb-1,jj) = znorthgloio(ji,jj,jr)
+            END DO
+         END DO
+      END DO
+
+
+      ! 2. North-Fold boundary conditions
+      ! ----------------------------------
+      CALL lbc_nfd( ztab(:,:), cd_type, psgn, pr2dj = jpr2dj )
+
+      ij = jpr2dj
+      !! Scatter back to pt2d
+      DO jj = nlcj - ijpj + 1 , nlcj +jpr2dj
+      ij  = ij +1 
+         DO ji= 1, nlci
+            pt2d(ji,jj) = ztab(ji+nimpp-1,ij)
+         END DO
+      END DO
+      !
+   END SUBROUTINE mpp_lbc_north_e
+
+
+   SUBROUTINE mpi_init_opa( ldtxt, ksft, code )
+      !!---------------------------------------------------------------------
+      !!                   ***  routine mpp_init.opa  ***
+      !!
+      !! ** Purpose :: export and attach a MPI buffer for bsend
+      !!
+      !! ** Method  :: define buffer size in namelist, if 0 no buffer attachment
+      !!            but classical mpi_init
+      !! 
+      !! History :: 01/11 :: IDRIS initial version for IBM only  
+      !!            08/04 :: R. Benshila, generalisation
+      !!---------------------------------------------------------------------
+      CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt 
+      INTEGER                      , INTENT(inout) ::   ksft
+      INTEGER                      , INTENT(  out) ::   code
+      INTEGER                                      ::   ierr, ji
+      LOGICAL                                      ::   mpi_was_called
+      !!---------------------------------------------------------------------
+      !
+      CALL mpi_initialized( mpi_was_called, code )      ! MPI initialization
+      IF ( code /= MPI_SUCCESS ) THEN
+         DO ji = 1, SIZE(ldtxt) 
+            IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode
+         END DO         
+         WRITE(*, cform_err)
+         WRITE(*, *) ' lib_mpp: Error in routine mpi_initialized'
+         CALL mpi_abort( mpi_comm_world, code, ierr )
+      ENDIF
+      !
+      IF( .NOT. mpi_was_called ) THEN
+         CALL mpi_init( code )
+         CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code )
+         IF ( code /= MPI_SUCCESS ) THEN
+            DO ji = 1, SIZE(ldtxt) 
+               IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode
+            END DO
+            WRITE(*, cform_err)
+            WRITE(*, *) ' lib_mpp: Error in routine mpi_comm_dup'
+            CALL mpi_abort( mpi_comm_world, code, ierr )
+         ENDIF
+      ENDIF
+      !
+      IF( nn_buffer > 0 ) THEN
+         WRITE(ldtxt(ksft),*) 'mpi_bsend, buffer allocation of  : ', nn_buffer   ;   ksft = ksft + 1
+         ! Buffer allocation and attachment
+         ALLOCATE( tampon(nn_buffer), stat = ierr )
+         IF (ierr /= 0) THEN 
+            DO ji = 1, SIZE(ldtxt) 
+               IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode
+            END DO
+            WRITE(*, cform_err)
+            WRITE(*, *) ' lib_mpp: Error in ALLOCATE', ierr
+            CALL mpi_abort( mpi_comm_world, code, ierr )
+         END IF
+         CALL mpi_buffer_attach( tampon, nn_buffer, code )
+      ENDIF
+      !
+   END SUBROUTINE mpi_init_opa
+
+#if defined key_mpp_rep
+   SUBROUTINE DDPDD_MPI (ydda, yddb, ilen, itype)
+      !!---------------------------------------------------------------------
+      !!   Routine DDPDD_MPI: used by reduction operator MPI_SUMDD
+      !!
+      !!   Modification of original codes written by David H. Bailey
+      !!   This subroutine computes yddb(i) = ydda(i)+yddb(i)
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in)                         :: ilen, itype
+      COMPLEX(wp), DIMENSION(ilen), INTENT(in)     :: ydda
+      COMPLEX(wp), DIMENSION(ilen), INTENT(inout)  :: yddb
+      !
+      REAL(wp) :: zerr, zt1, zt2    ! local work variables
+      INTEGER :: ji, ztmp           ! local scalar
+
+      ztmp = itype   ! avoid compilation warning
+
+      DO ji=1,ilen
+      ! Compute ydda + yddb using Knuth's trick.
+         zt1  = real(ydda(ji)) + real(yddb(ji))
+         zerr = zt1 - real(ydda(ji))
+         zt2  = ((real(yddb(ji)) - zerr) + (real(ydda(ji)) - (zt1 - zerr))) &
+                + aimag(ydda(ji)) + aimag(yddb(ji))
+
+         ! The result is zt1 + zt2, after normalization.
+         yddb(ji) = cmplx ( zt1 + zt2, zt2 - ((zt1 + zt2) - zt1),wp )
+      END DO
+
+   END SUBROUTINE DDPDD_MPI
+#endif
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default case:            Dummy module        share memory computing
+   !!----------------------------------------------------------------------
+
+   INTERFACE mpp_sum
+      MODULE PROCEDURE mpp_sum_a2s, mpp_sum_as, mpp_sum_ai, mpp_sum_s, mpp_sum_i
+   END INTERFACE
+   INTERFACE mpp_max
+      MODULE PROCEDURE mppmax_a_int, mppmax_int, mppmax_a_real, mppmax_real
+   END INTERFACE
+   INTERFACE mpp_min
+      MODULE PROCEDURE mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real
+   END INTERFACE
+   INTERFACE mppobc
+      MODULE PROCEDURE mppobc_1d, mppobc_2d, mppobc_3d, mppobc_4d
+   END INTERFACE
+   INTERFACE mpp_minloc
+      MODULE PROCEDURE mpp_minloc2d ,mpp_minloc3d
+   END INTERFACE
+   INTERFACE mpp_maxloc
+      MODULE PROCEDURE mpp_maxloc2d ,mpp_maxloc3d
+   END INTERFACE
+
+
+   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .FALSE.      !: mpp flag
+   INTEGER :: ncomm_ice
+
+CONTAINS
+
+   FUNCTION mynode( ldtxt, localComm ) RESULT (function_value)
+      CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt 
+      INTEGER, OPTIONAL            , INTENT(in   ) ::   localComm
+      IF( PRESENT( localComm ) .OR. .NOT.PRESENT( localComm ) )   function_value = 0
+      IF( .FALSE. )   ldtxt(:) = 'never done'
+   END FUNCTION mynode
+
+   SUBROUTINE mppsync                       ! Dummy routine
+   END SUBROUTINE mppsync
+
+   SUBROUTINE mpp_sum_as( parr, kdim, kcom )      ! Dummy routine
+      REAL   , DIMENSION(:) :: parr
+      INTEGER               :: kdim
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mpp_sum_as: You should not have seen this print! error?', kdim, parr(1), kcom
+   END SUBROUTINE mpp_sum_as
+
+   SUBROUTINE mpp_sum_a2s( parr, kdim, kcom )      ! Dummy routine
+      REAL   , DIMENSION(:,:) :: parr
+      INTEGER               :: kdim
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mpp_sum_a2s: You should not have seen this print! error?', kdim, parr(1,1), kcom
+   END SUBROUTINE mpp_sum_a2s
+
+   SUBROUTINE mpp_sum_ai( karr, kdim, kcom )      ! Dummy routine
+      INTEGER, DIMENSION(:) :: karr
+      INTEGER               :: kdim
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mpp_sum_ai: You should not have seen this print! error?', kdim, karr(1), kcom
+   END SUBROUTINE mpp_sum_ai
+
+   SUBROUTINE mpp_sum_s( psca, kcom )            ! Dummy routine
+      REAL                  :: psca
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mpp_sum_s: You should not have seen this print! error?', psca, kcom
+   END SUBROUTINE mpp_sum_s
+
+   SUBROUTINE mpp_sum_i( kint, kcom )            ! Dummy routine
+      integer               :: kint
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mpp_sum_i: You should not have seen this print! error?', kint, kcom
+   END SUBROUTINE mpp_sum_i
+
+   SUBROUTINE mppmax_a_real( parr, kdim, kcom )
+      REAL   , DIMENSION(:) :: parr
+      INTEGER               :: kdim
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mppmax_a_real: You should not have seen this print! error?', kdim, parr(1), kcom
+   END SUBROUTINE mppmax_a_real
+
+   SUBROUTINE mppmax_real( psca, kcom )
+      REAL                  :: psca
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mppmax_real: You should not have seen this print! error?', psca, kcom
+   END SUBROUTINE mppmax_real
+
+   SUBROUTINE mppmin_a_real( parr, kdim, kcom )
+      REAL   , DIMENSION(:) :: parr
+      INTEGER               :: kdim
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mppmin_a_real: You should not have seen this print! error?', kdim, parr(1), kcom
+   END SUBROUTINE mppmin_a_real
+
+   SUBROUTINE mppmin_real( psca, kcom )
+      REAL                  :: psca
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mppmin_real: You should not have seen this print! error?', psca, kcom
+   END SUBROUTINE mppmin_real
+
+   SUBROUTINE mppmax_a_int( karr, kdim ,kcom)
+      INTEGER, DIMENSION(:) :: karr
+      INTEGER               :: kdim
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mppmax_a_int: You should not have seen this print! error?', kdim, karr(1), kcom
+   END SUBROUTINE mppmax_a_int
+
+   SUBROUTINE mppmax_int( kint, kcom)
+      INTEGER               :: kint
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mppmax_int: You should not have seen this print! error?', kint, kcom
+   END SUBROUTINE mppmax_int
+
+   SUBROUTINE mppmin_a_int( karr, kdim, kcom )
+      INTEGER, DIMENSION(:) :: karr
+      INTEGER               :: kdim
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mppmin_a_int: You should not have seen this print! error?', kdim, karr(1), kcom
+   END SUBROUTINE mppmin_a_int
+
+   SUBROUTINE mppmin_int( kint, kcom )
+      INTEGER               :: kint
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mppmin_int: You should not have seen this print! error?', kint, kcom
+   END SUBROUTINE mppmin_int
+
+   SUBROUTINE mppobc_1d( parr, kd1, kd2, kl, kk, ktype, kij )
+      INTEGER  ::   kd1, kd2, kl , kk, ktype, kij
+      REAL, DIMENSION(:) ::   parr           ! variable array
+      WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1), kd1, kd2, kl, kk, ktype, kij
+   END SUBROUTINE mppobc_1d
+
+   SUBROUTINE mppobc_2d( parr, kd1, kd2, kl, kk, ktype, kij )
+      INTEGER  ::   kd1, kd2, kl , kk, ktype, kij
+      REAL, DIMENSION(:,:) ::   parr           ! variable array
+      WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1), kd1, kd2, kl, kk, ktype, kij
+   END SUBROUTINE mppobc_2d
+
+   SUBROUTINE mppobc_3d( parr, kd1, kd2, kl, kk, ktype, kij )
+      INTEGER  ::   kd1, kd2, kl , kk, ktype, kij
+      REAL, DIMENSION(:,:,:) ::   parr           ! variable array
+      WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1,1), kd1, kd2, kl, kk, ktype, kij
+   END SUBROUTINE mppobc_3d
+
+   SUBROUTINE mppobc_4d( parr, kd1, kd2, kl, kk, ktype, kij )
+      INTEGER  ::   kd1, kd2, kl , kk, ktype, kij
+      REAL, DIMENSION(:,:,:,:) ::   parr           ! variable array
+      WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1,1,1), kd1, kd2, kl, kk, ktype, kij
+   END SUBROUTINE mppobc_4d
+
+   SUBROUTINE mpp_minloc2d( ptab, pmask, pmin, ki, kj )
+      REAL                   :: pmin
+      REAL , DIMENSION (:,:) :: ptab, pmask
+      INTEGER :: ki, kj
+      WRITE(*,*) 'mpp_minloc2d: You should not have seen this print! error?', pmin, ki, kj, ptab(1,1), pmask(1,1)
+   END SUBROUTINE mpp_minloc2d
+
+   SUBROUTINE mpp_minloc3d( ptab, pmask, pmin, ki, kj, kk )
+      REAL                     :: pmin
+      REAL , DIMENSION (:,:,:) :: ptab, pmask
+      INTEGER :: ki, kj, kk
+      WRITE(*,*) 'mpp_minloc3d: You should not have seen this print! error?', pmin, ki, kj, kk, ptab(1,1,1), pmask(1,1,1)
+   END SUBROUTINE mpp_minloc3d
+
+   SUBROUTINE mpp_maxloc2d( ptab, pmask, pmax, ki, kj )
+      REAL                   :: pmax
+      REAL , DIMENSION (:,:) :: ptab, pmask
+      INTEGER :: ki, kj
+      WRITE(*,*) 'mpp_maxloc2d: You should not have seen this print! error?', pmax, ki, kj, ptab(1,1), pmask(1,1)
+   END SUBROUTINE mpp_maxloc2d
+
+   SUBROUTINE mpp_maxloc3d( ptab, pmask, pmax, ki, kj, kk )
+      REAL                     :: pmax
+      REAL , DIMENSION (:,:,:) :: ptab, pmask
+      INTEGER :: ki, kj, kk
+      WRITE(*,*) 'mpp_maxloc3d: You should not have seen this print! error?', pmax, ki, kj, kk, ptab(1,1,1), pmask(1,1,1)
+   END SUBROUTINE mpp_maxloc3d
+
+   SUBROUTINE mppstop
+      WRITE(*,*) 'mppstop: You should not have seen this print! error?'
+   END SUBROUTINE mppstop
+
+   SUBROUTINE mpp_ini_ice( kcom )
+      INTEGER :: kcom
+      WRITE(*,*) 'mpp_ini_ice: You should not have seen this print! error?', kcom
+   END SUBROUTINE mpp_ini_ice
+
+   SUBROUTINE mpp_ini_znl
+      WRITE(*,*) 'mpp_ini_znl: You should not have seen this print! error?'
+   END SUBROUTINE mpp_ini_znl
+
+   SUBROUTINE mpp_comm_free( kcom )
+      INTEGER :: kcom
+      WRITE(*,*) 'mpp_comm_free: You should not have seen this print! error?', kcom
+   END SUBROUTINE mpp_comm_free
+#endif
+   !!----------------------------------------------------------------------
+END MODULE lib_mpp
Index: trunk/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90	(revision 2528)
@@ -0,0 +1,493 @@
+MODULE mppini
+   !!==============================================================================
+   !!                       ***  MODULE mppini   ***
+   !! Ocean initialization : distributed memory computing initialization
+   !!==============================================================================
+
+   !!----------------------------------------------------------------------
+   !!   mpp_init       : Lay out the global domain over processors
+   !!   mpp_init2      : Lay out the global domain over processors 
+   !!                    with land processor elimination
+   !!   mpp_init_ioispl: IOIPSL initialization in mpp
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE dom_oce         ! ocean space and time domain 
+   USE in_out_manager  ! I/O Manager
+   USE lib_mpp         ! distribued memory computing library
+   USE ioipsl
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC mpp_init       ! called by opa.F90
+   PUBLIC mpp_init2      ! called by opa.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#if ! defined key_mpp_mpi
+   !!----------------------------------------------------------------------
+   !!   Default option :                            shared memory computing
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE mpp_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE mpp_init  ***
+      !!
+      !! ** Purpose :   Lay out the global domain over processors.
+      !!
+      !! ** Method  :   Shared memory computing, set the local processor
+      !!      variables to the value of the global domain
+      !!
+      !! History :
+      !!   9.0  !  04-01  (G. Madec, J.M. Molines)  F90 : free form, north fold jpni >1
+      !!----------------------------------------------------------------------
+
+      ! No mpp computation
+      nimpp  = 1
+      njmpp  = 1
+      nlci   = jpi
+      nlcj   = jpj
+      nldi   = 1
+      nldj   = 1
+      nlei   = jpi
+      nlej   = jpj
+      nperio = jperio
+      nbondi = 2
+      nbondj = 2
+      nidom  = FLIO_DOM_NONE
+      npolj = jperio
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'mpp_init(2) : NO massively parallel processing'
+         WRITE(numout,*) '~~~~~~~~~~~: '
+         WRITE(numout,*) '         nperio = ', nperio
+         WRITE(numout,*) '         npolj  = ', npolj
+         WRITE(numout,*) '         nimpp  = ', nimpp
+         WRITE(numout,*) '         njmpp  = ', njmpp
+      ENDIF
+
+      IF(  jpni /= 1 .OR. jpnj /= 1 .OR. jpnij /= 1 ) &
+          CALL ctl_stop( 'equality  jpni = jpnj = jpnij = 1 is not satisfied',   &
+          &              'the domain is lay out for distributed memory computing! ' )
+
+   END SUBROUTINE mpp_init
+
+
+   SUBROUTINE mpp_init2 
+      CALL mpp_init                             ! same routine as mpp_init
+   END SUBROUTINE mpp_init2
+
+#else
+   !!----------------------------------------------------------------------
+   !!   'key_mpp_mpi'          OR         MPI massively parallel processing
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE mpp_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE mpp_init  ***
+      !!                    
+      !! ** Purpose :   Lay out the global domain over processors.
+      !!
+      !! ** Method  :   Global domain is distributed in smaller local domains.
+      !!      Periodic condition is a function of the local domain position
+      !!      (global boundary or neighbouring domain) and of the global
+      !!      periodic
+      !!      Type :         jperio global periodic condition
+      !!                     nperio local  periodic condition
+      !!
+      !! ** Action  : - set domain parameters
+      !!                    nimpp     : longitudinal index 
+      !!                    njmpp     : latitudinal  index
+      !!                    nperio    : lateral condition type 
+      !!                    narea     : number for local area
+      !!                    nlci      : first dimension
+      !!                    nlcj      : second dimension
+      !!                    nbondi    : mark for "east-west local boundary"
+      !!                    nbondj    : mark for "north-south local boundary"
+      !!                    nproc     : number for local processor
+      !!                    noea      : number for local neighboring processor
+      !!                    nowe      : number for local neighboring processor
+      !!                    noso      : number for local neighboring processor
+      !!                    nono      : number for local neighboring processor
+      !!
+      !! History :
+      !!        !  94-11  (M. Guyon)  Original code
+      !!        !  95-04  (J. Escobar, M. Imbard)
+      !!        !  98-02  (M. Guyon)  FETI method
+      !!        !  98-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions
+      !!   8.5  !  02-08  (G. Madec)  F90 : free form
+      !!----------------------------------------------------------------------
+      !! * Local variables
+      INTEGER ::   ji, jj, jn               ! dummy loop indices
+      INTEGER ::   &
+         ii, ij, ifreq, il1, il2,        &  ! temporary integers
+         iresti, irestj, ijm1, imil,     &  !    "          "
+         inum                               ! temporary logical unit
+
+      INTEGER, DIMENSION(jpni,jpnj) ::   &
+         iimppt, ijmppt, ilcit, ilcjt       ! temporary workspace
+      REAL(wp) ::   zidom, zjdom            ! temporary scalars
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'mpp_init : Message Passing MPI'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~'
+
+
+      !  1. Dimension arrays for subdomains
+      ! -----------------------------------
+      !  Computation of local domain sizes ilcit() ilcjt()
+      !  These dimensions depend on global sizes jpni,jpnj and jpiglo,jpjglo
+      !  The subdomains are squares leeser than or equal to the global
+      !  dimensions divided by the number of processors minus the overlap
+      !  array (cf. par_oce.F90).
+      
+      nreci  = 2 * jpreci
+      nrecj  = 2 * jprecj
+      iresti = MOD( jpiglo - nreci , jpni )
+      irestj = MOD( jpjglo - nrecj , jpnj )
+
+      IF(  iresti == 0 )   iresti = jpni
+      DO jj = 1, jpnj
+         DO ji = 1, iresti
+            ilcit(ji,jj) = jpi
+         END DO
+         DO ji = iresti+1, jpni
+            ilcit(ji,jj) = jpi -1
+         END DO
+      END DO
+      
+      IF( irestj == 0 )   irestj = jpnj
+      DO ji = 1, jpni
+         DO jj = 1, irestj
+            ilcjt(ji,jj) = jpj
+         END DO
+         DO jj = irestj+1, jpnj
+            ilcjt(ji,jj) = jpj -1
+         END DO
+      END DO
+      
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '           defines mpp subdomains'
+         WRITE(numout,*) '           ----------------------'
+         WRITE(numout,*) '           iresti=',iresti,' irestj=',irestj
+         WRITE(numout,*) '           jpni  =',jpni  ,' jpnj  =',jpnj
+         ifreq = 4
+         il1   = 1
+         DO jn = 1, (jpni-1)/ifreq+1
+            il2 = MIN( jpni, il1+ifreq-1 )
+            WRITE(numout,*)
+            WRITE(numout,9200) ('***',ji = il1,il2-1)
+            DO jj = jpnj, 1, -1
+               WRITE(numout,9203) ('   ',ji = il1,il2-1)
+               WRITE(numout,9202) jj, ( ilcit(ji,jj),ilcjt(ji,jj),ji = il1,il2 )
+               WRITE(numout,9203) ('   ',ji = il1,il2-1)
+               WRITE(numout,9200) ('***',ji = il1,il2-1)
+            END DO
+            WRITE(numout,9201) (ji,ji = il1,il2)
+            il1 = il1+ifreq
+         END DO
+ 9200    FORMAT('     ***',20('*************',a3))
+ 9203    FORMAT('     *     ',20('         *   ',a3))
+ 9201    FORMAT('        ',20('   ',i3,'          '))
+ 9202    FORMAT(' ',i3,' *  ',20(i3,'  x',i3,'   *   '))
+      ENDIF
+
+      zidom = nreci
+      DO ji = 1, jpni
+         zidom = zidom + ilcit(ji,1) - nreci
+      END DO
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*)' sum ilcit(i,1) = ', zidom, ' jpiglo = ', jpiglo
+      
+      zjdom = nrecj
+      DO jj = 1, jpnj
+         zjdom = zjdom + ilcjt(1,jj) - nrecj
+      END DO
+      IF(lwp) WRITE(numout,*)' sum ilcit(1,j) = ', zjdom, ' jpjglo = ', jpjglo
+      IF(lwp) WRITE(numout,*)
+      
+
+      !  2. Index arrays for subdomains
+      ! -------------------------------
+      
+      iimppt(:,:) = 1
+      ijmppt(:,:) = 1
+      
+      IF( jpni > 1 ) THEN
+         DO jj = 1, jpnj
+            DO ji = 2, jpni
+               iimppt(ji,jj) = iimppt(ji-1,jj) + ilcit(ji-1,jj) - nreci
+            END DO
+         END DO
+      ENDIF
+
+      IF( jpnj > 1 ) THEN
+         DO jj = 2, jpnj
+            DO ji = 1, jpni
+               ijmppt(ji,jj) = ijmppt(ji,jj-1)+ilcjt(ji,jj-1)-nrecj
+            END DO
+         END DO
+      ENDIF
+      
+      ! 3. Subdomain description
+      ! ------------------------
+
+      DO jn = 1, jpnij
+         ii = 1 + MOD( jn-1, jpni )
+         ij = 1 + (jn-1) / jpni
+         nimppt(jn) = iimppt(ii,ij)
+         njmppt(jn) = ijmppt(ii,ij)
+         nlcit (jn) = ilcit (ii,ij)     
+         nlci       = nlcit (jn)     
+         nlcjt (jn) = ilcjt (ii,ij)     
+         nlcj       = nlcjt (jn)
+         nbondj = -1                                   ! general case
+         IF( jn   >  jpni          )   nbondj = 0      ! first row of processor
+         IF( jn   >  (jpnj-1)*jpni )   nbondj = 1      ! last  row of processor
+         IF( jpnj == 1             )   nbondj = 2      ! one processor only in j-direction
+         ibonjt(jn) = nbondj
+         
+         nbondi = 0                                    ! 
+         IF( MOD( jn, jpni ) == 1 )   nbondi = -1      !
+         IF( MOD( jn, jpni ) == 0 )   nbondi =  1      !
+         IF( jpni            == 1 )   nbondi =  2      ! one processor only in i-direction
+         ibonit(jn) = nbondi
+         
+         nldi =  1   + jpreci
+         nlei = nlci - jpreci
+         IF( nbondi == -1 .OR. nbondi == 2 )   nldi = 1
+         IF( nbondi ==  1 .OR. nbondi == 2 )   nlei = nlci
+         nldj =  1   + jprecj
+         nlej = nlcj - jprecj
+         IF( nbondj == -1 .OR. nbondj == 2 )   nldj = 1
+         IF( nbondj ==  1 .OR. nbondj == 2 )   nlej = nlcj
+         nldit(jn) = nldi
+         nleit(jn) = nlei
+         nldjt(jn) = nldj
+         nlejt(jn) = nlej
+      END DO
+      
+
+      ! 4. From global to local
+      ! -----------------------
+
+      nperio = 0
+      IF( jperio == 2 .AND. nbondj == -1 )   nperio = 2
+
+
+      ! 5. Subdomain neighbours
+      ! ----------------------
+
+      nproc = narea - 1
+      noso  = nproc - jpni
+      nowe  = nproc - 1
+      noea  = nproc + 1
+      nono  = nproc + jpni
+      ! great neighbours
+      npnw = nono - 1
+      npne = nono + 1
+      npsw = noso - 1
+      npse = noso + 1
+      nbsw = 1
+      nbnw = 1
+      IF( MOD( nproc, jpni ) == 0 ) THEN
+         nbsw = 0
+         nbnw = 0
+      ENDIF
+      nbse = 1
+      nbne = 1
+      IF( MOD( nproc, jpni ) == jpni-1 ) THEN
+         nbse = 0
+         nbne = 0
+      ENDIF
+      IF(nproc < jpni) THEN
+         nbsw = 0
+         nbse = 0
+      ENDIF
+      IF( nproc >= (jpnj-1)*jpni ) THEN
+         nbnw = 0
+         nbne = 0
+      ENDIF
+      nlcj = nlcjt(narea)  
+      nlci = nlcit(narea)  
+      nldi = nldit(narea)
+      nlei = nleit(narea)
+      nldj = nldjt(narea)
+      nlej = nlejt(narea)
+      nbondi = ibonit(narea)
+      nbondj = ibonjt(narea)
+      nimpp  = nimppt(narea)  
+      njmpp  = njmppt(narea)  
+
+     ! Save processor layout in layout.dat file 
+       IF (lwp) THEN
+        CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )
+        WRITE(inum,'(a)') '   jpnij     jpi     jpj     jpk  jpiglo  jpjglo'
+        WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo
+        WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp'
+
+        DO  jn = 1, jpnij
+         WRITE(inum,'(9i5)') jn, nlcit(jn), nlcjt(jn), &
+                                      nldit(jn), nldjt(jn), &
+                                      nleit(jn), nlejt(jn), &
+                                      nimppt(jn), njmppt(jn)
+        END DO
+        CLOSE(inum)   
+      END IF
+
+
+      ! w a r n i n g  narea (zone) /= nproc (processors)!
+
+      IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
+         IF( jpni == 1 )THEN
+            nbondi = 2
+            nperio = 1
+         ELSE
+            nbondi = 0
+         ENDIF
+         IF( MOD( narea, jpni ) == 0 ) THEN
+            noea = nproc-(jpni-1)
+            npne = npne-jpni
+            npse = npse-jpni
+         ENDIF
+         IF( MOD( narea, jpni ) == 1 ) THEN
+            nowe = nproc+(jpni-1)
+            npnw = npnw+jpni
+            npsw = npsw+jpni
+         ENDIF
+         nbsw = 1
+         nbnw = 1
+         nbse = 1
+         nbne = 1
+         IF( nproc < jpni ) THEN
+            nbsw = 0
+            nbse = 0
+         ENDIF
+         IF( nproc >= (jpnj-1)*jpni ) THEN
+            nbnw = 0
+            nbne = 0
+         ENDIF
+      ENDIF
+      npolj = 0
+      IF( jperio == 3 .OR. jperio == 4 ) THEN
+         ijm1 = jpni*(jpnj-1)
+         imil = ijm1+(jpni+1)/2
+         IF( narea > ijm1 ) npolj = 3
+         IF( MOD(jpni,2) == 1 .AND. narea == imil ) npolj = 4
+         IF( npolj == 3 ) nono = jpni*jpnj-narea+ijm1
+      ENDIF
+      IF( jperio == 5 .OR. jperio == 6 ) THEN
+          ijm1 = jpni*(jpnj-1)
+          imil = ijm1+(jpni+1)/2
+          IF( narea > ijm1) npolj = 5
+          IF( MOD(jpni,2) == 1 .AND. narea == imil ) npolj = 6
+          IF( npolj == 5 ) nono = jpni*jpnj-narea+ijm1
+      ENDIF
+
+      ! Periodicity : no corner if nbondi = 2 and nperio != 1
+
+      IF(lwp) THEN
+         WRITE(numout,*) ' nproc  = ', nproc
+         WRITE(numout,*) ' nowe   = ', nowe  , ' noea   =  ', noea
+         WRITE(numout,*) ' nono   = ', nono  , ' noso   =  ', noso
+         WRITE(numout,*) ' nbondi = ', nbondi
+         WRITE(numout,*) ' nbondj = ', nbondj
+         WRITE(numout,*) ' npolj  = ', npolj
+         WRITE(numout,*) ' nperio = ', nperio
+         WRITE(numout,*) ' nlci   = ', nlci
+         WRITE(numout,*) ' nlcj   = ', nlcj
+         WRITE(numout,*) ' nimpp  = ', nimpp
+         WRITE(numout,*) ' njmpp  = ', njmpp
+         WRITE(numout,*) ' nbse   = ', nbse  , ' npse   = ', npse
+         WRITE(numout,*) ' nbsw   = ', nbsw  , ' npsw   = ', npsw
+         WRITE(numout,*) ' nbne   = ', nbne  , ' npne   = ', npne
+         WRITE(numout,*) ' nbnw   = ', nbnw  , ' npnw   = ', npnw
+      ENDIF
+
+      IF( nperio == 1 .AND. jpni /= 1 ) CALL ctl_stop( ' mpp_init: error on cyclicity' )
+
+      ! Prepare mpp north fold
+
+      IF (jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
+         CALL mpp_ini_north
+      END IF
+
+      ! Prepare NetCDF output file (if necessary)
+      CALL mpp_init_ioipsl
+
+   END SUBROUTINE mpp_init
+
+#  include "mppini_2.h90"
+
+# if defined key_dimgout
+   !!----------------------------------------------------------------------
+   !!   'key_dimgout'                  NO use of NetCDF files
+   !!----------------------------------------------------------------------
+   SUBROUTINE mpp_init_ioipsl       ! Dummy routine
+   END SUBROUTINE mpp_init_ioipsl  
+# else
+   SUBROUTINE mpp_init_ioipsl
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE mpp_init_ioipsl  ***
+      !!
+      !! ** Purpose :   
+      !!
+      !! ** Method  :   
+      !!
+      !! History :
+      !!   9.0  !  04-03  (G. Madec )  MPP-IOIPSL 
+      !!   " "  !  08-12  (A. Coward)  addition in case of jpni*jpnj < jpnij
+      !!----------------------------------------------------------------------
+      !! Local declarations
+
+      INTEGER, DIMENSION(2) ::   &
+         iglo, iloc, iabsf, iabsl, ihals, ihale, idid
+      !!----------------------------------------------------------------------
+
+      ! The domain is split only horizontally along i- or/and j- direction
+      ! So we need at the most only 1D arrays with 2 elements.
+      ! Set idompar values equivalent to the jpdom_local_noextra definition
+      ! used in IOM. This works even if jpnij .ne. jpni*jpnj.
+      iglo(1) = jpiglo
+      iglo(2) = jpjglo
+      iloc(1) = nlci
+      iloc(2) = nlcj
+      iabsf(1) = nimppt(narea)
+      iabsf(2) = njmppt(narea)
+      iabsl(:) = iabsf(:) + iloc(:) - 1
+      ihals(1) = nldi - 1
+      ihals(2) = nldj - 1
+      ihale(1) = nlci - nlei
+      ihale(2) = nlcj - nlej
+      idid(1) = 1
+      idid(2) = 2
+
+      IF(lwp) THEN
+          WRITE(numout,*)
+          WRITE(numout,*) 'mpp_init_ioipsl :   iloc  = ', iloc (1), iloc (2)
+          WRITE(numout,*) '~~~~~~~~~~~~~~~     iabsf = ', iabsf(1), iabsf(2)
+          WRITE(numout,*) '                    ihals = ', ihals(1), ihals(2)
+          WRITE(numout,*) '                    ihale = ', ihale(1), ihale(2)
+      ENDIF
+
+      CALL flio_dom_set ( jpnij, nproc, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom)
+
+   END SUBROUTINE mpp_init_ioipsl  
+
+# endif
+#endif
+
+   !!======================================================================
+END MODULE mppini
Index: trunk/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90	(revision 2528)
@@ -0,0 +1,525 @@
+   SUBROUTINE mpp_init2
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE mpp_init2  ***
+      !!
+      !! * Purpose :   Lay out the global domain over processors.
+      !!     FOR USING THIS VERSION, A PREPROCESSING TRAITMENT IS RECOMMENDED
+      !!     FOR DEFINING BETTER CUTTING OUT.
+      !!       This routine is used with a the bathymetry file.
+      !!       In this version, the land processors are avoided and the adress
+      !!     processor (nproc, narea,noea, ...) are calculated again.
+      !!     The jpnij parameter can be lesser than jpni x jpnj
+      !!     and this jpnij parameter must be calculated before with an
+      !!     algoritmic preprocessing program.
+      !!
+      !! ** Method  :   Global domain is distributed in smaller local domains.
+      !!      Periodic condition is a function of the local domain position
+      !!      (global boundary or neighbouring domain) and of the global
+      !!      periodic
+      !!      Type :         jperio global periodic condition
+      !!                     nperio local  periodic condition
+      !!
+      !! ** Action :        nimpp     : longitudinal index 
+      !!                    njmpp     : latitudinal  index
+      !!                    nperio    : lateral condition type 
+      !!                    narea     : number for local area
+      !!                    nlci      : first dimension
+      !!                    nlcj      : second dimension
+      !!                    nproc     : number for local processor
+      !!                    noea      : number for local neighboring processor
+      !!                    nowe      : number for local neighboring processor
+      !!                    noso      : number for local neighboring processor
+      !!                    nono      : number for local neighboring processor
+      !!
+      !! History :
+      !!        !  94-11  (M. Guyon)  Original code
+      !!        !  95-04  (J. Escobar, M. Imbard)
+      !!        !  98-02  (M. Guyon)  FETI method
+      !!        !  98-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions
+      !!   9.0  !  04-01  (G. Madec, J.M Molines)  F90 : free form , north fold jpni > 1
+      !!----------------------------------------------------------------------
+      USE in_out_manager  ! I/O Manager
+      USE iom
+      !! 
+      INTEGER :: ji, jj, jn, jproc, jarea     ! dummy loop indices
+      INTEGER ::  inum                        ! temporary logical unit
+      INTEGER ::   &
+         ii, ij, ifreq, il1, il2,          &  ! temporary integers
+         icont, ili, ilj,                  &  !    "          "
+         isurf, ijm1, imil,                &  !    "          "
+         iino, ijno, iiso, ijso,           &  !    "          " 
+         iiea, ijea, iiwe, ijwe,           &  !    "          "
+         iinw, ijnw, iine, ijne,           &  !    "          "
+         iisw, ijsw, iise, ijse,           &  !    "          "
+         iresti, irestj, iproc                !    "          "
+      INTEGER, DIMENSION(jpnij) ::   &
+         iin, ijn          
+      INTEGER, DIMENSION(jpni,jpnj) ::   &
+         iimppt, ijmppt, ilci  , ilcj  ,   &  ! temporary workspace
+         ipproc, ibondj, ibondi, ipolj ,   &  !    "           "
+         ilei  , ilej  , ildi  , ildj  ,   &  !    "           "
+         ioea  , iowe  , ioso  , iono  ,   &  !    "           "
+         ione  , ionw  , iose  , iosw  ,   &  !    "           "
+         ibne  , ibnw  , ibse  , ibsw         !    "           "
+      INTEGER,  DIMENSION(jpiglo,jpjglo) ::   &
+         imask                                ! temporary global workspace
+      REAL(wp), DIMENSION(jpiglo,jpjglo) ::   &
+         zdta                   ! temporary data workspace
+      REAL(wp) ::   zidom , zjdom          ! temporary scalars
+
+      ! read namelist for ln_zco
+      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco
+
+      !!----------------------------------------------------------------------
+      !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+      !! $Id$
+      !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
+      !!----------------------------------------------------------------------
+      
+      REWIND ( numnam )              ! Read Namelist namzgr : vertical coordinate'
+      READ   ( numnam, namzgr )
+
+      IF(lwp)WRITE(numout,*)
+      IF(lwp)WRITE(numout,*) 'mpp_init : Message Passing MPI'
+      IF(lwp)WRITE(numout,*) '~~~~~~~~'
+      IF(lwp)WRITE(numout,*) ' '
+
+      IF( jpni*jpnj < jpnij ) CALL ctl_stop( ' jpnij > jpni x jpnj impossible' )
+
+      ! 0. initialisation
+      ! -----------------
+
+      ! 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 
+      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/) )
+      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/) )
+      ENDIF
+      CALL iom_close (inum)
+
+      ! land/sea mask over the global/zoom domain
+
+      imask(:,:)=1
+      WHERE ( zdta(:,:) <= 0. ) imask = 0
+
+      !  1. Dimension arrays for subdomains
+      ! -----------------------------------
+
+      !  Computation of local domain sizes ilci() ilcj()
+      !  These dimensions depend on global sizes jpni,jpnj and jpiglo,jpjglo
+      !  The subdomains are squares leeser than or equal to the global
+      !  dimensions divided by the number of processors minus the overlap
+      !  array.
+
+      nreci=2*jpreci
+      nrecj=2*jprecj
+      iresti = 1 + MOD( jpiglo - nreci -1 , jpni )
+      irestj = 1 + MOD( jpjglo - nrecj -1 , jpnj )
+
+      ilci(1:iresti      ,:) = jpi
+      ilci(iresti+1:jpni ,:) = jpi-1
+
+      ilcj(:,      1:irestj) = jpj
+      ilcj(:, irestj+1:jpnj) = jpj-1
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' mpp_init2: defines mpp subdomains'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~  ----------------------'
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'iresti=',iresti,' irestj=',irestj
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'jpni=',jpni,' jpnj=',jpnj
+
+      zidom = nreci + sum(ilci(:,1) - nreci ) 
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*)' sum ilci(i,1)=',zidom,' jpiglo=',jpiglo
+
+      zjdom = nrecj + sum(ilcj(1,:) - nrecj ) 
+      IF(lwp) WRITE(numout,*) ' sum ilcj(1,j)=',zjdom,' jpjglo=',jpjglo
+      IF(lwp) WRITE(numout,*)
+
+
+      !  2. Index arrays for subdomains
+      ! -------------------------------
+
+      iimppt(:,:) = 1
+      ijmppt(:,:) = 1
+      ipproc(:,:) = -1
+
+      IF( jpni > 1 )THEN
+         DO jj = 1, jpnj
+            DO ji = 2, jpni
+               iimppt(ji,jj) = iimppt(ji-1,jj) + ilci(ji-1,jj) - nreci
+            END DO
+         END DO
+      ENDIF
+
+      IF( jpnj > 1 )THEN
+         DO jj = 2, jpnj
+            DO ji = 1, jpni
+               ijmppt(ji,jj) = ijmppt(ji,jj-1) + ilcj(ji,jj-1) - nrecj
+            END DO
+         END DO
+      ENDIF
+
+
+      ! 3. Subdomain description in the Regular Case
+      ! --------------------------------------------
+
+      nperio = 0
+      icont = -1
+      DO jarea = 1, jpni*jpnj
+         ii = 1 + MOD(jarea-1,jpni)
+         ij = 1 +    (jarea-1)/jpni
+         ili = ilci(ii,ij)
+         ilj = ilcj(ii,ij)
+
+         ibondj(ii,ij) = -1
+         IF( jarea >  jpni          )   ibondj(ii,ij) = 0
+         IF( jarea >  (jpnj-1)*jpni )   ibondj(ii,ij) = 1
+         IF( jpnj  == 1             )   ibondj(ii,ij) = 2
+
+         ibondi(ii,ij) = 0
+         IF( MOD(jarea,jpni) == 1 )   ibondi(ii,ij) = -1
+         IF( MOD(jarea,jpni) == 0 )   ibondi(ii,ij) =  1
+         IF( jpni            == 1 )   ibondi(ii,ij) =  2
+
+         ! 2.4 Subdomain neighbors
+
+         iproc = jarea - 1
+         ioso(ii,ij) = iproc - jpni
+         iowe(ii,ij) = iproc - 1
+         ioea(ii,ij) = iproc + 1
+         iono(ii,ij) = iproc + jpni
+         ildi(ii,ij) = 1 + jpreci
+         ilei(ii,ij) = ili -jpreci
+         ionw(ii,ij) = iono(ii,ij) - 1
+         ione(ii,ij) = iono(ii,ij) + 1
+         iosw(ii,ij) = ioso(ii,ij) - 1
+         iose(ii,ij) = ioso(ii,ij) + 1
+         ibsw(ii,ij) = 1
+         ibnw(ii,ij) = 1
+         IF( MOD(iproc,jpni) == 0 ) THEN
+            ibsw(ii,ij) = 0
+            ibnw(ii,ij) = 0
+         ENDIF
+         ibse(ii,ij) = 1
+         ibne(ii,ij) = 1
+         IF( MOD(iproc,jpni) == jpni-1 ) THEN
+            ibse(ii,ij) = 0
+            ibne(ii,ij) = 0
+         ENDIF
+         IF( iproc < jpni ) THEN
+            ibsw(ii,ij) = 0
+            ibse(ii,ij) = 0
+         ENDIF
+         IF( iproc >= (jpnj-1)*jpni ) THEN
+            ibnw(ii,ij) = 0
+            ibne(ii,ij) = 0
+         ENDIF
+         IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 ) ildi(ii,ij) = 1
+         IF( ibondi(ii,ij) ==  1 .OR. ibondi(ii,ij) == 2 ) ilei(ii,ij) = ili
+         ildj(ii,ij) =  1  + jprecj
+         ilej(ii,ij) = ilj - jprecj
+         IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) = 1
+         IF( ibondj(ii,ij) ==  1 .OR. ibondj(ii,ij) == 2 ) ilej(ii,ij) = ilj
+
+         ! warning ii*ij (zone) /= nproc (processors)!
+
+         IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
+            IF( jpni == 1 )THEN
+               ibondi(ii,ij) = 2
+               nperio = 1
+            ELSE
+               ibondi(ii,ij) = 0
+            ENDIF
+            IF( MOD(jarea,jpni) == 0 ) THEN
+               ioea(ii,ij) = iproc - (jpni-1)
+               ione(ii,ij) = ione(ii,ij) - jpni
+               iose(ii,ij) = iose(ii,ij) - jpni
+            ENDIF
+            IF( MOD(jarea,jpni) == 1 ) THEN
+               iowe(ii,ij) = iproc + jpni - 1
+               ionw(ii,ij) = ionw(ii,ij) + jpni
+               iosw(ii,ij) = iosw(ii,ij) + jpni 
+            ENDIF
+            ibsw(ii,ij) = 1
+            ibnw(ii,ij) = 1
+            ibse(ii,ij) = 1
+            ibne(ii,ij) = 1
+            IF( iproc < jpni ) THEN
+               ibsw(ii,ij) = 0
+               ibse(ii,ij) = 0
+            ENDIF
+            IF( iproc >= (jpnj-1)*jpni ) THEN
+               ibnw(ii,ij) = 0
+               ibne(ii,ij) = 0
+            ENDIF
+         ENDIF
+         ipolj(ii,ij) = 0
+         IF( jperio == 3 .OR. jperio == 4 ) THEN
+            ijm1 = jpni*(jpnj-1)
+            imil = ijm1+(jpni+1)/2
+            IF( jarea > ijm1 ) ipolj(ii,ij) = 3
+            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 4
+            IF( ipolj(ii,ij) == 3 ) iono(ii,ij) = jpni*jpnj-jarea+ijm1
+         ENDIF
+         IF( jperio == 5 .OR. jperio == 6 ) THEN
+            ijm1 = jpni*(jpnj-1)
+            imil = ijm1+(jpni+1)/2
+            IF( jarea > ijm1) ipolj(ii,ij) = 5
+            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 6
+            IF( ipolj(ii,ij) == 5) iono(ii,ij) = jpni*jpnj-jarea+ijm1
+         ENDIF
+
+         isurf = 0
+         DO jj = 1+jprecj, ilj-jprecj
+            DO  ji = 1+jpreci, ili-jpreci
+               IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1) isurf = isurf+1
+            END DO
+         END DO
+         IF(isurf /= 0) THEN
+            icont = icont + 1
+            ipproc(ii,ij) = icont
+            iin(icont+1) = ii
+            ijn(icont+1) = ij
+         ENDIF
+      END DO
+
+      ! Control
+      IF(icont+1 /= jpnij) THEN
+         WRITE(ctmp1,*) ' jpni =',jpni,' jpnj =',jpnj
+         WRITE(ctmp2,*) ' jpnij =',jpnij, '< jpni x jpnj' 
+         WRITE(ctmp3,*) ' ***********, mpp_init2 finds jpnij=',icont+1
+         CALL ctl_stop( ' Eliminate land processors algorithm', '', ctmp1, ctmp2, '', ctmp3 )
+      ENDIF
+
+      ! 4. Subdomain print
+      ! ------------------
+
+      IF(lwp) THEN
+         ifreq = 4
+         il1 = 1
+         DO jn = 1,(jpni-1)/ifreq+1
+            il2 = MIN(jpni,il1+ifreq-1)
+            WRITE(numout,*)
+            WRITE(numout,9400) ('***',ji=il1,il2-1)
+            DO jj = jpnj, 1, -1
+               WRITE(numout,9403) ('   ',ji=il1,il2-1)
+               WRITE(numout,9402) jj, (ilci(ji,jj),ilcj(ji,jj),ji=il1,il2)
+               WRITE(numout,9404) (ipproc(ji,jj),ji=il1,il2)
+               WRITE(numout,9403) ('   ',ji=il1,il2-1)
+               WRITE(numout,9400) ('***',ji=il1,il2-1)
+            END DO
+            WRITE(numout,9401) (ji,ji=il1,il2)
+            il1 = il1+ifreq
+         END DO
+ 9400     FORMAT('     ***',20('*************',a3))
+ 9403     FORMAT('     *     ',20('         *   ',a3))
+ 9401     FORMAT('        ',20('   ',i3,'          '))
+ 9402     FORMAT(' ',i3,' *  ',20(i3,'  x',i3,'   *   '))
+ 9404     FORMAT('     *  ',20('      ',i3,'   *   '))
+      ENDIF
+
+
+      ! 5. neighbour treatment
+      ! ----------------------
+
+      DO jarea = 1, jpni*jpnj
+         iproc = jarea-1
+         ii = 1 + MOD(jarea-1,jpni)
+         ij = 1 +    (jarea-1)/jpni
+         IF( ipproc(ii,ij) == -1 .AND. iono(ii,ij) >= 0   &
+            .AND. iono(ii,ij) <= jpni*jpnj-1 ) THEN
+            iino = 1 + MOD(iono(ii,ij),jpni)
+            ijno = 1 +    (iono(ii,ij))/jpni
+            IF( ibondj(iino,ijno) == 1 ) ibondj(iino,ijno)=2
+            IF( ibondj(iino,ijno) == 0 ) ibondj(iino,ijno) = -1
+         ENDIF
+         IF( ipproc(ii,ij) == -1 .AND. ioso(ii,ij) >= 0   &
+            .AND. ioso(ii,ij) <= jpni*jpnj-1 ) THEN
+            iiso = 1 + MOD(ioso(ii,ij),jpni)
+            ijso = 1 +    (ioso(ii,ij))/jpni
+            IF( ibondj(iiso,ijso) == -1 ) ibondj(iiso,ijso) = 2
+            IF( ibondj(iiso,ijso) ==  0 ) ibondj(iiso,ijso) = 1
+         ENDIF
+         IF( ipproc(ii,ij) == -1 .AND. ioea(ii,ij) >= 0   &
+            .AND. ioea(ii,ij) <= jpni*jpnj-1) THEN
+            iiea = 1 + MOD(ioea(ii,ij),jpni)
+            ijea = 1 +    (ioea(ii,ij))/jpni
+            IF( ibondi(iiea,ijea) == 1 ) ibondi(iiea,ijea) = 2
+            IF( ibondi(iiea,ijea) == 0 ) ibondi(iiea,ijea) = -1
+         ENDIF
+         IF( ipproc(ii,ij) == -1 .AND. iowe(ii,ij) >= 0   &
+            .AND. iowe(ii,ij) <= jpni*jpnj-1) THEN
+            iiwe = 1 + MOD(iowe(ii,ij),jpni)
+            ijwe = 1 +    (iowe(ii,ij))/jpni
+            IF( ibondi(iiwe,ijwe) == -1 ) ibondi(iiwe,ijwe) = 2
+            IF( ibondi(iiwe,ijwe) ==  0 ) ibondi(iiwe,ijwe) = 1
+         ENDIF
+         IF( ipproc(ii,ij) == -1 .AND. ibne(ii,ij) == 1 ) THEN
+            iine = 1 + MOD(ione(ii,ij),jpni)
+            ijne = 1 +    (ione(ii,ij))/jpni
+            IF( ibsw(iine,ijne) == 1 ) ibsw(iine,ijne) = 0
+         ENDIF
+         IF( ipproc(ii,ij) == -1 .AND. ibsw(ii,ij) == 1 ) THEN
+            iisw = 1 + MOD(iosw(ii,ij),jpni)
+            ijsw = 1 +    (iosw(ii,ij))/jpni
+            IF( ibne(iisw,ijsw) == 1 ) ibne(iisw,ijsw) = 0
+         ENDIF
+         IF( ipproc(ii,ij) == -1 .AND. ibnw(ii,ij) == 1 ) THEN
+            iinw = 1 + MOD(ionw(ii,ij),jpni)
+            ijnw = 1 +    (ionw(ii,ij))/jpni
+            IF( ibse(iinw,ijnw) == 1 ) ibse(iinw,ijnw)=0
+         ENDIF
+         IF( ipproc(ii,ij) == -1 .AND. ibse(ii,ij) == 1 ) THEN
+            iise = 1 + MOD(iose(ii,ij),jpni)
+            ijse = 1 +    (iose(ii,ij))/jpni
+            IF( ibnw(iise,ijse) == 1 ) ibnw(iise,ijse) = 0
+         ENDIF
+      END DO
+
+
+      ! 6. Change processor name
+      ! ------------------------
+
+      nproc = narea-1
+      ii = iin(narea)
+      ij = ijn(narea)
+      IF( ioso(ii,ij) >= 0 .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iiso = 1 + MOD(ioso(ii,ij),jpni)
+         ijso = 1 +    (ioso(ii,ij))/jpni
+         noso = ipproc(iiso,ijso)
+      ENDIF
+      IF( iowe(ii,ij) >= 0 .AND. iowe(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iiwe = 1 + MOD(iowe(ii,ij),jpni)
+         ijwe = 1 +    (iowe(ii,ij))/jpni
+         nowe = ipproc(iiwe,ijwe)
+      ENDIF
+      IF( ioea(ii,ij) >= 0 .AND. ioea(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iiea = 1 + MOD(ioea(ii,ij),jpni)
+         ijea = 1 +    (ioea(ii,ij))/jpni
+         noea = ipproc(iiea,ijea)
+      ENDIF
+      IF( iono(ii,ij) >= 0 .AND. iono(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iino = 1 + MOD(iono(ii,ij),jpni)
+         ijno = 1 +    (iono(ii,ij))/jpni
+         nono = ipproc(iino,ijno)
+      ENDIF
+      IF( iose(ii,ij) >= 0 .AND. iose(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iise = 1 + MOD(iose(ii,ij),jpni)
+         ijse = 1 +    (iose(ii,ij))/jpni
+         npse = ipproc(iise,ijse)
+      ENDIF
+      IF( iosw(ii,ij) >= 0 .AND. iosw(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iisw = 1 + MOD(iosw(ii,ij),jpni)
+         ijsw = 1 +    (iosw(ii,ij))/jpni
+         npsw = ipproc(iisw,ijsw)
+      ENDIF
+      IF( ione(ii,ij) >= 0 .AND. ione(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iine = 1 + MOD(ione(ii,ij),jpni)
+         ijne = 1 +    (ione(ii,ij))/jpni
+         npne = ipproc(iine,ijne)
+      ENDIF
+      IF( ionw(ii,ij) >= 0 .AND. ionw(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iinw = 1 + MOD(ionw(ii,ij),jpni)
+         ijnw = 1 +    (ionw(ii,ij))/jpni
+         npnw = ipproc(iinw,ijnw)
+      ENDIF
+      nbnw = ibnw(ii,ij)
+      nbne = ibne(ii,ij)
+      nbsw = ibsw(ii,ij)
+      nbse = ibse(ii,ij)
+      nlcj = ilcj(ii,ij)  
+      nlci = ilci(ii,ij)  
+      nldi = ildi(ii,ij)
+      nlei = ilei(ii,ij)
+      nldj = ildj(ii,ij)
+      nlej = ilej(ii,ij)
+      nbondi = ibondi(ii,ij)
+      nbondj = ibondj(ii,ij)
+      nimpp = iimppt(ii,ij)  
+      njmpp = ijmppt(ii,ij)  
+      DO jproc = 1, jpnij
+         ii = iin(jproc)
+         ij = ijn(jproc)
+         nimppt(jproc) = iimppt(ii,ij)  
+         njmppt(jproc) = ijmppt(ii,ij)  
+         nlcjt(jproc) = ilcj(ii,ij)
+         nlcit(jproc) = ilci(ii,ij)
+         nldit(jproc) = ildi(ii,ij)
+         nleit(jproc) = ilei(ii,ij)
+         nldjt(jproc) = ildj(ii,ij)
+         nlejt(jproc) = ilej(ii,ij)
+      END DO
+
+      ! Save processor layout in ascii file
+      IF (lwp) THEN
+         CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )
+         WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo
+         WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp'
+
+        DO  jproc = 1, jpnij
+         WRITE(inum,'(9i5)') jproc, nlcit(jproc), nlcjt(jproc), &
+                                      nldit(jproc), nldjt(jproc), &
+                                      nleit(jproc), nlejt(jproc), &
+                                      nimppt(jproc), njmppt(jproc)
+        END DO
+        CLOSE(inum)   
+      END IF
+
+      IF( nperio == 1 .AND.jpni /= 1 ) CALL ctl_stop( ' mpp_init2:  error on cyclicity' )
+
+      ! Prepare mpp north fold
+
+      IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
+         CALL mpp_ini_north
+         IF(lwp) WRITE(numout,*) ' mpp_init2 : North fold boundary prepared for jpni >1'
+      ENDIF
+
+      ! Defined npolj, either 0, 3 , 4 , 5 , 6
+      ! In this case the important thing is that npolj /= 0
+      ! Because if we go through these line it is because jpni >1 and thus
+      ! we must use lbcnorthmpp, which tests only npolj =0 or npolj /= 0
+
+      npolj = 0
+      ij = ijn(narea)
+
+      IF( jperio == 3 .OR. jperio == 4 ) THEN
+         IF( ij == jpnj ) npolj = 3
+      ENDIF
+
+      IF( jperio == 5 .OR. jperio == 6 ) THEN
+         IF( ij == jpnj ) npolj = 5
+      ENDIF
+
+      ! Prepare NetCDF output file (if necessary)
+      CALL mpp_init_ioipsl
+
+      ! Periodicity : no corner if nbondi = 2 and nperio != 1
+
+      IF(lwp) THEN
+         WRITE(numout,*) ' nproc=  ',nproc
+         WRITE(numout,*) ' nowe=   ',nowe
+         WRITE(numout,*) ' noea=   ',noea
+         WRITE(numout,*) ' nono=   ',nono
+         WRITE(numout,*) ' noso=   ',noso
+         WRITE(numout,*) ' nbondi= ',nbondi
+         WRITE(numout,*) ' nbondj= ',nbondj
+         WRITE(numout,*) ' npolj=  ',npolj
+         WRITE(numout,*) ' nperio= ',nperio
+         WRITE(numout,*) ' nlci=   ',nlci
+         WRITE(numout,*) ' nlcj=   ',nlcj
+         WRITE(numout,*) ' nimpp=  ',nimpp
+         WRITE(numout,*) ' njmpp=  ',njmpp
+         WRITE(numout,*) ' nbse=   ',nbse,' npse= ',npse
+         WRITE(numout,*) ' nbsw=   ',nbsw,' npsw= ',npsw
+         WRITE(numout,*) ' nbne=   ',nbne,' npne= ',npne
+         WRITE(numout,*) ' nbnw=   ',nbnw,' npnw= ',npnw
+      ENDIF
+
+   END SUBROUTINE mpp_init2
Index: trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90	(revision 2528)
@@ -36,7 +36,7 @@
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -67,5 +67,5 @@
       NAMELIST/namdyn_ldf/ ln_dynldf_lap  , ln_dynldf_bilap,                  &
          &                 ln_dynldf_level, ln_dynldf_hor  , ln_dynldf_iso,   &
-         &                 rn_ahm_0       , rn_ahmb_0
+         &                 rn_ahm_0_lap   , rn_ahmb_0      , rn_ahm_0_blp
       !!----------------------------------------------------------------------
 
@@ -78,15 +78,17 @@
          WRITE(numout,*) '~~~~~~~'
          WRITE(numout,*) '   Namelist nam_dynldf : set lateral mixing parameters'
-         WRITE(numout,*) '      laplacian operator          ln_dynldf_lap   = ', ln_dynldf_lap
-         WRITE(numout,*) '      bilaplacian operator        ln_dynldf_bilap = ', ln_dynldf_bilap
-         WRITE(numout,*) '      iso-level                   ln_dynldf_level = ', ln_dynldf_level
-         WRITE(numout,*) '      horizontal (geopotential)   ln_dynldf_hor   = ', ln_dynldf_hor
-         WRITE(numout,*) '      iso-neutral                 ln_dynldf_iso   = ', ln_dynldf_iso
-         WRITE(numout,*) '      horizontal eddy viscosity   rn_ahm_0        = ', rn_ahm_0
-         WRITE(numout,*) '      background viscosity        rn_ahmb_0       = ', rn_ahmb_0
-      ENDIF
-
-      ahm0  = rn_ahm_0                  ! OLD namelist variables defined from DOCTOR namelist variables
-      ahmb0 = rn_ahmb_0
+         WRITE(numout,*) '      laplacian operator                      ln_dynldf_lap   = ', ln_dynldf_lap
+         WRITE(numout,*) '      bilaplacian operator                    ln_dynldf_bilap = ', ln_dynldf_bilap
+         WRITE(numout,*) '      iso-level                               ln_dynldf_level = ', ln_dynldf_level
+         WRITE(numout,*) '      horizontal (geopotential)               ln_dynldf_hor   = ', ln_dynldf_hor
+         WRITE(numout,*) '      iso-neutral                             ln_dynldf_iso   = ', ln_dynldf_iso
+         WRITE(numout,*) '      horizontal laplacian eddy viscosity     rn_ahm_0_lap    = ', rn_ahm_0_lap
+         WRITE(numout,*) '      background viscosity                    rn_ahmb_0       = ', rn_ahmb_0
+         WRITE(numout,*) '      horizontal bilaplacian eddy viscosity   rn_ahm_0_blp    = ', rn_ahm_0_blp
+      ENDIF
+
+      ahm0     = rn_ahm_0_lap              ! OLD namelist variables defined from DOCTOR namelist variables
+      ahmb0    = rn_ahmb_0
+      ahm0_blp = rn_ahm_0_blp
 
       ! ... check of lateral diffusive operator on tracers
@@ -117,5 +119,6 @@
       IF( ln_dynldf_bilap ) THEN
          IF(lwp) WRITE(numout,*) '   biharmonic momentum diffusion'
-         IF( ahm0 > 0 .AND. .NOT. lk_esopa )   CALL ctl_stop( 'The horizontal viscosity coef. ahm0 must be negative' )
+         IF( .NOT. ln_dynldf_lap ) ahm0 = ahm0_blp   ! Allow spatially varying coefs, which use ahm0 as input
+         IF( ahm0_blp > 0 .AND. .NOT. lk_esopa )   CALL ctl_stop( 'The horizontal viscosity coef. ahm0 must be negative' )
       ELSE
          IF(lwp) WRITE(numout,*) '   harmonic momentum diff. (default)'
Index: trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_antarctic.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_antarctic.h90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_antarctic.h90	(revision 2528)
@@ -3,7 +3,7 @@
    !!----------------------------------------------------------------------
    !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 !
Index: trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_arctic.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_arctic.h90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_arctic.h90	(revision 2528)
@@ -3,7 +3,7 @@
    !!----------------------------------------------------------------------
    !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c1d.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c1d.h90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c1d.h90	(revision 2528)
@@ -4,7 +4,7 @@
 
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -17,5 +17,6 @@
       !! ** Method  :   1D eddy viscosity coefficients ( depth )
       !!      ahm3, ahm4 never used
-      !!      biharmonic or harmonic operator : ahm1=ahm2 defined at T-level
+      !!      harmonic   operator : ahm1 defined at T-level
+      !!      biharmonic operator : ahm2 defined at T-level
       !!      isopycnal or geopotential harmonic operator
       !!                                      : ahm1 defined at T-level
@@ -27,6 +28,7 @@
 
       !! * Local variables
-      INTEGER :: jk   ! dummy loop indice
-      REAL(wp) ::   zdam, zwam, zm00, zm01, zmhf, zmhs
+      INTEGER  ::   jk   ! dummy loop indice
+      REAL(wp) ::   zdam,  zwam,  zm00,  zm01,  zmhf,  zmhs
+      REAL(wp) ::   zdam2, zwam2, zm200, zm201, zmh2f, zmh2s
       REAL(wp) ::   zahmf, zahms
       !!----------------------------------------------------------------------
@@ -37,5 +39,5 @@
       IF(lwp) WRITE(numout,*)
 
-      ! Set ahm1=ahm2   (always at t-level)
+      ! Set ahm1 for laplacian     (always at t-level)
       ! =============
       ! (USER: modify ahm1 following your desiderata)
@@ -54,8 +56,26 @@
       zmhs = zahms-zmhf * zm00
 
-      ! set ahm1=ahm2 at T-level
+      ! Set ahm2 for bilaplacian   (always at t-level)
+      ! =============
+      ! (USER: modify ahm2 following your desiderata)
+
+      ! initialization of the profile
+      ! ahms, ahmf: surface and bottom values
+      zahm2s = ahm0_blp
+      zahm2f = ahm0_blp/4.
+      ! zdam, zwam: depth of the inflection pt and width of inflection
+      zdam2  = -300.
+      zwam2  =  300.
+      ! computation coefficients
+      zm200 = TANH( (0-zdam2)/zwam2 )
+      zm201 = TANH( (-fsdept(1,1,jpk)-zdam2)/zwam2 )
+      zmh2f = (zahm2s-zahm2f)/(zm200-zm201)
+      zmh2s = zahm2s-zmh2f * zm00
+
+
+      ! set ahm1 and ahm2 at T-level
       DO jk = 1, jpk
-         ahm1(jk) = zmhs + zmhf * TANH( (-fsdept(1,1,jk)-zdam) / zwam )
-         ahm2(jk) = ahm1(jk)
+         ahm1(jk) = zmhs  + zmhf  * TANH( (-fsdept(1,1,jk)-zdam ) / zwam  )
+         ahm2(jk) = zmh2s + zmh2f * TANH( (-fsdept(1,1,jk)-zdam2) / zwam2 )
       END DO
 
@@ -63,9 +83,16 @@
       IF(lwp .AND. ld_print ) THEN
          WRITE(numout,*)
-         WRITE(numout,*) '         ahm profile : '
+         WRITE(numout,*) '         ahm profile (laplacian): '
          WRITE(numout,*)
          WRITE(numout,9100)
          DO jk = 1, jpk
             WRITE(numout,9110) jk, ahm1(jk), fsdept(1,1,jk)
+         END DO
+         WRITE(numout,*)
+         WRITE(numout,*) '         ahm profile (bilaplacian): '
+         WRITE(numout,*)
+         WRITE(numout,9100)
+         DO jk = 1, jpk
+            WRITE(numout,9110) jk, ahm2(jk), fsdept(1,1,jk)
          END DO
       ENDIF
Index: trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c2d.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c2d.h90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c2d.h90	(revision 2528)
@@ -7,7 +7,7 @@
 
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -27,7 +27,7 @@
       !!           iso-model level : ahm3, ahm4 not used
       !!
-      !!       biharmonic operator : ahm1 is defined at u-point
-      !!                             ahm2 is defined at v-point
-      !!                           : ahm3, ahm4 not used
+      !!       biharmonic operator : ahm3 is defined at u-point
+      !!                             ahm4 is defined at v-point
+      !!                           : ahm1, ahm2 not used
       !!
       !!----------------------------------------------------------------------
@@ -74,7 +74,8 @@
          ENDIF
 
-         ! Special case for ORCA R2 and R4 configurations (overwrite the value of ahm1 ahm2)
+         ! Special case for ORCA R1, R2 and R4 configurations (overwrite the value of ahm1 ahm2)
          ! ==============================================
          IF( cp_cfg == "orca" .AND. ( jp_cfg == 2 .OR. jp_cfg == 4 ) )   CALL ldf_dyn_c2d_orca( ld_print )
+         IF( cp_cfg == "orca" .AND.   jp_cfg == 1)                       CALL ldf_dyn_c2d_orca_R1( ld_print )
 
          ! Control print
@@ -102,5 +103,5 @@
          IF(lwp) WRITE(numout,*) '              maximum grid-spacing = ', zd_max, ' maximum value for ahm = ', ahm0
 
-         za00 = ahm0 / ( zd_max * zd_max * zd_max )
+         za00 = ahm0_blp / ( zd_max * zd_max * zd_max )
          DO jj = 1, jpj
             DO ji = 1, jpi
@@ -288,2 +289,171 @@
 
    END SUBROUTINE ldf_dyn_c2d_orca
+
+   SUBROUTINE ldf_dyn_c2d_orca_R1( ld_print )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE ldf_dyn_c2d  ***
+      !!
+      !!                   **** W A R N I N G ****
+      !!
+      !!                ORCA R1 configuration
+      !!                  
+      !!                   **** W A R N I N G ****
+      !!                  
+      !! ** Purpose :   initializations of the lateral viscosity for orca R1
+      !!
+      !! ** Method  :   blah blah blah...
+      !!
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE ldftra_oce, ONLY : aht0
+
+      !! * Arguments
+      LOGICAL, INTENT (in) ::   ld_print   ! If true, output arrays on numout
+
+      !! * Local variables
+      INTEGER ::   ji, jj, jn      ! dummy loop indices
+      INTEGER ::   inum            ! temporary logical unit
+      INTEGER ::   iim, ijm
+      INTEGER ::   ifreq, il1, il2, ij, ii
+      INTEGER, DIMENSION(jpidta,jpidta) ::   idata
+      INTEGER, DIMENSION(jpi   ,jpj   ) ::   icof
+
+      REAL(wp) ::   zahmeq, zcoft, zcoff, zmsk, zam20s
+
+      CHARACTER (len=15) ::   clexp
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'inildf: 2d eddy viscosity coefficient'
+      IF(lwp) WRITE(numout,*) '~~~~~~  --'
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '        orca_r1 ocean model'
+      IF(lwp) WRITE(numout,*)
+
+#if defined key_antarctic
+#     include "ldfdyn_antarctic.h90"
+#elif defined key_arctic
+#     include "ldfdyn_arctic.h90"
+#else
+      ! Read 2d integer array to specify western boundary increase in the
+      ! ===================== equatorial strip (20N-20S) defined at t-points
+
+      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)
+
+
+      ! Set ahm1 and ahm2  ( T- and F- points) (used for laplacian operator)
+      ! =================
+      ! define ahm1 and ahm2 at the right grid point position
+      ! (USER: modify ahm1 and ahm2 following your desiderata)
+      
+      
+      ! Decrease ahm to zahmeq m2/s in the tropics
+      ! (from 90   to 20   degrees: ahm = scaled by local metrics
+      !  from 20   to  2.5 degrees: ahm = decrease in (1-cos)/2
+      !  from  2.5 to  0   degrees: ahm = constant
+      ! symmetric in the south hemisphere)
+
+      zahmeq = aht0
+      zam20s = ahm0*COS( rad * 20. )
+      
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( ABS( gphif(ji,jj) ) >= 20. ) THEN
+!              leave as set in ldf_dyn_c2d
+            ELSEIF( ABS( gphif(ji,jj) ) <= 2.5 ) THEN
+               ahm2(ji,jj) =  zahmeq
+            ELSE
+               ahm2(ji,jj) =  zahmeq + (zam20s-zahmeq)/2.   &
+                  * ( 1. - COS( rad * ( ABS(gphif(ji,jj))-2.5 ) * 180. / 17.5 ) )
+            ENDIF
+            IF( ABS( gphit(ji,jj) ) >= 20. ) THEN
+!             leave as set in ldf_dyn_c2d
+            ELSEIF( ABS( gphit(ji,jj) ) <= 2.5 ) THEN
+               ahm1(ji,jj) =  zahmeq
+            ELSE
+               ahm1(ji,jj) =  zahmeq + (zam20s-zahmeq)/2.   &
+                  * ( 1. - COS( rad * ( ABS(gphit(ji,jj))-2.5 ) * 180. / 17.5 ) )
+            ENDIF
+         END DO
+      END DO
+
+      ! increase along western boundaries of equatorial strip
+      ! t-point
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+          IF( ABS( gphit(ji,jj) ) < 20. ) THEN
+            zcoft = FLOAT( icof(ji,jj) ) / 100.
+            ahm1(ji,jj) = zcoft * ahm0 + (1.-zcoft) * ahm1(ji,jj) 
+          ENDIF
+         END DO
+      END DO
+      ! f-point
+      icof(:,:) = icof(:,:) * tmask(:,:,1)
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+          IF( ABS( gphif(ji,jj) ) < 20. ) THEN
+            zmsk = tmask(ji,jj+1,1) + tmask(ji+1,jj+1,1) + tmask(ji,jj,1) + tmask(ji,jj+1,1)
+            IF( zmsk == 0. ) THEN
+               zcoff = 1.
+            ELSE
+               zcoff = FLOAT( icof(ji,jj+1) + icof(ji+1,jj+1) + icof(ji,jj) + icof(ji,jj+1) )   &
+                     / (zmsk * 100.)
+            ENDIF
+            ahm2(ji,jj) = zcoff * ahm0 + (1.-zcoff) * ahm2(ji,jj)
+          ENDIF
+         END DO
+      END DO
+#endif
+      
+      ! Lateral boundary conditions on ( ahm1, ahm2 )
+      !                                ==============
+      CALL lbc_lnk( ahm1, 'T', 1. )   ! T-point, unchanged sign
+      CALL lbc_lnk( ahm2, 'F', 1. )   ! F-point, unchanged sign
+
+      ! Control print
+      IF( lwp .AND. ld_print ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: 2D ahm1 array'
+         CALL prihre(ahm1,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: 2D ahm2 array'
+         CALL prihre(ahm2,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+      ENDIF
+
+   END SUBROUTINE ldf_dyn_c2d_orca_R1
Index: trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c3d.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c3d.h90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c3d.h90	(revision 2528)
@@ -4,7 +4,7 @@
 
    !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -26,11 +26,8 @@
       !!       ??? explanation of the default is missing
       !!----------------------------------------------------------------------
-      !! * Modules used
       USE ldftra_oce, ONLY : aht0
-
-      !! * Arguments
+      !!
       LOGICAL, INTENT (in) :: ld_print   ! If true, output arrays on numout
-
-      !! * local variables
+      !!
       INTEGER  ::   ji, jj, jk      ! dummy loop indices
       REAL(wp) ::   &
@@ -86,10 +83,10 @@
 
 
-         ! Special case for ORCA R2 and R4 configurations (overwrite the value of ahm1 ahm2)
+         ! Special case for ORCA R1, R2 and R4 configurations (overwrite the value of ahm1 ahm2)
          ! ==============================================
-         IF( cp_cfg == "orca" .AND. ( jp_cfg == 2 .OR. jp_cfg == 4 ) ) THEN
+         IF( cp_cfg == "orca" .AND. ( jp_cfg == 1 .OR. jp_cfg == 2 .OR. jp_cfg == 4 ) ) THEN 
             IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) '              ORCA R2 or R4: overwrite the previous definition of ahm'
-            IF(lwp) WRITE(numout,*) '              ============='
+            IF(lwp) WRITE(numout,*) '              ORCA R1, R2 or R4: overwrite the previous definition of ahm'
+            IF(lwp) WRITE(numout,*) '              ================='
             CALL ldf_dyn_c3d_orca( ld_print )
          ENDIF
@@ -122,5 +119,5 @@
          IF(lwp) WRITE(numout,*) '              maximum grid-spacing = ', zd_max, ' maximum value for ahm = ', ahm0
 
-         za00 = ahm0 / ( zd_max * zd_max * zd_max )
+         za00 = ahm0_blp / ( zd_max * zd_max * zd_max )
          DO jj = 1, jpj
             DO ji = 1, jpi
@@ -148,9 +145,5 @@
             END DO
          ELSE                            ! partial steps or s-ccordinate
-# if defined key_zco
-            zc = gdept_0(jpkm1)
-# else
             zc = MAXVAL( fsdept(:,:,jpkm1) )
-# endif
             IF( lk_mpp )   CALL mpp_max( zc )   ! max over the global domain
 
@@ -196,15 +189,12 @@
       !!                  ***  ROUTINE ldf_dyn_c3d  ***
       !!                   
-      !! ** Purpose :   ORCA R2 an R4 only
+      !! ** Purpose :   ORCA R1, R2 and R4 only
       !!
       !! ** Method  :   blah blah blah ....
       !!----------------------------------------------------------------------
-      !! * Modules used
       USE ldftra_oce, ONLY : aht0
-
-      !! * Arguments
+      !!
       LOGICAL, INTENT (in) :: ld_print   ! If true, output arrays on numout
-
-      !! * local variables
+      !!
       INTEGER ::   ji, jj, jk, jn      ! dummy loop indices
       INTEGER ::   ii0, ii1, ij0, ij1  ! temporary integers
@@ -228,5 +218,5 @@
       IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~'
       IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) '        orca R2 or R4 ocean model'
+      IF(lwp) WRITE(numout,*) '        orca R1, R2 or R4 ocean model'
       IF(lwp) WRITE(numout,*) '  reduced in the surface Eq. strip '
       IF(lwp) WRITE(numout,*)
@@ -318,4 +308,10 @@
       ENDIF
 
+      IF( jp_cfg == 1 )   THEN
+         zahmeq     = aht0  ! reduced to aht0 on equator; set to ahm0 if no tropical reduction is required
+         zahmm      = ahm0
+         zahm0(:,:) = ahm0
+      ENDIF
+
       DO jj = 1, jpj
          DO ji = 1, jpi
@@ -363,37 +359,38 @@
 
       ! other level: re-increase the coef in the deep ocean
-      
-#if defined key_orca_lev10
-      DO jk = 1, 210
-         zcoef(jk) = 1.
-      END DO
-      DO jk= 211, 230
-         zcoef(jk) = 1. + 0.1 * FLOAT(jk-210)
-      END DO
-      DO jk= 231, 260
-         zcoef(jk) = 3. + 0.2 * FLOAT(jk-230)
-      END DO
-      DO jk= 261, 270
-         zcoef(jk) = 9. + 0.1 * FLOAT(jk-260)
-      END DO
-      DO jk= 271, jpk
-         zcoef(jk) = 10.
-      END DO
-      DO jk= 1, jpk
-         IF(lwp) WRITE(numout,*) 'k= ',jk, 'cof ', zcoef(jk)
-      END DO
-#else
-       DO jk = 1, 21
-         zcoef(jk) = 1.
-      END DO
-      zcoef(22) = 2.
-      zcoef(23) = 3.
-      zcoef(24) = 5.
-      zcoef(25) = 7.
-      zcoef(26) = 9.
-      DO jk = 27, jpk
-         zcoef(jk) = 10.
-      END DO
-#endif
+      !==================================================================
+      ! Prior to v3.3, zcoeff was hardwired according to k-index jk.
+      !
+      ! From v3.3 onwards this has been generalised to a function of 
+      ! depth so that it can be used with any number of levels.
+      !
+      ! The function has been chosen to match the original values (shown
+      ! in the following comments) when using the standard 31 ORCA levels.  
+      !     DO jk = 1, 21
+      !        zcoef(jk) = 1._wp
+      !     END DO
+      !     zcoef(22) = 2._wp
+      !     zcoef(23) = 3._wp
+      !     zcoef(24) = 5._wp
+      !     zcoef(25) = 7._wp
+      !     zcoef(26) = 9._wp
+      !     DO jk = 27, jpk
+      !        zcoef(jk) = 10._wp
+      !     END DO
+      !==================================================================
+
+       IF(lwp) THEN
+          WRITE(numout,*)
+          WRITE(numout,*) '         1D zcoef array '
+          WRITE(numout,*) '         ~~~~~~~~~~~~~~ '
+          WRITE(numout,*)
+          WRITE(numout,*) '    jk        zcoef '
+       ENDIF
+
+      DO jk=1, jpk
+         zcoef(jk) = 1.0_wp + NINT(9.0_wp*(gdept_0(jk)-800.0_wp)/(3000.0_wp-800.0_wp))
+         zcoef(jk) = MIN(10.0_wp, MAX(1.0_wp, zcoef(jk)))
+         IF(lwp) WRITE(numout,'(4x,i3,6x,f7.3)') jk,zcoef(jk)
+      END DO
 
       DO jk = 2, jpk
@@ -402,22 +399,17 @@
       END DO
 
-      IF( jp_cfg == 4 )   THEN
-         ! Limit AHM in Gibraltar strait
+      IF( jp_cfg == 4 )   THEN         ! Limit AHM in Gibraltar strait
          ij0 = 50   ;   ij1 = 53
          ii0 = 69   ;   ii1 = 71
          DO jk = 1, jpk
-            ahm1(mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , jk) = min( zahmm, ahm1 (mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , jk) ) 
-            ahm2(mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , jk) = min( zahmm, ahm2 (mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , jk) )
-         END DO
-      ENDIF
-      
-      ! Lateral boundary conditions on ( ahm1, ahm2 )
-      !                                ==============
-      CALL lbc_lnk( ahm1, 'T', 1. )   ! T-point, unchanged sign
-      CALL lbc_lnk( ahm2, 'F', 1. )   ! F-point, unchanged sign
-
-      ! Control print
-
-      IF(lwp) THEN
+            ahm1(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),jk) = MIN( zahmm, ahm1(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),jk) ) 
+            ahm2(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),jk) = MIN( zahmm, ahm2(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),jk) )
+         END DO
+      ENDIF
+      CALL lbc_lnk( ahm1, 'T', 1. )   ! Lateral boundary conditions (unchanged sign)
+      CALL lbc_lnk( ahm2, 'F', 1. )
+
+
+      IF(lwp) THEN                    ! Control print
          WRITE(numout,*)
          WRITE(numout,*) '         3D ahm1 array (k=1)'
@@ -451,8 +443,6 @@
       ahm4 ( :, 1, :) = ahm4 ( :, 2, :)
       
-      ! Lateral boundary conditions on ( ahm3, ahm4 )
-      !                                ==============
-      CALL lbc_lnk( ahm3, 'U', 1. )   ! U-point, unchanged sign
-      CALL lbc_lnk( ahm4, 'V', 1. )   ! V-point, unchanged sign
+      CALL lbc_lnk( ahm3, 'U', 1. )    ! Lateral boundary conditions (unchanged sign)
+      CALL lbc_lnk( ahm4, 'V', 1. )
 
       ! Control print
Index: trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_oce.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_oce.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_oce.F90	(revision 2528)
@@ -17,8 +17,8 @@
    LOGICAL , PUBLIC ::   ln_dynldf_hor   = .TRUE.      !: horizontal (geopotential) direction
    LOGICAL , PUBLIC ::   ln_dynldf_iso   = .FALSE.     !: iso-neutral direction
-   REAL(wp), PUBLIC ::   rn_ahm_0        = 40000._wp   !: lateral eddy viscosity (m2/s)
-   REAL(wp), PUBLIC ::   rn_ahmb_0       =     0._wp   !: lateral background eddy viscosity (m2/s)
-
-   REAL(wp), PUBLIC ::   ahm0, ahmb0                 ! OLD namelist names
+   REAL(wp), PUBLIC ::   rn_ahm_0_lap    = 40000._wp   !: lateral laplacian eddy viscosity (m2/s)
+   REAL(wp), PUBLIC ::   rn_ahmb_0       =     0._wp   !: lateral laplacian background eddy viscosity (m2/s)
+   REAL(wp), PUBLIC ::   rn_ahm_0_blp    =     0._wp   !: lateral bilaplacian eddy viscosity (m4/s)
+   REAL(wp), PUBLIC ::   ahm0, ahmb0, ahm0_blp         ! OLD namelist names
 
 #if defined key_dynldf_c3d
@@ -33,7 +33,7 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!======================================================================
 END MODULE ldfdyn_oce
Index: trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_substitute.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_substitute.h90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_substitute.h90	(revision 2528)
@@ -6,8 +6,12 @@
    !!----------------------------------------------------------------------
    !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
+   !!
+   !! fsahmt, fsahmf - used for laplaian operator only
+   !! fsahmu, fsahmv - used for bilaplacian operator only
+   !!
 #if defined key_dynldf_c3d
 !   ' key_dynldf_c3d' :                  3D coefficient
@@ -26,11 +30,11 @@
 #  define   fsahmt(i,j,k)    ahm1(k)
 #  define   fsahmf(i,j,k)    ahm1(k)
-#  define   fsahmu(i,j,k)    ahm1(k)
-#  define   fsahmv(i,j,k)    ahm1(k)
+#  define   fsahmu(i,j,k)    ahm2(k)
+#  define   fsahmv(i,j,k)    ahm2(k)
 #else
 !   default option :               Constant coefficient
 #  define   fsahmt(i,j,k)   ahm0
 #  define   fsahmf(i,j,k)   ahm0
-#  define   fsahmu(i,j,k)   ahm0
-#  define   fsahmv(i,j,k)   ahm0
+#  define   fsahmu(i,j,k)   ahm0_blp
+#  define   fsahmv(i,j,k)   ahm0_blp
 #endif
Index: trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfeiv.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfeiv.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfeiv.F90	(revision 2528)
@@ -4,4 +4,7 @@
    !! Ocean physics:  variable eddy induced velocity coefficients
    !!======================================================================
+   !! History :  OPA  ! 1999-03  (G. Madec, A. Jouzeau)  Original code
+   !!   NEMO     1.0  ! 2002-06  (G. Madec)  Free form, F90
+   !!----------------------------------------------------------------------
 #if   defined key_traldf_eiv   &&   defined key_traldf_c2d
    !!----------------------------------------------------------------------
@@ -11,5 +14,4 @@
    !!   ldf_eiv      : compute the eddy induced velocity coefficients
    !!----------------------------------------------------------------------
-   !! * Modules used
    USE oce             ! ocean dynamics and tracers
    USE dom_oce         ! ocean space and time domain
@@ -22,21 +24,19 @@
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
    USE prtctl          ! Print control
-   USE iom
+   USE iom             ! I/O library
 
    IMPLICIT NONE
    PRIVATE
    
-   !! * Routine accessibility
-   PUBLIC ldf_eiv               ! routine called by step.F90
-   !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
+   PUBLIC   ldf_eiv    ! routine called by step.F90
+   
    !! * Substitutions
 #  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
@@ -46,27 +46,16 @@
       !!
       !! ** Purpose :   Compute the eddy induced velocity coefficient from the
-      !!      growth rate of baroclinic instability.
+      !!              growth rate of baroclinic instability.
       !!
       !! ** Method :
       !!
-      !! ** Action : - uslp(),  : i- and j-slopes of neutral surfaces
-      !!             - vslp()      at u- and v-points, resp.
-      !!             - wslpi(),  : i- and j-slopes of neutral surfaces
-      !!             - wslpj()     at w-points. 
-      !!
-      !! History :
-      !!   8.1  !  99-03  (G. Madec, A. Jouzeau)  Original code
-      !!   8.5  !  02-06  (G. Madec)  Free form, F90
+      !! ** Action : - uslp , vslp  : i- and j-slopes of neutral surfaces at u- & v-points
+      !!             - wslpi, wslpj : i- and j-slopes of neutral surfaces at w-points. 
       !!----------------------------------------------------------------------
-      !! * Arguments
-      INTEGER, INTENT( in ) ::   kt     ! ocean time-step inedx
-      
-      !! * Local declarations
-      INTEGER ::   ji, jj, jk           ! dummy loop indices
-      REAL(wp) ::   &
-         zfw, ze3w, zn2, zf20,       &  ! temporary scalars
-         zaht, zaht_min
-      REAL(wp), DIMENSION(jpi,jpj) ::   &
-         zn, zah, zhw, zross            ! workspace
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step inedx
+      !!
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zfw, ze3w, zn2, zf20, zaht, zaht_min      ! temporary scalars
+      REAL(wp), DIMENSION(jpi,jpj) ::   zn, zah, zhw, zross   ! 2D workspace
       !!----------------------------------------------------------------------
       
@@ -79,54 +68,87 @@
       ! 0. Local initialization
       ! -----------------------
-      zn   (:,:) = 0.e0
-      zhw  (:,:) = 5.e0
-      zah  (:,:) = 0.e0
-      zross(:,:) = 0.e0
+      zn   (:,:) = 0._wp
+      zhw  (:,:) = 5._wp
+      zah  (:,:) = 0._wp
+      zross(:,:) = 0._wp
 
 
       ! 1. Compute lateral diffusive coefficient 
       ! ----------------------------------------
-
-      DO jk = 1, jpk
+      IF( ln_traldf_grif ) THEN
+         DO jk = 1, jpk
 #  if defined key_vectopt_loop  
 !CDIR NOVERRCHK 
-         DO ji = 1, jpij   ! vector opt.
-            ! Take the max of N^2 and zero then take the vertical sum
-            ! of the square root of the resulting N^2 ( required to compute
-            ! internal Rossby radius Ro = .5 * sum_jpk(N) / f
-            zn2 = MAX( rn2b(ji,1,jk), 0.e0 )
-            zn(ji,1) = zn(ji,1) + SQRT( zn2 ) * fse3w(ji,1,jk)
-            ! Compute elements required for the inverse time scale of baroclinic
-            ! eddies using the isopycnal slopes calculated in ldfslp.F :
-            ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w))
-            ze3w = fse3w(ji,1,jk) * tmask(ji,1,jk)
-               zah(ji,1) = zah(ji,1) + zn2   &
-                              * ( wslpi(ji,1,jk) * wslpi(ji,1,jk)    &
-                                + wslpj(ji,1,jk) * wslpj(ji,1,jk) )   &
-                              * ze3w
-            zhw(ji,1) = zhw(ji,1) + ze3w
-         END DO
+            DO ji = 1, jpij   ! vector opt.
+               ! Take the max of N^2 and zero then take the vertical sum
+               ! of the square root of the resulting N^2 ( required to compute
+               ! internal Rossby radius Ro = .5 * sum_jpk(N) / f
+               zn2 = MAX( rn2b(ji,1,jk), 0._wp )
+               zn(ji,1) = zn(ji,1) + SQRT( zn2 ) * fse3w(ji,1,jk)
+               ! Compute elements required for the inverse time scale of baroclinic
+               ! eddies using the isopycnal slopes calculated in ldfslp.F :
+               ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w))
+               ze3w = fse3w(ji,1,jk) * tmask(ji,1,jk)
+               zah(ji,1) = zah(ji,1) + zn2 * wslp2(ji,1,jk) * ze3w
+               zhw(ji,1) = zhw(ji,1) + ze3w
+            END DO
 #  else
-         DO jj = 2, jpjm1
-!CDIR NOVERRCHK 
-            DO ji = 2, jpim1
-               ! Take the max of N^2 and zero then take the vertical sum 
-               ! of the square root of the resulting N^2 ( required to compute 
-               ! internal Rossby radius Ro = .5 * sum_jpk(N) / f 
-               zn2 = MAX( rn2b(ji,jj,jk), 0.e0 )
-               zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * fse3w(ji,jj,jk)
+            DO jj = 2, jpjm1
+!CDIR NOVERRCHK 
+               DO ji = 2, jpim1
+                  ! Take the max of N^2 and zero then take the vertical sum 
+                  ! of the square root of the resulting N^2 ( required to compute 
+                  ! internal Rossby radius Ro = .5 * sum_jpk(N) / f 
+                  zn2 = MAX( rn2b(ji,jj,jk), 0._wp )
+                  zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * fse3w(ji,jj,jk)
+                  ! Compute elements required for the inverse time scale of baroclinic
+                  ! eddies using the isopycnal slopes calculated in ldfslp.F : 
+                  ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w))
+                  ze3w = fse3w(ji,jj,jk) * tmask(ji,jj,jk)
+                  zah(ji,jj) = zah(ji,jj) + zn2 * wslp2(ji,jj,jk) * ze3w
+                  zhw(ji,jj) = zhw(ji,jj) + ze3w
+               END DO
+            END DO
+#  endif
+         END DO
+      ELSE
+         DO jk = 1, jpk
+#  if defined key_vectopt_loop  
+!CDIR NOVERRCHK 
+            DO ji = 1, jpij   ! vector opt.
+               ! Take the max of N^2 and zero then take the vertical sum
+               ! of the square root of the resulting N^2 ( required to compute
+               ! internal Rossby radius Ro = .5 * sum_jpk(N) / f
+               zn2 = MAX( rn2b(ji,1,jk), 0._wp )
+               zn(ji,1) = zn(ji,1) + SQRT( zn2 ) * fse3w(ji,1,jk)
                ! Compute elements required for the inverse time scale of baroclinic
-               ! eddies using the isopycnal slopes calculated in ldfslp.F : 
+               ! eddies using the isopycnal slopes calculated in ldfslp.F :
                ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w))
-               ze3w = fse3w(ji,jj,jk) * tmask(ji,jj,jk)
-               zah(ji,jj) = zah(ji,jj) + zn2   &
-                              * ( wslpi(ji,jj,jk) * wslpi(ji,jj,jk)    &
-                                + wslpj(ji,jj,jk) * wslpj(ji,jj,jk) )  &
-                              * ze3w
-               zhw(ji,jj) = zhw(ji,jj) + ze3w
-            END DO 
-         END DO 
+               ze3w = fse3w(ji,1,jk) * tmask(ji,1,jk)
+               zah(ji,1) = zah(ji,1) + zn2 * ( wslpi(ji,1,jk) * wslpi(ji,1,jk)   &
+                  &                          + wslpj(ji,1,jk) * wslpj(ji,1,jk) ) * ze3w
+               zhw(ji,1) = zhw(ji,1) + ze3w
+            END DO
+#  else
+            DO jj = 2, jpjm1
+!CDIR NOVERRCHK 
+               DO ji = 2, jpim1
+                  ! Take the max of N^2 and zero then take the vertical sum 
+                  ! of the square root of the resulting N^2 ( required to compute 
+                  ! internal Rossby radius Ro = .5 * sum_jpk(N) / f 
+                  zn2 = MAX( rn2b(ji,jj,jk), 0._wp )
+                  zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * fse3w(ji,jj,jk)
+                  ! Compute elements required for the inverse time scale of baroclinic
+                  ! eddies using the isopycnal slopes calculated in ldfslp.F : 
+                  ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w))
+                  ze3w = fse3w(ji,jj,jk) * tmask(ji,jj,jk)
+                  zah(ji,jj) = zah(ji,jj) + zn2 * ( wslpi(ji,jj,jk) * wslpi(ji,jj,jk)   &
+                     &                            + wslpj(ji,jj,jk) * wslpj(ji,jj,jk) ) * ze3w
+                  zhw(ji,jj) = zhw(ji,jj) + ze3w
+               END DO
+            END DO
 #  endif
-      END DO 
+         END DO
+      END IF
 
       DO jj = 2, jpjm1
@@ -141,11 +163,10 @@
       END DO
 
-      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN   ! ORCA R02
+      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN   ! ORCA R2
          DO jj = 2, jpjm1
 !CDIR NOVERRCHK 
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               ! Take the minimum between aeiw and aeiv0 for depth levels
-               ! lower than 20 (21 in w- point)
-               IF( mbathy(ji,jj) <= 21. ) aeiw(ji,jj) = MIN( aeiw(ji,jj), 1000. )
+               ! Take the minimum between aeiw and 1000 m2/s over shelves (depth shallower than 650 m)
+               IF( mbkt(ji,jj) <= 20 )   aeiw(ji,jj) = MIN( aeiw(ji,jj), 1000. )
             END DO
          END DO
@@ -153,5 +174,5 @@
 
       ! Decrease the coefficient in the tropics (20N-20S) 
-      zf20 = 2. * omega * sin( rad * 20. )
+      zf20 = 2._wp * omega * sin( rad * 20._wp )
       DO jj = 2, jpjm1
          DO ji = fs_2, fs_jpim1   ! vector opt.
@@ -168,21 +189,18 @@
          END DO
       ENDIF
-
-      ! lateral boundary condition on aeiw 
-      CALL lbc_lnk( aeiw, 'W', 1. )
+      CALL lbc_lnk( aeiw, 'W', 1. )      ! lateral boundary condition on aeiw 
+
 
       ! Average the diffusive coefficient at u- v- points 
       DO jj = 2, jpjm1
          DO ji = fs_2, fs_jpim1   ! vector opt.
-            aeiu(ji,jj) = .5 * ( aeiw(ji,jj) + aeiw(ji+1,jj  ) )
-            aeiv(ji,jj) = .5 * ( aeiw(ji,jj) + aeiw(ji  ,jj+1) )
+            aeiu(ji,jj) = 0.5_wp * ( aeiw(ji,jj) + aeiw(ji+1,jj  ) )
+            aeiv(ji,jj) = 0.5_wp * ( aeiw(ji,jj) + aeiw(ji  ,jj+1) )
          END DO 
       END DO 
-
-      ! lateral boundary condition on aeiu, aeiv
-      CALL lbc_lnk( aeiu, 'U', 1. )
-      CALL lbc_lnk( aeiv, 'V', 1. )
-
-      IF(ln_ctl)   THEN
+      CALL lbc_lnk( aeiu, 'U', 1. )   ;   CALL lbc_lnk( aeiv, 'V', 1. )      ! lateral boundary condition
+
+
+      IF(ln_ctl) THEN
          CALL prt_ctl(tab2d_1=aeiu, clinfo1=' eiv  - u: ', ovlap=1)
          CALL prt_ctl(tab2d_1=aeiv, clinfo1=' eiv  - v: ', ovlap=1)
@@ -191,9 +209,9 @@
       ! ORCA R05: add a space variation on aht (=aeiv except at the equator and river mouth)
       IF( cp_cfg == "orca" .AND. jp_cfg == 05 ) THEN
-         zf20     = 2. * omega * SIN( rad * 20. )
-         zaht_min = 100.                              ! minimum value for aht
+         zf20     = 2._wp * omega * SIN( rad * 20._wp )
+         zaht_min = 100._wp                           ! minimum value for aht
          DO jj = 1, jpj
             DO ji = 1, jpi
-               zaht      = ( 1. -  MIN( 1., ABS( ff(ji,jj) / zf20 ) ) ) * ( aht0 - zaht_min )  &
+               zaht      = ( 1._wp -  MIN( 1._wp , ABS( ff(ji,jj) / zf20 ) ) ) * ( aht0 - zaht_min )  &
                   &      + aht0 * rnfmsk(ji,jj)                          ! enhanced near river mouths
                ahtu(ji,jj) = MAX( MAX( zaht_min, aeiu(ji,jj) ) + zaht, aht0 )
@@ -209,13 +227,13 @@
       ENDIF
 
-      IF( aeiv0 == 0.e0 ) THEN
-         aeiu(:,:) = 0.e0
-         aeiv(:,:) = 0.e0
-         aeiw(:,:) = 0.e0
+      IF( aeiv0 == 0._wp ) THEN
+         aeiu(:,:) = 0._wp
+         aeiv(:,:) = 0._wp
+         aeiw(:,:) = 0._wp
       ENDIF
 
       CALL iom_put( "aht2d"    , ahtw )   ! lateral eddy diffusivity
       CALL iom_put( "aht2d_eiv", aeiw )   ! EIV lateral eddy diffusivity
-
+      !
    END SUBROUTINE ldf_eiv
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfeiv_substitute.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfeiv_substitute.h90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfeiv_substitute.h90	(revision 2528)
@@ -7,7 +7,7 @@
    !!----------------------------------------------------------------------
    !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 #  if defined key_traldf_c3d
Index: trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90	(revision 2528)
@@ -7,7 +7,8 @@
    !!            8.0  ! 1997-06  (G. Madec)  optimization, lbc
    !!            8.1  ! 1999-10  (A. Jouzeau)  NEW profile in the mixed layer
-   !!   NEMO     0.5  ! 2002-10  (G. Madec)  Free form, F90
-   !!            1.0  ! 2005-10  (A. Beckmann)  correction for s-coordinates
-   !!            3.2  ! 2010-11  (F. Dupond, G. Madec)  bug correction in slopes just below the ML
+   !!   NEMO     1.0  ! 2002-10  (G. Madec)  Free form, F90
+   !!             -   ! 2005-10  (A. Beckmann)  correction for s-coordinates
+   !!            3.3  ! 2010-10  (G. Nurser, C. Harris, G. Madec)  add Griffies operator
+   !!             -   ! 2010-11  (F. Dupond, G. Madec)  bug correction in slopes just below the ML
    !!----------------------------------------------------------------------
 #if   defined key_ldfslp   ||   defined key_esopa
@@ -15,14 +16,16 @@
    !!   'key_ldfslp'                      Rotation of lateral mixing tensor
    !!----------------------------------------------------------------------
-   !!   ldf_slp      : compute the slopes of iso-neutral surface
-   !!   ldf_slp_mxl  : compute the slopes of iso-neutral surface just below the Mixed Layer
+   !!   ldf_slp_grif : calculates the triads of isoneutral slopes (Griffies operator)
+   !!   ldf_slp      : calculates the slopes of neutral surface   (Madec operator)
+   !!   ldf_slp_mxl  : calculates the slopes at the base of the mixed layer (Madec operator)
    !!   ldf_slp_init : initialization of the slopes computation
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and tracers
    USE dom_oce         ! ocean space and time domain
-   USE ldftra_oce
-   USE ldfdyn_oce
+   USE ldftra_oce      ! lateral diffusion: traceur
+   USE ldfdyn_oce      ! lateral diffusion: dynamics
    USE phycst          ! physical constants
    USE zdfmxl          ! mixed layer depth
+   USE eosbn2          ! equation of states
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
    USE in_out_manager  ! I/O manager
@@ -32,23 +35,34 @@
    PRIVATE
 
-   PUBLIC   ldf_slp    ! routine called by step.F90
-
-   LOGICAL , PUBLIC, PARAMETER              ::   lk_ldfslp = .TRUE.   !: slopes flag
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   uslp, wslpi          !: i_slope at U- and W-points
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   vslp, wslpj          !: j-slope at V- and W-points
-   
-   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   omlmask           ! mask of the surface mixed layer at T-pt
-   REAL(wp), DIMENSION(jpi,jpj)     ::   uslpml, wslpiml   ! i_slope at U- and W-points just below the mixed layer
-   REAL(wp), DIMENSION(jpi,jpj)     ::   vslpml, wslpjml   ! j_slope at V- and W-points just below the mixed layer
+   PUBLIC   ldf_slp        ! routine called by step.F90
+   PUBLIC   ldf_slp_grif   ! routine called by step.F90
+   PUBLIC   ldf_slp_init   ! routine called by opa.F90
+
+   LOGICAL , PUBLIC, PARAMETER ::   lk_ldfslp = .TRUE.     !: slopes flag
+   !                                                                             !! Madec operator
+   REAL(wp), PUBLIC, DIMENSION(:,:,:)    , ALLOCATABLE ::   uslp, wslpi          !: i_slope at U- and W-points
+   REAL(wp), PUBLIC, DIMENSION(:,:,:)    , ALLOCATABLE ::   vslp, wslpj          !: j-slope at V- and W-points
+   !                                                                             !! Griffies operator
+   REAL(wp), PUBLIC, DIMENSION(:,:,:)    , ALLOCATABLE ::   wslp2                !: wslp**2 from Griffies quarter cells
+   REAL(wp), PUBLIC, DIMENSION(:,:,:,:,:), ALLOCATABLE ::   triadi_g, triadj_g   !: skew flux  slopes relative to geopotentials 
+   REAL(wp), PUBLIC, DIMENSION(:,:,:,:,:), ALLOCATABLE ::   triadi  , triadj     !: isoneutral slopes relative to model-coordinate
+
+   !                                                              !! Madec operator
+   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   omlmask           ! mask of the surface mixed layer at T-pt
+   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   uslpml, wslpiml   ! i_slope at U- and W-points just below the mixed layer
+   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   vslpml, wslpjml   ! j_slope at V- and W-points just below the mixed layer
+
+   REAL(wp) ::   repsln = 1.e-25_wp       ! tiny value used as minium of di(rho), dj(rho) and dk(rho)
 
    !! * Substitutions
 #  include "domzgr_substitute.h90"
+#  include "ldftra_substitute.h90"
+#  include "ldfeiv_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -58,5 +72,5 @@
       !! 
       !! ** Purpose :   Compute the slopes of neutral surface (slope of isopycnal
-      !!              surfaces referenced locally) ('key_traldfiso').
+      !!              surfaces referenced locally) (ln_traldf_iso=T).
       !! 
       !! ** Method  :   The slope in the i-direction is computed at U- and 
@@ -80,5 +94,5 @@
       USE oce , zgru  => ua   ! use ua as workspace
       USE oce , zgrv  => va   ! use va as workspace
-      USE oce , zwy   => ta   ! use ta as workspace
+      USE oce , zww   => ta   ! use ta as workspace
       USE oce , zwz   => sa   ! use sa as workspace
       !!
@@ -90,22 +104,20 @@
       INTEGER  ::   ii0, ii1, iku   ! temporary integer
       INTEGER  ::   ij0, ij1, ikv   ! temporary integer
-      REAL(wp) ::   zeps, zmg, zm05g, zalpha        ! temporary scalars
-      REAL(wp) ::   zcoef1, zcoef2, zcoef3          !    -         -
-      REAL(wp) ::   zcofu , zcofv , zcofw           !    -         -
-      REAL(wp) ::   zau, zbu, zai, zbi, z1u, z1wu   !    -         -
-      REAL(wp) ::   zav, zbv, zaj, zbj, z1v, z1wv   !
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zww     ! 3D workspace
+      REAL(wp) ::   zeps, zm1_g, zm1_2g, z1_16     ! local scalars
+      REAL(wp) ::   zci, zfi, zau, zbu, zai, zbi   !   -      -
+      REAL(wp) ::   zcj, zfj, zav, zbv, zaj, zbj   !   -      -
+      REAL(wp) ::   zck, zfk,      zbw             !   -      -
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdzr   ! 3D workspace
       !!----------------------------------------------------------------------
       
-      IF( kt == nit000 )   CALL ldf_slp_init      ! initialization (first time-step only)
-
-      zeps  =  1.e-20                             ! Local constant initialization
-      zmg   = -1.0 / grav
-      zm05g = -0.5 / grav
-      !
-      zww(:,:,:) = 0.e0
-      zwz(:,:,:) = 0.e0
-      !                                           ! horizontal density gradient computation
-      DO jk = 1, jpk
+      zeps   =  1.e-20_wp        !==   Local constant initialization   ==!
+      z1_16  =  1.0_wp / 16._wp
+      zm1_g  = -1.0_wp / grav
+      zm1_2g = -0.5_wp / grav
+      !
+      zww(:,:,:) = 0._wp
+      zwz(:,:,:) = 0._wp
+      !
+      DO jk = 1, jpk             !==   i- & j-gradient of density   ==!
          DO jj = 1, jpjm1
             DO ji = 1, fs_jpim1   ! vector opt.
@@ -123,23 +135,24 @@
             DO ji = 1, jpim1
 # endif
-               iku = MIN ( mbathy(ji,jj), mbathy(ji+1,jj) ) - 1               ! last ocean level
-               ikv = MIN ( mbathy(ji,jj), mbathy(ji,jj+1) ) - 1
-               zgru(ji,jj,iku) = gru(ji,jj) 
-               zgrv(ji,jj,ikv) = 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
-      
-
-      !                                           !* Local vertical density gradient evaluated from N^2
-      DO jk = 2, jpkm1                            !  zwy = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point
-         zwy(:,:,jk) = zmg * ( prd(:,:,jk) + 1. ) * (    pn2  (:,:,jk) + pn2  (:,:,jk+1)     )   &
-            &                                     / MAX( tmask(:,:,jk) + tmask(:,:,jk+1), 1. )
-      END DO
-      zwy(:,:,1) = 0.e0                           !  surface value set to zero
-
-      
-      CALL ldf_slp_mxl( prd, pn2 )                !* Slopes of isopycnal surfaces just below the mixed layer
-      
+      !
+      zdzr(:,:,1) = 0._wp        !==   Local vertical density gradient at T-point   == !   (evaluated from N^2)
+      DO jk = 2, jpkm1
+         !                                ! zdzr = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point
+         !                                !   trick: tmask(ik  )  = 0   =>   all pn2   = 0   =>   zdzr = 0
+         !                                !    else  tmask(ik+1)  = 0   =>   pn2(ik+1) = 0   =>   zdzr divides by 1
+         !                                !          umask(ik+1) /= 0   =>   all pn2  /= 0   =>   zdzr divides by 2
+         !                                ! NB: 1/(tmask+1) = (1-.5*tmask)  substitute a / by a *  ==> faster
+         zdzr(:,:,jk) = zm1_g * ( prd(:,:,jk) + 1._wp )              &
+            &                 * ( pn2(:,:,jk) + pn2(:,:,jk+1) ) * ( 1._wp - 0.5_wp * tmask(:,:,jk+1) )
+      END DO
+      !
+      !                          !==   Slopes just below the mixed layer   ==!
+      CALL ldf_slp_mxl( prd, pn2, zgru, zgrv, zdzr )        ! output: uslpml, vslpml, wslpiml, wslpjml
+
       
       ! I.  slopes at u and v point      | uslp = d/di( prd ) / d/dz( prd )
@@ -149,24 +162,33 @@
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               ! horizontal and vertical density gradient at u- and v-points
-               zau = 1. / e1u(ji,jj) * zgru(ji,jj,jk)
-               zav = 1. / e2v(ji,jj) * zgrv(ji,jj,jk)
-               zbu = 0.5 * ( zwy(ji,jj,jk) + zwy(ji+1,jj  ,jk) )
-               zbv = 0.5 * ( zwy(ji,jj,jk) + zwy(ji  ,jj+1,jk) )
-               ! bound the slopes: abs(zw.)<= 1/100 and zb..<0
-               !                   kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
-               zbu = MIN( zbu, -100.*ABS( zau ), -7.e+3/fse3u(ji,jj,jk)*ABS( zau ) )
-               zbv = MIN( zbv, -100.*ABS( zav ), -7.e+3/fse3v(ji,jj,jk)*ABS( zav ) )
-               ! uslp and vslp output in zwz and zww, resp.
-               zalpha = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) )
-               zwz (ji,jj,jk) = ( ( 1. - zalpha) * zau / ( zbu - zeps )                                           &
-                  &                    + zalpha  * uslpml(ji,jj)                                                  &
-                  &                              * 0.5 * ( fsdept(ji+1,jj,jk)+fsdept(ji,jj,jk)-fse3u(ji,jj,1) )   &
-                  &                              / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 5. ) ) * umask(ji,jj,jk)
-               zalpha = MAX( omlmask(ji,jj,jk), omlmask(ji,jj+1,jk) )
-               zww (ji,jj,jk) = ( ( 1. - zalpha) * zav / ( zbv - zeps )                                           &
-                  &                    + zalpha  * vslpml(ji,jj)                                                  &
-                  &                              * 0.5 * ( fsdept(ji,jj+1,jk)+fsdept(ji,jj,jk)-fse3v(ji,jj,1) )   &
-                  &                              / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 5. ) ) * vmask(ji,jj,jk)
+               !                                      ! horizontal and vertical density gradient at u- and v-points
+               zau = zgru(ji,jj,jk) / e1u(ji,jj)
+               zav = zgrv(ji,jj,jk) / e2v(ji,jj)
+               zbu = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(ji+1,jj  ,jk) )
+               zbv = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(ji  ,jj+1,jk) )
+               !                                      ! bound the slopes: abs(zw.)<= 1/100 and zb..<0
+               !                                      ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
+               zbu = MIN(  zbu, -100._wp* ABS( zau ) , -7.e+3_wp/fse3u(ji,jj,jk)* ABS( zau )  )
+               zbv = MIN(  zbv, -100._wp* ABS( zav ) , -7.e+3_wp/fse3v(ji,jj,jk)* ABS( zav )  )
+               !                                      ! uslp and vslp output in zwz and zww, resp.
+               zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) )
+               zfj = MAX( omlmask(ji,jj,jk), omlmask(ji,jj+1,jk) )
+               zwz(ji,jj,jk) = ( ( 1. - zfi) * zau / ( zbu - zeps )                                              &
+                  &                   + zfi  * uslpml(ji,jj)                                                     &
+                  &                          * 0.5_wp * ( fsdept(ji+1,jj,jk)+fsdept(ji,jj,jk)-fse3u(ji,jj,1) )   &
+                  &                          / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 5._wp ) ) * umask(ji,jj,jk)
+               zww(ji,jj,jk) = ( ( 1. - zfj) * zav / ( zbv - zeps )                                              &
+                  &                   + zfj  * vslpml(ji,jj)                                                     &
+                  &                          * 0.5_wp * ( fsdept(ji,jj+1,jk)+fsdept(ji,jj,jk)-fse3v(ji,jj,1) )   &
+                  &                          / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 5. ) ) * vmask(ji,jj,jk)
+!!gm  modif to suppress omlmask.... (as in Griffies case)
+!               !                                         ! jk must be >= ML level for zf=1. otherwise  zf=0.
+!               zfi = REAL( 1 - 1/(1 + jk / MAX( nmln(ji+1,jj), nmln(ji,jj) ) ), wp )
+!               zfj = REAL( 1 - 1/(1 + jk / MAX( nmln(ji,jj+1), nmln(ji,jj) ) ), wp )
+!               zci = 0.5 * ( fsdept(ji+1,jj,jk)+fsdept(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 10. ) )
+!               zcj = 0.5 * ( fsdept(ji,jj+1,jk)+fsdept(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 10. ) )
+!               zwz(ji,jj,jk) = ( zfi * zai / ( zbi - zeps ) + ( 1._wp - zfi ) * wslpiml(ji,jj) * zci ) * tmask(ji,jj,jk)
+!               zww(ji,jj,jk) = ( zfj * zaj / ( zbj - zeps ) + ( 1._wp - zfj ) * wslpjml(ji,jj) * zcj ) * tmask(ji,jj,jk)
+!!gm end modif
             END DO
          END DO
@@ -174,15 +196,14 @@
       CALL lbc_lnk( zwz, 'U', -1. )   ;   CALL lbc_lnk( zww, 'V', -1. )      ! lateral boundary conditions
       !
-      zcofu = 1. / 16.                            !* horizontal Shapiro filter
-      zcofv = 1. / 16.
+      !                                            !* horizontal Shapiro filter
       DO jk = 2, jpkm1
-         DO jj = 2, jpjm1, jpj-3                        ! rows jj=2 and =jpjm1 only
+         DO jj = 2, jpjm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only
             DO ji = 2, jpim1  
-               uslp(ji,jj,jk) = zcofu * (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)      &
+               uslp(ji,jj,jk) = z1_16 * (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)      &
                   &                       +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)      &
                   &                       + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)      &
                   &                       +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )    &
                   &                       + 4.*  zwz(ji  ,jj  ,jk)                       )
-               vslp(ji,jj,jk) = zcofv * (        zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)      &
+               vslp(ji,jj,jk) = z1_16 * (        zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)      &
                   &                       +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)      &
                   &                       + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)      &
@@ -193,10 +214,10 @@
          DO jj = 3, jpj-2                               ! other rows
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               uslp(ji,jj,jk) = zcofu * (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)      &
+               uslp(ji,jj,jk) = z1_16 * (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)      &
                   &                       +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)      &
                   &                       + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)      &
                   &                       +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )    &
                   &                       + 4.*  zwz(ji  ,jj  ,jk)                       )
-               vslp(ji,jj,jk) = zcofv * (        zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)      &
+               vslp(ji,jj,jk) = z1_16 * (        zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)      &
                   &                       +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)      &
                   &                       + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)      &
@@ -208,10 +229,8 @@
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               z1u  = ( umask(ji,jj+1,jk) + umask(ji,jj-1,jk) )*.5
-               z1v  = ( vmask(ji+1,jj,jk) + vmask(ji-1,jj,jk) )*.5
-               z1wu = ( umask(ji,jj,jk)   + umask(ji,jj,jk+1) )*.5
-               z1wv = ( vmask(ji,jj,jk)   + vmask(ji,jj,jk+1) )*.5
-               uslp(ji,jj,jk) = uslp(ji,jj,jk) * z1u * z1wu
-               vslp(ji,jj,jk) = vslp(ji,jj,jk) * z1v * z1wv
+               uslp(ji,jj,jk) = uslp(ji,jj,jk) * ( umask(ji,jj+1,jk) + umask(ji,jj-1,jk  ) ) * 0.5_wp   &
+                  &                            * ( umask(ji,jj  ,jk) + umask(ji,jj  ,jk+1) ) * 0.5_wp
+               vslp(ji,jj,jk) = vslp(ji,jj,jk) * ( vmask(ji+1,jj,jk) + vmask(ji-1,jj,jk  ) ) * 0.5_wp   &
+                  &                            * ( vmask(ji  ,jj,jk) + vmask(ji  ,jj,jk+1) ) * 0.5_wp
             END DO
          END DO
@@ -222,53 +241,50 @@
       ! ===========================      | wslpj = mij( d/dj( prd ) / d/dz( prd )
       !               
-      !                                           !* Local vertical density gradient evaluated from N^2
-      DO jk = 2, jpkm1                            !  zwy = d/dz(prd)= - mk ( prd ) / grav * pn2 -- at w point
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zwy(ji,jj,jk) = zm05g * pn2 (ji,jj,jk) * ( prd (ji,jj,jk) + prd (ji,jj,jk-1) + 2. )
-            END DO
-         END DO
-      END DO
-      DO jk = 2, jpkm1                            !* Slopes at w point
+      DO jk = 2, jpkm1
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               !                                        ! horizontal density i-gradient at w-points
-               zcoef1 = MAX( zeps, umask(ji-1,jj,jk  )+umask(ji,jj,jk  )    &
-                  &               +umask(ji-1,jj,jk-1)+umask(ji,jj,jk-1) )
-               zcoef1 = 1. / ( zcoef1 * e1t (ji,jj) )
-               zai = zcoef1 * (  zgru(ji  ,jj,jk  ) + zgru(ji  ,jj,jk-1)   &
-                  &            + zgru(ji-1,jj,jk-1) + zgru(ji-1,jj,jk  ) ) * tmask (ji,jj,jk)
-               !                                        ! horizontal density j-gradient at w-points
-               zcoef2 = MAX( zeps, vmask(ji,jj-1,jk  )+vmask(ji,jj,jk-1)   &
-                  &               +vmask(ji,jj-1,jk-1)+vmask(ji,jj,jk  ) )
-               zcoef2 = 1.0 / ( zcoef2 *  e2t (ji,jj) )
-               zaj = zcoef2 * (  zgrv(ji,jj  ,jk  ) + zgrv(ji,jj  ,jk-1)   &
-                  &            + zgrv(ji,jj-1,jk-1) + zgrv(ji,jj-1,jk  ) ) * tmask (ji,jj,jk)
+               !                                  !* Local vertical density gradient evaluated from N^2
+               zbw = zm1_2g * pn2 (ji,jj,jk) * ( prd (ji,jj,jk) + prd (ji,jj,jk-1) + 2. )
+               !                                  !* Slopes at w point
+               !                                        ! i- & j-gradient of density at w-points
+               zci = MAX(  umask(ji-1,jj,jk  ) + umask(ji,jj,jk  )           &
+                  &      + umask(ji-1,jj,jk-1) + umask(ji,jj,jk-1) , zeps  ) * e1t(ji,jj)
+               zcj = MAX(  vmask(ji,jj-1,jk  ) + vmask(ji,jj,jk-1)           &
+                  &      + vmask(ji,jj-1,jk-1) + vmask(ji,jj,jk  ) , zeps  ) *  e2t(ji,jj)
+               zai =    (  zgru (ji-1,jj,jk  ) + zgru (ji,jj,jk-1)           &
+                  &      + zgru (ji-1,jj,jk-1) + zgru (ji,jj,jk  )   ) / zci * tmask (ji,jj,jk)
+               zaj =    (  zgrv (ji,jj-1,jk  ) + zgrv (ji,jj,jk-1)           &
+                  &      + zgrv (ji,jj-1,jk-1) + zgrv (ji,jj,jk  )   ) / zcj * tmask (ji,jj,jk)
                !                                        ! bound the slopes: abs(zw.)<= 1/100 and zb..<0.
-               !                                        ! static instability: kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
-               zbi = MIN( zwy (ji,jj,jk),- 100.*ABS(zai), -7.e+3/fse3w(ji,jj,jk)*ABS(zai) )
-               zbj = MIN( zwy (ji,jj,jk), -100.*ABS(zaj), -7.e+3/fse3w(ji,jj,jk)*ABS(zaj) )
-               !                                        ! wslpi and wslpj output in zwz and zww, resp.
-               zalpha = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) )
-               zcoef3 = fsdepw(ji,jj,jk) / MAX( hmlp(ji,jj), 10. )
-               zwz(ji,jj,jk) = (     zai / ( zbi - zeps)  * ( 1. - zalpha )   &
-                  &             + zcoef3 * wslpiml(ji,jj) *        zalpha   ) * tmask (ji,jj,jk)
-               zww(ji,jj,jk) = (     zaj / ( zbj - zeps)  * ( 1. - zalpha )   &
-                  &             + zcoef3 * wslpjml(ji,jj) *        zalpha   ) * tmask (ji,jj,jk)
-            END DO
-         END DO
-      END DO
-      CALL lbc_lnk( zwz, 'T', -1. )   ;    CALL lbc_lnk( zww, 'T', -1. )      ! lateral boundary conditions on zwz and zww
+               !                                        ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
+               zbi = MIN( zbw ,- 100._wp* ABS( zai ) , -7.e+3_wp/fse3w(ji,jj,jk)* ABS( zai )  )
+               zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/fse3w(ji,jj,jk)* ABS( zaj )  )
+               !                                        ! wslpi and wslpj with ML flattening (output in zwz and zww, resp.)
+               zfk = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) )   ! zfk=1 in the ML otherwise zfk=0
+               zck = fsdepw(ji,jj,jk) / 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)
+               zww(ji,jj,jk) = (  zaj / ( zbj - zeps ) * ( 1._wp - zfk ) + zck * wslpjml(ji,jj) * zfk  ) * tmask(ji,jj,jk)
+
+!!gm  modif to suppress omlmask....  (as in Griffies operator)
+!               !                                         ! jk must be >= ML level for zfk=1. otherwise  zfk=0.
+!               zfk = REAL( 1 - 1/(1 + jk / nmln(ji+1,jj)), wp )
+!               zck = fsdepw(ji,jj,jk)    / MAX( hmlp(ji,jj), 10. )
+!               zwz(ji,jj,jk) = ( zfk * zai / ( zbi - zeps ) + ( 1._wp - zfk ) * wslpiml(ji,jj) * zck ) * tmask(ji,jj,jk)
+!               zww(ji,jj,jk) = ( zfk * zaj / ( zbj - zeps ) + ( 1._wp - zfk ) * wslpjml(ji,jj) * zck ) * tmask(ji,jj,jk)
+!!gm end modif
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( zwz, 'T', -1. )   ;    CALL lbc_lnk( zww, 'T', -1. )      ! lateral boundary conditions
       !
       !                                           !* horizontal Shapiro filter
       DO jk = 2, jpkm1
-         DO jj = 2, jpjm1, jpj-3                        ! rows jj=2 and =jpjm1
+         DO jj = 2, jpjm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only
             DO ji = 2, jpim1
-               zcofw = tmask(ji,jj,jk) / 16.
                wslpi(ji,jj,jk) = (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)     &
                   &                +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)     &
                   &                + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)     &
                   &                +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )   &
-                  &                + 4.*  zwz(ji  ,jj  ,jk)                        ) * zcofw
+                  &                + 4.*  zwz(ji  ,jj  ,jk)                         ) * z1_16 * tmask(ji,jj,jk)
 
                wslpj(ji,jj,jk) = (        zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)     &
@@ -276,15 +292,14 @@
                   &                + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)     &
                   &                +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )   &
-                  &                + 4.*  zww(ji  ,jj  ,jk)                        ) * zcofw
+                  &                + 4.*  zww(ji  ,jj  ,jk)                         ) * z1_16 * tmask(ji,jj,jk)
             END DO
          END DO  
          DO jj = 3, jpj-2                               ! other rows
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               zcofw = tmask(ji,jj,jk) / 16.
                wslpi(ji,jj,jk) = (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)     &
                   &                +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)     &
                   &                + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)     &
                   &                +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )   &
-                  &                + 4.*  zwz(ji  ,jj  ,jk)                        ) * zcofw
+                  &                + 4.*  zwz(ji  ,jj  ,jk)                         ) * z1_16 * tmask(ji,jj,jk)
 
                wslpj(ji,jj,jk) = (        zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)     &
@@ -292,5 +307,5 @@
                   &                + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)     &
                   &                +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )   &
-                  &                + 4.*  zww(ji  ,jj  ,jk)                        ) * zcofw
+                  &                + 4.*  zww(ji  ,jj  ,jk)                         ) * z1_16 * tmask(ji,jj,jk)
             END DO
          END DO
@@ -298,13 +313,12 @@
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               z1u = ( umask(ji,jj,jk) + umask(ji-1,jj,jk) ) *.5
-               z1v = ( vmask(ji,jj,jk) + vmask(ji,jj-1,jk) ) *.5
-               wslpi(ji,jj,jk) = wslpi(ji,jj,jk) * z1u * z1v
-               wslpj(ji,jj,jk) = wslpj(ji,jj,jk) * z1u * z1v
+               zck =   ( umask(ji,jj,jk) + umask(ji-1,jj,jk) )   &
+                  &  * ( vmask(ji,jj,jk) + vmask(ji,jj-1,jk) ) * 0.25
+               wslpi(ji,jj,jk) = wslpi(ji,jj,jk) * zck
+               wslpj(ji,jj,jk) = wslpj(ji,jj,jk) * zck
             END DO
          END DO
       END DO
          
-
       ! III.  Specific grid points     
       ! =========================== 
@@ -313,17 +327,17 @@
          !                                                    ! Gibraltar Strait
          ij0 =  50   ;   ij1 =  53
-         ii0 =  69   ;   ii1 =  71   ;   uslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0.e0
+         ii0 =  69   ;   ii1 =  71   ;   uslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
          ij0 =  51   ;   ij1 =  53
-         ii0 =  68   ;   ii1 =  71   ;   vslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0.e0
-         ii0 =  69   ;   ii1 =  71   ;   wslpi( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0.e0
-         ii0 =  69   ;   ii1 =  71   ;   wslpj( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0.e0
+         ii0 =  68   ;   ii1 =  71   ;   vslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
+         ii0 =  69   ;   ii1 =  71   ;   wslpi( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
+         ii0 =  69   ;   ii1 =  71   ;   wslpj( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
          !
          !                                                    ! Mediterrannean Sea
          ij0 =  49   ;   ij1 =  56
-         ii0 =  71   ;   ii1 =  90   ;   uslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0.e0
+         ii0 =  71   ;   ii1 =  90   ;   uslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
          ij0 =  50   ;   ij1 =  56
-         ii0 =  70   ;   ii1 =  90   ;   vslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0.e0
-         ii0 =  71   ;   ii1 =  90   ;   wslpi( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0.e0
-         ii0 =  71   ;   ii1 =  90   ;   wslpj( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0.e0
+         ii0 =  70   ;   ii1 =  90   ;   vslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
+         ii0 =  71   ;   ii1 =  90   ;   wslpi( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
+         ii0 =  71   ;   ii1 =  90   ;   wslpj( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
       ENDIF
 
@@ -341,7 +355,225 @@
       !
    END SUBROUTINE ldf_slp
-
-
-   SUBROUTINE ldf_slp_mxl( prd, pn2 )
+   
+
+   SUBROUTINE ldf_slp_grif ( kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE ldf_slp_grif  ***
+      !!
+      !! ** Purpose :   Compute the squared slopes of neutral surfaces (slope
+      !!      of iso-pycnal surfaces referenced locally) (ln_traldf_grif=T)
+      !!      at W-points using the Griffies quarter-cells.  
+      !!
+      !! ** Method  :   calculates alpha and beta at T-points 
+      !!
+      !! ** Action : - triadi_g, triadj_g   T-pts i- and j-slope triads relative to geopot. (used for eiv)
+      !!             - triadi , triadj    T-pts i- and j-slope triads relative to model-coordinate
+      !!             - wslp2              squared slope of neutral surfaces at w-points.
+      !!----------------------------------------------------------------------
+      USE oce,   zdit  => ua   ! use ua as workspace
+      USE oce,   zdis  => va   ! use va as workspace
+      USE oce,   zdjt  => ta   ! use ta as workspace
+      USE oce,   zdjs  => sa   ! use sa as workspace
+      !!
+      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
+      !!
+      INTEGER  ::   ji, jj, jk, jl, ip, jp, kp  ! dummy loop indices
+      INTEGER  ::   iku, ikv                ! temporary integer
+      REAL(wp) ::   zfacti, zfactj, zatempw,zatempu,zatempv   ! local scalars
+      REAL(wp) ::   zbu, zbv, zbti, zbtj
+      REAL(wp) ::   zdxrho_raw, zti_coord, zti_raw, zti_lim, zti_lim2, zti_g_raw, zti_g_lim
+      REAL(wp) ::   zdyrho_raw, ztj_coord, ztj_raw, ztj_lim, ztj_lim2, ztj_g_raw, ztj_g_lim
+      REAL(wp) ::   zdzrho_raw
+      REAL(wp), DIMENSION(jpi,jpj,jpk,0:1) ::   zdzrho, zdyrho, zdxrho     ! Horizontal and vertical density gradients
+      REAL(wp), DIMENSION(jpi,jpj,0:1,0:1) ::   zti_mlb, ztj_mlb
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     ::   zdkt, zdks
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     ::   zalpha, zbeta       ! alpha, beta at T points, at depth fsgdept
+      REAL(wp), DIMENSION(jpi,jpj)         ::   z1_mlbw
+      !!----------------------------------------------------------------------
+
+      !--------------------------------!
+      !  Some preliminary calculation  !
+      !--------------------------------!
+      !
+      CALL eos_alpbet( tsb, zalpha, zbeta )     !==  before thermal and haline expension coeff. at T-points  ==!
+      !
+      DO jk = 1, jpkm1                          !==  before lateral T & S gradients at T-level jk  ==!
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zdit(ji,jj,jk) = ( tb(ji+1,jj,jk) - tb(ji,jj,jk) ) * umask(ji,jj,jk)   ! i-gradient of T and S at jj
+               zdis(ji,jj,jk) = ( sb(ji+1,jj,jk) - sb(ji,jj,jk) ) * umask(ji,jj,jk)
+               zdjt(ji,jj,jk) = ( tb(ji,jj+1,jk) - tb(ji,jj,jk) ) * vmask(ji,jj,jk)   ! j-gradient of T and S at jj
+               zdjs(ji,jj,jk) = ( sb(ji,jj+1,jk) - sb(ji,jj,jk) ) * vmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      IF( ln_zps ) THEN                               ! partial steps: correction at the last level
+# if defined key_vectopt_loop
+         DO jj = 1, 1
+            DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
+# else
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+# endif
+               zdit(ji,jj,mbku(ji,jj)) = gtsu(ji,jj,jp_tem)                           ! i-gradient of T and S
+               zdis(ji,jj,mbku(ji,jj)) = gtsu(ji,jj,jp_sal)
+               zdjt(ji,jj,mbkv(ji,jj)) = gtsv(ji,jj,jp_tem)                           ! j-gradient of T and S
+               zdjs(ji,jj,mbkv(ji,jj)) = gtsv(ji,jj,jp_sal)
+            END DO
+         END DO
+      ENDIF
+      !
+      zdkt(:,:,1) = 0._wp                    !==  before vertical T & S gradient at w-level  ==!
+      zdks(:,:,1) = 0._wp
+      DO jk = 2, jpk
+         zdkt(:,:,jk) = ( tb(:,:,jk-1) - tb(:,:,jk) ) * tmask(:,:,jk)
+         zdks(:,:,jk) = ( sb(:,:,jk-1) - sb(:,:,jk) ) * tmask(:,:,jk)
+      END DO
+      !
+      !
+      DO jl = 0, 1                           !==  density i-, j-, and k-gradients  ==!
+         ip = jl   ;   jp = jl         ! guaranteed nonzero gradients ( absolute value larger than repsln)
+         DO jk = 1, jpkm1                          ! done each pair of triad
+            DO jj = 1, jpjm1                       ! NB: not masked due to the minimum value set
+               DO ji = 1, fs_jpim1   ! vector opt. 
+                  zdxrho_raw = ( zalpha(ji+ip,jj   ,jk) * zdit(ji,jj,jk) + zbeta(ji+ip,jj   ,jk) * zdis(ji,jj,jk) ) / e1u(ji,jj)
+                  zdyrho_raw = ( zalpha(ji   ,jj+jp,jk) * zdjt(ji,jj,jk) + zbeta(ji   ,jj+jp,jk) * zdjs(ji,jj,jk) ) / e2v(ji,jj)
+                  zdxrho(ji+ip,jj   ,jk,1-ip) = SIGN( MAX(   repsln, ABS( zdxrho_raw ) ), zdxrho_raw )    ! keep the sign
+                  zdyrho(ji   ,jj+jp,jk,1-jp) = SIGN( MAX(   repsln, ABS( zdyrho_raw ) ), zdyrho_raw )
+               END DO
+            END DO
+         END DO
+      END DO
+     DO kp = 0, 1                           !==  density i-, j-, and k-gradients  ==!
+         DO jk = 1, jpkm1                          ! done each pair of triad
+            DO jj = 1, jpj                       ! NB: not masked due to the minimum value set
+               DO ji = 1, jpi   ! vector opt. 
+                  zdzrho_raw = ( zalpha(ji,jj,jk) * zdkt(ji,jj,jk+kp) + zbeta(ji,jj,jk) * zdks(ji,jj,jk+kp) )   &
+                     &       / fse3w(ji,jj,jk+kp)
+                  zdzrho(ji   ,jj   ,jk,  kp) =     - MIN( - repsln,      zdzrho_raw )                    ! force zdzrho >= repsln
+               END DO
+            END DO
+         END DO
+      END DO
+      !
+      DO jj = 1, jpj                         !==  Reciprocal depth of the w-point below ML base  ==!
+         DO ji = 1, jpi
+            jk = MIN( nmln(ji,jj), mbkt(ji,jj) ) + 1     ! MIN in case ML depth is the ocean depth
+            z1_mlbw(ji,jj) = 1._wp / fsdepw(ji,jj,jk)
+         END DO
+      END DO
+      !
+      !                                      !==  intialisations to zero  ==!
+      !
+      wslp2  (:,:,:)     = 0._wp                                           ! wslp2 will be cumulated 3D field set to zero
+      triadi_g(:,:,1,:,:) = 0._wp   ;   triadi_g(:,:,jpk,:,:) = 0._wp      ! set surface and bottom slope to zero
+      triadj_g(:,:,1,:,:) = 0._wp   ;   triadj_g(:,:,jpk,:,:) = 0._wp
+!!gm _iso set to zero missing
+      triadi (:,:,1,:,:) = 0._wp   ;   triadj (:,:,jpk,:,:) = 0._wp        ! set surface and bottom slope to zero
+      triadj (:,:,1,:,:) = 0._wp   ;   triadj (:,:,jpk,:,:) = 0._wp
+      
+      !-------------------------------------!
+      !  Triads just below the Mixed Layer  !
+      !-------------------------------------!
+      !
+      DO jl = 0, 1               ! calculate slope of the 4 triads immediately ONE level below mixed-layer base
+         DO kp = 0, 1            ! with only the slope-max limit   and   MASKED 
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1
+                  ip = jl   ;   jp = jl
+                  jk = MIN( nmln(ji+ip,jj) , mbkt(ji+ip,jj) ) + 1         ! ML level+1 (MIN in case ML depth is the ocean depth)
+                  zti_g_raw = (  zdxrho(ji+ip,jj,jk-kp,1-ip) / zdzrho(ji+ip,jj,jk-kp,kp)      &
+                     &      + ( fsdept(ji+1,jj,jk-kp) - fsdept(ji,jj,jk-kp) ) / e1u(ji,jj)  ) * umask(ji,jj,jk)
+                  jk = MIN( nmln(ji,jj+jp) , mbkt(ji,jj+jp) ) + 1
+                  ztj_g_raw = (  zdyrho(ji,jj+jp,jk-kp,1-jp) / zdzrho(ji,jj+jp,jk-kp,kp)      &
+                     &      + ( fsdept(ji,jj+1,jk-kp) - fsdept(ji,jj,jk-kp) ) / e2v(ji,jj)  ) * vmask(ji,jj,jk)
+                  zti_mlb(ji+ip,jj   ,1-ip,kp) = SIGN( MIN( rn_slpmax, ABS( zti_g_raw ) ), zti_g_raw )
+                  ztj_mlb(ji   ,jj+jp,1-jp,kp) = SIGN( MIN( rn_slpmax, ABS( ztj_g_raw ) ), ztj_g_raw )
+               END DO
+            END DO
+         END DO
+      END DO
+
+      !-------------------------------------!
+      !  Triads with surface limits         !
+      !-------------------------------------!
+      !
+      DO kp = 0, 1                        ! k-index of triads
+         DO jl = 0, 1
+            ip = jl   ;   jp = jl         ! i- and j-indices of triads (i-k and j-k planes)
+            DO jk = 1, jpkm1
+               DO jj = 1, jpjm1
+                  DO ji = 1, fs_jpim1   ! vector opt.
+                     !
+                     ! Calculate slope relative to geopotentials used for GM skew fluxes
+                     ! For s-coordinate, subtract slope at t-points (equivalent to *adding* gradient of depth)
+                     ! Limit by slope *relative to geopotentials* by rn_slpmax, and mask by psi-point
+                     ! masked by umask taken at the level of dz(rho)
+                     !
+                     ! raw slopes: unmasked unbounded slopes (relative to geopotential (zti_g) and model surface (zti)
+                     !
+                     zti_raw   = zdxrho(ji+ip,jj   ,jk,1-ip) / zdzrho(ji+ip,jj   ,jk,kp)                   ! unmasked
+                     ztj_raw   = zdyrho(ji   ,jj+jp,jk,1-jp) / zdzrho(ji   ,jj+jp,jk,kp)
+                     zti_coord = ( fsdept(ji+1,jj  ,jk) - fsdept(ji,jj,jk) ) / e1u(ji,jj)
+                     ztj_coord = ( fsdept(ji  ,jj+1,jk) - fsdept(ji,jj,jk) ) / e2v(ji,jj)
+                  ! unmasked
+                     zti_g_raw = zti_raw + zti_coord      ! ref to geopot surfaces
+                     ztj_g_raw = ztj_raw + ztj_coord
+                     zti_g_lim = SIGN( MIN( rn_slpmax, ABS( zti_g_raw ) ), zti_g_raw )
+                     ztj_g_lim = SIGN( MIN( rn_slpmax, ABS( ztj_g_raw ) ), ztj_g_raw )
+                     !
+                     ! Below  ML use limited zti_g as is
+                     ! Inside ML replace by linearly reducing sx_mlb towards surface
+                     !
+                     zfacti = REAL( 1 - 1/(1 + (jk+kp-1)/nmln(ji+ip,jj)), wp )  ! k index of uppermost point(s) of triad is jk+kp-1
+                     zfactj = REAL( 1 - 1/(1 + (jk+kp-1)/nmln(ji,jj+jp)), wp )  ! must be .ge. nmln(ji,jj) for zfact=1
+                     !                                                          !                   otherwise  zfact=0
+                     zti_g_lim =           zfacti   * zti_g_lim                       &
+                        &      + ( 1._wp - zfacti ) * zti_mlb(ji+ip,jj,1-ip,kp)   &
+                        &                           * fsdepw(ji+ip,jj,jk+kp) * z1_mlbw(ji+ip,jj)
+                     ztj_g_lim =           zfactj   * ztj_g_lim                       &
+                        &      + ( 1._wp - zfactj ) * ztj_mlb(ji,jj+jp,1-jp,kp)   &
+                        &                           * fsdepw(ji,jj+jp,jk+kp) * z1_mlbw(ji,jj+jp)                   ! masked
+                     !
+                     triadi_g(ji+ip,jj   ,jk,1-ip,kp) = zti_g_lim * umask(ji,jj,jk+kp)
+                     triadj_g(ji   ,jj+jp,jk,1-jp,kp) = ztj_g_lim * vmask(ji,jj,jk+kp)
+                     !
+                     ! Get coefficients of isoneutral diffusion tensor
+                     ! 1. Utilise gradients *relative* to s-coordinate, so add t-point slopes (*subtract* depth gradients)
+                     ! 2. We require that isoneutral diffusion  gives no vertical buoyancy flux
+                     !     i.e. 33 term = (real slope* 31, 13 terms)
+                     ! To do this, retain limited sx**2  in vertical flux, but divide by real slope for 13/31 terms
+                     ! Equivalent to tapering A_iso = sx_limited**2/(real slope)**2
+                     !
+                     zti_lim  = zti_g_lim - zti_coord    ! remove the coordinate slope  ==> relative to coordinate surfaces
+                     ztj_lim  = ztj_g_lim - ztj_coord                                 
+                     zti_lim2 = zti_lim * zti_lim * umask(ji,jj,jk+kp)      ! square of limited slopes            ! masked <<==
+                     ztj_lim2 = ztj_lim * ztj_lim * vmask(ji,jj,jk+kp)
+                     !
+                     zbu = e1u(ji    ,jj) * e2u(ji   ,jj) * fse3u(ji   ,jj,jk   )
+                     zbv = e1v(ji    ,jj) * e2v(ji   ,jj) * fse3v(ji   ,jj,jk   )
+                     zbti = e1t(ji+ip,jj) * e2t(ji+ip,jj) * fse3w(ji+ip,jj,jk+kp)
+                     zbtj = e1t(ji,jj+jp) * e2t(ji,jj+jp) * fse3w(ji,jj+jp,jk+kp)
+                     !
+                     triadi(ji+ip,jj   ,jk,1-ip,kp) = zti_lim2 / zti_raw                                          ! masked
+                     triadj(ji   ,jj+jp,jk,1-jp,kp) = ztj_lim2 / ztj_raw
+                     !
+!!gm this may inhibit vectorization on Vect Computers, and even on scalar computers....  ==> to be checked
+                     wslp2 (ji+ip,jj,jk+kp) = wslp2(ji+ip,jj,jk+kp) + 0.25_wp * zbu / zbti * zti_lim2             ! masked
+                     wslp2 (ji,jj+jp,jk+kp) = wslp2(ji,jj+jp,jk+kp) + 0.25_wp * zbv / zbtj * ztj_lim2
+                  END DO
+               END DO
+            END DO
+         END DO
+      END DO
+      !
+      wslp2(:,:,1) = 0._wp                ! force the surface wslp to zero
+      
+      CALL lbc_lnk( wslp2, 'W', 1. )      ! lateral boundary confition on wslp2 only   ==>>> gm : necessary ? to be checked
+      !
+   END SUBROUTINE ldf_slp_grif
+
+
+   SUBROUTINE ldf_slp_mxl( prd, pn2, p_gru, p_grv, p_dzr )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE ldf_slp_mxl  ***
@@ -350,5 +582,8 @@
       !!              the mixed layer.
       !!
-      !! ** Method  :   caution: use zgru, zgrv and zwy computed in ldf_slp
+      !! ** Method  :   The slope in the i-direction is computed at u- & w-points
+      !!              (uslpml, wslpiml) and the slope in the j-direction is computed
+      !!              at v- and w-points (vslpml, wslpjml) with the same bounds as
+      !!              in ldf_slp.
       !!
       !! ** Action  :   uslpml, wslpiml :  i- &  j-slopes of neutral surfaces
@@ -356,31 +591,28 @@
       !!                omlmask         :  mixed layer mask
       !!----------------------------------------------------------------------
-      USE oce , zgru  => ua   ! zgru, zgrv (ua, va used as workspace)  
-      USE oce , zgrv  => va   ! set to i- & j-density gradient in ldf_slp
-      USE oce , zwy   => ta   ! set to vertical density gradient at T-point in ldfslp
-      !! 
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) ::   prd   ! in situ density
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) ::   pn2   ! Brunt-Vaisala frequency (locally ref.)
-      !!
-      INTEGER  ::   ji, jj, jk           ! dummy loop indices
-      INTEGER  ::   ik, ikm1             ! temporary integers
-      REAL(wp) ::   zeps, zmg, zm05g     ! temporary scalars
-      REAL(wp) ::   zcoef1, zcoef2       !    -         -
-      REAL(wp) ::   zau, zbu, zai, zbi   !    -         -
-      REAL(wp) ::   zav, zbv, zaj, zbj   !    -         -
-      REAL(wp) ::        zbw             !    -         -
-      !!----------------------------------------------------------------------
-
-      zeps  =  1.e-20                    ! Local constant initialization
-      zmg   = -1.0 / grav
-      zm05g = -0.5 / grav
-      !
-      uslpml (1,:) = 0.e0      ;      uslpml (jpi,:) = 0.e0
-      vslpml (1,:) = 0.e0      ;      vslpml (jpi,:) = 0.e0
-      wslpiml(1,:) = 0.e0      ;      wslpiml(jpi,:) = 0.e0
-      wslpjml(1,:) = 0.e0      ;      wslpjml(jpi,:) = 0.e0
-
-      !                                  ! surface mixed layer mask
-      DO jk = 1, jpk                          ! =1 inside the mixed layer, =0 otherwise
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) ::   prd            ! in situ density
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) ::   pn2            ! Brunt-Vaisala frequency (locally ref.)
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) ::   p_gru, p_grv   ! i- & j-gradient of density (u- & v-pts)
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) ::   p_dzr          ! z-gradient of density      (T-point)
+      !!
+      INTEGER  ::   ji , jj , jk         ! dummy loop indices
+      INTEGER  ::   iku, ikv, ik, ikm1   ! local integers
+      REAL(wp) ::   zeps, zm1_g, zm1_2g            ! local scalars
+      REAL(wp) ::   zci, zfi, zau, zbu, zai, zbi   !   -      -
+      REAL(wp) ::   zcj, zfj, zav, zbv, zaj, zbj   !   -      -
+      REAL(wp) ::   zck, zfk,      zbw             !   -      -
+      !!----------------------------------------------------------------------
+
+      zeps   =  1.e-20_wp        !==   Local constant initialization   ==!
+      zm1_g  = -1.0_wp / grav
+      zm1_2g = -0.5_wp / grav
+      !
+      uslpml (1,:) = 0._wp      ;      uslpml (jpi,:) = 0._wp
+      vslpml (1,:) = 0._wp      ;      vslpml (jpi,:) = 0._wp
+      wslpiml(1,:) = 0._wp      ;      wslpiml(jpi,:) = 0._wp
+      wslpjml(1,:) = 0._wp      ;      wslpjml(jpi,:) = 0._wp
+      !
+      !                          !==   surface mixed layer mask   !
+      DO jk = 1, jpk                      ! =1 inside the mixed layer, =0 otherwise
 # if defined key_vectopt_loop
          DO jj = 1, 1
@@ -391,6 +623,6 @@
 # endif
                ik = nmln(ji,jj) - 1
-               IF( jk <= ik ) THEN   ;   omlmask(ji,jj,jk) = 1.e0
-               ELSE                  ;   omlmask(ji,jj,jk) = 0.e0
+               IF( jk <= ik ) THEN   ;   omlmask(ji,jj,jk) = 1._wp
+               ELSE                  ;   omlmask(ji,jj,jk) = 0._wp
                ENDIF
             END DO
@@ -409,5 +641,4 @@
       !-----------------------------------------------------------------------
       !
-      !                            !* Slope at u points
 # if defined key_vectopt_loop
       DO jj = 1, 1
@@ -417,76 +648,49 @@
          DO ji = 2, jpim1
 # endif
-            ! horizontal and vertical density gradient at u-points
-            ik = MAX( 1, nmln(ji,jj) , nmln(ji+1,jj) )
-            ik = MIN( ik, jpkm1 )
-            zau = 1./ e1u(ji,jj) * zgru(ji,jj,ik)
-            zbu = 0.5*( zwy(ji,jj,ik) + zwy(ji+1,jj,ik) )
-            ! bound the slopes: abs(zw.)<= 1/100 and zb..<0
-            !                         kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
-            zbu = MIN( zbu, -100.*ABS(zau), -7.e+3/fse3u(ji,jj,ik)*ABS(zau) )
-            ! uslpml
-            uslpml (ji,jj) = zau / ( zbu - zeps ) * umask (ji,jj,ik)
-         END DO
-      END DO
-      CALL lbc_lnk( uslpml, 'U', -1. )      ! lateral boundary conditions (i-gradient => sign change)
-
-      !                            !* Slope at v points
-# if defined key_vectopt_loop
-      DO jj = 1, 1
-         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
-# else
-      DO jj = 2, jpjm1
-         DO ji = 2, jpim1
-# endif
-            ! horizontal and vertical density gradient at v-points
-            ik = MAX( 1, nmln(ji,jj) , nmln(ji,jj+1) )
-            ik = MIN( ik,jpkm1 )
-            zav = 1./ e2v(ji,jj) * zgrv(ji,jj,ik)
-            zbv = 0.5*( zwy(ji,jj,ik) + zwy(ji,jj+1,ik) )
-            ! bound the slopes: abs(zw.)<= 1/100 and zb..<0
-            !                         kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
-            zbv = MIN( zbv, -100.*ABS(zav), -7.e+3/fse3v(ji,jj,ik)*ABS( zav ) )
-            ! vslpml
-            vslpml (ji,jj) = zav / ( zbv - zeps ) * vmask (ji,jj,ik)
-         END DO
-      END DO
-      CALL lbc_lnk( vslpml, 'V', -1. )      ! lateral boundary conditions (j-gradient => sign change)
-
-      !                            !* Slopes at w points
-# if defined key_vectopt_loop
-      DO jj = 1, 1
-         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
-# else
-      DO jj = 2, jpjm1
-         DO ji = 2, jpim1
-# endif
-            ik = nmln(ji,jj) + 1
-            ik = MIN( ik, jpk )
-            ikm1 = MAX ( 1, ik-1 )
-            ! horizontal density i-gradient at w-points
-            zcoef1 = MAX( zeps, umask(ji-1,jj,ik  )+umask(ji,jj,ik  )   &
-               &               +umask(ji-1,jj,ikm1)+umask(ji,jj,ikm1) )
-            zcoef1 = 1. / ( zcoef1 * e1t (ji,jj) )
-            zai = zcoef1 * (  zgru(ji  ,jj,ik  ) + zgru(ji  ,jj,ikm1)   &
-               &            + zgru(ji-1,jj,ikm1) + zgru(ji-1,jj,ik  ) ) * tmask (ji,jj,ik)
-            ! horizontal density j-gradient at w-points
-            zcoef2 = MAX( zeps, vmask(ji,jj-1,ik  )+vmask(ji,jj,ikm1)    &
-               &               +vmask(ji,jj-1,ikm1)+vmask(ji,jj,ik  ) )
-            zcoef2 = 1.0 / ( zcoef2 *  e2t (ji,jj) )
-            zaj = zcoef2 * (  zgrv(ji,jj  ,ik  ) + zgrv(ji,jj  ,ikm1)   &
-               &            + zgrv(ji,jj-1,ikm1) + zgrv(ji,jj-1,ik  ) ) * tmask (ji,jj,ik)
-            ! vertical density gradient at w-point (from N^2)
-            zbw = zm05g * pn2 (ji,jj,ik) * ( prd (ji,jj,ik) + prd (ji,jj,ikm1) + 2. )
-            ! bound the slopes: abs(zw.)<= 1/100 and zb..<0.
-            !                   static instability:
-            !                   kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
-            zbi = MIN ( zbw,- 100.*ABS(zai), -7.e+3/fse3w(ji,jj,ik)*ABS(zai) )
-            zbj = MIN ( zbw, -100.*ABS(zaj), -7.e+3/fse3w(ji,jj,ik)*ABS(zaj) )
-            ! wslpiml and wslpjml
-            wslpiml (ji,jj) = zai / ( zbi - zeps) * tmask (ji,jj,ik)
-            wslpjml (ji,jj) = zaj / ( zbj - zeps) * tmask (ji,jj,ik)
-         END DO
-      END DO
-      CALL lbc_lnk( wslpiml, 'W', -1. )   ;   CALL lbc_lnk( wslpjml, 'W', -1. )      ! lateral boundary conditions
+            !                    !==   Slope at u- & v-points just below the Mixed Layer   ==!
+            !
+            !                          !- vertical density gradient for u- and v-slopes (from dzr at T-point)
+            iku = MIN(  MAX( 1, nmln(ji,jj) , nmln(ji+1,jj) ) , jpkm1  )   ! ML (MAX of T-pts, bound by jpkm1)
+            ikv = MIN(  MAX( 1, nmln(ji,jj) , nmln(ji,jj+1) ) , jpkm1  )   ! 
+            zbu = 0.5_wp * ( p_dzr(ji,jj,iku) + p_dzr(ji+1,jj  ,iku) )
+            zbv = 0.5_wp * ( p_dzr(ji,jj,ikv) + p_dzr(ji  ,jj+1,ikv) )
+            !                          !- horizontal density gradient at u- & v-points
+            zau = p_gru(ji,jj,iku) / e1u(ji,jj)
+            zav = p_grv(ji,jj,ikv) / e2v(ji,jj)
+            !                          !- bound the slopes: abs(zw.)<= 1/100 and zb..<0
+            !                                kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
+            zbu = MIN(  zbu , -100._wp* ABS( zau ) , -7.e+3_wp/fse3u(ji,jj,ik)* ABS( zau )  )
+            zbv = MIN(  zbv , -100._wp* ABS( zav ) , -7.e+3_wp/fse3v(ji,jj,ik)* ABS( zav )  )
+            !                          !- Slope at u- & v-points (uslpml, vslpml)
+            uslpml(ji,jj) = zau / ( zbu - zeps ) * umask(ji,jj,ik)
+            vslpml(ji,jj) = zav / ( zbv - zeps ) * vmask(ji,jj,ik)
+            !
+            !                    !==   i- & j-slopes at w-points just below the Mixed Layer   ==!
+            !
+            ik   = MIN( nmln(ji,jj) + 1, jpk )
+            ikm1 = MAX( 1, ik-1 )
+            !                          !- vertical density gradient for w-slope (from N^2)
+            zbw = zm1_2g * pn2 (ji,jj,ik) * ( prd (ji,jj,ik) + prd (ji,jj,ikm1) + 2. )
+            !                          !- horizontal density i- & j-gradient at w-points
+            zci = MAX(   umask(ji-1,jj,ik  ) + umask(ji,jj,ik  )           &
+               &       + umask(ji-1,jj,ikm1) + umask(ji,jj,ikm1) , zeps  ) * e1t(ji,jj) 
+            zcj = MAX(   vmask(ji,jj-1,ik  ) + vmask(ji,jj,ik  )           &
+               &       + vmask(ji,jj-1,ikm1) + vmask(ji,jj,ikm1) , zeps  ) * e2t(ji,jj)
+            zai =    (   p_gru(ji-1,jj,ik  ) + p_gru(ji,jj,ik)           &
+               &       + p_gru(ji-1,jj,ikm1) + p_gru(ji,jj,ikm1  )  ) / zci  * tmask(ji,jj,ik)
+            zaj =    (   p_grv(ji,jj-1,ik  ) + p_grv(ji,jj,ik  )           &
+               &       + p_grv(ji,jj-1,ikm1) + p_grv(ji,jj,ikm1)  ) / zcj  * tmask(ji,jj,ik)
+            !                          !- bound the slopes: abs(zw.)<= 1/100 and zb..<0.
+            !                             kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
+            zbi = MIN(  zbw , -100._wp* ABS( zai ) , -7.e+3_wp/fse3w(ji,jj,ik)* ABS( zai )  )
+            zbj = MIN(  zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/fse3w(ji,jj,ik)* ABS( zaj )  )
+            !                          !- 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)
+         END DO
+      END DO
+!!gm this lbc_lnk should be useless....
+      CALL lbc_lnk( uslpml , 'U', -1. )   ;   CALL lbc_lnk( vslpml , 'V', -1. )   ! lateral boundary cond. (sign change)
+      CALL lbc_lnk( wslpiml, 'W', -1. )   ;   CALL lbc_lnk( wslpjml, 'W', -1. )   ! lateral boundary conditions
       !
    END SUBROUTINE ldf_slp_mxl
@@ -503,52 +707,67 @@
       !!----------------------------------------------------------------------
       INTEGER ::   ji, jj, jk   ! dummy loop indices
+      INTEGER ::   ierr         ! local integer
       !!----------------------------------------------------------------------
       
       IF(lwp) THEN    
          WRITE(numout,*)
-         WRITE(numout,*) 'ldf_slp : direction of lateral mixing'
-         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,*) 'ldf_slp_init : direction of lateral mixing'
+         WRITE(numout,*) '~~~~~~~~~~~~'
       ENDIF
-
-      ! Direction of lateral diffusion (tracers and/or momentum)
-      ! ------------------------------
-      ! set the slope to zero (even in s-coordinates)
-
-      uslp (:,:,:) = 0.e0
-      vslp (:,:,:) = 0.e0
-      wslpi(:,:,:) = 0.e0
-      wslpj(:,:,:) = 0.e0
-
-      uslpml (:,:) = 0.e0
-      vslpml (:,:) = 0.e0
-      wslpiml(:,:) = 0.e0
-      wslpjml(:,:) = 0.e0
-
-      IF( (ln_traldf_hor .OR. ln_dynldf_hor) .AND. .NOT. (lk_vvl .AND. ln_rstart) ) THEN
-         IF(lwp) THEN
-            WRITE(numout,*) '          Horizontal mixing in s-coordinate: slope = slope of s-surfaces'
+      
+      IF( ln_traldf_grif ) THEN        ! Griffies operator : triad of slopes
+         ALLOCATE( triadi_g(jpi,jpj,jpk,0:1,0:1) , triadj_g(jpi,jpj,jpk,0:1,0:1) , wslp2(jpi,jpj,jpk) , STAT=ierr )
+         ALLOCATE( triadi  (jpi,jpj,jpk,0:1,0:1) , triadj  (jpi,jpj,jpk,0:1,0:1)                      , STAT=ierr )
+         IF( ierr > 0 ) THEN
+            CALL ctl_stop( 'ldf_slp_init : unable to allocate Griffies operator slope ' )   ;   RETURN
          ENDIF
-
-         ! geopotential diffusion in s-coordinates on tracers and/or momentum
-         ! The slopes of s-surfaces are computed once (no call to ldfslp in step)
-         ! The slopes for momentum diffusion are i- or j- averaged of those on tracers
-
-         ! set the slope of diffusion to the slope of s-surfaces
-         !      ( c a u t i o n : minus sign as fsdep has positive value )
-         DO jk = 1, jpk
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  uslp (ji,jj,jk) = -1./e1u(ji,jj) * ( fsdept(ji+1,jj,jk) - fsdept(ji ,jj ,jk) ) * umask(ji,jj,jk)
-                  vslp (ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept(ji,jj+1,jk) - fsdept(ji ,jj ,jk) ) * vmask(ji,jj,jk)
-                  wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw(ji+1,jj,jk) - fsdepw(ji-1,jj,jk) ) * tmask(ji,jj,jk) * 0.5
-                  wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw(ji,jj+1,jk) - fsdepw(ji,jj-1,jk) ) * tmask(ji,jj,jk) * 0.5
+         !
+         IF( ln_dynldf_iso )   CALL ctl_stop( 'ldf_slp_init: Griffies operator on momentum not supported' )
+         !
+         IF( ( ln_traldf_hor .AND. ln_dynldf_hor ) .AND. ln_sco )   &
+            &     CALL ctl_stop( 'ldf_slp_init: horizontal Griffies operator ',   &
+            &                                              'in s-coordinate not supported' )
+         !
+      ELSE                             ! Madec operator : slopes at u-, v-, and w-points
+         ALLOCATE( uslp(jpi,jpj,jpk) , vslp(jpi,jpj,jpk) , wslpi(jpi,jpj,jpk) , wslpj(jpi,jpj,jpk) ,                &
+            &   omlmask(jpi,jpj,jpk) , uslpml(jpi,jpj)   , vslpml(jpi,jpj)    , wslpiml(jpi,jpj)   , wslpjml(jpi,jpj) , STAT=ierr )
+         IF( ierr > 0 ) THEN
+            CALL ctl_stop( 'ldf_slp_init : unable to allocate Madec operator slope ' )   ;   RETURN
+         ENDIF
+
+         ! Direction of lateral diffusion (tracers and/or momentum)
+         ! ------------------------------
+         uslp (:,:,:) = 0._wp   ;   uslpml (:,:) = 0._wp      ! set the slope to zero (even in s-coordinates)
+         vslp (:,:,:) = 0._wp   ;   vslpml (:,:) = 0._wp
+         wslpi(:,:,:) = 0._wp   ;   wslpiml(:,:) = 0._wp
+         wslpj(:,:,:) = 0._wp   ;   wslpjml(:,:) = 0._wp
+
+!!gm I no longer understand this.....
+         IF( (ln_traldf_hor .OR. ln_dynldf_hor) .AND. .NOT. (lk_vvl .AND. ln_rstart) ) THEN
+            IF(lwp) THEN
+               WRITE(numout,*) '          Horizontal mixing in s-coordinate: slope = slope of s-surfaces'
+            ENDIF
+
+            ! geopotential diffusion in s-coordinates on tracers and/or momentum
+            ! The slopes of s-surfaces are computed once (no call to ldfslp in step)
+            ! The slopes for momentum diffusion are i- or j- averaged of those on tracers
+
+            ! set the slope of diffusion to the slope of s-surfaces
+            !      ( c a u t i o n : minus sign as fsdep has positive value )
+            DO jk = 1, jpk
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     uslp (ji,jj,jk) = -1./e1u(ji,jj) * ( fsdept(ji+1,jj,jk) - fsdept(ji ,jj ,jk) ) * umask(ji,jj,jk)
+                     vslp (ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept(ji,jj+1,jk) - fsdept(ji ,jj ,jk) ) * vmask(ji,jj,jk)
+                     wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw(ji+1,jj,jk) - fsdepw(ji-1,jj,jk) ) * tmask(ji,jj,jk) * 0.5
+                     wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw(ji,jj+1,jk) - fsdepw(ji,jj-1,jk) ) * tmask(ji,jj,jk) * 0.5
+                  END DO
                END DO
             END DO
-         END DO
-         ! Lateral boundary conditions on the slopes
-         CALL lbc_lnk( uslp , 'U', -1. )      ;      CALL lbc_lnk( vslp , 'V', -1. )
-         CALL lbc_lnk( wslpi, 'W', -1. )      ;      CALL lbc_lnk( wslpj, 'W', -1. )
-      ENDIF
-      !
+            ! Lateral boundary conditions on the slopes
+            CALL lbc_lnk( uslp , 'U', -1. )      ;      CALL lbc_lnk( vslp , 'V', -1. )
+            CALL lbc_lnk( wslpi, 'W', -1. )      ;      CALL lbc_lnk( wslpj, 'W', -1. )
+         ENDIF
+      ENDIF      !
    END SUBROUTINE ldf_slp_init
 
@@ -564,4 +783,6 @@
       WRITE(*,*) 'ldf_slp: You should not have seen this print! error?', kt, prd(1,1,1), pn2(1,1,1)
    END SUBROUTINE ldf_slp
+   SUBROUTINE ldf_slp_init       ! Dummy routine
+   END SUBROUTINE ldf_slp_init
 #endif
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90	(revision 2528)
@@ -34,7 +34,7 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -67,5 +67,7 @@
       NAMELIST/namtra_ldf/ ln_traldf_lap  , ln_traldf_bilap,                  &
          &                 ln_traldf_level, ln_traldf_hor  , ln_traldf_iso,   &
-         &                 rn_aht_0       , rn_ahtb_0      , rn_aeiv_0
+         &                 ln_traldf_grif , ln_traldf_gdia,                   &
+         &                 rn_aht_0       , rn_ahtb_0      , rn_aeiv_0,       &
+         &                 rn_slpmax
       !!----------------------------------------------------------------------
 
@@ -80,10 +82,19 @@
          WRITE(numout,*) 'ldf_tra_init : lateral tracer physics'
          WRITE(numout,*) '~~~~~~~~~~~~ '
-         WRITE(numout,*) '   Namelist namtra_ldf : lateral mixing coefficients'
+         WRITE(numout,*) '   Namelist namtra_ldf : lateral mixing parameters (type, direction, coefficients)'
          WRITE(numout,*) '      laplacian operator            ln_traldf_lap   = ', ln_traldf_lap
          WRITE(numout,*) '      bilaplacian operator          ln_traldf_bilap = ', ln_traldf_bilap
+         WRITE(numout,*) '      iso-level                     ln_traldf_level = ', ln_traldf_level
+         WRITE(numout,*) '      horizontal (geopotential)     ln_traldf_hor   = ', ln_traldf_hor
+         WRITE(numout,*) '      iso-neutral                   ln_traldf_iso   = ', ln_traldf_iso
+         WRITE(numout,*) '      iso-neutral (Griffies)        ln_traldf_grif  = ', ln_traldf_grif
+         WRITE(numout,*) '      Griffies strmfn diagnostics   ln_traldf_gdia  = ', ln_traldf_gdia
          WRITE(numout,*) '      lateral eddy diffusivity      rn_aht_0        = ', rn_aht_0
          WRITE(numout,*) '      background hor. diffusivity   rn_ahtb_0       = ', rn_ahtb_0
          WRITE(numout,*) '      eddy induced velocity coef.   rn_aeiv_0       = ', rn_aeiv_0
+         WRITE(numout,*) '      maximum isoppycnal slope      rn_slpmax       = ', rn_slpmax
+         WRITE(numout,*) '   + griffies operator internal controls not set via the namelist (experimental): '
+         WRITE(numout,*) '      calculate triads twice        l_triad_iso     = ', l_triad_iso
+         WRITE(numout,*) '      no Shapiro filter             l_no_smooth     = ', l_no_smooth
          WRITE(numout,*)
       ENDIF
Index: trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c1d.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c1d.h90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c1d.h90	(revision 2528)
@@ -4,7 +4,7 @@
 
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c2d.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c2d.h90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c2d.h90	(revision 2528)
@@ -4,7 +4,7 @@
 
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c3d.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c3d.h90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c3d.h90	(revision 2528)
@@ -4,7 +4,7 @@
 
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_oce.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_oce.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_oce.F90	(revision 2528)
@@ -20,9 +20,14 @@
    LOGICAL , PUBLIC ::   ln_traldf_hor   = .FALSE.   !: horizontal (geopotential) direction
    LOGICAL , PUBLIC ::   ln_traldf_iso   = .TRUE.    !: iso-neutral direction
+   LOGICAL , PUBLIC ::   ln_traldf_grif  = .FALSE.   !: griffies skew flux
+   LOGICAL , PUBLIC ::   ln_traldf_gdia  = .FALSE.   !: griffies skew flux streamfunction diagnostics
    REAL(wp), PUBLIC ::   rn_aht_0        = 2000._wp  !: lateral eddy diffusivity (m2/s)
    REAL(wp), PUBLIC ::   rn_ahtb_0       =    0._wp  !: lateral background eddy diffusivity (m2/s)
    REAL(wp), PUBLIC ::   rn_aeiv_0       = 2000._wp  !: eddy induced velocity coefficient (m2/s)
+   REAL(wp), PUBLIC ::   rn_slpmax       = 0.01_wp   !: slope limit
 
    REAL(wp), PUBLIC ::   aht0, ahtb0, aeiv0         !!: OLD namelist names
+   LOGICAL , PUBLIC ::   l_triad_iso     = .FALSE.   !: calculate triads twice
+   LOGICAL , PUBLIC ::   l_no_smooth     = .FALSE.   !: no Shapiro smoothing
 
 #if defined key_traldf_c3d
@@ -41,5 +46,5 @@
    !!   'key_traldf_eiv'                              eddy induced velocity
    !!----------------------------------------------------------------------
-   LOGICAL, PUBLIC, PARAMETER ::   lk_traldf_eiv   = .TRUE.   !: eddy induced velocity flag
+   LOGICAL, PUBLIC, PARAMETER               ::   lk_traldf_eiv   = .TRUE.   !: eddy induced velocity flag
       
 # if defined key_traldf_c3d
@@ -65,7 +70,7 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!=====================================================================
 END MODULE ldftra_oce
Index: trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_substitute.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_substitute.h90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_substitute.h90	(revision 2528)
@@ -6,7 +6,7 @@
    !!----------------------------------------------------------------------
    !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 #if defined key_traldf_c3d
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obc_oce.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obc_oce.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obc_oce.F90	(revision 2528)
@@ -231,7 +231,7 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!======================================================================
 END MODULE obc_oce
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obc_par.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obc_par.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obc_par.F90	(revision 2528)
@@ -21,7 +21,7 @@
    PUBLIC
    !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 #if ! defined key_agrif
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obc_par_EEL_R5.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obc_par_EEL_R5.h90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obc_par_EEL_R5.h90	(revision 2528)
@@ -5,7 +5,7 @@
    !!---------------------------------------------------------------------
    !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
    INTEGER, PARAMETER ::     &  !: time dimension for the BCS fields on input
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obc_par_POMME_R025.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obc_par_POMME_R025.h90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obc_par_POMME_R025.h90	(revision 2528)
@@ -4,4 +4,9 @@
    !! open boundary parameter : POMME configuration
    !!---------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
    INTEGER, PARAMETER ::  jptobc  =	      14   
    !: time dimension of the BCS fields on input
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obc_vectopt_loop_substitute.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obc_vectopt_loop_substitute.h90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obc_vectopt_loop_substitute.h90	(revision 2528)
@@ -5,10 +5,5 @@
    !!      to allow unrolling of do-loop using CPP macro.
    !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-#if defined key_vectopt_loop && defined key_obc && ! defined key_mpp_mpi && ! defined key_mpp_shmem
+#if defined key_vectopt_loop && defined key_obc && ! defined key_mpp_mpi
 #  define fs_niw0  jpiwob 
 #  define fs_niw1  jpiwob
@@ -29,2 +24,7 @@
 #  define fs_njs1  njs1
 #endif
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obcdta.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obcdta.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obcdta.F90	(revision 2528)
@@ -83,7 +83,7 @@
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2006)
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obcdyn_bt.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obcdyn_bt.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obcdyn_bt.F90	(revision 2528)
@@ -34,7 +34,7 @@
 
    !!---------------------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obcini.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obcini.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obcini.F90	(revision 2528)
@@ -31,7 +31,7 @@
 #  include "obc_vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -437,4 +437,13 @@
          END DO
       END IF
+
+      IF( lp_obc_west ) THEN ! ... West open boundary lateral surface
+         DO ji = niw0, niw1
+            DO jj = 1, jpj 
+               obcsurftot = obcsurftot+hu(ji,jj)*e2u(ji,jj)*uwmsk(jj,1) * MAX(obctmsk(ji,jj),obctmsk(ji+1,jj) )
+            END DO
+         END DO
+      END IF
+
       IF( lp_obc_north ) THEN ! ... North open boundary lateral surface
          DO jj = njn0, njn1
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obcrad.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obcrad.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obcrad.F90	(revision 2528)
@@ -42,7 +42,7 @@
 #  include "obc_vectopt_loop_substitute.h90"
    !!---------------------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!---------------------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obcrst.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obcrst.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obcrst.F90	(revision 2528)
@@ -24,7 +24,7 @@
 
    !!---------------------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!---------------------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obctra.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obctra.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obctra.F90	(revision 2528)
@@ -46,7 +46,7 @@
 #  include "obc_vectopt_loop_substitute.h90"
    !!---------------------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!---------------------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obcvol.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obcvol.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obcvol.F90	(revision 2528)
@@ -28,7 +28,7 @@
 #  include "obc_vectopt_loop_substitute.h90"
    !!---------------------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!---------------------------------------------------------------------------------
 
@@ -97,5 +97,5 @@
       ! ---------------------------------------------------------------------------
 
-      zCflxemp = SUM ( emp(:,:)*obctmsk(:,:)* e1t(:,:) * e2t(:,:)  / rau0 )
+      zCflxemp = SUM ( ( emp(:,:)-rnf(:,:) )*obctmsk(:,:)* e1t(:,:) * e2t(:,:)  / rau0 ) 
 
       IF( lk_mpp )   CALL mpp_sum( zCflxemp )   ! sum over the global domain
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/ddatetoymdhms.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/ddatetoymdhms.h90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/ddatetoymdhms.h90	(revision 2528)
@@ -0,0 +1,43 @@
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE ddatetoymdhms( ddate, kyea, kmon, kday, khou, kmin, ksec )
+      !!----------------------------------------------------------------------
+      !!
+      !!                    *** ROUTINE ddatetoymdhms ***
+      !!
+      !! ** Purpose : Convert YYYYMMDD.hhmmss to components
+      !!
+      !! ** Method  :
+      !!
+      !! ** Action  :
+      !!
+      !! History
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Arguments
+      REAL(dp), INTENT(IN) :: ddate
+      INTEGER, INTENT(OUT) :: kyea
+      INTEGER, INTENT(OUT) :: kmon
+      INTEGER, INTENT(OUT) :: kday
+      INTEGER, INTENT(OUT) :: khou
+      INTEGER, INTENT(OUT) :: kmin
+      INTEGER, INTENT(OUT) :: ksec
+      !! * Local declarations
+      INTEGER :: iyymmdd
+      INTEGER :: ihhmmss
+      
+      iyymmdd = INT( ddate )
+      ihhmmss = INT( ( ddate - iyymmdd ) * 1000000 )
+      kyea = iyymmdd/10000
+      kmon = iyymmdd / 100 - 100 * kyea
+      kday = MOD( iyymmdd, 100 )
+      khou = ihhmmss/10000
+      kmin = ihhmmss / 100 - 100 * khou
+      ksec = MOD( ihhmmss, 100 )
+      
+   END SUBROUTINE ddatetoymdhms
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90	(revision 2528)
@@ -0,0 +1,1565 @@
+MODULE diaobs
+   !!======================================================================
+   !!                       ***  MODULE diaobs  ***
+   !! Observation diagnostics: Computation of the misfit between data and
+   !!                          their model equivalent 
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   'key_diaobs' : Switch on the observation diagnostic computation
+   !!----------------------------------------------------------------------
+   !!   dia_obs_init : Reading and prepare observations
+   !!   dia_obs      : Compute model equivalent to observations
+   !!   dia_obs_wri  : Write observational diagnostics
+   !!   ini_date     : Compute the initial date YYYYMMDD.HHMMSS
+   !!   fin_date     : Compute the final date YYYYMMDD.HHMMSS
+   !!----------------------------------------------------------------------
+   !! * Modules used   
+   USE par_kind                 ! Precision variables
+   USE in_out_manager           ! I/O manager
+   USE par_oce
+   USE dom_oce                  ! Ocean space and time domain variables
+   USE obs_read_prof            ! Reading and allocation of observations (Coriolis)
+   USE obs_read_sla             ! Reading and allocation of SLA observations  
+   USE obs_read_sst             ! Reading and allocation of SST observations  
+   USE obs_readmdt              ! Reading and allocation of MDT for SLA.
+   USE obs_read_seaice          ! Reading and allocation of Sea Ice observations  
+   USE obs_read_vel             ! Reading and allocation of velocity component observations
+   USE obs_prep                 ! Preparation of obs. (grid search etc).
+   USE obs_oper                 ! Observation operators
+   USE obs_write                ! Writing of observation related diagnostics
+   USE obs_grid                 ! Grid searching
+   USE obs_read_altbias         ! Bias treatment for altimeter
+   USE obs_profiles_def         ! Profile data definitions
+   USE obs_profiles             ! Profile data storage
+   USE obs_surf_def             ! Surface data definitions
+   USE obs_sla                  ! SLA data storage
+   USE obs_sst                  ! SST data storage
+   USE obs_seaice               ! Sea Ice data storage
+   USE obs_types                ! Definitions for observation types
+   USE mpp_map                  ! MPP mapping
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+   PUBLIC dia_obs_init, &  ! Initialize and read observations
+      &   dia_obs,      &  ! Compute model equivalent to observations
+      &   dia_obs_wri      ! Write model equivalent to observations
+
+   !! * 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_ena         !: Logical switch for the ENACT data set
+   LOGICAL, PUBLIC :: ln_cor         !: Logical switch for the Coriolis data set
+   LOGICAL, PUBLIC :: ln_profb       !: Logical switch for profile feedback datafiles
+   LOGICAL, PUBLIC :: ln_sla         !: Logical switch for sea level anomalies 
+   LOGICAL, PUBLIC :: ln_sladt       !: Logical switch for SLA from AVISO files
+   LOGICAL, PUBLIC :: ln_slafb       !: Logical switch for SLA from feedback files
+   LOGICAL, PUBLIC :: ln_sst         !: Logical switch for sea surface temperature
+   LOGICAL, PUBLIC :: ln_reysst      !: Logical switch for Reynolds sea surface temperature
+   LOGICAL, PUBLIC :: ln_ghrsst      !: Logical switch for GHRSST data
+   LOGICAL, PUBLIC :: ln_sstfb       !: Logical switch for SST from feedback files
+   LOGICAL, PUBLIC :: ln_seaice      !: Logical switch for sea ice concentration
+   LOGICAL, PUBLIC :: ln_vel3d       !: Logical switch for velocity component (u,v) observations
+   LOGICAL, PUBLIC :: ln_velavcur    !: Logical switch for raw daily averaged netCDF current meter vel. data 
+   LOGICAL, PUBLIC :: ln_velhrcur    !: Logical switch for raw high freq netCDF current meter vel. data 
+   LOGICAL, PUBLIC :: ln_velavadcp   !: Logical switch for raw daily averaged netCDF ADCP vel. data 
+   LOGICAL, PUBLIC :: ln_velhradcp   !: Logical switch for raw high freq netCDF ADCP vel. data 
+   LOGICAL, PUBLIC :: ln_velfb       !: Logical switch for velocities from feedback files
+   LOGICAL, PUBLIC :: ln_ssh         !: Logical switch for sea surface height
+   LOGICAL, PUBLIC :: ln_sss         !: Logical switch for sea surface salinity
+   LOGICAL, PUBLIC :: ln_nea         !: Remove observations near land
+   LOGICAL, PUBLIC :: ln_altbias     !: Logical switch for altimeter bias  
+   LOGICAL, PUBLIC :: ln_ignmis      !: Logical switch for ignoring missing files
+   LOGICAL, PUBLIC :: ln_s_at_t      !: Logical switch to compute model S at T observations
+
+   REAL(KIND=dp), PUBLIC :: dobsini   !: Observation window start date YYYYMMDD.HHMMSS
+   REAL(KIND=dp), PUBLIC :: dobsend   !: Observation window end date YYYYMMDD.HHMMSS
+  
+   INTEGER, PUBLIC :: n1dint       !: Vertical interpolation method
+   INTEGER, PUBLIC :: n2dint       !: Horizontal interpolation method 
+
+   INTEGER, DIMENSION(imaxavtypes) :: &
+      & endailyavtypes !: ENACT data types which are daily average
+
+   INTEGER, PARAMETER :: MaxNumFiles = 1000
+   LOGICAL, DIMENSION(MaxNumFiles) :: &
+      & ln_profb_ena, & !: Is the feedback files from ENACT data ?
+   !                    !: If so use endailyavtypes
+      & ln_profb_enatim !: Change tim for 820 enact data set.
+   
+   LOGICAL, DIMENSION(MaxNumFiles) :: &
+      & ln_velfb_av   !: Is the velocity feedback files daily average?
+   LOGICAL, DIMENSION(:), ALLOCATABLE :: &
+      & ld_enact     !: Profile data is ENACT so use endailyavtypes
+   LOGICAL, DIMENSION(:), ALLOCATABLE :: &
+      & ld_velav     !: Velocity data is daily averaged
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE dia_obs_init
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE dia_obs_init  ***
+      !!          
+      !! ** Purpose : Initialize and read observations
+      !!
+      !! ** Method  : Read the namelist and call reading routines
+      !!
+      !! ** Action  : Read the namelist and call reading routines
+      !!
+      !! History :
+      !!        !  06-03  (K. Mogensen) Original code
+      !!        !  06-05  (A. Weaver) Reformatted
+      !!        !  06-10  (A. Weaver) Cleaning and add controls
+      !!        !  07-03  (K. Mogensen) General handling of profiles
+      !!----------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      !! * Local declarations
+      CHARACTER(len=128) :: enactfiles(MaxNumFiles)
+      CHARACTER(len=128) :: coriofiles(MaxNumFiles)
+      CHARACTER(len=128) :: profbfiles(MaxNumFiles)
+      CHARACTER(len=128) :: sstfiles(MaxNumFiles)      
+      CHARACTER(len=128) :: sstfbfiles(MaxNumFiles) 
+      CHARACTER(len=128) :: slafilesact(MaxNumFiles)      
+      CHARACTER(len=128) :: slafilespas(MaxNumFiles)      
+      CHARACTER(len=128) :: slafbfiles(MaxNumFiles)
+      CHARACTER(len=128) :: seaicefiles(MaxNumFiles)           
+      CHARACTER(len=128) :: velcurfiles(MaxNumFiles)  
+      CHARACTER(len=128) :: veladcpfiles(MaxNumFiles)    
+      CHARACTER(len=128) :: velavcurfiles(MaxNumFiles)
+      CHARACTER(len=128) :: velhrcurfiles(MaxNumFiles)
+      CHARACTER(len=128) :: velavadcpfiles(MaxNumFiles)
+      CHARACTER(len=128) :: velhradcpfiles(MaxNumFiles)
+      CHARACTER(len=128) :: velfbfiles(MaxNumFiles)
+      CHARACTER(LEN=128) :: reysstname
+      CHARACTER(LEN=12)  :: reysstfmt
+      CHARACTER(LEN=128) :: bias_file
+      CHARACTER(LEN=20)  :: datestr=" ", timestr=" "
+      NAMELIST/namobs/ln_ena, ln_cor, ln_profb, ln_t3d, ln_s3d,       &
+         &            ln_sla, ln_sladt, ln_slafb,                     &
+         &            ln_ssh, ln_sst, ln_sstfb, ln_sss, ln_nea,       &
+         &            enactfiles, coriofiles, profbfiles,             &
+         &            slafilesact, slafilespas, slafbfiles,           &
+         &            sstfiles, sstfbfiles,                           &
+         &            ln_seaice, seaicefiles,                         &
+         &            dobsini, dobsend, n1dint, n2dint,               &
+         &            nmsshc, mdtcorr, mdtcutoff,                     &
+         &            ln_reysst, ln_ghrsst, reysstname, reysstfmt,    &
+         &            ln_grid_search_lookup,                          &
+         &            grid_search_file, grid_search_res,              &
+         &            ln_grid_global, bias_file, ln_altbias,          &
+         &            endailyavtypes, ln_s_at_t, ln_profb_ena,        &
+         &            ln_vel3d, ln_velavcur, velavcurfiles,           &
+         &            ln_velhrcur, velhrcurfiles,                     &
+         &            ln_velavadcp, velavadcpfiles,                   &
+         &            ln_velhradcp, velhradcpfiles,                   &
+         &            ln_velfb, velfbfiles, ln_velfb_av,              &
+         &            ln_profb_enatim, ln_ignmis
+
+      INTEGER :: jprofset
+      INTEGER :: jveloset
+      INTEGER :: jvar
+      INTEGER :: jnumenact
+      INTEGER :: jnumcorio
+      INTEGER :: jnumprofb
+      INTEGER :: jnumslaact
+      INTEGER :: jnumslapas
+      INTEGER :: jnumslafb
+      INTEGER :: jnumsst
+      INTEGER :: jnumsstfb
+      INTEGER :: jnumseaice
+      INTEGER :: jnumvelavcur
+      INTEGER :: jnumvelhrcur  
+      INTEGER :: jnumvelavadcp
+      INTEGER :: jnumvelhradcp   
+      INTEGER :: jnumvelfb
+      INTEGER :: ji
+      INTEGER :: jset
+      LOGICAL :: lmask(MaxNumFiles), ll_u3d, ll_v3d
+
+      !-----------------------------------------------------------------------
+      ! Force exit if AGRIF activated
+      !-----------------------------------------------------------------------
+    
+      IF( lk_agrif ) THEN
+        CALL ctl_stop( 'dia_obs_init : key_diaobs and key_agrif cannot be used together' )
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Read namelist parameters
+      !-----------------------------------------------------------------------
+      ! default values already set except:
+
+      ln_t3d = .FALSE.
+      ln_s3d = .FALSE.
+      ln_vel3d = .FALSE.
+      ln_sla = .FALSE.
+      ln_altbias = .FALSE.
+      ln_ssh = .FALSE.
+      ln_sst = .FALSE.
+      ln_seaice = .FALSE.
+      ln_reysst = .FALSE.
+      ln_ghrsst = .FALSE.
+      ln_sss = .FALSE.
+      ln_profb = .FALSE.
+      ln_ena = .TRUE.
+      ln_cor = .FALSE.
+      ln_sladt = .TRUE.
+      ln_slafb = .FALSE.
+      ln_sstfb = .FALSE.
+      ln_velavcur = .FALSE.
+      ln_velhrcur = .FALSE.
+      ln_velavadcp = .FALSE.
+      ln_velhradcp = .FALSE.
+      ln_velfb = .FALSE.
+      ln_nea = .FALSE.
+      ln_grid_search_lookup = .FALSE.
+      ln_grid_global = .FALSE.
+      ln_s_at_t = .TRUE.
+      grid_search_file = 'xypos'
+      bias_file='bias.nc'
+      enactfiles(:) = ''
+      coriofiles(:) = ''
+      profbfiles(:) = ''
+      slafilesact(:) = ''
+      slafilespas(:) = ''
+      slafbfiles(:) = ''
+      sstfiles(:)   = ''
+      sstfbfiles(:) = ''
+      seaicefiles(:) = ''
+      velcurfiles(:) = ''
+      veladcpfiles(:) = ''
+      velavcurfiles(:) = ''
+      velhrcurfiles(:) = ''
+      velavadcpfiles(:) = ''
+      velhradcpfiles(:) = ''
+      velfbfiles(:) = ''
+      reysstname = 'sst_yYYYYmMM.nc'
+      reysstfmt = 'monthly'
+      endailyavtypes(:) = -1
+      endailyavtypes(1) = 820
+      ln_profb_ena(:) = .FALSE.
+      ln_profb_enatim(:) = .TRUE.
+      ln_velfb_av(:) = .FALSE.
+      ln_ignmis = .FALSE.
+      CALL ini_date( dobsini )
+      CALL fin_date( dobsend )
+      n1dint = 1
+      n2dint = 3
+
+      ! Read Namelist namobs : control observation diagnostics
+      REWIND( numnam )
+      READ  ( numnam, namobs )
+
+      ! Count number of files for each type
+      IF (ln_ena) THEN
+         lmask(:) = .FALSE.
+         WHERE (enactfiles(:) /= '') lmask(:) = .TRUE.
+         jnumenact = COUNT(lmask)
+      ENDIF
+      IF (ln_cor) THEN
+         lmask(:) = .FALSE.
+         WHERE (coriofiles(:) /= '') lmask(:) = .TRUE.
+         jnumcorio = COUNT(lmask)
+      ENDIF
+      IF (ln_profb) THEN
+         lmask(:) = .FALSE.
+         WHERE (profbfiles(:) /= '') lmask(:) = .TRUE.
+         jnumprofb = COUNT(lmask)
+      ENDIF
+      IF (ln_sladt) THEN
+         lmask(:) = .FALSE.
+         WHERE (slafilesact(:) /= '') lmask(:) = .TRUE.
+         jnumslaact = COUNT(lmask)
+         lmask(:) = .FALSE.
+         WHERE (slafilespas(:) /= '') lmask(:) = .TRUE.
+         jnumslapas = COUNT(lmask)
+      ENDIF
+      IF (ln_slafb) THEN
+         lmask(:) = .FALSE.
+         WHERE (slafbfiles(:) /= '') lmask(:) = .TRUE.
+         jnumslafb = COUNT(lmask)
+         lmask(:) = .FALSE.
+      ENDIF
+      IF (ln_ghrsst) THEN
+         lmask(:) = .FALSE.
+         WHERE (sstfiles(:) /= '') lmask(:) = .TRUE.
+         jnumsst = COUNT(lmask)
+      ENDIF      
+      IF (ln_sstfb) THEN
+         lmask(:) = .FALSE.
+         WHERE (sstfbfiles(:) /= '') lmask(:) = .TRUE.
+         jnumsstfb = COUNT(lmask)
+         lmask(:) = .FALSE.
+      ENDIF
+      IF (ln_seaice) THEN
+         lmask(:) = .FALSE.
+         WHERE (seaicefiles(:) /= '') lmask(:) = .TRUE.
+         jnumseaice = COUNT(lmask)
+      ENDIF
+      IF (ln_velavcur) THEN
+         lmask(:) = .FALSE.
+         WHERE (velavcurfiles(:) /= '') lmask(:) = .TRUE.
+         jnumvelavcur = COUNT(lmask)
+      ENDIF
+      IF (ln_velhrcur) THEN
+         lmask(:) = .FALSE.
+         WHERE (velhrcurfiles(:) /= '') lmask(:) = .TRUE.
+         jnumvelhrcur = COUNT(lmask)
+      ENDIF
+      IF (ln_velavadcp) THEN
+         lmask(:) = .FALSE.
+         WHERE (velavadcpfiles(:) /= '') lmask(:) = .TRUE.
+         jnumvelavadcp = COUNT(lmask)
+      ENDIF
+      IF (ln_velhradcp) THEN
+         lmask(:) = .FALSE.
+         WHERE (velhradcpfiles(:) /= '') lmask(:) = .TRUE.
+         jnumvelhradcp = COUNT(lmask)
+      ENDIF
+      IF (ln_velfb) THEN
+         lmask(:) = .FALSE.
+         WHERE (velfbfiles(:) /= '') lmask(:) = .TRUE.
+         jnumvelfb = COUNT(lmask)
+         lmask(:) = .FALSE.
+      ENDIF
+      
+      ! Control print
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dia_obs_init : Observation diagnostic initialization'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '          Namelist namobs : set observation diagnostic parameters' 
+         WRITE(numout,*) '             Logical switch for T profile observations          ln_t3d = ', ln_t3d
+         WRITE(numout,*) '             Logical switch for S profile observations          ln_s3d = ', ln_s3d
+         WRITE(numout,*) '             Logical switch for ENACT insitu data set           ln_ena = ', ln_ena
+         WRITE(numout,*) '             Logical switch for Coriolis insitu data set        ln_cor = ', ln_cor
+         WRITE(numout,*) '             Logical switch for feedback insitu data set      ln_profb = ', ln_profb
+         WRITE(numout,*) '             Logical switch for SLA observations                ln_sla = ', ln_sla
+         WRITE(numout,*) '             Logical switch for AVISO SLA data                ln_sladt = ', ln_sladt
+         WRITE(numout,*) '             Logical switch for feedback SLA data             ln_slafb = ', ln_slafb
+         WRITE(numout,*) '             Logical switch for SSH observations                ln_ssh = ', ln_ssh
+         WRITE(numout,*) '             Logical switch for SST observations                ln_sst = ', ln_sst
+         WRITE(numout,*) '             Logical switch for Reynolds observations        ln_reysst = ', ln_reysst    
+         WRITE(numout,*) '             Logical switch for GHRSST observations          ln_ghrsst = ', ln_ghrsst
+         WRITE(numout,*) '             Logical switch for feedback SST data             ln_sstfb = ', ln_sstfb
+         WRITE(numout,*) '             Logical switch for SSS observations                ln_sss = ', ln_sss
+         WRITE(numout,*) '             Logical switch for Sea Ice observations         ln_seaice = ', ln_seaice
+         WRITE(numout,*) '             Logical switch for velocity observations         ln_vel3d = ', ln_vel3d
+         WRITE(numout,*) '             Logical switch for velocity daily av. cur.    ln_velavcur = ', ln_velavcur
+         WRITE(numout,*) '             Logical switch for velocity high freq. cur.   ln_velhrcur = ', ln_velhrcur
+         WRITE(numout,*) '             Logical switch for velocity daily av. ADCP   ln_velavadcp = ', ln_velavadcp
+         WRITE(numout,*) '             Logical switch for velocity high freq. ADCP  ln_velhradcp = ', ln_velhradcp
+         WRITE(numout,*) '             Logical switch for feedback velocity data        ln_velfb = ', ln_velfb
+         WRITE(numout,*) '             Global distribtion of observations         ln_grid_global = ',ln_grid_global
+         WRITE(numout,*) &
+   '             Logical switch for obs grid search w/lookup table  ln_grid_search_lookup = ',ln_grid_search_lookup
+         IF (ln_grid_search_lookup) &
+            WRITE(numout,*) '             Grid search lookup file header       grid_search_file = ', grid_search_file
+         IF (ln_ena) THEN
+            DO ji = 1, jnumenact
+               WRITE(numout,'(1X,2A)') '             ENACT input observation file name          enactfiles = ', &
+                  TRIM(enactfiles(ji))
+            END DO
+         ENDIF
+         IF (ln_cor) THEN
+            DO ji = 1, jnumcorio
+               WRITE(numout,'(1X,2A)') '             Coriolis input observation file name       coriofiles = ', &
+                  TRIM(coriofiles(ji))
+            END DO
+         ENDIF
+         IF (ln_profb) THEN
+            DO ji = 1, jnumprofb
+               IF (ln_profb_ena(ji)) THEN
+                  WRITE(numout,'(1X,2A)') '       Enact feedback input observation file name       profbfiles = ', &
+                     TRIM(profbfiles(ji))
+               ELSE
+                  WRITE(numout,'(1X,2A)') '             Feedback input observation file name       profbfiles = ', &
+                     TRIM(profbfiles(ji))
+               ENDIF
+               WRITE(numout,'(1X,2A)') '       Enact feedback input time setting switch    ln_profb_enatim = ', ln_profb_enatim(ji)
+            END DO
+         ENDIF
+         IF (ln_sladt) THEN
+            DO ji = 1, jnumslaact
+               WRITE(numout,'(1X,2A)') '             Active SLA input observation file name    slafilesact = ', &
+                  TRIM(slafilesact(ji))
+            END DO
+            DO ji = 1, jnumslapas
+               WRITE(numout,'(1X,2A)') '             Passive SLA input observation file name   slafilespas = ', &
+                  TRIM(slafilespas(ji))
+            END DO
+         ENDIF
+         IF (ln_slafb) THEN
+            DO ji = 1, jnumslafb
+               WRITE(numout,'(1X,2A)') '             Feedback SLA input observation file name   slafbfiles = ', &
+                  TRIM(slafbfiles(ji))
+            END DO
+         ENDIF
+         IF (ln_ghrsst) THEN
+            DO ji = 1, jnumsst
+               WRITE(numout,'(1X,2A)') '             GHRSST input observation file name           sstfiles = ', &
+                  TRIM(sstfiles(ji))
+            END DO
+         ENDIF
+         IF (ln_sstfb) THEN
+            DO ji = 1, jnumsstfb
+               WRITE(numout,'(1X,2A)') '             Feedback SST input observation file name   sstfbfiles = ', &
+                  TRIM(sstfbfiles(ji))
+            END DO
+         ENDIF
+         IF (ln_seaice) THEN
+            DO ji = 1, jnumseaice
+               WRITE(numout,'(1X,2A)') '             Sea Ice input observation file name       seaicefiles = ', &
+                  TRIM(seaicefiles(ji))
+            END DO
+         ENDIF
+         IF (ln_velavcur) THEN
+            DO ji = 1, jnumvelavcur
+               WRITE(numout,'(1X,2A)') '             Vel. cur. daily av. input file name     velavcurfiles = ', &
+                  TRIM(velavcurfiles(ji))
+            END DO
+         ENDIF
+         IF (ln_velhrcur) THEN
+            DO ji = 1, jnumvelhrcur
+               WRITE(numout,'(1X,2A)') '             Vel. cur. high freq. input file name    velhvcurfiles = ', &
+                  TRIM(velhrcurfiles(ji))
+            END DO
+         ENDIF
+         IF (ln_velavadcp) THEN
+            DO ji = 1, jnumvelavadcp
+               WRITE(numout,'(1X,2A)') '             Vel. ADCP daily av. input file name    velavadcpfiles = ', &
+                  TRIM(velavadcpfiles(ji))
+            END DO
+         ENDIF
+         IF (ln_velhradcp) THEN
+            DO ji = 1, jnumvelhradcp
+               WRITE(numout,'(1X,2A)') '             Vel. ADCP high freq. input file name   velhvadcpfiles = ', &
+                  TRIM(velhradcpfiles(ji))
+            END DO
+         ENDIF
+         IF (ln_velfb) THEN
+            DO ji = 1, jnumvelfb
+               IF (ln_velfb_av(ji)) THEN
+                  WRITE(numout,'(1X,2A)') '             Vel. feedback daily av. input file name    velfbfiles = ', &
+                     TRIM(velfbfiles(ji))
+               ELSE
+                  WRITE(numout,'(1X,2A)') '             Vel. feedback input observation file name  velfbfiles = ', &
+                     TRIM(velfbfiles(ji))
+               ENDIF
+            END DO
+         ENDIF
+         WRITE(numout,*) '             Initial date in window YYYYMMDD.HHMMSS        dobsini = ', dobsini
+         WRITE(numout,*) '             Final date in window YYYYMMDD.HHMMSS          dobsend = ', dobsend
+         WRITE(numout,*) '             Type of vertical interpolation method          n1dint = ', n1dint
+         WRITE(numout,*) '             Type of horizontal interpolation method        n2dint = ', n2dint
+         WRITE(numout,*) '             Rejection of observations near land swithch    ln_nea = ', ln_nea
+         WRITE(numout,*) '             MSSH correction scheme                         nmsshc = ', nmsshc
+         WRITE(numout,*) '             MDT  correction                               mdtcorr = ', mdtcorr
+         WRITE(numout,*) '             MDT cutoff for computed correction          mdtcutoff = ', mdtcutoff
+         WRITE(numout,*) '             Logical switch for alt bias                ln_altbias = ', ln_altbias
+         WRITE(numout,*) '             Logical switch for ignoring missing files   ln_ignmis = ', ln_ignmis
+         WRITE(numout,*) '             ENACT daily average types                             = ',endailyavtypes
+
+      ENDIF
+      
+      IF ( ln_vel3d .AND. ( .NOT. ln_grid_global ) ) THEN
+         CALL ctl_stop( 'Velocity data only works with ln_grid_global=.true.' )
+         RETURN
+      ENDIF
+
+      CALL obs_typ_init
+      
+      CALL mppmap_init
+      
+      ! Parameter control
+#if defined key_diaobs
+      IF ( ( .NOT. ln_t3d ).AND.( .NOT. ln_s3d ).AND.( .NOT. ln_sla ).AND. &
+         & ( .NOT. ln_vel3d ).AND.                                         &
+         & ( .NOT. ln_ssh ).AND.( .NOT. ln_sst ).AND.( .NOT. ln_sss ).AND. &
+         & ( .NOT. ln_seaice ).AND.( .NOT. ln_vel3d ) ) THEN
+         IF(lwp) WRITE(numout,cform_war)
+         IF(lwp) WRITE(numout,*) ' key_diaobs is activated but logical flags', &
+            &                    ' ln_t3d, ln_s3d, ln_sla, ln_ssh, ln_sst, ln_sss, ln_seaice, ln_vel3d are all set to .FALSE.'
+         nwarn = nwarn + 1
+      ENDIF
+#endif
+
+      CALL obs_grid_setup( )
+      IF ( ( n1dint < 0 ).OR.( n1dint > 1 ) ) THEN
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) ' Choice of vertical (1D) interpolation method', &
+            &                    ' is not available'
+         nstop = nstop + 1
+      ENDIF
+      IF ( ( n2dint < 0 ).OR.( n2dint > 4 ) ) THEN
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) ' Choice of horizontal (2D) interpolation method', &
+            &                    ' is not available'
+         nstop = nstop + 1
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Depending on switches read the various observation types
+      !-----------------------------------------------------------------------
+      !  - Temperature/salinity profiles
+
+      IF ( ln_t3d .OR. ln_s3d ) THEN
+
+         ! Set the number of variables for profiles to 2 (T and S)
+         nprofvars = 2
+         ! Set the number of extra variables for profiles to 1 (insitu temp).
+         nprofextr = 1
+
+         ! Count how may insitu data sets we have and allocate data.
+         jprofset = 0
+         IF ( ln_ena ) jprofset = jprofset + 1
+         IF ( ln_cor ) jprofset = jprofset + 1
+         IF ( ln_profb ) jprofset = jprofset + jnumprofb
+         nprofsets = jprofset
+         IF ( nprofsets > 0 ) THEN
+            ALLOCATE(ld_enact(nprofsets))
+            ALLOCATE(profdata(nprofsets))
+            ALLOCATE(prodatqc(nprofsets))
+         ENDIF
+
+         jprofset = 0
+          
+         ! ENACT insitu data
+
+         IF ( ln_ena ) THEN
+
+            jprofset = jprofset + 1
+            
+            ld_enact(jprofset) = .TRUE.
+
+            CALL obs_rea_pro_dri( 1, profdata(jprofset),          &
+               &                  jnumenact, enactfiles(1:jnumenact), &
+               &                  nprofvars, nprofextr,        &
+               &                  nitend-nit000+2,             &
+               &                  dobsini, dobsend, ln_t3d, ln_s3d, &
+               &                  ln_ignmis, ln_s_at_t, .TRUE., .FALSE., &
+               &                  kdailyavtypes = endailyavtypes )
+
+            DO jvar = 1, 2
+
+               CALL obs_prof_staend( profdata(jprofset), jvar )
+
+            END DO
+
+            CALL obs_pre_pro( profdata(jprofset), prodatqc(jprofset),   &
+               &              ln_t3d, ln_s3d, ln_nea, &
+               &              kdailyavtypes=endailyavtypes )
+            
+         ENDIF
+
+         ! Coriolis insitu data
+
+         IF ( ln_cor ) THEN
+           
+            jprofset = jprofset + 1
+
+            ld_enact(jprofset) = .FALSE.
+
+            CALL obs_rea_pro_dri( 2, profdata(jprofset),          &
+               &                  jnumcorio, coriofiles(1:jnumcorio), &
+               &                  nprofvars, nprofextr,        &
+               &                  nitend-nit000+2,             &
+               &                  dobsini, dobsend, ln_t3d, ln_s3d, &
+               &                  ln_ignmis, ln_s_at_t, .FALSE., .FALSE. )
+
+            DO jvar = 1, 2
+
+               CALL obs_prof_staend( profdata(jprofset), jvar )
+
+            END DO
+
+            CALL obs_pre_pro( profdata(jprofset), prodatqc(jprofset),   &
+                 &            ln_t3d, ln_s3d, ln_nea )
+            
+         ENDIF
+ 
+         ! Feedback insitu data
+
+         IF ( ln_profb ) THEN
+           
+            DO jset = 1, jnumprofb
+               
+               jprofset = jprofset + 1
+               ld_enact (jprofset) = ln_profb_ena(jset)
+
+               CALL obs_rea_pro_dri( 0, profdata(jprofset),          &
+                  &                  1, profbfiles(jset:jset), &
+                  &                  nprofvars, nprofextr,        &
+                  &                  nitend-nit000+2,             &
+                  &                  dobsini, dobsend, ln_t3d, ln_s3d, &
+                  &                  ln_ignmis, ln_s_at_t, &
+                  &                  ld_enact(jprofset).AND.&
+                  &                  ln_profb_enatim(jset), &
+                  &                  .FALSE., kdailyavtypes = endailyavtypes )
+               
+               DO jvar = 1, 2
+                  
+                  CALL obs_prof_staend( profdata(jprofset), jvar )
+                  
+               END DO
+               
+               IF ( ld_enact(jprofset) ) THEN
+                  CALL obs_pre_pro( profdata(jprofset), prodatqc(jprofset),   &
+                     &              ln_t3d, ln_s3d, ln_nea, &
+                     &              kdailyavtypes = endailyavtypes )
+               ELSE
+                  CALL obs_pre_pro( profdata(jprofset), prodatqc(jprofset),   &
+                     &              ln_t3d, ln_s3d, ln_nea )
+               ENDIF
+               
+            END DO
+
+         ENDIF
+
+      ENDIF
+
+      !  - Sea level anomalies
+      IF ( ln_sla ) THEN
+        ! Set the number of variables for sla to 1
+         nslavars = 1
+
+         ! Set the number of extra variables for sla to 2
+         nslaextr = 2
+         
+         ! Set the number of sla data sets to 2
+         nslasets = 0
+         IF ( ln_sladt ) THEN
+            nslasets = nslasets + 2
+         ENDIF
+         IF ( ln_slafb ) THEN
+            nslasets = nslasets + jnumslafb
+         ENDIF
+         
+         ALLOCATE(sladata(nslasets))
+         ALLOCATE(sladatqc(nslasets))
+         sladata(:)%nsurf=0
+         sladatqc(:)%nsurf=0
+
+         nslasets = 0
+
+         ! AVISO SLA data
+
+         IF ( ln_sladt ) THEN
+
+            ! Active SLA observations
+            
+            nslasets = nslasets + 1
+            
+            CALL obs_rea_sla( 1, sladata(nslasets), jnumslaact, &
+               &              slafilesact(1:jnumslaact), &
+               &              nslavars, nslaextr, nitend-nit000+2, &
+               &              dobsini, dobsend, ln_ignmis, .FALSE. )
+            CALL obs_pre_sla( sladata(nslasets), sladatqc(nslasets), &
+               &              ln_sla, ln_nea )
+            
+            ! Passive SLA observations
+            
+            nslasets = nslasets + 1
+            
+            CALL obs_rea_sla( 1, sladata(nslasets), jnumslapas, &
+               &              slafilespas(1:jnumslapas), &
+               &              nslavars, nslaextr, nitend-nit000+2, &
+               &              dobsini, dobsend, ln_ignmis, .FALSE. )
+            
+            CALL obs_pre_sla( sladata(nslasets), sladatqc(nslasets), &
+               &              ln_sla, ln_nea )
+
+         ENDIF
+         
+         ! Feedback SLA data
+
+         IF ( ln_slafb ) THEN
+
+            DO jset = 1, jnumslafb
+            
+               nslasets = nslasets + 1
+            
+               CALL obs_rea_sla( 0, sladata(nslasets), 1, &
+                  &              slafbfiles(jset:jset), &
+                  &              nslavars, nslaextr, nitend-nit000+2, &
+                  &              dobsini, dobsend, ln_ignmis, .FALSE. )
+               CALL obs_pre_sla( sladata(nslasets), sladatqc(nslasets), &
+                  &              ln_sla, ln_nea )
+
+            END DO               
+
+         ENDIF
+         
+         CALL obs_rea_mdt( nslasets, sladatqc, n2dint )
+            
+         ! read in altimeter bias
+         
+         IF ( ln_altbias ) THEN     
+            CALL obs_rea_altbias ( nslasets, sladatqc, n2dint, bias_file )
+         ENDIF
+     
+      ENDIF
+
+      !  - Sea surface height
+      IF ( ln_ssh ) THEN
+         IF(lwp) WRITE(numout,*) ' SSH currently not available'
+      ENDIF
+
+      !  - Sea surface temperature
+      IF ( ln_sst ) THEN
+
+         ! Set the number of variables for sst to 1
+         nsstvars = 1
+
+         ! Set the number of extra variables for sst to 0
+         nsstextr = 0
+
+         nsstsets = 0
+
+         IF (ln_reysst) nsstsets = nsstsets + 1
+         IF (ln_ghrsst) nsstsets = nsstsets + 1
+         IF ( ln_sstfb ) THEN
+            nsstsets = nsstsets + jnumsstfb
+         ENDIF
+
+         ALLOCATE(sstdata(nsstsets))
+         ALLOCATE(sstdatqc(nsstsets))
+         sstdata(:)%nsurf=0
+         sstdatqc(:)%nsurf=0         
+
+         nsstsets = 0
+
+         IF (ln_reysst) THEN
+
+            nsstsets = nsstsets + 1
+
+            CALL obs_rea_sst_rey( reysstname, reysstfmt, sstdata(nsstsets), &
+               &                  nsstvars, nsstextr, &
+               &                  nitend-nit000+2, dobsini, dobsend )
+            CALL obs_pre_sst( sstdata(nsstsets), sstdatqc(nsstsets), ln_sst, &
+               &              ln_nea )
+
+        ENDIF
+        
+        IF (ln_ghrsst) THEN
+        
+            nsstsets = nsstsets + 1
+          
+            CALL obs_rea_sst( 1, sstdata(nsstsets), jnumsst, &
+               &              sstfiles(1:jnumsst), &
+               &              nsstvars, nsstextr, nitend-nit000+2, &
+               &              dobsini, dobsend, ln_ignmis, .FALSE. )
+            CALL obs_pre_sst( sstdata(nsstsets), sstdatqc(nsstsets), ln_sst, &
+               &              ln_nea )
+
+        ENDIF
+               
+         ! Feedback SST data
+
+         IF ( ln_sstfb ) THEN
+
+            DO jset = 1, jnumsstfb
+            
+               nsstsets = nsstsets + 1
+            
+               CALL obs_rea_sst( 0, sstdata(nsstsets), 1, &
+                  &              sstfbfiles(jset:jset), &
+                  &              nsstvars, nsstextr, nitend-nit000+2, &
+                  &              dobsini, dobsend, ln_ignmis, .FALSE. )
+               CALL obs_pre_sst( sstdata(nsstsets), sstdatqc(nsstsets), &
+                  &              ln_sst, ln_nea )
+
+            END DO               
+
+         ENDIF
+
+      ENDIF
+
+      !  - Sea surface salinity
+      IF ( ln_sss ) THEN
+         IF(lwp) WRITE(numout,*) ' SSS currently not available'
+      ENDIF
+
+      !  - Sea Ice Concentration
+      
+      IF ( ln_seaice ) THEN
+
+         ! Set the number of variables for seaice to 1
+         nseaicevars = 1
+
+         ! Set the number of extra variables for seaice to 0
+         nseaiceextr = 0
+         
+         ! Set the number of data sets to 1
+         nseaicesets = 1
+
+         ALLOCATE(seaicedata(nseaicesets))
+         ALLOCATE(seaicedatqc(nseaicesets))
+         seaicedata(:)%nsurf=0
+         seaicedatqc(:)%nsurf=0
+
+         CALL obs_rea_seaice( 1, seaicedata(nseaicesets), jnumseaice, &
+            &                 seaicefiles(1:jnumseaice), &
+            &                 nseaicevars, nseaiceextr, nitend-nit000+2, &
+            &                 dobsini, dobsend, ln_ignmis, .FALSE. )
+
+         CALL obs_pre_seaice( seaicedata(nseaicesets), seaicedatqc(nseaicesets), &
+            &                 ln_seaice, ln_nea )
+ 
+      ENDIF
+
+      IF (ln_vel3d) THEN
+
+         ! Set the number of variables for profiles to 2 (U and V)
+         nvelovars = 2
+
+         ! Set the number of extra variables for profiles to 2 to store 
+         ! rotation parameters
+         nveloextr = 2
+
+         jveloset = 0
+         
+         IF ( ln_velavcur ) jveloset = jveloset + 1
+         IF ( ln_velhrcur ) jveloset = jveloset + 1
+         IF ( ln_velavadcp ) jveloset = jveloset + 1
+         IF ( ln_velhradcp ) jveloset = jveloset + 1
+         IF (ln_velfb) jveloset = jveloset + jnumvelfb
+
+         nvelosets = jveloset
+         IF ( nvelosets > 0 ) THEN
+            ALLOCATE( velodata(nvelosets) )
+            ALLOCATE( veldatqc(nvelosets) )
+            ALLOCATE( ld_velav(nvelosets) )
+         ENDIF
+         
+         jveloset = 0
+         
+         ! Daily averaged data
+
+         IF ( ln_velavcur ) THEN
+            
+            jveloset = jveloset + 1
+            
+            ld_velav(jveloset) = .TRUE.
+            
+            CALL obs_rea_vel_dri( 1, velodata(jveloset), jnumvelavcur, &
+               &                  velavcurfiles(1:jnumvelavcur), &
+               &                  nvelovars, nveloextr, &
+               &                  nitend-nit000+2,              &
+               &                  dobsini, dobsend, ln_ignmis, &
+               &                  ld_velav(jveloset), &
+               &                  .FALSE. )
+            
+            DO jvar = 1, 2
+               CALL obs_prof_staend( velodata(jveloset), jvar )
+            END DO
+            
+            CALL obs_pre_vel( velodata(jveloset), veldatqc(jveloset), &
+               &              ln_vel3d, ln_nea, ld_velav(jveloset) )
+            
+         ENDIF
+
+         ! High frequency data
+
+         IF ( ln_velhrcur ) THEN
+            
+            jveloset = jveloset + 1
+            
+            ld_velav(jveloset) = .FALSE.
+               
+            CALL obs_rea_vel_dri( 1, velodata(jveloset), jnumvelhrcur, &
+               &                  velhrcurfiles(1:jnumvelhrcur), &
+               &                  nvelovars, nveloextr, &
+               &                  nitend-nit000+2,              &
+               &                  dobsini, dobsend, ln_ignmis, &
+               &                  ld_velav(jveloset), &
+               &                  .FALSE. )
+            
+            DO jvar = 1, 2
+               CALL obs_prof_staend( velodata(jveloset), jvar )
+            END DO
+            
+            CALL obs_pre_vel( velodata(jveloset), veldatqc(jveloset), &
+               &              ln_vel3d, ln_nea, ld_velav(jveloset) )
+            
+         ENDIF
+
+         ! Daily averaged data
+
+         IF ( ln_velavadcp ) THEN
+            
+            jveloset = jveloset + 1
+            
+            ld_velav(jveloset) = .TRUE.
+            
+            CALL obs_rea_vel_dri( 1, velodata(jveloset), jnumvelavadcp, &
+               &                  velavadcpfiles(1:jnumvelavadcp), &
+               &                  nvelovars, nveloextr, &
+               &                  nitend-nit000+2,              &
+               &                  dobsini, dobsend, ln_ignmis, &
+               &                  ld_velav(jveloset), &
+               &                  .FALSE. )
+            
+            DO jvar = 1, 2
+               CALL obs_prof_staend( velodata(jveloset), jvar )
+            END DO
+            
+            CALL obs_pre_vel( velodata(jveloset), veldatqc(jveloset), &
+               &              ln_vel3d, ln_nea, ld_velav(jveloset) )
+            
+         ENDIF
+
+         ! High frequency data
+
+         IF ( ln_velhradcp ) THEN
+            
+            jveloset = jveloset + 1
+            
+            ld_velav(jveloset) = .FALSE.
+               
+            CALL obs_rea_vel_dri( 1, velodata(jveloset), jnumvelhradcp, &
+               &                  velhradcpfiles(1:jnumvelhradcp), &
+               &                  nvelovars, nveloextr, &
+               &                  nitend-nit000+2,              &
+               &                  dobsini, dobsend, ln_ignmis, &
+               &                  ld_velav(jveloset), &
+               &                  .FALSE. )
+            
+            DO jvar = 1, 2
+               CALL obs_prof_staend( velodata(jveloset), jvar )
+            END DO
+            
+            CALL obs_pre_vel( velodata(jveloset), veldatqc(jveloset), &
+               &              ln_vel3d, ln_nea, ld_velav(jveloset) )
+            
+         ENDIF
+
+         IF ( ln_velfb ) THEN
+
+            DO jset = 1, jnumvelfb
+            
+               jveloset = jveloset + 1
+
+               ld_velav(jveloset) = ln_velfb_av(jset)
+               
+               CALL obs_rea_vel_dri( 0, velodata(jveloset), 1, &
+                  &                  velfbfiles(jset:jset), &
+                  &                  nvelovars, nveloextr, &
+                  &                  nitend-nit000+2,              &
+                  &                  dobsini, dobsend, ln_ignmis, &
+                  &                  ld_velav(jveloset), &
+                  &                  .FALSE. )
+               
+               DO jvar = 1, 2
+                  CALL obs_prof_staend( velodata(jveloset), jvar )
+               END DO
+               
+               CALL obs_pre_vel( velodata(jveloset), veldatqc(jveloset), &
+                  &              ln_vel3d, ln_nea, ld_velav(jveloset) )
+
+
+            END DO
+            
+         ENDIF
+
+      ENDIF
+     
+   END SUBROUTINE dia_obs_init
+
+   SUBROUTINE dia_obs( kstp )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE dia_obs  ***
+      !!          
+      !! ** Purpose : Call the observation operators on each time step
+      !!
+      !! ** 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  : 
+      !!
+      !! History :
+      !!        !  06-03  (K. Mogensen) Original code
+      !!        !  06-05  (K. Mogensen) Reformatted
+      !!        !  06-10  (A. Weaver) Cleaning
+      !!        !  07-03  (K. Mogensen) General handling of profiles
+      !!        !  07-04  (G. Smith) Generalized surface operators
+      !!        !  08-10  (M. Valdivieso) obs operator for velocity profiles
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE dom_oce, ONLY : &             ! Ocean space and time domain variables
+         & rdt,           &                       
+         & gdept_0,       &             
+         & tmask, umask, vmask                            
+      USE phycst, ONLY : &              ! Physical constants
+         & rday                         
+      USE oce, ONLY : &                 ! Ocean dynamics and tracers variables
+         & tn,  &             
+         & sn,  &
+         & un, vn,  &
+         & sshn
+#if defined key_ice_lim
+      USE ice, ONLY : &                     ! LIM Ice model variables
+         & frld
+#endif
+
+      IMPLICIT NONE
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kstp                         ! Current timestep
+      !! * Local declarations
+#if ! defined key_ice_lim
+      REAL(wp), DIMENSION(jpi,jpj) :: frld
+#endif
+      INTEGER :: idaystp                ! Number of timesteps per day
+      INTEGER :: jprofset               ! Profile data set loop variable
+      INTEGER :: jslaset                ! SLA data set loop variable
+      INTEGER :: jsstset                ! SST data set loop variable
+      INTEGER :: jseaiceset             ! sea ice data set loop variable
+      INTEGER :: jveloset               ! velocity profile data loop variable
+      INTEGER :: jvar                   ! Variable number    
+      CHARACTER(LEN=20) :: datestr=" ",timestr=" "
+ 
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dia_obs : Call the observation operators', kstp
+         WRITE(numout,*) '~~~~~~~'
+      ENDIF
+
+      idaystp = NINT( rday / rdt )
+
+      !-----------------------------------------------------------------------
+      ! No LIM => frld == 0.0_wp
+      !-----------------------------------------------------------------------
+#if ! defined key_ice_lim
+      frld(:,:) = 0.0_wp
+#endif
+      !-----------------------------------------------------------------------
+      ! Depending on switches call various observation operators
+      !-----------------------------------------------------------------------
+
+      !  - Temperature/salinity profiles
+      IF ( ln_t3d .OR. ln_s3d ) THEN
+         DO jprofset = 1, nprofsets
+            IF ( ld_enact(jprofset) ) THEN
+               CALL obs_pro_opt( prodatqc(jprofset),                          &
+                  &              kstp, jpi, jpj, jpk, nit000, idaystp, tn, sn,&
+                  &              gdept_0, tmask, n1dint, n2dint,              &
+                  &              kdailyavtypes = endailyavtypes )
+            ELSE
+               CALL obs_pro_opt( prodatqc(jprofset),                          &
+                  &              kstp, jpi, jpj, jpk, nit000, idaystp, tn, sn,&
+                  &              gdept_0, tmask, n1dint, n2dint               )
+            ENDIF
+         END DO
+      ENDIF
+
+      !  - Sea surface anomaly
+      IF ( ln_sla ) THEN
+         DO jslaset = 1, nslasets
+            CALL obs_sla_opt( sladatqc(jslaset),            &
+               &              kstp, jpi, jpj, nit000, sshn, &
+               &              tmask(:,:,1), n2dint )
+         END DO         
+      ENDIF
+
+      !  - Sea surface temperature
+      IF ( ln_sst ) THEN
+         DO jsstset = 1, nsstsets
+            CALL obs_sst_opt( sstdatqc(jsstset),                 &
+               &              kstp, jpi, jpj, nit000, tn(:,:,1), &
+               &              tmask(:,:,1), n2dint )
+         END DO
+      ENDIF
+
+      !  - Sea surface salinity
+      IF ( ln_sss ) THEN
+         IF(lwp) WRITE(numout,*) ' SSS currently not available'
+      ENDIF
+
+#if defined key_ice_lim
+      IF ( ln_seaice ) THEN
+         DO jseaiceset = 1, nseaicesets
+            CALL obs_seaice_opt( seaicedatqc(jseaiceset),      &
+               &              kstp, jpi, jpj, nit000, 1.-frld, &
+               &              tmask(:,:,1), n2dint )
+         END DO
+      ENDIF      
+#endif
+
+      !  - Velocity profiles
+      IF ( ln_vel3d ) THEN
+         DO jveloset = 1, nvelosets
+           ! zonal component of velocity
+           CALL obs_vel_opt( veldatqc(jveloset), kstp, jpi, jpj, jpk, &
+              &              nit000, idaystp, un, vn, gdept_0, umask, vmask, &
+                             n1dint, n2dint, ld_velav(jveloset) )
+         END DO
+      ENDIF
+
+   END SUBROUTINE dia_obs
+  
+   SUBROUTINE dia_obs_wri 
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE dia_obs_wri  ***
+      !!          
+      !! ** Purpose : Call observation diagnostic output routines
+      !!
+      !! ** Method  : Call observation diagnostic output routines
+      !!
+      !! ** Action  : 
+      !!
+      !! History :
+      !!        !  06-03  (K. Mogensen) Original code
+      !!        !  06-05  (K. Mogensen) Reformatted
+      !!        !  06-10  (A. Weaver) Cleaning
+      !!        !  07-03  (K. Mogensen) General handling of profiles
+      !!        !  08-09  (M. Valdivieso) Velocity component (U,V) profiles
+      !!----------------------------------------------------------------------
+      IMPLICIT NONE
+
+      !! * Local declarations
+
+      INTEGER :: jprofset                 ! Profile data set loop variable
+      INTEGER :: jveloset                 ! Velocity data set loop variable
+      INTEGER :: jslaset                  ! SLA data set loop variable
+      INTEGER :: jsstset                  ! SST data set loop variable
+      INTEGER :: jseaiceset               ! Sea Ice data set loop variable
+      INTEGER :: jset
+      INTEGER :: jfbini
+      CHARACTER(LEN=20) :: datestr=" ",timestr=" "
+      CHARACTER(LEN=10) :: cdtmp
+      !-----------------------------------------------------------------------
+      ! Depending on switches call various observation output routines
+      !-----------------------------------------------------------------------
+
+      !  - Temperature/salinity profiles
+
+      IF( ln_t3d .OR. ln_s3d ) THEN
+
+         ! Copy data from prodatqc to profdata structures
+         DO jprofset = 1, nprofsets
+
+            CALL obs_prof_decompress( prodatqc(jprofset), &
+                 &                    profdata(jprofset), .TRUE., numout )
+
+         END DO
+
+         ! Write the profiles.
+
+         jprofset = 0
+
+         ! ENACT insitu data
+
+         IF ( ln_ena ) THEN
+           
+            jprofset = jprofset + 1
+
+            CALL obs_wri_p3d( 'enact', profdata(jprofset) )
+
+         ENDIF
+
+         ! Coriolis insitu data
+
+         IF ( ln_cor ) THEN
+            
+            jprofset = jprofset + 1
+
+            CALL obs_wri_p3d( 'corio', profdata(jprofset) )
+            
+         ENDIF
+         
+         ! Feedback insitu data
+
+         IF ( ln_profb ) THEN
+
+            jfbini = jprofset + 1
+
+            DO jprofset = jfbini, nprofsets
+               
+               jset = jprofset - jfbini + 1
+               WRITE(cdtmp,'(A,I2.2)')'profb_',jset
+               CALL obs_wri_p3d( cdtmp, profdata(jprofset) )
+
+            END DO
+
+         ENDIF
+
+      ENDIF
+
+      !  - Sea surface anomaly
+      IF ( ln_sla ) THEN
+
+         ! Copy data from sladatqc to sladata structures
+         DO jslaset = 1, nslasets
+
+              CALL obs_surf_decompress( sladatqc(jslaset), &
+                 &                    sladata(jslaset), .TRUE., numout )
+
+         END DO
+
+         jslaset = 0 
+
+         ! Write the AVISO SLA data
+
+         IF ( ln_sladt ) THEN
+            
+            jslaset = 1
+            CALL obs_wri_sla( 'aviso_act', sladata(jslaset) )
+            jslaset = 2
+            CALL obs_wri_sla( 'aviso_pas', sladata(jslaset) )
+
+         ENDIF
+
+         IF ( ln_slafb ) THEN
+            
+            jfbini = jslaset + 1
+
+            DO jslaset = jfbini, nslasets
+               
+               jset = jslaset - jfbini + 1
+               WRITE(cdtmp,'(A,I2.2)')'slafb_',jset
+               CALL obs_wri_sla( cdtmp, sladata(jslaset) )
+
+            END DO
+
+         ENDIF
+
+      ENDIF
+
+      !  - Sea surface temperature
+      IF ( ln_sst ) THEN
+
+         ! Copy data from sstdatqc to sstdata structures
+         DO jsstset = 1, nsstsets
+     
+              CALL obs_surf_decompress( sstdatqc(jsstset), &
+                 &                    sstdata(jsstset), .TRUE., numout )
+
+         END DO
+
+         jsstset = 0 
+
+         ! Write the AVISO SST data
+
+         IF ( ln_reysst ) THEN
+            
+            jsstset = jsstset + 1
+            CALL obs_wri_sst( 'reynolds', sstdata(jsstset) )
+
+         ENDIF
+
+         IF ( ln_ghrsst ) THEN
+            
+            jsstset = jsstset + 1
+            CALL obs_wri_sst( 'ghr', sstdata(jsstset) )
+
+         ENDIF
+
+         IF ( ln_sstfb ) THEN
+            
+            jfbini = jsstset + 1
+
+            DO jsstset = jfbini, nsstsets
+               
+               jset = jsstset - jfbini + 1
+               WRITE(cdtmp,'(A,I2.2)')'sstfb_',jset
+               CALL obs_wri_sst( cdtmp, sstdata(jsstset) )
+
+            END DO
+
+         ENDIF
+
+      ENDIF
+
+      !  - Sea surface salinity
+      IF ( ln_sss ) THEN
+         IF(lwp) WRITE(numout,*) ' SSS currently not available'
+      ENDIF
+
+      !  - Sea Ice Concentration
+      IF ( ln_seaice ) THEN
+
+         ! Copy data from seaicedatqc to seaicedata structures
+         DO jseaiceset = 1, nseaicesets
+
+              CALL obs_surf_decompress( seaicedatqc(jseaiceset), &
+                 &                    seaicedata(jseaiceset), .TRUE., numout )
+
+         END DO
+
+         ! Write the Sea Ice data
+         DO jseaiceset = 1, nseaicesets
+      
+            WRITE(cdtmp,'(A,I2.2)')'seaicefb_',jseaiceset
+            CALL obs_wri_seaice( cdtmp, seaicedata(jseaiceset) )
+
+         END DO
+
+      ENDIF
+      
+      ! Velocity data
+      IF( ln_vel3d ) THEN
+
+         ! Copy data from veldatqc to velodata structures
+         DO jveloset = 1, nvelosets
+
+            CALL obs_prof_decompress( veldatqc(jveloset), &
+                 &                    velodata(jveloset), .TRUE., numout )
+
+         END DO
+
+         ! Write the profiles.
+
+         jveloset = 0
+
+         ! Daily averaged data
+
+         IF ( ln_velavcur ) THEN
+            
+            jveloset = jveloset + 1
+
+            CALL obs_wri_vel( 'velavcurr', velodata(jveloset), n2dint )
+
+         ENDIF
+
+         ! High frequency data
+
+         IF ( ln_velhrcur ) THEN
+            
+            jveloset = jveloset + 1
+
+            CALL obs_wri_vel( 'velhrcurr', velodata(jveloset), n2dint )
+
+         ENDIF
+
+         ! Daily averaged data
+
+         IF ( ln_velavadcp ) THEN
+            
+            jveloset = jveloset + 1
+
+            CALL obs_wri_vel( 'velavadcp', velodata(jveloset), n2dint )
+
+         ENDIF
+
+         ! High frequency data
+
+         IF ( ln_velhradcp ) THEN
+            
+            jveloset = jveloset + 1
+            
+            CALL obs_wri_vel( 'velhradcp', velodata(jveloset), n2dint )
+               
+         ENDIF
+
+         ! Feedback velocity data
+
+         IF ( ln_velfb ) THEN
+
+            jfbini = jveloset + 1
+
+            DO jveloset = jfbini, nvelosets
+               
+               jset = jveloset - jfbini + 1
+               WRITE(cdtmp,'(A,I2.2)')'velfb_',jset
+               CALL obs_wri_vel( cdtmp, velodata(jveloset), n2dint )
+
+            END DO
+
+         ENDIF
+         
+      ENDIF
+
+   END SUBROUTINE dia_obs_wri
+
+   SUBROUTINE ini_date( ddobsini )
+      !!----------------------------------------------------------------------
+      !!                    ***  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
+      !!
+      !! History :
+      !!        !  06-03  (K. Mogensen)  Original code
+      !!        !  06-05  (K. Mogensen)  Reformatted
+      !!        !  06-10  (A. Weaver) Cleaning
+      !!        !  06-10  (G. Smith) Calculates initial date the same as method for final date
+      !!        !  10-05  (D. Lea) Update to month length calculation for NEMO vn3.2
+      !!----------------------------------------------------------------------
+      USE phycst, ONLY : &            ! Physical constants
+         & rday
+!      USE daymod, ONLY : &            ! Time variables
+!         & nmonth_len           
+      USE dom_oce, ONLY : &           ! Ocean space and time domain variables
+         & rdt
+
+      IMPLICIT NONE
+
+      !! * Arguments
+      REAL(KIND=dp), INTENT(OUT) :: ddobsini                         ! Initial date in YYYYMMDD.HHMMSS
+
+      !! * Local declarations
+      INTEGER :: iyea        ! date - (year, month, day, hour, minute)
+      INTEGER :: imon
+      INTEGER :: iday
+      INTEGER :: ihou
+      INTEGER :: imin
+      INTEGER :: imday         ! Number of days in month.
+      REAL(KIND=wp) :: zdayfrc ! Fraction of day
+
+      INTEGER, DIMENSION(12) ::   imonth_len    !: length in days of the months of the current year
+
+      !!----------------------------------------------------------------------
+      !! Initial date initialization (year, month, day, hour, minute)
+      !! (This assumes that the initial date is for 00z))
+      !!----------------------------------------------------------------------
+      iyea =   ndate0 / 10000
+      imon = ( ndate0 - iyea * 10000 ) / 100
+      iday =   ndate0 - iyea * 10000 - imon * 100
+      ihou = 0
+      imin = 0
+
+      !!----------------------------------------------------------------------
+      !! Compute number of days + number of hours + min since initial time
+      !!----------------------------------------------------------------------
+      iday = iday + ( nit000 -1 ) * rdt / rday
+      zdayfrc = ( nit000 -1 ) * rdt / rday
+      zdayfrc = zdayfrc - aint(zdayfrc)
+      ihou = int( zdayfrc * 24 )
+      imin = int( (zdayfrc * 24 - ihou) * 60 )
+
+      !!-----------------------------------------------------------------------
+      !! Convert number of days (iday) into a real date
+      !!----------------------------------------------------------------------
+
+      CALL calc_month_len( iyea, imonth_len )
+      
+      DO WHILE ( iday > imonth_len(imon) )
+         iday = iday - imonth_len(imon)
+         imon = imon + 1 
+         IF ( imon > 12 ) THEN
+            imon = 1
+            iyea = iyea + 1
+            CALL calc_month_len( iyea, imonth_len )  ! update month lengths
+         ENDIF
+      END DO
+
+      !!----------------------------------------------------------------------
+      !! Convert it into YYYYMMDD.HHMMSS format.
+      !!----------------------------------------------------------------------
+      ddobsini = iyea * 10000_dp + imon * 100_dp + &
+         &       iday + ihou * 0.01_dp + imin * 0.0001_dp
+
+
+   END SUBROUTINE ini_date
+
+   SUBROUTINE fin_date( ddobsfin )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE fin_date  ***
+      !!          
+      !! ** 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
+      !!
+      !! History :
+      !!        !  06-03  (K. Mogensen)  Original code
+      !!        !  06-05  (K. Mogensen)  Reformatted
+      !!        !  06-10  (A. Weaver) Cleaning
+      !!        !  10-05  (D. Lea) Update to month length calculation for NEMO vn3.2
+      !!----------------------------------------------------------------------
+      USE phycst, ONLY : &            ! Physical constants
+         & rday
+!      USE daymod, ONLY : &            ! Time variables
+!         & nmonth_len                
+      USE dom_oce, ONLY : &           ! Ocean space and time domain variables
+         & rdt
+
+      IMPLICIT NONE
+
+      !! * Arguments
+      REAL(KIND=dp), INTENT(OUT) :: ddobsfin                   ! Final date in YYYYMMDD.HHMMSS
+
+      !! * Local declarations
+      INTEGER :: iyea        ! date - (year, month, day, hour, minute)
+      INTEGER :: imon
+      INTEGER :: iday
+      INTEGER :: ihou
+      INTEGER :: imin
+      INTEGER :: imday         ! Number of days in month.
+      REAL(KIND=wp) :: zdayfrc       ! Fraction of day
+         
+      INTEGER, DIMENSION(12) ::   imonth_len    !: length in days of the months of the current year
+            
+      !-----------------------------------------------------------------------
+      ! Initial date initialization (year, month, day, hour, minute)
+      ! (This assumes that the initial date is for 00z)
+      !-----------------------------------------------------------------------
+      iyea =   ndate0 / 10000
+      imon = ( ndate0 - iyea * 10000 ) / 100
+      iday =   ndate0 - iyea * 10000 - imon * 100
+      ihou = 0
+      imin = 0
+      
+      !-----------------------------------------------------------------------
+      ! Compute number of days + number of hours + min since initial time
+      !-----------------------------------------------------------------------
+      iday    = iday +  nitend  * rdt / rday
+      zdayfrc =  nitend  * rdt / rday
+      zdayfrc = zdayfrc - AINT( zdayfrc )
+      ihou    = INT( zdayfrc * 24 )
+      imin    = INT( ( zdayfrc * 24 - ihou ) * 60 )
+
+      !-----------------------------------------------------------------------
+      ! Convert number of days (iday) into a real date
+      !----------------------------------------------------------------------
+
+      CALL calc_month_len( iyea, imonth_len )
+      
+      DO WHILE ( iday > imonth_len(imon) )
+         iday = iday - imonth_len(imon)
+         imon = imon + 1 
+         IF ( imon > 12 ) THEN
+            imon = 1
+            iyea = iyea + 1
+            CALL calc_month_len( iyea, imonth_len )  ! update month lengths
+         ENDIF
+      END DO
+
+      !-----------------------------------------------------------------------
+      ! Convert it into YYYYMMDD.HHMMSS format
+      !-----------------------------------------------------------------------
+      ddobsfin = iyea * 10000_dp + imon * 100_dp    + iday &
+         &     + ihou * 0.01_dp  + imin * 0.0001_dp
+
+    END SUBROUTINE fin_date
+    
+END MODULE diaobs
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/find_obs_proc.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/find_obs_proc.h90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/find_obs_proc.h90	(revision 2528)
@@ -0,0 +1,60 @@
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE find_obs_proc(kldi,klei,kldj,klej,kmyproc,kobsp,kobsi,kobsj,kno)
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE find_obs_proc ***
+      !!          
+      !! ** Purpose : From the array kobsp containing the results of the grid
+      !!              grid search on each processor the processor return a
+      !!              decision of which processors should hold the observation.
+      !!
+      !! ** Method : Use i and j and halo regions to decide which processor to 
+      !!             put ob in. Intended to avoid the mpp calls required by
+      !!             obs_mpp_find_obs_proc
+      !!
+      !! History : 
+      !!! 03-08  (D. Lea)  Original code
+      !!-----------------------------------------------------------------------
+
+      !! * Arguments
+
+      INTEGER, INTENT(IN) :: kldi               ! Start of inner domain in i
+      INTEGER, INTENT(IN) :: klei               ! End of inner domain in i
+      INTEGER, INTENT(IN) :: kldj               ! Start of inner domain in j
+      INTEGER, INTENT(IN) :: klej               ! End of inner domain in j
+
+      INTEGER, INTENT(IN) :: kmyproc
+      INTEGER, INTENT(IN) :: kno
+
+      INTEGER, DIMENSION(kno), INTENT(IN) :: kobsi
+      INTEGER, DIMENSION(kno), INTENT(IN) :: kobsj
+      INTEGER, DIMENSION(kno), INTENT(INOUT) :: kobsp
+      
+      !! * local variables
+      INTEGER :: &
+         & ji
+          
+      ! first and last indoor i- and j-indexes      kldi, klei,   kldj, klej
+      ! exclude any obs in the bottom-left overlap region
+      ! also any obs outside to whole region (defined by nlci and nlcj)
+      ! I am assuming that kobsp does not need to be the correct processor 
+      ! number
+      
+      DO ji = 1, kno
+         IF (kobsi(ji) < kldi .OR. kobsj(ji) < kldj &
+            .OR. kobsi(ji) > klei  .OR. kobsj(ji) > klej) THEN
+            IF (lwp .AND. kobsp(ji) /= -1) WRITE(numout,*) &
+               & 'kobs: ',kobsi(ji), kobsj(ji), kobsp(ji)
+            kobsp(ji)=1000000
+         ENDIF
+      END DO
+
+      ! Ensure that observations not in processor are masked
+
+      WHERE(kobsp(:) /= kmyproc) kobsp(:)=1000000
+
+   END SUBROUTINE find_obs_proc
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/greg2jul.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/greg2jul.h90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/greg2jul.h90	(revision 2528)
@@ -0,0 +1,89 @@
+   SUBROUTINE greg2jul( ksec, kmin, khour, kday, kmonth, kyear, pjulian, &
+      &                 krefdate )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  ROUTINE greg2jul  ***
+      !!
+      !! ** Purpose : Produce the time relative to the current date and time.
+      !!
+      !! ** Method  : The units are days, so hours and minutes transform to
+      !!              fractions of a day. 
+      !!
+      !!              Reference date : 19500101
+      !! ** Action  :
+      !!
+      !! History :
+      !!      ! 06-04  (A. Vidard) Original
+      !!      ! 06-04  (A. Vidard) Reformatted
+      !!      ! 06-10  (A. Weaver) Cleanup
+      !!-----------------------------------------------------------------------
+
+      ! * Arguments
+      INTEGER, INTENT(IN) :: &
+         & ksec,   &
+         & kmin,   &
+         & khour,  & 
+         & kday,   &
+         & kmonth, & 
+         & kyear
+      REAL(KIND=dp), INTENT(OUT) :: &
+         & pjulian
+      INTEGER, INTENT(IN), OPTIONAL :: &
+         & krefdate
+
+      !! * Local declarations
+      INTEGER, PARAMETER :: &
+         & jpgreg = 15 + 31 * ( 10 + 12 * 1582 ), &     ! Gregorian calendar introduction date
+         & jporef = 2433283,                      &     ! Julian reference date: 19500101
+         & jparef = 2415021,                      &     ! Julian reference date: 19000101
+         & jpgref = 2299161                             ! Julian reference date start of Gregorian calender
+      INTEGER :: &
+         & ija,     &
+         & ijy,     &
+         & ijm,     &
+         & ijultmp, &
+         & ijyear,  &
+         & iref
+      CHARACTER(len=200) :: &
+         & cerr
+
+      IF ( PRESENT( krefdate ) ) THEN
+         SELECT CASE ( krefdate )
+
+         CASE( 0 ) 
+            iref = jpgref
+
+         CASE( 19500101 )
+            iref = jporef
+
+         CASE( 19000101 )
+            iref = jparef
+
+         CASE DEFAULT
+            WRITE(cerr,'(A,I8.8)')'greg2jul: Unknown krefdate:', krefdate
+            CALL ctl_stop( cerr )
+
+         END SELECT
+
+      ELSE
+         iref = jporef 
+      ENDIF
+
+      ! Main computation
+      ijyear = kyear
+      IF ( ijyear < 0 ) ijyear = ijyear + 1
+      IF ( kmonth > 2 ) THEN
+	 ijy = ijyear
+	 ijm = kmonth + 1
+      ELSE
+	 ijy = ijyear  - 1
+	 ijm = kmonth + 13
+      ENDIF
+      ijultmp = INT( 365.25 * ijy ) + INT( 30.6001 * ijm ) + kday + 1720995
+      IF ( kday + 31 * ( kmonth + 12 * ijyear ) >= jpgreg ) THEN
+	 ija = INT( 0.01 * ijy )
+	 ijultmp = ijultmp + 2 - ija + INT( 0.25 * ija )
+      ENDIF
+      pjulian = ( ijultmp - iref ) + ( ( 60 * khour + kmin ) * 60 + ksec ) / 86400.
+
+   END SUBROUTINE greg2jul
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/grt_cir_dis.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/grt_cir_dis.h90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/grt_cir_dis.h90	(revision 2528)
@@ -0,0 +1,33 @@
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   REAL(KIND=wp) FUNCTION grt_cir_dis( pa1, pa2, pb1, pb2, pc1, pc2 )
+      !!----------------------------------------------------------------------
+      !!                     *** FUNCTION grt_cir_dis ***
+      !!
+      !! ** Purpose : Great circle distance between pts (lat1,lon1) 
+      !!               & (lat2,lon2)
+      !!                   
+      !! ** Method   : Geometry.
+      !!
+      !! History :
+      !!        !  1995-12 (G. Madec, E. Durand, A. Weaver, N. Daget) Original 
+      !!        !  2006-03 (A. Vidard) Migration to NEMOVAR 
+      !!        !  2006-10 (A. Weaver) Cleanup
+      !!----------------------------------------------------------------------
+      
+      !! * Arguments
+      REAL(KIND=wp) :: pa1   !  sin(lat1)
+      REAL(KIND=wp) :: pa2   !  sin(lat2)
+      REAL(KIND=wp) :: pb1   !  cos(lat1) * cos(lon1)
+      REAL(KIND=wp) :: pb2   !  cos(lat2) * cos(lon2)
+      REAL(KIND=wp) :: pc1   !  cos(lat1) * sin(lon1)
+      REAL(KIND=wp) :: pc2   !  cos(lat2) * sin(lon2)
+
+      grt_cir_dis = &
+         &  ASIN( SQRT( 1.0 - ( pa1 * pa2 + pb1 * pb2 + pc1 * pc2 )**2 ) )
+      
+   END FUNCTION grt_cir_dis
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/grt_cir_dis_saa.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/grt_cir_dis_saa.h90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/grt_cir_dis_saa.h90	(revision 2528)
@@ -0,0 +1,32 @@
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   REAL(KIND=wp) FUNCTION grt_cir_dis_saa( pa, pb, pc )
+      !!----------------------------------------------------------------------
+      !!                     *** FUNCTION grt_cir_dis_saa ***
+      !!
+      !! ** Purpose : Great circle distance between pts (lat1,lon1) 
+      !!               & (lat2,lon2) with a small-angle approximation
+      !!
+      !! ** Method  : Geometry
+      !!
+      !! ** Action  :
+      !!
+      !! History
+      !!      !  95-12 (G. Madec, E. Durand, A. Weaver, N. Daget) Original 
+      !!      !  06-03 (A. Vidard) Migration to NEMOVAR 
+      !!      !  06-10 (A. Weaver) Cleanup
+      !!----------------------------------------------------------------------
+      
+      !! * Arguments
+      REAL(KIND=wp) :: pa   !  lon1 - lon2
+      REAL(KIND=wp) :: pb   !  lat1 - lat2
+      REAL(KIND=wp) :: pc   !  cos(lat2)
+
+      grt_cir_dis_saa = SQRT( pa * pa + ( pb * pc )**2 )
+
+   END FUNCTION grt_cir_dis_saa
+ 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/jul2greg.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/jul2greg.h90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/jul2greg.h90	(revision 2528)
@@ -0,0 +1,114 @@
+   RECURSIVE SUBROUTINE jul2greg( ksec, kminut, khour, kday, kmonth, kyear, &
+      &                           prelday, krefdate )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  ROUTINE jul2greg  ***
+      !!
+      !! ** Purpose : Take the relative time in days and re-express in terms of
+      !!              seconds, minutes, hours, days, month, year.
+      !!
+      !! ** Method  : Reference date : 19500101
+      !!
+      !! ** Action  :
+      !!
+      !! History
+      !!      ! 06-04  (A. Vidard) Original
+      !!      ! 06-05  (A. Vidard) Reformatted and refdate      
+      !!      ! 06-10  (A. Weaver) Cleanup
+      !!-----------------------------------------------------------------------
+
+      ! * Arguments
+      INTEGER, INTENT(IN), OPTIONAL :: &
+         & krefdate
+      INTEGER, INTENT(OUT) :: &
+         & ksec,   &
+         & kminut, &
+         & khour,  &
+         & kday,   &
+         & kmonth, &
+         & kyear
+      REAL(KIND=dp), INTENT(IN) :: &
+         & prelday
+
+      !! * Local declarations
+      INTEGER, PARAMETER :: &
+         & jpgreg = 2299161, &
+         & jporef = 2433283, &
+         & jparef = 2415021
+      INTEGER :: &
+         & ijulian, &
+         & ij1,     &
+         & ija,     &
+         & ijb,     &
+         & ijc,     &
+         & ijd,     &
+         & ije,     &
+         & isec,    &
+         & imin,    &
+         & ihou,    &
+         & iday,    &
+         & imon,    &
+         & iyea,    &
+         & iref
+      REAL(KIND=wp) :: &
+         & zday, &
+         & zref
+      CHARACTER(len=200) :: &
+         & cerr
+
+      ! Main computation
+      IF ( PRESENT( krefdate ) ) THEN
+
+         SELECT CASE ( krefdate )
+
+         CASE( 0 ) 
+            iref = jpgreg
+
+         CASE( 19500101 )
+            iref = jporef
+
+         CASE( 19000101 )
+            iref = jparef
+
+         CASE DEFAULT
+            WRITE(cerr,'(A,I8.8)')'jul2greg: Unknown krefdate:', krefdate
+            CALL ctl_stop( cerr )
+
+         END SELECT
+
+      ELSE
+         iref = jporef 
+      ENDIF
+
+      zday = prelday
+      ksec = NINT( 86400. * MOD( zday, 1. ) )
+
+      IF ( ksec < 0. ) ksec = 86400. + ksec
+
+      khour  = ksec / 3600
+      kminut = ( ksec - 3600 * khour ) / 60
+      ksec   = MOD( ksec , 60 )
+
+      ijulian = iref + INT( zday )
+      IF ( zday < 0. ) ijulian = ijulian - 1
+
+      ! If input date after 10/15/1582 :
+      IF ( ijulian >= jpgreg ) THEN
+	 ij1 = INT( ( DBLE( ijulian - 1867216 ) - 0.25 ) / 36524.25 )
+	 ija = ijulian + 1 + ij1 - INT( ( 0.25 * ij1 ) )
+      ELSE
+	 ija = ijulian
+      ENDIF
+
+      ijb = ija + 1524
+      ijc = INT( 6680. + ( DBLE ( ijb - 2439870 ) - 122.1 ) / 365.25 )
+      ijd = 365 * ijc + INT( 0.25 * ijc )
+      ije = INT( ( ijb - ijd ) / 30.6001 )
+      kday = ijb - ijd - INT( 30.6001 * ije )
+      kmonth = ije - 1
+      IF ( kmonth > 12 ) kmonth = kmonth - 12
+      kyear = ijc - 4715
+      IF ( kmonth > 2 ) kyear = kyear - 1
+      IF ( kyear <= 0 ) kyear = kyear - 1
+
+   END SUBROUTINE jul2greg
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/julian.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/julian.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/julian.F90	(revision 2528)
@@ -0,0 +1,30 @@
+MODULE julian
+   !!======================================================================
+   !!                       ***  MODULE julian   ***
+   !! Ocean          : Julian data utilities
+   !!=====================================================================
+
+   !!----------------------------------------------------------------------
+   !!   jul2greg        : Convert relative time to date
+   !!   greg2jul        : Convert date to relative time
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE par_kind, ONLY : &       ! Precision variables
+      & wp, &
+      & dp  
+   USE in_out_manager           ! I/O manager
+  
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+   PUBLIC jul2greg,        &  ! Convert relative time to date
+      &   greg2jul            ! Convert date to relative time 
+  
+CONTAINS
+ 
+#include "jul2greg.h90"
+
+#include "greg2jul.h90"
+   
+END MODULE julian
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/linquad.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/linquad.h90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/linquad.h90	(revision 2528)
@@ -0,0 +1,59 @@
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   LOGICAL FUNCTION linquad( px, py, pxv, pyv )
+      !!----------------------------------------------------------------------
+      !!                    ***  FUNCTION linquad ***
+      !!
+      !! ** Purpose : Determine whether a point P(x,y) lies within or on the
+      !!              boundary of a quadrangle (ABCD) of any shape on a plane.
+      !!
+      !! ** Method  : Check if the vectorial products PA x PC, PB x PA, 
+      !!              PC x PD, and PD x PB are all negative.
+      !!
+      !! ** Action  : 
+      !!
+      !! History :
+      !!        !  2001-11  (N. Daget, A. Weaver)
+      !!        !  2006-08  (A. Weaver) NEMOVAR migration
+      !!        !  2006-10  (A. Weaver) Cleanup
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+      REAL(KIND=wp), INTENT(IN) :: px        ! (lon) of the point P(x,y) 
+      REAL(KIND=wp), INTENT(IN) :: py        ! (lat) of the point P(x,y)               
+      REAL(KIND=wp), DIMENSION(4), INTENT(IN) :: &
+         & pxv,  &                  ! (lon, lat) of the surrounding cell
+         & pyv                     
+  
+      !! * Local declarations
+      REAL(KIND=wp) :: zst1
+      REAL(KIND=wp) :: zst2
+      REAL(KIND=wp) :: zst3
+      REAL(KIND=wp) :: zst4
+
+      !-----------------------------------------------------------------------
+      ! Test to see if the point is within the cell
+      !-----------------------------------------------------------------------
+      linquad = .FALSE.
+      zst1 =   ( px - pxv(1) ) * ( py - pyv(4) ) &
+         &   - ( py - pyv(1) ) * ( px - pxv(4) )
+      IF ( zst1 <= 0.0 ) THEN
+         zst2 =   ( px - pxv(4) ) * ( py - pyv(3) ) &
+         &   - ( py - pyv(4) ) * ( px - pxv(3) )
+         IF ( zst2 <= 0.0 ) THEN
+            zst3 =   ( px - pxv(3) ) * ( py - pyv(2) ) &
+               &   - ( py - pyv(3) ) * ( px - pxv(2) )
+            IF ( zst3 <= 0.0) THEN
+               zst4 =   ( px - pxv(2) ) * ( py - pyv(1) ) &
+                  &   - ( py - pyv(2) ) * ( px - pxv(1) )
+               IF ( zst4 <= 0.0 ) linquad = .TRUE.
+            ENDIF
+         ENDIF
+      ENDIF
+
+   END FUNCTION linquad
+
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/maxdist.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/maxdist.h90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/maxdist.h90	(revision 2528)
@@ -0,0 +1,76 @@
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   REAL FUNCTION maxdist( pxv, pyv )
+      !!----------------------------------------------------------------------
+      !!                    ***  FUNCTION maxdist ***
+      !!
+      !! ** Purpose : Compute the maximum distance between any points within
+      !!              a cell
+      !!
+      !! ** Method  : Call to grt_cir_dis
+      !!
+      !! ** Action  : 
+      !!
+      !! History :
+      !!        !  2006-08  (K. Mogensen)
+      !!        !  2006-10  (A. Weaver) Cleanup
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+      REAL(KIND=wp), DIMENSION(4), INTENT(IN) :: &
+          & pxv, &                 ! (lon, lat) of the surrounding cell
+          & pyv    
+
+      !! * Local declarations
+      REAL(KIND=wp), DIMENSION(4) :: &
+          &  zxv, &
+          &  zyv, &
+          &  za,  &
+          &  zb,  &
+          &  zc
+      REAL(KIND=wp) :: zdist
+      
+      INTEGER :: ji
+      INTEGER :: jj
+      
+      !-----------------------------------------------------------------------
+      ! Convert data to radians
+      !-----------------------------------------------------------------------
+      DO ji = 1, 4
+         zxv(ji) = pxv(ji) * rad
+         zyv(ji) = pyv(ji) * rad
+      END DO
+
+      !-----------------------------------------------------------------------
+      ! Prepare input to grt_cir_dis
+      !-----------------------------------------------------------------------
+      DO ji = 1, 4
+         za(ji) = SIN( zyv(ji) )
+         zb(ji) = COS( zyv(ji) ) * COS( zxv(ji) )
+         zc(ji) = COS( zyv(ji) ) * SIN( zxv(ji) )
+      END DO
+      
+      !-----------------------------------------------------------------------
+      ! Get max distance between any points in the area
+      !-----------------------------------------------------------------------
+      maxdist = 0.0
+      DO jj = 1, 4
+         DO ji = jj+1, 4
+            zdist = grt_cir_dis( za(jj), za(ji), zb(jj), &
+               &                 zb(ji), zc(jj), zc(ji))
+            IF ( zdist > maxdist ) THEN
+               maxdist = zdist
+            ENDIF
+         END DO
+      END DO
+      
+      !-----------------------------------------------------------------------
+      ! Convert to degrees.
+      !-----------------------------------------------------------------------
+      maxdist = maxdist / rad
+
+   END FUNCTION maxdist
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/mpp_map.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/mpp_map.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/mpp_map.F90	(revision 2528)
@@ -0,0 +1,84 @@
+MODULE mpp_map
+   !!======================================================================
+   !!                       ***  MODULE mpp_mpa  ***
+   !! NEMOVAR: MPP global grid point mapping to processors
+   !!======================================================================
+   !! History :  2.0  ! 2007-08  (K. Mogensen)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!  mppmap_init : Initialize mppmap.
+   !!----------------------------------------------------------------------
+   USE par_kind, ONLY :   wp            ! Precision variables
+   USE par_oce , ONLY :   jpi, jpj      ! Ocean parameters
+   USE dom_oce , ONLY :   mig, mjg, nldi, nlei, nldj, nlej, narea   ! Ocean space and time domain variables
+#if defined key_mpp_mpi
+   USE lib_mpp, ONLY :   mpi_comm_opa   ! MPP library
+#endif
+   USE in_out_manager   ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC ::   mppmap_init, mppmap   !: ???
+
+   INTEGER, DIMENSION(:,:), ALLOCATABLE ::   mppmap   ! ???
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE mppmap_init
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE mppmap_init ***
+      !!          
+      !! ** Purpose : Setup a global map of processor rank for all gridpoints
+      !!
+      !! ** Method  : MPI all reduce.
+      !!
+      !! ** Action  : This does only work for MPI. 
+      !!
+      !! References : http://www.mpi-forum.org
+      !!----------------------------------------------------------------------
+      INTEGER, DIMENSION(:,:), ALLOCATABLE ::   imppmap   !
+#if defined key_mpp_mpi
+      INTEGER :: ierr
+
+INCLUDE 'mpif.h'
+#endif
+      !!----------------------------------------------------------------------
+
+      ALLOCATE( &
+         & mppmap(jpiglo,jpjglo) &
+         & )
+
+      ! Initialize local imppmap
+
+      ALLOCATE( &
+         & imppmap(jpiglo,jpjglo) &
+         & )
+      imppmap(:,:) = 0
+
+      ! Setup local grid points
+      imppmap(mig(nldi):mig(nlei),mjg(nldj):mjg(nlej)) = narea 
+      
+      ! Get global data
+
+#if defined key_mpp_mpi
+
+      ! Call the MPI library to find the max across processors
+      CALL mpi_allreduce( imppmap, mppmap, jpiglo*jpjglo, mpi_integer,   &
+         &                mpi_max, mpi_comm_opa, ierr )
+#else      
+      
+      ! No MPP: Just copy the data
+      mppmap(:,:) = imppmap(:,:)
+#endif
+      !
+   END SUBROUTINE mppmap_init
+
+   !!======================================================================
+END MODULE mpp_map
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_const.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_const.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_const.F90	(revision 2528)
@@ -0,0 +1,23 @@
+MODULE obs_const
+   !!=====================================================================
+   !!                       ***  MODULE obs_const  ***
+   !! Observation diagnostics: Constants used by many modules
+   !!===================================================================== 
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   !! * Modules used
+   USE par_kind, ONLY : & ! Precision variables
+      & sp         
+   IMPLICIT NONE
+
+   !! * Routine/type accessibility
+   PUBLIC
+
+   REAL(kind=sp), PARAMETER :: obfillflt=99999.
+
+END MODULE obs_const
+
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_conv.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_conv.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_conv.F90	(revision 2528)
@@ -0,0 +1,46 @@
+MODULE obs_conv
+   !!=====================================================================
+   !!                       ***  MODULE  obs_conv  ***
+   !! Observation diagnostics: Various conversion functions
+   !!=====================================================================
+   !!
+   !!   potemp   : Compute potential temperature from insitu temperature,
+   !!              salinity and pressure
+   !!   fspott   : Compute potential temperature from insitu temperature,
+   !!              salinity and pressure
+   !!   atg      : Compute adiabatic temperature gradient deg c per decibar
+   !!   theta    : Compute potential temperature from insitu temperature,
+   !!              salinity and pressure
+   !!   depth    : Compute depth from pressure and latitude.
+   !!   p_to_dep : Compute depth from pressure and latitude 
+   !!              (approximate version)
+   !!   dep_to_p : Compute pressure from depth and latitude 
+   !!              (approximate version)
+   !!---------------------------------------------------------------------
+   !! * Modules used
+   USE par_kind, ONLY : & ! Precision variables
+      & wp   
+   IMPLICIT NONE
+ 
+   !! * Function accessibility
+   PRIVATE
+   PUBLIC &
+      & potemp,   &
+      & fspott,   &
+      & atg,      &
+      & theta,    &
+      & depth,    &
+      & p_to_dep, &
+      & dep_to_p
+   
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#include "obs_conv_functions.h90"
+
+END MODULE obs_conv
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_conv_functions.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_conv_functions.h90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_conv_functions.h90	(revision 2528)
@@ -0,0 +1,294 @@
+    !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+  REAL(KIND=wp) FUNCTION potemp( ps, pt, pp, ppr )
+      !!----------------------------------------------------------------------
+      !!                    ***  FUNCTION potemp  ***
+      !!          
+      !! ** Purpose : Compute potential temperature
+      !!
+      !! ** Method  : A regression formula is used. 
+      !!
+      !! ** Action  : The code is kept as close to the F77 code as possible
+      !!              Check value: potemp(35,20,2000,0) = 19.621967
+      !!
+      !! References : T. J. Mcdougall, D. R. Jackett, D. G. Wright 
+      !!              and R. Feistel
+      !!              Accurate and computationally efficient algoritms for
+      !!              potential temperatures and density of seawater
+      !!              Journal of atmospheric and oceanic technology
+      !!              Vol 20, 2003, pp 730-741
+      !!              
+      !!
+      !! History :
+      !!        !  07-05 (K. Mogensen) Original code
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+
+      REAL(KIND=wp), INTENT(IN) :: ps
+      REAL(KIND=wp), INTENT(IN) :: pt
+      REAL(KIND=wp), INTENT(IN) :: pp
+      REAL(KIND=wp), INTENT(IN) :: ppr
+
+      !! * Local declarations
+      REAL(KIND=wp) :: zpol
+      REAL(KIND=wp), PARAMETER :: a1 =  1.067610e-05
+      REAL(KIND=wp), PARAMETER :: a2 = -1.434297e-06
+      REAL(KIND=wp), PARAMETER :: a3 = -7.566349e-09
+      REAL(KIND=wp), PARAMETER :: a4 = -8.535585e-06
+      REAL(KIND=wp), PARAMETER :: a5 =  3.074672e-08
+      REAL(KIND=wp), PARAMETER :: a6 =  1.918639e-08
+      REAL(KIND=wp), PARAMETER :: a7 =  1.788718e-10
+
+      zpol = a1 + a2 * ps + a3 * ( pp + ppr ) + a4 * pt &
+         & + a5 * ps * pt + a6 * pt * pt + a7 * pt * ( pp + ppr )
+      
+      potemp = pt + ( pp - ppr ) * zpol
+      
+   END FUNCTION potemp
+
+   REAL(KIND=wp) FUNCTION fspott( pft, pfs, pfp )
+      !!----------------------------------------------------------------------
+      !!                    ***  FUNCTION fspott  ***
+      !!          
+      !! ** Purpose : Compute potential temperature
+      !!
+      !! ** Method  : A regression formula is used. 
+      !!
+      !! ** Action  : Check value: fspott(10,25,1000) = 8.4678516
+      !!
+      !! References : A. E. Gill
+      !!              Atmosphere-Ocean Dynamics
+      !!              Volume 30 (International Geophysics)
+      !!
+      !! History :
+      !!        !  07-05 (K. Mogensen) NEMO adopting of OPAVAR code.
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+      REAL(KIND=wp) :: pft   ! in situ temperature in degrees celcius
+      REAL(KIND=wp) :: pfs   ! salinity in psu
+      REAL(KIND=wp) :: pfp   ! pressure in bars
+      
+      fspott = &
+         &  pft - pfp * (   (            3.6504e-4                     &
+         &                    + pft * (  8.3198e-5                     &
+         &                    + pft * ( -5.4065e-7                     &
+         &                    + pft *    4.0274e-9  ) ) )              &
+         &                + ( pfs - 35.0 ) * (         1.7439e-5       &
+         &                                     - pft * 2.9778e-7 )     &
+         &                + pfp * (            8.9309e-7               &
+         &                          + pft * ( -3.1628e-8               &
+         &                          + pft *    2.1987e-10 )            &
+         &                          - ( pfs - 35.0 ) *  4.1057e-9      &
+         &                          + pfp * (          -1.6056e-10     &
+         &                                    + pft * 5.0484e-12 ) ) )
+
+   END FUNCTION fspott
+
+   REAL(KIND=wp) FUNCTION atg( p_s, p_t, p_p )
+      !!----------------------------------------------------------------------
+      !!                    ***  FUNCTION atg  ***
+      !!          
+      !! ** Purpose : Compute adiabatic temperature gradient deg c per decibar
+      !!
+      !! ** Method  : A regression formula is used
+      !!
+      !! ** Action  : The code is kept as close to the F77 code as possible
+      !!              Check value: atg(40,40,10000) = 3.255974e-4
+      !!
+      !! References : N. P. Fotonoff and R.C. Millard jr., 
+      !!              Algoritms for computation of fundamental
+      !!              properties of seawater
+      !!              Unesco technical papers in marine science 44
+      !!              Unesco 1983
+      !!
+      !! History :
+      !!        !  07-05 (K. Mogensen) Original code based on the F77 code.
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+
+      REAL(KIND=wp), INTENT(IN) :: p_s    ! Salinity in PSU
+      REAL(KIND=wp), INTENT(IN) :: p_t    ! Temperature in centigrades
+      REAL(KIND=wp), INTENT(IN) :: p_p    ! Pressure in decibars.
+
+      !! * Local declarations
+      
+      REAL(KIND=wp) :: z_ds
+
+      z_ds = p_s - 35.0
+      atg = ((( -2.1687e-16 * p_t + 1.8676e-14 ) * p_t - 4.6206e-13 ) * p_p      &
+         &  + (( 2.7759e-12 * p_t - 1.1351e-10 ) * z_ds + (( - 5.4481e-14 * p_t  &  
+         &  + 8.733e-12 ) * p_t - 6.7795e-10 ) * p_t  + 1.8741e-8)) * p_p        &
+         &  + ( -4.2393e-8 * p_t + 1.8932e-6 ) * z_ds                          &
+         &  + (( 6.6228e-10 * p_t - 6.836e-8 ) * p_t + 8.5258e-6 ) * p_t + 3.5803e-5
+
+   END FUNCTION atg
+      
+   REAL(KIND=wp) FUNCTION theta( p_s, p_t0, p_p0, p_pr )
+      !!----------------------------------------------------------------------
+      !!                    ***  FUNCTION theta  ***
+      !!          
+      !! ** Purpose : Compute potential temperature
+      !!
+      !! ** Method  : A regression formula is used. 
+      !!
+      !! ** Action  : The code is kept as close to the F77 code as possible
+      !!              Check value: theta(40,40,10000,0) = 36.89073
+      !!
+      !! References : N. P. Fotonoff and R.C. Millard jr., 
+      !!              Algoritms for computation of fundamental
+      !!              properties of seawater
+      !!              Unesco technical papers in marine science 44
+      !!              Unesco 1983
+      !!
+      !! History :
+      !!        !  07-05 (K. Mogensen) Original code based on the F77 code.
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+      REAL(KIND=wp), INTENT(IN) :: p_s
+      REAL(KIND=wp), INTENT(IN) :: p_t0
+      REAL(KIND=wp), INTENT(IN) :: p_p0
+      REAL(KIND=wp), INTENT(IN) :: p_pr
+
+      !! * Local declarations
+      REAL(KIND=wp) :: z_p
+      REAL(KIND=wp) :: z_t
+      REAL(KIND=wp) :: z_h
+      REAL(KIND=wp) :: z_xk
+      REAL(KIND=wp) :: z_q
+
+      z_p = p_p0
+      z_t = p_t0
+      z_h = p_pr - z_p
+      z_xk = z_h * atg( p_s, z_t, z_p ) 
+      Z_t = z_t + 0.5 * z_xk
+      z_q = z_xk
+      z_p = z_p + 0.5 * z_h
+      z_xk = z_h * atg( p_s, z_t, z_p )
+      z_t = z_t + 0.29289322 * ( z_xk - z_q )
+      z_q = 0.58578644 * z_xk + 0.121320344 * z_q
+      z_xk = z_h * atg( p_s, z_t, z_p )
+      z_t = z_t + 1.707106781 * ( z_xk - z_q )
+      z_q = 3.414213562 * z_xk - 4.121320244 * z_q
+      z_p = z_p + 0.5 * z_h
+      z_xk = z_h * atg( p_s, z_t, z_p )
+      theta = z_t + ( z_xk - 2.0 * z_q ) / 6.0
+
+   END FUNCTION theta
+
+   REAL(KIND=wp) FUNCTION depth( p_p, p_lat )
+      !!----------------------------------------------------------------------
+      !!                    ***  FUNCTION depth  ***
+      !!          
+      !! ** Purpose : Compute depth from pressure and latitudes
+      !!
+      !! ** Method  : A regression formula is used. 
+      !!
+      !! ** Action  : The code is kept as close to the F77 code as possible
+      !!              Check value: depth(10000,30) = 9712.653
+      !!
+      !! References : N. P. Fotonoff and R.C. Millard jr., 
+      !!              Algoritms for computation of fundamental
+      !!              properties of seawater
+      !!              Unesco technical papers in marine science 44
+      !!              Unesco 1983
+      !!
+      !! History :
+      !!        !  07-05 (K. Mogensen) Original code based on the F77 code.
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+      REAL(KIND=wp), INTENT(IN) :: p_p     ! Pressure in decibars
+      REAL(KIND=wp), INTENT(IN) :: p_lat   ! Latitude in degrees
+
+      !! * Local declarations
+      REAL(KIND=wp) :: z_x
+      REAL(KIND=wp) :: z_gr
+      
+      z_x = SIN( p_lat / 57.29578 )
+      z_x = z_x * z_x
+      z_gr = 9.780318 * ( 1.0 + ( 5.2788e-3 + 2.36e-5 * z_x ) * z_x ) + 1.092e-6 * p_p
+      depth = ((( -1.82e-15 * p_p + 2.279e-10 ) * p_p - 2.2512e-5 ) * p_p + 9.72659 ) * p_p
+      depth = depth / z_gr
+
+   END FUNCTION depth
+
+   REAL(KIND=wp) FUNCTION p_to_dep( p_p, p_lat )
+      !!----------------------------------------------------------------------
+      !!                    ***  FUNCTION p_to_dep  ***
+      !!          
+      !! ** Purpose : Compute depth from pressure and latitudes
+      !!
+      !! ** Method  : A regression formula is used. This version is less
+      !!              accurate the "depth" but invertible.
+      !!
+      !! ** Action  : 
+      !!
+      !! References : P.M Saunders
+      !!              Pratical conversion of pressure to depth
+      !!              Journal of physical oceanography Vol 11, 1981, pp 573-574
+      !!
+      !! History :
+      !!        !  07-05  (K. Mogensen) Original code
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+      REAL(KIND=wp), INTENT(IN) :: p_p    ! Pressure in decibars
+      REAL(KIND=wp), INTENT(IN) :: p_lat  ! Latitude in degrees
+
+      !! * Local declarations
+      REAL(KIND=wp) :: z_x
+      REAL(KIND=wp) :: z_c1
+      REAL(KIND=wp) :: z_c2
+
+      z_x = SIN( p_lat / 57.29578 )
+      z_x = z_x * z_x
+      z_c1 = ( 5.92  + 5.25 * z_x ) * 1e-3 
+      z_c2 = 2.21e-6 
+      p_to_dep = (1 - z_c1)  * p_p - z_c2 * p_p * p_p
+
+   END FUNCTION p_to_dep
+
+   REAL(KIND=wp) FUNCTION dep_to_p( p_dep, p_lat )
+      !!----------------------------------------------------------------------
+      !!                    ***  FUNCTION dep_to_p  ***
+      !!          
+      !! ** Purpose : Compute depth from pressure and latitudes
+      !!
+      !! ** Method  : The expression used in p_to_dep is inverted.
+      !!
+      !! ** Action  : 
+      !!
+      !! References : P.M Saunders
+      !!              Pratical conversion of pressure to depth
+      !!              Journal of physical oceanography Vol 11, 1981, pp 573-574
+      !!
+      !! History :
+      !!        !  07-05  (K. Mogensen) Original code
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+      REAL(KIND=wp), INTENT(IN) :: p_dep    ! Depth in meters
+      REAL(KIND=wp), INTENT(IN) :: p_lat    ! Latitude in degrees
+
+      !! * Local declarations
+      REAL(KIND=wp) :: z_x
+      REAL(KIND=wp) :: z_c1
+      REAL(KIND=wp) :: z_c2
+      REAL(KIND=wp) :: z_d
+
+      z_x = SIN( p_lat / 57.29578 )
+      z_x = z_x * z_x
+      z_c1 = ( 5.92  + 5.25 * z_x ) * 1e-3 
+      z_c2 = 2.21e-6 
+      z_d = ( z_c1 - 1 ) * ( z_c1 - 1  ) - 4 * z_c2 * p_dep
+      dep_to_p = (( 1 - z_c1 ) - SQRT( z_d )) / ( 2 * z_c2 )
+
+   END FUNCTION dep_to_p
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_fbm.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_fbm.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_fbm.F90	(revision 2528)
@@ -0,0 +1,1998 @@
+MODULE obs_fbm
+   !!======================================================================
+   !!                       ***  MODULE obs_fbm  ***
+   !! Observation operators : I/O + tools for feedback files
+   !!======================================================================
+   !! History : 
+   !!             !  08-11  (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   init_obfbdata     :  Initialize sizes in obfbdata structure
+   !!   alloc_obfbdata    :  Allocate data in an obfbdata structure
+   !!   dealloc_obfbdata  :  Dellocate data in an obfbdata structure
+   !!   copy_obfbdata     :  Copy an obfbdata structure
+   !!   subsamp_obfbdata  :  Sumsample an obfbdata structure
+   !!   merge_obfbdata    :  Merge multiple obfbdata structures into an one.
+   !!   write_obfbdata    :  Write an obfbdata structure into a netCDF file.
+   !!   read_obfbdata     :  Read an obfbdata structure from a netCDF file.
+   !!----------------------------------------------------------------------
+   USE netcdf
+   USE obs_utils      ! Various utilities for observation operators
+
+   IMPLICIT NONE
+   PUBLIC
+
+   ! Type kinds for feedback data.
+
+   INTEGER, PARAMETER :: fbsp = SELECTED_REAL_KIND( 6, 37) !: single precision
+   INTEGER, PARAMETER :: fbdp = SELECTED_REAL_KIND(12,307) !: double precision
+
+   ! Parameters for string lengths.
+
+   INTEGER, PARAMETER    :: ilenwmo  = 8    !: Length of station identifier
+   INTEGER, PARAMETER    :: ilentyp  = 4    !: Length of type
+   INTEGER, PARAMETER    :: ilenname = 8    !: Length of variable names
+   INTEGER, PARAMETER    :: ilengrid = 1    !: Grid (e.g. 'T') length
+   INTEGER, PARAMETER    :: ilenjuld = 14   !: Lenght of reference julian date
+   INTEGER, PARAMETER    :: idefnqcf = 2    !: Default number of words in QC
+                                            !  flags
+   INTEGER, PARAMETER    :: ilenlong = 128  !: Length of long name
+   INTEGER, PARAMETER    :: ilenunit = 32   !: Length of units
+   
+   ! Missinge data indicators 
+   
+   INTEGER, PARAMETER    :: fbimdi = -99999   !: Integers
+   REAL(fbsp), PARAMETER :: fbrmdi =  99999   !: Reals
+   
+   ! Main data structure for observation feedback data.
+
+   TYPE obfbdata
+      LOGICAL :: lalloc         !: Allocation status for data
+      LOGICAL :: lgrid          !: Include grid search info
+      INTEGER :: nvar           !: Number of variables
+      INTEGER :: nobs           !: Number of observations
+      INTEGER :: nlev           !: Number of levels
+      INTEGER :: nadd           !: Number of additional entries
+      INTEGER :: next           !: Number of extra variables
+      INTEGER :: nqcf           !: Number of words per qc flag
+      CHARACTER(LEN=ilenwmo), DIMENSION(:), POINTER :: &
+         & cdwmo                !: Identifier
+      CHARACTER(LEN=ilentyp), DIMENSION(:), POINTER :: &
+         & cdtyp                !: Instrument type
+      CHARACTER(LEN=ilenjuld) :: &
+         & cdjuldref            !: Julian date reference
+      INTEGER, DIMENSION(:), POINTER :: &
+         & kindex               !: Index of observations in the original file
+      INTEGER, DIMENSION(:), POINTER :: &
+         & ioqc, &              !: Observation QC
+         & ipqc, &              !: Position QC
+         & itqc                 !: Time QC
+      INTEGER, DIMENSION(:,:), POINTER :: &
+         & ioqcf, &             !: Observation QC flags
+         & ipqcf, &             !: Position QC flags
+         & itqcf                !: Time QC flags
+      INTEGER, DIMENSION(:,:), POINTER :: &
+         & idqc                 !: Depth QC
+      INTEGER, DIMENSION(:,:,:), POINTER :: &
+         & idqcf                !: Depth QC flags
+      REAL(KIND=fbdp), DIMENSION(:), POINTER :: &
+         & plam, &              !: Longitude
+         & pphi, &              !: Latitude
+         & ptim                 !: Time
+      REAL(KIND=fbsp), DIMENSION(:,:), POINTER :: &
+         & pdep                 !: Depth
+      CHARACTER(LEN=ilenname), DIMENSION(:), POINTER  :: &
+         & cname                !: Name of variable
+      REAL(fbsp), DIMENSION(:,:,:), POINTER :: &
+         & pob                  !: Observation
+      CHARACTER(LEN=ilenlong), DIMENSION(:), POINTER :: &
+         & coblong              !: Observation long name (for output)
+      CHARACTER(LEN=ilenunit), DIMENSION(:), POINTER :: &
+         & cobunit              !: Observation units (for output)
+      INTEGER, DIMENSION(:,:), POINTER :: &
+         & ivqc                 !: Variable QC
+      INTEGER, DIMENSION(:,:,:), POINTER :: &
+         & ivqcf                !: Variable QC flags
+      INTEGER, DIMENSION(:,:,:), POINTER :: &
+         & ivlqc                !: Variable level QC
+      INTEGER, DIMENSION(:,:,:,:), POINTER :: &
+         & ivlqcf               !: Variable level QC flags
+      INTEGER, DIMENSION(:,:), POINTER :: &
+         & iproc, &             !: Processor of obs (no I/O for this variable).
+         & iobsi, &             !: Global i index
+         & iobsj                !: Global j index
+      INTEGER, DIMENSION(:,:,:), POINTER :: &
+         & iobsk                !: k index
+      CHARACTER(LEN=ilengrid), DIMENSION(:), POINTER  :: &
+         & cgrid                !: Grid for this variable
+      CHARACTER(LEN=ilenname), DIMENSION(:), POINTER :: &
+         & caddname             !: Additional entries names
+      CHARACTER(LEN=ilenlong), DIMENSION(:,:), POINTER :: &
+         & caddlong             !: Additional entries long name (for output)
+      CHARACTER(LEN=ilenunit), DIMENSION(:,:), POINTER :: &
+         & caddunit             !: Additional entries units (for output)
+      REAL(fbsp), DIMENSION(:,:,:,:)   , POINTER :: &
+         & padd                 !: Additional entries
+      CHARACTER(LEN=ilenname), DIMENSION(:), POINTER :: &
+         & cextname             !: Extra variables names
+      CHARACTER(LEN=ilenlong), DIMENSION(:), POINTER :: &
+         & cextlong             !: Extra variables long name (for output)
+      CHARACTER(LEN=ilenunit), DIMENSION(:), POINTER :: &
+         & cextunit             !: Extra variables units (for output)
+      REAL(fbsp), DIMENSION(:,:,:)   , POINTER :: &
+         & pext                 !: Extra variables
+   END TYPE obfbdata
+
+   PRIVATE putvaratt_obfbdata
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE init_obfbdata( fbdata )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE init_obfbdata  ***
+      !!
+      !! ** Purpose :   Initialize sizes in obfbdata structure
+      !!
+      !! ** Method  :   
+      !!
+      !! ** Action  : 
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      TYPE(obfbdata) :: fbdata      ! obsfbdata structure
+
+      fbdata%nvar   = 0
+      fbdata%nobs   = 0
+      fbdata%nlev   = 0
+      fbdata%nadd   = 0
+      fbdata%next   = 0
+      fbdata%nqcf   = idefnqcf
+      fbdata%lalloc = .FALSE.
+      fbdata%lgrid  = .FALSE.
+
+   END SUBROUTINE init_obfbdata
+   
+   SUBROUTINE alloc_obfbdata( fbdata, kvar, kobs, klev, kadd, kext, lgrid, &
+      &                       kqcf)
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE alloc_obfbdata  ***
+      !!
+      !! ** Purpose :   Allocate data in an obfbdata structure
+      !!
+      !! ** Method  :   
+      !!
+      !! ** Action  : 
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      TYPE(obfbdata) ::  fbdata          ! obsfbdata structure to be allocated
+      INTEGER, INTENT(IN) :: kvar        ! Number of variables
+      INTEGER, INTENT(IN) :: kobs        ! Number of observations
+      INTEGER, INTENT(IN) :: klev        ! Number of levels
+      INTEGER, INTENT(IN) :: kadd        ! Number of additional entries
+      INTEGER, INTENT(IN) :: kext        ! Number of extra variables
+      LOGICAL, INTENT(IN) :: lgrid       ! Include grid search information
+      INTEGER, OPTIONAL ::  kqcf         ! Number of words for QC flags
+      !! * Local variables
+      INTEGER :: ji
+      INTEGER :: jv
+
+      ! Check allocation status and deallocate previous allocated structures
+
+      IF ( fbdata%lalloc ) THEN
+         CALL dealloc_obfbdata( fbdata )
+      ENDIF
+
+      ! Set dimensions
+
+      fbdata%lalloc = .TRUE.
+      fbdata%nvar   = kvar
+      fbdata%nobs   = kobs
+      fbdata%nlev   = MAX( klev, 1 )
+      fbdata%nadd   = kadd
+      fbdata%next   = kext
+      IF ( PRESENT(kqcf) ) THEN
+         fbdata%nqcf = kqcf
+      ELSE
+         fbdata%nqcf = idefnqcf
+      ENDIF
+
+      ! Set data not depending on number of observations
+
+      fbdata%cdjuldref  = REPEAT( 'X', ilenjuld )
+
+      ! Allocate and initialize standard data 
+
+      ALLOCATE( &
+         & fbdata%cname(fbdata%nvar),   &
+         & fbdata%coblong(fbdata%nvar), &
+         & fbdata%cobunit(fbdata%nvar)  &
+         & )
+      DO ji = 1, fbdata%nvar
+         WRITE(fbdata%cname(ji),'(A,I2.2)')'V_',ji
+         fbdata%coblong(ji) = REPEAT( ' ', ilenlong )
+         fbdata%cobunit(ji) = REPEAT( ' ', ilenunit )
+      END DO
+
+      ! Optionally also store grid search information
+      
+      IF ( lgrid ) THEN
+         ALLOCATE ( &
+            & fbdata%cgrid(fbdata%nvar) &
+            & )
+         fbdata%cgrid(:)      = REPEAT( 'X', ilengrid )
+         fbdata%lgrid         = .TRUE.
+      ENDIF
+         
+      ! Allocate and initialize additional entries if present
+         
+      IF ( fbdata%nadd > 0 ) THEN
+         ALLOCATE( &
+            & fbdata%caddname(fbdata%nadd),              &
+            & fbdata%caddlong(fbdata%nadd, fbdata%nvar), &
+            & fbdata%caddunit(fbdata%nadd, fbdata%nvar)  &
+            & )
+         DO ji = 1, fbdata%nadd
+            WRITE(fbdata%caddname(ji),'(A,I2.2)')'A',ji
+         END DO
+         DO jv = 1, fbdata%nvar
+            DO ji = 1, fbdata%nadd
+               fbdata%caddlong(ji,jv) = REPEAT( ' ', ilenlong )
+               fbdata%caddunit(ji,jv) = REPEAT( ' ', ilenunit )
+            END DO
+         END DO
+      ENDIF
+         
+      ! Allocate and initialize additional variables if present
+         
+      IF ( fbdata%next > 0 ) THEN
+         ALLOCATE( &
+            & fbdata%cextname(fbdata%next), &
+            & fbdata%cextlong(fbdata%next), &
+            & fbdata%cextunit(fbdata%next)  &
+            & )
+         DO ji = 1, fbdata%next
+            WRITE(fbdata%cextname(ji),'(A,I2.2)')'E_',ji
+            fbdata%cextlong(ji) = REPEAT( ' ', ilenlong )
+            fbdata%cextunit(ji) = REPEAT( ' ', ilenunit )
+         END DO
+      ENDIF
+
+      ! Data depending on number of observations is only allocated if nobs>0
+
+      IF ( fbdata%nobs > 0 ) THEN
+
+         ALLOCATE( &
+            & fbdata%cdwmo(fbdata%nobs),                                      &
+            & fbdata%cdtyp(fbdata%nobs),                                      &
+            & fbdata%ioqc(fbdata%nobs),                                       &
+            & fbdata%ioqcf(fbdata%nqcf,fbdata%nobs),                          &
+            & fbdata%ipqc(fbdata%nobs),                                       &
+            & fbdata%ipqcf(fbdata%nqcf,fbdata%nobs),                          &
+            & fbdata%itqc(fbdata%nobs),                                       &
+            & fbdata%itqcf(fbdata%nqcf,fbdata%nobs),                          &
+            & fbdata%idqc(fbdata%nlev,fbdata%nobs),                           &
+            & fbdata%idqcf(fbdata%nqcf,fbdata%nlev,fbdata%nobs),              &
+            & fbdata%plam(fbdata%nobs),                                       &
+            & fbdata%pphi(fbdata%nobs),                                       &
+            & fbdata%pdep(fbdata%nlev,fbdata%nobs),                           &
+            & fbdata%ptim(fbdata%nobs),                                       &
+            & fbdata%kindex(fbdata%nobs),                                     &
+            & fbdata%ivqc(fbdata%nobs,fbdata%nvar),                           &
+            & fbdata%ivqcf(fbdata%nqcf,fbdata%nobs,fbdata%nvar),              &
+            & fbdata%ivlqc(fbdata%nlev,fbdata%nobs,fbdata%nvar),              &
+            & fbdata%ivlqcf(fbdata%nqcf,fbdata%nlev,fbdata%nobs,fbdata%nvar), &
+            & fbdata%pob(fbdata%nlev,fbdata%nobs,fbdata%nvar)                 &
+            & )
+         fbdata%kindex(:)       = fbimdi
+         fbdata%cdwmo(:)        = REPEAT( 'X', ilenwmo )
+         fbdata%cdtyp(:)        = REPEAT( 'X', ilentyp )
+         fbdata%ioqc(:)         = fbimdi
+         fbdata%ioqcf(:,:)      = fbimdi
+         fbdata%ipqc(:)         = fbimdi
+         fbdata%ipqcf(:,:)      = fbimdi
+         fbdata%itqc(:)         = fbimdi
+         fbdata%itqcf(:,:)      = fbimdi
+         fbdata%idqc(:,:)       = fbimdi
+         fbdata%idqcf(:,:,:)    = fbimdi
+         fbdata%plam(:)         = fbrmdi
+         fbdata%pphi(:)         = fbrmdi
+         fbdata%pdep(:,:)       = fbrmdi
+         fbdata%ptim(:)         = fbrmdi
+         fbdata%ivqc(:,:)       = fbimdi
+         fbdata%ivqcf(:,:,:)    = fbimdi
+         fbdata%ivlqc(:,:,:)    = fbimdi
+         fbdata%ivlqcf(:,:,:,:) = fbimdi
+         fbdata%pob(:,:,:)      = fbrmdi
+         
+         ! Optionally also store grid search information
+         
+         IF ( lgrid ) THEN
+            ALLOCATE ( &
+               & fbdata%iproc(fbdata%nobs,fbdata%nvar),            &
+               & fbdata%iobsi(fbdata%nobs,fbdata%nvar),            &
+               & fbdata%iobsj(fbdata%nobs,fbdata%nvar),            &
+               & fbdata%iobsk(fbdata%nlev,fbdata%nobs,fbdata%nvar) &
+               & )
+            fbdata%iproc(:,:)    = fbimdi
+            fbdata%iobsi(:,:)    = fbimdi
+            fbdata%iobsj(:,:)    = fbimdi
+            fbdata%iobsk(:,:,:)  = fbimdi
+            fbdata%lgrid         = .TRUE.
+         ENDIF
+         
+         ! Allocate and initialize additional entries if present
+         
+         IF ( fbdata%nadd > 0 ) THEN
+            ALLOCATE( &
+               & fbdata%padd(fbdata%nlev,fbdata%nobs,fbdata%nadd,fbdata%nvar) &
+               & )
+            fbdata%padd(:,:,:,:) = fbrmdi
+         ENDIF
+         
+         ! Allocate and initialize additional variables if present
+         
+         IF ( fbdata%next > 0 ) THEN
+            ALLOCATE( &
+               & fbdata%pext(fbdata%nlev,fbdata%nobs,fbdata%next) &
+               & )
+            fbdata%pext(:,:,:) = fbrmdi
+         ENDIF
+
+      ENDIF
+
+   END SUBROUTINE alloc_obfbdata
+
+   SUBROUTINE dealloc_obfbdata( fbdata )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE dealloc_obfbdata  ***
+      !!
+      !! ** Purpose :   Deallocate data in an obfbdata strucure
+      !!
+      !! ** Method  :   
+      !!
+      !! ** Action  : 
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      TYPE(obfbdata) :: fbdata      ! obsfbdata structure
+
+      ! Deallocate data 
+
+      DEALLOCATE( &
+         & fbdata%cname,  &
+         & fbdata%coblong,&
+         & fbdata%cobunit &
+         & )
+
+      ! Deallocate optional grid search information
+      
+      IF ( fbdata%lgrid ) THEN
+         DEALLOCATE ( &
+            & fbdata%cgrid  &
+            & )
+      ENDIF
+
+      ! Deallocate additional entries
+
+      IF ( fbdata%nadd > 0 ) THEN
+         DEALLOCATE( &
+            & fbdata%caddname, &
+            & fbdata%caddlong, &
+            & fbdata%caddunit  &
+            & )
+      ENDIF
+
+      ! Deallocate extra variables
+
+      IF ( fbdata%next > 0 ) THEN
+         DEALLOCATE( &
+            & fbdata%cextname, &
+            & fbdata%cextlong, &
+            & fbdata%cextunit  &
+            & )
+      ENDIF
+
+      ! Deallocate arrays depending on number of obs (if nobs>0 only).
+
+      IF ( fbdata%nobs > 0 ) THEN
+
+         DEALLOCATE( &
+            & fbdata%cdwmo,  &
+            & fbdata%cdtyp,  &
+            & fbdata%ioqc,   &
+            & fbdata%ioqcf,  &
+            & fbdata%ipqc,   &
+            & fbdata%ipqcf,  &
+            & fbdata%itqc,   &
+            & fbdata%itqcf,  &
+            & fbdata%idqc,   &
+            & fbdata%idqcf,  &
+            & fbdata%plam,   &
+            & fbdata%pphi,   &
+            & fbdata%pdep,   &
+            & fbdata%ptim,   &
+            & fbdata%kindex, &
+            & fbdata%ivqc,   &
+            & fbdata%ivqcf,  &
+            & fbdata%ivlqc,  &
+            & fbdata%ivlqcf, &
+            & fbdata%pob     &
+            & )
+
+
+         ! Deallocate optional grid search information
+      
+         IF ( fbdata%lgrid ) THEN
+            DEALLOCATE ( &
+               & fbdata%iproc, &
+               & fbdata%iobsi, &
+               & fbdata%iobsj, &
+               & fbdata%iobsk  & 
+               & )
+         ENDIF
+
+         ! Deallocate additional entries
+
+         IF ( fbdata%nadd > 0 ) THEN
+            DEALLOCATE( &
+               & fbdata%padd       &
+               & )
+         ENDIF
+
+         ! Deallocate extra variables
+
+         IF ( fbdata%next > 0 ) THEN
+            DEALLOCATE( &
+               & fbdata%pext       &
+               & )
+         ENDIF
+
+      ENDIF
+
+      ! Reset arrays sizes
+
+      fbdata%lalloc = .FALSE.
+      fbdata%lgrid  = .FALSE.
+      fbdata%nvar   = 0
+      fbdata%nobs   = 0
+      fbdata%nlev   = 0
+      fbdata%nadd   = 0
+      fbdata%next   = 0
+   
+   END SUBROUTINE dealloc_obfbdata
+
+   SUBROUTINE copy_obfbdata( fbdata1, fbdata2, kadd, kext, lgrid, kqcf )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE copy_obfbdata  ***
+      !!
+      !! ** Purpose :   Copy an obfbdata structure
+      !!
+      !! ** Method  :   Copy all data from fbdata1 to fbdata2
+      !!                If fbdata2 is allocated it needs to be compliant
+      !!                with fbdata1.
+      !!                Additional entries can be added by setting nadd
+      !!                Additional extra fields can be added by setting next
+      !!                Grid information can be included with lgrid=.true.
+      !!
+      !! ** Action  : 
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      TYPE(obfbdata) :: fbdata1               ! Input obsfbdata structure
+      TYPE(obfbdata) :: fbdata2               ! Output obsfbdata structure
+      INTEGER, INTENT(IN), OPTIONAL :: kadd   ! Number of additional entries
+      INTEGER, INTENT(IN), OPTIONAL :: kext   ! Number of extra variables
+      INTEGER, INTENT(IN), OPTIONAL :: kqcf   ! Number of words per qc flags
+      LOGICAL, OPTIONAL :: lgrid              ! Grid info on output file
+
+      !! * Local variables
+      INTEGER :: nadd
+      INTEGER :: next
+      INTEGER :: nqcf
+      LOGICAL :: llgrid
+      INTEGER :: jv
+      INTEGER :: je
+      INTEGER :: ji
+      INTEGER :: jk
+      INTEGER :: jq
+
+      ! Check allocation status of fbdata1
+
+      IF ( .NOT. fbdata1%lalloc ) THEN
+         CALL fatal_error( 'copy_obfbdata: input data not allocated', &
+            &              __LINE__ )
+      ENDIF
+      
+      ! If nadd,next not specified use the ones from fbdata1
+      ! Otherwise check that they have large than the original ones
+      
+      IF ( PRESENT(kadd) ) THEN
+         nadd = kadd
+         IF ( nadd < fbdata1%nadd ) THEN
+            CALL warning    ( 'copy_obfbdata: ' // &
+               &              'nadd smaller than input nadd', __LINE__ )
+         ENDIF
+      ELSE
+         nadd = fbdata1%nadd
+      ENDIF
+      IF ( PRESENT(kext) ) THEN
+         next = kext
+         IF ( next < fbdata1%next ) THEN
+            CALL fatal_error( 'copy_obfbdata: ' // &
+               &              'next smaller than input next', __LINE__ )
+         ENDIF
+      ELSE
+         next = fbdata1%next
+      ENDIF
+      IF ( PRESENT(lgrid) ) THEN
+         llgrid = lgrid
+         IF ( fbdata1%lgrid .AND. (.NOT. llgrid) ) THEN
+            CALL fatal_error( 'copy_obfbdata: ' // &
+               &              'switching off grid info not possible', &
+               &              __LINE__ )
+         ENDIF
+      ELSE
+         llgrid = fbdata1%lgrid
+      ENDIF
+      IF ( PRESENT(kqcf) ) THEN
+         nqcf = kqcf
+         IF ( nqcf < fbdata1%nqcf ) THEN
+            CALL fatal_error( 'copy_obfbdata: ' // &
+               &              'nqcf smaller than input nqcf', __LINE__ )
+         ENDIF
+      ELSE
+         nqcf = fbdata1%nqcf
+      ENDIF
+
+      ! Check allocation status of fbdata2 and 
+      ! a) check that it conforms in size if already allocated
+      ! b) allocate it if not already allocated
+      
+      IF ( fbdata2%lalloc ) THEN
+         IF ( fbdata1%nvar > fbdata2%nvar ) THEN
+            CALL fatal_error( 'copy_obfbdata: ' // &
+               &              'output kvar smaller than input kvar', __LINE__ )
+         ENDIF
+         IF ( fbdata1%nobs > fbdata2%nobs ) THEN
+            CALL fatal_error( 'copy_obfbdata: ' // &
+               &              'output kobs smaller than input kobs', __LINE__ )
+         ENDIF
+         IF ( fbdata1%nlev > fbdata2%nlev ) THEN
+            CALL fatal_error( 'copy_obfbdata: ' // &
+               &              'output klev smaller than input klev', __LINE__ )
+         ENDIF
+         IF ( fbdata1%nadd > fbdata2%nadd ) THEN
+            CALL warning    ( 'copy_obfbdata: ' // &
+               &              'output nadd smaller than input nadd', __LINE__ )
+         ENDIF
+         IF ( fbdata1%next > fbdata2%next ) THEN
+            CALL fatal_error( 'copy_obfbdata: ' // &
+               &              'output next smaller than input next', __LINE__ )
+         ENDIF
+         IF ( fbdata1%lgrid .NEQV. fbdata2%lgrid ) THEN
+            CALL fatal_error( 'copy_obfbdata: ' // &
+               &              'lgrid inconsistent', __LINE__ )
+         ENDIF
+         IF ( fbdata1%next > fbdata2%next ) THEN
+            CALL fatal_error( 'copy_obfbdata: ' // &
+               &              'output next smaller than input next', __LINE__ )
+         ENDIF
+         IF ( fbdata1%nqcf > fbdata2%nqcf ) THEN
+            CALL fatal_error( 'copy_obfbdata: ' // &
+               &              'output  smaller than input kext', __LINE__ )
+         ENDIF
+      ELSE
+         CALL alloc_obfbdata( fbdata2, fbdata1%nvar, fbdata1%nobs, &
+            &                 fbdata1%nlev, nadd, next, llgrid, kqcf = nqcf )
+      ENDIF
+
+      ! Copy the header data
+
+      fbdata2%cdjuldref = fbdata1%cdjuldref
+
+      DO ji = 1, fbdata1%nobs
+         fbdata2%cdwmo(ji)  = fbdata1%cdwmo(ji)
+         fbdata2%cdtyp(ji)  = fbdata1%cdtyp(ji)
+         fbdata2%ioqc(ji)   = fbdata1%ioqc(ji)
+         fbdata2%ipqc(ji)   = fbdata1%ipqc(ji)
+         fbdata2%itqc(ji)   = fbdata1%itqc(ji)
+         fbdata2%plam(ji)   = fbdata1%plam(ji)
+         fbdata2%pphi(ji)   = fbdata1%pphi(ji)
+         fbdata2%ptim(ji)   = fbdata1%ptim(ji)
+         fbdata2%kindex(ji) = fbdata1%kindex(ji)
+         DO jq = 1, fbdata1%nqcf
+            fbdata2%ioqcf(jq,ji)  = fbdata1%ioqcf(jq,ji)
+            fbdata2%ipqcf(jq,ji)  = fbdata1%ipqcf(jq,ji)
+            fbdata2%itqcf(jq,ji)  = fbdata1%itqcf(jq,ji)
+         END DO
+         DO jk = 1, fbdata1%nlev
+            fbdata2%idqc(jk,ji)  = fbdata1%idqc(jk,ji)
+            fbdata2%pdep(jk,ji)  = fbdata1%pdep(jk,ji)
+            DO jq = 1, fbdata1%nqcf
+               fbdata2%idqcf(jq,jk,ji) = fbdata1%idqcf(jq,jk,ji)
+            END DO
+         END DO
+      END DO
+
+      ! Copy the variable data
+
+      DO jv = 1, fbdata1%nvar
+         fbdata2%cname(jv) = fbdata1%cname(jv)
+         fbdata2%coblong(jv) = fbdata1%coblong(jv)
+         fbdata2%cobunit(jv) = fbdata1%cobunit(jv)
+         DO ji = 1, fbdata1%nobs
+            fbdata2%ivqc(ji,jv)  = fbdata1%ivqc(ji,jv)
+            DO jq = 1, fbdata1%nqcf
+               fbdata2%ivqcf(jq,ji,jv) = fbdata1%ivqcf(jq,ji,jv)
+            END DO
+            DO jk = 1, fbdata1%nlev
+               fbdata2%ivlqc(jk,ji,jv)  = fbdata1%ivlqc(jk,ji,jv)
+               fbdata2%pob(jk,ji,jv)    = fbdata1%pob(jk,ji,jv)
+               DO jq = 1, fbdata1%nqcf
+                  fbdata2%ivlqcf(jq,jk,ji,jv) = fbdata1%ivlqcf(jq,jk,ji,jv)
+               END DO
+            END DO
+         END DO
+      END DO
+
+      ! Copy grid information
+      
+      IF ( fbdata1%lgrid ) THEN
+         DO jv = 1, fbdata1%nvar
+            fbdata2%cgrid(jv) = fbdata1%cgrid(jv)
+            DO ji = 1, fbdata1%nobs
+               fbdata2%iproc(ji,jv) = fbdata1%iproc(ji,jv)
+               fbdata2%iobsi(ji,jv) = fbdata1%iobsi(ji,jv)
+               fbdata2%iobsj(ji,jv) = fbdata1%iobsj(ji,jv)
+               DO jk = 1, fbdata1%nlev
+                  fbdata2%iobsk(jk,ji,jv)  = fbdata1%iobsk(jk,ji,jv)
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+      ! Copy additional information
+      
+      DO je = 1, MIN( fbdata1%nadd, fbdata2%nadd )
+         fbdata2%caddname(je) = fbdata1%caddname(je)
+      END DO
+      DO jv = 1, fbdata1%nvar
+         DO je = 1, MIN( fbdata1%nadd, fbdata2%nadd )
+            fbdata2%caddlong(je,jv) = fbdata1%caddlong(je,jv)
+            fbdata2%caddunit(je,jv) = fbdata1%caddunit(je,jv)
+            DO ji = 1, fbdata1%nobs
+               DO jk = 1, fbdata1%nlev
+                  fbdata2%padd(jk,ji,je,jv) = fbdata1%padd(jk,ji,je,jv)
+               END DO
+            END DO
+         END DO
+      END DO
+      
+      ! Copy extra information
+
+      DO je = 1, fbdata1%next
+         fbdata2%cextname(je) = fbdata1%cextname(je)
+         fbdata2%cextlong(je) = fbdata1%cextlong(je)
+         fbdata2%cextunit(je) = fbdata1%cextunit(je)
+      END DO
+      DO je = 1, fbdata1%next
+         DO ji = 1, fbdata1%nobs
+            DO jk = 1, fbdata1%nlev
+               fbdata2%pext(jk,ji,je) = fbdata1%pext(jk,ji,je)
+            END DO
+         END DO
+      END DO
+
+   END SUBROUTINE copy_obfbdata
+
+   SUBROUTINE subsamp_obfbdata( fbdata1, fbdata2, llvalid )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE susbamp_obfbdata  ***
+      !!
+      !! ** Purpose :   Subsample an obfbdata structure based on the
+      !!                logical mask.
+      !!
+      !! ** Method  :   Copy all data from fbdata1 to fbdata2 if
+      !!                llvalid(obs)==true
+      !!
+      !! ** Action  : 
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      TYPE(obfbdata) :: fbdata1           ! Input obsfbdata structure
+      TYPE(obfbdata) :: fbdata2           ! Output obsfbdata structure
+      LOGICAL, DIMENSION(fbdata1%nobs) :: llvalid     ! Grid info on output file
+      !! * Local variables
+      INTEGER :: nobs
+      INTEGER :: jv
+      INTEGER :: je
+      INTEGER :: ji
+      INTEGER :: jk
+      INTEGER :: jq
+      INTEGER :: ij
+
+      ! Check allocation status of fbdata1
+
+      IF ( .NOT. fbdata1%lalloc ) THEN
+         CALL fatal_error( 'copy_obfbdata: input data not allocated', &
+            &              __LINE__ )
+      ENDIF
+      
+      ! Check allocation status of fbdata2 and abort if already allocated
+      
+      IF ( fbdata2%lalloc ) THEN
+         CALL fatal_error( 'subsample_obfbdata: ' // &
+            &              'fbdata2 already allocated', __LINE__ )
+      ENDIF
+      
+      ! Count number of subsampled observations
+
+      nobs = COUNT(llvalid)
+      
+      ! Allocate new data structure
+
+      CALL alloc_obfbdata( fbdata2, fbdata1%nvar, nobs, &
+         &                 fbdata1%nlev, fbdata1%nadd, fbdata1%next, &
+         &                 fbdata1%lgrid, kqcf = fbdata1%nqcf )
+
+      ! Copy the header data
+
+      fbdata2%cdjuldref = fbdata1%cdjuldref
+      
+      ij = 0
+      DO ji = 1, fbdata1%nobs
+         IF ( llvalid(ji) ) THEN
+            ij = ij +1
+            fbdata2%cdwmo(ij)  = fbdata1%cdwmo(ji)
+            fbdata2%cdtyp(ij)  = fbdata1%cdtyp(ji)
+            fbdata2%ioqc(ij)   = fbdata1%ioqc(ji)
+            fbdata2%ipqc(ij)   = fbdata1%ipqc(ji)
+            fbdata2%itqc(ij)   = fbdata1%itqc(ji)
+            fbdata2%plam(ij)   = fbdata1%plam(ji)
+            fbdata2%pphi(ij)   = fbdata1%pphi(ji)
+            fbdata2%ptim(ij)   = fbdata1%ptim(ji)
+            fbdata2%kindex(ij) = fbdata1%kindex(ji)
+            DO jq = 1, fbdata1%nqcf
+               fbdata2%ioqcf(jq,ij)  = fbdata1%ioqcf(jq,ji)
+               fbdata2%ipqcf(jq,ij)  = fbdata1%ipqcf(jq,ji)
+               fbdata2%itqcf(jq,ij)  = fbdata1%itqcf(jq,ji)
+            END DO
+            DO jk = 1, fbdata1%nlev
+               fbdata2%idqc(jk,ij)  = fbdata1%idqc(jk,ji)
+               fbdata2%pdep(jk,ij)  = fbdata1%pdep(jk,ji)
+               DO jq = 1, fbdata1%nqcf
+                  fbdata2%idqcf(jq,jk,ij) = fbdata1%idqcf(jq,jk,ji)
+               END DO
+            END DO
+         ENDIF
+      END DO
+
+      ! Copy the variable data
+
+      DO jv = 1, fbdata1%nvar
+         fbdata2%cname(jv) = fbdata1%cname(jv)
+         fbdata2%coblong(jv) = fbdata1%coblong(jv)
+         fbdata2%cobunit(jv) = fbdata1%cobunit(jv)
+         ij = 0
+         DO ji = 1, fbdata1%nobs
+            IF ( llvalid(ji) ) THEN
+               ij = ij + 1
+               fbdata2%ivqc(ij,jv)  = fbdata1%ivqc(ji,jv)
+               DO jq = 1, fbdata1%nqcf
+                  fbdata2%ivqcf(jq,ij,jv) = fbdata1%ivqcf(jq,ji,jv)
+               END DO
+               DO jk = 1, fbdata1%nlev
+                  fbdata2%ivlqc(jk,ij,jv)  = fbdata1%ivlqc(jk,ji,jv)
+                  fbdata2%pob(jk,ij,jv)    = fbdata1%pob(jk,ji,jv)
+                  DO jq = 1, fbdata1%nqcf
+                     fbdata2%ivlqcf(jq,jk,ij,jv) = fbdata1%ivlqcf(jq,jk,ji,jv)
+                  END DO
+               END DO
+            ENDIF
+         END DO
+      END DO
+
+      ! Copy grid information
+      
+      IF ( fbdata1%lgrid ) THEN
+         DO jv = 1, fbdata1%nvar
+            fbdata2%cgrid(jv) = fbdata1%cgrid(jv)
+            ij = 0
+            DO ji = 1, fbdata1%nobs
+               IF ( llvalid(ji) ) THEN
+                  ij = ij + 1
+                  fbdata2%iproc(ij,jv) = fbdata1%iproc(ji,jv)
+                  fbdata2%iobsi(ij,jv) = fbdata1%iobsi(ji,jv)
+                  fbdata2%iobsj(ij,jv) = fbdata1%iobsj(ji,jv)
+                  DO jk = 1, fbdata1%nlev
+                     fbdata2%iobsk(jk,ij,jv)  = fbdata1%iobsk(jk,ji,jv)
+                  END DO
+               ENDIF
+            END DO
+         END DO
+      ENDIF
+
+      ! Copy additional information
+      
+      DO je = 1, fbdata1%nadd
+         fbdata2%caddname(je) = fbdata1%caddname(je)
+      END DO
+      DO jv = 1, fbdata1%nvar
+         DO je = 1, fbdata1%nadd
+            fbdata2%caddlong(je,jv) = fbdata1%caddlong(je,jv)
+            fbdata2%caddunit(je,jv) = fbdata1%caddunit(je,jv)
+            ij = 0
+            DO ji = 1, fbdata1%nobs
+               IF ( llvalid(ji) ) THEN
+                  ij = ij + 1
+                  DO jk = 1, fbdata1%nlev
+                     fbdata2%padd(jk,ij,je,jv) = fbdata1%padd(jk,ji,je,jv)
+                  END DO
+               ENDIF
+            END DO
+         END DO
+      END DO
+      
+      ! Copy extra information
+
+      DO je = 1, fbdata1%next
+         fbdata2%cextname(je) = fbdata1%cextname(je)
+         fbdata2%cextlong(je) = fbdata1%cextlong(je)
+         fbdata2%cextunit(je) = fbdata1%cextunit(je)
+      END DO
+      DO je = 1, fbdata1%next
+         ij = 0
+         DO ji = 1, fbdata1%nobs
+            IF ( llvalid(ji) ) THEN
+               ij = ij + 1
+               DO jk = 1, fbdata1%nlev
+                  fbdata2%pext(jk,ij,je) = fbdata1%pext(jk,ji,je)
+               END DO
+            ENDIF
+         END DO
+      END DO
+
+   END SUBROUTINE subsamp_obfbdata
+
+   SUBROUTINE merge_obfbdata( nsets, fbdatain, fbdataout, iset, inum, iind )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE merge_obfbdata  ***
+      !!
+      !! ** Purpose :   Merge multiple obfbdata structures into an one.
+      !!
+      !! ** Method  :   The order of elements is based on the indices in
+      !!                iind.
+      !!                All input data are assumed to be consistent. This
+      !!                is assumed to be checked before calling this routine.
+      !!                Likewise output data is assume to be consistent as 
+      !!                well without error checking.
+      !!
+      !! ** Action  : 
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT(IN):: nsets      ! Number of input data sets 
+      TYPE(obfbdata), DIMENSION(nsets) :: fbdatain  ! Input obsfbdata structure
+      TYPE(obfbdata) :: fbdataout      ! Output obsfbdata structure
+      INTEGER, INTENT(IN), DIMENSION(fbdataout%nobs) :: &
+         & iset                 ! Set number for a given obs.
+      INTEGER, INTENT(IN), DIMENSION(fbdataout%nobs) :: &
+         & inum                 ! Number within set for an obs
+      INTEGER, INTENT(IN), DIMENSION(fbdataout%nobs) :: &
+         & iind                 ! Indices for copying.
+      !! * Local variables
+
+      INTEGER :: js
+      INTEGER :: jo
+      INTEGER :: jv
+      INTEGER :: je
+      INTEGER :: ji
+      INTEGER :: jk
+      INTEGER :: jq
+
+      ! Check allocation status of fbdatain 
+      
+      DO js = 1, nsets
+         IF ( .NOT. fbdatain(js)%lalloc ) THEN
+            CALL fatal_error( 'merge_obfbdata: input data not allocated', &
+               &              __LINE__ )
+         ENDIF
+      END DO
+
+      ! Check allocation status of fbdataout
+      
+      IF ( .NOT.fbdataout%lalloc ) THEN
+         CALL fatal_error( 'merge_obfbdata: output data not allocated', &
+            &              __LINE__ )
+      ENDIF
+
+      ! Merge various names
+
+      DO jv = 1, fbdatain(1)%nvar
+         fbdataout%cname(jv) = fbdatain(1)%cname(jv)
+         fbdataout%coblong(jv) = fbdatain(1)%coblong(jv)
+         fbdataout%cobunit(jv) = fbdatain(1)%cobunit(jv)
+         IF ( fbdatain(1)%lgrid ) THEN
+            fbdataout%cgrid(jv) = fbdatain(1)%cgrid(jv)
+         ENDIF
+      END DO
+      DO jv = 1, fbdatain(1)%nadd
+         fbdataout%caddname(jv) = fbdatain(1)%caddname(jv)
+      END DO
+      DO jv = 1, fbdatain(1)%nvar
+         DO je = 1, fbdatain(1)%nadd
+            fbdataout%caddlong(je,jv) = fbdatain(1)%caddlong(je,jv)
+            fbdataout%caddunit(je,jv) = fbdatain(1)%caddunit(je,jv)
+         END DO
+      END DO
+      DO jv = 1, fbdatain(1)%next
+         fbdataout%cextname(jv) = fbdatain(1)%cextname(jv)
+         fbdataout%cextlong(jv) = fbdatain(1)%cextlong(jv)
+         fbdataout%cextunit(jv) = fbdatain(1)%cextunit(jv)
+      END DO
+      fbdataout%cdjuldref = fbdatain(1)%cdjuldref
+
+      ! Loop over total views
+
+      DO jo = 1, fbdataout%nobs
+
+         js = iset(iind(jo))
+         ji = inum(iind(jo))
+
+         ! Merge the header data
+
+         fbdataout%cdwmo(jo)  = fbdatain(js)%cdwmo(ji)
+         fbdataout%cdtyp(jo)  = fbdatain(js)%cdtyp(ji)
+         fbdataout%ioqc(jo)   = fbdatain(js)%ioqc(ji)
+         fbdataout%ipqc(jo)   = fbdatain(js)%ipqc(ji)
+         fbdataout%itqc(jo)   = fbdatain(js)%itqc(ji)
+         fbdataout%plam(jo)   = fbdatain(js)%plam(ji)
+         fbdataout%pphi(jo)   = fbdatain(js)%pphi(ji)
+         fbdataout%ptim(jo)   = fbdatain(js)%ptim(ji)
+         fbdataout%kindex(jo) = fbdatain(js)%kindex(ji)
+         DO jq = 1, fbdatain(js)%nqcf
+            fbdataout%ioqcf(jq,jo)  = fbdatain(js)%ioqcf(jq,ji)
+            fbdataout%ipqcf(jq,jo)  = fbdatain(js)%ipqcf(jq,ji)
+            fbdataout%itqcf(jq,jo)  = fbdatain(js)%itqcf(jq,ji)
+         END DO
+         DO jk = 1, fbdatain(js)%nlev
+            fbdataout%pdep(jk,jo)  = fbdatain(js)%pdep(jk,ji)
+            fbdataout%idqc(jk,jo)  = fbdatain(js)%idqc(jk,ji)
+            DO jq = 1, fbdatain(js)%nqcf
+               fbdataout%idqcf(jq,jk,jo) = fbdatain(js)%idqcf(jq,jk,ji)
+            END DO
+         END DO
+
+         ! Merge the variable data
+
+         DO jv = 1, fbdatain(js)%nvar
+            fbdataout%ivqc(jo,jv)  = fbdatain(js)%ivqc(ji,jv)
+            DO jq = 1, fbdatain(js)%nqcf
+               fbdataout%ivqcf(jq,jo,jv) = fbdatain(js)%ivqcf(jq,ji,jv)
+            END DO
+            DO jk = 1, fbdatain(js)%nlev
+               fbdataout%ivlqc(jk,jo,jv)  = fbdatain(js)%ivlqc(jk,ji,jv)
+               fbdataout%pob(jk,jo,jv)    = fbdatain(js)%pob(jk,ji,jv)
+               DO jq = 1, fbdatain(js)%nqcf
+                  fbdataout%ivlqcf(jq,jk,jo,jv) = &
+                     &                     fbdatain(js)%ivlqcf(jq,jk,ji,jv)
+               END DO
+            END DO
+         END DO
+
+         ! Merge grid information
+         
+         IF ( fbdatain(js)%lgrid ) THEN
+            DO jv = 1, fbdatain(js)%nvar
+               fbdataout%cgrid(jv) = fbdatain(js)%cgrid(jv)
+               fbdataout%iproc(jo,jv) = fbdatain(js)%iproc(ji,jv)
+               fbdataout%iobsi(jo,jv) = fbdatain(js)%iobsi(ji,jv)
+               fbdataout%iobsj(jo,jv) = fbdatain(js)%iobsj(ji,jv)
+               DO jk = 1, fbdatain(js)%nlev
+                  fbdataout%iobsk(jk,jo,jv)  = fbdatain(js)%iobsk(jk,ji,jv)
+               END DO
+            END DO
+         ENDIF
+
+         ! Merge additional information
+      
+         DO jv = 1, fbdatain(js)%nvar
+            DO je = 1, fbdatain(js)%nadd
+               DO jk = 1, fbdatain(js)%nlev
+                  fbdataout%padd(jk,jo,je,jv) = fbdatain(js)%padd(jk,ji,je,jv)
+               END DO
+            END DO
+         END DO
+         
+         ! Merge extra information
+         
+         DO je = 1, fbdatain(js)%next
+            DO jk = 1, fbdatain(js)%nlev
+               fbdataout%pext(jk,jo,je) = fbdatain(js)%pext(jk,ji,je)
+            END DO
+         END DO
+
+      END DO
+
+   END SUBROUTINE merge_obfbdata
+
+   SUBROUTINE write_obfbdata( cdfilename, fbdata )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE write_obfbdata  ***
+      !!
+      !! ** Purpose :   Write an obfbdata structure into a netCDF file.
+      !!
+      !! ** Method  :   
+      !!
+      !! ** Action  : 
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(len=*) :: cdfilename ! Output filename
+      TYPE(obfbdata)   :: fbdata     ! obsfbdata structure
+      !! * Local variables
+      CHARACTER(LEN=14), PARAMETER :: cpname = 'write_obfbdata'
+      ! Dimension ids
+      INTEGER :: idfile
+      INTEGER :: idodim
+      INTEGER :: idldim
+      INTEGER :: idvdim
+      INTEGER :: idadim
+      INTEGER :: idedim
+      INTEGER :: idsndim
+      INTEGER :: idsgdim
+      INTEGER :: idswdim
+      INTEGER :: idstdim
+      INTEGER :: idjddim
+      INTEGER :: idqcdim
+      INTEGER :: idvard
+      INTEGER :: idaddd
+      INTEGER :: idextd
+      INTEGER :: idcdwmo
+      INTEGER :: idcdtyp
+      INTEGER :: idplam
+      INTEGER :: idpphi
+      INTEGER :: idpdep
+      INTEGER :: idptim
+      INTEGER :: idptimr
+      INTEGER :: idioqc         
+      INTEGER :: idioqcf         
+      INTEGER :: idipqc
+      INTEGER :: idipqcf
+      INTEGER :: iditqc
+      INTEGER :: iditqcf
+      INTEGER :: ididqc
+      INTEGER :: ididqcf
+      INTEGER :: idkindex
+      INTEGER, DIMENSION(fbdata%nvar) :: &
+         & idpob,    &
+         & idivqc,   &
+         & idivqcf,  &
+         & idivlqc,  &
+         & idivlqcf, &
+         & idiobsi,  &
+         & idiobsj,  &
+         & idiobsk,  &
+         & idcgrid
+      INTEGER, DIMENSION(fbdata%nadd,fbdata%nvar) :: idpadd
+      INTEGER, DIMENSION(fbdata%next) :: idpext
+      INTEGER, DIMENSION(1) :: incdim1
+      INTEGER, DIMENSION(2) :: incdim2
+      INTEGER, DIMENSION(3) :: incdim3
+      INTEGER, DIMENSION(4) :: incdim4
+
+      INTEGER :: jv
+      INTEGER :: je
+      INTEGER :: ioldfill
+      CHARACTER(len=nf90_max_name) :: &
+         & cdtmp
+      CHARACTER(len=16), PARAMETER :: &
+         & cdqcconv = 'q where q =[0,9]'
+      CHARACTER(len=24), PARAMETER :: &
+         & cdqcfconv = 'NEMOVAR flag conventions'
+      CHARACTER(len=ilenlong) :: &
+         & cdltmp
+
+      ! Open output filename
+
+      CALL chkerr( nf90_create( TRIM( cdfilename ), nf90_clobber, idfile ), &
+         &         cpname, __LINE__ )
+      CALL chkerr( nf90_set_fill( idfile, nf90_nofill, ioldfill ), &
+         &         cpname, __LINE__ )
+      CALL chkerr( nf90_put_att( idfile, nf90_global, 'title', &
+         &                       'NEMO observation operator output' ), &
+         &         cpname, __LINE__ )
+      CALL chkerr( nf90_put_att( idfile, nf90_global, 'Convention', &
+         &                       'NEMO unified observation operator output' ),&
+         &         cpname,__LINE__ )
+
+      ! Create the dimensions
+
+      CALL chkerr( nf90_def_dim( idfile, 'N_OBS'  , fbdata%nobs, idodim ),  &
+         &         cpname,__LINE__ )
+      CALL chkerr( nf90_def_dim( idfile, 'N_LEVELS', fbdata%nlev, idldim ), &
+         &         cpname,__LINE__ )
+      CALL chkerr( nf90_def_dim( idfile, 'N_VARS', fbdata%nvar, idvdim ), &
+         &         cpname,__LINE__ )
+      CALL chkerr( nf90_def_dim( idfile, 'N_QCF', fbdata%nqcf, idqcdim ),&
+         &         cpname,__LINE__ )
+      IF ( fbdata%nadd > 0 ) THEN
+         CALL chkerr( nf90_def_dim( idfile, 'N_ENTRIES', fbdata%nadd, idadim ), &
+            &         cpname,__LINE__ )
+      ENDIF
+      IF ( fbdata%next > 0 ) THEN
+         CALL chkerr( nf90_def_dim( idfile, 'N_EXTRA', fbdata%next, idedim ), &
+            &         cpname,__LINE__ )
+      ENDIF
+      CALL chkerr( nf90_def_dim( idfile, 'STRINGNAM', ilenname, idsndim ), &
+         &         cpname,__LINE__ )
+      IF (fbdata%lgrid) THEN
+         CALL chkerr( nf90_def_dim( idfile, 'STRINGGRID', ilengrid, idsgdim ),&
+            &         cpname,__LINE__ )
+      ENDIF
+      CALL chkerr( nf90_def_dim( idfile, 'STRINGWMO', ilenwmo, idswdim ), &
+         &         cpname,__LINE__ )
+      CALL chkerr( nf90_def_dim( idfile, 'STRINGTYP', ilentyp, idstdim ), &
+         &         cpname,__LINE__ )
+      CALL chkerr( nf90_def_dim( idfile, 'STRINGJULD', ilenjuld, idjddim ), &
+         &         cpname,__LINE__ )
+      
+      ! Define netCDF variables for header information
+      
+      incdim2(1) = idsndim
+      incdim2(2) = idvdim
+
+      CALL chkerr( nf90_def_var( idfile, 'VARIABLES', nf90_char, incdim2, &
+         &                       idvard ), cpname, __LINE__ )
+      CALL putvaratt_obfbdata( idfile, idvard, &
+         &                     'List of variables in feedback files' )
+      
+      IF ( fbdata%nadd > 0 ) THEN
+         incdim2(1) = idsndim
+         incdim2(2) = idadim
+         CALL chkerr( nf90_def_var( idfile, 'ENTRIES', nf90_char, incdim2, &
+            &                       idaddd ), cpname, __LINE__ )
+         CALL putvaratt_obfbdata( idfile, idaddd,  &
+            &                     'List of additional entries for each '// &
+            &                     'variable in feedback files' )
+      ENDIF
+   
+      IF ( fbdata%next > 0 ) THEN
+         incdim2(1) = idsndim
+         incdim2(2) = idedim
+         CALL chkerr( nf90_def_var( idfile, 'EXTRA', nf90_char, incdim2, &
+            &                       idextd ), cpname, __LINE__ )
+         CALL putvaratt_obfbdata(  idfile, idextd, &
+            &                      'List of extra variables' )
+      ENDIF
+
+      incdim2(1) = idswdim
+      incdim2(2) = idodim
+      CALL chkerr( nf90_def_var( idfile, 'STATION_IDENTIFIER', &
+         &                       nf90_char, incdim2, &
+         &                       idcdwmo ), cpname, __LINE__ )
+      CALL putvaratt_obfbdata(  idfile, idcdwmo, &
+         &                      'Station identifier' )
+      incdim2(1) = idstdim
+      incdim2(2) = idodim
+      CALL chkerr( nf90_def_var( idfile, 'STATION_TYPE', &
+         &                       nf90_char, incdim2, &
+         &                       idcdtyp ), cpname, __LINE__ )
+      CALL putvaratt_obfbdata(  idfile, idcdtyp, &
+         &                      'Code instrument type' )
+      incdim1(1) = idodim
+      CALL chkerr( nf90_def_var( idfile, 'LONGITUDE', &
+         &                       nf90_double, incdim1, &
+         &                       idplam ), cpname, __LINE__ )
+      CALL putvaratt_obfbdata(  idfile, idplam, &
+         &                      'Longitude', cdunits = 'degrees_east', &
+         &                      rfillvalue = fbrmdi )
+      CALL chkerr( nf90_def_var( idfile, 'LATITUDE', &
+         &                       nf90_double, incdim1, &
+         &                       idpphi ), cpname, __LINE__ )
+      CALL putvaratt_obfbdata(  idfile, idpphi, &
+         &                      'Latitude', cdunits = 'degrees_north', &
+         &                      rfillvalue = fbrmdi )
+      incdim2(1) = idldim
+      incdim2(2) = idodim
+      CALL chkerr( nf90_def_var( idfile, 'DEPTH', &
+         &                       nf90_double, incdim2, &
+         &                       idpdep ), cpname, __LINE__ )
+      CALL putvaratt_obfbdata(  idfile, idpdep, &
+         &                      'Depth', cdunits = 'metre', &
+         &                      rfillvalue = fbrmdi )
+      incdim3(1) = idqcdim
+      incdim3(2) = idldim
+      incdim3(3) = idodim
+      CALL chkerr( nf90_def_var( idfile, 'DEPTH_QC', &
+         &                       nf90_int, incdim2, &
+         &                       ididqc ), cpname, __LINE__ )
+      CALL putvaratt_obfbdata(  idfile, ididqc, &
+         &                      'Quality on depth',  &
+         &                      conventions = cdqcconv, &
+         &                      ifillvalue = 0 )
+      CALL chkerr( nf90_def_var( idfile, 'DEPTH_QC_FLAGS', &
+         &                       nf90_int, incdim3, &
+         &                       ididqcf ), cpname, __LINE__ )
+      CALL putvaratt_obfbdata(  idfile, ididqcf, &
+         &                      'Quality flags on depth',  &
+         &                      conventions = cdqcfconv )
+      CALL chkerr( nf90_def_var( idfile, 'JULD', &
+         &                       nf90_double, incdim1, &
+         &                       idptim ), cpname, __LINE__ )
+      CALL putvaratt_obfbdata(  idfile, idptim, &
+         &                      'Julian day', &
+         &                      cdunits = 'days since JULD_REFERENCE', &
+         &                      conventions = 'relative julian days with '// &
+         &                                 'decimal part (as parts of day)', &
+         &                      rfillvalue = fbrmdi )
+      incdim1(1) = idjddim
+      CALL chkerr( nf90_def_var( idfile, 'JULD_REFERENCE', &
+         &                       nf90_char, incdim1, &
+         &                       idptimr ), cpname, __LINE__ )
+      CALL putvaratt_obfbdata(  idfile, idptimr, &
+         &                      'Date of reference for julian days ', &
+         &                      conventions = 'YYYYMMDDHHMMSS' )
+      incdim1(1) = idodim
+      CALL chkerr( nf90_def_var( idfile, 'OBSERVATION_QC', &
+         &                       nf90_int, incdim1, &
+         &                       idioqc ), cpname, __LINE__ )
+      CALL putvaratt_obfbdata(  idfile, idioqc, &
+         &                      'Quality on observation',  &
+         &                      conventions = cdqcconv, &
+         &                      ifillvalue = 0 )
+      incdim2(1) = idqcdim
+      incdim2(2) = idodim
+      CALL chkerr( nf90_def_var( idfile, 'OBSERVATION_QC_FLAGS', &
+         &                       nf90_int, incdim2, &
+         &                       idioqcf ), cpname, __LINE__ )
+      CALL putvaratt_obfbdata(  idfile, idioqcf, &
+         &                      'Quality flags on observation',  &
+         &                      conventions = cdqcfconv, &
+         &                      ifillvalue = 0 )
+      CALL chkerr( nf90_def_var( idfile, 'POSITION_QC', &
+         &                       nf90_int, incdim1, &
+         &                       idipqc ), cpname, __LINE__ )
+      CALL putvaratt_obfbdata(  idfile, idipqc, &
+         &                      'Quality on position (latitude and longitude)',  &
+         &                      conventions = cdqcconv, &
+         &                      ifillvalue = 0 )
+      CALL chkerr( nf90_def_var( idfile, 'POSITION_QC_FLAGS', &
+         &                       nf90_int, incdim2, &
+         &                       idipqcf ), cpname, __LINE__ )
+      CALL putvaratt_obfbdata(  idfile, idipqcf, &
+         &                      'Quality flags on position',  &
+         &                      conventions = cdqcfconv, &
+         &                      ifillvalue = 0 )
+      CALL chkerr( nf90_def_var( idfile, 'JULD_QC', &
+         &                       nf90_int, incdim1, &
+         &                       iditqc ), cpname, __LINE__ )
+      CALL putvaratt_obfbdata(  idfile, iditqc, &
+         &                      'Quality on date and time',  &
+         &                      conventions = cdqcconv, &
+         &                      ifillvalue = 0 )
+      CALL chkerr( nf90_def_var( idfile, 'JULD_QC_FLAGS', &
+         &                       nf90_int, incdim2, &
+         &                       iditqcf ), cpname, __LINE__ )
+      CALL putvaratt_obfbdata(  idfile, iditqcf, &
+         &                      'Quality flags on date and time',  &
+         &                      conventions = cdqcfconv, &
+         &                      ifillvalue = 0 )
+      CALL chkerr( nf90_def_var( idfile, 'ORIGINAL_FILE_INDEX', &
+         &                       nf90_int, incdim1, &
+         &                       idkindex ), cpname, __LINE__ )
+      CALL putvaratt_obfbdata(  idfile, idkindex, &
+         &                      'Index in original data file',  &
+         &                      ifillvalue = fbimdi )
+
+      ! Define netCDF variables for individual variables
+
+      DO jv = 1, fbdata%nvar
+
+         incdim1(1) = idodim
+         incdim2(1) = idldim
+         incdim2(2) = idodim
+         WRITE(cdtmp,'(2A)') TRIM(fbdata%cname(jv)),'_OBS'
+         CALL chkerr( nf90_def_var( idfile, cdtmp, nf90_float, &
+            &                       incdim2, idpob(jv) ), &
+            &         cpname, __LINE__ )
+         CALL putvaratt_obfbdata(  idfile, idpob(jv), &
+            &                      fbdata%coblong(jv),  &
+            &                      cdunits =  fbdata%cobunit(jv), &
+            &                      rfillvalue = fbrmdi )
+
+         IF ( fbdata%nadd > 0 ) THEN
+            DO je = 1, fbdata%nadd
+               WRITE(cdtmp,'(3A)') TRIM(fbdata%cname(jv)),'_',&
+                  &                TRIM(fbdata%caddname(je))
+               CALL chkerr( nf90_def_var( idfile, cdtmp, nf90_float, &
+                  &                       incdim2, idpadd(je,jv) ), &
+                  &         cpname, __LINE__ )
+               CALL putvaratt_obfbdata(  idfile, idpadd(je,jv), &
+                  &                      fbdata%caddlong(je,jv), &
+                  &                      cdunits =  fbdata%caddunit(je,jv), &
+                  &                      rfillvalue = fbrmdi )
+            END DO
+         ENDIF
+
+         cdltmp = fbdata%coblong(jv)
+         IF (( cdltmp(1:1) >= 'A' ).AND.( cdltmp(1:1) <= 'Z' )) &
+            & cdltmp(1:1) = ACHAR(IACHAR(cdltmp(1:1)) + 32)
+         WRITE(cdtmp,'(2A)') TRIM(fbdata%cname(jv)),'_QC'
+         CALL chkerr( nf90_def_var( idfile, cdtmp, nf90_int, &
+            &                       incdim1, idivqc(jv) ), &
+            &         cpname, __LINE__ )
+         CALL putvaratt_obfbdata(  idfile, idivqc(jv), &
+            &                      'Quality on '//cdltmp,  &
+            &                      conventions = cdqcconv, &
+            &                      ifillvalue = 0 )
+         incdim2(1) = idqcdim
+         incdim2(2) = idodim
+         WRITE(cdtmp,'(2A)') TRIM(fbdata%cname(jv)),'_QC_FLAGS'
+         CALL chkerr( nf90_def_var( idfile, cdtmp, nf90_int, &
+            &                       incdim2, idivqcf(jv) ), &
+            &         cpname, __LINE__ )
+         CALL putvaratt_obfbdata(  idfile, idivqcf(jv), &
+            &                      'Quality flags on '//cdltmp,  &
+            &                      conventions = cdqcfconv, &
+            &                      ifillvalue = 0 )
+         incdim2(1) = idldim
+         incdim2(2) = idodim
+         WRITE(cdtmp,'(2A)') TRIM(fbdata%cname(jv)),'_LEVEL_QC'
+         CALL chkerr( nf90_def_var( idfile, cdtmp, nf90_int, &
+            &                       incdim2, idivlqc(jv) ), &
+            &         cpname, __LINE__ )
+         CALL putvaratt_obfbdata(  idfile, idivlqc(jv), &
+            &                      'Quality for each level on '//cdltmp,  &
+            &                      conventions = cdqcconv, &
+            &                      ifillvalue = 0 )
+         incdim3(1) = idqcdim
+         incdim3(2) = idldim
+         incdim3(3) = idodim
+         WRITE(cdtmp,'(2A)') TRIM(fbdata%cname(jv)),'_LEVEL_QC_FLAGS'
+         CALL chkerr( nf90_def_var( idfile, cdtmp, nf90_int, &
+            &                       incdim3, idivlqcf(jv) ), &
+            &         cpname, __LINE__ )
+         CALL putvaratt_obfbdata(  idfile, idivlqcf(jv), &
+            &                      'Quality flags for each level on '//&
+            &                      cdltmp,  &
+            &                      conventions = cdqcfconv, &
+            &                      ifillvalue = 0 )
+
+         IF (fbdata%lgrid) THEN
+            incdim2(1) = idldim
+            incdim2(2) = idodim
+            WRITE(cdtmp,'(2A)') TRIM(fbdata%cname(jv)),'_IOBSI'
+            CALL chkerr( nf90_def_var( idfile, cdtmp, nf90_int, &
+               &                       incdim1, idiobsi(jv) ), &
+               &         cpname, __LINE__ )
+            CALL putvaratt_obfbdata(  idfile, idiobsi(jv), &
+               &                      'ORCA grid search I coordinate')
+            WRITE(cdtmp,'(2A)') TRIM(fbdata%cname(jv)),'_IOBSJ'
+            CALL chkerr( nf90_def_var( idfile, cdtmp, nf90_int, &
+               &                       incdim1, idiobsj(jv) ), &
+               &         cpname, __LINE__ )
+            CALL putvaratt_obfbdata(  idfile, idiobsj(jv), &
+               &                      'ORCA grid search J coordinate')
+            WRITE(cdtmp,'(2A)') TRIM(fbdata%cname(jv)),'_IOBSK'
+            CALL chkerr( nf90_def_var( idfile, cdtmp, nf90_int, &
+               &                       incdim2, idiobsk(jv) ), &
+               &         cpname, __LINE__ )
+            CALL putvaratt_obfbdata(  idfile, idiobsk(jv), &
+               &                      'ORCA grid search K coordinate')
+            incdim1(1) = idsgdim
+            WRITE(cdtmp,'(2A)') TRIM(fbdata%cname(jv)),'_GRID'
+            CALL chkerr( nf90_def_var( idfile, cdtmp, nf90_char, incdim1, &
+               &                       idcgrid(jv) ), cpname, __LINE__ )
+            CALL putvaratt_obfbdata(  idfile, idcgrid(jv), &
+               &                      'ORCA grid search grid (T,U,V)')
+         ENDIF
+
+      END DO
+
+      IF ( fbdata%next > 0 ) THEN
+         DO je = 1, fbdata%next
+            incdim2(1) = idldim
+            incdim2(2) = idodim
+            WRITE(cdtmp,'(A)') TRIM(fbdata%cextname(je))
+            CALL chkerr( nf90_def_var( idfile, cdtmp, nf90_float, &
+               &                       incdim2, idpext(je) ), &
+               &         cpname, __LINE__ )
+            CALL putvaratt_obfbdata(  idfile, idpext(je), &
+               &                      fbdata%cextlong(je),  &
+               &                      cdunits =  fbdata%cextunit(je), &
+               &                      rfillvalue = fbrmdi )
+         END DO
+      ENDIF
+      
+      ! Stop definitions
+
+      CALL chkerr( nf90_enddef( idfile ), cpname, __LINE__ )
+      
+      ! Write the variables
+      
+      CALL chkerr( nf90_put_var( idfile, idvard, fbdata%cname ), &
+         &         cpname, __LINE__ )
+      
+      IF ( fbdata%nadd > 0 ) THEN
+         CALL chkerr( nf90_put_var( idfile, idaddd, fbdata%caddname ), &
+            &         cpname, __LINE__ )
+      ENDIF
+      
+      IF ( fbdata%next > 0 ) THEN
+         CALL chkerr( nf90_put_var( idfile, idextd, fbdata%cextname ), &
+            &         cpname, __LINE__ )
+      ENDIF
+
+      CALL chkerr( nf90_put_var( idfile, idptimr, fbdata%cdjuldref ), &
+         &         cpname, __LINE__ )
+
+      ! Only write the data if observation is available
+      
+      IF ( fbdata%nobs > 0 ) THEN
+
+         CALL chkerr( nf90_put_var( idfile, idcdwmo, fbdata%cdwmo ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_put_var( idfile, idcdtyp, fbdata%cdtyp ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_put_var( idfile, idplam, fbdata%plam ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_put_var( idfile, idpphi, fbdata%pphi ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_put_var( idfile, idpdep, fbdata%pdep ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_put_var( idfile, idptim, fbdata%ptim ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_put_var( idfile, idioqc, fbdata%ioqc ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_put_var( idfile, idioqcf, fbdata%ioqcf ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_put_var( idfile, idipqc, fbdata%ipqc ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_put_var( idfile, idipqcf, fbdata%ipqcf ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_put_var( idfile, iditqc, fbdata%itqc ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_put_var( idfile, iditqcf, fbdata%itqcf ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_put_var( idfile, ididqc, fbdata%idqc ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_put_var( idfile, ididqcf, fbdata%idqcf ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_put_var( idfile, idkindex, fbdata%kindex ), &
+            &         cpname, __LINE__ )
+
+         DO jv = 1, fbdata%nvar
+            CALL chkerr( nf90_put_var( idfile, idpob(jv), fbdata%pob(:,:,jv) ), &
+               &         cpname, __LINE__ )
+            IF ( fbdata%nadd > 0 ) THEN
+               DO je = 1, fbdata%nadd
+                  CALL chkerr( nf90_put_var( idfile, idpadd(je,jv), &
+                     &                       fbdata%padd(:,:,je,jv) ), &
+                     &         cpname, __LINE__ )
+               END DO
+            ENDIF
+            CALL chkerr( nf90_put_var( idfile, idivqc(jv), &
+               &                       fbdata%ivqc(:,jv) ),&
+               &         cpname, __LINE__ )
+            CALL chkerr( nf90_put_var( idfile, idivqcf(jv), &
+               &                       fbdata%ivqcf(:,:,jv) ),&
+               &         cpname, __LINE__ )
+            CALL chkerr( nf90_put_var( idfile, idivlqc(jv), &
+               &                       fbdata%ivlqc(:,:,jv) ),&
+               &         cpname, __LINE__ )
+            CALL chkerr( nf90_put_var( idfile, idivlqcf(jv), &
+               &                       fbdata%ivlqcf(:,:,:,jv) ),&
+               &         cpname, __LINE__ )
+            IF (fbdata%lgrid) THEN
+               CALL chkerr( nf90_put_var( idfile, idiobsi(jv), &
+                  &                       fbdata%iobsi(:,jv) ),&
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_put_var( idfile, idiobsj(jv), &
+                  &                       fbdata%iobsj(:,jv) ),&
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_put_var( idfile, idiobsk(jv), &
+                  &                       fbdata%iobsk(:,:,jv) ),&
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_put_var( idfile, idcgrid(jv), &
+                  &                       fbdata%cgrid(jv) ), &
+                  &         cpname, __LINE__ )
+            ENDIF
+         END DO
+
+         IF ( fbdata%next > 0 ) THEN
+            DO je = 1, fbdata%next
+               CALL chkerr( nf90_put_var( idfile, idpext(je), &
+                  &                       fbdata%pext(:,:,je) ), &
+                  &         cpname, __LINE__ )
+            END DO
+         ENDIF
+
+      ENDIF
+
+      ! Close the file
+
+      CALL chkerr( nf90_close( idfile ), cpname, __LINE__ )
+
+      
+   END SUBROUTINE write_obfbdata
+
+   SUBROUTINE putvaratt_obfbdata( idfile, idvar, cdlongname, cdunits, &
+      &                           conventions, cfillvalue, &
+      &                           ifillvalue, rfillvalue )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE putvaratt_obfbdata  ***
+      !!
+      !! ** Purpose :   Write netcdf attributes for variable
+      !!
+      !! ** Method  :   
+      !!
+      !! ** Action  : 
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER :: idfile                    ! File netcdf id.
+      INTEGER :: idvar                     ! Variable netcdf id.
+      CHARACTER(len=*) :: cdlongname       ! Long name for variable
+      CHARACTER(len=*), OPTIONAL :: cdunits       ! Units for variable
+      CHARACTER(len=*), OPTIONAL :: cfillvalue    ! Fill value for character variables
+      INTEGER, OPTIONAL :: ifillvalue             ! Fill value for integer variables
+      REAL(kind=fbsp), OPTIONAL :: rfillvalue     ! Fill value for real variables
+      CHARACTER(len=*), OPTIONAL :: conventions   ! Conventions for variable
+      !! * Local variables
+      CHARACTER(LEN=18), PARAMETER :: &
+         & cpname = 'putvaratt_obfbdata'
+
+      CALL chkerr( nf90_put_att( idfile, idvar, 'long_name', &
+         &                       TRIM(cdlongname) ), &
+         &                       cpname, __LINE__ )
+      
+      IF ( PRESENT(cdunits) ) THEN
+
+         CALL chkerr( nf90_put_att( idfile, idvar, 'units', &
+            &                       TRIM(cdunits) ), &
+            &                       cpname, __LINE__ )
+
+      ENDIF
+
+      IF ( PRESENT(conventions) ) THEN
+
+         CALL chkerr( nf90_put_att( idfile, idvar, 'Conventions', &
+            &                       TRIM(conventions) ), &
+            &                       cpname, __LINE__ )
+
+      ENDIF
+
+      IF ( PRESENT(cfillvalue) ) THEN
+
+         CALL chkerr( nf90_put_att( idfile, idvar, '_Fillvalue', &
+            &                       TRIM(cfillvalue) ), &
+            &                       cpname, __LINE__ )
+
+      ENDIF
+
+      IF ( PRESENT(ifillvalue) ) THEN
+
+         CALL chkerr( nf90_put_att( idfile, idvar, '_Fillvalue', &
+            &                       ifillvalue ), &
+            &                       cpname, __LINE__ )
+
+      ENDIF
+
+      IF ( PRESENT(rfillvalue) ) THEN
+
+         CALL chkerr( nf90_put_att( idfile, idvar, '_Fillvalue', &
+            &                       rfillvalue ), &
+            &                       cpname, __LINE__ )
+
+      ENDIF
+
+   END SUBROUTINE putvaratt_obfbdata
+
+   SUBROUTINE read_obfbdata( cdfilename, fbdata, ldgrid )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE read_obfbdata  ***
+      !!
+      !! ** Purpose :   Read an obfbdata structure from a netCDF file.
+      !!
+      !! ** Method  :   
+      !!
+      !! ** Action  : 
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(len=*) :: cdfilename  ! Input filename
+      TYPE(obfbdata)   :: fbdata      ! obsfbdata structure
+      LOGICAL, OPTIONAL :: ldgrid     ! Allow forcing of grid info
+      !! * Local variables
+      CHARACTER(LEN=14), PARAMETER :: cpname = 'read_obfbdata'
+      INTEGER :: idfile
+      INTEGER :: idodim
+      INTEGER :: idldim
+      INTEGER :: idvdim
+      INTEGER :: idadim
+      INTEGER :: idedim
+      INTEGER :: idgdim
+      INTEGER :: idvard
+      INTEGER :: idaddd
+      INTEGER :: idextd
+      INTEGER :: idcdwmo
+      INTEGER :: idcdtyp
+      INTEGER :: idplam
+      INTEGER :: idpphi
+      INTEGER :: idpdep
+      INTEGER :: idptim
+      INTEGER :: idptimr
+      INTEGER :: idioqc        
+      INTEGER :: idioqcf
+      INTEGER :: idipqc
+      INTEGER :: idipqcf
+      INTEGER :: ididqc
+      INTEGER :: ididqcf
+      INTEGER :: iditqc
+      INTEGER :: iditqcf
+      INTEGER :: idkindex
+      INTEGER, DIMENSION(:), ALLOCATABLE :: &
+         & idpob,    &
+         & idivqc,   &
+         & idivqcf,  &
+         & idivlqc,  &
+         & idivlqcf, &
+         & idiobsi,  &
+         & idiobsj,  &
+         & idiobsk,  &
+         & idcgrid,  &
+         & idpext
+      INTEGER, DIMENSION(:,:), ALLOCATABLE :: &
+         & idpadd
+      INTEGER :: jv
+      INTEGER :: je
+      INTEGER :: nvar
+      INTEGER :: nobs
+      INTEGER :: nlev
+      INTEGER :: nadd
+      INTEGER :: next
+      LOGICAL :: lgrid
+      CHARACTER(len=NF90_MAX_NAME) :: cdtmp
+
+      ! Check allocation status and deallocate previous allocated structures
+
+      IF ( fbdata%lalloc ) THEN
+         CALL dealloc_obfbdata( fbdata )
+      ENDIF
+
+      ! Open input filename
+
+      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, idfile ), &
+         &         cpname, __LINE__ )
+
+      ! Get input dimensions
+
+      CALL chkerr( nf90_inq_dimid( idfile, 'N_OBS'  , idodim ),  &
+         &         cpname,__LINE__ )
+      CALL chkerr( nf90_inquire_dimension( idfile, idodim, len=nobs ), &
+         &         cpname,__LINE__ )
+      CALL chkerr( nf90_inq_dimid( idfile, 'N_LEVELS', idldim ), &
+         &         cpname,__LINE__ )
+      CALL chkerr( nf90_inquire_dimension( idfile, idldim, len=nlev ), &
+         &         cpname,__LINE__ )
+      CALL chkerr( nf90_inq_dimid( idfile, 'N_VARS', idvdim ), &
+         &         cpname,__LINE__ )
+      CALL chkerr( nf90_inquire_dimension( idfile, idvdim, len=nvar ), &
+         &         cpname,__LINE__ )
+      IF ( nf90_inq_dimid( idfile, 'N_ENTRIES',  idadim ) == 0 ) THEN
+         CALL chkerr( nf90_inquire_dimension( idfile, idadim, len=nadd ), &
+            &         cpname,__LINE__ )
+      ELSE
+         nadd = 0
+      ENDIF
+      IF ( nf90_inq_dimid( idfile, 'N_EXTRA',  idedim ) == 0 ) THEN
+         CALL chkerr( nf90_inquire_dimension( idfile, idedim, len=next ), &
+            &         cpname,__LINE__ )
+      ELSE
+         next = 0
+      ENDIF
+      !
+      ! Check if this input file  contains grid search informations
+      !
+      lgrid = ( nf90_inq_dimid( idfile, 'STRINGGRID',  idgdim ) == 0 )
+
+      ! Allocate data structure
+
+      IF ( PRESENT(ldgrid) ) THEN
+         CALL alloc_obfbdata( fbdata, nvar, nobs, nlev, nadd, next, &
+            & lgrid.OR.ldgrid )
+      ELSE
+         CALL alloc_obfbdata( fbdata, nvar, nobs, nlev, nadd, next, &
+            & lgrid )
+      ENDIF
+
+      ! Allocate netcdf identifiers
+
+      ALLOCATE( &
+         & idpob(fbdata%nvar),    &
+         & idivqc(fbdata%nvar),   &
+         & idivqcf(fbdata%nvar),  &
+         & idivlqc(fbdata%nvar),  &
+         & idivlqcf(fbdata%nvar), &
+         & idiobsi(fbdata%nvar),  &
+         & idiobsj(fbdata%nvar),  &
+         & idiobsk(fbdata%nvar),  &
+         & idcgrid(fbdata%nvar)   &
+         & )
+      IF ( fbdata%nadd > 0 ) THEN
+         ALLOCATE( &
+            & idpadd(fbdata%nadd,fbdata%nvar) &
+            & )
+      ENDIF
+      IF ( fbdata%next > 0 ) THEN
+         ALLOCATE( &
+            & idpext(fbdata%next) &
+            & )
+      ENDIF
+
+      ! Read variables for header information
+
+      CALL chkerr( nf90_inq_varid( idfile, 'VARIABLES',idvard ), &
+         &         cpname, __LINE__ )
+      CALL chkerr( nf90_get_var( idfile, idvard, fbdata%cname ), &
+         &         cpname, __LINE__ )
+      IF ( fbdata%nadd > 0 ) THEN
+         CALL chkerr( nf90_inq_varid( idfile, 'ENTRIES', idaddd ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_get_var( idfile, idaddd, fbdata%caddname ), &
+            &         cpname, __LINE__ )
+      ENDIF
+      IF ( fbdata%next > 0 ) THEN
+         CALL chkerr( nf90_inq_varid( idfile, 'EXTRA', idextd ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_get_var( idfile, idextd, fbdata%cextname ), &
+            &         cpname, __LINE__ )
+      ENDIF
+
+      CALL chkerr( nf90_inq_varid( idfile, 'JULD_REFERENCE', idptimr ), &
+         &         cpname, __LINE__ )
+      CALL chkerr( nf90_get_var( idfile, idptimr, fbdata%cdjuldref ), &
+         &         cpname, __LINE__ )
+
+      IF  ( fbdata%nobs > 0 ) THEN
+         
+         CALL chkerr( nf90_inq_varid( idfile, 'STATION_IDENTIFIER', idcdwmo ),&
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_get_var( idfile, idcdwmo, fbdata%cdwmo ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_inq_varid( idfile, 'STATION_TYPE', idcdtyp ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_get_var( idfile, idcdtyp, fbdata%cdtyp), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_inq_varid( idfile, 'LONGITUDE', idplam ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_get_var( idfile, idplam, fbdata%plam ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_inq_varid( idfile, 'LATITUDE', idpphi ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_get_var( idfile, idpphi, fbdata%pphi ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_inq_varid( idfile, 'DEPTH', idpdep ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_get_var( idfile, idpdep, fbdata%pdep ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_inq_varid( idfile, 'JULD', idptim ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_get_var( idfile, idptim, fbdata%ptim ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_inq_varid( idfile, 'OBSERVATION_QC', idioqc ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_get_var( idfile, idioqc, fbdata%ioqc ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_inq_varid( idfile, 'OBSERVATION_QC_FLAGS', idioqcf ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_get_var( idfile, idioqcf, fbdata%ioqcf ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_inq_varid( idfile, 'POSITION_QC', idipqc ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_get_var( idfile, idipqc, fbdata%ipqc ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_inq_varid( idfile, 'POSITION_QC_FLAGS', idipqcf ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_get_var( idfile, idipqcf, fbdata%ipqcf ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_inq_varid( idfile, 'DEPTH_QC', ididqc ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_get_var( idfile, ididqc, fbdata%idqc ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_inq_varid( idfile, 'DEPTH_QC_FLAGS', ididqcf ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_get_var( idfile, ididqcf, fbdata%idqcf ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_inq_varid( idfile, 'JULD_QC', iditqc ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_get_var( idfile, iditqc, fbdata%itqc ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_inq_varid( idfile, 'JULD_QC_FLAGS', iditqcf ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_get_var( idfile, iditqcf, fbdata%itqcf ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_inq_varid( idfile, 'ORIGINAL_FILE_INDEX', idkindex ), &
+            &         cpname, __LINE__ )
+         CALL chkerr( nf90_get_var( idfile, idkindex, fbdata%kindex ), &
+            &         cpname, __LINE__ )
+         
+         ! Read netCDF variables for individual variables
+         
+         DO jv = 1, fbdata%nvar
+            
+            WRITE(cdtmp,'(2A)') TRIM(fbdata%cname(jv)),'_OBS'
+            CALL chkerr( nf90_inq_varid( idfile, cdtmp, idpob(jv) ), &
+               &         cpname, __LINE__ )
+            CALL chkerr( nf90_get_var( idfile, idpob(jv), &
+               &                       fbdata%pob(:,:,jv) ), &
+               &         cpname, __LINE__ )
+            CALL getvaratt_obfbdata( idfile, idpob(jv), &
+               &                     fbdata%coblong(jv), &
+               &                     fbdata%cobunit(jv) )
+            
+            IF ( fbdata%nadd > 0 ) THEN
+               DO je = 1, fbdata%nadd
+                  WRITE(cdtmp,'(3A)') TRIM(fbdata%cname(jv)),'_',&
+                     &                TRIM(fbdata%caddname(je))
+                  CALL chkerr( nf90_inq_varid( idfile, cdtmp, idpadd(je,jv) ), &
+                     &         cpname, __LINE__ )
+                  CALL chkerr( nf90_get_var( idfile, idpadd(je,jv), &
+                     &                       fbdata%padd(:,:,je,jv) ), &
+                     &         cpname, __LINE__ )
+                  CALL getvaratt_obfbdata( idfile, idpadd(je,jv), &
+                     &                     fbdata%caddlong(je,jv), &
+                     &                     fbdata%caddunit(je,jv) )
+               END DO
+            ENDIF
+            
+            WRITE(cdtmp,'(2A)') TRIM(fbdata%cname(jv)),'_QC'
+            CALL chkerr( nf90_inq_varid( idfile, cdtmp, idivqc(jv) ), &
+            &         cpname, __LINE__ )
+            CALL chkerr( nf90_get_var( idfile, idivqc(jv), &
+               &                       fbdata%ivqc(:,jv) ), &
+               &         cpname, __LINE__ )
+            WRITE(cdtmp,'(2A)') TRIM(fbdata%cname(jv)),'_QC_FLAGS'
+            CALL chkerr( nf90_inq_varid( idfile, cdtmp, idivqcf(jv) ), &
+               &         cpname, __LINE__ )
+            CALL chkerr( nf90_get_var( idfile, idivqcf(jv), &
+               &                       fbdata%ivqcf(:,:,jv) ), &
+               &         cpname, __LINE__ )
+            WRITE(cdtmp,'(2A)') TRIM(fbdata%cname(jv)),'_LEVEL_QC'
+            CALL chkerr( nf90_inq_varid( idfile, cdtmp, idivlqc(jv) ), &
+               &         cpname, __LINE__ )
+            CALL chkerr( nf90_get_var( idfile, idivlqc(jv), &
+               &                       fbdata%ivlqc(:,:,jv) ), &
+               &         cpname, __LINE__ )
+            WRITE(cdtmp,'(2A)') TRIM(fbdata%cname(jv)),'_LEVEL_QC_FLAGS'
+            CALL chkerr( nf90_inq_varid( idfile, cdtmp, idivlqcf(jv) ), &
+               &         cpname, __LINE__ )
+            CALL chkerr( nf90_get_var( idfile, idivlqcf(jv), &
+               &                       fbdata%ivlqcf(:,:,:,jv) ), &
+               &         cpname, __LINE__ )
+            IF ( lgrid ) THEN
+               WRITE(cdtmp,'(2A)') TRIM(fbdata%cname(jv)),'_IOBSI'
+               CALL chkerr( nf90_inq_varid( idfile, cdtmp, idiobsi(jv) ), &
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_get_var( idfile, idiobsi(jv), &
+                  &                       fbdata%iobsi(:,jv) ), &
+                  &         cpname, __LINE__ )
+               WRITE(cdtmp,'(2A)') TRIM(fbdata%cname(jv)),'_IOBSJ'
+               CALL chkerr( nf90_inq_varid( idfile, cdtmp, idiobsj(jv) ), &
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_get_var( idfile, idiobsj(jv), &
+                  &                       fbdata%iobsj(:,jv) ), &
+                  &         cpname, __LINE__ )
+               WRITE(cdtmp,'(2A)') TRIM(fbdata%cname(jv)),'_IOBSK'
+               CALL chkerr( nf90_inq_varid( idfile, cdtmp, idiobsk(jv) ), &
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_get_var( idfile, idiobsk(jv), &
+                  &                       fbdata%iobsk(:,:,jv) ), &
+                  &         cpname, __LINE__ )
+               WRITE(cdtmp,'(2A)') TRIM(fbdata%cname(jv)),'_GRID'
+               CALL chkerr( nf90_inq_varid( idfile, cdtmp, idcgrid(jv) ), &
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_get_var( idfile, idcgrid(jv), &
+                  &                       fbdata%cgrid(jv) ), &
+                  &         cpname, __LINE__ )
+            ENDIF
+            
+         END DO
+         
+         IF ( fbdata%next > 0 ) THEN
+            DO je = 1, fbdata%next
+               WRITE(cdtmp,'(A)') TRIM(fbdata%cextname(je))
+               CALL chkerr( nf90_inq_varid( idfile, cdtmp, idpext(je) ), &
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_get_var( idfile, idpext(je), &
+                  &                       fbdata%pext(:,:,je) ), &
+                  &         cpname, __LINE__ )
+               CALL getvaratt_obfbdata( idfile, idpext(je), &
+                  &                     fbdata%cextlong(je), &
+                  &                     fbdata%cextunit(je) )
+            END DO
+         ENDIF
+
+      ELSE ! if no observations only get attributes
+
+         DO jv = 1, fbdata%nvar            
+
+            WRITE(cdtmp,'(2A)') TRIM(fbdata%cname(jv)),'_OBS'
+            CALL chkerr( nf90_inq_varid( idfile, cdtmp, idpob(jv) ), &
+               &         cpname, __LINE__ )
+            CALL getvaratt_obfbdata( idfile, idpob(jv), &
+               &                     fbdata%coblong(jv), &
+               &                     fbdata%cobunit(jv) )
+            
+            IF ( fbdata%nadd > 0 ) THEN
+               DO je = 1, fbdata%nadd
+                  WRITE(cdtmp,'(3A)') TRIM(fbdata%cname(jv)),'_',&
+                     &                TRIM(fbdata%caddname(je))
+                  CALL chkerr( nf90_inq_varid( idfile, cdtmp, idpadd(je,jv) ), &
+                     &         cpname, __LINE__ )
+                  CALL getvaratt_obfbdata( idfile, idpadd(je,jv), &
+                     &                     fbdata%caddlong(je,jv), &
+                     &                     fbdata%caddunit(je,jv) )
+               END DO
+            ENDIF
+            
+         END DO
+         
+         IF ( fbdata%next > 0 ) THEN
+            DO je = 1, fbdata%next
+               WRITE(cdtmp,'(A)') TRIM(fbdata%cextname(je))
+               CALL chkerr( nf90_inq_varid( idfile, cdtmp, idpext(je) ), &
+                  &         cpname, __LINE__ )
+               CALL getvaratt_obfbdata( idfile, idpext(je), &
+                  &                     fbdata%cextlong(je), &
+                  &                     fbdata%cextunit(je) )
+            END DO
+         ENDIF
+
+      ENDIF
+
+      ! Close the file
+
+      CALL chkerr( nf90_close( idfile ), cpname, __LINE__ )
+
+   END SUBROUTINE read_obfbdata
+
+   SUBROUTINE getvaratt_obfbdata( idfile, idvar, cdlongname, cdunits )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE putvaratt_obfbdata  ***
+      !!
+      !! ** Purpose :   Read netcdf attributes for variable
+      !!
+      !! ** Method  :   
+      !!
+      !! ** Action  : 
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER :: idfile      ! File netcdf id.
+      INTEGER :: idvar       ! Variable netcdf id.
+      CHARACTER(len=*) :: cdlongname  ! Long name for variable
+      CHARACTER(len=*) :: cdunits     ! Units for variable
+      !! * Local variables
+      CHARACTER(LEN=18), PARAMETER :: cpname = 'getvaratt_obfbdata'
+
+      CALL chkerr( nf90_get_att( idfile, idvar, 'long_name', &
+         &                       cdlongname ), &
+         &                       cpname, __LINE__ )
+
+      CALL chkerr( nf90_get_att( idfile, idvar, 'units', &
+         &                       cdunits ), &
+         &                       cpname, __LINE__ )
+
+   END SUBROUTINE getvaratt_obfbdata
+
+END MODULE obs_fbm
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grd_bruteforce.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grd_bruteforce.h90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grd_bruteforce.h90	(revision 2528)
@@ -0,0 +1,349 @@
+   SUBROUTINE obs_grd_bruteforce( kpi, kpj, kpiglo, kpjglo,       &
+      &                            kldi, klei, kldj, klej,         &
+      &                            kmyproc, ktotproc,              &
+      &                            pglam, pgphi, pmask,            &
+      &                            kobs, plam, pphi, kobsi, kobsj, &
+      &                                   kproc)
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE obs_grd_bruteforce ***
+      !!
+      !! ** Purpose : Search gridpoints to find the grid box containing
+      !!              the observations
+      !!
+      !! ** Method  : Call to linquad
+      !!
+      !! ** Action  : Return kproc holding the observation and kiobsi,kobsj
+      !!              valid on kproc=kmyproc processor only.
+      !!   
+      !! History :
+      !!        !  2001-11  (N. Daget, A. Weaver)
+      !!        !  2006-03  (A. Weaver) NEMOVAR migration.
+      !!        !  2006-05  (K. Mogensen) Moved to to separate routine.
+      !!        !  2007-10  (A. Vidard) Bug fix in wrap around checks; cleanup
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kpi                ! Number of local longitudes
+      INTEGER, INTENT(IN) :: kpj                ! Number of local latitudes
+      INTEGER, INTENT(IN) :: kpiglo             ! Number of global longitudes
+      INTEGER, INTENT(IN) :: kpjglo             ! Number of global latitudes
+      INTEGER, INTENT(IN) :: kldi               ! Start of inner domain in i
+      INTEGER, INTENT(IN) :: klei               ! End of inner domain in i
+      INTEGER, INTENT(IN) :: kldj               ! Start of inner domain in j
+      INTEGER, INTENT(IN) :: klej               ! End of inner domain in j
+      INTEGER, INTENT(IN) :: kmyproc            ! Processor number for MPP
+      INTEGER, INTENT(IN) :: ktotproc           ! Total number of processors
+      REAL(KIND=wp), DIMENSION(kpi,kpj), INTENT(IN) :: &
+         & pglam,   &               ! Grid point longitude
+         & pgphi,   &               ! Grid point latitude
+         & pmask                    ! Grid point mask
+      INTEGER,INTENT(IN) :: kobs                ! Size of the observation arrays
+      REAL(KIND=wp), DIMENSION(kobs), INTENT(IN) :: &
+         & plam, &                  ! Longitude of obsrvations 
+         & pphi                     ! Latitude of observations
+      INTEGER, DIMENSION(kobs), INTENT(OUT) :: &
+         & kobsi, &                 ! I-index of observations 
+         & kobsj, &                 ! J-index of observations 
+         & kproc                    ! Processor number of observations
+  
+      !! * Local declarations
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: &
+         & zplam, zpphi
+      REAL(wp) :: zlammax
+      REAL(wp) :: zlam
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jk
+      INTEGER :: jo
+      INTEGER :: jlon
+      INTEGER :: jlat
+      INTEGER :: joffset
+      INTEGER :: jostride
+      REAL(KIND=wp), DIMENSION(:,:), ALLOCATABLE :: &
+         & zlamg, &
+         & zphig, &
+         & zmskg, &
+         & zphitmax,&
+         & zphitmin,&
+         & zlamtmax,&
+         & zlamtmin
+      LOGICAL, DIMENSION(:,:), ALLOCATABLE :: &
+         & llinvalidcell
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
+         & zlamtm,  &
+         & zphitm
+
+      !-----------------------------------------------------------------------
+      ! Define grid setup for grid search
+      !-----------------------------------------------------------------------
+      IF (ln_grid_global) THEN
+         jlon     = kpiglo
+         jlat     = kpjglo
+         joffset  = kmyproc
+         jostride = ktotproc
+      ELSE
+         jlon     = kpi
+         jlat     = kpj
+         joffset  = 0
+         jostride = 1
+      ENDIF
+      !-----------------------------------------------------------------------
+      ! Set up data for grid search
+      !-----------------------------------------------------------------------
+      ALLOCATE( &
+         & zlamg(jlon,jlat),             &
+         & zphig(jlon,jlat),             &
+         & zmskg(jlon,jlat),             &
+         & zphitmax(jlon-1,jlat-1),      &
+         & zphitmin(jlon-1,jlat-1),      &
+         & zlamtmax(jlon-1,jlat-1),      &
+         & zlamtmin(jlon-1,jlat-1),      &
+         & llinvalidcell(jlon-1,jlat-1), &
+         & zlamtm(4,jlon-1,jlat-1),      &
+         & zphitm(4,jlon-1,jlat-1)       &
+         & )
+      !-----------------------------------------------------------------------
+      ! Copy data to local arrays
+      !-----------------------------------------------------------------------
+      IF (ln_grid_global) THEN
+         zlamg(:,:) = -1.e+10
+         zphig(:,:) = -1.e+10
+         zmskg(:,:) = -1.e+10
+         DO jj = kldj, klej
+            DO ji = kldi, klei
+               zlamg(mig(ji),mjg(jj)) = pglam(ji,jj)
+               zphig(mig(ji),mjg(jj)) = pgphi(ji,jj)
+               zmskg(mig(ji),mjg(jj)) = pmask(ji,jj)
+            END DO
+         END DO
+         CALL mpp_global_max( zlamg )
+         CALL mpp_global_max( zphig )
+         CALL mpp_global_max( zmskg )
+      ELSE
+         DO jj = 1, jlat
+            DO ji = 1, jlon
+               zlamg(ji,jj) = pglam(ji,jj)
+               zphig(ji,jj) = pgphi(ji,jj)
+               zmskg(ji,jj) = pmask(ji,jj)
+            END DO
+         END DO
+      ENDIF
+      !-----------------------------------------------------------------------
+      ! Copy longitudes and latitudes
+      !-----------------------------------------------------------------------
+      ALLOCATE( &
+         & zplam(kobs), &
+         & zpphi(kobs)  &
+         & )
+      DO jo = 1, kobs
+         zplam(jo) = plam(jo)
+         zpphi(jo) = pphi(jo)
+      END DO
+      !-----------------------------------------------------------------------
+      ! Set default values for output
+      !-----------------------------------------------------------------------
+      kproc(:) = -1
+      kobsi(:) = -1
+      kobsj(:) = -1
+      !-----------------------------------------------------------------------
+      ! Copy grid positions to temporary arrays and renormalize to 0 to 360.
+      !-----------------------------------------------------------------------
+      DO jj = 1, jlat-1
+         DO ji = 1, jlon-1
+            zlamtm(1,ji,jj) = zlamg(ji  ,jj  )
+            zphitm(1,ji,jj) = zphig(ji  ,jj  )
+            zlamtm(2,ji,jj) = zlamg(ji+1,jj  )
+            zphitm(2,ji,jj) = zphig(ji+1,jj  )
+            zlamtm(3,ji,jj) = zlamg(ji+1,jj+1)
+            zphitm(3,ji,jj) = zphig(ji+1,jj+1)
+            zlamtm(4,ji,jj) = zlamg(ji  ,jj+1)
+            zphitm(4,ji,jj) = zphig(ji  ,jj+1)
+         END DO
+      END DO
+      WHERE ( zlamtm(:,:,:) < 0.0_wp )
+         zlamtm(:,:,:) = zlamtm(:,:,:) + 360.0_wp
+      END WHERE
+      WHERE ( zlamtm(:,:,:) > 360.0_wp )
+         zlamtm(:,:,:) = zlamtm(:,:,:) - 360.0_wp
+      END WHERE
+      !-----------------------------------------------------------------------
+      ! Handle case of the wraparound; beware, not working with orca180
+      !-----------------------------------------------------------------------
+      DO jj = 1, jlat-1
+         DO ji = 1, jlon-1
+            zlammax = MAXVAL( zlamtm(:,ji,jj) )
+            WHERE (zlammax - zlamtm(:, ji, jj) > 180 ) &
+               & zlamtm(:,ji,jj) = zlamtm(:,ji,jj) + 360._wp
+            zphitmax(ji,jj) = MAXVAL(zphitm(:,ji,jj))
+            zphitmin(ji,jj) = MINVAL(zphitm(:,ji,jj))
+            zlamtmax(ji,jj) = MAXVAL(zlamtm(:,ji,jj))
+            zlamtmin(ji,jj) = MINVAL(zlamtm(:,ji,jj))
+         END DO
+      END DO
+      !-----------------------------------------------------------------------
+      ! Search for boxes with only land points mark them invalid
+      !-----------------------------------------------------------------------
+      llinvalidcell(:,:) = .FALSE.
+      DO jj = 1, jlat-1
+         DO ji = 1, jlon-1
+            llinvalidcell(ji,jj) =               &
+               & zmskg(ji  ,jj  ) == 0.0_wp .AND. &
+               & zmskg(ji+1,jj  ) == 0.0_wp .AND. &
+               & zmskg(ji+1,jj+1) == 0.0_wp .AND. &
+               & zmskg(ji  ,jj+1) == 0.0_wp
+         END DO
+      END DO
+
+      !------------------------------------------------------------------------
+      ! Master loop for grid search
+      !------------------------------------------------------------------------
+
+      DO jo = 1+joffset, kobs, jostride
+
+         !---------------------------------------------------------------------
+         ! Ensure that all observation longtiudes are between 0 and 360
+         !---------------------------------------------------------------------
+
+         IF ( zplam(jo) <   0.0_wp ) zplam(jo) = zplam(jo) + 360.0_wp
+         IF ( zplam(jo) > 360.0_wp ) zplam(jo) = zplam(jo) - 360.0_wp
+
+         !---------------------------------------------------------------------
+         ! Find observations which are on within 1e-6 of a grid point
+         !---------------------------------------------------------------------
+
+         gridloop: DO jj = 1, jlat-1
+            DO ji = 1, jlon-1
+               IF ( ABS( zphig(ji,jj) - zpphi(jo) ) < 1e-6 )  THEN
+                  zlam = zlamg(ji,jj)
+                  IF ( zlam <   0.0_wp ) zlam = zlam + 360.0_wp
+                  IF ( zlam > 360.0_wp ) zlam = zlam - 360.0_wp
+                  IF ( ABS( zlam - zplam(jo) ) < 1e-6 ) THEN
+                     IF ( llinvalidcell(ji,jj) ) THEN
+                        kproc(jo) = kmyproc + 1000000
+                        kobsi(jo) = ji + 1
+                        kobsj(jo) = jj + 1
+                        CYCLE
+                     ELSE
+                        kproc(jo) = kmyproc
+                        kobsi(jo) = ji + 1
+                        kobsj(jo) = jj + 1
+                        EXIT gridloop
+                     ENDIF
+                  ENDIF
+               ENDIF
+            END DO
+         END DO gridloop
+         
+         !---------------------------------------------------------------------
+         ! Ensure that all observation longtiudes are between -180 and 180
+         !---------------------------------------------------------------------
+
+         IF ( zplam(jo) > 180 ) zplam(jo) = zplam(jo) - 360.0_wp
+
+         !---------------------------------------------------------------------
+         ! Do coordinate search using brute force.
+         ! - For land points kproc is set to number of the processor + 1000000
+         !   and we continue the search.
+         ! - For ocean points kproc is set to the number of the processor 
+         !   and we stop the search.
+         !---------------------------------------------------------------------
+
+         IF ( kproc(jo) == -1 ) THEN
+
+            ! Normal case
+            gridpoints : DO jj = 1, jlat-1
+               DO ji = 1, jlon-1
+                  
+                  IF ( ( zplam(jo) > zlamtmax(ji,jj) ) .OR. &
+                     & ( zplam(jo) < zlamtmin(ji,jj) ) ) CYCLE
+                  
+                  IF ( ABS( zpphi(jo) ) < 85 ) THEN
+                     IF ( ( zpphi(jo) > zphitmax(ji,jj) ) .OR. &
+                        & ( zpphi(jo) < zphitmin(ji,jj) ) ) CYCLE
+                  ENDIF
+                  
+                  IF ( linquad( zplam(jo), zpphi(jo), &
+                     &          zlamtm(:,ji,jj), zphitm(:,ji,jj) ) ) THEN
+                     IF ( llinvalidcell(ji,jj) ) THEN
+                        kproc(jo) = kmyproc + 1000000
+                        kobsi(jo) = ji + 1
+                        kobsj(jo) = jj + 1
+                        CYCLE
+                     ELSE
+                        kproc(jo) = kmyproc
+                        kobsi(jo) = ji + 1
+                        kobsj(jo) = jj + 1
+                        EXIT gridpoints
+                     ENDIF
+                  ENDIF
+                  
+               END DO
+            END DO gridpoints
+
+         ENDIF
+
+         ! In case of failure retry for obs. longtiude + 360.
+         IF ( kproc(jo) == -1 ) THEN
+            gridpoints_greenwich : DO jj = 1, jlat-1
+               DO ji = 1, jlon-1
+
+                  IF ( ( zplam(jo)+360.0_wp > zlamtmax(ji,jj) ) .OR. &
+                     & ( zplam(jo)+360.0_wp < zlamtmin(ji,jj) ) ) CYCLE
+
+                  IF ( ABS( zpphi(jo) ) < 85 ) THEN
+                     IF ( ( zpphi(jo) > zphitmax(ji,jj) ) .OR. &
+                        & ( zpphi(jo) < zphitmin(ji,jj) ) ) CYCLE
+                  ENDIF
+
+                  IF ( linquad( zplam(jo)+360.0_wp, zpphi(jo), &
+                     &          zlamtm(:,ji,jj), zphitm(:,ji,jj) ) ) THEN
+                     IF ( llinvalidcell(ji,jj) ) THEN
+                        kproc(jo) = kmyproc + 1000000
+                        kobsi(jo) = ji + 1
+                        kobsj(jo) = jj + 1
+                        CYCLE
+                     ELSE
+                        kproc(jo) = kmyproc
+                        kobsi(jo) = ji + 1
+                        kobsj(jo) = jj + 1
+                        EXIT gridpoints_greenwich
+                     ENDIF
+                  ENDIF
+
+               END DO
+            END DO gridpoints_greenwich
+
+         ENDIF
+      END DO
+
+      !----------------------------------------------------------------------
+      ! Synchronize kproc on all processors
+      !----------------------------------------------------------------------
+      IF ( ln_grid_global ) THEN
+         CALL obs_mpp_max_integer( kproc, kobs )
+         CALL obs_mpp_max_integer( kobsi, kobs )
+         CALL obs_mpp_max_integer( kobsj, kobs )
+      ELSE
+         CALL obs_mpp_find_obs_proc( kproc, kobsi, kobsj, kobs )
+      ENDIF
+
+      WHERE( kproc(:) >= 1000000 )
+         kproc(:) = kproc(:) - 1000000
+      END WHERE
+
+      DEALLOCATE( &
+         & zlamg,         &
+         & zphig,         &
+         & zmskg,         &
+         & zphitmax,      &
+         & zphitmin,      &
+         & zlamtmax,      &
+         & zlamtmin,      &
+         & llinvalidcell, &
+         & zlamtm,        &
+         & zphitm,        &
+         & zplam,         &
+         & zpphi          &
+         & )
+
+   END SUBROUTINE obs_grd_bruteforce
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grid.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grid.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grid.F90	(revision 2528)
@@ -0,0 +1,1178 @@
+MODULE obs_grid
+   !!======================================================================
+   !!                       ***  MODULE  obs_grid  ***
+   !! Observation diagnostics: Various tools for grid searching etc.
+   !!======================================================================
+   !!----------------------------------------------------------------------
+   !!   obs_grid_search   : Find i,j on the ORCA grid from lat,lon
+   !!   obs_level_search  : Find level from depth
+   !!   obs_zlevel_search : Find depth level from observed depth
+   !!   obs_tlevel_search : Find temperature level from observed temp
+   !!   obs_rlevel_search : Find density level from observed density
+   !!----------------------------------------------------------------------
+   !! * Modules used   
+   USE par_kind, ONLY : &          ! Precision variables
+      & wp 
+   USE par_oce, ONLY :  &          ! Ocean parameters
+      & jpk,     &
+      & jpni,    &
+      & jpnj,    &
+      & jpnij
+   USE dom_oce                     ! Ocean space and time domain variables
+   USE obs_mpp, ONLY : &           ! MPP support routines for observation diagnostics
+      & obs_mpp_find_obs_proc, &
+      & mpp_global_max,        &
+      & obs_mpp_max_integer
+   USE phycst, ONLY : &            ! Physical constants
+      & rad
+   USE obs_utils, ONLY : &         ! Observation operator utility functions
+      & grt_cir_dis, &
+      & chkerr
+   USE in_out_manager              ! Printing support
+   USE netcdf
+   USE obs_const, ONLY :      &
+      & obfillflt                  ! Fillvalue   
+   
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PUBLIC  obs_grid_setup,      & ! Setup grid searching
+      &    obs_grid_search,     & ! Find i, j on the ORCA grid from lat, lon
+      &    obs_grid_deallocate, & ! Deallocate the look up table
+      &    obs_level_search       ! Find level from depth
+
+   PRIVATE linquad,                    & ! Determine whether a point lies within a cell
+      &    maxdist,                    & ! Find the maximum distance between 2 pts in a cell
+      &    obs_grd_bruteforce, & ! Find i, j on the ORCA grid from lat, lon
+      &    obs_grd_lookup        ! Find i, j on the ORCA grid from lat, lon quicker
+
+   !!* Module variables
+
+   !! Default values
+   REAL, PUBLIC :: grid_search_res = 0.5    ! Resolution of grid
+   INTEGER, PRIVATE :: gsearch_nlons_def    ! Num of longitudes
+   INTEGER, PRIVATE :: gsearch_nlats_def    ! Num of latitudes
+   REAL(wp), PRIVATE :: gsearch_lonmin_def  ! Min longitude
+   REAL(wp), PRIVATE :: gsearch_latmin_def  ! Min latitude
+   REAL(wp), PRIVATE :: gsearch_dlon_def    ! Lon spacing
+   REAL(wp), PRIVATE :: gsearch_dlat_def    ! Lat spacing
+   !! Variable versions
+   INTEGER, PRIVATE :: nlons     ! Num of longitudes
+   INTEGER, PRIVATE :: nlats     ! Num of latitudes
+   REAL(wp), PRIVATE :: lonmin ! Min longitude
+   REAL(wp), PRIVATE :: latmin ! Min latitude
+   REAL(wp), PRIVATE :: dlon     ! Lon spacing
+   REAL(wp), PRIVATE :: dlat     ! Lat spacing
+   
+   INTEGER, PRIVATE :: maxxdiff, maxydiff ! Max diffs between model points
+   INTEGER, PRIVATE :: limxdiff, limydiff
+   
+   ! Data storage
+   REAL(wp), PRIVATE, DIMENSION(:,:), ALLOCATABLE :: &
+      & lons,  &
+      & lats
+   INTEGER, PRIVATE, DIMENSION(:,:), ALLOCATABLE :: &
+      & ixpos, &
+      & iypos, &
+      & iprocn    
+
+   ! Switches
+   LOGICAL, PUBLIC :: ln_grid_search_lookup  ! Use lookup table to speed up grid search
+   LOGICAL, PUBLIC :: ln_grid_global         ! Use global distribution of observations
+   CHARACTER(LEN=44), PUBLIC :: &
+      & grid_search_file    ! file name head for grid search lookup 
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE obs_grid_search( kobsin, plam, pphi, kobsi, kobsj, kproc, &
+      &                        cdgrid )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE obs_grid_search ***
+      !!
+      !! ** Purpose : Search local gridpoints to find the grid box containing
+      !!              the observations calls either
+      !!              obs_grd_bruteforce - the original brute force search
+      !!                     or
+      !!              obs_grd_lookup - uses a lookup table to do a fast 
+      !!search
+      !!History :
+      !!        !  2007-12  (D. Lea) 
+      !!------------------------------------------------------------------------
+
+      !! * Arguments
+      INTEGER :: &
+         & kobsin                     ! Size of the observation arrays
+      REAL(KIND=wp), DIMENSION(kobsin), INTENT(IN) :: &
+         & plam, &                  ! Longitude of obsrvations 
+         & pphi                     ! Latitude of observations
+      INTEGER, DIMENSION(kobsin), INTENT(OUT) :: &
+         & kobsi, &                 ! I-index of observations 
+         & kobsj, &                 ! J-index of observations 
+         & kproc                    ! Processor number of observations
+      CHARACTER(LEN=1) :: &
+         & cdgrid                   ! Grid to search
+
+      IF(kobsin > 0) THEN
+
+         IF ( ln_grid_search_lookup .AND. ( cdgrid == 'T' ) ) THEN
+            CALL obs_grd_lookup( kobsin, plam, pphi, &
+               &                         kobsi, kobsj, kproc )
+         ELSE
+            IF ( cdgrid == 'T' ) THEN
+               CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo, &
+                  &                             nldi, nlei,nldj,  nlej,   &
+                  &                             nproc, jpnij,             &
+                  &                             glamt, gphit, tmask,      &
+                  &                             kobsin, plam, pphi,       &
+                  &                             kobsi, kobsj, kproc )
+            ELSEIF ( cdgrid == 'U' ) THEN
+               CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo, &
+                  &                             nldi, nlei,nldj,  nlej,   &
+                  &                             nproc, jpnij,             &
+                  &                             glamu, gphiu, umask,      &
+                  &                             kobsin, plam, pphi,       &
+                  &                             kobsi, kobsj, kproc )
+            ELSEIF ( cdgrid == 'V' ) THEN
+               CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo, &
+                  &                             nldi, nlei,nldj,  nlej,   &
+                  &                             nproc, jpnij,             &
+                  &                             glamv, gphiv, vmask,      &
+                  &                             kobsin, plam, pphi,       &
+                  &                             kobsi, kobsj, kproc )
+            ELSEIF ( cdgrid == 'F' ) THEN
+               CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo, &
+                  &                             nldi, nlei,nldj,  nlej,   &
+                  &                             nproc, jpnij,             &
+                  &                             glamf, gphif, fmask,      &
+                  &                             kobsin, plam, pphi,       &
+                  &                             kobsi, kobsj, kproc )
+            ELSE
+               CALL ctl_stop( 'Grid not supported' )
+            ENDIF
+         ENDIF
+         
+      ENDIF
+
+   END SUBROUTINE obs_grid_search
+
+#include "obs_grd_bruteforce.h90"
+   
+   SUBROUTINE obs_grd_lookup( kobs, plam, pphi, kobsi, kobsj, kproc )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE obs_grid_lookup ***
+      !!
+      !! ** Purpose : Search local gridpoints to find the grid box containing
+      !!              the observations (much faster then obs_grd_bruteforce)
+      !!
+      !! ** Method  : Call to linquad
+      !!
+      !! ** Action  : Return kproc holding the observation and kiobsi,kobsj
+      !!              valid on kproc=nproc processor only.
+      !!   
+      !! History :
+      !!        !  2007-12 (D. Lea) new routine based on obs_grid_search
+      !!! updated with fixes from new version of obs_grid_search_bruteforce
+      !!! speeded up where points are not near a "difficult" region like an edge
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+      INTEGER :: kobs                     ! Size of the observation arrays
+      REAL(KIND=wp), DIMENSION(kobs), INTENT(IN) :: &
+         & plam, &                  ! Longitude of obsrvations 
+         & pphi                     ! Latitude of observations
+      INTEGER, DIMENSION(kobs), INTENT(OUT) :: &
+         & kobsi, &                 ! I-index of observations 
+         & kobsj, &                 ! J-index of observations 
+         & kproc                    ! Processor number of observations
+  
+      !! * Local declarations
+      REAL(KIND=wp), DIMENSION(:), ALLOCATABLE :: &
+         & zplam
+      REAL(wp) :: zlammax
+      REAL(wp) :: zlam
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jk
+      INTEGER :: jo
+      INTEGER :: isx
+      INTEGER :: isy
+      INTEGER :: jimin
+      INTEGER :: jimax
+      INTEGER :: jjmin
+      INTEGER :: jjmax
+      INTEGER :: jojimin
+      INTEGER :: jojimax
+      INTEGER :: jojjmin
+      INTEGER :: jojjmax
+      INTEGER :: ipx1
+      INTEGER :: ipy1
+      INTEGER :: ip
+      INTEGER :: jp
+      INTEGER :: ipx
+      INTEGER :: ipy
+      INTEGER :: ipmx
+      INTEGER :: jlon
+      INTEGER :: jlat
+      INTEGER :: joffset
+      INTEGER :: jostride
+      REAL(KIND=wp), DIMENSION(:,:), ALLOCATABLE :: &
+         & zlamg, &
+         & zphig, &
+         & zmskg, &
+         & zphitmax,&
+         & zphitmin,&
+         & zlamtmax,&
+         & zlamtmin
+      LOGICAL, DIMENSION(:,:), ALLOCATABLE :: &
+         & llinvalidcell
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
+         & zlamtm,  &
+         & zphitm
+      LOGICAL :: llfourflag
+      INTEGER :: ifourflagcountt
+      INTEGER :: ifourflagcountf
+      INTEGER, DIMENSION(5) :: ifourflagcountr
+
+      !-----------------------------------------------------------------------
+      ! Define grid for grid search
+      !-----------------------------------------------------------------------
+      IF (ln_grid_global) THEN
+         jlon     = jpiglo
+         jlat     = jpjglo
+         joffset  = nproc
+         jostride = jpnij
+      ELSE
+         jlon     = jpi
+         jlat     = jpj
+         joffset  = 0
+         jostride = 1
+      ENDIF
+      !-----------------------------------------------------------------------
+      ! Set up data for grid search
+      !-----------------------------------------------------------------------
+      ALLOCATE( &
+         & zlamg(jlon,jlat),             &
+         & zphig(jlon,jlat),             &
+         & zmskg(jlon,jlat),             &
+         & zphitmax(jlon-1,jlat-1),      &
+         & zphitmin(jlon-1,jlat-1),      &
+         & zlamtmax(jlon-1,jlat-1),      &
+         & zlamtmin(jlon-1,jlat-1),      &
+         & llinvalidcell(jlon-1,jlat-1), &
+         & zlamtm(4,jlon-1,jlat-1),      &
+         & zphitm(4,jlon-1,jlat-1)       &
+         & )
+      !-----------------------------------------------------------------------
+      ! Copy data to local arrays
+      !-----------------------------------------------------------------------
+      IF (ln_grid_global) THEN
+         zlamg(:,:) = -1.e+10
+         zphig(:,:) = -1.e+10
+         zmskg(:,:) = -1.e+10
+         ! Add various grids here.
+         DO jj = nldj, nlej
+            DO ji = nldi, nlei
+               zlamg(mig(ji),mjg(jj)) = glamt(ji,jj)
+               zphig(mig(ji),mjg(jj)) = gphit(ji,jj)
+               zmskg(mig(ji),mjg(jj)) = tmask(ji,jj,1)
+            END DO
+         END DO
+         CALL mpp_global_max( zlamg )
+         CALL mpp_global_max( zphig )
+         CALL mpp_global_max( zmskg )
+      ELSE
+         ! Add various grids here.
+         DO jj = 1, jlat
+            DO ji = 1, jlon
+               zlamg(ji,jj) = glamt(ji,jj)
+               zphig(ji,jj) = gphit(ji,jj)
+               zmskg(ji,jj) = tmask(ji,jj,1)
+            END DO
+         END DO
+      ENDIF
+      !-----------------------------------------------------------------------
+      ! Copy longitudes
+      !----------------------------------------------------------------------- 
+      ALLOCATE( &
+         & zplam(kobs) &
+         & )
+      DO jo = 1, kobs
+         zplam(jo) = plam(jo)
+      END DO
+      !-----------------------------------------------------------------------
+      ! Set default values for output
+      !-----------------------------------------------------------------------
+      kproc(:) = -1
+      kobsi(:) = -1
+      kobsj(:) = -1
+      !-----------------------------------------------------------------------
+      ! Copy grid positions to temporary arrays and renormalize to 0 to 360.
+      !-----------------------------------------------------------------------
+      DO jj = 1, jlat-1
+         DO ji = 1, jlon-1
+            zlamtm(1,ji,jj) = zlamg(ji  ,jj  )
+            zphitm(1,ji,jj) = zphig(ji  ,jj  )
+            zlamtm(2,ji,jj) = zlamg(ji+1,jj  )
+            zphitm(2,ji,jj) = zphig(ji+1,jj  )
+            zlamtm(3,ji,jj) = zlamg(ji+1,jj+1)
+            zphitm(3,ji,jj) = zphig(ji+1,jj+1)
+            zlamtm(4,ji,jj) = zlamg(ji  ,jj+1)
+            zphitm(4,ji,jj) = zphig(ji  ,jj+1)
+         END DO
+      END DO
+      WHERE ( zlamtm(:,:,:) < 0.0_wp )
+         zlamtm(:,:,:) = zlamtm(:,:,:) + 360.0_wp
+      END WHERE
+      WHERE ( zlamtm(:,:,:) > 360.0_wp )
+         zlamtm(:,:,:) = zlamtm(:,:,:) - 360.0_wp
+      END WHERE
+      !-----------------------------------------------------------------------
+      ! Handle case of the wraparound; beware, not working with orca180
+      !-----------------------------------------------------------------------
+      DO jj = 1, jlat-1
+         DO ji = 1, jlon-1
+            zlammax = MAXVAL( zlamtm(:,ji,jj) )
+            WHERE (zlammax - zlamtm(:, ji, jj) > 180 ) & 
+               & zlamtm(:,ji,jj) = zlamtm(:,ji,jj) + 360._wp
+            zphitmax(ji,jj) = MAXVAL(zphitm(:,ji,jj))
+            zphitmin(ji,jj) = MINVAL(zphitm(:,ji,jj))
+            zlamtmax(ji,jj) = MAXVAL(zlamtm(:,ji,jj))
+            zlamtmin(ji,jj) = MINVAL(zlamtm(:,ji,jj))
+         END DO
+      END DO
+      !-----------------------------------------------------------------------
+      ! Search for boxes with only land points mark them invalid
+      !-----------------------------------------------------------------------
+      llinvalidcell(:,:) = .FALSE.
+      DO jj = 1, jlat-1
+         DO ji = 1, jlon-1
+            llinvalidcell(ji,jj) =               &
+               & zmskg(ji  ,jj  ) == 0.0_wp .AND. &
+               & zmskg(ji+1,jj  ) == 0.0_wp .AND. &
+               & zmskg(ji+1,jj+1) == 0.0_wp .AND. &
+               & zmskg(ji  ,jj+1) == 0.0_wp
+         END DO
+      END DO
+
+      if(lwp) WRITE(numout,*) 'obs_grid_lookup do coordinate search using lookup table'
+
+      !-----------------------------------------------------------------------
+      ! Do coordinate search using lookup table with local searches.
+      ! - For land points kproc is set to number of the processor + 1000000
+      !   and we continue the search.
+      ! - For ocean points kproc is set to the number of the processor 
+      !   and we stop the search.
+      !-----------------------------------------------------------------------
+      ifourflagcountt = 0
+      ifourflagcountf = 0
+      ifourflagcountr(:) = 0
+
+      !------------------------------------------------------------------------
+      ! Master loop for grid search
+      !------------------------------------------------------------------------
+         
+      gpkobs: DO jo = 1+joffset, kobs, jostride
+         ! Normal case
+         !        specify 4 points which surround the lat lon of interest
+         !                          x i,j+1  x i+1, j+1
+         !
+         !
+         !                             * lon,lat
+         !                          x i,j    x i+1,j
+
+         ! bottom corner point
+         ipx1 = INT( ( zplam(jo)  - lonmin ) / dlon + 1.0 ) 
+         ipy1 = INT( ( pphi (jo)  - latmin ) / dlat + 1.0 )  
+         
+         ipx = ipx1 + 1
+         ipy = ipy1 + 1
+
+         ! flag for searching around four points separately
+         ! default to false
+         llfourflag = .FALSE.
+         
+         ! check for point fully outside of region
+         IF ( (ipx1 > nlons) .OR. (ipy1 > nlats) .OR. &
+            & (ipx < 1) .OR. (ipy < 1) ) THEN
+            CYCLE
+         ENDIF
+         ! check wrap around
+         IF ( (ipx > nlons) .OR. (ipy > nlats) .OR. &
+            & (ipx1 < 1) .OR. (ipy1 < 1) ) THEN
+            llfourflag=.TRUE.
+            ifourflagcountr(1) = ifourflagcountr(1) + 1
+         ENDIF
+
+         IF (MAXVAL(ixpos(ipx1:ipx,ipy1:ipy)) == -1) CYCLE! cycle if no lookup points found
+         
+         jimin = 0
+         jimax = 0
+         jjmin = 0
+         jjmax = 0
+         
+         IF (.NOT. llfourflag) THEN 
+
+            ! calculate points range
+            ! define a square region encompassing the four corner points
+            ! do I need the -1 points?
+
+            jojimin = MINVAL(ixpos(ipx1:ipx,ipy1:ipy)) - 1
+            jojimax = MAXVAL(ixpos(ipx1:ipx,ipy1:ipy)) + 1
+            jojjmin = MINVAL(iypos(ipx1:ipx,ipy1:ipy)) - 1
+            jojjmax = MAXVAL(iypos(ipx1:ipx,ipy1:ipy)) + 1
+
+            jimin = jojimin - 1
+            jimax = jojimax + 1
+            jjmin = jojjmin - 1
+            jjmax = jojjmax + 1
+            
+            IF ( jojimin < 0 .OR. jojjmin < 0) THEN 
+               llfourflag = .TRUE.
+               ifourflagcountr(2) = ifourflagcountr(2) + 1
+            ENDIF
+            IF ( jojimax - jojimin > maxxdiff) THEN
+               llfourflag = .TRUE.
+               ifourflagcountr(3) = ifourflagcountr(3) + 1
+            ENDIF
+            IF ( jojjmax - jojjmin > maxydiff) THEN
+               llfourflag = .TRUE.
+               ifourflagcountr(4) = ifourflagcountr(4) + 1
+            ENDIF
+            
+         ENDIF
+
+         ipmx = 0
+         IF (llfourflag) ipmx = 1
+
+         IF (llfourflag) THEN 
+            ifourflagcountt = ifourflagcountt + 1
+         ELSE
+            ifourflagcountf = ifourflagcountf + 1
+         ENDIF
+
+         gridpointsn : DO ip = 0, ipmx
+            DO jp = 0, ipmx
+               
+               IF ( kproc(jo) /= -1 ) EXIT gridpointsn
+        
+               ipx = ipx1 + ip
+               ipy = ipy1 + jp
+               
+               IF (llfourflag) THEN
+
+                  ! deal with wrap around
+                  IF ( ipx > nlons ) ipx = 1
+                  IF ( ipy > nlats ) ipy = 1
+                  IF ( ipx < 1     ) ipx = nlons
+                  IF ( ipy < 1     ) ipy = nlats
+
+                  ! get i,j 
+                  isx = ixpos(ipx,ipy)
+                  isy = iypos(ipx,ipy)
+                  
+                  ! estimate appropriate search region (use max/min values)
+                  jimin = isx - maxxdiff - 1
+                  jimax = isx + maxxdiff + 1
+                  jjmin = isy - maxydiff - 1
+                  jjmax = isy + maxydiff + 1
+
+               ENDIF
+
+               IF ( jimin < 1      ) jimin = 1
+               IF ( jimax > jlon-1 ) jimax = jlon-1
+               IF ( jjmin < 1      ) jjmin = 1
+               IF ( jjmax > jlat-1 ) jjmax = jlat-1
+               
+               !---------------------------------------------------------------
+               ! Ensure that all observation longtiudes are between 0 and 360 
+               !---------------------------------------------------------------
+
+               IF ( zplam(jo) <   0.0_wp ) zplam(jo) = zplam(jo) + 360.0_wp
+               IF ( zplam(jo) > 360.0_wp ) zplam(jo) = zplam(jo) - 360.0_wp
+      
+               !---------------------------------------------------------------
+               ! Find observations which are on within 1e-6 of a grid point
+               !---------------------------------------------------------------
+
+               gridloop: DO jj = jjmin, jjmax
+                  DO ji = jimin, jimax
+                     IF ( ABS( zphig(ji,jj) - pphi(jo) ) < 1e-6 )  THEN
+                        zlam = zlamg(ji,jj)
+                        IF ( zlam <   0.0_wp ) zlam = zlam + 360.0_wp
+                        IF ( zlam > 360.0_wp ) zlam = zlam - 360.0_wp
+                        IF ( ABS( zlam - zplam(jo) ) < 1e-6 ) THEN
+                           IF ( llinvalidcell(ji,jj) ) THEN
+                              kproc(jo) = nproc + 1000000
+                              kobsi(jo) = ji + 1
+                              kobsj(jo) = jj + 1
+                              CYCLE
+                           ELSE
+                              kproc(jo) = nproc
+                              kobsi(jo) = ji + 1
+                              kobsj(jo) = jj + 1
+                              EXIT gridloop
+                           ENDIF
+                        ENDIF
+                     ENDIF
+                  END DO
+               END DO gridloop
+
+               !---------------------------------------------------------------
+               ! Ensure that all observation longtiudes are between -180/180
+               !---------------------------------------------------------------
+
+               IF ( zplam(jo) > 180 ) zplam(jo) = zplam(jo) - 360.0_wp
+
+               IF ( kproc(jo) == -1 ) THEN
+                  
+                  ! Normal case 
+                  gridpoints : DO jj = jjmin, jjmax
+                     DO ji = jimin, jimax
+
+
+                        IF ( ( zplam(jo) > zlamtmax(ji,jj) ) .OR. &
+                           & ( zplam(jo) < zlamtmin(ji,jj) ) ) CYCLE
+                        
+                        IF ( ABS( pphi(jo) ) < 85 ) THEN
+                           IF ( ( pphi(jo) > zphitmax(ji,jj) ) .OR. &
+                              & ( pphi(jo) < zphitmin(ji,jj) ) ) CYCLE
+                        ENDIF
+                        
+                        IF ( linquad( zplam(jo), pphi(jo), &
+                           &          zlamtm(:,ji,jj), zphitm(:,ji,jj) ) ) THEN
+                           IF ( llinvalidcell(ji,jj) ) THEN
+                              kproc(jo) = nproc + 1000000
+                              kobsi(jo) = ji + 1
+                              kobsj(jo) = jj + 1
+                              CYCLE
+                           ELSE
+                              kproc(jo) = nproc
+                              kobsi(jo) = ji + 1
+                              kobsj(jo) = jj + 1
+                              EXIT gridpoints
+                           ENDIF
+                        ENDIF
+                        
+                     END DO
+                  END DO gridpoints
+               ENDIF
+
+               ! In case of failure retry for obs. longtiude + 360.
+               IF ( kproc(jo) == -1 ) THEN
+                  gridpoints_greenwich : DO jj = jjmin, jjmax
+                     DO ji = jimin, jimax
+                        
+                        IF ( ( zplam(jo)+360.0_wp > zlamtmax(ji,jj) ) .OR. &
+                           & ( zplam(jo)+360.0_wp < zlamtmin(ji,jj) ) ) CYCLE
+
+                        IF ( ABS( pphi(jo) ) < 85 ) THEN
+                           IF ( ( pphi(jo) > zphitmax(ji,jj) ) .OR. &
+                              & ( pphi(jo) < zphitmin(ji,jj) ) ) CYCLE
+                        ENDIF
+
+                        IF ( linquad( zplam(jo)+360.0_wp, pphi(jo), &
+                           &          zlamtm(:,ji,jj), zphitm(:,ji,jj) ) ) THEN
+                           IF ( llinvalidcell(ji,jj) ) THEN
+                              kproc(jo) = nproc + 1000000
+                              kobsi(jo) = ji + 1
+                              kobsj(jo) = jj + 1
+                              CYCLE
+                           ELSE
+                              kproc(jo) = nproc
+                              kobsi(jo) = ji + 1
+                              kobsj(jo) = jj + 1
+                              EXIT gridpoints_greenwich
+                           ENDIF
+                        ENDIF
+                        
+                     END DO
+                  END DO gridpoints_greenwich
+                  
+               ENDIF   ! kproc
+               
+            END DO
+         END DO gridpointsn
+      END DO gpkobs  ! kobs
+
+      !----------------------------------------------------------------------
+      ! Synchronize kproc on all processors
+      !----------------------------------------------------------------------
+      IF ( ln_grid_global ) THEN
+         CALL obs_mpp_max_integer( kproc, kobs )
+         CALL obs_mpp_max_integer( kobsi, kobs )
+         CALL obs_mpp_max_integer( kobsj, kobs )
+      ELSE
+         CALL obs_mpp_find_obs_proc( kproc, kobsi, kobsj, kobs )
+      ENDIF
+
+      WHERE( kproc(:) >= 1000000 )
+         kproc(:) = kproc(:) - 1000000
+      END WHERE
+
+      DEALLOCATE( &
+         & zlamg,         &
+         & zphig,         &
+         & zmskg,         &
+         & zphitmax,      &
+         & zphitmin,      &
+         & zlamtmax,      &
+         & zlamtmin,      &
+         & llinvalidcell, &
+         & zlamtm,        &
+         & zphitm,        &
+         & zplam          &
+         & )
+      
+   END SUBROUTINE obs_grd_lookup
+
+
+   SUBROUTINE obs_grid_setup
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE obs_grid_setup ***
+      !!
+      !! ** Purpose : Setup a lookup table to reduce the searching required
+      !!              for converting lat lons to grid point location
+      !!              produces or reads in a preexisting file for use in 
+      !!              obs_grid_search_lookup_local
+      !!
+      !! ** Method : calls obs_grid_search_bruteforce_local with a array 
+      !!             of lats and lons
+      !!
+      !! History :
+      !!        !  2007-12 (D. Lea) new routine
+      !!----------------------------------------------------------------------
+      
+      !! * Local declarations
+      CHARACTER(LEN=15), PARAMETER :: &
+         & cpname = 'obs_grid_setup'
+      CHARACTER(LEN=40) :: cfname      
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jk
+      INTEGER :: jo
+      INTEGER :: idfile, idny, idnx, idxpos, idypos
+      INTEGER :: idlat, idlon, fileexist
+      INTEGER, DIMENSION(2) :: incdim
+      CHARACTER(LEN=20) :: datestr=" ",timestr=" "
+      REAL(wp) :: tmpx1, tmpx2, tmpy1, tmpy2
+      REAL(wp) :: meanxdiff, meanydiff
+      REAL(wp) :: meanxdiff1, meanydiff1
+      REAL(wp) :: meanxdiff2, meanydiff2
+      INTEGER :: numx1, numx2, numy1, numy2, df
+      INTEGER :: jimin, jimax, jjmin, jjmax
+      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: &
+         & lonsi,     &
+         & latsi
+      INTEGER, DIMENSION(:,:), ALLOCATABLE :: &  
+         & ixposi,    &
+         & iyposi,    & 
+         & iproci    
+      INTEGER, PARAMETER :: histsize=90
+      INTEGER, DIMENSION(histsize) :: &
+         & histx1, histx2, histy1, histy2
+      REAL, DIMENSION(histsize) :: &
+         & fhistx1, fhistx2, fhisty1, fhisty2
+      REAL(wp) :: histtol
+      
+      IF (ln_grid_search_lookup) THEN
+         
+         WRITE(numout,*) 'Calling obs_grid_setup'
+         
+         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) THEN
+            WRITE(numout,*)'Grid search gsearch_nlons_def  = ',gsearch_nlons_def
+            WRITE(numout,*)'Grid search gsearch_nlats_def  = ',gsearch_nlats_def
+            WRITE(numout,*)'Grid search gsearch_lonmin_def = ',gsearch_lonmin_def
+            WRITE(numout,*)'Grid search gsearch_latmin_def = ',gsearch_latmin_def
+            WRITE(numout,*)'Grid search gsearch_dlon_def   = ',gsearch_dlon_def
+            WRITE(numout,*)'Grid search gsearch_dlat_def   = ',gsearch_dlat_def
+         ENDIF
+
+         IF ( ln_grid_global ) THEN
+            WRITE(cfname, FMT="(A,'_',A)") &
+               &          TRIM(grid_search_file), 'global.nc'
+         ELSE
+            WRITE(cfname, FMT="(A,'_',I4.4,'of',I4.4,'by',I4.4,'.nc')") &
+               &          TRIM(grid_search_file), nproc, jpni, jpnj
+         ENDIF
+
+         fileexist=nf90_open( TRIM( cfname ), nf90_nowrite, &
+            &                  idfile )
+         
+         IF ( fileexist == nf90_noerr ) THEN
+            
+            ! read data
+            ! initially assume size is as defined (to be fixed)
+            
+            WRITE(numout,*) 'Reading: ',cfname
+            
+            CALL chkerr( nf90_open( TRIM( cfname ), nf90_nowrite, idfile ), &
+               &         cpname, __LINE__ )
+            CALL chkerr( nf90_get_att( idfile, nf90_global, 'maxxdiff', maxxdiff ), &
+               &         cpname, __LINE__ )        
+            CALL chkerr( nf90_get_att( idfile, nf90_global, 'maxydiff', maxydiff ), &
+               &         cpname, __LINE__ )        
+            CALL chkerr( nf90_get_att( idfile, nf90_global, 'dlon', dlon ), &
+            &         cpname, __LINE__ )        
+            CALL chkerr( nf90_get_att( idfile, nf90_global, 'dlat', dlat ), &
+               &         cpname, __LINE__ )        
+            CALL chkerr( nf90_get_att( idfile, nf90_global, 'lonmin', lonmin ), &
+               &         cpname, __LINE__ )        
+            CALL chkerr( nf90_get_att( idfile, nf90_global, 'latmin', latmin ), &
+               &         cpname, __LINE__ )        
+            
+            CALL chkerr( nf90_inq_dimid(idfile, 'nx'  , idnx), &
+               &         cpname, __LINE__ )
+            CALL chkerr( nf90_inquire_dimension( idfile, idnx, len = nlons ),     &
+               &         cpname, __LINE__ ) 
+            CALL chkerr( nf90_inq_dimid(idfile, 'ny'  , idny), &
+               &         cpname, __LINE__ )
+            CALL chkerr( nf90_inquire_dimension( idfile, idny, len = nlats ),     &
+               &         cpname, __LINE__ ) 
+            
+            ALLOCATE( &
+               & lons(nlons,nlats),  &
+               & lats(nlons,nlats),  &
+               & ixpos(nlons,nlats), &
+               & iypos(nlons,nlats), &
+               & iprocn(nlons,nlats)  &
+               & )
+            
+            CALL chkerr( nf90_inq_varid( idfile, 'XPOS', idxpos ), & 
+               &         cpname, __LINE__ )
+            CALL chkerr( nf90_get_var  ( idfile, idxpos, ixpos),   &
+               &         cpname, __LINE__ )
+            CALL chkerr( nf90_inq_varid( idfile, 'YPOS', idypos ), & 
+               &         cpname, __LINE__ )
+            CALL chkerr( nf90_get_var  ( idfile, idypos, iypos),   &
+               &         cpname, __LINE__ )
+            
+            CALL chkerr( nf90_close( idfile ), cpname, __LINE__ )
+            
+            ! setup arrays
+            
+            DO ji = 1, nlons
+               DO jj = 1, nlats
+                  lons(ji,jj) = lonmin + (ji-1) * dlon
+                  lats(ji,jj) = latmin + (jj-1) * dlat
+               END DO
+            END DO
+            
+            ! if we are not reading the file we need to create it
+            ! create new obs grid search lookup file
+            
+         ELSE 
+            
+            ! call obs_grid_search
+            
+            IF (lwp) THEN
+               WRITE(numout,*) 'creating: ',cfname
+               WRITE(numout,*) 'calling obs_grid_search: ',nlons*nlats
+            ENDIF
+
+            ! set parameters from default values
+            nlons  = gsearch_nlons_def
+            nlats  = gsearch_nlats_def
+            lonmin = gsearch_lonmin_def
+            latmin = gsearch_latmin_def
+            dlon   = gsearch_dlon_def
+            dlat   = gsearch_dlat_def
+            
+            ! setup arrays
+            
+            ALLOCATE( &
+               & lonsi(nlons,nlats),   &
+               & latsi(nlons,nlats),   &
+               & ixposi(nlons,nlats),  &
+               & iyposi(nlons,nlats),  &
+               & iproci(nlons,nlats)   &
+               & )
+         
+            DO ji = 1, nlons
+               DO jj = 1, nlats
+                  lonsi(ji,jj) = lonmin + (ji-1) * dlon
+                  latsi(ji,jj) = latmin + (jj-1) * dlat
+               END DO
+            END DO
+            
+            CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo,  &
+               &                     nldi, nlei,nldj,  nlej,    &
+               &                     nproc, jpnij,              &
+               &                     glamt, gphit, tmask,       &
+               &                     nlons*nlats, lonsi, latsi, &
+               &                     ixposi, iyposi, iproci )
+            
+            ! minimise file size by removing regions with no data from xypos file
+            ! should be able to just use xpos (ypos will have the same areas of missing data)
+         
+            jimin=1
+            jimax=nlons
+            jjmin=1
+            jjmax=nlats
+
+            minlon_xpos: DO ji= 1, nlons
+               IF (COUNT(ixposi(ji,:) >= 0) > 0) THEN
+                  jimin=ji
+                  EXIT minlon_xpos
+               ENDIF
+            END DO minlon_xpos
+
+            maxlon_xpos: DO ji= nlons, 1, -1
+               IF (COUNT(ixposi(ji,:) >= 0) > 0) THEN
+                  jimax=ji
+                  EXIT maxlon_xpos
+               ENDIF
+            END DO maxlon_xpos
+
+            minlat_xpos: DO jj= 1, nlats
+               IF (COUNT(ixposi(:,jj) >= 0) > 0) THEN
+                  jjmin=jj
+                  EXIT minlat_xpos
+               ENDIF
+            END DO minlat_xpos
+
+            maxlat_xpos: DO jj= nlats, 1, -1
+               IF (COUNT(ixposi(:,jj) >= 0) > 0) THEN 
+                  jjmax=jj
+                  EXIT maxlat_xpos
+               ENDIF
+            END DO maxlat_xpos
+
+            lonmin = lonsi(jimin,jjmin)
+            latmin = latsi(jimin,jjmin)
+            nlons  = jimax-jimin+1
+            nlats  = jjmax-jjmin+1
+
+            ! construct new arrays
+
+            ALLOCATE( &
+               & lons(nlons,nlats),    &
+               & lats(nlons,nlats),    &
+               & ixpos(nlons,nlats),   &
+               & iypos(nlons,nlats),   &
+               & iprocn(nlons,nlats)    &
+               & )
+
+            lons(:,:) = lonsi(jimin:jimax,jjmin:jjmax)
+            lats(:,:) = latsi(jimin:jimax,jjmin:jjmax)
+            ixpos(:,:) = ixposi(jimin:jimax,jjmin:jjmax)
+            iypos(:,:) = iyposi(jimin:jimax,jjmin:jjmax)
+            iprocn(:,:) = iproci(jimin:jimax,jjmin:jjmax)
+
+            DEALLOCATE(lonsi,latsi,ixposi,iyposi,iproci)
+
+            ! calculate (estimate) maxxdiff, maxydiff
+            ! this is to help define the search area for obs_grid_search_lookup
+
+            maxxdiff = 1
+            maxydiff = 1
+
+            tmpx1 = 0
+            tmpx2 = 0
+            tmpy1 = 0
+            tmpy2 = 0 
+
+            numx1 = 0
+            numx2 = 0
+            numy1 = 0
+            numy2 = 0
+
+            ! calculate the mean absolute xdiff and ydiff
+            ! also calculate a histogram
+            ! note the reason why looking for xdiff and ydiff in both directions
+            ! is to allow for rotated grids
+
+            DO ji = 1, nlons-1
+               DO jj = 1, nlats-1
+                  IF ( ixpos(ji,jj) > 0 .AND. iypos(ji,jj) > 0 ) THEN
+                     IF ( ixpos(ji+1,jj) > 0 ) THEN
+                        df = ABS( ixpos(ji+1,jj) - ixpos(ji,jj) )
+                        tmpx1 = tmpx1+df
+                        numx1 = numx1+1
+                        IF ( df < histsize ) histx1(df+1) = histx1(df+1) + 1
+                     ENDIF
+                     IF ( ixpos(ji,jj+1) > 0 ) THEN
+                        df = ABS( ixpos(ji,jj+1) - ixpos(ji,jj) )
+                        tmpx2 = tmpx2 + df
+                        numx2 = numx2 + 1
+                        IF ( df < histsize ) histx2(df+1) = histx2(df+1) + 1
+                     ENDIF
+                     IF (iypos(ji+1,jj) > 0) THEN
+                        df = ABS( iypos(ji+1,jj) - iypos(ji,jj) )
+                        tmpy1 = tmpy1 + df
+                        numy1 = numy1 + 1
+                        IF ( df < histsize ) histy1(df+1) = histy1(df+1) + 1
+                     ENDIF
+                     IF ( iypos(ji,jj+1) > 0 ) THEN
+                        df = ABS( iypos(ji,jj+1) - iypos(ji,jj) )
+                        tmpy2 = tmpy2 + df
+                        numy2 = numy2 + 1
+                        IF ( df < histsize ) histy2(df+1) = histy2(df+1) + 1
+                     ENDIF
+                  ENDIF
+               END DO
+            END DO
+
+            IF (lwp) THEN
+               WRITE(numout,*) 'histograms'
+               WRITE(numout,*) '0   1   2   3   4   5   6   7   8   9   10 ...'
+               WRITE(numout,*) 'histx1'
+               WRITE(numout,*) histx1
+               WRITE(numout,*) 'histx2'
+               WRITE(numout,*) histx2
+               WRITE(numout,*) 'histy1'
+               WRITE(numout,*) histy1
+               WRITE(numout,*) 'histy2'
+               WRITE(numout,*) histy2
+            ENDIF
+
+            meanxdiff1 = tmpx1 / numx1
+            meanydiff1 = tmpy1 / numy1
+            meanxdiff2 = tmpx2 / numx2
+            meanydiff2 = tmpy2 / numy2
+
+            meanxdiff = MAXVAL((/ meanxdiff1, meanxdiff2 /))
+            meanydiff = MAXVAL((/ meanydiff1, meanydiff2 /))
+
+            IF (lwp) THEN
+               WRITE(numout,*) tmpx1, tmpx2, tmpy1, tmpy2
+               WRITE(numout,*) numx1, numx2, numy1, numy2
+               WRITE(numout,*) 'meanxdiff: ',meanxdiff, meanxdiff1, meanxdiff2
+               WRITE(numout,*) 'meanydiff: ',meanydiff, meanydiff1, meanydiff2
+            ENDIF
+
+            tmpx1 = 0
+            tmpx2 = 0
+            tmpy1 = 0
+            tmpy2 = 0
+
+            numx1 = 0
+            numx2 = 0
+            numy1 = 0
+            numy2 = 0
+
+            histx1(:) = 0
+            histx2(:) = 0
+            histy1(:) = 0
+            histy2(:) = 0
+
+            limxdiff = meanxdiff * 4! limit the difference to avoid picking up wraparound
+            limydiff = meanydiff * 4
+
+            DO ji = 1, nlons-1
+               DO jj = 1, nlats-1
+                  IF ( ixpos(ji,jj) > 0 .AND. iypos(ji,jj) > 0 ) THEN
+
+                     IF ( ixpos(ji+1,jj) > 0 ) THEN
+                        df = ABS( ixpos(ji+1,jj)-ixpos(ji,jj) )
+                        tmpx1 = df
+                        IF ( df < limxdiff ) numx1 = numx1+1
+                        IF ( df < histsize ) histx1(df+1) = histx1(df+1) + 1
+                     ENDIF
+                     IF ( ixpos(ji,jj+1) > 0 ) THEN
+                        df = ABS( ixpos(ji,jj+1) - ixpos(ji,jj) )
+                        tmpx2 = df
+                        IF ( df < limxdiff ) numx2 = numx2 + 1
+                        IF ( df < histsize ) histx2(df+1) = histx2(df+1) + 1
+                     ENDIF
+                     IF (iypos(ji+1,jj) > 0) THEN
+                        df = ABS( iypos(ji+1,jj) - iypos(ji,jj) )
+                        tmpy1 = df
+                        IF ( df < limxdiff ) numy1 = numy1 + 1
+                        IF ( df < histsize ) histy1(df+1) = histy1(df+1) + 1
+                     ENDIF
+                     IF (iypos(ji,jj+1) > 0) THEN
+                        df = ABS( iypos(ji,jj+1) - iypos(ji,jj) )
+                        tmpy2 = df
+                        IF ( df < limxdiff ) numy2 = numy2+1
+                        IF ( df < histsize ) histy2(df+1) = histy2(df+1)+1
+                     ENDIF
+
+                     IF ( maxxdiff < tmpx1 .AND. tmpx1 < limxdiff ) &
+                        & maxxdiff = tmpx1
+                     IF ( maxxdiff < tmpx2 .AND. tmpx2 < limxdiff ) &
+                        & maxxdiff = tmpx2
+                     IF ( maxydiff < tmpy1 .AND. tmpy1 < limydiff ) &
+                        & maxydiff = tmpy1
+                     IF ( maxydiff < tmpy2 .AND. tmpy2 < limydiff ) &
+                        & maxydiff = tmpy2
+
+                  ENDIF
+               END DO
+            END DO
+
+            ! cumulative histograms
+
+            DO ji = 1, histsize - 1
+               histx1(ji+1) = histx1(ji+1) + histx1(ji)
+               histx2(ji+1) = histx2(ji+1) + histx2(ji)
+               histy1(ji+1) = histy1(ji+1) + histy1(ji)
+               histy2(ji+1) = histy2(ji+1) + histy2(ji)
+            END DO
+
+            fhistx1(:) = histx1(:) * 1.0 / numx1
+            fhistx2(:) = histx2(:) * 1.0 / numx2
+            fhisty1(:) = histy1(:) * 1.0 / numy1
+            fhisty2(:) = histy2(:) * 1.0 / numy2
+
+            ! output new histograms
+
+            IF (lwp) THEN
+               WRITE(numout,*) 'cumulative histograms'
+               WRITE(numout,*) '0   1   2   3   4   5   6   7   8   9   10 ...'
+               WRITE(numout,*) 'fhistx1'
+               WRITE(numout,*) fhistx1
+               WRITE(numout,*) 'fhistx2'
+               WRITE(numout,*) fhistx2
+               WRITE(numout,*) 'fhisty1'
+               WRITE(numout,*) fhisty1
+               WRITE(numout,*) 'fhisty2'
+               WRITE(numout,*) fhisty2
+            ENDIF
+
+            ! calculate maxxdiff and maxydiff based on cumulative histograms
+            ! where > 0.999 of points are
+
+            ! maxval just converts 1x1 vector return from maxloc to a scalar 
+
+            histtol = 0.999
+            tmpx1 = MAXVAL( MAXLOC( fhistx1(:), mask = ( fhistx1(:) <= histtol ) ) )
+            tmpx2 = MAXVAL( MAXLOC( fhistx2(:), mask = ( fhistx2(:) <= histtol ) ) )
+            tmpy1 = MAXVAL( MAXLOC( fhisty1(:), mask = ( fhisty1(:) <= histtol ) ) )
+            tmpy2 = MAXVAL( MAXLOC( fhisty2(:), mask = ( fhisty2(:) <= histtol ) ) )
+
+            maxxdiff = MAXVAL( (/ tmpx1, tmpx2 /) ) + 1
+            maxydiff = MAXVAL( (/ tmpy1, tmpy2 /) ) + 1
+
+            ! Write out data
+
+            IF ( ( .NOT. ln_grid_global ) .OR. &
+               & ( ( ln_grid_global ) .AND. ( nproc==0 ) ) ) THEN
+
+               CALL chkerr( nf90_create (TRIM(cfname), nf90_clobber, idfile), &
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_put_att( idfile, nf90_global, 'title',       &
+                  &         'Mapping file from lon/lat to model grid point' ),&
+                  &         cpname,__LINE__ ) 
+               CALL chkerr( nf90_put_att( idfile, nf90_global, 'maxxdiff',    &
+                  &                       maxxdiff ),                         &
+                  &         cpname,__LINE__ ) 
+               CALL chkerr( nf90_put_att( idfile, nf90_global, 'maxydiff',    &
+                  &                       maxydiff ),                         &
+                  &         cpname,__LINE__ ) 
+               CALL chkerr( nf90_put_att( idfile, nf90_global, 'dlon', dlon ),&
+                  &         cpname,__LINE__ ) 
+               CALL chkerr( nf90_put_att( idfile, nf90_global, 'dlat', dlat ),&
+                  &         cpname,__LINE__ ) 
+               CALL chkerr( nf90_put_att( idfile, nf90_global, 'lonmin',      &
+                  &                       lonmin ),                           &
+                  &         cpname,__LINE__ ) 
+               CALL chkerr( nf90_put_att( idfile, nf90_global, 'latmin',      &
+                  &                       latmin ),                           &
+                  &         cpname,__LINE__ ) 
+
+               CALL chkerr( nf90_def_dim(idfile, 'nx'  , nlons, idnx),        &
+                  &         cpname,__LINE__ )
+               CALL chkerr( nf90_def_dim(idfile, 'ny'  , nlats, idny),        &
+                  &         cpname,__LINE__ )
+
+               incdim(1) = idnx
+               incdim(2) = idny
+               
+               CALL chkerr( nf90_def_var( idfile, 'LON', nf90_float, incdim,  &
+                  &                       idlon ),                            &
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_put_att( idfile, idlon, 'long_name',         &
+                  &                       'longitude' ),                      &
+                  &         cpname, __LINE__ )
+               
+               CALL chkerr( nf90_def_var( idfile, 'LAT', nf90_float, incdim,  &
+                  &                       idlat ),                            &
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_put_att( idfile, idlat, 'long_name',         &
+                  &                       'latitude' ),                       &
+                  &         cpname, __LINE__ )
+
+               CALL chkerr( nf90_def_var( idfile, 'XPOS', nf90_int, incdim,   &
+                  &                       idxpos ),                           &
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_put_att( idfile, idxpos, 'long_name',        &
+                  &                       'x position' ),                     &
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_put_att( idfile, idxpos, '_FillValue', -1 ), &
+                  &         cpname, __LINE__ )
+
+               CALL chkerr( nf90_def_var( idfile, 'YPOS', nf90_int, incdim,   &
+                  &                       idypos ),                           &
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_put_att( idfile, idypos, 'long_name',        &
+                  &                       'y position' ),                     &
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_put_att( idfile, idypos, '_FillValue', -1 ), &
+                  &         cpname, __LINE__ )
+
+               CALL chkerr( nf90_enddef( idfile ), cpname, __LINE__ )
+               
+               CALL chkerr( nf90_put_var( idfile, idlon, lons),               &
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_put_var( idfile, idlat, lats),               &
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_put_var( idfile, idxpos, ixpos),             &
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_put_var( idfile, idypos, iypos),             &
+                  &         cpname, __LINE__ )
+               
+               CALL chkerr( nf90_close( idfile ), cpname, __LINE__ )
+               
+               ! should also output max i, max j spacing for use in 
+               ! obs_grid_search_lookup
+               
+            ENDIF
+
+         ENDIF
+
+      ENDIF
+
+   END SUBROUTINE obs_grid_setup
+   
+   SUBROUTINE obs_grid_deallocate( )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE obs_grid_setup ***
+      !!
+      !! ** Purpose : Deallocate arrays setup by obs_grid_setup
+      !!
+      !! History :
+      !!        !  2007-12 (D. Lea) new routine
+      !!-----------------------------------------------------------------------
+
+      IF (ln_grid_search_lookup) THEN
+         DEALLOCATE( lons, lats, ixpos, iypos, iprocn )
+      ENDIF
+      
+   END SUBROUTINE obs_grid_deallocate
+
+#include "obs_level_search.h90"
+
+#include "linquad.h90"
+
+#include "maxdist.h90"
+
+#include "find_obs_proc.h90"
+
+END MODULE obs_grid
+
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_h2d.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_h2d.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_h2d.F90	(revision 2528)
@@ -0,0 +1,56 @@
+MODULE obs_inter_h2d
+   !!======================================================================
+   !!                       ***  MODULE obs_inter_h2d   ***
+   !! Observation diagnostics: Perform the horizontal interpolation
+   !!                          from model grid to observation location
+   !!=====================================================================
+
+   !!----------------------------------------------------------------------
+   !!   obs_int_h2d     : Horizontal interpolation to the observation point
+   !!   obs_int_h2d_ds1 : Distance-weighted interpolation                 (n2dint=0)
+   !!   obs_int_h2d_ds2 : Distance-weighted interpolation (small angle)   (n2dint=1)
+   !!   obs_int_h2d_bil : Bilinear interpolation (geographical grid)      (n2dint=2)
+   !!   obs_int_h2d_bir : Bilinear remapping interpolation (general grid) (n2dint=3)
+   !!   obs_int_h2d_pol : Polynomial interpolation                        (n2dint=4)
+   !!   bil_wgt         : Compute weights for bilinear remapping
+   !!   lu_invmat       : Invert a matrix using LU decomposition
+   !!   lu_decomp       : LU decomposition
+   !!   lu_backsb       : LU decomposition - back substitution
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE par_kind, ONLY : &  ! Precision variables
+      & wp
+   USE phycst,   ONLY : &  ! Physical constants
+      & rad,  &
+      & rpi
+   USE in_out_manager
+   USE obs_const, ONLY : &
+      & obfillflt		! Fillvalue
+   USE obs_utils           ! Utility functions
+   
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE obs_int_h2d_ds1, & ! Distance-weighted interpolation               
+      &    obs_int_h2d_ds2, & ! Distance-weighted interpolation (small angle) 
+      &    obs_int_h2d_bil, & ! Bilinear interpolation (geographical grid)    
+      &    obs_int_h2d_bir, & ! Bilinear remapping interpolation (general grid)
+      &    obs_int_h2d_pol, & ! Polynomial interpolation                       
+      &    lu_invmat,       & ! Invert a matrix using LU decomposition
+      &    lu_decomp,       & ! LU decomposition
+      &    lu_backsb,       & ! LU decomposition - back substitution
+      &    bil_wgt            ! Compute weights for bilinear remapping
+   PUBLIC obs_int_h2d,      & ! Horizontal interpolation to the observation point
+      &   obs_int_h2d_init    ! Set up weights and vertical mask
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+ 
+#include "obsinter_h2d.h90"
+
+END MODULE obs_inter_h2d
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_sup.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_sup.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_sup.F90	(revision 2528)
@@ -0,0 +1,378 @@
+MODULE obs_inter_sup
+   !!=====================================================================
+   !!                       ***  MODULE obs_inter_sup  ***
+   !! Observation diagnostics: Support for interpolation
+   !!=====================================================================
+
+   !!----------------------------------------------------------------------
+   !!   obs_int_comm_3d : Get 3D interpolation stencil
+   !!   obs_int_comm_2d : Get 2D interpolation stencil
+   !!---------------------------------------------------------------------
+   !! * Modules used
+   USE par_kind        ! Precision variables
+   USE dom_oce         ! Domain variables
+   USE mpp_map         ! Map of processor points
+   USE lib_mpp         ! MPP stuff
+   USE obs_mpp         ! MPP stuff for observations
+   USE obs_grid        ! Grid tools
+   USE in_out_manager  ! I/O stuff
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+   
+   PUBLIC obs_int_comm_3d, & ! Get 3D interpolation stencil
+      &   obs_int_comm_2d    ! Get 2D interpolation stencil
+   
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE obs_int_comm_3d( kptsi, kptsj, kobs, kpk, kgrdi, kgrdj, &
+      &                        pval, pgval, kproc )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_int_comm_3d  ***
+      !!          
+      !! ** Purpose : Get 3D interpolation stencil
+      !!
+      !! ** Method  : Either on-demand communication with 
+      !!              obs_int_comm_3d_global 
+      !!              or local memory with
+      !!              obs_int_comm_3D_local
+      !!              depending on ln_global_grid
+      !!
+      !! ** Action  : 
+      !!
+      !! History :
+      !!        !  08-02  (K. Mogensen)  Original code
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kptsi     ! Number of i horizontal points per stencil 
+      INTEGER, INTENT(IN) :: kptsj     ! Number of j horizontal points per stencil
+      INTEGER, INTENT(IN) :: kobs      ! Local number of observations
+      INTEGER, INTENT(IN) :: kpk       ! Number of levels
+      INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: &
+         & kgrdi, &         ! i,j indicies for each stencil
+         & kgrdj
+      INTEGER, OPTIONAL, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: &
+         & kproc            ! Precomputed processor for each i,j,iobs points
+      REAL(KIND=wp), DIMENSION(jpi,jpj,kpk), INTENT(IN) ::&
+         & pval             ! Local 3D array to extract data from
+      REAL(KIND=wp), DIMENSION(kptsi,kptsj,kpk,kobs), INTENT(OUT) ::&
+         & pgval            ! Stencil at each point
+      !! * Local declarations
+      
+      IF (ln_grid_global) THEN
+         
+         IF (PRESENT(kproc)) THEN
+
+            CALL obs_int_comm_3d_global( kptsi, kptsj, kobs, kpk, kgrdi, &
+               &                         kgrdj, pval, pgval, kproc=kproc )
+
+         ELSE
+
+            CALL obs_int_comm_3d_global( kptsi, kptsj, kobs, kpk, kgrdi, &
+               &                         kgrdj, pval, pgval )
+
+         ENDIF
+
+      ELSE
+
+         CALL obs_int_comm_3d_local( kptsi, kptsj, kobs, kpk, kgrdi, kgrdj, &
+            &                        pval, pgval )
+
+      ENDIF
+
+   END SUBROUTINE obs_int_comm_3d
+
+   SUBROUTINE obs_int_comm_2d( kptsi, kptsj, kobs, kgrdi, kgrdj, pval, pgval, &
+      &                        kproc )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_int_comm_2d  ***
+      !!          
+      !! ** Purpose : Get 2D interpolation stencil
+      !!
+      !! ** Method  : Call to obs_int_comm_3d
+      !!
+      !! ** Action  : 
+      !!
+      !! History :
+      !!        !  08-02  (K. Mogensen)  Original code
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kptsi        ! Number of i horizontal points per stencil
+      INTEGER, INTENT(IN) :: kptsj        ! Number of j horizontal points per stencil
+      INTEGER, INTENT(IN) :: kobs          ! Local number of observations
+      INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: &
+         & kgrdi, &         ! i,j indicies for each stencil
+         & kgrdj
+      INTEGER, OPTIONAL, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: &
+         & kproc            ! Precomputed processor for each i,j,iobs points
+      REAL(KIND=wp), DIMENSION(jpi,jpj), INTENT(IN) ::&
+         & pval             ! Local 3D array to extra data from
+      REAL(KIND=wp), DIMENSION(kptsi,kptsj,kobs), INTENT(OUT) ::&
+         & pgval            ! Stencil at each point
+      !! * Local declarations
+      REAL(KIND=wp), DIMENSION(jpi,jpj,1) :: &
+         & zval
+      REAL(KIND=wp), DIMENSION(kptsi,kptsj,1,kobs) ::&
+         & zgval 
+
+      ! Set up local "3D" buffer
+
+      zval(:,:,1) = pval(:,:)
+
+      ! Call the 3D version
+
+      IF (PRESENT(kproc)) THEN
+
+         CALL obs_int_comm_3d( kptsi, kptsj, kobs, 1, kgrdi, kgrdj, zval, &
+            &                  zgval, kproc=kproc )
+      ELSE
+
+         CALL obs_int_comm_3d( kptsi, kptsj, kobs, 1, kgrdi, kgrdj, zval, &
+            &                  zgval )
+
+      ENDIF
+
+      ! Copy "3D" data back to 2D
+
+      pgval(:,:,:) = zgval(:,:,1,:)
+
+   END SUBROUTINE obs_int_comm_2d
+
+   SUBROUTINE obs_int_comm_3d_global( kptsi, kptsj, kobs, kpk, kgrdi, kgrdj, &
+      &                               pval, pgval, kproc )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_int_comm_3d_global  ***
+      !!          
+      !! ** Purpose : Get 3D interpolation stencil (global version)
+      !!
+      !! ** Method  : On-demand communication where each processor send its
+      !!              list of (i,j) of points to all processors and receive 
+      !!              the corresponding values
+      !!
+      !! ** Action  : 
+      !!
+      !! History :
+      !!        !  08-02  (K. Mogensen)  Original code
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kptsi     ! Number of i horizontal points per stencil 
+      INTEGER, INTENT(IN) :: kptsj     ! Number of j horizontal points per stencil
+      INTEGER, INTENT(IN) :: kobs      ! Local number of observations
+      INTEGER, INTENT(IN) :: kpk       ! Number of levels
+      INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: &
+         & kgrdi, &         ! i,j indicies for each stencil
+         & kgrdj
+      INTEGER, OPTIONAL, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: &
+         & kproc            ! Precomputed processor for each i,j,iobs points
+      REAL(KIND=wp), DIMENSION(jpi,jpj,kpk), INTENT(IN) ::&
+         & pval             ! Local 3D array to extract data from
+      REAL(KIND=wp), DIMENSION(kptsi,kptsj,kpk,kobs), INTENT(OUT) ::&
+         & pgval            ! Stencil at each point
+      !! * Local declarations
+      REAL(KIND=wp), DIMENSION(:,:), ALLOCATABLE :: &
+         & zsend, &
+         & zrecv
+      INTEGER, DIMENSION(:), ALLOCATABLE :: &
+         & igrdij_send, &
+         & igrdij_recv
+      INTEGER, DIMENSION(kptsi,kptsj,kobs) :: &
+         & iorder, &
+         & iproc
+      INTEGER :: nplocal(jpnij)
+      INTEGER :: npglobal(jpnij)
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jk
+      INTEGER :: jp
+      INTEGER :: jobs
+      INTEGER :: it
+      INTEGER :: itot
+      INTEGER :: ii
+      INTEGER :: ij
+
+      ! Check valid points
+      
+      IF ( ( MAXVAL(kgrdi) > jpiglo ) .OR. ( MINVAL(kgrdi) < 1 ) .OR. &
+         & ( MAXVAL(kgrdj) > jpjglo ) .OR. ( MINVAL(kgrdj) < 1 ) ) THEN
+         
+         CALL ctl_stop( 'Error in obs_int_comm_3d_global', &
+            &           'Point outside global domain' )
+         
+      ENDIF
+
+      ! Count number of points on each processors
+
+      nplocal(:) = 0
+      IF (PRESENT(kproc)) THEN 
+         iproc(:,:,:) = kproc(:,:,:)
+         DO jobs = 1, kobs
+            DO jj = 1, kptsj
+               DO ji = 1, kptsi
+                  nplocal(iproc(ji,jj,jobs)) = nplocal(iproc(ji,jj,jobs)) + 1
+               END DO
+            END DO
+         END DO
+      ELSE
+         DO jobs = 1, kobs
+            DO jj = 1, kptsj
+               DO ji = 1, kptsi
+                  iproc(ji,jj,jobs) = mppmap(kgrdi(ji,jj,jobs),&
+                     &                       kgrdj(ji,jj,jobs))
+                  nplocal(iproc(ji,jj,jobs)) = nplocal(iproc(ji,jj,jobs)) + 1
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+      ! Send local number of points and receive points on current domain
+
+      CALL mpp_alltoall_int( 1, nplocal, npglobal )
+
+      ! Allocate message parsing workspace
+
+      itot = SUM(npglobal)
+
+      ALLOCATE( &
+         & igrdij_send(kptsi*kptsj*kobs*2), &
+         & igrdij_recv(itot*2),             &
+         & zsend(kpk,itot),                 &
+         & zrecv(kpk,kptsi*kptsj*kobs)      &
+         & )
+
+      ! Pack buffers for list of points
+
+      it = 0
+      DO jp = 1, jpnij 
+         DO jobs = 1, kobs
+            DO jj = 1, kptsj
+               DO ji = 1, kptsi
+                  IF ( iproc(ji,jj,jobs) == jp ) THEN
+                     it = it + 1
+                     iorder(ji,jj,jobs) = it
+                     igrdij_send(2*it-1) = kgrdi(ji,jj,jobs)
+                     igrdij_send(2*it  ) = kgrdj(ji,jj,jobs)
+                  ENDIF
+               END DO
+            END DO
+         END DO
+      END DO
+
+      ! Send and recieve buffers for list of points
+
+      CALL mpp_alltoallv_int( igrdij_send, kptsi*kptsj*kobs*2, nplocal(:)*2, &
+         &                    igrdij_recv, itot*2, npglobal(:)*2 )
+
+      ! Pack interpolation data to be sent
+
+      DO ji = 1, itot
+         ii = mi1(igrdij_recv(2*ji-1))
+         ij = mj1(igrdij_recv(2*ji))
+         DO jk = 1, kpk
+            zsend(jk,ji) = pval(ii,ij,jk)
+         END DO
+      END DO
+
+      ! Re-adjust sizes
+
+      nplocal(:)  = kpk*nplocal(:)
+      npglobal(:) = kpk*npglobal(:)
+
+
+      ! Send and receive data for interpolation stencil
+
+      CALL mpp_alltoallv_real( zsend, kpk*itot,             npglobal, &
+         &                     zrecv, kpk*kptsi*kptsj*kobs, nplocal )
+
+      ! Copy the received data into output data structure
+      
+      DO jobs = 1, kobs
+         DO jj = 1, kptsj
+            DO ji = 1, kptsi
+               it = iorder(ji,jj,jobs)  
+               DO jk = 1, kpk
+                  pgval(ji,jj,jk,jobs) = zrecv(jk,it)
+               END DO
+            END DO
+         END DO
+      END DO
+
+      ! Deallocate message parsing workspace
+
+      DEALLOCATE( &
+         & igrdij_send, &
+         & igrdij_recv, &
+         & zsend,       &
+         & zrecv        &
+         & )
+
+   END SUBROUTINE obs_int_comm_3d_global
+   
+   SUBROUTINE obs_int_comm_3d_local( kptsi, kptsj, kobs, kpk, kgrdi, kgrdj, &
+      &                              pval, pgval )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_int_comm_3d_global  ***
+      !!          
+      !! ** Purpose : Get 3D interpolation stencil (global version)
+      !!
+      !! ** Method  : On-demand communication where each processor send its
+      !!              list of (i,j) of points to all processors and receive 
+      !!              the corresponding values
+      !!
+      !! ** Action  : 
+      !!
+      !! History :
+      !!        !  08-02  (K. Mogensen)  Original code
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kptsi        ! Number of i horizontal points per stencil 
+      INTEGER, INTENT(IN) :: kptsj        ! Number of j horizontal points per stencil
+      INTEGER, INTENT(IN) :: kobs         ! Local number of observations
+      INTEGER, INTENT(IN) :: kpk          ! Number of levels
+      INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: &
+         & kgrdi, &         ! i,j indicies for each stencil
+         & kgrdj
+      REAL(KIND=wp), DIMENSION(jpi,jpj,kpk), INTENT(IN) ::&
+         & pval             ! Local 3D array to extract data from
+      REAL(KIND=wp), DIMENSION(kptsi,kptsj,kpk,kobs), INTENT(OUT) ::&
+         & pgval            ! Stencil at each point
+      !! * Local declarations
+      INTEGER ::  ji
+      INTEGER ::  jj
+      INTEGER ::  jk
+      INTEGER ::  jobs
+
+      ! Check valid points
+
+      IF ( ( MAXVAL(kgrdi) > jpi ) .OR. ( MINVAL(kgrdi) < 1 ) .OR. &
+         & ( MAXVAL(kgrdj) > jpj ) .OR. ( MINVAL(kgrdj) < 1 ) ) THEN
+         
+         CALL ctl_stop( 'Error in obs_int_comm_3d_local', &
+            &           'Point outside local domain' )
+         
+      ENDIF
+
+      ! Copy local data
+
+      DO jobs = 1, kobs
+         DO jj = 1, kptsj
+            DO ji = 1, kptsi
+               DO jk = 1, kpk
+                  pgval(ji,jj,jk,jobs) = &
+                     &            pval(kgrdi(ji,jj,jobs),kgrdj(ji,jj,jobs),jk)
+               END DO
+            END DO
+         END DO
+      END DO
+
+   END SUBROUTINE obs_int_comm_3d_local
+
+END MODULE obs_inter_sup
+ 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_z1d.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_z1d.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_z1d.F90	(revision 2528)
@@ -0,0 +1,37 @@
+MODULE obs_inter_z1d
+   !!======================================================================
+   !!                       ***  MODULE obs_inter_z1d  ***
+   !! Observation diagnostics: Perform the vertical interpolation
+   !!                          from model grid to observation location
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   obs_int_z1d     : Vertical interpolation to the observation point
+   !!   obs_int_z1d_spl : Compute the vertical 2nd derivative of the
+   !!                     interpolating function for a cubic spline (n1dint=1)
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE par_kind, ONLY : &  ! Precision variables
+      & wp
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC obs_int_z1d,    &  ! Vertical interpolation to the observation pt.
+      &   obs_int_z1d_spl    ! Compute the vertical 2nd derivative of the
+                             ! interpolating function used with a cubic spline
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#include "obsinter_z1d.h90"
+
+END MODULE obs_inter_z1d
+
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_level_search.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_level_search.h90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_level_search.h90	(revision 2528)
@@ -0,0 +1,51 @@
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE obs_level_search( kgrd, pgrddep, kobs, pobsdep, kobsk )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_level_search ***
+      !!
+      !! ** Purpose : Search levels to find matching level to observed depth
+      !!
+      !! ** Method  : Straightforward search
+      !!
+      !! ** Action  : 
+      !!
+      !! History :
+      !!        !  2001-11  (N. Daget, A. Weaver)
+      !!        !  2006-03  (A. Weaver) NEMOVAR migration.
+      !!        !  2006-05  (K. Mogensen) Moved to to separate routine.
+      !!        !  2006-10  (A. Weaver) Cleanup
+      !!        !  2008-10  (K. Mogensen) Remove assumptions on grid.
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kgrd     ! Number of gridpoints
+      REAL(KIND=wp), DIMENSION(kgrd), INTENT(INOUT) :: &
+         &   pgrddep  ! Depths of gridpoints
+      INTEGER, INTENT(IN) :: &
+         &   kobs     ! Number of observations
+      REAL(KIND=wp), DIMENSION(kobs), INTENT(INOUT) :: &
+         &   pobsdep  ! Depths of observations
+      INTEGER ,DIMENSION(kobs), INTENT(OUT) :: &
+         &   kobsk    ! Level indices of observations
+  
+      !! * Local declarations
+      INTEGER :: ji
+      INTEGER :: jk
+
+      !------------------------------------------------------------------------
+      ! Search levels for each observations to find matching level
+      !------------------------------------------------------------------------
+      DO ji = 1, kobs 
+         kobsk(ji) = 1
+         depk: DO jk = 2, kgrd
+            IF ( pgrddep(jk) >= pobsdep(ji) ) EXIT depk
+         END DO depk
+         kobsk(ji) = jk
+      END DO
+
+   END SUBROUTINE obs_level_search
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_mpp.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_mpp.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_mpp.F90	(revision 2528)
@@ -0,0 +1,498 @@
+MODULE obs_mpp
+   !!======================================================================
+   !!                       ***  MODULE obs_mpp  ***
+   !! Observation diagnostics: Various MPP support routines
+   !!======================================================================
+   !! History :  2.0  ! 2006-03  (K. Mogensen)  Original code
+   !!             -   ! 2006-05  (K. Mogensen)  Reformatted
+   !!             -   ! 2008-01  (K. Mogensen)  add mpp_global_max
+   !!----------------------------------------------------------------------
+#  define mpivar mpi_double_precision
+   !!----------------------------------------------------------------------
+   !! obs_mpp_bcast_integer : Broadcast an integer array from a processor to all processors
+   !! obs_mpp_max_integer   : Find maximum on all processors of each value in an integer on all processors
+   !! obs_mpp_find_obs_proc : Find processors which should hold the observations
+   !! obs_mpp_sum_integers  : Sum an integer array from all processors
+   !! obs_mpp_sum_integer   : Sum an integer from all processors
+   !!----------------------------------------------------------------------
+   USE dom_oce, ONLY :   nproc, mig, mjg   ! Ocean space and time domain variables
+   USE mpp_map, ONLY :   mppmap
+   USE in_out_manager
+#if defined key_mpp_mpi
+   USE lib_mpp, ONLY :   mpi_comm_opa      ! MPP library
+#endif
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC obs_mpp_bcast_integer, & !: Broadcast an integer array from a proc to all procs
+      &   obs_mpp_max_integer,   & !: Find maximum across processors in an integer array
+      &   obs_mpp_find_obs_proc, & !: Find processors which should hold the observations
+      &   obs_mpp_sum_integers,  & !: Sum an integer array from all processors
+      &   obs_mpp_sum_integer,   & !: Sum an integer from all processors
+      &   mpp_alltoall_int,      &
+      &   mpp_alltoallv_int,     &
+      &   mpp_alltoallv_real,    &
+      &   mpp_global_max
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE obs_mpp_bcast_integer( kvals, kno, kroot )
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE obs_mpp_bcast_integer ***
+      !!          
+      !! ** Purpose : Send array kvals to all processors
+      !!
+      !! ** Method  : MPI broadcast
+      !!
+      !! ** Action  : This does only work for MPI. 
+      !!              MPI_COMM_OPA needs to be replace for OASIS4.!
+      !!
+      !! References : http://www.mpi-forum.org
+      !!----------------------------------------------------------------------
+      INTEGER                , INTENT(in   ) ::   kno     ! Number of elements in array
+      INTEGER                , INTENT(in   ) ::   kroot   ! Processor to send data
+      INTEGER, DIMENSION(kno), INTENT(inout) ::   kvals   ! Array to send on kroot, receive for non-kroot
+      !
+#if defined key_mpp_mpi
+      !
+      INTEGER :: ierr 
+      !
+INCLUDE 'mpif.h'
+      !!----------------------------------------------------------------------
+
+      ! Call the MPI library to broadcast data
+      CALL mpi_bcast( kvals, kno, mpi_integer,  &
+         &            kroot, mpi_comm_opa, ierr )
+#else
+      ! no MPI: empty routine
+#endif
+      !
+   END SUBROUTINE obs_mpp_bcast_integer
+
+  
+   SUBROUTINE obs_mpp_max_integer( kvals, kno )
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE obs_mpp_bcast_integer ***
+      !!          
+      !! ** Purpose : Find maximum across processors in an integer array.
+      !!
+      !! ** Method  : MPI all reduce.
+      !!
+      !! ** Action  : This does only work for MPI. 
+      !!              It does not work for SHMEM.
+      !!              MPI_COMM_OPA needs to be replace for OASIS4.!
+      !!
+      !! References : http://www.mpi-forum.org
+      !!----------------------------------------------------------------------
+      INTEGER                , INTENT(in   ) ::   kno     ! Number of elements in array
+      INTEGER, DIMENSION(kno), INTENT(inout) ::   kvals   ! Array to send on kroot, receive for non-kroot  
+      !
+#if defined key_mpp_mpi
+      !
+      INTEGER :: ierr 
+      INTEGER, DIMENSION(kno) ::   ivals
+      !
+INCLUDE 'mpif.h'
+      !!----------------------------------------------------------------------
+
+      ! Call the MPI library to find the maximum across processors
+      CALL mpi_allreduce( kvals, ivals, kno, mpi_integer,   &
+         &                mpi_max, mpi_comm_opa, ierr )
+      kvals(:) = ivals(:)
+#else
+      ! no MPI: empty routine
+#endif
+   END SUBROUTINE obs_mpp_max_integer
+
+
+   SUBROUTINE obs_mpp_find_obs_proc( kobsp, kobsi, kobsj, kno )
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE obs_mpp_find_obs_proc ***
+      !!          
+      !! ** Purpose : From the array kobsp containing the results of the grid
+      !!              grid search on each processor the processor return a
+      !!              decision of which processors should hold the observation.
+      !!
+      !! ** Method  : A temporary 2D array holding all the decisions is
+      !!              constructed using mpi_allgather on each processor.
+      !!              If more than one processor has found the observation
+      !!              with the observation in the inner domain gets it
+      !!
+      !! ** Action  : This does only work for MPI. 
+      !!              It does not work for SHMEM.
+      !!
+      !! References : http://www.mpi-forum.org
+      !!----------------------------------------------------------------------
+      INTEGER                , INTENT(in   ) ::   kno
+      INTEGER, DIMENSION(kno), INTENT(in   ) ::   kobsi, kobsj
+      INTEGER, DIMENSION(kno), INTENT(inout) ::   kobsp
+      !
+#if defined key_mpp_mpi
+      !
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: size
+      INTEGER :: ierr
+      INTEGER :: iobsip
+      INTEGER :: iobsjp
+      INTEGER :: num_sus_obs
+      INTEGER, DIMENSION(kno) ::   iobsig, iobsjg
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   iobsp, iobsi, iobsj
+      !!
+INCLUDE 'mpif.h'
+      !!----------------------------------------------------------------------
+
+      !-----------------------------------------------------------------------
+      ! Call the MPI library to find the maximum accross processors
+      !-----------------------------------------------------------------------
+      CALL mpi_comm_size( mpi_comm_opa, size, ierr )
+      !-----------------------------------------------------------------------
+      ! Convert local grids points to global grid points
+      !-----------------------------------------------------------------------
+      DO ji = 1, kno
+         IF ( ( kobsi(ji) >= 1 ) .AND. ( kobsi(ji) <= jpi ) .AND. &
+            & ( kobsj(ji) >= 1 ) .AND. ( kobsj(ji) <= jpj ) ) THEN
+            iobsig(ji) = mig( kobsi(ji) )
+            iobsjg(ji) = mjg( kobsj(ji) )
+         ELSE
+            iobsig(ji) = -1
+            iobsjg(ji) = -1
+         ENDIF
+      END DO
+      !-----------------------------------------------------------------------
+      ! Get the decisions from all processors
+      !-----------------------------------------------------------------------
+      ALLOCATE( iobsp(kno,size) )
+      ALLOCATE( iobsi(kno,size) )
+      ALLOCATE( iobsj(kno,size) )
+      CALL mpi_allgather( kobsp, kno, mpi_integer, &
+         &                iobsp, kno, mpi_integer, &
+         &                mpi_comm_opa, ierr )
+      CALL mpi_allgather( iobsig, kno, mpi_integer, &
+         &                iobsi, kno, mpi_integer, &
+         &                mpi_comm_opa, ierr )
+      CALL mpi_allgather( iobsjg, kno, mpi_integer, &
+         &                iobsj, kno, mpi_integer, &
+         &                mpi_comm_opa, ierr )
+
+      !-----------------------------------------------------------------------
+      ! Find the processor with observations from the lowest processor 
+      ! number among processors holding the observation.
+      !-----------------------------------------------------------------------
+      kobsp(:) = -1
+      num_sus_obs = 0
+      DO ji = 1, kno
+         DO jj = 1, size
+            IF ( ( kobsp(ji) == -1 ) .AND. ( iobsp(ji,jj) /= -1 ) ) THEN
+               kobsp(ji) = iobsp(ji,jj)
+               iobsip = iobsi(ji,jj)
+               iobsjp = iobsj(ji,jj)
+            ENDIF
+            IF ( ( kobsp(ji) /= -1 ) .AND. ( iobsp(ji,jj) /= -1 ) ) THEN
+               IF ( ( iobsip /= iobsi(ji,jj) ) .OR. &
+                  & ( iobsjp /= iobsj(ji,jj) ) ) THEN
+                  IF ( ( kobsp(ji) < 1000000 ) .AND. &
+                     & ( iobsp(ji,jj) < 1000000 ) ) THEN
+                     num_sus_obs=num_sus_obs+1
+                  ENDIF
+               ENDIF
+               IF ( mppmap(iobsip,iobsjp) /= ( kobsp(ji)+1 ) ) THEN
+                  IF ( ( iobsi(ji,jj) /= -1 ) .AND. &
+                     & ( iobsj(ji,jj) /= -1 ) ) THEN
+                     IF ((mppmap(iobsi(ji,jj),iobsj(ji,jj)) == (iobsp(ji,jj)+1))&
+                        & .OR. ( iobsp(ji,jj) < kobsp(ji) ) ) THEN
+                        kobsp(ji) = iobsp(ji,jj)
+                        iobsip = iobsi(ji,jj)
+                        iobsjp = iobsj(ji,jj)
+                     ENDIF
+                  ENDIF
+               ENDIF
+            ENDIF
+         END DO
+      END DO
+      IF (lwp) WRITE(numout,*) 'Number of suspicious observations: ',num_sus_obs
+
+      DEALLOCATE( iobsj )
+      DEALLOCATE( iobsi )
+      DEALLOCATE( iobsp )
+#else
+      ! no MPI: empty routine
+#endif
+      !
+   END SUBROUTINE obs_mpp_find_obs_proc
+
+
+   SUBROUTINE obs_mpp_sum_integers( kvalsin, kvalsout, kno )
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE obs_mpp_sum_integers ***
+      !!          
+      !! ** Purpose : Sum an integer array.
+      !!
+      !! ** Method  : MPI all reduce.
+      !!
+      !! ** Action  : This does only work for MPI. 
+      !!              It does not work for SHMEM.
+      !!
+      !! References : http://www.mpi-forum.org
+      !!----------------------------------------------------------------------
+      INTEGER                , INTENT(in   ) :: kno
+      INTEGER, DIMENSION(kno), INTENT(in   ) ::   kvalsin
+      INTEGER, DIMENSION(kno), INTENT(  out) ::   kvalsout
+      !
+#if defined key_mpp_mpi
+      !
+      INTEGER :: ierr
+      !
+INCLUDE 'mpif.h'
+      !!----------------------------------------------------------------------
+      !
+      !-----------------------------------------------------------------------
+      ! Call the MPI library to find the sum across processors
+      !-----------------------------------------------------------------------
+      CALL mpi_allreduce( kvalsin, kvalsout, kno, mpi_integer, &
+         &                mpi_sum, mpi_comm_opa, ierr )
+#else
+      !-----------------------------------------------------------------------
+      ! For no-MPP just return input values
+      !-----------------------------------------------------------------------
+      kvalsout(:) = kvalsin(:)
+#endif
+      !
+   END SUBROUTINE obs_mpp_sum_integers
+
+
+   SUBROUTINE obs_mpp_sum_integer( kvalin, kvalout )
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE obs_mpp_sum_integers ***
+      !!          
+      !! ** Purpose : Sum a single integer
+      !!
+      !! ** Method  : MPI all reduce.
+      !!
+      !! ** Action  : This does only work for MPI. 
+      !!              It does not work for SHMEM.
+      !!
+      !! References : http://www.mpi-forum.org
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in   ) ::   kvalin
+      INTEGER, INTENT(  out) ::   kvalout
+      !
+#if defined key_mpp_mpi
+      !
+      INTEGER :: ierr
+      !
+INCLUDE 'mpif.h'
+      !!----------------------------------------------------------------------
+      !
+      !-----------------------------------------------------------------------
+      ! Call the MPI library to find the sum across processors
+      !-----------------------------------------------------------------------
+      CALL mpi_allreduce( kvalin, kvalout, 1, mpi_integer,   &
+         &                mpi_sum, mpi_comm_opa, ierr )
+#else
+      !-----------------------------------------------------------------------
+      ! For no-MPP just return input values
+      !-----------------------------------------------------------------------
+      kvalout = kvalin
+#endif
+      !
+   END SUBROUTINE obs_mpp_sum_integer
+
+
+   SUBROUTINE mpp_global_max( pval )
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE mpp_global_or ***
+      !!          
+      !! ** Purpose : Get the maximum value across processors for a global 
+      !!              real array
+      !!
+      !! ** Method  : MPI allreduce
+      !!
+      !! ** Action  : This does only work for MPI. 
+      !!              It does not work for SHMEM.
+      !!
+      !! References : http://www.mpi-forum.org
+      !!----------------------------------------------------------------------
+      REAL(KIND=wp), DIMENSION(jpiglo,jpjglo), INTENT(inout) ::   pval
+      !
+      INTEGER :: ierr
+      !
+#if defined key_mpp_mpi
+      !
+INCLUDE 'mpif.h'
+      REAL(KIND=wp), DIMENSION(:,:), ALLOCATABLE ::   zcp
+      !!----------------------------------------------------------------------
+
+      ! Copy data for input to MPI
+
+      ALLOCATE( &
+         & zcp(jpiglo,jpjglo) &
+         & )
+      zcp(:,:) = pval(:,:)
+
+      ! Call the MPI library to find the coast lines globally
+
+      CALL mpi_allreduce( zcp, pval, jpiglo*jpjglo, mpivar, &
+         &                mpi_max, mpi_comm_opa, ierr )
+
+      DEALLOCATE( &
+         & zcp &
+         & )
+
+#else
+      ! no MPI: empty routine
+#endif
+      !
+   END SUBROUTINE mpp_global_max
+
+
+   SUBROUTINE mpp_alltoall_int( kno, kvalsin, kvalsout )
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE mpp_allgatherv ***
+      !!          
+      !! ** Purpose : all to all.
+      !!
+      !! ** Method  : MPI alltoall
+      !!
+      !! ** Action  : This does only work for MPI. 
+      !!              It does not work for SHMEM.
+      !!
+      !! References : http://www.mpi-forum.org
+      !!----------------------------------------------------------------------
+      INTEGER                      , INTENT(in   ) ::   kno
+      INTEGER, DIMENSION(kno*jpnij), INTENT(in   ) ::   kvalsin
+      INTEGER, DIMENSION(kno*jpnij), INTENT(  out) ::   kvalsout
+      !!
+      INTEGER :: ierr
+      !
+#if defined key_mpp_mpi
+      !
+INCLUDE 'mpif.h'
+      !-----------------------------------------------------------------------
+      ! Call the MPI library to do the all to all operation of the data
+      !-----------------------------------------------------------------------
+      CALL mpi_alltoall( kvalsin,  kno, mpi_integer, &
+         &               kvalsout, kno, mpi_integer, &
+         &               mpi_comm_opa, ierr )
+#else
+      !-----------------------------------------------------------------------
+      ! For no-MPP just return input values
+      !-----------------------------------------------------------------------
+      kvalsout = kvalsin
+#endif
+      !
+   END SUBROUTINE mpp_alltoall_int
+
+
+   SUBROUTINE mpp_alltoallv_int( kvalsin, knoin , kinv , kvalsout,   &
+      &                                   knoout, koutv )
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE mpp_alltoallv_int ***
+      !!          
+      !! ** Purpose : all to all (integer version).
+      !!
+      !! ** Method  : MPI alltoall
+      !!
+      !! ** Action  : This does only work for MPI. 
+      !!              It does not work for SHMEM.
+      !!
+      !! References : http://www.mpi-forum.org
+      !!----------------------------------------------------------------------
+      INTEGER                   , INTENT(in) :: knoin
+      INTEGER                   , INTENT(in) :: knoout
+      INTEGER, DIMENSION(jpnij)                 ::   kinv, koutv
+      INTEGER, DIMENSION(knoin) , INTENT(in   ) ::   kvalsin
+      INTEGER, DIMENSION(knoout), INTENT(  out) ::   kvalsout
+      !!
+      INTEGER :: ierr
+      INTEGER :: jproc
+      !
+#if defined key_mpp_mpi
+      !
+INCLUDE 'mpif.h'
+      INTEGER, DIMENSION(jpnij) ::   irdsp, isdsp
+      !-----------------------------------------------------------------------
+      ! Compute displacements
+      !-----------------------------------------------------------------------
+      irdsp(1) = 0
+      isdsp(1) = 0
+      DO jproc = 2, jpnij
+         isdsp(jproc) = isdsp(jproc-1) + kinv(jproc-1)
+         irdsp(jproc) = irdsp(jproc-1) + koutv(jproc-1)
+      END DO
+      !-----------------------------------------------------------------------
+      ! Call the MPI library to do the all to all operation of the data
+      !-----------------------------------------------------------------------
+      CALL mpi_alltoallv( kvalsin,  kinv,  isdsp, mpi_integer, &
+         &                kvalsout, koutv, irdsp, mpi_integer, &
+         &                mpi_comm_opa, ierr )
+#else
+      !-----------------------------------------------------------------------
+      ! For no-MPP just return input values
+      !-----------------------------------------------------------------------
+      kvalsout = kvalsin
+#endif
+      !
+   END SUBROUTINE mpp_alltoallv_int
+
+
+   SUBROUTINE mpp_alltoallv_real( pvalsin, knoin , kinv , pvalsout,   &
+      &                                    knoout, koutv )
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE mpp_alltoallv_real ***
+      !!          
+      !! ** Purpose : all to all (integer version).
+      !!
+      !! ** Method  : MPI alltoall
+      !!
+      !! ** Action  : This does only work for MPI. 
+      !!              It does not work for SHMEM.
+      !!
+      !! References : http://www.mpi-forum.org
+      !!----------------------------------------------------------------------
+      INTEGER                    , INTENT(in   ) :: knoin
+      INTEGER                    , INTENT(in   ) :: knoout
+      INTEGER , DIMENSION(jpnij)                 ::   kinv, koutv
+      REAL(wp), DIMENSION(knoin) , INTENT(in   ) ::   pvalsin
+      REAL(wp), DIMENSION(knoout), INTENT(  out) ::   pvalsout
+      !!
+      INTEGER :: ierr
+      INTEGER :: jproc
+      !
+#if defined key_mpp_mpi
+      !
+INCLUDE 'mpif.h'
+      INTEGER, DIMENSION(jpnij) ::   irdsp, isdsp
+      !!----------------------------------------------------------------------
+      !
+      !-----------------------------------------------------------------------
+      ! Compute displacements
+      !-----------------------------------------------------------------------
+      irdsp(1) = 0
+      isdsp(1) = 0
+      DO jproc = 2, jpnij
+         isdsp(jproc) = isdsp(jproc-1) + kinv(jproc-1)
+         irdsp(jproc) = irdsp(jproc-1) + koutv(jproc-1)
+      END DO
+      !-----------------------------------------------------------------------
+      ! Call the MPI library to do the all to all operation of the data
+      !-----------------------------------------------------------------------
+      CALL mpi_alltoallv( pvalsin,  kinv,  isdsp, mpivar, &
+         &                pvalsout, koutv, irdsp, mpivar, &
+         &                mpi_comm_opa, ierr )
+#else
+      !-----------------------------------------------------------------------
+      ! For no-MPP just return input values
+      !-----------------------------------------------------------------------
+      pvalsout = pvalsin
+#endif
+      !
+   END SUBROUTINE mpp_alltoallv_real
+
+   !!======================================================================
+END MODULE obs_mpp
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90	(revision 2528)
@@ -0,0 +1,1321 @@
+MODULE obs_oper
+   !!======================================================================
+   !!                       ***  MODULE obs_oper  ***
+   !! Observation diagnostics: Observation operators for various observation
+   !!                          types
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   obs_pro_opt :    Compute the model counterpart of temperature and
+   !!                    salinity observations from profiles
+   !!   obs_sla_opt :    Compute the model counterpart of sea level anomaly
+   !!                    observations
+   !!   obs_sst_opt :    Compute the model counterpart of sea surface temperature
+   !!                    observations
+   !!   obs_sss_opt :    Compute the model counterpart of sea surface salinity
+   !!                    observations
+   !!   obs_seaice_opt : Compute the model counterpart of sea ice concentration
+   !!                    observations
+   !!
+   !!   obs_vel_opt :    Compute the model counterpart of zonal and meridional
+   !!                    components of velocity from observations.
+   !!----------------------------------------------------------------------
+
+   !! * 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
+      & obs_int_h2d, &
+      & obs_int_h2d_init
+   USE obs_inter_z1d, ONLY : &    ! Vertical interpolation to the observation pt
+      & obs_int_z1d,    &
+      & obs_int_z1d_spl
+   USE obs_const,  ONLY :     &
+      & obfillflt		  ! Fillvalue   
+   USE dom_oce,       ONLY : &
+      & glamt, glamu, glamv, &
+      & gphit, gphiu, gphiv
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC obs_pro_opt, &  ! Compute the model counterpart of profile observations
+      &   obs_sla_opt, &  ! Compute the model counterpart of SLA observations
+      &   obs_sst_opt, &  ! Compute the model counterpart of SST observations
+      &   obs_sss_opt, &  ! Compute the model counterpart of SSS observations
+      &   obs_seaice_opt, &
+      &   obs_vel_opt     ! Compute the model counterpart of velocity profile data
+
+   INTEGER, PARAMETER, PUBLIC :: imaxavtypes = 20 ! Max number of daily avgd obs types
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE obs_pro_opt( prodatqc, kt, kpi, kpj, kpk, kit000, kdaystp, &
+      &                    ptn, psn, pgdept, ptmask, k1dint, k2dint, &
+      &                    kdailyavtypes )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  ROUTINE obs_pro_opt  ***
+      !!
+      !! ** Purpose : Compute the model counterpart of profiles
+      !!              data by interpolating from the model grid to the 
+      !!              observation point.
+      !!
+      !! ** Method  : Linearly interpolate to each observation point using 
+      !!              the model values at the corners of the surrounding grid box.
+      !!
+      !!    First, a vertical profile of horizontally interpolated model
+      !!    now temperatures is computed at the obs (lon, lat) point.
+      !!    Several horizontal interpolation schemes are available:
+      !!        - distance-weighted (great circle) (k2dint = 0)
+      !!        - distance-weighted (small angle)  (k2dint = 1)
+      !!        - bilinear (geographical grid)     (k2dint = 2)
+      !!        - bilinear (quadrilateral grid)    (k2dint = 3)
+      !!        - polynomial (quadrilateral grid)  (k2dint = 4)
+      !!
+      !!    Next, the vertical temperature profile is interpolated to the
+      !!    data depth points. Two vertical interpolation schemes are
+      !!    available:
+      !!        - linear       (k1dint = 0)
+      !!        - Cubic spline (k1dint = 1)
+      !!
+      !!    For the cubic spline the 2nd derivative of the interpolating 
+      !!    polynomial is computed before entering the vertical interpolation 
+      !!    routine.
+      !!
+      !!    For ENACT moored buoy data (e.g., TAO), the model equivalent is
+      !!    a daily mean model temperature field. So, we first compute
+      !!    the mean, then interpolate only at the end of the day.
+      !!
+      !!    Note: the in situ temperature observations must be converted
+      !!    to potential temperature (the model variable) prior to
+      !!    assimilation. 
+      !!??????????????????????????????????????????????????????????????
+      !!    INCLUDE POTENTIAL TEMP -> IN SITU TEMP IN OBS OPERATOR???
+      !!??????????????????????????????????????????????????????????????
+      !!
+      !! ** Action  :
+      !!
+      !! History :
+      !!      ! 97-11 (A. Weaver, S. Ricci, N. Daget)
+      !!      ! 06-03 (G. Smith) NEMOVAR migration
+      !!      ! 06-10 (A. Weaver) Cleanup
+      !!      ! 07-01 (K. Mogensen) Merge of temperature and salinity
+      !!      ! 07-03 (K. Mogensen) General handling of profiles
+      !!-----------------------------------------------------------------------
+  
+      !! * Modules used
+      USE obs_profiles_def ! Definition of storage space for profile obs.
+
+      IMPLICIT NONE
+
+      !! * Arguments
+      TYPE(obs_prof), INTENT(INOUT) :: prodatqc  ! Subset of profile data not failing screening
+      INTEGER, INTENT(IN) :: kt        ! Time step
+      INTEGER, INTENT(IN) :: kpi       ! Model grid parameters
+      INTEGER, INTENT(IN) :: kpj
+      INTEGER, INTENT(IN) :: kpk
+      INTEGER, INTENT(IN) :: kit000    ! Number of the first time step 
+                                       !   (kit000-1 = restart time)
+      INTEGER, INTENT(IN) :: k1dint    ! Vertical interpolation type (see header)
+      INTEGER, INTENT(IN) :: k2dint    ! Horizontal interpolation type (see header)
+      INTEGER, INTENT(IN) :: kdaystp   ! Number of time steps per day                    
+      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: &
+         & ptn,    &    ! Model temperature field
+         & psn,    &    ! Model salinity field
+         & ptmask       ! Land-sea mask
+      REAL(KIND=wp), INTENT(IN), DIMENSION(kpk) :: &
+         & pgdept       ! Model array of depth levels
+      INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: &
+         & kdailyavtypes! Types for daily averages
+      !! * Local declarations
+      INTEGER ::   ji
+      INTEGER ::   jj
+      INTEGER ::   jk
+      INTEGER ::   jobs
+      INTEGER ::   inrc
+      INTEGER ::   ipro
+      INTEGER ::   idayend
+      INTEGER ::   ista
+      INTEGER ::   iend
+      INTEGER ::   iobs
+      INTEGER, DIMENSION(imaxavtypes) :: &
+         & idailyavtypes
+      REAL(KIND=wp) :: zlam
+      REAL(KIND=wp) :: zphi
+      REAL(KIND=wp) :: zdaystp
+      REAL(KIND=wp), DIMENSION(kpk) :: &
+         & zobsmask, &
+         & zobsk,    &
+         & zobs2k
+      REAL(KIND=wp), DIMENSION(2,2,kpk) :: &
+         & zweig
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: &
+         & zmask, &
+         & zintt, &
+         & zints, &
+         & zinmt, &
+         & zinms
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
+         & zglam, &
+         & zgphi
+      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
+         & igrdi, &
+         & igrdj
+
+      !------------------------------------------------------------------------
+      ! Local initialization 
+      !------------------------------------------------------------------------
+      ! ... Record and data counters
+      inrc = kt - kit000 + 2
+      ipro = prodatqc%npstp(inrc)
+ 
+      ! Daily average types
+      IF ( PRESENT(kdailyavtypes) ) THEN
+         idailyavtypes(:) = kdailyavtypes(:)
+      ELSE
+         idailyavtypes(:) = -1
+      ENDIF
+
+      ! Initialize daily mean for first timestep
+      idayend = MOD( kt - kit000 + 1, kdaystp )
+
+      ! Added kt == 0 test to catch restart case 
+      IF ( idayend == 1 .OR. kt == 0) THEN
+         IF (lwp) WRITE(numout,*) 'Reset prodatqc%vdmean on time-step: ',kt
+         DO jk = 1, jpk
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  prodatqc%vdmean(ji,jj,jk,1) = 0.0
+                  prodatqc%vdmean(ji,jj,jk,2) = 0.0
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ! Increment the temperature field for computing daily mean
+               prodatqc%vdmean(ji,jj,jk,1) = prodatqc%vdmean(ji,jj,jk,1) &
+                  &                        + ptn(ji,jj,jk)
+               ! Increment the salinity field for computing daily mean
+               prodatqc%vdmean(ji,jj,jk,2) = prodatqc%vdmean(ji,jj,jk,2) &
+                  &                        + psn(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+   
+      ! Compute the daily mean at the end of day
+      zdaystp = 1.0 / REAL( kdaystp )
+      IF ( idayend == 0 ) THEN
+         DO jk = 1, jpk
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  prodatqc%vdmean(ji,jj,jk,1) = prodatqc%vdmean(ji,jj,jk,1) &
+                     &                        * zdaystp
+                  prodatqc%vdmean(ji,jj,jk,2) = prodatqc%vdmean(ji,jj,jk,2) &
+                  &                           * zdaystp
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+      ! Get the data for interpolation
+      ALLOCATE( &
+         & igrdi(2,2,ipro),      &
+         & igrdj(2,2,ipro),      &
+         & zglam(2,2,ipro),      &
+         & zgphi(2,2,ipro),      &
+         & zmask(2,2,kpk,ipro),  &
+         & zintt(2,2,kpk,ipro),  &
+         & zints(2,2,kpk,ipro)   &
+         & )
+
+      DO jobs = prodatqc%nprofup + 1, prodatqc%nprofup + ipro
+         iobs = jobs - prodatqc%nprofup
+         igrdi(1,1,iobs) = prodatqc%mi(jobs,1)-1
+         igrdj(1,1,iobs) = prodatqc%mj(jobs,1)-1
+         igrdi(1,2,iobs) = prodatqc%mi(jobs,1)-1
+         igrdj(1,2,iobs) = prodatqc%mj(jobs,1)
+         igrdi(2,1,iobs) = prodatqc%mi(jobs,1)
+         igrdj(2,1,iobs) = prodatqc%mj(jobs,1)-1
+         igrdi(2,2,iobs) = prodatqc%mi(jobs,1)
+         igrdj(2,2,iobs) = prodatqc%mj(jobs,1)
+      END DO
+
+      CALL obs_int_comm_2d( 2, 2, ipro, igrdi, igrdj, glamt, zglam )
+      CALL obs_int_comm_2d( 2, 2, ipro, igrdi, igrdj, gphit, zgphi )
+      CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdi, igrdj, ptmask,zmask )
+      CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdi, igrdj, ptn,   zintt )
+      CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdi, igrdj, psn,   zints )
+
+      ! At the end of the day also get interpolated means
+      IF ( idayend == 0 ) THEN
+
+         ALLOCATE( &
+            & zinmt(2,2,kpk,ipro),  &
+            & zinms(2,2,kpk,ipro)   &
+            & )
+
+         CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdi, igrdj, &
+            &                  prodatqc%vdmean(:,:,:,1), zinmt )
+         CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdi, igrdj, &
+            &                  prodatqc%vdmean(:,:,:,2), zinms )
+
+      ENDIF
+
+      DO jobs = prodatqc%nprofup + 1, prodatqc%nprofup + ipro
+
+         iobs = jobs - prodatqc%nprofup
+
+         IF ( kt /= prodatqc%mstp(jobs) ) THEN
+            
+            IF(lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) ' E R R O R : Observation',              &
+                  &            ' time step is not consistent with the', &
+                  &            ' model time step'
+               WRITE(numout,*) ' ========='
+               WRITE(numout,*)
+               WRITE(numout,*) ' Record  = ', jobs,                    &
+                  &            ' kt      = ', kt,                      &
+                  &            ' mstp    = ', prodatqc%mstp(jobs), &
+                  &            ' ntyp    = ', prodatqc%ntyp(jobs)
+            ENDIF
+            CALL ctl_stop( 'obs_pro_opt', 'Inconsistent time' )
+         ENDIF
+         
+         zlam = prodatqc%rlam(jobs)
+         zphi = prodatqc%rphi(jobs)
+         
+         ! Horizontal weights and vertical mask
+
+         IF ( ( prodatqc%npvend(jobs,1) > 0 ) .OR. &
+            & ( prodatqc%npvend(jobs,2) > 0 ) ) THEN
+
+            CALL obs_int_h2d_init( kpk, kpk, k2dint, zlam, zphi,     &
+               &                   zglam(:,:,iobs), zgphi(:,:,iobs), &
+               &                   zmask(:,:,:,iobs), zweig, zobsmask )
+
+         ENDIF
+
+         IF ( prodatqc%npvend(jobs,1) > 0 ) THEN
+
+            zobsk(:) = obfillflt
+
+	    IF ( ANY (idailyavtypes(:) == prodatqc%ntyp(jobs)) ) THEN
+
+               IF ( idayend == 0 )  THEN
+                  
+                  ! Daily averaged moored buoy (MRB) data
+                  
+                  CALL obs_int_h2d( kpk, kpk,      &
+                     &              zweig, zinmt(:,:,:,iobs), zobsk )
+                  
+                  
+               ELSE
+               
+                  CALL ctl_stop( ' A nonzero' //     &
+                     &           ' number of profile T BUOY data should' // &
+                     &           ' only occur at the end of a given day' )
+
+               ENDIF
+	       
+            ELSE 
+               
+               ! Point data
+
+               CALL obs_int_h2d( kpk, kpk,      &
+                  &              zweig, zintt(:,:,:,iobs), zobsk )
+
+            ENDIF
+
+            !-------------------------------------------------------------
+            ! Compute vertical second-derivative of the interpolating 
+            ! polynomial at obs points
+            !-------------------------------------------------------------
+            
+            IF ( k1dint == 1 ) THEN
+               CALL obs_int_z1d_spl( kpk, zobsk, zobs2k,   &
+                  &                  pgdept, zobsmask )
+            ENDIF
+            
+            !-----------------------------------------------------------------
+            !  Vertical interpolation to the observation point
+            !-----------------------------------------------------------------
+            ista = prodatqc%npvsta(jobs,1)
+            iend = prodatqc%npvend(jobs,1)
+            CALL obs_int_z1d( kpk,                &
+               & prodatqc%var(1)%mvk(ista:iend),  &
+               & k1dint, iend - ista + 1,         &
+               & prodatqc%var(1)%vdep(ista:iend), &
+               & zobsk, zobs2k,                   &
+               & prodatqc%var(1)%vmod(ista:iend), &
+               & pgdept, zobsmask )
+
+         ENDIF
+
+         IF ( prodatqc%npvend(jobs,2) > 0 ) THEN
+
+            zobsk(:) = obfillflt
+
+            IF ( ANY (idailyavtypes(:) == prodatqc%ntyp(jobs)) ) THEN
+
+               IF ( idayend == 0 )  THEN
+
+                  ! Daily averaged moored buoy (MRB) data
+                  
+                  CALL obs_int_h2d( kpk, kpk,      &
+                     &              zweig, zinms(:,:,:,iobs), zobsk )
+                  
+               ELSE
+
+                  CALL ctl_stop( ' A nonzero' //     &
+                     &           ' number of profile S BUOY data should' // &
+                     &           ' only occur at the end of a given day' )
+
+               ENDIF
+
+            ELSE
+               
+               ! Point data
+
+               CALL obs_int_h2d( kpk, kpk,      &
+                  &              zweig, zints(:,:,:,iobs), zobsk )
+
+            ENDIF
+
+
+            !-------------------------------------------------------------
+            ! Compute vertical second-derivative of the interpolating 
+            ! polynomial at obs points
+            !-------------------------------------------------------------
+            
+            IF ( k1dint == 1 ) THEN
+               CALL obs_int_z1d_spl( kpk, zobsk, zobs2k, &
+                  &                  pgdept, zobsmask )
+            ENDIF
+            
+            !----------------------------------------------------------------
+            !  Vertical interpolation to the observation point
+            !----------------------------------------------------------------
+            ista = prodatqc%npvsta(jobs,2)
+            iend = prodatqc%npvend(jobs,2)
+            CALL obs_int_z1d( kpk, &
+               & prodatqc%var(2)%mvk(ista:iend),&
+               & k1dint, iend - ista + 1, &
+               & prodatqc%var(2)%vdep(ista:iend),&
+               & zobsk, zobs2k, &
+               & prodatqc%var(2)%vmod(ista:iend),&
+               & pgdept, zobsmask )
+
+         ENDIF
+
+      END DO
+ 
+      ! Deallocate the data for interpolation
+      DEALLOCATE( &
+         & igrdi, &
+         & igrdj, &
+         & zglam, &
+         & zgphi, &
+         & zmask, &
+         & zintt, &
+         & zints  &
+         & )
+      ! At the end of the day also get interpolated means
+      IF ( idayend == 0 ) THEN
+         DEALLOCATE( &
+            & zinmt,  &
+            & zinms   &
+            & )
+      ENDIF
+
+      prodatqc%nprofup = prodatqc%nprofup + ipro 
+      
+   END SUBROUTINE obs_pro_opt
+
+   SUBROUTINE obs_sla_opt( sladatqc, kt, kpi, kpj, kit000, &
+      &                    psshn, psshmask, k2dint )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  ROUTINE obs_sla_opt  ***
+      !!
+      !! ** Purpose : Compute the model counterpart of sea level anomaly
+      !!              data by interpolating from the model grid to the 
+      !!              observation point.
+      !!
+      !! ** Method  : Linearly interpolate to each observation point using 
+      !!              the model values at the corners of the surrounding grid box.
+      !!
+      !!    The now model SSH is first computed at the obs (lon, lat) point.
+      !!
+      !!    Several horizontal interpolation schemes are available:
+      !!        - distance-weighted (great circle) (k2dint = 0)
+      !!        - distance-weighted (small angle)  (k2dint = 1)
+      !!        - bilinear (geographical grid)     (k2dint = 2)
+      !!        - bilinear (quadrilateral grid)    (k2dint = 3)
+      !!        - polynomial (quadrilateral grid)  (k2dint = 4)
+      !!  
+      !!    The sea level anomaly at the observation points is then computed 
+      !!    by removing a mean dynamic topography (defined at the obs. point).
+      !!
+      !! ** Action  :
+      !!
+      !! History :
+      !!      ! 07-03 (A. Weaver)
+      !!-----------------------------------------------------------------------
+  
+      !! * Modules used
+      USE obs_surf_def  ! Definition of storage space for surface observations
+
+      IMPLICIT NONE
+
+      !! * Arguments
+      TYPE(obs_surf), INTENT(INOUT) :: sladatqc     ! Subset of surface data not failing screening
+      INTEGER, INTENT(IN) :: kt      ! Time step
+      INTEGER, INTENT(IN) :: kpi     ! Model grid parameters
+      INTEGER, INTENT(IN) :: kpj
+      INTEGER, INTENT(IN) :: kit000   ! Number of the first time step 
+                                      !   (kit000-1 = restart time)
+      INTEGER, INTENT(IN) :: k2dint   ! Horizontal interpolation type (see header)
+      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj) :: &
+         & psshn,  &    ! Model SSH field
+         & psshmask     ! Land-sea mask
+         
+      !! * Local declarations
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jobs
+      INTEGER :: inrc
+      INTEGER :: isla
+      INTEGER :: iobs
+      REAL(KIND=wp) :: zlam
+      REAL(KIND=wp) :: zphi
+      REAL(KIND=wp) :: zext(1), zobsmask(1)
+      REAL(kind=wp), DIMENSION(2,2,1) :: &
+         & zweig
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
+         & zmask, &
+         & zsshl, &
+         & zglam, &
+         & zgphi
+      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
+         & igrdi, &
+         & igrdj
+
+      !------------------------------------------------------------------------
+      ! Local initialization 
+      !------------------------------------------------------------------------
+      ! ... Record and data counters
+      inrc = kt - kit000 + 2
+      isla = sladatqc%nsstp(inrc)
+
+      ! Get the data for interpolation
+
+      ALLOCATE( &
+         & igrdi(2,2,isla), &
+         & igrdj(2,2,isla), &
+         & zglam(2,2,isla), &
+         & zgphi(2,2,isla), &
+         & zmask(2,2,isla), &
+         & zsshl(2,2,isla)  &
+         & )
+      
+      DO jobs = sladatqc%nsurfup + 1, sladatqc%nsurfup + isla
+         iobs = jobs - sladatqc%nsurfup
+         igrdi(1,1,iobs) = sladatqc%mi(jobs)-1
+         igrdj(1,1,iobs) = sladatqc%mj(jobs)-1
+         igrdi(1,2,iobs) = sladatqc%mi(jobs)-1
+         igrdj(1,2,iobs) = sladatqc%mj(jobs)
+         igrdi(2,1,iobs) = sladatqc%mi(jobs)
+         igrdj(2,1,iobs) = sladatqc%mj(jobs)-1
+         igrdi(2,2,iobs) = sladatqc%mi(jobs)
+         igrdj(2,2,iobs) = sladatqc%mj(jobs)
+      END DO
+
+      CALL obs_int_comm_2d( 2, 2, isla, &
+         &                  igrdi, igrdj, glamt, zglam )
+      CALL obs_int_comm_2d( 2, 2, isla, &
+         &                  igrdi, igrdj, gphit, zgphi )
+      CALL obs_int_comm_2d( 2, 2, isla, &
+         &                  igrdi, igrdj, psshmask, zmask )
+      CALL obs_int_comm_2d( 2, 2, isla, &
+         &                  igrdi, igrdj, psshn, zsshl )
+
+      ! Loop over observations
+
+      DO jobs = sladatqc%nsurfup + 1, sladatqc%nsurfup + isla
+
+         iobs = jobs - sladatqc%nsurfup
+
+         IF ( kt /= sladatqc%mstp(jobs) ) THEN
+            
+            IF(lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) ' E R R O R : Observation',              &
+                  &            ' time step is not consistent with the', &
+                  &            ' model time step'
+               WRITE(numout,*) ' ========='
+               WRITE(numout,*)
+               WRITE(numout,*) ' Record  = ', jobs,                &
+                  &            ' kt      = ', kt,                  &
+                  &            ' mstp    = ', sladatqc%mstp(jobs), &
+                  &            ' ntyp    = ', sladatqc%ntyp(jobs)
+            ENDIF
+            CALL ctl_stop( 'obs_sla_opt', 'Inconsistent time' )
+            
+         ENDIF
+         
+         zlam = sladatqc%rlam(jobs)
+         zphi = sladatqc%rphi(jobs)
+
+         ! Get weights to interpolate the model SSH to the observation point
+         CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         &
+            &                   zglam(:,:,iobs), zgphi(:,:,iobs), &
+            &                   zmask(:,:,iobs), zweig, zobsmask )
+         
+
+         ! Interpolate the model SSH to the observation point
+         CALL obs_int_h2d( 1, 1,      &
+            &              zweig, zsshl(:,:,iobs),  zext )
+         
+         sladatqc%rext(jobs,1) = zext(1)
+         ! ... Remove the MDT at the observation point
+         sladatqc%rmod(jobs,1) = sladatqc%rext(jobs,1) - sladatqc%rext(jobs,2)
+
+      END DO
+
+      ! Deallocate the data for interpolation
+      DEALLOCATE( &
+         & igrdi, &
+         & igrdj, &
+         & zglam, &
+         & zgphi, &
+         & zmask, &
+         & zsshl  &
+         & )
+
+      sladatqc%nsurfup = sladatqc%nsurfup + isla
+
+   END SUBROUTINE obs_sla_opt
+
+   SUBROUTINE obs_sst_opt( sstdatqc, kt, kpi, kpj, kit000, &
+      &                    psstn, psstmask, k2dint )
+
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  ROUTINE obs_sst_opt  ***
+      !!
+      !! ** Purpose : Compute the model counterpart of surface temperature
+      !!              data by interpolating from the model grid to the 
+      !!              observation point.
+      !!
+      !! ** Method  : Linearly interpolate to each observation point using 
+      !!              the model values at the corners of the surrounding grid box.
+      !!
+      !!    The now model SST is first computed at the obs (lon, lat) point.
+      !!
+      !!    Several horizontal interpolation schemes are available:
+      !!        - distance-weighted (great circle) (k2dint = 0)
+      !!        - distance-weighted (small angle)  (k2dint = 1)
+      !!        - bilinear (geographical grid)     (k2dint = 2)
+      !!        - bilinear (quadrilateral grid)    (k2dint = 3)
+      !!        - polynomial (quadrilateral grid)  (k2dint = 4)
+      !!
+      !!
+      !! ** Action  :
+      !!
+      !! History :
+      !!        !  07-07  (S. Ricci ) : Original
+      !!      
+      !!-----------------------------------------------------------------------
+
+      !! * Modules used
+      USE obs_surf_def  ! Definition of storage space for surface observations
+
+      IMPLICIT NONE
+
+      !! * Arguments
+      TYPE(obs_surf), INTENT(INOUT) :: &
+         & sstdatqc     ! Subset of surface data not failing screening
+      INTEGER, INTENT(IN) :: kt        ! Time step
+      INTEGER, INTENT(IN) :: kpi       ! Model grid parameters
+      INTEGER, INTENT(IN) :: kpj
+      INTEGER, INTENT(IN) :: kit000    ! Number of the first time step 
+                                       !   (kit000-1 = restart time)
+      INTEGER, INTENT(IN) :: k2dint    ! Horizontal interpolation type (see header)
+      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj) :: &
+         & psstn,  &    ! Model SST field
+         & psstmask     ! Land-sea mask
+         
+      !! * Local declarations
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jobs
+      INTEGER :: inrc
+      INTEGER :: isst
+      INTEGER :: iobs
+      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, &
+         & zsstl, &
+         & zglam, &
+         & zgphi
+      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
+         & igrdi, &
+         & igrdj
+
+      !-----------------------------------------------------------------------
+      ! Local initialization 
+      !-----------------------------------------------------------------------
+      ! ... Record and data counters
+      inrc = kt - kit000 + 2
+      isst = sstdatqc%nsstp(inrc)
+
+      ! Get the data for interpolation
+      
+      ALLOCATE( &
+         & igrdi(2,2,isst), &
+         & igrdj(2,2,isst), &
+         & zglam(2,2,isst), &
+         & zgphi(2,2,isst), &
+         & zmask(2,2,isst), &
+         & zsstl(2,2,isst)  &
+         & )
+      
+      DO jobs = sstdatqc%nsurfup + 1, sstdatqc%nsurfup + isst
+         iobs = jobs - sstdatqc%nsurfup
+         igrdi(1,1,iobs) = sstdatqc%mi(jobs)-1
+         igrdj(1,1,iobs) = sstdatqc%mj(jobs)-1
+         igrdi(1,2,iobs) = sstdatqc%mi(jobs)-1
+         igrdj(1,2,iobs) = sstdatqc%mj(jobs)
+         igrdi(2,1,iobs) = sstdatqc%mi(jobs)
+         igrdj(2,1,iobs) = sstdatqc%mj(jobs)-1
+         igrdi(2,2,iobs) = sstdatqc%mi(jobs)
+         igrdj(2,2,iobs) = sstdatqc%mj(jobs)
+      END DO
+      
+      CALL obs_int_comm_2d( 2, 2, isst, &
+         &                  igrdi, igrdj, glamt, zglam )
+      CALL obs_int_comm_2d( 2, 2, isst, &
+         &                  igrdi, igrdj, gphit, zgphi )
+      CALL obs_int_comm_2d( 2, 2, isst, &
+         &                  igrdi, igrdj, psstmask, zmask )
+      CALL obs_int_comm_2d( 2, 2, isst, &
+         &                  igrdi, igrdj, psstn, zsstl )
+      
+      ! Loop over observations
+
+      DO jobs = sstdatqc%nsurfup + 1, sstdatqc%nsurfup + isst
+         
+         iobs = jobs - sstdatqc%nsurfup
+         
+         IF ( kt /= sstdatqc%mstp(jobs) ) THEN
+            
+            IF(lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) ' E R R O R : Observation',              &
+                  &            ' time step is not consistent with the', &
+                  &            ' model time step'
+               WRITE(numout,*) ' ========='
+               WRITE(numout,*)
+               WRITE(numout,*) ' Record  = ', jobs,                &
+                  &            ' kt      = ', kt,                  &
+                  &            ' mstp    = ', sstdatqc%mstp(jobs), &
+                  &            ' ntyp    = ', sstdatqc%ntyp(jobs)
+            ENDIF
+            CALL ctl_stop( 'obs_sst_opt', 'Inconsistent time' )
+            
+         ENDIF
+         
+         zlam = sstdatqc%rlam(jobs)
+         zphi = sstdatqc%rphi(jobs)
+         
+         ! Get weights to interpolate the model SST to the observation point
+         CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         &
+            &                   zglam(:,:,iobs), zgphi(:,:,iobs), &
+            &                   zmask(:,:,iobs), zweig, zobsmask )
+            
+         ! Interpolate the model SST to the observation point 
+         CALL obs_int_h2d( 1, 1,      &
+            &              zweig, zsstl(:,:,iobs),  zext )
+         
+         sstdatqc%rmod(jobs,1) = zext(1)
+         
+      END DO
+      
+      ! Deallocate the data for interpolation
+      DEALLOCATE( &
+         & igrdi, &
+         & igrdj, &
+         & zglam, &
+         & zgphi, &
+         & zmask, &
+         & zsstl  &
+         & )
+      
+      sstdatqc%nsurfup = sstdatqc%nsurfup + isst
+
+   END SUBROUTINE obs_sst_opt
+
+   SUBROUTINE obs_sss_opt
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  ROUTINE obs_sss_opt  ***
+      !!
+      !! ** Purpose : Compute the model counterpart of sea surface salinity
+      !!              data by interpolating from the model grid to the 
+      !!              observation point.
+      !!
+      !! ** Method  : 
+      !!
+      !! ** Action  :
+      !!
+      !! History :
+      !!      ! ??-?? 
+      !!-----------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+   END SUBROUTINE obs_sss_opt
+
+   SUBROUTINE obs_seaice_opt( seaicedatqc, kt, kpi, kpj, kit000, &
+      &                    pseaicen, pseaicemask, k2dint )
+
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  ROUTINE obs_seaice_opt  ***
+      !!
+      !! ** Purpose : Compute the model counterpart of surface temperature
+      !!              data by interpolating from the model grid to the 
+      !!              observation point.
+      !!
+      !! ** Method  : Linearly interpolate to each observation point using 
+      !!              the model values at the corners of the surrounding grid box.
+      !!
+      !!    The now model sea ice is first computed at the obs (lon, lat) point.
+      !!
+      !!    Several horizontal interpolation schemes are available:
+      !!        - distance-weighted (great circle) (k2dint = 0)
+      !!        - distance-weighted (small angle)  (k2dint = 1)
+      !!        - bilinear (geographical grid)     (k2dint = 2)
+      !!        - bilinear (quadrilateral grid)    (k2dint = 3)
+      !!        - polynomial (quadrilateral grid)  (k2dint = 4)
+      !!
+      !!
+      !! ** Action  :
+      !!
+      !! History :
+      !!        !  07-07  (S. Ricci ) : Original
+      !!      
+      !!-----------------------------------------------------------------------
+
+      !! * Modules used
+      USE obs_surf_def  ! Definition of storage space for surface observations
+
+      IMPLICIT NONE
+
+      !! * Arguments
+      TYPE(obs_surf), INTENT(INOUT) :: seaicedatqc     ! Subset of surface data not failing screening
+      INTEGER, INTENT(IN) :: kt       ! Time step
+      INTEGER, INTENT(IN) :: kpi      ! Model grid parameters
+      INTEGER, INTENT(IN) :: kpj
+      INTEGER, INTENT(IN) :: kit000   ! Number of the first time step 
+                                      !   (kit000-1 = restart time)
+      INTEGER, INTENT(IN) :: k2dint   ! Horizontal interpolation type (see header)
+      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj) :: &
+         & pseaicen,  &    ! Model sea ice field
+         & pseaicemask     ! Land-sea mask
+         
+      !! * Local declarations
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jobs
+      INTEGER :: inrc
+      INTEGER :: iseaice
+      INTEGER :: iobs
+       
+      REAL(KIND=wp) :: zlam
+      REAL(KIND=wp) :: zphi
+      REAL(KIND=wp) :: zext(1), zobsmask(1)
+      REAL(kind=wp), DIMENSION(2,2,1) :: &
+         & zweig
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
+         & zmask, &
+         & zseaicel, &
+         & zglam, &
+         & zgphi
+      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
+         & igrdi, &
+         & igrdj
+
+      !------------------------------------------------------------------------
+      ! Local initialization 
+      !------------------------------------------------------------------------
+      ! ... Record and data counters
+      inrc = kt - kit000 + 2
+      iseaice = seaicedatqc%nsstp(inrc)
+
+      ! Get the data for interpolation
+      
+      ALLOCATE( &
+         & igrdi(2,2,iseaice), &
+         & igrdj(2,2,iseaice), &
+         & zglam(2,2,iseaice), &
+         & zgphi(2,2,iseaice), &
+         & zmask(2,2,iseaice), &
+         & zseaicel(2,2,iseaice)  &
+         & )
+      
+      DO jobs = seaicedatqc%nsurfup + 1, seaicedatqc%nsurfup + iseaice
+         iobs = jobs - seaicedatqc%nsurfup
+         igrdi(1,1,iobs) = seaicedatqc%mi(jobs)-1
+         igrdj(1,1,iobs) = seaicedatqc%mj(jobs)-1
+         igrdi(1,2,iobs) = seaicedatqc%mi(jobs)-1
+         igrdj(1,2,iobs) = seaicedatqc%mj(jobs)
+         igrdi(2,1,iobs) = seaicedatqc%mi(jobs)
+         igrdj(2,1,iobs) = seaicedatqc%mj(jobs)-1
+         igrdi(2,2,iobs) = seaicedatqc%mi(jobs)
+         igrdj(2,2,iobs) = seaicedatqc%mj(jobs)
+      END DO
+      
+      CALL obs_int_comm_2d( 2, 2, iseaice, &
+         &                  igrdi, igrdj, glamt, zglam )
+      CALL obs_int_comm_2d( 2, 2, iseaice, &
+         &                  igrdi, igrdj, gphit, zgphi )
+      CALL obs_int_comm_2d( 2, 2, iseaice, &
+         &                  igrdi, igrdj, pseaicemask, zmask )
+      CALL obs_int_comm_2d( 2, 2, iseaice, &
+         &                  igrdi, igrdj, pseaicen, zseaicel )
+      
+      DO jobs = seaicedatqc%nsurfup + 1, seaicedatqc%nsurfup + iseaice
+         
+         iobs = jobs - seaicedatqc%nsurfup
+         
+         IF ( kt /= seaicedatqc%mstp(jobs) ) THEN
+            
+            IF(lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) ' E R R O R : Observation',              &
+                  &            ' time step is not consistent with the', &
+                  &            ' model time step'
+               WRITE(numout,*) ' ========='
+               WRITE(numout,*)
+               WRITE(numout,*) ' Record  = ', jobs,                &
+                  &            ' kt      = ', kt,                  &
+                  &            ' mstp    = ', seaicedatqc%mstp(jobs), &
+                  &            ' ntyp    = ', seaicedatqc%ntyp(jobs)
+            ENDIF
+            CALL ctl_stop( 'obs_seaice_opt', 'Inconsistent time' )
+            
+         ENDIF
+         
+         zlam = seaicedatqc%rlam(jobs)
+         zphi = seaicedatqc%rphi(jobs)
+         
+         ! Get weights to interpolate the model sea ice to the observation point
+         CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         &
+            &                   zglam(:,:,iobs), zgphi(:,:,iobs), &
+            &                   zmask(:,:,iobs), zweig, zobsmask )
+         
+         ! ... Interpolate the model sea ice to the observation point
+         CALL obs_int_h2d( 1, 1,      &
+            &              zweig, zseaicel(:,:,iobs),  zext )
+         
+         seaicedatqc%rmod(jobs,1) = zext(1)
+         
+      END DO
+      
+      ! Deallocate the data for interpolation
+      DEALLOCATE( &
+         & igrdi,    &
+         & igrdj,    &
+         & zglam,    &
+         & zgphi,    &
+         & zmask,    &
+         & zseaicel  &
+         & )
+      
+      seaicedatqc%nsurfup = seaicedatqc%nsurfup + iseaice
+
+   END SUBROUTINE obs_seaice_opt
+
+   SUBROUTINE obs_vel_opt( prodatqc, kt, kpi, kpj, kpk, kit000, kdaystp, &
+      &                    pun, pvn, pgdept, pumask, pvmask, k1dint, k2dint, &
+      &                    ld_dailyav )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  ROUTINE obs_vel_opt  ***
+      !!
+      !! ** Purpose : Compute the model counterpart of velocity profile
+      !!              data by interpolating from the model grid to the 
+      !!              observation point.
+      !!
+      !! ** Method  : Linearly interpolate zonal and meridional components of velocity 
+      !!              to each observation point using the model values at the corners of 
+      !!              the surrounding grid box. The model velocity components are on a 
+      !!              staggered C- grid.
+      !!
+      !!    For velocity data from the TAO array, the model equivalent is
+      !!    a daily mean velocity field. So, we first compute
+      !!    the mean, then interpolate only at the end of the day.
+      !!
+      !! ** Action  :
+      !!
+      !! History :
+      !!    ! 07-03 (K. Mogensen)      : Temperature and Salinity profiles
+      !!    ! 08-10 (Maria Valdivieso) : Velocity component (U,V) profiles
+      !!-----------------------------------------------------------------------
+    
+      !! * Modules used
+      USE obs_profiles_def ! Definition of storage space for profile obs.
+
+      IMPLICIT NONE
+
+      !! * Arguments
+      TYPE(obs_prof), INTENT(INOUT) :: &
+         & prodatqc        ! Subset of profile data not failing screening
+      INTEGER, INTENT(IN) :: kt        ! Time step
+      INTEGER, INTENT(IN) :: kpi       ! Model grid parameters
+      INTEGER, INTENT(IN) :: kpj
+      INTEGER, INTENT(IN) :: kpk 
+      INTEGER, INTENT(IN) :: kit000    ! Number of the first time step 
+                                       !   (kit000-1 = restart time)
+      INTEGER, INTENT(IN) :: k1dint    ! Vertical interpolation type (see header)
+      INTEGER, INTENT(IN) :: k2dint    ! Horizontal interpolation type (see header)
+      INTEGER, INTENT(IN) :: kdaystp   ! Number of time steps per day                    
+      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: &
+         & pun,    &    ! Model zonal component of velocity
+         & pvn,    &    ! Model meridional component of velocity
+         & pumask, &    ! Land-sea mask
+         & pvmask       ! Land-sea mask
+      REAL(KIND=wp), INTENT(IN), DIMENSION(kpk) :: &
+         & pgdept       ! Model array of depth levels
+      LOGICAL, INTENT(IN) :: ld_dailyav
+         
+      !! * Local declarations
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jk
+      INTEGER :: jobs
+      INTEGER :: inrc
+      INTEGER :: ipro
+      INTEGER :: idayend
+      INTEGER :: ista
+      INTEGER :: iend
+      INTEGER :: iobs
+      INTEGER, DIMENSION(imaxavtypes) :: &
+         & idailyavtypes
+      REAL(KIND=wp) :: zlam
+      REAL(KIND=wp) :: zphi
+      REAL(KIND=wp) :: zdaystp
+      REAL(KIND=wp), DIMENSION(kpk) :: &
+         & zobsmask, &
+         & zobsk,    &
+         & zobs2k
+      REAL(KIND=wp), DIMENSION(2,2,kpk) :: &
+         & zweigu,zweigv
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: &
+         & zumask, zvmask, &
+         & zintu, &
+         & zintv, &
+         & zinmu, &
+         & zinmv
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
+         & zglamu, zglamv, &
+         & zgphiu, zgphiv
+      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
+         & igrdiu, &
+         & igrdju, &
+         & igrdiv, &
+         & igrdjv
+
+      !------------------------------------------------------------------------
+      ! Local initialization 
+      !------------------------------------------------------------------------
+      ! ... Record and data counters
+      inrc = kt - kit000 + 2
+      ipro = prodatqc%npstp(inrc)
+
+      ! Initialize daily mean for first timestep
+      idayend = MOD( kt - kit000 + 1, kdaystp )
+
+      ! Added kt == 0 test to catch restart case 
+      IF ( idayend == 1 .OR. kt == 0) THEN
+         IF (lwp) WRITE(numout,*) 'Reset prodatqc%vdmean on time-step: ',kt
+         prodatqc%vdmean(:,:,:,1) = 0.0
+         prodatqc%vdmean(:,:,:,2) = 0.0
+      ENDIF
+
+      ! Increment the zonal velocity field for computing daily mean
+      prodatqc%vdmean(:,:,:,1) = prodatqc%vdmean(:,:,:,1) + pun(:,:,:)
+      ! Increment the meridional velocity field for computing daily mean
+      prodatqc%vdmean(:,:,:,2) = prodatqc%vdmean(:,:,:,2) + pvn(:,:,:)
+   
+      ! Compute the daily mean at the end of day
+      zdaystp = 1.0 / REAL( kdaystp )
+      IF ( idayend == 0 ) THEN
+         prodatqc%vdmean(:,:,:,1) = prodatqc%vdmean(:,:,:,1) * zdaystp
+         prodatqc%vdmean(:,:,:,2) = prodatqc%vdmean(:,:,:,2) * zdaystp
+      ENDIF
+
+      ! Get the data for interpolation
+      ALLOCATE( &
+         & igrdiu(2,2,ipro),      &
+         & igrdju(2,2,ipro),      &
+         & igrdiv(2,2,ipro),      &
+         & igrdjv(2,2,ipro),      &
+         & zglamu(2,2,ipro), zglamv(2,2,ipro), &
+         & zgphiu(2,2,ipro), zgphiv(2,2,ipro), &
+         & zumask(2,2,kpk,ipro), zvmask(2,2,kpk,ipro), &
+         & zintu(2,2,kpk,ipro),  &
+         & zintv(2,2,kpk,ipro)   &
+         & )
+
+      DO jobs = prodatqc%nprofup + 1, prodatqc%nprofup + ipro
+         iobs = jobs - prodatqc%nprofup
+         igrdiu(1,1,iobs) = prodatqc%mi(jobs,1)-1
+         igrdju(1,1,iobs) = prodatqc%mj(jobs,1)-1
+         igrdiu(1,2,iobs) = prodatqc%mi(jobs,1)-1
+         igrdju(1,2,iobs) = prodatqc%mj(jobs,1)
+         igrdiu(2,1,iobs) = prodatqc%mi(jobs,1)
+         igrdju(2,1,iobs) = prodatqc%mj(jobs,1)-1
+         igrdiu(2,2,iobs) = prodatqc%mi(jobs,1)
+         igrdju(2,2,iobs) = prodatqc%mj(jobs,1)
+         igrdiv(1,1,iobs) = prodatqc%mi(jobs,2)-1
+         igrdjv(1,1,iobs) = prodatqc%mj(jobs,2)-1
+         igrdiv(1,2,iobs) = prodatqc%mi(jobs,2)-1
+         igrdjv(1,2,iobs) = prodatqc%mj(jobs,2)
+         igrdiv(2,1,iobs) = prodatqc%mi(jobs,2)
+         igrdjv(2,1,iobs) = prodatqc%mj(jobs,2)-1
+         igrdiv(2,2,iobs) = prodatqc%mi(jobs,2)
+         igrdjv(2,2,iobs) = prodatqc%mj(jobs,2)
+      END DO
+
+      CALL obs_int_comm_2d( 2, 2, ipro, igrdiu, igrdju, glamu, zglamu )
+      CALL obs_int_comm_2d( 2, 2, ipro, igrdiu, igrdju, gphiu, zgphiu )
+      CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdiu, igrdju, pumask, zumask )
+      CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdiu, igrdju, pun, zintu )
+
+      CALL obs_int_comm_2d( 2, 2, ipro, igrdiv, igrdjv, glamv, zglamv )
+      CALL obs_int_comm_2d( 2, 2, ipro, igrdiv, igrdjv, gphiv, zgphiv )
+      CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdiv, igrdjv, pvmask, zvmask )
+      CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdiv, igrdjv, pvn, zintv )
+
+      ! At the end of the day also get interpolated means
+      IF ( idayend == 0 ) THEN
+
+         ALLOCATE( &
+            & zinmu(2,2,kpk,ipro),  &
+            & zinmv(2,2,kpk,ipro)   &
+            & )
+
+         CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdiu, igrdju, &
+            &                  prodatqc%vdmean(:,:,:,1), zinmu )
+         CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdiv, igrdjv, &
+            &                  prodatqc%vdmean(:,:,:,2), zinmv )
+
+      ENDIF
+
+! loop over observations
+
+      DO jobs = prodatqc%nprofup + 1, prodatqc%nprofup + ipro
+
+         iobs = jobs - prodatqc%nprofup
+
+         IF ( kt /= prodatqc%mstp(jobs) ) THEN
+            
+            IF(lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) ' E R R O R : Observation',              &
+                  &            ' time step is not consistent with the', &
+                  &            ' model time step'
+               WRITE(numout,*) ' ========='
+               WRITE(numout,*)
+               WRITE(numout,*) ' Record  = ', jobs,                    &
+                  &            ' kt      = ', kt,                      &
+                  &            ' mstp    = ', prodatqc%mstp(jobs), &
+                  &            ' ntyp    = ', prodatqc%ntyp(jobs)
+            ENDIF
+            CALL ctl_stop( 'obs_pro_opt', 'Inconsistent time' )
+         ENDIF
+         
+         zlam = prodatqc%rlam(jobs)
+         zphi = prodatqc%rphi(jobs)
+
+         ! Horizontal weights and vertical mask
+
+         IF  ( prodatqc%npvend(jobs,1) > 0 ) THEN
+
+            CALL obs_int_h2d_init( kpk, kpk, k2dint, zlam, zphi,     &
+               &                   zglamu(:,:,iobs), zgphiu(:,:,iobs), &
+               &                   zumask(:,:,:,iobs), zweigu, zobsmask )
+
+         ENDIF
+
+         
+         IF ( prodatqc%npvend(jobs,2) > 0 ) THEN
+
+            CALL obs_int_h2d_init( kpk, kpk, k2dint, zlam, zphi,     &
+               &                   zglamv(:,:,iobs), zgphiv(:,:,iobs), &
+               &                   zvmask(:,:,:,iobs), zweigv, zobsmask )
+
+         ENDIF
+
+
+         IF ( prodatqc%npvend(jobs,1) > 0 ) THEN
+
+            zobsk(:) = obfillflt
+
+	    IF ( ld_dailyav ) THEN
+
+               IF ( idayend == 0 )  THEN
+                  
+                  ! Daily averaged data
+                  
+                  CALL obs_int_h2d( kpk, kpk,      &
+                     &              zweigu, zinmu(:,:,:,iobs), zobsk )
+                  
+                  
+               ELSE
+               
+                  CALL ctl_stop( ' A nonzero' //     &
+                     &           ' number of U profile data should' // &
+                     &           ' only occur at the end of a given day' )
+
+               ENDIF
+	       
+            ELSE 
+               
+               ! Point data
+
+               CALL obs_int_h2d( kpk, kpk,      &
+                  &              zweigu, zintu(:,:,:,iobs), zobsk )
+
+            ENDIF
+
+            !-------------------------------------------------------------
+            ! Compute vertical second-derivative of the interpolating 
+            ! polynomial at obs points
+            !-------------------------------------------------------------
+            
+            IF ( k1dint == 1 ) THEN
+               CALL obs_int_z1d_spl( kpk, zobsk, zobs2k,   &
+                  &                  pgdept, zobsmask )
+            ENDIF
+            
+            !-----------------------------------------------------------------
+            !  Vertical interpolation to the observation point
+            !-----------------------------------------------------------------
+            ista = prodatqc%npvsta(jobs,1)
+            iend = prodatqc%npvend(jobs,1)
+            CALL obs_int_z1d( kpk,                &
+               & prodatqc%var(1)%mvk(ista:iend),  &
+               & k1dint, iend - ista + 1,         &
+               & prodatqc%var(1)%vdep(ista:iend), &
+               & zobsk, zobs2k,                   &
+               & prodatqc%var(1)%vmod(ista:iend), &
+               & pgdept, zobsmask )
+
+         ENDIF
+
+         IF ( prodatqc%npvend(jobs,2) > 0 ) THEN
+
+            zobsk(:) = obfillflt
+
+            IF ( ld_dailyav ) THEN
+
+               IF ( idayend == 0 )  THEN
+
+                  ! Daily averaged data
+                  
+                  CALL obs_int_h2d( kpk, kpk,      &
+                     &              zweigv, zinmv(:,:,:,iobs), zobsk )
+                  
+               ELSE
+
+                  CALL ctl_stop( ' A nonzero' //     &
+                     &           ' number of V profile data should' // &
+                     &           ' only occur at the end of a given day' )
+
+               ENDIF
+
+            ELSE
+               
+               ! Point data
+
+               CALL obs_int_h2d( kpk, kpk,      &
+                  &              zweigv, zintv(:,:,:,iobs), zobsk )
+
+            ENDIF
+
+
+            !-------------------------------------------------------------
+            ! Compute vertical second-derivative of the interpolating 
+            ! polynomial at obs points
+            !-------------------------------------------------------------
+            
+            IF ( k1dint == 1 ) THEN
+               CALL obs_int_z1d_spl( kpk, zobsk, zobs2k, &
+                  &                  pgdept, zobsmask )
+            ENDIF
+            
+            !----------------------------------------------------------------
+            !  Vertical interpolation to the observation point
+            !----------------------------------------------------------------
+            ista = prodatqc%npvsta(jobs,2)
+            iend = prodatqc%npvend(jobs,2)
+            CALL obs_int_z1d( kpk, &
+               & prodatqc%var(2)%mvk(ista:iend),&
+               & k1dint, iend - ista + 1, &
+               & prodatqc%var(2)%vdep(ista:iend),&
+               & zobsk, zobs2k, &
+               & prodatqc%var(2)%vmod(ista:iend),&
+               & pgdept, zobsmask )
+
+         ENDIF
+
+      END DO
+ 
+      ! Deallocate the data for interpolation
+      DEALLOCATE( &
+         & igrdiu, &
+         & igrdju, &
+         & igrdiv, &
+         & igrdjv, &
+         & zglamu, zglamv, &
+         & zgphiu, zgphiv, &
+         & zumask, zvmask, &
+         & zintu, &
+         & zintv  &
+         & )
+      ! At the end of the day also get interpolated means
+      IF ( idayend == 0 ) THEN
+         DEALLOCATE( &
+            & zinmu,  &
+            & zinmv   &
+            & )
+      ENDIF
+
+      prodatqc%nprofup = prodatqc%nprofup + ipro 
+      
+   END SUBROUTINE obs_vel_opt
+
+END MODULE obs_oper
+
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90	(revision 2528)
@@ -0,0 +1,1971 @@
+MODULE obs_prep
+   !!=====================================================================
+   !!                       ***  MODULE  obs_prep  ***
+   !! Observation diagnostics: Prepare observation arrays: screening, 
+   !!                          sorting, coordinate search
+   !!=====================================================================
+
+   !!---------------------------------------------------------------------
+   !!   obs_pre_pro  : First level check and screening of T/S profiles
+   !!   obs_pre_sla  : First level check and screening of SLA observations
+   !!   obs_pre_sst  : First level check and screening of SLA observations
+   !!   obs_pre_seaice : First level check and screening of sea ice observations
+   !!   obs_pre_vel  : First level check and screening of velocity obs.
+   !!   obs_scr      : Basic screening of the observations
+   !!   obs_coo_tim  : Compute number of time steps to the observation time
+   !!   obs_sor      : Sort the observation arrays
+   !!---------------------------------------------------------------------
+   !! * Modules used
+   USE par_kind, ONLY : & ! Precision variables
+      & wp   
+   USE in_out_manager     ! I/O manager
+   USE obs_profiles_def   ! Definitions for storage arrays for profiles
+   USE obs_surf_def       ! Definitions for storage arrays for surface data
+   USE obs_mpp, ONLY : &  ! MPP support routines for observation diagnostics
+      & obs_mpp_sum_integer, &
+      & obs_mpp_sum_integers
+   USE obs_inter_sup      ! Interpolation support
+   USE obs_oper           ! Observation operators
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC &
+      & obs_pre_pro, &    ! First level check and screening of profiles
+      & obs_pre_sla, &    ! First level check and screening of SLA data
+      & obs_pre_sst, &    ! First level check and screening of SLA data
+      & obs_pre_seaice, & ! First level check and screening of sea ice data
+      & obs_pre_vel, &     ! First level check and screening of velocity profiles
+      & calc_month_len     ! Calculate the number of days in the months of a year  
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE obs_pre_pro( profdata, prodatqc, ld_t3d, ld_s3d, ld_nea, &
+      &                    kdailyavtypes )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_pre_pro  ***
+      !!
+      !! ** Purpose : First level check and screening of T and S profiles
+      !!
+      !! ** Method  : First level check and screening of T and S profiles
+      !!
+      !! ** Action  : 
+      !!
+      !! References :
+      !!   
+      !! History :
+      !!        !  2007-01  (K. Mogensen) Merge of obs_pre_t3d and obs_pre_s3d 
+      !!        !  2007-03  (K. Mogensen) General handling of profiles
+      !!        !  2007-06  (K. Mogensen et al) Reject obs. near land.
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE domstp              ! Domain: set the time-step
+      USE par_oce             ! Ocean parameters
+      USE dom_oce, ONLY : &   ! Geographical information
+         & glamt,   &
+         & gphit,   &
+         & gdept_0, &
+         & tmask,   &
+         & nproc
+      !! * Arguments
+      TYPE(obs_prof), INTENT(INOUT) :: profdata     ! Full set of profile data
+      TYPE(obs_prof), INTENT(INOUT) :: prodatqc     ! Subset of profile data not failing screening
+      LOGICAL, INTENT(IN) :: ld_t3d         ! Switch for temperature
+      LOGICAL, INTENT(IN) :: ld_s3d         ! Switch for salinity
+      LOGICAL, INTENT(IN) :: ld_nea         ! Switch for rejecting observation near land
+      INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: &
+         & kdailyavtypes! Types for daily averages
+      !! * Local declarations   
+      INTEGER :: iyea0         ! Initial date
+      INTEGER :: imon0         !  - (year, month, day, hour, minute)
+      INTEGER :: iday0   
+      INTEGER :: ihou0
+      INTEGER :: imin0
+      INTEGER :: icycle        ! Current assimilation cycle
+                               ! Counters for observations that
+      INTEGER :: iotdobs       !  - outside time domain
+      INTEGER :: iosdtobs      !  - outside space domain (temperature)
+      INTEGER :: iosdsobs      !  - outside space domain (salinity)
+      INTEGER :: ilantobs      !  - within a model land cell (temperature)
+      INTEGER :: ilansobs      !  - within a model land cell (salinity)
+      INTEGER :: inlatobs      !  - close to land (temperature)
+      INTEGER :: inlasobs      !  - close to land (salinity)
+      INTEGER :: igrdobs       !  - fail the grid search
+                               ! Global counters for observations that
+      INTEGER :: iotdobsmpp    !  - outside time domain
+      INTEGER :: iosdtobsmpp   !  - outside space domain (temperature)
+      INTEGER :: iosdsobsmpp   !  - outside space domain (salinity)
+      INTEGER :: ilantobsmpp   !  - within a model land cell (temperature)
+      INTEGER :: ilansobsmpp   !  - within a model land cell (salinity)
+      INTEGER :: inlatobsmpp   !  - close to land (temperature)
+      INTEGER :: inlasobsmpp   !  - close to land (salinity)
+      INTEGER :: igrdobsmpp    !  - fail the grid search
+      TYPE(obs_prof_valid) ::  llvalid     ! Profile selection 
+      TYPE(obs_prof_valid), DIMENSION(profdata%nvar) :: &
+         & llvvalid            ! T,S selection 
+      INTEGER :: jvar          ! Variable loop variable
+      INTEGER :: jobs          ! Obs. loop variable
+      INTEGER :: jstp          ! Time loop variable
+      INTEGER :: inrc          ! Time index variable
+      
+      IF(lwp) WRITE(numout,*)'obs_pre_pro : Preparing the profile observations...'
+
+      ! Initial date initialization (year, month, day, hour, minute)
+      iyea0 =   ndate0 / 10000
+      imon0 = ( ndate0 - iyea0 * 10000 ) / 100
+      iday0 =   ndate0 - iyea0 * 10000 - imon0 * 100
+      ihou0 = 0
+      imin0 = 0
+
+      icycle = no     ! Assimilation cycle
+
+      ! Diagnotics counters for various failures.
+
+      iotdobs  = 0
+      igrdobs  = 0
+      iosdtobs = 0
+      iosdsobs = 0
+      ilantobs = 0
+      ilansobs = 0
+      inlatobs = 0
+      inlasobs = 0
+
+      ! -----------------------------------------------------------------------
+      ! Find time coordinate for profiles
+      ! -----------------------------------------------------------------------
+
+      IF ( PRESENT(kdailyavtypes) ) THEN
+         CALL obs_coo_tim_prof( icycle, &
+            &                iyea0,   imon0,   iday0,   ihou0,   imin0,      &
+            &                profdata%nprof,   profdata%nyea, profdata%nmon, &
+            &                profdata%nday,    profdata%nhou, profdata%nmin, &
+            &                profdata%ntyp,    profdata%nqc,  profdata%mstp, &
+            &                iotdobs, kdailyavtypes = kdailyavtypes        )
+      ELSE
+         CALL obs_coo_tim_prof( icycle, &
+            &                iyea0,   imon0,   iday0,   ihou0,   imin0,      &
+            &                profdata%nprof,   profdata%nyea, profdata%nmon, &
+            &                profdata%nday,    profdata%nhou, profdata%nmin, &
+            &                profdata%ntyp,    profdata%nqc,  profdata%mstp, &
+            &                iotdobs )
+      ENDIF
+      CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp )
+      
+      ! -----------------------------------------------------------------------
+      ! Check for profiles failing the grid search
+      ! -----------------------------------------------------------------------
+
+      CALL obs_coo_grd( profdata%nprof,   profdata%mi, profdata%mj, &
+         &              profdata%nqc,     igrdobs                         )
+
+      CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp )
+
+      ! -----------------------------------------------------------------------
+      ! Reject all observations for profiles with nqc > 10
+      ! -----------------------------------------------------------------------
+
+      CALL obs_pro_rej( profdata )
+
+      ! -----------------------------------------------------------------------
+      ! Check for land points. This includes points below the model
+      ! bathymetry so this is done for every point in the profile
+      ! -----------------------------------------------------------------------
+
+      ! Temperature
+
+      CALL obs_coo_spc_3d( profdata%nprof,        profdata%nvprot(1),   &
+         &                 profdata%npvsta(:,1),  profdata%npvend(:,1), &
+         &                 jpi,                   jpj,                  &
+         &                 jpk,                                         &
+         &                 profdata%mi,           profdata%mj,          & 
+         &                 profdata%var(1)%mvk,                         &
+         &                 profdata%rlam,         profdata%rphi,        &
+         &                 profdata%var(1)%vdep,                        &
+         &                 glamt,                 gphit,                &
+         &                 gdept_0,               tmask,                &
+         &                 profdata%nqc,          profdata%var(1)%nvqc, &
+         &                 iosdtobs,              ilantobs,             &
+         &                 inlatobs,              ld_nea                )
+
+      CALL obs_mpp_sum_integer( iosdtobs, iosdtobsmpp )
+      CALL obs_mpp_sum_integer( ilantobs, ilantobsmpp )
+      CALL obs_mpp_sum_integer( inlatobs, inlatobsmpp )
+
+      ! Salinity
+
+      CALL obs_coo_spc_3d( profdata%nprof,        profdata%nvprot(2),   &
+         &                 profdata%npvsta(:,2),  profdata%npvend(:,2), &
+         &                 jpi,                   jpj,                  &
+         &                 jpk,                                         &
+         &                 profdata%mi,           profdata%mj,          & 
+         &                 profdata%var(2)%mvk,                         &
+         &                 profdata%rlam,         profdata%rphi,        &
+         &                 profdata%var(2)%vdep,                        &
+         &                 glamt,                 gphit,                &
+         &                 gdept_0,               tmask,                &
+         &                 profdata%nqc,          profdata%var(2)%nvqc, &
+         &                 iosdsobs,              ilansobs,             &
+         &                 inlasobs,              ld_nea                )
+
+      CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp )
+      CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp )
+      CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp )
+
+      ! -----------------------------------------------------------------------
+      ! Copy useful data from the profdata data structure to
+      ! the prodatqc data structure 
+      ! -----------------------------------------------------------------------
+
+      ! Allocate the selection arrays
+
+      ALLOCATE( llvalid%luse(profdata%nprof) )
+      DO jvar = 1,profdata%nvar
+         ALLOCATE( llvvalid(jvar)%luse(profdata%nvprot(jvar)) )
+      END DO
+
+      ! We want all data which has qc flags <= 10
+
+      llvalid%luse(:) = ( profdata%nqc(:)  <= 10 )
+      DO jvar = 1,profdata%nvar
+         llvvalid(jvar)%luse(:) = ( profdata%var(jvar)%nvqc(:) <= 10 )
+      END DO
+
+      ! The actual copying
+
+      CALL obs_prof_compress( profdata,     prodatqc,       .TRUE.,  numout, &
+         &                    lvalid=llvalid, lvvalid=llvvalid )
+
+      ! Dellocate the selection arrays
+      DEALLOCATE( llvalid%luse )
+      DO jvar = 1,profdata%nvar
+         DEALLOCATE( llvvalid(jvar)%luse )
+      END DO
+
+      ! -----------------------------------------------------------------------
+      ! Print information about what observations are left after qc
+      ! -----------------------------------------------------------------------
+
+      ! Update the total observation counter array
+      
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'obs_pre_pro :'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*)
+         WRITE(numout,*) ' Profiles outside time domain                = ', &
+            &            iotdobsmpp
+         WRITE(numout,*) ' Remaining profiles that failed grid search  = ', &
+            &            igrdobsmpp
+         WRITE(numout,*) ' Remaining T data outside space domain       = ', &
+            &            iosdtobsmpp
+         WRITE(numout,*) ' Remaining T data at land points             = ', &
+            &            ilantobsmpp
+         IF (ld_nea) THEN
+            WRITE(numout,*) ' Remaining T data near land points (removed) = ',&
+               &            inlatobsmpp
+         ELSE
+            WRITE(numout,*) ' Remaining T data near land points (kept)    = ',&
+               &            inlatobsmpp
+         ENDIF
+         WRITE(numout,*) ' T data accepted                             = ', &
+            &            prodatqc%nvprotmpp(1)
+         WRITE(numout,*) ' Remaining S data outside space domain       = ', &
+            &            iosdsobsmpp
+         WRITE(numout,*) ' Remaining S data at land points             = ', &
+            &            ilansobsmpp
+         IF (ld_nea) THEN
+            WRITE(numout,*) ' Remaining S data near land points (removed) = ',&
+               &            inlasobsmpp
+         ELSE
+            WRITE(numout,*) ' Remaining S data near land points (kept)    = ',&
+               &            inlasobsmpp
+         ENDIF
+         WRITE(numout,*) ' S data accepted                             = ', &
+            &            prodatqc%nvprotmpp(2)
+
+         WRITE(numout,*)
+         WRITE(numout,*) ' Number of observations per time step :'
+         WRITE(numout,*)
+         WRITE(numout,997)
+         WRITE(numout,998)
+      ENDIF
+      
+      DO jobs = 1, prodatqc%nprof
+         inrc = prodatqc%mstp(jobs) + 2 - nit000
+         prodatqc%npstp(inrc)  = prodatqc%npstp(inrc) + 1
+         DO jvar = 1, prodatqc%nvar
+            IF ( prodatqc%npvend(jobs,jvar) > 0 ) THEN
+               prodatqc%nvstp(inrc,jvar) = prodatqc%nvstp(inrc,jvar) + &
+                  &                      ( prodatqc%npvend(jobs,jvar) - &
+                  &                        prodatqc%npvsta(jobs,jvar) + 1 )
+            ENDIF
+         END DO
+      END DO
+      
+      
+      CALL obs_mpp_sum_integers( prodatqc%npstp, prodatqc%npstpmpp, &
+         &                       nitend - nit000 + 2 )
+      DO jvar = 1, prodatqc%nvar
+         CALL obs_mpp_sum_integers( prodatqc%nvstp(:,jvar), &
+            &                       prodatqc%nvstpmpp(:,jvar), &
+            &                       nitend - nit000 + 2 )
+      END DO
+
+      IF ( lwp ) THEN
+         DO jstp = nit000 - 1, nitend
+            inrc = jstp - nit000 + 2
+            WRITE(numout,999) jstp, prodatqc%npstpmpp(inrc), &
+               &                    prodatqc%nvstpmpp(inrc,1), &
+               &                    prodatqc%nvstpmpp(inrc,2)
+         END DO
+      ENDIF
+
+997   FORMAT(10X,'Time step',5X,'Profiles',5X,'Temperature',5X,'Salinity')
+998   FORMAT(10X,'---------',5X,'--------',5X,'-----------',5X,'--------')
+999   FORMAT(10X,I9,5X,I8,5X,I11,5X,I8)
+      
+   END SUBROUTINE obs_pre_pro
+
+   SUBROUTINE obs_pre_sla( sladata, sladatqc, ld_sla, ld_nea )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_pre_sla  ***
+      !!
+      !! ** Purpose : First level check and screening of SLA observations
+      !!
+      !! ** Method  : First level check and screening of SLA observations
+      !!
+      !! ** Action  : 
+      !!
+      !! References :
+      !!   
+      !! History :
+      !!        !  2007-03  (A. Weaver, K. Mogensen) Original
+      !!        !  2007-06  (K. Mogensen et al) Reject obs. near land.
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE domstp              ! Domain: set the time-step
+      USE par_oce             ! Ocean parameters
+      USE dom_oce, ONLY : &   ! Geographical information
+         & glamt,   &
+         & gphit,   &
+         & tmask,   &
+         & nproc
+      !! * Arguments
+      TYPE(obs_surf), INTENT(INOUT) :: sladata    ! Full set of SLA data
+      TYPE(obs_surf), INTENT(INOUT) :: sladatqc   ! Subset of SLA data not failing screening
+      LOGICAL, INTENT(IN) :: ld_sla         ! Switch for SLA data
+      LOGICAL, INTENT(IN) :: ld_nea         ! Switch for rejecting observation near land
+      !! * Local declarations
+      INTEGER :: iyea0        ! Initial date
+      INTEGER :: imon0        !  - (year, month, day, hour, minute)
+      INTEGER :: iday0    
+      INTEGER :: ihou0    
+      INTEGER :: imin0
+      INTEGER :: icycle       ! Current assimilation cycle
+                              ! Counters for observations that
+      INTEGER :: iotdobs      !  - outside time domain
+      INTEGER :: iosdsobs     !  - outside space domain
+      INTEGER :: ilansobs     !  - within a model land cell
+      INTEGER :: inlasobs     !  - close to land
+      INTEGER :: igrdobs      !  - fail the grid search
+                              ! Global counters for observations that
+      INTEGER :: iotdobsmpp     !  - outside time domain
+      INTEGER :: iosdsobsmpp    !  - outside space domain
+      INTEGER :: ilansobsmpp    !  - within a model land cell
+      INTEGER :: inlasobsmpp    !  - close to land
+      INTEGER :: igrdobsmpp     !  - fail the grid search
+      LOGICAL, DIMENSION(:), ALLOCATABLE :: & 
+         & llvalid            ! SLA data selection
+      INTEGER :: jobs         ! Obs. loop variable
+      INTEGER :: jstp         ! Time loop variable
+      INTEGER :: inrc         ! Time index variable
+
+      IF(lwp) WRITE(numout,*)'obs_pre_sla : Preparing the SLA observations...'
+
+      ! Initial date initialization (year, month, day, hour, minute)
+      iyea0 =   ndate0 / 10000
+      imon0 = ( ndate0 - iyea0 * 10000 ) / 100
+      iday0 =   ndate0 - iyea0 * 10000 - imon0 * 100
+      ihou0 = 0
+      imin0 = 0
+
+      icycle = no     ! Assimilation cycle
+
+      ! Diagnotics counters for various failures.
+
+      iotdobs  = 0
+      igrdobs  = 0
+      iosdsobs = 0
+      ilansobs = 0
+      inlasobs = 0
+
+      ! -----------------------------------------------------------------------
+      ! Find time coordinate for SLA data
+      ! -----------------------------------------------------------------------
+
+      CALL obs_coo_tim( icycle, &
+         &              iyea0,   imon0,   iday0,   ihou0,   imin0,      &
+         &              sladata%nsurf,   sladata%nyea, sladata%nmon, &
+         &              sladata%nday,    sladata%nhou, sladata%nmin, &
+         &              sladata%nqc,     sladata%mstp, iotdobs        )
+
+      CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp )
+      
+      ! -----------------------------------------------------------------------
+      ! Check for SLA data failing the grid search
+      ! -----------------------------------------------------------------------
+
+      CALL obs_coo_grd( sladata%nsurf,   sladata%mi, sladata%mj, &
+         &              sladata%nqc,     igrdobs                         )
+
+      CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp )
+
+      ! -----------------------------------------------------------------------
+      ! Check for land points. 
+      ! -----------------------------------------------------------------------
+
+      CALL obs_coo_spc_2d( sladata%nsurf,              &
+         &                 jpi,          jpj,          &
+         &                 sladata%mi,   sladata%mj,   & 
+         &                 sladata%rlam, sladata%rphi, &
+         &                 glamt,        gphit,        &
+         &                 tmask(:,:,1), sladata%nqc,  &
+         &                 iosdsobs,     ilansobs,     &
+         &                 inlasobs,     ld_nea        )
+
+      CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp )
+      CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp )
+      CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp )
+
+      ! -----------------------------------------------------------------------
+      ! Copy useful data from the sladata data structure to
+      ! the sladatqc data structure 
+      ! -----------------------------------------------------------------------
+
+      ! Allocate the selection arrays
+
+      ALLOCATE( llvalid(sladata%nsurf) )
+      
+      ! We want all data which has qc flags <= 10
+
+      llvalid(:)  = ( sladata%nqc(:)  <= 10 )
+
+      ! The actual copying
+
+      CALL obs_surf_compress( sladata,     sladatqc,       .TRUE.,  numout, &
+         &                    lvalid=llvalid )
+
+      ! Dellocate the selection arrays
+      DEALLOCATE( llvalid )
+
+      ! -----------------------------------------------------------------------
+      ! Print information about what observations are left after qc
+      ! -----------------------------------------------------------------------
+
+      ! Update the total observation counter array
+      
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'obs_pre_sla :'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*)
+         WRITE(numout,*) ' SLA data outside time domain                  = ', &
+            &            iotdobsmpp
+         WRITE(numout,*) ' Remaining SLA data that failed grid search    = ', &
+            &            igrdobsmpp
+         WRITE(numout,*) ' Remaining SLA data outside space domain       = ', &
+            &            iosdsobsmpp
+         WRITE(numout,*) ' Remaining SLA data at land points             = ', &
+            &            ilansobsmpp
+         IF (ld_nea) THEN
+            WRITE(numout,*) ' Remaining SLA data near land points (removed) = ', &
+               &            inlasobsmpp
+         ELSE
+            WRITE(numout,*) ' Remaining SLA data near land points (kept)    = ', &
+               &            inlasobsmpp
+         ENDIF
+         WRITE(numout,*) ' SLA data accepted                             = ', &
+            &            sladatqc%nsurfmpp
+
+         WRITE(numout,*)
+         WRITE(numout,*) ' Number of observations per time step :'
+         WRITE(numout,*)
+         WRITE(numout,1997)
+         WRITE(numout,1998)
+      ENDIF
+      
+      DO jobs = 1, sladatqc%nsurf
+         inrc = sladatqc%mstp(jobs) + 2 - nit000
+         sladatqc%nsstp(inrc)  = sladatqc%nsstp(inrc) + 1
+      END DO
+      
+      CALL obs_mpp_sum_integers( sladatqc%nsstp, sladatqc%nsstpmpp, &
+         &                       nitend - nit000 + 2 )
+
+      IF ( lwp ) THEN
+         DO jstp = nit000 - 1, nitend
+            inrc = jstp - nit000 + 2
+            WRITE(numout,1999) jstp, sladatqc%nsstpmpp(inrc)
+         END DO
+      ENDIF
+
+1997  FORMAT(10X,'Time step',5X,'Sea level anomaly')
+1998  FORMAT(10X,'---------',5X,'-----------------')
+1999  FORMAT(10X,I9,5X,I17)
+
+   END SUBROUTINE obs_pre_sla
+
+   SUBROUTINE obs_pre_sst( sstdata, sstdatqc, ld_sst, ld_nea )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_pre_sst  ***
+      !!
+      !! ** Purpose : First level check and screening of SST observations
+      !!
+      !! ** Method  : First level check and screening of SST observations
+      !!
+      !! ** Action  : 
+      !!
+      !! References :
+      !!   
+      !! History :
+      !!        !  2007-03  (S. Ricci) SST data preparation 
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE domstp              ! Domain: set the time-step
+      USE par_oce             ! Ocean parameters
+      USE dom_oce, ONLY : &   ! Geographical information
+         & glamt,   &
+         & gphit,   &
+         & tmask,   &
+         & nproc
+      !! * Arguments
+      TYPE(obs_surf), INTENT(INOUT) :: sstdata     ! Full set of SST data
+      TYPE(obs_surf), INTENT(INOUT) :: sstdatqc    ! Subset of SST data not failing screening
+      LOGICAL :: ld_sst             ! Switch for SST data
+      LOGICAL :: ld_nea             ! Switch for rejecting observation near land
+      !! * Local declarations
+      INTEGER :: iyea0        ! Initial date
+      INTEGER :: imon0        !  - (year, month, day, hour, minute)
+      INTEGER :: iday0   
+      INTEGER :: ihou0    
+      INTEGER :: imin0
+      INTEGER :: icycle       ! Current assimilation cycle
+                              ! Counters for observations that
+      INTEGER :: iotdobs      !  - outside time domain
+      INTEGER :: iosdsobs     !  - outside space domain
+      INTEGER :: ilansobs     !  - within a model land cell
+      INTEGER :: inlasobs     !  - close to land
+      INTEGER :: igrdobs      !  - fail the grid search
+                              ! Global counters for observations that
+      INTEGER :: iotdobsmpp   !  - outside time domain
+      INTEGER :: iosdsobsmpp  !  - outside space domain
+      INTEGER :: ilansobsmpp  !  - within a model land cell
+      INTEGER :: inlasobsmpp  !  - close to land
+      INTEGER :: igrdobsmpp   !  - fail the grid search
+      LOGICAL, DIMENSION(:), ALLOCATABLE :: & 
+         & llvalid            ! SST data selection
+      INTEGER :: jobs         ! Obs. loop variable
+      INTEGER :: jstp         ! Time loop variable
+      INTEGER :: inrc         ! Time index variable
+
+      IF(lwp) WRITE(numout,*)'obs_pre_sst : Preparing the SST observations...'
+
+      ! Initial date initialization (year, month, day, hour, minute)
+      iyea0 =   ndate0 / 10000
+      imon0 = ( ndate0 - iyea0 * 10000 ) / 100
+      iday0 =   ndate0 - iyea0 * 10000 - imon0 * 100
+      ihou0 = 0
+      imin0 = 0
+
+      icycle = no     ! Assimilation cycle
+
+      ! Diagnotics counters for various failures.
+
+      iotdobs  = 0
+      igrdobs  = 0
+      iosdsobs = 0
+      ilansobs = 0
+      inlasobs = 0
+
+      ! -----------------------------------------------------------------------
+      ! Find time coordinate for SST data
+      ! -----------------------------------------------------------------------
+
+      CALL obs_coo_tim( icycle, &
+         &              iyea0,   imon0,   iday0,   ihou0,   imin0,      &
+         &              sstdata%nsurf,   sstdata%nyea, sstdata%nmon, &
+         &              sstdata%nday,    sstdata%nhou, sstdata%nmin, &
+         &              sstdata%nqc,     sstdata%mstp, iotdobs        )
+      CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp )
+      ! -----------------------------------------------------------------------
+      ! Check for SST data failing the grid search
+      ! -----------------------------------------------------------------------
+
+      CALL obs_coo_grd( sstdata%nsurf,   sstdata%mi, sstdata%mj, &
+         &              sstdata%nqc,     igrdobs                         )
+      CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp )
+
+      ! -----------------------------------------------------------------------
+      ! Check for land points. 
+      ! -----------------------------------------------------------------------
+
+      CALL obs_coo_spc_2d( sstdata%nsurf,              &
+         &                 jpi,          jpj,          &
+         &                 sstdata%mi,   sstdata%mj,   & 
+         &                 sstdata%rlam, sstdata%rphi, &
+         &                 glamt,        gphit,        &
+         &                 tmask(:,:,1), sstdata%nqc,  &
+         &                 iosdsobs,     ilansobs,     &
+         &                 inlasobs,     ld_nea        )
+
+      CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp )
+      CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp )
+      CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp )
+
+      ! -----------------------------------------------------------------------
+      ! Copy useful data from the sstdata data structure to
+      ! the sstdatqc data structure 
+      ! -----------------------------------------------------------------------
+
+      ! Allocate the selection arrays
+
+      ALLOCATE( llvalid(sstdata%nsurf) )
+      
+      ! We want all data which has qc flags <= 0
+
+      llvalid(:)  = ( sstdata%nqc(:)  <= 10 )
+
+      ! The actual copying
+
+      CALL obs_surf_compress( sstdata,     sstdatqc,       .TRUE.,  numout, &
+         &                    lvalid=llvalid )
+
+      ! Dellocate the selection arrays
+      DEALLOCATE( llvalid )
+
+      ! -----------------------------------------------------------------------
+      ! Print information about what observations are left after qc
+      ! -----------------------------------------------------------------------
+
+      ! Update the total observation counter array
+      
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'obs_pre_sst :'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*)
+         WRITE(numout,*) ' SST data outside time domain                  = ', &
+            &            iotdobsmpp
+         WRITE(numout,*) ' Remaining SST data that failed grid search    = ', &
+            &            igrdobsmpp
+         WRITE(numout,*) ' Remaining SST data outside space domain       = ', &
+            &            iosdsobsmpp
+         WRITE(numout,*) ' Remaining SST data at land points             = ', &
+            &            ilansobsmpp
+         IF (ld_nea) THEN
+            WRITE(numout,*) ' Remaining SST data near land points (removed) = ', &
+               &            inlasobsmpp
+         ELSE
+            WRITE(numout,*) ' Remaining SST data near land points (kept)    = ', &
+               &            inlasobsmpp
+         ENDIF
+         WRITE(numout,*) ' SST data accepted                             = ', &
+            &            sstdatqc%nsurfmpp
+
+         WRITE(numout,*)
+         WRITE(numout,*) ' Number of observations per time step :'
+         WRITE(numout,*)
+         WRITE(numout,1997)
+         WRITE(numout,1998)
+      ENDIF
+      
+      DO jobs = 1, sstdatqc%nsurf
+         inrc = sstdatqc%mstp(jobs) + 2 - nit000
+         sstdatqc%nsstp(inrc)  = sstdatqc%nsstp(inrc) + 1
+      END DO
+      
+      CALL obs_mpp_sum_integers( sstdatqc%nsstp, sstdatqc%nsstpmpp, &
+         &                       nitend - nit000 + 2 )
+
+      IF ( lwp ) THEN
+         DO jstp = nit000 - 1, nitend
+            inrc = jstp - nit000 + 2
+            WRITE(numout,1999) jstp, sstdatqc%nsstpmpp(inrc)
+         END DO
+      ENDIF
+
+1997  FORMAT(10X,'Time step',5X,'Sea surface temperature')
+1998  FORMAT(10X,'---------',5X,'-----------------')
+1999  FORMAT(10X,I9,5X,I17)
+      
+   END SUBROUTINE obs_pre_sst
+
+   SUBROUTINE obs_pre_seaice( seaicedata, seaicedatqc, ld_seaice, ld_nea )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_pre_seaice  ***
+      !!
+      !! ** Purpose : First level check and screening of Sea Ice observations
+      !!
+      !! ** Method  : First level check and screening of Sea Ice observations
+      !!
+      !! ** Action  : 
+      !!
+      !! References :
+      !!   
+      !! History :
+      !!        !  2007-11 (D. Lea) based on obs_pre_sst
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE domstp              ! Domain: set the time-step
+      USE par_oce             ! Ocean parameters
+      USE dom_oce, ONLY : &   ! Geographical information
+         & glamt,   &
+         & gphit,   &
+         & tmask,   &
+         & nproc
+      !! * Arguments
+      TYPE(obs_surf), INTENT(INOUT) :: seaicedata     ! Full set of Sea Ice data
+      TYPE(obs_surf), INTENT(INOUT) :: seaicedatqc    ! Subset of sea ice data not failing screening
+      LOGICAL :: ld_seaice     ! Switch for sea ice data
+      LOGICAL :: ld_nea        ! Switch for rejecting observation near land
+      !! * Local declarations
+      INTEGER :: iyea0         ! Initial date
+      INTEGER :: imon0         !  - (year, month, day, hour, minute)
+      INTEGER :: iday0    
+      INTEGER :: ihou0    
+      INTEGER :: imin0
+      INTEGER :: icycle       ! Current assimilation cycle
+                              ! Counters for observations that
+      INTEGER :: iotdobs      !  - outside time domain
+      INTEGER :: iosdsobs     !  - outside space domain
+      INTEGER :: ilansobs     !  - within a model land cell
+      INTEGER :: inlasobs     !  - close to land
+      INTEGER :: igrdobs      !  - fail the grid search
+                              ! Global counters for observations that
+      INTEGER :: iotdobsmpp   !  - outside time domain
+      INTEGER :: iosdsobsmpp  !  - outside space domain
+      INTEGER :: ilansobsmpp  !  - within a model land cell
+      INTEGER :: inlasobsmpp  !  - close to land
+      INTEGER :: igrdobsmpp   !  - fail the grid search
+      LOGICAL, DIMENSION(:), ALLOCATABLE :: & 
+         & llvalid            ! data selection
+      INTEGER :: jobs         ! Obs. loop variable
+      INTEGER :: jstp         ! Time loop variable
+      INTEGER :: inrc         ! Time index variable
+
+      IF (lwp) WRITE(numout,*)'obs_pre_seaice : Preparing the sea ice observations...'
+
+      ! Initial date initialization (year, month, day, hour, minute)
+      iyea0 =   ndate0 / 10000
+      imon0 = ( ndate0 - iyea0 * 10000 ) / 100
+      iday0 =   ndate0 - iyea0 * 10000 - imon0 * 100
+      ihou0 = 0
+      imin0 = 0
+
+      icycle = no     ! Assimilation cycle
+
+      ! Diagnotics counters for various failures.
+
+      iotdobs  = 0
+      igrdobs  = 0
+      iosdsobs = 0
+      ilansobs = 0
+      inlasobs = 0
+
+      ! -----------------------------------------------------------------------
+      ! Find time coordinate for sea ice data
+      ! -----------------------------------------------------------------------
+
+      CALL obs_coo_tim( icycle, &
+         &              iyea0,   imon0,   iday0,   ihou0,   imin0,      &
+         &              seaicedata%nsurf,   seaicedata%nyea, seaicedata%nmon, &
+         &              seaicedata%nday,    seaicedata%nhou, seaicedata%nmin, &
+         &              seaicedata%nqc,     seaicedata%mstp, iotdobs        )
+      CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp )
+      ! -----------------------------------------------------------------------
+      ! Check for sea ice data failing the grid search
+      ! -----------------------------------------------------------------------
+
+      CALL obs_coo_grd( seaicedata%nsurf,   seaicedata%mi, seaicedata%mj, &
+         &              seaicedata%nqc,     igrdobs                         )
+      CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp )
+
+      ! -----------------------------------------------------------------------
+      ! Check for land points. 
+      ! -----------------------------------------------------------------------
+
+      CALL obs_coo_spc_2d( seaicedata%nsurf,                 &
+         &                 jpi,             jpj,             &
+         &                 seaicedata%mi,   seaicedata%mj,   & 
+         &                 seaicedata%rlam, seaicedata%rphi, &
+         &                 glamt,           gphit,           &
+         &                 tmask(:,:,1),    seaicedata%nqc,  &
+         &                 iosdsobs,        ilansobs,        &
+         &                 inlasobs,        ld_nea           )
+
+      CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp )
+      CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp )
+      CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp )
+
+      ! -----------------------------------------------------------------------
+      ! Copy useful data from the seaicedata data structure to
+      ! the seaicedatqc data structure 
+      ! -----------------------------------------------------------------------
+
+      ! Allocate the selection arrays
+
+      ALLOCATE( llvalid(seaicedata%nsurf) )
+      
+      ! We want all data which has qc flags <= 0
+
+      llvalid(:)  = ( seaicedata%nqc(:)  <= 10 )
+
+      ! The actual copying
+
+      CALL obs_surf_compress( seaicedata,     seaicedatqc,       .TRUE.,  numout, &
+         &                    lvalid=llvalid )
+
+      ! Dellocate the selection arrays
+      DEALLOCATE( llvalid )
+
+      ! -----------------------------------------------------------------------
+      ! Print information about what observations are left after qc
+      ! -----------------------------------------------------------------------
+
+      ! Update the total observation counter array
+      
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'obs_pre_seaice :'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*)
+         WRITE(numout,*) ' Sea ice data outside time domain                  = ', &
+            &            iotdobsmpp
+         WRITE(numout,*) ' Remaining sea ice data that failed grid search    = ', &
+            &            igrdobsmpp
+         WRITE(numout,*) ' Remaining sea ice data outside space domain       = ', &
+            &            iosdsobsmpp
+         WRITE(numout,*) ' Remaining sea ice data at land points             = ', &
+            &            ilansobsmpp
+         IF (ld_nea) THEN
+            WRITE(numout,*) ' Remaining sea ice data near land points (removed) = ', &
+               &            inlasobsmpp
+         ELSE
+            WRITE(numout,*) ' Remaining sea ice data near land points (kept)    = ', &
+               &            inlasobsmpp
+         ENDIF
+         WRITE(numout,*) ' Sea ice data accepted                             = ', &
+            &            seaicedatqc%nsurfmpp
+
+         WRITE(numout,*)
+         WRITE(numout,*) ' Number of observations per time step :'
+         WRITE(numout,*)
+         WRITE(numout,1997)
+         WRITE(numout,1998)
+      ENDIF
+      
+      DO jobs = 1, seaicedatqc%nsurf
+         inrc = seaicedatqc%mstp(jobs) + 2 - nit000
+         seaicedatqc%nsstp(inrc)  = seaicedatqc%nsstp(inrc) + 1
+      END DO
+      
+      CALL obs_mpp_sum_integers( seaicedatqc%nsstp, seaicedatqc%nsstpmpp, &
+         &                       nitend - nit000 + 2 )
+
+      IF ( lwp ) THEN
+         DO jstp = nit000 - 1, nitend
+            inrc = jstp - nit000 + 2
+            WRITE(numout,1999) jstp, seaicedatqc%nsstpmpp(inrc)
+         END DO
+      ENDIF
+
+1997  FORMAT(10X,'Time step',5X,'Sea ice data           ')
+1998  FORMAT(10X,'---------',5X,'-----------------')
+1999  FORMAT(10X,I9,5X,I17)
+      
+   END SUBROUTINE obs_pre_seaice
+
+   SUBROUTINE obs_pre_vel( profdata, prodatqc, ld_vel3d, ld_nea, ld_dailyav )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_pre_taovel  ***
+      !!
+      !! ** Purpose : First level check and screening of U and V profiles
+      !!
+      !! ** Method  : First level check and screening of U and V profiles
+      !!
+      !! History :
+      !!        !  2007-06  (K. Mogensen) original : T and S profile data
+      !!        !  2008-09  (M. Valdivieso) : TAO velocity data
+      !!        !  2009-01  (K. Mogensen) : New feedback strictuer
+      !!
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE domstp              ! Domain: set the time-step
+      USE par_oce             ! Ocean parameters
+      USE dom_oce, ONLY : &   ! Geographical information
+         & glamt, glamu, glamv,    &
+         & gphit, gphiu, gphiv,    &
+         & gdept_0, &
+         & 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
+      !! * Local declarations
+      INTEGER :: iyea0        ! Initial date
+      INTEGER :: imon0        !  - (year, month, day, hour, minute)
+      INTEGER :: iday0    
+      INTEGER :: ihou0    
+      INTEGER :: imin0
+      INTEGER :: icycle       ! Current assimilation cycle
+                              ! Counters for observations that
+      INTEGER :: iotdobs      !  - outside time domain
+      INTEGER :: 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 :: igrdobs      !  - fail the grid search
+      INTEGER :: iuvchku      !  - reject u if v rejected and vice versa
+      INTEGER :: iuvchkv      !
+                              ! Global counters for observations that
+      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 :: igrdobsmpp   !  - fail the grid search
+      INTEGER :: iuvchkumpp   !  - reject u if v rejected and vice versa
+      INTEGER :: iuvchkvmpp   !
+      TYPE(obs_prof_valid) ::  llvalid      ! Profile selection 
+      TYPE(obs_prof_valid), DIMENSION(profdata%nvar) :: &
+         & llvvalid           ! U,V selection 
+      INTEGER :: jvar         ! Variable loop variable
+      INTEGER :: jobs         ! Obs. loop variable
+      INTEGER :: jstp         ! Time loop variable
+      INTEGER :: inrc         ! Time index variable
+
+      IF(lwp) WRITE(numout,*)'obs_pre_vel: Preparing the velocity profile data'
+
+      ! Initial date initialization (year, month, day, hour, minute)
+      iyea0 =   ndate0 / 10000
+      imon0 = ( ndate0 - iyea0 * 10000 ) / 100
+      iday0 =   ndate0 - iyea0 * 10000 - imon0 * 100
+      ihou0 = 0
+      imin0 = 0
+
+      icycle = no     ! Assimilation cycle
+
+      ! Diagnotics counters for various failures.
+
+      iotdobs  = 0
+      igrdobs  = 0
+      iosduobs = 0
+      iosdvobs = 0
+      ilanuobs = 0
+      ilanvobs = 0
+      inlauobs = 0
+      inlavobs = 0
+      iuvchku  = 0
+      iuvchkv = 0
+
+      ! -----------------------------------------------------------------------
+      ! Find time coordinate for profiles
+      ! -----------------------------------------------------------------------
+
+      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        )
+	 
+      CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp )
+      
+      ! -----------------------------------------------------------------------
+      ! Check for profiles failing the grid search
+      ! -----------------------------------------------------------------------
+
+      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_mpp_sum_integer( igrdobs, igrdobsmpp )
+
+      ! -----------------------------------------------------------------------
+      ! Reject all observations for profiles with nqc > 10
+      ! -----------------------------------------------------------------------
+
+      CALL obs_pro_rej( profdata )
+
+      ! -----------------------------------------------------------------------
+      ! Check for land points. This includes points below the model
+      ! bathymetry so this is done for every point in the profile
+      ! -----------------------------------------------------------------------
+
+      ! Zonal Velocity Component
+
+      CALL obs_coo_spc_3d( profdata%nprof,        profdata%nvprot(1),   &
+         &                 profdata%npvsta(:,1),  profdata%npvend(:,1), &
+         &                 jpi,                   jpj,                  &
+         &                 jpk,                                         &
+         &                 profdata%mi,           profdata%mj,          & 
+         &                 profdata%var(1)%mvk,                         &
+         &                 profdata%rlam,         profdata%rphi,        &
+         &                 profdata%var(1)%vdep,                        &
+         &                 glamu,                 gphiu,                &
+         &                 gdept_0,               umask,                &
+         &                 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
+
+      CALL obs_coo_spc_3d( profdata%nprof,        profdata%nvprot(2),   &
+         &                 profdata%npvsta(:,2),  profdata%npvend(:,2), &
+         &                 jpi,                   jpj,                  &
+         &                 jpk,                                         &
+         &                 profdata%mi,           profdata%mj,          & 
+         &                 profdata%var(2)%mvk,                         &
+         &                 profdata%rlam,         profdata%rphi,        &
+         &                 profdata%var(2)%vdep,                        &
+         &                 glamv,                 gphiv,                &
+         &                 gdept_0,               vmask,                &
+         &                 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 )
+
+      ! -----------------------------------------------------------------------
+      ! Reject u if v is rejected and vice versa
+      ! -----------------------------------------------------------------------
+
+      CALL obs_uv_rej( profdata, iuvchku, iuvchkv )
+      CALL obs_mpp_sum_integer( iuvchku, iuvchkumpp )
+      CALL obs_mpp_sum_integer( iuvchkv, iuvchkvmpp )
+
+      ! -----------------------------------------------------------------------
+      ! Copy useful data from the profdata data structure to
+      ! the prodatqc data structure 
+      ! -----------------------------------------------------------------------
+
+      ! Allocate the selection arrays
+
+      ALLOCATE( llvalid%luse(profdata%nprof) )
+      DO jvar = 1,profdata%nvar
+         ALLOCATE( llvvalid(jvar)%luse(profdata%nvprot(jvar)) )
+      END DO
+
+      ! We want all data which has qc flags = 0
+
+      llvalid%luse(:) = ( profdata%nqc(:)  <= 10 )
+      DO jvar = 1,profdata%nvar
+         llvvalid(jvar)%luse(:) = ( profdata%var(jvar)%nvqc(:) <= 10 )
+      END DO
+
+      ! The actual copying
+
+      CALL obs_prof_compress( profdata,     prodatqc,       .TRUE.,  numout, &
+         &                    lvalid=llvalid, lvvalid=llvvalid )
+
+      ! Dellocate the selection arrays
+      DEALLOCATE( llvalid%luse )
+      DO jvar = 1,profdata%nvar
+         DEALLOCATE( llvvalid(jvar)%luse )
+      END DO
+
+      ! -----------------------------------------------------------------------
+      ! Print information about what observations are left after qc
+      ! -----------------------------------------------------------------------
+
+      ! Update the total observation counter array
+      
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'obs_pre_vel :'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*)
+         WRITE(numout,*) ' Profiles outside time domain                = ', &
+            &            iotdobsmpp
+         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
+         IF (ld_nea) THEN
+            WRITE(numout,*) ' Remaining U data near land points (removed) = ',&
+               &            inlauobsmpp
+         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                             = ', &
+            &            prodatqc%nvprotmpp(1)
+         WRITE(numout,*) ' Remaining V data outside space domain       = ', &
+            &            iosdvobsmpp
+         WRITE(numout,*) ' Remaining V data at land points             = ', &
+            &            ilanvobsmpp
+         IF (ld_nea) THEN
+            WRITE(numout,*) ' Remaining V data near land points (removed) = ',&
+               &            inlavobsmpp
+         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                             = ', &
+            &            prodatqc%nvprotmpp(2)
+
+         WRITE(numout,*)
+         WRITE(numout,*) ' Number of observations per time step :'
+         WRITE(numout,*)
+         WRITE(numout,997)
+         WRITE(numout,998)
+      ENDIF
+      
+      DO jobs = 1, prodatqc%nprof
+         inrc = prodatqc%mstp(jobs) + 2 - nit000
+         prodatqc%npstp(inrc)  = prodatqc%npstp(inrc) + 1
+         DO jvar = 1, prodatqc%nvar
+            IF ( prodatqc%npvend(jobs,jvar) > 0 ) THEN
+               prodatqc%nvstp(inrc,jvar) = prodatqc%nvstp(inrc,jvar) + &
+                  &                      ( prodatqc%npvend(jobs,jvar) - &
+                  &                        prodatqc%npvsta(jobs,jvar) + 1 )
+            ENDIF
+         END DO
+      END DO
+      
+      
+      CALL obs_mpp_sum_integers( prodatqc%npstp, prodatqc%npstpmpp, &
+         &                       nitend - nit000 + 2 )
+      DO jvar = 1, prodatqc%nvar
+         CALL obs_mpp_sum_integers( prodatqc%nvstp(:,jvar), &
+            &                       prodatqc%nvstpmpp(:,jvar), &
+            &                       nitend - nit000 + 2 )
+      END DO
+
+      IF ( lwp ) THEN
+         DO jstp = nit000 - 1, nitend
+            inrc = jstp - nit000 + 2
+            WRITE(numout,999) jstp, prodatqc%npstpmpp(inrc), &
+               &                    prodatqc%nvstpmpp(inrc,1), &
+               &                    prodatqc%nvstpmpp(inrc,2)
+         END DO
+      ENDIF
+
+997   FORMAT(10X,'Time step',5X,'Profiles',5X,'Zonal Comp.',5X,'Meridional Comp.')
+998   FORMAT(10X,'---------',5X,'--------',5X,'-----------',5X,'----------------')
+999   FORMAT(10X,I9,5X,I8,5X,I11,5X,I8)
+
+   END SUBROUTINE obs_pre_vel
+
+   SUBROUTINE obs_coo_tim( kcycle, &
+      &                    kyea0,   kmon0,   kday0,   khou0,   kmin0,     &
+      &                    kobsno,                                        &
+      &                    kobsyea, kobsmon, kobsday, kobshou, kobsmin,   &
+      &                    kobsqc,  kobsstp, kotdobs                      )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_coo_tim ***
+      !!
+      !! ** Purpose : Compute the number of time steps to the observation time.
+      !!
+      !! ** Method  : For time coordinates ( yea_obs, mon_obs, day_obs, 
+      !!              hou_obs, min_obs ), this routine locates the time step 
+      !!              that is closest to this time.
+      !!
+      !! ** Action  : 
+      !!
+      !! References :
+      !!   
+      !! History :
+      !!        !  1997-07  (A. Weaver) Original
+      !!        !  2006-08  (A. Weaver) NEMOVAR migration
+      !!        !  2006-10  (A. Weaver) Cleanup
+      !!        !  2007-01  (K. Mogensen) Rewritten with loop
+      !!        !  2010-05  (D. Lea) Fix in leap year calculation for NEMO vn3.2
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE dom_oce, ONLY : &  ! Geographical information
+         & rdt
+      USE phycst, ONLY : &   ! Physical constants
+         & rday,  &             
+         & rmmss, &             
+         & rhhmm                        
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kcycle     ! Current cycle
+      INTEGER, INTENT(IN) :: kyea0      ! Initial date coordinates
+      INTEGER, INTENT(IN) :: kmon0
+      INTEGER, INTENT(IN) :: kday0 
+      INTEGER, INTENT(IN) :: khou0
+      INTEGER, INTENT(IN) :: kmin0
+      INTEGER, INTENT(IN) :: kobsno     ! Number of observations
+      INTEGER, INTENT(INOUT) :: kotdobs   ! Number of observations failing time check
+      INTEGER, DIMENSION(kobsno), INTENT(IN ) :: &
+         & kobsyea,  &      ! Observation time coordinates
+         & kobsmon,  &
+         & kobsday,  & 
+         & kobshou,  &
+         & kobsmin
+      INTEGER, DIMENSION(kobsno), INTENT(INOUT) :: &
+         & kobsqc           ! Quality control flag
+      INTEGER, DIMENSION(kobsno), INTENT(OUT) :: &
+         & kobsstp          ! Number of time steps up to the 
+                            ! observation time
+
+      !! * Local declarations
+      INTEGER :: jyea
+      INTEGER :: jmon
+      INTEGER :: jday
+      INTEGER :: jobs
+      INTEGER :: iyeastr
+      INTEGER :: iyeaend
+      INTEGER :: imonstr
+      INTEGER :: imonend
+      INTEGER :: idaystr
+      INTEGER :: idayend 
+      INTEGER :: iskip
+      INTEGER :: idaystp
+      REAL(KIND=wp) :: zminstp
+      REAL(KIND=wp) :: zhoustp
+      REAL(KIND=wp) :: zobsstp 
+      INTEGER, DIMENSION(12) ::   imonth_len    !: length in days of the months of the current year
+ 
+      !-----------------------------------------------------------------------
+      ! Initialization
+      !-----------------------------------------------------------------------
+
+      ! Intialize the number of time steps per day
+      idaystp = NINT( rday / rdt )
+
+      !---------------------------------------------------------------------
+      ! Locate the model time coordinates for interpolation
+      !---------------------------------------------------------------------
+
+      DO jobs = 1, kobsno
+
+         ! Initialize the time step counter
+         kobsstp(jobs) = nit000 - 1
+
+         ! Flag if observation date is less than the initial date
+
+         IF ( ( kobsyea(jobs) < kyea0 )                   &
+            & .OR. ( ( kobsyea(jobs) == kyea0 )           &
+            &        .AND. ( kobsmon(jobs) <  kmon0 ) )   &
+            & .OR. ( ( kobsyea(jobs) == kyea0 )           &
+            &        .AND. ( kobsmon(jobs) == kmon0 )     &
+            &        .AND. ( kobsday(jobs) <  kday0 ) )   &
+            & .OR. ( ( kobsyea(jobs) == kyea0 )           &
+            &        .AND. ( kobsmon(jobs) == kmon0 )     &
+            &        .AND. ( kobsday(jobs) == kday0 )     &
+            &        .AND. ( kobshou(jobs) <  khou0 ) )   &
+            &  .OR. ( ( kobsyea(jobs) == kyea0 )          &
+            &        .AND. ( kobsmon(jobs) == kmon0 )     &
+            &        .AND. ( kobsday(jobs) == kday0 )          &
+            &        .AND. ( kobshou(jobs) == khou0 )          &
+            &        .AND. ( kobsmin(jobs) <= kmin0 ) ) ) THEN
+            kobsstp(jobs) = -1
+            kobsqc(jobs)  = kobsqc(jobs) + 11
+            kotdobs       = kotdobs + 1
+            CYCLE
+         ENDIF
+
+         ! Compute the number of time steps to the observation day
+         iyeastr = kyea0
+         iyeaend = kobsyea(jobs)
+         
+         !---------------------------------------------------------------------
+         ! Year loop
+         !---------------------------------------------------------------------
+         DO jyea = iyeastr, iyeaend
+
+            CALL calc_month_len( jyea, imonth_len )
+            
+            imonstr = 1
+            IF ( jyea == kyea0         ) imonstr = kmon0
+            imonend = 12
+            IF ( jyea == kobsyea(jobs) ) imonend = kobsmon(jobs)
+            
+            ! Month loop
+            DO jmon = imonstr, imonend
+               
+               idaystr = 1
+               IF (       ( jmon == kmon0   ) &
+                  & .AND. ( jyea == kyea0   ) ) idaystr = kday0
+               idayend = imonth_len(jmon)
+               IF (       ( jmon == kobsmon(jobs) ) &
+                  & .AND. ( jyea == kobsyea(jobs) ) ) idayend = kobsday(jobs) - 1
+               
+               ! Day loop
+               DO jday = idaystr, idayend
+                  kobsstp(jobs) = kobsstp(jobs) + idaystp
+               END DO
+               
+            END DO
+
+         END DO
+
+         ! Add in the number of time steps to the observation minute
+         zminstp = rmmss / rdt
+         zhoustp = rhhmm * zminstp
+
+         zobsstp =   REAL( kobsmin(jobs) - kmin0, KIND=wp ) * zminstp &
+            &      + REAL( kobshou(jobs) - khou0, KIND=wp ) * zhoustp
+         kobsstp(jobs) = kobsstp(jobs) + NINT( zobsstp )
+
+         ! Flag if observation step outside the time window
+         IF ( ( kobsstp(jobs) < ( nit000 - 1 ) ) &
+            & .OR.( kobsstp(jobs) > nitend ) ) THEN
+            kobsqc(jobs) = kobsqc(jobs) + 12
+            kotdobs = kotdobs + 1
+            CYCLE
+         ENDIF
+
+      END DO
+
+   END SUBROUTINE obs_coo_tim
+
+   SUBROUTINE calc_month_len( iyear, imonth_len )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE calc_month_len  ***
+      !!          
+      !! ** Purpose : Compute the number of days in a months given a year.
+      !!
+      !! ** Method  : 
+      !!
+      !! ** Action  : 
+      !!
+      !! History :
+      !!        !  10-05  (D. Lea)   New routine based on day_init 
+      !!----------------------------------------------------------------------
+
+      INTEGER, DIMENSION(12) ::   imonth_len    !: length in days of the months of the current year
+      INTEGER :: iyear         !: year
+      
+      ! length of the month of the current year (from nleapy, read in namelist)
+      IF ( nleapy < 2 ) THEN 
+         imonth_len(:) = (/ 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /)
+         IF ( nleapy == 1 ) THEN   ! we are using calendar with leap years
+            IF ( MOD(iyear, 4) == 0 .AND. ( MOD(iyear, 400) == 0 .OR. MOD(iyear, 100) /= 0 ) ) THEN
+               imonth_len(2) = 29
+            ENDIF
+         ENDIF
+      ELSE
+         imonth_len(:) = nleapy   ! all months with nleapy days per year
+      ENDIF
+
+   END SUBROUTINE
+
+   SUBROUTINE obs_coo_tim_prof( kcycle,                                   &
+      &                    kyea0,   kmon0,   kday0,   khou0,   kmin0,     &
+      &                    kobsno,                                        &
+      &                    kobsyea, kobsmon, kobsday, kobshou, kobsmin,   &
+      &                    ktyp,    kobsqc,  kobsstp, kotdobs, kdailyavtypes, &
+      &                    ld_dailyav )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_coo_tim ***
+      !!
+      !! ** Purpose : Compute the number of time steps to the observation time.
+      !!
+      !! ** Method  : For time coordinates ( yea_obs, mon_obs, day_obs, 
+      !!              hou_obs, min_obs ), this routine locates the time step 
+      !!              that is closest to this time.
+      !!
+      !! ** Action  : 
+      !!
+      !! References :
+      !!   
+      !! History :
+      !!        !  1997-07  (A. Weaver) Original
+      !!        !  2006-08  (A. Weaver) NEMOVAR migration
+      !!        !  2006-10  (A. Weaver) Cleanup
+      !!        !  2007-01  (K. Mogensen) Rewritten with loop
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kcycle      ! Current cycle
+      INTEGER, INTENT(IN) :: kyea0       ! Initial date coordinates
+      INTEGER, INTENT(IN) :: kmon0
+      INTEGER, INTENT(IN) :: kday0
+      INTEGER, INTENT(IN) :: khou0
+      INTEGER, INTENT(IN) :: kmin0
+      INTEGER, INTENT(IN) :: kobsno      ! Number of observations
+      INTEGER, INTENT(INOUT) ::  kotdobs    ! Number of observations failing time check
+      INTEGER, DIMENSION(kobsno), INTENT(IN ) :: &
+         & kobsyea,  &      ! Observation time coordinates
+         & kobsmon,  &
+         & kobsday,  & 
+         & kobshou,  &
+         & kobsmin,  &
+         & ktyp             ! Observation type.
+      INTEGER, DIMENSION(kobsno), INTENT(INOUT) :: &
+         & kobsqc           ! Quality control flag
+      INTEGER, DIMENSION(kobsno), INTENT(OUT) :: &
+         & kobsstp          ! Number of time steps up to the 
+                            ! observation time
+      INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: &
+         & kdailyavtypes    ! Types for daily averages
+      LOGICAL, OPTIONAL :: ld_dailyav    ! All types are daily averages
+      !! * Local declarations
+      INTEGER :: jobs
+
+      !-----------------------------------------------------------------------
+      ! Call standard obs_coo_tim
+      !-----------------------------------------------------------------------
+
+      CALL obs_coo_tim( kcycle, &
+         &              kyea0,   kmon0,   kday0,   khou0,   kmin0,     &
+         &              kobsno,                                        &
+         &              kobsyea, kobsmon, kobsday, kobshou, kobsmin,   &
+         &              kobsqc,  kobsstp, kotdobs                      )
+
+      !------------------------------------------------------------------------
+      ! Always reject daily averaged data (e.g. MRB data (820)) at initial time
+      !------------------------------------------------------------------------
+
+      IF ( PRESENT(kdailyavtypes) ) THEN
+         DO jobs = 1, kobsno
+            
+            IF ( kobsqc(jobs) <= 10 ) THEN
+               
+               IF ( ( kobsstp(jobs) == (nit000 - 1) ).AND.&
+                  & ( ANY (kdailyavtypes(:) == ktyp(jobs)) ) ) THEN
+                  kobsqc(jobs) = kobsqc(jobs) + 14
+                  kotdobs      = kotdobs + 1
+                  CYCLE
+               ENDIF
+               
+            ENDIF
+         END DO
+      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
+
+   SUBROUTINE obs_coo_grd( kobsno, kobsi, kobsj, kobsqc, kgrdobs )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_coo_grd ***
+      !!
+      !! ** Purpose : Verify that the grid search has not failed
+      !!
+      !! ** Method  : The previously computed i,j indeces are checked  
+      !!
+      !! ** Action  : 
+      !!
+      !! References :
+      !!   
+      !! History :
+      !!        !  2007-01  (K. Mogensen)  Original
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kobsno        ! Number of observations
+      INTEGER, DIMENSION(kobsno), INTENT(IN ) :: &
+         & kobsi, &         ! i,j indeces previously computed
+         & kobsj
+      INTEGER, INTENT(INOUT) ::  kgrdobs   ! Number of observations failing the check
+      INTEGER, DIMENSION(kobsno), INTENT(INOUT) :: &
+         & kobsqc           ! Quality control flag
+
+      !! * Local declarations
+      INTEGER :: jobs       ! Loop variable
+
+      ! Flag if the grid search failed
+
+      DO jobs = 1, kobsno
+         IF ( ( kobsi(jobs) <= 0 ) .AND. ( kobsj(jobs) <= 0 ) ) THEN
+            kobsqc(jobs) = kobsqc(jobs) + 18
+            kgrdobs = kgrdobs + 1
+         ENDIF
+      END DO
+      
+   END SUBROUTINE obs_coo_grd
+
+   SUBROUTINE obs_coo_spc_2d( kobsno, kpi,     kpj,              &
+      &                       kobsi,  kobsj,   pobslam, pobsphi, & 
+      &                       plam,   pphi,    pmask,            &
+      &                       kobsqc, kosdobs, klanobs,          &
+      &                       knlaobs,ld_nea                     )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_coo_spc_2d  ***
+      !!
+      !! ** Purpose : Check for points outside the domain and land points
+      !!
+      !! ** Method  : Remove the observations that are outside the model space
+      !!              and time domain or located within model land cells.
+      !!
+      !! ** Action  : 
+      !!   
+      !! History :
+      !!        !  2007-03  (A. Weaver, K. Mogensen)  Original
+      !!        !  2007-06  (K. Mogensen et al) Reject obs. near land.
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kobsno    ! Total number of observations
+      INTEGER, INTENT(IN) :: kpi       ! Number of grid points in (i,j)
+      INTEGER, INTENT(IN) :: kpj
+      INTEGER, DIMENSION(kobsno), INTENT(IN) :: &
+         & kobsi, &           ! Observation (i,j) coordinates
+         & kobsj
+      REAL(KIND=wp), DIMENSION(kobsno), INTENT(IN) :: &
+         & pobslam, &         ! Observation (lon,lat) coordinates
+         & pobsphi
+      REAL(KIND=wp), DIMENSION(kpi,kpj), INTENT(IN) :: &
+         & plam, pphi         ! Model (lon,lat) coordinates
+      REAL(KIND=wp), DIMENSION(kpi,kpj), INTENT(IN) :: &
+         & pmask              ! Land mask array
+      INTEGER, DIMENSION(kobsno), INTENT(INOUT) :: &
+         & kobsqc             ! Observation quality control
+      INTEGER, INTENT(INOUT) :: kosdobs   ! Observations outside space domain
+      INTEGER, INTENT(INOUT) :: klanobs   ! Observations within a model land cell
+      INTEGER, INTENT(INOUT) :: knlaobs   ! Observations near land
+      LOGICAL, INTENT(IN) :: ld_nea       ! Flag observations near land
+      !! * Local declarations
+      REAL(KIND=wp), DIMENSION(2,2,kobsno) :: &
+         & zgmsk              ! Grid mask
+      REAL(KIND=wp), DIMENSION(2,2,kobsno) :: &
+         & zglam, &           ! Model longitude at grid points
+         & zgphi              ! Model latitude at grid points
+      INTEGER, DIMENSION(2,2,kobsno) :: &
+         & igrdi, &           ! Grid i,j
+         & igrdj
+      LOGICAL :: lgridobs           ! Is observation on a model grid point.
+      INTEGER :: iig, ijg           ! i,j of observation on model grid point.
+      INTEGER :: jobs, ji, jj
+      
+      ! Get grid point indices
+
+      DO jobs = 1, kobsno
+         
+         ! For invalid points use 2,2
+
+         IF ( kobsqc(jobs) >= 10 ) THEN
+
+            igrdi(1,1,jobs) = 1
+            igrdj(1,1,jobs) = 1
+            igrdi(1,2,jobs) = 1
+            igrdj(1,2,jobs) = 2
+            igrdi(2,1,jobs) = 2
+            igrdj(2,1,jobs) = 1
+            igrdi(2,2,jobs) = 2
+            igrdj(2,2,jobs) = 2
+
+         ELSE
+
+            igrdi(1,1,jobs) = kobsi(jobs)-1
+            igrdj(1,1,jobs) = kobsj(jobs)-1
+            igrdi(1,2,jobs) = kobsi(jobs)-1
+            igrdj(1,2,jobs) = kobsj(jobs)
+            igrdi(2,1,jobs) = kobsi(jobs)
+            igrdj(2,1,jobs) = kobsj(jobs)-1
+            igrdi(2,2,jobs) = kobsi(jobs)
+            igrdj(2,2,jobs) = kobsj(jobs)
+
+         ENDIF
+
+      END DO
+      
+      CALL obs_int_comm_2d( 2, 2, kobsno, igrdi, igrdj, pmask, zgmsk )
+      CALL obs_int_comm_2d( 2, 2, kobsno, igrdi, igrdj, plam, zglam )
+      CALL obs_int_comm_2d( 2, 2, kobsno, igrdi, igrdj, pphi, zgphi )
+
+      DO jobs = 1, kobsno
+
+         ! Skip bad observations
+         IF ( kobsqc(jobs) >= 10 ) CYCLE
+
+         ! Flag if the observation falls outside the model spatial domain
+         IF (       ( pobslam(jobs) < -180. ) &
+            &  .OR. ( pobslam(jobs) >  180. ) &
+            &  .OR. ( pobsphi(jobs) <  -90. ) &
+            &  .OR. ( pobsphi(jobs) >   90. ) ) THEN
+            kobsqc(jobs) = kobsqc(jobs) + 11
+            kosdobs = kosdobs + 1
+            CYCLE
+         ENDIF
+
+         ! Flag if the observation falls with a model land cell
+         IF ( SUM( zgmsk(1:2,1:2,jobs) ) == 0.0_wp ) THEN
+            kobsqc(jobs) = kobsqc(jobs)  + 12
+            klanobs = klanobs + 1
+            CYCLE
+         ENDIF
+
+         ! Check if this observation is on a grid point
+
+         lgridobs = .FALSE.
+         iig = -1
+         ijg = -1
+         DO jj = 1, 2
+            DO ji = 1, 2
+               IF ( ( ABS( zgphi(ji,jj,jobs) - pobsphi(jobs) ) < 1.0e-6_wp ) &
+                  & .AND. &
+                  & ( ABS( zglam(ji,jj,jobs) - pobslam(jobs) ) < 1.0e-6_wp ) &
+                  & ) THEN
+                  lgridobs = .TRUE.
+                  iig = ji
+                  ijg = jj
+               ENDIF
+            END DO
+         END DO
+  
+         ! For observations on the grid reject them if their are at
+         ! a masked point
+         
+         IF (lgridobs) THEN
+            IF (zgmsk(iig,ijg,jobs) == 0.0_wp ) THEN
+               kobsqc(jobs) = kobsqc(jobs) + 12
+               klanobs = klanobs + 1
+               CYCLE
+            ENDIF
+         ENDIF
+                      
+         ! Flag if the observation falls is close to land
+         IF ( MINVAL( zgmsk(1:2,1:2,jobs) ) == 0.0_wp) THEN
+            IF (ld_nea) kobsqc(jobs) = kobsqc(jobs) + 14
+            knlaobs = knlaobs + 1
+            CYCLE
+         ENDIF
+            
+      END DO
+
+   END SUBROUTINE obs_coo_spc_2d
+
+   SUBROUTINE obs_coo_spc_3d( kprofno, kobsno,  kpstart, kpend, &
+      &                       kpi,     kpj,     kpk,            &
+      &                       kobsi,   kobsj,   kobsk,          &
+      &                       pobslam, pobsphi, pobsdep,        &
+      &                       plam,    pphi,    pdep,    pmask, &
+      &                       kpobsqc, kobsqc,  kosdobs,        &
+      &                       klanobs, knlaobs, ld_nea          )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_coo_spc_3d  ***
+      !!
+      !! ** Purpose : Check for points outside the domain and land points
+      !!              Reset depth of observation above highest model level
+      !!              to the value of highest model level
+      !!
+      !! ** Method  : Remove the observations that are outside the model space
+      !!              and time domain or located within model land cells.
+      !!
+      !!              NB. T and S profile observations lying between the ocean
+      !!              surface and the depth of the first model T point are 
+      !!              assigned a depth equal to that of the first model T pt.
+      !!
+      !! ** Action  : 
+      !!   
+      !! History :
+      !!        !  2007-01  (K. Mogensen) Rewrite of parts of obs_scr
+      !!        !  2007-06  (K. Mogensen et al) Reject obs. near land.
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE dom_oce, ONLY : &       ! Geographical information
+         & gdepw_0                        
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kprofno      ! Number of profiles
+      INTEGER, INTENT(IN) :: kobsno       ! Total number of observations
+      INTEGER, INTENT(IN) :: kpi          ! Number of grid points in (i,j,k)
+      INTEGER, INTENT(IN) :: kpj
+      INTEGER, INTENT(IN) :: kpk    
+      INTEGER, DIMENSION(kprofno), INTENT(IN) :: &
+         & kpstart, &         ! Start of individual profiles
+         & kpend              ! End of individual profiles
+      INTEGER, DIMENSION(kprofno), INTENT(IN) :: &
+         & kobsi, &           ! Observation (i,j) coordinates
+         & kobsj
+      INTEGER, DIMENSION(kobsno), INTENT(IN) :: &
+         & kobsk              ! Observation k coordinate
+      REAL(KIND=wp), DIMENSION(kprofno), INTENT(IN) :: &
+         & pobslam, &         ! Observation (lon,lat) coordinates
+         & pobsphi
+      REAL(KIND=wp), DIMENSION(kobsno), INTENT(INOUT) :: &
+         & pobsdep            ! Observation depths  
+      REAL(KIND=wp), DIMENSION(kpi,kpj), INTENT(IN) :: &
+         & plam, pphi         ! Model (lon,lat) coordinates
+      REAL(KIND=wp), DIMENSION(kpk), INTENT(IN) :: &
+         & pdep               ! Model depth coordinates
+      REAL(KIND=wp), DIMENSION(kpi,kpj,kpk), INTENT(IN) :: &
+         & pmask              ! Land mask array
+      INTEGER, DIMENSION(kprofno), INTENT(INOUT) :: &
+         & kpobsqc             ! Profile quality control
+      INTEGER, DIMENSION(kobsno), INTENT(INOUT) :: &
+         & kobsqc             ! Observation quality control
+      INTEGER, INTENT(INOUT) :: kosdobs     ! Observations outside space domain
+      INTEGER, INTENT(INOUT) :: klanobs     ! Observations within a model land cell
+      INTEGER, INTENT(INOUT) :: knlaobs     ! Observations near land
+      LOGICAL, INTENT(IN) :: ld_nea         ! Flag observations near land
+      !! * Local declarations
+      REAL(KIND=wp), DIMENSION(2,2,kpk,kprofno) :: &
+         & zgmsk              ! Grid mask
+      REAL(KIND=wp), DIMENSION(2,2,kprofno) :: &
+         & zglam, &           ! Model longitude at grid points
+         & zgphi              ! Model latitude at grid points
+      INTEGER, DIMENSION(2,2,kprofno) :: &
+         & igrdi, &           ! Grid i,j
+         & igrdj
+      LOGICAL :: lgridobs           ! Is observation on a model grid point.
+      INTEGER :: iig, ijg           ! i,j of observation on model grid point.
+      INTEGER :: jobs, jobsp, jk, ji, jj
+
+      ! Get grid point indices
+      
+      DO jobs = 1, kprofno
+
+         ! For invalid points use 2,2
+
+         IF ( kpobsqc(jobs) >= 10 ) THEN
+            
+            igrdi(1,1,jobs) = 1
+            igrdj(1,1,jobs) = 1
+            igrdi(1,2,jobs) = 1
+            igrdj(1,2,jobs) = 2
+            igrdi(2,1,jobs) = 2
+            igrdj(2,1,jobs) = 1
+            igrdi(2,2,jobs) = 2
+            igrdj(2,2,jobs) = 2
+            
+         ELSE
+            
+            igrdi(1,1,jobs) = kobsi(jobs)-1
+            igrdj(1,1,jobs) = kobsj(jobs)-1
+            igrdi(1,2,jobs) = kobsi(jobs)-1
+            igrdj(1,2,jobs) = kobsj(jobs)
+            igrdi(2,1,jobs) = kobsi(jobs)
+            igrdj(2,1,jobs) = kobsj(jobs)-1
+            igrdi(2,2,jobs) = kobsi(jobs)
+            igrdj(2,2,jobs) = kobsj(jobs)
+            
+         ENDIF
+         
+      END DO
+      
+      CALL obs_int_comm_3d( 2, 2, kprofno, kpk, igrdi, igrdj, pmask, zgmsk )
+      CALL obs_int_comm_2d( 2, 2, kprofno, igrdi, igrdj, plam, zglam )
+      CALL obs_int_comm_2d( 2, 2, kprofno, igrdi, igrdj, pphi, zgphi )
+
+      DO jobs = 1, kprofno
+
+         ! Skip bad profiles
+         IF ( kpobsqc(jobs) >= 10 ) CYCLE
+
+         ! Check if this observation is on a grid point
+
+         lgridobs = .FALSE.
+         iig = -1
+         ijg = -1
+         DO jj = 1, 2
+            DO ji = 1, 2
+               IF ( ( ABS( zgphi(ji,jj,jobs) - pobsphi(jobs) ) < 1.0e-6_wp ) &
+                  & .AND. &
+                  & ( ABS( zglam(ji,jj,jobs) - pobslam(jobs) ) < 1.0e-6_wp ) &
+                  & ) THEN
+                  lgridobs = .TRUE.
+                  iig = ji
+                  ijg = jj
+               ENDIF
+            END DO
+         END DO
+
+         ! Reject observations
+
+         DO jobsp = kpstart(jobs), kpend(jobs)
+
+            ! Flag if the observation falls outside the model spatial domain
+            IF (       ( pobslam(jobs) < -180.         )       &
+               &  .OR. ( pobslam(jobs) >  180.         )       &
+               &  .OR. ( pobsphi(jobs) <  -90.         )       &
+               &  .OR. ( pobsphi(jobs) >   90.         )       &
+               &  .OR. ( pobsdep(jobsp) < 0.0          )       &
+               &  .OR. ( pobsdep(jobsp) > gdepw_0(kpk) ) ) THEN
+               kobsqc(jobsp) = kobsqc(jobsp) + 11
+               kosdobs = kosdobs + 1
+               CYCLE
+            ENDIF
+
+            ! Flag if the observation falls with a model land cell
+            IF ( SUM( zgmsk(1:2,1:2,kobsk(jobsp)-1:kobsk(jobsp),jobs) ) &
+               &  == 0.0_wp ) THEN
+               kobsqc(jobsp) = kobsqc(jobsp) + 12
+               klanobs = klanobs + 1
+               CYCLE
+            ENDIF
+
+            ! For observations on the grid reject them if their are at
+            ! a masked point
+            
+            IF (lgridobs) THEN
+               IF (zgmsk(iig,ijg,kobsk(jobsp)-1,jobs) == 0.0_wp ) THEN
+                  kobsqc(jobsp) = kobsqc(jobsp) + 12
+                  klanobs = klanobs + 1
+                  CYCLE
+               ENDIF
+            ENDIF
+            
+            ! Flag if the observation falls is close to land
+            IF ( MINVAL( zgmsk(1:2,1:2,kobsk(jobsp)-1:kobsk(jobsp),jobs) ) == &
+               &  0.0_wp) THEN
+               IF (ld_nea) kobsqc(jobsp) = kobsqc(jobsp) + 14
+               knlaobs = knlaobs + 1
+            ENDIF
+
+            ! Set observation depth equal to that of the first model depth
+            IF ( pobsdep(jobsp) <= pdep(1) ) THEN
+               pobsdep(jobsp) = pdep(1)  
+            ENDIF
+            
+         END DO
+      END DO
+
+   END SUBROUTINE obs_coo_spc_3d
+
+   SUBROUTINE obs_pro_rej( profdata )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_pro_rej ***
+      !!
+      !! ** Purpose : Reject all data within a rejected profile
+      !!
+      !! ** Method  : 
+      !!
+      !! ** Action  : 
+      !!
+      !! References :
+      !!   
+      !! History :
+      !!        !  2007-10  (K. Mogensen) Original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      !! * Arguments
+      TYPE(obs_prof), INTENT(INOUT) :: profdata     ! Profile data
+      !! * Local declarations
+      INTEGER :: jprof
+      INTEGER :: jvar
+      INTEGER :: jobs
+      
+      ! Loop over profiles
+
+      DO jprof = 1, profdata%nprof
+
+         IF ( profdata%nqc(jprof) > 10 ) THEN
+            
+            DO jvar = 1, profdata%nvar
+
+               DO jobs = profdata%npvsta(jprof,jvar),  &
+                  &      profdata%npvend(jprof,jvar)
+                  
+                  profdata%var(jvar)%nvqc(jobs) = &
+                     & profdata%var(jvar)%nvqc(jobs) + 26
+
+               END DO
+
+            END DO
+
+         ENDIF
+
+      END DO
+
+   END SUBROUTINE obs_pro_rej
+
+   SUBROUTINE obs_uv_rej( profdata, knumu, knumv )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_uv_rej ***
+      !!
+      !! ** Purpose : Reject u if v is rejected and vice versa
+      !!
+      !! ** Method  : 
+      !!
+      !! ** Action  : 
+      !!
+      !! References :
+      !!   
+      !! History :
+      !!        !  2009-2  (K. Mogensen) Original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      !! * Arguments
+      TYPE(obs_prof), INTENT(INOUT) :: profdata   ! Profile data
+      INTEGER, INTENT(INOUT) :: knumu             ! Number of u rejected
+      INTEGER, INTENT(INOUT) :: knumv             ! Number of v rejected
+      !! * Local declarations
+      INTEGER :: jprof
+      INTEGER :: jvar
+      INTEGER :: jobs
+      
+      ! Loop over profiles
+
+      DO jprof = 1, profdata%nprof
+
+         IF ( ( profdata%npvsta(jprof,1) /= profdata%npvsta(jprof,2) ) .OR. &
+            & ( profdata%npvend(jprof,1) /= profdata%npvend(jprof,2) ) ) THEN
+
+            CALL ctl_stop('U,V profiles inconsistent in obs_uv_rej')
+            RETURN
+
+         ENDIF
+
+         DO jobs = profdata%npvsta(jprof,1), profdata%npvend(jprof,1)
+            
+            IF ( ( profdata%var(1)%nvqc(jobs) > 10 ) .AND. &
+               & ( profdata%var(2)%nvqc(jobs) <= 10) ) THEN
+               profdata%var(2)%nvqc(jobs) = profdata%var(2)%nvqc(jobs) + 42
+               knumv = knumv + 1
+            ENDIF
+            IF ( ( profdata%var(2)%nvqc(jobs) > 10 ) .AND. &
+               & ( profdata%var(1)%nvqc(jobs) <= 10) ) THEN
+               profdata%var(1)%nvqc(jobs) = profdata%var(1)%nvqc(jobs) + 42
+               knumu = knumu + 1
+            ENDIF
+            
+         END DO
+            
+      END DO
+
+   END SUBROUTINE obs_uv_rej
+
+END MODULE obs_prep
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prof_io.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prof_io.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prof_io.F90	(revision 2528)
@@ -0,0 +1,32 @@
+MODULE obs_prof_io
+   !!======================================================================
+   !!                       ***  MODULE obs_prof_io  ***
+   !! Observation operators : I/O for ENACT and Coriolis files
+   !!======================================================================
+   !! History : 
+   !!             !  09-01  (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   read_enactfile    :  Read a obfbdata structure from an ENACT file.
+   !!   read_coriofile    :  Read a obfbdata structure from an Coriolis file.
+   !!----------------------------------------------------------------------
+   USE par_kind
+   USE obs_utils
+   USE obs_fbm
+   USE obs_conv
+   USE netcdf
+   IMPLICIT NONE
+
+   INTEGER, PARAMETER :: imaxlev = 10000
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#include "obsprof_io.h90"
+
+END MODULE obs_prof_io
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_profiles.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_profiles.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_profiles.F90	(revision 2528)
@@ -0,0 +1,43 @@
+MODULE obs_profiles
+   !!=====================================================================
+   !!                       ***  MODULE  obs_profiles  ***
+   !! Observation diagnostics: Storage space for profile observations
+   !!                          arrays and additional flags etc.
+   !!=====================================================================
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   
+   !! * Modules used 
+   USE obs_profiles_def ! Definition of profile data types and tools
+
+   IMPLICIT NONE
+   
+   SAVE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC nprofsets, nprofvars, nprofextr, profdata, prodatqc
+   PUBLIC nvelosets, nvelovars, nveloextr, velodata, veldatqc
+   
+   !! * Shared Module variables
+   INTEGER :: nprofsets                    ! Total number of profile data sets
+   INTEGER :: nprofvars                    ! Total number of variables for profiles
+   INTEGER :: nprofextr                    ! Extra fields for each variable
+!$AGRIF_DO_NOT_TREAT
+   TYPE(obs_prof), POINTER ::  profdata(:) ! Initial profile data
+   TYPE(obs_prof), POINTER ::  prodatqc(:) ! Profile data after quality control
+!$AGRIF_END_DO_NOT_TREAT
+
+   INTEGER :: nvelosets                     ! Total number of velocity profile data sets
+   INTEGER :: nvelovars                     ! Total number of variables for profiles
+   INTEGER :: nveloextr                     ! Extra fields for each variable
+!$AGRIF_DO_NOT_TREAT
+   TYPE(obs_prof), POINTER ::  velodata(:)  ! Initial velocity profile data
+   TYPE(obs_prof), POINTER ::  veldatqc(:)  ! Velocity profile data after quality control
+!$AGRIF_END_DO_NOT_TREAT
+END MODULE obs_profiles
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_profiles_def.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_profiles_def.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_profiles_def.F90	(revision 2528)
@@ -0,0 +1,919 @@
+MODULE obs_profiles_def
+   !!=====================================================================
+   !!                       ***  MODULE  obs_profiles_def  ***
+   !! Observation diagnostics: Storage handling for T,S profiles
+   !!                          arrays and additional flags etc.
+   !!                          This module only defines the data type and
+   !!                          operations on the data type. There is no
+   !!                          actual data in the module.
+   !!===================================================================== 
+
+   !!----------------------------------------------------------------------
+   !!   obs_prof            : F90 type containing the profile information
+   !!   obs_prof_var        : F90 type containing the variable definition
+   !!   obs_prof_valid       : F90 type containing the valid obs. definition
+   !!   obs_prof_alloc      : Allocates profile arrays
+   !!   obs_prof_dealloc    : Deallocates profile arrays
+   !!   obs_prof_compress   : Extract sub-information from a obs_prof type
+   !!                         to a new obs_prof type
+   !!   obs_prof_decompress : Reinsert sub-information from a obs_prof type
+   !!                         into the original obs_prof type
+   !!   obs_prof_staend     : Set npvsta and npvend of a variable within an 
+   !!                         obs_prof_var type
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE par_kind, ONLY : & ! Precision variables
+      & wp         
+   USE in_out_manager     ! I/O manager
+   USE obs_mpp, ONLY : &  ! MPP tools 
+      obs_mpp_sum_integers
+   USE obs_fbm            ! Obs feedback format
+
+   IMPLICIT NONE
+
+   !! * Routine/type accessibility
+   PRIVATE
+
+   PUBLIC &
+      & obs_prof,           &
+      & obs_prof_var,       &
+      & obs_prof_valid,     &
+      & obs_prof_alloc,     &
+      & obs_prof_alloc_var, &
+      & obs_prof_dealloc,   &
+      & obs_prof_compress,  &
+      & obs_prof_decompress,&
+      & obs_prof_staend
+
+   !! * Type definition for valid observations
+
+   TYPE obs_prof_valid
+      
+      LOGICAL, POINTER, DIMENSION(:) :: luse
+
+   END TYPE obs_prof_valid
+
+   !! * Type definition for each variable
+
+   TYPE obs_prof_var
+
+      ! Arrays with size equal to the number of observations
+
+      INTEGER, POINTER, DIMENSION(:) :: &
+         & mvk,   &       !: k-th grid coord. for interpolating to profile data
+         & nvpidx,&       !: Profile number
+         & nvlidx,&       !: Level number in profile
+         & nvqc,  &       !: Variable QC flags
+         & idqc           !: Depth QC flag
+
+      REAL(KIND=wp), POINTER, DIMENSION(:) :: &
+         & vdep,  &       !: Depth coordinate of profile data
+         & vobs,  &       !: Profile data
+         & vmod           !: Model counterpart of the profile data vector
+
+      REAL(KIND=wp), POINTER, DIMENSION(:,:) :: &
+         & vext           !: Extra variables
+
+      INTEGER, POINTER, DIMENSION(:) :: &
+         & nvind          !: Source indices of temp. data in compressed data
+
+      ! Arrays with size equal to idefnqcf times the number of observations
+      INTEGER, POINTER, DIMENSION(:,:) :: &
+         & idqcf,  &      !: Depth QC flags
+         & nvqcf          !: Variable QC flags
+
+   END TYPE obs_prof_var
+
+   !! * Type definition for profile observation type
+
+   TYPE obs_prof
+
+      ! Bookkeeping
+
+      INTEGER :: nvar     !: Number of variables
+      INTEGER :: next     !: Number of extra fields
+      INTEGER :: nprof    !: Total number of profiles within window.
+      INTEGER :: nstp     !: Number of time steps
+      INTEGER :: npi      !: Number of 3D grid points
+      INTEGER :: npj
+      INTEGER :: npk
+      INTEGER :: nprofup  !: Observation counter used in obs_oper
+
+      ! Bookkeeping arrays with sizes equal to number of variables
+
+      INTEGER, POINTER, DIMENSION(:) :: &
+         & nvprot,   &    !: Local total number of profile T data
+         & nvprotmpp      !: Global total number of profile T data
+      
+      ! Arrays with size equal to the number of profiles
+
+      INTEGER, POINTER, DIMENSION(:) :: &
+         & npidx,&        !: Profile number
+         & npfil,&        !: Profile number in file
+         & nyea, &        !: Year of profile
+         & nmon, &        !: Month of profile
+         & nday, &        !: Day of profile
+         & nhou, &        !: Hour of profile
+         & nmin, &        !: Minute of profile
+         & mstp, &        !: Time step nearest to profile
+         & nqc,  &        !: Profile QC
+         & ntyp, &        !: Type of profile product (WMO table 1770)
+         & ipqc, &        !: Position QC
+         & itqc           !: Time QC
+
+      REAL(KIND=wp), POINTER, DIMENSION(:) :: &
+         & rlam, &        !: Longitude coordinate of profile data
+         & rphi           !: Latitude coordinate of profile data
+
+      CHARACTER(LEN=8), POINTER, DIMENSION(:) :: &
+         & cwmo           !: Profile WMO indentifier
+      
+      ! Arrays with size equal to the number of profiles times
+      ! number of variables
+
+      INTEGER, POINTER, DIMENSION(:,:) :: &
+         & npvsta, &      !: Start of each variable profile in full arrays
+         & npvend, &      !: End of each variable profile in full arrays
+         & mi,     &      !: i-th grid coord. for interpolating to profile T data
+         & mj,     &      !: j-th grid coord. for interpolating to profile T data
+         & ivqc           !: QC flags for all levels for a variable
+
+      ! Arrays with size equal to idefnqcf
+      ! the number of profiles times number of variables
+      INTEGER, POINTER, DIMENSION(:,:) :: &
+         & nqcf,  &       !: Observation QC flags
+         & ipqcf, &       !: Position QC flags
+         & itqcf          !: Time QC flags
+
+      ! Arrays with size equal to idefnqcf
+      ! the number of profiles times number of variables
+      INTEGER, POINTER, DIMENSION(:,:,:) :: &
+         & ivqcf
+
+      ! Arrays of variables
+
+      TYPE(obs_prof_var), POINTER, DIMENSION(:) :: var
+
+      ! Arrays with size equal to the number of time steps in the window
+
+      INTEGER, POINTER, DIMENSION(:) :: &
+         & npstp,    &    !: Total number of profiles
+         & npstpmpp       !: Total number of profiles
+
+      ! Arrays with size equal to the number of time steps in the window times
+      ! number of variables
+
+      INTEGER, POINTER, DIMENSION(:,:) :: &
+         & nvstp,    &    !: Local total num. of profile data each time step 
+         & nvstpmpp       !: Global total num. of profile data each time step
+      
+      ! Arrays with size equal to the number of grid points times number of
+      ! variables
+
+      REAL(KIND=wp), POINTER, DIMENSION(:,:,:,:) :: &
+         & vdmean        !: Daily averaged model field
+
+      ! Arrays used to store source indices when 
+      ! compressing obs_prof derived types
+      
+      ! Array with size nprof
+
+      INTEGER, POINTER, DIMENSION(:) :: &
+         & npind         !: Source indices of profile data in compressed data
+
+   END TYPE obs_prof
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+   
+   SUBROUTINE obs_prof_alloc( prof,  kvar, kext, kprof,  &
+      &                       ko3dt, kstp, kpi, kpj, kpk )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE obs_prof_alloc  ***
+      !!                      
+      !! ** Purpose : - Allocate data for profile arrays
+      !! 
+      !! ** Method  : - Fortran-90 dynamic arrays
+      !!
+      !! History :
+      !!        !  07-01  (K. Mogensen) Original code
+      !!        !  07-03  (K. Mogensen) Generalized profiles
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      TYPE(obs_prof), INTENT(INOUT) :: prof      ! Profile data to be allocated
+      INTEGER, INTENT(IN) :: kprof  ! Number of profiles
+      INTEGER, INTENT(IN) :: kvar   ! Number of variables
+      INTEGER, INTENT(IN) :: kext   ! Number of extra fields within each variable
+      INTEGER, INTENT(IN), DIMENSION(kvar) :: &
+         & ko3dt     ! Number of observations per variables
+      INTEGER, INTENT(IN) :: kstp   ! Number of time steps
+      INTEGER, INTENT(IN) :: kpi    ! Number of 3D grid points
+      INTEGER, INTENT(IN) :: kpj
+      INTEGER, INTENT(IN) :: kpk
+
+      !!* Local variables
+      INTEGER :: jvar
+      INTEGER :: ji
+
+      ! Set bookkeeping variables
+
+      prof%nvar      = kvar
+      prof%next      = kext
+      prof%nprof     = kprof
+
+      prof%nstp      = kstp
+      prof%npi       = kpi
+      prof%npj       = kpj
+      prof%npk       = kpk
+
+      ! Allocate arrays of size number of variables
+
+      ALLOCATE( &
+         & prof%nvprot(kvar),   &
+         & prof%nvprotmpp(kvar) &
+         )
+         
+      DO jvar = 1, kvar
+         prof%nvprot   (jvar) = ko3dt(jvar)
+         prof%nvprotmpp(jvar) = 0
+      END DO
+
+      ! Allocate arrays of size number of profiles
+      ! times number of variables
+      
+      ALLOCATE( &
+         & prof%npvsta(kprof,kvar), &  
+         & prof%npvend(kprof,kvar), &
+         & prof%mi(kprof,kvar),     &
+         & prof%mj(kprof,kvar),     &
+         & prof%ivqc(kprof,kvar)    &
+         )
+
+      ! Allocate arrays of size iqcfdef times number of profiles
+      ! times number of variables
+
+      ALLOCATE( &
+         & prof%ivqcf(idefnqcf,kprof,kvar) &
+         & )
+
+      ! Allocate arrays of size number of profiles
+
+      ALLOCATE( &
+         & prof%npidx(kprof),   &
+         & prof%npfil(kprof),   &
+         & prof%nyea(kprof),    &
+         & prof%nmon(kprof),    &
+         & prof%nday(kprof),    &
+         & prof%nhou(kprof),    &
+         & prof%nmin(kprof),    &
+         & prof%mstp(kprof),    &
+         & prof%nqc(kprof),     &
+         & prof%ipqc(kprof),    &
+         & prof%itqc(kprof),    &
+         & prof%ntyp(kprof),    &
+         & prof%rlam(kprof),    &
+         & prof%rphi(kprof),    &
+         & prof%cwmo(kprof),    &
+         & prof%npind(kprof)    &
+         & )
+
+      ! Allocate arrays of size idefnqcf times number of profiles
+
+      ALLOCATE( &
+         & prof%nqcf(idefnqcf,kprof),  &
+         & prof%ipqcf(idefnqcf,kprof), &
+         & prof%itqcf(idefnqcf,kprof)  &
+         & )
+
+      ! Allocate obs_prof_var type
+      ALLOCATE( &
+         & prof%var(kvar) &
+         & )
+
+      ! For each variables allocate arrays of size number of observations
+
+      DO jvar = 1, kvar
+
+         IF ( ko3dt(jvar) >= 0 ) THEN
+            CALL obs_prof_alloc_var( prof, jvar, kext, ko3dt(jvar) )
+         ENDIF
+         
+      END DO
+
+      ! Allocate arrays of size number of time step size
+
+      ALLOCATE( &
+         & prof%npstp(kstp),   &
+         & prof%npstpmpp(kstp) &
+         & )
+
+      ! Allocate arrays of size number of time step size times 
+      ! number of variables
+      
+      ALLOCATE( &
+         & prof%nvstp(kstp,kvar),   &
+         & prof%nvstpmpp(kstp,kvar) &
+         & )
+
+      ! Allocate arrays of size number of grid points size times
+      ! number of variables
+
+      ALLOCATE( &
+         & prof%vdmean(kpi,kpj,kpk,kvar) &
+         & )
+
+      ! Set defaults for compression indices
+      
+      DO ji = 1, kprof
+         prof%npind(ji) = ji
+      END DO
+
+      DO jvar = 1, kvar
+         DO ji = 1, ko3dt(jvar)
+            prof%var(jvar)%nvind(ji) = ji
+         END DO
+      END DO
+
+      ! Set defaults for number of observations per time step
+
+      prof%npstp(:)      = 0
+      prof%npstpmpp(:)   = 0
+      prof%nvstp(:,:)    = 0
+      prof%nvstpmpp(:,:) = 0
+      
+      ! Set the observation counter used in obs_oper
+
+      prof%nprofup     = 0
+
+   END SUBROUTINE obs_prof_alloc
+
+   SUBROUTINE obs_prof_dealloc( prof )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE obs_prof_dealloc  ***
+      !!                      
+      !! ** Purpose : - Deallocate data for profile arrays
+      !! 
+      !! ** Method  : - Fortran-90 dynamic arrays
+      !!
+      !! History :
+      !!        !  07-01  (K. Mogensen) Original code
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      TYPE(obs_prof), INTENT(INOUT) :: &
+         & prof      ! Profile data to be deallocated
+
+      !!* Local variables
+      INTEGER :: &
+         & jvar
+
+      ! Deallocate arrays of size number of profiles
+      ! times number of variables
+      
+      DEALLOCATE( &
+         & prof%npvsta, &  
+         & prof%npvend  &
+         )
+
+      ! Dellocate arrays of size number of profiles size
+
+      DEALLOCATE( &
+         & prof%mi,      &
+         & prof%mj,      &
+         & prof%ivqc,    &
+         & prof%ivqcf,   &
+         & prof%npidx,   &
+         & prof%npfil,   &
+         & prof%nyea,    &
+         & prof%nmon,    &
+         & prof%nday,    &
+         & prof%nhou,    &
+         & prof%nmin,    &
+         & prof%mstp,    &
+         & prof%nqc,     &
+         & prof%ipqc,    &
+         & prof%itqc,    &
+         & prof%nqcf,    &
+         & prof%ipqcf,   &
+         & prof%itqcf,   &
+         & prof%ntyp,    &
+         & prof%rlam,    &
+         & prof%rphi,    &
+         & prof%cwmo,    &
+         & prof%npind    &
+         & )
+
+      ! For each variables allocate arrays of size number of observations
+
+      DO jvar = 1, prof%nvar
+
+         IF ( prof%nvprot(jvar) >= 0 ) THEN
+
+            CALL obs_prof_dealloc_var( prof, jvar )
+
+         ENDIF
+         
+      END DO
+
+      ! Dellocate obs_prof_var type
+      DEALLOCATE( &
+         & prof%var &
+         & )
+
+      ! Deallocate arrays of size number of time step size
+
+      DEALLOCATE( &
+         & prof%npstp,   &
+         & prof%npstpmpp &
+         & )
+
+      ! Deallocate arrays of size number of time step size times 
+      ! number of variables
+      
+      DEALLOCATE( &
+         & prof%nvstp,   &
+         & prof%nvstpmpp &
+         & )
+
+      ! Deallocate arrays of size number of grid points size times
+      ! number of variables
+
+      DEALLOCATE( &
+         & prof%vdmean &
+         & )
+
+      ! Dellocate arrays of size number of variables
+
+      DEALLOCATE( &
+         & prof%nvprot,  &
+         & prof%nvprotmpp &
+         )
+
+
+   END SUBROUTINE obs_prof_dealloc
+
+
+   SUBROUTINE obs_prof_alloc_var( prof, kvar, kext, kobs )
+
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE obs_prof_alloc_var  ***
+      !!                      
+      !! ** Purpose : - Allocate data for variable data in profile arrays
+      !! 
+      !! ** Method  : - Fortran-90 dynamic arrays
+      !!
+      !! History :
+      !!        !  07-03  (K. Mogensen) Original code
+      !! * Arguments
+      TYPE(obs_prof), INTENT(INOUT) :: prof   ! Profile data to be allocated
+      INTEGER, INTENT(IN) :: kvar   ! Variable number
+      INTEGER, INTENT(IN) :: kext   ! Number of extra fields within each variable
+      INTEGER, INTENT(IN) :: kobs   ! Number of observations
+      
+      ALLOCATE( & 
+         & prof%var(kvar)%mvk(kobs),       &
+         & prof%var(kvar)%nvpidx(kobs),    &
+         & prof%var(kvar)%nvlidx(kobs),    &
+         & prof%var(kvar)%nvqc(kobs),      &
+         & prof%var(kvar)%idqc(kobs),      &
+         & prof%var(kvar)%vdep(kobs),      &
+         & prof%var(kvar)%vobs(kobs),      &
+         & prof%var(kvar)%vmod(kobs),      &
+         & prof%var(kvar)%nvind(kobs)      &
+         & )
+      ALLOCATE( & 
+         & prof%var(kvar)%idqcf(idefnqcf,kobs), &
+         & prof%var(kvar)%nvqcf(idefnqcf,kobs)  &
+         & )
+      IF (kext>0) THEN
+         ALLOCATE( & 
+            & prof%var(kvar)%vext(kobs,kext) &
+            & )
+      ENDIF
+
+   END SUBROUTINE obs_prof_alloc_var
+
+   SUBROUTINE obs_prof_dealloc_var( prof, kvar )
+
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE obs_prof_alloc_var  ***
+      !!                      
+      !! ** Purpose : - Allocate data for variable data in profile arrays
+      !! 
+      !! ** Method  : - Fortran-90 dynamic arrays
+      !!
+      !! History :
+      !!        !  07-03  (K. Mogensen) Original code
+      !! * Arguments
+      TYPE(obs_prof), INTENT(INOUT) :: prof   ! Profile data to be allocated
+      INTEGER, INTENT(IN) :: kvar      ! Variable number
+      
+      DEALLOCATE( & 
+         & prof%var(kvar)%mvk,    &
+         & prof%var(kvar)%nvpidx, &
+         & prof%var(kvar)%nvlidx, &
+         & prof%var(kvar)%nvqc,   &
+         & prof%var(kvar)%idqc,   &
+         & prof%var(kvar)%vdep,   &
+         & prof%var(kvar)%vobs,   &
+         & prof%var(kvar)%vmod,   &
+         & prof%var(kvar)%nvind,  &
+         & prof%var(kvar)%idqcf,  &
+         & prof%var(kvar)%nvqcf   &
+         & )
+      IF (prof%next>0) THEN
+         DEALLOCATE( & 
+            & prof%var(kvar)%vext  &
+            & )
+      ENDIF
+
+   END SUBROUTINE obs_prof_dealloc_var
+
+   SUBROUTINE obs_prof_compress( prof,   newprof, lallocate, &
+      &                          kumout, lvalid,   lvvalid )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE obs_prof_compress  ***
+      !!                      
+      !! ** Purpose : - Extract sub-information from a obs_prof type
+      !!                into a new obs_prof type
+      !! 
+      !! ** Method  : - The data is copied from prof to new prof.
+      !!                In the case of lvalid and lvvalid both being
+      !!                present only the selected data will be copied.
+      !!                If lallocate is true the data in the newprof is 
+      !!                allocated either with the same number of elements
+      !!                as prof or with only the subset of elements defined
+      !!                by the optional selection in lvalid and lvvalid
+      !!
+      !! History :
+      !!        !  07-01  (K. Mogensen) Original code
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      TYPE(obs_prof), INTENT(IN)    :: prof      ! Original profile
+      TYPE(obs_prof), INTENT(INOUT) :: newprof   ! New profile with the copy of the data
+      LOGICAL :: lallocate                ! Allocate newprof data
+      INTEGER,INTENT(IN) :: kumout        ! Fortran unit for messages
+      TYPE(obs_prof_valid), OPTIONAL, INTENT(in) :: &
+         & lvalid        ! Valid profiles
+      TYPE(obs_prof_valid), OPTIONAL, INTENT(in), DIMENSION(prof%nvar) :: &
+         & lvvalid       ! Valid data within the profiles
+      
+      !!* Local variables
+      INTEGER :: inprof
+      INTEGER, DIMENSION(prof%nvar) :: &
+         & invpro
+      INTEGER :: jvar
+      INTEGER :: jext
+      INTEGER :: ji
+      INTEGER :: jj 
+      LOGICAL :: lfirst
+      TYPE(obs_prof_valid) :: &
+         & llvalid
+      TYPE(obs_prof_valid), DIMENSION(prof%nvar) :: &
+         & llvvalid
+      LOGICAL :: lallpresent
+      LOGICAL :: lnonepresent
+
+      ! Check that either all or none of the masks are persent.
+
+      lallpresent  = .FALSE.
+      lnonepresent = .FALSE.
+      IF ( PRESENT(lvalid) .AND. PRESENT(lvvalid) ) THEN
+         lallpresent =  .TRUE.
+      ELSEIF ( ( .NOT. PRESENT(lvalid)  ) .AND. &
+         &     ( .NOT. PRESENT(lvvalid) ) ) THEN
+         lnonepresent = .TRUE.
+      ELSE
+         CALL ctl_stop('Error in obs_prof_compress:', &
+            &          'Either all selection variables should be set', &
+            &          'or no selection variable should be set' )
+      ENDIF
+      
+      ! Count how many elements there should be in the new data structure
+
+      IF ( lallpresent ) THEN
+         inprof = 0
+         invpro(:) = 0
+         DO ji = 1, prof%nprof
+            IF ( lvalid%luse(ji) ) THEN
+               inprof=inprof+1
+               DO jvar = 1, prof%nvar
+                  DO jj = prof%npvsta(ji,jvar), prof%npvend(ji,jvar)
+                     IF ( lvvalid(jvar)%luse(jj) ) &
+                        &           invpro(jvar) = invpro(jvar) +1
+                  END DO
+               END DO
+            ENDIF
+         END DO
+      ELSE
+         inprof    = prof%nprof
+         invpro(:) = prof%nvprot(:)
+      ENDIF
+
+      ! Optionally allocate data in the new data structure
+
+      IF ( lallocate ) THEN
+         CALL obs_prof_alloc( newprof,   prof%nvar, &
+            &                 prof%next,            &
+            &                 inprof,    invpro,    &
+            &                 prof%nstp, prof%npi,  &
+            &                 prof%npj,  prof%npk )
+      ENDIF
+
+      ! Allocate temporary mask array to unify the code for both cases
+
+      ALLOCATE( llvalid%luse(prof%nprof) )
+      DO jvar = 1, prof%nvar
+         ALLOCATE( llvvalid(jvar)%luse(prof%nvprot(jvar)) )
+      END DO
+      IF ( lallpresent ) THEN
+         llvalid%luse(:) = lvalid%luse(:)
+         DO jvar = 1, prof%nvar
+            llvvalid(jvar)%luse(:) = lvvalid(jvar)%luse(:)
+         END DO
+      ELSE
+         llvalid%luse(:) = .TRUE.
+         DO jvar = 1, prof%nvar
+            llvvalid(jvar)%luse(:) = .TRUE.
+         END DO
+      ENDIF
+
+      ! Setup bookkeeping variables
+
+      inprof    = 0
+      invpro(:) = 0
+
+      newprof%npvsta(:,:) =  0
+      newprof%npvend(:,:) = -1
+      
+      ! Loop over source profiles
+
+      DO ji = 1, prof%nprof
+
+         IF ( llvalid%luse(ji) ) THEN
+
+            ! Copy the header information
+
+            inprof = inprof + 1
+
+            newprof%mi(inprof,:)  = prof%mi(ji,:)
+            newprof%mj(inprof,:) = prof%mj(ji,:)
+            newprof%npidx(inprof) = prof%npidx(ji)
+            newprof%npfil(inprof) = prof%npfil(ji)
+            newprof%nyea(inprof)  = prof%nyea(ji)
+            newprof%nmon(inprof)  = prof%nmon(ji)
+            newprof%nday(inprof)  = prof%nday(ji)
+            newprof%nhou(inprof)  = prof%nhou(ji)
+            newprof%nmin(inprof)  = prof%nmin(ji)
+            newprof%mstp(inprof)  = prof%mstp(ji)
+            newprof%nqc(inprof)   = prof%nqc(ji)
+            newprof%ipqc(inprof)  = prof%ipqc(ji)
+            newprof%itqc(inprof)  = prof%itqc(ji)
+            newprof%ivqc(inprof,:)= prof%ivqc(ji,:)
+            newprof%ntyp(inprof)  = prof%ntyp(ji)
+            newprof%rlam(inprof)  = prof%rlam(ji)
+            newprof%rphi(inprof)  = prof%rphi(ji)
+            newprof%cwmo(inprof)  = prof%cwmo(ji)
+            
+            ! QC info
+
+            newprof%nqcf(:,inprof)    = prof%nqcf(:,ji)
+            newprof%ipqcf(:,inprof)   = prof%ipqcf(:,ji)
+            newprof%itqcf(:,inprof)   = prof%itqcf(:,ji)
+            newprof%ivqcf(:,inprof,:) = prof%ivqcf(:,ji,:)
+            
+            ! npind is the index of the original profile
+            
+            newprof%npind(inprof) = ji
+
+            ! Copy the variable information
+
+            DO jvar = 1, prof%nvar
+
+               lfirst = .TRUE.
+               
+               DO jj = prof%npvsta(ji,jvar), prof%npvend(ji,jvar)
+                  
+                  IF ( llvvalid(jvar)%luse(jj) ) THEN
+
+                     invpro(jvar) = invpro(jvar) + 1
+                  
+                     ! Book keeping information
+                                    
+                     IF ( lfirst ) THEN
+                        lfirst = .FALSE.
+                        newprof%npvsta(inprof,jvar) = invpro(jvar)
+                     ENDIF
+                     newprof%npvend(inprof,jvar) = invpro(jvar)
+
+                     ! Variable data
+                     
+                     newprof%var(jvar)%mvk(invpro(jvar))    = &
+                        &                           prof%var(jvar)%mvk(jj)
+                     newprof%var(jvar)%nvpidx(invpro(jvar)) = &
+                        &                           prof%var(jvar)%nvpidx(jj)
+                     newprof%var(jvar)%nvlidx(invpro(jvar)) = &
+                        &                           prof%var(jvar)%nvlidx(jj)
+                     newprof%var(jvar)%nvqc(invpro(jvar))   = &
+                        &                           prof%var(jvar)%nvqc(jj)
+                     newprof%var(jvar)%idqc(invpro(jvar))   = &
+                        &                           prof%var(jvar)%idqc(jj)
+                     newprof%var(jvar)%idqcf(:,invpro(jvar))= &
+                        &                           prof%var(jvar)%idqcf(:,jj)
+                     newprof%var(jvar)%nvqcf(:,invpro(jvar))= &
+                        &                           prof%var(jvar)%nvqcf(:,jj)
+                     newprof%var(jvar)%vdep(invpro(jvar))   = &
+                        &                           prof%var(jvar)%vdep(jj)
+                     newprof%var(jvar)%vobs(invpro(jvar))   = &
+                        &                           prof%var(jvar)%vobs(jj)
+                     newprof%var(jvar)%vmod(invpro(jvar))   = &
+                        &                           prof%var(jvar)%vmod(jj)
+                     DO jext = 1, prof%next
+                        newprof%var(jvar)%vext(invpro(jvar),jext) = &
+                           &                      prof%var(jvar)%vext(jj,jext)
+                     END DO
+                  
+                     ! nvind is the index of the original variable data
+                     
+                     newprof%var(jvar)%nvind(invpro(jvar))  = jj
+                     
+                  ENDIF
+
+               END DO
+
+            END DO
+
+         ENDIF
+
+      END DO
+
+      ! Update MPP counters
+
+      DO jvar = 1, prof%nvar
+         newprof%nvprot(jvar) = invpro(jvar)
+      END DO
+      CALL obs_mpp_sum_integers ( newprof%nvprot, newprof%nvprotmpp,&
+         &                        prof%nvar )
+      
+      ! Set book keeping variables which do not depend on number of obs.
+
+      newprof%nvar     = prof%nvar
+      newprof%next     = prof%next
+      newprof%nstp     = prof%nstp
+      newprof%npi      = prof%npi
+      newprof%npj      = prof%npj
+      newprof%npk      = prof%npk
+ 
+      ! Deallocate temporary data
+
+      DO jvar = 1, prof%nvar
+         DEALLOCATE( llvvalid(jvar)%luse )
+      END DO
+ 
+      DEALLOCATE( llvalid%luse )
+     
+   END SUBROUTINE obs_prof_compress
+
+   SUBROUTINE obs_prof_decompress( prof, oldprof, ldeallocate, kumout )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE obs_prof_decompress  ***
+      !!                      
+      !! ** Purpose : - Copy back information to original profile type
+      !!
+      !! ** Method  : - Reinsert updated information from a previous
+      !!                copied/compressed profile type into the original
+      !!                profile data and optionally deallocate the prof
+      !!                data input
+      !! 
+      !! History :
+      !!        !  07-01  (K. Mogensen) Original code
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      TYPE(obs_prof),INTENT(INOUT) :: prof      ! Updated profile data
+      TYPE(obs_prof),INTENT(INOUT) :: oldprof   ! Original profile data
+      LOGICAL :: ldeallocate         ! Deallocate the updated data of insertion
+      INTEGER,INTENT(in) :: kumout   ! Output unit
+      
+      !!* Local variables
+      INTEGER :: jvar
+      INTEGER :: jext
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jk
+      INTEGER :: jl
+
+      DO ji = 1, prof%nprof
+
+         ! Copy header information
+         
+         jk = prof%npind(ji)
+      
+         oldprof%mi(jk,:)  = prof%mi(ji,:)
+         oldprof%mj(jk,:)  = prof%mj(ji,:)
+         oldprof%npidx(jk) = prof%npidx(ji)
+         oldprof%npfil(jk) = prof%npfil(ji)
+         oldprof%nyea(jk)  = prof%nyea(ji)
+         oldprof%nmon(jk)  = prof%nmon(ji)
+         oldprof%nday(jk)  = prof%nday(ji)
+         oldprof%nhou(jk)  = prof%nhou(ji)
+         oldprof%nmin(jk)  = prof%nmin(ji)
+         oldprof%mstp(jk)  = prof%mstp(ji)
+         oldprof%nqc(jk)   = prof%nqc(ji)
+         oldprof%ipqc(jk)  = prof%ipqc(ji)
+         oldprof%itqc(jk)  = prof%itqc(ji)
+         oldprof%ivqc(jk,:)= prof%ivqc(ji,:)
+         oldprof%ntyp(jk)  = prof%ntyp(ji)
+         oldprof%rlam(jk)  = prof%rlam(ji)
+         oldprof%rphi(jk)  = prof%rphi(ji)
+         oldprof%cwmo(jk)  = prof%cwmo(ji)
+         
+         ! QC info
+
+         oldprof%nqcf(:,jk)    = prof%nqcf(:,ji)
+         oldprof%ipqcf(:,jk)   = prof%ipqcf(:,ji)
+         oldprof%itqcf(:,jk)   = prof%itqcf(:,ji)
+         oldprof%ivqcf(:,jk,:) = prof%ivqcf(:,ji,:)
+
+         ! Copy the variable information
+
+         DO jvar = 1, prof%nvar
+
+            DO jj = prof%npvsta(ji,jvar), prof%npvend(ji,jvar)
+               
+               jl = prof%var(jvar)%nvind(jj)
+
+               oldprof%var(jvar)%mvk(jl)    = prof%var(jvar)%mvk(jj)
+               oldprof%var(jvar)%nvpidx(jl) = prof%var(jvar)%nvpidx(jj)
+               oldprof%var(jvar)%nvlidx(jl) = prof%var(jvar)%nvlidx(jj)
+               oldprof%var(jvar)%nvqc(jl)   = prof%var(jvar)%nvqc(jj)
+               oldprof%var(jvar)%idqc(jl)   = prof%var(jvar)%idqc(jj)
+               oldprof%var(jvar)%vdep(jl)   = prof%var(jvar)%vdep(jj)
+               oldprof%var(jvar)%vobs(jl)   = prof%var(jvar)%vobs(jj)
+               oldprof%var(jvar)%vmod(jl)   = prof%var(jvar)%vmod(jj)
+               oldprof%var(jvar)%idqcf(:,jl) = prof%var(jvar)%idqcf(:,jj)
+               oldprof%var(jvar)%nvqcf(:,jl) = prof%var(jvar)%nvqcf(:,jj)
+               DO jext = 1, prof%next
+                  oldprof%var(jvar)%vext(jl,jext) = &
+                     &                        prof%var(jvar)%vext(jj,jext)
+               END DO
+               
+            END DO
+
+         END DO
+         
+      END DO
+
+      ! Optionally deallocate the updated profile data
+
+      IF ( ldeallocate ) CALL obs_prof_dealloc( prof )
+      
+   END SUBROUTINE obs_prof_decompress
+
+   SUBROUTINE obs_prof_staend( prof, kvarno )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE obs_prof_decompress  ***
+      !!                      
+      !! ** Purpose : - Set npvsta and npvend of a variable within 
+      !!                an obs_prof_var type
+      !!
+      !! ** Method  : - Find the start and stop of a profile by searching 
+      !!                through the data
+      !! 
+      !! History :
+      !!        !  07-04  (K. Mogensen) Original code
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      TYPE(obs_prof),INTENT(INOUT) :: prof     ! Profile data
+      INTEGER,INTENT(IN) :: kvarno     ! Variable number
+
+      !!* Local variables
+      INTEGER :: ji
+      INTEGER :: iprofno
+
+      !-----------------------------------------------------------------------
+      ! Compute start and end bookkeeping arrays
+      !-----------------------------------------------------------------------
+
+      prof%npvsta(:,kvarno) = prof%nvprot(kvarno) + 1
+      prof%npvend(:,kvarno) = -1
+      DO ji = 1, prof%nvprot(kvarno)
+         iprofno = prof%var(kvarno)%nvpidx(ji)
+         prof%npvsta(iprofno,kvarno) = &
+            & MIN( ji, prof%npvsta(iprofno,kvarno) )
+         prof%npvend(iprofno,kvarno) = &
+            & MAX( ji, prof%npvend(iprofno,kvarno) )
+      END DO
+
+      DO ji = 1, prof%nprof
+         IF ( prof%npvsta(ji,kvarno) == ( prof%nvprot(kvarno) + 1 ) ) &
+            & prof%npvsta(ji,kvarno) = 0
+      END DO
+
+   END SUBROUTINE obs_prof_staend
+   
+END MODULE obs_profiles_def
+
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_altbias.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_altbias.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_altbias.F90	(revision 2528)
@@ -0,0 +1,212 @@
+MODULE obs_read_altbias
+   !!======================================================================
+   !!                       ***  MODULE obs_readaltbias  ***
+   !! Observation diagnostics: Read the bias for SLA data
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   obs_rea_altbias : Driver for reading altimeter bias
+   !!----------------------------------------------------------------------
+
+   !! * Modules used   
+   USE par_kind, ONLY : &       ! Precision variables
+      & wp, &
+      & dp, &
+      & sp
+   USE par_oce, ONLY : &        ! Domain parameters
+      & jpi, &
+      & jpj, &
+      & jpim1
+   USE in_out_manager, ONLY : & ! I/O manager
+      & lwp,    &
+      & numout 
+   USE obs_surf_def             ! Surface observation definitions
+   USE dom_oce, ONLY : &        ! Domain variables
+      & tmask, &
+      & tmask_i, &
+      & e1t,   &
+      & e2t,   &
+      & gphit
+   USE oce, ONLY : &           ! Model variables
+      & sshn
+   USE obs_inter_h2d
+   USE obs_utils               ! Various observation tools
+   USE obs_inter_sup
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC obs_rea_altbias     ! Read the altimeter bias
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE obs_rea_altbias( kslano, sladata, k2dint, bias_file )
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_rea_altbias ***
+      !!
+      !! ** Purpose : Read from file the bias data 
+      !!
+      !! ** Method  : 
+      !!
+      !! ** Action  : 
+      !!
+      !! References :
+      !!
+      !! History :  
+      !!      ! :  2008-02 (D. Lea) Initial version
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE iom
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kslano      ! Number of SLA Products
+      TYPE(obs_surf), DIMENSION(kslano), INTENT(INOUT) :: &
+         & sladata       ! SLA data
+      INTEGER, INTENT(IN) :: k2dint
+      CHARACTER(LEN=128) :: bias_file
+
+      !! * Local declarations
+
+      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
+      INTEGER :: jpjaltbias   ! Number of grid point in longitude for the bias
+      INTEGER :: iico         ! Grid point indicies
+      INTEGER :: ijco
+      INTEGER :: i_nx_id      ! Index to read the NetCDF file
+      INTEGER :: i_ny_id      ! 
+      INTEGER :: i_file_id    ! 
+      INTEGER :: i_var_id
+
+      REAL(wp), DIMENSION(jpi,jpj) :: & 
+         & z_altbias           ! Array to store the alt bias values
+      REAL(wp), DIMENSION(1) :: &
+         & zext, &
+         & zobsmask
+      REAL(wp), DIMENSION(2,2,1) :: &
+         & zweig
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
+         & zmask, &
+         & zbias, &
+         & zglam, &
+         & zgphi
+      REAL(wp) :: zlam
+      REAL(wp) :: zphi
+      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
+         & igrdi, &
+         & igrdj
+      INTEGER :: numaltbias
+
+      IF(lwp)WRITE(numout,*) 
+      IF(lwp)WRITE(numout,*) ' obs_rea_altbias : '
+      IF(lwp)WRITE(numout,*) ' ------------- '
+      IF(lwp)WRITE(numout,*) '   Read altimeter bias'
+
+      ! Open the file
+
+      z_altbias(:,:)=0.0_wp
+      numaltbias=0
+
+      IF(lwp)WRITE(numout,*) 'Opening ',bias_file
+
+      CALL iom_open( bias_file, numaltbias, ldstop=.FALSE. )
+      
+
+      IF (numaltbias .GT. 0) THEN      
+
+         ! Get the Alt bias data
+         
+         CALL iom_get( numaltbias, jpdom_data, 'altbias', z_altbias(:,:), 1 )
+         
+         ! Close the file
+         
+         CALL iom_close(numaltbias)     
+         
+      ELSE
+
+         IF(lwp)WRITE(numout,*) 'no file found'
+      
+      ENDIF
+
+      ! 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)
+            
+            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)
+            
+         END DO
+
+         DEALLOCATE( &
+            & igrdi, &
+            & igrdj, &
+            & zglam, &
+            & zgphi, &
+            & zmask, &
+            & zbias  &
+            & )
+         
+      END DO
+
+   END SUBROUTINE obs_rea_altbias
+
+
+ 
+END MODULE obs_read_altbias
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90	(revision 2528)
@@ -0,0 +1,827 @@
+MODULE obs_read_prof
+   !!======================================================================
+   !!                       ***  MODULE obs_read_prof  ***
+   !! Observation diagnostics: Read the T and S profile observations
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   obs_rea_pro_dri : Driver for reading profile obs
+   !!----------------------------------------------------------------------
+
+   !! * Modules used   
+   USE par_kind                 ! Precision variables
+   USE par_oce                  ! Ocean parameters
+   USE in_out_manager           ! I/O manager
+   USE dom_oce                  ! Ocean space and time domain variables
+   USE obs_mpp                  ! MPP support routines for observation diagnostics
+   USE julian                   ! Julian date routines
+   USE obs_utils                ! Observation operator utility functions
+   USE obs_prep                 ! Prepare observation arrays
+   USE obs_grid                 ! Grid search
+   USE obs_sort                 ! Sorting observation arrays
+   USE obs_profiles_def         ! Profile definitions
+   USE obs_conv                 ! Various conversion routines
+   USE obs_types                ! Observation type definitions
+   USE netcdf                   ! NetCDF library
+   USE obs_oper                 ! Observation operators
+   USE obs_prof_io              ! Profile files I/O (non-FB files)
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC obs_rea_pro_dri  ! Read the profile observations 
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+ 
+   SUBROUTINE obs_rea_pro_dri( kformat, &
+      &                        profdata, knumfiles, cfilenames, &
+      &                        kvars, kextr, kstp, ddobsini, ddobsend, &
+      &                        ldt3d, lds3d, ldignmis, ldsatt, ldavtimset, &
+      &                        ldmod, kdailyavtypes )
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_rea_pro_dri ***
+      !!
+      !! ** Purpose : Read from file the profile observations
+      !!
+      !! ** Method  : Depending on kformat either ENACT, CORIOLIS or
+      !!              feedback data files are read
+      !!
+      !! ** Action  : 
+      !!
+      !! References : 
+      !!
+      !! History :  
+      !!      ! :  2009-09 (K. Mogensen) : New merged version of old routines
+      !!----------------------------------------------------------------------
+      !! * Modules used
+   
+      !! * Arguments
+      INTEGER ::  kformat    ! Format of input data
+      !                      ! 1: ENACT
+      !                      ! 2: Coriolis
+      TYPE(obs_prof), INTENT(OUT) ::  profdata     ! Profile data to be read
+      INTEGER, INTENT(IN) :: knumfiles      ! Number of files to read in
+      CHARACTER(LEN=128), INTENT(IN) ::  &
+         & cfilenames(knumfiles)  ! File names to read in
+      INTEGER, INTENT(IN) :: kvars      ! Number of variables in profdata
+      INTEGER, INTENT(IN) :: kextr      ! Number of extra fields for each var in profdata
+      INTEGER, INTENT(IN) :: kstp        ! Ocean time-step index
+      LOGICAL, INTENT(IN) :: 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, DIMENSION(imaxavtypes), OPTIONAL :: &
+         & kdailyavtypes
+
+      !! * Local declarations
+      CHARACTER(LEN=15), PARAMETER :: cpname='obs_rea_pro_dri'
+      INTEGER :: jvar
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jk
+      INTEGER :: ij
+      INTEGER :: iflag
+      INTEGER :: inobf
+      INTEGER :: i_file_id
+      INTEGER :: inowin
+      INTEGER :: iyea
+      INTEGER :: imon
+      INTEGER :: iday
+      INTEGER :: ihou
+      INTEGER :: imin
+      INTEGER :: isec
+      INTEGER, DIMENSION(knumfiles) :: &
+         & irefdate
+      INTEGER, DIMENSION(ntyp1770+1) :: &
+         & itypt,    &
+         & ityptmpp, &
+         & ityps,    &
+         & itypsmpp 
+      INTEGER :: it3dtmpp
+      INTEGER :: is3dtmpp
+      INTEGER :: ip3dtmpp
+      INTEGER, DIMENSION(:), ALLOCATABLE :: &
+         & iobsi,    &
+         & iobsj,    &
+         & iproc,    &
+         & iindx,    &
+         & ifileidx, &
+         & iprofidx
+      INTEGER :: itype
+      INTEGER, DIMENSION(imaxavtypes) :: &
+         & idailyavtypes
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: &
+         & zphi, &
+         & zlam
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: &
+         & zdat
+      LOGICAL :: llvalprof
+      TYPE(obfbdata), POINTER, DIMENSION(:) :: &
+         & inpfiles
+      REAL(dp), DIMENSION(knumfiles) :: &
+         & djulini, &
+         & djulend
+      INTEGER :: iprof
+      INTEGER :: iproftot
+      INTEGER :: it3dt0
+      INTEGER :: is3dt0
+      INTEGER :: it3dt
+      INTEGER :: is3dt
+      INTEGER :: ip3dt
+      INTEGER, DIMENSION(kvars) :: &
+         & iv3dt
+      CHARACTER(len=8) :: cl_refdate
+   
+      ! Local initialization
+      iprof = 0
+      it3dt0 = 0
+      is3dt0 = 0
+      ip3dt = 0
+
+      ! Daily average types
+      IF ( PRESENT(kdailyavtypes) ) THEN
+         idailyavtypes(:) = kdailyavtypes(:)
+      ELSE
+         idailyavtypes(:) = -1
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Check data the model part is just with feedback data files
+      !-----------------------------------------------------------------------
+      IF ( ldmod .AND. ( kformat /= 0 ) ) THEN
+         CALL ctl_stop( 'Model can only be read from feedback data' )
+         RETURN
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Count the number of files needed and allocate the obfbdata type
+      !-----------------------------------------------------------------------
+      
+      inobf = knumfiles
+      
+      ALLOCATE( inpfiles(inobf) )
+
+      prof_files : DO jj = 1, inobf
+          
+         !---------------------------------------------------------------------
+         ! Prints
+         !---------------------------------------------------------------------
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' obs_rea_pro_dri : Reading from file = ', &
+               & TRIM( TRIM( cfilenames(jj) ) )
+            WRITE(numout,*) ' ~~~~~~~~~~~~~~~'
+            WRITE(numout,*)
+         ENDIF
+
+         !---------------------------------------------------------------------
+         !  Initialization: Open file and get dimensions only
+         !---------------------------------------------------------------------
+         
+         iflag = nf90_open( TRIM( TRIM( cfilenames(jj) ) ), nf90_nowrite, &
+            &                      i_file_id )
+         
+         IF ( iflag /= nf90_noerr ) THEN
+
+            IF ( ldignmis ) THEN
+               inpfiles(jj)%nobs = 0
+               CALL ctl_warn( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
+                  &           ' not found' )
+            ELSE 
+               CALL ctl_stop( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
+                  &           ' not found' )
+            ENDIF
+
+         ELSE 
+            
+            !------------------------------------------------------------------
+            !  Close the file since it is opened in read_proffile
+            !------------------------------------------------------------------
+            
+            iflag = nf90_close( i_file_id )
+
+            !------------------------------------------------------------------
+            !  Read the profile file into inpfiles
+            !------------------------------------------------------------------
+            IF ( kformat == 0 ) THEN
+               CALL init_obfbdata( inpfiles(jj) )
+               IF(lwp) THEN
+                  WRITE(numout,*)
+                  WRITE(numout,*)'Reading from feedback file :', &
+                     &           TRIM( cfilenames(jj) )
+               ENDIF
+               CALL read_obfbdata( TRIM( cfilenames(jj) ), inpfiles(jj), &
+                  &                ldgrid = .TRUE. )
+               IF ( inpfiles(jj)%nvar < 2 ) THEN
+                  CALL ctl_stop( 'Feedback format error' )
+                  RETURN
+               ENDIF
+               IF ( TRIM(inpfiles(jj)%cname(1)) /= 'POTM' ) THEN
+                  CALL ctl_stop( 'Feedback format error' )
+                  RETURN
+               ENDIF
+               IF ( TRIM(inpfiles(jj)%cname(2)) /= 'PSAL' ) THEN
+                  CALL ctl_stop( 'Feedback format error' )
+                  RETURN
+               ENDIF
+               IF ( ldmod .AND. ( inpfiles(jj)%nadd == 0 ) ) THEN
+                  CALL ctl_stop( 'Model not in input data' )
+                  RETURN
+               ENDIF
+            ELSEIF ( kformat == 1 ) THEN
+               CALL read_enactfile( TRIM( cfilenames(jj) ), inpfiles(jj), &
+                  &                 numout, lwp, .TRUE. )
+            ELSEIF ( kformat == 2 ) THEN
+               CALL read_coriofile( TRIM( cfilenames(jj) ), inpfiles(jj), &
+                  &                 numout, lwp, .TRUE. )
+            ELSE
+               CALL ctl_stop( 'File format unknown' )
+            ENDIF
+            
+            !------------------------------------------------------------------
+            !  Change longitude (-180,180)
+            !------------------------------------------------------------------
+
+            DO ji = 1, inpfiles(jj)%nobs 
+
+               IF ( inpfiles(jj)%plam(ji) < -180. ) &
+                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) + 360.
+
+               IF ( inpfiles(jj)%plam(ji) >  180. ) &
+                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) - 360.
+
+            END DO
+
+            !------------------------------------------------------------------
+            !  Calculate the date  (change eventually)
+            !------------------------------------------------------------------
+            cl_refdate=inpfiles(jj)%cdjuldref(1:8)
+            READ(cl_refdate,'(I8)') irefdate(jj)
+            
+            CALL ddatetoymdhms( ddobsini, iyea, imon, iday, ihou, imin, isec )
+            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulini(jj), &
+               &           krefdate = irefdate(jj) )
+            CALL ddatetoymdhms( ddobsend, iyea, imon, iday, ihou, imin, isec )
+            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulend(jj), &
+               &           krefdate = irefdate(jj) )
+
+            IF ( ldavtimset ) THEN
+               DO ji = 1, inpfiles(jj)%nobs
+                  ! 
+                  !  for daily averaged data for example
+                  !  MRB data (itype==820) force the time
+                  !  to be the  end of the day
+                  !
+                  READ( inpfiles(jj)%cdtyp(ji), '(I4)' ) itype
+                  IF ( ANY (idailyavtypes == itype ) ) THEN
+                     inpfiles(jj)%ptim(ji) = &
+                     & INT(inpfiles(jj)%ptim(ji)) + 1
+                  ENDIF
+               END DO
+            ENDIF
+            
+            IF ( inpfiles(jj)%nobs > 0 ) THEN
+               inpfiles(jj)%iproc = -1
+               inpfiles(jj)%iobsi = -1
+               inpfiles(jj)%iobsj = -1
+            ENDIF
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+               IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. &
+                  & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+               ENDIF
+            END DO
+            ALLOCATE( zlam(inowin)  )
+            ALLOCATE( zphi(inowin)  )
+            ALLOCATE( iobsi(inowin) )
+            ALLOCATE( iobsj(inowin) )
+            ALLOCATE( iproc(inowin) )
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+               IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. &
+                  & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+                  zlam(inowin) = inpfiles(jj)%plam(ji)
+                  zphi(inowin) = inpfiles(jj)%pphi(ji)
+               ENDIF
+            END DO
+
+            CALL obs_grid_search( inowin, zlam, zphi, iobsi, iobsj, iproc, 'T' )
+
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+               IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. &
+                  & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+                  inpfiles(jj)%iproc(ji,1) = iproc(inowin)
+                  inpfiles(jj)%iobsi(ji,1) = iobsi(inowin)
+                  inpfiles(jj)%iobsj(ji,1) = iobsj(inowin)
+               ENDIF
+            END DO
+            DEALLOCATE( zlam, zphi, iobsi, iobsj, iproc )
+
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+               IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. &
+                  & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  IF ( nproc == 0 ) THEN
+                     IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
+                  ELSE
+                     IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
+                  ENDIF
+                  llvalprof = .FALSE.
+                  IF ( ldt3d ) THEN
+                     loop_t_count : DO ij = 1,inpfiles(jj)%nlev
+                        IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) &
+                           & CYCLE
+                        IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
+                           & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
+                           it3dt0 = it3dt0 + 1
+                        ENDIF
+                     END DO loop_t_count
+                  ENDIF
+                  IF ( lds3d ) THEN
+                     loop_s_count : DO ij = 1,inpfiles(jj)%nlev
+                        IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) &
+                           & CYCLE
+                        IF ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
+                           & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
+                           is3dt0 = is3dt0 + 1
+                        ENDIF
+                     END DO loop_s_count
+                  ENDIF
+                  loop_p_count : DO ij = 1,inpfiles(jj)%nlev
+                     IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) &
+                        & CYCLE
+                     IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
+                        &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. &
+                        &     ldt3d ) .OR. &
+                        & ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
+                        &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. &
+                        &     lds3d ) ) THEN
+                        ip3dt = ip3dt + 1
+                        llvalprof = .TRUE.
+                     ENDIF
+                  END DO loop_p_count
+
+                  IF ( llvalprof ) iprof = iprof + 1
+
+               ENDIF
+            END DO
+
+         ENDIF
+
+      END DO prof_files
+      
+      !-----------------------------------------------------------------------
+      ! Get the time ordered indices of the input data
+      !-----------------------------------------------------------------------
+
+      !---------------------------------------------------------------------
+      !  Loop over input data files to count total number of profiles
+      !---------------------------------------------------------------------
+      iproftot = 0
+      DO jj = 1, inobf
+         DO ji = 1, inpfiles(jj)%nobs
+            IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+            IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. &
+               & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE
+            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+               iproftot = iproftot + 1
+            ENDIF
+         END DO
+      END DO
+
+      ALLOCATE( iindx(iproftot), ifileidx(iproftot), &
+         &      iprofidx(iproftot), zdat(iproftot) )
+      jk = 0
+      DO jj = 1, inobf
+         DO ji = 1, inpfiles(jj)%nobs
+            IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+            IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. &
+               & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE
+            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+               jk = jk + 1
+               ifileidx(jk) = jj
+               iprofidx(jk) = ji
+               zdat(jk)     = inpfiles(jj)%ptim(ji)
+            ENDIF
+         END DO
+      END DO
+      CALL sort_dp_indx( iproftot, &
+         &               zdat,     &
+         &               iindx   )
+      
+      iv3dt(:) = -1
+      IF (ldsatt) THEN
+         iv3dt(1) = ip3dt
+         iv3dt(2) = ip3dt
+      ELSE
+         iv3dt(1) = it3dt0
+         iv3dt(2) = is3dt0
+      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
+
+      iprof = 0
+
+      ip3dt = 0
+      it3dt = 0
+      is3dt = 0
+      itypt   (:) = 0
+      ityptmpp(:) = 0
+      
+      ityps   (:) = 0
+      itypsmpp(:) = 0
+      
+      
+      DO jk = 1, iproftot
+         
+         jj = ifileidx(iindx(jk))
+         ji = iprofidx(iindx(jk))
+
+         IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+         IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. &
+            & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE
+
+         IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND.  &
+            & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN
+            
+            IF ( nproc == 0 ) THEN
+               IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
+            ELSE
+               IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
+            ENDIF
+            
+            llvalprof = .FALSE.
+
+            IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+
+            IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. &
+               & ( inpfiles(jj)%ivqc(ji,2) > 2 ) ) CYCLE
+
+            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
+
+               CALL jul2greg( isec,                   &
+                  &           imin,                   &
+                  &           ihou,                   &
+                  &           iday,                   &
+                  &           imon,                   &
+                  &           iyea,                   &
+                  &           inpfiles(jj)%ptim(ji), &
+                  &           irefdate(jj) )
+
+
+               ! Profile time coordinates
+               profdata%nyea(iprof) = iyea
+               profdata%nmon(iprof) = imon
+               profdata%nday(iprof) = iday
+               profdata%nhou(iprof) = ihou
+               profdata%nmin(iprof) = imin
+               
+               ! Profile space coordinates
+               profdata%rlam(iprof) = inpfiles(jj)%plam(ji)
+               profdata%rphi(iprof) = inpfiles(jj)%pphi(ji)
+
+               ! Coordinate search parameters
+               profdata%mi  (iprof,:) = 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)' ) itype
+               profdata%ntyp(iprof) = itype
+               
+               ! QC stuff
+
+               profdata%nqc(iprof)     = inpfiles(jj)%ioqc(ji)
+               profdata%nqcf(:,iprof)  = inpfiles(jj)%ioqcf(:,ji)
+               profdata%ipqc(iprof)    = inpfiles(jj)%ipqc(ji)
+               profdata%ipqcf(:,iprof) = inpfiles(jj)%ipqcf(:,ji)
+               profdata%itqc(iprof)    = inpfiles(jj)%itqc(ji)
+               profdata%itqcf(:,iprof) = inpfiles(jj)%itqcf(:,ji)
+               profdata%ivqc(iprof,:)  = inpfiles(jj)%ivqc(ji,:)
+               profdata%ivqcf(:,iprof,:) = inpfiles(jj)%ivqcf(:,ji,:)
+
+               ! Bookkeeping data to match profiles
+               profdata%npidx(iprof) = iprof
+               profdata%npfil(iprof) = iindx(jk)
+
+               ! Observation QC flag (whole profile)
+               profdata%nqc(iprof)  = 0 !TODO
+
+               loop_p : DO ij = 1, inpfiles(jj)%nlev            
+                  
+                  IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) &
+                     & CYCLE
+
+                  IF (ldsatt) THEN
+
+                     IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
+                        &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. &
+                        &     ldt3d ) .OR. &
+                        & ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
+                        &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. &
+                        &     lds3d ) ) 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
+                     
+                     IF (ldsatt) THEN
+
+                        it3dt = ip3dt
+
+                     ELSE
+
+                        it3dt = it3dt + 1
+                        
+                     ENDIF
+
+                     ! Depth of T observation
+                     profdata%var(1)%vdep(it3dt) = &
+                        &                inpfiles(jj)%pdep(ij,ji)
+                     
+                     ! Depth of T observation QC
+                     profdata%var(1)%idqc(it3dt) = &
+                        &                inpfiles(jj)%idqc(ij,ji)
+                     
+                     ! Depth of T observation QC flags
+                     profdata%var(1)%idqcf(:,it3dt) = &
+                        &                inpfiles(jj)%idqcf(:,ij,ji)
+                     
+                     ! Profile index
+                     profdata%var(1)%nvpidx(it3dt) = iprof
+                     
+                     ! Vertical index in original profile
+                     profdata%var(1)%nvlidx(it3dt) = ij
+
+                     ! Profile potential T value
+                     IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
+                        & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
+                        profdata%var(1)%vobs(it3dt) = &
+                           &                inpfiles(jj)%pob(ij,ji,1)
+                        IF ( ldmod ) THEN
+                           profdata%var(1)%vmod(it3dt) = &
+                              &                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
+                     ELSE
+                        profdata%var(1)%vobs(it3dt) = fbrmdi
+                     ENDIF
+
+                     ! Profile T qc
+                     profdata%var(1)%nvqc(it3dt) = &
+                        & inpfiles(jj)%ivlqc(ij,ji,1)
+
+                     ! Profile T qc flags
+                     profdata%var(1)%nvqcf(:,it3dt) = &
+                        & inpfiles(jj)%ivlqcf(:,ij,ji,1)
+
+                     ! Profile insitu T value
+                     profdata%var(1)%vext(it3dt,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
+                     
+                     IF (ldsatt) THEN
+
+                        is3dt = ip3dt
+
+                     ELSE
+
+                        is3dt = is3dt + 1
+                        
+                     ENDIF
+
+                     ! Depth of S observation
+                     profdata%var(2)%vdep(is3dt) = &
+                        &                inpfiles(jj)%pdep(ij,ji)
+                     
+                     ! Depth of S observation QC
+                     profdata%var(2)%idqc(is3dt) = &
+                        &                inpfiles(jj)%idqc(ij,ji)
+                     
+                     ! Depth of S observation QC flags
+                     profdata%var(2)%idqcf(:,is3dt) = &
+                        &                inpfiles(jj)%idqcf(:,ij,ji)
+                     
+                     ! Profile index
+                     profdata%var(2)%nvpidx(is3dt) = iprof
+                     
+                     ! Vertical index in original profile
+                     profdata%var(2)%nvlidx(is3dt) = ij
+
+                     ! Profile S value
+                     IF ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
+                        & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
+                        profdata%var(2)%vobs(is3dt) = &
+                           &                inpfiles(jj)%pob(ij,ji,2)
+                        IF ( ldmod ) THEN
+                           profdata%var(2)%vmod(is3dt) = &
+                              &                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
+                     ELSE
+                        profdata%var(2)%vobs(is3dt) = fbrmdi
+                     ENDIF
+                     
+                     ! Profile S qc
+                     profdata%var(2)%nvqc(is3dt) = &
+                        & inpfiles(jj)%ivlqc(ij,ji,2)
+
+                     ! Profile S qc flags
+                     profdata%var(2)%nvqcf(:,is3dt) = &
+                        & inpfiles(jj)%ivlqcf(:,ij,ji,2)
+
+                  ENDIF
+            
+               END DO loop_p
+
+            ENDIF
+
+         ENDIF
+
+      END DO
+
+      !-----------------------------------------------------------------------
+      ! 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 )
+      
+      !-----------------------------------------------------------------------
+      ! Output number of observations.
+      !-----------------------------------------------------------------------
+      IF(lwp) THEN
+         WRITE(numout,*) 
+         WRITE(numout,'(1X,A)') 'Profile data'
+         WRITE(numout,'(1X,A)') '------------'
+         WRITE(numout,*) 
+         WRITE(numout,'(1X,A)') 'Profile T data'
+         WRITE(numout,'(1X,A)') '--------------'
+         DO ji = 0, ntyp1770
+            IF ( ityptmpp(ji+1) > 0 ) THEN
+               WRITE(numout,'(1X,A3,1X,A48,A3,I8)') ctypshort(ji), &
+                  & cwmonam1770(ji)(1:52),' = ', &
+                  & ityptmpp(ji+1)
+            ENDIF
+         END DO
+         WRITE(numout,'(1X,A)') &
+            & '---------------------------------------------------------------'
+         WRITE(numout,'(1X,A55,I8)') &
+            & 'Total profile T data                                 = ',&
+            & it3dtmpp
+         WRITE(numout,'(1X,A)') &
+            & '---------------------------------------------------------------'
+         WRITE(numout,*) 
+         WRITE(numout,'(1X,A)') 'Profile S data'
+         WRITE(numout,'(1X,A)') '--------------'
+         DO ji = 0, ntyp1770
+            IF ( itypsmpp(ji+1) > 0 ) THEN
+               WRITE(numout,'(1X,A3,1X,A48,A3,I8)') ctypshort(ji), &
+                  & cwmonam1770(ji)(1:52),' = ', &
+                  & itypsmpp(ji+1)
+            ENDIF
+         END DO
+         WRITE(numout,'(1X,A)') &
+            & '---------------------------------------------------------------'
+         WRITE(numout,'(1X,A55,I8)') &
+            & 'Total profile S data                                 = ',&
+            & is3dtmpp
+         WRITE(numout,'(1X,A)') &
+            & '---------------------------------------------------------------'
+         WRITE(numout,*) 
+      ENDIF
+      
+      IF (ldsatt) THEN
+         profdata%nvprot(1)    = ip3dt
+         profdata%nvprot(2)    = ip3dt
+         profdata%nvprotmpp(1) = ip3dtmpp
+         profdata%nvprotmpp(2) = ip3dtmpp
+      ELSE
+         profdata%nvprot(1)    = it3dt
+         profdata%nvprot(2)    = is3dt
+         profdata%nvprotmpp(1) = it3dtmpp
+         profdata%nvprotmpp(2) = is3dtmpp
+      ENDIF
+      profdata%nprof        = iprof
+
+      !-----------------------------------------------------------------------
+      ! Model level search
+      !-----------------------------------------------------------------------
+      IF ( ldt3d ) THEN
+         CALL obs_level_search( jpk, gdept_0, &
+            & profdata%nvprot(1), profdata%var(1)%vdep, &
+            & profdata%var(1)%mvk )
+      ENDIF
+      IF ( lds3d ) THEN
+         CALL obs_level_search( jpk, gdept_0, &
+            & profdata%nvprot(2), profdata%var(2)%vdep, &
+            & profdata%var(2)%mvk )
+      ENDIF
+      
+      !-----------------------------------------------------------------------
+      ! Set model equivalent to 99999
+      !-----------------------------------------------------------------------
+      IF ( .NOT. ldmod ) THEN
+         DO jvar = 1, kvars
+            profdata%var(jvar)%vmod(:) = fbrmdi
+         END DO
+      ENDIF
+      !-----------------------------------------------------------------------
+      ! Deallocate temporary data
+      !-----------------------------------------------------------------------
+      DEALLOCATE( ifileidx, iprofidx, zdat )
+
+      !-----------------------------------------------------------------------
+      ! Deallocate input data
+      !-----------------------------------------------------------------------
+      DO jj = 1, inobf
+         CALL dealloc_obfbdata( inpfiles(jj) )
+      END DO
+      DEALLOCATE( inpfiles )
+
+   END SUBROUTINE obs_rea_pro_dri
+
+END MODULE obs_read_prof
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_seaice.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_seaice.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_seaice.F90	(revision 2528)
@@ -0,0 +1,455 @@
+MODULE obs_read_seaice
+   !!======================================================================
+   !!                       ***  MODULE obs_read_seaice  ***
+   !! Observation diagnostics: Read the along track SEAICE data from
+   !!                          GHRSST or any SEAICE data from feedback files
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   obs_rea_seaice : Driver for reading seaice data from the GHRSST/feedback
+   !!----------------------------------------------------------------------
+
+   !! * Modules used   
+   USE par_kind                 ! Precision variables
+   USE in_out_manager           ! I/O manager
+   USE dom_oce                  ! Ocean space and time domain variables
+   USE obs_mpp                  ! MPP support routines for observation diagnostics
+   USE julian                   ! Julian date routines
+   USE obs_utils                ! Observation operator utility functions
+   USE obs_grid                 ! Grid search
+   USE obs_sort                 ! Sorting observation arrays
+   USE obs_surf_def             ! Surface observation definitions
+   USE obs_types                ! Observation type definitions
+   USE obs_seaice_io            ! I/O for seaice files
+   USE iom                      ! I/O of fields for Reynolds data
+   USE netcdf                   ! NetCDF library
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC obs_rea_seaice      ! Read the seaice observations from the point data
+   
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE obs_rea_seaice( kformat, &
+      &                    seaicedata, knumfiles, cfilenames, &
+      &                    kvars, kextr, kstp, ddobsini, ddobsend, &
+      &                    ldignmis, ldmod )
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_rea_seaice ***
+      !!
+      !! ** Purpose : Read from file the seaice data
+      !!
+      !! ** Method  : Depending on kformat either AVISO or
+      !!              feedback data files are read
+      !!
+      !! ** Action  : 
+      !!
+      !!
+      !! History :  
+      !!      ! :  2009-01 (K. Mogensen) Initial version based on old versions
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Arguments
+      INTEGER :: kformat   ! Format of input data 
+      !                    ! 0: Feedback
+      !                    ! 1: GHRSST
+      TYPE(obs_surf), INTENT(INOUT) :: &
+         & seaicedata     ! seaice data to be read
+      INTEGER, INTENT(IN) :: knumfiles   ! Number of corio format files to read in
+      CHARACTER(LEN=128), INTENT(IN) :: cfilenames(knumfiles) ! File names to read in
+      INTEGER, INTENT(IN) :: kvars    ! Number of variables in seaicedata
+      INTEGER, INTENT(IN) :: kextr    ! Number of extra fields for each var in seaicedata
+      INTEGER, INTENT(IN) :: kstp     ! Ocean time-step index
+      LOGICAL, INTENT(IN) :: ldignmis   ! Ignore missing files
+      LOGICAL, INTENT(IN) :: ldmod      ! Initialize model from input data
+      REAL(KIND=dp), INTENT(IN) :: ddobsini    ! Obs. ini time in YYYYMMDD.HHMMSS
+      REAL(KIND=dp), INTENT(IN) :: ddobsend    ! Obs. end time in YYYYMMDD.HHMMSS
+         
+      !! * Local declarations
+      CHARACTER(LEN=14), PARAMETER :: cpname='obs_rea_seaice'
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jk
+      INTEGER :: iflag
+      INTEGER :: inobf
+      INTEGER :: i_file_id
+      INTEGER :: inowin
+      INTEGER :: iyea
+      INTEGER :: imon
+      INTEGER :: iday
+      INTEGER :: ihou
+      INTEGER :: imin
+      INTEGER :: isec
+      INTEGER, DIMENSION(knumfiles) :: &
+         & irefdate
+      INTEGER :: iobsmpp
+      INTEGER, PARAMETER :: iseaicemaxtype = 1024
+      INTEGER, DIMENSION(0:iseaicemaxtype) :: &
+         & ityp, &
+         & itypmpp
+      INTEGER, DIMENSION(:), ALLOCATABLE :: &
+         & iobsi,    &
+         & iobsj,    &
+         & iproc,    &
+         & iindx,    &
+         & ifileidx, &
+         & iseaiceidx
+      INTEGER :: itype
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: &
+         & zphi, &
+         & zlam
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: &
+         & zdat
+      LOGICAL :: llvalprof
+      TYPE(obfbdata), POINTER, DIMENSION(:) :: &
+         & inpfiles
+      REAL(dp), DIMENSION(knumfiles) :: &
+         & djulini, &
+         & djulend
+      INTEGER :: iobs
+      INTEGER :: iobstot
+      CHARACTER(len=8) :: cl_refdate
+   
+      ! Local initialization
+      iobs = 0
+ 
+      !-----------------------------------------------------------------------
+      ! Check data the model part is just with feedback data files
+      !-----------------------------------------------------------------------
+      IF ( ldmod .AND. ( kformat /= 0 ) ) THEN
+         CALL ctl_stop( 'Model can only be read from feedback data' )
+         RETURN
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Count the number of files needed and allocate the obfbdata type
+      !-----------------------------------------------------------------------
+      
+      inobf = knumfiles
+      
+      ALLOCATE( inpfiles(inobf) )
+
+      seaice_files : DO jj = 1, inobf
+          
+         !---------------------------------------------------------------------
+         ! Prints
+         !---------------------------------------------------------------------
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' obs_rea_seaice : Reading from file = ', &
+               & TRIM( TRIM( cfilenames(jj) ) )
+            WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+            WRITE(numout,*)
+         ENDIF
+
+         !---------------------------------------------------------------------
+         !  Initialization: Open file and get dimensions only
+         !---------------------------------------------------------------------
+         
+         iflag = nf90_open( TRIM( TRIM( cfilenames(jj) ) ), nf90_nowrite, &
+            &                      i_file_id )
+         
+         IF ( iflag /= nf90_noerr ) THEN
+
+            IF ( ldignmis ) THEN
+               inpfiles(jj)%nobs = 0
+               CALL ctl_warn( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
+                  &           ' not found' )
+            ELSE 
+               CALL ctl_stop( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
+                  &           ' not found' )
+            ENDIF
+
+         ELSE 
+            
+            !------------------------------------------------------------------
+            !  Close the file since it is opened in read_proffile
+            !------------------------------------------------------------------
+            
+            iflag = nf90_close( i_file_id )
+
+            !------------------------------------------------------------------
+            !  Read the profile file into inpfiles
+            !------------------------------------------------------------------
+            IF ( kformat == 0 ) THEN
+               CALL init_obfbdata( inpfiles(jj) )
+               IF(lwp) THEN
+                  WRITE(numout,*)
+                  WRITE(numout,*)'Reading from feedback file :', &
+                     &           TRIM( cfilenames(jj) )
+               ENDIF
+               CALL read_obfbdata( TRIM( cfilenames(jj) ), inpfiles(jj), &
+                  &                ldgrid = .TRUE. )
+               IF ( ldmod .AND. ( ( inpfiles(jj)%nadd == 0 ) .OR.&
+                  &               ( inpfiles(jj)%next < 2 ) ) ) THEN
+                  CALL ctl_stop( 'Model not in input data' )
+                  RETURN
+               ENDIF
+            ELSEIF ( kformat == 1) THEN
+               CALL read_seaice( TRIM( cfilenames(jj) ), inpfiles(jj), &
+               &                 numout, lwp, .TRUE. )
+            ELSE
+               CALL ctl_stop( 'File format unknown' )
+            ENDIF
+
+            !------------------------------------------------------------------
+            !  Change longitude (-180,180)
+            !------------------------------------------------------------------
+
+            DO ji = 1, inpfiles(jj)%nobs 
+
+               IF ( inpfiles(jj)%plam(ji) < -180. ) &
+                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) + 360.
+
+               IF ( inpfiles(jj)%plam(ji) >  180. ) &
+                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) - 360.
+
+            END DO
+
+            !------------------------------------------------------------------
+            !  Calculate the date  (change eventually)
+            !------------------------------------------------------------------
+            cl_refdate=inpfiles(jj)%cdjuldref(1:8)
+            READ(cl_refdate,'(I8)') irefdate(jj)
+            
+            CALL ddatetoymdhms( ddobsini, iyea, imon, iday, ihou, imin, isec )
+            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulini(jj), &
+               &           krefdate = irefdate(jj) )
+            CALL ddatetoymdhms( ddobsend, iyea, imon, iday, ihou, imin, isec )
+            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulend(jj), &
+               &           krefdate = irefdate(jj) )
+            IF ( inpfiles(jj)%nobs > 0 ) THEN
+               inpfiles(jj)%iproc = -1
+               inpfiles(jj)%iobsi = -1
+               inpfiles(jj)%iobsj = -1
+            ENDIF
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+               ENDIF
+            END DO
+            ALLOCATE( zlam(inowin)  )
+            ALLOCATE( zphi(inowin)  )
+            ALLOCATE( iobsi(inowin) )
+            ALLOCATE( iobsj(inowin) )
+            ALLOCATE( iproc(inowin) )
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+                  zlam(inowin) = inpfiles(jj)%plam(ji)
+                  zphi(inowin) = inpfiles(jj)%pphi(ji)
+               ENDIF
+            END DO
+
+            CALL obs_grid_search( inowin, zlam, zphi, iobsi, iobsj, iproc, 'T' )
+
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+                  inpfiles(jj)%iproc(ji,1) = iproc(inowin)
+                  inpfiles(jj)%iobsi(ji,1) = iobsi(inowin)
+                  inpfiles(jj)%iobsj(ji,1) = iobsj(inowin)
+               ENDIF
+            END DO
+            DEALLOCATE( zlam, zphi, iobsi, iobsj, iproc )
+
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  IF ( nproc == 0 ) THEN
+                     IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
+                  ELSE
+                     IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
+                  ENDIF
+                  llvalprof = .FALSE.
+                  IF ( ( inpfiles(jj)%ivlqc(1,ji,1) == 1 ) .OR. &
+                     & ( inpfiles(jj)%ivlqc(1,ji,1) == 2 ) ) THEN
+                     iobs = iobs + 1
+                  ENDIF
+               ENDIF
+            END DO
+
+         ENDIF
+
+      END DO seaice_files
+
+      !-----------------------------------------------------------------------
+      ! Get the time ordered indices of the input data
+      !-----------------------------------------------------------------------
+
+      !---------------------------------------------------------------------
+      !  Loop over input data files to count total number of profiles
+      !---------------------------------------------------------------------
+      iobstot = 0
+      DO jj = 1, inobf
+         DO ji = 1, inpfiles(jj)%nobs
+            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+               iobstot = iobstot + 1
+            ENDIF
+         END DO
+      END DO
+
+      ALLOCATE( iindx(iobstot), ifileidx(iobstot), &
+         &      iseaiceidx(iobstot), zdat(iobstot) )
+      jk = 0
+      DO jj = 1, inobf
+         DO ji = 1, inpfiles(jj)%nobs
+            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+               jk = jk + 1
+               ifileidx(jk) = jj
+               iseaiceidx(jk) = ji
+               zdat(jk)     = inpfiles(jj)%ptim(ji)
+            ENDIF
+         END DO
+      END DO
+      CALL sort_dp_indx( iobstot, &
+         &               zdat,     &
+         &               iindx   )
+      
+      CALL obs_surf_alloc( seaicedata, iobs, kvars, kextr, kstp )
+      
+      ! * Read obs/positions, QC, all variable and assign to seaicedata
+ 
+      iobs = 0
+
+      ityp   (:) = 0
+      itypmpp(:) = 0
+      
+      DO jk = 1, iobstot
+         
+         jj = ifileidx(iindx(jk))
+         ji = iseaiceidx(iindx(jk))
+         IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND.  &
+            & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN
+            
+            IF ( nproc == 0 ) THEN
+               IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
+            ELSE
+               IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
+            ENDIF
+            
+            ! Set observation information
+            
+            IF ( ( inpfiles(jj)%ivlqc(1,ji,1) == 1 ) .OR. &
+               & ( inpfiles(jj)%ivlqc(1,ji,1) == 2 ) ) THEN
+
+               iobs = iobs + 1
+
+               CALL jul2greg( isec,                   &
+                  &           imin,                   &
+                  &           ihou,                   &
+                  &           iday,                   &
+                  &           imon,                   &
+                  &           iyea,                   &
+                  &           inpfiles(jj)%ptim(ji), &
+                  &           irefdate(jj) )
+
+
+               ! seaice time coordinates
+               seaicedata%nyea(iobs) = iyea
+               seaicedata%nmon(iobs) = imon
+               seaicedata%nday(iobs) = iday
+               seaicedata%nhou(iobs) = ihou
+               seaicedata%nmin(iobs) = imin
+               
+               ! seaice space coordinates
+               seaicedata%rlam(iobs) = inpfiles(jj)%plam(ji)
+               seaicedata%rphi(iobs) = inpfiles(jj)%pphi(ji)
+
+               ! Coordinate search parameters
+               seaicedata%mi  (iobs) = inpfiles(jj)%iobsi(ji,1)
+               seaicedata%mj  (iobs) = inpfiles(jj)%iobsj(ji,1)
+               
+               ! Instrument type
+               READ( inpfiles(jj)%cdtyp(ji), '(I4)' ) itype
+               seaicedata%ntyp(iobs) = itype
+               IF ( itype < iseaicemaxtype + 1 ) THEN
+                  ityp(itype+1) = ityp(itype+1) + 1
+               ELSE
+                  IF(lwp)WRITE(numout,*)'WARNING:Increase iseaicemaxtype in ',&
+                     &                  cpname
+               ENDIF
+
+               ! Bookkeeping data to match observations
+               seaicedata%nsidx(iobs) = iobs
+               seaicedata%nsfil(iobs) = iindx(jk)
+
+               ! QC flags
+               seaicedata%nqc(iobs) = inpfiles(jj)%ivqc(ji,1)
+
+               ! Observed value
+               seaicedata%robs(iobs,1) = inpfiles(jj)%pob(1,ji,1)
+
+
+               ! Model and MDT is set to fbrmdi unless read from file
+               IF ( ldmod ) THEN
+                  seaicedata%rmod(iobs,1) = inpfiles(jj)%padd(1,ji,1,1)
+               ELSE
+                  seaicedata%rmod(iobs,1) = fbrmdi
+               ENDIF
+            ENDIF
+         ENDIF
+
+      END DO
+
+      !-----------------------------------------------------------------------
+      ! Sum up over processors
+      !-----------------------------------------------------------------------
+      
+      CALL obs_mpp_sum_integer( iobs, iobsmpp )
+      
+      !-----------------------------------------------------------------------
+      ! Output number of observations.
+      !-----------------------------------------------------------------------
+      IF (lwp) THEN
+
+         WRITE(numout,*)
+         WRITE(numout,'(1X,A)')'Seaice data types'
+         WRITE(numout,'(1X,A)')'-----------------'
+         DO jj = 1,8
+            IF ( itypmpp(jj) > 0 ) THEN
+               WRITE(numout,'(1X,A4,I4,A3,I10)')'Type ', jj,' = ',itypmpp(jj)
+            ENDIF
+         END DO
+         WRITE(numout,'(1X,A50)')'--------------------------------------------------'
+         WRITE(numout,'(1X,A40,I10)')'Total                                 = ',iobsmpp
+         WRITE(numout,*)
+
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Deallocate temporary data
+      !-----------------------------------------------------------------------
+      DEALLOCATE( ifileidx, iseaiceidx, zdat )
+
+      !-----------------------------------------------------------------------
+      ! Deallocate input data
+      !-----------------------------------------------------------------------
+      DO jj = 1, inobf
+         CALL dealloc_obfbdata( inpfiles(jj) )
+      END DO
+      DEALLOCATE( inpfiles )
+
+   END SUBROUTINE obs_rea_seaice
+
+END MODULE obs_read_seaice
+
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_sla.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_sla.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_sla.F90	(revision 2528)
@@ -0,0 +1,539 @@
+MODULE obs_read_sla
+   !!======================================================================
+   !!                       ***  MODULE obs_read_sla  ***
+   !! Observation diagnostics: Read the along track SLA data from
+   !!                          the AVISO/CLS database or any SLA data 
+   !!                          from feedback files
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   obs_rea_sla : Driver for reading SLA data from the AVISO/CLS/feedback
+   !!----------------------------------------------------------------------
+
+   !! * Modules used   
+   USE par_kind                 ! Precision variables
+   USE in_out_manager           ! I/O manager
+   USE dom_oce                  ! Ocean space and time domain variables
+   USE obs_mpp                  ! MPP support routines for observation diagnostics
+   USE julian                   ! Julian date routines
+   USE obs_utils                ! Observation operator utility functions
+   USE obs_grid                 ! Grid search
+   USE obs_sort                 ! Sorting observation arrays
+   USE obs_surf_def             ! Surface observation definitions
+   USE obs_types                ! Observation type definitions
+   USE obs_sla_io               ! I/O for sla files
+   USE netcdf                   ! NetCDF library
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC obs_rea_sla  ! Read the SLA observations from the AVISO/SLA database
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE obs_rea_sla( kformat, &
+      &                    sladata, knumfiles, cfilenames, &
+      &                    kvars, kextr, kstp, ddobsini, ddobsend, &
+      &                    ldignmis, ldmod, ldobstd )
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_rea_sla ***
+      !!
+      !! ** Purpose : Read from file the SLA data
+      !!
+      !! ** Method  : Depending on kformat either AVISO or
+      !!              feedback data files are read
+      !!
+      !! ** Action  : 
+      !!
+      !!
+      !! History :  
+      !!      ! :  2009-01 (K. Mogensen) Initial version based on old versions
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Arguments
+      INTEGER :: kformat    ! Format of input data
+      !                     ! 0: Feedback
+      !                     ! 1: AVISO
+      TYPE(obs_surf), INTENT(INOUT) :: sladata    ! SLA data to be read
+      INTEGER, INTENT(IN) :: knumfiles      ! Number of files to read in
+      CHARACTER(LEN=128), INTENT(IN) ::  &
+         & cfilenames(knumfiles) ! File names to read in
+      INTEGER, INTENT(IN) :: kvars     ! Number of variables in sladata
+      INTEGER, INTENT(IN) :: kextr     ! Number of extra fields for each var in sladata
+      INTEGER, INTENT(IN) :: kstp      ! Ocean time-step index
+      LOGICAL, INTENT(IN) :: ldignmis    ! Ignore missing files
+      LOGICAL, INTENT(IN) :: ldmod       ! Initialize model from input data
+      LOGICAL, INTENT(INOUT), optional :: &
+         & ldobstd        ! Read observation standard deviation from fb. file
+      REAL(KIND=dp), INTENT(IN) :: ddobsini  ! Obs. ini time in YYYYMMDD.HHMMSS
+      REAL(KIND=dp), INTENT(IN) :: ddobsend  ! Obs. end time in YYYYMMDD.HHMMSS
+         
+      !! * Local declarations
+      CHARACTER(LEN=11), PARAMETER :: cpname='obs_rea_sla'
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jk
+      INTEGER :: iflag
+      INTEGER :: inobf
+      INTEGER :: i_file_id
+      INTEGER :: inowin
+      INTEGER :: iyea
+      INTEGER :: imon
+      INTEGER :: iday
+      INTEGER :: ihou
+      INTEGER :: imin
+      INTEGER :: isec
+      INTEGER, DIMENSION(knumfiles) :: &
+         & irefdate
+      INTEGER :: iobsmpp
+      INTEGER, DIMENSION(imaxmissions+1) :: &
+         & ityp, &
+         & itypmpp
+      INTEGER, DIMENSION(:), ALLOCATABLE :: &
+         & iobsi,    &
+         & iobsj,    &
+         & iproc,    &
+         & iindx,    &
+         & ifileidx, &
+         & islaidx
+      INTEGER :: itype 
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: &
+         & zphi, &
+         & zlam
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: &
+         & zdat
+      LOGICAL :: llvalprof
+      LOGICAL :: llobstd
+      TYPE(obfbdata), POINTER, DIMENSION(:) :: &
+         & inpfiles
+      REAL(dp), DIMENSION(knumfiles) :: &
+         & djulini, &
+         & djulend
+      INTEGER, DIMENSION(knumfiles) :: &
+         & iobspos, &
+         & iobcpos
+      INTEGER :: iobs
+      INTEGER :: iobstot
+      CHARACTER(len=8) :: cl_refdate
+   
+      ! Local initialization
+      iobs = 0
+      IF ( PRESENT(ldobstd) ) THEN
+         IF (.NOT.ldmod) THEN
+            llobstd = .false.
+         ELSE
+            llobstd = ldobstd
+         ENDIF
+      ELSE
+         llobstd = .FALSE.
+      ENDIF
+ 
+      !-----------------------------------------------------------------------
+      ! Check that the model part is just with feedback data files
+      !-----------------------------------------------------------------------
+      IF ( ldmod .AND. ( kformat /= 0 ) ) THEN
+         CALL ctl_stop( 'Model can only be read from feedback data' )
+         RETURN
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Check that the prescribed obs err is just with feedback data files
+      !-----------------------------------------------------------------------
+      IF ( llobstd .AND. ( kformat /= 0 ) ) THEN
+         CALL ctl_stop( 'Observation error can only be read from feedback files' )
+         RETURN
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Count the number of files needed and allocate the obfbdata type
+      !-----------------------------------------------------------------------
+      
+      inobf = knumfiles
+      
+      ALLOCATE( inpfiles(inobf) )
+
+      sla_files : DO jj = 1, inobf
+          
+         !---------------------------------------------------------------------
+         ! Prints
+         !---------------------------------------------------------------------
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' obs_rea_sla : Reading from file = ', &
+               & TRIM( TRIM( cfilenames(jj) ) )
+            WRITE(numout,*) ' ~~~~~~~~~~~'
+            WRITE(numout,*)
+         ENDIF
+
+         !---------------------------------------------------------------------
+         !  Initialization: Open file and get dimensions only
+         !---------------------------------------------------------------------
+         
+         iflag = nf90_open( TRIM( TRIM( cfilenames(jj) ) ), nf90_nowrite, &
+            &                      i_file_id )
+         
+         IF ( iflag /= nf90_noerr ) THEN
+
+            IF ( ldignmis ) THEN
+               inpfiles(jj)%nobs = 0
+               CALL ctl_warn( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
+                  &           ' not found' )
+            ELSE 
+               CALL ctl_stop( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
+                  &           ' not found' )
+            ENDIF
+
+         ELSE 
+            
+            !------------------------------------------------------------------
+            !  Close the file since it is opened in read_proffile
+            !------------------------------------------------------------------
+            
+            iflag = nf90_close( i_file_id )
+
+            !------------------------------------------------------------------
+            !  Read the profile file into inpfiles
+            !------------------------------------------------------------------
+            IF ( kformat == 0 ) THEN
+               CALL init_obfbdata( inpfiles(jj) )
+               IF(lwp) THEN
+                  WRITE(numout,*)
+                  WRITE(numout,*)'Reading from feedback file :', &
+                     &           TRIM( cfilenames(jj) )
+               ENDIF
+               CALL read_obfbdata( TRIM( cfilenames(jj) ), inpfiles(jj), &
+                  &                ldgrid = .TRUE. )
+               IF ( inpfiles(jj)%nvar < 1 ) THEN
+                  CALL ctl_stop( 'Feedback format error' )
+                  RETURN
+               ENDIF
+               IF ( TRIM(inpfiles(jj)%cname(1)) /= 'SLA' ) THEN
+                  CALL ctl_stop( 'Feedback format error' )
+                  RETURN
+               ENDIF 
+               IF ( ldmod .AND. ( ( inpfiles(jj)%nadd == 0 ) .OR.&
+                  &               ( inpfiles(jj)%next == 0 ) ) ) THEN
+                  CALL ctl_stop( 'Model not in input data' )
+                  RETURN
+               ENDIF
+            ELSEIF ( kformat == 1) THEN
+               CALL read_avisofile( TRIM( cfilenames(jj) ), inpfiles(jj), &
+               &                    numout, lwp, .TRUE. )
+            ELSE
+               CALL ctl_stop( 'File format unknown' )
+            ENDIF
+
+            !------------------------------------------------------------------
+            !  Change longitude (-180,180)
+            !------------------------------------------------------------------
+
+            DO ji = 1, inpfiles(jj)%nobs 
+
+               IF ( inpfiles(jj)%plam(ji) < -180. ) &
+                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) + 360.
+
+               IF ( inpfiles(jj)%plam(ji) >  180. ) &
+                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) - 360.
+
+            END DO
+
+            !------------------------------------------------------------------
+            !  Calculate the date  (change eventually)
+            !------------------------------------------------------------------
+            cl_refdate=inpfiles(jj)%cdjuldref(1:8)
+            READ(cl_refdate,'(I8)') irefdate(jj)
+            
+            CALL ddatetoymdhms( ddobsini, iyea, imon, iday, ihou, imin, isec )
+            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulini(jj), &
+               &           krefdate = irefdate(jj) )
+            CALL ddatetoymdhms( ddobsend, iyea, imon, iday, ihou, imin, isec )
+            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulend(jj), &
+               &           krefdate = irefdate(jj) )
+            IF ( inpfiles(jj)%nobs > 0 ) THEN
+               inpfiles(jj)%iproc = -1
+               inpfiles(jj)%iobsi = -1
+               inpfiles(jj)%iobsj = -1
+            ENDIF
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+               IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+               ENDIF
+            END DO
+            ALLOCATE( zlam(inowin)  )
+            ALLOCATE( zphi(inowin)  )
+            ALLOCATE( iobsi(inowin) )
+            ALLOCATE( iobsj(inowin) )
+            ALLOCATE( iproc(inowin) )
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+               IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+                  zlam(inowin) = inpfiles(jj)%plam(ji)
+                  zphi(inowin) = inpfiles(jj)%pphi(ji)
+               ENDIF
+            END DO
+
+            CALL obs_grid_search( inowin, zlam, zphi, iobsi, iobsj, iproc, 'T' )
+
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+               IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+                  inpfiles(jj)%iproc(ji,1) = iproc(inowin)
+                  inpfiles(jj)%iobsi(ji,1) = iobsi(inowin)
+                  inpfiles(jj)%iobsj(ji,1) = iobsj(inowin)
+               ENDIF
+            END DO
+            DEALLOCATE( zlam, zphi, iobsi, iobsj, iproc )
+
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+               IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  IF ( nproc == 0 ) THEN
+                     IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
+                  ELSE
+                     IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
+                  ENDIF
+                  llvalprof = .FALSE.
+                  IF ( ( inpfiles(jj)%ivlqc(1,ji,1) == 1 ) .OR. &
+                     & ( inpfiles(jj)%ivlqc(1,ji,1) == 2 ) ) THEN
+                     iobs = iobs + 1
+                  ENDIF
+               ENDIF
+            END DO
+
+         ENDIF
+      
+      END DO sla_files
+
+      IF (llobstd) THEN
+         
+         DO jj = 1, inobf
+            iobspos(jj) = -1
+            iobcpos(jj) = -1
+            DO ji = 1,inpfiles(jj)%nadd
+               IF ( TRIM(inpfiles(jj)%caddname(ji)) == 'OSTD' ) THEN
+                  iobspos(jj)=ji
+               ENDIF
+               IF ( TRIM(inpfiles(jj)%caddname(ji)) == 'OCNT' ) THEN
+                  iobcpos(jj)=ji
+               ENDIF
+            END DO
+         END DO
+         llobstd = ( ( MINVAL(iobspos) > 0 ) .AND. ( MINVAL(iobcpos) > 0 ) )
+         IF (llobstd) THEN
+            IF (lwp) WRITE(numout,*)'SLA superobs information present.'
+         ELSE
+            IF (lwp) WRITE(numout,*)'SLA superobs information not present.'
+         ENDIF
+
+      ENDIF
+      
+      !-----------------------------------------------------------------------
+      ! Get the time ordered indices of the input data
+      !-----------------------------------------------------------------------
+
+      !---------------------------------------------------------------------
+      !  Loop over input data files to count total number of profiles
+      !---------------------------------------------------------------------
+      iobstot = 0
+      DO jj = 1, inobf
+         DO ji = 1, inpfiles(jj)%nobs
+            IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+            IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE
+            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+               iobstot = iobstot + 1
+            ENDIF
+         END DO
+      END DO
+
+      ALLOCATE( iindx(iobstot), ifileidx(iobstot), &
+         &      islaidx(iobstot), zdat(iobstot) )
+      jk = 0
+      DO jj = 1, inobf
+         DO ji = 1, inpfiles(jj)%nobs
+            IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+            IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE
+            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+               jk = jk + 1
+               ifileidx(jk) = jj
+               islaidx(jk) = ji
+               zdat(jk)     = inpfiles(jj)%ptim(ji)
+            ENDIF
+         END DO
+      END DO
+      CALL sort_dp_indx( iobstot, &
+         &               zdat,     &
+         &               iindx   )
+      
+      CALL obs_surf_alloc( sladata, iobs, kvars, kextr, kstp )
+      
+      ! * Read obs/positions, QC, all variable and assign to sladata
+ 
+      iobs = 0
+
+      ityp   (:) = 0
+      itypmpp(:) = 0
+      
+      DO jk = 1, iobstot
+         
+         jj = ifileidx(iindx(jk))
+         ji = islaidx(iindx(jk))
+
+         IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+         IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE
+
+         IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND.  &
+            & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN
+            
+            IF ( nproc == 0 ) THEN
+               IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
+            ELSE
+               IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
+            ENDIF
+            
+            ! Set observation information
+            
+            IF ( ( inpfiles(jj)%ivlqc(1,ji,1) == 1 ) .OR. &
+               & ( inpfiles(jj)%ivlqc(1,ji,1) == 2 ) ) THEN
+
+               iobs = iobs + 1
+
+               CALL jul2greg( isec,                   &
+                  &           imin,                   &
+                  &           ihou,                   &
+                  &           iday,                   &
+                  &           imon,                   &
+                  &           iyea,                   &
+                  &           inpfiles(jj)%ptim(ji), &
+                  &           irefdate(jj) )
+
+
+               ! SLA time coordinates
+               sladata%nyea(iobs) = iyea
+               sladata%nmon(iobs) = imon
+               sladata%nday(iobs) = iday
+               sladata%nhou(iobs) = ihou
+               sladata%nmin(iobs) = imin
+               
+               ! SLA space coordinates
+               sladata%rlam(iobs) = inpfiles(jj)%plam(ji)
+               sladata%rphi(iobs) = inpfiles(jj)%pphi(ji)
+
+               ! Coordinate search parameters
+               sladata%mi  (iobs) = inpfiles(jj)%iobsi(ji,1)
+               sladata%mj  (iobs) = inpfiles(jj)%iobsj(ji,1)
+               
+               ! Instrument type
+               READ( inpfiles(jj)%cdtyp(ji), '(I4)' ) itype
+               sladata%ntyp(iobs) = itype
+               ityp(itype+1) = ityp(itype+1) + 1
+
+               ! Identifier
+               sladata%cwmo(iobs) = inpfiles(jj)%cdwmo(ji)
+
+               ! Bookkeeping data to match observations
+               sladata%nsidx(iobs) = iobs
+               sladata%nsfil(iobs) = iindx(jk)
+
+               ! QC flags
+               sladata%nqc(iobs) = inpfiles(jj)%ivqc(ji,1)
+
+               ! Observed value
+               sladata%robs(iobs,1) = inpfiles(jj)%pob(1,ji,1)
+
+
+               ! Model and MDT is set to fbrmdi unless read from file
+               IF ( ldmod ) THEN
+                  sladata%rmod(iobs,1) = inpfiles(jj)%padd(1,ji,1,1)
+                  sladata%rext(iobs,1) = inpfiles(jj)%padd(1,ji,2,1)
+                  sladata%rext(iobs,2) = inpfiles(jj)%pext(1,ji,1)
+                  IF (llobstd) THEN
+                     sladata%rext(iobs,3) = &
+                        & inpfiles(jj)%padd(1,ji,iobspos(jj),1)
+                     sladata%rext(iobs,4) = &
+                        & inpfiles(jj)%padd(1,ji,iobcpos(jj),1)
+                  ENDIF
+               ELSE
+                  sladata%rmod(iobs,1) = fbrmdi
+                  sladata%rext(iobs,:) = fbrmdi
+               ENDIF
+
+            ENDIF
+         ENDIF
+
+      END DO
+
+      !-----------------------------------------------------------------------
+      ! Sum up over processors
+      !-----------------------------------------------------------------------
+      
+      CALL obs_mpp_sum_integer( iobs, iobsmpp )
+      CALL obs_mpp_sum_integers( ityp, itypmpp, imaxmissions + 1 )
+      
+      !-----------------------------------------------------------------------
+      ! Output number of observations.
+      !-----------------------------------------------------------------------
+      IF (lwp) THEN
+
+         WRITE(numout,*)
+         WRITE(numout,'(1X,A)')'Altimeter satellites'
+         WRITE(numout,'(1X,A)')'--------------------'
+         DO jj = 1,8
+            IF ( itypmpp(jj) > 0 ) THEN
+               WRITE(numout,'(1X,A38,A2,I10)')calttyp(jj-1),'= ',itypmpp(jj)
+            ENDIF
+         END DO
+         WRITE(numout,'(1X,A50)')'--------------------------------------------------'
+         WRITE(numout,'(1X,A40,I10)')'Total                                 = ',iobsmpp
+         WRITE(numout,*)
+
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Deallocate temporary data
+      !-----------------------------------------------------------------------
+      DEALLOCATE( ifileidx, islaidx, zdat )
+
+      !-----------------------------------------------------------------------
+      ! Deallocate input data
+      !-----------------------------------------------------------------------
+      DO jj = 1, inobf
+         CALL dealloc_obfbdata( inpfiles(jj) )
+      END DO
+      DEALLOCATE( inpfiles )
+
+      !-----------------------------------------------------------------------
+      ! Reset ldobstd if the data is present
+      !-----------------------------------------------------------------------
+      IF ( PRESENT(ldobstd) ) THEN
+         ldobstd = llobstd
+      ENDIF
+
+   END SUBROUTINE obs_rea_sla
+
+END MODULE obs_read_sla
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_sst.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_sst.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_sst.F90	(revision 2528)
@@ -0,0 +1,762 @@
+MODULE obs_read_sst
+   !!======================================================================
+   !!                       ***  MODULE obs_read_sst  ***
+   !! Observation diagnostics: Read the SST data from the GHRSST database 
+   !!                          or any SST data from feedback files
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   obs_rea_sst : Driver for reading SST data from the GHRSST/feedback
+   !!   obs_rea_sst_rey : Driver for reading SST data from Reynolds
+   !!----------------------------------------------------------------------
+
+   !! * Modules used   
+   USE par_kind                 ! Precision variables
+   USE in_out_manager           ! I/O manager
+   USE dom_oce                  ! Ocean space and time domain variables
+   USE obs_mpp                  ! MPP support routines for observation diagnostics
+   USE julian                   ! Julian date routines
+   USE obs_utils                ! Observation operator utility functions
+   USE obs_grid                 ! Grid search
+   USE obs_sort                 ! Sorting observation arrays
+   USE obs_surf_def             ! Surface observation definitions
+   USE obs_types                ! Observation type definitions
+   USE obs_sst_io               ! I/O for sst files
+   USE iom                      ! I/O of fields for Reynolds data
+   USE netcdf                   ! NetCDF library
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC obs_rea_sst      ! Read the SST observations from the point data
+   PUBLIC obs_rea_sst_rey  ! Read the gridded Reynolds SST 
+   
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE obs_rea_sst( kformat, &
+      &                    sstdata, knumfiles, cfilenames, &
+      &                    kvars, kextr, kstp, ddobsini, ddobsend, &
+      &                    ldignmis, ldmod )
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_rea_sst ***
+      !!
+      !! ** Purpose : Read from file the SST data
+      !!
+      !! ** Method  : Depending on kformat either AVISO or
+      !!              feedback data files are read
+      !!
+      !! ** Action  : 
+      !!
+      !!
+      !! History :  
+      !!      ! :  2009-01 (K. Mogensen) Initial version based on old versions
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Arguments
+      INTEGER :: kformat   ! Format of input data
+      !                    ! 0: Feedback
+      !                    ! 1: GHRSST
+      TYPE(obs_surf), INTENT(INOUT) :: sstdata   ! SST data to be read
+      INTEGER, INTENT(IN) :: knumfiles    ! Number of corio format files to read in
+      CHARACTER(LEN=128), INTENT(IN) :: cfilenames(knumfiles) ! File names to read in
+      INTEGER, INTENT(IN) :: kvars      ! Number of variables in sstdata
+      INTEGER, INTENT(IN) :: kextr      ! Number of extra fields for each var in sstdata
+      INTEGER, INTENT(IN) :: kstp       ! Ocean time-step index
+      LOGICAL, INTENT(IN) :: ldignmis   ! Ignore missing files
+      LOGICAL, INTENT(IN) :: ldmod      ! Initialize model from input data
+      REAL(KIND=dp), INTENT(IN) :: ddobsini   ! Obs. ini time in YYYYMMDD.HHMMSS
+      REAL(KIND=dp), INTENT(IN) :: ddobsend   ! Obs. end time in YYYYMMDD.HHMMSS
+         
+      !! * Local declarations
+      CHARACTER(LEN=11), PARAMETER :: cpname='obs_rea_sst'
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jk
+      INTEGER :: iflag
+      INTEGER :: inobf
+      INTEGER :: i_file_id
+      INTEGER :: inowin
+      INTEGER :: iyea
+      INTEGER :: imon
+      INTEGER :: iday
+      INTEGER :: ihou
+      INTEGER :: imin
+      INTEGER :: isec
+      INTEGER, DIMENSION(knumfiles) :: irefdate
+      INTEGER :: iobsmpp
+      INTEGER, PARAMETER :: isstmaxtype = 1024
+      INTEGER, DIMENSION(0:isstmaxtype) :: &
+         & ityp, &
+         & itypmpp
+      INTEGER, DIMENSION(:), ALLOCATABLE :: &
+         & iobsi,    &
+         & iobsj,    &
+         & iproc,    &
+         & iindx,    &
+         & ifileidx, &
+         & isstidx
+      INTEGER :: itype
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: &
+         & zphi, &
+         & zlam
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: &
+         & zdat
+      LOGICAL :: llvalprof
+      TYPE(obfbdata), POINTER, DIMENSION(:) :: &
+         & inpfiles
+      REAL(dp), DIMENSION(knumfiles) :: &
+         & djulini, &
+         & djulend
+      INTEGER :: iobs
+      INTEGER :: iobstot
+      CHARACTER(len=8) :: cl_refdate
+   
+      ! Local initialization
+      iobs = 0
+ 
+      !-----------------------------------------------------------------------
+      ! Check data the model part is just with feedback data files
+      !-----------------------------------------------------------------------
+      IF ( ldmod .AND. ( kformat /= 0 ) ) THEN
+         CALL ctl_stop( 'Model can only be read from feedback data' )
+         RETURN
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Count the number of files needed and allocate the obfbdata type
+      !-----------------------------------------------------------------------
+      
+      inobf = knumfiles
+      
+      ALLOCATE( inpfiles(inobf) )
+
+      sst_files : DO jj = 1, inobf
+
+         CALL init_obfbdata( inpfiles(jj) )
+          
+         !---------------------------------------------------------------------
+         ! Prints
+         !---------------------------------------------------------------------
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' obs_rea_sst : Reading from file = ', &
+               & TRIM( TRIM( cfilenames(jj) ) )
+            WRITE(numout,*) ' ~~~~~~~~~~~'
+            WRITE(numout,*)
+         ENDIF
+
+         !---------------------------------------------------------------------
+         !  Initialization: Open file and get dimensions only
+         !---------------------------------------------------------------------
+         
+         iflag = nf90_open( TRIM( TRIM( cfilenames(jj) ) ), nf90_nowrite, &
+            &                      i_file_id )
+         
+         IF ( iflag /= nf90_noerr ) THEN
+
+            IF ( ldignmis ) THEN
+               inpfiles(jj)%nobs = 0
+               CALL ctl_warn( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
+                  &           ' not found' )
+            ELSE 
+               CALL ctl_stop( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
+                  &           ' not found' )
+            ENDIF
+
+         ELSE 
+            
+            !------------------------------------------------------------------
+            !  Close the file since it is opened in read_proffile
+            !------------------------------------------------------------------
+            
+            iflag = nf90_close( i_file_id )
+
+            !------------------------------------------------------------------
+            !  Read the profile file into inpfiles
+            !------------------------------------------------------------------
+            IF ( kformat == 0 ) THEN
+               IF(lwp) THEN
+                  WRITE(numout,*)
+                  WRITE(numout,*)'Reading from feedback file :', &
+                     &           TRIM( cfilenames(jj) )
+               ENDIF
+               CALL read_obfbdata( TRIM( cfilenames(jj) ), inpfiles(jj), &
+                  &                ldgrid = .TRUE. )
+               IF ( ldmod .AND. ( inpfiles(jj)%nadd == 0 ) ) THEN
+                  CALL ctl_stop( 'Model not in input data' )
+                  RETURN
+               ENDIF
+            ELSEIF ( kformat == 1) THEN
+               CALL read_ghrsst( TRIM( cfilenames(jj) ), inpfiles(jj), &
+               &                 numout, lwp, .TRUE. )
+            ELSE
+               CALL ctl_stop( 'File format unknown' )
+            ENDIF
+
+            !------------------------------------------------------------------
+            !  Change longitude (-180,180)
+            !------------------------------------------------------------------
+
+            DO ji = 1, inpfiles(jj)%nobs 
+
+               IF ( inpfiles(jj)%plam(ji) < -180. ) &
+                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) + 360.
+
+               IF ( inpfiles(jj)%plam(ji) >  180. ) &
+                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) - 360.
+
+            END DO
+
+            !------------------------------------------------------------------
+            !  Calculate the date  (change eventually)
+            !------------------------------------------------------------------
+            cl_refdate=inpfiles(jj)%cdjuldref(1:8)
+            READ(cl_refdate,'(I8)') irefdate(jj)
+            
+            CALL ddatetoymdhms( ddobsini, iyea, imon, iday, ihou, imin, isec )
+            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulini(jj), &
+               &           krefdate = irefdate(jj) )
+            CALL ddatetoymdhms( ddobsend, iyea, imon, iday, ihou, imin, isec )
+            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulend(jj), &
+               &           krefdate = irefdate(jj) )
+            IF ( inpfiles(jj)%nobs > 0 ) THEN
+               inpfiles(jj)%iproc = -1
+               inpfiles(jj)%iobsi = -1
+               inpfiles(jj)%iobsj = -1
+            ENDIF
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+               ENDIF
+            END DO
+            ALLOCATE( zlam(inowin)  )
+            ALLOCATE( zphi(inowin)  )
+            ALLOCATE( iobsi(inowin) )
+            ALLOCATE( iobsj(inowin) )
+            ALLOCATE( iproc(inowin) )
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+                  zlam(inowin) = inpfiles(jj)%plam(ji)
+                  zphi(inowin) = inpfiles(jj)%pphi(ji)
+               ENDIF
+            END DO
+
+            CALL obs_grid_search( inowin, zlam, zphi, iobsi, iobsj, iproc, 'T' )
+
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+                  inpfiles(jj)%iproc(ji,1) = iproc(inowin)
+                  inpfiles(jj)%iobsi(ji,1) = iobsi(inowin)
+                  inpfiles(jj)%iobsj(ji,1) = iobsj(inowin)
+               ENDIF
+            END DO
+            DEALLOCATE( zlam, zphi, iobsi, iobsj, iproc )
+
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  IF ( nproc == 0 ) THEN
+                     IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
+                  ELSE
+                     IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
+                  ENDIF
+                  llvalprof = .FALSE.
+                  IF ( ( inpfiles(jj)%ivlqc(1,ji,1) == 1 ) .OR. &
+                     & ( inpfiles(jj)%ivlqc(1,ji,1) == 2 ) ) THEN
+                     iobs = iobs + 1
+                  ENDIF
+               ENDIF
+            END DO
+
+         ENDIF
+
+      END DO sst_files
+
+      !-----------------------------------------------------------------------
+      ! Get the time ordered indices of the input data
+      !-----------------------------------------------------------------------
+
+      !---------------------------------------------------------------------
+      !  Loop over input data files to count total number of profiles
+      !---------------------------------------------------------------------
+      iobstot = 0
+      DO jj = 1, inobf
+         DO ji = 1, inpfiles(jj)%nobs
+            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+               iobstot = iobstot + 1
+            ENDIF
+         END DO
+      END DO
+
+      ALLOCATE( iindx(iobstot), ifileidx(iobstot), &
+         &      isstidx(iobstot), zdat(iobstot) )
+      jk = 0
+      DO jj = 1, inobf
+         DO ji = 1, inpfiles(jj)%nobs
+            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+               jk = jk + 1
+               ifileidx(jk) = jj
+               isstidx(jk) = ji
+               zdat(jk)     = inpfiles(jj)%ptim(ji)
+            ENDIF
+         END DO
+      END DO
+      CALL sort_dp_indx( iobstot, &
+         &               zdat,     &
+         &               iindx   )
+      
+      CALL obs_surf_alloc( sstdata, iobs, kvars, kextr, kstp )
+      
+      ! * Read obs/positions, QC, all variable and assign to sstdata
+ 
+      iobs = 0
+
+      ityp   (:) = 0
+      itypmpp(:) = 0
+      
+      DO jk = 1, iobstot
+         
+         jj = ifileidx(iindx(jk))
+         ji = isstidx(iindx(jk))
+         IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND.  &
+            & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN
+            
+            IF ( nproc == 0 ) THEN
+               IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
+            ELSE
+               IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
+            ENDIF
+            
+            ! Set observation information
+            
+            IF ( ( inpfiles(jj)%ivlqc(1,ji,1) == 1 ) .OR. &
+               & ( inpfiles(jj)%ivlqc(1,ji,1) == 2 ) ) THEN
+
+               iobs = iobs + 1
+
+               CALL jul2greg( isec,                   &
+                  &           imin,                   &
+                  &           ihou,                   &
+                  &           iday,                   &
+                  &           imon,                   &
+                  &           iyea,                   &
+                  &           inpfiles(jj)%ptim(ji), &
+                  &           irefdate(jj) )
+
+
+               ! SST time coordinates
+               sstdata%nyea(iobs) = iyea
+               sstdata%nmon(iobs) = imon
+               sstdata%nday(iobs) = iday
+               sstdata%nhou(iobs) = ihou
+               sstdata%nmin(iobs) = imin
+               
+               ! SST space coordinates
+               sstdata%rlam(iobs) = inpfiles(jj)%plam(ji)
+               sstdata%rphi(iobs) = inpfiles(jj)%pphi(ji)
+
+               ! Coordinate search parameters
+               sstdata%mi  (iobs) = inpfiles(jj)%iobsi(ji,1)
+               sstdata%mj  (iobs) = inpfiles(jj)%iobsj(ji,1)
+               
+               ! Instrument type
+               READ( inpfiles(jj)%cdtyp(ji), '(I4)' ) itype
+               sstdata%ntyp(iobs) = itype
+               IF ( itype < isstmaxtype + 1 ) THEN
+                  ityp(itype+1) = ityp(itype+1) + 1
+               ELSE
+                  IF(lwp)WRITE(numout,*)'WARNING:Increase isstmaxtype in ',&
+                     &                  cpname
+               ENDIF
+
+               ! Bookkeeping data to match observations
+               sstdata%nsidx(iobs) = iobs
+               sstdata%nsfil(iobs) = iindx(jk)
+
+               ! QC flags
+               sstdata%nqc(iobs) = inpfiles(jj)%ivqc(ji,1)
+
+               ! Observed value
+               sstdata%robs(iobs,1) = inpfiles(jj)%pob(1,ji,1)
+
+
+               ! Model and MDT is set to fbrmdi unless read from file
+               IF ( ldmod ) THEN
+                  sstdata%rmod(iobs,1) = inpfiles(jj)%padd(1,ji,1,1)
+               ELSE
+                  sstdata%rmod(iobs,1) = fbrmdi
+               ENDIF
+            ENDIF
+         ENDIF
+
+      END DO
+
+      !-----------------------------------------------------------------------
+      ! Sum up over processors
+      !-----------------------------------------------------------------------
+      
+      CALL obs_mpp_sum_integer( iobs, iobsmpp )
+      
+      !-----------------------------------------------------------------------
+      ! Output number of observations.
+      !-----------------------------------------------------------------------
+      IF (lwp) THEN
+
+         WRITE(numout,*)
+         WRITE(numout,'(1X,A)')'SST data types'
+         WRITE(numout,'(1X,A)')'--------------'
+         DO jj = 1,8
+            IF ( itypmpp(jj) > 0 ) THEN
+               WRITE(numout,'(1X,A4,I4,A3,I10)')'Type ', jj,' = ',itypmpp(jj)
+            ENDIF
+         END DO
+         WRITE(numout,'(1X,A50)')'--------------------------------------------------'
+         WRITE(numout,'(1X,A40,I10)')'Total                                 = ',iobsmpp
+         WRITE(numout,*)
+
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Deallocate temporary data
+      !-----------------------------------------------------------------------
+      DEALLOCATE( ifileidx, isstidx, zdat )
+
+      !-----------------------------------------------------------------------
+      ! Deallocate input data
+      !-----------------------------------------------------------------------
+      DO jj = 1, inobf
+         IF ( inpfiles(jj)%lalloc ) THEN
+            CALL dealloc_obfbdata( inpfiles(jj) )
+         ENDIF
+      END DO
+      DEALLOCATE( inpfiles )
+
+   END SUBROUTINE obs_rea_sst
+
+   SUBROUTINE obs_rea_sst_rey( sstname, cdsstfmt, sstdata, kvars, kextra, &
+      &                        kstp, ddobsini, ddobsend )
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_rea_sst ***
+      !!
+      !! ** Purpose : Read from file the pseudo SST data from Reynolds
+      !!
+      !! ** Method  : 
+      !!
+      !! ** Action  : 
+      !!
+      !! References : 
+      !!
+      !! History :  
+      !!      ! :  
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE par_oce          ! Ocean parameters
+   
+      !! * Arguments
+      CHARACTER(len=128), INTENT(IN) :: sstname   ! Generic file name
+      CHARACTER(len=12), INTENT(IN) :: cdsstfmt   ! Format of SST files (yearly/monthly)
+      TYPE(obs_surf), INTENT(INOUT) :: sstdata    ! SST data
+      REAL(KIND=dp), INTENT(IN) :: ddobsini    ! Obs. ini time in YYYYMMDD.HHMMSS
+      REAL(KIND=dp), INTENT(IN) :: ddobsend    ! Obs. end time in YYYYMMDD.HHMMSS
+      INTEGER, INTENT(IN) :: kvars      ! Number of variables in sstdata structures
+      INTEGER, INTENT(IN) :: kextra     ! Number of extra variables in sstdata structures
+      INTEGER, INTENT(IN) :: kstp       ! Ocean time-step index
+      
+      INTEGER :: iyear
+      INTEGER :: imon
+      INTEGER :: iday
+      INTEGER :: ihour
+      INTEGER :: imin
+      INTEGER :: isec
+      INTEGER :: ihhmmss
+      INTEGER :: iyear1
+      INTEGER :: iyear2
+      INTEGER :: imon1
+      INTEGER :: imon2
+      INTEGER :: iyearf
+      INTEGER :: imonf
+      REAL(KIND=wp) :: pjulini
+      REAL(KIND=wp) :: pjulend
+      REAL(KIND=wp) :: pjulb
+      REAL(KIND=wp) :: pjule
+      REAL(KIND=wp) :: pjul
+      INTEGER :: inumsst
+      INTEGER :: itotrec
+      INTEGER :: inumobs
+      INTEGER :: irec
+      INTEGER :: ifld
+      INTEGER :: inum
+      INTEGER :: ji, jj
+      CHARACTER(len=128) :: clname
+      CHARACTER(len=4) :: cdyear
+      CHARACTER(len=2) :: cdmon
+      REAL(kind=wp), ALLOCATABLE, DIMENSION(:,:,:) :: zsstin
+
+      IF (lwp) WRITE(numout,*)'In obs_rea_sst_rey',sstname
+
+      !-----------------------------------------------------------------------
+      ! Convert observation window to julian dates.
+      !-----------------------------------------------------------------------
+      iyear1 = NINT( ddobsini / 10000 )
+      imon1 = NINT( ( ddobsini - iyear1 * 10000 ) / 100 )
+      iday = MOD( NINT( ddobsini ), 100 )
+      ihhmmss = ( ddobsini - NINT( ddobsini ) ) * 1000000
+      ihour = ihhmmss / 10000
+      imin = ( ihhmmss - ihour * 100 ) / 100
+      isec = MOD( ihhmmss, 100 )
+      CALL greg2jul ( isec, imin, ihour, iday, imon1, iyear1, pjulini )
+      IF (lwp) WRITE(numout,*)'dateini',ddobsini,iyear1,imon1,iday,ihour, &
+         & imin,isec,pjulini
+
+      iyear2 = NINT( ddobsini / 10000 )
+      imon2 = NINT( ( ddobsend - iyear2 * 10000 ) / 100 )
+      iday = MOD( NINT( ddobsend ), 100 )
+      ihhmmss = ( ddobsend - NINT( ddobsend ) ) * 1000000
+      ihour = ihhmmss / 10000
+      imin = ( ihhmmss - ihour * 100 ) / 100
+      isec = MOD( ihhmmss, 100 )
+      CALL greg2jul ( isec, imin, ihour, iday, imon2, iyear2, pjulend )
+      IF (lwp) WRITE(numout,*)'dateend',ddobsend,iyear2,imon2,iday,ihour, &
+         & imin,isec,pjulend
+
+      itotrec = NINT( pjulend - pjulini ) 
+      ALLOCATE( &
+         & zsstin( jpi, jpj, itotrec) &
+         & )
+      
+      pjul = pjulini + 1
+      
+      iyearf = -1 
+      imonf = -1
+
+      IF ( TRIM(cdsstfmt) == 'yearly' ) THEN
+
+         DO
+         
+            CALL jul2greg( isec, imin, ihour, iday, imon, iyear, &
+               &           pjul, 19500101 )
+            !
+            IF ( iyear /= iyearf ) THEN
+               
+               CALL greg2jul ( 0, 0, 0, 1, 1, iyear, pjulb )
+               
+               IF ( iyearf /= -1 ) THEN
+                  
+                  CALL iom_close ( inumsst )      
+                  
+               ENDIF
+               
+               clname = sstname
+               jj = INDEX( clname, 'YYYY' )
+               
+               IF ( jj == 0 ) THEN
+                  
+                  CALL ctl_stop( 'obs_rea_sst_rey : ', &
+                  &           'Error processing filename ' // TRIM(sstname) )
+                  
+               ENDIF
+               
+               WRITE(cdyear,'(I4.4)') iyear
+               clname(jj:jj+3) = cdyear
+               IF(lwp) WRITE(numout,*)'Reading from Reynolds SST file : ',&
+                  & TRIM(clname)
+               
+               inumsst = 0
+               
+               CALL iom_open ( clname, inumsst )
+               
+               IF ( inumsst == 0 ) THEN
+                  
+                  CALL ctl_stop( 'obs_rea_sst_rey : ', &
+                     &           'Error reading ' // TRIM(clname) )
+                  
+               ENDIF
+               
+               iyearf = iyear
+               
+            ENDIF
+            
+            irec = pjul - pjulb + 1
+            ifld = pjul - pjulini
+            
+            CALL iom_get ( inumsst, jpdom_data, 'sst', zsstin(:,:,ifld), irec )
+            
+            pjul = pjul + 1
+            
+            IF ( pjul > pjulend ) EXIT
+         
+         END DO
+
+      ELSEIF ( TRIM(cdsstfmt) == 'monthly' ) THEN
+
+         DO
+         
+            CALL jul2greg( isec, imin, ihour, iday, imon, iyear, &
+               &           pjul, 19500101 )
+            !
+            IF ( iyear /= iyearf .OR. imon /= imonf ) THEN
+               
+               CALL greg2jul ( 0, 0, 0, 1, imon, iyear, pjulb )
+               
+               IF ( iyearf /= -1 .AND. imonf /= -1 ) THEN
+                  
+                  CALL iom_close ( inumsst )      
+                  
+               ENDIF
+               
+               clname = sstname
+
+               jj = INDEX( clname, 'YYYY' )
+
+               IF ( jj == 0 ) THEN
+                  
+                  CALL ctl_stop( 'obs_rea_sst_rey : ', &
+                  &           'Error processing filename ' // TRIM(sstname) )
+                  
+               ENDIF
+               
+               WRITE(cdyear,'(I4.4)') iyear
+               clname(jj:jj+3) = cdyear
+
+               jj = INDEX( clname, 'MM' )
+               
+               IF ( jj == 0 ) THEN
+                  
+                  CALL ctl_stop( 'obs_rea_sst_rey : ', &
+                  &           'Error processing filename ' // TRIM(sstname) )
+                  
+               ENDIF
+               
+               WRITE(cdmon,'(I2.2)') imon
+               clname(jj:jj+1) = cdmon
+
+
+               IF(lwp) WRITE(numout,*)'Reading from Reynolds SST file : ',&
+                  & TRIM(clname)
+               
+               inumsst = 0
+               
+               CALL iom_open ( clname, inumsst )
+               
+               IF ( inumsst == 0 ) THEN
+                  
+                  CALL ctl_stop( 'obs_rea_sst_rey : ', &
+                     &           'Error reading ' // TRIM(clname) )
+                  
+               ENDIF
+               
+               iyearf = iyear
+               imonf = iyear
+               
+            ENDIF
+            
+            irec = pjul - pjulb + 1
+            ifld = pjul - pjulini
+            
+            CALL iom_get ( inumsst, jpdom_data, 'sst', zsstin(:,:,ifld), irec )
+            
+            pjul = pjul + 1
+            
+            IF ( pjul > pjulend ) EXIT
+         
+         END DO
+
+      ELSE
+         
+         CALL ctl_stop('Unknown REYNOLDS sst input data file format')
+
+      ENDIF
+
+      CALL iom_close ( inumsst )      
+
+      inumobs = 0
+      DO jj = nldj, nlej
+         DO ji = nldi, nlei
+            IF ( tmask(ji,jj,1) == 1.0_wp ) inumobs = inumobs + 1
+         END DO
+      END DO
+      inumobs = inumobs * itotrec
+
+      ! Allocate obs_surf data structure for time sorted data
+         
+      CALL obs_surf_alloc( sstdata, inumobs, kvars, kextra, kstp )
+
+      pjul = pjulini + 1
+
+      inumobs = 0
+
+      DO
+
+         CALL jul2greg( isec, imin, ihour, iday, imon, iyear, &
+            &           pjul, 19500101 )
+
+         ifld = pjul - pjulini
+
+         DO jj = nldj, nlej
+            DO ji = nldi, nlei
+
+               IF ( tmask(ji,jj,1) == 1.0_wp ) THEN
+
+                  inumobs = inumobs + 1
+                  
+                  ! Integer values
+                  IF (ln_grid_global) THEN
+                     sstdata%mi(inumobs)     = MAX(mig(ji),2)
+                     sstdata%mj(inumobs)     = MAX(mjg(jj),2)
+                  ELSE
+                     sstdata%mi(inumobs)     = MAX(ji,2)
+                     sstdata%mj(inumobs)     = MAX(jj,2)
+                  ENDIF
+                  sstdata%nsidx(inumobs)  = 0
+                  sstdata%nsfil(inumobs)  = 0
+                  sstdata%nyea(inumobs)   = iyear
+                  sstdata%nmon(inumobs)   = imon
+                  sstdata%nday(inumobs)   = iday
+                  sstdata%nhou(inumobs)   = ihour
+                  sstdata%nmin(inumobs)   = imin
+                  sstdata%mstp(inumobs)   = 0
+                  sstdata%nqc(inumobs)    = 0
+                  sstdata%ntyp(inumobs)   = 0
+         
+                  ! Real values
+                  sstdata%rlam(inumobs)   = glamt(ji,jj)
+                  sstdata%rphi(inumobs)   = gphit(ji,jj)
+                  sstdata%robs(inumobs,1) = zsstin(ji,jj,ifld)
+                  sstdata%rmod(inumobs,1) = fbrmdi
+                  sstdata%rext(inumobs,:) = fbrmdi
+
+               ENDIF
+
+            END DO
+         END DO
+
+         pjul = pjul + 1
+
+         IF ( pjul > pjulend ) EXIT
+
+      END DO
+
+   END SUBROUTINE obs_rea_sst_rey
+
+END MODULE obs_read_sst
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_vel.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_vel.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_vel.F90	(revision 2528)
@@ -0,0 +1,645 @@
+MODULE obs_read_vel
+   !!======================================================================
+   !!                       ***  MODULE obs_read_vel  ***
+   !! Observation diagnostics: Read the velocity profile observations
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   obs_rea_vel_dri : Driver for reading profile obs
+   !!----------------------------------------------------------------------
+
+   !! * Modules used   
+   USE par_kind                 ! Precision variables
+   USE par_oce                  ! Ocean parameters
+   USE in_out_manager           ! I/O manager
+   USE dom_oce                  ! Ocean space and time domain variables
+   USE obs_mpp                  ! MPP support routines for observation diagnostics
+   USE julian                   ! Julian date routines
+   USE obs_utils                ! Observation operator utility functions
+   USE obs_prep                 ! Prepare observation arrays
+   USE obs_grid                 ! Grid search
+   USE obs_sort                 ! Sorting observation arrays
+   USE obs_profiles_def         ! Profile definitions
+   USE obs_conv                 ! Various conversion routines
+   USE obs_types                ! Observation type definitions
+   USE netcdf                   ! NetCDF library
+   USE obs_oper                 ! Observation operators
+   USE obs_vel_io               ! Velocity profile files I/O (non-FB files)
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC obs_rea_vel_dri  ! Read the profile observations 
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+ 
+   SUBROUTINE obs_rea_vel_dri( kformat, &
+      &                        profdata, knumfiles, cfilenames, &
+      &                        kvars, kextr, kstp, ddobsini, ddobsend, &
+      &                        ldignmis, ldavtimset, ldmod )
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_rea_pro_dri ***
+      !!
+      !! ** Purpose : Read from file the profile observations
+      !!
+      !! ** Method  : Depending on kformat either ENACT, CORIOLIS or
+      !!              feedback data files are read
+      !!
+      !! ** Action  : 
+      !!
+      !! References : 
+      !!
+      !! History :  
+      !!      ! :  2009-01 (K. Mogensen) : New merged version of old routines
+      !!----------------------------------------------------------------------
+      !! * Modules used
+   
+      !! * Arguments
+      INTEGER :: kformat   ! Format of input data
+      !                    ! 1: ENACT
+      !                    ! 2: Coriolis
+      TYPE(obs_prof), INTENT(OUT) :: profdata    ! Profile data to be read
+      INTEGER, INTENT(IN) :: knumfiles           ! Number of files to read in
+      CHARACTER(LEN=128), INTENT(IN) ::  cfilenames(knumfiles) ! File names to read in
+      INTEGER, INTENT(IN) :: kvars       ! Number of variables in profdata
+      INTEGER, INTENT(IN) :: kextr       ! Number of extra fields for each var in profdata
+      INTEGER, INTENT(IN) :: kstp        !  Ocean time-step index
+      LOGICAL, INTENT(IN) :: ldignmis    ! Ignore missing files
+      LOGICAL, INTENT(IN) :: ldavtimset  ! Set time to be equal to the end of the day
+      LOGICAL, INTENT(IN) :: ldmod       ! Initialize model from input data
+      REAL(KIND=dp), INTENT(IN) :: ddobsini   ! Obs. ini time in YYYYMMDD.HHMMSS
+      REAL(KIND=dp), INTENT(IN) :: ddobsend   ! Obs. end time in YYYYMMDD.HHMMSS
+
+      !! * Local declarations
+      CHARACTER(LEN=15), PARAMETER :: cpname='obs_rea_vel_dri'
+      INTEGER :: jvar
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jk
+      INTEGER :: ij
+      INTEGER :: iflag
+      INTEGER :: inobf
+      INTEGER :: i_file_id
+      INTEGER :: inowin
+      INTEGER :: iyea
+      INTEGER :: imon
+      INTEGER :: iday
+      INTEGER :: ihou
+      INTEGER :: imin
+      INTEGER :: isec
+      INTEGER, DIMENSION(knumfiles) :: &
+         & irefdate
+      INTEGER, DIMENSION(ntyp1770+1) :: &
+         & itypuv,    &
+         & itypuvmpp 
+      INTEGER :: iuv3dtmpp
+      INTEGER, DIMENSION(:), ALLOCATABLE :: &
+         & iobsiu,   &
+         & iobsju,   &
+         & iprocu,   &
+         & iobsiv,   &
+         & iobsjv,   &
+         & iprocv,   &
+         & iindx,    &
+         & ifileidx, &
+         & iprofidx
+      INTEGER :: itype
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: &
+         & zphi, &
+         & zlam
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: &
+         & zdat
+      LOGICAL :: &
+         & llvalprof
+      TYPE(obfbdata), POINTER, DIMENSION(:) :: &
+         & inpfiles
+      REAL(dp), DIMENSION(knumfiles) :: &
+         & djulini, &
+         & djulend
+      INTEGER :: iprof
+      INTEGER :: iproftot
+      INTEGER :: iuv3dt
+      INTEGER, DIMENSION(kvars) :: iv3dt
+      CHARACTER(len=8) :: cl_refdate
+   
+      ! Local initialization
+      iprof = 0
+      iuv3dt = 0
+
+      !-----------------------------------------------------------------------
+      ! Check data the model part is just with feedback data files
+      !-----------------------------------------------------------------------
+      IF ( ldmod .AND. ( kformat /= 0 ) ) THEN
+         CALL ctl_stop( 'Model can only be read from feedback data' )
+         RETURN
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Count the number of files needed and allocate the obfbdata type
+      !-----------------------------------------------------------------------
+      
+      inobf = knumfiles
+
+      ALLOCATE( inpfiles(inobf) )
+
+      prof_files : DO jj = 1, inobf
+          
+         !---------------------------------------------------------------------
+         ! Prints
+         !---------------------------------------------------------------------
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' obs_rea_vel_dri : Reading from file = ', &
+               & TRIM( TRIM( cfilenames(jj) ) )
+            WRITE(numout,*) ' ~~~~~~~~~~~~~~~'
+            WRITE(numout,*)
+         ENDIF
+
+         !---------------------------------------------------------------------
+         !  Initialization: Open file and get dimensions only
+         !---------------------------------------------------------------------
+         
+         iflag = nf90_open( TRIM( TRIM( cfilenames(jj) ) ), nf90_nowrite, &
+            &                      i_file_id )
+         
+         IF ( iflag /= nf90_noerr ) THEN
+
+            IF ( ldignmis ) THEN
+               inpfiles(jj)%nobs = 0
+               CALL ctl_warn( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
+                  &           ' not found' )
+            ELSE 
+               CALL ctl_stop( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
+                  &           ' not found' )
+            ENDIF
+
+         ELSE 
+            
+            !------------------------------------------------------------------
+            !  Close the file since it is opened in read_proffile
+            !------------------------------------------------------------------
+            
+            iflag = nf90_close( i_file_id )
+
+            !------------------------------------------------------------------
+            !  Read the profile file into inpfiles
+            !------------------------------------------------------------------
+            IF ( kformat == 0 ) THEN
+               CALL init_obfbdata( inpfiles(jj) )
+               IF(lwp) THEN
+                  WRITE(numout,*)
+                  WRITE(numout,*)'Reading from feedback file :', &
+                     &           TRIM( cfilenames(jj) )
+               ENDIF
+               CALL read_obfbdata( TRIM( cfilenames(jj) ), inpfiles(jj), &
+                  &                ldgrid = .TRUE. )
+               IF ( ldmod .AND. ( inpfiles(jj)%nadd == 0 ) ) THEN
+                  CALL ctl_stop( 'Model not in input data' )
+                  RETURN
+               ENDIF
+            ELSEIF ( kformat == 1 ) THEN
+               CALL read_taondbc( TRIM( cfilenames(jj) ), inpfiles(jj), &
+                  &               numout, lwp, .TRUE. )
+            ELSE
+               CALL ctl_stop( 'File format unknown' )
+            ENDIF
+            
+            !------------------------------------------------------------------
+            !  Change longitude (-180,180)
+            !------------------------------------------------------------------
+
+            DO ji = 1, inpfiles(jj)%nobs 
+
+               IF ( inpfiles(jj)%plam(ji) < -180. ) &
+                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) + 360.
+
+               IF ( inpfiles(jj)%plam(ji) >  180. ) &
+                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) - 360.
+
+            END DO
+
+            !------------------------------------------------------------------
+            !  Calculate the date  (change eventually)
+            !------------------------------------------------------------------
+            cl_refdate=inpfiles(jj)%cdjuldref(1:8)
+            READ(cl_refdate,'(I8)') irefdate(jj)
+            
+            CALL ddatetoymdhms( ddobsini, iyea, imon, iday, ihou, imin, isec )
+            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulini(jj), &
+               &           krefdate = irefdate(jj) )
+            CALL ddatetoymdhms( ddobsend, iyea, imon, iday, ihou, imin, isec )
+            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulend(jj), &
+               &           krefdate = irefdate(jj) )
+
+            IF ( ldavtimset ) THEN
+               DO ji = 1, inpfiles(jj)%nobs
+                  ! 
+                  !  for daily averaged data force the time
+                  !  to be the  end of the day
+                  !
+                  inpfiles(jj)%ptim(ji) = &
+                     & INT(inpfiles(jj)%ptim(ji)) + 1
+               END DO
+            ENDIF
+            
+            IF ( inpfiles(jj)%nobs > 0 ) THEN
+               inpfiles(jj)%iproc = -1
+               inpfiles(jj)%iobsi = -1
+               inpfiles(jj)%iobsj = -1
+            ENDIF
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+               ENDIF
+            END DO
+            ALLOCATE( zlam(inowin)  )
+            ALLOCATE( zphi(inowin)  )
+            ALLOCATE( iobsiu(inowin) )
+            ALLOCATE( iobsju(inowin) )
+            ALLOCATE( iprocu(inowin) )
+            ALLOCATE( iobsiv(inowin) )
+            ALLOCATE( iobsjv(inowin) )
+            ALLOCATE( iprocv(inowin) )
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+                  zlam(inowin) = inpfiles(jj)%plam(ji)
+                  zphi(inowin) = inpfiles(jj)%pphi(ji)
+               ENDIF
+            END DO
+
+            CALL obs_grid_search( inowin, zlam, zphi, iobsiu, iobsju, iprocu, &
+               & 'U' )
+            CALL obs_grid_search( inowin, zlam, zphi, iobsiv, iobsjv, iprocv, &
+               & 'V' )
+
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+                  inpfiles(jj)%iproc(ji,1) = iprocu(inowin)
+                  inpfiles(jj)%iobsi(ji,1) = iobsiu(inowin)
+                  inpfiles(jj)%iobsj(ji,1) = iobsju(inowin)
+                  inpfiles(jj)%iproc(ji,2) = iprocv(inowin)
+                  inpfiles(jj)%iobsi(ji,2) = iobsiv(inowin)
+                  inpfiles(jj)%iobsj(ji,2) = iobsjv(inowin)
+                  IF ( inpfiles(jj)%iproc(ji,1) /= &
+                     & inpfiles(jj)%iproc(ji,2) ) THEN
+                     CALL ctl_stop( 'Error in obs_read_vel:', &
+                        & 'U and V observation on different processors')
+                  ENDIF
+               ENDIF
+            END DO
+            DEALLOCATE( zlam, zphi, iobsiu, iobsju, iprocu,  &
+               & iobsiv, iobsjv, iprocv )
+
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  IF ( nproc == 0 ) THEN
+                     IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
+                  ELSE
+                     IF ( inpfiles(jj)%iproc(ji,1) /=  nproc ) CYCLE
+                  ENDIF
+                  llvalprof = .FALSE.
+                  IF ( ( ( nproc == 0 ) .AND. &
+                     & ( inpfiles(jj)%iproc(ji,1) <=  nproc ) ) .OR. &
+                     & ( inpfiles(jj)%iproc(ji,1) ==  nproc ) ) THEN
+                     loop_uv_count : DO ij = 1,inpfiles(jj)%nlev
+                        IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) &
+                           & CYCLE
+                        IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
+                           & ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
+                           & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
+                           iuv3dt = iuv3dt + 1
+                           llvalprof = .TRUE.
+                        ENDIF
+                     END DO loop_uv_count
+                  ENDIF
+                  IF ( llvalprof ) iprof = iprof + 1
+               ENDIF
+            END DO
+
+         ENDIF
+         
+      END DO prof_files
+
+      !-----------------------------------------------------------------------
+      ! Get the time ordered indices of the input data
+      !-----------------------------------------------------------------------
+
+      !---------------------------------------------------------------------
+      !  Loop over input data files to count total number of profiles
+      !---------------------------------------------------------------------
+      iproftot = 0
+      DO jj = 1, inobf
+         DO ji = 1, inpfiles(jj)%nobs
+            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+               iproftot = iproftot + 1
+            ENDIF
+         END DO
+      END DO
+
+      ALLOCATE( iindx(iproftot), ifileidx(iproftot), &
+         &      iprofidx(iproftot), zdat(iproftot) )
+      jk = 0
+      DO jj = 1, inobf
+         DO ji = 1, inpfiles(jj)%nobs
+            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+               jk = jk + 1
+               ifileidx(jk) = jj
+               iprofidx(jk) = ji
+               zdat(jk)     = inpfiles(jj)%ptim(ji)
+            ENDIF
+         END DO
+      END DO
+      CALL sort_dp_indx( iproftot, &
+         &               zdat,     &
+         &               iindx   )
+      
+      iv3dt(:) = -1
+      iv3dt(1:2) = iuv3dt
+      CALL obs_prof_alloc( profdata, kvars, kextr, iprof, iv3dt, &
+         &                 kstp, jpi, jpj, jpk )
+      
+      ! * Read obs/positions, QC, all variable and assign to profdata
+
+      profdata%nprof     = 0
+      profdata%nvprot(:) = 0
+
+      iprof = 0
+
+      iuv3dt = 0
+      itypuv   (:) = 0
+      itypuvmpp(:) = 0
+      
+      DO jk = 1, iproftot
+         
+         jj = ifileidx(iindx(jk))
+         ji = iprofidx(iindx(jk))
+         IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND.  &
+            & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN
+            
+            IF ( nproc == 0 ) THEN
+               IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
+            ELSE
+               IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
+            ENDIF
+            
+            llvalprof = .FALSE.
+
+            loop_prof : DO ij = 1, inpfiles(jj)%nlev
+               
+               IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) &
+                  & CYCLE
+               
+               IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
+                  & ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
+                  & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
+
+                  llvalprof = .TRUE.
+                  EXIT loop_prof
+
+               ENDIF
+
+            END DO loop_prof
+            
+            ! Set profile information
+            
+            IF ( llvalprof ) THEN
+               
+               iprof = iprof + 1
+
+               CALL jul2greg( isec,                   &
+                  &           imin,                   &
+                  &           ihou,                   &
+                  &           iday,                   &
+                  &           imon,                   &
+                  &           iyea,                   &
+                  &           inpfiles(jj)%ptim(ji), &
+                  &           irefdate(jj) )
+
+
+               ! Profile time coordinates
+               profdata%nyea(iprof) = iyea
+               profdata%nmon(iprof) = imon
+               profdata%nday(iprof) = iday
+               profdata%nhou(iprof) = ihou
+               profdata%nmin(iprof) = imin
+               
+               ! Profile space coordinates
+               profdata%rlam(iprof) = inpfiles(jj)%plam(ji)
+               profdata%rphi(iprof) = inpfiles(jj)%pphi(ji)
+
+               ! Coordinate search parameters
+               profdata%mi  (iprof,1) = inpfiles(jj)%iobsi(ji,1)
+               profdata%mj  (iprof,1) = inpfiles(jj)%iobsj(ji,1)
+               profdata%mi  (iprof,2) = inpfiles(jj)%iobsi(ji,2)
+               profdata%mj  (iprof,2) = inpfiles(jj)%iobsj(ji,2)
+               
+               ! Profile WMO number
+               profdata%cwmo(iprof) = inpfiles(jj)%cdwmo(ji)
+               
+               ! Instrument type
+               READ( inpfiles(jj)%cdtyp(ji), '(I4)' ) itype
+               profdata%ntyp(iprof) = itype
+               
+               ! QC stuff
+
+               profdata%nqc(iprof)     = inpfiles(jj)%ioqc(ji)
+               profdata%nqcf(:,iprof)  = inpfiles(jj)%ioqcf(:,ji)
+               profdata%ipqc(iprof)    = inpfiles(jj)%ipqc(ji)
+               profdata%ipqcf(:,iprof) = inpfiles(jj)%ipqcf(:,ji)
+               profdata%itqc(iprof)    = inpfiles(jj)%itqc(ji)
+               profdata%itqcf(:,iprof) = inpfiles(jj)%itqcf(:,ji)
+               profdata%ivqc(iprof,:)  = inpfiles(jj)%ivqc(ji,:)
+               profdata%ivqcf(:,iprof,:) = inpfiles(jj)%ivqcf(:,ji,:)
+
+               ! Bookkeeping data to match profiles
+               profdata%npidx(iprof) = iprof
+               profdata%npfil(iprof) = iindx(jk)
+
+               ! Observation QC flag (whole profile)
+               profdata%nqc(iprof)  = 0 !TODO
+
+               loop_uv : DO ij = 1, inpfiles(jj)%nlev            
+                   
+                  IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) &
+                     & CYCLE
+
+                  IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
+                     & ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
+                     & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
+                     iuv3dt = iuv3dt + 1
+                  ELSE
+                     CYCLE
+                  ENDIF
+
+                  ! Depth of U observation
+                  profdata%var(1)%vdep(iuv3dt) = &
+                     &                inpfiles(jj)%pdep(ij,ji)
+                  
+                  ! Depth of U observation QC
+                  profdata%var(1)%idqc(iuv3dt) = &
+                     &                inpfiles(jj)%idqc(ij,ji)
+                  
+                  ! Depth of U observation QC flags
+                  profdata%var(1)%idqcf(:,iuv3dt) = &
+                     &                inpfiles(jj)%idqcf(:,ij,ji)
+                  
+                  ! Profile index
+                  profdata%var(1)%nvpidx(iuv3dt) = iprof
+                  
+                  ! Vertical index in original profile
+                  profdata%var(1)%nvlidx(iuv3dt) = ij
+
+                  ! Profile U value
+
+                  profdata%var(1)%vobs(iuv3dt) = &
+                     &                inpfiles(jj)%pob(ij,ji,1)
+                  IF ( ldmod ) THEN
+                     profdata%var(1)%vmod(iuv3dt) = &
+                        &                inpfiles(jj)%padd(ij,ji,1,1)
+                  ENDIF
+                  
+                  ! Profile U qc
+                  profdata%var(1)%nvqc(iuv3dt) = &
+                     & inpfiles(jj)%ivlqc(ij,ji,1)
+                  
+                  ! Profile U qc flags
+                  profdata%var(1)%nvqcf(:,iuv3dt) = &
+                     & inpfiles(jj)%ivlqcf(:,ij,ji,1)
+                  
+                  
+                  ! Depth of V observation
+                  profdata%var(2)%vdep(iuv3dt) = &
+                     &                inpfiles(jj)%pdep(ij,ji)
+                  
+                  ! Depth of V observation QC
+                  profdata%var(2)%idqc(iuv3dt) = &
+                     &                inpfiles(jj)%idqc(ij,ji)
+                  
+                  ! Depth of V observation QC flags
+                  profdata%var(2)%idqcf(:,iuv3dt) = &
+                     &                inpfiles(jj)%idqcf(:,ij,ji)
+                  
+                  ! Profile index
+                  profdata%var(2)%nvpidx(iuv3dt) = iprof
+                  
+                  ! Vertical index in original profile
+                  profdata%var(2)%nvlidx(iuv3dt) = ij
+                  
+                  ! Profile V value
+                  profdata%var(2)%vobs(iuv3dt) = &
+                     &                inpfiles(jj)%pob(ij,ji,2)
+                  IF ( ldmod ) THEN
+                     profdata%var(2)%vmod(iuv3dt) = &
+                        &                inpfiles(jj)%padd(ij,ji,1,2)
+                  ENDIF
+                     
+                  ! Profile V qc
+                  profdata%var(2)%nvqc(iuv3dt) = &
+                     & inpfiles(jj)%ivlqc(ij,ji,2)
+                  
+                  ! Profile V qc flags
+                  profdata%var(2)%nvqcf(:,iuv3dt) = &
+                        & inpfiles(jj)%ivlqcf(:,ij,ji,2)
+                  
+                  ! Observation type
+                  itypuv( profdata%ntyp(iprof) + 1 ) = &
+                     & itypuv( profdata%ntyp(iprof) + 1 ) + 1
+
+
+               END DO loop_uv
+
+            ENDIF
+
+         ENDIF
+
+      END DO
+
+      !-----------------------------------------------------------------------
+      ! Sum up over processors
+      !-----------------------------------------------------------------------
+      
+      CALL obs_mpp_sum_integer ( iuv3dt, iuv3dtmpp )
+      
+      CALL obs_mpp_sum_integers( itypuv, itypuvmpp, ntyp1770 + 1 )
+      
+      !-----------------------------------------------------------------------
+      ! Output number of observations.
+      !-----------------------------------------------------------------------
+      IF(lwp) THEN
+         WRITE(numout,*) 
+         WRITE(numout,'(1X,A)') 'Profile U,V velocity data'
+         WRITE(numout,'(1X,A)') '-------------------------'
+         WRITE(numout,*) 
+         DO ji = 0, ntyp1770
+            IF ( itypuvmpp(ji+1) > 0 ) THEN
+               WRITE(numout,'(1X,A3,A3,I8)') ctypshort(ji), ' = ', &
+                  & itypuvmpp(ji+1)
+            ENDIF
+         END DO
+         WRITE(numout,'(1X,A)') '--------------'
+         WRITE(numout,'(1X,A6,I8)') &
+            & 'Total profile UV data                                 = ',&
+            & iuv3dtmpp
+         WRITE(numout,'(1X,A)') '--------------'
+      ENDIF
+      
+      profdata%nvprot(1)    = iuv3dt
+      profdata%nvprot(2)    = iuv3dt
+      profdata%nvprotmpp(1) = iuv3dtmpp
+      profdata%nvprotmpp(2) = iuv3dtmpp
+      profdata%nprof        = iprof
+
+      !-----------------------------------------------------------------------
+      ! Model level search
+      !-----------------------------------------------------------------------
+      CALL obs_level_search( jpk, gdept_0, &
+         & profdata%nvprot(1), profdata%var(1)%vdep, &
+         & profdata%var(1)%mvk )
+      CALL obs_level_search( jpk, gdept_0, &
+         & profdata%nvprot(2), profdata%var(2)%vdep, &
+         & profdata%var(2)%mvk )
+      
+      !-----------------------------------------------------------------------
+      ! Set model equivalent to 99999
+      !-----------------------------------------------------------------------
+      IF ( .NOT. ldmod ) THEN
+         DO jvar = 1, kvars
+            profdata%var(jvar)%vmod(:) = fbrmdi
+         END DO
+      ENDIF
+      !-----------------------------------------------------------------------
+      ! Deallocate temporary data
+      !-----------------------------------------------------------------------
+      DEALLOCATE( ifileidx, iprofidx, zdat )
+
+      !-----------------------------------------------------------------------
+      ! Deallocate input data
+      !-----------------------------------------------------------------------
+      DO jj = 1, inobf
+         CALL dealloc_obfbdata( inpfiles(jj) )
+      END DO
+      DEALLOCATE( inpfiles )
+
+   END SUBROUTINE obs_rea_vel_dri
+   
+END MODULE obs_read_vel
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90	(revision 2528)
@@ -0,0 +1,345 @@
+MODULE obs_readmdt
+   !!======================================================================
+   !!                       ***  MODULE obs_readmdt  ***
+   !! Observation diagnostics: Read the MDT for SLA data (skeleton for now)
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   obs_rea_mdt : Driver for reading MDT
+   !!----------------------------------------------------------------------
+
+   !! * Modules used   
+   USE par_kind, ONLY : &       ! Precision variables
+      & wp, &
+      & dp, &
+      & sp
+   USE par_oce, ONLY : &        ! Domain parameters
+      & jpi, &
+      & jpj, &
+      & jpim1
+   USE in_out_manager, ONLY : & ! I/O manager
+      & lwp,    &
+      & numout 
+   USE obs_surf_def             ! Surface observation definitions
+   USE dom_oce, ONLY : &        ! Domain variables
+      & tmask, &
+      & tmask_i, &
+      & e1t,   &
+      & e2t,   &
+      & gphit, &
+      & glamt
+   USE obs_const, ONLY : &
+      & obfillflt              ! Fillvalue
+   USE oce, ONLY : &           ! Model variables
+      & sshn
+   USE obs_inter_sup           ! Interpolation support routines
+   USE obs_inter_h2d           ! 2D interpolation
+   USE obs_utils               ! Various observation tools
+   USE lib_mpp, only: &        ! MPP routines
+      & lk_mpp, &
+      & mpp_sum
+   USE iom_nf90   
+   USE netcdf                   ! NetCDF library
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   INTEGER, PUBLIC :: nmsshc = 1        ! MDT correction scheme
+   REAL(wp), PUBLIC :: mdtcorr = 1.61   ! User specified MDT correction
+   REAL(wp), PUBLIC :: mdtcutoff = 65.0  ! MDT cutoff for computed correction
+   PUBLIC obs_rea_mdt     ! Read the MDT
+   PUBLIC obs_offset_mdt  ! Remove the offset between the model MDT and the 
+                          ! used one
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE obs_rea_mdt( kslano, sladata, k2dint )
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_rea_mdt ***
+      !!
+      !! ** Purpose : Read from file the MDT data (skeleton)
+      !!
+      !! ** Method  : 
+      !!
+      !! ** Action  : 
+      !!
+      !! References :
+      !!
+      !! History :  
+      !!      ! :  2007-03 (K. Mogensen) Initial skeleton version
+      !!      ! :  2007-04 (E. Remy) migration and improvement from OPAVAR
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE iom
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kslano          ! Number of SLA Products
+      TYPE(obs_surf), DIMENSION(kslano), INTENT(INOUT) :: &
+         & sladata       ! SLA data
+      INTEGER, INTENT(IN) :: k2dint
+
+      !! * Local declarations
+
+      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      ! Number of grid point in latitude for the MDT
+      INTEGER :: jpjmdt      ! Number of grid point in longitude for the MDT
+      INTEGER :: iico        ! Grid point indicies
+      INTEGER :: ijco 
+      INTEGER :: i_nx_id     ! Index to read the NetCDF file
+      INTEGER :: i_ny_id     ! 
+      INTEGER :: i_file_id   ! 
+      INTEGER :: i_var_id
+      INTEGER :: i_stat
+
+      REAL(wp), DIMENSION(jpi,jpj) :: & 
+         & z_mdt,       &  ! Array to store the MDT values
+         & mdtmask         ! Array to store the mask for the MDT
+      REAL(wp), DIMENSION(1) :: &
+         & zext, &
+         & zobsmask
+      REAL(wp), DIMENSION(2,2,1) :: &
+         & zweig
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
+         & zmask, &
+         & zmdtl, &
+         & zglam, &
+         & zgphi
+         
+      REAL(wp) :: zlam
+      REAL(wp) :: zphi
+      REAL(wp) :: zfill
+      REAL(sp) :: zinfill
+      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
+         & igrdi, &
+         & igrdj
+      INTEGER :: nummdt
+
+      IF(lwp)WRITE(numout,*) 
+      IF(lwp)WRITE(numout,*) ' obs_rea_mdt : '
+      IF(lwp)WRITE(numout,*) ' ------------- '
+      IF(lwp)WRITE(numout,*) '   Read MDT for referencing altimeter', &
+         &                   '   anomalies'
+
+      ! Open the file
+      
+      CALL iom_open( mdtname, nummdt )
+      
+      ! Get the MDT data
+
+      CALL iom_get( nummdt, jpdom_data, 'sossheig', z_mdt(:,:), 1 )
+
+      ! Close the file
+
+      CALL iom_close(nummdt)     
+      
+      ! Read in the fill value
+      zinfill = 0.0
+      i_stat = nf90_open( mdtname, nf90_nowrite, nummdt )
+      i_stat = nf90_inq_varid( nummdt, 'sossheig', i_var_id )
+      i_stat = nf90_get_att( nummdt, i_var_id, "_FillValue",zinfill)
+      zfill = zinfill
+      i_stat = nf90_close( nummdt )
+
+! setup mask based on tmask and MDT mask
+! set mask to 0 where the MDT is set to fillvalue
+
+      WHERE(z_mdt(:,:) /= zfill)
+         mdtmask(:,:)=tmask(:,:,1)
+      ELSEWHERE
+         mdtmask(:,:)=0
+      END WHERE
+
+      ! 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 )
+
+      ! 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)  &
+            & )
+         
+         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
+            
+            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 )
+            
+            CALL obs_int_h2d( 1, 1,      &
+                   &              zweig, zmdtl(:,:,jobs),  zext )
+ 
+            sladata(jslano)%rext(jobs,2) = zext(1)
+
+! mark any masked data with a QC flag
+            IF ( zobsmask(1) == 0 ) sladata(jslano)%nqc(jobs) = 11
+
+         END DO
+         
+         DEALLOCATE( &
+            & igrdi, &
+            & igrdj, &
+            & zglam, &
+            & zgphi, &
+            & zmask, &
+            & zmdtl  &
+            & )
+
+      END DO
+
+   END SUBROUTINE obs_rea_mdt
+
+   SUBROUTINE obs_offset_mdt( mdt, zfill )
+
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_offset_mdt ***
+      !!
+      !! ** Purpose : Compute a correction term for the MDT on the model grid
+      !!             !!!!! IF it is on the model grid
+      !!
+      !! ** Method  : Compute the mean difference between the model and the 
+      !!              used MDT and remove the offset. 
+      !!
+      !! ** Action  : 
+      !!
+      !! References :
+      !!
+      !! History :  
+      !!      ! :  2007-04 (E. Remy) migration from OPAVAR
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Arguments
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(INOUT) :: &
+         & mdt           ! MDT used on the model grid
+      REAL(wp), INTENT(IN) :: zfill 
+
+      !! * Local declarations 
+      REAL(wp) :: zdxdy
+      REAL(wp) :: zarea
+      REAL(wp) :: zeta1
+      REAL(wp) :: zeta2
+      REAL(wp) :: zcorr_mdt  
+      REAL(wp) :: zcorr_bcketa
+      REAL(wp) :: zcorr
+      REAL(wp), DIMENSION(jpi,jpj) :: zpromsk
+      INTEGER :: jj
+      INTEGER :: ji
+      CHARACTER(LEN=14), PARAMETER :: &
+         & cpname = 'obs_offset_mdt'
+   
+      !  Initialize the local mask, for domain projection 
+      !  Also exclude mdt points which are set to missing data
+
+      DO ji = 1, jpi
+        DO jj = 1, jpj
+           zpromsk(ji,jj) = tmask_i(ji,jj)
+           IF (    ( gphit(ji,jj) .GT.  mdtcutoff ) &
+              &.OR.( gphit(ji,jj) .LT. -mdtcutoff ) &
+              &.OR.( mdt(ji,jj) .EQ. zfill ) ) &
+              &        zpromsk(ji,jj) = 0.0
+        END DO
+      END DO 
+
+      ! Compute MSSH mean over [0,360] x [-mdtcutoff,mdtcutoff]
+
+      zarea = 0.0
+      zeta1 = 0.0
+      zeta2 = 0.0
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+          zdxdy = e1t(ji,jj) * e2t(ji,jj) * zpromsk(ji,jj)
+          zarea = zarea + zdxdy
+          zeta1 = zeta1 + mdt(ji,jj) * zdxdy
+          zeta2 = zeta2 + sshn (ji,jj) * zdxdy
+        END DO      
+      END DO
+
+      IF( lk_mpp) CALL mpp_sum( zeta1 )
+      IF( lk_mpp) CALL mpp_sum( zeta2 )
+      IF( lk_mpp) CALL mpp_sum( zarea )
+      
+      zcorr_mdt = zeta1 / zarea
+      zcorr_bcketa  = zeta2 / zarea
+
+      !  Define correction term
+
+      zcorr = zcorr_mdt - zcorr_bcketa
+
+      !  Correct spatial mean of the MSSH
+
+      IF ( nmsshc == 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(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) ' obs_readmdt : mdtcutoff     = ', mdtcutoff
+         WRITE(numout,*) ' -----------   zcorr_mdt     = ', zcorr_mdt
+         WRITE(numout,*) '               zcorr_bcketa  = ', zcorr_bcketa
+         WRITE(numout,*) '               zcorr         = ', zcorr
+         WRITE(numout,*) '               nmsshc        = ', nmsshc
+         WRITE(numout,*) 
+      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' 
+
+
+   END SUBROUTINE obs_offset_mdt
+ 
+END MODULE obs_readmdt
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_rot_vel.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_rot_vel.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_rot_vel.F90	(revision 2528)
@@ -0,0 +1,231 @@
+MODULE obs_rot_vel
+   !!======================================================================
+   !!                       ***  MODULE obs_rot_vel  ***
+   !! Observation diagnostics: Read the velocity profile observations
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   obs_rotvel : Rotate velocity data into N-S,E-W directorions
+   !!----------------------------------------------------------------------
+   !! * Modules used   
+   USE par_kind                 ! Precision variables
+   USE par_oce                  ! Ocean parameters
+   USE in_out_manager           ! I/O manager
+   USE dom_oce                  ! Ocean space and time domain variables
+   USE obs_grid                 ! Grid search
+   USE obs_utils                ! For error handling
+   USE obs_profiles_def         ! Profile definitions
+   USE obs_inter_h2d            ! Horizontal interpolation
+   USE obs_inter_sup            ! MPP support routines for interpolation
+   USE geo2ocean                ! Rotation of vectors
+   USE obs_fbm                  ! Feedback definitions
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC obs_rotvel            ! Rotate the observations
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE obs_rotvel( profdata, k2dint, pu, pv )
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_rea_pro_dri ***
+      !!
+      !! ** Purpose : Rotate velocity data into N-S,E-W directorions
+      !!
+      !! ** Method  : Interpolation of geo2ocean coefficients on U,V grid
+      !!              to observation point followed by a similar computations
+      !!              as in geo2ocean.
+      !!
+      !! ** Action  : Review if there is a better way to do this.
+      !!
+      !! References : 
+      !!
+      !! History :  
+      !!      ! :  2009-02 (K. Mogensen) : New routine
+      !!----------------------------------------------------------------------
+      !! * Modules used
+   
+      !! * Arguments
+      TYPE(obs_prof), INTENT(INOUT) :: profdata    ! Profile data to be read
+      INTEGER, INTENT(IN) :: k2dint     ! Horizontal interpolation methed
+      REAL(wp), DIMENSION(*) :: &
+         & pu, &
+         & pv
+      !! * Local declarations
+      REAL(wp), DIMENSION(jpi,jpj) :: &
+         & zsingu, &
+         & zcosgu, &
+         & zsingv, &
+         & zcosgv
+      REAL(wp), DIMENSION(2,2,1) :: zweig
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
+         & zmasku, &
+         & zmaskv, &
+         & zcoslu, &
+         & zsinlu, &
+         & zcoslv, &
+         & zsinlv, &
+         & zglamu, &
+         & zgphiu, &
+         & zglamv, &
+         & zgphiv
+      REAL(wp), DIMENSION(1) :: &
+         & zsinu, &
+         & zcosu, &
+         & zsinv, &
+         & zcosv
+      REAL(wp) :: zsin
+      REAL(wp) :: zcos
+      REAL(wp), DIMENSION(1) :: zobsmask
+      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
+         & igrdiu, &
+         & igrdju, &
+         & igrdiv, &
+         & igrdjv
+      INTEGER :: ji
+      INTEGER :: jk
+
+      !-----------------------------------------------------------------------
+      ! Allocate data for message parsing and interpolation
+      !-----------------------------------------------------------------------
+
+      ALLOCATE( &
+         & igrdiu(2,2,profdata%nprof), &
+         & igrdju(2,2,profdata%nprof), &
+         & zglamu(2,2,profdata%nprof), &
+         & zgphiu(2,2,profdata%nprof), &
+         & zmasku(2,2,profdata%nprof), &
+         & zcoslu(2,2,profdata%nprof), &
+         & zsinlu(2,2,profdata%nprof), &
+         & igrdiv(2,2,profdata%nprof), &
+         & igrdjv(2,2,profdata%nprof), &
+         & zglamv(2,2,profdata%nprof), &
+         & zgphiv(2,2,profdata%nprof), &
+         & zmaskv(2,2,profdata%nprof), &
+         & zcoslv(2,2,profdata%nprof), &
+         & zsinlv(2,2,profdata%nprof)  &
+         & )
+
+      !-----------------------------------------------------------------------
+      ! Receive the angles on the U and V grids.
+      !-----------------------------------------------------------------------
+
+      CALL obs_rot( zsingu, zcosgu, zsingv, zcosgv )
+
+      DO ji = 1, profdata%nprof
+         igrdiu(1,1,ji) = profdata%mi(ji,1)-1
+         igrdju(1,1,ji) = profdata%mj(ji,1)-1
+         igrdiu(1,2,ji) = profdata%mi(ji,1)-1
+         igrdju(1,2,ji) = profdata%mj(ji,1)
+         igrdiu(2,1,ji) = profdata%mi(ji,1)
+         igrdju(2,1,ji) = profdata%mj(ji,1)-1
+         igrdiu(2,2,ji) = profdata%mi(ji,1)
+         igrdju(2,2,ji) = profdata%mj(ji,1)
+         igrdiv(1,1,ji) = profdata%mi(ji,2)-1
+         igrdjv(1,1,ji) = profdata%mj(ji,2)-1
+         igrdiv(1,2,ji) = profdata%mi(ji,2)-1
+         igrdjv(1,2,ji) = profdata%mj(ji,2)
+         igrdiv(2,1,ji) = profdata%mi(ji,2)
+         igrdjv(2,1,ji) = profdata%mj(ji,2)-1
+         igrdiv(2,2,ji) = profdata%mi(ji,2)
+         igrdjv(2,2,ji) = profdata%mj(ji,2)
+      END DO
+
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, &
+         &                  glamu, zglamu )
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, &
+         &                  gphiu, zgphiu )
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, &
+         &                  umask(:,:,1), zmasku )
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, &
+         &                  zsingu, zsinlu )
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, &
+         &                  zcosgu, zcoslu )
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, &
+         &                  glamv, zglamv )
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, &
+         &                  gphiv, zgphiv )
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, &
+         &                  vmask(:,:,1), zmaskv )
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, &
+         &                  zsingv, zsinlv )
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, &
+         &                  zcosgv, zcoslv )
+
+      DO ji = 1, profdata%nprof
+            
+         CALL obs_int_h2d_init( 1, 1, k2dint, &
+            &                   profdata%rlam(ji), profdata%rphi(ji), &
+            &                   zglamu(:,:,ji), zgphiu(:,:,ji), &
+            &                   zmasku(:,:,ji), zweig, zobsmask )
+         
+         CALL obs_int_h2d( 1, 1, zweig, zsinlu(:,:,ji),  zsinu )
+
+         CALL obs_int_h2d( 1, 1, zweig, zcoslu(:,:,ji),  zcosu )
+
+         CALL obs_int_h2d_init( 1, 1, k2dint, &
+            &                   profdata%rlam(ji), profdata%rphi(ji), &
+            &                   zglamv(:,:,ji), zgphiv(:,:,ji), &
+            &                   zmaskv(:,:,ji), zweig, zobsmask )
+         
+         CALL obs_int_h2d( 1, 1, zweig, zsinlv(:,:,ji),  zsinv )
+
+         CALL obs_int_h2d( 1, 1, zweig, zcoslv(:,:,ji),  zcosv )
+
+         ! Assume that the angle at observation point is the 
+         ! mean of u and v cosines/sines
+
+         zcos = 0.5_wp * ( zcosu(1) + zcosv(1) )
+         zsin = 0.5_wp * ( zsinu(1) + zsinv(1) )
+         
+         IF ( ( profdata%npvsta(ji,1) /= profdata%npvsta(ji,2) ) .OR. &
+            & ( profdata%npvend(ji,1) /= profdata%npvend(ji,2) ) ) THEN
+            CALL fatal_error( 'Different number of U and V observations '// &
+               'in a profile in obs_rotvel', __LINE__ )
+         ENDIF
+
+         DO jk = profdata%npvsta(ji,1), profdata%npvend(ji,1)
+            IF ( ( profdata%var(1)%vmod(jk) /= fbrmdi ) .AND. &
+               & ( profdata%var(1)%vmod(jk) /= fbrmdi ) ) THEN
+               pu(jk) = profdata%var(1)%vmod(jk) * zcos - &
+                  &     profdata%var(2)%vmod(jk) * zsin 
+               pv(jk) = profdata%var(2)%vmod(jk) * zcos + &
+                  &     profdata%var(1)%vmod(jk) * zsin
+            ELSE
+               pu(jk) = fbrmdi
+               pv(jk) = fbrmdi
+            ENDIF
+         END DO
+
+      END DO
+      
+      DEALLOCATE( &
+         & igrdiu, &
+         & igrdju, &
+         & zglamu, &
+         & zgphiu, &
+         & zmasku, &
+         & zcoslu, &
+         & zsinlu, &
+         & igrdiv, &
+         & igrdjv, &
+         & zglamv, &
+         & zgphiv, &
+         & zmaskv, &
+         & zcoslv, &
+         & zsinlv  &
+         & )
+
+   END SUBROUTINE obs_rotvel
+
+END MODULE obs_rot_vel
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_seaice.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_seaice.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_seaice.F90	(revision 2528)
@@ -0,0 +1,37 @@
+MODULE obs_seaice
+   !!=====================================================================
+   !!                       ***  MODULE  obs_seaice  ***
+   !! Observation diagnostics: Storage space for sea ice observations
+   !!                          arrays and additional flags etc.
+   !!=====================================================================
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   
+   !! * Modules used 
+   USE obs_surf_def ! Definition of sea ice data types and tools
+
+   IMPLICIT NONE
+   
+   SAVE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC nseaicevars, nseaiceextr, nseaicesets, seaicedata, seaicedatqc
+
+   !! * Shared Module variables
+   INTEGER :: nseaicevars                               ! Number of seaicedata variables
+   INTEGER :: nseaiceextr                               ! Number of seaicedata extra 
+                                                     ! variables
+   INTEGER :: nseaicesets                               ! Number of seaicedata sets
+!$AGRIF_DO_NOT_TREAT
+   TYPE(obs_surf), POINTER, DIMENSION(:) :: seaicedata  ! Initial sea ice data
+   TYPE(obs_surf), POINTER, DIMENSION(:) :: seaicedatqc ! Sea ice data after quality control
+!$AGRIF_END_DO_NOT_TREAT
+
+END MODULE obs_seaice
+
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_seaice_io.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_seaice_io.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_seaice_io.F90	(revision 2528)
@@ -0,0 +1,30 @@
+MODULE obs_seaice_io
+   !!======================================================================
+   !!                       ***  MODULE obs_seaice_io  ***
+   !! Observation operators : I/O for GHRSEAICE files
+   !!======================================================================
+   !! History : 
+   !!             !  09-01  (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   read_seaicefile    :  Read a obfbdata structure from an GHRSEAICE file
+   !!----------------------------------------------------------------------
+   USE par_kind
+   USE obs_utils
+   USE obs_fbm
+   USE julian
+   USE netcdf
+
+   IMPLICIT NONE
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#include "obsseaice_io.h90"
+
+END MODULE obs_seaice_io
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sla.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sla.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sla.F90	(revision 2528)
@@ -0,0 +1,35 @@
+MODULE obs_sla
+   !!=====================================================================
+   !!                       ***  MODULE  obs_sla  ***
+   !! Observation diagnostics: Storage space for SLA observations
+   !!                          arrays and additional flags etc.
+   !!=====================================================================
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   
+   !! * Modules used 
+   USE obs_surf_def ! Definition of SLA data types and tools
+
+   IMPLICIT NONE
+   
+   SAVE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC nslavars, nslaextr, nslasets, sladata, sladatqc
+
+   !! * Shared Module variables
+   INTEGER :: nslavars                               ! Number of sladata variables
+   INTEGER :: nslaextr                               ! Number of sladata extra 
+                                                     ! variables
+   INTEGER :: nslasets                               ! Number of sladata sets                                               
+!$AGRIF_DO_NOT_TREAT
+   TYPE(obs_surf), POINTER, DIMENSION(:) :: sladata  ! Initial SLA data
+   TYPE(obs_surf), POINTER, DIMENSION(:) :: sladatqc ! SLA data after quality control
+!$AGRIF_END_DO_NOT_TREAT
+
+END MODULE obs_sla
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sla_io.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sla_io.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sla_io.F90	(revision 2528)
@@ -0,0 +1,30 @@
+MODULE obs_sla_io
+   !!======================================================================
+   !!                       ***  MODULE obs_sla_io  ***
+   !! Observation operators : I/O for AVISO SLA files
+   !!======================================================================
+   !! History : 
+   !!             !  09-01  (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   read_enactfile    :  Read a obfbdata structure from an AVISO SLA file
+   !!----------------------------------------------------------------------
+   USE par_kind
+   USE obs_utils
+   USE obs_fbm
+   use obs_sla_types
+   USE netcdf
+
+   IMPLICIT NONE
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#include "obssla_io.h90"
+
+END MODULE obs_sla_io
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sla_types.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sla_types.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sla_types.F90	(revision 2528)
@@ -0,0 +1,19 @@
+MODULE obs_sla_types
+   !!======================================================================
+   !!                       ***  MODULE obs_sla_type  ***
+   !! Observation operators : Satellite identifiers for SLA data
+   !!======================================================================
+   !! History : 
+   !!             !  09-01  (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   IMPLICIT NONE
+
+#include "obssla_types.h90"
+
+END MODULE obs_sla_types
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sort.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sort.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sort.F90	(revision 2528)
@@ -0,0 +1,147 @@
+MODULE obs_sort
+   !!=====================================================================
+   !!                       ***  MODULE obs_sort  ***
+   !! Observation diagnostics: Various tools for sorting etc.
+   !!=====================================================================
+
+   !!----------------------------------------------------------------------
+   !!   sort_dp_indx : Get indicies for ascending order for a double prec. array
+   !!   index_sort   : Get indicies for ascending order for a double prec. array
+   !!---------------------------------------------------------------------
+   !! * Modules used
+   USE par_kind, ONLY : & ! Precision variables
+      & dp
+  
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE index_sort    ! Get indicies for ascending order for a double prec. array
+   
+   PUBLIC sort_dp_indx   ! Get indicies for ascending order for a double prec. array
+  
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE sort_dp_indx( kvals, pvals, kindx )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE sort_dp_indx  ***
+      !!          
+      !! ** Purpose : Get indicies for ascending order for a double precision array
+      !!
+      !! ** Method  : Call index_sort routine
+      !!
+      !! ** Action  : 
+      !!
+      !! History :
+      !!        !  06-05  (K. Mogensen)  Original code
+      !!        !  06-10  (A. Weaver) Cleaning
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kvals     ! Number of elements to be sorted
+      REAL(KIND=dp), DIMENSION(kvals), INTENT(IN) :: &
+         & pvals            ! Array to be sorted
+      INTEGER, DIMENSION(kvals), INTENT(OUT) ::  &
+         & kindx            ! Indices for ordering of array
+
+      !! * Local declarations
+
+      !-----------------------------------------------------------------------
+      ! Call qsort routine
+      !-----------------------------------------------------------------------
+      IF (kvals>=1) THEN
+
+         CALL index_sort( pvals, kindx, kvals )
+
+      ENDIF
+
+   END SUBROUTINE sort_dp_indx
+
+   SUBROUTINE index_sort( pval, kindx, kvals )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE index_sort  ***
+      !!          
+      !! ** Purpose : Get indicies for ascending order for a double precision array
+      !!
+      !! ** Method  : Heapsort
+      !!
+      !! ** Action  : 
+      !!
+      !! References : http://en.wikipedia.org/wiki/Heapsort
+      !!
+      !! History :
+      !!        !  06-05  (K. Mogensen)  Original code
+      !!        !  06-10  (A. Weaver) Cleaning
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kvals         ! Number of values
+      REAL(KIND=dp), DIMENSION(kvals), INTENT(IN) :: &
+         & pval                            ! Array to be sorted
+      INTEGER, DIMENSION(kvals), INTENT(INOUT) :: &
+         & kindx                           ! Indicies for ordering
+
+      !! * Local declarations
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jt
+      INTEGER :: jn
+      INTEGER :: jparent
+      INTEGER :: jchild
+
+      DO ji = 1, kvals
+         kindx(ji) = ji
+      END DO
+      
+      ji = kvals/2 + 1
+      jn = kvals
+
+      main_loop : DO
+
+         IF ( ji > 1 ) THEN
+            ji = ji-1
+            jt = kindx(ji)
+         ELSE
+            jt = kindx(jn)
+            kindx(jn) = kindx(1)
+            jn = jn-1
+            IF ( jn <= 1 ) THEN
+               kindx(1) = jt
+               EXIT main_loop
+            ENDIF
+         ENDIF
+
+         jparent = ji
+         jchild =  2 * ji
+
+         inner_loop : DO
+
+            IF ( jchild > jn ) EXIT inner_loop
+            IF ( jchild < jn ) THEN
+               IF ( pval(kindx(jchild)) < pval(kindx(jchild+1)) ) THEN
+                 jchild = jchild+1
+               ENDIF
+            ENDIF
+            IF  ( pval(jt) < pval(kindx(jchild))) THEN
+               kindx(jparent) = kindx(jchild)
+               jparent = jchild
+               jchild  = jchild*2
+            ELSE 
+               jchild = jn + 1 
+            ENDIF
+
+         END DO inner_loop
+
+         kindx(jparent) = jt
+
+      END DO main_loop
+      
+   END SUBROUTINE index_sort
+
+END MODULE obs_sort
+ 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sst.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sst.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sst.F90	(revision 2528)
@@ -0,0 +1,37 @@
+MODULE obs_sst
+   !!=====================================================================
+   !!                       ***  MODULE  obs_sst  ***
+   !! Observation diagnostics: Storage space for SST observations
+   !!                          arrays and additional flags etc.
+   !!=====================================================================
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   
+   !! * Modules used 
+   USE obs_surf_def ! Definition of SST data types and tools
+
+   IMPLICIT NONE
+   
+   SAVE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC nsstvars, nsstextr, nsstsets, sstdata, sstdatqc
+
+   !! * Shared Module variables
+   INTEGER :: nsstvars                               ! Number of sstdata variables
+   INTEGER :: nsstextr                               ! Number of sstdata extra 
+                                                     ! variables
+   INTEGER :: nsstsets                               ! Number of sstdata sets
+!$AGRIF_DO_NOT_TREAT
+   TYPE(obs_surf), POINTER, DIMENSION(:) :: sstdata  ! Initial SST data
+   TYPE(obs_surf), POINTER, DIMENSION(:) :: sstdatqc ! SST data after quality control
+!$AGRIF_END_DO_NOT_TREAT
+
+END MODULE obs_sst
+
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sst_io.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sst_io.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sst_io.F90	(revision 2528)
@@ -0,0 +1,30 @@
+MODULE obs_sst_io
+   !!======================================================================
+   !!                       ***  MODULE obs_sst_io  ***
+   !! Observation operators : I/O for GHRSST files
+   !!======================================================================
+   !! History : 
+   !!             !  09-01  (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   read_sstfile    :  Read a obfbdata structure from an GHRSST file
+   !!----------------------------------------------------------------------
+   USE par_kind
+   USE obs_utils
+   USE obs_fbm
+   USE julian
+   USE netcdf
+
+   IMPLICIT NONE
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#include "obssst_io.h90"
+
+END MODULE obs_sst_io
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_surf_def.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_surf_def.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_surf_def.F90	(revision 2528)
@@ -0,0 +1,461 @@
+MODULE obs_surf_def
+   !!=====================================================================
+   !!                       ***  MODULE  obs_surf_def  ***
+   !! Observation diagnostics: Storage handling for surface observation
+   !!                          arrays and additional flags etc.
+   !!                          This module only defines the data type and
+   !!                          operations on the data type. There is no
+   !!                          actual data in the module.
+   !!===================================================================== 
+
+   !!----------------------------------------------------------------------
+   !!   obs_surf            : F90 type containing the surface information
+   !!   obs_surf_alloc      : Allocates surface data arrays
+   !!   obs_surf_dealloc    : Deallocates surface data arrays
+   !!   obs_surf_compress   : Extract sub-information from a obs_surf type
+   !!                         to a new obs_surf type
+   !!   obs_surf_decompress : Reinsert sub-information from a obs_surf type
+   !!                         into the original obs_surf type
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE par_kind, ONLY : & ! Precision variables
+      & wp         
+   USE obs_mpp, ONLY : &  ! MPP tools 
+      obs_mpp_sum_integer
+
+   IMPLICIT NONE
+
+   !! * Routine/type accessibility
+   PRIVATE
+
+   PUBLIC &
+      & obs_surf,           &
+      & obs_surf_alloc,     &
+      & obs_surf_dealloc,   &
+      & obs_surf_compress,  &
+      & obs_surf_decompress
+
+   !! * Type definition for surface observation type
+
+   TYPE obs_surf
+
+      ! Bookkeeping
+
+      INTEGER :: nsurf      !: Local number of surface data within window
+      INTEGER :: nsurfmpp   !: Global number of surface data within window
+      INTEGER :: nvar       !: Number of variables at observation points
+      INTEGER :: nextra     !: Number of extra fields at observation points
+      INTEGER :: nstp       !: Number of time steps
+      INTEGER :: nsurfup    !: Observation counter used in obs_oper
+
+      ! Arrays with size equal to the number of surface observations
+
+      INTEGER, POINTER, DIMENSION(:) :: &
+         & mi,   &        !: i-th grid coord. for interpolating to surface observation
+         & mj,   &        !: j-th grid coord. for interpolating to surface observation
+         & nsidx,&        !: Surface observation number
+         & nsfil,&        !: Surface observation number in file
+         & nyea, &        !: Year of surface observation
+         & nmon, &        !: Month of surface observation 
+         & nday, &        !: Day of surface observation
+         & nhou, &        !: Hour of surface observation
+         & nmin, &        !: Minute of surface observation
+         & mstp, &        !: Time step nearest to surface observation
+         & nqc,  &        !: Surface observation qc flag
+         & ntyp           !: Type of surface observation product
+
+      CHARACTER(LEN=8), POINTER, DIMENSION(:) :: &
+         & cwmo           !: WMO indentifier
+         
+      REAL(KIND=wp), POINTER, DIMENSION(:) :: &
+         & rlam, &        !: Longitude coordinate of surface observation
+         & rphi           !: Latitude coordinate of surface observation
+
+      REAL(KIND=wp), POINTER, DIMENSION(:,:) :: &
+         & robs, &        !: Surface observation 
+         & rmod           !: Model counterpart of the surface observation vector
+
+      REAL(KIND=wp), POINTER, DIMENSION(:,:) :: &
+         & rext           !: Extra fields interpolated to observation points
+
+      ! Arrays with size equal to the number of time steps in the window
+
+      INTEGER, POINTER, DIMENSION(:) :: &
+         & nsstp,     &   !: Local number of surface observations per time step
+         & nsstpmpp       !: Global number of surface observations per time step
+
+      ! Arrays used to store source indices when 
+      ! compressing obs_surf derived types
+      
+      ! Array with size nsurf
+
+      INTEGER, POINTER, DIMENSION(:) :: &
+         & nsind          !: Source indices of surface data in compressed data
+
+   END TYPE obs_surf
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+   
+   SUBROUTINE obs_surf_alloc( surf, ksurf, kvar, kextra, kstp )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE obs_surf_alloc  ***
+      !!                      
+      !! ** Purpose : - Allocate data for surface data arrays
+      !! 
+      !! ** Method  : - Fortran-90 dynamic arrays
+      !!
+      !! History :
+      !!        !  07-03  (K. Mogensen, A. Weaver, E. Remy, S. Ricci) original
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      TYPE(obs_surf), INTENT(INOUT) ::  surf      ! Surface data to be allocated
+      INTEGER, INTENT(IN) :: ksurf   ! Number of surface observations
+      INTEGER, INTENT(IN) :: kvar    ! Number of surface variables
+      INTEGER, INTENT(IN) :: kextra  ! Number of extra fields at observation points
+      INTEGER, INTENT(IN) :: kstp    ! Number of time steps
+
+      !!* Local variables
+      INTEGER :: ji
+
+      ! Set bookkeeping variables
+
+      surf%nsurf    = ksurf
+      surf%nsurfmpp = 0
+      surf%nextra   = kextra
+      surf%nvar     = kvar
+      surf%nstp     = kstp
+      
+      ! Allocate arrays of number of surface data size
+
+      ALLOCATE( &
+         & surf%mi(ksurf),      &
+         & surf%mj(ksurf),      &
+         & surf%nsidx(ksurf),   &
+         & surf%nsfil(ksurf),   &
+         & surf%nyea(ksurf),    &
+         & surf%nmon(ksurf),    &
+         & surf%nday(ksurf),    &
+         & surf%nhou(ksurf),    &
+         & surf%nmin(ksurf),    &
+         & surf%mstp(ksurf),    &
+         & surf%nqc(ksurf),     &
+         & surf%ntyp(ksurf),    &
+         & surf%cwmo(ksurf),    &
+         & surf%rlam(ksurf),    &
+         & surf%rphi(ksurf),    &
+         & surf%nsind(ksurf)    &
+         & )
+
+
+      ! Allocate arrays of number of surface data size * number of variables
+
+      ALLOCATE( & 
+         & surf%robs(ksurf,kvar), &
+         & surf%rmod(ksurf,kvar)  &
+         & )   
+
+      ! Allocate arrays of number of extra fields at observation points
+
+      ALLOCATE( & 
+         & surf%rext(ksurf,kextra) &
+         & )
+
+      ! Allocate arrays of number of time step size
+
+      ALLOCATE( &
+         & surf%nsstp(kstp),     &
+         & surf%nsstpmpp(kstp)   &
+         & )
+
+      ! Set defaults for compression indices
+      
+      DO ji = 1, ksurf
+         surf%nsind(ji) = ji
+      END DO
+      
+      ! Set defaults for number of observations per time step
+
+      surf%nsstp(:)     = 0
+      surf%nsstpmpp(:)  = 0
+
+      ! Set the observation counter used in obs_oper
+
+      surf%nsurfup     = 0
+              
+   END SUBROUTINE obs_surf_alloc
+
+   SUBROUTINE obs_surf_dealloc( surf )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE obs_surf_dealloc  ***
+      !!                      
+      !! ** Purpose : - Deallocate data for surface data arrays
+      !! 
+      !! ** Method  : - Fortran-90 dynamic arrays
+      !!
+      !! History :
+      !!        !  07-03  (K. Mogensen, A. Weaver, E. Remy, S. Ricci) original
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      TYPE(obs_surf), INTENT(INOUT) :: &
+         & surf      ! Surface data to be allocated
+
+      !!* Local variables
+
+      ! Deallocate arrays of number of surface data size
+
+      DEALLOCATE( &
+         & surf%mi,      &
+         & surf%mj,      &
+         & surf%nsidx,   &
+         & surf%nsfil,   &
+         & surf%nyea,    &
+         & surf%nmon,    &
+         & surf%nday,    &
+         & surf%nhou,    &
+         & surf%nmin,    &
+         & surf%mstp,    &
+         & surf%nqc,     &
+         & surf%ntyp,    &
+         & surf%cwmo,    &
+         & surf%rlam,    &
+         & surf%rphi,    &
+         & surf%nsind    &
+         & )
+
+      ! Allocate arrays of number of surface data size * number of variables
+
+      DEALLOCATE( & 
+         & surf%robs,    &
+         & surf%rmod     &
+         & )
+
+      ! Deallocate arrays of number of extra fields at observation points
+
+      DEALLOCATE( & 
+         & surf%rext &
+         & )
+
+      ! Deallocate arrays of number of time step size
+
+      DEALLOCATE( &
+         & surf%nsstp,     &
+         & surf%nsstpmpp   &
+         & )
+
+   END SUBROUTINE obs_surf_dealloc
+
+   SUBROUTINE obs_surf_compress( surf, newsurf, lallocate, kumout, lvalid )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE obs_surf_compress  ***
+      !!                      
+      !! ** Purpose : - Extract sub-information from a obs_surf type
+      !!                into a new obs_surf type
+      !! 
+      !! ** Method  : - The data is copied from surf to new surf.
+      !!                In the case of lvalid being present only the 
+      !!                selected data will be copied.
+      !!                If lallocate is true the data in the newsurf is 
+      !!                allocated either with the same number of elements
+      !!                as surf or with only the subset of elements defined
+      !!                by the optional selection.
+      !!
+      !! History :
+      !!        !  07-03  (K. Mogensen, A. Weaver, E. Remy, S. Ricci) original
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      TYPE(obs_surf), INTENT(IN)    :: surf      ! Original surface data
+      TYPE(obs_surf), INTENT(INOUT) :: newsurf   ! New surface data with a subset of the original data
+      LOGICAL :: lallocate     ! Allocate newsurf data
+      INTEGER,INTENT(IN) :: kumout        ! Fortran unit for messages
+      LOGICAL, OPTIONAL, INTENT(in), DIMENSION(:) :: &
+         & lvalid         ! Valid of surface observations
+      
+      !!* Local variables
+      INTEGER :: insurf
+      INTEGER :: ji
+      INTEGER :: jk
+      LOGICAL, DIMENSION(:), ALLOCATABLE :: llvalid
+
+      ! Count how many elements there should be in the new data structure
+
+      IF ( PRESENT(lvalid) ) THEN
+         insurf = 0
+         DO ji = 1, surf%nsurf
+            IF ( lvalid(ji) ) THEN
+               insurf = insurf + 1
+            ENDIF
+         END DO
+      ELSE
+         insurf = surf%nsurf
+      ENDIF
+
+      ! Optionally allocate data in the new data structure
+
+      IF ( lallocate ) THEN
+         CALL obs_surf_alloc( newsurf,  insurf, surf%nvar, &
+            & surf%nextra, surf%nstp )
+      ENDIF
+
+      ! Allocate temporary valid array to unify the code for both cases
+
+      ALLOCATE( llvalid(surf%nsurf) )
+      IF ( PRESENT(lvalid) ) THEN
+         llvalid(:)  = lvalid(:)
+      ELSE
+         llvalid(:)  = .TRUE.
+      ENDIF
+
+      ! Setup bookkeeping variables
+
+      insurf = 0
+
+      ! Loop over source surface data
+
+      DO ji = 1, surf%nsurf
+
+         IF ( llvalid(ji) ) THEN
+
+            ! Copy the header information
+
+            insurf = insurf + 1
+
+            newsurf%mi(insurf)    = surf%mi(ji)
+            newsurf%mj(insurf)    = surf%mj(ji)
+            newsurf%nsidx(insurf) = surf%nsidx(ji)
+            newsurf%nsfil(insurf) = surf%nsfil(ji)
+            newsurf%nyea(insurf)  = surf%nyea(ji)
+            newsurf%nmon(insurf)  = surf%nmon(ji)
+            newsurf%nday(insurf)  = surf%nday(ji)
+            newsurf%nhou(insurf)  = surf%nhou(ji)
+            newsurf%nmin(insurf)  = surf%nmin(ji)
+            newsurf%mstp(insurf)  = surf%mstp(ji)
+            newsurf%nqc(insurf)   = surf%nqc(ji)
+            newsurf%ntyp(insurf)  = surf%ntyp(ji)
+            newsurf%cwmo(insurf)  = surf%cwmo(ji)
+            newsurf%rlam(insurf)  = surf%rlam(ji)
+            newsurf%rphi(insurf)  = surf%rphi(ji)
+
+            DO jk = 1, surf%nvar
+
+               newsurf%robs(insurf,jk)  = surf%robs(ji,jk)
+               newsurf%rmod(insurf,jk)  = surf%rmod(ji,jk)
+               
+            END DO
+
+            DO jk = 1, surf%nextra
+
+               newsurf%rext(insurf,jk) = surf%rext(ji,jk)
+
+            END DO
+            
+            ! nsind is the index of the original surface data
+            
+            newsurf%nsind(insurf) = ji
+
+         ENDIF
+
+      END DO
+
+      ! Update MPP counters
+
+      newsurf%nsurf = insurf
+      CALL obs_mpp_sum_integer ( newsurf%nsurf, newsurf%nsurfmpp )
+
+      ! Set book keeping variables which do not depend on number of obs.
+
+      newsurf%nstp  = surf%nstp
+ 
+      ! Deallocate temporary data
+
+      DEALLOCATE( llvalid )
+     
+   END SUBROUTINE obs_surf_compress
+
+   SUBROUTINE obs_surf_decompress( surf, oldsurf, ldeallocate, kumout )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE obs_surf_decompress  ***
+      !!                      
+      !! ** Purpose : - Copy back information to original surface data type
+      !!
+      !! ** Method  : - Reinsert updated information from a previous
+      !!                copied/compressed surface data type into the original
+      !!                surface data and optionally deallocate the surface
+      !!                data input
+      !! 
+      !! History :
+      !!        !  07-03  (K. Mogensen, A. Weaver, E. Remy, S. Ricci) original
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      TYPE(obs_surf),INTENT(INOUT) :: surf       ! Updated surface data
+      TYPE(obs_surf),INTENT(INOUT) :: oldsurf    ! Original surface data
+      LOGICAL :: ldeallocate ! Deallocate the updated data of insertion
+      INTEGER,INTENT(in) :: kumout      ! Output unit
+      
+      !!* Local variables
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jk
+
+      ! Copy data from surf to old surf
+
+      DO ji = 1, surf%nsurf
+
+         jj=surf%nsind(ji)
+
+         oldsurf%mi(jj)    = surf%mi(ji)
+         oldsurf%mj(jj)    = surf%mj(ji)
+         oldsurf%nsidx(jj) = surf%nsidx(ji)
+         oldsurf%nsfil(jj) = surf%nsfil(ji)
+         oldsurf%nyea(jj)  = surf%nyea(ji)
+         oldsurf%nmon(jj)  = surf%nmon(ji)
+         oldsurf%nday(jj)  = surf%nday(ji)
+         oldsurf%nhou(jj)  = surf%nhou(ji)
+         oldsurf%nmin(jj)  = surf%nmin(ji)
+         oldsurf%mstp(jj)  = surf%mstp(ji)
+         oldsurf%nqc(jj)   = surf%nqc(ji)
+         oldsurf%ntyp(jj)  = surf%ntyp(ji)
+         oldsurf%cwmo(jj)  = surf%cwmo(ji)
+         oldsurf%rlam(jj)  = surf%rlam(ji)
+         oldsurf%rphi(jj)  = surf%rphi(ji)
+
+      END DO
+
+      DO jk = 1, surf%nvar
+
+         DO ji = 1, surf%nsurf
+            
+            jj=surf%nsind(ji)
+
+            oldsurf%robs(jj,jk)  = surf%robs(ji,jk)
+            oldsurf%rmod(jj,jk)  = surf%rmod(ji,jk)
+
+         END DO
+
+      END DO
+
+      DO jk = 1, surf%nextra
+
+         DO ji = 1, surf%nsurf
+            
+            jj=surf%nsind(ji)
+
+            oldsurf%rext(jj,jk)  = surf%rext(ji,jk)
+
+         END DO
+
+      END DO
+
+      ! Optionally deallocate the updated surface data
+
+      IF ( ldeallocate ) CALL obs_surf_dealloc( surf )
+      
+   END SUBROUTINE obs_surf_decompress
+   
+END MODULE obs_surf_def
+
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_types.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_types.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_types.F90	(revision 2528)
@@ -0,0 +1,267 @@
+MODULE obs_types
+   !!=====================================================================
+   !!                       ***  MODULE  obs_types  ***
+   !! Observation diagnostics: Observation type integer to character 
+   !!                          translation
+   !!=====================================================================
+
+   !!---------------------------------------------------------------------
+   !! 
+   !!   The NetCDF variable CWMO_INST_TYP_COR is used to identify the 
+   !!   different instrument types for coriolis data.
+   !!
+   !!    WMO  NEMOVAR  TYPE                   DESCRIPTION
+   !!    ---  -------  ----   --------------------------------------------
+   !!    800     0     MBT    (1941-) mechanical bathythermograph data
+   !!    401     1     XBT    (1967-) expendable bathythermograph data
+   !!    830     2     CTD    (1967-) high resolution CTD data
+   !!    820     3     MRB    (1990-) moored buoy data
+   !!    831     4     PFL    (1994-) profiling float data
+   !!    995     5     DRB    (1998-) drifting buoy data
+   !!    997     6     APB    (1997-) autonomous pinniped bathythermograph
+   !!    996     7     UOR    (1992-) undulating oceanographic recorder
+   !!    741     8     OSD    (1800-) low resolution (bottle) CTD data
+  !!
+   !! History :
+   !!        !  06-03  (K. Mogensen) Original code
+   !!        !  06-10  (A. Weaver) Cleanup
+   !!---------------------------------------------------------------------
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE 
+
+   !! * Shared Module variables
+
+   INTEGER, PUBLIC, PARAMETER :: ntyp1770 = 1023
+!RBbug useless ?   CHARACTER(LEN=4), PUBLIC, DIMENSION(0:ntyp1770) :: cwmotyp1770
+   CHARACTER(LEN=80), PUBLIC, DIMENSION(0:ntyp1770) :: cwmonam1770
+   CHARACTER(LEN=3), PUBLIC, DIMENSION(0:ntyp1770) :: ctypshort
+
+   INTEGER, PUBLIC, PARAMETER :: ntypalt = 8
+   CHARACTER(LEN=40), PUBLIC, DIMENSION(0:ntypalt) :: calttyp
+
+   PUBLIC obs_typ_init
+   PUBLIC obs_wmo_init
+   PUBLIC obs_alt_typ_init
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS 
+   
+   SUBROUTINE obs_typ_init
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_wmo_init ***
+      !!
+      !! ** Purpose : Initialize code tables
+      !!
+      !! ** Method  : 
+      !!
+      !! ** Action  : 
+      !!
+      !! References : 
+      !!
+      !! History :  
+      !!      ! :  2007-06 (K. Mogensen) Original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      
+      !! * Arguments
+
+      !! * Local declarations
+
+      CALL obs_wmo_init
+
+      CALL obs_alt_typ_init
+
+   END SUBROUTINE obs_typ_init
+
+   SUBROUTINE obs_wmo_init
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_wmo_init ***
+      !!
+      !! ** Purpose : Initialize WMO code 1770 code tables
+      !!
+      !! ** Method  : Direct initialisation of variables
+      !!
+      !! ** Action  : 
+      !!
+      !! References : WORLD  METEOROLOGICAL  ORGANIZATION
+      !!              Manual on Codes
+      !!              International Codes
+      !!              VOLUME I.1 (Annex II to WMO Technical Regulations)
+      !!              Part A -- Alphanumeric Codes
+      !!              1995 edition
+      !!              WMO-No. 306 
+      !!              Secretariat of the World Meteorological Organization 
+      !!              Geneva, Switzerland
+      !!
+      !! History :  
+      !!      ! :  2007-04 (K. Mogensen) Original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      
+      !! * Arguments
+
+      !! * Local declarations
+      INTEGER :: ji
+
+      DO ji = 0, ntyp1770
+
+         cwmonam1770(ji) = 'Not defined'
+         ctypshort(ji) = 'XBT'
+
+!         IF ( ji < 1000 ) THEN
+!            WRITE(cwmotyp1770(ji),'(1X,I3.3)') ji
+!         ELSE
+!            WRITE(cwmotyp1770(ji),'(I4.4)') ji
+!         ENDIF
+
+      END DO
+
+      cwmonam1770(   1) = 'Sippican T-4'
+      cwmonam1770(   2) = 'Sippican T-4'
+      cwmonam1770(  11) = 'Sippican T-5'
+      cwmonam1770(  21) = 'Sippican Fast Deep'
+      cwmonam1770(  31) = 'Sippican T-6'
+      cwmonam1770(  32) = 'Sippican T-6'
+      cwmonam1770(  41) = 'Sippican T-7'
+      cwmonam1770(  42) = 'Sippican T-7'
+      cwmonam1770(  51) = 'Sippican Deep Blue'
+      cwmonam1770(  52) = 'Sippican Deep Blue'
+      cwmonam1770(  61) = 'Sippican T-10'
+      cwmonam1770(  71) = 'Sippican T-11'
+      cwmonam1770( 201) = 'TSK T-4'
+      cwmonam1770( 202) = 'TSK T-4'
+      cwmonam1770( 211) = 'TSK T-6'
+      cwmonam1770( 212) = 'TSK T-6'
+      cwmonam1770( 221) = 'TSK T-7'
+      cwmonam1770( 222) = 'TSK T-7'
+      cwmonam1770( 231) = 'TSK T-5'
+      cwmonam1770( 241) = 'TSK T-10'
+      cwmonam1770( 251) = 'TSK Deep Blue'
+      cwmonam1770( 252) = 'TSK Deep Blue'
+      cwmonam1770( 261) = 'TSK AXBT '
+      cwmonam1770( 401) = 'Sparton XBT-1'
+      cwmonam1770( 411) = 'Sparton XBT-3'
+      cwmonam1770( 421) = 'Sparton XBT-4'
+      cwmonam1770( 431) = 'Sparton XBT-5'
+      cwmonam1770( 441) = 'Sparton XBT-5DB'
+      cwmonam1770( 451) = 'Sparton XBT-6'
+      cwmonam1770( 461) = 'Sparton XBT-7'
+      cwmonam1770( 462) = 'Sparton XBT-7'
+      cwmonam1770( 471) = 'Sparton XBT-7DB'
+      cwmonam1770( 481) = 'Sparton XBT-10'
+      cwmonam1770( 491) = 'Sparton XBT-20'
+      cwmonam1770( 501) = 'Sparton XBT-20DB'
+      cwmonam1770( 510) = 'Sparton 536 AXBT'
+      cwmonam1770( 700) = 'Sippican XCTD standard'
+      cwmonam1770( 710) = 'Sippican XCTD deep'
+      cwmonam1770( 720) = 'Sippican AXCTD'
+      cwmonam1770( 730) = 'Sippican SXCTD'
+      cwmonam1770( 741) = 'TSK XCTD'
+      cwmonam1770( 742) = 'TSK XCTD-2 '
+      cwmonam1770( 743) = 'TSK XCTD-2F '
+      cwmonam1770( 751) = 'TSK AXCTD '
+      cwmonam1770( 800) = 'Mechanical BT'
+      cwmonam1770( 810) = 'Hydrocast'
+      cwmonam1770( 820) = 'Thermistor Chain'
+      cwmonam1770( 825) = 'Temperature (sonic) and pressure probes'
+      cwmonam1770( 830) = 'CTD'
+      cwmonam1770( 831) = 'CTD-P-ALACE float'
+      cwmonam1770( 840) = 'PROVOR, No conductivity sensor '
+      cwmonam1770( 841) = 'PROVOR, Seabird conductivity sensor '
+      cwmonam1770( 842) = 'PROVOR, FSI conductivity sensor '
+      cwmonam1770( 845) = 'Web Research, No conductivity sensor '
+      cwmonam1770( 846) = 'Web Research, Seabird conductivity sensor '
+      cwmonam1770( 847) = 'Web Research. FSI conductivity sensor'
+      cwmonam1770( 850) = 'SOLO, No conductivity sensor '
+      cwmonam1770( 851) = 'SOLO, Seabird conductivity sensor '
+      cwmonam1770( 852) = 'SOLO, FSI conductivity sensor'
+      cwmonam1770( 855) = 'Profiling float, NINJA, no conductivity sensor'
+      cwmonam1770( 856) = 'Profiling float, NINJA, SBE conductivity sensor'
+      cwmonam1770( 857) = 'Profiling float, NINJA, FSI conductivity sensor'
+      cwmonam1770( 858) = 'Profiling float, NINJA, TSK conductivity sensor'
+      cwmonam1770( 900) = 'Sippican T-12 XBT'
+      cwmonam1770(1023) = 'Missing value'
+
+      DO ji = 853, 854
+         cwmonam1770(ji) = 'Reserved'
+      END DO
+
+      DO ji = 859, 899
+         cwmonam1770(ji) = 'Reserved'
+      END DO
+
+      DO ji = 901, 999
+         cwmonam1770(ji) = 'Reserved'
+      END DO
+
+      DO ji = 1000, 1022
+         cwmonam1770(ji) = 'Reserved'
+      END DO
+
+      ctypshort(800) = 'MBT'
+      ctypshort(401) = 'XBT'
+      ctypshort(830) = 'CTD'
+      ctypshort(820) = 'MRB'
+      ctypshort(831) = 'PFL'
+      ctypshort(995) = 'DRB'
+      ctypshort(997) = 'APB'
+      ctypshort(996) = 'UOR'
+      ctypshort(700:799) = 'OSD'
+
+   END SUBROUTINE obs_wmo_init
+
+   SUBROUTINE obs_alt_typ_init
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_alt_typ_init ***
+      !!
+      !! ** Purpose : Initialize CLS altimeter code tables
+      !!
+      !! ** Method  : Direct initialisation of variables
+      !!
+      !! ** Action  : 
+      !!
+      !! References : CLS
+      !1              SSALTO/DUACS User Handbook
+      !!              (M)SLA and (M)ADT Near-Real Time and
+      !!              Delayed time products
+      !!              CLS-DOS-NT-06-034
+      !!              2006
+      !!              CLS
+      !!              8-10 Rue Hermes
+      !!              Parc Technologique du Canal
+      !!              31526 Ramonville St-Agne
+      !!              France
+      !!
+      !! History :  
+      !!      ! :  2007-06 (K. Mogensen) Original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      
+      !! * Arguments
+
+      !! * Local declarations
+
+      calttyp(0) = 'Unknown'
+      calttyp(1) = 'ERS-1'
+      calttyp(2) = 'ERS-2'
+      calttyp(3) = 'Topex/Poseidon'
+      calttyp(4) = 'Topex/Poseidon on its new orbit'
+      calttyp(5) = 'GFO'
+      calttyp(6) = 'Jason-1'
+      calttyp(7) = 'Envisat'
+      calttyp(8) = 'Jason-2'
+
+   END SUBROUTINE obs_alt_typ_init
+
+END MODULE obs_types
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_utils.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_utils.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_utils.F90	(revision 2528)
@@ -0,0 +1,212 @@
+MODULE obs_utils
+   !!======================================================================
+   !!                       ***  MODULE obs_utils   ***
+   !! Observation diagnostics: Utility functions
+   !!=====================================================================
+
+   !!----------------------------------------------------------------------
+   !!   grt_cir_dis     : Great circle distance 
+   !!   grt_cir_dis_saa : Great circle distance (small angle)
+   !!   chkerr          : Error-message managment for NetCDF files
+   !!   chkdim          : Error-message managment for NetCDF files
+   !!   fatal_error     : Fatal error handling
+   !!   ddatetoymdhms   : Convert YYYYMMDD.hhmmss to components
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE par_oce, ONLY : &        ! Precision variables
+      & wp, &
+      & dp, &
+      & i8  
+   USE in_out_manager           ! I/O manager
+  
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+   PUBLIC grt_cir_dis,     &  ! Great circle distance 
+      &   grt_cir_dis_saa, &  ! Great circle distance (small angle)
+      &   str_c_to_for,    &  ! Remove non-printable chars from string
+      &   chkerr,          &  ! Error-message managment for NetCDF files
+      &   chkdim,          &  ! Check if dimensions are correct for a variable
+      &   fatal_error,     &  ! Fatal error handling
+      &   warning,         &  ! Warning handling
+      &   ddatetoymdhms       ! Convert YYYYMMDD.hhmmss to components
+         
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+ 
+#include "grt_cir_dis.h90"
+
+#include "grt_cir_dis_saa.h90"
+
+#include "str_c_to_for.h90"
+
+   SUBROUTINE chkerr( kstatus, cd_name, klineno )
+      !!----------------------------------------------------------------------
+      !!   
+      !!                    *** ROUTINE chkerr ***
+      !! 
+      !! ** Purpose : Error-message managment for NetCDF files.
+      !! 
+      !! ** Method  : 
+      !!
+      !! ** Action  :
+      !!
+      !! History
+      !!      ! 02-12  (N. Daget)  hdlerr
+      !!      ! 06-04  (A. Vidard) f90/nemovar migration, change name
+      !!      ! 06-10  (A. Weaver) Cleanup
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE netcdf             ! NetCDF library
+      USE dom_oce, ONLY : &  ! Ocean space and time domain variables
+         & nproc
+
+      !! * Arguments
+      INTEGER :: kstatus
+      INTEGER :: klineno
+      CHARACTER(LEN=*) :: cd_name
+      
+      !! * Local declarations
+      CHARACTER(len=200) :: clineno
+
+      ! Main computation
+      IF ( kstatus /= nf90_noerr ) THEN
+         WRITE(clineno,'(A,I8)')' at line number ', klineno
+         CALL ctl_stop( ' chkerr', ' Netcdf Error in ' // TRIM( cd_name ), &
+            &           clineno, nf90_strerror( kstatus ) )
+      ENDIF
+
+   END SUBROUTINE chkerr
+
+   SUBROUTINE chkdim( kfileid, kvarid, kndim, kdim, cd_name, klineno )
+      !!----------------------------------------------------------------------
+      !!   
+      !!                    *** ROUTINE chkerr ***
+      !! 
+      !! ** Purpose : Error-message managment for NetCDF files.
+      !! 
+      !! ** Method  : 
+      !!
+      !! ** Action  :
+      !!
+      !! History
+      !!      ! 07-03  (K. Mogenen + E. Remy) Initial version
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE netcdf             ! NetCDF library
+      USE dom_oce, ONLY : &  ! Ocean space and time domain variables
+         & nproc
+
+      !! * Arguments
+      INTEGER :: kfileid       ! NetCDF file id   
+      INTEGER :: kvarid        ! NetCDF variable id   
+      INTEGER :: kndim         ! Expected number of dimensions
+      INTEGER, DIMENSION(kndim) :: kdim      ! Expected dimensions
+      CHARACTER(LEN=*) :: cd_name            ! Calling routine name
+      INTEGER ::  klineno      ! Calling line number
+
+      !! * Local declarations
+      INTEGER :: indim
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: &
+         & idim,ilendim
+      INTEGER :: ji
+      LOGICAL :: llerr
+      CHARACTER(len=200) :: clineno
+
+      CALL chkerr( nf90_inquire_variable( kfileid, kvarid, ndims=indim ), &
+         &         cd_name, klineno )
+
+      ALLOCATE(idim(indim),ilendim(indim))
+
+      CALL chkerr( nf90_inquire_variable( kfileid, kvarid, dimids=idim ), &
+         &         cd_name, klineno )
+
+      DO ji = 1, indim
+         CALL chkerr( nf90_inquire_dimension( kfileid, idim(ji), &
+            &                                 len=ilendim(ji) ), &
+            &         cd_name, klineno )
+      END DO
+      
+      IF ( indim /= kndim ) THEN
+         WRITE(clineno,'(A,I8)')' at line number ', klineno
+         CALL ctl_stop( ' chkdim',  &
+            &           ' Netcdf no dim error in ' // TRIM( cd_name ), &
+            &           clineno )
+      ENDIF
+
+      DO ji = 1, indim
+         IF ( ilendim(ji) /= kdim(ji) ) THEN
+            WRITE(clineno,'(A,I8)')' at line number ', klineno
+            CALL ctl_stop( ' chkdim',  &
+               &           ' Netcdf dim len error in ' // TRIM( cd_name ), &
+               &           clineno )
+         ENDIF
+      END DO
+         
+      DEALLOCATE(idim,ilendim)
+
+   END SUBROUTINE chkdim
+   
+  SUBROUTINE fatal_error( cd_name, klineno )
+      !!----------------------------------------------------------------------
+      !!
+      !!                    *** ROUTINE fatal_error ***
+      !!
+      !! ** Purpose : Fatal error handling
+      !!
+      !! ** Method  :
+      !!
+      !! ** Action  :
+      !!
+      !! History
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Arguments
+      INTEGER :: klineno
+      CHARACTER(LEN=*) :: cd_name
+      !! * Local declarations
+      CHARACTER(len=200) :: clineno
+
+      WRITE(clineno,'(A,I8)')' at line number ', klineno
+      CALL ctl_stop( ' fatal_error', ' Error in ' // TRIM( cd_name ), &
+         &           clineno)
+      
+   END SUBROUTINE fatal_error
+
+   SUBROUTINE warning( cd_name, klineno )
+      !!----------------------------------------------------------------------
+      !!
+      !!                    *** ROUTINE warning ***
+      !!
+      !! ** Purpose : Warning handling
+      !!
+      !! ** Method  :
+      !!
+      !! ** Action  :
+      !!
+      !! History
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Arguments
+      INTEGER :: klineno
+      CHARACTER(LEN=*) :: cd_name
+      !! * Local declarations
+      CHARACTER(len=200) :: clineno
+
+      WRITE(clineno,'(A,I8)')' at line number ', klineno
+      CALL ctl_warn( ' warning', ' Potential problem in ' // TRIM( cd_name ), &
+         &           clineno)
+      
+   END SUBROUTINE warning
+
+#include "ddatetoymdhms.h90"
+
+END MODULE obs_utils
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_vel_io.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_vel_io.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_vel_io.F90	(revision 2528)
@@ -0,0 +1,32 @@
+MODULE obs_vel_io
+   !!======================================================================
+   !!                       ***  MODULE obs_vel_io  ***
+   !! Observation operators : I/O for TAO velocity data
+   !!======================================================================
+   !! History : 
+   !!             !  09-01  (K. Mogensen) Initial version based on obs_read_taovel
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   read_taofile    :  Read a obfbdata structure from an TAO velocity file.
+   !!----------------------------------------------------------------------
+   USE par_kind
+   USE obs_utils
+   USE obs_fbm
+   USE obs_conv
+   USE in_out_manager
+   USE netcdf
+   IMPLICIT NONE
+
+   INTEGER, PARAMETER :: imaxlev = 10000
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#include "obsvel_io.h90"
+
+END MODULE obs_vel_io
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90	(revision 2528)
@@ -0,0 +1,914 @@
+MODULE obs_write
+   !!======================================================================
+   !!                       ***  MODULE obs_write   ***
+   !! Observation diagnosticss: Write observation related diagnostics
+   !!=====================================================================
+
+   !!----------------------------------------------------------------------
+   !!   cdf_wri_p3d   : Write profile observation diagnostics in NetCDF format
+   !!   obs_wri_sla   : Write SLA observation related diagnostics
+   !!   obs_wri_sst   : Write SST observation related diagnostics
+   !!   obs_wri_seaice: Write seaice observation related diagnostics
+   !!   cdf_wri_vel   : Write velocity observation diagnostics in NetCDF format
+   !!----------------------------------------------------------------------
+
+   !! * Modules used
+   USE par_kind, ONLY : &   ! Precision variables
+      & wp
+   USE in_out_manager       ! I/O manager
+   USE dom_oce              ! Ocean space and time domain variables
+   USE obs_types            ! Observation type integer to character translation
+   USE julian, ONLY : &         ! Julian date routines
+      & greg2jul
+   USE obs_utils, ONLY : &  ! Observation operator utility functions
+      & chkerr
+   USE obs_profiles_def     ! Type definitions for profiles
+   USE obs_surf_def         ! Type defintions for surface observations
+   USE obs_fbm              ! Observation feedback I/O
+   USE obs_grid             ! Grid tools
+   USE obs_conv             ! Conversion between units
+   USE obs_const
+   USE obs_sla_types
+   USE obs_rot_vel          ! Rotation of velocities
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+   PUBLIC obs_wri_p3d, &    ! Write profile observation related diagnostics
+      &   obs_wri_sla, &    ! Write SLA observation related diagnostics
+      &   obs_wri_sst, &    ! Write SST observation related diagnostics
+      &   obs_wri_sss, &    ! Write SSS observation related diagnostics
+      &   obs_wri_seaice, & ! Write seaice observation related diagnostics
+      &   obs_wri_vel, &    ! Write velocity observation related diagnostics
+      &   obswriinfo
+   
+   TYPE obswriinfo
+      INTEGER :: inum
+      INTEGER, POINTER, DIMENSION(:) :: ipoint
+      CHARACTER(len=ilenname), POINTER, DIMENSION(:) :: cdname
+      CHARACTER(len=ilenlong), POINTER, DIMENSION(:,:) :: cdlong
+      CHARACTER(len=ilenunit), POINTER, DIMENSION(:,:) :: cdunit
+   END TYPE obswriinfo
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE obs_wri_p3d( cprefix, profdata, padd, pext )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     *** ROUTINE obs_wri_p3d  ***
+      !!
+      !! ** Purpose : Write temperature and salinity (profile) observation 
+      !!              related diagnostics
+      !!
+      !! ** Method  : NetCDF
+      !! 
+      !! ** Action  :
+      !!
+      !! History :
+      !!      ! 06-04  (A. Vidard) Original
+      !!      ! 06-04  (A. Vidard) Reformatted
+      !!      ! 06-10  (A. Weaver) Cleanup
+      !!      ! 07-01  (K. Mogensen) Use profile data types
+      !!      ! 07-03  (K. Mogensen) General handling of profiles
+      !!      ! 09-01  (K. Mogensen) New feedback format
+      !!-----------------------------------------------------------------------
+
+      !! * Modules used
+
+      !! * Arguments
+      CHARACTER(LEN=*), INTENT(IN) :: cprefix        ! Prefix for output files
+      TYPE(obs_prof), INTENT(INOUT) :: profdata      ! Full set of profile data
+      TYPE(obswriinfo), OPTIONAL :: padd             ! Additional info for each variable
+      TYPE(obswriinfo), OPTIONAL :: pext             ! Extra info
+      
+      !! * Local declarations
+      TYPE(obfbdata) :: fbdata
+      CHARACTER(LEN=40) :: cfname
+      INTEGER :: ilevel
+      INTEGER :: jvar
+      INTEGER :: jo
+      INTEGER :: jk
+      INTEGER :: ik
+      INTEGER :: ja
+      INTEGER :: je
+      REAL(wp) :: zpres
+      INTEGER :: nadd
+      INTEGER :: next
+
+      IF ( PRESENT( padd ) ) THEN
+         nadd = padd%inum
+      ELSE
+         nadd = 0
+      ENDIF
+
+      IF ( PRESENT( pext ) ) THEN
+         next = pext%inum
+      ELSE
+         next = 0
+      ENDIF
+      
+      CALL init_obfbdata( fbdata )
+
+      ! Find maximum level
+      ilevel = 0
+      DO jvar = 1, 2
+         ilevel = MAX( ilevel, MAXVAL( profdata%var(jvar)%nvlidx(:) ) )
+      END DO
+      CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, &
+         &                 1 + nadd, 1 + next, .TRUE. )
+
+      fbdata%cname(1)      = 'POTM'
+      fbdata%cname(2)      = 'PSAL'
+      fbdata%coblong(1)    = 'Potential temperature'
+      fbdata%coblong(2)    = 'Practical salinity'
+      fbdata%cobunit(1)    = 'Degrees centigrade'
+      fbdata%cobunit(2)    = 'PSU'
+      fbdata%cextname(1)   = 'TEMP'
+      fbdata%cextlong(1)   = 'Insitu temperature'
+      fbdata%cextunit(1)   = 'Degrees centigrade'
+      DO je = 1, next
+         fbdata%cextname(1+je) = pext%cdname(je)
+         fbdata%cextlong(1+je) = pext%cdlong(je,1)
+         fbdata%cextunit(1+je) = pext%cdunit(je,1)
+      END DO
+      fbdata%caddname(1)   = 'Hx'
+      fbdata%caddlong(1,1) = 'Model interpolated potential temperature'
+      fbdata%caddlong(1,2) = 'Model interpolated practical salinity'
+      fbdata%caddunit(1,1) = 'Degrees centigrade'
+      fbdata%caddunit(1,2) = 'PSU'
+      fbdata%cgrid(:)      = 'T'
+      DO ja = 1, nadd
+         fbdata%caddname(1+ja) = padd%cdname(ja)
+         DO jvar = 1, 2
+            fbdata%caddlong(1+ja,jvar) = padd%cdlong(ja,jvar)
+            fbdata%caddunit(1+ja,jvar) = padd%cdunit(ja,jvar)
+         END DO
+      END DO
+         
+      WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cprefix), nproc
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*)'obs_wri_p3d :'
+         WRITE(numout,*)'~~~~~~~~~~~~~'
+         WRITE(numout,*)'Writing profile feedback file : ',TRIM(cfname)
+      ENDIF
+
+      ! Transform obs_prof data structure into obfbdata structure
+      fbdata%cdjuldref = '19500101000000'
+      DO jo = 1, profdata%nprof
+         fbdata%plam(jo)      = profdata%rlam(jo)
+         fbdata%pphi(jo)      = profdata%rphi(jo)
+         WRITE(fbdata%cdtyp(jo),'(I4)') profdata%ntyp(jo)
+         fbdata%ivqc(jo,:)    = profdata%ivqc(jo,:)
+         fbdata%ivqcf(:,jo,:) = profdata%ivqcf(:,jo,:)
+         IF ( profdata%nqc(jo) > 10 ) THEN
+            fbdata%ioqc(jo)    = 4
+            fbdata%ioqcf(1,jo) = profdata%nqcf(1,jo)
+            fbdata%ioqcf(2,jo) = profdata%nqc(jo) - 10
+         ELSE
+            fbdata%ioqc(jo)    = profdata%nqc(jo)
+            fbdata%ioqcf(:,jo) = profdata%nqcf(:,jo)
+         ENDIF
+         fbdata%ipqc(jo)      = profdata%ipqc(jo)
+         fbdata%ipqcf(:,jo)   = profdata%ipqcf(:,jo)
+         fbdata%itqc(jo)      = profdata%itqc(jo)
+         fbdata%itqcf(:,jo)   = profdata%itqcf(:,jo)
+         fbdata%cdwmo(jo)     = profdata%cwmo(jo)
+         fbdata%kindex(jo)    = profdata%npfil(jo)
+         DO jvar = 1, profdata%nvar
+            IF (ln_grid_global) THEN
+               fbdata%iobsi(jo,jvar) = profdata%mi(jo,jvar)
+               fbdata%iobsj(jo,jvar) = profdata%mj(jo,jvar)
+            ELSE
+               fbdata%iobsi(jo,jvar) = mig(profdata%mi(jo,jvar))
+               fbdata%iobsj(jo,jvar) = mjg(profdata%mj(jo,jvar))
+            ENDIF
+         END DO
+         CALL greg2jul( 0, &
+            &           profdata%nmin(jo), &
+            &           profdata%nhou(jo), &
+            &           profdata%nday(jo), &
+            &           profdata%nmon(jo), &
+            &           profdata%nyea(jo), &
+            &           fbdata%ptim(jo),   &
+            &           krefdate = 19500101 )
+         ! Reform the profiles arrays for output
+         DO jvar = 1, 2
+            DO jk = profdata%npvsta(jo,jvar), profdata%npvend(jo,jvar)
+               ik = profdata%var(jvar)%nvlidx(jk)
+               fbdata%padd(ik,jo,1,jvar) = profdata%var(jvar)%vmod(jk)
+               fbdata%pob(ik,jo,jvar)    = profdata%var(jvar)%vobs(jk)
+               fbdata%pdep(ik,jo)        = profdata%var(jvar)%vdep(jk)
+               fbdata%idqc(ik,jo)        = profdata%var(jvar)%idqc(jk)
+               fbdata%idqcf(:,ik,jo)     = profdata%var(jvar)%idqcf(:,jk)
+               IF ( profdata%var(jvar)%nvqc(jk) > 10 ) THEN
+                  fbdata%ivlqc(ik,jo,jvar) = 4
+                  fbdata%ivlqcf(1,ik,jo,jvar) = profdata%var(jvar)%nvqcf(1,jk)
+                  fbdata%ivlqcf(2,ik,jo,jvar) = profdata%var(jvar)%nvqc(jk) - 10
+               ELSE
+                  fbdata%ivlqc(ik,jo,jvar) = profdata%var(jvar)%nvqc(jk)
+                  fbdata%ivlqcf(:,ik,jo,jvar) = profdata%var(jvar)%nvqcf(:,jk)
+               ENDIF
+               fbdata%iobsk(ik,jo,jvar)  = profdata%var(jvar)%mvk(jk)
+               DO ja = 1, nadd
+                  fbdata%padd(ik,jo,1+ja,jvar) = &
+                     & profdata%var(jvar)%vext(jk,padd%ipoint(ja))
+               END DO
+               DO je = 1, next
+                  fbdata%pext(ik,jo,1+je) = &
+                     & profdata%var(jvar)%vext(jk,pext%ipoint(je))
+               END DO
+               IF ( jvar == 1 ) THEN
+                  fbdata%pext(ik,jo,1) = profdata%var(jvar)%vext(jk,1)
+               ENDIF 
+            END DO
+         END DO
+      END DO
+
+      ! Convert insitu temperature to potential temperature using the model
+      ! salinity if no potential temperature
+      DO jo = 1, fbdata%nobs
+         IF ( fbdata%pphi(jo) < 9999.0 ) THEN
+            DO jk = 1, fbdata%nlev
+               IF ( ( fbdata%pob(jk,jo,1) >= 9999.0 ) .AND. &
+                  & ( fbdata%pdep(jk,jo) < 9999.0 ) .AND. &
+                  & ( fbdata%padd(jk,jo,1,2) < 9999.0 ) .AND. &
+                  & ( fbdata%pext(jk,jo,1) < 9999.0 ) ) THEN
+                  zpres = dep_to_p( REAL(fbdata%pdep(jk,jo),wp), &
+                     &              REAL(fbdata%pphi(jo),wp) )
+                  fbdata%pob(jk,jo,1) = potemp( &
+                     &                     REAL(fbdata%padd(jk,jo,1,2), wp),  &
+                     &                     REAL(fbdata%pext(jk,jo,1), wp), &
+                     &                     zpres, 0.0_wp )
+               ENDIF
+            END DO
+         ENDIF
+      END DO
+      
+      ! Write the obfbdata structure
+      CALL write_obfbdata( cfname, fbdata )
+      
+      CALL dealloc_obfbdata( fbdata )
+     
+   END SUBROUTINE obs_wri_p3d
+
+   SUBROUTINE obs_wri_sla( cprefix, sladata, padd, pext )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     *** ROUTINE obs_wri_sla  ***
+      !!
+      !! ** Purpose : Write SLA observation diagnostics
+      !!              related 
+      !!
+      !! ** Method  : NetCDF
+      !! 
+      !! ** Action  :
+      !!
+      !!      ! 07-03  (K. Mogensen) Original
+      !!      ! 09-01  (K. Mogensen) New feedback format.
+      !!-----------------------------------------------------------------------
+
+      !! * Modules used
+      IMPLICIT NONE
+
+      !! * Arguments
+      CHARACTER(LEN=*), INTENT(IN) :: cprefix          ! Prefix for output files
+      TYPE(obs_surf), INTENT(INOUT) :: sladata         ! Full set of SLAa
+      TYPE(obswriinfo), OPTIONAL :: padd               ! Additional info for each variable
+      TYPE(obswriinfo), OPTIONAL :: pext               ! Extra info
+
+      !! * Local declarations
+      TYPE(obfbdata) :: fbdata
+      CHARACTER(LEN=40) :: cfname         ! netCDF filename
+      CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_wri_sla'
+      INTEGER :: jo
+      INTEGER :: ja
+      INTEGER :: je
+      INTEGER :: nadd
+      INTEGER :: next
+
+      IF ( PRESENT( padd ) ) THEN
+         nadd = padd%inum
+      ELSE
+         nadd = 0
+      ENDIF
+
+      IF ( PRESENT( pext ) ) THEN
+         next = pext%inum
+      ELSE
+         next = 0
+      ENDIF
+
+      CALL init_obfbdata( fbdata )
+
+      CALL alloc_obfbdata( fbdata, 1, sladata%nsurf, 1, &
+         &                 2 + nadd, 1 + next, .TRUE. )
+
+      fbdata%cname(1)      = 'SLA'
+      fbdata%coblong(1)    = 'Sea level anomaly'
+      fbdata%cobunit(1)    = 'Metres'
+      fbdata%cextname(1)   = 'MDT'
+      fbdata%cextlong(1)   = 'Mean dynamic topography'
+      fbdata%cextunit(1)   = 'Metres'
+      DO je = 1, next
+         fbdata%cextname(1+je) = pext%cdname(je)
+         fbdata%cextlong(1+je) = pext%cdlong(je,1)
+         fbdata%cextunit(1+je) = pext%cdunit(je,1)
+      END DO
+      fbdata%caddname(1)   = 'Hx'
+      fbdata%caddlong(1,1) = 'Model interpolated SSH - MDT'
+      fbdata%caddunit(1,1) = 'Metres' 
+      fbdata%caddname(2)   = 'SSH'
+      fbdata%caddlong(2,1) = 'Model Sea surface height'
+      fbdata%caddunit(2,1) = 'Metres'
+      fbdata%cgrid(1)      = 'T'
+      DO ja = 1, nadd
+         fbdata%caddname(2+ja) = padd%cdname(ja)
+         fbdata%caddlong(2+ja,1) = padd%cdlong(ja,1)
+         fbdata%caddunit(2+ja,1) = padd%cdunit(ja,1)
+      END DO
+
+      WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cprefix), nproc
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*)'obs_wri_sla :'
+         WRITE(numout,*)'~~~~~~~~~~~~~'
+         WRITE(numout,*)'Writing SLA feedback file : ',TRIM(cfname)
+      ENDIF
+
+      ! Transform obs_prof data structure into obfbdata structure
+      fbdata%cdjuldref = '19500101000000'
+      DO jo = 1, sladata%nsurf
+         fbdata%plam(jo)      = sladata%rlam(jo)
+         fbdata%pphi(jo)      = sladata%rphi(jo)
+         WRITE(fbdata%cdtyp(jo),'(I4)') sladata%ntyp(jo)
+         fbdata%ivqc(jo,:)    = 0
+         fbdata%ivqcf(:,jo,:) = 0
+         IF ( sladata%nqc(jo) > 10 ) THEN
+            fbdata%ioqc(jo)    = 4
+            fbdata%ioqcf(1,jo) = 0
+            fbdata%ioqcf(2,jo) = sladata%nqc(jo) - 10
+         ELSE
+            fbdata%ioqc(jo)    = sladata%nqc(jo)
+            fbdata%ioqcf(:,jo) = 0
+         ENDIF
+         fbdata%ipqc(jo)      = 0
+         fbdata%ipqcf(:,jo)   = 0
+         fbdata%itqc(jo)      = 0
+         fbdata%itqcf(:,jo)   = 0
+         fbdata%cdwmo(jo)     = sladata%cwmo(jo)
+         fbdata%kindex(jo)    = sladata%nsfil(jo)
+         IF (ln_grid_global) THEN
+            fbdata%iobsi(jo,1) = sladata%mi(jo)
+            fbdata%iobsj(jo,1) = sladata%mj(jo)
+         ELSE
+            fbdata%iobsi(jo,1) = mig(sladata%mi(jo))
+            fbdata%iobsj(jo,1) = mjg(sladata%mj(jo))
+         ENDIF
+         CALL greg2jul( 0, &
+            &           sladata%nmin(jo), &
+            &           sladata%nhou(jo), &
+            &           sladata%nday(jo), &
+            &           sladata%nmon(jo), &
+            &           sladata%nyea(jo), &
+            &           fbdata%ptim(jo),   &
+            &           krefdate = 19500101 )
+         fbdata%padd(1,jo,1,1) = sladata%rmod(jo,1)
+         fbdata%padd(1,jo,2,1) = sladata%rext(jo,1)
+         fbdata%pob(1,jo,1)    = sladata%robs(jo,1) 
+         fbdata%pdep(1,jo)     = 0.0
+         fbdata%idqc(1,jo)     = 0
+         fbdata%idqcf(:,1,jo)  = 0
+         IF ( sladata%nqc(jo) > 10 ) THEN
+            fbdata%ivqc(jo,1)       = 4
+            fbdata%ivlqc(1,jo,1)    = 4
+            fbdata%ivlqcf(1,1,jo,1) = 0
+            fbdata%ivlqcf(2,1,jo,1) = sladata%nqc(jo) - 10
+         ELSE
+            fbdata%ivqc(jo,1)       = sladata%nqc(jo)
+            fbdata%ivlqc(1,jo,1)    = sladata%nqc(jo)
+            fbdata%ivlqcf(:,1,jo,1) = 0
+         ENDIF
+         fbdata%iobsk(1,jo,1)  = 0
+         fbdata%pext(1,jo,1) = sladata%rext(jo,2)
+         DO ja = 1, nadd
+            fbdata%padd(1,jo,2+ja,1) = &
+               & sladata%rext(jo,padd%ipoint(ja))
+         END DO
+         DO je = 1, next
+            fbdata%pext(1,jo,1+je) = &
+               & sladata%rext(jo,pext%ipoint(je))
+         END DO
+      END DO
+
+      ! Write the obfbdata structure
+      CALL write_obfbdata( cfname, fbdata )
+
+      CALL dealloc_obfbdata( fbdata )
+
+   END SUBROUTINE obs_wri_sla
+
+   SUBROUTINE obs_wri_sst( cprefix, sstdata, padd, pext )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     *** ROUTINE obs_wri_sst  ***
+      !!
+      !! ** Purpose : Write SST observation diagnostics
+      !!              related 
+      !!
+      !! ** Method  : NetCDF
+      !! 
+      !! ** Action  :
+      !!
+      !!      ! 07-07  (S. Ricci) Original
+      !!      ! 09-01  (K. Mogensen) New feedback format.
+      !!-----------------------------------------------------------------------
+
+      !! * Modules used
+      IMPLICIT NONE
+
+      !! * Arguments
+      CHARACTER(LEN=*), INTENT(IN) :: cprefix       ! Prefix for output files
+      TYPE(obs_surf), INTENT(INOUT) :: sstdata      ! Full set of SST
+      TYPE(obswriinfo), OPTIONAL :: padd            ! Additional info for each variable
+      TYPE(obswriinfo), OPTIONAL :: pext            ! Extra info
+
+      !! * Local declarations 
+      TYPE(obfbdata) :: fbdata
+      CHARACTER(LEN=40) ::  cfname             ! netCDF filename
+      CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_wri_sst'
+      INTEGER :: jo
+      INTEGER :: ja
+      INTEGER :: je
+      INTEGER :: nadd
+      INTEGER :: next
+
+      IF ( PRESENT( padd ) ) THEN
+         nadd = padd%inum
+      ELSE
+         nadd = 0
+      ENDIF
+
+      IF ( PRESENT( pext ) ) THEN
+         next = pext%inum
+      ELSE
+         next = 0
+      ENDIF
+
+      CALL init_obfbdata( fbdata )
+
+      CALL alloc_obfbdata( fbdata, 1, sstdata%nsurf, 1, &
+         &                 1 + nadd, next, .TRUE. )
+
+      fbdata%cname(1)      = 'SST'
+      fbdata%coblong(1)    = 'Sea surface temperature'
+      fbdata%cobunit(1)    = 'Degree centigrade'
+      DO je = 1, next
+         fbdata%cextname(je) = pext%cdname(je)
+         fbdata%cextlong(je) = pext%cdlong(je,1)
+         fbdata%cextunit(je) = pext%cdunit(je,1)
+      END DO
+      fbdata%caddname(1)   = 'Hx'
+      fbdata%caddlong(1,1) = 'Model interpolated SST'
+      fbdata%caddunit(1,1) = 'Degree centigrade'
+      fbdata%cgrid(1)      = 'T'
+      DO ja = 1, nadd
+         fbdata%caddname(1+ja) = padd%cdname(ja)
+         fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1)
+         fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1)
+      END DO
+
+      WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cprefix), nproc
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*)'obs_wri_sst :'
+         WRITE(numout,*)'~~~~~~~~~~~~~'
+         WRITE(numout,*)'Writing SST feedback file : ',TRIM(cfname)
+      ENDIF
+
+      ! Transform obs_prof data structure into obfbdata structure
+      fbdata%cdjuldref = '19500101000000'
+      DO jo = 1, sstdata%nsurf
+         fbdata%plam(jo)      = sstdata%rlam(jo)
+         fbdata%pphi(jo)      = sstdata%rphi(jo)
+         WRITE(fbdata%cdtyp(jo),'(I4)') sstdata%ntyp(jo)
+         fbdata%ivqc(jo,:)    = 0
+         fbdata%ivqcf(:,jo,:) = 0
+         IF ( sstdata%nqc(jo) > 10 ) THEN
+            fbdata%ioqc(jo)    = 4
+            fbdata%ioqcf(1,jo) = 0
+            fbdata%ioqcf(2,jo) = sstdata%nqc(jo) - 10
+         ELSE
+            fbdata%ioqc(jo)    = MAX(sstdata%nqc(jo),1)
+            fbdata%ioqcf(:,jo) = 0
+         ENDIF
+         fbdata%ipqc(jo)      = 0
+         fbdata%ipqcf(:,jo)   = 0
+         fbdata%itqc(jo)      = 0
+         fbdata%itqcf(:,jo)   = 0
+         fbdata%cdwmo(jo)     = ''
+         fbdata%kindex(jo)    = sstdata%nsfil(jo)
+         IF (ln_grid_global) THEN
+            fbdata%iobsi(jo,1) = sstdata%mi(jo)
+            fbdata%iobsj(jo,1) = sstdata%mj(jo)
+         ELSE
+            fbdata%iobsi(jo,1) = mig(sstdata%mi(jo))
+            fbdata%iobsj(jo,1) = mjg(sstdata%mj(jo))
+         ENDIF
+         CALL greg2jul( 0, &
+            &           sstdata%nmin(jo), &
+            &           sstdata%nhou(jo), &
+            &           sstdata%nday(jo), &
+            &           sstdata%nmon(jo), &
+            &           sstdata%nyea(jo), &
+            &           fbdata%ptim(jo),   &
+            &           krefdate = 19500101 )
+         fbdata%padd(1,jo,1,1) = sstdata%rmod(jo,1)
+         fbdata%pob(1,jo,1)    = sstdata%robs(jo,1)
+         fbdata%pdep(1,jo)     = 0.0
+         fbdata%idqc(1,jo)     = 0
+         fbdata%idqcf(:,1,jo)  = 0
+         IF ( sstdata%nqc(jo) > 10 ) THEN
+            fbdata%ivqc(jo,1)       = 4
+            fbdata%ivlqc(1,jo,1)    = 4
+            fbdata%ivlqcf(1,1,jo,1) = 0
+            fbdata%ivlqcf(2,1,jo,1) = sstdata%nqc(jo) - 10
+         ELSE
+            fbdata%ivqc(jo,1)       = MAX(sstdata%nqc(jo),1)
+            fbdata%ivlqc(1,jo,1)    = MAX(sstdata%nqc(jo),1)
+            fbdata%ivlqcf(:,1,jo,1) = 0
+         ENDIF
+         fbdata%iobsk(1,jo,1)  = 0
+         DO ja = 1, nadd
+            fbdata%padd(1,jo,1+ja,1) = &
+               & sstdata%rext(jo,padd%ipoint(ja))
+         END DO
+         DO je = 1, next
+            fbdata%pext(1,jo,je) = &
+               & sstdata%rext(jo,pext%ipoint(je))
+         END DO
+
+      END DO
+
+      ! Write the obfbdata structure
+
+      CALL write_obfbdata( cfname, fbdata )
+
+      CALL dealloc_obfbdata( fbdata )
+
+   END SUBROUTINE obs_wri_sst
+
+   SUBROUTINE obs_wri_sss
+   END SUBROUTINE obs_wri_sss
+
+   SUBROUTINE obs_wri_seaice( cprefix, seaicedata, padd, pext )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     *** ROUTINE obs_wri_seaice  ***
+      !!
+      !! ** Purpose : Write sea ice observation diagnostics
+      !!              related 
+      !!
+      !! ** Method  : NetCDF
+      !! 
+      !! ** Action  :
+      !!
+      !!      ! 07-07  (S. Ricci) Original
+      !!      ! 09-01  (K. Mogensen) New feedback format.
+      !!-----------------------------------------------------------------------
+
+      !! * Modules used
+      IMPLICIT NONE
+
+      !! * Arguments
+      CHARACTER(LEN=*), INTENT(IN) :: cprefix       ! Prefix for output files
+      TYPE(obs_surf), INTENT(INOUT) :: seaicedata   ! Full set of sea ice
+      TYPE(obswriinfo), OPTIONAL :: padd            ! Additional info for each variable
+      TYPE(obswriinfo), OPTIONAL :: pext            ! Extra info
+
+      !! * Local declarations 
+      TYPE(obfbdata) :: fbdata
+      CHARACTER(LEN=40) :: cfname             ! netCDF filename
+      CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_wri_seaice'
+      INTEGER :: jo
+      INTEGER :: ja
+      INTEGER :: je
+      INTEGER :: nadd
+      INTEGER :: next
+
+      IF ( PRESENT( padd ) ) THEN
+         nadd = padd%inum
+      ELSE
+         nadd = 0
+      ENDIF
+
+      IF ( PRESENT( pext ) ) THEN
+         next = pext%inum
+      ELSE
+         next = 0
+      ENDIF
+
+      CALL init_obfbdata( fbdata )
+
+      CALL alloc_obfbdata( fbdata, 1, seaicedata%nsurf, 1, 1, 0, .TRUE. )
+
+      fbdata%cname(1)      = 'SEAICE'
+      fbdata%coblong(1)    = 'Sea ice'
+      fbdata%cobunit(1)    = 'Fraction'
+      DO je = 1, next
+         fbdata%cextname(je) = pext%cdname(je)
+         fbdata%cextlong(je) = pext%cdlong(je,1)
+         fbdata%cextunit(je) = pext%cdunit(je,1)
+      END DO
+      fbdata%caddname(1)   = 'Hx'
+      fbdata%caddlong(1,1) = 'Model interpolated ICE'
+      fbdata%caddunit(1,1) = 'Fraction'
+      fbdata%cgrid(1)      = 'T'
+      DO ja = 1, nadd
+         fbdata%caddname(1+ja) = padd%cdname(ja)
+         fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1)
+         fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1)
+      END DO
+
+      WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cprefix), nproc
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*)'obs_wri_seaice :'
+         WRITE(numout,*)'~~~~~~~~~~~~~~~~'
+         WRITE(numout,*)'Writing SEAICE feedback file : ',TRIM(cfname)
+      ENDIF
+
+      ! Transform obs_prof data structure into obfbdata structure
+      fbdata%cdjuldref = '19500101000000'
+      DO jo = 1, seaicedata%nsurf
+         fbdata%plam(jo)      = seaicedata%rlam(jo)
+         fbdata%pphi(jo)      = seaicedata%rphi(jo)
+         WRITE(fbdata%cdtyp(jo),'(I4)') seaicedata%ntyp(jo)
+         fbdata%ivqc(jo,:)    = 0
+         fbdata%ivqcf(:,jo,:) = 0
+         IF ( seaicedata%nqc(jo) > 10 ) THEN
+            fbdata%ioqc(jo)    = 4
+            fbdata%ioqcf(1,jo) = 0
+            fbdata%ioqcf(2,jo) = seaicedata%nqc(jo) - 10
+         ELSE
+            fbdata%ioqc(jo)    = MAX(seaicedata%nqc(jo),1)
+            fbdata%ioqcf(:,jo) = 0
+         ENDIF
+         fbdata%ipqc(jo)      = 0
+         fbdata%ipqcf(:,jo)   = 0
+         fbdata%itqc(jo)      = 0
+         fbdata%itqcf(:,jo)   = 0
+         fbdata%cdwmo(jo)     = ''
+         fbdata%kindex(jo)    = seaicedata%nsfil(jo)
+         IF (ln_grid_global) THEN
+            fbdata%iobsi(jo,1) = seaicedata%mi(jo)
+            fbdata%iobsj(jo,1) = seaicedata%mj(jo)
+         ELSE
+            fbdata%iobsi(jo,1) = mig(seaicedata%mi(jo))
+            fbdata%iobsj(jo,1) = mjg(seaicedata%mj(jo))
+         ENDIF
+         CALL greg2jul( 0, &
+            &           seaicedata%nmin(jo), &
+            &           seaicedata%nhou(jo), &
+            &           seaicedata%nday(jo), &
+            &           seaicedata%nmon(jo), &
+            &           seaicedata%nyea(jo), &
+            &           fbdata%ptim(jo),   &
+            &           krefdate = 19500101 )
+         fbdata%padd(1,jo,1,1) = seaicedata%rmod(jo,1)
+         fbdata%pob(1,jo,1)    = seaicedata%robs(jo,1)
+         fbdata%pdep(1,jo)     = 0.0
+         fbdata%idqc(1,jo)     = 0
+         fbdata%idqcf(:,1,jo)  = 0
+         IF ( seaicedata%nqc(jo) > 10 ) THEN
+            fbdata%ivlqc(1,jo,1) = 4
+            fbdata%ivlqcf(1,1,jo,1) = 0
+            fbdata%ivlqcf(2,1,jo,1) = seaicedata%nqc(jo) - 10
+         ELSE
+            fbdata%ivlqc(1,jo,1) = MAX(seaicedata%nqc(jo),1)
+            fbdata%ivlqcf(:,1,jo,1) = 0
+         ENDIF
+         fbdata%iobsk(1,jo,1)  = 0
+         DO ja = 1, nadd
+            fbdata%padd(1,jo,1+ja,1) = &
+               & seaicedata%rext(jo,padd%ipoint(ja))
+         END DO
+         DO je = 1, next
+            fbdata%pext(1,jo,je) = &
+               & seaicedata%rext(jo,pext%ipoint(je))
+         END DO
+
+      END DO
+
+      ! Write the obfbdata structure
+      CALL write_obfbdata( cfname, fbdata )
+
+      CALL dealloc_obfbdata( fbdata )
+
+   END SUBROUTINE obs_wri_seaice
+
+   SUBROUTINE obs_wri_vel( cprefix, profdata, k2dint, padd, pext )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     *** ROUTINE obs_wri_p3d  ***
+      !!
+      !! ** Purpose : Write current (profile) observation 
+      !!              related diagnostics
+      !!
+      !! ** Method  : NetCDF
+      !! 
+      !! ** Action  :
+      !!
+      !! History :
+      !!      ! 09-01  (K. Mogensen) New feedback format routine
+      !!-----------------------------------------------------------------------
+
+      !! * Modules used
+
+      !! * Arguments
+      CHARACTER(LEN=*), INTENT(IN) :: cprefix       ! Prefix for output files
+      TYPE(obs_prof), INTENT(INOUT) :: profdata     ! Full set of profile data
+      INTEGER, INTENT(IN) :: k2dint                 ! Horizontal interpolation method
+      TYPE(obswriinfo), OPTIONAL :: padd            ! Additional info for each variable
+      TYPE(obswriinfo), OPTIONAL :: pext            ! Extra info
+
+      !! * Local declarations
+      TYPE(obfbdata) :: fbdata
+      CHARACTER(LEN=40) :: cfname
+      INTEGER :: ilevel
+      INTEGER :: jvar
+      INTEGER :: jk
+      INTEGER :: ik
+      INTEGER :: jo
+      INTEGER :: ja
+      INTEGER :: je
+      INTEGER :: nadd
+      INTEGER :: next
+      REAL(wp) :: zpres
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: &
+         & zu, &
+         & zv
+
+      IF ( PRESENT( padd ) ) THEN
+         nadd = padd%inum
+      ELSE
+         nadd = 0
+      ENDIF
+
+      IF ( PRESENT( pext ) ) THEN
+         next = pext%inum
+      ELSE
+         next = 0
+      ENDIF
+
+      CALL init_obfbdata( fbdata )
+
+      ! Find maximum level
+      ilevel = 0
+      DO jvar = 1, 2
+         ilevel = MAX( ilevel, MAXVAL( profdata%var(jvar)%nvlidx(:) ) )
+      END DO
+      CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, 2, 0, .TRUE. )
+
+      fbdata%cname(1)      = 'UVEL'
+      fbdata%cname(2)      = 'VVEL'
+      fbdata%coblong(1)    = 'Zonal velocity'
+      fbdata%coblong(2)    = 'Meridional velocity'
+      fbdata%cobunit(1)    = 'm/s'
+      fbdata%cobunit(2)    = 'm/s'
+      DO je = 1, next
+         fbdata%cextname(je) = pext%cdname(je)
+         fbdata%cextlong(je) = pext%cdlong(je,1)
+         fbdata%cextunit(je) = pext%cdunit(je,1)
+      END DO
+      fbdata%caddname(1)   = 'Hx'
+      fbdata%caddlong(1,1) = 'Model interpolated zonal velocity'
+      fbdata%caddlong(1,2) = 'Model interpolated meridional velocity'
+      fbdata%caddunit(1,1) = 'm/s'
+      fbdata%caddunit(1,2) = 'm/s'
+      fbdata%caddname(2)   = 'HxG'
+      fbdata%caddlong(2,1) = 'Model interpolated zonal velocity (model grid)'
+      fbdata%caddlong(2,2) = 'Model interpolated meridional velocity (model grid)'
+      fbdata%caddunit(2,1) = 'm/s'
+      fbdata%caddunit(2,2) = 'm/s' 
+      fbdata%cgrid(1)      = 'U' 
+      fbdata%cgrid(2)      = 'V'
+      DO ja = 1, nadd
+         fbdata%caddname(2+ja) = padd%cdname(ja)
+         fbdata%caddlong(2+ja,1) = padd%cdlong(ja,1)
+         fbdata%caddunit(2+ja,1) = padd%cdunit(ja,1)
+      END DO
+
+      WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cprefix), nproc
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*)'obs_wri_vel :'
+         WRITE(numout,*)'~~~~~~~~~~~~~'
+         WRITE(numout,*)'Writing velocuty feedback file : ',TRIM(cfname)
+      ENDIF
+
+      ALLOCATE( &
+         & zu(profdata%nvprot(1)), &
+         & zv(profdata%nvprot(2))  &
+         & )
+      CALL obs_rotvel( profdata, k2dint, zu, zv )
+
+      ! Transform obs_prof data structure into obfbdata structure
+      fbdata%cdjuldref = '19500101000000'
+      DO jo = 1, profdata%nprof
+         fbdata%plam(jo)      = profdata%rlam(jo)
+         fbdata%pphi(jo)      = profdata%rphi(jo)
+         WRITE(fbdata%cdtyp(jo),'(I4)') profdata%ntyp(jo)
+         fbdata%ivqc(jo,:)    = profdata%ivqc(jo,:)
+         fbdata%ivqcf(:,jo,:) = profdata%ivqcf(:,jo,:)
+         IF ( profdata%nqc(jo) > 10 ) THEN
+            fbdata%ioqc(jo)    = 4
+            fbdata%ioqcf(1,jo) = profdata%nqcf(1,jo)
+            fbdata%ioqcf(2,jo) = profdata%nqc(jo) - 10
+         ELSE
+            fbdata%ioqc(jo)    = profdata%nqc(jo)
+            fbdata%ioqcf(:,jo) = profdata%nqcf(:,jo)
+         ENDIF
+         fbdata%ipqc(jo)      = profdata%ipqc(jo)
+         fbdata%ipqcf(:,jo)   = profdata%ipqcf(:,jo)
+         fbdata%itqc(jo)      = profdata%itqc(jo)
+         fbdata%itqcf(:,jo)   = profdata%itqcf(:,jo)
+         fbdata%cdwmo(jo)     = profdata%cwmo(jo)
+         fbdata%kindex(jo)    = profdata%npfil(jo)
+         DO jvar = 1, profdata%nvar
+            IF (ln_grid_global) THEN
+               fbdata%iobsi(jo,jvar) = profdata%mi(jo,jvar)
+               fbdata%iobsj(jo,jvar) = profdata%mj(jo,jvar)
+            ELSE
+               fbdata%iobsi(jo,jvar) = mig(profdata%mi(jo,jvar))
+               fbdata%iobsj(jo,jvar) = mjg(profdata%mj(jo,jvar))
+            ENDIF
+         END DO
+         CALL greg2jul( 0, &
+            &           profdata%nmin(jo), &
+            &           profdata%nhou(jo), &
+            &           profdata%nday(jo), &
+            &           profdata%nmon(jo), &
+            &           profdata%nyea(jo), &
+            &           fbdata%ptim(jo),   &
+            &           krefdate = 19500101 )
+         ! Reform the profiles arrays for output
+         DO jvar = 1, 2
+            DO jk = profdata%npvsta(jo,jvar), profdata%npvend(jo,jvar)
+               ik = profdata%var(jvar)%nvlidx(jk)
+               IF ( jvar == 1 ) THEN
+                  fbdata%padd(ik,jo,1,jvar) = zu(jk)
+               ELSE
+                  fbdata%padd(ik,jo,1,jvar) = zv(jk)
+               ENDIF
+               fbdata%padd(ik,jo,2,jvar) = profdata%var(jvar)%vmod(jk)
+               fbdata%pob(ik,jo,jvar)    = profdata%var(jvar)%vobs(jk)
+               fbdata%pdep(ik,jo)        = profdata%var(jvar)%vdep(jk)
+               fbdata%idqc(ik,jo)        = profdata%var(jvar)%idqc(jk)
+               fbdata%idqcf(:,ik,jo)     = profdata%var(jvar)%idqcf(:,jk)
+               IF ( profdata%var(jvar)%nvqc(jk) > 10 ) THEN
+                  fbdata%ivlqc(ik,jo,jvar) = 4
+                  fbdata%ivlqcf(1,ik,jo,jvar) = profdata%var(jvar)%nvqcf(1,jk)
+                  fbdata%ivlqcf(2,ik,jo,jvar) = profdata%var(jvar)%nvqc(jk) - 10
+               ELSE
+                  fbdata%ivlqc(ik,jo,jvar) = profdata%var(jvar)%nvqc(jk)
+                  fbdata%ivlqcf(:,ik,jo,jvar) = profdata%var(jvar)%nvqcf(:,jk)
+               ENDIF
+               fbdata%iobsk(ik,jo,jvar)  = profdata%var(jvar)%mvk(jk)
+               DO ja = 1, nadd
+                  fbdata%padd(ik,jo,2+ja,jvar) = &
+                     & profdata%var(jvar)%vext(jk,padd%ipoint(ja))
+               END DO
+               DO je = 1, next
+                  fbdata%pext(ik,jo,je) = &
+                     & profdata%var(jvar)%vext(jk,pext%ipoint(je))
+               END DO
+            END DO
+         END DO
+      END DO
+
+      ! Write the obfbdata structure
+      CALL write_obfbdata( cfname, fbdata )
+      
+      CALL dealloc_obfbdata( fbdata )
+     
+      DEALLOCATE( &
+         & zu, &
+         & zv  &
+         & )
+
+   END SUBROUTINE obs_wri_vel
+
+END MODULE obs_write
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obsinter_h2d.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obsinter_h2d.h90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obsinter_h2d.h90	(revision 2528)
@@ -0,0 +1,1359 @@
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE obs_int_h2d_init( kpk,   kpk2,  k2dint, plam,  pphi, &
+      &                         pglam, pgphi, pmask,  pweig, pobsmask, &
+      &                         iminpoints )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  ROUTINE obs_int_h2d  ***
+      !!
+      !! ** Purpose : Computes weights for horizontal interpolation to the 
+      !!              observation point.
+      !!
+      !! ** Method  : Horizontal interpolation to the observation point using
+      !!              model values at the corners of the surrounding grid 
+      !!              points.
+      !!
+      !!    Interpolation Schemes : 
+      !!
+      !!    1) k2dint = 0: Distance-weighted interpolation scheme 1
+      !!
+      !!       The interpolation weights are computed as a weighted 
+      !!       sum of the distance between the model grid points (A)
+      !!       and the observation point (B). Distance (s) is computed 
+      !!       using the great-circle distance formula: 
+      !!
+      !!       s(AB) = arcos(   sin( phiA ) x sin( phiB )
+      !!                      + cos( phiA ) x cos( phiB ) 
+      !!                                    x cos( lamB - lamA ) )
+      !!
+      !!    2) k2dint = 1: Distance-weighted interpolation scheme 2
+      !!
+      !!       As k2dint = 0 but with distance (ds) computed using 
+      !!       a small-angle approximation to the great-circle formula:
+      !!
+      !!       ds(AB) = sqrt(   ( phiB - phiA )^{2} 
+      !!                    + ( ( lamB - lamA ) * cos( phiB ) )^{2} )
+      !!
+      !!    3) k2dint = 2: Bilinear interpolation on a geographical grid
+      !!
+      !!       The interpolation is split into two 1D interpolations in
+      !!       the longitude and latitude directions, respectively.
+      !!
+      !!    4) k2dint = 3: General bilinear remapping interpolation
+      !!
+      !!       An iterative scheme that involves first mapping a 
+      !!       quadrilateral cell into a cell with coordinates 
+      !!       (0,0), (1,0), (0,1) and (1,1).
+      !!
+      !!    5) k2dint = 4: Polynomial interpolation
+      !!
+      !!       The interpolation weights are computed by fitting a 
+      !!       polynomial function of the form 
+      !!              
+      !!       P(i) = a1(i) + a2(i) * phi + a3(i) * plam 
+      !!                                  + a4(i) * phi * plam
+      !!    
+      !!       through the model values at the four surrounding grid points.
+      !!
+      !! ** Action  :
+      !!                   
+      !! References : Jones, P.: A users guide for SCRIP: A Spherical 
+      !!                        Coordinate Remapping and Interpolation Package.
+      !!                        Version 1.4. Los Alomos. 
+      !!                    
+      !!       http://www.acl.lanl.gov/climate/software/SCRIP/SCRIPmain.html
+      !!
+      !! History :
+      !!        ! 97-11 (A. Weaver, N. Daget)
+      !!        ! 06-03 (A. Vidard) NEMOVAR migration
+      !!        ! 06-10 (A. Weaver) Cleanup
+      !!        ! 07-08 (K. Mogensen) Split in two routines for easier adj.
+      !!-----------------------------------------------------------------------
+      !! * Modules used
+      !! * Arguments
+      INTEGER, INTENT(IN) :: &
+         & kpk,   &             ! Parameter values for automatic arrays
+         & kpk2,  &        
+         & k2dint               ! Interpolation scheme options
+                                ! = 0 distance-weighted (great circle)
+                                ! = 1 distance-weighted (small angle)
+                                ! = 2 bilinear (geographical grid)
+                                ! = 3 bilinear (quadrilateral grid)
+                                ! = 4 polynomial (quadrilateral grid)
+      REAL(KIND=wp), INTENT(INOUT) :: &
+         & plam, &
+         & pphi                 ! Geographical (lat,lon) coordinates of
+                                ! observation
+      REAL(KIND=wp), DIMENSION(2,2), INTENT(IN) :: &
+         & pglam, &             ! Model variable lat
+         & pgphi                ! Model variable lon
+      REAL(KIND=wp), DIMENSION(2,2,kpk2), INTENT(IN) :: &
+         & pmask                ! Model variable mask
+      REAL(KIND=wp), DIMENSION(2,2,kpk2), INTENT(OUT) ::  &
+         & pweig                ! Weights for interpolation
+      REAL(KIND=wp), DIMENSION(kpk2), INTENT(OUT) ::  &
+         & pobsmask             ! Vertical mask for observations
+      INTEGER, INTENT(IN), OPTIONAL :: &
+         & iminpoints           ! Reject point which is not surrounded
+                                ! by at least iminpoints sea points
+
+      !! * Local declarations
+      INTEGER :: &
+         & jk
+      INTEGER :: &
+         & ikmax, &
+         & iamb1, &
+         & iamb2
+      REAL(KIND=wp) :: &
+         & zphimm,  &
+         & zphimp,  &
+         & zphipm,  &
+         & zphipp,  &
+         & zlammm,  &
+         & zlammp,  &
+         & zlampm,  &
+         & zlampp,  &
+         & zphimin, &
+         & zphimax, &
+         & zlammin, &
+         & zlammax
+      REAL(KIND=wp), DIMENSION(kpk2) :: &
+         & z2dmm,  &
+         & z2dmp,  &
+         & z2dpm,  &
+         & z2dpp,  &
+         & z2dmmt, &
+         & z2dmpt, &
+         & z2dpmt, &
+         & z2dppt, &
+         & zsum
+      LOGICAL :: &
+         & ll_ds1, &
+         & ll_skip, &
+         & ll_fail
+       
+      !------------------------------------------------------------------------
+      ! Constants for the 360 degrees ambiguity
+      !------------------------------------------------------------------------
+      iamb1 = 10   ! dlam < iamb1 * dphi
+      iamb2 = 3    ! Special treatment if iamb2 * lam < max(lam) 
+       
+      !------------------------------------------------------------------------
+      ! Initialize number of levels
+      !------------------------------------------------------------------------
+      IF ( kpk2 == 1 ) THEN
+         ikmax = 1
+      ELSEIF ( kpk2 == kpk) THEN
+         ikmax = kpk-1
+      ENDIF
+      !------------------------------------------------------------------------
+      ! Initialize the cell corners
+      !------------------------------------------------------------------------
+      zphimm = pgphi(1,1)
+      zphimp = pgphi(1,2)
+      zphipm = pgphi(2,1)
+      zphipp = pgphi(2,2)
+      zlammm = pglam(1,1)
+      zlammp = pglam(1,2)
+      zlampm = pglam(2,1)
+      zlampp = pglam(2,2)
+       
+      !------------------------------------------------------------------------
+      ! Treat the 360 degrees ambiguity
+      !------------------------------------------------------------------------
+      DO WHILE ( ( zlammm < 0.0_wp ).OR.( zlammm > 360.0_wp )  &
+         &   .OR.( zlampm < 0.0_wp ).OR.( zlampm > 360.0_wp )  &
+         &   .OR.( zlampp < 0.0_wp ).OR.( zlampp > 360.0_wp )  &
+         &   .OR.( zlammp < 0.0_wp ).OR.( zlammp > 360.0_wp ) )
+       
+         IF ( zlammm < 0.0_wp   ) zlammm = zlammm + 360.0_wp
+         IF ( zlammm > 360.0_wp ) zlammm = zlammm - 360.0_wp
+         IF ( zlammp < 0.0_wp   ) zlammp = zlammp + 360.0_wp
+         IF ( zlammp > 360.0_wp ) zlammp = zlammp - 360.0_wp
+         IF ( zlampm < 0.0_wp   ) zlampm = zlampm + 360.0_wp
+         IF ( zlampm > 360.0_wp ) zlampm = zlampm - 360.0_wp
+         IF ( zlampp < 0.0_wp   ) zlampp = zlampp + 360.0_wp
+         IF ( zlampp > 360.0_wp ) zlampp = zlampp - 360.0_wp
+       
+      END DO
+
+      DO WHILE ( ( plam < 0.0_wp ) .OR. ( plam > 360.0_wp ) )
+         IF ( plam < 0.0_wp   ) plam = plam + 360.0_wp
+         IF ( plam > 360.0_wp ) plam = plam - 360.0_wp
+      END DO
+
+      !------------------------------------------------------------------------
+      ! Special case for observation on grid points
+      !------------------------------------------------------------------------
+      ll_skip = .FALSE.
+      IF ( ( ABS( zphimm - pphi ) < 1.0e-6_wp ) .AND. &
+         & ( ABS( zlammm - plam ) < 1.0e-6_wp ) ) THEN
+         z2dmm(:) = 1.0_wp
+         z2dpm(:) = 0.0_wp
+         z2dmp(:) = 0.0_wp
+         z2dpp(:) = 0.0_wp
+         ll_skip = .TRUE.
+      ENDIF
+      IF ( ( ABS( zphipm - pphi ) < 1.0e-6_wp ) .AND. &
+         & ( ABS( zlampm - plam ) < 1.0e-6_wp ) ) THEN
+         z2dmm(:) = 0.0_wp
+         z2dpm(:) = 1.0_wp
+         z2dmp(:) = 0.0_wp
+         z2dpp(:) = 0.0_wp
+         ll_skip = .TRUE.
+      ENDIF
+      IF ( ( ABS( zphimp - pphi ) < 1.0e-6_wp ) .AND. &
+         & ( ABS( zlammp - plam ) < 1.0e-6_wp ) ) THEN
+         z2dmm(:) = 0.0_wp
+         z2dpm(:) = 0.0_wp
+         z2dmp(:) = 1.0_wp
+         z2dpp(:) = 0.0_wp
+         ll_skip = .TRUE.
+      ENDIF
+      IF ( ( ABS( zphipp - pphi ) < 1.0e-6_wp ) .AND. &
+         & ( ABS( zlampp - plam ) < 1.0e-6_wp ) ) THEN
+         z2dmm(:) = 0.0_wp
+         z2dpm(:) = 0.0_wp
+         z2dmp(:) = 0.0_wp
+         z2dpp(:) = 1.0_wp
+         ll_skip = .TRUE.
+      ENDIF
+
+      IF ( .NOT.ll_skip ) THEN
+
+         zphimin = MIN( zphimm, zphipm, zphipp, zphimp )
+         zphimax = MAX( zphimm, zphipm, zphipp, zphimp )
+         zlammin = MIN( zlammm, zlampm, zlampp, zlammp )
+         zlammax = MAX( zlammm, zlampm, zlampp, zlammp )
+
+         IF ( ( ( zlammax - zlammin ) / ( zphimax - zphimin ) ) > iamb1 ) THEN
+            IF ( iamb2 * zlammm < zlammax ) zlammm = zlammm + 360.0_wp
+            IF ( iamb2 * zlammp < zlammax ) zlammp = zlammp + 360.0_wp
+            IF ( iamb2 * zlampm < zlammax ) zlampm = zlampm + 360.0_wp
+            IF ( iamb2 * zlampp < zlammax ) zlampp = zlampp + 360.0_wp
+         ENDIF
+
+         zlammin = MIN( zlammm, zlampm, zlampp, zlammp )
+         IF ( zlammm > ( zlammin + 180.0_wp ) ) zlammm = zlammm - 360.0_wp
+         IF ( zlammp > ( zlammin + 180.0_wp ) ) zlammp = zlammp - 360.0_wp
+         IF ( zlampm > ( zlammin + 180.0_wp ) ) zlampm = zlampm - 360.0_wp
+         IF ( zlampp > ( zlammin + 180.0_wp ) ) zlampp = zlampp - 360.0_wp
+         
+         IF ( plam < zlammin ) plam = plam + 360.0_wp
+	   z2dmm = 0.0_wp
+	   z2dmp = 0.0_wp
+	   z2dpm = 0.0_wp
+	   z2dpp = 0.0_wp
+         SELECT CASE (k2dint)
+            
+         CASE(0)
+            CALL obs_int_h2d_ds1( kpk2, ikmax,                        &
+               &                  pphi, plam, pmask,                  &
+               &                  zphimm, zlammm, zphimp, zlammp,     & 
+               &                  zphipm, zlampm, zphipp, zlampp,     &
+               &                  z2dmm, z2dmp, z2dpm, z2dpp )
+         CASE(1)
+            CALL obs_int_h2d_ds2( kpk2, ikmax,                        &
+               &                  pphi, plam, pmask,                  &
+               &                  zphimm, zlammm, zphimp, zlammp,     &
+               &                  zphipm, zlampm, zphipp, zlampp,     &
+               &                  z2dmm, z2dmp, z2dpm, z2dpp )
+         CASE(2)
+            CALL obs_int_h2d_bil( kpk2, ikmax,                        &
+               &                  pphi, plam, pmask,                  &
+               &                                          zlammp,     &
+               &                  zphipm,         zphipp, zlampp,     &
+               &                  z2dmm, z2dmp, z2dpm, z2dpp )
+         CASE(3)
+            CALL obs_int_h2d_bir( kpk2, ikmax,                        &
+               &                  pphi, plam, pmask,                  &
+               &                  zphimm, zlammm, zphimp, zlammp,     &
+               &                  zphipm, zlampm, zphipp, zlampp,     &
+               &                  z2dmm, z2dmp, z2dpm, z2dpp, ll_fail )
+            IF (ll_fail) THEN
+               IF(lwp) THEN
+                  WRITE(numout,*)'Bilinear weight computation failed'
+                  WRITE(numout,*)'Switching to great circle distance'
+                  WRITE(numout,*)
+               ENDIF
+               CALL obs_int_h2d_ds1( kpk2, ikmax,                        &
+                  &                  pphi, plam, pmask,                  &
+                  &                  zphimm, zlammm, zphimp, zlammp,     & 
+                  &                  zphipm, zlampm, zphipp, zlampp,     &
+                  &                  z2dmm, z2dmp, z2dpm, z2dpp )
+            ENDIF
+         CASE(4)  
+            CALL obs_int_h2d_pol( kpk2, ikmax,                        &
+               &                  pphi, plam, pmask,                  &
+               &                  zphimm, zlammm, zphimp, zlammp,     &
+               &                  zphipm, zlampm, zphipp, zlampp,     & 
+               &                  z2dmm, z2dmp, z2dpm, z2dpp )
+         END SELECT
+
+      ENDIF
+      !------------------------------------------------------------------------
+      ! Compute weights for interpolation to the observation point
+      !------------------------------------------------------------------------
+      pobsmask(:) = 0.0_wp
+      pweig(:,:,:) = 0.0_wp
+      ! ll_ds1 is used for failed interpolations
+      ll_ds1 = .FALSE.
+      DO jk = 1, ikmax
+         IF (PRESENT(iminpoints)) THEN
+            IF (NINT(SUM(pmask(:,:,jk)))<iminpoints) CYCLE
+         ENDIF
+         zsum(jk) = z2dmm(jk) + z2dmp(jk) + z2dpm(jk) + z2dpp(jk) 
+         IF ( zsum(jk) /= 0.0_wp ) THEN
+            pweig(1,1,jk) = z2dmm(jk) 
+            pweig(1,2,jk) = z2dmp(jk)
+            pweig(2,1,jk) = z2dpm(jk)
+            pweig(2,2,jk) = z2dpp(jk)
+            ! Set the vertical mask
+            IF ( ( ( z2dmm(jk) > 0.0_wp ) .AND.       &
+               &   ( pmask(1,1,jk) == 1.0_wp ) ) .OR. &
+               & ( ( z2dmp(jk) > 0.0_wp ) .AND.       &
+               &   ( pmask(1,2,jk) == 1.0_wp ) ) .OR. &
+               & ( ( z2dpm(jk) > 0.0_wp ) .AND.       &
+               &   ( pmask(2,1,jk) == 1.0_wp ) ) .OR. &
+               & ( ( z2dpp(jk) > 0.0_wp ) .AND.       &
+               &   ( pmask(2,2,jk) == 1.0_wp ) ) ) pobsmask(jk)=1.0_wp
+         ELSE
+            ! If the interpolation has failed due to the point
+            ! being on the intersect of two land points retry with
+            ! k2dint = 0
+            IF ( ( pmask(1,1,jk) /= 0.0_wp ).OR. &
+               & ( pmask(1,2,jk) /= 0.0_wp ).OR. &
+               & ( pmask(2,1,jk) /= 0.0_wp ).OR. &
+               & ( pmask(2,2,jk) /= 0.0_wp ) ) THEN
+               ! If ll_ds1 is false compute k2dint = 0 weights
+               IF ( .NOT.ll_ds1 ) THEN
+                  CALL obs_int_h2d_ds1( kpk2, ikmax,                        &
+                     &                  pphi, plam, pmask,                  &
+                     &                  zphimm, zlammm, zphimp, zlammp,     & 
+                     &                  zphipm, zlampm, zphipp, zlampp,     &
+                     &                  z2dmmt, z2dmpt, z2dpmt, z2dppt ) 
+                  ll_ds1 = .TRUE.
+               ENDIF
+               zsum(jk) = z2dmmt(jk) + z2dmpt(jk) + z2dpmt(jk) + z2dppt(jk) 
+               IF ( zsum(jk) /= 0.0_wp ) THEN
+                  pweig(1,1,jk) = z2dmmt(jk) 
+                  pweig(1,2,jk) = z2dmpt(jk)
+                  pweig(2,1,jk) = z2dpmt(jk)
+                  pweig(2,2,jk) = z2dppt(jk)
+                  ! Set the vertical mask
+                  IF ( ( ( z2dmmt(jk) > 0.0_wp ) .AND.      &
+                     &   ( pmask(1,1,jk) == 1.0_wp ) ) .OR. &
+                     & ( ( z2dmpt(jk) > 0.0_wp ) .AND.      &
+                     &   ( pmask(1,2,jk) == 1.0_wp ) ) .OR. &
+                     & ( ( z2dpmt(jk) > 0.0_wp) .AND.      &
+                     &   ( pmask(2,1,jk) == 1.0_wp ) ) .OR. &
+                     & ( ( z2dppt(jk) > 0.0_wp ) .AND.      &
+                     &   ( pmask(2,2,jk) == 1.0_wp ) ) )    &
+                     & pobsmask(jk)=1.0_wp
+               ENDIF
+            ENDIF
+         ENDIF
+      END DO
+  
+   END SUBROUTINE obs_int_h2d_init
+
+   SUBROUTINE obs_int_h2d( kpk, kpk2, &
+      &                    pweig, pmod, pobsk )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  ROUTINE obs_int_h2d  ***
+      !!
+      !! ** Purpose : Horizontal interpolation to the observation point.
+      !!
+      !! ** Method  : Horizontal interpolation to the observation point using
+      !!              model values at the corners of the surrounding grid 
+      !!              points.
+      !!
+      !! ** Action  :
+      !!                   
+      !! References : 
+      !!
+      !! History :
+      !!        ! 97-11 (A. Weaver, N. Daget)
+      !!        ! 06-03 (A. Vidard) NEMOVAR migration
+      !!        ! 06-10 (A. Weaver) Cleanup
+      !!        ! 07-08 (K. Mogensen) Split in two routines for easier adj.
+      !!-----------------------------------------------------------------------
+      !! * Modules used
+      !! * Arguments
+      INTEGER, INTENT(IN) :: &
+         & kpk,   &             ! Parameter values for automatic arrays
+         & kpk2
+      REAL(KIND=wp), DIMENSION(2,2,kpk2), INTENT(IN) :: &
+         & pweig                ! Interpolation weights
+      REAL(KIND=wp), DIMENSION(2,2,kpk2), INTENT(IN) :: &
+         & pmod                 ! Model variable to interpolate
+      REAL(KIND=wp), DIMENSION(kpk2), INTENT(OUT) ::  &
+         & pobsk                ! Model profile interpolated to obs (i,j) pt
+
+      !! * Local declarations
+      INTEGER :: &
+         & jk
+      INTEGER :: &
+         & ikmax
+      REAL(KIND=wp) :: &
+         & zsum
+      !------------------------------------------------------------------------
+      ! Initialize number of levels
+      !------------------------------------------------------------------------
+      IF ( kpk2 == 1 ) THEN
+         ikmax = 1
+      ELSEIF ( kpk2 == kpk) THEN
+         ikmax = kpk-1
+      ENDIF
+      !------------------------------------------------------------------------
+      ! Interpolate to the observation point
+      !------------------------------------------------------------------------
+      pobsk(:) = obfillflt
+      DO jk = 1, ikmax
+         zsum = pweig(1,1,jk) + pweig(1,2,jk) + pweig(2,1,jk) +  pweig(2,2,jk) 
+         IF ( zsum /= 0.0_wp ) THEN
+            pobsk(jk) = (  pweig(1,1,jk) * pmod(1,1,jk)         &
+               &         + pweig(1,2,jk) * pmod(1,2,jk)         &
+               &         + pweig(2,1,jk) * pmod(2,1,jk)         &
+               &         + pweig(2,2,jk) * pmod(2,2,jk)         &
+               &                                             ) / zsum
+         ENDIF
+      END DO
+
+   END SUBROUTINE obs_int_h2d
+  
+   SUBROUTINE obs_int_h2d_ds1( kpk2, kmax,                        &
+      &                        pphi, plam, pmask,                 &
+      &                        pphimm, plammm, pphimp, plammp,    & 
+      &                        pphipm, plampm, pphipp, plampp,    &
+      &                        p2dmm, p2dmp, p2dpm, p2dpp )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  ROUTINE obs_int_h2d_ds1  ***
+      !!
+      !! ** Purpose : Distance-weighted interpolation scheme (k2dint = 0)
+      !!
+      !! ** Method  : The interpolation weights are computed as a weighted 
+      !!              sum of the distance between the model grid points (A) 
+      !!              and the observation point (B). 
+      !!
+      !!    Distance (s) is computed using the great-circle distance formula:
+      !!
+      !!    s(AB) = arcos(   sin( phiA ) x sin( phiB )
+      !!                   + cos( phiA ) x cos( phiB ) x cos( lamB - lamA )
+      !!
+      !! ** Action  :
+      !!
+      !! History :
+      !!        ! 97-11 (A. Weaver, N. Daget)
+      !!        ! 06-10 (A. Weaver) Cleanup
+      !!-----------------------------------------------------------------------
+
+      !! * Modules used
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: &
+         & kpk2, &             ! Parameter values for automatic arrays
+         & kmax
+      REAL(KIND=wp), INTENT(IN) :: &
+         & pphi,   &           ! Geographical location of observation
+         & plam,   &
+         & pphimm, &           ! Geographical location of surrounding
+         & pphimp, &           ! model grid points
+         & pphipm, &
+         & pphipp, & 
+         & plammm, &
+         & plammp, &
+         & plampm, &
+         & plampp
+      REAL(KIND=wp), DIMENSION(2,2,kpk2), INTENT(IN) :: &
+         & pmask               ! Model variable mask 
+      REAL(KIND=wp), DIMENSION(kpk2), INTENT(OUT) :: &
+         & p2dmm, &            ! Interpolation weights
+         & p2dmp, &
+         & p2dpm, &
+         & p2dpp
+
+      !! * Local declarations
+      INTEGER :: &
+         & jk
+      REAL(KIND=wp) :: &
+         & zphi2,   &
+         & zlam2,   &
+         & zcola,   &
+         & za2,     &
+         & zb2,     &
+         & zc2,     &
+         & zphimm2, &
+         & zphimp2, &
+         & zphipm2, &
+         & zphipp2, &
+         & zlammm2, &
+         & zlammp2, &
+         & zlampm2, &
+         & zlampp2, &
+         & za1mm,   &
+         & za1mp,   &
+         & za1pm,   &
+         & za1pp,   &
+         & zcomm,   &
+         & zcomp,   &
+         & zcopm,   &
+         & zcopp,   &
+         & zb1mm,   &
+         & zb1mp,   &
+         & zb1pm,   &
+         & zb1pp,   &
+         & zc1mm,   &
+         & zc1mp,   &
+         & zc1pm,   &
+         & zc1pp,   &
+         & zsopmpp, &
+         & zsommmp, &
+         & zsomm,   &
+         & zsomp,   &
+         & zsopm,   &
+         & zsopp
+       
+      !------------------------------------------------------------------------
+      ! Distance-weighted interpolation using the great circle formula
+      !------------------------------------------------------------------------
+      zphi2 = pphi * rad
+      zlam2 = plam * rad
+      zcola = COS( zphi2 )
+      za2   = SIN( zphi2 )
+      zb2   = zcola * COS( zlam2 )
+      zc2   = zcola * SIN( zlam2 )
+       
+      zphimm2 = pphimm * rad
+      zphimp2 = pphimp * rad
+      zphipm2 = pphipm * rad
+      zphipp2 = pphipp * rad
+       
+      zlammm2 = plammm * rad
+      zlammp2 = plammp * rad
+      zlampm2 = plampm * rad
+      zlampp2 = plampp * rad
+       
+      za1mm = SIN( zphimm2 )
+      za1mp = SIN( zphimp2 )
+      za1pm = SIN( zphipm2 )
+      za1pp = SIN( zphipp2 )
+       
+      zcomm = COS( zphimm2 )
+      zcomp = COS( zphimp2 )
+      zcopm = COS( zphipm2 )
+      zcopp = COS( zphipp2 )
+       
+      zb1mm = zcomm * COS( zlammm2 )
+      zb1mp = zcomp * COS( zlammp2 )
+      zb1pm = zcopm * COS( zlampm2 )
+      zb1pp = zcopp * COS( zlampp2 )
+       
+      zc1mm = zcomm * SIN( zlammm2 )
+      zc1mp = zcomp * SIN( zlammp2 )
+      zc1pm = zcopm * SIN( zlampm2 )
+      zc1pp = zcopp * SIN( zlampp2 )
+       
+      ! Function for arcsin(sqrt(1-x^2) version of great-circle formula
+      zsomm = grt_cir_dis( za1mm, za2, zb1mm, zb2, zc1mm, zc2 )
+      zsomp = grt_cir_dis( za1mp, za2, zb1mp, zb2, zc1mp, zc2 )
+      zsopm = grt_cir_dis( za1pm, za2, zb1pm, zb2, zc1pm, zc2 )
+      zsopp = grt_cir_dis( za1pp, za2, zb1pp, zb2, zc1pp, zc2 )
+       
+      zsopmpp = zsopm * zsopp
+      zsommmp = zsomm * zsomp
+      DO jk = 1, kmax
+         p2dmm(jk) = zsomp * zsopmpp * pmask(1,1,jk)
+         p2dmp(jk) = zsomm * zsopmpp * pmask(1,2,jk) 
+         p2dpm(jk) = zsopp * zsommmp * pmask(2,1,jk)
+         p2dpp(jk) = zsopm * zsommmp * pmask(2,2,jk)
+      END DO
+       
+   END SUBROUTINE obs_int_h2d_ds1
+  
+   SUBROUTINE obs_int_h2d_ds2( kpk2, kmax,                        &
+      &                        pphi, plam, pmask,                 &
+      &                        pphimm, plammm, pphimp, plammp,    &
+      &                        pphipm, plampm, pphipp, plampp,    &
+      &                        p2dmm, p2dmp, p2dpm, p2dpp ) 
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  ROUTINE obs_int_h2d_ds2  ***
+      !!
+      !! ** Purpose : Distance-weighted interpolation scheme (k2dint = 1)
+      !!
+      !! ** Method  : As k2dint = 0 but with distance (ds) computed using a 
+      !!              small-angle approximation to the great-circle distance 
+      !!              formula:
+      !!
+      !!    ds(AB) = sqrt(   ( phiB - phiA )^{2}
+      !!                   + ( ( lamB - lamA ) * cos( phiB ) )^{2} )
+      !!
+      !! ** Action  :
+      !!
+      !! History :
+      !!        ! 97-11 (A. Weaver, N. Daget)
+      !!        ! 06-10 (A. Weaver) Cleanup
+      !!-----------------------------------------------------------------------
+
+      !!-----------------------------------------------------------------------
+      !! * Modules used
+      !!----------------------------------------------------------------------- 
+      !! * Arguments
+      INTEGER, INTENT(IN) :: &
+         & kpk2, &             ! Parameter values for automatic arrays
+         & kmax
+      REAL(KIND=wp), INTENT(IN) ::        &
+         & pphi,   &           ! Geographical location of observation
+         & plam,   &
+         & pphimm, &           ! Geographical location of surrounding
+         & pphimp, &           ! model grid points
+         & pphipm, &
+         & pphipp, & 
+         & plammm, &
+         & plammp, &
+         & plampm, &
+         & plampp
+      REAL(KIND=wp), DIMENSION(2,2,kpk2), INTENT(IN) :: &
+         & pmask               ! Model variable mask 
+      REAL(KIND=wp), DIMENSION(kpk2), INTENT(OUT) :: &
+         & p2dmm, &            ! Interpolation weights
+         & p2dmp, &
+         & p2dpm, &
+         & p2dpp
+
+      !! * Local declarations
+      INTEGER :: &
+         & jk
+      REAL(KIND=wp) :: &
+         & zcosp,   &
+         & zdlmm,   &
+         & zdlmp,   &
+         & zdlpm,   &
+         & zdlpp,   &
+         & zdpmm,   &
+         & zdpmp,   &
+         & zdppm,   &
+         & zdppp,   &
+         & zsomm,   &
+         & zsomp,   &
+         & zsopm,   &
+         & zsopp,   &
+         & zsopmpp, &
+         & zsommmp
+       
+      !------------------------------------------------------------------------
+      ! Distance-weighted interpolation with a small angle approximation
+      !------------------------------------------------------------------------
+      zcosp = COS( pphi * rad )
+       
+      zdlmm = plammm - plam
+      zdlmp = plammp - plam
+      zdlpm = plampm - plam
+      zdlpp = plampp - plam
+       
+      zdpmm = pphimm - pphi
+      zdpmp = pphimp - pphi
+      zdppm = pphipm - pphi
+      zdppp = pphipp - pphi
+       
+      zsomm = grt_cir_dis_saa( zdlmm, zdpmm, zcosp )
+      zsomp = grt_cir_dis_saa( zdlmp, zdpmp, zcosp )
+      zsopm = grt_cir_dis_saa( zdlpm, zdppm, zcosp )
+      zsopp = grt_cir_dis_saa( zdlpp, zdppp, zcosp )
+       
+      zsopmpp = zsopm * zsopp
+      zsommmp = zsomm * zsomp
+       
+      DO jk = 1, kmax
+         p2dmm(jk) = zsomp * zsopmpp * pmask(1,1,jk)
+         p2dmp(jk) = zsomm * zsopmpp * pmask(1,2,jk)
+         p2dpm(jk) = zsopp * zsommmp * pmask(2,1,jk)
+         p2dpp(jk) = zsopm * zsommmp * pmask(2,2,jk)
+      END DO
+       
+   END SUBROUTINE obs_int_h2d_ds2
+  
+   SUBROUTINE obs_int_h2d_bil( kpk2, kmax,                        &
+      &                        pphi, plam, pmask,                 &
+      &                        plammp, pphipm, pphipp, plampp,    &
+      &                        p2dmm, p2dmp, p2dpm, p2dpp)
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  ROUTINE obs_int_h2d_bil  ***
+      !!
+      !! ** Purpose : Bilinear interpolation on a geographical grid (k2dint = 2)
+      !!
+      !! ** Method  : The interpolation is split into two 1D interpolations in 
+      !!              the longitude and latitude directions, respectively.
+      !!
+      !!    An iterative scheme that involves first mapping a quadrilateral
+      !!    cell into a cell with coordinates (0,0), (1,0), (0,1) and (1,1).
+      !!
+      !! ** Action  :
+      !!
+      !! History :
+      !!        ! 97-11 (A. Weaver, N. Daget)
+      !!        ! 06-10 (A. Weaver) Cleanup
+      !!-----------------------------------------------------------------------
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: &
+         & kpk2, &             ! Parameter values for automatic arrays
+         & kmax
+      REAL(KIND=wp), INTENT(IN) :: &
+         & pphi,   &           ! Geographical location of observation
+         & plam,   &
+         & pphipm, &           ! Geographical location of surrounding
+         & pphipp, &           ! model grid points
+         & plammp, &
+         & plampp
+      REAL(KIND=wp), DIMENSION(2,2,kpk2), INTENT(IN)  :: &
+         & pmask               ! Model variable mask
+      REAL(KIND=wp), DIMENSION(kpk2), INTENT(OUT) :: &
+         & p2dmm, &            ! Interpolation weights
+         & p2dmp, &
+         & p2dpm, &
+         & p2dpp
+
+      !! * Local declarations
+      INTEGER :: &
+         & jk
+      REAL(KIND=wp) :: &
+         & zdlmp, &
+         & zdppm, &
+         & zdlpp, &
+         & zdppp
+       
+      !----------------------------------------------------------------------
+      ! Bilinear interpolation for geographical grid
+      !----------------------------------------------------------------------
+      zdlmp = ABS(plam   - plammp) 
+      zdppm = ABS(pphi   - pphipm)
+      zdlpp = ABS(plampp - plam)
+      zdppp = ABS(pphipp - pphi)
+       
+      DO jk = 1, kmax
+         p2dmm(jk) = zdlpp * zdppp * pmask(1,1,jk)
+         p2dmp(jk) = zdlpp * zdppm * pmask(1,2,jk)
+         p2dpm(jk) = zdlmp * zdppp * pmask(2,1,jk)
+         p2dpp(jk) = zdlmp * zdppm * pmask(2,2,jk)
+      END DO
+       
+   END SUBROUTINE obs_int_h2d_bil
+  
+   SUBROUTINE obs_int_h2d_bir( kpk2, kmax,                        &
+      &                        pphi, plam, pmask,                 &
+      &                        pphimm, plammm, pphimp, plammp,    &
+      &                        pphipm, plampm, pphipp, plampp,    &
+      &                        p2dmm, p2dmp, p2dpm, p2dpp, ldfail )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  ROUTINE obs_int_h2d_bir  ***
+      !!
+      !! ** Purpose : General bilinear remapping interpolation (k2dint = 3)
+      !!
+      !! ** Method  : An iterative scheme that involves first mapping a 
+      !!              quadrilateral cell into a cell with coordinates 
+      !!              (0,0), (1,0), (0,1) and (1,1).
+      !!
+      !! ** Action  :
+      !!
+      !! History :
+      !!        ! 97-11 (A. Weaver, N. Daget)
+      !!        ! 06-10 (A. Weaver) Cleanup
+      !!-----------------------------------------------------------------------
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: &
+         & kpk2, &             ! Parameter values for automatic arrays
+         & kmax
+      REAL(KIND=wp), INTENT(IN) ::        &
+         & pphi,   &           ! Geographical location of observation
+         & plam,   &
+         & pphimm, &           ! Geographical location of surrounding
+         & pphimp, &           ! model grid points
+         & pphipm, &
+         & pphipp, & 
+         & plammm, &
+         & plammp, &
+         & plampm, &
+         & plampp
+      REAL(KIND=wp), DIMENSION(2,2,kpk2), INTENT(IN) :: &
+         & pmask               ! Model variable mask 
+      REAL(KIND=wp), DIMENSION(kpk2), INTENT(OUT) :: &
+         & p2dmm, &            ! Interpolation weights
+         & p2dmp, &
+         & p2dpm, &
+         & p2dpp
+      LOGICAL, INTENT(OUT) :: &
+         & ldfail
+      !! * Local declarations
+      INTEGER :: &
+         & jk
+      REAL(KIND=wp) :: &
+         & zbiwmm, &
+         & zbiwmp, &
+         & zbiwpm, &
+         & zbiwpp
+  
+      !----------------------------------------------------------------------
+      ! Bilinear remapping interpolation for general quadrilateral grid
+      !----------------------------------------------------------------------
+      CALL bil_wgt( pphimm, pphimp, pphipm, pphipp,  &
+         &          plammm, plammp, plampm, plampp,  &
+         &          zbiwmm, zbiwmp, zbiwpm, zbiwpp,  &
+         &          pphi  , plam,   ldfail           )
+
+      IF ( .NOT.ldfail ) THEN
+         DO jk = 1, kmax
+            p2dmm(jk) = zbiwmm * pmask(1,1,jk)
+            p2dmp(jk) = zbiwmp * pmask(1,2,jk)
+            p2dpm(jk) = zbiwpm * pmask(2,1,jk)
+            p2dpp(jk) = zbiwpp * pmask(2,2,jk)
+         END DO
+      ENDIF
+
+   END SUBROUTINE obs_int_h2d_bir
+
+   SUBROUTINE obs_int_h2d_pol( kpk2, kmax,                         &
+      &                        pphi, plam, pmask,                  &
+      &                        pphimm, plammm, pphimp, plammp,     &
+      &                        pphipm, plampm, pphipp, plampp,     &
+      &                        p2dmm, p2dmp, p2dpm, p2dpp )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  ROUTINE obs_int_h2d_pol  ***
+      !!
+      !! ** Purpose : Polynomial interpolation (k2dint = 4)
+      !!
+      !! ** Method  : The interpolation weights are computed by fitting a 
+      !!              polynomial function of the form
+      !!
+      !!    P(i) = a1(i) + a2(i) * phi + a3(i) * plam + a4(i) * phi * plam
+      !!
+      !!    through the model values at four surrounding grid pts (i=1,4).
+      !!    As k2dint = 0 but with distance (ds) computed using a small-
+      !!    angle approximation to the great-circle distance formula:
+      !!
+      !!    ds(AB) = sqrt(   ( phiB - phiA )^{2}
+      !!                   + ( ( lamB - lamA ) * cos( phiB ) )^{2} )
+      !!
+      !! ** Action  :
+      !!
+      !! History :
+      !!        ! 97-11 (A. Weaver, N. Daget)
+      !!        ! 06-10 (A. Weaver) Cleanup
+      !!-----------------------------------------------------------------------
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: &  
+         & kpk2,   &           ! Parameter values for automatic arrays 
+         & kmax
+      REAL(KIND=wp), INTENT(IN) :: &
+         & pphi,   &           ! Geographical location of observation
+         & plam,   &
+         & pphimm, &           ! Geographical location of surrounding
+         & pphimp, &           ! model grid points
+         & pphipm, &
+         & pphipp, &
+         & plammm, &
+         & plammp, &
+         & plampm, &
+         & plampp
+      REAL(KIND=wp), DIMENSION(2,2,kpk2), INTENT(IN) :: &
+         & pmask               ! Model variable mask
+      REAL(KIND=wp), DIMENSION(kpk2), INTENT(OUT) :: &
+         & p2dmm,  &           ! Interpolation weights
+         & p2dmp,  &
+         & p2dpm,  &
+         & p2dpp
+  
+      !! * Local declarations
+      INTEGER :: &
+         & jk
+      REAL(KIND=wp) :: &
+         & zplp
+      REAL(KIND=wp), DIMENSION(4,4) :: &
+         & zmat,  &
+         & zmati
+       
+      !------------------------------------------------------------------------
+      ! Polynomial interpolation
+      !------------------------------------------------------------------------       
+      zmat(1,1) = 1.0_wp
+      zmat(1,2) = 1.0_wp
+      zmat(1,3) = 1.0_wp
+      zmat(1,4) = 1.0_wp
+      zmat(2,1) = plammm
+      zmat(2,2) = plammp
+      zmat(2,3) = plampm
+      zmat(2,4) = plampp
+      zmat(3,1) = pphimm
+      zmat(3,2) = pphimp
+      zmat(3,3) = pphipm
+      zmat(3,4) = pphipp
+      zmat(4,1) = plammm * pphimm
+      zmat(4,2) = plammp * pphimp
+      zmat(4,3) = plampm * pphipm
+      zmat(4,4) = plampp * pphipp
+       
+      CALL lu_invmat( zmat, 4, zmati )
+       
+      zplp = plam * pphi            
+      DO jk = 1, kmax
+         p2dmm(jk) = ABS(   zmati(1,1)        + zmati(1,2) * plam    &
+            &             + zmati(1,3) * pphi + zmati(1,4) * zplp )  &
+            &      * pmask(1,1,jk) 
+         p2dmp(jk) = ABS(   zmati(2,1)        + zmati(2,2) * plam    &
+            &             + zmati(2,3) * pphi + zmati(2,4) * zplp )  &
+            &      * pmask(1,2,jk)
+         p2dpm(jk) = ABS(   zmati(3,1)        + zmati(3,2) * plam    &
+            &             + zmati(3,3) * pphi + zmati(3,4) * zplp )  &
+            &      * pmask(2,1,jk)
+         p2dpp(jk) = ABS(   zmati(4,1)        + zmati(4,2) * plam    &
+            &             + zmati(4,3) * pphi + zmati(4,4) * zplp )  &
+            &      * pmask(2,2,jk)
+      END DO
+  
+   END SUBROUTINE obs_int_h2d_pol
+
+   SUBROUTINE bil_wgt( pphimm, pphimp, pphipm, pphipp,   &
+      &               plammm, plammp, plampm, plampp,   &
+      &               pbiwmm, pbiwmp, pbiwpm, pbiwpp,   &
+      &               pphi  , plam,   ldfail            )
+      !!-------------------------------------------------------------------
+      !!
+      !!                   ***  ROUTINE bil_wgt  ***
+      !!
+      !! ** Purpose : Compute the weights for a bilinear remapping 
+      !!              interpolation scheme.
+      !!
+      !! ** Method  : This scheme is appropriate for bilinear interpolation 
+      !!              on a general quadrilateral grid.    
+      !!              This scheme is also used in OASIS.
+      !!
+      !!              This routine is a derivative of the SCRIP software.
+      !!              Copyright 1997, 1998 the Regents of the University 
+      !!              of California. See SCRIP_Copyright.txt.
+      !!     
+      !! ** Action  :
+      !!
+      !! References : Jones, P.: A user's guide for SCRIP: A Spherical 
+      !!                Coordinate Remapping and Interpolation Package. 
+      !!                Version 1.4. Los Alamos. 
+      !!                  
+      !!         http://www.acl.lanl.gov/climate/software/SCRIP/SCRIPmain.html
+      !!
+      !! History
+      !!      ! 97-11 (A. Weaver, N. Daget)
+      !!      ! 06-03 (A. Vidard)
+      !!      ! 06-10 (A. Weaver) Cleanup
+      !!-----------------------------------------------------------------------
+ 
+      !! * Arguments
+      REAL(KIND=wp), INTENT(IN) :: &
+         & pphi,   &           ! Geographical location of observation
+         & plam,   &
+         & pphimm, &           ! Geographical location of surrounding
+         & pphimp, &           ! model grid points
+         & pphipm, &
+         & pphipp, &
+         & plammm, &
+         & plammp, & 
+         & plampm, &
+         & plampp
+      REAL(KIND=wp), INTENT(OUT) :: &
+         & pbiwmm, &           ! Interpolation weights
+         & pbiwmp, &
+         & pbiwpm, &
+         & pbiwpp
+      LOGICAL, INTENT(out) :: &
+         & ldfail
+
+      !! * Local declarations
+      INTEGER :: &
+         & jiter
+      INTEGER :: &
+         & itermax
+      REAL(KIND=wp) :: &
+         & zphi,    &           ! Geographical location of observation
+         & zlam,    &
+         & zphimm,  &           ! Geographical location of surrounding
+         & zphimp,  &           ! model grid points
+         & zphipm,  &
+         & zphipp,  &
+         & zlammm,  &
+         & zlammp,  & 
+         & zlampm,  &
+         & zlampp,  &
+         & zdth1,   &
+         & zdth2,   &
+         & zdth3,   &
+         & zdthp,   &
+         & zdph1,   &
+         & zdph2,   &
+         & zdph3,   &
+         & zdphp,   &
+         & zmat1,   &
+         & zmat2,   &
+         & zmat3,   &
+         & zmat4,   &
+         & zdeli,   &
+         & zdelj,   &
+         & ziguess, &
+         & zjguess, &
+         & zeps,    &
+         & zdeterm, &
+         & z2pi,    &
+         & zhpi
+      
+      ! Initialization
+
+      ! Conversion to radians
+
+      zphi   = pphi   * rad
+      zlam   = plam   * rad
+      zphimm = pphimm * rad
+      zphimp = pphimp * rad
+      zphipm = pphipm * rad
+      zphipp = pphipp * rad
+      zlammm = plammm * rad
+      zlammp = plammp * rad
+      zlampm = plampm * rad
+      zlampp = plampp * rad
+
+      ldfail = .FALSE.
+
+      zdth1 = zphipm - zphimm
+      zdth2 = zphimp - zphimm
+      zdth3 = zphipp - zphipm - zdth2
+       
+      zdph1 = zlampm - zlammm
+      zdph2 = zlammp - zlammm
+      zdph3 = zlampp - zlampm
+       
+      z2pi = 2.0_wp * rpi
+       
+      IF ( zdph1 >  3.0_wp * rpi ) zdph1 = zdph1 - z2pi
+      IF ( zdph2 >  3.0_wp * rpi ) zdph2 = zdph2 - z2pi
+      IF ( zdph3 >  3.0_wp * rpi ) zdph3 = zdph3 - z2pi
+      IF ( zdph1 < -3.0_wp * rpi ) zdph1 = zdph1 + z2pi
+      IF ( zdph2 < -3.0_wp * rpi ) zdph2 = zdph2 + z2pi
+      IF ( zdph3 < -3.0_wp * rpi ) zdph3 = zdph3 + z2pi
+       
+      zdph3 = zdph3 - zdph2
+       
+      ziguess = 0.5_wp
+      zjguess = 0.5_wp
+       
+      itermax = 100
+
+      IF ( wp == sp ) THEN
+         zeps = 1.0e-6_wp	! Single precision
+      ELSE
+         zeps = 1.0e-10_wp      ! Double precision
+      ENDIF
+  
+      !------------------------------------------------------------------------
+      ! Iterate to determine (i,j) in new coordinate system
+      !------------------------------------------------------------------------
+      jiter_loop: DO jiter = 1, itermax
+         
+         zdthp = zphi - zphimm - zdth1 * ziguess - zdth2 * zjguess &
+            &  - zdth3 * ziguess * zjguess
+         zdphp = zlam - zlammm
+         
+         zhpi = 0.5_wp * rpi
+         IF ( zdphp >  3.0_wp * zhpi ) zdphp = zdphp - z2pi
+         IF ( zdphp < -3.0_wp * zhpi ) zdphp = zdphp + z2pi
+         
+         zdphp = zdphp - zdph1 * ziguess - zdph2 * zjguess &
+            &  - zdph3 * ziguess * zjguess
+         
+         zmat1 = zdth1 + zdth3 * zjguess
+         zmat2 = zdth2 + zdth3 * ziguess
+         zmat3 = zdph1 + zdph3 * zjguess
+         zmat4 = zdph2 + zdph3 * ziguess
+         
+         ! Matrix determinant
+         zdeterm = zmat1 * zmat4 - zmat2 * zmat3
+         
+         zdeli = ( zdthp * zmat4 - zmat2 * zdphp) / zdeterm
+         zdelj = ( zmat1 * zdphp - zdthp * zmat3) / zdeterm
+         
+         IF ( ABS( zdeli ) < zeps .AND. ABS( zdelj ) < zeps ) EXIT jiter_loop
+         
+         ziguess = ziguess + zdeli
+         zjguess = zjguess + zdelj
+
+         ! DJL prevent ziguess and zjguess from going outside the range
+         ! 0 to 1
+         ! prevents interpolated value going wrong
+         ! for example sea ice concentration gt 1
+         
+         IF ( ziguess < 0 ) ziguess = 0.0_wp
+         IF ( zjguess < 0 ) zjguess = 0.0_wp
+         IF ( ziguess > 1 ) ziguess = 1.0_wp
+         IF ( zjguess > 1 ) zjguess = 1.0_wp
+         
+      END DO jiter_loop
+       
+      IF ( jiter <= itermax ) THEN
+           
+         ! Successfully found i,j, now compute the weights
+
+         pbiwmm = ( 1.0_wp - ziguess ) * ( 1.0_wp - zjguess )
+         pbiwmp = ( 1.0_wp - ziguess ) *            zjguess
+         pbiwpm =            ziguess   * ( 1.0_wp - zjguess )
+         pbiwpp =            ziguess   *            zjguess
+         
+      ELSEIF ( jiter > itermax ) THEN
+            
+         IF(lwp) THEN
+            
+            WRITE(numout,*)'Obs lat/lon  : ',pphi, plam
+            WRITE(numout,*)'Grid lats    : ',pphimm, pphimp, pphipm, pphipp
+            WRITE(numout,*)'Grid lons    : ',plammm, plammp, plampm, plampp
+            WRITE(numout,*)'Current i,j  : ',ziguess, zjguess
+            WRITE(numout,*)'Weights      : ',pbiwmm, pbiwmp, pbiwpm, pbiwpp
+            WRITE(numout,*)'jiter        = ',jiter
+            WRITE(numout,*)'zeps         = ',zeps
+            WRITE(numout,*)'zdeli, zdelj = ',zdeli, zdelj
+            WRITE(numout,*)' Iterations for i,j exceed max iteration count!'
+            WRITE(numout,*)
+            
+            ldfail = .TRUE.
+
+         ENDIF
+         
+      ENDIF
+    
+   END SUBROUTINE bil_wgt
+
+   SUBROUTINE lu_invmat( pmatin, kdim, pmatou )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                   ***  ROUTINE lu_invmat  ***
+      !!
+      !! ** Purpose : Invert a matrix using LU decomposition.
+      !!
+      !! ** Method  : 
+      !! 
+      !! ** Action  :
+      !!
+      !! References : 
+      !!
+      !! History
+      !!      ! 02-11 (A. Weaver, N. Daget)
+      !!      ! 06-03 (A. Vidard)
+      !!      ! 06-10 (A. Weaver) Cleanup
+      !!      ! 06-11 (NEMOVAR task force) Fix declaration of zd.
+      !!-----------------------------------------------------------------------
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: &
+         & kdim             ! Array dimension
+      REAL(KIND=wp), DIMENSION(kdim,kdim), INTENT(IN) :: &
+         & pmatin 
+      REAL(KIND=wp), DIMENSION(kdim,kdim), INTENT(OUT) :: &
+         & pmatou 
+  
+      !! * Local declarations
+      INTEGER :: &
+         & ji, &
+         & jj
+      INTEGER, DIMENSION(kdim) :: &
+         & indx
+      REAL(KIND=wp), DIMENSION(kdim,kdim) :: &
+         & zmat
+      REAL(KIND=wp) :: &
+         & zd
+
+      ! Invert the matrix       
+      DO jj = 1, kdim
+         DO ji = 1, kdim
+            pmatou(ji,jj) = 0.0_wp
+            zmat(ji,jj) = pmatin(ji,jj)
+         END DO
+         pmatou(jj,jj) = 1.0_wp
+      END DO
+      CALL lu_decomp( zmat, kdim, kdim, indx, zd )
+      DO jj = 1, kdim
+         CALL lu_backsb( zmat, kdim, kdim, indx, pmatou(1,jj) )
+      END DO
+      
+   END SUBROUTINE lu_invmat
+
+   SUBROUTINE lu_decomp( pmatin, kdim1, kdim2, kindex, pflt )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                   ***  ROUTINE lu_decomp  ***
+      !!
+      !! ** Purpose : Compute the LU decomposition of a matrix
+      !!
+      !! ** Method  : 
+      !! 
+      !! ** Action  :
+      !!
+      !! References : 
+      !!
+      !! History
+      !!      ! 02-11 (A. Weaver, N. Daget)
+      !!      ! 06-03 (A. Vidard)
+      !!      ! 06-10 (A. Weaver) Cleanup
+      !!-----------------------------------------------------------------------
+       
+      !! * Arguments
+      INTEGER, INTENT(IN) :: &
+         & kdim1, &   ! Array dimensions
+         & kdim2
+      INTEGER, DIMENSION(kdim1), INTENT(OUT) :: &
+         & kindex
+      REAL(KIND=wp), INTENT(OUT) :: &
+         & pflt
+      REAL(KIND=wp), DIMENSION(kdim2,kdim2), INTENT(INOUT) :: &
+         & pmatin 
+  
+      !! * Local declarations
+      INTEGER, PARAMETER :: &
+         & jpmax = 100
+      REAL(KIND=wp), PARAMETER :: &
+         & pptiny = 1.0e-20_wp
+      REAL(KIND=wp), DIMENSION(jpmax) :: &
+         & zvv
+      INTEGER :: &
+         & ji, &
+         & jj, &
+         & jk
+      INTEGER :: &
+         & imax
+      REAL(KIND=wp) :: &
+         & zsum,  &
+         & zdum,  &
+         & zaamax
+       
+      ! Main computation
+      pflt = 1.0_wp
+      DO ji = 1, kdim1
+         zaamax = 0.0_wp
+         DO jj = 1, kdim1
+            IF ( ABS( pmatin(ji,jj) ) > zaamax ) zaamax = ABS( pmatin(ji,jj) )
+         END DO
+         IF ( zaamax == 0.0_wp ) THEN
+            CALL ctl_stop( 'singular matrix' )
+         ENDIF 
+         zvv(ji) = 1.0_wp / zaamax
+      END DO
+      DO jj = 1, kdim1
+         DO ji = 1, jj-1
+            zsum = pmatin(ji,jj)
+            DO jk = 1, ji-1
+	       zsum = zsum - pmatin(ji,jk) * pmatin(jk,jj)
+	    END DO
+            pmatin(ji,jj) = zsum
+         END DO
+         zaamax = 0.0_wp
+         DO ji = jj, kdim1
+            zsum = pmatin(ji,jj)
+            DO jk = 1, jj-1
+               zsum = zsum - pmatin(ji,jk) * pmatin(jk,jj)
+            END DO
+            pmatin(ji,jj) = zsum
+            zdum = zvv(ji) * ABS( zsum )
+            IF ( zdum >= zaamax ) THEN
+               imax = ji
+               zaamax = zdum
+            ENDIF
+	 END DO
+         IF ( jj /= imax ) THEN
+            DO jk = 1, kdim1
+               zdum = pmatin(imax,jk)
+               pmatin(imax,jk) = pmatin(jj,jk)
+               pmatin(jj,jk) = zdum
+	    END DO
+            pflt = -pflt
+            zvv(imax) = zvv(jj)
+         ENDIF
+         kindex(jj) = imax
+         IF ( pmatin(jj,jj) == 0.0_wp ) pmatin(jj,jj) = pptiny
+         IF ( jj /= kdim1 ) THEN
+            zdum = 1.0_wp / pmatin(jj,jj)
+            DO ji = jj+1, kdim1
+               pmatin(ji,jj) = pmatin(ji,jj) * zdum
+	    END DO
+         ENDIF
+      END DO
+     
+   END SUBROUTINE lu_decomp
+     
+   SUBROUTINE lu_backsb( pmat, kdim1, kdim2, kindex, pvect )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                   ***  ROUTINE lu_backsb  ***
+      !!
+      !! ** Purpose : Back substitution
+      !!
+      !! ** Method  : 
+      !! 
+      !! ** Action  :
+      !!
+      !! References : 
+      !!
+      !! History
+      !!      ! 02-11 (A. Weaver, N. Daget)
+      !!      ! 06-03 (A. Vidard)
+      !!      ! 06-10 (A. Weaver) Cleanup
+      !!-----------------------------------------------------------------------
+      
+      !! * Arguments
+      INTEGER, INTENT(IN) :: &
+         & kdim1, &     ! Array dimensions
+         & kdim2
+      INTEGER, DIMENSION(kdim1), INTENT(IN) :: &
+         & kindex
+      REAL(KIND=wp), DIMENSION(kdim1), INTENT(INOUT) :: &
+         & pvect
+      REAL(KIND=wp), DIMENSION(kdim2,kdim2), INTENT(IN) :: &
+         & pmat
+  
+      !! * Local declarations
+      INTEGER :: &
+         & ji,  &
+         & jii, &
+         & jj,  &
+         & jll
+      REAL(KIND=wp) :: &
+         & zsum
+
+      ! Main computation
+      jii = 0
+      DO ji = 1, kdim1
+         jll = kindex(ji)
+         zsum = pvect(jll)
+         pvect(jll) = pvect(ji)
+         IF ( jii /= 0 ) THEN
+            DO jj = jii, ji-1
+               zsum = zsum - pmat(ji,jj) * pvect(jj)
+            END DO
+         ELSEIF ( zsum /= 0.0_wp ) THEN
+            jii = ji
+         ENDIF
+         pvect(ji) = zsum
+      END DO
+      DO ji = kdim1, 1, -1
+         zsum = pvect(ji)
+         DO jj = ji+1, kdim1
+            zsum = zsum - pmat(ji,jj) * pvect(jj)
+         END DO
+         pvect(ji) = zsum / pmat(ji,ji)
+      END DO
+     
+   END SUBROUTINE lu_backsb
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obsinter_z1d.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obsinter_z1d.h90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obsinter_z1d.h90	(revision 2528)
@@ -0,0 +1,191 @@
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE obs_int_z1d( kpk, kkco, k1dint, kdep, &
+      &                    pobsdep, pobsk, pobs2k,  &
+      &                    pobs, pdep, pobsmask )
+      !!---------------------------------------------------------------------
+      !!
+      !!                   ***  ROUTINE obs_int_z1d ***
+      !!
+      !! ** Purpose : Vertical interpolation to the observation point.
+      !!  
+      !! ** Method  : If k1dint = 0 then use linear interpolation.
+      !!              If k1dint = 1 then use cubic spline interpolation.
+      !! 
+      !! ** Action  :
+      !!
+      !! References :
+      !!
+      !! History
+      !!      ! 97-11 (A. Weaver, S. Ricci, N. Daget)
+      !!      ! 06-03 (G. Smith) Conversion to F90 for use with NEMOVAR
+      !!      ! 06-10 (A. Weaver) Cleanup
+      !!      ! 07-01 (K. Mogensen) Use profile rather than single level
+      !!---------------------------------------------------------------------
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kpk        ! Number of vertical levels
+      INTEGER, INTENT(IN) :: k1dint     ! 0 = linear; 1 = cubic spline interpolation 
+      INTEGER, INTENT(IN) :: kdep       ! Number of levels in profile
+      INTEGER, INTENT(IN), DIMENSION(kdep) :: &
+         & kkco                 ! Array indicies for interpolation
+      REAL(KIND=wp), INTENT(IN), DIMENSION(kdep) :: &
+         & pobsdep              ! Depth of the observation
+      REAL(KIND=wp), INTENT(IN), DIMENSION(kpk) :: &
+         & pobsk,  &            ! Model profile at a given (lon,lat)
+         & pobs2k, &            ! 2nd derivative of the interpolating function
+         & pdep,   &            ! Model depth array
+         & pobsmask             ! Vertical mask
+      REAL(KIND=wp), INTENT(OUT), DIMENSION(kdep) :: &
+         & pobs                 ! Model equivalent at observation point
+  
+      !! * Local declarations
+      REAL(KIND=wp) :: z1dm       ! Distance above and below obs to model grid points
+      REAL(KIND=wp) :: z1dp         
+      REAL(KIND=wp) :: zsum       ! Dummy variables for computation
+      REAL(KIND=wp) :: zsum2
+      INTEGER :: jdep             ! Observation depths loop variable
+    
+      !------------------------------------------------------------------------
+      ! Loop over all observation depths
+      !------------------------------------------------------------------------
+
+      DO jdep = 1, kdep
+
+         !---------------------------------------------------------------------
+         ! Initialization
+         !---------------------------------------------------------------------
+         z1dm = ( pdep(kkco(jdep)) - pobsdep(jdep)      )
+         z1dp = ( pobsdep(jdep)    - pdep(kkco(jdep)-1) )
+         IF ( pobsmask(kkco(jdep)) == 0.0_wp ) z1dp = 0.0_wp
+
+         zsum = z1dm + z1dp
+         
+         IF ( k1dint == 0 ) THEN
+
+            !-----------------------------------------------------------------
+            !  Linear interpolation
+            !-----------------------------------------------------------------
+            pobs(jdep) = (   z1dm * pobsk(kkco(jdep)-1) &
+               &           + z1dp * pobsk(kkco(jdep)  ) ) / zsum
+
+         ELSEIF ( k1dint == 1 ) THEN
+
+            !-----------------------------------------------------------------
+            ! Cubic spline interpolation
+            !-----------------------------------------------------------------
+            zsum2 = zsum * zsum
+            pobs(jdep)  = (  z1dm                             * pobsk (kkco(jdep)-1) &
+               &           + z1dp                             * pobsk (kkco(jdep)  ) &
+               &           + ( z1dm * ( z1dm * z1dm - zsum2 ) * pobs2k(kkco(jdep)-1) &
+               &           +   z1dp * ( z1dp * z1dp - zsum2 ) * pobs2k(kkco(jdep)  ) &
+               &             ) / 6.0_wp                                              &
+               &          ) / zsum
+
+         ENDIF
+      END DO
+
+   END SUBROUTINE obs_int_z1d
+
+   SUBROUTINE obs_int_z1d_spl( kpk, pobsk, pobs2k, &
+      &                        pdep, pobsmask )
+      !!--------------------------------------------------------------------
+      !!
+      !!                  *** ROUTINE obs_int_z1d_spl ***
+      !!
+      !! ** Purpose : Compute the local vector of vertical second-derivatives 
+      !!              of the interpolating function used with a cubic spline.
+      !!  
+      !! ** Method  : 
+      !! 
+      !!    Top and bottom boundary conditions on the 2nd derivative are
+      !!    set to zero.
+      !!
+      !! ** Action  :
+      !!
+      !! References : 
+      !!
+      !! History
+      !!      ! 01-11 (A. Weaver, S. Ricci, N. Daget)
+      !!      ! 06-03 (G. Smith) Conversion to F90 for use with NEMOVAR
+      !!      ! 06-10 (A. Weaver) Cleanup
+      !!----------------------------------------------------------------------
+     
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kpk               ! Number of vertical levels
+      REAL(KIND=wp), INTENT(IN), DIMENSION(kpk) :: &
+         & pobsk, &          ! Model profile at a given (lon,lat)
+         & pdep,  &          ! Model depth array
+         & pobsmask          ! Vertical mask
+      REAL(KIND=wp), INTENT(OUT), DIMENSION(kpk) :: &
+         & pobs2k            ! 2nd derivative of the interpolating function
+  
+      !! * Local declarations
+      INTEGER :: jk
+      REAL(KIND=wp) :: za
+      REAL(KIND=wp) :: zb
+      REAL(KIND=wp) :: zc
+      REAL(KIND=wp) :: zpa
+      REAL(KIND=wp) :: zkm
+      REAL(KIND=wp) :: zkp
+      REAL(KIND=wp) :: zk
+      REAL(KIND=wp), DIMENSION(kpk-1) :: &
+         & zs, &
+         & zp, &
+         & zu, &
+         & zv
+
+      !-----------------------------------------------------------------------
+      ! Matrix initialisation
+      !-----------------------------------------------------------------------
+      zs(1) =  0.0_wp
+      zp(1) =  0.0_wp
+      zv(1) = -0.5_wp
+      DO jk = 2, kpk-1
+         zs(jk) =  ( pdep(jk  ) - pdep(jk-1) ) &
+            &    / ( pdep(jk+1) - pdep(jk-1) )
+         zp(jk) = zs(jk) * zv(jk-1) + 2.0_wp
+         zv(jk) = ( zs(jk) - 1.0_wp ) / zp(jk)
+      END DO
+ 
+      !-----------------------------------------------------------------------
+      ! Solution of the tridiagonal system
+      !-----------------------------------------------------------------------
+ 
+      ! Top boundary condition
+      zu(1) = 0.0_wp
+ 
+      DO jk = 2, kpk-1
+         za = pdep(jk+1) - pdep(jk-1)
+         zb = pdep(jk+1) - pdep(jk  )
+         zc = pdep(jk  ) - pdep(jk-1)
+ 
+         zpa = 6.0_wp / ( zp(jk) * za )
+         zkm = zpa / zc
+         zkp = zpa / zb
+         zk  = - ( zkm + zkp )
+  
+         zu(jk) =  pobsk(jk+1) * zkp  &
+            &    + pobsk(jk  ) * zk   &
+            &    + pobsk(jk-1) * zkm  &
+            &    + zu(jk-1) * ( -zs(jk) / zp(jk) )
+      END DO
+ 
+      !-----------------------------------------------------------------------
+      ! Second derivative
+      !-----------------------------------------------------------------------
+      pobs2k(kpk) = 0.0_wp
+ 
+      ! Bottom boundary condition
+      DO jk = kpk-1, 1, -1
+         pobs2k(jk) = zv(jk) * pobs2k(jk+1) + zu(jk)
+         IF ( pobsmask(jk+1) == 0.0_wp ) pobs2k(jk) = 0.0_wp
+      END DO
+ 
+  END SUBROUTINE obs_int_z1d_spl
+
+
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obsprof_io.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obsprof_io.h90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obsprof_io.h90	(revision 2528)
@@ -0,0 +1,834 @@
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE read_enactfile( cdfilename, inpfile, kunit, ldwp, ldgrid )
+      !!---------------------------------------------------------------------
+      !!
+      !!                     ** ROUTINE read_enactfile **
+      !!
+      !! ** Purpose : Read from file the profile ENACT observations.
+      !!
+      !! ** Method  : The data file is a NetCDF file. 
+      !!
+      !! ** Action  :
+      !!
+      !! History : 
+      !!          ! 09-01 (K. Mogensen) Original based on old versions
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(LEN=*) :: cdfilename ! Input filename
+      TYPE(obfbdata)   :: inpfile    ! Output obfbdata structure
+      INTEGER          :: kunit      ! Unit for output
+      LOGICAL          :: ldwp       ! Print info
+      LOGICAL          :: ldgrid     ! Save grid info in data structure
+      !! * Local declarations
+      INTEGER :: iobs                ! Number of observations
+      INTEGER :: ilev                      ! Number of levels
+      INTEGER :: i_file_id
+      INTEGER :: i_obs_id
+      INTEGER :: i_lev_id
+      INTEGER :: i_phi_id
+      INTEGER :: i_lam_id
+      INTEGER :: i_depth_id
+      INTEGER :: i_var_id
+      INTEGER :: i_pl_num_id
+      INTEGER :: i_reference_date_time_id
+      INTEGER :: i_format_version_id
+      INTEGER :: i_juld_id
+      INTEGER :: i_data_type_id
+      INTEGER :: i_wmo_inst_type_id
+      INTEGER :: i_qc_var_id
+      INTEGER :: i_dc_ref_id
+      INTEGER :: i_qc_flag_id
+      CHARACTER(LEN=40) :: cl_fld_lam
+      CHARACTER(LEN=40) :: cl_fld_phi
+      CHARACTER(LEN=40) :: cl_fld_depth 
+      CHARACTER(LEN=40) :: cl_fld_var_tp
+      CHARACTER(LEN=40) :: cl_fld_var_s
+      CHARACTER(LEN=40) :: cl_fld_var_ti
+      CHARACTER(LEN=40) :: cl_fld_var_juld_qc
+      CHARACTER(LEN=40) :: cl_fld_var_pos_qc
+      CHARACTER(LEN=40) :: cl_fld_var_depth_qc 
+      CHARACTER(LEN=40) :: cl_fld_var_qc_t
+      CHARACTER(LEN=40) :: cl_fld_var_qc_s
+      CHARACTER(LEN=40) :: cl_fld_var_prof_qc_t
+      CHARACTER(LEN=40) :: cl_fld_var_prof_qc_s
+      CHARACTER(LEN=40) :: cl_fld_reference_date_time
+      CHARACTER(LEN=40) :: cl_fld_juld
+      CHARACTER(LEN=40) :: cl_fld_data_type
+      CHARACTER(LEN=40) :: cl_fld_pl_num
+      CHARACTER(LEN=40) :: cl_fld_format_version
+      CHARACTER(LEN=40) :: cl_fld_wmo_inst_type
+      CHARACTER(LEN=40) :: cl_fld_qc_flags_profiles
+      CHARACTER(LEN=40) :: cl_fld_qc_flags_levels
+
+      CHARACTER(LEN=14), PARAMETER :: cl_name = 'read_enactfile'
+      CHARACTER(LEN=16)            :: cl_data_type = ''
+      CHARACTER(LEN=4 )            :: cl_format_version = ''
+      INTEGER, DIMENSION(1) :: istart1, icount1
+      INTEGER, DIMENSION(2) :: istart2, icount2
+      CHARACTER(len=imaxlev) :: clqc
+      CHARACTER(len=1) :: cqc
+      INTEGER :: ji, jk
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: iqc1
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: iqc2
+
+      !-----------------------------------------------------------------------
+      ! Initialization
+      !-----------------------------------------------------------------------
+
+      cl_fld_lam                 = 'LONGITUDE'
+      cl_fld_phi                 = 'LATITUDE'
+      cl_fld_depth               = 'DEPH_CORRECTED'
+      cl_fld_reference_date_time = 'REFERENCE_DATE_TIME'
+      cl_fld_juld                = 'JULD'
+      cl_fld_data_type           = 'DATA_TYPE'
+      cl_fld_format_version      = 'FORMAT_VERSION'
+      cl_fld_wmo_inst_type       = 'WMO_INST_TYPE'
+      cl_fld_pl_num              = 'PLATFORM_NUMBER'
+
+      cl_fld_var_qc_t            = 'POTM_CORRECTED_QC'
+      cl_fld_var_prof_qc_t       = 'PROFILE_POTM_QC'
+      cl_fld_var_tp              = 'POTM_CORRECTED'
+      cl_fld_var_qc_s            = 'PSAL_CORRECTED_QC'
+      cl_fld_var_prof_qc_s       = 'PROFILE_PSAL_QC'
+      cl_fld_var_s               = 'PSAL_CORRECTED'
+      cl_fld_var_depth_qc        = 'DEPH_CORRECTED_QC'
+      cl_fld_var_juld_qc         = 'JULD_QC'
+      cl_fld_var_pos_qc          = 'POSITION_QC'
+      cl_fld_var_ti              = 'TEMP'
+      cl_fld_qc_flags_profiles   = 'QC_FLAGS_PROFILES'
+      cl_fld_qc_flags_levels     = 'QC_FLAGS_LEVELS'
+
+      icount1(1) = 1 
+
+      !-----------------------------------------------------------------------
+      ! Open file
+      !-----------------------------------------------------------------------
+
+      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, &
+            &      i_file_id ),           cl_name, __LINE__ )
+
+      !-----------------------------------------------------------------------
+      ! Read the heading of the file
+      !-----------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_data_type,      &
+         &         i_data_type_id ),      cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_data_type_id,        &
+         &         cl_data_type ),        cl_name, __LINE__ )
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_format_version, &
+         &         i_format_version_id ), cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_format_version_id,   &
+         &         cl_format_version ),   cl_name, __LINE__ )
+      
+      CALL str_c_to_for( cl_data_type )
+      CALL str_c_to_for( cl_format_version )
+      
+      IF(ldwp)WRITE(kunit,*)
+      IF(ldwp)WRITE(kunit,*) ' read_enactfile :' 
+      IF(ldwp)WRITE(kunit,*) ' ~~~~~~~~~~~~~~~~'
+      IF(ldwp)WRITE(kunit,*) '               Data type           = ', &
+         &                TRIM( ADJUSTL( cl_data_type ) )
+      IF(ldwp)WRITE(kunit,*) '               Format version      = ',  &
+         &                TRIM( ADJUSTL( cl_format_version ) )
+      
+      IF ( ( ( INDEX( cl_data_type,"ENACT v1.0" ) == 1 ) .OR.   &
+         &   ( INDEX( cl_data_type,"ENACT v1.4" ) == 1 ) .OR.   &
+         &   ( INDEX( cl_data_type,"ENACT v1.5" ) == 1 ) .OR.   &
+         &   ( INDEX( cl_data_type,"ENSEMBLES EN3 v1" ) == 1 )      ) &
+         &   .AND.                                              &
+         &   ( INDEX( cl_format_version,"2.0"   ) == 1 ) ) THEN
+         IF(ldwp)WRITE(kunit,*)'               Valid input file'
+      ELSE
+         CALL fatal_error( 'Invalid input file', __LINE__ )
+      ENDIF
+
+      !---------------------------------------------------------------------
+      ! Read the number of observations and levels to allocate arrays
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_dimid        ( i_file_id, 'N_PROF', i_obs_id ),         &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_obs_id, len = iobs ),     &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inq_dimid        ( i_file_id, 'N_LEVELS', i_lev_id ),     &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_lev_id, len = ilev ), &
+         &         cl_name, __LINE__ )
+      IF(ldwp)WRITE(kunit,*) '               No. of data records = ', iobs
+      IF(ldwp)WRITE(kunit,*) '               No. of levels       = ', ilev
+      IF(ldwp)WRITE(kunit,*) 
+      IF (ilev > imaxlev) THEN
+         CALL fatal_error( 'Increase imaxlev in obs_prof_io.F90', __LINE__ )
+      ENDIF
+
+      !---------------------------------------------------------------------
+      ! Allocate arrays
+      !---------------------------------------------------------------------
+
+      CALL init_obfbdata( inpfile )
+      CALL alloc_obfbdata( inpfile, 2, iobs, ilev, 0, 1, ldgrid )
+      inpfile%cname(1) = 'POTM'
+      inpfile%cname(2) = 'PSAL'
+      inpfile%coblong(1) = 'Potential temperature'
+      inpfile%coblong(2) = 'Practical salinity'
+      inpfile%cobunit(1) = 'Degrees Celsius'
+      inpfile%cobunit(2) = 'PSU'
+      inpfile%cextname(1) = 'TEMP'
+      inpfile%cextlong(1) = 'Insitu temperature'
+      inpfile%cextunit(1) = 'Degrees Celsius'
+
+      !---------------------------------------------------------------------
+      ! Read the QC atributes
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_qc_t, i_qc_var_id ),                         &
+         &         cl_name, __LINE__ )        
+      istart2(1) = 1
+      icount2(2) = 1
+      icount2(1) = ilev
+      DO ji = 1, iobs 
+         istart2(2) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, clqc,                                   &
+            &                         start = istart2, count = icount2),                              &
+            &         cl_name, __LINE__ )
+         DO jk = 1, ilev
+            inpfile%ivlqc(jk,ji,1) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
+         END DO
+      END DO
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_qc_s, i_qc_var_id ),                         &
+         &         cl_name, __LINE__ )
+      DO ji = 1, iobs
+         istart2(2) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, clqc,                                   &
+            &                         start = istart2, count = icount2),                              &
+            &         cl_name, __LINE__ )
+         DO jk = 1, ilev
+            inpfile%ivlqc(jk,ji,2) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
+         END DO
+      END DO
+      ! No depth QC in files
+      DO ji = 1, iobs
+         DO jk = 1, ilev
+            inpfile%idqc(jk,ji)  = 1
+            inpfile%idqcf(:,jk,ji) = 0
+         END DO
+      END DO
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_prof_qc_t, i_qc_var_id ),                    &
+         &         cl_name,  __LINE__ )
+      DO ji = 1,iobs
+         istart1(1) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                    &
+            &                         start = istart1, count = icount1),                              &
+            &         cl_name, __LINE__ )
+         inpfile%ivqc(ji,1) = IACHAR( cqc ) - IACHAR( '0' )
+      END DO
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_prof_qc_s, i_qc_var_id ),                    & 
+         &         cl_name, __LINE__ ) 
+      DO ji = 1,iobs
+         istart1(1) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                    &
+            &                         start = istart1, count = icount1),                              &
+            &         cl_name, __LINE__ )
+         inpfile%ivqc(ji,2) = IACHAR( cqc ) - IACHAR( '0' )
+      END DO
+!!      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_juld_qc, i_qc_var_id ),                       &
+!!         &         cl_name, __LINE__ ) 
+!!      !DO ji = 1,iobs
+!!         istart1(1) = ji
+!!         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                    &
+!!            &                         start = istart1, count = icount1),                              &
+!!            &         cl_name, __LINE__ )
+!!         inpfile%itqc(ji)    = IACHAR( cqc ) - IACHAR( '0' )
+!!         inpfile%itqcf(:,ji) = 0
+!!      END DO
+      ! Since the flags are not set in the ENACT files we reset them to 0
+      inpfile%itqc(:)    = 1      
+      inpfile%itqcf(:,:) = 0
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_pos_qc, i_qc_var_id ),                       &
+         &         cl_name, __LINE__ ) 
+      DO ji = 1,iobs
+         istart1(1) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                    &
+            &                         start = istart1, count = icount1),                              &
+            &         cl_name, __LINE__ )
+         inpfile%ipqc(ji)    = IACHAR( cqc ) - IACHAR( '0' )
+         inpfile%ipqcf(:,ji) = 0
+      END DO
+      DO ji = 1,iobs
+         inpfile%ioqc(ji) = MIN( inpfile%ivqc(ji,1), inpfile%ivqc(ji,2) )
+      END DO
+      IF ( nf90_inq_varid( i_file_id, cl_fld_qc_flags_profiles, i_qc_flag_id ) == nf90_noerr ) THEN
+         ALLOCATE( &
+            & iqc1(iobs) &
+            & )
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_flag_id, iqc1 ),                                &
+            &         cl_name, __LINE__ )
+         DO ji = 1,iobs
+            inpfile%ioqcf(1,ji)   = iqc1(ji)
+            inpfile%ivqcf(1,ji,:) = iqc1(ji)
+            inpfile%ioqcf(2,ji)   = 0
+            inpfile%ivqcf(2,ji,:) = 0
+         END DO
+         DEALLOCATE( &
+            & iqc1 &
+            & )
+      ELSE
+         IF(ldwp) WRITE(kunit,*)'No QC profile flags in file'
+         inpfile%ioqcf(:,:)   = 0
+         inpfile%ivqcf(:,:,:) = 0
+      ENDIF
+      IF ( nf90_inq_varid( i_file_id, cl_fld_qc_flags_levels, i_qc_flag_id ) == nf90_noerr ) THEN
+         ALLOCATE( &
+            & iqc2(ilev,iobs) &
+            & )
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_flag_id, iqc2 ),                                &
+            &         cl_name, __LINE__ )
+         DO ji = 1,iobs
+            DO jk = 1,ilev
+               inpfile%ivlqcf(1,jk,ji,:) = iqc2(jk,ji)
+               inpfile%ivlqcf(2,jk,ji,:) = 0
+            END DO
+         END DO
+         DEALLOCATE( &
+            & iqc2 &
+            & )
+      ELSE
+         IF(ldwp) WRITE(kunit,*)'No QC level flags in file'
+         inpfile%ivlqcf(:,:,:,:) = 0
+      ENDIF
+
+      !---------------------------------------------------------------------
+      ! Read the time/position variables 
+      !---------------------------------------------------------------------
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_juld, i_juld_id ),                               &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_juld_id, inpfile%ptim ),                              &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_depth, i_depth_id ),                             &
+            &         cl_name, __LINE__ )         
+      CALL chkerr( nf90_get_var  ( i_file_id, i_depth_id, inpfile%pdep ),                             &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_phi, i_phi_id ),                                 &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_phi_id, inpfile%pphi ),                               &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_lam, i_lam_id ),                                 &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_lam_id, inpfile%plam ),                               &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_reference_date_time, i_reference_date_time_id ), &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_reference_date_time_id, inpfile%cdjuldref ),          &
+         &         cl_name, __LINE__ )
+      
+      !---------------------------------------------------------------------
+      ! Read the platform information
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_wmo_inst_type, i_wmo_inst_type_id ),             &
+         &         cl_name, __LINE__ )          
+      CALL chkerr( nf90_get_var  ( i_file_id, i_wmo_inst_type_id, inpfile%cdtyp ),                    &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_pl_num, i_pl_num_id ),                           &
+         &         cl_name, __LINE__ )         
+      CALL chkerr( nf90_get_var  ( i_file_id, i_pl_num_id, inpfile%cdwmo ),                           &
+         &         cl_name, __LINE__ )         
+
+      !---------------------------------------------------------------------
+      ! Read the variables
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_tp, i_var_id ),                              &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, inpfile%pob(:,:,1) ),                         &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_s, i_var_id ),                               &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, inpfile%pob(:,:,2) ),                         &
+         &         cl_name, __LINE__ )
+ 
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_ti, i_var_id ),                              &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, inpfile%pext(:,:,1) ),                        &
+         &         cl_name, __LINE__ )
+
+      !---------------------------------------------------------------------
+      ! Close file
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_close( i_file_id ),           cl_name, __LINE__ )
+
+      !---------------------------------------------------------------------
+      ! Set file indexes
+      !---------------------------------------------------------------------
+      DO ji = 1, inpfile%nobs
+         inpfile%kindex(ji) = ji
+      END DO
+
+   END SUBROUTINE read_enactfile
+
+   SUBROUTINE read_coriofile( cdfilename, inpfile, kunit, ldwp, ldgrid )
+      !!---------------------------------------------------------------------
+      !!
+      !!                     ** ROUTINE read_coriofile **
+      !!
+      !! ** Purpose : Read from file the profile CORIO observations.
+      !!
+      !! ** Method  : The data file is a NetCDF file. 
+      !!
+      !! ** Action  :
+      !!
+      !! History : 
+      !!          ! 09-01 (K. Mogensen) Original based on old versions
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(LEN=*) :: cdfilename ! Input filename
+      TYPE(obfbdata)   :: inpfile    ! Output enactfile structure
+      INTEGER          :: kunit      ! Unit for output
+      LOGICAL          :: ldwp       ! Print info
+      LOGICAL          :: ldgrid     ! Save grid info in data structure
+      INTEGER  :: &
+         & iobs, &
+         & ilev
+      !! * Local declarations
+      INTEGER :: &
+         & i_file_id,                &
+         & i_obs_id,                 &
+         & i_lev_id,                 &
+         & i_phi_id,                 & 
+         & i_lam_id,                 &
+         & i_depth_id,               &
+         & i_pres_id,                &
+         & i_var_id,                 &
+         & i_pl_num_id,              &
+         & i_format_version_id,      &
+         & i_juld_id,                &
+         & i_data_type_id,           &
+         & i_wmo_inst_type_id,       &
+         & i_qc_var_id,              &
+         & i_dc_ref_id
+      CHARACTER(LEN=40) :: & 
+         & cl_fld_lam,                 &
+         & cl_fld_phi,                 &
+         & cl_fld_depth,               & 
+         & cl_fld_depth_qc,            & 
+         & cl_fld_pres,                & 
+         & cl_fld_pres_qc,             & 
+         & cl_fld_var_t,               &
+         & cl_fld_var_s,               &
+         & cl_fld_var_ti,              &
+         & cl_fld_var_pos_qc,          &
+         & cl_fld_var_qc_t,            &
+         & cl_fld_var_qc_s,            &
+         & cl_fld_var_prof_qc_t,       &
+         & cl_fld_var_prof_qc_s,       &
+         & cl_fld_dc_ref,              &
+         & cl_fld_juld,                &
+         & cl_fld_pl_num,              &
+         & cl_fld_wmo_inst_type
+      CHARACTER(LEN=14), PARAMETER :: &
+         & cl_name = 'read_coriofile'
+      CHARACTER(LEN=4 )            :: &
+         & cl_format_version = ''
+      INTEGER, DIMENSION(1) :: &
+         & istart1, icount1
+      INTEGER, DIMENSION(2) :: &
+         & istart2, icount2
+      CHARACTER(len=imaxlev) :: &
+         & clqc
+      CHARACTER(len=1) :: &
+         & cqc
+      CHARACTER(len=256) :: &
+         & cdjulref
+      INTEGER :: &
+         & ji, jk
+      INTEGER :: &
+         & iformat
+      LOGICAL :: & 
+         & lsal
+      REAL(fbdp), DIMENSION(:,:), ALLOCATABLE :: &
+         & zpres
+      INTEGER, DIMENSION(:,:), ALLOCATABLE :: &
+         & ipresqc
+      CHARACTER(len=256) :: &
+         & cerr
+      !-----------------------------------------------------------------------
+      ! Initialization
+      !-----------------------------------------------------------------------
+
+      icount1(1) = 1 
+      lsal = .TRUE.
+
+      !-----------------------------------------------------------------------
+      ! Open file
+      !-----------------------------------------------------------------------
+
+      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, &
+            &      i_file_id ),           cl_name, __LINE__ )
+
+      !-----------------------------------------------------------------------
+      ! Check format and set variables accordingly
+      !-----------------------------------------------------------------------
+
+      IF ( ( nf90_inq_dimid( i_file_id, 'N_PROF', i_obs_id ) == nf90_noerr ) .AND. &
+         & ( nf90_inq_dimid( i_file_id, 'N_LEVELS', i_lev_id ) == nf90_noerr ) ) THEN
+         iformat = 1
+      ELSEIF ( ( nf90_inq_dimid( i_file_id, 'mN_PROF', i_obs_id ) == nf90_noerr ) .AND. &
+         & ( nf90_inq_dimid( i_file_id, 'mN_ZLEV', i_lev_id ) == nf90_noerr ) ) THEN
+         iformat = 2
+      ELSE
+         WRITE(cerr,'(2A)')'Invalid data format in ',cl_name
+         CALL fatal_error( cerr, __LINE__ )
+      ENDIF
+      IF ( iformat == 1 ) THEN
+         cl_fld_lam                 = 'LONGITUDE'
+         cl_fld_phi                 = 'LATITUDE'  
+         cl_fld_depth               = 'DEPH'
+         cl_fld_depth_qc            = 'DEPH_QC'
+         cl_fld_pres                = 'PRES'
+         cl_fld_pres_qc             = 'PRES_QC'
+         cl_fld_juld                = 'JULD'
+         cl_fld_wmo_inst_type       = 'WMO_INST_TYPE'
+         cl_fld_dc_ref              = 'DC_REFERENCE'
+         cl_fld_pl_num              = 'PLATFORM_NUMBER'
+         cl_fld_var_qc_t            = 'TEMP_QC'
+         cl_fld_var_prof_qc_t       = 'PROFILE_TEMP_QC'
+         cl_fld_var_t               = 'TEMP'
+         cl_fld_var_qc_s            = 'PSAL_QC'
+         cl_fld_var_prof_qc_s       = 'PROFILE_PSAL_QC'
+         cl_fld_var_s               = 'PSAL'
+         cl_fld_var_pos_qc          = 'POSITION_QC'
+      ELSEIF ( iformat==2 ) THEN
+         cl_fld_lam                 = 'LONGITUDE'
+         cl_fld_phi                 = 'LATITUDE'  
+         cl_fld_depth               = 'DEPH'
+         cl_fld_depth_qc            = 'QC_DEPH'
+         cl_fld_pres                = 'PRES'
+         cl_fld_pres_qc             = 'QC_PRES'
+         cl_fld_juld                = 'JULD'
+         cl_fld_wmo_inst_type       = 'INST_TYPE'
+         cl_fld_dc_ref              = 'REFERENCE'
+         cl_fld_pl_num              = 'PLATFORM_NUMBER'
+         cl_fld_var_qc_t            = 'QC_TEMP'
+         cl_fld_var_prof_qc_t       = 'Q_PROFILE_TEMP'
+         cl_fld_var_t               = 'TEMP'
+         cl_fld_var_qc_s            = 'QC_PSAL'
+         cl_fld_var_prof_qc_s       = 'Q_PROFILE_PSAL'
+         cl_fld_var_s               = 'PSAL'
+         cl_fld_var_pos_qc          = 'Q_POSITION'
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Read the heading of the file
+      !-----------------------------------------------------------------------
+
+      IF(ldwp)WRITE(kunit,*)
+      IF(ldwp)WRITE(kunit,*) ' read_coriofile :' 
+      IF(ldwp)WRITE(kunit,*) ' ~~~~~~~~~~~~~~~~'
+      IF(ldwp)WRITE(kunit,*) '               Format version      = ', iformat
+
+      !---------------------------------------------------------------------
+      ! Read the number of observations and levels to allocate arrays
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_obs_id, len = iobs ), &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_lev_id, len = ilev ), &
+         &         cl_name, __LINE__ )
+      IF(ldwp)WRITE(kunit,*) '               No. of data records = ', iobs
+      IF(ldwp)WRITE(kunit,*) '               No. of levels       = ', ilev
+      IF(ldwp)WRITE(kunit,*) 
+      IF (ilev > imaxlev) THEN
+         CALL fatal_error( 'Increase imaxlev in obs_prof_io.F90', __LINE__ )
+      ENDIF
+
+      !---------------------------------------------------------------------
+      ! Allocate arrays
+      !---------------------------------------------------------------------
+
+      CALL init_obfbdata( inpfile )
+      CALL alloc_obfbdata( inpfile, 2, iobs, ilev, 0, 1, ldgrid )
+      inpfile%cname(1) = 'POTM'
+      inpfile%cname(2) = 'PSAL'
+      inpfile%coblong(1) = 'Potential temperature'
+      inpfile%coblong(2) = 'Practical salinity'
+      inpfile%cobunit(1) = 'Degrees Celsius'
+      inpfile%cobunit(2) = 'PSU'
+      inpfile%cextname(1) = 'TEMP'
+      inpfile%cextlong(1) = 'Insitu temperature'
+      inpfile%cextunit(1) = 'Degrees Celsius'
+      ALLOCATE( &
+         & zpres(ilev,iobs),  &
+         & ipresqc(ilev,iobs) &
+         & )
+      !---------------------------------------------------------------------
+      ! Get julian data reference (iformat==2)
+      !---------------------------------------------------------------------
+
+      IF (iformat==2) THEN
+         CALL chkerr ( nf90_get_att( i_file_id, nf90_global, &
+            &                        "Reference_date_time", cdjulref ), &
+            &         cl_name, __LINE__ )
+         inpfile%cdjuldref = cdjulref(7:10)//cdjulref(4:5)// &
+            & cdjulref(1:2)//cdjulref(12:13)//cdjulref(15:16)//cdjulref(18:19)
+      ENDIF
+
+      !---------------------------------------------------------------------
+      ! Read the QC attributes
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_qc_t, i_qc_var_id ),                                &
+         &         cl_name, __LINE__ )
+      istart2(1) = 1
+      icount2(2) = 1
+      icount2(1) = ilev
+      DO ji = 1, iobs 
+         istart2(2) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, clqc,                                   &
+            &                         start = istart2, count = icount2),                              &
+            &         cl_name, __LINE__ )
+         DO jk = 1, ilev
+            inpfile%ivlqc(jk,ji,1) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
+         END DO
+      END DO
+      IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_s, i_qc_var_id ) == nf90_noerr ) THEN
+         DO ji = 1, iobs
+            istart2(2) = ji
+            CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, clqc,                                &
+               &                         start = istart2, count = icount2),                           &
+               &         cl_name, __LINE__ )
+            DO jk = 1, ilev
+               inpfile%ivlqc(jk,ji,2) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
+            END DO
+         END DO
+      ELSE
+         inpfile%ivlqc(:,:,2) = 4
+         inpfile%pob(:,:,2) = fbrmdi
+         lsal = .FALSE.
+      ENDIF
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_prof_qc_t, i_qc_var_id ),                    &
+         &         cl_name,  __LINE__ )
+      DO ji = 1,iobs
+         istart1(1) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                    &
+            &                         start = istart1, count = icount1),                              &
+            &         cl_name, __LINE__ )
+         inpfile%ivqc(ji,1) = IACHAR( cqc ) - IACHAR( '0' )
+      END DO
+      IF (lsal) THEN
+         CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_prof_qc_s, i_qc_var_id ),                 & 
+            &         cl_name, __LINE__ ) 
+         DO ji = 1,iobs
+            istart1(1) = ji
+            CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                 &
+               &                         start = istart1, count = icount1),                           &
+               &         cl_name, __LINE__ )
+            inpfile%ivqc(ji,2) = IACHAR( cqc ) - IACHAR( '0' )
+         END DO
+      ELSE
+         inpfile%ivqc(:,2) = 4
+      ENDIF
+      DO ji = 1,iobs
+         inpfile%ioqc(ji) = MIN( inpfile%ivqc(ji,1), inpfile%ivqc(ji,2) )
+      END DO
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_pos_qc, i_qc_var_id ),                       &
+         &         cl_name, __LINE__ ) 
+      DO ji = 1, iobs
+         istart1(1) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                    &
+            &                         start = istart1, count = icount1),                              &
+            &         cl_name, __LINE__ )
+         inpfile%ipqc(ji)  = IACHAR( cqc ) - IACHAR( '0' )
+      END DO
+      
+      !---------------------------------------------------------------------
+      ! Read the time/position variables 
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_juld, i_juld_id ),                               &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_juld_id, inpfile%ptim ),                              &
+         &         cl_name, __LINE__ )
+      IF (iformat==1) THEN
+         CALL chkerr ( nf90_get_att( i_file_id, i_juld_id, &
+            &                        "units", cdjulref ), &
+            &         cl_name, __LINE__ )
+         inpfile%cdjuldref = cdjulref(12:15)//cdjulref(17:18)// &
+            & cdjulref(20:21)//cdjulref(23:24)//cdjulref(26:27)//&
+            & cdjulref(29:30)
+      ENDIF
+      
+      IF ( nf90_inq_varid( i_file_id, cl_fld_depth, i_depth_id ) == nf90_noerr ) THEN
+         CALL chkerr( nf90_get_var  ( i_file_id, i_depth_id, inpfile%pdep ),                          &
+            &         cl_name, __LINE__ )
+         CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_depth_qc, i_qc_var_id ),                      & 
+            &         cl_name, __LINE__ ) 
+         DO ji = 1, iobs
+            istart2(2) = ji
+            CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, clqc,                                &
+               &                         start = istart2, count = icount2),                           &
+               &         cl_name, __LINE__ )
+            DO jk = 1, ilev
+               inpfile%idqc(jk,ji) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
+            END DO
+         END DO
+      ELSE
+         inpfile%pdep(:,:) = fbrmdi
+         inpfile%idqc(:,:) = 4
+      ENDIF
+
+      IF ( nf90_inq_varid( i_file_id, cl_fld_pres, i_pres_id ) == nf90_noerr ) THEN
+         CALL chkerr( nf90_get_var  ( i_file_id, i_pres_id, zpres ),                                  &
+            &         cl_name, __LINE__ )
+         CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_pres_qc, i_qc_var_id ),                       & 
+            &         cl_name, __LINE__ ) 
+         DO ji = 1, iobs
+            istart2(2) = ji
+            CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, clqc,                                &
+               &                         start = istart2, count = icount2),                           &
+               &         cl_name, __LINE__ )
+            DO jk = 1, ilev
+               ipresqc(jk,ji) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
+            END DO
+         END DO
+      ELSE
+         zpres(:,:) = fbrmdi
+         ipresqc(:,:) = 4
+      ENDIF
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_phi, i_phi_id ),                                 &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_phi_id, inpfile%pphi ),                               &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_lam, i_lam_id ),                                 &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_lam_id, inpfile%plam ),                               &
+         &         cl_name, __LINE__ )
+      
+      !---------------------------------------------------------------------
+      ! Read the platform information
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_wmo_inst_type, i_wmo_inst_type_id ),             &
+         &         cl_name, __LINE__ )          
+      CALL chkerr( nf90_get_var  ( i_file_id, i_wmo_inst_type_id, inpfile%cdtyp ),                    &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_pl_num, i_pl_num_id ),                           &
+         &         cl_name, __LINE__ )         
+      CALL chkerr( nf90_get_var  ( i_file_id, i_pl_num_id, inpfile%cdwmo ),                           &
+         &         cl_name, __LINE__ )         
+
+      
+      !---------------------------------------------------------------------
+      ! Read the variables
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_t, i_var_id ),                               &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, inpfile%pext(:,:,1) ),                        &
+         &         cl_name, __LINE__ )
+
+      IF (lsal) THEN      
+         CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_s, i_var_id ),                            &
+            &         cl_name, __LINE__ )
+         CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, inpfile%pob(:,:,2) ),                      &
+            &         cl_name, __LINE__ )
+      ENDIF
+
+      !---------------------------------------------------------------------
+      ! Close file
+      !---------------------------------------------------------------------
+         
+      CALL chkerr( nf90_close( i_file_id ),           cl_name, __LINE__ )
+
+      !---------------------------------------------------------------------
+      ! Set file indexes
+      !---------------------------------------------------------------------
+      DO ji = 1, inpfile%nobs
+         inpfile%kindex(ji) = ji
+      END DO
+      
+      !---------------------------------------------------------------------
+      !  Coriolis data conversion from insitu to potential temperature
+      !---------------------------------------------------------------------
+      !---------------------------------------------------------------------
+      !  Convert pressure to depth if depth not present
+      !---------------------------------------------------------------------
+      DO ji = 1, inpfile%nobs
+         IF ( inpfile%pphi(ji) < 9999.0 ) THEN
+            DO jk = 1, inpfile%nlev
+               IF ( inpfile%pdep(jk,ji) >= 9999.0 ) THEN
+                  IF ( zpres(jk,ji) < 9999.0 ) THEN
+                     inpfile%pdep(jk,ji) = &
+                        & p_to_dep( REAL(zpres(jk,ji),wp), REAL(inpfile%pphi(ji),wp) )
+                     inpfile%idqc(jk,ji) = ipresqc(jk,ji)
+                  ENDIF
+               ENDIF
+            END DO
+         ENDIF
+      END DO
+      
+      !---------------------------------------------------------------------
+      !  Convert depth to pressure if pressure not present
+      !---------------------------------------------------------------------
+      DO ji = 1, inpfile%nobs
+         IF ( inpfile%pphi(ji) < 9999.0 ) THEN
+            DO jk = 1, inpfile%nlev
+               IF ( zpres(jk,ji) >= 9999.0 ) THEN
+                  IF ( inpfile%pdep(jk,ji) < 9999.0 ) THEN
+                     zpres(jk,ji) = dep_to_p( REAL(inpfile%pdep(jk,ji),wp), &
+                        &                            REAL(inpfile%pphi(ji),wp) )
+                     ipresqc(jk,ji) = inpfile%idqc(jk,ji)
+                  ENDIF
+               ENDIF
+            END DO
+         ENDIF
+      END DO
+      
+      !---------------------------------------------------------------------
+      !  Convert insitu temperature to potential temperature if
+      !  salinity, insitu temperature and pressure are present
+      !---------------------------------------------------------------------
+      DO ji = 1, inpfile%nobs
+         DO jk = 1, inpfile%nlev
+            IF (( inpfile%pob(jk,ji,2) < 9999.0 ) .AND. &
+               &( inpfile%pext(jk,ji,1) < 9999.0 ) .AND. &
+               &( zpres(jk,ji) < 9999.0 ) ) THEN
+               inpfile%pob(jk,ji,1) = potemp( REAL(inpfile%pob(jk,ji,2), wp),  &
+                  &                           REAL(inpfile%pext(jk,ji,1), wp), &
+                  &                           REAL(zpres(jk,ji),wp),  &
+                  &                           0.0_wp )
+            ELSE
+               inpfile%pob(jk,ji,1) = fbrmdi
+            ENDIF
+         END DO
+      END DO
+
+      !---------------------------------------------------------------------
+      !  Initialize flags since they are not in the CORIOLIS input files
+      !---------------------------------------------------------------------
+
+      inpfile%ioqcf(:,:)      = 0
+      inpfile%ipqcf(:,:)      = 0
+      inpfile%itqcf(:,:)      = 0
+      inpfile%idqcf(:,:,:)    = 0
+      inpfile%ivqcf(:,:,:)    = 0
+      inpfile%ivlqcf(:,:,:,:) = 0
+
+   END SUBROUTINE read_coriofile
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obsseaice_io.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obsseaice_io.h90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obsseaice_io.h90	(revision 2528)
@@ -0,0 +1,270 @@
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE read_seaice( cdfilename, inpfile, kunit, ldwp, ldgrid )
+      !!---------------------------------------------------------------------
+      !!
+      !!                     ** ROUTINE read_seaice **
+      !!
+      !! ** Purpose : Read from file the SEAICE observations.
+      !!
+      !! ** Method  : The data file is a NetCDF file. 
+      !!
+      !! ** Action  :
+      !!
+      !! References : 
+      !!
+      !! History : 
+      !!          ! 09-01 (K. Mogensen) Original based on old versions
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(LEN=*) :: cdfilename ! Input filename
+      TYPE(obfbdata)   :: inpfile    ! Output obfbdata structure
+      INTEGER          :: kunit      ! Unit for output
+      LOGICAL          :: ldwp       ! Print info
+      LOGICAL          :: ldgrid     ! Save grid info in data structure
+      !! * Local declarations
+      CHARACTER(LEN=12),PARAMETER :: cpname = 'read_seaice'
+      INTEGER :: i_file_id    ! netcdf IDS
+      INTEGER :: i_time_id
+      INTEGER :: i_ni_id
+      INTEGER :: i_data_id
+      INTEGER :: i_var_id
+      INTEGER :: i_data       ! Number of data per parameter in current file
+      INTEGER :: i_time       ! Number of reference times in file
+      INTEGER, DIMENSION(:), POINTER :: &
+         & i_reftime        ! Reference time in file in seconds since 1/1/1981.
+      INTEGER, DIMENSION(:,:), POINTER :: &
+         & i_dtime, &       ! Offset in seconds since reference time
+         & i_qc,    &       ! Quality control flag.
+         & i_type           ! Type of seaice measurement.            
+      REAL(wp), DIMENSION(:), POINTER :: &
+         & z_phi,   &       ! Latitudes
+         & z_lam            ! Longitudes
+      REAL(wp), DIMENSION(:,:), POINTER :: &
+         & z_seaice         ! Seaice data     
+      INTEGER, PARAMETER :: imaxdim = 2    ! Assumed maximum for no. dims. in file
+      INTEGER, DIMENSION(2) :: idims       ! Dimensions in file
+      INTEGER :: iilen          ! Length of netCDF attributes
+      INTEGER :: itype          ! Typeof netCDF attributes
+      REAL(KIND=wp) :: zsca      ! Scale factor
+      REAL(KIND=wp) :: zoff      ! Offset for data in netcdf file
+      REAL(KIND=wp) :: z_offset  ! Offset for time conversion
+      REAL(KIND=wp) :: zfill     ! Fill value in netcdf file
+      CHARACTER (len=33) ::creftime     ! Reference time of file
+      INTEGER :: i_refyear       ! Integer version of reference time
+      INTEGER :: i_refmonth
+      INTEGER :: i_refday
+      INTEGER :: i_refhour
+      INTEGER :: i_refmin
+      INTEGER :: i_refsec
+      INTEGER :: ichunk
+      INTEGER :: jtim
+      INTEGER :: jobs
+      INTEGER :: iobs
+
+      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, &
+         &                i_file_id, chunksize=ichunk), cpname, __LINE__ )
+      
+      ! Get the netCDF dimensions
+      
+      CALL chkerr( nf90_inq_dimid( i_file_id, 'time', i_time_id ),  &
+         &       cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_time_id, &
+         &                              len = i_time ),  &
+         &      cpname, __LINE__ )
+      
+      CALL chkerr( nf90_inq_dimid( i_file_id, 'ni', i_ni_id ),  &
+         &       cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_ni_id, &
+         &                              len = i_data ),  &
+         &      cpname, __LINE__ )
+      
+      
+      ! Allocate NetCDF variables
+      
+      ALLOCATE( &
+         & i_reftime    ( i_time                 ), &
+         & i_dtime      ( i_data,i_time  ), &      
+         & i_qc         ( i_data,i_time  ), & 
+         & i_type       ( i_data,i_time  ), &     
+         & z_phi        ( i_data                 ), &   
+         & z_lam        ( i_data                 ), &  
+         & z_seaice        ( i_data,i_time  )  &
+         & )
+      
+      ! Get reference time of file which is in seconds since 1981/1/1 00:00. 
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'time', i_var_id ), & 
+         &       cpname, __LINE__ )
+      idims(1) = i_time
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_reftime),&
+         &       cpname, __LINE__ )
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "units") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "units",creftime), cpname,  __LINE__ )
+      ELSE
+         creftime = "seconds since 1981-01-01 00:00:00"
+      ENDIF
+      READ(creftime(15:18),*)i_refyear
+      READ(creftime(20:21),*)i_refmonth
+      READ(creftime(23:24),*)i_refday
+      READ(creftime(26:27),*)i_refhour
+      READ(creftime(29:30),*)i_refmin
+      READ(creftime(32:33),*)i_refsec
+      !Work out offset in days between reference time and 1/1/1950.
+      CALL greg2jul( i_refsec, i_refmin, i_refhour, i_refday, &
+         &           i_refmonth, i_refyear, z_offset)
+      
+      ! Get list of times for each ob in seconds relative to reference time
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'SeaIce_dtime', i_var_id ), & 
+         &       cpname, __LINE__ )
+      idims(1) = i_data
+      idims(2) = i_time
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_dtime),&
+         &       cpname, __LINE__ )
+      zsca = 1.0      
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "scale_factor",zsca), cpname,  __LINE__ )
+      ENDIF
+      zoff = 0.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "add_offset") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "add_offset",zoff), cpname,  __LINE__ )
+      ENDIF
+      i_dtime(:,:) = NINT((zsca * FLOAT(i_dtime(:,:))) &
+         &                 + zoff)
+      
+      ! Get longitudes
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'lon', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = i_data
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_lam),   &
+         &         cpname, __LINE__ )
+      
+      ! Get latitudes
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'lat', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = i_data
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_phi),   &
+         &         cpname, __LINE__ )
+      
+      ! Get seaice data
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'sea_ice_concentration', &
+         &                         i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = i_data
+      idims(2) = i_time
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_seaice), &
+         &       cpname, __LINE__ )
+      zoff = 0.
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "scale_factor",zsca), cpname, __LINE__ )
+      ENDIF
+      zsca = 1.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
+         &                       == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                       "scale_factor",zsca), cpname, __LINE__ )
+      ENDIF
+      zfill = 0.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "_FillValue") &
+         &                       == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                       "_FillValue",zfill), cpname, __LINE__ )
+      ENDIF
+      WHERE(z_seaice(:,:) /=  zfill)
+         z_seaice(:,:) = (zsca * z_seaice(:,:)) + zoff
+      ELSEWHERE
+         z_seaice(:,:) = fbrmdi
+      END WHERE
+      
+      ! Get QC flag
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'confidence_flag', i_var_id ), & 
+         &       cpname, __LINE__ )
+      idims(1) = i_data
+      idims(2) = i_time
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_qc),   &
+            &       cpname, __LINE__ )
+      
+      ! Get seaice obs type
+      
+      i_type(:,:)=1
+      
+      ! Close the file
+      
+      CALL chkerr( nf90_close( i_file_id ), cpname, __LINE__ )
+
+      ! Fill the obfbdata structure
+
+      ! Allocate obfbdata
+      
+      iobs = i_data * i_time
+      CALL init_obfbdata( inpfile )
+      CALL alloc_obfbdata( inpfile, 1, iobs, 1, 0, 0, ldgrid )
+      inpfile%cname(1) = 'SEAICE'
+
+      ! Fill the obfbdata structure from input data
+
+      inpfile%cdjuldref = "19500101000000"
+      iobs = 0
+      DO jtim = 1, i_time
+         DO jobs = 1, i_data
+            iobs = iobs + 1
+            ! Characters
+            WRITE(inpfile%cdwmo(iobs),'(A6,A2)') 'seaice','  '
+            WRITE(inpfile%cdtyp(iobs),'(I4)') i_type(jobs,jtim)
+            ! Real values
+            inpfile%plam(iobs)         = z_lam(jobs)
+            inpfile%pphi(iobs)         = z_phi(jobs)
+            inpfile%pob(1,iobs,1)      = z_seaice(jobs,jtim)
+            inpfile%ptim(iobs)         = &
+               & REAL(i_reftime(jtim))/(60.*60.*24.) + &
+               & z_offset + REAL(i_dtime(jobs,jtim))/(60.*60.*24.)
+            inpfile%pdep(1,iobs)       = 0.0
+            ! Integers
+            inpfile%kindex(iobs)       = iobs
+            IF ( z_seaice(jobs,jtim) == fbrmdi ) THEN
+               inpfile%ioqc(iobs)      = 4
+               inpfile%ivqc(iobs,1)    = 4 
+               inpfile%ivlqc(1,iobs,1) = 4
+            ELSE 
+               inpfile%ioqc(iobs)      = i_qc(jobs,jtim)
+               inpfile%ivqc(iobs,1)    = i_qc(jobs,jtim)
+               inpfile%ivlqc(1,iobs,1) = 1
+            ENDIF
+            inpfile%ipqc(iobs)         = 0 
+            inpfile%ipqcf(:,iobs)      = 0
+            inpfile%itqc(iobs)         = 0
+            inpfile%itqcf(:,iobs)      = 0
+            inpfile%ivqcf(:,iobs,1)    = 0
+            inpfile%ioqcf(:,iobs)      = 0
+            inpfile%idqc(1,iobs)       = 0
+            inpfile%idqcf(1,1,iobs)    = 0
+            inpfile%ivlqcf(:,1,iobs,1) = 0
+         END DO
+      END DO
+
+   END SUBROUTINE read_seaice
+
+
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obssla_io.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obssla_io.h90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obssla_io.h90	(revision 2528)
@@ -0,0 +1,378 @@
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE read_avisofile( cdfilename, inpfile, kunit, ldwp, ldgrid )
+      !!---------------------------------------------------------------------
+      !!
+      !!                     ** ROUTINE read_avisofile **
+      !!
+      !! ** Purpose : Read from file the AVISO SLA observations.
+      !!
+      !! ** Method  : The data file is a NetCDF file. 
+      !!
+      !! ** Action  :
+      !!
+      !! References : http://www.aviso.oceanobs.com
+      !!
+      !! History : 
+      !!          ! 09-01 (K. Mogensen) Original based on old versions
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(LEN=*) :: cdfilename ! Input filename
+      TYPE(obfbdata)   :: inpfile    ! Output obfbdata structure
+      INTEGER          :: kunit      ! Unit for output
+      LOGICAL          :: ldwp       ! Print info
+      LOGICAL          :: ldgrid     ! Save grid info in data structure
+      !! * Local declarations
+      CHARACTER(LEN=14),PARAMETER :: cpname = 'read_avisofile'
+      INTEGER :: i_file_id     ! netcdf IDS
+      INTEGER :: i_tracks_id
+      INTEGER :: i_cycles_id
+      INTEGER :: i_data_id
+      INTEGER :: i_var_id
+      INTEGER, PARAMETER :: imaxdim = 2    ! Assumed maximum for no. dims. in file
+      INTEGER, DIMENSION(2) :: idims       ! Dimensions in file
+      INTEGER :: iilen         ! Length of netCDF attributes
+      INTEGER :: itype         ! Typeof netCDF attributes
+      REAL(fbdp) :: zsca       ! Scale factor
+      REAL(fbdp) :: zfill      ! Fill value
+      CHARACTER(len=3) ::  cmission      ! Mission global attribute
+      INTEGER :: itracks       ! Maximum number of passes in file
+      INTEGER :: icycles       ! Maximum number of cycles for each pass
+      INTEGER :: idata         ! Number of data per parameter in current file
+      REAL(fbdp) :: zdeltat    ! Time gap getween two measurements in seconds
+      INTEGER, DIMENSION(:), POINTER :: & 
+         & iptracks,     &  ! List of passes contained in current file
+         & ipnbpoints,   &  ! Number of points per pass
+         & ipdataindexes    ! Index of data in theoretical profile
+      INTEGER, DIMENSION(:,:), POINTER :: & 
+         & ipcycles         ! List of cycles per pass
+      REAL(fbdp), DIMENSION(:), POINTER :: &
+         & zphi,   &        ! Latitudes
+         & zlam             ! Longitudes
+      REAL(fbdp), DIMENSION(:,:), POINTER :: &
+         & zbegindates      ! Date of point with index 0
+      REAL(fbdp) :: zbeginmiss    ! Missing data for dates
+      REAL(fbsp), DIMENSION(:,:), POINTER :: &
+         & zsla             ! SLA data
+      REAL(fbdp), DIMENSION(:), POINTER :: &
+         & zjuld            ! Julian date
+      LOGICAL, DIMENSION(:), POINTER :: &
+         & llskip           ! Skip observation
+      CHARACTER(len=14) :: cdjuldref    ! Julian data reference
+      INTEGER :: imission   ! Mission number converted from Mission global 
+                            ! netCDF atttribute.
+      CHARACTER(len=255) :: ctmp
+      INTEGER :: iobs
+      INTEGER :: jl
+      INTEGER :: jm
+      INTEGER :: jj
+      INTEGER :: ji
+      INTEGER :: jk
+      INTEGER :: jobs
+      INTEGER :: jcycle
+
+      ! Open the file
+
+      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, i_file_id ), &
+         &         cpname, __LINE__ )
+
+      ! Get the netCDF dimensions
+      
+      CALL chkerr( nf90_inq_dimid( i_file_id, 'Tracks', i_tracks_id ),  &
+         &         cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_tracks_id, &
+         &                                 len = itracks ),  &
+         &         cpname, __LINE__ )
+      
+      CALL chkerr( nf90_inq_dimid( i_file_id, 'Cycles', i_cycles_id ),  &
+         &         cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_cycles_id, &
+         &                                 len = icycles ),  &
+         &      cpname, __LINE__ )
+      
+      CALL chkerr( nf90_inq_dimid( i_file_id, 'Data', i_data_id ),  &
+         &         cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_data_id, &
+         &                                 len = idata ),  &
+         &         cpname, __LINE__ )
+
+      ! Allocate memory for input data
+
+      ALLOCATE( &
+         & iptracks     ( itracks          ), &  
+         & ipnbpoints   ( itracks          ), &  
+         & ipcycles     ( icycles, itracks ), &
+         & zphi         ( idata            ), &   
+         & zlam         ( idata            ), &  
+         & zbegindates  ( icycles, itracks ), &
+         & ipdataindexes( idata            ), & 
+         & zsla         ( icycles, idata   ), &
+         & zjuld        ( idata*icycles    ), &
+         & llskip       ( idata*icycles    )  &
+         & )
+
+      ! Get time gap getween two measurements in seconds
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'DeltaT', i_var_id ), & 
+         &         cpname, __LINE__ )
+      CALL chkdim( i_file_id, i_var_id, 0, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zdeltat), &
+         &         cpname, __LINE__ )
+      zsca = 1.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, 'scale_factor') &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     'scale_factor',zsca), cpname,  __LINE__)
+      ENDIF
+      zdeltat = zsca * zdeltat
+         
+      ! Get List of passes contained in current file      
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'Tracks', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = itracks
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, iptracks), &
+         &         cpname, __LINE__ )
+      
+      ! Get Number of points per pass
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'NbPoints', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = itracks
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, ipnbpoints),&
+         &         cpname, __LINE__ )
+      
+      ! Get list of cycles per pass
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'Cycles', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = icycles
+      idims(2) = itracks
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, ipcycles),   &
+         &         cpname, __LINE__ )
+
+      ! Get longitudes
+
+      CALL chkerr( nf90_inq_varid( i_file_id, 'Longitudes', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = idata
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zlam),   &
+         &         cpname, __LINE__ )
+      zsca = 1.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, 'scale_factor') &
+         &                         == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     'scale_factor',zsca), cpname,  __LINE__)
+      ENDIF
+      zlam(:) = zsca * zlam(:)
+      
+      ! Get latitudes
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'Latitudes', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = idata
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zphi),   &
+         &         cpname, __LINE__ )
+      zsca = 1.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, 'scale_factor') &
+         &                       == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     'scale_factor',zsca), cpname,  __LINE__)
+      ENDIF
+      zphi(:) = zsca * zphi(:)
+      
+      ! Get date of point with index 0
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'BeginDates', i_var_id ), & 
+         &        cpname, __LINE__ )
+      idims(1) = icycles
+      idims(2) = itracks
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zbegindates), &
+         &         cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_attribute( i_file_id, i_var_id, &
+         &                                 'units', len = iilen,  &
+         &                                  xtype = itype), cpname, __LINE__ )
+      IF (( itype /= NF90_CHAR ) .OR. ( iilen > 255 )) THEN
+         CALL fatal_error('Error decoding BeginDates unit', __LINE__ )
+      ENDIF
+      CALL chkerr( nf90_get_att( i_file_id, i_var_id, 'units', &
+         &                       ctmp ), cpname, __LINE__ )
+      jl=1
+      DO jm = 1, LEN(TRIM(ctmp))
+         IF ((ctmp(jm:jm)>='0').AND.(ctmp(jm:jm)<='9')) THEN
+            cdjuldref(jl:jl) = ctmp(jm:jm)
+            jl=jl+1
+         ENDIF
+         IF (jl>14) EXIT
+      END DO
+      CALL chkerr( nf90_inquire_attribute( i_file_id, i_var_id, '_FillValue', &
+         &                                  xtype = itype), cpname, __LINE__ )
+      IF ( itype /= NF90_DOUBLE ) THEN
+         CALL fatal_error('Error decoding BeginDates missing data', __LINE__ )
+      ENDIF
+      CALL chkerr( nf90_get_att( i_file_id, i_var_id, '_FillValue', &
+         &                       zbeginmiss ), cpname, __LINE__ )
+
+      ! Get indices of data in theoretical profile
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'DataIndexes', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = idata
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, ipdataindexes),   &
+         &       cpname, __LINE__ )
+      
+      ! Get SLA data
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'SLA', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = icycles
+      idims(2) = idata
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zsla),   &
+         &         cpname, __LINE__ )
+      zsca = 1.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, 'scale_factor') &
+         &                        == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                       'scale_factor',zsca), cpname, __LINE__ )
+      ENDIF
+      zfill = 0.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, '_FillValue') &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     '_FillValue',zfill), cpname,  __LINE__ )
+      ENDIF
+      WHERE(zsla(:,:) /=  zfill)
+         zsla(:,:) = zsca * zsla(:,:)
+      ELSEWHERE
+         zsla(:,:) = fbrmdi
+      END WHERE
+      
+      ! Get the global Mission netCDF attribute
+      
+      cmission='   '
+      CALL chkerr( nf90_inquire_attribute( i_file_id, nf90_global, &
+         &                                 'Mission', len = iilen,  &
+         &                                 xtype = itype), cpname, __LINE__ )
+      IF (( itype /= NF90_CHAR ) .OR. ( iilen > 3 )) THEN
+         CALL fatal_error('Error decoding Mission global attribute', __LINE__ )
+      ENDIF
+      CALL chkerr( nf90_get_att( i_file_id, nf90_global, 'Mission', &
+         &                       cmission ), cpname, __LINE__ )
+      
+      ! Convert it to an integer
+      imission = 0
+      DO jm = 1, imaxmissions
+         IF (cmission==cmissions(jm)) THEN
+            imission = jm
+            EXIT
+         ENDIF
+      END DO
+      
+      ! Close the file
+      
+      CALL chkerr( nf90_close( i_file_id ), cpname, __LINE__ )
+
+      ! Compute Julian dates for all observations
+      
+      jm = 0
+      jl = 0
+      DO jj = 1, itracks
+         DO ji = 1, ipnbpoints(jj)
+            jl = jl + 1
+            DO jk = 1, icycles
+               jm = jm + 1
+               IF (zbegindates(jk,jj)==zbeginmiss) THEN
+                  llskip(jm) = .TRUE.
+                  zjuld(jm)  = fbrmdi
+               ELSE
+                  llskip(jm) = .FALSE.
+                  zjuld(jm)  = zbegindates(jk,jj) + &
+                     &         (ipdataindexes(jl) * zdeltat / 86400._wp )
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      ! Get rid of missing data
+
+      jm = 0
+      DO jobs = 1, idata
+         DO jcycle = 1, icycles
+            jm = jm + 1
+            IF (zsla(jcycle,jobs) == fbrmdi) llskip(jm) = .TRUE.
+         END DO
+      END DO
+      
+      ! Allocate obfbdata
+
+      iobs = COUNT( .NOT.llskip(:) )
+      CALL init_obfbdata( inpfile )
+      CALL alloc_obfbdata( inpfile, 1, iobs, 1, 0, 0, ldgrid )
+      inpfile%cname(1) = 'SLA'
+
+      ! Fill the obfbdata structure from input data
+
+      inpfile%cdjuldref = cdjuldref
+      iobs = 0
+      jm = 0
+      DO jobs = 1, idata
+         DO jcycle = 1, icycles
+            jm = jm + 1
+            IF (llskip(jm)) CYCLE
+            iobs = iobs + 1
+            ! Characters
+            WRITE(inpfile%cdwmo(iobs),'(A3,A5)') cmissions(imission), '     '
+            WRITE(inpfile%cdtyp(iobs),'(I4)') imission
+            ! Real values
+            inpfile%plam(iobs)         = zlam(jobs)
+            inpfile%pphi(iobs)         = zphi(jobs)
+            inpfile%pob(1,iobs,1)      = zsla(jcycle,jobs)
+            inpfile%ptim(iobs)         = zjuld(jm)
+            inpfile%pdep(1,iobs)       = 0.0
+            ! Integers
+            inpfile%kindex(iobs)       = iobs
+            inpfile%ioqc(iobs)      = 1
+            inpfile%ivqc(iobs,1)    = 1
+            inpfile%ivlqc(1,iobs,1) = 1
+            inpfile%ipqc(iobs)         = 0 
+            inpfile%ipqcf(:,iobs)      = 0
+            inpfile%itqc(iobs)         = 0
+            inpfile%itqcf(:,iobs)      = 0
+            inpfile%ivqcf(:,iobs,1)    = 0
+            inpfile%ioqcf(:,iobs)      = 0
+            inpfile%idqc(1,iobs)       = 0
+            inpfile%idqcf(1,1,iobs)    = 0
+            inpfile%ivlqcf(:,1,iobs,1) = 0
+         END DO
+      END DO
+
+
+      ! Deallocate memory for input data
+
+      DEALLOCATE( &
+         & iptracks,      &
+         & ipnbpoints,    &
+         & ipcycles,      &
+         & zphi,          &
+         & zlam,          &  
+         & zbegindates,   &
+         & ipdataindexes, &
+         & zsla,          &
+         & zjuld,         &
+         & llskip         &
+         & )
+
+   END SUBROUTINE read_avisofile
+
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obssla_types.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obssla_types.h90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obssla_types.h90	(revision 2528)
@@ -0,0 +1,9 @@
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   INTEGER, PARAMETER :: imaxmissions=8
+   CHARACTER(len=3) :: cmissions(0:imaxmissions) = &
+      & (/ 'XXX', 'E1 ', 'E2 ', 'TP ', 'TPM', 'G2 ', 'J1 ', 'EN ', 'J2 ' /)
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obssst_io.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obssst_io.h90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obssst_io.h90	(revision 2528)
@@ -0,0 +1,286 @@
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE read_ghrsst( cdfilename, inpfile, kunit, ldwp, ldgrid )
+      !!---------------------------------------------------------------------
+      !!
+      !!                     ** ROUTINE read_ghrsst **
+      !!
+      !! ** Purpose : Read from file the GHRSST observations.
+      !!
+      !! ** Method  : The data file is a NetCDF file. 
+      !!
+      !! ** Action  :
+      !!
+      !! References : 
+      !!
+      !! History : 
+      !!          ! 09-01 (K. Mogensen) Original based on old versions
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(LEN=*) :: cdfilename ! Input filename
+      TYPE(obfbdata)   :: inpfile    ! Output obfbdata structure
+      INTEGER          :: kunit      ! Unit for output
+      LOGICAL          :: ldwp       ! Print info
+      LOGICAL          :: ldgrid     ! Save grid info in data structure
+      !! * Local declarations
+      CHARACTER(LEN=12),PARAMETER :: cpname = 'read_ghrsst'
+      INTEGER :: i_file_id        ! netcdf IDS
+      INTEGER :: i_time_id
+      INTEGER :: i_ni_id
+      INTEGER :: i_data_id
+      INTEGER :: i_var_id
+      INTEGER :: i_data           ! Number of data per parameter in current file
+      INTEGER :: i_time           ! Number of reference times in file
+      INTEGER, DIMENSION(:), POINTER :: &
+         & i_reftime        ! Reference time in file in seconds since 1/1/1981.
+      INTEGER, DIMENSION(:,:), POINTER :: &
+         & i_dtime, &       ! Offset in seconds since reference time
+         & i_qc,    &       ! Quality control flag.
+         & i_type           ! Type of SST measurement.            
+      REAL(wp), DIMENSION(:), POINTER :: &
+         & z_phi,   &       ! Latitudes
+         & z_lam            ! Longitudes
+      REAL(wp), DIMENSION(:,:), POINTER :: &
+         & z_sst            ! SST data     
+      INTEGER, PARAMETER :: imaxdim = 2      ! Assumed maximum for no. dims. in file
+      INTEGER, DIMENSION(2) :: idims         ! Dimensions in file
+      INTEGER :: iilen            ! Length of netCDF attributes
+      INTEGER :: itype            ! Typeof netCDF attributes
+      REAL(KIND=wp) :: zsca           ! Scale factor
+      REAL(KIND=wp) :: zoff           ! Offset for data in netcdf file
+      REAL(KIND=wp) :: z_offset       ! Offset for time conversion
+      REAL(KIND=wp) :: zfill          ! Fill value in netcdf file
+      CHARACTER (len=33) :: creftime  ! Reference time of file
+      INTEGER :: i_refyear            ! Integer version of reference time
+      INTEGER :: i_refmonth
+      INTEGER :: i_refday
+      INTEGER :: i_refhour
+      INTEGER :: i_refmin
+      INTEGER :: i_refsec
+      INTEGER :: ichunk
+      INTEGER :: jtim
+      INTEGER :: jobs
+      INTEGER :: iobs
+
+      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, &
+         &                i_file_id, chunksize=ichunk), cpname, __LINE__ )
+      
+      ! Get the netCDF dimensions
+      
+      CALL chkerr( nf90_inq_dimid( i_file_id, 'time', i_time_id ),  &
+         &       cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_time_id, &
+         &                              len = i_time ),  &
+         &      cpname, __LINE__ )
+      
+      CALL chkerr( nf90_inq_dimid( i_file_id, 'ni', i_ni_id ),  &
+         &       cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_ni_id, &
+         &                              len = i_data ),  &
+         &      cpname, __LINE__ )
+      
+      
+      ! Allocate NetCDF variables
+      
+      ALLOCATE( &
+         & i_reftime    ( i_time                 ), &
+         & i_dtime      ( i_data,i_time  ), &      
+         & i_qc         ( i_data,i_time  ), & 
+         & i_type       ( i_data,i_time  ), &     
+         & z_phi        ( i_data                 ), &   
+         & z_lam        ( i_data                 ), &  
+         & z_sst        ( i_data,i_time  )  &
+         & )
+      
+      ! Get reference time of file which is in seconds since 1981/1/1 00:00. 
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'time', i_var_id ), & 
+         &       cpname, __LINE__ )
+      idims(1) = i_time
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_reftime),&
+         &       cpname, __LINE__ )
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "units") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "units",creftime), cpname,  __LINE__ )
+      ELSE
+         creftime = "seconds since 1981-01-01 00:00:00"
+      ENDIF
+      READ(creftime(15:18),*)i_refyear
+      READ(creftime(20:21),*)i_refmonth
+      READ(creftime(23:24),*)i_refday
+      READ(creftime(26:27),*)i_refhour
+      READ(creftime(29:30),*)i_refmin
+      READ(creftime(32:33),*)i_refsec
+      !Work out offset in days between reference time and 1/1/1950.
+      CALL greg2jul( i_refsec, i_refmin, i_refhour, i_refday, &
+         &           i_refmonth, i_refyear, z_offset)
+      
+      ! Get list of times for each ob in seconds relative to reference time
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'sst_dtime', i_var_id ), & 
+         &       cpname, __LINE__ )
+      idims(1) = i_data
+      idims(2) = i_time
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_dtime),&
+         &       cpname, __LINE__ )
+      zsca = 1.0      
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "scale_factor",zsca), cpname,  __LINE__ )
+      ENDIF
+      zoff = 0.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "add_offset") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "add_offset",zoff), cpname,  __LINE__ )
+      ENDIF
+      i_dtime(:,:) = NINT((zsca * FLOAT(i_dtime(:,:))) &
+         &                 + zoff)
+      
+      ! Get longitudes
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'lon', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = i_data
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_lam),   &
+         &         cpname, __LINE__ )
+      
+      ! Get latitudes
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'lat', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = i_data
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_phi),   &
+         &         cpname, __LINE__ )
+      
+      ! Get SST data
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'sea_surface_temperature', &
+         &                         i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = i_data
+      idims(2) = i_time
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_sst), &
+         &       cpname, __LINE__ )
+      zoff = 0.
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "scale_factor",zsca), cpname, __LINE__ )
+      ENDIF
+      zsca = 1.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
+         &                       == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                       "scale_factor",zsca), cpname, __LINE__ )
+      ENDIF
+      zfill = 0.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "_FillValue") &
+         &                       == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                       "_FillValue",zfill), cpname, __LINE__ )
+      ENDIF
+      WHERE(z_sst(:,:) /=  zfill)
+         z_sst(:,:) = (zsca * z_sst(:,:)) + zoff
+      ELSEWHERE
+         z_sst(:,:) = fbrmdi
+      END WHERE
+      
+      ! Get QC flag
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'confidence_flag', i_var_id ), & 
+         &       cpname, __LINE__ )
+      idims(1) = i_data
+      idims(2) = i_time
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_qc),   &
+            &       cpname, __LINE__ )
+      
+      ! Get SST obs type
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'data_source', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = i_data
+      idims(2) = i_time
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_type),   &
+         &       cpname, __LINE__ )
+      
+      ! Close the file
+      
+      CALL chkerr( nf90_close( i_file_id ), cpname, __LINE__ )
+
+      ! Fill the obfbdata structure
+
+      ! Allocate obfbdata
+      
+      iobs = i_data * i_time
+      CALL init_obfbdata( inpfile )
+      CALL alloc_obfbdata( inpfile, 1, iobs, 1, 0, 0, ldgrid )
+      inpfile%cname(1) = 'SST'
+
+      ! Fill the obfbdata structure from input data
+
+      inpfile%cdjuldref = "19500101000000"
+      iobs = 0
+      DO jtim = 1, i_time
+         DO jobs = 1, i_data
+            iobs = iobs + 1
+            ! Characters
+            WRITE(inpfile%cdwmo(iobs),'(A6,A2)') 'ghrsst','  '
+            WRITE(inpfile%cdtyp(iobs),'(I4)') i_type(jobs,jtim)
+            ! Real values
+            inpfile%plam(iobs)         = z_lam(jobs)
+            inpfile%pphi(iobs)         = z_phi(jobs)
+            inpfile%pob(1,iobs,1)      = z_sst(jobs,jtim)
+            inpfile%ptim(iobs)         = &
+               & REAL(i_reftime(jtim))/(60.*60.*24.) + &
+               & z_offset + REAL(i_dtime(jobs,jtim))/(60.*60.*24.)
+            inpfile%pdep(1,iobs)       = 0.0
+            ! Integers
+            inpfile%kindex(iobs)       = iobs
+            IF ( z_sst(jobs,jtim) == fbrmdi ) THEN
+               inpfile%ioqc(iobs)      = 4
+               inpfile%ivqc(iobs,1)    = 4 
+               inpfile%ivlqc(1,iobs,1) = 4
+            ELSE 
+               inpfile%ioqc(iobs)      = i_qc(jobs,jtim)
+               inpfile%ivqc(iobs,1)    = i_qc(jobs,jtim)
+               inpfile%ivlqc(1,iobs,1) = 1
+            ENDIF
+            inpfile%ipqc(iobs)         = 0 
+            inpfile%ipqcf(:,iobs)      = 0
+            inpfile%itqc(iobs)         = 0
+            inpfile%itqcf(:,iobs)      = 0
+            inpfile%ivqcf(:,iobs,1)    = 0
+            inpfile%ioqcf(:,iobs)      = 0
+            inpfile%idqc(1,iobs)       = 0
+            inpfile%idqcf(1,1,iobs)    = 0
+            inpfile%ivlqcf(:,1,iobs,1) = 0
+         END DO
+      END DO
+
+      DEALLOCATE( &
+         & i_reftime, &
+         & i_dtime,   &
+         & i_qc,      &
+         & i_type,    &
+         & z_phi,     &
+         & z_lam,     &
+         & z_sst      &
+         & )
+
+   END SUBROUTINE read_ghrsst
+
+
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obsvel_io.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obsvel_io.h90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/obsvel_io.h90	(revision 2528)
@@ -0,0 +1,360 @@
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE read_taondbc( cdfilename, inpfile, kunit, ldwp, ldgrid )
+      !!---------------------------------------------------------------------
+      !!
+      !!                     ** ROUTINE read_enactfile **
+      !!
+      !! ** Purpose : Read from file the TAO data fro NDBC.
+      !!
+      !! ** Method  : The data file is a NetCDF file. 
+      !!
+      !! ** Action  :
+      !!
+      !! ** Reference : http://tao.noaa.gov/tao/data_deliv/deliv_ndbc.shtml
+      !! History : 
+      !!          ! 09-01 (K. Mogensen) Original version.
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(LEN=*) :: cdfilename ! Input filename
+      TYPE(obfbdata)   :: inpfile    ! Output obfbdata structure
+      INTEGER          :: kunit      ! Unit for output
+      LOGICAL          :: ldwp       ! Print info
+      LOGICAL          :: ldgrid     ! Save grid info in data structure
+      !! * Local declarations
+      INTEGER :: iobs                ! Number of observations
+      INTEGER :: ilev                ! Number of levels
+      INTEGER :: ilat                ! Number of latitudes
+      INTEGER :: ilon                ! Number of longtudes
+      INTEGER :: itim                ! Number of obs. times
+      INTEGER :: i_file_id
+      INTEGER :: i_dimid_id
+      INTEGER :: i_phi_id
+      INTEGER :: i_lam_id
+      INTEGER :: i_depth_id
+      INTEGER :: i_var_id
+      INTEGER :: i_time_id
+      INTEGER :: i_time2_id
+      INTEGER :: i_qc_var_id
+      CHARACTER(LEN=40) :: cl_fld_lam
+      CHARACTER(LEN=40) :: cl_fld_phi
+      CHARACTER(LEN=40) :: cl_fld_depth
+      CHARACTER(LEN=40) :: cl_fld_var_u
+      CHARACTER(LEN=40) :: cl_fld_var_v
+      CHARACTER(LEN=40) :: cl_fld_var_qc_uv1
+      CHARACTER(LEN=40) :: cl_fld_var_qc_uv2
+      CHARACTER(LEN=40) :: cl_fld_time
+      CHARACTER(LEN=40) :: cl_fld_time2
+      INTEGER :: ja
+      INTEGER :: jo
+      INTEGER :: jk
+      INTEGER :: jt
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: &
+         & zv,     &
+         & zu,     &
+         & zuv1qc, &
+         & zuv2qc
+      REAL(wp), ALLOCATABLE, DIMENSION(:) :: &
+         & zdep, &
+         & zlat, &
+         & zlon, &
+         & zjuld
+      REAL(wp) :: zl
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: &
+         & itime, &
+         & itime2
+      CHARACTER(LEN=50) :: cdjulref
+      CHARACTER(LEN=12), PARAMETER :: cl_name = 'read_taondbc'
+      CHARACTER(len=1) :: cns, cew
+
+      !-----------------------------------------------------------------------
+      ! Initialization
+      !-----------------------------------------------------------------------
+      cl_fld_lam                 = 'lon'
+      cl_fld_phi                 = 'lat'
+      cl_fld_depth               = 'depth'
+      cl_fld_time                = 'time'
+      cl_fld_time2               = 'time2'
+
+      !-----------------------------------------------------------------------
+      ! Open file
+      !-----------------------------------------------------------------------
+
+      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, &
+            &      i_file_id ),           cl_name, __LINE__ )
+
+      !-----------------------------------------------------------------------
+      ! Read the heading of the file
+      !-----------------------------------------------------------------------
+      IF(ldwp) WRITE(kunit,*)
+      IF(ldwp) WRITE(kunit,*) ' read_taondbc :' 
+      IF(ldwp) WRITE(kunit,*) ' ~~~~~~~~~~~~'
+      
+      !---------------------------------------------------------------------
+      ! Read the number of observations and of levels to allocate array
+      !---------------------------------------------------------------------
+      CALL chkerr( nf90_inq_dimid        ( i_file_id, 'time', i_dimid_id ),        &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_dimid_id, len = itim ),    &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inq_dimid        ( i_file_id, 'depth', i_dimid_id ),       &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_dimid_id, len = ilev ),    &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inq_dimid        ( i_file_id, 'lat', i_dimid_id ),           &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_dimid_id, len = ilat ),    &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inq_dimid        ( i_file_id, 'lon', i_dimid_id ),         &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_dimid_id, len = ilon ),    &
+         &         cl_name, __LINE__ ) 
+
+      iobs = itim * ilat * ilon
+      IF(ldwp)WRITE(kunit,*) '         No. of data records = ', iobs
+      IF(ldwp)WRITE(kunit,*) '         No. of levels       = ', ilev
+      IF(ldwp)WRITE(kunit,*) 
+
+      !---------------------------------------------------------------------
+      ! Allocate arrays
+      !---------------------------------------------------------------------
+
+      CALL init_obfbdata( inpfile )
+      CALL alloc_obfbdata( inpfile, 2, iobs, ilev, 0, 0, ldgrid )
+      inpfile%cname(1) = 'UVEL'
+      inpfile%cname(2) = 'VVEL'
+      inpfile%coblong(1) = 'Zonal current'
+      inpfile%coblong(2) = 'Meridional current'
+      inpfile%cobunit(1) = 'Meters per second'
+      inpfile%cobunit(2) = 'Meters per second'
+
+      ALLOCATE( &
+         & zu(ilon,ilat,ilev,itim),     &
+         & zv(ilon,ilat,ilev,itim),     &
+         & zdep(ilev),                  &
+         & zuv1qc(ilon,ilat,ilev,itim), &
+         & zuv2qc(ilon,ilat,ilev,itim), &
+         & itime(itim),                 &
+         & itime2(itim),                &
+         & zlat(ilat),                  &
+         & zlon(ilon),                  &
+         & zjuld(itim)                  &
+         & )
+
+      !---------------------------------------------------------------------
+      ! Read the time/position variables 
+      !---------------------------------------------------------------------
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_time, i_time_id ),                               &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_time_id, itime ),                                     &
+         &         cl_name, __LINE__ )
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_time2, i_time2_id ),                             &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_time2_id, itime2 ),                                   &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_depth, i_depth_id ),                             &
+            &         cl_name, __LINE__ )         
+      CALL chkerr( nf90_get_var  ( i_file_id, i_depth_id, zdep ),                                     &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_phi, i_phi_id ),                                 &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_phi_id, zlat ),                                       &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_lam, i_lam_id ),                                 &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_lam_id, zlon ),                                       &
+         &         cl_name, __LINE__ )
+      
+      !---------------------------------------------------------------------
+      ! Read the variables
+      !---------------------------------------------------------------------
+
+      ! ADCP format assumed
+      cl_fld_var_u = 'u_1205'
+      IF ( nf90_inq_varid( i_file_id, cl_fld_var_u, i_var_id ) /= nf90_noerr ) THEN
+         ! Try again with current meter format
+         cl_fld_var_u = 'U_320'
+         IF ( nf90_inq_varid( i_file_id, cl_fld_var_u, i_var_id ) /= nf90_noerr ) THEN
+            CALL fatal_error( 'Unknown format in read_taondbc', __LINE__ )
+         ENDIF
+      ENDIF
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zu ),                                         &
+         &         cl_name, __LINE__ )
+      
+      ! ADCP format assumed
+      cl_fld_var_v = 'v_1206'
+      IF ( nf90_inq_varid( i_file_id, cl_fld_var_v, i_var_id ) /= nf90_noerr ) THEN
+         ! Try again with current meter format
+         cl_fld_var_v = 'V_321'
+         IF ( nf90_inq_varid( i_file_id, cl_fld_var_v, i_var_id ) /= nf90_noerr ) THEN
+            CALL fatal_error( 'Unknown format in read_taondbc', __LINE__ )
+         ENDIF
+      ENDIF
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zv ),                                         &
+         &         cl_name, __LINE__ )
+
+      !---------------------------------------------------------------------
+      ! Read the QC attributes
+      !---------------------------------------------------------------------
+      
+      ! ADCP format assumed
+      cl_fld_var_qc_uv1 = 'QU_5205'
+      IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_uv1, i_qc_var_id ) /= nf90_noerr ) THEN
+         ! Try again with current meter format
+         cl_fld_var_qc_uv1 = 'QCS_5300'
+         IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_uv1, i_qc_var_id ) /= nf90_noerr ) THEN
+            ! Try again with high freq. current meter format
+            cl_fld_var_qc_uv1 = 'QCU_5320'
+            IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_uv1, i_qc_var_id ) /= nf90_noerr ) THEN
+               CALL fatal_error( 'Unknown format in read_taondbc', __LINE__ )
+            ENDIF
+         ENDIF
+      ENDIF
+      CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, zuv1qc),                                   &
+         &         cl_name, __LINE__ )
+
+      ! ADCP format assumed
+      cl_fld_var_qc_uv2 = 'QV_5206'
+      IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_uv2, i_qc_var_id ) /= nf90_noerr ) THEN
+         ! Try again with current meter format
+         cl_fld_var_qc_uv2 = 'QCD_5310'
+         IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_uv2, i_qc_var_id ) /= nf90_noerr ) THEN
+            ! Try again with high freq. current meter format
+            cl_fld_var_qc_uv2 = 'QCV_5321'
+            IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_uv2, i_qc_var_id ) /= nf90_noerr ) THEN
+               CALL fatal_error( 'Unknown format in read_taondbc', __LINE__ )
+            ENDIF
+         ENDIF
+      ENDIF
+      CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, zuv2qc),                                   &
+         &         cl_name, __LINE__ )
+
+      !---------------------------------------------------------------------
+      ! Close file
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_close( i_file_id ),           cl_name, __LINE__ )
+
+      !---------------------------------------------------------------------
+      ! Convert to to 19500101 based Julian date
+      !---------------------------------------------------------------------
+      DO jt = 1, itim
+         zjuld(jt) = REAL(itime(jt),wp) + REAL(itime2(jt),wp)/86400000.0_wp &
+            &           - 2433283.0_wp
+      END DO
+      inpfile%cdjuldref = '19500101000000'
+
+      !---------------------------------------------------------------------
+      ! Copy info to obfbdata structure
+      !---------------------------------------------------------------------
+
+      iobs = 0
+      DO jt = 1, itim
+         DO ja = 1, ilat
+            DO jo = 1, ilon
+               iobs = iobs + 1
+               zl = zlon(jo)
+               IF ( zl > 180.0_wp ) zl = zl - 360.0_wp
+               IF ( zl < 0 ) THEN
+                  cew = 'w'
+               ELSE
+                  cew = 'e'
+               ENDIF
+               IF ( zlat(jo) < 0 ) THEN
+                  cns = 's'
+               ELSE
+                  cns = 'n'
+               ENDIF
+               WRITE(inpfile%cdwmo(iobs),'(A1,I2.2,A1,I3.3)') &
+                  & cns, ABS(NINT(zlat(ja))), cew, ABS(NINT(zl))
+               DO jk = 1, ilev
+                  inpfile%pob(jk,iobs,1)     = zu(jo,ja,jk,jt)
+                  inpfile%pob(jk,iobs,2)     = zv(jo,ja,jk,jt)
+                  inpfile%pdep(jk,iobs)      = zdep(jk)
+                  inpfile%ivlqc(jk,iobs,1:2) = INT( MAX( zuv1qc(jo,ja,jk,jt), zuv2qc(jo,ja,jk,jt) ) )
+               END DO
+               inpfile%plam(iobs) = zlon(jo)
+               inpfile%pphi(iobs) = zlat(ja)
+               inpfile%ptim(iobs) = zjuld(jt)
+            END DO
+         END DO
+      END DO
+
+      ! No position, time, depth and variable QC in input files
+      DO jo = 1, iobs
+         inpfile%ipqc(jo) = 1
+         inpfile%itqc(jo) = 1
+         inpfile%ivqc(jo,1:2) = 1
+         DO jk = 1, ilev
+            inpfile%idqc(jk,jo) = 1
+         END DO
+      END DO
+
+      !---------------------------------------------------------------------
+      ! Set the platform information
+      !---------------------------------------------------------------------
+      inpfile%cdtyp(:)=' 820'
+
+      !---------------------------------------------------------------------
+      ! Set QC flags for missing data and rescale to m/s
+      !---------------------------------------------------------------------
+
+      DO jo = 1, iobs
+         DO jk = 1, ilev
+            IF ( ( ABS(inpfile%pob(jk,jo,1)) > 10000.0_wp ) .OR. &
+               & ( ABS(inpfile%pob(jk,jo,2)) > 10000.0_wp ) ) THEN
+               inpfile%ivlqc(jk,jo,:) = 4
+               inpfile%pob(jk,jo,1) = fbrmdi
+               inpfile%pob(jk,jo,2) = fbrmdi
+            ELSE
+               inpfile%pob(jk,jo,1) = 0.01 * inpfile%pob(jk,jo,1)
+               inpfile%pob(jk,jo,2) = 0.01 * inpfile%pob(jk,jo,2)
+            ENDIF
+         END DO
+      END DO
+
+      !---------------------------------------------------------------------
+      ! Set file indexes
+      !---------------------------------------------------------------------
+
+      DO jo = 1, inpfile%nobs
+         inpfile%kindex(jo) = jo
+      END DO
+
+      !---------------------------------------------------------------------
+      ! Initialize flags since they are not in the TAO input files
+      !---------------------------------------------------------------------
+
+      inpfile%ioqcf(:,:)      = 0
+      inpfile%ipqcf(:,:)      = 0
+      inpfile%itqcf(:,:)      = 0
+      inpfile%idqcf(:,:,:)    = 0
+      inpfile%ivqcf(:,:,:)    = 0
+      inpfile%ivlqcf(:,:,:,:) = 0
+
+      !---------------------------------------------------------------------
+      ! Deallocate data
+      !---------------------------------------------------------------------
+      DEALLOCATE( &
+         & zu,     &
+         & zv,     &
+         & zdep,   &
+         & zuv1qc, &
+         & zuv2qc, &
+         & itime,  &
+         & itime2, &
+         & zlat,   &
+         & zlon,   &
+         & zjuld   &
+         & )
+
+   END SUBROUTINE read_taondbc
Index: trunk/NEMOGCM/NEMO/OPA_SRC/OBS/str_c_to_for.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/OBS/str_c_to_for.h90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/OBS/str_c_to_for.h90	(revision 2528)
@@ -0,0 +1,39 @@
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE str_c_to_for( cd_str )
+      !!---------------------------------------------------------------------
+      !!   
+      !!                     *** ROUTINE str_c_to_for ***
+      !! 
+      !! ** Purpose : Loop over a string and replace all non-printable
+      !!              ASCII characters with spaces assuming English 
+      !!              characters only
+      !!
+      !! ** Method  : Loop over a string and replace all non-printable
+      !!              ASCII characters with spaces assuming English 
+      !!              characters only
+      !!
+      !! ** Action  : 
+      !! 
+      !! History :  
+      !!        ! : 06-05 (K. Mogensen) Original
+      !!        ! : 06-05 (A. Vidard) Cleaning up
+      !!        ! : 06-10 (A. Weaver) More cleaning
+      !!---------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(LEN=*), INTENT(INOUT) :: cd_str
+
+      !! * Local declarations
+      INTEGER :: &
+         & ji
+
+      DO ji = 1, LEN( cd_str )
+         IF (     ( IACHAR( cd_str(ji:ji) ) > 128 ) &
+            & .OR.( IACHAR( cd_str(ji:ji) ) < 32  ) ) cd_str(ji:ji) = ' '
+      END DO
+
+   END SUBROUTINE str_c_to_for
Index: trunk/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90	(revision 2528)
@@ -45,7 +45,7 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 9.0 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90	(revision 2528)
@@ -29,4 +29,5 @@
    USE mod_prism_put_proto          ! OASIS3 prism module for snding
    USE mod_prism_get_proto          ! OASIS3 prism module for receiving
+   USE mod_comprism_proto           ! OASIS3 prism module to get coupling frequency
    USE par_oce                      ! ocean parameters
    USE dom_oce                      ! ocean space and time domain
@@ -61,10 +62,11 @@
    PUBLIC cpl_prism_snd
    PUBLIC cpl_prism_rcv
+   PUBLIC cpl_prism_freq
    PUBLIC cpl_prism_finalize
 
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2006) 
-   !! $Header$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -210,5 +212,5 @@
       !! * Arguments
       !!
-      INTEGER,                      INTENT( IN    )   :: kid       ! variable intex in the array
+      INTEGER,                      INTENT( IN    )   :: kid       ! variable index in the array
       INTEGER,                      INTENT(   OUT )   :: kinfo     ! OASIS3 info argument
       INTEGER,                      INTENT( IN    )   :: kstep     ! ocean time-step in seconds
@@ -247,5 +249,5 @@
       !!      like stresses and fluxes from the coupler or remote application.
       !!----------------------------------------------------------------------
-      INTEGER,                      INTENT( IN    )   :: kid       ! variable intex in the array
+      INTEGER,                      INTENT( IN    )   :: kid       ! variable index in the array
       INTEGER,                      INTENT( IN    )   :: kstep     ! ocean time-step in seconds
       REAL(wp), DIMENSION(jpi,jpj), INTENT( INOUT )   :: pdata     ! IN to keep the value if nothing is done
@@ -293,4 +295,18 @@
 
 
+   FUNCTION cpl_prism_freq( kid )  
+
+      !!---------------------------------------------------------------------
+      !!              ***  ROUTINE cpl_prism_freq  ***
+      !!
+      !! ** Purpose : - send back the coupling frequency for a particular field
+      !!----------------------------------------------------------------------
+      INTEGER,INTENT( IN )   :: kid              ! variable index 
+      INTEGER                :: cpl_prism_freq   ! coupling frequency
+      cpl_prism_freq = ig_def_freq( kid )
+
+   END FUNCTION cpl_prism_freq
+
+
    SUBROUTINE cpl_prism_finalize
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis4.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis4.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis4.F90	(revision 2528)
@@ -1,7 +1,6 @@
 MODULE cpl_oasis4
    !!======================================================================
-   !!                    ***  MODULE cpl_oasis4  ***
+   !!                    ***  MODULE cpl_oasis  ***
    !! Coupled O/A : coupled ocean-atmosphere case using OASIS4
-   !!               special case: OPA/LIM coupled to ECHAM5
    !!=====================================================================
    !! History :   
@@ -11,113 +10,65 @@
    !!   " "  !  05-08  (R. Redler, W. Park) frld initialization, paral(2) revision
    !!   " "  !  05-09  (R. Redler) extended to allow for communication over root only
-   !!   " "  !  05-09  (R. Redler) extended to allow for communication over root only
-   !!   " "  !  05-12  (R. Hill, Met. Office) Tweaks and hacks to get NEMO/O4 working
-   !!   " "  !  06-02  (R. Redler, W. Park) Bug fixes and updates according to the OASIS3 interface
-   !!   " "  !  06-02  (R. Redler) app/grid/grid_name from namelist
+   !!   " "  !  06-01  (W. Park) modification of physical part
+   !!   " "  !  06-02  (R. Redler, W. Park) buffer array fix for root exchange
+   !!   " "  !  2010   (E. Maisonnave and S. Masson) complete rewrite
    !!----------------------------------------------------------------------
 #if defined key_oasis4
    !!----------------------------------------------------------------------
    !!   'key_oasis4'                    coupled Ocean/Atmosphere via OASIS4
+   !!----------------------------------------------------------------------
    !!----------------------------------------------------------------------
    !!   cpl_prism_init     : initialization of coupled mode communication
    !!   cpl_prism_define   : definition of grid and fields
-   !!   cpl_prism_send     : send out fields in coupled mode
-   !!   cpl_prism_recv     : receive fields in coupled mode
+   !!   cpl_prism_snd     : snd out fields in coupled mode
+   !!   cpl_prism_rcv     : receive fields in coupled mode
+   !!   cpl_prism_update_time   : update date sent to Oasis
    !!   cpl_prism_finalize : finalize the coupled mode communication
    !!----------------------------------------------------------------------
-   !! * Modules used
-!##################### WARNING coupled mode ###############################
-!##################### WARNING coupled mode ###############################
-!   Following line must be enabled if coupling with OASIS
-!   USE prism                        ! prism module
-!##################### WARNING coupled mode ###############################
-!##################### WARNING coupled mode ###############################
-#if defined key_mpp_mpi
-   USE lib_mpp, only : mppsize, mpprank   ! message passing
-   USE lib_mpp, only : mppsend            ! message passing
-   USE lib_mpp, only : mpprecv            ! message passing
-#endif
+   USE prism              ! OASIS4 prism module
+   USE par_oce                      ! ocean parameters
    USE dom_oce                      ! ocean space and time domain
+   USE domwri                       ! ocean space and time domain
    USE in_out_manager               ! I/O manager
-   USE par_oce                      !
-   USE phycst, only : rt0           ! freezing point of sea water
-   USE oasis4_date                  ! OASIS4 date declarations in
-                                    ! PRISM compatible format
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+
    IMPLICIT NONE
+   PRIVATE
 !
-! Exchange parameters for coupling ORCA-LIM with ECHAM5
-!
-#if defined key_cpl_ocevel
-   INTEGER, PARAMETER         :: nsend =  6
-#else
-   INTEGER, PARAMETER         :: nsend =  4
-#endif
-
-#if defined key_cpl_discharge
-   INTEGER, PARAMETER         :: nrecv = 20
-#else
-   INTEGER, PARAMETER         :: nrecv = 17
-#endif
-
-   INTEGER, DIMENSION(nsend)  :: send_id
-   INTEGER, DIMENSION(nrecv)  :: recv_id
-
-   CHARACTER(len=32)          :: cpl_send (nsend)
-   CHARACTER(len=32)          :: cpl_recv (nrecv)
-
-   CHARACTER(len=16)          :: app_name       ! application name for OASIS use
-   CHARACTER(len=16)          :: comp_name      ! name of this PRISM component
-   CHARACTER(len=16)          :: grid_name      ! name of the grid
-   CHARACTER(len=1)           :: c_mpi_send
-
-! The following now come in via new module oasis4_date
-!   TYPE(PRISM_Time_struct), PUBLIC    :: dates          ! date info for send operation
-!   TYPE(PRISM_Time_struct), PUBLIC    :: dates_bound(2) ! date info for send operation
-!   TYPE(PRISM_Time_struct), PUBLIC    :: dater          ! date info for receive operation
-!   TYPE(PRISM_Time_struct), PUBLIC    :: dater_bound(2) ! date info for receive operation
-!   TYPE(PRISM_Time_struct), PUBLIC    :: tmpdate
-
-   PRIVATE
-
-   INTEGER, PARAMETER         :: localRoot  = 0
-
-   INTEGER                    :: localRank      ! local MPI rank
-   INTEGER                    :: localSize      ! local MPI size
-   INTEGER                    :: localComm      ! local MPI size
-   LOGICAL                    :: commRank       ! true for ranks doing OASIS communication
-   INTEGER                    :: comp_id        ! id returned by prism_init_comp
-
-   INTEGER                    :: range(5)
-
-   LOGICAL, SAVE              :: prism_was_initialized
-   LOGICAL, SAVE              :: prism_was_terminated
-   INTEGER, SAVE              :: write_grid
-
-   INTEGER                    :: ierror         ! return error code
-
-#ifdef key_cpl_rootexchg
-   LOGICAL                               :: rootexchg =.true.     ! logical switch 
-#else
-   LOGICAL                               :: rootexchg =.false.    ! logical switch
-#endif
-
-   REAL(wp), DIMENSION(:,:), ALLOCATABLE :: exfld  ! Temporary buffer for exchange
-   REAL(wp), DIMENSION(:),   ALLOCATABLE :: buffer ! Temporary buffer for exchange
-   INTEGER, DIMENSION(:,:),  ALLOCATABLE :: ranges ! Temporary buffer for exchange
-
-   DOUBLE PRECISION           :: date_incr
+!   LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .TRUE.    ! coupled flag
+   INTEGER                    :: ncomp_id           ! id returned by prism_init_comp
+   INTEGER                    :: nerror             ! return error code
+   INTEGER, PUBLIC            :: OASIS_Rcv  = 1     ! return code if received field
+   INTEGER, PUBLIC            :: OASIS_idle = 0     ! return code if nothing done by oasis
+
+   INTEGER, PARAMETER :: nmaxfld=40    ! Maximum number of coupling fields
+   
+   TYPE, PUBLIC ::   FLD_CPL            ! Type for coupling field information
+      LOGICAL            ::   laction   ! To be coupled or not
+      CHARACTER(len = 8) ::   clname    ! Name of the coupling field   
+      CHARACTER(len = 1) ::   clgrid    ! Grid type  
+      REAL(wp)           ::   nsgn      ! Control of the sign change
+      INTEGER            ::   nid       ! Id of the field
+   END TYPE FLD_CPL
+
+   TYPE(FLD_CPL), DIMENSION(nmaxfld), PUBLIC :: srcv, ssnd   ! Coupling fields
+
+   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: exfld  ! Temporary buffer for receiving
+
+   TYPE(PRISM_Time_struct), PUBLIC    :: date            ! date info for send operation
+   TYPE(PRISM_Time_struct), PUBLIC    :: date_bound(2)   ! date info for send operation
+
 
    !! Routine accessibility
    PUBLIC cpl_prism_init
    PUBLIC cpl_prism_define
-   PUBLIC cpl_prism_send
-   PUBLIC cpl_prism_recv
+   PUBLIC cpl_prism_snd
+   PUBLIC cpl_prism_rcv
+   PUBLIC cpl_prism_update_time
    PUBLIC cpl_prism_finalize
 
-   PUBLIC send_id, recv_id
-
    !!----------------------------------------------------------------------
    !!   OPA 9.0 , LOCEAN-IPSL (2006) 
-   !! $Id$
+   !! $Header$ 
    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -125,7 +76,5 @@
 CONTAINS
 
-   SUBROUTINE cpl_prism_init( localCommunicator )
-
-      IMPLICIT NONE
+   SUBROUTINE cpl_prism_init (kl_comm) 
 
       !!-------------------------------------------------------------------
@@ -137,111 +86,20 @@
       !! ** Method  :   OASIS4 MPI communication 
       !!--------------------------------------------------------------------
-      !! * Arguments
-      !!
-      INTEGER, INTENT(OUT)       :: localCommunicator
-      !!
-      !! * Local declarations
-      !!
-
-      NAMELIST/nam_mpp/ app_name, comp_name, c_mpi_send, grid_name
-
-      !!
-      !!--------------------------------------------------------------------
-      !!
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'cpl_prism_init : initialization in coupled ocean/atmosphere case'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~'
-      IF(lwp) WRITE(numout,*)
-     
-#if defined key_flx_bulk_monthly || defined key_flx_bulk_daily || defined key_flx_forced_daily
-
-#if !defined key_oasis4
-! The following is not necessarily a valid peice of checking
-
-      IF(lwp) WRITE(numout,cform_err)
-      IF(lwp) WRITE(numout,*) ' key_coupled and key_flx_bulk_* key_flx_forced_daily are incompatible'
-      nstop = nstop + 1
-
-#endif
-
-#endif
-
-      REWIND( numnam )
-      READ  ( numnam, nam_mpp )
-      REWIND( numnam )
-
-      !------------------------------------------------------------------
-      ! 1st Initialize the PRISM system for the application
-      !------------------------------------------------------------------
-
-      CALL prism_initialized (prism_was_initialized, ierror)
-      IF ( ierror /= PRISM_Success ) &
-         CALL prism_abort( comp_id, 'OPA9.0', 'cpl_prism_init: Failure in prism_initialized' )
-
-      IF ( .NOT. prism_was_initialized ) THEN
-         CALL prism_init( app_name, ierror )
-         IF ( ierror /= PRISM_Success ) &
-            CALL prism_abort(comp_id, 'OPA9.0', 'cpl_prism_init: Failure in prism_init')
-         prism_was_initialized = .true.
-      ELSE
-         call prism_abort(comp_id, 'OPA9.0', 'cpl_prism_init: Do not initialize prism twice!')
-      ENDIF
-      !
-      ! Obtain the actual dates and date bounds
-      !
-      ! date is determined by adding days since beginning of
-      !   the run to the corresponding initial date. Note that
-      !   OPA internal info about the start date of the experiment
-      !   is bypassed. Instead we rely sololy on the info provided
-      !   by the SCC.xml file. 
-      !
-      dates   = PRISM_Jobstart_date
-
-      WRITE(6,*) "PRISM JOB START DATE IS", dates
-
-      !
-      ! upper bound is determined by adding half a time step
-      !
-      tmpdate = dates
-      date_incr = rdttra(1)/2.0
-      CALL PRISM_calc_newdate ( tmpdate, date_incr, ierror )
-      dates_bound(2) = tmpdate
-      !
-      ! lower bound is determined by half distance to date from previous run
-      !
-      tmpdate   = dates
-      date_incr = ( adatrj - adatrj0 ) * 43200.0
-      CALL PRISM_calc_newdate ( tmpdate, date_incr, ierror )
-      dates_bound(1) = tmpdate
-
-      dater = dates
-      dater_bound(1) = dates_bound(1) 
-      dater_bound(2) = dates_bound(2) 
-
-      WRITE(6,*) "DATE send and rec BOUNDS",dater_bound
-      WRITE(6,*) "OTHER BITS FOR DATE",rdttra(1)
-      WRITE(6,*) "adatrj/0",adatrj,adatrj0,date_incr
+      INTEGER, INTENT(   OUT )   :: kl_comm       ! local communicator of the model
+      !
+      
+      CALL prism_init( 'nemo', nerror )
 
       !------------------------------------------------------------------
       ! 2nd Initialize the PRISM system for the component
       !------------------------------------------------------------------
-
-      CALL prism_init_comp ( comp_id, comp_name, ierror )
-      IF ( ierror /= PRISM_Success ) &
-         CALL prism_abort (comp_id, 'OPA9.0', 'cpl_prism_init: Failure in prism_init_comp')
-
-      WRITE(6,*) "COMPLETED INIT_COMP",comp_name,comp_id
-
-      !------------------------------------------------------------------
-      ! 3rd Get an MPI communicator for OPA local communication
-      !------------------------------------------------------------------
-
-      CALL prism_get_localcomm ( comp_id, localComm, ierror )
-      IF ( ierror /= PRISM_Success ) &
-         CALL prism_abort (comp_id, 'OPA9.0', 'cpl_prism_init: Failure in prism_get_localcomm' )
-
-      localCommunicator = localComm
-
-       WRITE(6,*) "COMPLETED GET_LOCALCOMM",comp_name,comp_id
+      CALL prism_init_comp( ncomp_id, 'oceanx', nerror )
+      IF( nerror /= PRISM_Success )   CALL prism_abort( ncomp_id, 'cpl_prism_init', 'Failure in prism_init_comp' )
+
+      !------------------------------------------------------------------
+      ! 3rd Get an MPI communicator fr OPA local communication
+      !------------------------------------------------------------------
+      CALL prism_get_localcomm( ncomp_id, kl_comm, nerror )
+      IF( nerror /= PRISM_Success )   CALL prism_abort( ncomp_id, 'cpl_prism_init', 'Failure in prism_get_localcomm' )
 
 
@@ -249,7 +107,5 @@
 
 
-   SUBROUTINE cpl_prism_define ()
-
-      IMPLICIT NONE
+   SUBROUTINE cpl_prism_define (krcv, ksnd)
 
       !!-------------------------------------------------------------------
@@ -261,903 +117,311 @@
       !! ** Method  :   OASIS4 MPI communication 
       !!--------------------------------------------------------------------
-      !! * Arguments
-      !!
-      !! * Local declarations
-
-      INTEGER                    :: grid_id(2)     ! id returned by prism_def_grid
-
-      INTEGER                    :: upoint_id(2), &
-                                    vpoint_id(2), &
-                                    tpoint_id(2), &
-                                    fpoint_id(2)   ! ids returned by prism_set_points
-
-      INTEGER                    :: umask_id(2), &
-                                    vmask_id(2), &
-                                    tmask_id(2), &
-                                    fmask_id(2)    ! ids returned by prism_set_mask
-
-      INTEGER                    :: grid_type      ! PRISM grid type
-
-      INTEGER                    :: shape(2,3)     ! shape of arrays passed to PSMILe
-      INTEGER                    :: nodim(2)
+      INTEGER, INTENT( IN    )   :: krcv, ksnd     ! Number of received and sent coupling fields
+      !
+      INTEGER, DIMENSION(4)      :: igrid     ! ids returned by prism_def_grid
+      INTEGER, DIMENSION(4)      :: iptid     ! ids returned by prism_set_points
+
+      INTEGER, DIMENSION(4)      :: imskid  ! ids returned by prism_set_mask
+      INTEGER, DIMENSION(4)      :: iishift     ! 
+      INTEGER, DIMENSION(4)      :: ijshift    ! 
+      INTEGER, DIMENSION(4)      :: iioff     ! 
+      INTEGER, DIMENSION(4)      :: ijoff    ! 
+      INTEGER, DIMENSION(4)      :: itmp    ! 
+      INTEGER, DIMENSION(1,3)    :: iextent    ! 
+      INTEGER, DIMENSION(1,3)    :: ioffset    ! 
+
+
+      INTEGER                    :: ishape(2,3)     ! shape of arrays passed to PSMILe
       INTEGER                    :: data_type      ! data type of transients
 
-      INTEGER                    :: nbr_corners
 
       LOGICAL                    :: new_points
       LOGICAL                    :: new_mask
-      LOGICAL                    :: mask(jpi,jpj,jpk)
-
-      INTEGER                    :: ji, jj, jk     ! local loop indicees
-
-      CHARACTER(len=32)          :: cpl_send (nsend)
-      CHARACTER(len=32)          :: cpl_recv (nrecv)
-
-      CHARACTER(len=32)          :: grid_name      ! name of the grid
-      CHARACTER(len=32)          :: point_name     ! name of the grid points
-
-      REAL(kind=wp), ALLOCATABLE :: rclon(:,:,:)
-      REAL(kind=wp), ALLOCATABLE :: rclat(:,:,:)
-      REAL(kind=wp), ALLOCATABLE :: rcz  (:,:)
-
+      LOGICAL                    :: llmask(jpi,jpj,1)
+
+      INTEGER                    :: ji, jj, jg, jc     ! local loop indicees
+      INTEGER                    :: ii,ij     ! index
+      INTEGER, DIMENSION(1)      :: ind     ! index
+
+      CHARACTER(len=32)          :: clpt_name     ! name of the grid points
+      CHARACTER(len=7)           :: cltxt 
+      CHARACTER(len=1), DIMENSION(4) :: clgrd = (/ 'T','U','V','F' /)     ! name of the grid points
+
+      REAL(kind=wp), DIMENSION(jpi,jpj,4)  :: zclo, zcla
+      REAL(kind=wp), DIMENSION(jpi,jpj  )  :: zlon, zlat
+
+      TYPE(PRISM_Time_struct)    :: tmpdate
+      INTEGER                    :: idate_incr      ! date increment
+      !!
       !!--------------------------------------------------------------------
-     
+
       IF(lwp) WRITE(numout,*)
       IF(lwp) WRITE(numout,*) 'cpl_prism_define : initialization in coupled ocean/atmosphere case'
       IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~'
       IF(lwp) WRITE(numout,*)
-     
-#if defined key_flx_bulk_monthly || defined key_flx_bulk_daily || defined key_flx_forced_daily
-
-#if !defined key_oasis4
-! The problem with the following is that it ASSUMES we're only ever coupling to an atmosphere
-! which is not necessarily the case. Prevent this test temporarily for NEMOGAM development.
-
-      IF(lwp) WRITE(numout,cform_err)
-      IF(lwp) WRITE(numout,*) ' key_coupled and key_flx_bulk_... are incompatible'
-      nstop = nstop + 1
-
-#endif
-
-#endif
-
-      ! -----------------------------------------------------------------
-      ! ... Some initialisation
-      ! -----------------------------------------------------------------
-
-      send_id = 0
-      recv_id = 0
-
-#if defined key_mpp_mpi
-
-      ! -----------------------------------------------------------------
-      ! ... Some MPI stuff relevant for optional exchange via root only
-      ! -----------------------------------------------------------------
-
-      commRank = .false.
-
-      localRank = mpprank ! from lib_mpp
-      localSize = mppsize ! from lib_mpp
-
-      IF(lwp) WRITE(numout,*) "CALLING DEFINE"
-
-      IF ( rootexchg ) THEN
-         IF ( localRank == localRoot ) commRank = .true.
-      ELSE
-         commRank = .true.
-      ENDIF
-
-#else
-      !
-      ! For non-parallel configurations the one and only process ("localRoot")
-      ! takes part in the communication
-      ! 
-      localRank = localRoot
-      commRank = .true.
-
-#endif
-
-      ! -----------------------------------------------------------------
+
+      !
       ! ... Allocate memory for data exchange
-      ! -----------------------------------------------------------------
-
-
-      IF(lwp) WRITE(numout,*) "Abbout to allocate exfld",jpi,jpj
-
-      ALLOCATE(exfld(1:jpi,1:jpj), stat = ierror)
-      IF (ierror > 0) THEN
-         CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in allocating Reals')
+      !
+      ALLOCATE( exfld(nlei-nldi+1, nlej-nldj+1, 1), stat = nerror )
+      IF ( nerror > 0 ) THEN
+         CALL prism_abort( ncomp_id, 'cpl_prism_define', 'Failure in allocating exfld' )
          RETURN
       ENDIF
 
-      IF ( rootexchg .and. localRank == localRoot ) THEN
-         ALLOCATE(ranges(5,0:localSize-1), stat = ierror)
-         IF (ierror > 0) THEN
-            CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in allocating Integer')
-            RETURN
-         ENDIF
-      ENDIF
-
-      !------------------------------------------------------------------
-      ! 1st Declare the local grid (ORCA tripolar) characteristics for
-      !     surface coupling. The halo regions must be excluded. For
-      !     surface coupling it is sufficient to specify only one
-      !     vertical z-level.
-      !------------------------------------------------------------------
-
-      grid_type = PRISM_irrlonlat_regvrt
-
-      IF(lwp) WRITE(numout,*) "Set grid type"
-
-
-      ! -----------------------------------------------------------------
-      ! ... Define the shape of the valid region without the halo.
+
+      ! -----------------------------------------------------------------
+      ! ... Define the shape of the valid region without the halo and overlaps between cpus
       !     For serial configuration (key_mpp_mpi not being active)
       !     nl* is set to the global values 1 and jp*glo.
       ! -----------------------------------------------------------------
 
-      IF ( rootexchg ) THEN
-         shape(1,1) = 1+jpreci
-         shape(2,1) = jpiglo-jpreci
-         shape(1,2) = 1+jpreci
-         shape(2,2) = jpjglo-jpreci
-         shape(1,3) = 1
-         shape(2,3) = 1
-      ELSE
-         shape(1,1) = 1+jpreci
-         shape(2,1) = jpi-jpreci
-         shape(1,2) = 1+jpreci
-         shape(2,2) = jpj-jpreci
-         shape(1,3) = 1
-         shape(2,3) = 1
-      ENDIF
-
-      IF(lwp) WRITE(numout,*) "commrank is", commRank
-
-      IF ( commRank ) THEN
-
-         IF(lwp) WRITE(numout,*) "CALLING DEF_GRID"
-
-         IF(lwp) WRITE(numout,*) "grid name",grid_name
-         IF(lwp) WRITE(numout,*) " shape",shape
-         IF(lwp) WRITE(numout,*) "grid type",grid_type
-
-         CALL prism_def_grid ( grid_id(1), grid_name, comp_id, shape, &
-              grid_type, ierror )
-         IF ( ierror /= PRISM_Success ) THEN
-            PRINT *, 'OPA cpl_prism_define: Failure in prism_def_grid'
-            CALL prism_abort (comp_id, 'OPA9.0', 'cpl_prism_define: Failure in prism_def_grid')
+      ishape(:,1) = (/ 1, nlei-nldi+1 /)
+      ishape(:,2) = (/ 1, nlej-nldj+1 /)
+      ishape(:,3) = (/ 1,           1 /)
+          
+      DO ji = 1, 4
+         CALL prism_def_grid( igrid(ji), 'orca'//clgrd(ji), ncomp_id, ishape, PRISM_irrlonlat_regvrt, nerror )
+         IF( nerror /= PRISM_Success )   CALL prism_abort (ncomp_id, 'cpl_prism_define',   &
+            &                                                        'Failure in prism_def_grid of '//clgrd(jg)//'-point' )
+      END DO
+      
+      ! -----------------------------------------------------------------
+      ! ... Define the partition 
+      ! -----------------------------------------------------------------
+      
+      iextent(1,:) = (/    nlei-nldi+1,    nlej-nldj+1, 1 /)
+      ioffset(1,:) = (/ nldi-1+nimpp-1, nldj-1+njmpp-1, 0 /)
+      
+      DO ji = 1, 4
+         CALL prism_def_partition( igrid(ji), 1, ioffset, iextent, nerror )
+         IF( nerror /= PRISM_Success )   CALL prism_abort (ncomp_id, 'cpl_prism_define',   &
+            &                                                        'Failure in prism_def_partition of '//clgrd(jg)//'-point' )
+      END DO
+
+      ! -----------------------------------------------------------------
+      ! ... Define the elements, i.e. specify the corner points for each
+      !     volume element. In case OPA runs on level coordinates (regular
+      !     in the vertical) we only need to give the 4 horizontal corners
+      !     for a volume element plus the vertical position of the upper
+      !     and lower face. Nevertheless the volume element has 8 corners.
+      ! -----------------------------------------------------------------
+      
+      iioff(:) = (/0,1,0,1/)
+      ijoff(:) = (/0,0,1,1/) 
+      iishift(:) = (/0,1,1,0/)
+      ijshift(:) = (/0,0,1,1/)
+
+      DO jg = 1, 4    ! ... the t,u,v,f-points
+
+         cltxt = clgrd(jg)//'-point'
+         
+         ! -----------------------------------------------------------------
+         ! ... Convert OPA masks to logicals and define the masks
+         ! -----------------------------------------------------------------
+         SELECT CASE( jg ) 
+         CASE(1)   ;   llmask(:,:,1) = ( tmask(:,:,1)  ) == 1.
+         CASE(2)   ;   llmask(:,:,1) = ( umask(:,:,1)  ) == 1.
+         CASE(3)   ;   llmask(:,:,1) = ( vmask(:,:,1)  ) == 1.
+         CASE(4)   ;   llmask(:,:,1) = ( fmask(:,:,1)  ) == 1.
+!         CASE(1)   ;   llmask(:,:,1) = ( tmask(:,:,1) * dom_uniq('T') ) == 1.
+!         CASE(2)   ;   llmask(:,:,1) = ( umask(:,:,1) * dom_uniq('U') ) == 1.
+!         CASE(3)   ;   llmask(:,:,1) = ( vmask(:,:,1) * dom_uniq('V') ) == 1.
+!         CASE(4)   ;   llmask(:,:,1) = ( fmask(:,:,1) * dom_uniq('F') ) == 1.
+         END SELECT
+         CALL prism_set_mask( imskid(jg), igrid(jg), ishape, llmask(nldi:nlei, nldj:nlej, 1), .TRUE., nerror )
+         IF( nerror /= PRISM_Success )   CALL prism_abort( ncomp_id, 'cpl_prism_define', 'Failure in prism_set_mask for '//cltxt )
+
+         ! -----------------------------------------------------------------
+         ! ... Define the corners
+         ! -----------------------------------------------------------------
+         SELECT CASE( jg ) 
+         CASE(1)   ;   zlon(:,:) = glamf(:,:)   ;   zlat(:,:) = gphif(:,:)
+         CASE(2)   ;   zlon(:,:) = glamv(:,:)   ;   zlat(:,:) = gphiv(:,:)
+         CASE(3)   ;   zlon(:,:) = glamu(:,:)   ;   zlat(:,:) = gphiu(:,:) 
+         CASE(4)   ;   zlon(:,:) = glamt(:,:)   ;   zlat(:,:) = gphit(:,:)
+         END SELECT
+
+         DO jc = 1, 4   ! corner number (anti-clockwise, starting from the bottom left corner)
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1   ! NO vector opt.
+                  ii = ji-1 + iioff(jg) + iishift(jc)
+                  ij = jj-1 + ijoff(jg) + ijshift(jc)
+                  zclo(ji,jj,jc) = zlon(ii,ij)
+                  zcla(ji,jj,jc) = zlat(ii,ij)
+               END DO
+            END DO
+            CALL lbc_lnk( zclo(:,:,jc), clgrd(jg), 1. )   ;   CALL lbc_lnk( zcla(:,:,jc), clgrd(jg), 1. )
+         END DO
+
+         CALL prism_set_corners( igrid(jg), 8, ishape, zclo(nldi:nlei, nldj:nlej,:),   &
+            &                                          zcla(nldi:nlei, nldj:nlej,:), RESHAPE( (/-1.,1./), (/1,2/) ), nerror )
+         IF( nerror /= PRISM_Success )   CALL prism_abort( ncomp_id, 'cpl_prism_define', 'Failure in prism_set_corners of '//cltxt )    
+
+         ! -----------------------------------------------------------------
+         ! ... Define the center points
+         ! -----------------------------------------------------------------
+         SELECT CASE( jg ) 
+         CASE(1)   ;   zlon(:,:) = glamt(:,:)   ;   zlat(:,:) = gphit(:,:)
+         CASE(2)   ;   zlon(:,:) = glamu(:,:)   ;   zlat(:,:) = gphiu(:,:)
+         CASE(3)   ;   zlon(:,:) = glamv(:,:)   ;   zlat(:,:) = gphiv(:,:)
+         CASE(4)   ;   zlon(:,:) = glamf(:,:)   ;   zlat(:,:) = gphif(:,:)
+         END SELECT
+
+         CALL prism_set_points ( iptid(jg), cltxt, igrid(jg), ishape, zlon(nldi:nlei, nldj:nlej),   &
+         &                                                            zlat(nldi:nlei, nldj:nlej), (/0./), .TRUE., nerror )
+         IF( nerror /= PRISM_Success )   CALL prism_abort ( ncomp_id, 'cpl_prism_define', 'Failure in prism_set_points '//cltxt )
+
+      END DO
+
+      ! ... Announce send variables. 
+      !
+      DO ji = 1, ksnd
+         IF ( ssnd(ji)%laction ) THEN 
+            
+            itmp(:) = 0
+            WHERE( clgrd == ssnd(ji)%clgrid  ) itmp = 1
+            ind(:) = maxloc( itmp )
+            WRITE(6,*) ' grid for field ', ind(1), ssnd(ji)%clname
+             ind(1) = 1
+
+            CALL prism_def_var( ssnd(ji)%nid, ssnd(ji)%clname, igrid(ind(1)), iptid(ind(1)),  imskid(ind(1)), (/ 3, 0/),   &
+               &                ishape, PRISM_Double_Precision, nerror )
+            IF ( nerror /= PRISM_Success )   CALL prism_abort( ssnd(ji)%nid, 'cpl_prism_define',   &
+               &                                               'Failure in prism_def_var for '//TRIM(ssnd(ji)%clname))
+
          ENDIF
-
-         !------------------------------------------------------------------
-         ! 2nd Declare the geometic information for this grid.
-         !------------------------------------------------------------------
-
-         ! -----------------------------------------------------------------
-         ! ... Redefine shape which may now include the halo region as well.
-         ! -----------------------------------------------------------------
-
-         shape(1,1) = 1
-         shape(2,1) = jpi
-         shape(1,2) = 1
-         shape(2,2) = jpj
-         shape(1,3) = 1
-         shape(2,3) = 1
-
-         IF(lwp) WRITE(numout,*) "redefined shape",shape
-
-         ! -----------------------------------------------------------------
-         ! ... Define the elements, i.e. specify the corner points for each
-         !     volume element. In case OPA runs on level coordinates (regular
-         !     in the vertical) we only need to give the 4 horizontal corners
-         !     for a volume element plus the vertical position of the upper
-         !     and lower face. Nevertheless the volume element has 8 corners.
-         ! -----------------------------------------------------------------
-
-         !
-         ! ... Treat corners in the horizontal plane
-         !
-         ALLOCATE(rclon(shape(1,1):shape(2,1),shape(1,2):shape(2,2),4), &
-              STAT=ierror)
-         IF ( ierror /= 0 ) &
-              CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: error in allocate for rclon')
-
-         ALLOCATE(rclat(shape(1,1):shape(2,1),shape(1,2):shape(2,2),4), &
-              STAT=ierror)
-         IF ( ierror /= 0 ) &
-              CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: error in allocate for rclon')
-
-         nbr_corners = 8
-         !
-         ! ... Set right longitudes and upper latitudes
-         !
-         DO jj = shape(1,2), shape(2,2)
-            DO ji = shape(1,1), shape(2,1)
-               rclon(ji,jj,1) = glamu(ji,jj)
-               rclon(ji,jj,2) = glamu(ji,jj)
-               rclat(ji,jj,2) = gphiv(ji,jj)
-               rclat(ji,jj,3) = gphiv(ji,jj)
-            ENDDO
-         ENDDO
-         !
-         ! ... Set the lower latitudes
-         !
-         DO jj = shape(1,2)+1, shape(2,2)
-            DO ji = shape(1,1), shape(2,1)
-               rclat(ji,jj-1,1) = rclat(ji,jj,2)
-               rclat(ji,jj-1,4) = rclat(ji,jj,3)
-            ENDDO
-         ENDDO
-         !
-         ! ... Set the left longitudes
-         !
-         DO jj = shape(1,2), shape(2,2)
-            DO ji = shape(1,1)+1, shape(2,1)
-               rclon(ji-1,jj,3) = rclon(ji,jj,2)
-               rclon(ji-1,jj,4) = rclon(ji,jj,1)
-            ENDDO
-         ENDDO
-         !
-         ! ... Set the lowermost latitudes 
-         !
-         DO jj = shape(1,2), shape(1,2)
-            DO ji = shape(1,1), shape(2,1)
-               rclat(ji,jj,1) = 2.0*gphit(ji,jj)-rclat(ji,jj,2)
-               rclat(ji,jj,4) = 2.0*gphit(ji,jj)-rclat(ji,jj,4)
-            ENDDO
-         ENDDO
-         !
-         ! ... Set the rightmost latitudes 
-         !
-         DO jj = shape(1,2), shape(2,2)
-            DO ji = shape(1,2), shape(1,2)
-               rclon(ji,jj,3) = 2.0*glamt(ji,jj)-rclon(ji,jj,2)
-               rclon(ji,jj,4) = 2.0*glamt(ji,jj)-rclon(ji,jj,1)
-
-               WRITE(76,*) "rclon", ji, jj, rclon(ji,jj,1), &
-                                            rclon(ji,jj,2), &
-                                            rclon(ji,jj,3), &
-                                            rclon(ji,jj,4)
-
-               WRITE(76,*) "rclat", ji, jj, rclat(ji,jj,1), &
-                                            rclat(ji,jj,2), &
-                                            rclat(ji,jj,3), &
-                                            rclat(ji,jj,4)
-
-            ENDDO
-         ENDDO
-
-         !
-         ! ... Treat corners along the vertical axis
-         !
-         ALLOCATE(rcz(shape(1,3):shape(2,3),2), STAT=ierror)
-         IF ( ierror /= 0 ) &
-              CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: error in allocate for rcz')
-
-         DO jk = shape(1,3), shape(2,3)
-            rcz(jk,1) = gdepw(jk)
-            rcz(jk,2) = gdepw(jk+1)
-         ENDDO
-
-         IF(lwp) WRITE(numout,*) "ABOUT TO CALL SET CORNERS",shape 
-
-         CALL prism_set_corners ( grid_id(1), nbr_corners, shape, rclon, rclat, &
-              rcz, ierror)
-         IF ( ierror /= PRISM_Success ) &
-              CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in prism_set_corners')
-
-         DEALLOCATE(rclon, rclat, rcz)
-
-         ! -----------------------------------------------------------------
-         ! ... Define the gridpoints  
-         ! -----------------------------------------------------------------
-
-         new_points = .TRUE.
-
-         IF(lwp) WRITE(numout,*) "CALLING SET_POINTS"
-
-         !
-         ! ... the u-points
-         !
-         point_name = 'u-points'
-         CALL prism_set_points ( upoint_id(1), point_name, grid_id(1), shape,      &
-              glamu, gphiu, gdept(shape(1,3):shape(2,3)), new_points, ierror )
-         IF ( ierror /= PRISM_Success ) &
-              CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in prism_set_points upoint_id')
-         !
-         ! ... the v-points
-         !
-
-         IF(lwp) WRITE(numout,*) "CALLING SET_POINTS done u doing v"
-
-         point_name = 'v-points'
-         CALL prism_set_points ( vpoint_id(1), point_name, grid_id(1), shape,      &
-              glamv, gphiv, gdept(shape(1,3):shape(2,3)), new_points, ierror )      
-         IF ( ierror /= PRISM_Success ) &
-              CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in prism_set_points vpoint_id')
-         !
-         ! ... the t-points
-         !
-         ! WRITE(76,*) 'CALLING T POINTS', shape
-         ! WRITE(77,*) 'glamt', glamt
-         ! WRITE(78,*) 'gphit', gphit
-         !
-         point_name = 't-points'
-         CALL prism_set_points ( tpoint_id(1), point_name, grid_id(1), shape,   &
-              glamt, gphit, gdept(shape(1,3):shape(2,3)), new_points, ierror )
-         IF ( ierror /= PRISM_Success ) &
-              CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in prism_set_points tpoint_id')
-         !
-         ! ... the f-points
-         !
-         point_name = 'f-points'
-         CALL prism_set_points ( fpoint_id(1), point_name, grid_id(1), shape,   &
-              glamf, gphif, gdept(shape(1,3):shape(2,3)), new_points, ierror )
-         IF ( ierror /= PRISM_Success ) &
-              CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in prism_set_points fpoint_id')
-
-
-         IF(lwp) WRITE(numout,*) "CALLING SET_POINTS done f"
-
-         ! -----------------------------------------------------------------
-         ! ... Convert OPA masks to logicals and define the masks
-         ! -----------------------------------------------------------------
-
-         new_mask = .true.
-
-         mask = (umask == 1)
-         CALL prism_set_mask (umask_id(1), grid_id(1), shape, &
-                 mask(shape(1,1):shape(2,1),                  &
-                      shape(1,2):shape(2,2),                  &
-                      shape(1,3):shape(2,3)),                 &
-              new_mask, ierror )
-         IF ( ierror /= PRISM_Success ) &
-              CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in prism_set_mask umask_id')
-
-         mask = (vmask == 1)
-         CALL prism_set_mask (vmask_id(1), grid_id(1), shape, &
-                 mask(shape(1,1):shape(2,1),                  &
-                      shape(1,2):shape(2,2),                  &
-                      shape(1,3):shape(2,3)),                 &
-              new_mask, ierror )
-         IF ( ierror /= PRISM_Success ) &
-              CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in prism_set_mask umask_id')
-
-         mask = (tmask == 1)
-         CALL prism_set_mask (tmask_id(1), grid_id(1), shape, &
-                 mask(shape(1,1):shape(2,1),                  &
-                      shape(1,2):shape(2,2),                  &
-                      shape(1,3):shape(2,3)),                 &
-              new_mask, ierror )
-         IF ( ierror /= PRISM_Success ) &
-              CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in prism_set_mask umask_id')
-
-         mask = (fmask == 1)
-         CALL prism_set_mask (fmask_id(1), grid_id(1), shape, &
-                 mask(shape(1,1):shape(2,1),                  &
-                      shape(1,2):shape(2,2),                  &
-                      shape(1,3):shape(2,3)),                 &
-              new_mask, ierror )
-         IF ( ierror /= PRISM_Success ) &
-              CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in prism_set_mask umask_id')
-
-         IF(lwp) WRITE(numout,*) "DONE ALL THE SET MASKS"
-
-         ! -----------------------------------------------------------------
-         ! ... Define the angles
-         !   This is needed if zonal tau is not oriented E-W and meridional
-         !   tau is not oriented along N-S but rather along local coordinate
-         !   axis. Please check!!!!
-         ! -----------------------------------------------------------------
-
-!rr      cal prism_set_angles ( ..., ierror ) ! not yet supported by OASIS4
-
-         ! -----------------------------------------------------------------
-         ! ... Define the partition 
-         ! -----------------------------------------------------------------
-         
-         IF ( rootexchg ) THEN
-
-            range(1) = nimpp-1+nldi   ! global start in i
-            range(2) = nlei-nldi+1    ! local size in i of valid region
-            range(3) = njmpp-1+nldj   ! global start in j
-            range(4) = nlej-nldj+1    ! local size in j of valid region
-            range(5) = range(2) &
-                     * range(4)       ! local horizontal size
-            !
-            ! Collect ranges from all NEMO procs on the local root process
-            !
-            CALL mpi_gather(range,  5, MPI_INTEGER, &
-                            ranges, 5, MPI_INTEGER, localRoot, localComm, ierror)
-
-            IF ( localRank == localRoot ) THEN
-
-               maxlen = maxval(ranges(5,:))
-
-               ALLOCATE(buffer(1:maxlen), stat = ierror)
-               IF (ierror > 0) THEN
-                  CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in allocating buffer')
-                  RETURN
-               ENDIF
-
-            ENDIF
+      END DO
+      !
+      ! ... Announce received variables. 
+      !
+      DO ji = 1, krcv
+         IF ( srcv(ji)%laction ) THEN 
+
+            itmp(:) = 0
+            WHERE( clgrd == srcv(ji)%clgrid  ) itmp = 1
+            ind(:) = maxloc( itmp )
+            WRITE(6,*) ' grid for field ', ind(1), srcv(ji)%clname
+             ind(1) = 1
+ 
+            CALL prism_def_var( srcv(ji)%nid, srcv(ji)%clname, igrid(ind(1)), iptid(ind(1)), imskid(ind(1)), (/ 3, 0/),   &
+               &                ishape, PRISM_Double_Precision, nerror )
+            IF ( nerror /= PRISM_Success )   CALL prism_abort( srcv(ji)%nid, 'cpl_prism_define',   &
+               &                                               'Failure in prism_def_var for '//TRIM(srcv(ji)%clname))
 
          ENDIF
-
-         ! -----------------------------------------------------------------
-         ! ... Define the scalefactors 
-         ! -----------------------------------------------------------------
-
-!rr      WRITE(numout,*) "CALLING SCALEFACTOR"
-!rr      call prism_set_scalefactor ( grid_id(1), shape, e1t, e2t, e3t, ierror )  ! not yet supported by OASIS4
-!rr      WRITE(numout,*) "ABOUT TO DEFINE THE TRANSIENTS"
-
-         !------------------------------------------------------------------
-         ! 3rd Declare the transient variables
-         !------------------------------------------------------------------
-         !
-         ! ... Define symbolic names for the transient fields send by the ocean
-         !     These must be identical to the names specified in the SMIOC file.
-         !
-         cpl_send( 1)='SOSSTSST' ! sea surface temperature              -> sst_io
-         cpl_send( 2)='SITOCEAN' ! sea ice thickness                    -> hicif (only 1 layer available!)
-#if defined key_cpl_albedo
-         cpl_send( 3)='STIOCEAN' ! surface temperature over sea ice     -> tn_ice
-         cpl_send( 4)='SAIOCEAN' ! albedo over sea ice                  -> alb_ice
-#else
-         cpl_send( 3)='SITOCEAN' ! sea ice thickness                    -> hicif (only 1 layer available!)
-         cpl_send( 4)='SNTOCEAN' ! surface snow thickness over sea ice  -> hsnif
-#endif
-#if defined key_cpl_ocevel
-         cpl_send( 5)='SUNOCEAN' ! U-velocity                           -> un
-         cpl_send( 6)='SVNOCEAN' ! V-velocity                           -> vn
-#endif
-         !
-         ! ...  Define symbolic names for transient fields received by the ocean.
-         !      These must be identical to the names specified in the SMIOC file.
-         !
-         ! ...  a) U-Grid fields
-         !
-         cpl_recv( 1)='TXWOCEWU' ! weighted surface downward eastward stress
-         cpl_recv( 2)='TYWOCEWU' ! weighted surface downward northward stress
-         cpl_recv( 3)='TXIOCEWU' ! weighted surface downward eastward stress over ice
-         cpl_recv( 4)='TYIOCEWU' ! weighted surface downward northward stress over ice
-         !
-         ! ...  a) V-Grid fields
-         !
-         cpl_recv( 5)='TXWOCEWV' ! weighted surface downward eastward stress
-         cpl_recv( 6)='TYWOCEWV' ! weighted surface downward northward stress
-         cpl_recv( 7)='TXIOCEWV' ! weighted surface downward eastward stress over ice
-         cpl_recv( 8)='TYIOCEWV' ! weighted surface downward northward stress over ice
-         !
-         ! ...  a) T-Grid fields
-         !
-         cpl_recv( 9)='FRWOCEPE' ! P-E over water                               -> zpew
-         cpl_recv(10)='FRIOCEPE' ! P-E over ice                                 -> zpei
-         cpl_recv(11)='FRROCESN' ! surface downward snow fall                   -> zpsol
-         cpl_recv(12)='FRIOCEEV' ! surface upward snow flux where sea ice       -> zevice
-
-         cpl_recv(13)='QSWOCESR' ! surface net downward shortwave flux          -> qsr_oce
-         cpl_recv(14)='QSWOCENS' ! surface downward non-solar heat flux in air  -> qnsr_oce
-         cpl_recv(15)='QSIOCESR' ! solar heat flux on sea ice                   -> qsr_ice
-         cpl_recv(16)='QSIOCENS' ! non-solar heat flux on sea ice               -> qnsr_ice
-         cpl_recv(17)='QSIOCEDQ' ! non-solar heat flux derivative               -> dqns_ice
-
-#ifdef key_cpl_discharge
-         cpl_recv(18)='FRWOCEIS' ! ice discharge into ocean                     -> calving
-         cpl_recv(19)='FRWOCERD' ! river discharge into ocean                   -> zrunriv
-         cpl_recv(20)='FRWOCECD' ! continental discharge into ocean             -> zruncot
-#endif
-         IF ( wp == 4 ) data_type = PRISM_REAL
-         IF ( wp == 8 ) data_type = PRISM_DOUBLE_PRECISION
-
-         nodim(1) = 3 ! check
-         nodim(2) = 0
-         !
-         ! ... Announce send variables, all on T points. 
-         !
-         DO ji = 1, nsend
-            ! if ( ji == 2 ) ; then ; nodim(2) = 2 ; else ; nodim(2) = 0 ; endif
-            CALL prism_def_var (send_id(ji), cpl_send(ji), grid_id(1), &
-                 tpoint_id(1), tmask_id(1), nodim, shape, data_type, ierror)
-            IF ( ierror /= PRISM_Success ) THEN
-               PRINT *, 'Failed to define transient ', ji, TRIM(cpl_send(ji))
-               CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in prism_def_var')
-            ENDIF
-         ENDDO
-         !
-         nodim(1) = 3 ! check
-         nodim(2) = 0
-         !
-         ! ... Announce recv variables. 
-         !
-         ! ... a) on U points
-         !
-         DO ji = 1, 4
-            CALL prism_def_var (recv_id(ji), cpl_recv(ji), grid_id(1), &
-                 upoint_id(1), umask_id(1), nodim, shape, data_type, ierror)
-            IF ( ierror /= PRISM_Success ) THEN
-               PRINT *, 'Failed to define transient ', ji, TRIM(cpl_recv(ji))
-               CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in prism_def_var')
-            ENDIF
-         ENDDO
-         !
-         ! ... b) on V points
-         !
-         DO ji = 5, 8 
-            CALL prism_def_var (recv_id(ji), cpl_recv(ji), grid_id(1), &
-                 vpoint_id(1), vmask_id(1), nodim, shape, data_type, ierror)
-            IF ( ierror /= PRISM_Success ) THEN
-               PRINT *, 'Failed to define transient ', TRIM(cpl_recv(ji))
-               CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in prism_def_var')
-            ENDIF
-         ENDDO
-         !
-         ! ... c) on T points
-         !
-         DO ji = 9, nrecv
-            CALL prism_def_var (recv_id(ji), "SORUNOFF", grid_id(1), &
-                 tpoint_id(1), tmask_id(1), nodim, shape, data_type, ierror)
-            IF ( ierror /= PRISM_Success ) THEN
-               PRINT *, 'Failed to define transient ', TRIM(cpl_recv(ji))
-               CALL prism_abort ( comp_id, 'OPA9.0', 'OPA cpl_prism_define: Failure in prism_def_var')
-            ENDIF
-         ENDDO
-
-      ENDIF ! commRank
-
-      !------------------------------------------------------------------
-      ! 4th End of definition phase
-      !------------------------------------------------------------------
-
-      IF(lwp) WRITE(numout,*) "ABOUT TO CALL PRISM_ENDDEF" 
-
-      CALL prism_enddef(ierror)
-
-      IF(lwp) WRITE(numout,*) "DONE ENDDEF",ierror
-
-      IF ( ierror /= PRISM_Success ) &
-         CALL prism_abort ( comp_id, 'OPA9.0', 'cpl_prism_define: Failure in prism_enddef')
-        
-      IF(lwp) WRITE(numout,*) "ALL DONE, EXITING PRISM SET UP PHASE"
- 
+      END DO
+      
+      !------------------------------------------------------------------
+      ! End of definition phase
+      !------------------------------------------------------------------
+      
+      CALL prism_enddef( nerror )
+      IF ( nerror /= PRISM_Success )   CALL prism_abort ( ncomp_id, 'cpl_prism_define', 'Failure in prism_enddef')
+      
    END SUBROUTINE cpl_prism_define
-
-
-
-   SUBROUTINE cpl_prism_send( var_id, date, data_array, info )
-
-      IMPLICIT NONE
+   
+   
+   SUBROUTINE cpl_prism_snd( kid, kstep, pdata, kinfo )
 
       !!---------------------------------------------------------------------
-      !!              ***  ROUTINE cpl_prism_send  ***
+      !!              ***  ROUTINE cpl_prism_snd  ***
       !!
       !! ** Purpose : - At each coupling time-step,this routine sends fields
       !!      like sst or ice cover to the coupler or remote application.
-      !!
-      !! ** Method  : OASIS4
       !!----------------------------------------------------------------------
       !! * Arguments
       !!
-      INTEGER, INTENT( IN )  :: var_id    ! variable Id
-      INTEGER, INTENT( OUT ) :: info      ! variable Id
-      INTEGER, INTENT( IN )  :: date      ! ocean time-step in seconds
-      REAL(wp)               :: data_array(:,:)
-      !!
-      !! * Local declarations
-      !!
-#if defined key_mpp_mpi
-      REAL(wp)               :: global_array(jpiglo,jpjglo)
-      !
-!mpi  INTEGER                :: status(MPI_STATUS_SIZE)
-!mpi  INTEGER                :: type       ! MPI data type
-      INTEGER                :: request    ! MPI isend request
-      INTEGER                :: ji, jj, jn ! local loop indicees
-#else
-      INTEGER                :: ji
-#endif
-      !!
-      INTEGER, SAVE          :: ncount = 0
+      INTEGER,                      INTENT( IN    )   :: kid       ! variable intex in the array
+      INTEGER,                      INTENT(   OUT )   :: kinfo     ! OASIS4 info argument
+      INTEGER,                      INTENT( IN    )   :: kstep     ! ocean time-step in seconds
+      REAL(wp), DIMENSION(jpi,jpj), INTENT( IN    )   :: pdata
+      !!
       !!
       !!--------------------------------------------------------------------
-      !!
-      ncount = ncount + 1
-
-#if defined key_mpp_mpi
-
-      request = 0
-
-      IF ( rootexchg ) THEN
-         !
-!mpi     IF ( wp == 4 ) type = MPI_REAL
-!mpi     IF ( wp == 8 ) type = MPI_DOUBLE_PRECISION
-         !
-         ! collect data on the local root process
-         !
-         IF ( localRank /= localRoot ) THEN
-
-            DO jj = nldj, nlej
-               DO ji = nldi, nlei
-                  exfld(ji-nldi+1,jj-nldj+1)=data_array(ji,jj)
-               ENDDO
-            ENDDO
-
-!mpi        CALL mpi_send(exfld, range(5), type, localRoot, localRank, localComm, ierror)
-            CALL mppsend (localRank, exfld, range(5), localRoot, request)
-         ENDIF
-
-         IF ( localRank == localRoot ) THEN
-
-            DO jj = ranges(3,localRoot), ranges(3,localRoot)+ranges(4,localRoot)-1
-               DO ji = ranges(1,localRoot), ranges(1,localRoot)+ranges(2,localRoot)-1
-                  global_array(ji,jj) = data_array(ji,jj) ! workaround
-               ENDDO
-            ENDDO
-
-            DO jn = 1, localSize-1
-
-!mpi           CALL mpi_recv(buffer, ranges(5,jn), type, localRoot, jn, localComm, status, ierror)
-               CALL mpprecv(jn, buffer, ranges(5,jn))
-
-               DO jj = ranges(3,jn), ranges(3,jn)+ranges(4,jn)-1
-                  DO ji = ranges(1,jn), ranges(1,jn)+ranges(2,jn)-1
-                     global_array(ji,jj) = buffer( (jj-ranges(3,jn))*ranges(2,jn) + ji-ranges(1,jn)+1 )
-                  ENDDO
-               ENDDO
-
-            ENDDO
-
-         ENDIF
-         !
-         ! send data from local root to OASIS4
-         !
-         CALL prism_put ( var_id, dates, dates_bound, global_array, info, ierror )      
-
-      ELSE
-         !
-         ! send local data from every process to OASIS4
-         !
-         CALL prism_put ( var_id, dates, dates_bound, data_array, info, ierror )      
-
-      ENDIF !rootexchg
-
-#else
-
-      !
-      ! send local data from every process to OASIS4
-      !
-      IF ( commRank ) &
-      CALL prism_put ( var_id, dates, dates_bound, data_array, info, ierror )      
-
-#endif
-
-      IF ( commRank ) THEN
-
-         IF (l_ctl) THEN
-
-            IF ( info==PRISM_Cpl ) THEN
-               WRITE(numout,*) '****************'
-               DO ji = 1, nsend
-                  IF (var_id == send_id(ji) ) THEN
-                     WRITE(numout,*) 'prism_put_proto: Outgoing ', cpl_send(ji)
-                     EXIT
-                  ENDIF
-               ENDDO
-               WRITE(numout,*) 'prism_put: var_id       ', var_id
-               WRITE(numout,*) 'prism_put:   date       ', date
-               WRITE(numout,*) 'prism_put:   info       ', info
-               WRITE(numout,*) '     - Minimum value is ', MINVAL(data_array)
-               WRITE(numout,*) '     - Maximum value is ', MAXVAL(data_array)
-               WRITE(numout,*) '     -     Sum value is ', SUM(data_array)
-               WRITE(numout,*) '****************'
-            ENDIF
-
-         ENDIF
-
-         IF ( ncount == nrecv ) THEN
-            !
-            !  3. Update dates and dates_bound for next step. We assume that cpl_prism_send
-            !  is called for all send fields at each time step. Therefore we update
-            !  the date argument to prism_put only every nsend call to cpl_prism_send.
-            !
-            dates_bound(1) = dates_bound(2)
-
-            tmpdate    = dates_bound(2)
-            date_incr  = rdCplttra(1)/2.0
-
-            CALL PRISM_calc_newdate ( tmpdate, date_incr, ierror )
-            dates = tmpdate
-            CALL PRISM_calc_newdate ( tmpdate, date_incr, ierror )
-            dates_bound(2) = tmpdate
-
-            ncount = 0
-
-         ENDIF
-
-      ENDIF ! commRank
-
-   END SUBROUTINE cpl_prism_send
-
-
-
-   SUBROUTINE cpl_prism_recv(  var_id, date, data_array, info )
-
-      IMPLICIT NONE
+      !
+      ! snd data to OASIS4
+      !
+      exfld(:,:,1) = pdata(nldi:nlei, nldj:nlej)
+      CALL prism_put( ssnd(kid)%nid, date, date_bound, exfld, kinfo, nerror )
+      IF ( nerror /= PRISM_Success )   CALL prism_abort( ssnd(kid)%nid, 'cpl_prism_snd',   &
+         &                                               'Failure in prism_put for '//TRIM(ssnd(kid)%clname) )
+
+      IF ( ln_ctl ) THEN        
+         IF ( kinfo >= PRISM_Cpl     .OR. kinfo == PRISM_Rst .OR.   &
+            & kinfo == PRISM_RstTimeop ) THEN
+            WRITE(numout,*) '****************'
+            WRITE(numout,*) 'prism_put: Outgoing ', ssnd(kid)%clname
+            WRITE(numout,*) 'prism_put: ivarid ', ssnd(kid)%nid
+            WRITE(numout,*) 'prism_put:  kstep ', kstep
+            WRITE(numout,*) 'prism_put:   info ', kinfo
+            WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata)
+            WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata)
+            WRITE(numout,*) '     -     Sum value is ', SUM(pdata)
+            WRITE(numout,*) '****************'
+        ENDIF
+     ENDIF
+    END SUBROUTINE cpl_prism_snd
+
+
+   SUBROUTINE cpl_prism_rcv( kid, kstep, pdata, kinfo )
 
       !!---------------------------------------------------------------------
-      !!              ***  ROUTINE cpl_prism_recv  ***
+      !!              ***  ROUTINE cpl_prism_rcv  ***
       !!
       !! ** Purpose : - At each coupling time-step,this routine receives fields
       !!      like stresses and fluxes from the coupler or remote application.
-      !!
-      !! ** Method  : OASIS4
       !!----------------------------------------------------------------------
-      !! * Arguments
-      !!
-      INTEGER, INTENT( IN )  :: var_id    ! variable Id
-      INTEGER, INTENT( OUT ) :: info      ! variable Id
-      INTEGER, INTENT( IN )  :: date      ! ocean time-step in seconds
-      REAL(wp),INTENT( OUT ) :: data_array(:,:)
-      !!
-      !! * Local declarations
-      !!
-#if defined key_mpp_mpi
-      REAL(wp)               :: global_array(jpiglo,jpjglo)
-      !
-      LOGICAL                :: action = .false.
-!mpi  INTEGER                :: status(MPI_STATUS_SIZE)
-!mpi  INTEGER                :: type       ! MPI data type
-      INTEGER                :: request    ! MPI isend request
-      INTEGER                :: ji, jj, jn ! local loop indicees
-#else
-      INTEGER                :: ji
-#endif
-
-      INTEGER, SAVE          :: ncount = 0
-      !!
+      INTEGER,                      INTENT( IN    )   :: kid       ! variable intex in the array
+      INTEGER,                      INTENT( IN    )   :: kstep     ! ocean time-step in seconds
+      REAL(wp), DIMENSION(jpi,jpj), INTENT( INOUT )   :: pdata     ! IN to keep the value if nothing is done
+      INTEGER,                      INTENT(   OUT )   :: kinfo     ! OASIS4 info argument
+      !!
+      LOGICAL                :: llaction
       !!--------------------------------------------------------------------
-      !!
-      ncount  = ncount + 1
-
-#ifdef key_mpp_mpi
-
-      request = 0
-
-      IF ( rootexchg ) THEN
-         !
-         ! receive data from OASIS4 on local root
-         !
-         IF ( commRank ) &
-         CALL prism_get (var_id, dater, dater_bound, global_array, info, ierror)
-         CALL MPI_BCAST ( info, 1, MPI_INTEGER, localRoot, localComm, ierror )
-
-      ELSE
-         !
-         ! receive local data from OASIS4 on every process
-         !
-         CALL prism_get (var_id, dater, dater_bound, exfld, info, ierror)
-
-      ENDIF
-
-      action = (info==PRISM_CplIO)
-
-      IF ( rootexchg .and. action ) THEN
-         !
-!mpi     IF ( wp == 4 ) type = MPI_REAL
-!mpi     IF ( wp == 8 ) type = MPI_DOUBLE_PRECISION
-         !
-         ! distribute data to processes
-         !
-         IF ( localRank == localRoot ) THEN
-
-            DO jj = ranges(3,localRoot), ranges(3,localRoot)+ranges(4,localRoot)-1
-               DO ji = ranges(1,localRoot), ranges(1,localRoot)+ranges(2,localRoot)-1
-                  exfld(ji,jj) = global_array(ji,jj)
-               ENDDO
-            ENDDO
-
-            DO jn = 1, localSize-1
-
-               DO jj = ranges(3,jn), ranges(3,jn)+ranges(4,jn)-1
-                  DO ji = ranges(1,jn), ranges(1,jn)+ranges(2,jn)-1
-                     buffer( (jj-ranges(3,jn))*ranges(2,jn) + ji-ranges(1,jn)+1 ) = global_array(ji,jj)
-                  ENDDO
-               ENDDO
-
-!mpi           CALL mpi_send(buffer, ranges(5,jn), type, jn, jn, localComm, ierror)
-               CALL mppsend (jn, buffer, ranges(5,jn), jn, request)  
-
-            ENDDO
-
-         ENDIF
-
-         IF ( localRank /= localRoot ) &
-!mpi         CALL mpi_recv(exfld, range(5), type, localRoot, localRank, localComm, status, ierror)
-             CALL mpprecv(localRank, exfld, range(5))
-      ENDIF
-
-      IF ( action ) THEN
-
-         data_array = 0.0
-
-         DO jj = nldj, nlej
-            DO ji = nldi, nlei
-               data_array(ji,jj)=exfld(ji-nldi+1,jj-nldj+1)
-            ENDDO
-         ENDDO
-
-         IF (l_ctl) THEN        
+      !
+      ! receive local data from OASIS4 on every process
+      !
+      CALL prism_get( srcv(kid)%nid, date, date_bound, exfld, kinfo, nerror )         
+      IF ( nerror /= PRISM_Success )   CALL prism_abort( srcv(kid)%nid, 'cpl_prism_rcv',   &
+         &                                               'Failure in prism_get for '//TRIM(srcv(kid)%clname) )
+
+      WRITE(numout,*) 'prism_get: Incoming ', srcv(kid)%clname
+      call flush(numout)
+      llaction = .false.
+      IF( kinfo == PRISM_Cpl )  llaction = .TRUE.
+
+      IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid
+
+      IF ( llaction ) THEN
+
+         kinfo = OASIS_Rcv
+         pdata(nldi:nlei, nldj:nlej) = exfld(:,:,1)
+         
+         !--- Fill the overlap areas and extra hallows (mpp)
+         !--- check periodicity conditions (all cases)
+         CALL lbc_lnk( pdata, srcv(kid)%clgrid, srcv(kid)%nsgn )   
+         
+         IF ( ln_ctl ) THEN        
             WRITE(numout,*) '****************'
-            DO ji = 1, nrecv
-               IF (var_id == recv_id(ji) ) THEN
-                  WRITE(numout,*) 'prism_get: Incoming ', cpl_recv(ji)
-                  EXIT
-               ENDIF
-            ENDDO
-            WRITE(numout,*) 'prism_get: var_id       ', var_id
-            WRITE(numout,*) 'prism_get:   date       ', date
-            WRITE(numout,*) 'prism_get:   info       ', info
-            WRITE(numout,*) '     - Minimum value is ', MINVAL(data_array)
-            WRITE(numout,*) '     - Maximum value is ', MAXVAL(data_array)
-            WRITE(numout,*) '     -     Sum value is ', SUM(data_array)
+            WRITE(numout,*) 'prism_get: Incoming ', srcv(kid)%clname
+            WRITE(numout,*) 'prism_get: ivarid '  , srcv(kid)%nid
+            WRITE(numout,*) 'prism_get:   kstep', kstep
+            WRITE(numout,*) 'prism_get:   info ', kinfo
+            WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata)
+            WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata)
+            WRITE(numout,*) '     -     Sum value is ', SUM(pdata)
             WRITE(numout,*) '****************'
          ENDIF
 
+      ELSE
+         kinfo = OASIS_idle     
       ENDIF
-#else
-
-      CALL prism_get (var_id, dater, dater_bound, exfld, info, ierror)
-
-      IF ( info==PRISM_CplIO ) THEN
-               data_array=exfld
-
-         IF (l_ctl) THEN        
-            WRITE(numout,*) '****************'
-            DO ji = 1, nrecv
-               IF (var_id == recv_id(ji) ) THEN
-                  WRITE(numout,*) 'prism_get: Incoming ', cpl_recv(ji)
-                  EXIT
-               ENDIF
-            ENDDO
-            WRITE(numout,*) 'prism_get: var_id       ', var_id
-            WRITE(numout,*) 'prism_get:   date       ', date
-            WRITE(numout,*) 'prism_get:   info       ', info
-            WRITE(numout,*) '     - Minimum value is ', MINVAL(data_array)
-            WRITE(numout,*) '     - Maximum value is ', MAXVAL(data_array)
-            WRITE(numout,*) '     -     Sum value is ', SUM(data_array)
-            WRITE(numout,*) '****************'
-         ENDIF
-
-      ENDIF
-
-#endif
-
-      IF ( ncount == nrecv ) THEN
-         !
-         !  3. Update dater and dater_bound for next step. We assume that cpl_prism_recv
-         !  is called for all recv fields at each time step. Therefore we update
-         !  the date argument to prism_get only every nrecv call to cpl_prism_recv.
-         !
-         dater_bound(1) = dater_bound(2)
-
-         tmpdate    = dater_bound(2)
-         date_incr  = rdttra(1)/2.0
-
-         CALL PRISM_calc_newdate ( tmpdate, date_incr, ierror )
-         dater = tmpdate
-         CALL PRISM_calc_newdate ( tmpdate, date_incr, ierror )
-         dater_bound(2) = tmpdate
-
-         ncount = 0
-
-      ENDIF
-
-   END SUBROUTINE cpl_prism_recv
-
+
+
+   END SUBROUTINE cpl_prism_rcv
 
 
    SUBROUTINE cpl_prism_finalize
-
-      IMPLICIT NONE
 
       !!---------------------------------------------------------------------
@@ -1167,46 +431,57 @@
       !!      called explicitly before cpl_prism_init it will also close
       !!      MPI communication.
-      !!
-      !! ** Method  : OASIS4
       !!----------------------------------------------------------------------
 
       DEALLOCATE(exfld)
-
-      if ( prism_was_initialized ) then
-
-         call prism_terminated ( prism_was_terminated, ierror )
-         
-         if ( prism_was_terminated ) then
-            print *, 'prism has already been terminated.'
-         else
-            call prism_terminate ( ierror )
-            prism_was_terminated = .true.
-         endif
-
-      else
-
-         print *, 'Initialize prism before terminating it.'
-
-      endif
-
+      CALL prism_terminate ( nerror )         
 
    END SUBROUTINE cpl_prism_finalize
 
-#else
-
-   !!----------------------------------------------------------------------
-   !!   Default case           Dummy module         forced Ocean/Atmosphere
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE cpl_prism_init             ! Dummy routine
-   END SUBROUTINE cpl_prism_init
-   SUBROUTINE cpl_prism_define           ! Dummy routine
-   END SUBROUTINE cpl_prism_define
-   SUBROUTINE cpl_prism_send             ! Dummy routine
-   END SUBROUTINE cpl_prism_send
-   SUBROUTINE cpl_prism_recv             ! Dummy routine
-   END SUBROUTINE cpl_prism_recv
-   SUBROUTINE cpl_prism_finalize         ! Dummy routine
-   END SUBROUTINE cpl_prism_finalize
+   SUBROUTINE cpl_prism_update_time(kt)
+
+      !!---------------------------------------------------------------------
+      !!              ***  ROUTINE cpl_prism_update_time  ***
+      !!
+      !! ** Purpose : - Increment date with model timestep
+      !!      called explicitly at the end of each timestep
+      !!----------------------------------------------------------------------
+
+      INTEGER, INTENT(in) ::   kt       ! ocean model time step index
+
+      TYPE(PRISM_Time_struct)    :: tmpdate
+      INTEGER                    :: idate_incr     ! date increment
+
+
+      IF( kt == nit000 ) THEN
+      !
+      ! Define the actual date 
+      !
+      ! date is determined by adding days since beginning of the run to the corresponding initial date.
+      ! Note that OPA internal info about the start date of the experiment is bypassed.
+      ! Instead we rely sololy on the info provided by the SCC.xml file.
+      !
+         date = PRISM_Jobstart_date
+         !
+         !
+         ! lower/upper bound is determined by adding half a time step
+         !
+         idate_incr = 0.5 * NINT ( rdttra(1) )
+         tmpdate = date   ;   CALL PRISM_calc_newdate ( tmpdate, -idate_incr, nerror )   ;   date_bound(1) = tmpdate
+         tmpdate = date   ;   CALL PRISM_calc_newdate ( tmpdate,  idate_incr, nerror )   ;   date_bound(2) = tmpdate
+
+      ELSE
+      !
+      ! Date update
+      !
+         idate_incr  = rdttra(1)
+         CALL PRISM_calc_newdate( date, idate_incr, nerror )
+         date_bound(1) = date_bound(2)
+         tmpdate = date_bound(2)
+         CALL PRISM_calc_newdate( tmpdate, idate_incr, nerror )
+         date_bound(2) = tmpdate
+
+      END IF
+
+   END SUBROUTINE cpl_prism_update_time
 
 #endif
Index: trunk/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90	(revision 2528)
@@ -15,4 +15,5 @@
    USE oce             ! ocean dynamics and tracers
    USE dom_oce         ! ocean space and time domain
+   USE ioipsl, ONLY :   ymds2ju, ju2ymds   ! for calendar
    USE phycst          ! ???
    USE in_out_manager  ! I/O manager
@@ -29,9 +30,9 @@
       LOGICAL              ::   ln_tint     ! time interpolation or not (T/F)
       LOGICAL              ::   ln_clim     ! climatology or not (T/F)
-      CHARACTER(len = 7)   ::   cltype      ! type of data file 'daily', 'monthly' or yearly'
+      CHARACTER(len = 8)   ::   cltype      ! type of data file 'daily', 'monthly' or yearly'
       CHARACTER(len = 34)  ::   wname       ! generic name of a NetCDF weights file to be used, blank if not
       CHARACTER(len = 34)  ::   vcomp       ! symbolic component name if a vector that needs rotation
-                                           ! a string starting with "U" or "V" for each component   
-                                           ! chars 2 onwards identify which components go together  
+                                            ! a string starting with "U" or "V" for each component   
+                                            ! chars 2 onwards identify which components go together  
    END TYPE FLD_N
 
@@ -43,15 +44,14 @@
       LOGICAL                         ::   ln_tint      ! time interpolation or not (T/F)
       LOGICAL                         ::   ln_clim      ! climatology or not (T/F)
-      CHARACTER(len = 7)              ::   cltype       ! type of data file 'daily', 'monthly' or yearly'
+      CHARACTER(len = 8)              ::   cltype       ! type of data file 'daily', 'monthly' or yearly'
       INTEGER                         ::   num          ! iom id of the jpfld files to be read
-      INTEGER                         ::   nswap_sec    ! swapping time in second since Jan. 1st 00h of nit000 year
       INTEGER , DIMENSION(2)          ::   nrec_b       ! before record (1: index, 2: second since Jan. 1st 00h of nit000 year)
       INTEGER , DIMENSION(2)          ::   nrec_a       ! after  record (1: index, 2: second since Jan. 1st 00h of nit000 year)
-      REAL(wp) , ALLOCATABLE, DIMENSION(:,:)   ::   fnow         ! input fields interpolated to now time step
-      REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:) ::   fdta         ! 2 consecutive record of input fields
+      REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:  ) ::   fnow       ! input fields interpolated to now time step
+      REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:,:) ::   fdta       ! 2 consecutive record of input fields
       CHARACTER(len = 256)            ::   wgtname      ! current name of the NetCDF weight file acting as a key
                                                         ! into the WGTLIST structure
       CHARACTER(len = 34)             ::   vcomp        ! symbolic name for a vector component that needs rotation
-      LOGICAL ,  DIMENSION(2)         ::   rotn         ! flag to indicate whether field has been rotated
+      LOGICAL                         ::   rotn         ! flag to indicate whether field has been rotated
    END TYPE FLD
 
@@ -71,13 +71,13 @@
       INTEGER                                 ::   numwgt       ! number of weights (4=bilinear, 16=bicubic)
       INTEGER                                 ::   nestid       ! for agrif, keep track of nest we're in
-      INTEGER                                 ::   offset       ! =0 when cyclic grid has coincident first/last columns, 
-                                                                ! =1 when they assumed to be one grid spacing apart      
-                                                                ! =-1 otherwise
+      INTEGER                                 ::   overlap      ! =0 when cyclic grid has no overlapping EW columns
+                                                                ! =>1 when they have one or more overlapping columns      
+                                                                ! =-1 not cyclic
       LOGICAL                                 ::   cyclic       ! east-west cyclic or not
-      INTEGER, DIMENSION(:,:,:), POINTER      ::   data_jpi     ! array of source integers
-      INTEGER, DIMENSION(:,:,:), POINTER      ::   data_jpj     ! array of source integers
+      INTEGER,  DIMENSION(:,:,:), POINTER     ::   data_jpi     ! array of source integers
+      INTEGER,  DIMENSION(:,:,:), POINTER     ::   data_jpj     ! array of source integers
       REAL(wp), DIMENSION(:,:,:), POINTER     ::   data_wgt     ! array of weights on model grid
-      REAL(wp), DIMENSION(:,:), POINTER       ::   fly_dta      ! array of values on input grid
-      REAL(wp), DIMENSION(:,:), POINTER       ::   col2         ! temporary array for reading in columns
+      REAL(wp), DIMENSION(:,:,:), POINTER     ::   fly_dta      ! array of values on input grid
+      REAL(wp), DIMENSION(:,:,:), POINTER     ::   col          ! temporary array for reading in columns
    END TYPE WGT
 
@@ -91,7 +91,7 @@
 
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2006) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -114,11 +114,6 @@
       TYPE(FLD), INTENT(inout), DIMENSION(:) ::   sd        ! input field related variables
       !!
-      CHARACTER (LEN=34)                     ::   acomp     ! dummy weight name
-      INTEGER                                ::   kf, nf    ! dummy indices
-      INTEGER                                ::   imf       ! size of the structure sd
-      REAL(wp), DIMENSION(jpi,jpj)           ::   utmp, vtmp! temporary arrays for vector rotation
-
+      INTEGER  ::   imf        ! size of the structure sd
       INTEGER  ::   jf         ! dummy indices
-      INTEGER  ::   kw         ! index into wgts array
       INTEGER  ::   ireclast   ! last record to be read in the current year file
       INTEGER  ::   isecend    ! number of second since Jan. 1st 00h of nit000 year at nitend
@@ -131,175 +126,128 @@
       CHARACTER(LEN=1000) ::   clfmt   ! write format
       !!---------------------------------------------------------------------
-      !
+      ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar 
+      isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rdttra(1))   ! middle of sbc time step
       imf = SIZE( sd )
-      isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rdttra(1))   ! centrered in the middle of sbc time step
-      !
-      !                                         ! ===================== !
-      DO jf = 1, imf                            !    LOOP OVER FIELD    !
-         !                                      ! ===================== !
-         !
-         IF( kt == nit000 )   CALL fld_init( kn_fsbc, sd(jf) )
-         !
-         ! read/update the after data?
-         IF( isecsbc > sd(jf)%nswap_sec ) THEN 
-
-            IF( sd(jf)%ln_tint ) THEN         ! time interpolation: swap before record field
+      !
+      IF( kt == nit000 ) THEN                      ! initialization
+         DO jf = 1, imf 
+            CALL fld_init( kn_fsbc, sd(jf) )       ! read each before field (put them in after as they will be swapped)
+         END DO
+         IF( lwp ) CALL wgt_print()                ! control print
+         CALL fld_rot( kt, sd )                    ! rotate vector fiels if needed
+      ENDIF
+      !                                            ! ====================================== !
+      IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN         ! update field at each kn_fsbc time-step !
+         !                                         ! ====================================== !
+         !
+         DO jf = 1, imf                            ! ---   loop over field   --- !
+            
+            IF( isecsbc > sd(jf)%nrec_a(2) .OR. kt == nit000 ) THEN  ! read/update the after data?
+
+               IF( sd(jf)%ln_tint ) THEN                             ! swap before record field and informations
+                  sd(jf)%nrec_b(:) = sd(jf)%nrec_a(:)
 !CDIR COLLAPSE
-               sd(jf)%fdta(:,:,1) = sd(jf)%fdta(:,:,2)
-               sd(jf)%rotn(1)     = sd(jf)%rotn(2)
+                  sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2)
+               ENDIF
+
+               CALL fld_rec( kn_fsbc, sd(jf) )                       ! update record informations
+
+               ! do we have to change the year/month/week/day of the forcing field?? 
+               IF( sd(jf)%ln_tint ) THEN
+                  ! if we do time interpolation we will need to open next year/month/week/day file before the end of the current
+                  ! one. If so, we are still before the end of the year/month/week/day when calling fld_rec so sd(jf)%nrec_a(1)
+                  ! will be larger than the record number that should be read for current year/month/week/day
+
+                  ! last record to be read in the current file
+                  IF    ( sd(jf)%nfreqh == -12 ) THEN                 ;   ireclast = 1    !  yearly mean
+                  ELSEIF( sd(jf)%nfreqh ==  -1 ) THEN                                     ! monthly mean
+                     IF(     sd(jf)%cltype      == 'monthly' ) THEN   ;   ireclast = 1
+                     ELSE                                             ;   ireclast = 12
+                     ENDIF
+                  ELSE                                                                    ! higher frequency mean (in hours)
+                     IF(     sd(jf)%cltype      == 'monthly' ) THEN   ;   ireclast = 24 * nmonth_len(nmonth) / sd(jf)%nfreqh 
+                     ELSEIF( sd(jf)%cltype(1:4) == 'week'    ) THEN   ;   ireclast = 24 * 7                  / sd(jf)%nfreqh
+                     ELSEIF( sd(jf)%cltype      == 'daily'   ) THEN   ;   ireclast = 24                      / sd(jf)%nfreqh
+                     ELSE                                             ;   ireclast = 24 * nyear_len(     1 ) / sd(jf)%nfreqh 
+                     ENDIF
+                  ENDIF
+
+                  ! do we need next file data?
+                  IF( sd(jf)%nrec_a(1) > ireclast ) THEN
+
+                     sd(jf)%nrec_a(1) = 1              ! force to read the first record of the next file
+
+                     IF( .NOT. sd(jf)%ln_clim ) THEN   ! close the current file and open a new one.
+
+                        llnxtmth = sd(jf)%cltype == 'monthly' .OR. nday == nmonth_len(nmonth)      ! open next month file?
+                        llnxtyr  = sd(jf)%cltype == 'yearly'  .OR. (nmonth == 12 .AND. llnxtmth)   ! open next year  file?
+
+                        ! if the run finishes at the end of the current year/month/week/day, we will allow next
+                        ! year/month/week/day file to be not present. If the run continue further than the current
+                        ! year/month/week/day, next year/month/week/day file must exist
+                        isecend = nsec_year + nsec1jan000 + (nitend - kt) * NINT(rdttra(1))   ! second at the end of the run 
+                        llstop = isecend > sd(jf)%nrec_a(2)                                   ! read more than 1 record of next year
+
+                        CALL fld_clopn( sd(jf), nyear  + COUNT((/llnxtyr /))                                           ,         &
+                           &                    nmonth + COUNT((/llnxtmth/)) - 12                 * COUNT((/llnxtyr /)),         &
+                           &                    nday   + 1                   - nmonth_len(nmonth) * COUNT((/llnxtmth/)), llstop )
+
+                        IF( sd(jf)%num <= 0 .AND. .NOT. llstop ) THEN    ! next year file does not exist
+                           CALL ctl_warn('next year/month/week/day file: '//TRIM(sd(jf)%clname)//     &
+                              &     ' not present -> back to current year/month/day')
+                           CALL fld_clopn( sd(jf), nyear, nmonth, nday )       ! back to the current year/month/day
+                           sd(jf)%nrec_a(1) = ireclast     ! force to read the last record to be read in the current year file
+                        ENDIF
+
+                     ENDIF
+                  ENDIF
+
+               ELSE
+                  ! if we are not doing time interpolation, we must change the year/month/week/day of the file just after
+                  ! switching to the NEW year/month/week/day. If it is the case, we are at the beginning of the
+                  ! year/month/week/day when calling fld_rec so sd(jf)%nrec_a(1) = 1
+                  IF( sd(jf)%nrec_a(1) == 1 .AND. .NOT. ( sd(jf)%ln_clim .AND. sd(jf)%cltype == 'yearly' ) )   &
+                     &   CALL fld_clopn( sd(jf), nyear, nmonth, nday )
+               ENDIF
+
+               ! read after data
+               CALL fld_get( sd(jf) )
+
             ENDIF
-
-            ! update record informations
-            CALL fld_rec( kn_fsbc, sd(jf) )
-
-            ! do we have to change the year/month/day of the forcing field?? 
-            IF( sd(jf)%ln_tint ) THEN
-               ! if we do time interpolation we will need to open next year/month/day file before the end of the current one
-               ! if so, we are still before the end of the year/month/day when calling fld_rec so sd(jf)%nrec_a(1) will be
-               ! larger than the record number that should be read for current year/month/day (for ex. 13 for monthly mean file)
-
-               ! last record to be read in the current file
-               IF( sd(jf)%nfreqh == -1 ) THEN                  ;   ireclast = 12
-               ELSE                             
-                  IF(     sd(jf)%cltype == 'monthly'   ) THEN  ;   ireclast = 24 * nmonth_len(nmonth) / sd(jf)%nfreqh 
-                  ELSEIF( sd(jf)%cltype == 'daily'     ) THEN  ;   ireclast = 24                      / sd(jf)%nfreqh
-                  ELSE                                         ;   ireclast = 24 * nyear_len(     1 ) / sd(jf)%nfreqh 
-                  ENDIF
-               ENDIF
-              
-               ! do we need next file data?
-               IF( sd(jf)%nrec_a(1) > ireclast ) THEN
-
-                  sd(jf)%nrec_a(1) = 1              ! force to read the first record of the next file
-
-                  IF( .NOT. sd(jf)%ln_clim ) THEN   ! close the current file and open a new one.
-
-                     llnxtmth = sd(jf)%cltype == 'monthly' .OR. nday == nmonth_len(nmonth)      ! open next month file?
-                     llnxtyr  = sd(jf)%cltype == 'yearly'  .OR. (nmonth == 12 .AND. llnxtmth)   ! open next year  file?
-
-                     ! if the run finishes at the end of the current year/month/day, we will allow next year/month/day file to be
-                     ! not present. If the run continue further than the current year/month/day, next year/month/day file must exist
-                     isecend = nsec_year + nsec1jan000 + (nitend - kt) * NINT(rdttra(1))   ! second at the end of the run 
-                     llstop = isecend > sd(jf)%nswap_sec                                   ! read more than 1 record of next year
-
-                     CALL fld_clopn( sd(jf), nyear  + COUNT((/llnxtyr /))                                           ,         &
-                        &                    nmonth + COUNT((/llnxtmth/)) - 12                 * COUNT((/llnxtyr /)),         &
-                        &                    nday   + 1                   - nmonth_len(nmonth) * COUNT((/llnxtmth/)), llstop )
-
-                     IF( sd(jf)%num <= 0 .AND. .NOT. llstop ) THEN    ! next year file does not exist
-                        CALL ctl_warn('next year/month/day file: '//TRIM(sd(jf)%clname)//     &
-                                &     ' not present -> back to current year/month/day')
-                        CALL fld_clopn( sd(jf), nyear, nmonth, nday )       ! back to the current year/month/day
-                        sd(jf)%nrec_a(1) = ireclast     ! force to read the last record to be read in the current year file
-                     ENDIF
-
-                  ENDIF 
-               ENDIF
-        
-            ELSE
-               ! if we are not doing time interpolation, we must change the year/month/day of the file just after switching
-               ! to the NEW year/month/day. If it is the case, we are at the beginning of the year/month/day when calling 
-               ! fld_rec so sd(jf)%nrec_a(1) = 1
-               IF( sd(jf)%nrec_a(1) == 1 .AND. .NOT. sd(jf)%ln_clim )   CALL fld_clopn( sd(jf), nyear, nmonth, nday )
-            ENDIF
-
-            ! read after data
-            IF( LEN(TRIM(sd(jf)%wgtname)) > 0 ) THEN
-               CALL wgt_list( sd(jf), kw )
-               CALL fld_interp( sd(jf)%num, sd(jf)%clvar, kw, sd(jf)%fdta(:,:,2), sd(jf)%nrec_a(1) )
-            ELSE
-               CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,2), sd(jf)%nrec_a(1) )
-            ENDIF
-            sd(jf)%rotn(2) = .FALSE.
-
-         ENDIF
-         !                                      ! ===================== !
-      END DO                                    !  END LOOP OVER FIELD  !
-      !                                         ! ===================== !
-
-      IF( kt == nit000 .AND. lwp ) CALL wgt_print()
-
-      !! Vector fields may need to be rotated onto the local grid direction
-      !! This has to happen before the time interpolations
-      !! (sga: following code should be modified so that pairs arent searched for each time
-
-      DO jf = 1, imf
-         !! find vector rotations required 
-         IF( LEN(TRIM(sd(jf)%vcomp)) > 0 ) THEN
-             !! east-west component has symbolic name starting with 'U'
-             IF( sd(jf)%vcomp(1:1) == 'U' ) THEN
-                !! found an east-west component, look for the north-south component
-                !! which has same symbolic name but with 'U' replaced with 'V'
-                nf = LEN_TRIM( sd(jf)%vcomp )
-                IF( nf == 1) THEN
-                   acomp = 'V'
-                ELSE
-                   acomp = 'V' // sd(jf)%vcomp(2:nf)
-                ENDIF
-                kf = -1
-                DO nf = 1, imf
-                  IF( TRIM(sd(nf)%vcomp) == TRIM(acomp) ) kf = nf
-                END DO
-                IF( kf > 0 ) THEN
-                   !! fields jf,kf are two components which need to be rotated together
-                   DO nf = 1,2
-                      !! check each time level of this pair
-                      IF( .NOT. sd(jf)%rotn(nf) .AND. .NOT. sd(kf)%rotn(nf) ) THEN
-                         utmp(:,:) = 0.0
-                         vtmp(:,:) = 0.0
-                         CALL rot_rep( sd(jf)%fdta(:,:,nf), sd(kf)%fdta(:,:,nf), 'T', 'en->i', utmp(:,:) )
-                         CALL rot_rep( sd(jf)%fdta(:,:,nf), sd(kf)%fdta(:,:,nf), 'T', 'en->j', vtmp(:,:) )
-                         sd(jf)%fdta(:,:,nf) = utmp(:,:)
-                         sd(kf)%fdta(:,:,nf) = vtmp(:,:)
-                         sd(jf)%rotn(nf) = .TRUE.
-                         sd(kf)%rotn(nf) = .TRUE.
-                         IF( lwp .AND. kt == nit000 ) &
-                                   WRITE(numout,*) 'fld_read: vector pair (',  &
-                                                   TRIM(sd(jf)%clvar),',',TRIM(sd(kf)%clvar), &
-                                                   ') rotated on to model grid'
-                      ENDIF
-                   END DO
-                ENDIF
-             ENDIF
-         ENDIF
-      END DO
-
-      !                                         ! ===================== !
-      DO jf = 1, imf                            !    LOOP OVER FIELD    !
-         !                                      ! ===================== !
-         !
-         ! update field at each kn_fsbc time-step
-         IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN   
+         END DO                                    ! --- end loop over field --- !
+
+         CALL fld_rot( kt, sd )                    ! rotate vector fiels if needed
+
+         DO jf = 1, imf                            ! ---   loop over field   --- !
             !
-            IF( sd(jf)%ln_tint ) THEN
+            IF( sd(jf)%ln_tint ) THEN              ! temporal interpolation
                IF(lwp .AND. kt - nit000 <= 100 ) THEN 
-                  clfmt = "('fld_read: var ', a, ' kt = ', i8,' Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," //   &
-                     &    "' records b/a: ', i4.4, '/', i4.4, ' (', f7.2,'/', f7.2, ' days)')"
-                  WRITE(numout, clfmt)  TRIM( sd(jf)%clvar ), kt, nyear, nmonth, nday,   &
+                  clfmt = "('fld_read: var ', a, ' kt = ', i8, ' (', f7.2,' days), Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," //   &
+                     &    "', records b/a: ', i4.4, '/', i4.4, ' (days ', f7.2,'/', f7.2, ')')"
+                  WRITE(numout, clfmt)  TRIM( sd(jf)%clvar ), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday,   &
                      & sd(jf)%nrec_b(1), sd(jf)%nrec_a(1), REAL(sd(jf)%nrec_b(2),wp)/rday, REAL(sd(jf)%nrec_a(2),wp)/rday
                ENDIF
-               !
+               ! temporal interpolation weights
                ztinta =  REAL( isecsbc - sd(jf)%nrec_b(2), wp ) / REAL( sd(jf)%nrec_a(2) - sd(jf)%nrec_b(2), wp )
                ztintb =  1. - ztinta
 !CDIR COLLAPSE
-               sd(jf)%fnow(:,:) = ztintb * sd(jf)%fdta(:,:,1) + ztinta * sd(jf)%fdta(:,:,2)
-            ELSE
+               sd(jf)%fnow(:,:,:) = ztintb * sd(jf)%fdta(:,:,:,1) + ztinta * sd(jf)%fdta(:,:,:,2)
+            ELSE   ! nothing to do...
                IF(lwp .AND. kt - nit000 <= 100 ) THEN
-                  clfmt = "('fld_read: var ', a, ' kt = ', i8,' Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," //   &
-                     &    "' record: ', i4.4, ' at ', f7.2, ' day')"
-                  WRITE(numout, clfmt) TRIM(sd(jf)%clvar), kt, nyear, nmonth, nday, sd(jf)%nrec_a(1), REAL(sd(jf)%nrec_a(2),wp)/rday
+                  clfmt = "('fld_read: var ', a, ' kt = ', i8,' (', f7.2,' days), Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," //   &
+                     &    "', record: ', i4.4, ' (days ', f7.2, ' <-> ', f7.2, ')')"
+                  WRITE(numout, clfmt) TRIM(sd(jf)%clvar), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday,    &
+                     &                 sd(jf)%nrec_a(1), REAL(sd(jf)%nrec_b(2),wp)/rday, REAL(sd(jf)%nrec_a(2),wp)/rday
                ENDIF
-!CDIR COLLAPSE
-               sd(jf)%fnow(:,:) = sd(jf)%fdta(:,:,2)   ! piecewise constant field
- 
             ENDIF
             !
-         ENDIF
-
-         IF( kt == nitend )   CALL iom_close( sd(jf)%num )   ! Close the input files
-
-         !                                      ! ===================== !
-      END DO                                    !  END LOOP OVER FIELD  !
-      !                                         ! ===================== !
+            IF( kt == nitend - kn_fsbc + 1 )   CALL iom_close( sd(jf)%num )   ! Close the input files
+
+         END DO                                    ! --- end loop over field --- !
+         !
+         !                                         ! ====================================== !
+      ENDIF                                        ! update field at each kn_fsbc time-step !
+      !                                            ! ====================================== !
+      !
    END SUBROUTINE fld_read
 
@@ -314,69 +262,97 @@
       !! ** Method  :   
       !!----------------------------------------------------------------------
-      INTEGER  , INTENT(in   ) ::   kn_fsbc     ! sbc computation period (in time step) 
-      TYPE(FLD), INTENT(inout) ::   sdjf        ! input field related variables
-      !!
-      LOGICAL :: llprevyr       ! are we reading previous year  file?
-      LOGICAL :: llprevmth      ! are we reading previous month file?
-      LOGICAL :: llprevday      ! are we reading previous day   file?
-      LOGICAL :: llprev         ! llprevyr .OR. llprevmth .OR. llprevday
-      INTEGER :: idvar          ! variable id 
-      INTEGER :: inrec          ! number of record existing for this variable
-      INTEGER :: kwgt
+      INTEGER  , INTENT(in   ) ::   kn_fsbc   ! sbc computation period (in time step) 
+      TYPE(FLD), INTENT(inout) ::   sdjf      ! input field related variables
+      !!
+      LOGICAL :: llprevyr              ! are we reading previous year  file?
+      LOGICAL :: llprevmth             ! are we reading previous month file?
+      LOGICAL :: llprevweek            ! are we reading previous week  file?
+      LOGICAL :: llprevday             ! are we reading previous day   file?
+      LOGICAL :: llprev                ! llprevyr .OR. llprevmth .OR. llprevweek .OR. llprevday
+      INTEGER :: idvar                 ! variable id 
+      INTEGER :: inrec                 ! number of record existing for this variable
+      INTEGER :: iyear, imonth, iday   ! first day of the current file in yyyy mm dd
+      INTEGER :: isec_week             ! number of seconds since start of the weekly file
       CHARACTER(LEN=1000) ::   clfmt   ! write format
       !!---------------------------------------------------------------------
-
+      
       ! some default definitions...
       sdjf%num = 0   ! default definition for non-opened file
       IF( sdjf%ln_clim )   sdjf%clname = TRIM( sdjf%clrootname )   ! file name defaut definition, never change in this case
-      llprevyr  = .FALSE.
-      llprevmth = .FALSE.
-      llprevday = .FALSE.
+      llprevyr   = .FALSE.
+      llprevmth  = .FALSE.
+      llprevweek = .FALSE.
+      llprevday  = .FALSE.
+      isec_week  = 0
             
+      IF( sdjf%cltype(1:4) == 'week' .AND. nn_leapy == 0 )   &
+         &   CALL ctl_stop('fld_clopn: weekly file ('//TRIM(sdjf%clrootname)//') needs nn_leapy = 1')
+      IF( sdjf%cltype(1:4) == 'week' .AND. sdjf%ln_clim  )   &
+         &   CALL ctl_stop('fld_clopn: weekly file ('//TRIM(sdjf%clrootname)//') needs ln_clim = .FALSE.')
+
       ! define record informations
-      CALL fld_rec( kn_fsbc, sdjf )
-
-      ! Note: shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar 
+      CALL fld_rec( kn_fsbc, sdjf, ldbefore = .TRUE. )  ! return before values in sdjf%nrec_a (as we will swap it later)
+
+      ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar 
 
       IF( sdjf%ln_tint ) THEN ! we need to read the previous record and we will put it in the current record structure
-         
-         IF( sdjf%nrec_b(1) == 0  ) THEN   ! we redefine record sdjf%nrec_b(1) with the last record of previous year file
-            IF( sdjf%nfreqh == -1 ) THEN   ! monthly mean
-               IF( sdjf%cltype == 'monthly' ) THEN   ! monthly file
-                  sdjf%nrec_b(1) = 1                                                       ! force to read the unique record
-                  llprevmth = .NOT. sdjf%ln_clim                                           ! use previous month file?
+
+         IF( sdjf%nrec_a(1) == 0  ) THEN   ! we redefine record sdjf%nrec_a(1) with the last record of previous year file
+            IF    ( sdjf%nfreqh == -12 ) THEN   ! yearly mean
+               IF( sdjf%cltype == 'yearly' ) THEN             ! yearly file
+                  sdjf%nrec_a(1) = 1                                                       ! force to read the unique record
+                  llprevyr  = .NOT. sdjf%ln_clim                                           ! use previous year  file?
+               ELSE
+                  CALL ctl_stop( "fld_init: yearly mean file must be in a yearly type of file: "//TRIM(sdjf%clname) )
+               ENDIF
+            ELSEIF( sdjf%nfreqh ==  -1 ) THEN   ! monthly mean
+               IF( sdjf%cltype == 'monthly' ) THEN            ! monthly file
+                  sdjf%nrec_a(1) = 1                                                       ! force to read the unique record
+                  llprevmth = .TRUE.                                                       ! use previous month file?
                   llprevyr  = llprevmth .AND. nmonth == 1                                  ! use previous year  file?
-               ELSE                                  ! yearly file
-                  sdjf%nrec_b(1) = 12                                                      ! force to read december mean
+               ELSE                                           ! yearly file
+                  sdjf%nrec_a(1) = 12                                                      ! force to read december mean
                   llprevyr = .NOT. sdjf%ln_clim                                            ! use previous year  file?
                ENDIF
-            ELSE   
-               IF( sdjf%cltype == 'monthly' ) THEN   ! monthly file
-                  sdjf%nrec_b(1) = 24 * nmonth_len(nmonth-1) / sdjf%nfreqh                 ! last record of previous month
-                  llprevmth = .NOT. sdjf%ln_clim                                           ! use previous month file?
+            ELSE                                ! higher frequency mean (in hours) 
+               IF    ( sdjf%cltype      == 'monthly' ) THEN   ! monthly file
+                  sdjf%nrec_a(1) = 24 * nmonth_len(nmonth-1) / sdjf%nfreqh                 ! last record of previous month
+                  llprevmth = .TRUE.                                                       ! use previous month file?
                   llprevyr  = llprevmth .AND. nmonth == 1                                  ! use previous year  file?
-               ELSEIF( sdjf%cltype == 'daily' ) THEN ! daily file
-                  sdjf%nrec_b(1) = 24 / sdjf%nfreqh                                        ! last record of previous day
-                  llprevday = .NOT. sdjf%ln_clim                                           ! use previous day   file?
+               ELSEIF( sdjf%cltype(1:4) == 'week'    ) THEN   ! weekly file
+                  llprevweek = .TRUE.                                                      ! use previous week  file?
+                  sdjf%nrec_a(1) = 24 * 7 / sdjf%nfreqh                                    ! last record of previous week
+                  isec_week = NINT(rday) * 7                                               ! add a shift toward previous week
+               ELSEIF( sdjf%cltype      == 'daily'   ) THEN   ! daily file
+                  sdjf%nrec_a(1) = 24 / sdjf%nfreqh                                        ! last record of previous day
+                  llprevday = .TRUE.                                                       ! use previous day   file?
                   llprevmth = llprevday .AND. nday   == 1                                  ! use previous month file?
                   llprevyr  = llprevmth .AND. nmonth == 1                                  ! use previous year  file?
-               ELSE                                  ! yearly file
-                  sdjf%nrec_b(1) = 24 * nyear_len(0) / sdjf%nfreqh                         ! last record of year month
+               ELSE                                           ! yearly file
+                  sdjf%nrec_a(1) = 24 * nyear_len(0) / sdjf%nfreqh                         ! last record of previous year 
                   llprevyr = .NOT. sdjf%ln_clim                                            ! use previous year  file?
                ENDIF
             ENDIF
          ENDIF
-         llprev = llprevyr .OR. llprevmth .OR. llprevday
-
-         CALL fld_clopn( sdjf, nyear  - COUNT((/llprevyr /))                                              ,               &
-            &                  nmonth - COUNT((/llprevmth/)) + 12                   * COUNT((/llprevyr /)),               &
-            &                  nday   - COUNT((/llprevday/)) + nmonth_len(nmonth-1) * COUNT((/llprevmth/)), .NOT. llprev )
-         
+         IF ( sdjf%cltype(1:4) == 'week' ) THEN
+            isec_week = isec_week + ksec_week( sdjf%cltype(6:8) )   ! second since the beginning of the week
+            llprevmth = isec_week > nsec_month                      ! longer time since the beginning of the week than the month
+            llprevyr  = llprevmth .AND. nmonth == 1
+         ENDIF
+         llprev = llprevyr .OR. llprevmth .OR. llprevweek .OR. llprevday
+         !
+         iyear  = nyear  - COUNT((/llprevyr /))
+         imonth = nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr /))
+         iday   = nday   - COUNT((/llprevday/)) + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - isec_week / NINT(rday)
+         !
+         CALL fld_clopn( sdjf, iyear, imonth, iday, .NOT. llprev )
+
          ! if previous year/month/day file does not exist, we switch to the current year/month/day
          IF( llprev .AND. sdjf%num <= 0 ) THEN
-            CALL ctl_warn( 'previous year/month/day file: '//TRIM(sdjf%clname)//' not present -> back to current year/month/day')
+            CALL ctl_warn( 'previous year/month/week/day file: '//TRIM(sdjf%clname)//   &
+               &           ' not present -> back to current year/month/week/day' )
             ! we force to read the first record of the current year/month/day instead of last record of previous year/month/day
-            llprev = .false.
-            sdjf%nrec_b(1) = 1
+            llprev = .FALSE.
+            sdjf%nrec_a(1) = 1
             CALL fld_clopn( sdjf, nyear, nmonth, nday )
          ENDIF
@@ -386,50 +362,103 @@
             IF( idvar <= 0 )   RETURN
             inrec = iom_file( sdjf%num )%dimsz( iom_file( sdjf%num )%ndims(idvar), idvar )   ! size of the last dim of idvar
-            sdjf%nrec_b(1) = MIN( sdjf%nrec_b(1), inrec )   ! make sure we select an existing record
-         ENDIF
-
-         ! read before data into sdjf%fdta(:,:,2) because we will swap data in the following part of fld_read
-         IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN
-            CALL wgt_list( sdjf, kwgt )
-            CALL fld_interp( sdjf%num, sdjf%clvar, kwgt, sdjf%fdta(:,:,2), sdjf%nrec_b(1) )
+            sdjf%nrec_a(1) = MIN( sdjf%nrec_a(1), inrec )   ! make sure we select an existing record
+         ENDIF
+
+         ! read before data 
+         CALL fld_get( sdjf )  ! read before values in after arrays(as we will swap it later)
+
+         clfmt = "('fld_init : time-interpolation for ', a, ' read previous record = ', i4, ' at time = ', f7.2, ' days')"
+         IF(lwp) WRITE(numout, clfmt) TRIM(sdjf%clvar), sdjf%nrec_a(1), REAL(sdjf%nrec_a(2),wp)/rday
+
+         IF( llprev )   CALL iom_close( sdjf%num )          ! force to close previous year file (-> redefine sdjf%num to 0)
+
+      ENDIF
+
+      ! make sure current year/month/day file is opened
+      IF( sdjf%num <= 0 ) THEN
+         !
+         IF ( sdjf%cltype(1:4) == 'week' ) THEN
+            isec_week  = ksec_week( sdjf%cltype(6:8) )      ! second since the beginning of the week
+            llprevmth  = isec_week > nsec_month             ! longer time since beginning of the week than the month
+            llprevyr   = llprevmth .AND. nmonth == 1
          ELSE
-            CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,2), sdjf%nrec_b(1) )
-         ENDIF
-         sdjf%rotn(2) = .FALSE.
-
-         clfmt = "('fld_init : time-interpolation for ', a, ' read previous record = ', i4, ' at time = ', f7.2, ' days')"
-         IF(lwp) WRITE(numout, clfmt) TRIM(sdjf%clvar), sdjf%nrec_b(1), REAL(sdjf%nrec_b(2),wp)/rday
-
-         IF( llprev )   CALL iom_close( sdjf%num )   ! close previous year file (-> redefine sdjf%num to 0)
-
+            isec_week  = 0
+            llprevmth  = .FALSE.
+            llprevyr   = .FALSE.
+         ENDIF
+         !
+         iyear  = nyear  - COUNT((/llprevyr /))
+         imonth = nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr /))
+         iday   = nday   + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - isec_week / NINT(rday)
+         !
+         CALL fld_clopn( sdjf, iyear, imonth, iday )
+      ENDIF 
+
+   END SUBROUTINE fld_init
+
+
+   SUBROUTINE fld_rec( kn_fsbc, sdjf, ldbefore )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE fld_rec  ***
+      !!
+      !! ** Purpose : Compute
+      !!              if sdjf%ln_tint = .TRUE.
+      !!                  nrec_a: record number and its time (nrec_b is obtained from nrec_a when swapping)
+      !!              if sdjf%ln_tint = .FALSE.
+      !!                  nrec_a(1): record number
+      !!                  nrec_b(2) and nrec_a(2): time of the beginning and end of the record (for print only)
+      !!
+      !! ** Method  :   
+      !!----------------------------------------------------------------------
+      INTEGER  , INTENT(in   )           ::   kn_fsbc   ! sbc computation period (in time step) 
+      TYPE(FLD), INTENT(inout)           ::   sdjf      ! input field related variables
+      LOGICAL  , INTENT(in   ), OPTIONAL ::   ldbefore  ! sent back before record values (default = .FALSE.)
+                                                        ! used only if sdjf%ln_tint = .TRUE.
+      !!
+      LOGICAL  ::   llbefore    ! local definition of ldbefore
+      INTEGER  ::   iendrec     ! end of this record (in seconds)
+      INTEGER  ::   imth        ! month number
+      INTEGER  ::   ifreq_sec   ! frequency mean (in seconds)
+      INTEGER  ::   isec_week   ! number of seconds since the start of the weekly file
+      REAL(wp) ::   ztmp        ! temporary variable
+      !!----------------------------------------------------------------------
+      !
+      ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar 
+      !
+      IF( PRESENT(ldbefore) ) THEN   ;   llbefore = ldbefore .AND. sdjf%ln_tint   ! needed only if sdjf%ln_tint = .TRUE.
+      ELSE                           ;   llbefore = .FALSE.
       ENDIF
-
-      IF( sdjf%num <= 0 )   CALL fld_clopn( sdjf, nyear, nmonth, nday )   ! make sure current year/month/day file is opened
-
-      sdjf%nswap_sec = nsec_year + nsec1jan000 - 1   ! force read/update the after data in the following part of fld_read 
-      
-   END SUBROUTINE fld_init
-
-
-   SUBROUTINE fld_rec( kn_fsbc, sdjf )
-      !!---------------------------------------------------------------------
-      !!                    ***  ROUTINE fld_rec  ***
-      !!
-      !! ** Purpose :   compute nrec_a, nrec_b and nswap_sec
-      !!
-      !! ** Method  :   
-      !!----------------------------------------------------------------------
-      INTEGER  , INTENT(in   ) ::   kn_fsbc     ! sbc computation period (in time step) 
-      TYPE(FLD), INTENT(inout) ::   sdjf        ! input field related variables
-      !!
-      INTEGER  ::   irec        ! record number
-      INTEGER  ::   isecd       ! rday
-      REAL(wp) ::   ztmp        ! temporary variable
-      INTEGER  ::   ifreq_sec   ! frequency mean (in seconds)
-      !!----------------------------------------------------------------------
-      !
-      ! Note: shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar 
-      !
-      IF( sdjf%nfreqh == -1 ) THEN      ! monthly mean
+      !
+      !                                      ! =========== !
+      IF    ( sdjf%nfreqh == -12 ) THEN      ! yearly mean
+         !                                   ! =========== !
+         !
+         IF( sdjf%ln_tint ) THEN                 ! time interpolation, shift by 1/2 record
+            !
+            !                  INT( ztmp )
+            !                     /|\
+            !                    1 |    *----
+            !                    0 |----(              
+            !                      |----+----|--> time
+            !                      0   /|\   1   (nday/nyear_len(1))
+            !                           |   
+            !                           |   
+            !       forcing record :    1 
+            !                            
+            ztmp = REAL( nday, wp ) / REAL( nyear_len(1), wp ) + 0.5
+            sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/))
+            ! swap at the middle of the year
+            IF( llbefore ) THEN   ;   sdjf%nrec_a(2) = nsec1jan000 - NINT(0.5 * rday) * nyear_len(0)
+            ELSE                  ;   sdjf%nrec_a(2) = nsec1jan000 + NINT(0.5 * rday) * nyear_len(1)   
+            ENDIF
+         ELSE                                    ! no time interpolation
+            sdjf%nrec_a(1) = 1
+            sdjf%nrec_a(2) = NINT(rday) * nyear_len(1) + nsec1jan000   ! swap at the end    of the year
+            sdjf%nrec_b(2) = nsec1jan000                               ! beginning of the year (only for print)
+         ENDIF
+         !
+         !                                   ! ============ !
+      ELSEIF( sdjf%nfreqh ==  -1 ) THEN      ! monthly mean !
+         !                                   ! ============ !
          !
          IF( sdjf%ln_tint ) THEN                 ! time interpolation, shift by 1/2 record
@@ -445,25 +474,29 @@
             !       forcing record :  nmonth 
             !                            
-            ztmp  = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5
-         ELSE
-            ztmp  = 0.e0
-         ENDIF
-         irec = nmonth + INT( ztmp )
-
-         IF( sdjf%ln_tint ) THEN   ;   sdjf%nswap_sec = nmonth_half(irec) + nsec1jan000   ! swap at the middle of the month
-         ELSE                      ;   sdjf%nswap_sec = nmonth_end (irec) + nsec1jan000   ! swap at the end    of the month
-         ENDIF
-
-         sdjf%nrec_a(:) = (/ irec, nmonth_half(irec) + nsec1jan000 /)   ! define after  record number and time
-         irec = irec - 1                                                ! move back to previous record
-         sdjf%nrec_b(:) = (/ irec, nmonth_half(irec) + nsec1jan000 /)   ! define before record number and time
-         !
-      ELSE                              ! higher frequency mean (in hours)
-         !
-         ifreq_sec = sdjf%nfreqh * 3600   ! frequency mean (in seconds)
+            ztmp = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5
+            imth = nmonth + INT( ztmp ) - COUNT((/llbefore/))
+            IF( sdjf%cltype == 'monthly' ) THEN   ;   sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/))
+            ELSE                                  ;   sdjf%nrec_a(1) = imth
+            ENDIF
+            sdjf%nrec_a(2) = nmonth_half(   imth ) + nsec1jan000   ! swap at the middle of the month
+         ELSE                                    ! no time interpolation
+            IF( sdjf%cltype == 'monthly' ) THEN   ;   sdjf%nrec_a(1) = 1
+            ELSE                                  ;   sdjf%nrec_a(1) = nmonth
+            ENDIF
+            sdjf%nrec_a(2) =  nmonth_end(nmonth  ) + nsec1jan000   ! swap at the end    of the month
+            sdjf%nrec_b(2) =  nmonth_end(nmonth-1) + nsec1jan000   ! beginning of the month (only for print)
+         ENDIF
+         !
+         !                                   ! ================================ !
+      ELSE                                   ! higher frequency mean (in hours)
+         !                                   ! ================================ !
+         !
+         ifreq_sec = sdjf%nfreqh * 3600                                                 ! frequency mean (in seconds)
+         IF( sdjf%cltype(1:4) == 'week' )   isec_week = ksec_week( sdjf%cltype(6:8) )   ! since the first day of the current week
          ! number of second since the beginning of the file
-         IF(     sdjf%cltype == 'monthly' ) THEN   ;   ztmp = REAL(nsec_month,wp)   ! since 00h on the 1st day of the current month
-         ELSEIF( sdjf%cltype == 'daily'   ) THEN   ;   ztmp = REAL(nsec_day  ,wp)   ! since 00h of the current day
-         ELSE                                      ;   ztmp = REAL(nsec_year ,wp)   ! since 00h on Jan 1 of the current year
+         IF(     sdjf%cltype      == 'monthly' ) THEN   ;   ztmp = REAL(nsec_month,wp)  ! since the first day of the current month
+         ELSEIF( sdjf%cltype(1:4) == 'week'    ) THEN   ;   ztmp = REAL(isec_week ,wp)  ! since the first day of the current week
+         ELSEIF( sdjf%cltype      == 'daily'   ) THEN   ;   ztmp = REAL(nsec_day  ,wp)  ! since 00h of the current day
+         ELSE                                           ;   ztmp = REAL(nsec_year ,wp)  ! since 00h on Jan 1 of the current year
          ENDIF
          ztmp = ztmp + 0.5 * REAL(kn_fsbc - 1, wp) * rdttra(1)   ! shift time to be centrered in the middle of sbc time step
@@ -482,6 +515,6 @@
             !       forcing record :  1     2     3
             !                   
-            ztmp = ztmp / REAL(ifreq_sec, wp) + 0.5
-         ELSE                 
+            ztmp= ztmp / REAL(ifreq_sec, wp) + 0.5
+         ELSE                                   ! no time interpolation
             !
             !                  INT( ztmp )
@@ -496,28 +529,19 @@
             !       forcing record :  1     2     3
             !                            
-            ztmp = ztmp / REAL(ifreq_sec, wp)
-         ENDIF
-         irec = 1 + INT( ztmp )
-
-         isecd = NINT(rday)
-         ! after record index and second since Jan. 1st 00h of nit000 year
-         sdjf%nrec_a(:) = (/ irec, ifreq_sec * irec - ifreq_sec / 2 + nsec1jan000 /)
-         IF( sdjf%cltype == 'monthly' )   &   ! add the number of seconds between 00h Jan 1 and the end of previous month
-            sdjf%nrec_a(2) = sdjf%nrec_a(2) + isecd * SUM(nmonth_len(1:nmonth -1))   ! ok if nmonth=1
-         IF( sdjf%cltype == 'daily'   )   &   ! add the number of seconds between 00h Jan 1 and the end of previous day
-            sdjf%nrec_a(2) = sdjf%nrec_a(2) + isecd * ( nday_year - 1 )
-
-         ! before record index and second since Jan. 1st 00h of nit000 year
-         irec = irec - 1.                           ! move back to previous record
-         sdjf%nrec_b(:) = (/ irec, ifreq_sec * irec - ifreq_sec / 2 + nsec1jan000 /)
-         IF( sdjf%cltype == 'monthly' )   &   ! add the number of seconds between 00h Jan 1 and the end of previous month
-            sdjf%nrec_b(2) = sdjf%nrec_b(2) + isecd * SUM(nmonth_len(1:nmonth -1))   ! ok if nmonth=1
-         IF( sdjf%cltype == 'daily'   )   &   ! add the number of seconds between 00h Jan 1 and the end of previous day
-            sdjf%nrec_b(2) = sdjf%nrec_b(2) + isecd * ( nday_year - 1 )
-
-         ! swapping time in second since Jan. 1st 00h of nit000 year
-         IF( sdjf%ln_tint ) THEN   ;   sdjf%nswap_sec =  sdjf%nrec_a(2)                     ! swap at the middle of the record
-         ELSE                      ;   sdjf%nswap_sec =  sdjf%nrec_a(2) + ifreq_sec / 2     ! swap at the end    of the record
-         ENDIF       
+            ztmp= ztmp / REAL(ifreq_sec, wp)
+         ENDIF
+         sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/))   ! record nomber to be read
+
+         iendrec = ifreq_sec * sdjf%nrec_a(1) + nsec1jan000       ! end of this record (in second)
+         ! add the number of seconds between 00h Jan 1 and the end of previous month/week/day (ok if nmonth=1)
+         IF( sdjf%cltype      == 'monthly' )   iendrec = iendrec + NINT(rday) * SUM(nmonth_len(1:nmonth -1))
+         IF( sdjf%cltype(1:4) == 'week'    )   iendrec = iendrec + ( nsec_year - isec_week )
+         IF( sdjf%cltype      == 'daily'   )   iendrec = iendrec + NINT(rday) * ( nday_year - 1 )
+         IF( sdjf%ln_tint ) THEN
+             sdjf%nrec_a(2) = iendrec - ifreq_sec / 2        ! swap at the middle of the record
+         ELSE
+             sdjf%nrec_a(2) = iendrec                        ! swap at the end    of the record
+             sdjf%nrec_b(2) = iendrec - ifreq_sec            ! beginning of the record (only for print)
+         ENDIF
          !
       ENDIF
@@ -526,4 +550,95 @@
 
 
+   SUBROUTINE fld_get( sdjf )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE fld_clopn  ***
+      !!
+      !! ** Purpose :   read the data
+      !!
+      !! ** Method  :   
+      !!----------------------------------------------------------------------
+      TYPE(FLD), INTENT(inout)   ::   sdjf   ! input field related variables
+      !!
+      INTEGER                    ::   ipk    ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk )
+      INTEGER                    ::   iw     ! index into wgts array
+      !!---------------------------------------------------------------------
+            
+      ipk = SIZE( sdjf%fnow, 3 )
+      IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN
+         CALL wgt_list( sdjf, iw )
+         IF( sdjf%ln_tint ) THEN   ;   CALL fld_interp( sdjf%num, sdjf%clvar, iw , ipk  , sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) )
+         ELSE                      ;   CALL fld_interp( sdjf%num, sdjf%clvar, iw , ipk  , sdjf%fnow(:,:,:  ), sdjf%nrec_a(1) )
+         ENDIF
+      ELSE
+         SELECT CASE( ipk )
+         CASE(1)   
+            IF( sdjf%ln_tint ) THEN   ;   CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,1,2), sdjf%nrec_a(1) )
+            ELSE                      ;   CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fnow(:,:,1  ), sdjf%nrec_a(1) )
+            ENDIF
+         CASE DEFAULT
+            IF( sdjf%ln_tint ) THEN   ;   CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) )
+            ELSE                      ;   CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fnow(:,:,:  ), sdjf%nrec_a(1) )
+            ENDIF
+         END SELECT
+      ENDIF
+      !
+      sdjf%rotn = .false.   ! vector not yet rotated
+
+   END SUBROUTINE fld_get
+
+
+   SUBROUTINE fld_rot( kt, sd )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE fld_clopn  ***
+      !!
+      !! ** Purpose :   Vector fields may need to be rotated onto the local grid direction
+      !!
+      !! ** Method  :   
+      !!----------------------------------------------------------------------
+      INTEGER  , INTENT(in   )               ::   kt        ! ocean time step
+      TYPE(FLD), INTENT(inout), DIMENSION(:) ::   sd        ! input field related variables
+      !!
+      INTEGER                      ::   ju, jv, jk   ! loop indices
+      INTEGER                      ::   imf          ! size of the structure sd
+      INTEGER                      ::   ill          ! character length
+      INTEGER                      ::   iv           ! indice of V component
+      REAL(wp), DIMENSION(jpi,jpj) ::   utmp, vtmp   ! temporary arrays for vector rotation
+      CHARACTER (LEN=100)          ::   clcomp       ! dummy weight name
+      !!---------------------------------------------------------------------
+      !! (sga: following code should be modified so that pairs arent searched for each time
+      !
+      imf = SIZE( sd )
+      DO ju = 1, imf
+         ill = LEN_TRIM( sd(ju)%vcomp )
+         IF( ill > 0 .AND. .NOT. sd(ju)%rotn ) THEN   ! find vector rotations required             
+             IF( sd(ju)%vcomp(1:1) == 'U' ) THEN      ! east-west component has symbolic name starting with 'U'
+                ! look for the north-south component which has same symbolic name but with 'U' replaced with 'V'
+                clcomp = 'V' // sd(ju)%vcomp(2:ill)   ! works even if ill == 1
+                iv = -1
+                DO jv = 1, imf
+                  IF( TRIM(sd(jv)%vcomp) == TRIM(clcomp) )   iv = jv
+                END DO
+                IF( iv > 0 ) THEN   ! fields ju and iv are two components which need to be rotated together
+                   DO jk = 1, SIZE( sd(ju)%fnow, 3 )
+                      IF( sd(ju)%ln_tint )THEN
+                         CALL rot_rep( sd(ju)%fdta(:,:,jk,2), sd(iv)%fdta(:,:,jk,2), 'T', 'en->i', utmp(:,:) )
+                         CALL rot_rep( sd(ju)%fdta(:,:,jk,2), sd(iv)%fdta(:,:,jk,2), 'T', 'en->j', vtmp(:,:) )
+                         sd(ju)%fdta(:,:,jk,2) = utmp(:,:)   ;   sd(iv)%fdta(:,:,jk,2) = vtmp(:,:)
+                      ELSE 
+                         CALL rot_rep( sd(ju)%fnow(:,:,jk  ), sd(iv)%fnow(:,:,jk  ), 'T', 'en->i', utmp(:,:) )
+                         CALL rot_rep( sd(ju)%fnow(:,:,jk  ), sd(iv)%fnow(:,:,jk  ), 'T', 'en->j', vtmp(:,:) )
+                         sd(ju)%fnow(:,:,jk  ) = utmp(:,:)   ;   sd(iv)%fnow(:,:,jk  ) = vtmp(:,:)
+                      ENDIF
+                   END DO
+                   sd(ju)%rotn = .TRUE.               ! vector was rotated 
+                   IF( lwp .AND. kt == nit000 )   WRITE(numout,*)   &
+                      &   'fld_read: vector pair ('//TRIM(sd(ju)%clvar)//', '//TRIM(sd(iv)%clvar)//') rotated on to model grid'
+                ENDIF
+             ENDIF
+          ENDIF
+       END DO
+   END SUBROUTINE fld_rot
+
+
    SUBROUTINE fld_clopn( sdjf, kyear, kmonth, kday, ldstop )
       !!---------------------------------------------------------------------
@@ -534,16 +649,25 @@
       !! ** Method  :   
       !!----------------------------------------------------------------------
-      TYPE(FLD), INTENT(inout)           ::   sdjf     ! input field related variables
-      INTEGER  , INTENT(in   )           ::   kyear    ! year value
-      INTEGER  , INTENT(in   )           ::   kmonth   ! month value
-      INTEGER  , INTENT(in   )           ::   kday     ! day value
-      LOGICAL  , INTENT(in   ), OPTIONAL ::   ldstop   ! stop if open to read a non-existing file (default = .TRUE.)
+      TYPE(FLD), INTENT(inout)           ::   sdjf                  ! input field related variables
+      INTEGER  , INTENT(in   )           ::   kyear                 ! year value
+      INTEGER  , INTENT(in   )           ::   kmonth                ! month value
+      INTEGER  , INTENT(in   )           ::   kday                  ! day value
+      LOGICAL  , INTENT(in   ), OPTIONAL ::   ldstop                ! stop if open to read a non-existing file (default = .TRUE.)
 
       IF( sdjf%num /= 0 )   CALL iom_close( sdjf%num )   ! close file if already open
       ! build the new filename if not climatological data
-      IF( .NOT. sdjf%ln_clim ) THEN   ;   WRITE(sdjf%clname, '(a,"_y",i4.4)' ) TRIM( sdjf%clrootname ), kyear    ! add year
-         IF( sdjf%cltype /= 'yearly' )    WRITE(sdjf%clname, '(a,"m" ,i2.2)' ) TRIM( sdjf%clname     ), kmonth   ! add month
-         IF( sdjf%cltype == 'daily'  )    WRITE(sdjf%clname, '(a,"d" ,i2.2)' ) TRIM( sdjf%clname     ), kday     ! add day
+      sdjf%clname=TRIM(sdjf%clrootname)
+      !
+      ! note that sdjf%ln_clim is is only acting on presence of the year in the file
+      IF( .NOT. sdjf%ln_clim ) THEN   
+                                         WRITE(sdjf%clname, '(a,"_y",i4.4)' ) TRIM( sdjf%clrootname ), kyear    ! add year
+         IF( sdjf%cltype /= 'yearly' )   WRITE(sdjf%clname, '(a,"m" ,i2.2)' ) TRIM( sdjf%clname     ), kmonth   ! add month
+      ELSE
+         ! build the new filename if climatological data
+         IF( sdjf%cltype /= 'yearly' )   WRITE(sdjf%clname, '(a,"_m",i2.2)' ) TRIM( sdjf%clrootname ), kmonth   ! add month
       ENDIF
+      IF( sdjf%cltype == 'daily' .OR. sdjf%cltype(1:4) == 'week' ) &
+            &                            WRITE(sdjf%clname, '(a,"d" ,i2.2)' ) TRIM( sdjf%clname     ), kday     ! add day
+      !
       CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop, ldiof =  LEN(TRIM(sdjf%wgtname)) > 0 )
       !
@@ -575,7 +699,5 @@
          sdf(jf)%ln_tint    = sdf_n(jf)%ln_tint
          sdf(jf)%ln_clim    = sdf_n(jf)%ln_clim
-         IF( sdf(jf)%nfreqh == -1. ) THEN   ;   sdf(jf)%cltype = 'yearly'
-         ELSE                               ;   sdf(jf)%cltype = sdf_n(jf)%cltype
-         ENDIF
+         sdf(jf)%cltype     = sdf_n(jf)%cltype
          sdf(jf)%wgtname = " "
          IF( LEN( TRIM(sdf_n(jf)%wname) ) > 0 )   sdf(jf)%wgtname = TRIM( cdir )//TRIM( sdf_n(jf)%wname )
@@ -598,4 +720,5 @@
                &                          ' pairing    : '    , TRIM( sdf(jf)%vcomp      ),   &
                &                          ' data type: '      ,       sdf(jf)%cltype
+            call flush(numout)
          END DO
       ENDIF
@@ -672,5 +795,5 @@
          IF( ref_wgts(kw)%cyclic ) THEN
             WRITE(numout,*) '       cyclical'
-            IF( ref_wgts(kw)%offset > 0 ) WRITE(numout,*) '                 with offset'
+            IF( ref_wgts(kw)%overlap > 0 ) WRITE(numout,*) '              with overlap of ', ref_wgts(kw)%overlap
          ELSE
             WRITE(numout,*) '       not cyclical'
@@ -695,13 +818,11 @@
       INTEGER                                 ::   inum          ! temporary logical unit
       INTEGER                                 ::   id            ! temporary variable id
+      INTEGER                                 ::   ipk           ! temporary vertical dimension
       CHARACTER (len=5)                       ::   aname
       INTEGER , DIMENSION(3)                  ::   ddims
       INTEGER , DIMENSION(jpi, jpj)           ::   data_src
       REAL(wp), DIMENSION(jpi, jpj)           ::   data_tmp
-      REAL(wp), DIMENSION(:,:), ALLOCATABLE   ::   line2, lines  ! temporary array to read 2 lineumns
-      CHARACTER (len=34)                      ::   lonvar
       LOGICAL                                 ::   cyclical
-      REAL(wp)                                ::   resid, dlon   ! temporary array to read 2 lineumns
-      INTEGER                                 ::   offset        ! temporary integer
+      INTEGER                                 ::   zwrap         ! temporary integer
       !!----------------------------------------------------------------------
       !
@@ -721,66 +842,4 @@
       id = iom_varid( inum, sd%clvar, ddims )
 
-      !! check for an east-west cyclic grid
-      !! try to guess name of longitude variable
-
-      lonvar = 'nav_lon'
-      id = iom_varid(inum, TRIM(lonvar), ldstop=.FALSE.)
-      IF( id <= 0 ) THEN
-         lonvar = 'lon'
-         id = iom_varid(inum, TRIM(lonvar), ldstop=.FALSE.)
-      ENDIF
-
-      offset = -1
-      cyclical = .FALSE.
-      IF( id > 0 ) THEN
-         !! found a longitude variable
-         !! now going to assume that grid is regular so we can read a single row
-
-         !! because input array is 2d, have to present iom with 2d array even though we only need 1d slice
-         !! worse, we cant pass line2(:,1) to iom_get since this is treated as a 1d array which doesnt match input file
-         ALLOCATE( lines(ddims(1),2) )
-         CALL iom_get(inum, jpdom_unknown, lonvar, lines(:,:), 1, kstart=(/1,1/), kcount=(/ddims(1),2/) )
-
-         !! find largest grid spacing
-         lines(1:ddims(1)-1,2) = lines(2:ddims(1),1) - lines(1:ddims(1)-1,1)
-         dlon = MAXVAL( lines(1:ddims(1)-1,2) )
-
-         resid = ABS(ABS(lines(ddims(1),1)-lines(1,1))-360.0)
-         IF( resid < rsmall ) THEN
-            !! end rows overlap in longitude
-            offset = 0
-            cyclical = .TRUE.
-         ELSEIF( resid < 2.0*dlon ) THEN
-            !! also call it cyclic if difference between end points is less than twice dlon from 360
-            offset = 1
-            cyclical = .TRUE.
-         ENDIF
-
-         DEALLOCATE( lines )
-
-      ELSE
-         !! guessing failed
-         !! read in first and last columns of data variable
-         !! since we dont know the name of the longitude variable (or even if there is one)
-         !! we assume that if these two columns are equal, file is cyclic east-west
-
-         !! because input array is 2d, have to present iom with 2d array even though we only need 1d slice
-         !! worse, we cant pass line2(1,:) to iom_get since this is treated as a 1d array which doesnt match input file
-         ALLOCATE( lines(2,ddims(2)), line2(2,ddims(2)) )
-         CALL iom_get(inum, jpdom_unknown, sd%clvar, line2(:,:), 1, kstart=(/1,1/), kcount=(/2,ddims(2)/) )
-         lines(2,:) = line2(1,:)
-
-         CALL iom_get(inum, jpdom_unknown, sd%clvar, line2(:,:), 1, kstart=(/ddims(1)-1,1/), kcount=(/2,ddims(2)/) )
-         lines(1,:) = line2(2,:)
-
-         resid = SUM( ABS(lines(1,:) - lines(2,:)) )
-         IF( resid < ddims(2)*rsmall ) THEN
-            offset = 0
-            cyclical = .TRUE.
-         ENDIF
-
-         DEALLOCATE( lines, line2 )
-      ENDIF
-
       !! close it
       CALL iom_close( inum )
@@ -790,14 +849,25 @@
       CALL iom_open ( sd%wgtname, inum )   ! interpolation weights
       IF ( inum > 0 ) THEN
+
+         !! determine whether we have an east-west cyclic grid
+         !! from global attribute called "ew_wrap" in the weights file
+         !! note that if not found, iom_getatt returns -999 and cyclic with no overlap is assumed
+         !! since this is the most common forcing configuration
+
+         CALL iom_getatt(inum, 'ew_wrap', zwrap)
+         IF( zwrap >= 0 ) THEN
+            cyclical = .TRUE.
+         ELSE IF( zwrap == -999 ) THEN
+            cyclical = .TRUE.
+            zwrap = 0
+         ELSE
+            cyclical = .FALSE.
+         ENDIF
 
          ref_wgts(nxt_wgt)%ddims(1) = ddims(1)
          ref_wgts(nxt_wgt)%ddims(2) = ddims(2)
          ref_wgts(nxt_wgt)%wgtname = sd%wgtname
-         ref_wgts(nxt_wgt)%offset = -1
-         ref_wgts(nxt_wgt)%cyclic = .FALSE.
-         IF( cyclical ) THEN
-            ref_wgts(nxt_wgt)%offset = offset
-            ref_wgts(nxt_wgt)%cyclic = .TRUE.
-         ENDIF
+         ref_wgts(nxt_wgt)%overlap = zwrap
+         ref_wgts(nxt_wgt)%cyclic = cyclical
          ref_wgts(nxt_wgt)%nestid = 0
 #if defined key_agrif
@@ -857,6 +927,7 @@
          ! SA: +3 stencil is a patch to avoid out-of-bound computation in some configuration. 
          ! a more robust solution will be given in next release
-         ALLOCATE( ref_wgts(nxt_wgt)%fly_dta(ref_wgts(nxt_wgt)%jpiwgt+3, ref_wgts(nxt_wgt)%jpjwgt+3) )
-         IF( ref_wgts(nxt_wgt)%cyclic ) ALLOCATE( ref_wgts(nxt_wgt)%col2(2,ref_wgts(nxt_wgt)%jpjwgt+3) )
+         ipk =  SIZE(sd%fnow, 3)
+         ALLOCATE( ref_wgts(nxt_wgt)%fly_dta(ref_wgts(nxt_wgt)%jpiwgt+3, ref_wgts(nxt_wgt)%jpjwgt+3 ,ipk) )
+         IF( ref_wgts(nxt_wgt)%cyclic ) ALLOCATE( ref_wgts(nxt_wgt)%col(1,ref_wgts(nxt_wgt)%jpjwgt+3,ipk) )
 
          nxt_wgt = nxt_wgt + 1
@@ -868,5 +939,5 @@
    END SUBROUTINE fld_weight
 
-   SUBROUTINE fld_interp(num, clvar, kw, dta, nrec)
+   SUBROUTINE fld_interp(num, clvar, kw, kk, dta, nrec)
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE fld_interp  ***
@@ -880,8 +951,9 @@
       CHARACTER(LEN=*), INTENT(in)                        ::   clvar               ! variable name
       INTEGER,          INTENT(in)                        ::   kw                  ! weights number
-      REAL(wp),         INTENT(inout), DIMENSION(jpi,jpj) ::   dta                 ! output field on model grid
+      INTEGER,          INTENT(in)                        ::   kk                  ! vertical dimension of kk
+      REAL(wp),         INTENT(inout), DIMENSION(jpi,jpj,kk) ::   dta              ! output field on model grid
       INTEGER,          INTENT(in)                        ::   nrec                ! record number to read (ie time slice)
       !! 
-      INTEGER, DIMENSION(2)                               ::   rec1,recn           ! temporary arrays for start and length
+      INTEGER, DIMENSION(3)                               ::   rec1,recn           ! temporary arrays for start and length
       INTEGER                                             ::  jk, jn, jm           ! loop counters
       INTEGER                                             ::  ni, nj               ! lengths
@@ -897,5 +969,5 @@
       !! so we need to have a 4 by 4 subgrid surrounding each model point to cover both cases
 
-      !! sub grid where we already have weights
+      !! sub grid from non-model input grid which encloses all grid points in this nemo process
       jpimin = ref_wgts(kw)%botleft(1)
       jpjmin = ref_wgts(kw)%botleft(2)
@@ -903,11 +975,15 @@
       jpjwid = ref_wgts(kw)%jpjwgt
 
-      !! what we need to read into sub grid in order to calculate gradients
+      !! when reading in, expand this sub-grid by one halo point all the way round for calculating gradients
       rec1(1) = MAX( jpimin-1, 1 )
       rec1(2) = MAX( jpjmin-1, 1 )
+      rec1(3) = 1
       recn(1) = MIN( jpiwid+2, ref_wgts(kw)%ddims(1)-rec1(1)+1 )
       recn(2) = MIN( jpjwid+2, ref_wgts(kw)%ddims(2)-rec1(2)+1 )
-
-      !! where we need to read it to
+      recn(3) = kk
+
+      !! where we need to put it in the non-nemo grid fly_dta
+      !! note that jpi1 and jpj1 only differ from 1 when jpimin and jpjmin are 1
+      !! (ie at the extreme west or south of the whole input grid) and similarly for jpi2 and jpj2
       jpi1 = 2 + rec1(1) - jpimin
       jpj1 = 2 + rec1(2) - jpjmin
@@ -915,10 +991,16 @@
       jpj2 = jpj1 + recn(2) - 1
 
-      ref_wgts(kw)%fly_dta(:,:) = 0.0
-      CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2), nrec, rec1, recn)
+      ref_wgts(kw)%fly_dta(:,:,:) = 0.0
+      SELECT CASE( SIZE(ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:),3) )
+      CASE(1)
+           CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,1), nrec, rec1, recn)
+      CASE DEFAULT
+           CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:), nrec, rec1, recn)
+      END SELECT 
 
       !! first four weights common to both bilinear and bicubic
+      !! data_jpi, data_jpj have already been shifted to (1,1) corresponding to botleft
       !! note that we have to offset by 1 into fly_dta array because of halo
-      dta(:,:) = 0.0
+      dta(:,:,:) = 0.0
       DO jk = 1,4
         DO jn = 1, jpj
@@ -926,5 +1008,5 @@
             ni = ref_wgts(kw)%data_jpi(jm,jn,jk)
             nj = ref_wgts(kw)%data_jpj(jm,jn,jk)
-            dta(jm,jn) = dta(jm,jn) + ref_wgts(kw)%data_wgt(jm,jn,jk) * ref_wgts(kw)%fly_dta(ni+1,nj+1)
+            dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk) * ref_wgts(kw)%fly_dta(ni+1,nj+1,:)
           END DO
         END DO
@@ -935,14 +1017,14 @@
         !! fix up halo points that we couldnt read from file
         IF( jpi1 == 2 ) THEN
-           ref_wgts(kw)%fly_dta(jpi1-1,:) = ref_wgts(kw)%fly_dta(jpi1,:)
+           ref_wgts(kw)%fly_dta(jpi1-1,:,:) = ref_wgts(kw)%fly_dta(jpi1,:,:)
         ENDIF
         IF( jpi2 + jpimin - 1 == ref_wgts(kw)%ddims(1)+1 ) THEN
-           ref_wgts(kw)%fly_dta(jpi2+1,:) = ref_wgts(kw)%fly_dta(jpi2,:)
+           ref_wgts(kw)%fly_dta(jpi2+1,:,:) = ref_wgts(kw)%fly_dta(jpi2,:,:)
         ENDIF
         IF( jpj1 == 2 ) THEN
-           ref_wgts(kw)%fly_dta(:,jpj1-1) = ref_wgts(kw)%fly_dta(:,jpj1)
+           ref_wgts(kw)%fly_dta(:,jpj1-1,:) = ref_wgts(kw)%fly_dta(:,jpj1,:)
         ENDIF
         IF( jpj2 + jpjmin - 1 == ref_wgts(kw)%ddims(2)+1 .AND. jpj2 .lt. jpjwid+2 ) THEN
-           ref_wgts(kw)%fly_dta(:,jpj2+1) = 2.0*ref_wgts(kw)%fly_dta(:,jpj2) - ref_wgts(kw)%fly_dta(:,jpj2-1)
+           ref_wgts(kw)%fly_dta(:,jpj2+1,:) = 2.0*ref_wgts(kw)%fly_dta(:,jpj2,:) - ref_wgts(kw)%fly_dta(:,jpj2-1,:)
         ENDIF
 
@@ -951,17 +1033,27 @@
         IF( ref_wgts(kw)%cyclic ) THEN
            rec1(2) = MAX( jpjmin-1, 1 )
-           recn(1) = 2
+           recn(1) = 1
            recn(2) = MIN( jpjwid+2, ref_wgts(kw)%ddims(2)-rec1(2)+1 )
            jpj1 = 2 + rec1(2) - jpjmin
            jpj2 = jpj1 + recn(2) - 1
            IF( jpi1 == 2 ) THEN
-              rec1(1) = ref_wgts(kw)%ddims(1) - 1
-              CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2), nrec, rec1, recn)
-              ref_wgts(kw)%fly_dta(jpi1-1,jpj1:jpj2) = ref_wgts(kw)%col2(ref_wgts(kw)%offset+1,jpj1:jpj2)
+              rec1(1) = ref_wgts(kw)%ddims(1) - ref_wgts(kw)%overlap
+              SELECT CASE( SIZE( ref_wgts(kw)%col(:,jpj1:jpj2,:),3) )
+              CASE(1)
+                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,1), nrec, rec1, recn)
+              CASE DEFAULT
+                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,:), nrec, rec1, recn)
+              END SELECT      
+              ref_wgts(kw)%fly_dta(jpi1-1,jpj1:jpj2,:) = ref_wgts(kw)%col(1,jpj1:jpj2,:)
            ENDIF
            IF( jpi2 + jpimin - 1 == ref_wgts(kw)%ddims(1)+1 ) THEN
-              rec1(1) = 1
-              CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2), nrec, rec1, recn)
-              ref_wgts(kw)%fly_dta(jpi2+1,jpj1:jpj2) = ref_wgts(kw)%col2(2-ref_wgts(kw)%offset,jpj1:jpj2)
+              rec1(1) = 1 + ref_wgts(kw)%overlap
+              SELECT CASE( SIZE( ref_wgts(kw)%col(:,jpj1:jpj2,:),3) )
+              CASE(1)
+                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,1), nrec, rec1, recn)
+              CASE DEFAULT
+                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,:), nrec, rec1, recn)
+              END SELECT
+              ref_wgts(kw)%fly_dta(jpi2+1,jpj1:jpj2,:) = ref_wgts(kw)%col(1,jpj1:jpj2,:)
            ENDIF
         ENDIF
@@ -973,6 +1065,6 @@
               ni = ref_wgts(kw)%data_jpi(jm,jn,jk)
               nj = ref_wgts(kw)%data_jpj(jm,jn,jk)
-              dta(jm,jn) = dta(jm,jn) + ref_wgts(kw)%data_wgt(jm,jn,jk+4) * 0.5 *         &
-                               (ref_wgts(kw)%fly_dta(ni+2,nj+1) - ref_wgts(kw)%fly_dta(ni,nj+1))
+              dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk+4) * 0.5 *         &
+                               (ref_wgts(kw)%fly_dta(ni+2,nj+1,:) - ref_wgts(kw)%fly_dta(ni,nj+1,:))
             END DO
           END DO
@@ -985,6 +1077,6 @@
               ni = ref_wgts(kw)%data_jpi(jm,jn,jk)
               nj = ref_wgts(kw)%data_jpj(jm,jn,jk)
-              dta(jm,jn) = dta(jm,jn) + ref_wgts(kw)%data_wgt(jm,jn,jk+8) * 0.5 *         &
-                               (ref_wgts(kw)%fly_dta(ni+1,nj+2) - ref_wgts(kw)%fly_dta(ni+1,nj))
+              dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk+8) * 0.5 *         &
+                               (ref_wgts(kw)%fly_dta(ni+1,nj+2,:) - ref_wgts(kw)%fly_dta(ni+1,nj,:))
             END DO
           END DO
@@ -997,7 +1089,7 @@
               ni = ref_wgts(kw)%data_jpi(jm,jn,jk)
               nj = ref_wgts(kw)%data_jpj(jm,jn,jk)
-              dta(jm,jn) = dta(jm,jn) + ref_wgts(kw)%data_wgt(jm,jn,jk+12) * 0.25 * ( &
-                               (ref_wgts(kw)%fly_dta(ni+2,nj+2) - ref_wgts(kw)%fly_dta(ni  ,nj+2)) -   &
-                               (ref_wgts(kw)%fly_dta(ni+2,nj  ) - ref_wgts(kw)%fly_dta(ni  ,nj  )))
+              dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk+12) * 0.25 * ( &
+                               (ref_wgts(kw)%fly_dta(ni+2,nj+2,:) - ref_wgts(kw)%fly_dta(ni  ,nj+2,:)) -   &
+                               (ref_wgts(kw)%fly_dta(ni+2,nj  ,:) - ref_wgts(kw)%fly_dta(ni  ,nj  ,:)))
             END DO
           END DO
@@ -1007,4 +1099,34 @@
 
    END SUBROUTINE fld_interp
-  
+
+
+   FUNCTION ksec_week( cdday )
+      !!---------------------------------------------------------------------
+      !!                    ***  FUNCTION kshift_week *** 
+      !!
+      !! ** Purpose :  
+      !!
+      !! ** Method  :
+      !!---------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in)   ::   cdday   !3 first letters of the first day of the weekly file
+      !!
+      INTEGER                        ::   ksec_week  ! output variable
+      INTEGER                        ::   ijul       !temp variable
+      INTEGER                        ::   ishift     !temp variable
+      CHARACTER(len=3),DIMENSION(7)  ::   cl_week 
+      !!----------------------------------------------------------------------
+      cl_week = (/"sun","sat","fri","thu","wed","tue","mon"/)
+      DO ijul = 1, 7
+         IF( cl_week(ijul) == TRIM(cdday) ) EXIT
+      ENDDO
+      IF( ijul .GT. 7 )   CALL ctl_stop( 'ksec_week: wrong day for sdjf%cltype(6:8): '//TRIM(cdday) )
+      !
+      ishift = ijul * NINT(rday)
+      ! 
+      ksec_week = nsec_week + ishift
+      ksec_week = MOD( ksec_week, 7*NINT(rday) )
+      ! 
+   END FUNCTION ksec_week
+
+
 END MODULE fldread
Index: trunk/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90	(revision 2528)
@@ -27,4 +27,6 @@
                                              ! they are only a useless overlay of rot_rep
 
+   PUBLIC   obs_rot
+
    REAL(wp), DIMENSION(jpi,jpj) ::   &
       gsint, gcost,   &  ! cos/sin between model grid lines and NP direction at T point
@@ -38,7 +40,7 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -522,4 +524,42 @@
    END SUBROUTINE repere
 
+
+   SUBROUTINE obs_rot ( psinu, pcosu, psinv, pcosv )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE obs_rot  ***
+      !!
+      !! ** Purpose :   Copy gsinu, gcosu, gsinv and gsinv
+      !!                to input data for rotations of
+      !!                current at observation points
+      !!
+      !! History :
+      !!   9.2  !  09-02  (K. Mogensen)
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT( OUT )::   &
+         & psinu, pcosu, psinv, pcosv! copy of data
+
+      !!----------------------------------------------------------------------
+
+      ! Initialization of gsin* and gcos* at first call
+      ! -----------------------------------------------
+
+      IF( lmust_init ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' obs_rot : geographic <--> stretched'
+         IF(lwp) WRITE(numout,*) ' ~~~~~~~   coordinate transformation'
+
+         CALL angle       ! initialization of the transformation
+         lmust_init = .FALSE.
+
+      ENDIF
+
+      psinu(:,:) = gsinu(:,:)
+      pcosu(:,:) = gcosu(:,:)
+      psinv(:,:) = gsinv(:,:)
+      pcosv(:,:) = gcosv(:,:)
+
+   END SUBROUTINE obs_rot
+
+
   !!======================================================================
 END MODULE geo2ocean
Index: trunk/NEMOGCM/NEMO/OPA_SRC/SBC/oasis4_date.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/SBC/oasis4_date.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/SBC/oasis4_date.F90	(revision 2528)
@@ -10,7 +10,7 @@
 #if defined key_oasis4
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2006) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 !##################### WARNING coupled mode ###############################
Index: trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90	(revision 2528)
@@ -9,5 +9,5 @@
 #if defined key_lim3 || defined key_lim2
    !!----------------------------------------------------------------------
-   !!   'key_lim2' or 'key_lim3' :             LIM 2.0 or 3.0 sea-ice model
+   !!   'key_lim2' or 'key_lim3' :             LIM-2 or LIM-3 sea-ice model
    !!----------------------------------------------------------------------
    USE par_oce          ! ocean parameters
@@ -23,12 +23,16 @@
 
 # if defined  key_lim2
-   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2        = .TRUE.    !: LIM-2 ice model
-   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3        = .FALSE.   !: no LIM-3
-   CHARACTER(len=1), PUBLIC            ::   cigr_type      = 'I'       !: 'I'-grid ice-velocity (B-grid lower left corner)
+   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2    = .TRUE.   !: LIM-2 ice model
+   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3    = .FALSE.  !: no LIM-3
+#  if defined key_lim2_vp
+   CHARACTER(len=1), PUBLIC, PARAMETER ::   cp_ice_msh = 'I'      !: VP : 'I'-grid ice-velocity (B-grid lower left corner)
+#  else
+   CHARACTER(len=1), PUBLIC, PARAMETER ::   cp_ice_msh = 'C'      !: EVP: 'C'-grid ice-velocity
+#  endif
 # endif
 # if defined  key_lim3
-   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2        = .FALSE.   !: no LIM-2
-   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3        = .TRUE.    !: LIM-3 ice model
-   CHARACTER(len=1), PUBLIC            ::   cigr_type      = 'C'       !: 'C'-grid ice-velocity
+   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2    = .FALSE.  !: no LIM-2
+   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3    = .TRUE.   !: LIM-3 ice model
+   CHARACTER(len=1), PUBLIC, PARAMETER ::   cp_ice_msh = 'C'      !: 'C'-grid ice-velocity
 # endif
 
@@ -41,8 +45,8 @@
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   alb_ice   !: albedo of ice
 
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   utau_ice    !: u-stress over ice (I-point for LIM2 or U,V-point for LIM3)   [N/m2]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   vtau_ice    !: v-stress over ice (I-point for LIM2 or U,V-point for LIM3)   [N/m2]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fr1_i0      !: 1st fraction of sol. rad. which penetrate inside the ice cover
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fr2_i0      !: 2nd fraction of sol. rad. which penetrate inside the ice cover
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   utau_ice    !: u-stress over ice (I-pt for VP or U,V-pts for EVP)   [N/m2]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   vtau_ice    !: v-stress over ice (I-pt for VP or U,V-pts for EVP)   [N/m2]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fr1_i0      !: 1st fraction of Qsr which penetrates inside the ice cover
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fr2_i0      !: 2nd fraction of Qsr which penetrates inside the ice cover
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   emp_ice     !: solid freshwater budget over ice: sublivation - snow
 
@@ -55,15 +59,13 @@
    !!   Default option                      NO LIM 2.0 or 3.0 sea-ice model
    !!----------------------------------------------------------------------
-   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2        = .FALSE.  !: no LIM-2 ice model
-   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3        = .FALSE.  !: no LIM-3 ice model
-   CHARACTER(len=1), PUBLIC            ::   cigr_type      = '-'      !: no grid ice-velocity
+   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2    = .FALSE.  !: no LIM-2 ice model
+   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim3    = .FALSE.  !: no LIM-3 ice model
+   CHARACTER(len=1), PUBLIC, PARAMETER ::   cp_ice_msh = '-'      !: no grid ice-velocity
 #endif
 
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!======================================================================
 END MODULE sbc_ice
Index: trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90	(revision 2528)
@@ -4,6 +4,9 @@
    !! Surface module :   variables defined in core memory 
    !!======================================================================
-   !! History :  3.0   !  2006-06  (G. Madec)  Original code
-   !!             -    !  2008-08  (G. Madec)  namsbc moved from sbcmod
+   !! History :  3.0  ! 2006-06  (G. Madec)  Original code
+   !!             -   ! 2008-08  (G. Madec)  namsbc moved from sbcmod
+   !!            3.3  ! 2010-04  (M. Leclair, G. Madec)  Forcing averaged over 2 time steps
+   !!             -   ! 2010-11  (G. Madec) ice-ocean stress always computed at each ocean time-step
+   !!            3.3  ! 2010-10  (J. Chanut, C. Bricaud)  add the surface pressure forcing
    !!----------------------------------------------------------------------
    USE par_oce          ! ocean parameters
@@ -24,4 +27,5 @@
    LOGICAL , PUBLIC ::   ln_rnf      = .FALSE.   !: runoffs / runoff mouths
    LOGICAL , PUBLIC ::   ln_ssr      = .FALSE.   !: Sea Surface restoring on SST and/or SSS      
+   LOGICAL , PUBLIC ::   ln_apr_dyn  = .FALSE.   !: Atmospheric pressure forcing used on dynamics (ocean & ice)
    INTEGER , PUBLIC ::   nn_ice      = 0         !: flag on ice in the surface boundary condition (=0/1/2/3)
    INTEGER , PUBLIC ::   nn_fwb      = 0         !: FreshWater Budget: 
@@ -29,32 +33,32 @@
    !                                             !:  = 1 global mean of e-p-r set to zero at each nn_fsbc time step
    !                                             !:  = 2 annual global mean of e-p-r set to zero
-   INTEGER , PUBLIC ::   nn_ico_cpl  = 0          !: ice-ocean coupling indicator
-   !                                             !:  = 0   LIM-3 old case
-   !                                             !:  = 1   stresses computed using now ocean velocity
-   !                                             !:  = 2   combination of 0 and 1 cases
 
    !!----------------------------------------------------------------------
    !!              Ocean Surface Boundary Condition fields
    !!----------------------------------------------------------------------
-   LOGICAL , PUBLIC ::   lhftau = .FALSE.              !: HF tau contribution: mean of stress module - module of the mean stress
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   utau      !: sea surface i-stress (ocean referential)     [N/m2]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   vtau      !: sea surface j-stress (ocean referential)     [N/m2]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   taum      !: module of sea surface stress (at T-point)    [N/m2] 
-   !! wndm is used only in PISCES to compute gases exchanges at the surface of the free ocean or in the leads in sea-ice parts
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   wndm      !: wind speed module at T-point (=|U10m-Uoce|)  [m/s] 
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qsr       !: sea heat flux:     solar                     [W/m2]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qns       !: sea heat flux: non solar                     [W/m2]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qsr_tot   !: total     solar heat flux (over sea and ice) [W/m2]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qns_tot   !: total non solar heat flux (over sea and ice) [W/m2]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   emp       !: freshwater budget: volume flux               [Kg/m2/s]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   emps      !: freshwater budget: concentration/dillution   [Kg/m2/s]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   emp_tot   !: total evaporation - (liquid + solid) precpitation over oce and ice
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   tprecip   !: total precipitation           [Kg/m2/s]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sprecip   !: solid precipitation           [Kg/m2/s]
-!!$   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rrunoff       !: runoff
-!!$   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   calving       !: calving
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fr_i      !: ice fraction  (between 0 to 1)               -
+   LOGICAL , PUBLIC ::   lhftau = .FALSE.        !: HF tau used in TKE: mean(stress module) - module(mean stress)
+   !!                                   !!   now    ! before   !!
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   utau   , utau_b   !: sea surface i-stress (ocean referential)     [N/m2]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   vtau   , vtau_b   !: sea surface j-stress (ocean referential)     [N/m2]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   taum              !: module of sea surface stress (at T-point)    [N/m2] 
+   !! wndm is used only in PISCES to compute surface gases exchanges in ice-free ocean or leads
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   wndm              !: wind speed module at T-point (=|U10m-Uoce|)  [m/s]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qsr               !: sea heat flux:     solar                     [W/m2]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qns    , qns_b    !: sea heat flux: non solar                     [W/m2]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qsr_tot           !: total     solar heat flux (over sea and ice) [W/m2]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qns_tot           !: total non solar heat flux (over sea and ice) [W/m2]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   emp    , emp_b    !: freshwater budget: volume flux               [Kg/m2/s]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   emps   , emps_b   !: freshwater budget: concentration/dillution   [Kg/m2/s]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   emp_tot           !: total E-P over ocean and ice                 [Kg/m2/s]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rnf    , rnf_b    !: river runoff   [Kg/m2/s]  
+   !!
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpts) ::  sbc_tsc, sbc_tsc_b  !: sbc content trend                      [K.m/s]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   qsr_hc , qsr_hc_b   !: heat content trend due to qsr flux     [K.m/s]
+   !!
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   tprecip           !: total precipitation                          [Kg/m2/s]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sprecip           !: solid precipitation                          [Kg/m2/s]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fr_i              !: ice fraction = 1 - lead fraction      (between 0 to 1)
 #if defined key_cpl_carbon_cycle
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   atm_co2   !: atmospheric pCO2                             [ppm]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   atm_co2           !: atmospheric pCO2                             [ppm]
 #endif
 
@@ -70,8 +74,7 @@
 
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2006) 
-   !! $ Id: $
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!======================================================================
-
 END MODULE sbc_oce
Index: trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcana.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcana.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcana.F90	(revision 2528)
@@ -39,7 +39,7 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -208,5 +208,5 @@
 
       ! Compute the emp flux such as its integration on the whole domain at each time is zero
-      IF( nbench /= 1 .AND. nbit_cmp /= 1 ) THEN
+      IF( nbench /= 1 ) THEN
          zsumemp = 0.e0   ;   zsurf = 0.e0
          DO jj = 1, jpj
Index: trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90	(revision 2528)
@@ -0,0 +1,173 @@
+MODULE sbcapr
+   !!======================================================================
+   !!                       ***  MODULE  sbcapr  ***
+   !! Surface module :   atmospheric pressure forcing
+   !!======================================================================
+   !! History :  3.3  !   2010-09  (J. Chanut, C. Bricaud, G. Madec)  Original code
+   !!----------------------------------------------------------------------
+   
+   !!----------------------------------------------------------------------
+   !!   sbc_apr        : read atmospheric pressure in netcdf files 
+   !!----------------------------------------------------------------------
+   USE bdy_par         ! Unstructured boundary parameters
+   USE obc_par         ! open boundary condition parameters
+   USE dom_oce         ! ocean space and time domain
+   USE sbc_oce         ! surface boundary condition
+   USE dynspg_oce      ! surface pressure gradient variables
+   USE phycst          ! physical constants
+   USE fldread         ! read input fields
+   USE in_out_manager  ! I/O manager
+   USE lib_fortran     ! distribued memory computing library
+   USE iom
+   USE restart
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   sbc_apr    ! routine called in sbcmod
+   
+   !                                         !!* namsbc_apr namelist (Atmospheric PRessure) *
+   LOGICAL, PUBLIC ::   ln_apr_obc = .FALSE.  !: inverse barometer added to OBC ssh data 
+   LOGICAL, PUBLIC ::   ln_apr_bdy = .FALSE.  !: inverse barometer added to BDY ssh data
+   LOGICAL, PUBLIC ::   ln_ref_apr = .FALSE.  !: ref. pressure: global mean Patm (F) or a constant (F)
+
+   REAL(wp), ALLOCATABLE, PUBLIC, DIMENSION(:,:) ::   ssh_ib    ! Inverse barometer now    sea surface height     [m]
+   REAL(wp), ALLOCATABLE, PUBLIC, DIMENSION(:,:) ::   ssh_ibb   ! Inverse barometer before sea surface height     [m]
+   REAL(wp), ALLOCATABLE, PUBLIC, DIMENSION(:,:) ::   apr       ! atmospheric pressure at kt                   [N/m2]
+   
+   REAL(wp) ::   rpref = 101000._wp   ! reference atmospheric pressure          [N/m2]
+   REAL(wp) ::   tarea                ! whole domain mean masked ocean surface
+   REAL(wp) ::   r1_grau              ! = 1.e0 / (grav * rau0)
+
+   
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:)   ::   sf_apr   ! structure of input fields (file informations, fields read)
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
+   !! $Id $
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE sbc_apr( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE sbc_apr  ***
+      !!
+      !! ** Purpose :   read atmospheric pressure fields in netcdf files.
+      !!
+      !! ** Method  : - Read namelist namsbc_apr
+      !!              - Read Patm fields in netcdf files 
+      !!              - Compute reference atmospheric pressure
+      !!              - Compute inverse barometer ssh
+      !! ** action  :   apr      : atmospheric pressure at kt
+      !!                ssh_ib   : inverse barometer ssh at kt
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in)::   kt   ! ocean time step
+      !!
+      INTEGER            ::   ierror  ! local integer 
+      REAL(wp)           ::   zpref   ! local scalar
+      !!
+      CHARACTER(len=100) ::  cn_dir   ! Root directory for location of ssr files
+      TYPE(FLD_N)        ::  sn_apr   ! informations about the fields to be read
+      !!
+      NAMELIST/namsbc_apr/ cn_dir, sn_apr, ln_ref_apr
+      !!----------------------------------------------------------------------
+      !
+      !
+      !                                         ! -------------------- !
+      IF( kt == nit000 ) THEN                   ! First call kt=nit000 !
+         !                                      ! -------------------- !
+         !                                            !* set file information (default values)
+         ! ... default values (NB: frequency positive => hours, negative => months)
+         !            !   file   ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation !
+         !            !   name   !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs    !
+         sn_apr = FLD_N( 'patm'  ,    24     ,  'patm'    ,  .false.   , .true.  ,   'yearly'  , ''       , ''       )
+         cn_dir  = './'          ! directory in which the Patm data are 
+
+         REWIND( numnam )                             !* read in namlist namsbc_apr
+         READ  ( numnam, namsbc_apr ) 
+         !
+         ALLOCATE( sf_apr(1), STAT=ierror )           !* allocate and fill sf_sst (forcing structure) with sn_sst
+         IF( ierror > 0 ) THEN
+            CALL ctl_stop( 'sbc_apr: unable to allocate sf_apr structure' )   ;   RETURN
+         ENDIF
+         CALL fld_fill( sf_apr, (/ sn_apr /), cn_dir, 'sbc_apr', 'Atmospheric pressure ', 'namsbc_apr' )
+                                ALLOCATE( sf_apr(1)%fnow(jpi,jpj,1)   )
+         IF( sn_apr%ln_tint )   ALLOCATE( sf_apr(1)%fdta(jpi,jpj,1,2) )
+                                ALLOCATE( ssh_ib(jpi,jpj) , ssh_ibb(jpi,jpj) )
+                                ALLOCATE( apr (jpi,jpj) )
+         !
+         IF(lwp) THEN                                 !* control print
+            WRITE(numout,*)
+            WRITE(numout,*) '   Namelist namsbc_apr : Atmospheric PRessure as extrenal forcing'
+            WRITE(numout,*) '      ref. pressure: global mean Patm (T) or a constant (F)  ln_ref_apr = ', ln_ref_apr
+         ENDIF
+         !
+         IF( ln_ref_apr ) THEN                        !* Compute whole inner domain mean masked ocean surface
+            tarea = glob_sum( e1t(:,:) * e2t(:,:) )
+            IF(lwp) WRITE(numout,*) '         Variable ref. Patm computed over a ocean surface of ', tarea*1e-6, 'km2'
+         ELSE
+            IF(lwp) WRITE(numout,*) '         Reference Patm used : ', rpref, ' N/m2'
+         ENDIF
+         !
+         r1_grau = 1.e0 / (grav * rau0)               !* constant for optimization
+         !
+         !                                            !* control check
+         IF( ln_apr_obc .OR. ln_apr_bdy   )   &
+            CALL ctl_stop( 'sbc_apr: inverse barometer added to OBC or BDY ssh data not yet implemented ' )
+         IF( ln_apr_obc .AND. .NOT. lk_obc )   &
+            CALL ctl_stop( 'sbc_apr: add inverse barometer to OBC requires to use key_obc' )
+         IF( ln_apr_bdy .AND. .NOT. lk_bdy )   &
+            CALL ctl_stop( 'sbc_apr: add inverse barometer to OBC requires to use key_bdy' )
+         IF( ( ln_apr_obc .OR. ln_apr_bdy ) .AND. .NOT. lk_dynspg_ts )   &
+            CALL ctl_stop( 'sbc_apr: use inverse barometer ssh at open boundary ONLY possible with time-splitting' )
+         IF( ( ln_apr_obc .OR. ln_apr_bdy ) .AND. .NOT. ln_apr_dyn   )   &
+            CALL ctl_stop( 'sbc_apr: use inverse barometer ssh at open boundary ONLY requires ln_apr_dyn=T' )
+      ENDIF
+
+      !                                         ! ========================== !
+      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN      !    At each sbc time-step   !
+         !                                      ! ===========+++============ !
+         !
+         IF( kt /= nit000 )   ssh_ibb(:,:) = ssh_ib(:,:)    !* Swap of ssh_ib fields
+         !
+         CALL fld_read( kt, nn_fsbc, sf_apr )               !* input Patm provided at kt + nn_fsbc/2
+         !
+         !                                                  !* update the reference atmospheric pressure (if necessary)
+         IF( ln_ref_apr )   rpref = glob_sum( sf_apr(1)%fnow(:,:,1) * e1t(:,:) * e2t(:,:) ) / tarea
+         !
+         !                                                  !* Patm related forcing at kt
+         ssh_ib(:,:) = - ( sf_apr(1)%fnow(:,:,1) - rpref ) * r1_grau    ! equivalent ssh (inverse barometer)
+         apr   (:,:) =     sf_apr(1)%fnow(:,:,1)                        ! atmospheric pressure
+         !
+         CALL iom_put( "ssh_ib", ssh_ib )                   !* output the inverse barometer ssh
+      ENDIF
+
+      !                                         ! ---------------------------------------- !
+      IF( kt == nit000 ) THEN                   !   set the forcing field at nit000 - 1    !
+         !                                      ! ---------------------------------------- !
+         !                                            !* Restart: read in restart file
+         IF( ln_rstart .AND. iom_varid( numror, 'ssh_ibb', ldstop = .FALSE. ) > 0 ) THEN 
+            IF(lwp) WRITE(numout,*) 'sbc_apr:   ssh_ibb read in the restart file'
+            CALL iom_get( numror, jpdom_autoglo, 'ssh_ibb', ssh_ibb )   ! before inv. barometer ssh
+            !
+         ELSE                                         !* no restart: set from nit000 values
+            IF(lwp) WRITE(numout,*) 'sbc_apr:   ssh_ibb set to nit000 values'
+            ssh_ibb(:,:) = ssh_ib(:,:)
+         ENDIF
+      ENDIF
+      !                                         ! ---------------------------------------- !
+      IF( lrst_oce ) THEN                       !      Write in the ocean restart file     !
+         !                                      ! ---------------------------------------- !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'sbc_apr : ssh_ib written in ocean restart file at it= ', kt,' date= ', ndastp
+         IF(lwp) WRITE(numout,*) '~~~~'
+         CALL iom_rstput( kt, nitrst, numrow, 'ssh_ibb' , ssh_ib )
+      ENDIF
+      !
+   END SUBROUTINE sbc_apr
+      
+   !!======================================================================
+END MODULE sbcapr
Index: trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90	(revision 2528)
@@ -37,4 +37,5 @@
    USE ice_2
 #endif
+
    IMPLICIT NONE
    PRIVATE
@@ -81,9 +82,8 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -137,13 +137,13 @@
 
          ! (NB: frequency positive => hours, negative => months)
-         !            !    file     ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation   !
-         !            !    name     !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      !
-         sn_utau = FLD_N( 'utau'    ,    24     ,  'utau'    ,  .true.    , .false. ,   'yearly'  , ''       , ''         ) 
-         sn_vtau = FLD_N( 'vtau'    ,    24     ,  'vtau'    ,  .true.    , .false. ,   'yearly'  , ''       , ''         ) 
-         sn_wndm = FLD_N( 'mwnd10m' ,    24     ,  'm_10'    ,  .true.    , .false. ,   'yearly'  , ''       , ''         ) 
-         sn_tair = FLD_N( 'tair10m' ,    24     ,  't_10'    ,  .false.   , .false. ,   'yearly'  , ''       , ''         ) 
-         sn_humi = FLD_N( 'humi10m' ,    24     ,  'q_10'    ,  .false.   , .false. ,   'yearly'  , ''       , ''         ) 
-         sn_ccov = FLD_N( 'ccover'  ,    -1     ,  'cloud'   ,  .true.    , .false. ,   'yearly'  , ''       , ''         ) 
-         sn_prec = FLD_N( 'precip'  ,    -1     ,  'precip'  ,  .true.    , .false. ,   'yearly'  , ''       , ''         ) 
+         !            !    file    ! frequency ! variable ! time intep !  clim   ! 'yearly' or ! weights  ! rotation !
+         !            !    name    !  (hours)  !  name    !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs    !
+         sn_utau = FLD_N( 'utau'   ,    24     , 'utau'   ,  .true.    , .false. ,   'yearly'  , ''       , ''       ) 
+         sn_vtau = FLD_N( 'vtau'   ,    24     , 'vtau'   ,  .true.    , .false. ,   'yearly'  , ''       , ''       ) 
+         sn_wndm = FLD_N( 'mwnd10m',    24     , 'm_10'   ,  .true.    , .false. ,   'yearly'  , ''       , ''       ) 
+         sn_tair = FLD_N( 'tair10m',    24     , 't_10'   ,  .false.   , .false. ,   'yearly'  , ''       , ''       ) 
+         sn_humi = FLD_N( 'humi10m',    24     , 'q_10'   ,  .false.   , .false. ,   'yearly'  , ''       , ''       ) 
+         sn_ccov = FLD_N( 'ccover' ,    -1     , 'cloud'  ,  .true.    , .false. ,   'yearly'  , ''       , ''       ) 
+         sn_prec = FLD_N( 'precip' ,    -1     , 'precip' ,  .true.    , .false. ,   'yearly'  , ''       , ''       ) 
 
          REWIND( numnam )                    ! ... read in namlist namsbc_clio
@@ -160,11 +160,8 @@
             CALL ctl_stop( 'sbc_blk_clio: unable to allocate sf structure' )   ;   RETURN
          ENDIF
-
          DO ifpr= 1, jpfld
-            ALLOCATE( sf(ifpr)%fnow(jpi,jpj) )
-            ALLOCATE( sf(ifpr)%fdta(jpi,jpj,2) )
-         END DO
-
-
+            ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) )
+            IF( slf_i(ifpr)%ln_tint ) ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) )
+         END DO
          ! fill sf with slf_i and control print
          CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_clio', 'flux formulation for ocean surface boundary condition', 'namsbc_clio' )
@@ -178,40 +175,8 @@
       !
 #if defined key_lim3      
-      tatm_ice(:,:) = sf(jp_tair)%fnow(:,:)     !RB ugly patch
+      tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1)     !RB ugly patch
 #endif
-      !
-      IF(lwp .AND. nitend-nit000 <= 100 ) THEN
-         IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN
-            WRITE(numout,*)
-            WRITE(numout,*) ' read monthly CLIO fluxes: ok, kt: ', kt
-            WRITE(numout,*)
-            ifpr = INT(jpi/8)      ;      jfpr = INT(jpj/10)
-            WRITE(numout,*) TRIM(sf(jp_utau)%clvar),' day: ',ndastp
-            CALL prihre( sf(jp_utau)%fnow,jpi,jpj,1,jpi,ifpr,1,jpj,jfpr,0.,numout )
-            WRITE(numout,*)
-            WRITE(numout,*) TRIM(sf(jp_vtau)%clvar),' day: ',ndastp
-            CALL prihre( sf(jp_vtau)%fnow,jpi,jpj,1,jpi,ifpr,1,jpj,jfpr,0.,numout )
-            WRITE(numout,*)
-            WRITE(numout,*) TRIM(sf(jp_humi)%clvar),' day: ',ndastp
-            CALL prihre( sf(jp_humi)%fnow,jpi,jpj,1,jpi,ifpr,1,jpj,jfpr,0.,numout )
-            WRITE(numout,*)
-            WRITE(numout,*) TRIM(sf(jp_wndm)%clvar),' day: ',ndastp
-            CALL prihre( sf(jp_wndm)%fnow,jpi,jpj,1,jpi,ifpr,1,jpj,jfpr,0.,numout )
-            WRITE(numout,*)
-            WRITE(numout,*) TRIM(sf(jp_ccov)%clvar),' day: ',ndastp
-            CALL prihre( sf(jp_ccov)%fnow,jpi,jpj,1,jpi,ifpr,1,jpj,jfpr,0.,numout )
-            WRITE(numout,*)
-            WRITE(numout,*) TRIM(sf(jp_prec)%clvar),' day: ',ndastp
-            CALL prihre( sf(jp_prec)%fnow,jpi,jpj,1,jpi,ifpr,1,jpj,jfpr,0.,numout )
-            WRITE(numout,*)
-            WRITE(numout,*) TRIM(sf(jp_tair)%clvar),' day: ',ndastp
-            CALL prihre( sf(jp_tair)%fnow,jpi,jpj,1,jpi,ifpr,1,jpj,jfpr,0.,numout )
-            WRITE(numout,*)
-         ENDIF
-      ENDIF
-
-      IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN
-          CALL blk_oce_clio( sf, sst_m )                  ! compute the surface ocean fluxes using CLIO bulk formulea
-      ENDIF                                               ! 
+      !                                                        ! surface ocean fluxes computed with CLIO bulk formulea
+      IF( MOD( kt - 1, nn_fsbc ) == 0 )   CALL blk_oce_clio( sf, sst_m )
       !
    END SUBROUTINE sbc_blk_clio
@@ -270,10 +235,7 @@
       !------------------------------------!
 !CDIR COLLAPSE
-      DO jj = 1 , jpj
-         DO ji = 1, jpi
-            utau(ji,jj) = sf(jp_utau)%fnow(ji,jj)
-            vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj)
-         END DO
-      END DO
+      utau(:,:) = sf(jp_utau)%fnow(:,:,1)
+!CDIR COLLAPSE
+      vtau(:,:) = sf(jp_vtau)%fnow(:,:,1)
 
       !------------------------------------!
@@ -295,9 +257,5 @@
       !------------------------------------!
 !CDIR COLLAPSE
-      DO jj = 1 , jpj
-         DO ji = 1, jpi
-            wndm(ji,jj) = sf(jp_wndm)%fnow(ji,jj)
-         END DO
-      END DO
+      wndm(:,:) = sf(jp_wndm)%fnow(:,:,1)
 
       !------------------------------------------------!
@@ -317,6 +275,6 @@
             !
             zsst  = pst(ji,jj)              + rt0           ! converte Celcius to Kelvin the SST
-            ztatm = sf(jp_tair)%fnow(ji,jj)                 ! and set minimum value far above 0 K (=rt0 over land)
-            zcco1 = 1.0 - sf(jp_ccov)%fnow(ji,jj)           ! fraction of clear sky ( 1 - cloud cover)
+            ztatm = sf(jp_tair)%fnow(ji,jj,1)               ! and set minimum value far above 0 K (=rt0 over land)
+            zcco1 = 1.0 - sf(jp_ccov)%fnow(ji,jj,1)         ! fraction of clear sky ( 1 - cloud cover)
             zrhoa = zpatm / ( 287.04 * ztatm )              ! air density (equation of state for dry air) 
             ztamr = ztatm - rtt                             ! Saturation water vapour
@@ -325,5 +283,5 @@
             zmt3  = SIGN( 28.200, -ztamr )                  !           \/
             zes   = 611.0 * EXP(  ABS( ztamr ) * MIN ( zmt1, zmt2 ) / ( ztatm - 35.86  + MAX( 0.e0, zmt3 ) )  )
-            zev    = sf(jp_humi)%fnow(ji,jj) * zes          ! vapour pressure  
+            zev    = sf(jp_humi)%fnow(ji,jj,1) * zes        ! vapour pressure  
             zevsqr = SQRT( zev * 0.01 )                     ! square-root of vapour pressure
             zqatm = 0.622 * zev / ( zpatm - 0.378 * zev )   ! specific humidity 
@@ -333,5 +291,5 @@
             !--------------------------------------!
             ztatm3  = ztatm * ztatm * ztatm
-            zcldeff = 1.0 - sbudyko(ji,jj) * sf(jp_ccov)%fnow(ji,jj) * sf(jp_ccov)%fnow(ji,jj)    
+            zcldeff = 1.0 - sbudyko(ji,jj) * sf(jp_ccov)%fnow(ji,jj,1) * sf(jp_ccov)%fnow(ji,jj,1)    
             ztaevbk = ztatm * ztatm3 * zcldeff * ( 0.39 - 0.05 * zevsqr ) 
             !
@@ -351,5 +309,5 @@
             zdeltaq = zqatm - zqsato
             ztvmoy  = ztatm * ( 1. + 2.2e-3 * ztatm * zqatm )
-            zdenum  = MAX( sf(jp_wndm)%fnow(ji,jj) * sf(jp_wndm)%fnow(ji,jj) * ztvmoy, zeps )
+            zdenum  = MAX( sf(jp_wndm)%fnow(ji,jj,1) * sf(jp_wndm)%fnow(ji,jj,1) * ztvmoy, zeps )
             zdtetar = zdteta / zdenum
             ztvmoyr = ztvmoy * ztvmoy * zdeltaq / zdenum
@@ -373,5 +331,5 @@
             zpsil   = zpsih
             
-            zvatmg         = MAX( 0.032 * 1.5e-3 * sf(jp_wndm)%fnow(ji,jj) * sf(jp_wndm)%fnow(ji,jj) / grav, zeps )
+            zvatmg         = MAX( 0.032 * 1.5e-3 * sf(jp_wndm)%fnow(ji,jj,1) * sf(jp_wndm)%fnow(ji,jj,1) / grav, zeps )
             zcmn           = vkarmn / LOG ( 10. / zvatmg )
             zchn           = 0.0327 * zcmn
@@ -387,5 +345,5 @@
             zcleo          = zcln * zclcm 
 
-            zrhova         = zrhoa * sf(jp_wndm)%fnow(ji,jj)
+            zrhova         = zrhoa * sf(jp_wndm)%fnow(ji,jj,1)
 
             ! sensible heat flux
@@ -403,12 +361,6 @@
 
 !CDIR COLLAPSE
-!CDIR NOVERRCHK
-      DO jj = 1, jpj
-!CDIR NOVERRCHK
-         DO ji = 1, jpi
-            qns (ji,jj) = zqlw(ji,jj) - zqsb(ji,jj) - zqla(ji,jj)      ! Downward Non Solar flux
-            emp (ji,jj) = zqla(ji,jj) / cevap - sf(jp_prec)%fnow(ji,jj) / rday * tmask(ji,jj,1)
-         END DO
-      END DO
+      emp (:,:) = zqla(:,:) / cevap - sf(jp_prec)%fnow(:,:,1) / rday * tmask(:,:,1)
+      qns (:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)         ! Downward Non Solar flux
       emps(:,:) = emp(:,:)
       !
@@ -476,5 +428,5 @@
       INTEGER  ::   ijpl          ! number of ice categories (size of 3rd dim of input arrays)
       !!
-      REAL(wp) ::   zcoef, zmt1, zmt2, zmt3, ztatm3             ! temporary scalars
+      REAL(wp) ::   zcoef, zmt1, zmt2, zmt3, ztatm3     ! temporary scalars
       REAL(wp) ::   ztaevbk, zind1, zind2, zind3, ztamr         !    -         -
       REAL(wp) ::   zesi, zqsati, zdesidt                       !    -         -
@@ -499,26 +451,16 @@
       SELECT CASE( cd_grid )
       CASE( 'C' )                          ! C-grid ice dynamics
-         ! Change from wind speed to wind stress over OCEAN (cao is used)
-         zcoef = cai / cao 
-!CDIR COLLAPSE
-         DO jj = 1 , jpj
-            DO ji = 1, jpi
-               p_taui(ji,jj) = zcoef * utau(ji,jj)
-               p_tauj(ji,jj) = zcoef * vtau(ji,jj)
-            END DO
-         END DO
-      CASE( 'B' )                          ! B-grid ice dynamics
-         ! Change from wind speed to wind stress over OCEAN (cao is used)
-         zcoef = 0.5 * cai / cao 
-         ! stress from ocean U- and V-points to ice U,V point
-!CDIR COLLAPSE
-         DO jj = 2, jpj
-            DO ji = 2, jpi   ! B grid : no vector opt.
+         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. )   ! I-point (i.e. ice U-V point)
-         CALL lbc_lnk( p_tauj(:,:), 'I', -1. )   ! I-point (i.e. ice U-V point)
+         CALL lbc_lnk( p_taui(:,:), 'I', -1. )   ;   CALL lbc_lnk( p_tauj(:,:), 'I', -1. )   ! I-point
       END SELECT
 
@@ -532,5 +474,5 @@
 !CDIR NOVERRCHK
          DO ji = 1, jpi
-            ztatm (ji,jj) = sf(jp_tair)%fnow(ji,jj)                  ! air temperature in Kelvins 
+            ztatm (ji,jj) = sf(jp_tair)%fnow(ji,jj,1)                ! air temperature in Kelvins 
       
             zrhoa(ji,jj) = zpatm / ( 287.04 * ztatm(ji,jj) )         ! air density (equation of state for dry air) 
@@ -543,5 +485,5 @@
                &                / ( ztatm(ji,jj) - 35.86  + MAX( 0.e0, zmt3 ) )  )
 
-            zev = sf(jp_humi)%fnow(ji,jj) * zes                      ! vapour pressure  
+            zev = sf(jp_humi)%fnow(ji,jj,1) * zes                    ! vapour pressure  
             zevsqr(ji,jj) = SQRT( zev * 0.01 )                       ! square-root of vapour pressure
             zqatm(ji,jj) = 0.622 * zev / ( zpatm - 0.378 * zev )     ! specific humidity 
@@ -553,5 +495,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) / rday   &        ! rday = converte mm/day to kg/m2/s
+            p_spr(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 )   &
@@ -563,6 +505,6 @@
             ! 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) ) + 0.35 * sf(jp_ccov)%fnow(ji,jj) 
-            p_fr2(ji,jj) = 0.82  * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj) ) + 0.65 * sf(jp_ccov)%fnow(ji,jj)
+            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
@@ -586,5 +528,5 @@
                !-------------------------------------------!
                ztatm3  = ztatm(ji,jj) * ztatm(ji,jj) * ztatm(ji,jj)
-               zcldeff = 1.0 - sbudyko(ji,jj) * sf(jp_ccov)%fnow(ji,jj) * sf(jp_ccov)%fnow(ji,jj)    
+               zcldeff = 1.0 - sbudyko(ji,jj) * sf(jp_ccov)%fnow(ji,jj,1) * sf(jp_ccov)%fnow(ji,jj,1)    
                ztaevbk = ztatm3 * ztatm(ji,jj) * zcldeff * ( 0.39 - 0.05 * zevsqr(ji,jj) ) 
                !
@@ -611,5 +553,5 @@
                
                !  sensible and latent fluxes over ice
-               zrhova     = zrhoa(ji,jj) * sf(jp_wndm)%fnow(ji,jj)      ! computation of intermediate values
+               zrhova     = zrhoa(ji,jj) * sf(jp_wndm)%fnow(ji,jj,1)      ! computation of intermediate values
                zrhovaclei = zrhova * zcshi * 2.834e+06
                zrhovacshi = zrhova * zclei * 1004.0
@@ -641,5 +583,5 @@
       p_qns(:,:,:) = z_qlw (:,:,:) - z_qsb (:,:,:) - p_qla (:,:,:)      ! Downward Non Solar flux
 !CDIR COLLAPSE
-      p_tpr(:,:)   = sf(jp_prec)%fnow(:,:) / rday                       ! total precipitation [kg/m2/s]
+      p_tpr(:,:)   = sf(jp_prec)%fnow(:,:,1) / rday                     ! total precipitation [kg/m2/s]
       !
 !!gm : not necessary as all input data are lbc_lnk...
@@ -737,11 +679,11 @@
 !CDIR NOVERRCHK
          DO ji = 1, jpi
-            ztamr = sf(jp_tair)%fnow(ji,jj) - rtt
+            ztamr = sf(jp_tair)%fnow(ji,jj,1) - rtt
             zmt1  = SIGN( 17.269,  ztamr )
             zmt2  = SIGN( 21.875,  ztamr )
             zmt3  = SIGN( 28.200, -ztamr )
             zes = 611.0 * EXP(  ABS( ztamr ) * MIN ( zmt1, zmt2 )   &              ! Saturation water vapour
-               &                     / ( sf(jp_tair)%fnow(ji,jj) - 35.86  + MAX( 0.e0, zmt3 ) )  )
-            zev(ji,jj) = sf(jp_humi)%fnow(ji,jj) * zes * 1.0e-05                   ! vapour pressure  
+               &                     / ( sf(jp_tair)%fnow(ji,jj,1) - 35.86  + MAX( 0.e0, zmt3 ) )  )
+            zev(ji,jj) = sf(jp_humi)%fnow(ji,jj,1) * zes * 1.0e-05                 ! vapour pressure  
          END DO
       END DO
@@ -800,6 +742,6 @@
 
                ! ocean albedo depending on the cloud cover (Payne, 1972)
-               za_oce     = ( 1.0 - sf(jp_ccov)%fnow(ji,jj) ) * 0.05 / ( 1.1 * zcmue**1.4 + 0.15 )   &   ! clear sky
-                  &       +         sf(jp_ccov)%fnow(ji,jj)   * 0.06                                     ! overcast
+               za_oce     = ( 1.0 - sf(jp_ccov)%fnow(ji,jj,1) ) * 0.05 / ( 1.1 * zcmue**1.4 + 0.15 )   &   ! clear sky
+                  &       +         sf(jp_ccov)%fnow(ji,jj,1)   * 0.06                                     ! overcast
 
                   ! solar heat flux absorbed by the ocean (Zillman, 1972)
@@ -816,7 +758,7 @@
          DO ji = 1, jpi
             zlmunoon = ASIN( zps(ji,jj) + zpc(ji,jj) ) / rad                         ! local noon solar altitude
-            zcldcor  = MIN(  1.e0, ( 1.e0 - 0.62 * sf(jp_ccov)%fnow(ji,jj)   &       ! cloud correction (Reed 1977)
+            zcldcor  = MIN(  1.e0, ( 1.e0 - 0.62 * sf(jp_ccov)%fnow(ji,jj,1)   &     ! cloud correction (Reed 1977)
                &                          + 0.0019 * zlmunoon )                 )
-            pqsr_oce(ji,jj) = zcoef1 * zcldcor * pqsr_oce(ji,jj) * tmask(ji,jj,1)   ! and zcoef1: ellipsity
+            pqsr_oce(ji,jj) = zcoef1 * zcldcor * pqsr_oce(ji,jj) * tmask(ji,jj,1)    ! and zcoef1: ellipsity
          END DO
       END DO
@@ -867,11 +809,11 @@
 !CDIR NOVERRCHK
          DO ji = 1, jpi           
-            ztamr = sf(jp_tair)%fnow(ji,jj) - rtt           
+            ztamr = sf(jp_tair)%fnow(ji,jj,1) - rtt           
             zmt1  = SIGN( 17.269,  ztamr )
             zmt2  = SIGN( 21.875,  ztamr )
             zmt3  = SIGN( 28.200, -ztamr )
             zes = 611.0 * EXP(  ABS( ztamr ) * MIN ( zmt1, zmt2 )   &              ! Saturation water vapour
-               &                     / ( sf(jp_tair)%fnow(ji,jj) - 35.86  + MAX( 0.e0, zmt3 ) )  )
-            zev(ji,jj) = sf(jp_humi)%fnow(ji,jj) * zes * 1.0e-05                   ! vapour pressure  
+               &                     / ( sf(jp_tair)%fnow(ji,jj,1) - 35.86  + MAX( 0.e0, zmt3 ) )  )
+            zev(ji,jj) = sf(jp_humi)%fnow(ji,jj,1) * zes * 1.0e-05                 ! vapour pressure  
          END DO
       END DO
@@ -940,6 +882,6 @@
                      &        / (  1.0 + 0.139  * stauc(ji,jj) * ( 1.0 - 0.9435 * pa_ice_os(ji,jj,jl) ) )       
              
-                  pqsr_ice(ji,jj,jl) = pqsr_ice(ji,jj,jl) + (  ( 1.0 - sf(jp_ccov)%fnow(ji,jj) ) * zqsr_ice_cs    &
-                     &                                       +         sf(jp_ccov)%fnow(ji,jj)   * zqsr_ice_os  )
+                  pqsr_ice(ji,jj,jl) = pqsr_ice(ji,jj,jl) + (  ( 1.0 - sf(jp_ccov)%fnow(ji,jj,1) ) * zqsr_ice_cs    &
+                     &                                       +         sf(jp_ccov)%fnow(ji,jj,1)   * zqsr_ice_os  )
                END DO
             END DO
Index: trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90	(revision 2528)
@@ -12,4 +12,5 @@
    !!            3.0  !  2006-06  (G. Madec) sbc rewritting   
    !!            3.2  !  2009-04  (B. Lemaire)  Introduce iom_put
+   !!            3.3  !  2010-10  (S. Masson)  add diurnal cycle
    !!----------------------------------------------------------------------
 
@@ -26,4 +27,5 @@
    USE fldread         ! read input fields
    USE sbc_oce         ! Surface boundary condition: ocean fields
+   USE sbcdcy          ! surface boundary condition: diurnal cycle
    USE iom             ! I/O manager library
    USE in_out_manager  ! I/O manager
@@ -34,5 +36,4 @@
    USE sbc_ice         ! Surface boundary condition: ice fields
 #endif
-
 
    IMPLICIT NONE
@@ -61,9 +62,10 @@
    REAL(wp), PARAMETER ::   Stef =    5.67e-8     ! Stefan Boltzmann constant
    REAL(wp), PARAMETER ::   Cice =    1.63e-3     ! transfer coefficient over ice
-
-   !                                !!* Namelist namsbc_core : CORE bulk parameters
-   LOGICAL  ::   ln_2m     = .FALSE.     ! logical flag for height of air temp. and hum
-   LOGICAL  ::   ln_taudif = .FALSE.     ! logical flag to use the "mean of stress module - module of mean stress" data
-   REAL(wp) ::   rn_pfac   = 1.          ! multiplication factor for precipitation
+   REAL(wp), PARAMETER ::   albo =    0.066       ! ocean albedo assumed to be contant
+
+   !                                  !!* Namelist namsbc_core : CORE bulk parameters
+   LOGICAL  ::   ln_2m     = .FALSE.   ! logical flag for height of air temp. and hum
+   LOGICAL  ::   ln_taudif = .FALSE.   ! logical flag to use the "mean of stress module - module of mean stress" data
+   REAL(wp) ::   rn_pfac   = 1.        ! multiplication factor for precipitation
 
    !! * Substitutions
@@ -71,9 +73,8 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO-consortium (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -132,20 +133,27 @@
          !
          ! (NB: frequency positive => hours, negative => months)
-         !            !    file     ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation   !
-         !            !    name     !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      !
-         sn_wndi = FLD_N( 'uwnd10m' ,    24     ,  'u_10'    ,  .false.   , .false. ,   'yearly'  , ''       , ''         )
-         sn_wndj = FLD_N( 'vwnd10m' ,    24     ,  'v_10'    ,  .false.   , .false. ,   'yearly'  , ''       , ''         )
-         sn_qsr  = FLD_N( 'qsw'     ,    24     ,  'qsw'     ,  .false.   , .false. ,   'yearly'  , ''       , ''         )
-         sn_qlw  = FLD_N( 'qlw'     ,    24     ,  'qlw'     ,  .false.   , .false. ,   'yearly'  , ''       , ''         )
-         sn_tair = FLD_N( 'tair10m' ,    24     ,  't_10'    ,  .false.   , .false. ,   'yearly'  , ''       , ''         )
-         sn_humi = FLD_N( 'humi10m' ,    24     ,  'q_10'    ,  .false.   , .false. ,   'yearly'  , ''       , ''         )
-         sn_prec = FLD_N( 'precip'  ,    -1     ,  'precip'  ,  .true.    , .false. ,   'yearly'  , ''       , ''         )
-         sn_snow = FLD_N( 'snow'    ,    -1     ,  'snow'    ,  .true.    , .false. ,   'yearly'  , ''       , ''         )
-         sn_tdif = FLD_N( 'taudif'  ,    24     ,  'taudif'  ,  .true.    , .false. ,   'yearly'  , ''       , ''         )
+         !            !    file    ! frequency ! variable ! time intep !  clim   ! 'yearly' or ! weights  ! rotation !
+         !            !    name    !  (hours)  !  name    !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs    !
+         sn_wndi = FLD_N( 'uwnd10m',    24     , 'u_10'   ,  .false.   , .false. ,   'yearly'  , ''       , ''       )
+         sn_wndj = FLD_N( 'vwnd10m',    24     , 'v_10'   ,  .false.   , .false. ,   'yearly'  , ''       , ''       )
+         sn_qsr  = FLD_N( 'qsw'    ,    24     , 'qsw'    ,  .false.   , .false. ,   'yearly'  , ''       , ''       )
+         sn_qlw  = FLD_N( 'qlw'    ,    24     , 'qlw'    ,  .false.   , .false. ,   'yearly'  , ''       , ''       )
+         sn_tair = FLD_N( 'tair10m',    24     , 't_10'   ,  .false.   , .false. ,   'yearly'  , ''       , ''       )
+         sn_humi = FLD_N( 'humi10m',    24     , 'q_10'   ,  .false.   , .false. ,   'yearly'  , ''       , ''       )
+         sn_prec = FLD_N( 'precip' ,    -1     , 'precip' ,  .true.    , .false. ,   'yearly'  , ''       , ''       )
+         sn_snow = FLD_N( 'snow'   ,    -1     , 'snow'   ,  .true.    , .false. ,   'yearly'  , ''       , ''       )
+         sn_tdif = FLD_N( 'taudif' ,    24     , 'taudif' ,  .true.    , .false. ,   'yearly'  , ''       , ''       )
          !
-         REWIND( numnam )                    ! ... read in namlist namsbc_core
+         REWIND( numnam )                          ! read in namlist namsbc_core
          READ  ( numnam, namsbc_core )
-         !
-         ! store namelist information in an array
+         !                                         ! check: do we plan to use ln_dm2dc with non-daily forcing?
+         IF( ln_dm2dc .AND. sn_qsr%nfreqh /= 24 )   & 
+            &   CALL ctl_stop( 'sbc_blk_core: ln_dm2dc can be activated only with daily short-wave forcing' ) 
+         IF( ln_dm2dc .AND. sn_qsr%ln_tint ) THEN
+            CALL ctl_warn( 'sbc_blk_core: ln_dm2dc is taking care of the temporal interpolation of daily qsr',   &
+                 &         '              ==> We force time interpolation = .false. for qsr' )
+            sn_qsr%ln_tint = .false.
+         ENDIF
+         !                                         ! store namelist information in an array
          slf_i(jp_wndi) = sn_wndi   ;   slf_i(jp_wndj) = sn_wndj
          slf_i(jp_qsr ) = sn_qsr    ;   slf_i(jp_qlw ) = sn_qlw
@@ -153,34 +161,29 @@
          slf_i(jp_prec) = sn_prec   ;   slf_i(jp_snow) = sn_snow
          slf_i(jp_tdif) = sn_tdif
-         !
-         ! do we use HF tau information?
-         lhftau = ln_taudif
+         !                 
+         lhftau = ln_taudif                        ! do we use HF tau information?
          jfld = jpfld - COUNT( (/.NOT. lhftau/) )
          !
-         ! set sf structure
-         ALLOCATE( sf(jfld), STAT=ierror )
+         ALLOCATE( sf(jfld), STAT=ierror )         ! set sf structure
          IF( ierror > 0 ) THEN
             CALL ctl_stop( 'sbc_blk_core: unable to allocate sf structure' )   ;   RETURN
          ENDIF
          DO ifpr= 1, jfld
-            ALLOCATE( sf(ifpr)%fnow(jpi,jpj) )
-            ALLOCATE( sf(ifpr)%fdta(jpi,jpj,2) )
+            ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) )
+            IF( slf_i(ifpr)%ln_tint ) ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) )
          END DO
-         !
-         ! fill sf with slf_i and control print
-         CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_core', 'flux formulattion for ocean surface boundary condition', 'namsbc_core' )
+         !                                         ! fill sf with slf_i and control print
+         CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_core', 'flux formulation for ocean surface boundary condition', 'namsbc_core' )
          !
       ENDIF
 
-      CALL fld_read( kt, nn_fsbc, sf )                   ! input fields provided at the current time-step
+      CALL fld_read( kt, nn_fsbc, sf )        ! input fields provided at the current time-step
 
 #if defined key_lim3
-      tatm_ice(:,:) = sf(jp_tair)%fnow(:,:)
+      tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1)                  ! LIM3: make Tair available in sea-ice
 #endif
-
-      IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN
-          CALL blk_oce_core( sf, sst_m, ssu_m, ssv_m )   ! compute the surface ocean fluxes using CLIO bulk formulea
-      ENDIF
-      !                                                  ! using CORE bulk formulea
+      !                                                        ! surface ocean fluxes computed with CLIO bulk formulea
+      IF( MOD( kt - 1, nn_fsbc ) == 0 )   CALL blk_oce_core( sf, sst_m, ssu_m, ssv_m )
+      !
    END SUBROUTINE sbc_blk_core
    
@@ -244,6 +247,6 @@
       DO jj = 2, jpjm1
          DO ji = fs_2, fs_jpim1   ! vect. opt.
-            zwnd_i(ji,jj) = (  sf(jp_wndi)%fnow(ji,jj) - 0.5 * ( pu(ji-1,jj  ) + pu(ji,jj) )  )
-            zwnd_j(ji,jj) = (  sf(jp_wndj)%fnow(ji,jj) - 0.5 * ( pv(ji  ,jj-1) + pv(ji,jj) )  )
+            zwnd_i(ji,jj) = (  sf(jp_wndi)%fnow(ji,jj,1) - 0.5 * ( pu(ji-1,jj  ) + pu(ji,jj) )  )
+            zwnd_j(ji,jj) = (  sf(jp_wndj)%fnow(ji,jj,1) - 0.5 * ( pv(ji  ,jj-1) + pv(ji,jj) )  )
          END DO
       END DO
@@ -260,10 +263,11 @@
       ! ----------------------------------------------------------------------------- !
     
-      ! ocean albedo assumed to be 0.066
-!CDIR COLLAPSE
-      qsr (:,:) = ( 1. - 0.066 ) * sf(jp_qsr)%fnow(:,:) * tmask(:,:,1)                                 ! Short Wave
-!CDIR COLLAPSE
-      zqlw(:,:) = (  sf(jp_qlw)%fnow(:,:) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:)  ) * tmask(:,:,1)   ! Long  Wave
-                      
+      ! ocean albedo assumed to be constant + modify now Qsr to include the diurnal cycle                    ! Short Wave
+      zztmp = 1. - albo
+      IF( ln_dm2dc ) THEN   ;   qsr(:,:) = zztmp * sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * tmask(:,:,1)
+      ELSE                  ;   qsr(:,:) = zztmp *          sf(jp_qsr)%fnow(:,:,1)   * tmask(:,:,1)
+      ENDIF
+!CDIR COLLAPSE
+      zqlw(:,:) = (  sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:)  ) * tmask(:,:,1)   ! Long  Wave
       ! ----------------------------------------------------------------------------- !
       !     II    Turbulent FLUXES                                                    !
@@ -307,5 +311,5 @@
       IF( lhftau ) THEN 
 !CDIR COLLAPSE
-         taum(:,:) = taum(:,:) + sf(jp_tdif)%fnow(:,:)
+         taum(:,:) = taum(:,:) + sf(jp_tdif)%fnow(:,:,1)
       ENDIF
       CALL iom_put( "taum_oce", taum )   ! output wind stress module
@@ -330,7 +334,7 @@
       ELSE
 !CDIR COLLAPSE
-         zevap(:,:) = MAX( 0.e0, rhoa    *Ce(:,:)*( zqsatw(:,:) - sf(jp_humi)%fnow(:,:) ) * wndm(:,:) )   ! Evaporation
-!CDIR COLLAPSE
-         zqsb (:,:) =            rhoa*cpa*Ch(:,:)*( zst   (:,:) - sf(jp_tair)%fnow(:,:) ) * wndm(:,:)     ! Sensible Heat
+         zevap(:,:) = MAX( 0.e0, rhoa    *Ce(:,:)*( zqsatw(:,:) - sf(jp_humi)%fnow(:,:,1) ) * wndm(:,:) )   ! Evaporation
+!CDIR COLLAPSE
+         zqsb (:,:) =            rhoa*cpa*Ch(:,:)*( zst   (:,:) - sf(jp_tair)%fnow(:,:,1) ) * wndm(:,:)     ! Sensible Heat
       ENDIF
 !CDIR COLLAPSE
@@ -355,5 +359,5 @@
       qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)      ! Downward Non Solar flux
 !CDIR COLLAPSE
-      emp (:,:) = zevap(:,:) - sf(jp_prec)%fnow(:,:) * rn_pfac * tmask(:,:,1)
+      emp(:,:) = zevap(:,:) - sf(jp_prec)%fnow(:,:,1) * rn_pfac * tmask(:,:,1)
 !CDIR COLLAPSE
       emps(:,:) = emp(:,:)
@@ -392,21 +396,21 @@
       !! caution : the net upward water flux has with mm/day unit
       !!---------------------------------------------------------------------
-      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)      ::   pst      ! ice surface temperature (>0, =rt0 over land) [Kelvin]
-      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj)    ::   pui      ! ice surface velocity (i- and i- components      [m/s]
-      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj)    ::   pvi      !    at I-point (B-grid) or U & V-point (C-grid)
-      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)      ::   palb     ! ice albedo (clear sky) (alb_ice_cs)               [%]
-      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj)    ::   p_taui   ! i- & j-components of surface ice stress        [N/m2]
-      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj)    ::   p_tauj   !   at I-point (B-grid) or U & V-point (C-grid)
-      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 (T-point)  [%]
-      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj)    ::   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
+      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   pst      ! ice surface temperature (>0, =rt0 over land) [Kelvin]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   pui      ! ice surface velocity (i- and i- components      [m/s]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   pvi      !    at I-point (B-grid) or U & V-point (C-grid)
+      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   palb     ! ice albedo (clear sky) (alb_ice_cs)               [%]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   p_taui   ! i- & j-components of surface ice stress        [N/m2]
+      REAL(wp), DIMENSION(jpi,jpj), 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(jpi,jpj), INTENT(  out) ::   p_tpr    ! total precipitation          (T-point)      [Kg/m2/s]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   p_spr    ! solid precipitation          (T-point)      [Kg/m2/s]
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   p_fr1    ! 1sr fraction of qsr penetration in ice (T-point)  [%]
+      REAL(wp), DIMENSION(jpi,jpj), 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
@@ -414,4 +418,5 @@
       REAL(wp) ::   zst2, zst3
       REAL(wp) ::   zcoef_wnorm, zcoef_wnorm2, zcoef_dqlw, zcoef_dqla, zcoef_dqsb
+      REAL(wp) ::   zztmp                                        ! temporary variable
       REAL(wp) ::   zcoef_frca                                   ! fractional cloud amount
       REAL(wp) ::   zwnorm_f, zwndi_f , zwndj_f                  ! relative wind module and components at F-point
@@ -427,10 +432,10 @@
 
       ! local scalars ( place there for vector optimisation purposes)
-      zcoef_wnorm = rhoa * Cice
+      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
-      zcoef_frca = 1.0  - 0.3
+      zcoef_dqlw   = 4.0 * 0.95 * Stef
+      zcoef_dqla   = -Ls * Cice * 11637800. * (-5897.8)
+      zcoef_dqsb   = rhoa * cpa * Cice
+      zcoef_frca   = 1.0  - 0.3
 
 !!gm brutal....
@@ -444,14 +449,14 @@
       ! ----------------------------------------------------------------------------- !
       SELECT CASE( cd_grid )
-      CASE( 'B' )                  ! B-grid ice dynamics :   I-point (i.e. F-point with sea-ice indexation)
+      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)
 !CDIR NOVERRCHK
          DO jj = 2, jpjm1
-            DO ji = 2, jpim1   ! B grid : no vector opt
+            DO ji = 2, jpim1   ! B grid : NO vector opt
                ! ... scalar wind at I-point (fld being at T-point)
-               zwndi_f = 0.25 * (  sf(jp_wndi)%fnow(ji-1,jj  ) + sf(jp_wndi)%fnow(ji  ,jj  )   &
-                  &              + sf(jp_wndi)%fnow(ji-1,jj-1) + sf(jp_wndi)%fnow(ji  ,jj-1)  ) - pui(ji,jj)
-               zwndj_f = 0.25 * (  sf(jp_wndj)%fnow(ji-1,jj  ) + sf(jp_wndj)%fnow(ji  ,jj  )   &
-                  &              + sf(jp_wndj)%fnow(ji-1,jj-1) + sf(jp_wndj)%fnow(ji  ,jj-1)  ) - pvi(ji,jj)
+               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)  ) - pui(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)  ) - pvi(ji,jj)
                zwnorm_f = zcoef_wnorm * SQRT( zwndi_f * zwndi_f + zwndj_f * zwndj_f )
                ! ... ice stress at I-point
@@ -459,8 +464,8 @@
                p_tauj(ji,jj) = zwnorm_f * zwndj_f
                ! ... scalar wind at T-point (fld being at T-point)
-               zwndi_t = sf(jp_wndi)%fnow(ji,jj) - 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) - 0.25 * (  pvi(ji,jj+1) + pvi(ji+1,jj+1)   &
-                  &                                        + pvi(ji,jj  ) + pvi(ji+1,jj  )  )
+               zwndi_t = sf(jp_wndi)%fnow(ji,jj,1) - 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) - 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)
             END DO
@@ -476,6 +481,6 @@
          DO jj = 2, jpj
             DO ji = fs_2, jpi   ! vect. opt.
-               zwndi_t = (  sf(jp_wndi)%fnow(ji,jj) - 0.5 * ( pui(ji-1,jj  ) + pui(ji,jj) )  )
-               zwndj_t = (  sf(jp_wndj)%fnow(ji,jj) - 0.5 * ( pvi(ji  ,jj-1) + pvi(ji,jj) )  )
+               zwndi_t = (  sf(jp_wndi)%fnow(ji,jj,1) - 0.5 * ( pui(ji-1,jj  ) + pui(ji,jj) )  )
+               zwndj_t = (  sf(jp_wndj)%fnow(ji,jj,1) - 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)
             END DO
@@ -486,8 +491,8 @@
          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) + sf(jp_wndi)%fnow(ji,jj) ) - 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) + sf(jp_wndj)%fnow(ji,jj) ) - pvi(ji,jj) )
+               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) ) - 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) ) - pvi(ji,jj) )
             END DO
          END DO
@@ -498,4 +503,5 @@
       END SELECT
 
+      zztmp = 1. / ( 1. - albo )
       !                                     ! ========================== !
       DO jl = 1, ijpl                       !  Loop over ice categories  !
@@ -512,8 +518,7 @@
                zst3 = pst(ji,jj,jl) * zst2
                ! Short Wave (sw)
-               p_qsr(ji,jj,jl) = ( 1. - palb(ji,jj,jl) ) * sf(jp_qsr)%fnow(ji,jj) * tmask(ji,jj,1)
+               p_qsr(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)       &                         
-                  &                   - 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 * pst(ji,jj,jl) * zst3  ) * tmask(ji,jj,1)
                ! lw sensitivity
                z_dqlw(ji,jj,jl) = zcoef_dqlw * zst3                                               
@@ -525,8 +530,8 @@
                ! ... 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) )
+               z_qsb(ji,jj,jl) = rhoa * cpa * Cice * z_wnds_t(ji,jj) * ( pst(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1) )
                ! Latent Heat
                p_qla(ji,jj,jl) = 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)  ) )
+                  &                    * (  11637800. * EXP( -5897.8 / pst(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj,1)  ) )
                ! Latent heat sensitivity for ice (Dqla/Dt)
                p_dqla(ji,jj,jl) = zcoef_dqla * z_wnds_t(ji,jj) / ( zst2 ) * EXP( -5897.8 / pst(ji,jj,jl) )
@@ -558,7 +563,7 @@
        
 !CDIR COLLAPSE
-      p_tpr(:,:) = sf(jp_prec)%fnow(:,:) * rn_pfac      ! total precipitation [kg/m2/s]
-!CDIR COLLAPSE
-      p_spr(:,:) = sf(jp_snow)%fnow(:,:) * rn_pfac      ! solid precipitation [kg/m2/s]
+      p_tpr(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac      ! total precipitation [kg/m2/s]
+!CDIR COLLAPSE
+      p_spr(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac      ! solid precipitation [kg/m2/s]
       CALL iom_put( 'snowpre', p_spr )                  ! Snow precipitation 
       !
@@ -597,6 +602,4 @@
       !!   9.0  !  05-08  (L. Brodeau) Rewriting and optimization
       !!----------------------------------------------------------------------
-      !! * Arguments
-
       REAL(wp), INTENT(in) :: zu                 ! altitude of wind measurement       [m]
       REAL(wp), INTENT(in), DIMENSION(jpi,jpj) ::  &
@@ -638,5 +641,5 @@
          grav   = 9.8,          &  ! gravity                       
          kappa  = 0.4              ! von Karman s constant
-
+      !!----------------------------------------------------------------------
       !! * Start
       !! Air/sea differences
@@ -762,5 +765,5 @@
          grav   = 9.8,      &  ! gravity                       
          kappa  = 0.4          ! von Karman's constant
-
+      !!----------------------------------------------------------------------
       !!  * Start
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90	(revision 2528)
@@ -4,7 +4,7 @@
    !! Surface Boundary Condition :  momentum, heat and freshwater fluxes in coupled mode
    !!======================================================================
-   !! History :  2.0  !  06-2007  (R. Redler, N. Keenlyside, W. Park) Original code split into flxmod & taumod
-   !!            3.0  !  02-2008  (G. Madec, C Talandier)  surface module
-   !!            3.1  !  02-2009  (G. Madec, S. Masson, E. Maisonave, A. Caubel) generic coupled interface
+   !! History :  2.0  ! 2007-06  (R. Redler, N. Keenlyside, W. Park) Original code split into flxmod & taumod
+   !!            3.0  ! 2008-02  (G. Madec, C Talandier)  surface module
+   !!            3.1  ! 2009_02  (G. Madec, S. Masson, E. Maisonave, A. Caubel) generic coupled interface
    !!----------------------------------------------------------------------
 #if defined key_oasis3 || defined key_oasis4
@@ -23,7 +23,9 @@
    USE sbc_oce         ! Surface boundary condition: ocean fields
    USE sbc_ice         ! Surface boundary condition: ice fields
+   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
 #if defined key_lim2
@@ -163,7 +165,7 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -527,4 +529,7 @@
       CALL cpl_prism_define(jprcv, jpsnd)            
       !
+      IF( ln_dm2dc .AND. ( cpl_prism_freq( jpr_qsroce ) + cpl_prism_freq( jpr_qsrmix ) /= 86400 ) )   &
+         &   CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' )
+
    END SUBROUTINE sbc_cpl_init
 
@@ -728,4 +733,5 @@
          IF( srcv(jpr_qsroce)%laction )   qsr(:,:) = frcv(:,:,jpr_qsroce) 
          IF( srcv(jpr_qsrmix)%laction )   qsr(:,:) = frcv(:,:,jpr_qsrmix)
+         IF( ln_dm2dc )   qsr(:,:) = sbc_dcy( qsr )                           ! modify qsr to include the diurnal cycle
          !
          !                                                       ! total freshwater fluxes over the ocean (emp, emps)
@@ -783,7 +789,7 @@
       !! ** Method  :   transform the received stress from the atmosphere into
       !!             an atmosphere-ice stress in the (i,j) ocean referencial
-      !!             and at the velocity point of the sea-ice model (cigr_type):
+      !!             and at the velocity point of the sea-ice model (cp_ice_msh):
       !!                'C'-grid : i- (j-) components given at U- (V-) point 
-      !!                'B'-grid : both components given at I-point 
+      !!                'I'-grid : B-grid lower-left corner: both components given at I-point 
       !!
       !!                The received stress are :
@@ -798,5 +804,5 @@
       !!                 first  as  2 components on the sphere 
       !!                 second as  2 components oriented along the local grid
-      !!                 third  as  2 components on the cigr_type point 
+      !!                 third  as  2 components on the cp_ice_msh point 
       !!
       !!                In 'oce and ice' case, only one vector stress field 
@@ -804,7 +810,7 @@
       !!             so that it is now defined as (i,j) components given at U-
       !!             and V-points, respectively. Therefore, here only the third
-      !!             transformation is done and only if the ice-grid is a 'B'-grid. 
-      !!
-      !! ** Action  :   return ptau_i, ptau_j, the stress over the ice at cigr_type point
+      !!             transformation is done and only if the ice-grid is a 'I'-grid. 
+      !!
+      !! ** Action  :   return ptau_i, ptau_j, the stress over the ice at cp_ice_msh point
       !!----------------------------------------------------------------------
       REAL(wp), INTENT(out), DIMENSION(jpi,jpj) ::   p_taui   ! i- & j-components of atmos-ice stress [N/m2]
@@ -867,5 +873,5 @@
          !    
          !                                                  j+1   j     -----V---F
-         ! ice stress on ice velocity point (cigr_type)                  !       |
+         ! ice stress on ice velocity point (cp_ice_msh)                 !       |
          ! (C-grid ==>(U,V) or B-grid ==> I or F)                 j      |   T   U
          !                                                               |       |
@@ -874,5 +880,5 @@
          !                                                              i-1  i   i
          !                                                               i      i+1 (for I)
-         SELECT CASE ( cigr_type )
+         SELECT CASE ( cp_ice_msh )
             !
          CASE( 'I' )                                         ! B-grid ==> I
@@ -1159,4 +1165,8 @@
             &                     + palbi         (:,:,1) * zicefr(:,:,1) ) )
       END SELECT
+      IF( ln_dm2dc ) THEN   ! modify qsr to include the diurnal cycle
+         pqsr_tot(:,:  ) = sbc_dcy( pqsr_tot(:,:  ) )
+         pqsr_ice(:,:,1) = sbc_dcy( pqsr_ice(:,:,1) )
+      ENDIF
 
       SELECT CASE( TRIM( cn_rcv_dqnsdt ) )
@@ -1249,5 +1259,5 @@
             END DO
          CASE( 'weighted oce and ice' )   
-            SELECT CASE ( cigr_type )
+            SELECT CASE ( cp_ice_msh )
             CASE( 'C' )                      ! Ocean and Ice on C-grid ==> T
                DO jj = 2, jpjm1
@@ -1284,5 +1294,5 @@
             CALL lbc_lnk( zitx1, 'T', -1. )   ;   CALL lbc_lnk( zity1, 'T', -1. )
          CASE( 'mixed oce-ice'        )
-            SELECT CASE ( cigr_type )
+            SELECT CASE ( cp_ice_msh )
             CASE( 'C' )                      ! Ocean and Ice on C-grid ==> T
                DO jj = 2, jpjm1
Index: trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcdcy.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcdcy.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcdcy.F90	(revision 2528)
@@ -0,0 +1,211 @@
+MODULE sbcdcy
+   !!======================================================================
+   !!                    ***  MODULE  sbcdcy  ***
+   !! Ocean forcing:  compute the diurnal cycle
+   !!======================================================================
+   !! History : OPA  !  2005-02  (D. Bernie)  Original code
+   !!   NEMO    2.0  !  2006-02  (S. Masson, G. Madec)  adaptation to NEMO
+   !!           3.1  !  2009-07  (J.M. Molines)  adaptation to v3.1
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!  sbc_dcy : compute solar flux at kt from daily mean, taking 
+   !!            diurnal cycle into account
+   !!----------------------------------------------------------------------
+   USE oce              ! ocean dynamics and tracers
+   USE phycst           ! ocean physics
+   USE dom_oce          ! ocean space and time domain
+   USE sbc_oce          ! Surface boundary condition: ocean fields
+   USE in_out_manager   ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+   INTEGER, PUBLIC              ::   nday_qsr                    ! day when parameters were computed
+   REAL(wp), DIMENSION(jpi,jpj) ::   raa , rbb  , rcc  , rab     ! parameters used to compute the diurnal cycle
+   REAL(wp), DIMENSION(jpi,jpj) ::   rtmd, rdawn, rdusk, rscal   !     -       -         -           -      -
+  
+   PUBLIC   sbc_dcy     ! routine called by sbc
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO-consortium (2010) 
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+      FUNCTION sbc_dcy( pqsrin ) RESULT( zqsrout )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sbc_dcy  ***
+      !!
+      !! ** Purpose : introduce a diurnal cycle of qsr from daily values
+      !!
+      !! ** Method  : see Appendix A of Bernie et al. 2007.
+      !!
+      !! ** Action  : redistribute daily QSR on each time step following the diurnal cycle
+      !!
+      !! reference  : Bernie, DJ, E Guilyardi, G Madec, JM Slingo, and SJ Woolnough, 2007
+      !!              Impact of resolving the diurnal cycle in an ocean--atmosphere GCM. 
+      !!              Part 1: a diurnally forced OGCM. Climate Dynamics 29:6, 575-590.
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqsrin    ! input daily QSR flux 
+      !!
+      INTEGER  ::   ji, jj                                       ! dummy loop indices
+      REAL(wp) ::   ztwopi, zinvtwopi, zconvrad 
+      REAL(wp) ::   zlo, zup, zlousd, zupusd
+      REAL(wp) ::   zdsws, zdecrad, ztx, zsin, zcos
+      REAL(wp) ::   ztmp, ztmp1, ztmp2, ztest
+      REAL(wp), DIMENSION(jpi,jpj) ::   zqsrout                  ! output QSR flux with diurnal cycle
+      !---------------------------statement functions------------------------
+      REAL(wp) ::   fintegral, pt1, pt2, paaa, pbbb, pccc        ! dummy statement function arguments
+      fintegral( pt1, pt2, paaa, pbbb, pccc ) =                         &
+         &   paaa * pt2 + zinvtwopi * pbbb * SIN(pccc + ztwopi * pt2)   &
+         & - paaa * pt1 - zinvtwopi * pbbb * SIN(pccc + ztwopi * pt1)
+      !!---------------------------------------------------------------------
+
+      ! Initialization
+      ! --------------
+      ztwopi    = 2. * rpi
+      zinvtwopi = 1. / ztwopi
+      zconvrad  = ztwopi / 360.
+
+      ! When are we during the day (from 0 to 1)
+      zlo = ( REAL(nsec_day, wp) - 0.5   * rdttra(1) ) / rday
+      zup = zlo + ( REAL(nn_fsbc, wp) * rdttra(1) ) / rday
+
+      !                                          
+      IF( nday_qsr == -1 ) THEN       ! first time step only               
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'sbc_dcy : introduce diurnal cycle from daily mean qsr'
+            WRITE(numout,*) '~~~~~~~'
+            WRITE(numout,*)
+         ENDIF
+         ! Compute rcc needed to compute the time integral of the diurnal cycle
+         rcc(:,:) = zconvrad * glamt(:,:) - rpi
+         ! time of midday
+         rtmd(:,:) = 0.5 - glamt(:,:) / 360.
+         rtmd(:,:) = MOD( (rtmd(:,:) + 1.), 1. )
+      ENDIF
+
+      ! If this is a new day, we have to update the dawn, dusk and scaling function  
+      !----------------------
+    
+      !     2.1 dawn and dusk  
+
+      ! nday is the number of days since the beginning of the current month 
+      IF( nday_qsr /= nday ) THEN 
+         ! save the day of the year and the daily mean of qsr
+         nday_qsr = nday 
+         ! number of days since the previous winter solstice (supposed to be always 21 December)         
+         zdsws = REAL(11 + nday_year, wp)
+         ! declination of the earths orbit
+         zdecrad = (-23.5 * zconvrad) * COS( zdsws * ztwopi / REAL(nyear_len(1),wp) )
+         ! Compute A and B needed to compute the time integral of the diurnal cycle
+        
+         zsin = SIN( zdecrad )   ;   zcos = COS( zdecrad )
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ztmp = zconvrad * gphit(ji,jj)
+               raa(ji,jj) = SIN( ztmp ) * zsin
+               rbb(ji,jj) = COS( ztmp ) * zcos
+            END DO  
+         END DO  
+
+         ! Compute the time of dawn and dusk
+
+         ! rab to test if the day time is equal to 0, less than 24h of full day        
+         rab(:,:) = -raa(:,:) / rbb(:,:)
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF ( ABS(rab(ji,jj)) < 1 ) THEN         ! day duration is less than 24h
+         ! When is it night?
+                  ztx = zinvtwopi * (ACOS(rab(ji,jj)) - rcc(ji,jj))
+                  ztest = -rbb(ji,jj) * SIN( rcc(ji,jj) + ztwopi * ztx )
+         ! is it dawn or dusk?
+                  IF ( ztest > 0 ) THEN
+                     rdawn(ji,jj) = ztx
+                     rdusk(ji,jj) = rtmd(ji,jj) + ( rtmd(ji,jj) - rdawn(ji,jj) )
+                  ELSE
+                     rdusk(ji,jj) = ztx
+                     rdawn(ji,jj) = rtmd(ji,jj) - ( rdusk(ji,jj) - rtmd(ji,jj) )
+                  ENDIF
+               ELSE
+                  rdawn(ji,jj) = rtmd(ji,jj) + 0.5
+                  rdusk(ji,jj) = rdawn(ji,jj)
+               ENDIF
+             END DO  
+         END DO  
+         rdawn(:,:) = MOD((rdawn(:,:) + 1.), 1.)
+         rdusk(:,:) = MOD((rdusk(:,:) + 1.), 1.)
+
+         !     2.2 Compute the scalling function:
+         !         S* = the inverse of the time integral of the diurnal cycle from dawm to dusk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF ( ABS(rab(ji,jj)) < 1 ) THEN         ! day duration is less than 24h
+                  IF ( rdawn(ji,jj) < rdusk(ji,jj) ) THEN      ! day time in one part
+                     rscal(ji,jj) = fintegral(rdawn(ji,jj), rdusk(ji,jj), raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
+                     rscal(ji,jj) = 1. / rscal(ji,jj)
+                  ELSE                                         ! day time in two parts
+                     rscal(ji,jj) = fintegral(0., rdusk(ji,jj), raa(ji,jj), rbb(ji,jj), rcc(ji,jj))   &
+                        &         + fintegral(rdawn(ji,jj), 1., raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
+                     rscal(ji,jj) = 1. / rscal(ji,jj)
+                  ENDIF
+               ELSE
+                  IF ( raa(ji,jj) > rbb(ji,jj) ) THEN         ! 24h day
+                     rscal(ji,jj) = fintegral(0., 1., raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
+                     rscal(ji,jj) = 1. / rscal(ji,jj)
+                  ELSE                                          ! No day
+                     rscal(ji,jj) = 0.e0
+                  ENDIF
+               ENDIF
+            END DO  
+         END DO  
+         !
+         ztmp = rday / ( rdttra(1) * REAL(nn_fsbc, wp) )
+         rscal(:,:) = rscal(:,:) * ztmp
+
+      ENDIF 
+
+         !     3. update qsr with the diurnal cycle
+         !     ------------------------------------
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( ABS(rab(ji,jj)) < 1 ) THEN         ! day duration is less than 24h
+               !
+               IF( rdawn(ji,jj) < rdusk(ji,jj) ) THEN       ! day time in one part
+                  zlousd = MAX(zlo, rdawn(ji,jj))
+                  zlousd = MIN(zlousd, zup)
+                  zupusd = MIN(zup, rdusk(ji,jj))
+                  zupusd = MAX(zupusd, zlo)
+                  ztmp = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
+                  zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj)
+                  !
+               ELSE                                         ! day time in two parts
+                  zlousd = MIN(zlo, rdusk(ji,jj))
+                  zupusd = MIN(zup, rdusk(ji,jj))
+                  ztmp1 = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
+                  zlousd = MAX(zlo, rdawn(ji,jj))
+                  zupusd = MAX(zup, rdawn(ji,jj))
+                  ztmp2 = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
+                  ztmp = ztmp1 + ztmp2
+                  zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj)
+               ENDIF
+            ELSE                                   ! 24h light or 24h night
+               !
+               IF( raa(ji,jj) > rbb(ji,jj) ) THEN           ! 24h day
+                  ztmp = fintegral(zlo, zup, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
+                  zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj)
+                  !
+               ELSE                                         ! No day
+                  zqsrout(ji,jj) = 0.e0
+               ENDIF
+            ENDIF
+         END DO  
+      END DO  
+      !
+   END FUNCTION sbc_dcy
+
+   !!======================================================================
+END MODULE sbcdcy
Index: trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90	(revision 2528)
@@ -4,28 +4,16 @@
    !! Ocean forcing:  momentum, heat and freshwater flux formulation
    !!=====================================================================
-   !! History :  9.0   !  06-06  (G. Madec)  Original code
+   !! History :  1.0  !  2006-06  (G. Madec)  Original code
+   !!            3.3  !  2010-10  (S. Masson)  add diurnal cycle
    !!----------------------------------------------------------------------
 
    !!----------------------------------------------------------------------
    !!   namflx   : flux formulation namlist
-   !!   sbc_flx  : flux formulation as ocean surface boundary condition
-   !!              (forced mode, fluxes read in NetCDF files)
-   !!----------------------------------------------------------------------
-   !! question diverses
-   !!  *   ajouter un test sur la division entier de freqh et rdttra ???
-   !!  **  ajoute dans namelist: 1 year forcing files
-   !!                         or forcing file starts at the begining of the run
-   !!  *** we assume that the forcing file start and end with the previous
-   !!      year last record and the next year first record (useful for
-   !!      time interpolation, required even if no time interp???)
-   !!  *   ajouter un test sur la division de la frequence en pas de temps
-   !!  ==> daymod ajout de nsec_year = number of second since the begining of the year
-   !!      assumed to be 0 at 0h january the 1st (i.e. 24h december the 31)
-   !!
-   !!  *** regrouper dtatem et dtasal
+   !!   sbc_flx  : flux formulation as ocean surface boundary condition (forced mode, fluxes read in NetCDF files)
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and tracers
    USE dom_oce         ! ocean space and time domain
-   USE sbc_oce         ! Surface boundary condition: ocean fields
+   USE sbc_oce         ! surface boundary condition: ocean fields
+   USE sbcdcy          ! surface boundary condition: diurnal cycle on qsr
    USE phycst          ! physical constants
    USE fldread         ! read input fields
@@ -52,9 +40,8 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2006) 
+   !! NEMO/OPA 3.3 , NEMO-consortium (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -98,61 +85,60 @@
       NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp
       !!---------------------------------------------------------------------
-      !                                         ! ====================== !
-      IF( kt == nit000 ) THEN                   !  First call kt=nit000  !
-         !                                      ! ====================== !
+      !
+      IF( kt == nit000 ) THEN                ! First call kt=nit000  
          ! set file information
          cn_dir = './'        ! directory in which the model is executed
          ! ... default values (NB: frequency positive => hours, negative => months)
-         !              !   file    ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation   !
-         !              !   name    !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      !
-         sn_utau = FLD_N(   'utau'  ,    24     ,  'utau'    ,  .false.   , .false. ,   'yearly'  , ''       , ''         )
-         sn_vtau = FLD_N(   'vtau'  ,    24     ,  'vtau'    ,  .false.   , .false. ,   'yearly'  , ''       , ''         )
-         sn_qtot = FLD_N(   'qtot'  ,    24     ,  'qtot'    ,  .false.   , .false. ,   'yearly'  , ''       , ''         )
-         sn_qsr  = FLD_N(   'qsr'   ,    24     ,  'qsr'     ,  .false.   , .false. ,   'yearly'  , ''       , ''         )
-         sn_emp  = FLD_N(   'emp'   ,    24     ,  'emp'     ,  .false.   , .false. ,   'yearly'  , ''       , ''         )
-
-         REWIND ( numnam )               ! ... read in namlist namflx
+         !              !  file   ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation  !
+         !              !  name   !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs     !
+         sn_utau = FLD_N(  'utau' ,    24     ,  'utau'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
+         sn_vtau = FLD_N(  'vtau' ,    24     ,  'vtau'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
+         sn_qtot = FLD_N(  'qtot' ,    24     ,  'qtot'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
+         sn_qsr  = FLD_N(  'qsr'  ,    24     ,  'qsr'     ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
+         sn_emp  = FLD_N(  'emp'  ,    24     ,  'emp'     ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
+         !
+         REWIND ( numnam )                         ! read in namlist namflx
          READ   ( numnam, namsbc_flx ) 
-
-         ! store namelist information in an array
+         !
+         !                                         ! check: do we plan to use ln_dm2dc with non-daily forcing?
+         IF( ln_dm2dc .AND. sn_qsr%nfreqh /= 24 )   &
+            &   CALL ctl_stop( 'sbc_blk_core: ln_dm2dc can be activated only with daily short-wave forcing' ) 
+         !
+         !                                         ! store namelist information in an array
          slf_i(jp_utau) = sn_utau   ;   slf_i(jp_vtau) = sn_vtau
          slf_i(jp_qtot) = sn_qtot   ;   slf_i(jp_qsr ) = sn_qsr 
          slf_i(jp_emp ) = sn_emp
-
-         ! set sf structure
-         ALLOCATE( sf(jpfld), STAT=ierror )
+         !
+         ALLOCATE( sf(jpfld), STAT=ierror )        ! set sf structure
          IF( ierror > 0 ) THEN   
             CALL ctl_stop( 'sbc_flx: unable to allocate sf structure' )   ;   RETURN  
          ENDIF
          DO ji= 1, jpfld
-            ALLOCATE( sf(ji)%fnow(jpi,jpj) )
-            ALLOCATE( sf(ji)%fdta(jpi,jpj,2) )
+            ALLOCATE( sf(ji)%fnow(jpi,jpj,1) )
+            IF( slf_i(ji)%ln_tint ) ALLOCATE( sf(ji)%fdta(jpi,jpj,1,2) )
          END DO
-
-
-         ! fill sf with slf_i and control print
+         !                                         ! fill sf with slf_i and control print
          CALL fld_fill( sf, slf_i, cn_dir, 'sbc_flx', 'flux formulation for ocean surface boundary condition', 'namsbc_flx' )
          !
       ENDIF
 
-      CALL fld_read( kt, nn_fsbc, sf )           ! Read input fields and provides the
-      !                                          ! input fields at the current time-step
+      CALL fld_read( kt, nn_fsbc, sf )                            ! input fields provided at the current time-step
+     
+      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN                        ! update ocean fluxes at each SBC frequency
 
-      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN
-         !
-         ! set the ocean fluxes from read fields
+         IF( ln_dm2dc ) THEN   ;   qsr(:,:) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) )   ! modify now Qsr to include the diurnal cycle
+         ELSE                  ;   qsr(:,:) =          sf(jp_qsr)%fnow(:,:,1)
+         ENDIF
 !CDIR COLLAPSE
-         DO jj = 1, jpj
+         DO jj = 1, jpj                                           ! set the ocean fluxes from read fields
             DO ji = 1, jpi
-               utau(ji,jj) = sf(jp_utau)%fnow(ji,jj)
-               vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj)
-               qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj) - sf(jp_qsr)%fnow(ji,jj)
-               qsr (ji,jj) = sf(jp_qsr )%fnow(ji,jj)
-               emp (ji,jj) = sf(jp_emp )%fnow(ji,jj)
+               utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1)
+               vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1)
+               qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1)
+               emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1)
             END DO
          END DO
-         
-         ! module of wind stress and wind speed at T-point
-         zcoef = 1. / ( zrhoa * zcdrag ) 
+         !                                                        ! module of wind stress and wind speed at T-point
+         zcoef = 1. / ( zrhoa * zcdrag )
 !CDIR NOVERRCHK
          DO jj = 2, jpjm1
@@ -168,9 +154,7 @@
          CALL lbc_lnk( taum(:,:), 'T', 1. )   ;   CALL lbc_lnk( wndm(:,:), 'T', 1. )
 
-         ! Initialization of emps (when no ice model)
-         emps(:,:) = emp (:,:) 
+         emps(:,:) = emp (:,:)                                    ! Initialization of emps (needed when no ice model)
                   
-         ! control print (if less than 100 time-step asked)
-         IF( nitend-nit000 <= 100 .AND. lwp ) THEN
+         IF( nitend-nit000 <= 100 .AND. lwp ) THEN                ! control print (if less than 100 time-step asked)
             WRITE(numout,*) 
             WRITE(numout,*) '        read daily momentum, heat and freshwater fluxes OK'
Index: trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90	(revision 2528)
@@ -4,8 +4,8 @@
    !! Ocean fluxes   : domain averaged freshwater budget
    !!======================================================================
-   !! History :  8.2  !  01-02  (E. Durand)  Original code
-   !!            8.5  !  02-06  (G. Madec)  F90: Free form and module
-   !!            9.0  !  06-08  (G. Madec)  Surface module
-   !!            9.2  !  09-07  (C. Talandier) emp mean s spread over erp area 
+   !! History :  OPA  ! 2001-02  (E. Durand)  Original code
+   !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module
+   !!            3.0  ! 2006-08  (G. Madec)  Surface module
+   !!            3.2  ! 2009-07  (C. Talandier) emp mean s spread over erp area 
    !!----------------------------------------------------------------------
 
@@ -23,4 +23,5 @@
    USE lib_mpp         ! distribued memory computing library
    USE lbclnk          ! ocean lateral boundary conditions
+   USE lib_fortran
 
    IMPLICIT NONE
@@ -31,8 +32,8 @@
    REAL(wp) ::   a_fwb_b            ! annual domain averaged freshwater budget
    REAL(wp) ::   a_fwb              ! for 2 year before (_b) and before year.
-   REAL(wp) ::   empold             ! empold to be suppressed
+   REAL(wp) ::   fwfold             ! fwfold to be suppressed
    REAL(wp) ::   area               ! global mean ocean surface (interior domain)
 
-   REAL(wp), DIMENSION(jpi,jpj) ::   e1e2_i    ! area of the interior domain (e1t*e2t*tmask_i)
+   REAL(wp), DIMENSION(jpi,jpj) ::   e1e2    ! area of the interior domain (e1t*e2t)
 
    !! * Substitutions
@@ -40,7 +41,7 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2006) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 CONTAINS
@@ -65,5 +66,5 @@
       INTEGER  ::   inum                  ! temporary logical unit
       INTEGER  ::   ikty, iyear           ! 
-      REAL(wp) ::   z_emp, z_emp_nsrf, zsum_emp, zsum_erp       ! temporary scalars
+      REAL(wp) ::   z_fwf, z_fwf_nsrf, zsum_fwf, zsum_erp       ! temporary scalars
       REAL(wp) ::   zsurf_neg, zsurf_pos, zsurf_tospread
       REAL(wp), DIMENSION(jpi,jpj) ::   ztmsk_neg, ztmsk_pos, ztmsk_tospread
@@ -72,5 +73,4 @@
       !
       IF( kt == nit000 ) THEN
-         !
          IF(lwp) THEN
             WRITE(numout,*)
@@ -79,13 +79,11 @@
             IF( kn_fwb == 1 )   WRITE(numout,*) '          instantaneously set to zero'
             IF( kn_fwb == 2 )   WRITE(numout,*) '          adjusted from previous year budget'
-            IF( kn_fwb == 3 )   WRITE(numout,*) '          emp set to zero and spread out over erp area'
+            IF( kn_fwb == 3 )   WRITE(numout,*) '          fwf set to zero and spread out over erp area'
          ENDIF
          !
          IF( kn_fwb == 3 .AND. nn_sssr /= 2 )   CALL ctl_stop( 'sbc_fwb: nn_fwb = 3 requires nn_sssr = 2, we stop ' )
          !
-         e1e2_i(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:)
-         area = SUM( e1e2_i(:,:) )
-         IF( lk_mpp )   CALL  mpp_sum( area    )   ! sum over the global domain
-         !
+         e1e2(:,:) = e1t(:,:) * e2t(:,:) 
+         area = glob_sum( e1e2(:,:) )           ! interior global domain surface
       ENDIF
       
@@ -93,53 +91,43 @@
       SELECT CASE ( kn_fwb )
       !
-      CASE ( 0 )                               
-         WRITE(ctmp1,*)'sbc_fwb : nn_fwb = ', kn_fwb, ' is not yet associated to an option, choose either 1/2'
-         CALL ctl_stop( ctmp1 )
+      CASE ( 1 )                             !==  global mean fwf set to zero  ==!
          !
-         
-      !
-      CASE ( 1 )                               ! global mean emp set to zero
          IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN
-            z_emp = SUM( e1e2_i(:,:) * emp(:,:) ) / area
-            IF( lk_mpp )   CALL  mpp_sum( z_emp    )   ! sum over the global domain
-            emp (:,:) = emp (:,:) - z_emp
-            emps(:,:) = emps(:,:) - z_emp
+            z_fwf = glob_sum( e1e2(:,:) * ( emp(:,:) - rnf(:,:) ) ) / area   ! sum over the global domain
+            emp (:,:) = emp (:,:) - z_fwf 
+            emps(:,:) = emps(:,:) - z_fwf 
          ENDIF
          !
-      CASE ( 2 )                               ! emp budget adjusted from the previous year
-         ! initialisation
-         IF( kt == nit000 ) THEN
-            ! Read the corrective factor on precipitations (empold)
+      CASE ( 2 )                             !==  fwf budget adjusted from the previous year  ==!
+         !
+         IF( kt == nit000 ) THEN                   ! initialisation
+            !                                         ! Read the corrective factor on precipitations (fwfold)
             CALL ctl_opn( inum, 'EMPave_old.dat', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
             READ ( inum, "(24X,I8,2ES24.16)" ) iyear, a_fwb_b, a_fwb
             CLOSE( inum )
-            empold = a_fwb                  ! current year freshwater budget correction
-            !                               ! estimate from the previous year budget
+            fwfold = a_fwb                            ! current year freshwater budget correction
+            !                                         ! estimate from the previous year budget
             IF(lwp)WRITE(numout,*)
-            IF(lwp)WRITE(numout,*)'sbc_fwb : year = ',iyear  , ' freshwater budget correction = ', empold
+            IF(lwp)WRITE(numout,*)'sbc_fwb : year = ',iyear  , ' freshwater budget correction = ', fwfold
             IF(lwp)WRITE(numout,*)'          year = ',iyear-1, ' freshwater budget read       = ', a_fwb
             IF(lwp)WRITE(numout,*)'          year = ',iyear-2, ' freshwater budget read       = ', a_fwb_b
          ENDIF   
-         ! 
-         ! Update empold if new year start
+         !                                         ! Update fwfold if new year start
          ikty = 365 * 86400 / rdttra(1)    !!bug  use of 365 days leap year or 360d year !!!!!!!
          IF( MOD( kt, ikty ) == 0 ) THEN
             a_fwb_b = a_fwb
-            a_fwb   = SUM( e1e2_i(:,:) * sshn(:,:) )
-            IF( lk_mpp )   CALL  mpp_sum( a_fwb    )   ! sum over the global domain
+            a_fwb   = glob_sum( e1e2(:,:) * sshn(:,:) )   ! sum over the global domain
             a_fwb   = a_fwb * 1.e+3 / ( area * 86400. * 365. )     ! convert in Kg/m3/s = mm/s
 !!gm        !                                                      !!bug 365d year 
-            empold =  a_fwb                 ! current year freshwater budget correction
-            !                               ! estimate from the previous year budget
+            fwfold =  a_fwb                           ! current year freshwater budget correction
+            !                                         ! estimate from the previous year budget
          ENDIF
          ! 
-         ! correct the freshwater fluxes
-         IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN
-            emp (:,:) = emp (:,:) + empold
-            emps(:,:) = emps(:,:) + empold
+         IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN      ! correct the freshwater fluxes
+            emp (:,:) = emp (:,:) + fwfold
+            emps(:,:) = emps(:,:) + fwfold
          ENDIF
          !
-         ! save empold value in a file
-         IF( kt == nitend .AND. lwp ) THEN
+         IF( kt == nitend .AND. lwp ) THEN         ! save fwfold value in a file
             CALL ctl_opn( inum, 'EMPave.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )
             WRITE( inum, "(24X,I8,2ES24.16)" ) nyear, a_fwb_b, a_fwb
@@ -147,71 +135,58 @@
          ENDIF
          !
-      CASE ( 3 )                               ! global emp set to zero and spread out over erp area
+      CASE ( 3 )                             !==  global fwf set to zero and spread out over erp area  ==!
          !
          IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN
-            ! Select <0 and >0 area of erp
-            ztmsk_pos(:,:) = tmask_i(:,:)
-            WHERE( erp < 0.e0 ) ztmsk_pos = 0.e0
+            ztmsk_pos(:,:) = tmask_i(:,:)                      ! Select <0 and >0 area of erp
+            WHERE( erp < 0._wp )   ztmsk_pos = 0._wp
             ztmsk_neg(:,:) = tmask_i(:,:) - ztmsk_pos(:,:)
-
-            ! Area filled by <0 and >0 erp 
-            zsurf_neg = SUM( e1e2_i(:,:)*ztmsk_neg(:,:) )
-            zsurf_pos = SUM( e1e2_i(:,:)*ztmsk_pos(:,:) )
-        
-            ! emp global mean 
-            z_emp = SUM( e1e2_i(:,:) * emp(:,:) ) / area
             !
-            IF( lk_mpp )   CALL  mpp_sum( z_emp )
-            IF( lk_mpp )   CALL  mpp_sum( zsurf_neg )
-            IF( lk_mpp )   CALL  mpp_sum( zsurf_pos )
-            
-            IF( z_emp < 0.e0 ) THEN
-                ! to spread out over >0 erp area to increase evaporation damping process
-                zsurf_tospread = zsurf_pos
+            zsurf_neg = glob_sum( e1e2(:,:)*ztmsk_neg(:,:) )   ! Area filled by <0 and >0 erp 
+            zsurf_pos = glob_sum( e1e2(:,:)*ztmsk_pos(:,:) )
+            !                                                  ! fwf global mean 
+            z_fwf = glob_sum( e1e2(:,:) * ( emp(:,:) - rnf(:,:) ) ) / area
+            !            
+            IF( z_fwf < 0._wp ) THEN         ! spread out over >0 erp area to increase evaporation
+                zsurf_tospread      = zsurf_pos
                 ztmsk_tospread(:,:) = ztmsk_pos(:,:)
-            ELSE
-                ! to spread out over <0 erp area to increase precipitation damping process
-                zsurf_tospread = zsurf_neg
+            ELSE                             ! spread out over <0 erp area to increase precipitation
+                zsurf_tospread      = zsurf_neg
                 ztmsk_tospread(:,:) = ztmsk_neg(:,:)
             ENDIF
-
-            ! emp global mean over <0 or >0 erp area
-            zsum_emp = SUM( e1e2_i(:,:) * z_emp )
-            IF( lk_mpp )   CALL  mpp_sum( zsum_emp )
-            z_emp_nsrf =  zsum_emp / ( zsurf_tospread + rsmall )
-            ! weight to respect erp field 2D structure 
-            zsum_erp = SUM( ztmsk_tospread(:,:) * erp(:,:) * e1e2_i(:,:) )
-            IF( lk_mpp )   CALL  mpp_sum( zsum_erp )
+            !
+            zsum_fwf   = glob_sum( e1e2(:,:) * z_fwf )         ! fwf global mean over <0 or >0 erp area
+!!gm :  zsum_fwf   = z_fwf * area   ???  it is right?  I think so....
+            z_fwf_nsrf =  zsum_fwf / ( zsurf_tospread + rsmall )
+            !                                                  ! weight to respect erp field 2D structure 
+            zsum_erp = glob_sum( ztmsk_tospread(:,:) * erp(:,:) * e1e2(:,:) )
             z_wgt(:,:) = ztmsk_tospread(:,:) * erp(:,:) / ( zsum_erp + rsmall )
-
-            ! final correction term to apply
-            zerp_cor(:,:) = -1. * z_emp_nsrf * zsurf_tospread * z_wgt(:,:)
-
+            !                                                  ! final correction term to apply
+            zerp_cor(:,:) = -1. * z_fwf_nsrf * zsurf_tospread * z_wgt(:,:)
+            !
+!!gm   ===>>>>  lbc_lnk should be useless as all the computation is done over the whole domain !
             CALL lbc_lnk( zerp_cor, 'T', 1. )
-
+            !
             emp (:,:) = emp (:,:) + zerp_cor(:,:)
             emps(:,:) = emps(:,:) + zerp_cor(:,:)
             erp (:,:) = erp (:,:) + zerp_cor(:,:)
-            
-            IF( nprint == 1 .AND. lwp ) THEN
-               IF( z_emp < 0.e0 ) THEN
-                  WRITE(numout,*)'       z_emp < 0'
-                  WRITE(numout,*)'       SUM(erp+)        = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2_i(:,:) )*1.e-3,' m3.s-1'
+            !
+            IF( nprint == 1 .AND. lwp ) THEN                   ! control print
+               IF( z_fwf < 0._wp ) THEN
+                  WRITE(numout,*)'   z_fwf < 0'
+                  WRITE(numout,*)'   SUM(erp+)     = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2(:,:) )*1.e-9,' Sv'
                ELSE
-                   WRITE(numout,*)'      z_emp >= 0'
-                   WRITE(numout,*)'      SUM(erp-)        = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2_i(:,:) )*1.e-3,' m3.s-1'
+                  WRITE(numout,*)'   z_fwf >= 0'
+                  WRITE(numout,*)'   SUM(erp-)     = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2(:,:) )*1.e-9,' Sv'
                ENDIF
-               WRITE(numout,*)'      SUM(empG)        = ', SUM( z_emp*e1e2_i(:,:) )*1.e-3,' m3.s-1'
-               WRITE(numout,*)'      z_emp            = ', z_emp      ,' mm.s-1'
-               WRITE(numout,*)'      z_emp_nsrf       = ', z_emp_nsrf ,' mm.s-1'
-               WRITE(numout,*)'      MIN(zerp_cor)    = ', MINVAL(zerp_cor) 
-               WRITE(numout,*)'      MAX(zerp_cor)    = ', MAXVAL(zerp_cor) 
+               WRITE(numout,*)'   SUM(empG)     = ', SUM( z_fwf*e1e2(:,:) )*1.e-9,' Sv'
+               WRITE(numout,*)'   z_fwf         = ', z_fwf      ,' Kg/m2/s'
+               WRITE(numout,*)'   z_fwf_nsrf    = ', z_fwf_nsrf ,' Kg/m2/s'
+               WRITE(numout,*)'   MIN(zerp_cor) = ', MINVAL(zerp_cor) 
+               WRITE(numout,*)'   MAX(zerp_cor) = ', MAXVAL(zerp_cor) 
             ENDIF
-            !
          ENDIF
          !
-      CASE DEFAULT    ! you should never be there
-         WRITE(ctmp1,*)'sbc_fwb : nn_fwb = ', kn_fwb, ' is not permitted for the FreshWater Budget correction, choose either 1/2'
-         CALL ctl_stop( ctmp1 )
+      CASE DEFAULT                           !==  you should never be there  ==!
+         CALL ctl_stop( 'sbc_fwb : wrong nn_fwb value for the FreshWater Budget correction, choose either 1, 2 or 3' )
          !
       END SELECT
Index: trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90	(revision 2528)
@@ -30,7 +30,7 @@
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -81,6 +81,6 @@
             CALL ctl_stop( 'sbc_ice_if: unable to allocate sf_ice structure' )   ;   RETURN
          ENDIF
-         ALLOCATE( sf_ice(1)%fnow(jpi,jpj) )
-         ALLOCATE( sf_ice(1)%fdta(jpi,jpj,2) )
+         ALLOCATE( sf_ice(1)%fnow(jpi,jpj,1) )
+         IF( sn_ice%ln_tint ) ALLOCATE( sf_ice(1)%fdta(jpi,jpj,1,2) )
 
 
@@ -107,5 +107,5 @@
                !
                zt_fzp  = fr_i(ji,jj)                        ! freezing point temperature
-               zfr_obs = sf_ice(1)%fnow(ji,jj)              ! observed ice cover
+               zfr_obs = sf_ice(1)%fnow(ji,jj,1)            ! observed ice cover
                !                                            ! ocean ice fraction (0/1) from the freezing point temperature
                IF( sst_m(ji,jj) <= zt_fzp ) THEN   ;   fr_i(ji,jj) = 1.e0
Index: trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90	(revision 2528)
@@ -5,8 +5,9 @@
    !!       &           covered area using LIM sea-ice model
    !! Sea-Ice model  :  LIM 3.0 Sea ice model time-stepping
-   !!======================================================================
-   !! History :  2.0   !  2006-12  (M. Vancoppenolle) Original code
-   !!            3.0   !  2008-02  (C. Talandier)  Surface module from icestp.F90
-   !!            9.0   !  2008-04  (G. Madec)  sltyle and lim_ctl routine
+   !!=====================================================================
+   !! History :  2.0  ! 2006-12  (M. Vancoppenolle) Original code
+   !!            3.0  ! 2008-02  (C. Talandier)  Surface module from icestp.F90
+   !!             -   ! 2008-04  (G. Madec)  sltyle and lim_ctl routine
+   !!            3.3  ! 2010-11  (G. Madec) ice-ocean stress always computed at each ocean time-step
    !!----------------------------------------------------------------------
 #if defined key_lim3
@@ -19,11 +20,10 @@
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and tracers
-   USE c1d             ! 1d configuration
    USE dom_oce         ! ocean space and time domain
-   USE lib_mpp
+   USE lib_mpp         ! MPP library
    USE par_ice         ! sea-ice parameters
-   USE ice
-   USE iceini
-   USE dom_ice
+   USE ice             ! LIM-3: ice variables
+   USE iceini          ! LIM-3: ice initialisation
+   USE dom_ice         ! LIM-3: ice domain
 
    USE sbc_oce         ! Surface boundary condition: ocean fields
@@ -31,5 +31,5 @@
    USE sbcblk_core     ! Surface boundary condition: CORE bulk
    USE sbcblk_clio     ! Surface boundary condition: CLIO bulk
-   USE albedo
+   USE albedo          ! ocean & ice albedo
 
    USE phycst          ! Define parameters for the routines
@@ -47,5 +47,6 @@
    USE limvar          ! Ice variables switch
 
-   USE lbclnk
+   USE c1d             ! 1D vertical configuration
+   USE lbclnk          ! lateral boundary condition - MPP link
    USE iom             ! I/O manager library
    USE in_out_manager  ! I/O manager
@@ -57,18 +58,15 @@
    PUBLIC sbc_ice_lim  ! routine called by sbcmod.F90
    
-   CHARACTER(len=1) ::   cl_grid = 'C'     ! type of grid used in ice dynamics
-
    !! * Substitutions
 #  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/LIM 3.0 , UCL-LOCEAN-IPSL  (2008)
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
-   SUBROUTINE sbc_ice_lim( kt, kblk, kico )
+   SUBROUTINE sbc_ice_lim( kt, kblk )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE sbc_ice_lim  ***
@@ -92,5 +90,4 @@
       INTEGER, INTENT(in) ::   kt      ! ocean time step
       INTEGER, INTENT(in) ::   kblk    ! type of bulk (=3 CLIO, =4 CORE)
-      INTEGER, INTENT(in) ::   kico    ! ice-ocean stress treatment
       !!
       INTEGER  ::   jl                 ! loop index
@@ -143,5 +140,5 @@
                &                      qla_ice   , dqns_ice  , dqla_ice  ,               &
                &                      tprecip   , sprecip   ,                           &
-               &                      fr1_i0    , fr2_i0    , cl_grid, jpl  )
+               &                      fr1_i0    , fr2_i0    , cp_ice_msh, jpl  )
             !         
          CASE( 4 )                                       ! CORE bulk formulation
@@ -150,5 +147,5 @@
                &                      qla_ice   , dqns_ice  , dqla_ice  ,               &
                &                      tprecip   , sprecip   ,                           &
-               &                      fr1_i0    , fr2_i0    , cl_grid, jpl  )
+               &                      fr1_i0    , fr2_i0    , cp_ice_msh, jpl  )
          END SELECT
 
@@ -161,34 +158,34 @@
          !                                           ! Store previous ice values
 !!gm : remark   old_...   should becomes ...b  as tn versus tb  
-         old_a_i(:,:,:)   = a_i(:,:,:)     ! ice area
-         old_e_i(:,:,:,:) = e_i(:,:,:,:)   ! ice thermal energy
-         old_v_i(:,:,:)   = v_i(:,:,:)     ! ice volume
-         old_v_s(:,:,:)   = v_s(:,:,:)     ! snow volume 
-         old_e_s(:,:,:,:) = e_s(:,:,:,:)   ! snow thermal energy
-         old_smv_i(:,:,:) = smv_i(:,:,:)   ! salt content
-         old_oa_i(:,:,:)  = oa_i(:,:,:)    ! areal age content
+         old_a_i  (:,:,:)   = a_i  (:,:,:)     ! ice area
+         old_e_i  (:,:,:,:) = e_i  (:,:,:,:)   ! ice thermal energy
+         old_v_i  (:,:,:)   = v_i  (:,:,:)     ! ice volume
+         old_v_s  (:,:,:)   = v_s  (:,:,:)     ! snow volume 
+         old_e_s  (:,:,:,:) = e_s  (:,:,:,:)   ! snow thermal energy
+         old_smv_i(:,:,:)   = smv_i(:,:,:)     ! salt content
+         old_oa_i (:,:,:)   = oa_i (:,:,:)     ! areal age content
 
          !                                           ! intialisation to zero    !!gm is it truly necessary ???
-         d_a_i_thd(:,:,:)   = 0.e0 ; d_a_i_trp(:,:,:)   = 0.e0
-         d_v_i_thd(:,:,:)   = 0.e0 ; d_v_i_trp(:,:,:)   = 0.e0
-         d_e_i_thd(:,:,:,:) = 0.e0 ; d_e_i_trp(:,:,:,:) = 0.e0
-         d_v_s_thd(:,:,:)   = 0.e0 ; d_v_s_trp(:,:,:)   = 0.e0
-         d_e_s_thd(:,:,:,:) = 0.e0 ; d_e_s_trp(:,:,:,:) = 0.e0
-         d_smv_i_thd(:,:,:) = 0.e0 ; d_smv_i_trp(:,:,:) = 0.e0
-         d_oa_i_thd(:,:,:)  = 0.e0 ; d_oa_i_trp(:,:,:)  = 0.e0
-         !
-         fseqv(:,:)     = 0.e0
-         fsbri(:,:)     = 0.e0     ; fsalt_res(:,:) = 0.e0
+         d_a_i_thd  (:,:,:)   = 0.e0   ;   d_a_i_trp  (:,:,:)   = 0.e0
+         d_v_i_thd  (:,:,:)   = 0.e0   ;   d_v_i_trp  (:,:,:)   = 0.e0
+         d_e_i_thd  (:,:,:,:) = 0.e0   ;   d_e_i_trp  (:,:,:,:) = 0.e0
+         d_v_s_thd  (:,:,:)   = 0.e0   ;   d_v_s_trp  (:,:,:)   = 0.e0
+         d_e_s_thd  (:,:,:,:) = 0.e0   ;   d_e_s_trp  (:,:,:,:) = 0.e0
+         d_smv_i_thd(:,:,:)   = 0.e0   ;   d_smv_i_trp(:,:,:)   = 0.e0
+         d_oa_i_thd (:,:,:)   = 0.e0   ;   d_oa_i_trp (:,:,:)   = 0.e0
+         !
+         fseqv    (:,:) = 0.e0
+         fsbri    (:,:) = 0.e0     ;   fsalt_res(:,:) = 0.e0
          fsalt_rpo(:,:) = 0.e0
-         fhmec(:,:)     = 0.e0     ; fhbri(:,:)     = 0.e0
-         fmmec(:,:)     = 0.e0     ; fheat_res(:,:) = 0.e0
-         fheat_rpo(:,:) = 0.e0     ; focea2D(:,:)   = 0.e0
-         fsup2D(:,:)    = 0.e0
+         fhmec    (:,:) = 0.e0     ;   fhbri    (:,:) = 0.e0
+         fmmec    (:,:) = 0.e0     ;   fheat_res(:,:) = 0.e0
+         fheat_rpo(:,:) = 0.e0     ;   focea2D  (:,:) = 0.e0
+         fsup2D   (:,:) = 0.e0
          ! 
-         diag_sni_gr(:,:) = 0.e0   ; diag_lat_gr(:,:) = 0.e0
-         diag_bot_gr(:,:) = 0.e0   ; diag_dyn_gr(:,:) = 0.e0
-         diag_bot_me(:,:) = 0.e0   ; diag_sur_me(:,:) = 0.e0
+         diag_sni_gr(:,:) = 0.e0   ;   diag_lat_gr(:,:) = 0.e0
+         diag_bot_gr(:,:) = 0.e0   ;   diag_dyn_gr(:,:) = 0.e0
+         diag_bot_me(:,:) = 0.e0   ;   diag_sur_me(:,:) = 0.e0
          ! dynamical invariants
-         delta_i(:,:) = 0.e0       ; divu_i (:,:) = 0.e0       ;    shear_i(:,:) = 0.e0
+         delta_i(:,:) = 0.e0       ;   divu_i(:,:) = 0.e0       ;   shear_i(:,:) = 0.e0
 
                           CALL lim_rst_opn( kt )     ! Open Ice restart file
@@ -196,5 +193,6 @@
          IF( ln_nicep )   CALL lim_prt_state( jiindx, jjindx, 1, ' - Beginning the time step - ' )   ! control print
          !
-         IF( .NOT. lk_c1d ) THEN                     ! Ice dynamics & transport (not in 1D case)
+         IF( .NOT. lk_c1d ) THEN
+                                                     ! Ice dynamics & transport (not in 1D case)
                           CALL lim_dyn( kt )              ! Ice dynamics    ( rheology/dynamics )
                           CALL lim_trp( kt )              ! Ice transport   ( Advection/diffusion )
@@ -204,5 +202,4 @@
                           CALL lim_itd_me                 ! Mechanical redistribution ! (ridging/rafting)
          ENDIF
-         !
          !                                           ! Ice thermodynamics 
                           CALL lim_var_glo2eqv            ! equivalent variables
@@ -216,5 +213,5 @@
                           CALL lim_itd_th( kt )           !  Remap ice categories, lateral accretion  !
          !
-         !                                           ! Global variables update |
+         !                                           ! Global variables update
                           CALL lim_var_agg( 1 )           ! requested by limupdate
                           CALL lim_update                 ! Global variables update
@@ -223,8 +220,5 @@
          IF( ln_nicep )   CALL lim_prt_state( jiindx, jjindx, 2, ' - Final state - ' )   ! control print
          !
-         !                                           ! Fluxes of mass and heat to the ocean |
-                         CALL lim_sbc_flx( kt )           ! Ice/Ocean heat freshwater/salt fluxes
-         IF( ln_limdyn .AND. kico == 0 )   &              ! Ice/Ocean stresses (only in ice-dynamic case)
-            &            CALL lim_sbc_tau( kt, kico )     ! otherwise the atm.-ocean stresses are used everywhere
+                          CALL lim_sbc_flx( kt )     ! Update surface ocean mass, heat and salt fluxes
          !
          IF( ln_nicep )   CALL lim_prt_state( jiindx, jjindx, 3, ' - Final state lim_sbc - ' )   ! control print
@@ -239,12 +233,15 @@
          IF( ln_nicep )   CALL lim_ctl               ! alerts in case of model crash
          !
-      ENDIF                                          ! End sea-ice time step only
-
-      !                                              !--------------------------!
-      ! Ice/Ocean stresses (nn_ico_cpl=1 or 2 cases) !  at all ocean time step  !
-      !                                              !--------------------------!
-      IF( ln_limdyn .AND. kico /= 0 )   &
-         &                CALL lim_sbc_tau( kt, kico ) 
-!!gm   remark, in this case the ocean-ice stress is not saved in diag call above .....  find a solution!!!
+      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
+      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!!!
       !
    END SUBROUTINE sbc_ice_lim
@@ -664,6 +661,6 @@
    !!----------------------------------------------------------------------
 CONTAINS
-   SUBROUTINE sbc_ice_lim ( kt, kblk, kico )     ! Dummy routine
-      WRITE(*,*) 'sbc_ice_lim: You should not have seen this print! error?', kt, kblk, kico
+   SUBROUTINE sbc_ice_lim ( kt, kblk )     ! Dummy routine
+      WRITE(*,*) 'sbc_ice_lim: You should not have seen this print! error?', kt, kblk
    END SUBROUTINE sbc_ice_lim
 #endif
Index: trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90	(revision 2528)
@@ -2,22 +2,19 @@
    !!======================================================================
    !!                       ***  MODULE  sbcice_lim_2  ***
-   !! Surface module :  update surface ocean boundary condition over ice
-   !!                   covered area using LIM sea-ice model
-   !! Sea-Ice model  :  LIM 2.0 Sea ice model time-stepping
+   !! Surface module :  update surface ocean boundary condition over ice covered area using LIM sea-ice model
+   !! Sea-Ice model  :  LIM-2 Sea ice model time-stepping
    !!======================================================================
    !! History :  1.0   !  06-2006  (G. Madec)  from icestp_2.F90
    !!            3.0   !  08-2008  (S. Masson, E. .... ) coupled interface
+   !!            3.3   !  05-2009  (G.Garric) addition of the lim2_evp case
    !!----------------------------------------------------------------------
 #if defined key_lim2
    !!----------------------------------------------------------------------
-   !!   'key_lim2' :                                  LIM 2.0 sea-ice model
-   !!----------------------------------------------------------------------
-   !!   sbc_ice_lim_2  : sea-ice model time-stepping and
-   !!                    update ocean sbc over ice-covered area
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers
-   USE c1d             ! 1d configuration
-   USE dom_oce         ! ocean space and time domain
-   USE lib_mpp
+   !!   'key_lim2' :                                    LIM-2 sea-ice model
+   !!----------------------------------------------------------------------
+   !!   sbc_ice_lim_2   : sea-ice model time-stepping and update ocean sbc over ice-covered area
+   !!----------------------------------------------------------------------
+   USE oce              ! ocean dynamics and tracers
+   USE dom_oce          ! ocean space and time domain
    USE ice_2
    USE par_ice_2
@@ -25,26 +22,29 @@
    USE dom_ice_2
 
-   USE sbc_oce         ! Surface boundary condition: ocean fields
-   USE sbc_ice         ! Surface boundary condition: ice   fields
-   USE sbcblk_core     ! Surface boundary condition: CORE bulk
-   USE sbcblk_clio     ! Surface boundary condition: CLIO bulk
-   USE sbccpl          ! Surface boundary condition: coupled interface
+   USE sbc_oce          ! Surface boundary condition: ocean fields
+   USE sbc_ice          ! Surface boundary condition: ice   fields
+   USE sbcblk_core      ! Surface boundary condition: CORE bulk
+   USE sbcblk_clio      ! Surface boundary condition: CLIO bulk
+   USE sbccpl           ! Surface boundary condition: coupled interface
    USE albedo
 
-   USE phycst          ! Define parameters for the routines
-   USE eosbn2          ! equation of state
+   USE phycst           ! Define parameters for the routines
+   USE eosbn2           ! equation of state
    USE limdyn_2
    USE limtrp_2
    USE limdmp_2
    USE limthd_2
-   USE limsbc_2        ! sea surface boundary condition
+   USE limsbc_2         ! sea surface boundary condition
    USE limdia_2
    USE limwri_2
    USE limrst_2
 
-   USE lbclnk
-   USE iom             ! I/O manager library
-   USE in_out_manager  ! I/O manager
-   USE prtctl          ! Print control
+   USE c1d              ! 1D vertical configuration
+
+   USE lbclnk           ! lateral boundary condition - MPP link
+   USE lib_mpp          ! MPP library
+   USE iom              ! I/O manager library
+   USE in_out_manager   ! I/O manager
+   USE prtctl           ! Print control
 
    IMPLICIT NONE
@@ -52,6 +52,4 @@
 
    PUBLIC sbc_ice_lim_2 ! routine called by sbcmod.F90
-   
-   CHARACTER(len=1) ::   cl_grid = 'B'     ! type of grid used in ice dynamics
 
    !! * Substitutions
@@ -59,9 +57,8 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/SBC  3.0 , LOCEAN-IPSL (2008) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
@@ -99,21 +96,30 @@
          IF(lwp) WRITE(numout,*) 'sbc_ice_lim_2 : update ocean surface boudary condition' 
          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~   via Louvain la Neuve Ice Model (LIM) time stepping'
-
+         !
          CALL ice_init_2
-
       ENDIF
 
-      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN
-         !
+      !                                        !----------------------!
+      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !  Ice time-step only  !
+         !                                     !----------------------!
+         !  Bulk Formulea !
+         !----------------!
          ! ... mean surface ocean current at ice dynamics point
-         !     B-grid dynamics :  I-point 
-         DO jj = 2, jpj
-            DO ji = 2, jpi   ! B grid : no vector opt.
-               u_oce(ji,jj) = 0.5 * ( ssu_m(ji-1,jj  ) + ssu_m(ji-1,jj-1) ) * tmu(ji,jj)
-               v_oce(ji,jj) = 0.5 * ( ssv_m(ji  ,jj-1) + ssv_m(ji-1,jj-1) ) * tmu(ji,jj)
+         SELECT CASE( cp_ice_msh )
+         CASE( 'I' )                  !== B-grid ice dynamics :   I-point (i.e. F-point with sea-ice indexation)
+            DO jj = 2, jpj
+               DO ji = 2, jpi   ! NO vector opt. possible
+                  u_oce(ji,jj) = 0.5_wp * ( ssu_m(ji-1,jj  ) + ssu_m(ji-1,jj-1) ) * tmu(ji,jj)
+                  v_oce(ji,jj) = 0.5_wp * ( ssv_m(ji  ,jj-1) + ssv_m(ji-1,jj-1) ) * tmu(ji,jj)
+               END DO
             END DO
-         END DO
-         CALL lbc_lnk( u_oce, 'I', -1. )   ! I-point (i.e. F-point with ice indices)
-         CALL lbc_lnk( v_oce, 'I', -1. )   ! I-point (i.e. F-point with ice indices)
+            CALL lbc_lnk( u_oce, 'I', -1. )   ! I-point (i.e. F-point with ice indices)
+            CALL lbc_lnk( v_oce, 'I', -1. )   ! I-point (i.e. F-point with ice indices)
+            !
+         CASE( 'C' )                  !== C-grid ice dynamics :   U & V-points (same as ocean)
+            u_oce(:,:) = ssu_m(:,:)                     ! mean surface ocean current at ice velocity point
+            v_oce(:,:) = ssv_m(:,:)
+            !
+         END SELECT
 
          ! ... masked sea surface freezing temperature [Kelvin] (set to rt0 over land)
@@ -144,5 +150,5 @@
                &                      qla_ice    , dqns_ice   , dqla_ice   ,            &
                &                      tprecip    , sprecip    ,                         &
-               &                      fr1_i0     , fr2_i0     , cl_grid    , jpl  )
+               &                      fr1_i0     , fr2_i0     , cp_ice_msh , jpl  )
 
          CASE( 4 )           ! CORE bulk formulation
@@ -151,5 +157,5 @@
                &                      qla_ice    , dqns_ice   , dqla_ice   ,            &
                &                      tprecip    , sprecip    ,                         &
-               &                      fr1_i0     , fr2_i0     , cl_grid    , jpl  )
+               &                      fr1_i0     , fr2_i0     , cp_ice_msh , jpl  )
          CASE( 5 )           ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics)
             CALL sbc_cpl_ice_tau( utau_ice , vtau_ice )
@@ -172,29 +178,39 @@
          !  Ice model step  !
          ! ---------------- !
-
-                                        CALL lim_rst_opn_2  ( kt )      ! Open Ice restart file
-         IF( .NOT. lk_c1d ) THEN                                        ! Ice dynamics & transport (not in 1D case)
-                                        CALL lim_dyn_2      ( kt )           ! Ice dynamics    ( rheology/dynamics )
-                                        CALL lim_trp_2      ( kt )           ! Ice transport   ( Advection/diffusion )
-            IF( ln_limdmp )             CALL lim_dmp_2      ( kt )           ! Ice damping 
-         ENDIF
+         numit = numit + nn_fsbc                           ! Ice model time step
+
+                           CALL lim_rst_opn_2  ( kt )  ! Open Ice restart file
+         IF( .NOT. lk_c1d ) THEN                       ! Ice dynamics & transport (except in 1D case)
+                           CALL lim_dyn_2      ( kt )      ! Ice dynamics    ( rheology/dynamics )
+                           CALL lim_trp_2      ( kt )      ! Ice transport   ( Advection/diffusion )
+           IF( ln_limdmp ) CALL lim_dmp_2      ( kt )      ! Ice damping 
+         END IF
 #if defined key_coupled
-         IF( ksbc == 5    )             CALL sbc_cpl_ice_flx( reshape( frld, (/jpi,jpj,1/) ),        &
-      &                                                       qns_tot, qns_ice, qsr_tot , qsr_ice,   &
-      &                                                       emp_tot, emp_ice, dqns_ice, sprecip,   &
+         !                                             ! Ice surface fluxes in coupled mode 
+         IF( ksbc == 5 )   CALL sbc_cpl_ice_flx( reshape( frld, (/jpi,jpj,1/) ),                 &
+      &                                                   qns_tot, qns_ice, qsr_tot , qsr_ice,   &
+      &                                                   emp_tot, emp_ice, dqns_ice, sprecip,   &
       !                                      optional arguments, used only in 'mixed oce-ice' case
-      &                                                       palbi = zalb_ice_cs, psst = sst_m, pist = sist )
+      &                                                   palbi = zalb_ice_cs, psst = sst_m, pist = sist )
 #endif
-                                        CALL lim_thd_2      ( kt )      ! Ice thermodynamics 
-                                        CALL lim_sbc_2      ( kt )      ! Ice/Ocean Mass & Heat fluxes 
+                           CALL lim_thd_2      ( kt )      ! Ice thermodynamics 
+                           CALL lim_sbc_flx_2  ( kt )      ! update surface ocean mass, heat & salt fluxes 
 
          IF( ( MOD( kt+nn_fsbc-1, ninfo ) == 0 .OR. ntmoy == 1 ) .AND. .NOT. lk_mpp )   &
-            &                           CALL lim_dia_2      ( kt )      ! Ice Diagnostics
+            &              CALL lim_dia_2      ( kt )      ! Ice Diagnostics
 # if ! defined key_iomput
-                                        CALL lim_wri_2      ( kt )      ! Ice outputs
+                           CALL lim_wri_2      ( kt )      ! Ice outputs
 # endif
-         IF( lrst_ice )                 CALL lim_rst_write_2( kt )      ! Ice restart file
+         IF( lrst_ice  )   CALL lim_rst_write_2( kt )      ! Ice restart file
          !
-      ENDIF
+      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
+      IF( ln_limdyn    )   CALL lim_sbc_tau_2( kt, ub(:,:,1), vb(:,:,1) )  ! using before instantaneous surf. currents
       !
    END SUBROUTINE sbc_ice_lim_2
Index: trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90	(revision 2528)
@@ -4,6 +4,11 @@
    !! Surface module :  provide to the ocean its surface boundary condition
    !!======================================================================
-   !! History :  3.0   !  07-2006  (G. Madec)  Original code
-   !!             -    !  08-2008  (S. Masson, E. .... ) coupled interface
+   !! History :  3.0  ! 2006-07  (G. Madec)  Original code
+   !!            3.1  ! 2008-08  (S. Masson, A. Caubel, E. Maisonnave, G. Madec) coupled interface
+   !!            3.3  ! 2010-04  (M. Leclair, G. Madec)  Forcing averaged over 2 time steps
+   !!            3.3  ! 2010-10  (S. Masson)  add diurnal cycle
+   !!            3.3  ! 2010-09  (D. Storkey) add ice boundary conditions (BDY)
+   !!             -   ! 2010-11  (G. Madec) ice-ocean stress always computed at each ocean time-step
+   !!             -   ! 2010-10  (J. Chanut, C. Bricaud, G. Madec)  add the surface pressure forcing
    !!----------------------------------------------------------------------
 
@@ -12,29 +17,32 @@
    !!   sbc            : surface ocean momentum, heat and freshwater boundary conditions
    !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers
-   USE dom_oce         ! ocean space and time domain
-   USE phycst          ! physical constants
-
-   USE sbc_oce         ! Surface boundary condition: ocean fields
-   USE sbc_ice         ! Surface boundary condition: ice fields
-   USE sbcssm          ! surface boundary condition: sea-surface mean variables
-   USE sbcana          ! surface boundary condition: analytical formulation
-   USE sbcflx          ! surface boundary condition: flux formulation
-   USE sbcblk_clio     ! surface boundary condition: bulk formulation : CLIO
-   USE sbcblk_core     ! surface boundary condition: bulk formulation : CORE
-   USE sbcice_if       ! surface boundary condition: ice-if sea-ice model
-   USE sbcice_lim      ! surface boundary condition: LIM 3.0 sea-ice model
-   USE sbcice_lim_2    ! surface boundary condition: LIM 2.0 sea-ice model
-   USE sbccpl          ! surface boundary condition: coupled florulation
+   USE oce              ! ocean dynamics and tracers
+   USE dom_oce          ! ocean space and time domain
+   USE phycst           ! physical constants
+   USE sbc_oce          ! Surface boundary condition: ocean fields
+   USE sbc_ice          ! Surface boundary condition: ice fields
+   USE sbcdcy           ! surface boundary condition: diurnal cycle
+   USE sbcssm           ! surface boundary condition: sea-surface mean variables
+   USE sbcapr           ! surface boundary condition: atmospheric pressure
+   USE sbcana           ! surface boundary condition: analytical formulation
+   USE sbcflx           ! surface boundary condition: flux formulation
+   USE sbcblk_clio      ! surface boundary condition: bulk formulation : CLIO
+   USE sbcblk_core      ! surface boundary condition: bulk formulation : CORE
+   USE sbcice_if        ! surface boundary condition: ice-if sea-ice model
+   USE sbcice_lim       ! surface boundary condition: LIM 3.0 sea-ice model
+   USE sbcice_lim_2     ! surface boundary condition: LIM 2.0 sea-ice model
+   USE sbccpl           ! surface boundary condition: coupled florulation
    USE cpl_oasis3, ONLY:lk_cpl      ! are we in coupled mode?
-   USE sbcssr          ! surface boundary condition: sea surface restoring
-   USE sbcrnf          ! surface boundary condition: runoffs
-   USE sbcfwb          ! surface boundary condition: freshwater budget
-   USE closea          ! closed sea
-
-   USE prtctl          ! Print control                    (prt_ctl routine)
-   USE restart         ! ocean restart
-   USE iom
-   USE in_out_manager  ! I/O manager
+   USE sbcssr           ! surface boundary condition: sea surface restoring
+   USE sbcrnf           ! surface boundary condition: runoffs
+   USE sbcfwb           ! surface boundary condition: freshwater budget
+   USE closea           ! closed sea
+   USE bdy_par         ! unstructured open boundary data variables
+   USE bdyice          ! unstructured open boundary data  (bdy_ice_frs routine)
+
+   USE prtctl           ! Print control                    (prt_ctl routine)
+   USE restart          ! ocean restart
+   USE iom              ! IOM library
+   USE in_out_manager   ! I/O manager
 
    IMPLICIT NONE
@@ -49,9 +57,8 @@
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
+   !! NEMO/OPA 3.3 , NEMO-consortium (2010) 
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
@@ -69,6 +76,6 @@
       INTEGER ::   icpt      ! temporary integer
       !!
-      NAMELIST/namsbc/ nn_fsbc, ln_ana, ln_flx, ln_blk_clio, ln_blk_core, ln_cpl,   &
-         &             nn_ice , ln_dm2dc, ln_rnf, ln_ssr, nn_fwb, nn_ico_cpl
+      NAMELIST/namsbc/ nn_fsbc, ln_ana  , ln_flx, ln_blk_clio, ln_blk_core, ln_cpl    ,   &
+         &             ln_apr_dyn, nn_ice , ln_dm2dc, ln_rnf, ln_ssr     , nn_fwb
       !!----------------------------------------------------------------------
 
@@ -79,23 +86,18 @@
       ENDIF
 
-      REWIND( numnam )                   ! Read Namelist namsbc
+      REWIND( numnam )           ! Read Namelist namsbc
       READ  ( numnam, namsbc )
 
-      ! overwrite namelist parameter using CPP key information
-!!gm here no overwrite, test all option via namelist change: require more incore memory
-!!gm  IF( lk_sbc_cpl       ) THEN   ;   ln_cpl      = .TRUE.   ;   ELSE   ;   ln_cpl      = .FALSE.   ;   ENDIF
-
-      IF ( Agrif_Root() ) THEN
-        IF( lk_lim2 )            nn_ice      = 2
-        IF( lk_lim3 )            nn_ice      = 3
-      ENDIF
-      !
-      IF( cp_cfg == 'gyre' ) THEN
+      !                          ! overwrite namelist parameter using CPP key information
+      IF( Agrif_Root() ) THEN                ! AGRIF zoom
+        IF( lk_lim2 )   nn_ice      = 2
+        IF( lk_lim3 )   nn_ice      = 3
+      ENDIF
+      IF( cp_cfg == 'gyre' ) THEN            ! GYRE configuration
           ln_ana      = .TRUE.   
           nn_ice      =   0
       ENDIF
       
-      ! Control print
-      IF(lwp) THEN
+      IF(lwp) THEN               ! Control print
          WRITE(numout,*) '        Namelist namsbc (partly overwritten with CPP key setting)'
          WRITE(numout,*) '           frequency update of sbc (and ice)             nn_fsbc     = ', nn_fsbc
@@ -107,6 +109,6 @@
          WRITE(numout,*) '              coupled    formulation (T if key_sbc_cpl)  ln_cpl      = ', ln_cpl
          WRITE(numout,*) '           Misc. options of sbc : '
+         WRITE(numout,*) '              Patm gradient added in ocean & ice Eqs.    ln_apr_dyn  = ', ln_apr_dyn
          WRITE(numout,*) '              ice management in the sbc (=0/1/2/3)       nn_ice      = ', nn_ice 
-         WRITE(numout,*) '              ice-ocean stress computation (=0/1/2)      nn_ico_cpl  = ', nn_ico_cpl
          WRITE(numout,*) '              daily mean to diurnal cycle qsr            ln_dm2dc    = ', ln_dm2dc 
          WRITE(numout,*) '              runoff / runoff mouths                     ln_rnf      = ', ln_rnf
@@ -116,7 +118,9 @@
       ENDIF
 
+      !                          ! Checks:
       IF( .NOT. ln_rnf ) THEN                      ! no specific treatment in vicinity of river mouths 
          ln_rnf_mouth  = .false.                      
          nkrnf         = 0
+         rnf     (:,:) = 0.e0
          rnfmsk  (:,:) = 0.e0
          rnfmsk_z(:)   = 0.e0
@@ -138,5 +142,13 @@
          &   CALL ctl_stop( 'sea-ice model requires a bulk formulation or coupled configuration' )
       
-      ! Choice of the Surface Boudary Condition (set nsbc)
+      IF( ln_dm2dc )   nday_qsr = -1   ! initialisation flag
+
+      IF( ln_dm2dc .AND. .NOT.( ln_flx .OR. ln_blk_core ) )   &
+         &   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...' )
+      
+      !                          ! Choice of the Surface Boudary Condition (set nsbc)
       icpt = 0
       IF( ln_ana          ) THEN   ;   nsbc =  1   ; icpt = icpt + 1   ;   ENDIF       ! analytical      formulation
@@ -147,5 +159,5 @@
       IF( cp_cfg == 'gyre') THEN   ;   nsbc =  0                       ;   ENDIF       ! GYRE analytical formulation
       IF( lk_esopa        )            nsbc = -1                                       ! esopa test, ALL formulations
-
+      !
       IF( icpt /= 1 .AND. .NOT.lk_esopa ) THEN
          WRITE(numout,*)
@@ -179,6 +191,8 @@
       !!                CAUTION : never mask the surface stress field (tke sbc)
       !!
-      !! ** Action  : - set the ocean surface boundary condition, i.e.  
-      !!                utau, vtau, qns, qsr, emp, emps, qrp, erp
+      !! ** Action  : - set the ocean surface boundary condition at before and now 
+      !!                time step, i.e.  
+      !!                utau_b, vtau_b, qns_b, qsr_b, emp_n, emps_b, qrp_b, erp_b
+      !!                utau  , vtau  , qns  , qsr  , emp  , emps  , qrp  , erp
       !!              - updte the ice fraction : fr_i
       !!----------------------------------------------------------------------
@@ -186,17 +200,31 @@
       !!---------------------------------------------------------------------
 
-      CALL iom_setkt( kt + nn_fsbc - 1 )         !  in sbc, iom_put is called every nn_fsbc time step
-      !
-      ! ocean to sbc mean sea surface variables (ss._m)
-      ! ---------------------------------------
-      CALL sbc_ssm( kt )                         ! sea surface mean currents (at U- and V-points), 
-      !                                          ! temperature and salinity (at T-point) over nf_sbc time-step
-      !                                          ! (i.e. sst_m, sss_m, ssu_m, ssv_m)
-
-      ! sbc formulation
-      ! ---------------
-         
-      SELECT CASE( nsbc )                        ! Compute ocean surface boundary condition
-      !                                          ! (i.e. utau,vtau, qns, qsr, emp, emps)
+      !                                            ! ---------------------------------------- !
+      IF( kt /= nit000 ) THEN                      !          Swap of forcing fields          !
+         !                                         ! ---------------------------------------- !
+         utau_b(:,:) = utau(:,:)                         ! Swap the ocean forcing fields
+         vtau_b(:,:) = vtau(:,:)                         ! (except at nit000 where before fields
+         qns_b (:,:) = qns (:,:)                         !  are set at the end of the routine)
+         ! The 3D heat content due to qsr forcing is treated in traqsr
+         ! qsr_b (:,:) = qsr (:,:)
+         emp_b (:,:) = emp (:,:)
+         emps_b(:,:) = emps(:,:)
+      ENDIF
+      !                                            ! ---------------------------------------- !
+      !                                            !        forcing field computation         !
+      !                                            ! ---------------------------------------- !
+
+      CALL iom_setkt( kt + nn_fsbc - 1 )                 ! in sbc, iom_put is called every nn_fsbc time step
+      !
+      IF( ln_apr_dyn ) CALL sbc_apr( kt )                ! atmospheric pressure provided at kt+0.5*nn_fsbc
+                                                         ! (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
+
+                                                   !==  sbc formulation  ==!
+                                                            
+      SELECT CASE( nsbc )                                ! Compute ocean surface boundary condition
+      !                                                  ! (i.e. utau,vtau, qns, qsr, emp, emps)
       CASE(  0 )   ;   CALL sbc_gyre    ( kt )                    ! analytical formulation : GYRE configuration
       CASE(  1 )   ;   CALL sbc_ana     ( kt )                    ! analytical formulation : uniform sbc
@@ -214,15 +242,13 @@
       END SELECT
 
-      ! Misc. Options
-      ! -------------
-
-!!gm  IF( ln_dm2dc       )   CALL sbc_dcy( kt )                 ! Daily mean qsr distributed over the Diurnal Cycle
+      !                                            !==  Misc. Options  ==!
       
       SELECT CASE( nn_ice )                                     ! Update heat and freshwater fluxes over sea-ice areas
-      CASE(  1 )   ;       CALL sbc_ice_if   ( kt )                   ! Ice-cover climatology ("Ice-if" model)
+      CASE(  1 )   ;       CALL sbc_ice_if   ( kt )                  ! Ice-cover climatology ("Ice-if" model)
          !                                                      
-      CASE(  2 )   ;       CALL sbc_ice_lim_2( kt, nsbc )             ! LIM 2.0 ice model
+      CASE(  2 )   ;       CALL sbc_ice_lim_2( kt, nsbc )            ! LIM-2 ice model
+         IF( lk_bdy )      CALL bdy_ice_frs  ( kt )                  ! BDY boundary condition
          !                                                     
-      CASE(  3 )   ;       CALL sbc_ice_lim  ( kt, nsbc, nn_ico_cpl)  ! LIM 3.0 ice model
+      CASE(  3 )   ;       CALL sbc_ice_lim  ( kt, nsbc )            ! LIM-3 ice model
       END SELECT                                              
 
@@ -235,15 +261,55 @@
       IF( nclosea == 1 )   CALL sbc_clo( kt )                   ! treatment of closed sea in the model domain 
       !                                                         ! (update freshwater fluxes)
-      !
 !RBbug do not understand why see ticket 667
-      CALL lbc_lnk( emp, 'T', 1. )  
-      !
+      CALL lbc_lnk( emp, 'T', 1. )
+      !
+      IF( kt == nit000 ) THEN                          !   set the forcing field at nit000 - 1    !
+         !                                             ! ---------------------------------------- !
+         IF( ln_rstart .AND.    &                               !* Restart: read in restart file
+            & iom_varid( numror, 'utau_b', ldstop = .FALSE. ) > 0 ) THEN 
+            IF(lwp) WRITE(numout,*) '          nit000-1 surface forcing fields red in the restart file'
+            CALL iom_get( numror, jpdom_autoglo, 'utau_b', utau_b )   ! before i-stress  (U-point)
+            CALL iom_get( numror, jpdom_autoglo, 'vtau_b', vtau_b )   ! before j-stress  (V-point)
+            CALL iom_get( numror, jpdom_autoglo, 'qns_b' , qns_b  )   ! before non solar heat flux (T-point)
+            ! The 3D heat content due to qsr forcing is treated in traqsr
+            ! CALL iom_get( numror, jpdom_autoglo, 'qsr_b' , qsr_b  )   ! before     solar heat flux (T-point)
+            CALL iom_get( numror, jpdom_autoglo, 'emp_b' , emp_b  )   ! before     freshwater flux (T-point)
+            CALL iom_get( numror, jpdom_autoglo, 'emps_b', emps_b )   ! before C/D freshwater flux (T-point)
+         ELSE                                                   !* no restart: set from nit000 values
+            IF(lwp) WRITE(numout,*) '          nit000-1 surface forcing fields set to nit000'
+            utau_b(:,:) = utau(:,:) 
+            vtau_b(:,:) = vtau(:,:)
+            qns_b (:,:) = qns (:,:)
+            ! qsr_b (:,:) = qsr (:,:)
+            emp_b (:,:) = emp (:,:)
+            emps_b(:,:) = emps(:,:)
+         ENDIF
+      ENDIF
+      !                                                ! ---------------------------------------- !
+      IF( lrst_oce ) THEN                              !      Write in the ocean restart file     !
+         !                                             ! ---------------------------------------- !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'sbc : ocean surface forcing fields written in ocean restart file ',   &
+            &                    'at it= ', kt,' date= ', ndastp
+         IF(lwp) WRITE(numout,*) '~~~~'
+         CALL iom_rstput( kt, nitrst, numrow, 'utau_b' , utau )
+         CALL iom_rstput( kt, nitrst, numrow, 'vtau_b' , vtau )
+         CALL iom_rstput( kt, nitrst, numrow, 'qns_b'  , qns  )
+         ! The 3D heat content due to qsr forcing is treated in traqsr
+         ! CALL iom_rstput( kt, nitrst, numrow, 'qsr_b'  , qsr  )
+         CALL iom_rstput( kt, nitrst, numrow, 'emp_b'  , emp  )
+         CALL iom_rstput( kt, nitrst, numrow, 'emps_b' , emps )
+      ENDIF
+
+      !                                                ! ---------------------------------------- !
+      !                                                !        Outputs and control print         !
+      !                                                ! ---------------------------------------- !
       IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN
-         CALL iom_put( "emp"    , emp       )                   ! upward water flux
-         CALL iom_put( "emps"   , emps      )                   ! c/d water flux
-         CALL iom_put( "qns+qsr", qns + qsr )                   ! total heat flux   (caution if ln_dm2dc=true, to be 
-         CALL iom_put( "qns"    , qns       )                   ! solar heat flux    moved after the call to iom_setkt)
-         CALL iom_put( "qsr"    ,       qsr )                   ! solar heat flux    moved after the call to iom_setkt)
-         IF(  nn_ice > 0 )   CALL iom_put( "ice_cover", fr_i )  ! ice fraction 
+         CALL iom_put( "emp-rnf" , emp  - rnf )                   ! upward water flux
+         CALL iom_put( "emps-rnf", emps - rnf )                   ! c/d water flux
+         CALL iom_put( "qns+qsr" , qns  + qsr )                   ! total heat flux 
+         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 
       ENDIF
       !
@@ -256,14 +322,14 @@
       !
       IF(ln_ctl) THEN         ! print mean trends (used for debugging)
-         CALL prt_ctl(tab2d_1=fr_i   , clinfo1=' fr_i - : ', mask1=tmask, ovlap=1 )
-         CALL prt_ctl(tab2d_1=emp    , clinfo1=' emp  - : ', mask1=tmask, ovlap=1 )
-         CALL prt_ctl(tab2d_1=emps   , clinfo1=' emps - : ', mask1=tmask, ovlap=1 )
-         CALL prt_ctl(tab2d_1=qns    , clinfo1=' qns  - : ', mask1=tmask, ovlap=1 )
-         CALL prt_ctl(tab2d_1=qsr    , clinfo1=' qsr  - : ', mask1=tmask, ovlap=1 )
-         CALL prt_ctl(tab3d_1=tmask  , clinfo1=' tmask  : ', mask1=tmask, ovlap=1, kdim=jpk )
-         CALL prt_ctl(tab3d_1=tn     , clinfo1=' sst  - : ', mask1=tmask, ovlap=1, kdim=1   )
-         CALL prt_ctl(tab3d_1=sn     , clinfo1=' sss  - : ', mask1=tmask, ovlap=1, kdim=1   )
-         CALL prt_ctl(tab2d_1=utau   , clinfo1=' utau - : ', mask1=umask,                      &
-            &         tab2d_2=vtau   , clinfo2=' vtau - : ', mask2=vmask, ovlap=1 )
+         CALL prt_ctl(tab2d_1=fr_i      , clinfo1=' fr_i     - : ', mask1=tmask, ovlap=1 )
+         CALL prt_ctl(tab2d_1=(emp-rnf) , clinfo1=' emp-rnf  - : ', mask1=tmask, ovlap=1 )
+         CALL prt_ctl(tab2d_1=(emps-rnf), clinfo1=' emps-rnf - : ', mask1=tmask, ovlap=1 )
+         CALL prt_ctl(tab2d_1=qns       , clinfo1=' qns      - : ', mask1=tmask, ovlap=1 )
+         CALL prt_ctl(tab2d_1=qsr       , clinfo1=' qsr      - : ', mask1=tmask, ovlap=1 )
+         CALL prt_ctl(tab3d_1=tmask     , clinfo1=' tmask    - : ', mask1=tmask, ovlap=1, kdim=jpk )
+         CALL prt_ctl(tab3d_1=tn        , clinfo1=' sst      - : ', mask1=tmask, ovlap=1, kdim=1   )
+         CALL prt_ctl(tab3d_1=sn        , clinfo1=' sss      - : ', mask1=tmask, ovlap=1, kdim=1   )
+         CALL prt_ctl(tab2d_1=utau      , clinfo1=' utau     - : ', mask1=umask,                      &
+            &         tab2d_2=vtau      , clinfo2=' vtau     - : ', mask2=vmask, ovlap=1 )
       ENDIF
       !
Index: trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90	(revision 2528)
@@ -4,8 +4,9 @@
    !! Ocean forcing:  river runoff
    !!=====================================================================
-   !! History :  OPA  !  2000-11  (R. Hordoir, E. Durand)  NetCDF FORMAT
-   !!   NEMO     1.0  !  2002-09  (G. Madec)  F90: Free form and module
-   !!            3.0  !  2006-07  (G. Madec)  Surface module 
-   !!            3.2  !  2009-04  (B. Lemaire)  Introduce iom_put
+   !! History :  OPA  ! 2000-11  (R. Hordoir, E. Durand)  NetCDF FORMAT
+   !!   NEMO     1.0  ! 2002-09  (G. Madec)  F90: Free form and module
+   !!            3.0  ! 2006-07  (G. Madec)  Surface module 
+   !!            3.2  ! 2009-04  (B. Lemaire)  Introduce iom_put
+   !!            3.3  ! 2010-10  (R. Furner, G. Madec) runoff distributed over ocean levels
    !!----------------------------------------------------------------------
 
@@ -18,35 +19,52 @@
    USE phycst          ! physical constants
    USE sbc_oce         ! surface boundary condition variables
-   USE fldread         ! ???
+   USE fldread         ! read input field at current time step
    USE in_out_manager  ! I/O manager
    USE iom             ! I/O module
+   USE restart         ! restart
+   USE closea          ! closed seas
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC sbc_rnf          ! routine call in step module
-
-   !                                                     !!* namsbc_rnf namelist *
+   PUBLIC   sbc_rnf       ! routine call in sbcmod module
+   PUBLIC   sbc_rnf_div   ! routine called in sshwzv module
+
+   !                                                      !!* namsbc_rnf namelist *
    CHARACTER(len=100), PUBLIC ::   cn_dir       = './'    !: Root directory for location of ssr files
+   LOGICAL           , PUBLIC ::   ln_rnf_depth = .false. !: depth       river runoffs attribute specified in a file
+   LOGICAL           , PUBLIC ::   ln_rnf_tem   = .false. !: temperature river runoffs attribute specified in a file 
+   LOGICAL           , PUBLIC ::   ln_rnf_sal   = .false. !: salinity    river runoffs attribute specified in a file 
    LOGICAL           , PUBLIC ::   ln_rnf_emp   = .false. !: 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_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 = .false. !: specific treatment in mouths vicinity
-   REAL(wp)          , PUBLIC ::   rn_hrnf      = 0.e0    !: runoffs, depth over which enhanced vertical mixing is used
-   REAL(wp)          , PUBLIC ::   rn_avt_rnf   = 0.e0    !: runoffs, value of the additional vertical mixing coef. [m2/s]
-   REAL(wp)          , PUBLIC ::   rn_rfact     = 1.e0    !: multiplicative factor for runoff
-
-   INTEGER , PUBLIC                     ::   nkrnf = 0   !: number of levels over which Kz is increased at river mouths
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rnfmsk      !: river mouth mask (hori.)
-   REAL(wp), PUBLIC, DIMENSION(jpk)     ::   rnfmsk_z    !: river mouth mask (vert.)
-
-   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_rnf   ! structure of input SST (file information, fields read)
-
+   REAL(wp)          , PUBLIC ::   rn_hrnf      = 0._wp   !: runoffs, depth over which enhanced vertical mixing is used
+   REAL(wp)          , PUBLIC ::   rn_avt_rnf   = 0._wp   !: runoffs, value of the additional vertical mixing coef. [m2/s]
+   REAL(wp)          , PUBLIC ::   rn_rfact     = 1._wp   !: multiplicative factor for runoff
+
+   INTEGER , PUBLIC                          ::   nkrnf = 0         !: nb of levels over which Kz is increased at river mouths
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)      ::   rnfmsk            !: river mouth mask (hori.)
+   REAL(wp), PUBLIC, DIMENSION(jpk)          ::   rnfmsk_z          !: river mouth mask (vert.)
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)      ::   h_rnf             !: depth of runoff in m
+   INTEGER,  PUBLIC, DIMENSION(jpi,jpj)      ::   nk_rnf            !: depth of runoff in model levels
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpts) :: rnf_tsc_b, rnf_tsc  !: before and now T & S contents of runoffs  [K.m/s & PSU.m/s]
+   
+   REAL(wp) ::   r1_rau0   ! = 1 / rau0 
+
+   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  
+#  include "domzgr_substitute.h90"  
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -66,17 +84,14 @@
       !!
       INTEGER  ::   ji, jj   ! dummy loop indices
-      INTEGER  ::   ierror   ! temporary integer
       !!----------------------------------------------------------------------
       !                                   
-      IF( kt == nit000 ) THEN  
-         IF( .NOT. ln_rnf_emp ) THEN
-            ALLOCATE( sf_rnf(1), STAT=ierror )
-            IF( ierror > 0 ) THEN
-               CALL ctl_stop( 'sbc_rnf: unable to allocate sf_rnf structure' )   ;   RETURN
-            ENDIF
-            ALLOCATE( sf_rnf(1)%fnow(jpi,jpj) )
-            ALLOCATE( sf_rnf(1)%fdta(jpi,jpj,2) )
-         ENDIF
-         CALL sbc_rnf_init(sf_rnf)
+      IF( kt == nit000 )   CALL sbc_rnf_init                           ! Read namelist and allocate structures
+
+      !                                            ! ---------------------------------------- !
+      IF( kt /= nit000 ) THEN                      !          Swap of forcing fields          !
+         !                                         ! ---------------------------------------- !
+         rnf_b    (:,:  ) = rnf    (:,:  )               ! Swap the ocean forcing fields except at nit000
+         rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:)               ! where before fields are set at the end of the routine
+         !
       ENDIF
 
@@ -85,31 +100,130 @@
          !                                                !-------------------!
          !
-         CALL fld_read( kt, nn_fsbc, sf_rnf )   ! Read Runoffs data and provides it
-         !                                      ! at the current time-step
-
+                             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)
+            END WHERE
+         ENDIF
+         !
+         IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN
+            rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) )  
+            !
+            r1_rau0 = 1._wp / rau0
+            !                                                     ! 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 )                 ! if missing data value use SST as runoffs temperature  
+                   rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0
+               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( ln_rnf_tem .OR. ln_rnf_sal ) THEN                 ! runoffs as outflow: use ocean SST and SSS
+               WHERE( rnf(:,:) < 0._wp )                                 ! example baltic model when flow is out of domain 
+                  rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0
+                  rnf_tsc(:,:,jp_sal) = sss_m(:,:) * rnf(:,:) * r1_rau0
+               END WHERE
+            ENDIF
+            !
+            CALL iom_put( "runoffs", rnf )         ! output runoffs arrays
+         ENDIF
+         !
+      ENDIF
+      !
+      IF( kt == nit000 ) THEN                          !   set the forcing field at nit000 - 1    !
+         !                                             ! ---------------------------------------- !
+         IF( ln_rstart .AND.    &                               !* Restart: read in restart file
+            & iom_varid( numror, 'rnf_b', ldstop = .FALSE. ) > 0 ) THEN 
+            IF(lwp) WRITE(numout,*) '          nit000-1 runoff forcing fields red in the restart file'
+            CALL iom_get( numror, jpdom_autoglo, 'rnf_b', rnf_b )     ! before runoff
+            CALL iom_get( numror, jpdom_autoglo, 'rnf_hc_b', rnf_tsc_b(:,:,jp_tem) )   ! before heat content of runoff
+            CALL iom_get( numror, jpdom_autoglo, 'rnf_sc_b', rnf_tsc_b(:,:,jp_sal) )   ! before salinity content of runoff
+         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(:,:,:)   
+         ENDIF
+      ENDIF
+      !                                                ! ---------------------------------------- !
+      IF( lrst_oce ) THEN                              !      Write in the ocean restart file     !
+         !                                             ! ---------------------------------------- !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'sbcrnf : runoff forcing fields written in ocean restart file ',   &
+            &                    'at it= ', kt,' date= ', ndastp
+         IF(lwp) WRITE(numout,*) '~~~~'
+         CALL iom_rstput( kt, nitrst, numrow, 'rnf_b' , rnf )
+         CALL iom_rstput( kt, nitrst, numrow, 'rnf_hc_b', rnf_tsc(:,:,jp_tem) )
+         CALL iom_rstput( kt, nitrst, numrow, 'rnf_sc_b', rnf_tsc(:,:,jp_sal) )
+      ENDIF
+      !
+   END SUBROUTINE sbc_rnf
+
+
+   SUBROUTINE sbc_rnf_div( phdivn )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sbc_rnf  ***
+      !!       
+      !! ** Purpose :   update the horizontal divergence with the runoff inflow
+      !!
+      !! ** Method  :   
+      !!                CAUTION : rnf is positive (inflow) decreasing the 
+      !!                          divergence and expressed in m/s
+      !!
+      !! ** Action  :   phdivn   decreased by the runoff inflow
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   phdivn   ! horizontal divergence
+      !!
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   r1_rau0   ! local scalar
+      REAL(wp) ::   zfact     ! local scalar
+      !!----------------------------------------------------------------------
+      !
+      zfact = 0.5_wp
+      !
+      r1_rau0 = 1._wp / rau0
+      IF( ln_rnf_depth ) 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
+               DO ji = 1, jpi
+                  h_rnf(ji,jj) = 0._wp 
+                  DO jk = 1, nk_rnf(ji,jj)                           ! recalculates h_rnf to be the depth in metres
+                     h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk)   ! to the bottom of the relevant grid box 
+                  END DO 
+                  !                          ! apply the runoff input flow
+                  DO jk = 1, nk_rnf(ji,jj)
+                     phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rau0 / h_rnf(ji,jj)
+                  END DO
+               END DO
+            END DO
+         ELSE                          ! constant volume case : just apply the runoff input flow
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  IF( gphit(ji,jj) > 40 .AND. gphit(ji,jj) < 65 )   sf_rnf(1)%fnow(ji,jj) = 0.85 * sf_rnf(1)%fnow(ji,jj)
+                  DO jk = 1, nk_rnf(ji,jj)
+                     phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rau0 / h_rnf(ji,jj)
+                  END DO
                END DO
             END DO
          ENDIF
-
-         ! C a u t i o n : runoff is negative and in kg/m2/s 
-
-         IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN
-            emp (:,:) = emp (:,:) - rn_rfact * ABS( sf_rnf(1)%fnow(:,:) )
-            emps(:,:) = emps(:,:) - rn_rfact * ABS( sf_rnf(1)%fnow(:,:) )
-            CALL iom_put( "runoffs", sf_rnf(1)%fnow )         ! runoffs
-         ENDIF
-         !
-      ENDIF
-      !
-   END SUBROUTINE sbc_rnf
-
-
-   SUBROUTINE sbc_rnf_init( sf_rnf )
+      ELSE                       !==   runoff put only at the surface   ==!
+         IF( lk_vvl ) THEN              ! variable volume case
+            h_rnf(:,:) = fse3t(:,:,1)   ! recalculate h_rnf to be depth of top box
+         ENDIF
+         phdivn(:,:,1) = phdivn(:,:,1) - ( rnf(:,:) + rnf_b(:,:) ) * zfact * r1_rau0 / fse3t(:,:,1)
+      ENDIF
+      !
+   END SUBROUTINE sbc_rnf_div
+
+
+   SUBROUTINE sbc_rnf_init
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE sbc_rnf_init  ***
@@ -121,8 +235,11 @@
       !! ** Action  : - read parameters
       !!----------------------------------------------------------------------
-      TYPE(FLD), INTENT(inout), DIMENSION(:) :: sf_rnf   ! input data
-      !!
-      NAMELIST/namsbc_rnf/ cn_dir, ln_rnf_emp, sn_rnf, sn_cnf, ln_rnf_mouth,   &
-         &                 rn_hrnf, rn_avt_rnf, rn_rfact
+      CHARACTER(len=32) ::   rn_dep_file   ! runoff file name  
+      INTEGER           ::   ji, jj, jk    ! dummy loop indices
+      INTEGER           ::   ierror, inum  ! temporary integer
+      !! 
+      NAMELIST/namsbc_rnf/ cn_dir, ln_rnf_emp, 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  
       !!----------------------------------------------------------------------
 
@@ -136,4 +253,7 @@
       sn_cnf = FLD_N( 'runoffs',     0     , 'sorunoff' ,  .FALSE.   , .true. ,   'yearly'  , ''       , ''         )
 
+      sn_s_rnf = FLD_N( 'runoffs',  24.  , 'rosaline' ,  .TRUE.    , .true. ,   'yearly'  , ''    , ''  )  
+      sn_t_rnf = FLD_N( 'runoffs',  24.  , 'rotemper' ,  .TRUE.    , .true. ,   'yearly'  , ''    , ''  )  
+      sn_dep_rnf = FLD_N( 'runoffs',   0.  , 'rodepth'  ,  .FALSE.   , .true. ,   'yearly'  , ''    , ''  )  
       !
       REWIND ( numnam )                         ! Read Namelist namsbc_rnf
@@ -157,16 +277,89 @@
       !                                   ! ==================
       !
-      IF( ln_rnf_emp ) THEN                     ! runoffs directly provided in the precipitations
+      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'
-         !
-      ELSE                                      ! runoffs read in a file : set sf_rnf structure 
-         !
-         ! sf_rnf already allocated in main routine
-         ! fill sf_rnf with sn_rnf and control print
+         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  ==!
+         !
+         ALLOCATE( sf_rnf(1), STAT=ierror )         ! Create sf_rnf structure (runoff inflow)
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          runoffs inflow read in a file'
+         IF( ierror > 0 ) THEN
+            CALL ctl_stop( 'sbc_rnf: unable to allocate sf_rnf structure' )   ;   RETURN
+         ENDIF
+         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' )
          !
-      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 )  
+            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. fsdept(ji,jj,jk) < h_rnf(ji,jj) ) ;  jk = jk + 1 ;  END DO  
+                     nk_rnf(ji,jj) = jk  
+                  ELSEIF( h_rnf(ji,jj) == -1   ) THEN   ;  nk_rnf(ji,jj) = 1  
+                  ELSEIF( h_rnf(ji,jj) == -999 ) THEN   ;  nk_rnf(ji,jj) = mbkt(ji,jj)
+                  ELSEIF( h_rnf(ji,jj) /=  0   ) THEN  
+                     CALL ctl_stop( 'runoff depth not positive, and not -999 or -1, rnf value in file fort.999'  )  
+                     WRITE(999,*) 'ji, jj, rnf(ji,jj) :', ji, jj, 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
+            END DO
+         ELSE                                       ! runoffs applied at the surface 
+            nk_rnf(:,:) = 1  
+            h_rnf (:,:) = fse3t(:,:,1)
+         ENDIF  
+         ! 
+      ENDIF
+      !
+      rnf_tsc(:,:,:) = 0._wp                    ! runoffs temperature & salinty contents initilisation
+      !
       !                                   ! ========================
       !                                   !   River mouth vicinity
@@ -178,7 +371,9 @@
          !                                      !    - mixed upstream-centered (ln_traadv_cen2=T)
          !
-         !                                          ! Number of level over which Kz increase
-         nkrnf = 0
-         IF( rn_hrnf > 0.e0 ) THEN
+         IF ( ln_rnf_depth )   CALL ctl_warn( 'sbc_rnf_init: increased mixing turned on but effects may already',   &
+            &                                              'be spread through depth by ln_rnf_depth'               ) 
+         !
+         nkrnf = 0                                  ! Number of level over which Kz increase
+         IF( rn_hrnf > 0._wp ) THEN
             nkrnf = 2
             DO WHILE( nkrnf /= jpkm1 .AND. gdepw_0(nkrnf+1) < rn_hrnf )   ;   nkrnf = nkrnf + 1   ;   END DO
@@ -198,6 +393,6 @@
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) '          No specific treatment at river mouths'
-         rnfmsk  (:,:) = 0.e0 
-         rnfmsk_z(:)   = 0.e0
+         rnfmsk  (:,:) = 0._wp 
+         rnfmsk_z(:)   = 0._wp
          nkrnf = 0
       ENDIF
@@ -226,5 +421,4 @@
       !!                rnfmsk_z vertical structure
       !!----------------------------------------------------------------------
-      USE closea, ONLY :    clo_rnf   ! rnfmsk update routine
       !
       INTEGER           ::   inum        ! temporary integers
@@ -248,5 +442,5 @@
       IF( nclosea == 1 )    CALL clo_rnf( rnfmsk )                ! closed sea inflow set as ruver mouth
 
-      rnfmsk_z(:)   = 0.e0                                        ! vertical structure 
+      rnfmsk_z(:)   = 0._wp                                        ! vertical structure 
       rnfmsk_z(1)   = 1.0
       rnfmsk_z(2)   = 1.0                                         ! **********
Index: trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90	(revision 2528)
@@ -5,4 +5,5 @@
    !!======================================================================
    !! History :  9.0   !  06-07  (G. Madec)  Original code
+   !!            3.3  ! 2010-10  (C. Bricaud, G. Madec)  add the Patm forcing for sea-ice
    !!----------------------------------------------------------------------
 
@@ -14,4 +15,6 @@
    USE dom_oce         ! ocean space and time domain
    USE sbc_oce         ! Surface boundary condition: ocean fields
+   USE sbc_oce         ! surface boundary condition: ocean fields
+   USE sbcapr          ! surface boundary condition: atmospheric pressure
    USE prtctl          ! Print control                    (prt_ctl routine)
    USE restart         ! ocean restart
@@ -27,7 +30,7 @@
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2006) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -44,4 +47,6 @@
       !!      V-points) [m/s], temperature [Celcius] and salinity [psu] over
       !!      the periode (kt - nn_fsbc) to kt
+      !!         Note that the inverse barometer ssh (i.e. ssh associated with Patm)
+      !!      is add to ssh_m when ln_apr_dyn = T. Required for sea-ice dynamics.
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt        ! ocean time step
@@ -63,5 +68,9 @@
          sst_m(:,:) = tn(:,:,1)
          sss_m(:,:) = sn(:,:,1)
-         ssh_m(:,:) = sshn(:,:)
+         !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics)
+         IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )
+         ELSE                    ;   ssh_m(:,:) = sshn(:,:)
+         ENDIF
+
          !
       ELSE
@@ -99,5 +108,9 @@
                sst_m(:,:) = zcoef * tn(:,:,1)
                sss_m(:,:) = zcoef * sn(:,:,1)
-               ssh_m(:,:) = zcoef * sshn(:,:)
+               !                          ! removed inverse barometer ssh when Patm forcing is used 
+               IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = zcoef * ( sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) )
+               ELSE                    ;   ssh_m(:,:) = zcoef *   sshn(:,:)
+               ENDIF
+
             ENDIF
             !                                             ! ---------------------------------------- !
@@ -117,5 +130,8 @@
          sst_m(:,:) = sst_m(:,:) + tn(:,:,1)
          sss_m(:,:) = sss_m(:,:) + sn(:,:,1)
-         ssh_m(:,:) = ssh_m(:,:) + sshn(:,:)
+         !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics)
+         IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) - 0.5 *  ( ssh_ib(:,:) + ssh_ibb(:,:) )
+         ELSE                    ;   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:)
+         ENDIF
 
          !                                                ! ---------------------------------------- !
Index: trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90	(revision 2528)
@@ -46,7 +46,7 @@
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -115,9 +115,9 @@
                CALL ctl_stop( 'sbc_ssr: unable to allocate sf_sst structure' )   ;   RETURN
             ENDIF
-            ALLOCATE( sf_sst(1)%fnow(jpi,jpj) )
-            ALLOCATE( sf_sst(1)%fdta(jpi,jpj,2) )
+            ALLOCATE( sf_sst(1)%fnow(jpi,jpj,1) )
             !
             ! fill sf_sst with sn_sst and control print
             CALL fld_fill( sf_sst, (/ sn_sst /), cn_dir, 'sbc_ssr', 'SST restoring term toward SST data', 'namsbc_ssr' )
+            IF( sf_sst(1)%ln_tint ) ALLOCATE( sf_sst(1)%fdta(jpi,jpj,1,2) )
          ENDIF
          !
@@ -128,9 +128,9 @@
                CALL ctl_stop( 'sbc_ssr: unable to allocate sf_sss structure' )   ;   RETURN
             ENDIF
-            ALLOCATE( sf_sss(1)%fnow(jpi,jpj) )
-            ALLOCATE( sf_sss(1)%fdta(jpi,jpj,2) )
+            ALLOCATE( sf_sss(1)%fnow(jpi,jpj,1) )
             !
             ! fill sf_sss with sn_sss and control print
             CALL fld_fill( sf_sss, (/ sn_sss /), cn_dir, 'sbc_ssr', 'SSS restoring term toward SSS data', 'namsbc_ssr' )
+            IF( sf_sss(1)%ln_tint )ALLOCATE( sf_sss(1)%fdta(jpi,jpj,1,2) )
          ENDIF
          !
@@ -153,5 +153,5 @@
                DO jj = 1, jpj
                   DO ji = 1, jpi
-                     zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj) )
+                     zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) )
                      qns(ji,jj) = qns(ji,jj) + zqrp
                      qrp(ji,jj) = zqrp
@@ -167,5 +167,5 @@
                   DO ji = 1, jpi
                      zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths
-                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj) )   &
+                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) )   &
                         &        / ( sss_m(ji,jj) + 1.e-20   )
                      emps(ji,jj) = emps(ji,jj) + zerp
@@ -182,5 +182,5 @@
                   DO ji = 1, jpi                            
                      zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths
-                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj) )   &
+                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) )   &
                         &        / ( sss_m(ji,jj) + 1.e-20   )
                      IF( ln_sssr_bnd )   zerp = SIGN( 1., zerp ) * MIN( zerp_bnd, ABS(zerp) )
Index: trunk/NEMOGCM/NEMO/OPA_SRC/SOL/sol_oce.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/SOL/sol_oce.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/SOL/sol_oce.F90	(revision 2528)
@@ -50,7 +50,7 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 END MODULE sol_oce
Index: trunk/NEMOGCM/NEMO/OPA_SRC/SOL/solmat.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/SOL/solmat.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/SOL/solmat.F90	(revision 2528)
@@ -15,4 +15,5 @@
    !!             3.2  ! 2009-06  (S. Masson)  distributed restart using iom
    !!              -   ! 2009-07  (R. Benshila)  suppression of rigid-lid option
+   !!             3.3  ! 2010-09  (D. Storkey) update for BDY module.
    !!----------------------------------------------------------------------
 
@@ -26,4 +27,5 @@
    USE phycst          ! physical constants
    USE obc_oce         ! ocean open boundary conditions
+   USE bdy_oce         ! unstructured open boundary conditions
    USE lbclnk          ! lateral boudary conditions
    USE lib_mpp         ! distributed memory computing
@@ -36,7 +38,7 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -80,5 +82,5 @@
       ENDIF
 
-#if defined key_dynspg_flt 
+#if defined key_dynspg_flt && ! defined key_bdy
 #   if ! defined key_obc
 
@@ -158,4 +160,38 @@
     ENDIF
 #   endif
+
+#  elif defined key_dynspg_flt && defined key_bdy 
+
+      !   defined gcdmat in the case of unstructured open boundaries
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            zcoef = z2dt * z2dt * grav * bmask(ji,jj)
+
+            !  south coefficient
+            zcoefs = -zcoef * hv(ji,jj-1) * e1v(ji,jj-1)/e2v(ji,jj-1)
+            zcoefs = zcoefs * bdyvmask(ji,jj-1)
+            gcp(ji,jj,1) = zcoefs
+
+            !  west coefficient
+            zcoefw = -zcoef * hu(ji-1,jj) * e2u(ji-1,jj)/e1u(ji-1,jj)
+            zcoefw = zcoefw * bdyumask(ji-1,jj)
+            gcp(ji,jj,2) = zcoefw
+
+            !  east coefficient
+            zcoefe = -zcoef * hu(ji,jj) * e2u(ji,jj)/e1u(ji,jj)
+            zcoefe = zcoefe * bdyumask(ji,jj)
+            gcp(ji,jj,3) = zcoefe
+
+            !  north coefficient
+            zcoefn = -zcoef * hv(ji,jj) * e1v(ji,jj)/e2v(ji,jj)
+            zcoefn = zcoefn * bdyvmask(ji,jj)
+            gcp(ji,jj,4) = zcoefn
+
+            ! diagonal coefficient
+            gcdmat(ji,jj) = e1t(ji,jj)*e2t(ji,jj)*bmask(ji,jj) &
+                            - zcoefs -zcoefw -zcoefe -zcoefn
+         END DO
+      END DO
+
 #endif
 
@@ -297,5 +333,5 @@
          SELECT CASE ( cd_type )
          ! 
-         CASE ( 'T', 'S', 'U', 'W' )
+         CASE ( 'T' , 'U', 'W' )
             DO jk = 1, 4
                DO ji = 1-jpr2di, nlci+jpr2di
@@ -311,5 +347,5 @@
             END DO
             !
-         CASE ( 'F' ,'G' , 'I', 'V' )
+         CASE ( 'F' , 'I', 'V' )
             DO jk =1, 4
                DO ji = 1-jpr2di, nlci+jpr2di
@@ -325,5 +361,5 @@
          SELECT CASE (cd_type )
          !
-         CASE ( 'T'  ,'S', 'U', 'W')
+         CASE ( 'T' , 'U', 'W')
             DO jk =1, 4
                DO ji = 1-jpr2di, nlci+jpr2di
@@ -332,5 +368,5 @@
             END DO
             !
-         CASE ( 'F' ,'G' , 'I', 'V' )
+         CASE ( 'F' , 'I', 'V' )
             DO jk =1, 4
                DO ji = 1-jpr2di, nlci+jpr2di
Index: trunk/NEMOGCM/NEMO/OPA_SRC/SOL/solpcg.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/SOL/solpcg.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/SOL/solpcg.F90	(revision 2528)
@@ -14,4 +14,5 @@
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
    USE in_out_manager  ! I/O manager
+   USE lib_fortran
 
    IMPLICIT NONE
@@ -23,7 +24,7 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 CONTAINS
@@ -95,4 +96,6 @@
       ! Initialization of the algorithm with standard PCG
       ! -------------------------------------------------
+      zgcr = 0.e0 
+      gcr  = 0.e0 
 
       CALL lbc_lnk( gcx, c_solver_pt, 1. )   ! lateral boundary condition
@@ -100,5 +103,4 @@
       ! gcr   = gcb-a.gcx
       ! gcdes = gcr
-
       DO jj = 2, jpjm1
          DO ji = fs_2, fs_jpim1   ! vector opt.
@@ -114,6 +116,5 @@
 
       ! rnorme = (gcr,gcr)
-      rnorme = SUM(  gcr(:,:) * gcdmat(:,:) * gcr(:,:)  )
-      IF( lk_mpp )   CALL mpp_sum( rnorme )   ! sum over the global domain
+      rnorme = glob_sum(  gcr(:,:) * gcdmat(:,:) * gcr(:,:)  )
 
       CALL lbc_lnk( gcdes, c_solver_pt, 1. )   ! lateral boundary condition
@@ -129,6 +130,5 @@
 
       ! alph = (gcr,gcr)/(gcdes,gccd)
-      radd = SUM(  gcdes(:,:) * gcdmat(:,:) * gccd(:,:)  )
-      IF( lk_mpp )   CALL mpp_sum( radd )   ! sum over the global domain
+      radd = glob_sum(  gcdes(:,:) * gcdmat(:,:) * gccd(:,:)  )
       alph = rnorme /radd
 
@@ -162,13 +162,12 @@
          ! rnorme = (gcr,gcr)
          rr = rnorme
-         zsum(1) = SUM(  gcr(:,:) * gcdmat(:,:) * gcr(:,:)  )
 
          ! zgcad = (zgcr,gcr) 
-         zsum(2) = SUM( gcr(2:jpim1,2:jpjm1) * gcdmat(2:jpim1,2:jpjm1) * zgcr(2:jpim1,2:jpjm1) )
-
-         IF( lk_mpp )   CALL mpp_sum( zsum, 2 )   ! sum over the global domain
+         zsum(1) = glob_sum(gcr(:,:) * gcdmat(:,:) * gcr(:,:))
+         zsum(2) = glob_sum(gcr(:,:) * gcdmat(:,:) * zgcr(:,:) * bmask(:,:))
+
+         !!RB we should gather the 2 glob_sum
          rnorme = zsum(1)  
          zgcad  = zsum(2)
-
          ! test of convergence
          IF( rnorme < epsr .OR. jn == nn_nmax ) THEN
Index: trunk/NEMOGCM/NEMO/OPA_SRC/SOL/solsor.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/SOL/solsor.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/SOL/solsor.F90	(revision 2528)
@@ -22,4 +22,5 @@
    USE lib_mpp         ! distributed memory computing
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE lib_fortran
 
    IMPLICIT NONE
@@ -29,7 +30,7 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -64,4 +65,5 @@
       INTEGER  ::   ijmppodd, ijmppeven, ijpr2d
       REAL(wp) ::   ztmp, zres, zres2
+      REAL(wp), DIMENSION(jpi,jpj) ::ztab
       !!----------------------------------------------------------------------
       
@@ -131,6 +133,7 @@
                ENDIF
             CASE ( 1 )                 ! relative precision
-               rnorme = SUM( gcr(2:nlci-1,2:nlcj-1) )
-               IF( lk_mpp )   CALL mpp_sum( rnorme )   ! sum over the global domain
+               ztab = 0.
+               ztab(:,:) = gcr(2:nlci-1,2:nlcj-1)
+               rnorme = glob_sum( ztab)    ! sum over the global domain
                ! test of convergence
                IF( rnorme < epsr .OR. jn == nn_nmax ) THEN
Index: trunk/NEMOGCM/NEMO/OPA_SRC/SOL/solver.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/SOL/solver.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/SOL/solver.F90	(revision 2528)
@@ -31,7 +31,7 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 9.0 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -102,17 +102,8 @@
       END SELECT
       !
-      IF( nbit_cmp == 1 ) THEN            ! reproductibility test SOR required
-         IF( nn_solv /= 2 ) THEN
-            CALL ctl_stop( ' Reproductibility tests (nbit_cmp=1) require the SOR solver: nn_solv = 2' )
-         ELSE IF( MAX( jpr2di, jpr2dj ) > 0 ) THEN
-            CALL ctl_stop( ' Reproductibility tests (nbit_cmp=1) require jpr2di = jpr2dj = 0' )
-         END IF 
-      END IF
 
       !                             !* Grid-point at which the solver is applied
 !!gm  c_solver_pt should be removed: nomore bsf, only T-point is used
-      IF( lk_mpp ) THEN   ;    c_solver_pt = 'S'   ! S=T with special staff ??? which one?
-      ELSE                ;    c_solver_pt = 'T'
-      ENDIF
+      c_solver_pt = 'T'                   ! always T-point (ssh solver only, not anymore bsf)
 
       CALL sol_mat( kt )            !* Construction of the elliptic system matrix
Index: trunk/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90	(revision 2528)
@@ -16,4 +16,6 @@
    !!             -   ! 2003-08  (G. Madec)  F90, free form
    !!            3.0  ! 2006-08  (G. Madec)  add tfreez function
+   !!            3.3  ! 2010-05  (C. Ethe, G. Madec)  merge TRC-TRA
+   !!             -   ! 2010-10  (G. Nurser, G. Madec)  add eos_alpbet used in ldfslp
    !!----------------------------------------------------------------------
 
@@ -25,4 +27,5 @@
    !!   eos_insitu_2d  : Compute the in situ density for 2d fields
    !!   eos_bn2        : Compute the Brunt-Vaisala frequency
+   !!   eos_alpbet     : calculates the in situ thermal and haline expansion coeff.
    !!   tfreez         : Compute the surface freezing temperature
    !!   eos_init       : set eos parameters (namelist)
@@ -37,5 +40,5 @@
    PRIVATE
 
-   !! * Interface 
+   !                   !! * Interface 
    INTERFACE eos
       MODULE PROCEDURE eos_insitu, eos_insitu_pot, eos_insitu_2d
@@ -48,12 +51,13 @@
    PUBLIC   eos_init   ! called by istate module
    PUBLIC   bn2        ! called by step module
+   PUBLIC   eos_alpbet ! called by ldfslp module
    PUBLIC   tfreez     ! called by sbcice_... modules
 
-   !                                        !!* Namelist (nameos) *
-   INTEGER , PUBLIC ::   nn_eos   = 0        !: = 0/1/2 type of eq. of state and Brunt-Vaisala frequ.
-   REAL(wp), PUBLIC ::   rn_alpha = 2.0e-4   !: thermal expension coeff. (linear equation of state)
-   REAL(wp), PUBLIC ::   rn_beta  = 7.7e-4   !: saline  expension coeff. (linear equation of state)
-
-   REAL(wp), PUBLIC ::   ralpbet           !: alpha / beta ratio
+   !                                          !!* Namelist (nameos) *
+   INTEGER , PUBLIC ::   nn_eos   = 0         !: = 0/1/2 type of eq. of state and Brunt-Vaisala frequ.
+   REAL(wp), PUBLIC ::   rn_alpha = 2.0e-4_wp !: thermal expension coeff. (linear equation of state)
+   REAL(wp), PUBLIC ::   rn_beta  = 7.7e-4_wp !: saline  expension coeff. (linear equation of state)
+
+   REAL(wp), PUBLIC ::   ralpbet              !: alpha / beta ratio
    
    !! * Substitutions
@@ -61,12 +65,11 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
-   SUBROUTINE eos_insitu( ptem, psal, prd )
+   SUBROUTINE eos_insitu( pts, prd )
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE eos_insitu  ***
@@ -98,5 +101,5 @@
       !!              prd(t,s) = rn_beta * s - rn_alpha * tn - 1.
       !!      Note that no boundary condition problem occurs in this routine
-      !!      as (ptem,psal) are defined over the whole domain.
+      !!      as pts are defined over the whole domain.
       !!
       !! ** Action  :   compute prd , the in situ density (no units)
@@ -104,7 +107,7 @@
       !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994
       !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   ptem   ! potential temperature  [Celcius]
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   psal   ! salinity               [psu]
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   prd    ! in situ density 
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius]
+      !                                                               ! 2 : salinity               [psu]
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   prd   ! in situ density 
       !!
       INTEGER  ::   ji, jj, jk           ! dummy loop indices
@@ -123,22 +126,22 @@
          zrau0r = 1.e0 / rau0
 !CDIR NOVERRCHK
-         zws(:,:,:) = SQRT( ABS( psal(:,:,:) ) )
+         zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) )
          !  
          DO jk = 1, jpkm1
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  zt = ptem  (ji,jj,jk)
-                  zs = psal  (ji,jj,jk)
+                  zt = pts   (ji,jj,jk,jp_tem)
+                  zs = pts   (ji,jj,jk,jp_sal)
                   zh = fsdept(ji,jj,jk)        ! depth
                   zsr= zws   (ji,jj,jk)        ! square root salinity
                   !
                   ! compute volumic mass pure water at atm pressure
-                  zr1= ( ( ( ( 6.536332e-9*zt-1.120083e-6 )*zt+1.001685e-4)*zt   &
-                     &      -9.095290e-3 )*zt+6.793952e-2 )*zt+999.842594
+                  zr1= ( ( ( ( 6.536332e-9_wp  *zt - 1.120083e-6_wp )*zt + 1.001685e-4_wp )*zt   &
+                     &        -9.095290e-3_wp )*zt + 6.793952e-2_wp )*zt +  999.842594_wp
                   ! seawater volumic mass atm pressure
-                  zr2= ( ( ( 5.3875e-9*zt-8.2467e-7 ) *zt+7.6438e-5 ) *zt        &
-                     &                   -4.0899e-3 ) *zt+0.824493
-                  zr3= ( -1.6546e-6*zt+1.0227e-4 ) *zt-5.72466e-3
-                  zr4= 4.8314e-4
+                  zr2= ( ( ( 5.3875e-9_wp*zt-8.2467e-7_wp ) *zt+7.6438e-5_wp ) *zt        &
+                     &                      -4.0899e-3_wp ) *zt+0.824493_wp
+                  zr3= ( -1.6546e-6_wp*zt+1.0227e-4_wp )    *zt-5.72466e-3_wp
+                  zr4= 4.8314e-4_wp
                   !
                   ! potential volumic mass (reference to the surface)
@@ -146,20 +149,20 @@
                   !
                   ! add the compression terms
-                  ze = ( -3.508914e-8*zt-1.248266e-8 ) *zt-2.595994e-6
-                  zbw= (  1.296821e-6*zt-5.782165e-9 ) *zt+1.045941e-4
+                  ze = ( -3.508914e-8_wp*zt-1.248266e-8_wp ) *zt-2.595994e-6_wp
+                  zbw= (  1.296821e-6_wp*zt-5.782165e-9_wp ) *zt+1.045941e-4_wp
                   zb = zbw + ze * zs
                   !
-                  zd = -2.042967e-2
-                  zc =   (-7.267926e-5*zt+2.598241e-3 ) *zt+0.1571896
-                  zaw= ( ( 5.939910e-6*zt+2.512549e-3 ) *zt-0.1028859 ) *zt - 4.721788
+                  zd = -2.042967e-2_wp
+                  zc =   (-7.267926e-5_wp*zt+2.598241e-3_wp ) *zt+0.1571896_wp
+                  zaw= ( ( 5.939910e-6_wp*zt+2.512549e-3_wp ) *zt-0.1028859_wp ) *zt - 4.721788_wp
                   za = ( zd*zsr + zc ) *zs + zaw
                   !
-                  zb1=   (-0.1909078*zt+7.390729 ) *zt-55.87545
-                  za1= ( ( 2.326469e-3*zt+1.553190)*zt-65.00517 ) *zt+1044.077
-                  zkw= ( ( (-1.361629e-4*zt-1.852732e-2 ) *zt-30.41638 ) *zt + 2098.925 ) *zt+190925.6
+                  zb1=   (-0.1909078_wp*zt+7.390729_wp )        *zt-55.87545_wp
+                  za1= ( ( 2.326469e-3_wp*zt+1.553190_wp)       *zt-65.00517_wp ) *zt+1044.077_wp
+                  zkw= ( ( (-1.361629e-4_wp*zt-1.852732e-2_wp ) *zt-30.41638_wp ) *zt + 2098.925_wp ) *zt+190925.6_wp
                   zk0= ( zb1*zsr + za1 )*zs + zkw
                   !
                   ! masked in situ density anomaly
-                  prd(ji,jj,jk) = (  zrhop / (  1.0 - zh / ( zk0 - zh * ( za - zh * zb ) )  )    &
+                  prd(ji,jj,jk) = (  zrhop / (  1.0_wp - zh / ( zk0 - zh * ( za - zh * zb ) )  )    &
                      &             - rau0  ) * zrau0r * tmask(ji,jj,jk)
                END DO
@@ -169,10 +172,10 @@
       CASE( 1 )                !==  Linear formulation function of temperature only  ==!
          DO jk = 1, jpkm1
-            prd(:,:,jk) = ( 0.0285 - rn_alpha * ptem(:,:,jk) ) * tmask(:,:,jk)
+            prd(:,:,jk) = ( 0.0285_wp - rn_alpha * pts(:,:,jk,jp_tem) ) * tmask(:,:,jk)
          END DO
          !
       CASE( 2 )                !==  Linear formulation function of temperature and salinity  ==!
          DO jk = 1, jpkm1
-            prd(:,:,jk) = ( rn_beta  * psal(:,:,jk) - rn_alpha * ptem(:,:,jk) ) * tmask(:,:,jk)
+            prd(:,:,jk) = ( rn_beta  * pts(:,:,jk,jp_sal) - rn_alpha * pts(:,:,jk,jp_tem) ) * tmask(:,:,jk)
          END DO
          !
@@ -184,5 +187,5 @@
 
 
-   SUBROUTINE eos_insitu_pot( ptem, psal, prd, prhop )
+   SUBROUTINE eos_insitu_pot( pts, prd, prhop )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE eos_insitu_pot  ***
@@ -230,8 +233,8 @@
       !!                Brown and Campana, Mon. Weather Rev., 1978
       !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   ptem   ! potential temperature  [Celcius]
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   psal   ! salinity               [psu]
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   prd    ! in situ density 
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   prhop  ! potential density (surface referenced)
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius]
+      !                                                               ! 2 : salinity               [psu]
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prd    ! in situ density 
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prhop  ! potential density (surface referenced)
 
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
@@ -246,22 +249,22 @@
          zrau0r = 1.e0 / rau0
 !CDIR NOVERRCHK
-         zws(:,:,:) = SQRT( ABS( psal(:,:,:) ) )
+         zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) )
          !  
          DO jk = 1, jpkm1
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  zt = ptem  (ji,jj,jk)
-                  zs = psal  (ji,jj,jk)
+                  zt = pts   (ji,jj,jk,jp_tem)
+                  zs = pts   (ji,jj,jk,jp_sal)
                   zh = fsdept(ji,jj,jk)        ! depth
                   zsr= zws   (ji,jj,jk)        ! square root salinity
                   !
                   ! compute volumic mass pure water at atm pressure
-                  zr1= ( ( ( ( 6.536332e-9*zt-1.120083e-6 )*zt+1.001685e-4 )*zt   &
-                     &                       -9.095290e-3 )*zt+6.793952e-2 )*zt+999.842594
+                  zr1= ( ( ( ( 6.536332e-9_wp*zt-1.120083e-6_wp )*zt+1.001685e-4_wp )*zt   &
+                     &                          -9.095290e-3_wp )*zt+6.793952e-2_wp )*zt+999.842594_wp
                   ! seawater volumic mass atm pressure
-                  zr2= ( ( ( 5.3875e-9*zt-8.2467e-7 ) *zt+7.6438e-5 ) *zt   &
-                     &                                   -4.0899e-3 ) *zt+0.824493
-                  zr3= ( -1.6546e-6*zt+1.0227e-4 ) *zt-5.72466e-3
-                  zr4= 4.8314e-4
+                  zr2= ( ( ( 5.3875e-9_wp*zt-8.2467e-7_wp ) *zt+7.6438e-5_wp ) *zt   &
+                     &                                         -4.0899e-3_wp ) *zt+0.824493_wp
+                  zr3= ( -1.6546e-6_wp*zt+1.0227e-4_wp )    *zt-5.72466e-3_wp
+                  zr4= 4.8314e-4_wp
                   !
                   ! potential volumic mass (reference to the surface)
@@ -272,20 +275,20 @@
                   !
                   ! add the compression terms
-                  ze = ( -3.508914e-8*zt-1.248266e-8 ) *zt-2.595994e-6
-                  zbw= (  1.296821e-6*zt-5.782165e-9 ) *zt+1.045941e-4
+                  ze = ( -3.508914e-8_wp*zt-1.248266e-8_wp ) *zt-2.595994e-6_wp
+                  zbw= (  1.296821e-6_wp*zt-5.782165e-9_wp ) *zt+1.045941e-4_wp
                   zb = zbw + ze * zs
                   !
-                  zd = -2.042967e-2
-                  zc =   (-7.267926e-5*zt+2.598241e-3 ) *zt+0.1571896
-                  zaw= ( ( 5.939910e-6*zt+2.512549e-3 ) *zt-0.1028859 ) *zt - 4.721788
+                  zd = -2.042967e-2_wp
+                  zc =   (-7.267926e-5_wp*zt+2.598241e-3_wp ) *zt+0.1571896_wp
+                  zaw= ( ( 5.939910e-6_wp*zt+2.512549e-3_wp ) *zt-0.1028859_wp ) *zt - 4.721788_wp
                   za = ( zd*zsr + zc ) *zs + zaw
                   !
-                  zb1=   (-0.1909078*zt+7.390729 ) *zt-55.87545
-                  za1= ( ( 2.326469e-3*zt+1.553190)*zt-65.00517 ) *zt+1044.077
-                  zkw= ( ( (-1.361629e-4*zt-1.852732e-2 ) *zt-30.41638 ) *zt + 2098.925 ) *zt+190925.6
+                  zb1=   (  -0.1909078_wp  *zt+7.390729_wp    ) *zt-55.87545_wp
+                  za1= ( (   2.326469e-3_wp*zt+1.553190_wp    ) *zt-65.00517_wp ) *zt + 1044.077_wp
+                  zkw= ( ( (-1.361629e-4_wp*zt-1.852732e-2_wp ) *zt-30.41638_wp ) *zt + 2098.925_wp ) *zt+190925.6_wp
                   zk0= ( zb1*zsr + za1 )*zs + zkw
                   !
                   ! masked in situ density anomaly
-                  prd(ji,jj,jk) = (  zrhop / (  1.0 - zh / ( zk0 - zh * ( za - zh * zb ) )  )    &
+                  prd(ji,jj,jk) = (  zrhop / (  1.0_wp - zh / ( zk0 - zh * ( za - zh * zb ) )  )    &
                      &             - rau0  ) * zrau0r * tmask(ji,jj,jk)
                END DO
@@ -295,12 +298,12 @@
       CASE( 1 )                !==  Linear formulation = F( temperature )  ==!
          DO jk = 1, jpkm1
-            prd  (:,:,jk) = ( 0.0285 - rn_alpha * ptem(:,:,jk) )        * tmask(:,:,jk)
-            prhop(:,:,jk) = ( 1.e0   +          prd (:,:,jk) ) * rau0 * tmask(:,:,jk)
+            prd  (:,:,jk) = ( 0.0285_wp - rn_alpha * pts(:,:,jk,jp_tem) )        * tmask(:,:,jk)
+            prhop(:,:,jk) = ( 1.e0_wp   +            prd (:,:,jk)       ) * rau0 * tmask(:,:,jk)
          END DO
          !
       CASE( 2 )                !==  Linear formulation = F( temperature , salinity )  ==!
          DO jk = 1, jpkm1
-            prd  (:,:,jk) = ( rn_beta  * psal(:,:,jk) - rn_alpha * ptem(:,:,jk) )        * tmask(:,:,jk)
-            prhop(:,:,jk) = ( 1.e0   + prd (:,:,jk) )                         * rau0 * tmask(:,:,jk)
+            prd  (:,:,jk) = ( rn_beta  * pts(:,:,jk,jp_sal) - rn_alpha * pts(:,:,jk,jp_tem) )        * tmask(:,:,jk)
+            prhop(:,:,jk) = ( 1.e0_wp  + prd (:,:,jk) )                                       * rau0 * tmask(:,:,jk)
          END DO
          !
@@ -312,5 +315,5 @@
 
 
-   SUBROUTINE eos_insitu_2d( ptem, psal, pdep, prd )
+   SUBROUTINE eos_insitu_2d( pts, pdep, prd )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE eos_insitu_2d  ***
@@ -342,5 +345,5 @@
       !!              prd(t,s) = rn_beta * s - rn_alpha * tn - 1.
       !!      Note that no boundary condition problem occurs in this routine
-      !!      as (ptem,psal) are defined over the whole domain.
+      !!      as pts are defined over the whole domain.
       !!
       !! ** Action  : - prd , the in situ density (no units)
@@ -348,8 +351,8 @@
       !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994
       !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   ptem   ! potential temperature  [Celcius]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   psal   ! salinity               [psu]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   pdep   ! depth                  [m]
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   prd    ! in situ density 
+      REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius]
+      !                                                           ! 2 : salinity               [psu]
+      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(in   ) ::   pdep  ! depth                  [m]
+      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(  out) ::   prd   ! in situ density 
       !!
       INTEGER  ::   ji, jj                    ! dummy loop indices
@@ -369,5 +372,5 @@
 !CDIR NOVERRCHK
             DO ji = 1, fs_jpim1   ! vector opt.
-               zws(ji,jj) = SQRT( ABS( psal(ji,jj) ) )
+               zws(ji,jj) = SQRT( ABS( pts(ji,jj,jp_sal) ) )
             END DO
          END DO
@@ -375,17 +378,17 @@
             DO ji = 1, fs_jpim1   ! vector opt.
                zmask = tmask(ji,jj,1)          ! land/sea bottom mask = surf. mask
-               zt    = ptem (ji,jj)            ! interpolated T
-               zs    = psal (ji,jj)            ! interpolated S
+               zt    = pts  (ji,jj,jp_tem)            ! interpolated T
+               zs    = pts  (ji,jj,jp_sal)            ! interpolated S
                zsr   = zws  (ji,jj)            ! square root of interpolated S
                zh    = pdep (ji,jj)            ! depth at the partial step level
                !
                ! compute volumic mass pure water at atm pressure
-               zr1 = ( ( ( ( 6.536332e-9*zt-1.120083e-6 )*zt+1.001685e-4 )*zt   &
-                  &                        -9.095290e-3 )*zt+6.793952e-2 )*zt+999.842594
+               zr1 = ( ( ( ( 6.536332e-9_wp*zt-1.120083e-6_wp )*zt+1.001685e-4_wp )*zt   &
+                  &                        -9.095290e-3_wp )*zt+6.793952e-2_wp )*zt+999.842594_wp
                ! seawater volumic mass atm pressure
-               zr2 = ( ( ( 5.3875e-9*zt-8.2467e-7 )*zt+7.6438e-5 ) *zt   &
-                  &                                   -4.0899e-3 ) *zt+0.824493
-               zr3 = ( -1.6546e-6*zt+1.0227e-4 ) *zt-5.72466e-3
-               zr4 = 4.8314e-4
+               zr2 = ( ( ( 5.3875e-9_wp*zt-8.2467e-7_wp )*zt+7.6438e-5_wp ) *zt   &
+                  &                                   -4.0899e-3_wp ) *zt+0.824493_wp
+               zr3 = ( -1.6546e-6_wp*zt+1.0227e-4_wp ) *zt-5.72466e-3_wp
+               zr4 = 4.8314e-4_wp
                !
                ! potential volumic mass (reference to the surface)
@@ -393,21 +396,21 @@
                !
                ! add the compression terms
-               ze = ( -3.508914e-8*zt-1.248266e-8 ) *zt-2.595994e-6
-               zbw= (  1.296821e-6*zt-5.782165e-9 ) *zt+1.045941e-4
+               ze = ( -3.508914e-8_wp*zt-1.248266e-8_wp ) *zt-2.595994e-6_wp
+               zbw= (  1.296821e-6_wp*zt-5.782165e-9_wp ) *zt+1.045941e-4_wp
                zb = zbw + ze * zs
                !
-               zd = -2.042967e-2
-               zc =   (-7.267926e-5*zt+2.598241e-3 ) *zt+0.1571896
-               zaw= ( ( 5.939910e-6*zt+2.512549e-3 ) *zt-0.1028859 ) *zt -4.721788
+               zd =    -2.042967e-2_wp
+               zc =   (-7.267926e-5_wp*zt+2.598241e-3_wp ) *zt+0.1571896_wp
+               zaw= ( ( 5.939910e-6_wp*zt+2.512549e-3_wp ) *zt-0.1028859_wp ) *zt -4.721788_wp
                za = ( zd*zsr + zc ) *zs + zaw
                !
-               zb1=   (-0.1909078*zt+7.390729 ) *zt-55.87545
-               za1= ( ( 2.326469e-3*zt+1.553190)*zt-65.00517 ) *zt+1044.077
-               zkw= ( ( (-1.361629e-4*zt-1.852732e-2 ) *zt-30.41638 ) *zt   &
-                  &                                       +2098.925 ) *zt+190925.6
+               zb1=     (-0.1909078_wp  *zt+7.390729_wp      ) *zt-55.87545_wp
+               za1=   ( ( 2.326469e-3_wp*zt+1.553190_wp      ) *zt-65.00517_wp ) *zt+1044.077_wp
+               zkw= ( ( (-1.361629e-4_wp*zt-1.852732e-2_wp   ) *zt-30.41638_wp ) *zt   &
+                  &                             +2098.925_wp ) *zt+190925.6_wp
                zk0= ( zb1*zsr + za1 )*zs + zkw
                !
                ! masked in situ density anomaly
-               prd(ji,jj) = ( zrhop / (  1.0 - zh / ( zk0 - zh * ( za - zh * zb ) )  ) - rau0 ) / rau0 * zmask
+               prd(ji,jj) = ( zrhop / (  1.0_wp - zh / ( zk0 - zh * ( za - zh * zb ) )  ) - rau0 ) / rau0 * zmask
             END DO
          END DO
@@ -416,5 +419,5 @@
          DO jj = 1, jpjm1
             DO ji = 1, fs_jpim1   ! vector opt.
-               prd(ji,jj) = ( 0.0285 - rn_alpha * ptem(ji,jj) ) * tmask(ji,jj,1)
+               prd(ji,jj) = ( 0.0285_wp - rn_alpha * pts(ji,jj,jp_tem) ) * tmask(ji,jj,1)
             END DO
          END DO
@@ -423,5 +426,5 @@
          DO jj = 1, jpjm1
             DO ji = 1, fs_jpim1   ! vector opt.
-               prd(ji,jj) = ( rn_beta * psal(ji,jj) - rn_alpha * ptem(ji,jj) ) * tmask(ji,jj,1) 
+               prd(ji,jj) = ( rn_beta * pts(ji,jj,jp_sal) - rn_alpha * pts(ji,jj,jp_tem) ) * tmask(ji,jj,1) 
             END DO
          END DO
@@ -434,5 +437,5 @@
 
 
-   SUBROUTINE eos_bn2( ptem, psal, pn2 )
+   SUBROUTINE eos_bn2( pts, pn2 )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE eos_bn2  ***
@@ -464,7 +467,7 @@
       !! References :   McDougall, J. Phys. Oceanogr., 17, 1950-1964, 1987.
       !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   ptem   ! potential temperature   [Celcius]
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   psal   ! salinity                [psu]
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   pn2    ! Brunt-Vaisala frequency [s-1]
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius]
+      !                                                               ! 2 : salinity               [psu]
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pn2    ! Brunt-Vaisala frequency [s-1]
       !!
       INTEGER  ::   ji, jj, jk   ! dummy loop indices
@@ -485,41 +488,41 @@
                DO ji = 1, jpi
                   zgde3w = grav / fse3w(ji,jj,jk)
-                  zt = 0.5 * ( ptem(ji,jj,jk) + ptem(ji,jj,jk-1) )          ! potential temperature at w-point
-                  zs = 0.5 * ( psal(ji,jj,jk) + psal(ji,jj,jk-1) ) - 35.0   ! salinity anomaly (s-35) at w-point
+                  zt = 0.5 * ( pts(ji,jj,jk,jp_tem) + pts(ji,jj,jk-1,jp_tem) )          ! potential temperature at w-point
+                  zs = 0.5 * ( pts(ji,jj,jk,jp_sal) + pts(ji,jj,jk-1,jp_sal) ) - 35.0   ! salinity anomaly (s-35) at w-point
                   zh = fsdepw(ji,jj,jk)                                     ! depth in meters  at w-point
                   !
-                  zalbet = ( ( ( - 0.255019e-07 * zt + 0.298357e-05 ) * zt   &   ! ratio alpha/beta
-                     &                               - 0.203814e-03 ) * zt   &
-                     &                               + 0.170907e-01 ) * zt   &
-                     &   + 0.665157e-01                                      &
-                     &   +     ( - 0.678662e-05 * zs                         &
-                     &           - 0.846960e-04 * zt + 0.378110e-02 ) * zs   &
-                     &   +   ( ( - 0.302285e-13 * zh                         &
-                     &           - 0.251520e-11 * zs                         &
-                     &           + 0.512857e-12 * zt * zt           ) * zh   &
-                     &           - 0.164759e-06 * zs                         &
-                     &        +(   0.791325e-08 * zt - 0.933746e-06 ) * zt   &
-                     &                               + 0.380374e-04 ) * zh
+                  zalbet = ( ( ( - 0.255019e-07_wp * zt + 0.298357e-05_wp ) * zt   &   ! ratio alpha/beta
+                     &                                  - 0.203814e-03_wp ) * zt   &
+                     &                                  + 0.170907e-01_wp ) * zt   &
+                     &   +         0.665157e-01_wp                                 &
+                     &   +     ( - 0.678662e-05_wp * zs                            &
+                     &           - 0.846960e-04_wp * zt + 0.378110e-02_wp ) * zs   &
+                     &   +   ( ( - 0.302285e-13_wp * zh                            &
+                     &           - 0.251520e-11_wp * zs                            &
+                     &           + 0.512857e-12_wp * zt * zt              ) * zh   &
+                     &           - 0.164759e-06_wp * zs                            &
+                     &        +(   0.791325e-08_wp * zt - 0.933746e-06_wp ) * zt   &
+                     &                                  + 0.380374e-04_wp ) * zh
                      !
-                  zbeta  = ( ( -0.415613e-09 * zt + 0.555579e-07 ) * zt      &   ! beta
-                     &                            - 0.301985e-05 ) * zt      &
-                     &   + 0.785567e-03                                      &
-                     &   + (     0.515032e-08 * zs                           &
-                     &         + 0.788212e-08 * zt - 0.356603e-06 ) * zs     &
-                     &   +(  (   0.121551e-17 * zh                           &
-                     &         - 0.602281e-15 * zs                           &
-                     &         - 0.175379e-14 * zt + 0.176621e-12 ) * zh     &
-                     &                             + 0.408195e-10   * zs     &
-                     &     + ( - 0.213127e-11 * zt + 0.192867e-09 ) * zt     &
-                     &                             - 0.121555e-07 ) * zh
+                  zbeta  = ( ( -0.415613e-09_wp * zt + 0.555579e-07_wp ) * zt      &   ! beta
+                     &                               - 0.301985e-05_wp ) * zt      &
+                     &   +       0.785567e-03_wp                                   &
+                     &   + (     0.515032e-08_wp * zs                              &
+                     &         + 0.788212e-08_wp * zt - 0.356603e-06_wp ) * zs     &
+                     &   + ( (   0.121551e-17_wp * zh                              &
+                     &         - 0.602281e-15_wp * zs                              &
+                     &         - 0.175379e-14_wp * zt + 0.176621e-12_wp ) * zh     &
+                     &                                + 0.408195e-10_wp   * zs     &
+                     &     + ( - 0.213127e-11_wp * zt + 0.192867e-09_wp ) * zt     &
+                     &                                - 0.121555e-07_wp ) * zh
                      !
                   pn2(ji,jj,jk) = zgde3w * zbeta * tmask(ji,jj,jk)           &   ! N^2 
-                     &          * ( zalbet * ( ptem(ji,jj,jk-1) - ptem(ji,jj,jk) )   &
-                     &                     - ( psal(ji,jj,jk-1) - psal(ji,jj,jk) ) )
+                     &          * ( zalbet * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) )   &
+                     &                     - ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) )
 #if defined key_zdfddm
                   !                                                         !!bug **** caution a traiter zds=dk[S]= 0 !!!!
-                  zds = ( psal(ji,jj,jk-1) - psal(ji,jj,jk) )                    ! Rrau = (alpha / beta) (dk[t] / dk[s])
-                  IF ( ABS( zds) <= 1.e-20 ) zds = 1.e-20
-                  rrau(ji,jj,jk) = zalbet * ( ptem(ji,jj,jk-1) - ptem(ji,jj,jk) ) / zds
+                  zds = ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) )                    ! Rrau = (alpha / beta) (dk[t] / dk[s])
+                  IF ( ABS( zds) <= 1.e-20_wp ) zds = 1.e-20_wp
+                  rrau(ji,jj,jk) = zalbet * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) / zds
 #endif
                END DO
@@ -529,11 +532,11 @@
       CASE( 1 )                !==  Linear formulation = F( temperature )  ==!
          DO jk = 2, jpkm1
-            pn2(:,:,jk) = grav * rn_alpha * ( ptem(:,:,jk-1) - ptem(:,:,jk) ) / fse3w(:,:,jk) * tmask(:,:,jk)
+            pn2(:,:,jk) = grav * rn_alpha * ( pts(:,:,jk-1,jp_tem) - pts(:,:,jk,jp_tem) ) / fse3w(:,:,jk) * tmask(:,:,jk)
          END DO
          !
       CASE( 2 )                !==  Linear formulation = F( temperature , salinity )  ==!
          DO jk = 2, jpkm1
-            pn2(:,:,jk) = grav * (  rn_alpha * ( ptem(:,:,jk-1) - ptem(:,:,jk) )      &
-               &                  - rn_beta  * ( psal(:,:,jk-1) - psal(:,:,jk) )  )   &
+            pn2(:,:,jk) = grav * (  rn_alpha * ( pts(:,:,jk-1,jp_tem) - pts(:,:,jk,jp_tem) )      &
+               &                  - rn_beta  * ( pts(:,:,jk-1,jp_sal) - pts(:,:,jk,jp_sal) )  )   &
                &               / fse3w(:,:,jk) * tmask(:,:,jk)
          END DO 
@@ -542,7 +545,7 @@
             DO jj = 1, jpj
                DO ji = 1, jpi
-                  zds = ( psal(ji,jj,jk-1) - psal(ji,jj,jk) )
-                  IF ( ABS( zds ) <= 1.e-20 ) zds = 1.e-20
-                  rrau(ji,jj,jk) = ralpbet * ( ptem(ji,jj,jk-1) - ptem(ji,jj,jk) ) / zds
+                  zds = ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) )  
+                  IF ( ABS( zds ) <= 1.e-20_wp ) zds = 1.e-20_wp
+                  rrau(ji,jj,jk) = ralpbet * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) / zds
                END DO
             END DO
@@ -559,4 +562,90 @@
 
 
+   SUBROUTINE eos_alpbet( pts, palph, pbeta )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE ldf_slp_grif  ***
+      !!
+      !! ** Purpose :   Calculates the thermal and haline expansion coefficients at T-points. 
+      !!
+      !! ** Method  :   calculates alpha and beta at T-points 
+      !!       * nn_eos = 0  : UNESCO sea water properties
+      !!         The brunt-vaisala frequency is computed using the polynomial
+      !!      polynomial expression of McDougall (1987):
+      !!            N^2 = grav * beta * ( alpha/beta*dk[ t ] - dk[ s ] )/e3w
+      !!      If lk_zdfddm=T, the heat/salt buoyancy flux ratio Rrau is
+      !!      computed and used in zdfddm module :
+      !!              Rrau = alpha/beta * ( dk[ t ] / dk[ s ] )
+      !!       * nn_eos = 1  : linear equation of state (temperature only)
+      !!            N^2 = grav * rn_alpha * dk[ t ]/e3w
+      !!       * nn_eos = 2  : linear equation of state (temperature & salinity)
+      !!            N^2 = grav * (rn_alpha * dk[ t ] - rn_beta * dk[ s ] ) / e3w
+      !!       * nn_eos = 3  : Jackett JAOT 2003 ???
+      !!
+      !! ** Action  : - palph, pbeta : thermal and haline expansion coeff. at T-point
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts            ! pot. temperature & salinity
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   palph, pbeta   ! thermal & haline expansion coeff.
+      !!
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zt, zs, zh   ! local scalars 
+      !!----------------------------------------------------------------------
+      !
+      SELECT CASE ( nn_eos )
+      !
+      CASE ( 0 )               ! Jackett and McDougall (1994) formulation
+         DO jk = 1, jpk
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zt = pts(ji,jj,jk,jp_tem)           ! potential temperature
+                  zs = pts(ji,jj,jk,jp_sal) - 35._wp  ! salinity anomaly (s-35)
+                  zh = fsdept(ji,jj,jk)              ! depth in meters 
+                  !
+                  pbeta(ji,jj,jk) = ( ( -0.415613e-09_wp * zt + 0.555579e-07_wp ) * zt   &
+                     &                                        - 0.301985e-05_wp ) * zt   &
+                     &           + 0.785567e-03_wp                                       &
+                     &           + (     0.515032e-08_wp * zs                            &
+                     &                 + 0.788212e-08_wp * zt - 0.356603e-06_wp ) * zs   &
+                     &           + ( (   0.121551e-17_wp * zh                            &
+                     &                 - 0.602281e-15_wp * zs                            &
+                     &                 - 0.175379e-14_wp * zt + 0.176621e-12_wp ) * zh   &
+                     &                                        + 0.408195e-10_wp   * zs   &
+                     &             + ( - 0.213127e-11_wp * zt + 0.192867e-09_wp ) * zt   &
+                     &                                        - 0.121555e-07_wp ) * zh
+                     !
+                  palph(ji,jj,jk) = - pbeta(ji,jj,jk) *                             &
+                      &     ((( ( - 0.255019e-07_wp * zt + 0.298357e-05_wp ) * zt   &
+                      &                                  - 0.203814e-03_wp ) * zt   &
+                      &                                  + 0.170907e-01_wp ) * zt   &
+                      &   + 0.665157e-01_wp                                         &
+                      &   +     ( - 0.678662e-05_wp * zs                            &
+                      &           - 0.846960e-04_wp * zt + 0.378110e-02_wp ) * zs   &
+                      &   +   ( ( - 0.302285e-13_wp * zh                            &
+                      &           - 0.251520e-11_wp * zs                            &
+                      &           + 0.512857e-12_wp * zt * zt              ) * zh   &
+                      &           - 0.164759e-06_wp * zs                            &
+                      &        +(   0.791325e-08_wp * zt - 0.933746e-06_wp ) * zt   &
+                      &                                  + 0.380374e-04_wp ) * zh)
+               END DO
+            END DO
+         END DO
+         !
+      CASE ( 1 )
+         palph(:,:,:) = - rn_alpha
+         pbeta(:,:,:) =   0._wp
+         !
+      CASE ( 2 )
+         palph(:,:,:) = - rn_alpha
+         pbeta(:,:,:) =   rn_beta
+         !
+      CASE DEFAULT
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          bad flag value for nn_eos = ', nn_eos
+         nstop = nstop + 1
+         !
+      END SELECT
+      !
+   END SUBROUTINE eos_alpbet
+
+
    FUNCTION tfreez( psal ) RESULT( ptf )
       !!----------------------------------------------------------------------
@@ -575,6 +664,6 @@
       !!----------------------------------------------------------------------
       !
-      ptf(:,:) = ( - 0.0575 + 1.710523e-3 * SQRT( psal(:,:) )   &
-         &                  - 2.154996e-4 *       psal(:,:)   ) * psal(:,:)
+      ptf(:,:) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(:,:) )   &
+         &                     - 2.154996e-4_wp *       psal(:,:)   ) * psal(:,:)
       !
    END FUNCTION tfreez
Index: trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90	(revision 2528)
@@ -4,5 +4,6 @@
    !! Ocean active tracers:  advection trend 
    !!==============================================================================
-   !! History :  2.0  !  05-11  (G. Madec)  Original code
+   !! History :  2.0  !  2005-11  (G. Madec)  Original code
+   !!            3.3  !  2010-09  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
    !!----------------------------------------------------------------------
 
@@ -18,7 +19,7 @@
    USE traadv_muscl2   ! MUSCL2   scheme           (tra_adv_muscl2 routine)
    USE traadv_ubs      ! UBS      scheme           (tra_adv_ubs    routine)
-   USE traadv_qck     !! QUICKEST scheme           (tra_adv_qck    routine)
+   USE traadv_qck      ! QUICKEST scheme           (tra_adv_qck    routine)
    USE traadv_eiv      ! eddy induced velocity     (tra_adv_eiv    routine)
-   USE trabbl          ! tracers: bottom boundary layer
+   USE cla             ! cross land advection      (cla_traadv     routine)
    USE ldftra_oce      ! lateral diffusion coefficient on tracers
    USE in_out_manager  ! I/O manager
@@ -29,15 +30,18 @@
    PRIVATE
 
-   PUBLIC   tra_adv    ! routine called by step module
+   PUBLIC   tra_adv        ! routine called by step module
+   PUBLIC   tra_adv_init   ! routine called by opa module
  
-   !                                                   !!* Namelist namtra_adv *
-   LOGICAL, PUBLIC ::   ln_traadv_cen2   = .TRUE.       ! 2nd order centered scheme flag
-   LOGICAL, PUBLIC ::   ln_traadv_tvd    = .FALSE.      ! TVD scheme flag
-   LOGICAL, PUBLIC ::   ln_traadv_muscl  = .FALSE.      ! MUSCL scheme flag
-   LOGICAL, PUBLIC ::   ln_traadv_muscl2 = .FALSE.      ! MUSCL2 scheme flag
-   LOGICAL, PUBLIC ::   ln_traadv_ubs    = .FALSE.      ! UBS scheme flag
-   LOGICAL, PUBLIC ::   ln_traadv_qck    = .FALSE.      ! QUICKEST scheme flag
+   !                                        !!* Namelist namtra_adv *
+   LOGICAL ::   ln_traadv_cen2   = .TRUE.    ! 2nd order centered scheme flag
+   LOGICAL ::   ln_traadv_tvd    = .FALSE.   ! TVD scheme flag
+   LOGICAL ::   ln_traadv_muscl  = .FALSE.   ! MUSCL scheme flag
+   LOGICAL ::   ln_traadv_muscl2 = .FALSE.   ! MUSCL2 scheme flag
+   LOGICAL ::   ln_traadv_ubs    = .FALSE.   ! UBS scheme flag
+   LOGICAL ::   ln_traadv_qck    = .FALSE.   ! QUICKEST scheme flag
 
    INTEGER ::   nadv   ! choice of the type of advection scheme
+
+   REAL(wp), DIMENSION(jpk) ::   r2dt   ! vertical profile time-step, = 2 rdttra except at nit000 (=rdttra) if neuler=0
 
    !! * Substitutions
@@ -45,9 +49,8 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -60,74 +63,72 @@
       !! ** Method  : - Update (ua,va) with the advection term following nadv
       !!----------------------------------------------------------------------
-#if ( defined key_trabbl_adv || defined key_traldf_eiv )
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zun, zvn, zwn   ! effective velocity
-#else
-      USE oce, ONLY :                       zun => un       ! the effective velocity is the
-      USE oce, ONLY :                       zvn => vn       ! Eulerian velocity
-      USE oce, ONLY :                       zwn => wn       ! 
-#endif
-      !!
       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      !
+      INTEGER ::   jk   ! dummy loop index
+      REAL(wp), DIMENSION(jpi,jpj,jpk)   ::  zun, zvn, zwn   ! 3D workspace: effective transport
       !!----------------------------------------------------------------------
+      !                                          ! set time step
+      IF( neuler == 0 .AND. kt == nit000 ) THEN     ! at nit000
+         r2dt(:) =  rdttra(:)                          ! = rdtra (restarting with Euler time stepping)
+      ELSEIF( kt <= nit000 + 1) THEN                ! at nit000 or nit000+1
+         r2dt(:) = 2. * rdttra(:)                      ! = 2 rdttra (leapfrog)
+      ENDIF
+      !
+      IF( nn_cla == 1 )   CALL cla_traadv( kt )       !==  Cross Land Advection  ==! (hor. advection)
+      !
+      !                                               !==  effective transport  ==!
+      DO jk = 1, jpkm1
+         zun(:,:,jk) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk)                  ! eulerian transport only
+         zvn(:,:,jk) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk)
+         zwn(:,:,jk) = e1t(:,:) * e2t(:,:)      * wn(:,:,jk)
+      END DO
+      zwn(:,:,jpk) = 0.e0                                                     ! no transport trough the bottom
+      !
+      IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif )   &
+         &              CALL tra_adv_eiv( kt, zun, zvn, zwn, 'TRA' )          ! add the eiv transport (if necessary)
+      !
+      CALL iom_put( "uoce_eff", zun )                                         ! output effective transport      
+      CALL iom_put( "voce_eff", zvn )
+      CALL iom_put( "woce_eff", zwn )
 
-      IF( kt == nit000 )   CALL tra_adv_ctl          ! initialisation & control of options
-
-#if defined key_trabbl_adv
-      zun(:,:,:) = un(:,:,:) - u_bbl(:,:,:)          ! add the bbl velocity
-      zvn(:,:,:) = vn(:,:,:) - v_bbl(:,:,:)
-      zwn(:,:,:) = wn(:,:,:) + w_bbl(:,:,:)
-#endif
-      IF( lk_traldf_eiv ) THEN                       ! commpute and add the eiv velocity
-         IF( .NOT. lk_trabbl_adv ) THEN 
-            zun(:,:,:) = un(:,:,:)
-            zvn(:,:,:) = vn(:,:,:)
-            zwn(:,:,:) = wn(:,:,:)
-         ENDIF
-         CALL tra_adv_eiv( kt, zun, zvn, zwn ) 
-      ENDIF
-
-      SELECT CASE ( nadv )                           ! compute advection trend and add it to general trend
-      CASE ( 1 )   ;   CALL tra_adv_cen2    ( kt, zun, zvn, zwn )    ! 2nd order centered scheme
-      CASE ( 2 )   ;   CALL tra_adv_tvd     ( kt, zun, zvn, zwn )    ! TVD      scheme
-      CASE ( 3 )   ;   CALL tra_adv_muscl   ( kt, zun, zvn, zwn )    ! MUSCL    scheme
-      CASE ( 4 )   ;   CALL tra_adv_muscl2  ( kt, zun, zvn, zwn )    ! MUSCL2   scheme
-      CASE ( 5 )   ;   CALL tra_adv_ubs     ( kt, zun, zvn, zwn )    ! UBS      scheme
-      CASE ( 6 )   ;   CALL tra_adv_qck     ( kt, zun, zvn, zwn )    ! QUICKEST scheme
+      SELECT CASE ( nadv )                            !==  compute advection trend and add it to general trend  ==!
+      CASE ( 1 )   ;    CALL tra_adv_cen2  ( kt, 'TRA',       zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  2nd order centered
+      CASE ( 2 )   ;    CALL tra_adv_tvd   ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  TVD 
+      CASE ( 3 )   ;    CALL tra_adv_muscl ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb,      tsa, jpts )   !  MUSCL 
+      CASE ( 4 )   ;    CALL tra_adv_muscl2( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  MUSCL2 
+      CASE ( 5 )   ;    CALL tra_adv_ubs   ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  UBS 
+      CASE ( 6 )   ;    CALL tra_adv_qck   ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  QUICKEST 
       !
-      CASE (-1 )                                                     ! esopa: test all possibility with control print
-                       CALL tra_adv_cen2    ( kt, zun, zvn, zwn )
-                       CALL prt_ctl( tab3d_1=ta, clinfo1=' adv0 - Ta: ', mask1=tmask,               &
-            &                        tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-                       CALL tra_adv_tvd     ( kt, zun, zvn, zwn )
-                       CALL prt_ctl( tab3d_1=ta, clinfo1=' adv2 - Ta: ', mask1=tmask,               &
-            &                        tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-                       CALL tra_adv_muscl   ( kt, zun, zvn, zwn )
-                       CALL prt_ctl( tab3d_1=ta, clinfo1=' adv3 - Ta: ', mask1=tmask,               &
-            &                        tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-                       CALL tra_adv_muscl2  ( kt, zun, zvn, zwn )
-                       CALL prt_ctl( tab3d_1=ta, clinfo1=' adv4 - Ta: ', mask1=tmask,               &
-            &                        tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-                       CALL tra_adv_ubs     ( kt, zun, zvn, zwn )
-                       CALL prt_ctl( tab3d_1=ta, clinfo1=' adv5 - Ta: ', mask1=tmask,               &
-            &                        tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-                       CALL tra_adv_qck     ( kt, zun, zvn, zwn )
-                       CALL prt_ctl( tab3d_1=ta, clinfo1=' adv6 - Ta: ', mask1=tmask,               &
-            &                        tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+      CASE (-1 )                                      !==  esopa: test all possibility with control print  ==!
+         CALL tra_adv_cen2  ( kt, 'TRA',       zun, zvn, zwn, tsb, tsn, tsa, jpts )          
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv0 - Ta: ', mask1=tmask,               &
+            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+         CALL tra_adv_tvd   ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts )          
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv1 - Ta: ', mask1=tmask,               &
+            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+         CALL tra_adv_muscl ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb,      tsa, jpts )          
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv3 - Ta: ', mask1=tmask,               &
+            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+         CALL tra_adv_muscl2( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts )          
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv4 - Ta: ', mask1=tmask,               &
+            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+         CALL tra_adv_ubs   ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts )          
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv5 - Ta: ', mask1=tmask,               &
+            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+         CALL tra_adv_qck   ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts )          
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv6 - Ta: ', mask1=tmask,               &
+            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
       END SELECT
-       
-      CALL iom_put( "uoce_eff", zun )   ! effective i-current      
-      CALL iom_put( "voce_eff", zvn )   ! effective j-current
-      CALL iom_put( "woce_eff", zwn )   ! effective vert. current
-
+      !
       !                                              ! print mean trends (used for debugging)
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' adv  - Ta: ', mask1=tmask,               &
-         &                       tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv  - Ta: ', mask1=tmask,               &
+         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
       !
    END SUBROUTINE tra_adv
 
 
-   SUBROUTINE tra_adv_ctl
+   SUBROUTINE tra_adv_init
       !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_adv_ctl  ***
+      !!                  ***  ROUTINE tra_adv_init  ***
       !!                
       !! ** Purpose :   Control the consistency between namelist options for 
@@ -135,7 +136,7 @@
       !!----------------------------------------------------------------------
       INTEGER ::   ioptio
-
-      NAMELIST/namtra_adv/ ln_traadv_cen2 , ln_traadv_tvd,    &
-         &                 ln_traadv_muscl, ln_traadv_muscl2, &
+      !!
+      NAMELIST/namtra_adv/ ln_traadv_cen2 , ln_traadv_tvd,     &
+         &                 ln_traadv_muscl, ln_traadv_muscl2,  &
          &                 ln_traadv_ubs  , ln_traadv_qck
       !!----------------------------------------------------------------------
@@ -146,5 +147,5 @@
       IF(lwp) THEN                    ! Namelist print
          WRITE(numout,*)
-         WRITE(numout,*) 'tra_adv_ctl : choice/control of the tracer advection scheme'
+         WRITE(numout,*) 'tra_adv_init : choice/control of the tracer advection scheme'
          WRITE(numout,*) '~~~~~~~~~~~'
          WRITE(numout,*) '   Namelist namtra_adv : chose a advection scheme for tracers'
@@ -155,5 +156,5 @@
          WRITE(numout,*) '      UBS    advection scheme        ln_traadv_ubs    = ', ln_traadv_ubs
          WRITE(numout,*) '      QUICKEST advection scheme      ln_traadv_qck    = ', ln_traadv_qck
-    ENDIF
+      ENDIF
 
       ioptio = 0                      ! Parameter control
@@ -167,7 +168,4 @@
 
       IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE advection scheme in namelist namtra_adv' )
-
-      IF( n_cla == 1 .AND. .NOT. ln_traadv_cen2 )   &
-         &                CALL ctl_stop( 'cross-land advection only with 2nd order advection scheme' )
 
       !                              ! Set nadv
@@ -191,5 +189,5 @@
       ENDIF
       !
-   END SUBROUTINE tra_adv_ctl
+   END SUBROUTINE tra_adv_init
 
   !!======================================================================
Index: trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90	(revision 2528)
@@ -2,5 +2,5 @@
    !!======================================================================
    !!                     ***  MODULE  traadv_cen2  ***
-   !! Ocean active tracers:  horizontal & vertical advective trend
+   !! Ocean  tracers:  horizontal & vertical advective trend
    !!======================================================================
    !! History :  8.2  ! 2001-08  (G. Madec, E. Durand)  trahad+trazad=traadv 
@@ -11,31 +11,24 @@
    !!             -   ! 2006-07  (G. madec)  add ups_orca_set routine
    !!            3.2  ! 2009-07  (G. Madec) add avmb, avtb in restart for cen2 advection
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   tra_adv_cen2 : update the tracer trend with the horizontal and
-   !!                  vertical advection trends using a seconder order
-   !!   ups_orca_set : allow mixed upstream/centered scheme in specific
-   !!                  area (set for orca 2 and 4 only)
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and active tracers
+   !!            3.3  ! 2010-05  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_adv_cen2 : update the tracer trend with the advection trends using a 2nd order centered scheme
+   !!   ups_orca_set : allow mixed upstream/centered scheme in specific area (set for orca 2 and 4 only)
+   !!----------------------------------------------------------------------
+   USE oce, ONLY: tsn  ! now ocean temperature and salinity
    USE dom_oce         ! ocean space and time domain
-   USE sbc_oce         ! surface boundary condition: ocean
-   USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient
-   USE trdmod_oce      ! ocean variables trends
    USE eosbn2          ! equation of state
-   USE trdmod          ! ocean active tracers trends 
+   USE trdmod_oce      ! tracers trends
+   USE trdtra          ! tracers trends
    USE closea          ! closed sea
-   USE trabbl          ! advective term in the BBL
-   USE sbcmod          ! surface Boundary Condition
    USE sbcrnf          ! river runoffs
    USE in_out_manager  ! I/O manager
    USE iom             ! IOM library
-   USE lib_mpp
-   USE lbclnk          ! ocean lateral boundary condition (or mpp link)
    USE diaptr          ! poleward transport diagnostics
-   USE prtctl          ! Print control
    USE zdf_oce         ! ocean vertical physics
    USE restart         ! ocean restart
+   USE trc_oce         ! share passive tracers/Ocean variables
 
    IMPLICIT NONE
@@ -45,21 +38,20 @@
    PUBLIC   ups_orca_set    ! routine used by traadv_cen2_jki.F90
 
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   upsmsk    !: mixed upstream/centered scheme near some straits 
+   LOGICAL  :: l_trd       ! flag to compute trends
+
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: upsmsk    !: mixed upstream/centered scheme near some straits 
    !                                                   !  and in closed seas (orca 2 and 4 configurations)
-
-   REAL(wp), DIMENSION(jpi,jpj) ::   btr2   ! inverse of T-point surface [1/(e1t*e2t)]
-
    !! * Substitutions
 #  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
-   SUBROUTINE tra_adv_cen2( kt, pun, pvn, pwn )
+   SUBROUTINE tra_adv_cen2( kt, cdtype, pun, pvn, pwn,        &
+      &                                 ptb, ptn, pta, kjpt   ) 
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_adv_cen2  ***
@@ -77,9 +69,9 @@
       !!         Part I : horizontal advection
       !!       * centered flux:
-      !!               zcenu = e2u*e3u  un  mi(tn)
-      !!               zcenv = e1v*e3v  vn  mj(tn)
+      !!               zcenu = e2u*e3u  un  mi(ptn)
+      !!               zcenv = e1v*e3v  vn  mj(ptn)
       !!       * upstream flux:
-      !!               zupsu = e2u*e3u  un  (tb(i) or tb(i-1) ) [un>0 or <0]
-      !!               zupsv = e1v*e3v  vn  (tb(j) or tb(j-1) ) [vn>0 or <0]
+      !!               zupsu = e2u*e3u  un  (ptb(i) or ptb(i-1) ) [un>0 or <0]
+      !!               zupsv = e1v*e3v  vn  (ptb(j) or ptb(j-1) ) [vn>0 or <0]
       !!       * mixed upstream / centered horizontal advection scheme
       !!               zcofi = max(zind(i+1), zind(i))
@@ -88,67 +80,61 @@
       !!               zwy = zcofj * zupsv + (1-zcofj) * zcenv
       !!       * horizontal advective trend (divergence of the fluxes)
-      !!               zta = 1/(e1t*e2t*e3t) { di-1[zwx] + dj-1[zwy] }
+      !!               ztra = 1/(e1t*e2t*e3t) { di-1[zwx] + dj-1[zwy] }
       !!       * Add this trend now to the general trend of tracer (ta,sa):
-      !!              (ta,sa) = (ta,sa) + ( zta , zsa )
+      !!               pta = pta + ztra
       !!       * trend diagnostic ('key_trdtra' defined): the trend is
       !!      saved for diagnostics. The trends saved is expressed as
       !!      Uh.gradh(T), i.e.
-      !!                     save trend = zta + tn divn
-      !!         In addition, the advective trend in the two horizontal direc-
-      !!      tion is also re-computed as Uh gradh(T). Indeed hadt+tn divn is
-      !!      equal to (in s-coordinates, and similarly in z-coord.):
-      !!         zta+tn*divn=1/(e1t*e2t*e3t) { mi-1( e2u*e3u  un  di[tn] )
-      !!                                      +mj-1( e1v*e3v  vn  mj[tn] )  }
-      !!         NB:in z-coordinate - full step (ln_zco=T) e3u=e3v=e3t, so
-      !!      they vanish from the expression of the flux and divergence.
+      !!                     save trend = ztra + ptn divn
       !!
       !!         Part II : vertical advection
       !!      For temperature (idem for salinity) the advective trend is com-
       !!      puted as follows :
-      !!            zta = 1/e3t dk+1[ zwz ]
+      !!            ztra = 1/e3t dk+1[ zwz ]
       !!      where the vertical advective flux, zwz, is given by :
       !!            zwz = zcofk * zupst + (1-zcofk) * zcent
       !!      with
-      !!        zupsv = upstream flux = wn * (tb(k) or tb(k-1) ) [wn>0 or <0]
+      !!        zupsv = upstream flux = wn * (ptb(k) or ptb(k-1) ) [wn>0 or <0]
       !!        zcenu = centered flux = wn * mk(tn)
       !!         The surface boundary condition is :
       !!      variable volume (lk_vvl = T) : zero advective flux
-      !!      lin. free-surf  (lk_vvl = F) : wn(:,:,1) * tn(:,:,1)
+      !!      lin. free-surf  (lk_vvl = F) : wn(:,:,1) * ptn(:,:,1)
       !!         Add this trend now to the general trend of tracer (ta,sa):
-      !!            (ta,sa) = (ta,sa) + ( zta , zsa )
+      !!             pta = pta + ztra
       !!         Trend diagnostic ('key_trdtra' defined): the trend is
       !!      saved for diagnostics. The trends saved is expressed as :
-      !!             save trend =  w.gradz(T) = zta - tn divn.
-      !!
-      !! ** Action :  - update (ta,sa) with the now advective tracer trends
-      !!              - save trends in (ztrdt,ztrds) ('key_trdtra')
-      !!----------------------------------------------------------------------
-      USE oce, ONLY :   zwx => ua   ! use ua as workspace
-      USE oce, ONLY :   zwy => va   ! use va as workspace
-      !!
-      INTEGER , INTENT(in)                         ::   kt    ! ocean time-step index
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pun   ! ocean velocity u-component
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pvn   ! ocean velocity v-component
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pwn   ! ocean velocity w-component
-      !!
-      INTEGER  ::   ji, jj, jk                       ! dummy loop indices
-      REAL(wp) ::   zbtr, zhw, ze3tr                 ! temporary scalars
-      REAL(wp) ::   zfp_ui, zfp_vj, zfp_w , zfui     !    -         -
-      REAL(wp) ::   zfm_ui, zfm_vj, zfm_w , zfvj     !    -         -
+      !!             save trend =  w.gradz(T) = ztra - ptn divn.
+      !!
+      !! ** Action :  - update pta  with the now advective tracer trends
+      !!              - save trends if needed
+      !!----------------------------------------------------------------------
+      USE oce         , zwx => ua   ! use ua as workspace
+      USE oce         , zwy => va   ! use va as workspace
+      !!
+      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+      !!
+      INTEGER  ::   ji, jj, jk, jn                   ! dummy loop indices
+      REAL(wp) ::   zbtr, ztra                       ! temporary scalars
+      REAL(wp) ::   zfp_ui, zfp_vj, zfp_w            !    -         -
+      REAL(wp) ::   zfm_ui, zfm_vj, zfm_w            !    -         -
       REAL(wp) ::   zcofi , zcofj , zcofk            !    -         -
-      REAL(wp) ::   zupsut, zupsus, zcenut, zcenus   !    -         -
-      REAL(wp) ::   zupsvt, zupsvs, zcenvt, zcenvs   !    -         -
-      REAL(wp) ::   zupst , zupss , zcent , zcens    !    -         -
-      REAL(wp) ::   z_hdivn_x, z_hdivn_y, z_hdivn    !    -         -
+      REAL(wp) ::   zupsut, zcenut                   !    -         -
+      REAL(wp) ::   zupsvt, zcenvt                   !    -         -
+      REAL(wp) ::   zupst , zcent                    !    -         -
       REAL(wp) ::   zice                             !    -         -
       REAL(wp), DIMENSION(jpi,jpj)     ::   ztfreez            ! 2D workspace
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwz, ztrdt, zind   ! 3D workspace
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zww, ztrds         !  "      "
-      !!----------------------------------------------------------------------
-
-      IF( kt == nit000 ) THEN
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwz, zind   ! 3D workspace 
+      !!----------------------------------------------------------------------
+
+
+      IF( kt == nit000 )  THEN
          IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_adv_cen2 : 2nd order centered advection scheme'
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~   Vector optimization case'
+         IF(lwp) WRITE(numout,*) 'tra_adv_cen2 : 2nd order centered advection scheme on ', cdtype
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~ '
          IF(lwp) WRITE(numout,*)
          !
@@ -157,7 +143,4 @@
          IF( cp_cfg == "orca" )   CALL ups_orca_set      ! set mixed Upstream/centered scheme near some straits
          !                                               ! and in closed seas (orca2 and orca4 only)
-         !   
-         btr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) )        ! inverse of T-point surface
-         !
          IF( jp_cfg == 2 .AND. .NOT. ln_rstart ) THEN    ! Increase the background in the surface layers
             avmb(1) = 10.  * avmb(1)      ;      avtb(1) = 10.  * avtb(1)
@@ -166,17 +149,20 @@
             avmb(4) =  2.5 * avmb(4)      ;      avtb(4) =  2.5 * avtb(4)
          ENDIF
+         !
+         l_trd = .FALSE.
+         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.
       ENDIF
-
+      !
       ! Upstream / centered scheme indicator
       ! ------------------------------------
 !!gm  not strickly exact : the freezing point should be computed at each ocean levels...
 !!gm  not a big deal since cen2 is no more used in global ice-ocean simulations
-      ztfreez(:,:) = tfreez( sn(:,:,1) )
+      ztfreez(:,:) = tfreez( tsn(:,:,1,jp_sal) )
       DO jk = 1, jpk
          DO jj = 1, jpj
             DO ji = 1, jpi
                !                                        ! below ice covered area (if tn < "freezing"+0.1 )
-               IF( tn(ji,jj,jk) <= ztfreez(ji,jj) + 0.1 ) THEN   ;   zice = 1.e0
-               ELSE                                              ;   zice = 0.e0
+               IF( tsn(ji,jj,jk,jp_tem) <= ztfreez(ji,jj) + 0.1 ) THEN   ;   zice = 1.e0
+               ELSE                                                      ;   zice = 0.e0
                ENDIF
                zind(ji,jj,jk) = MAX (   &
@@ -189,167 +175,98 @@
       END DO
 
-      ! I. Horizontal advection
-      !    ====================
-      !
-      DO jk = 1, jpkm1
-         !                        ! Second order centered tracer flux at u- and v-points
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               ! upstream indicator
-               zcofi = MAX( zind(ji+1,jj,jk), zind(ji,jj,jk) )
-               zcofj = MAX( zind(ji,jj+1,jk), zind(ji,jj,jk) )
-               ! volume fluxes * 1/2
-               zfui = 0.5 * e2u(ji,jj) * fse3u(ji,jj,jk) * pun(ji,jj,jk)
-               zfvj = 0.5 * e1v(ji,jj) * fse3v(ji,jj,jk) * pvn(ji,jj,jk)
+      DO jn = 1, kjpt
+         !
+         ! I. Horizontal advection
+         !    ====================
+         !
+         DO jk = 1, jpkm1
+            !                        ! Second order centered tracer flux at u- and v-points
+            DO jj = 1, jpjm1
                !
-               ! upstream scheme
-               zfp_ui = zfui + ABS( zfui )
-               zfp_vj = zfvj + ABS( zfvj )
-               zfm_ui = zfui - ABS( zfui )
-               zfm_vj = zfvj - ABS( zfvj )
-               zupsut = zfp_ui * tb(ji,jj,jk) + zfm_ui * tb(ji+1,jj  ,jk)
-               zupsvt = zfp_vj * tb(ji,jj,jk) + zfm_vj * tb(ji  ,jj+1,jk)
-               zupsus = zfp_ui * sb(ji,jj,jk) + zfm_ui * sb(ji+1,jj  ,jk)
-               zupsvs = zfp_vj * sb(ji,jj,jk) + zfm_vj * sb(ji  ,jj+1,jk)
-               ! centered scheme
-               zcenut = zfui * ( tn(ji,jj,jk) + tn(ji+1,jj  ,jk) )
-               zcenvt = zfvj * ( tn(ji,jj,jk) + tn(ji  ,jj+1,jk) )
-               zcenus = zfui * ( sn(ji,jj,jk) + sn(ji+1,jj  ,jk) )
-               zcenvs = zfvj * ( sn(ji,jj,jk) + sn(ji  ,jj+1,jk) )
-               ! mixed centered / upstream scheme
-               zwx(ji,jj,jk) = zcofi * zupsut + (1.-zcofi) * zcenut
-               zwy(ji,jj,jk) = zcofj * zupsvt + (1.-zcofj) * zcenvt
-               zww(ji,jj,jk) = zcofi * zupsus + (1.-zcofi) * zcenus
-               zwz(ji,jj,jk) = zcofj * zupsvs + (1.-zcofj) * zcenvs
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  ! upstream indicator
+                  zcofi = MAX( zind(ji+1,jj,jk), zind(ji,jj,jk) )
+                  zcofj = MAX( zind(ji,jj+1,jk), zind(ji,jj,jk) )
+                  !
+                  ! upstream scheme
+                  zfp_ui = pun(ji,jj,jk) + ABS( pun(ji,jj,jk) )
+                  zfm_ui = pun(ji,jj,jk) - ABS( pun(ji,jj,jk) )
+                  zfp_vj = pvn(ji,jj,jk) + ABS( pvn(ji,jj,jk) )
+                  zfm_vj = pvn(ji,jj,jk) - ABS( pvn(ji,jj,jk) )
+                  zupsut = zfp_ui * ptb(ji,jj,jk,jn) + zfm_ui * ptb(ji+1,jj  ,jk,jn)
+                  zupsvt = zfp_vj * ptb(ji,jj,jk,jn) + zfm_vj * ptb(ji  ,jj+1,jk,jn)
+                  ! centered scheme
+                  zcenut = pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj  ,jk,jn) )
+                  zcenvt = pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji  ,jj+1,jk,jn) )
+                  ! mixed centered / upstream scheme
+                  zwx(ji,jj,jk) = 0.5 * ( zcofi * zupsut + (1.-zcofi) * zcenut )
+                  zwy(ji,jj,jk) = 0.5 * ( zcofj * zupsvt + (1.-zcofj) * zcenvt )
+               END DO
             END DO
          END DO
-         !                        ! Tracer flux divergence at t-point added to the general trend
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zbtr = btr2(ji,jj) / fse3t(ji,jj,jk)
-               !
-               ta(ji,jj,jk) = ta(ji,jj,jk) - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk)  &
-                  &                                  + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk)  )
-               sa(ji,jj,jk) = sa(ji,jj,jk) - zbtr * (  zww(ji,jj,jk) - zww(ji-1,jj  ,jk)  &
-                  &                                  + zwz(ji,jj,jk) - zwz(ji  ,jj-1,jk)  )
+
+         ! II. Vertical advection
+         !     ==================
+         !
+         !                                                ! Vertical advective fluxes
+         zwz(:,:,jpk) = 0.e0                                   ! Bottom  value : flux set to zero
+         !                                                     ! Surface value : 
+         IF( lk_vvl ) THEN   ;   zwz(:,:, 1 ) = 0.e0                         ! volume variable
+         ELSE                ;   zwz(:,:, 1 ) = pwn(:,:,1) * ptn(:,:,1,jn)   ! linear free surface 
+         ENDIF
+         !
+         DO jk = 2, jpk              ! Second order centered tracer flux at w-point
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ! upstream indicator
+                  zcofk = MAX( zind(ji,jj,jk-1), zind(ji,jj,jk) ) 
+                  ! mixed centered / upstream scheme
+                  zfp_w = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) )
+                  zfm_w = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) )
+                  zupst = zfp_w * ptb(ji,jj,jk,jn) + zfm_w * ptb(ji,jj,jk-1,jn)
+                  ! centered scheme
+                  zcent = pwn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) )
+                  ! mixed centered / upstream scheme
+                  zwz(ji,jj,jk) = 0.5 * ( zcofk * zupst + (1.-zcofk) * zcent )
+               END DO
             END DO
          END DO
-      END DO
-
-
-      IF( l_trdtra ) THEN      ! Save the i- and j-advective trends for diagnostic (U.gradz(T) trends)
-         !
+
+         ! II. Divergence of advective fluxes
+         ! ----------------------------------
          DO jk = 1, jpkm1
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  !-- Compute zonal divergence by splitting hdivn (see divcur.F90)
-                  !   N.B. This computation is not valid with OBC, BDY, cla, eiv, advective bbl 
-                  zbtr      = btr2(ji,jj) / fse3t(ji,jj,jk)
-                  z_hdivn_x = (  e2u(ji  ,jj) * fse3u(ji  ,jj,jk) * pun(ji  ,jj,jk)          &
-                     &         - e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * pun(ji-1,jj,jk) ) * zbtr
-                  !
-                  ztrdt(ji,jj,jk) = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj,jk) ) + tn(ji,jj,jk) * z_hdivn_x
-                  ztrds(ji,jj,jk) = - zbtr * ( zww(ji,jj,jk) - zww(ji-1,jj,jk) ) + sn(ji,jj,jk) * z_hdivn_x
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) *  fse3t(ji,jj,jk) )
+                  ! advective trends
+                  ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
+                  &                + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   &
+                  &                + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1)  )
+                  ! advective trends added to the general tracer trends
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
                END DO
             END DO
          END DO
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_xad, 'TRA', kt)
-         !
-         DO jk = 1, jpkm1           ! T/S MERIDIONAL advection trends
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr      = btr2(ji,jj) / fse3t(ji,jj,jk)
-                  z_hdivn_y = (  e1v(ji,  jj) * fse3v(ji,jj  ,jk) * pvn(ji,jj  ,jk)          &
-                     &         - e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * pvn(ji,jj-1,jk) ) * zbtr
-                  !
-                  ztrdt(ji,jj,jk) = - zbtr * ( zwy(ji,jj,jk) - zwy(ji,jj-1,jk) ) + tn(ji,jj,jk) * z_hdivn_y          
-                  ztrds(ji,jj,jk) = - zbtr * ( zwz(ji,jj,jk) - zwz(ji,jj-1,jk) ) + sn(ji,jj,jk) * z_hdivn_y
-               END DO
-            END DO
-         END DO
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_yad, 'TRA', kt)
-         !
-         ztrdt(:,:,:) = ta(:,:,:)   ;   ztrds(:,:,:) = sa(:,:,:)       ! Save the horizontal up-to-date ta/sa trends
-         !
-      ENDIF
-
-      IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN      ! "zonal" mean advective heat and salt transport 
-         pht_adv(:) = ptr_vj( zwy(:,:,:) )
-         pst_adv(:) = ptr_vj( zwz(:,:,:) )
-      ENDIF
-
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' cen2 had  - Ta: ', mask1=tmask, &
-         &                       tab3d_2=sa, clinfo2=            ' Sa: ', mask2=tmask, clinfo3='tra' )
-
-
-      ! II. Vertical advection
-      !     ==================
-      !
-      zwx(:,:,jpk) = 0.e0     ;    zwy(:,:,jpk) = 0.e0      ! Bottom value  : flux set to zero
-      !
-      IF( lk_vvl ) THEN                                     ! Surface value : zero in variable volume
-         zwx(:,:, 1 ) = 0.e0    ;    zwy(:,:, 1 ) = 0.e0
-      ELSE                                                  !               : linear free surface case
-         zwx(:,:, 1 ) = pwn(:,:,1) * tn(:,:,1)
-         zwy(:,:, 1 ) = pwn(:,:,1) * sn(:,:,1)
-      ENDIF
-      !
-      DO jk = 2, jpk              ! Second order centered tracer flux at w-point
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zcofk = MAX( zind(ji,jj,jk-1), zind(ji,jj,jk) )      ! upstream indicator
-               zhw = 0.5 * pwn(ji,jj,jk)                            ! velocity * 1/2
-               !
-               zfp_w = zhw + ABS( zhw )                             ! upstream scheme
-               zfm_w = zhw - ABS( zhw )
-               zupst = zfp_w * tb(ji,jj,jk) + zfm_w * tb(ji,jj,jk-1)
-               zupss = zfp_w * sb(ji,jj,jk) + zfm_w * sb(ji,jj,jk-1)
-               !
-               zcent = zhw * ( tn(ji,jj,jk) + tn(ji,jj,jk-1) )      ! centered scheme
-               zcens = zhw * ( sn(ji,jj,jk) + sn(ji,jj,jk-1) )
-               !
-               zwx(ji,jj,jk) = zcofk * zupst + (1.-zcofk) * zcent   ! mixed centered / upstream scheme
-               zwy(ji,jj,jk) = zcofk * zupss + (1.-zcofk) * zcens
-            END DO
-         END DO
-      END DO
-      !
-      DO jk = 1, jpkm1            ! divergence of Tracer flux added to the general trend
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ze3tr = 1. / fse3t(ji,jj,jk)
-               ta(ji,jj,jk) =  ta(ji,jj,jk) - ze3tr * ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) )
-               sa(ji,jj,jk) =  sa(ji,jj,jk) - ze3tr * ( zwy(ji,jj,jk) - zwy(ji,jj,jk+1) )
-            END DO
-         END DO
-      END DO
-
-      IF( l_trdtra ) THEN      ! Save the vertical advective trends for diagnostic (W gradz(T) trends)
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr      = btr2(ji,jj) / fse3t(ji,jj,jk)
-                  z_hdivn_x = e2u(ji,jj)*fse3u(ji,jj,jk)*pun(ji,jj,jk) - e2u(ji-1,jj)*fse3u(ji-1,jj,jk)*pun(ji-1,jj,jk)
-                  z_hdivn_y = e1v(ji,jj)*fse3v(ji,jj,jk)*pvn(ji,jj,jk) - e1v(ji,jj-1)*fse3v(ji,jj-1,jk)*pvn(ji,jj-1,jk)
-                  !
-                  z_hdivn   = (z_hdivn_x + z_hdivn_y) * zbtr
-                  ztrdt(ji,jj,jk) = ta(ji,jj,jk) - ztrdt(ji,jj,jk) - tn(ji,jj,jk) * z_hdivn 
-                  ztrds(ji,jj,jk) = sa(ji,jj,jk) - ztrds(ji,jj,jk) - sn(ji,jj,jk) * z_hdivn
-               END DO
-            END DO
-         END DO
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_zad, 'TRA', kt)
-      ENDIF
-
-      ! write avmb, avtb in restart (traadv_cen2 requires a modified avmb, avtb that are
+
+         !                                 ! trend diagnostics (contribution of upstream fluxes)
+         IF( l_trd ) THEN
+            CALL trd_tra( kt, cdtype, jn, jptra_trd_xad, zwx, pun, ptn(:,:,:,jn) )
+            CALL trd_tra( kt, cdtype, jn, jptra_trd_yad, zwy, pvn, ptn(:,:,:,jn) )
+            CALL trd_tra( kt, cdtype, jn, jptra_trd_zad, zwz, pwn, ptn(:,:,:,jn) )
+         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(:,:,:) )
+         ENDIF
+         !
+      ENDDO
+
       ! ---------------------------  required in restart file to ensure restartability)
       ! avmb, avtb will be read in zdfini in restart case as they are used in zdftke, kpp etc...
-      IF( lrst_oce ) THEN
+      IF( lrst_oce .AND. cdtype == 'TRA' ) THEN
          CALL iom_rstput( kt, nitrst, numrow, 'avmb', avmb )
          CALL iom_rstput( kt, nitrst, numrow, 'avtb', avtb )
       ENDIF
-
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' cen2 zad  - Ta: ', mask1=tmask, &
-         &                       tab3d_2=sa, clinfo2=            ' Sa: ', mask2=tmask, clinfo3='tra' )
       !
    END SUBROUTINE tra_adv_cen2
Index: trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90	(revision 2528)
@@ -2,12 +2,12 @@
    !!======================================================================
    !!                    ***  MODULE  traadv_eiv  ***
-   !! Ocean active tracers:  advection trend - eddy induced velocity
+   !! Ocean tracers:  advection trend - eddy induced velocity
    !!======================================================================
-   !! History :  9.0  !  05-11  (G. Madec)  Original code, from traldf and zdf _iso
+   !! History :  1.0  !  2005-11 (G. Madec)  Original code, from traldf and zdf _iso
+   !!            3.3  !  2010-05 (C. Ethe, G. Madec)  merge TRC-TRA 
    !!----------------------------------------------------------------------
 #if defined key_traldf_eiv   ||   defined key_esopa
    !!----------------------------------------------------------------------
    !!   'key_traldf_eiv'                  rotation of the lateral mixing tensor
-   !!----------------------------------------------------------------------
    !!----------------------------------------------------------------------
    !!   tra_ldf_iso : update the tracer trend with the horizontal component
@@ -21,4 +21,5 @@
    USE in_out_manager  ! I/O manager
    USE iom
+   USE trc_oce         ! share passive tracers/Ocean variables
 # if defined key_diaeiv
    USE phycst          ! physical constants
@@ -38,12 +39,12 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2006) 
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
 CONTAINS
 
-   SUBROUTINE tra_adv_eiv( kt, pun, pvn, pwn )
+   SUBROUTINE tra_adv_eiv( kt, pun, pvn, pwn, cdtype )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_adv_eiv  ***
@@ -63,30 +64,36 @@
       !! ** Action  : - add to p.n the eiv component
       !!----------------------------------------------------------------------
-      INTEGER , INTENT(in   )                         ::   kt    ! ocean time-step index
-      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pun   ! in : 3 ocean velocity components 
-      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pvn   ! out: 3 ocean velocity components
-      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pwn   !      increased by the eiv
+      INTEGER                         , INTENT(in   ) ::   kt       ! ocean time-step index
+      CHARACTER(len=3)                , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator)
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pun      ! in : 3 ocean velocity components 
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pvn      ! out: 3 ocean velocity components
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pwn      ! increased by the eiv
       !!
       INTEGER  ::   ji, jj, jk                 ! dummy loop indices
-      REAL(wp) ::   zuwk, zuwk1, zuwi, zuwi1   ! temporary scalar
-      REAL(wp) ::   zvwk, zvwk1, zvwj, zvwj1   !    "         "
-      REAL(wp) ::   zu_eiv, zv_eiv, zw_eiv     !    "         "
-# if defined key_diaeiv
-      REAL(wp) ::   zztmp                      !    "         "
-      REAL(wp), DIMENSION(jpi,jpj) ::   z2d    !    "         "
+      REAL(wp) ::   zuwk, zuwk1, zuwi, zuwi1   ! local scalars
+      REAL(wp) ::   zvwk, zvwk1, zvwj, zvwj1   !   -      -
+      REAL(wp), DIMENSION(jpi,jpj) ::   zu_eiv, zv_eiv, zw_eiv     ! 2D workspace
+# if defined key_diaeiv 
+      REAL(wp) ::   zztmp                      ! local scalar
+      REAL(wp), DIMENSION(jpi,jpj) ::   z2d    ! 2D workspace
 # endif  
       !!----------------------------------------------------------------------
 
-      IF( kt == nit000 ) THEN
+      IF( kt == nit000 )  THEN
          IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_adv_eiv : eddy induced advection :'
+         IF(lwp) WRITE(numout,*) 'tra_adv_eiv : eddy induced advection on ', cdtype,' :'
          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   add to velocity fields the eiv component'
-# if defined key_diaeiv
-         u_eiv(:,:,:) = 0.e0
-         v_eiv(:,:,:) = 0.e0
-         w_eiv(:,:,:) = 0.e0
+# if defined key_diaeiv 
+         IF( cdtype == 'TRA') THEN
+            u_eiv(:,:,:) = 0.e0
+            v_eiv(:,:,:) = 0.e0
+            w_eiv(:,:,:) = 0.e0
+         END IF
 # endif
       ENDIF
-      !                                             ! =================
+
+      zu_eiv(:,:) = 0.e0   ;   zv_eiv(:,:) = 0.e0   ;    zw_eiv(:,:) = 0.e0  
+      
+                                                    ! =================
       DO jk = 1, jpkm1                              !  Horizontal slab
          !                                          ! =================
@@ -98,15 +105,17 @@
                zvwk1= ( wslpj(ji,jj,jk+1) + wslpj(ji,jj+1,jk+1) ) * fsaeiv(ji,jj,jk+1) * vmask(ji,jj,jk+1)
 
-               zu_eiv = 0.5 * umask(ji,jj,jk) * ( zuwk - zuwk1 ) / fse3u(ji,jj,jk)
-               zv_eiv = 0.5 * vmask(ji,jj,jk) * ( zvwk - zvwk1 ) / fse3v(ji,jj,jk)
+               zu_eiv(ji,jj) = 0.5 * umask(ji,jj,jk) * ( zuwk - zuwk1 ) 
+               zv_eiv(ji,jj) = 0.5 * vmask(ji,jj,jk) * ( zvwk - zvwk1 ) 
    
-               pun(ji,jj,jk) = pun(ji,jj,jk) + zu_eiv
-               pvn(ji,jj,jk) = pvn(ji,jj,jk) + zv_eiv
-# if defined key_diaeiv
-               u_eiv(ji,jj,jk) = zu_eiv
-               v_eiv(ji,jj,jk) = zv_eiv
-# endif
+               pun(ji,jj,jk) = pun(ji,jj,jk) + e2u(ji,jj) * zu_eiv(ji,jj)
+               pvn(ji,jj,jk) = pvn(ji,jj,jk) + e1v(ji,jj) * zv_eiv(ji,jj)
             END DO
          END DO
+# if defined key_diaeiv 
+         IF( cdtype == 'TRA') THEN
+            u_eiv(:,:,jk) = zu_eiv(:,:) / fse3u(:,:,jk)
+            v_eiv(:,:,jk) = zv_eiv(:,:) / fse3v(:,:,jk)
+         END IF
+# endif
          IF( jk >=2 ) THEN                             ! jk=1 zw_eiv=0, not computed
             DO jj = 2, jpjm1
@@ -118,5 +127,5 @@
                   zvwj1 = ( wslpj(ji,jj,jk)+wslpj(ji,jj+1,jk) ) * fsaeiv(ji,jj  ,jk) * e1v(ji  ,jj) * vmask(ji  ,jj,jk)
   
-                  zw_eiv = - 0.5 * tmask(ji,jj,jk) * ( zuwi1 - zuwi + zvwj1 - zvwj ) / ( e1t(ji,jj)*e2t(ji,jj) )
+                  zw_eiv(ji,jj) = - 0.5 * tmask(ji,jj,jk) * ( zuwi1 - zuwi + zvwj1 - zvwj ) 
 # else
                   zuwi  = ( wslpi(ji,jj,jk) + wslpi(ji-1,jj,jk) ) * e2u(ji-1,jj) * umask(ji-1,jj,jk)
@@ -125,14 +134,12 @@
                   zvwj1 = ( wslpj(ji,jj,jk) + wslpj(ji,jj+1,jk) ) * e1v(ji  ,jj) * vmask(ji  ,jj,jk)
 
-                  zw_eiv = - 0.5 * tmask(ji,jj,jk) * fsaeiw(ji,jj,jk) * ( zuwi1 - zuwi + zvwj1 - zvwj )  &
-                     &                                                / ( e1t(ji,jj)*e2t(ji,jj) )
+                  zw_eiv(ji,jj) = - 0.5 * tmask(ji,jj,jk) * fsaeiw(ji,jj,jk) * ( zuwi1 - zuwi + zvwj1 - zvwj )
 # endif
-                  pwn(ji,jj,jk) = pwn(ji,jj,jk) + zw_eiv
-
-# if defined key_diaeiv
-                  w_eiv(ji,jj,jk) = zw_eiv
-# endif
+                  pwn(ji,jj,jk) = pwn(ji,jj,jk) + zw_eiv(ji,jj)
                END DO
             END DO
+# if defined key_diaeiv 
+            IF( cdtype == 'TRA')  w_eiv(:,:,jk) = zw_eiv(:,:) / ( e1t(:,:) * e2t(:,:) )
+# endif
          ENDIF
          !                                          ! =================
@@ -140,31 +147,35 @@
       !                                             ! =================
 
-# if defined key_diaeiv
-      CALL iom_put( "uoce_eiv", u_eiv )    ! i-eiv current
-      CALL iom_put( "voce_eiv", v_eiv )    ! j-eiv current
-      CALL iom_put( "woce_eiv", w_eiv )    ! vert. eiv current
-      IF( lk_diaar5 ) THEN
-         zztmp = 0.5 * rau0 * rcp 
-         z2d(:,:) = 0.e0 
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  z2d(ji,jj) = z2d(ji,jj) + zztmp * u_eiv(ji,jj,jk) * (tn(ji,jj,jk)+tn(ji+1,jj,jk)) * e1u(ji,jj) * fse3u(ji,jj,jk) 
+# if defined key_diaeiv 
+      IF( cdtype == 'TRA') THEN
+         CALL iom_put( "uoce_eiv", u_eiv )    ! i-eiv current
+         CALL iom_put( "voce_eiv", v_eiv )    ! j-eiv current
+         CALL iom_put( "woce_eiv", w_eiv )    ! vert. eiv current
+         IF( lk_diaar5 ) THEN
+            zztmp = 0.5 * rau0 * rcp 
+            z2d(:,:) = 0.e0 
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     z2d(ji,jj) = z2d(ji,jj) + zztmp * u_eiv(ji,jj,jk) &
+                       &         * (tsn(ji,jj,jk,jp_tem)+tsn(ji+1,jj,jk,jp_tem)) * e1u(ji,jj) * fse3u(ji,jj,jk) 
+                  END DO
                END DO
             END DO
-         END DO
-         CALL lbc_lnk( z2d, 'U', -1. )
-         CALL iom_put( "ueiv_heattr", z2d )                  ! heat transport in i-direction
-         z2d(:,:) = 0.e0 
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  z2d(ji,jj) = z2d(ji,jj) + zztmp * v_eiv(ji,jj,jk) * (tn(ji,jj,jk)+tn(ji,jj+1,jk)) * e2v(ji,jj) * fse3v(ji,jj,jk) 
+            CALL lbc_lnk( z2d, 'U', -1. )
+            CALL iom_put( "ueiv_heattr", z2d )                  ! heat transport in i-direction
+            z2d(:,:) = 0.e0 
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     z2d(ji,jj) = z2d(ji,jj) + zztmp * v_eiv(ji,jj,jk) &
+                     &           * (tsn(ji,jj,jk,jp_tem)+tsn(ji,jj+1,jk,jp_tem)) * e2v(ji,jj) * fse3v(ji,jj,jk) 
+                  END DO
                END DO
             END DO
-         END DO
-         CALL lbc_lnk( z2d, 'V', -1. )
-         CALL iom_put( "veiv_heattr", z2d )                  !  heat transport in i-direction
-      ENDIF
+            CALL lbc_lnk( z2d, 'V', -1. )
+            CALL iom_put( "veiv_heattr", z2d )                  !  heat transport in i-direction
+         ENDIF
+    END IF
 # endif  
       ! 
@@ -176,7 +187,10 @@
    !!----------------------------------------------------------------------
 CONTAINS
-   SUBROUTINE tra_adv_eiv( kt, pun, pvn, pwn )              ! Empty routine
+   SUBROUTINE tra_adv_eiv( kt, pun, pvn, pwn, cdtype )              ! Empty routine
+      INTEGER  ::   kt    
+      CHARACTER(len=3) ::   cdtype
       REAL, DIMENSION(:,:,:) ::   pun, pvn, pwn
-      WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?', kt, 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
+      WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?', pun(1,1,1), pvn(1,1,1), pwn(1,1,1)
    END SUBROUTINE tra_adv_eiv
 #endif
Index: trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90	(revision 2528)
@@ -2,9 +2,10 @@
    !!======================================================================
    !!                       ***  MODULE  traadv_muscl  ***
-   !! Ocean active tracers:  horizontal & vertical advective trend
+   !! Ocean  tracers:  horizontal & vertical advective trend
    !!======================================================================
-   !! History :       !  06-00  (A.Estublier)  for passive tracers
-   !!                 !  01-08  (E.Durand, G.Madec)  adapted for T & S
-   !!            8.5  !  02-06  (G. Madec)  F90: Free form and module
+   !! History :       !  2000-06  (A.Estublier)  for passive tracers
+   !!                 !  2001-08  (E.Durand, G.Madec)  adapted for T & S
+   !!   NEMO     1.0  !  2002-06  (G. Madec)  F90: Free form and module
+   !!            3.2  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
    !!----------------------------------------------------------------------
 
@@ -15,6 +16,6 @@
    USE oce             ! ocean dynamics and active tracers
    USE dom_oce         ! ocean space and time domain
-   USE trdmod          ! ocean active tracers trends 
-   USE trdmod_oce      ! ocean variables trends
+   USE trdmod_oce      ! tracers trends 
+   USE trdtra      ! tracers trends 
    USE in_out_manager  ! I/O manager
    USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient
@@ -23,5 +24,6 @@
    USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
    USE diaptr          ! poleward transport diagnostics
-   USE prtctl          ! Print control
+   USE trc_oce         ! share passive tracers/Ocean variables
+
 
    IMPLICIT NONE
@@ -29,4 +31,6 @@
 
    PUBLIC   tra_adv_muscl  ! routine called by step.F90
+
+   LOGICAL  :: l_trd       ! flag to compute trends
 
    !! * Substitutions
@@ -34,12 +38,12 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2006) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
-   SUBROUTINE tra_adv_muscl( kt, pun, pvn, pwn )
+   SUBROUTINE tra_adv_muscl( kt, cdtype, p2dt, pun, pvn, pwn, &
+      &                                        ptb, pta, kjpt )
       !!----------------------------------------------------------------------
       !!                    ***  ROUTINE tra_adv_muscl  ***
@@ -52,370 +56,196 @@
       !!
       !! ** Action  : - update (ta,sa) with the now advective tracer trends
-      !!              - save trends in (ztrdt,ztrds) ('key_trdtra')
+      !!              - save trends 
       !!
       !! References : Estubier, A., and M. Levy, Notes Techn. Pole de Modelisation
       !!              IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa)
       !!----------------------------------------------------------------------
-      USE oce, ONLY :   ztrdt => ua   ! use ua as workspace
-      USE oce, ONLY :   ztrds => va   ! use va as workspace
-      !!
-      INTEGER , INTENT(in)                         ::   kt    ! ocean time-step index
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pun   ! ocean velocity u-component
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pvn   ! ocean velocity v-component
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pwn   ! ocean velocity w-component
-      !!
-      INTEGER ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp) ::   &
-         zu, zv, zw, zeu, zev,           &  
-         zew, zbtr, zstep,               &
-         z0u, z0v, z0w,                  &
-         zzt1, zzt2, zalpha,             &
-         zzs1, zzs2, z2,                 &
-         zta, zsa,                       &
-        z_hdivn_x, z_hdivn_y, z_hdivn
-      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zt1, zt2, ztp1, ztp2   ! 3D workspace
-      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zs1, zs2, zsp1, zsp2   !  "      "
+      USE oce         , zwx => ua   ! use ua as workspace
+      USE oce         , zwy => va   ! use va as workspace
+      !!
+      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
+      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb             ! before tracer field
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+      !!
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::   zu, z0u, zzwx    ! local scalar
+      REAL(wp) ::   zv, z0v, zzwy    !   -      -
+      REAL(wp) ::   zw, z0w          !   -      -
+      REAL(wp) ::   ztra, zbtr, zdt, zalpha
+      REAL(wp), DIMENSION (jpi,jpj,jpk) :: zslpx, zslpy   ! 3D workspace
       !!----------------------------------------------------------------------
 
-      IF( kt == nit000 .AND. lwp ) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'tra_adv : MUSCL advection scheme'
-         WRITE(numout,*) '~~~~~~~'
+      IF( kt == nit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_adv : MUSCL advection scheme on ', cdtype
+         IF(lwp) WRITE(numout,*) '~~~~~~~'
+         !
+         l_trd = .FALSE.
+         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.
       ENDIF
 
-      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;    z2 = 1.
-      ELSE                                        ;    z2 = 2.
-      ENDIF
-
-      ! I. Horizontal advective fluxes
-      ! ------------------------------
-      ! first guess of the slopes
-      ! interior values
-      DO jk = 1, jpkm1
-         DO jj = 1, jpjm1      
-            DO ji = 1, fs_jpim1   ! vector opt.
-               zt1(ji,jj,jk) = umask(ji,jj,jk) * ( tb(ji+1,jj,jk) - tb(ji,jj,jk) )
-               zs1(ji,jj,jk) = umask(ji,jj,jk) * ( sb(ji+1,jj,jk) - sb(ji,jj,jk) )
-               zt2(ji,jj,jk) = vmask(ji,jj,jk) * ( tb(ji,jj+1,jk) - tb(ji,jj,jk) )
-               zs2(ji,jj,jk) = vmask(ji,jj,jk) * ( sb(ji,jj+1,jk) - sb(ji,jj,jk) )
-            END DO
-         END DO
-      END DO
-      ! bottom values
-      zt1(:,:,jpk) = 0.e0    ;    zt2(:,:,jpk) = 0.e0
-      zs1(:,:,jpk) = 0.e0    ;    zs2(:,:,jpk) = 0.e0
-
-      ! lateral boundary conditions on zt1, zt2 ; zs1, zs2   (changed sign)
-      CALL lbc_lnk( zt1, 'U', -1. )   ;   CALL lbc_lnk( zs1, 'U', -1. )
-      CALL lbc_lnk( zt2, 'V', -1. )   ;   CALL lbc_lnk( zs2, 'V', -1. )
-
-      ! Slopes
-      ! interior values
-      DO jk = 1, jpkm1
-         DO jj = 2, jpj
-            DO ji = fs_2, jpi   ! vector opt.
-               ztp1(ji,jj,jk) =                    ( zt1(ji,jj,jk) + zt1(ji-1,jj  ,jk) )   &
-                  &           * ( 0.25 + SIGN( 0.25, zt1(ji,jj,jk) * zt1(ji-1,jj  ,jk) ) )
-               zsp1(ji,jj,jk) =                    ( zs1(ji,jj,jk) + zs1(ji-1,jj  ,jk) )   &
-                  &           * ( 0.25 + SIGN( 0.25, zs1(ji,jj,jk) * zs1(ji-1,jj  ,jk) ) )
-               ztp2(ji,jj,jk) =                    ( zt2(ji,jj,jk) + zt2(ji  ,jj-1,jk) )   &
-                  &           * ( 0.25 + SIGN( 0.25, zt2(ji,jj,jk) * zt2(ji  ,jj-1,jk) ) )
-               zsp2(ji,jj,jk) =                    ( zs2(ji,jj,jk) + zs2(ji  ,jj-1,jk) )   &
-                  &           * ( 0.25 + SIGN( 0.25, zs2(ji,jj,jk) * zs2(ji  ,jj-1,jk) ) )
-            END DO
-         END DO
-      END DO
-      ! bottom values
-      ztp1(:,:,jpk) = 0.e0    ;    ztp2(:,:,jpk) = 0.e0
-      zsp1(:,:,jpk) = 0.e0    ;    zsp2(:,:,jpk) = 0.e0
-
-      ! Slopes limitation
-      DO jk = 1, jpkm1
-         DO jj = 2, jpj
-            DO ji = fs_2, jpi   ! vector opt.
-               ztp1(ji,jj,jk) = SIGN( 1., ztp1(ji,jj,jk) )   &
-                  &           * MIN(    ABS( ztp1(ji  ,jj,jk) ),   &
-                  &                  2.*ABS( zt1 (ji-1,jj,jk) ),   &
-                  &                  2.*ABS( zt1 (ji  ,jj,jk) ) )
-               zsp1(ji,jj,jk) = SIGN( 1., zsp1(ji,jj,jk) )   &
-                  &           * MIN(    ABS( zsp1(ji  ,jj,jk) ),   &
-                  &                  2.*ABS( zs1 (ji-1,jj,jk) ),   &
-                  &                  2.*ABS( zs1 (ji  ,jj,jk) ) )
-               ztp2(ji,jj,jk) = SIGN( 1., ztp2(ji,jj,jk) )   &
-                  &           * MIN(    ABS( ztp2(ji,jj  ,jk) ),   &
-                  &                  2.*ABS( zt2 (ji,jj-1,jk) ),   &
-                  &                  2.*ABS( zt2 (ji,jj  ,jk) ) )
-               zsp2(ji,jj,jk) = SIGN( 1., zsp2(ji,jj,jk) )   &
-                  &           * MIN(    ABS( zsp2(ji,jj  ,jk) ),   &
-                  &                  2.*ABS( zs2 (ji,jj-1,jk) ),   &
-                  &                  2.*ABS( zs2 (ji,jj  ,jk) ) )
-            END DO
-         END DO
-      END DO        
-
-      ! Advection terms
-      ! interior values
-      DO jk = 1, jpkm1
-         zstep  = z2 * rdttra(jk)
-         DO jj = 2, jpjm1      
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ! volume fluxes
-#if defined key_zco
-               zeu = e2u(ji,jj)                   * pun(ji,jj,jk)
-               zev = e1v(ji,jj)                   * pvn(ji,jj,jk)
-#else
-               zeu = e2u(ji,jj) * fse3u(ji,jj,jk) * pun(ji,jj,jk)
-               zev = e1v(ji,jj) * fse3v(ji,jj,jk) * pvn(ji,jj,jk)
-#endif
-               ! MUSCL fluxes
-               z0u = SIGN( 0.5, pun(ji,jj,jk) )            
-               zalpha = 0.5 - z0u
-               zu  = z0u - 0.5 * pun(ji,jj,jk) * zstep / e1u(ji,jj)
-               zzt1 = tb(ji+1,jj,jk) + zu*ztp1(ji+1,jj,jk)
-               zzt2 = tb(ji  ,jj,jk) + zu*ztp1(ji  ,jj,jk)
-               zzs1 = sb(ji+1,jj,jk) + zu*zsp1(ji+1,jj,jk)
-               zzs2 = sb(ji  ,jj,jk) + zu*zsp1(ji  ,jj,jk)
-               zt1(ji,jj,jk) = zeu * ( zalpha * zzt1 + (1.-zalpha) * zzt2 )
-               zs1(ji,jj,jk) = zeu * ( zalpha * zzs1 + (1.-zalpha) * zzs2 )
-               !
-               z0v = SIGN( 0.5, pvn(ji,jj,jk) )            
-               zalpha = 0.5 - z0v
-               zv  = z0v - 0.5 * pvn(ji,jj,jk) * zstep / e2v(ji,jj)
-               zzt1 = tb(ji,jj+1,jk) + zv*ztp2(ji,jj+1,jk)
-               zzt2 = tb(ji,jj  ,jk) + zv*ztp2(ji,jj  ,jk)
-               zzs1 = sb(ji,jj+1,jk) + zv*zsp2(ji,jj+1,jk)
-               zzs2 = sb(ji,jj  ,jk) + zv*zsp2(ji,jj  ,jk)
-               zt2(ji,jj,jk) = zev * ( zalpha * zzt1 + (1.-zalpha) * zzt2 )
-               zs2(ji,jj,jk) = zev * ( zalpha * zzs1 + (1.-zalpha) * zzs2 )
-            END DO
-         END DO
-      END DO
-
-      ! lateral boundary conditions on zt1, zt2 ; zs1, zs2   (changed sign)
-      CALL lbc_lnk( zt1, 'U', -1. )   ;   CALL lbc_lnk( zs1, 'U', -1. ) 
-      CALL lbc_lnk( zt2, 'V', -1. )   ;   CALL lbc_lnk( zs2, 'V', -1. )
-
-      ! Tracer flux divergence at t-point added to the general trend
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1      
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-#if defined key_zco
-               zbtr = 1. / ( e1t(ji,jj)*e2t(ji,jj) )
-#else
-               zbtr = 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )
-#endif
-               ! horizontal advective trends
-               zta = - zbtr * ( zt1(ji,jj,jk) - zt1(ji-1,jj  ,jk  )   &
-                  &           + zt2(ji,jj,jk) - zt2(ji  ,jj-1,jk  ) )
-               zsa = - zbtr * ( zs1(ji,jj,jk) - zs1(ji-1,jj  ,jk  )   &
-                  &           + zs2(ji,jj,jk) - zs2(ji  ,jj-1,jk  ) ) 
-               ! add it to the general tracer trends
-               ta(ji,jj,jk) = ta(ji,jj,jk) + zta
-               sa(ji,jj,jk) = sa(ji,jj,jk) + zsa
-            END DO
-        END DO
-      END DO        
-
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' muscl had  - Ta: ', mask1=tmask ,  &
-         &                       tab3d_2=sa, clinfo2=             ' Sa: ', mask2=tmask, clinfo3='tra' )
-
-      ! Save the horizontal advective trends for diagnostics
-      IF( l_trdtra ) THEN
-         ztrdt(:,:,:) = 0.e0   ;   ztrds(:,:,:) = 0.e0
-         !
-         ! T/S ZONAL advection trends
+      !                                                     ! ===========
+      DO jn = 1, kjpt                                       ! tracer loop
+         !                                                  ! ===========
+         ! I. Horizontal advective fluxes
+         ! ------------------------------
+         ! first guess of the slopes
+         zwx(:,:,jpk) = 0.e0   ;   zwy(:,:,jpk) = 0.e0        ! bottom values
+         ! interior values
          DO jk = 1, jpkm1
+            DO jj = 1, jpjm1      
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwx(ji,jj,jk) = umask(ji,jj,jk) * ( ptb(ji+1,jj,jk,jn) - ptb(ji,jj,jk,jn) )
+                  zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( ptb(ji,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )
+               END DO
+           END DO
+         END DO
+         !
+         CALL lbc_lnk( zwx, 'U', -1. )                        ! lateral boundary conditions on zwx, zwy   (changed sign)
+         CALL lbc_lnk( zwy, 'V', -1. )
+         !                                             !-- Slopes of tracer
+         zslpx(:,:,jpk) = 0.e0   ;   zslpy(:,:,jpk) = 0.e0    ! bottom values
+         DO jk = 1, jpkm1                                     ! interior values
+            DO jj = 2, jpj
+               DO ji = fs_2, jpi   ! vector opt.
+                  zslpx(ji,jj,jk) =                    ( zwx(ji,jj,jk) + zwx(ji-1,jj  ,jk) )   &
+                     &            * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji-1,jj  ,jk) ) )
+                  zslpy(ji,jj,jk) =                    ( zwy(ji,jj,jk) + zwy(ji  ,jj-1,jk) )   &
+                     &            * ( 0.25 + SIGN( 0.25, zwy(ji,jj,jk) * zwy(ji  ,jj-1,jk) ) )
+               END DO
+            END DO
+         END DO
+         !
+         DO jk = 1, jpkm1                                     ! Slopes limitation
+            DO jj = 2, jpj
+               DO ji = fs_2, jpi   ! vector opt.
+                  zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji  ,jj,jk) ),   &
+                     &                                                 2.*ABS( zwx  (ji-1,jj,jk) ),   &
+                     &                                                 2.*ABS( zwx  (ji  ,jj,jk) ) )
+                  zslpy(ji,jj,jk) = SIGN( 1., zslpy(ji,jj,jk) ) * MIN(    ABS( zslpy(ji,jj  ,jk) ),   &
+                     &                                                 2.*ABS( zwy  (ji,jj-1,jk) ),   &
+                     &                                                 2.*ABS( zwy  (ji,jj  ,jk) ) )
+               END DO
+           END DO
+         END DO             ! interior values
+
+         !                                             !-- MUSCL horizontal advective fluxes
+         DO jk = 1, jpkm1                                     ! interior values
+            zdt  = p2dt(jk)
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  !-- Compute zonal divergence by splitting hdivn (see divcur.F90)
-                  !   N.B. This computation is not valid along OBCs (if any)
-#if defined key_zco
-                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) )
-                  z_hdivn_x = (  e2u(ji  ,jj) * pun(ji  ,jj,jk)                              &
-                     &         - e2u(ji-1,jj) * pun(ji-1,jj,jk) ) * zbtr
-#else
-                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  z_hdivn_x = (  e2u(ji  ,jj) * fse3u(ji  ,jj,jk) * pun(ji  ,jj,jk)          &
-                     &         - e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * pun(ji-1,jj,jk) ) * zbtr
-#endif
-                  ztrdt(ji,jj,jk) = - zbtr * ( zt1(ji,jj,jk) - zt1(ji-1,jj,jk) ) + tn(ji,jj,jk) * z_hdivn_x
-                  ztrds(ji,jj,jk) = - zbtr * ( zs1(ji,jj,jk) - zs1(ji-1,jj,jk) ) + sn(ji,jj,jk) * z_hdivn_x
-               END DO
-            END DO
-         END DO
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_xad, 'TRA', kt)
-
-         ! T/S MERIDIONAL advection trends
+                  ! MUSCL fluxes
+                  z0u = SIGN( 0.5, pun(ji,jj,jk) )
+                  zalpha = 0.5 - z0u
+                  zu  = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) )
+                  zzwx = ptb(ji+1,jj,jk,jn) + zu * zslpx(ji+1,jj,jk)
+                  zzwy = ptb(ji  ,jj,jk,jn) + zu * zslpx(ji  ,jj,jk)
+                  zwx(ji,jj,jk) = pun(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
+                  !
+                  z0v = SIGN( 0.5, pvn(ji,jj,jk) )
+                  zalpha = 0.5 - z0v
+                  zv  = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) )
+                  zzwx = ptb(ji,jj+1,jk,jn) + zv * zslpy(ji,jj+1,jk)
+                  zzwy = ptb(ji,jj  ,jk,jn) + zv * zslpy(ji,jj  ,jk) 
+                  zwy(ji,jj,jk) = pvn(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
+               END DO
+            END DO
+         END DO
+         !                                                    ! lateral boundary conditions on zwx, zwy   (changed sign)
+         CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. )
+         !
+         ! Tracer flux divergence at t-point added to the general trend
          DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  !-- Compute merid. divergence by splitting hdivn (see divcur.F90)
-                  !   N.B. This computation is not valid along OBCs (if any)
-#if defined key_zco
-                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) )
-                  z_hdivn_y = (  e1v(ji,jj  ) * pvn(ji,jj  ,jk)                              &
-                     &         - e1v(ji,jj-1) * pvn(ji,jj-1,jk) ) * zbtr
-#else
-                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  z_hdivn_y = (  e1v(ji,  jj) * fse3v(ji,jj  ,jk) * pvn(ji,jj  ,jk)          &
-                     &         - e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * pvn(ji,jj-1,jk) ) * zbtr
-#endif
-                  ztrdt(ji,jj,jk) = - zbtr * ( zt2(ji,jj,jk) - zt2(ji,jj-1,jk) ) + tn(ji,jj,jk) * z_hdivn_y          
-                  ztrds(ji,jj,jk) = - zbtr * ( zs2(ji,jj,jk) - zs2(ji,jj-1,jk) ) + sn(ji,jj,jk) * z_hdivn_y
-               END DO
-            END DO
-         END DO
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_yad, 'TRA', kt)
-
-         ! Save the up-to-date ta and sa trends
-         ztrdt(:,:,:) = ta(:,:,:) 
-         ztrds(:,:,:) = sa(:,:,:) 
-         !
-      ENDIF
-
-      ! "zonal" mean advective heat and salt transport
-      IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN
-         IF( lk_zco ) THEN
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                    zt2(ji,jj,jk) = zt2(ji,jj,jk) * fse3v(ji,jj,jk)
-                    zs2(ji,jj,jk) = zs2(ji,jj,jk) * fse3v(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
+            DO jj = 2, jpjm1      
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ! horizontal advective trends
+                  ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
+                  &               + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  ) )
+                  ! add it to the general tracer trends
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
+               END DO
+           END DO
+         END DO        
+         !                                 ! trend diagnostics (contribution of upstream fluxes)
+         IF( l_trd )  THEN
+            CALL trd_tra( kt, cdtype, jn, jptra_trd_xad, zwx, pun, ptb(:,:,:,jn) )
+            CALL trd_tra( kt, cdtype, jn, jptra_trd_yad, zwy, pvn, ptb(:,:,:,jn) )
+         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(:,:,:) )
          ENDIF
-         pht_adv(:) = ptr_vj( zt2(:,:,:) )
-         pst_adv(:) = ptr_vj( zs2(:,:,:) )
-      ENDIF
-
-      ! II. Vertical advective fluxes
-      ! -----------------------------
-      
-      ! First guess of the slope
-      ! interior values
-      DO jk = 2, jpkm1
-         zt1(:,:,jk) = tmask(:,:,jk) * ( tb(:,:,jk-1) - tb(:,:,jk) )
-         zs1(:,:,jk) = tmask(:,:,jk) * ( sb(:,:,jk-1) - sb(:,:,jk) )
-      END DO
-      ! surface & bottom boundary conditions
-      zt1 (:,:, 1 ) = 0.e0    ;    zt1 (:,:,jpk) = 0.e0
-      zs1 (:,:, 1 ) = 0.e0    ;    zs1 (:,:,jpk) = 0.e0
-
-      ! Slopes
-      DO jk = 2, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ztp1(ji,jj,jk) =                    ( zt1(ji,jj,jk) + zt1(ji,jj,jk+1) )   &
-                  &           * ( 0.25 + SIGN( 0.25, zt1(ji,jj,jk) * zt1(ji,jj,jk+1) ) )
-               zsp1(ji,jj,jk) =                    ( zs1(ji,jj,jk) + zs1(ji,jj,jk+1) )   &
-                  &           * ( 0.25 + SIGN( 0.25, zs1(ji,jj,jk) * zs1(ji,jj,jk+1) ) )
-            END DO
-         END DO
-      END DO
-
-      ! Slopes limitation
-      ! interior values
-      DO jk = 2, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ztp1(ji,jj,jk) = SIGN( 1., ztp1(ji,jj,jk) )   &
-                  &           * MIN(    ABS( ztp1(ji,jj,jk  ) ),   &
-                  &                  2.*ABS( zt1 (ji,jj,jk+1) ),   &
-                  &                  2.*ABS( zt1 (ji,jj,jk  ) ) )
-               zsp1(ji,jj,jk) = SIGN( 1., zsp1(ji,jj,jk) )   &
-                  &           * MIN(    ABS( zsp1(ji,jj,jk  ) ),   &
-                  &                  2.*ABS( zs1 (ji,jj,jk+1) ),   &
-                  &                  2.*ABS( zs1 (ji,jj,jk  ) ) )
-            END DO
-         END DO
-      END DO
-      ! surface values
-      ztp1(:,:,1) = 0.e0
-      zsp1(:,:,1) = 0.e0
-
-      ! vertical advective flux
-      ! interior values
-      DO jk = 1, jpkm1
-         zstep  = z2 * rdttra(jk)
-         DO jj = 2, jpjm1      
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zew = pwn(ji,jj,jk+1)
-               z0w = SIGN( 0.5, pwn(ji,jj,jk+1) )
-               zalpha = 0.5 + z0w
-               zw  = z0w - 0.5 * pwn(ji,jj,jk+1)*zstep / fse3w(ji,jj,jk+1)
-               zzt1 = tb(ji,jj,jk+1) + zw*ztp1(ji,jj,jk+1)
-               zzt2 = tb(ji,jj,jk  ) + zw*ztp1(ji,jj,jk  )
-               zzs1 = sb(ji,jj,jk+1) + zw*zsp1(ji,jj,jk+1)
-               zzs2 = sb(ji,jj,jk  ) + zw*zsp1(ji,jj,jk  )
-               zt1(ji,jj,jk+1) = zew * ( zalpha * zzt1 + (1.-zalpha)*zzt2 )
-               zs1(ji,jj,jk+1) = zew * ( zalpha * zzs1 + (1.-zalpha)*zzs2 )
-            END DO
-         END DO
-      END DO
-      ! surface values
-      IF( lk_vvl ) THEN
-         ! variable volume : flux set to zero
-         zt1(:,:, 1 ) = 0.e0
-         zs1(:,:, 1 ) = 0.e0
-      ELSE
-         ! free surface-constant volume
-         zt1(:,:, 1 ) = pwn(:,:,1) * tb(:,:,1)
-         zs1(:,:, 1 ) = pwn(:,:,1) * sb(:,:,1)
-      ENDIF
-
-      ! bottom values
-      zt1(:,:,jpk) = 0.e0
-      zs1(:,:,jpk) = 0.e0
-
-
-      ! Compute & add the vertical advective trend
-
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1      
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zbtr = 1. / fse3t(ji,jj,jk)
-               ! horizontal advective trends
-               zta = - zbtr * ( zt1(ji,jj,jk) - zt1(ji,jj,jk+1) )
-               zsa = - zbtr * ( zs1(ji,jj,jk) - zs1(ji,jj,jk+1) )
-               ! add it to the general tracer trends
-               ta(ji,jj,jk) =  ta(ji,jj,jk) + zta
-               sa(ji,jj,jk) =  sa(ji,jj,jk) + zsa
-            END DO
-         END DO
-      END DO
-
-      ! Save the vertical advective trends for diagnostic
-      ! -------------------------------------------------
-      IF( l_trdtra )   THEN
-         ! Recompute the vertical advection zta & zsa trends computed 
-         ! at the step 2. above in making the difference between the new 
-         ! trends and the previous one: ta()/sa - ztrdt()/ztrds() and substract
-         ! the term tn()/sn()*hdivn() to recover the W gradz(T/S) trends
-
+
+         ! II. Vertical advective fluxes
+         ! -----------------------------
+         !                                             !-- first guess of the slopes
+         zwx (:,:, 1 ) = 0.e0    ;    zwx (:,:,jpk) = 0.e0    ! surface & bottom boundary conditions
+         DO jk = 2, jpkm1                                     ! interior values
+            zwx(:,:,jk) = tmask(:,:,jk) * ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) )
+         END DO
+
+         !                                             !-- Slopes of tracer
+         zslpx(:,:,1) = 0.e0                                  ! surface values
+         DO jk = 2, jpkm1                                     ! interior value
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zslpx(ji,jj,jk) =                    ( zwx(ji,jj,jk) + zwx(ji,jj,jk+1) )   &
+                     &            * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji,jj,jk+1) ) )
+               END DO
+            END DO
+         END DO
+         !                                             !-- Slopes limitation
+         DO jk = 2, jpkm1                                     ! interior values
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji,jj,jk  ) ),   &
+                     &                                                 2.*ABS( zwx  (ji,jj,jk+1) ),   &
+                     &                                                 2.*ABS( zwx  (ji,jj,jk  ) )  )
+               END DO
+            END DO
+         END DO
+         !                                             !-- vertical advective flux
+         !                                                    ! surface values  (bottom already set to zero)
+         IF( lk_vvl ) THEN    ;   zwx(:,:, 1 ) = 0.e0                      !  variable volume
+         ELSE                 ;   zwx(:,:, 1 ) = pwn(:,:,1) * ptb(:,:,1,jn)   ! linear free surface
+         ENDIF 
+         !
+         DO jk = 1, jpkm1                                     ! interior values
+            zdt  = p2dt(jk)
+            DO jj = 2, jpjm1      
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3w(ji,jj,jk+1) )
+                  z0w = SIGN( 0.5, pwn(ji,jj,jk+1) )
+                  zalpha = 0.5 + z0w
+                  zw  = z0w - 0.5 * pwn(ji,jj,jk+1) * zdt * zbtr 
+                  zzwx = ptb(ji,jj,jk+1,jn) + zw * zslpx(ji,jj,jk+1)
+                  zzwy = ptb(ji,jj,jk  ,jn) + zw * zslpx(ji,jj,jk  )
+                  zwx(ji,jj,jk+1) = pwn(ji,jj,jk+1) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
+               END DO 
+            END DO
+         END DO
+
+         ! Compute & add the vertical advective trend
          DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-#if defined key_zco
-                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) )
-                  z_hdivn_x = e2u(ji,jj)*pun(ji,jj,jk) - e2u(ji-1,jj)*pun(ji-1,jj,jk)
-                  z_hdivn_y = e1v(ji,jj)*pvn(ji,jj,jk) - e1v(ji,jj-1)*pvn(ji,jj-1,jk)
-#else
-                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  z_hdivn_x = e2u(ji,jj)*fse3u(ji,jj,jk)*pun(ji,jj,jk) - e2u(ji-1,jj)*fse3u(ji-1,jj,jk)*pun(ji-1,jj,jk)
-                  z_hdivn_y = e1v(ji,jj)*fse3v(ji,jj,jk)*pvn(ji,jj,jk) - e1v(ji,jj-1)*fse3v(ji,jj-1,jk)*pvn(ji,jj-1,jk)
-#endif
-                  z_hdivn   = (z_hdivn_x + z_hdivn_y) * zbtr
-                  ztrdt(ji,jj,jk) = ta(ji,jj,jk) - ztrdt(ji,jj,jk) - tn(ji,jj,jk) * z_hdivn 
-                  ztrds(ji,jj,jk) = sa(ji,jj,jk) - ztrds(ji,jj,jk) - sn(ji,jj,jk) * z_hdivn
-               END DO
-            END DO
-         END DO
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_zad, 'TRA', kt)
-         !
-      ENDIF
-
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' muscl zad  - Ta: ', mask1=tmask ,   &
-         &                       tab3d_2=sa, clinfo2=             ' Sa: ', mask2=tmask, clinfo3='tra' )
+            DO jj = 2, jpjm1      
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ! vertical advective trends 
+                  ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) )
+                  ! add it to the general tracer trends
+                  pta(ji,jj,jk,jn) =  pta(ji,jj,jk,jn) + ztra
+               END DO
+            END DO
+         END DO
+         !                                 ! Save the vertical advective trends for diagnostic
+         IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_trd_zad, zwx, pwn, ptb(:,:,:,jn) )
+         !
+      ENDDO
       !
    END SUBROUTINE tra_adv_muscl
Index: trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90	(revision 2528)
@@ -2,7 +2,8 @@
    !!==============================================================================
    !!                       ***  MODULE  traadv_muscl2  ***
-   !! Ocean active tracers:  horizontal & vertical advective trend
+   !! Ocean  tracers:  horizontal & vertical advective trend
    !!==============================================================================
-   !! History :  9.0  !  02-06  (G. Madec) from traadv_muscl
+   !! History :  1.0  !  2002-06  (G. Madec) from traadv_muscl
+   !!            3.2  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
    !!----------------------------------------------------------------------
 
@@ -13,19 +14,21 @@
    USE oce             ! ocean dynamics and active tracers
    USE dom_oce         ! ocean space and time domain
-   USE trdmod          ! ocean active tracers trends 
-   USE trdmod_oce      ! ocean variables trends
+   USE trdmod_oce      ! tracers trends 
+   USE trdtra          ! tracers trends 
    USE in_out_manager  ! I/O manager
    USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient
    USE trabbl          ! tracers: bottom boundary layer
-   USE lib_mpp
+   USE lib_mpp         ! distribued memory computing
    USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
    USE diaptr          ! poleward transport diagnostics
-   USE prtctl          ! Print control
+   USE trc_oce         ! share passive tracers/Ocean variables
+
 
    IMPLICIT NONE
    PRIVATE
 
-   !! * Accessibility
-   PUBLIC tra_adv_muscl2        ! routine called by step.F90
+   PUBLIC   tra_adv_muscl2        ! routine called by step.F90
+
+   LOGICAL  :: l_trd       ! flag to compute trends
 
    !! * Substitutions
@@ -33,12 +36,12 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2006) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
-   SUBROUTINE tra_adv_muscl2( kt, pun, pvn, pwn )
+   SUBROUTINE tra_adv_muscl2( kt, cdtype, p2dt, pun, pvn, pwn,      &
+      &                                         ptb, ptn, pta, kjpt )
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE tra_adv_muscl2  ***
@@ -50,444 +53,232 @@
       !! ** Method  : MUSCL scheme plus centered scheme at ocean boundaries
       !!
-      !! ** Action  : - update (ta,sa) with the now advective tracer trends
-      !!              - save trends in (ztrdt,ztrds) ('key_trdtra')
+      !! ** Action  : - update (pta) with the now advective tracer trends
+      !!              - save trends 
       !!
       !! References : Estubier, A., and M. Levy, Notes Techn. Pole de Modelisation
       !!              IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa)
       !!----------------------------------------------------------------------
-      USE oce              , ztrdt => ua   ! use ua as workspace
-      USE oce              , ztrds => va   ! use va as workspace
-      !!
-      INTEGER , INTENT(in)                         ::   kt    ! ocean time-step index
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pun   ! ocean velocity u-component
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pvn   ! ocean velocity v-component
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pwn   ! ocean velocity w-component
-      !!
-      INTEGER ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp) ::   &
-         zu, zv, zw, zeu, zev,           &  
-         zew, zbtr, zstep,               &
-         z0u, z0v, z0w,                  &
-         zzt1, zzt2, zalpha,             &
-         zzs1, zzs2, z2,                 &
-         zta, zsa,                       &
-         z_hdivn_x, z_hdivn_y, z_hdivn
-      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zt1, zt2, ztp1, ztp2   ! 3D workspace
-      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zs1, zs2, zsp1, zsp2   !  "      "
+      USE oce         , zwx => ua   ! use ua as workspace
+      USE oce         , zwy => va   ! use va as workspace
+      !!
+      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
+      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before & now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+      !!
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::   zu, z0u, zzwx    ! local scalar
+      REAL(wp) ::   zv, z0v, zzwy    !   -      -
+      REAL(wp) ::   zw, z0w          !   -      -
+      REAL(wp) ::   ztra, zbtr, zdt, zalpha
+      REAL(wp), DIMENSION (jpi,jpj,jpk) ::  zslpx, zslpy   ! 3D workspace
       !!----------------------------------------------------------------------
 
-      IF( kt == nit000 .AND. lwp ) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'tra_adv_muscl2 : MUSCL2 advection scheme'
-         WRITE(numout,*) '~~~~~~~~~~~~~~~'
+      IF( kt == nit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_adv_muscl2 : MUSCL2 advection scheme on ', cdtype
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~'
+         !
+         l_trd = .FALSE.
+         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.
       ENDIF
 
-      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   z2 = 1.
-      ELSE                                        ;   z2 = 2.
-      ENDIF
-
-      ! I. Horizontal advective fluxes
-      ! ------------------------------
-
-      ! first guess of the slopes
-      ! interior values
-      DO jk = 1, jpkm1
-         DO jj = 1, jpjm1      
-            DO ji = 1, fs_jpim1   ! vector opt.
-               zt1(ji,jj,jk) = umask(ji,jj,jk) * ( tb(ji+1,jj,jk) - tb(ji,jj,jk) )
-               zs1(ji,jj,jk) = umask(ji,jj,jk) * ( sb(ji+1,jj,jk) - sb(ji,jj,jk) )
-               zt2(ji,jj,jk) = vmask(ji,jj,jk) * ( tb(ji,jj+1,jk) - tb(ji,jj,jk) )
-               zs2(ji,jj,jk) = vmask(ji,jj,jk) * ( sb(ji,jj+1,jk) - sb(ji,jj,jk) )
-            END DO
-         END DO
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         ! I. Horizontal advective fluxes
+         ! ------------------------------
+         ! first guess of the slopes
+         zwx(:,:,jpk) = 0.e0   ;   zwy(:,:,jpk) = 0.e0        ! bottom values
+         ! interior values
+         DO jk = 1, jpkm1
+            DO jj = 1, jpjm1      
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwx(ji,jj,jk) = umask(ji,jj,jk) * ( ptb(ji+1,jj,jk,jn) - ptb(ji,jj,jk,jn) )
+                  zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( ptb(ji,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )
+               END DO
+           END DO
+         END DO
+         !
+         CALL lbc_lnk( zwx, 'U', -1. )                        ! lateral boundary conditions on zwx, zwy   (changed sign)
+         CALL lbc_lnk( zwy, 'V', -1. )
+         !                                             !-- Slopes of tracer
+         zslpx(:,:,jpk) = 0.e0   ;   zslpy(:,:,jpk) = 0.e0    ! bottom values
+         DO jk = 1, jpkm1                                     ! interior values
+            DO jj = 2, jpj
+               DO ji = fs_2, jpi   ! vector opt.
+                  zslpx(ji,jj,jk) =                    ( zwx(ji,jj,jk) + zwx(ji-1,jj  ,jk) )   &
+                     &            * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji-1,jj  ,jk) ) )
+                  zslpy(ji,jj,jk) =                    ( zwy(ji,jj,jk) + zwy(ji  ,jj-1,jk) )   &
+                     &            * ( 0.25 + SIGN( 0.25, zwy(ji,jj,jk) * zwy(ji  ,jj-1,jk) ) )
+               END DO
+            END DO
+         END DO
+         !
+         DO jk = 1, jpkm1                                     ! Slopes limitation
+            DO jj = 2, jpj
+               DO ji = fs_2, jpi   ! vector opt.
+                  zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji  ,jj,jk) ),   &
+                     &                                                 2.*ABS( zwx  (ji-1,jj,jk) ),   &
+                     &                                                 2.*ABS( zwx  (ji  ,jj,jk) ) )
+                  zslpy(ji,jj,jk) = SIGN( 1., zslpy(ji,jj,jk) ) * MIN(    ABS( zslpy(ji,jj  ,jk) ),   &
+                     &                                                 2.*ABS( zwy  (ji,jj-1,jk) ),   &
+                     &                                                 2.*ABS( zwy  (ji,jj  ,jk) ) )
+               END DO
+           END DO
+         END DO             ! interior values
+
+        !                                             !-- MUSCL horizontal advective fluxes
+         DO jk = 1, jpkm1                                     ! interior values
+            zdt  = p2dt(jk)
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ! MUSCL fluxes
+                  z0u = SIGN( 0.5, pun(ji,jj,jk) )
+                  zalpha = 0.5 - z0u
+                  zu  = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) )
+                  zzwx = ptb(ji+1,jj,jk,jn) + zu * zslpx(ji+1,jj,jk)
+                  zzwy = ptb(ji  ,jj,jk,jn) + zu * zslpx(ji  ,jj,jk)
+                  zwx(ji,jj,jk) = pun(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
+                  !
+                  z0v = SIGN( 0.5, pvn(ji,jj,jk) )
+                  zalpha = 0.5 - z0v
+                  zv  = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) )
+                  zzwx = ptb(ji,jj+1,jk,jn) + zv * zslpy(ji,jj+1,jk)
+                  zzwy = ptb(ji,jj  ,jk,jn) + zv * zslpy(ji,jj  ,jk)
+                  zwy(ji,jj,jk) = pvn(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
+               END DO
+            END DO
+         END DO
+
+         !!  centered scheme at lateral b.C. if off-shore velocity
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  IF( umask(ji,jj,jk) == 0. ) THEN
+                     IF( pun(ji+1,jj,jk) > 0. .AND. ji /= jpi ) THEN
+                        zwx(ji+1,jj,jk) = 0.5 * pun(ji+1,jj,jk) * ( ptn(ji+1,jj,jk,jn) + ptn(ji+2,jj,jk,jn) )
+                     ENDIF
+                     IF( pun(ji-1,jj,jk) < 0. ) THEN
+                        zwx(ji-1,jj,jk) = 0.5 * pun(ji-1,jj,jk) * ( ptn(ji-1,jj,jk,jn) + ptn(ji,jj,jk,jn) ) 
+                     ENDIF
+                  ENDIF
+                  IF( vmask(ji,jj,jk) == 0. ) THEN
+                     IF( pvn(ji,jj+1,jk) > 0. .AND. jj /= jpj ) THEN
+                        zwy(ji,jj+1,jk) = 0.5 * pvn(ji,jj+1,jk) * ( ptn(ji,jj+1,jk,jn) + ptn(ji,jj+2,jk,jn) )
+                     ENDIF
+                     IF( pvn(ji,jj-1,jk) < 0. ) THEN
+                        zwy(ji,jj-1,jk) = 0.5 * pvn(ji,jj-1,jk) * ( ptn(ji,jj-1,jk,jn) + ptn(ji,jj,jk,jn) ) 
+                     ENDIF
+                  ENDIF
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. )   ! lateral boundary condition (changed sign)
+
+         ! Tracer flux divergence at t-point added to the general trend
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ! horizontal advective trends 
+                  ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
+                  &               + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  ) )
+                  ! added to the general tracer trends
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
+               END DO
+           END DO
+         END DO
+         !                                 ! trend diagnostics (contribution of upstream fluxes)
+         IF( l_trd ) THEN
+            CALL trd_tra( kt, cdtype, jn, jptra_trd_xad, zwx, pun, ptb(:,:,:,jn) )
+            CALL trd_tra( kt, cdtype, jn, jptra_trd_yad, zwy, pvn, ptb(:,:,:,jn) )
+         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(:,:,:) )
+         ENDIF
+
+         ! II. Vertical advective fluxes
+         ! -----------------------------
+         !                                             !-- first guess of the slopes
+         zwx (:,:, 1 ) = 0.e0    ;    zwx (:,:,jpk) = 0.e0    ! surface & bottom boundary conditions
+         DO jk = 2, jpkm1                                     ! interior values
+            zwx(:,:,jk) = tmask(:,:,jk) * ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) )
+         END DO
+
+         !                                             !-- Slopes of tracer
+         zslpx(:,:,1) = 0.e0                                  ! surface values
+         DO jk = 2, jpkm1                                     ! interior value
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zslpx(ji,jj,jk) =                    ( zwx(ji,jj,jk) + zwx(ji,jj,jk+1) )   &
+                     &            * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji,jj,jk+1) ) )
+               END DO
+            END DO
+         END DO
+         !                                             !-- Slopes limitation
+         DO jk = 2, jpkm1                                     ! interior values
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji,jj,jk  ) ),   &
+                     &                                                 2.*ABS( zwx  (ji,jj,jk+1) ),   &
+                     &                                                 2.*ABS( zwx  (ji,jj,jk  ) )  )
+               END DO
+            END DO
+         END DO
+         !                                             !-- vertical advective flux
+         !                                                    ! surface values  (bottom already set to zero)
+         IF( lk_vvl ) THEN    ;   zwx(:,:, 1 ) = 0.e0                      !  variable volume
+         ELSE                 ;   zwx(:,:, 1 ) = pwn(:,:,1) * ptb(:,:,1,jn)   ! linear free surface
+         ENDIF
+         !
+         DO jk = 1, jpkm1                                     ! interior values
+            zdt  = p2dt(jk)
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3w(ji,jj,jk+1) )
+                  z0w = SIGN( 0.5, pwn(ji,jj,jk+1) )
+                  zalpha = 0.5 + z0w
+                  zw  = z0w - 0.5 * pwn(ji,jj,jk+1) * zdt * zbtr
+                  zzwx = ptb(ji,jj,jk+1,jn) + zw * zslpx(ji,jj,jk+1)
+                  zzwy = ptb(ji,jj,jk  ,jn) + zw * zslpx(ji,jj,jk  )
+                  zwx(ji,jj,jk+1) = pwn(ji,jj,jk+1) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
+               END DO
+            END DO
+         END DO
+         !
+         DO jk = 2, jpkm1        ! centered near the bottom
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  IF( tmask(ji,jj,jk+1) == 0. ) THEN
+                     IF( pwn(ji,jj,jk) > 0. ) THEN
+                        zwx(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk-1,jn) + ptn(ji,jj,jk,jn) ) 
+                     ENDIF
+                  ENDIF
+               END DO
+            END DO
+         END DO
+         !
+         DO jk = 1, jpkm1        ! Compute & add the vertical advective trend
+            DO jj = 2, jpjm1      
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ! vertical advective trends 
+                  ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) )
+                  ! added to the general tracer trends
+                  pta(ji,jj,jk,jn) =  pta(ji,jj,jk,jn) + ztra
+               END DO
+            END DO
+         END DO
+         !                       ! trend diagnostics (contribution of upstream fluxes)
+         IF( l_trd )  CALL trd_tra( kt, cdtype, jn, jptra_trd_zad, zwx, pwn, ptb(:,:,:,jn) )
+         !
       END DO
-      ! bottom values
-      zt1(:,:,jpk) = 0.e0    ;    zt2(:,:,jpk) = 0.e0
-      zs1(:,:,jpk) = 0.e0    ;    zs2(:,:,jpk) = 0.e0
-
-      ! lateral boundary conditions on zt1, zt2 ; zs1, zs2   (changed sign)
-      CALL lbc_lnk( zt1, 'U', -1. )   ;   CALL lbc_lnk( zs1, 'U', -1. )
-      CALL lbc_lnk( zt2, 'V', -1. )   ;   CALL lbc_lnk( zs2, 'V', -1. )
-
-      ! Slopes
-      ! interior values
-      DO jk = 1, jpkm1
-         DO jj = 2, jpj
-            DO ji = fs_2, jpi   ! vector opt.
-               ztp1(ji,jj,jk) =                    ( zt1(ji,jj,jk) + zt1(ji-1,jj  ,jk) )   &
-                  &           * ( 0.25 + SIGN( 0.25, zt1(ji,jj,jk) * zt1(ji-1,jj  ,jk) ) )
-               zsp1(ji,jj,jk) =                    ( zs1(ji,jj,jk) + zs1(ji-1,jj  ,jk) )   &
-                  &           * ( 0.25 + SIGN( 0.25, zs1(ji,jj,jk) * zs1(ji-1,jj  ,jk) ) )
-               ztp2(ji,jj,jk) =                    ( zt2(ji,jj,jk) + zt2(ji  ,jj-1,jk) )   &
-                  &           * ( 0.25 + SIGN( 0.25, zt2(ji,jj,jk) * zt2(ji  ,jj-1,jk) ) )
-               zsp2(ji,jj,jk) =                    ( zs2(ji,jj,jk) + zs2(ji  ,jj-1,jk) )   &
-                  &           * ( 0.25 + SIGN( 0.25, zs2(ji,jj,jk) * zs2(ji  ,jj-1,jk) ) )
-            END DO
-         END DO
-      END DO
-      ! bottom values
-      ztp1(:,:,jpk) = 0.e0    ;    ztp2(:,:,jpk) = 0.e0
-      zsp1(:,:,jpk) = 0.e0    ;    zsp2(:,:,jpk) = 0.e0
-
-      ! Slopes limitation
-      DO jk = 1, jpkm1
-         DO jj = 2, jpj
-            DO ji = fs_2, jpi   ! vector opt.
-               ztp1(ji,jj,jk) = SIGN( 1., ztp1(ji,jj,jk) )   &
-                  &           * MIN(    ABS( ztp1(ji  ,jj,jk) ),   &
-                  &                  2.*ABS( zt1 (ji-1,jj,jk) ),   &
-                  &                  2.*ABS( zt1 (ji  ,jj,jk) ) )
-               zsp1(ji,jj,jk) = SIGN( 1., zsp1(ji,jj,jk) )   &
-                  &           * MIN(    ABS( zsp1(ji  ,jj,jk) ),   &
-                  &                  2.*ABS( zs1 (ji-1,jj,jk) ),   &
-                  &                  2.*ABS( zs1 (ji  ,jj,jk) ) )
-               ztp2(ji,jj,jk) = SIGN( 1., ztp2(ji,jj,jk) )   &
-                  &           * MIN(    ABS( ztp2(ji,jj  ,jk) ),   &
-                  &                  2.*ABS( zt2 (ji,jj-1,jk) ),   &
-                  &                  2.*ABS( zt2 (ji,jj  ,jk) ) )
-               zsp2(ji,jj,jk) = SIGN( 1., zsp2(ji,jj,jk) )   &
-                  &           * MIN(    ABS( zsp2(ji,jj  ,jk) ),   &
-                  &                  2.*ABS( zs2 (ji,jj-1,jk) ),   &
-                  &                  2.*ABS( zs2 (ji,jj  ,jk) ) )
-            END DO
-         END DO
-      END DO        
-
-      ! Advection terms
-      ! interior values
-      DO jk = 1, jpkm1
-         zstep  = z2 * rdttra(jk)
-         DO jj = 2, jpjm1      
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ! volume fluxes
-#if defined key_zco
-               zeu = e2u(ji,jj)                   * pun(ji,jj,jk)
-               zev = e1v(ji,jj)                   * pvn(ji,jj,jk)
-#else
-               zeu = e2u(ji,jj) * fse3u(ji,jj,jk) * pun(ji,jj,jk)
-               zev = e1v(ji,jj) * fse3v(ji,jj,jk) * pvn(ji,jj,jk)
-#endif
-               ! MUSCL fluxes
-               z0u = SIGN( 0.5, pun(ji,jj,jk) )            
-               zalpha = 0.5 - z0u
-               zu  = z0u - 0.5 * pun(ji,jj,jk) * zstep / e1u(ji,jj)
-               zzt1 = tb(ji+1,jj,jk) + zu*ztp1(ji+1,jj,jk)
-               zzt2 = tb(ji  ,jj,jk) + zu*ztp1(ji  ,jj,jk)
-               zzs1 = sb(ji+1,jj,jk) + zu*zsp1(ji+1,jj,jk)
-               zzs2 = sb(ji  ,jj,jk) + zu*zsp1(ji  ,jj,jk)
-               zt1(ji,jj,jk) = zeu * ( zalpha * zzt1 + (1.-zalpha) * zzt2 )
-               zs1(ji,jj,jk) = zeu * ( zalpha * zzs1 + (1.-zalpha) * zzs2 )
-               !
-               z0v = SIGN( 0.5, pvn(ji,jj,jk) )            
-               zalpha = 0.5 - z0v
-               zv  = z0v - 0.5 * pvn(ji,jj,jk) * zstep / e2v(ji,jj)
-               zzt1 = tb(ji,jj+1,jk) + zv*ztp2(ji,jj+1,jk)
-               zzt2 = tb(ji,jj  ,jk) + zv*ztp2(ji,jj  ,jk)
-               zzs1 = sb(ji,jj+1,jk) + zv*zsp2(ji,jj+1,jk)
-               zzs2 = sb(ji,jj  ,jk) + zv*zsp2(ji,jj  ,jk)
-               zt2(ji,jj,jk) = zev * ( zalpha * zzt1 + (1.-zalpha) * zzt2 )
-               zs2(ji,jj,jk) = zev * ( zalpha * zzs1 + (1.-zalpha) * zzs2 )
-            END DO
-         END DO
-      END DO
-
-      !!!!  centered scheme at lateral b.C. if off-shore velocity
-      DO jk = 1, jpkm1
-        DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-#if defined key_zco
-               IF( umask(ji,jj,jk) == 0. ) THEN
-                  IF( pun(ji+1,jj,jk) > 0. .AND. ji /= jpi ) THEN
-                     zt1(ji+1,jj,jk) = e2u(ji+1,jj) * pun(ji+1,jj,jk) * ( tb(ji+1,jj,jk) + tb(ji+2,jj,jk) ) * 0.5
-                     zs1(ji+1,jj,jk) = e2u(ji+1,jj) * pun(ji+1,jj,jk) * ( sb(ji+1,jj,jk) + sb(ji+2,jj,jk) ) * 0.5
-                  ENDIF
-                  IF( pun(ji-1,jj,jk) < 0. ) THEN
-                     zt1(ji-1,jj,jk) = e2u(ji-1,jj) * pun(ji-1,jj,jk) * ( tb(ji-1,jj,jk) + tb(ji  ,jj,jk) ) * 0.5
-                     zs1(ji-1,jj,jk) = e2u(ji-1,jj) * pun(ji-1,jj,jk) * ( sb(ji-1,jj,jk) + sb(ji  ,jj,jk) ) * 0.5
-                  ENDIF
-               ENDIF
-               IF( vmask(ji,jj,jk) == 0. ) THEN
-                  IF( pvn(ji,jj+1,jk) > 0. .AND. jj /= jpj ) THEN
-                     zt2(ji,jj+1,jk) = e1v(ji,jj+1) * pvn(ji,jj+1,jk) * ( tb(ji,jj+1,jk) + tb(ji,jj+2,jk) ) * 0.5
-                     zs2(ji,jj+1,jk) = e1v(ji,jj+1) * pvn(ji,jj+1,jk) * ( sb(ji,jj+1,jk) + sb(ji,jj+2,jk) ) * 0.5
-                  ENDIF
-                  IF( pvn(ji,jj-1,jk) < 0. ) THEN
-                     zt2(ji,jj-1,jk) = e1v(ji,jj-1) * pvn(ji,jj-1,jk) * ( tb(ji,jj-1,jk) + tb(ji  ,jj,jk) ) * 0.5
-                     zs2(ji,jj-1,jk) = e1v(ji,jj-1) * pvn(ji,jj-1,jk) * ( sb(ji,jj-1,jk) + sb(ji  ,jj,jk) ) * 0.5
-                  ENDIF
-               ENDIF
-#else
-               IF( umask(ji,jj,jk) == 0. ) THEN
-                  IF( pun(ji+1,jj,jk) > 0. .AND. ji /= jpi ) THEN
-                     zt1(ji+1,jj,jk) = e2u(ji+1,jj)* fse3u(ji+1,jj,jk)   &
-                        &            * pun(ji+1,jj,jk) * ( tb(ji+1,jj,jk) + tb(ji+2,jj,jk) ) * 0.5
-                     zs1(ji+1,jj,jk) = e2u(ji+1,jj)* fse3u(ji+1,jj,jk)   &
-                        &            * pun(ji+1,jj,jk) * ( sb(ji+1,jj,jk) + sb(ji+2,jj,jk) ) * 0.5
-                  ENDIF
-                  IF( pun(ji-1,jj,jk) < 0. ) THEN
-                     zt1(ji-1,jj,jk) = e2u(ji-1,jj)* fse3u(ji-1,jj,jk)   &
-                        &            * pun(ji-1,jj,jk) * ( tb(ji-1,jj,jk) + tb(ji  ,jj,jk) ) * 0.5
-                     zs1(ji-1,jj,jk) = e2u(ji-1,jj)* fse3u(ji-1,jj,jk)   &
-                        &            * pun(ji-1,jj,jk) * ( sb(ji-1,jj,jk) + sb(ji  ,jj,jk) ) * 0.5
-                  ENDIF
-               ENDIF
-               IF( vmask(ji,jj,jk) == 0. ) THEN
-                  IF( pvn(ji,jj+1,jk) > 0. .AND. jj /= jpj ) THEN
-                     zt2(ji,jj+1,jk) = e1v(ji,jj+1) * fse3v(ji,jj+1,jk)   &
-                        &            * pvn(ji,jj+1,jk) * ( tb(ji,jj+1,jk) + tb(ji,jj+2,jk) ) * 0.5
-                     zs2(ji,jj+1,jk) = e1v(ji,jj+1) * fse3v(ji,jj+1,jk)   &
-                        &            * pvn(ji,jj+1,jk) * ( sb(ji,jj+1,jk) + sb(ji,jj+2,jk) ) * 0.5
-                  ENDIF
-                  IF( pvn(ji,jj-1,jk) < 0. ) THEN
-                     zt2(ji,jj-1,jk) = e1v(ji,jj-1)* fse3v(ji,jj-1,jk)   &
-                        &            * pvn(ji,jj-1,jk) * ( tb(ji,jj-1,jk) + tb(ji  ,jj,jk) ) * 0.5
-                     zs2(ji,jj-1,jk) = e1v(ji,jj-1)* fse3v(ji,jj-1,jk)   &
-                        &            * pvn(ji,jj-1,jk) * ( sb(ji,jj-1,jk) + sb(ji  ,jj,jk) ) * 0.5
-                  ENDIF
-               ENDIF
-#endif
-            END DO
-         END DO
-      END DO
-
-      ! lateral boundary conditions on zt1, zt2 ; zs1, zs2   (changed sign)
-      CALL lbc_lnk( zt1, 'U', -1. )   ;   CALL lbc_lnk( zs1, 'U', -1. ) 
-      CALL lbc_lnk( zt2, 'V', -1. )   ;   CALL lbc_lnk( zs2, 'V', -1. )
-
-      ! Compute & add the horizontal advective trend
-
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1      
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-#if defined key_zco
-               zbtr = 1. / ( e1t(ji,jj)*e2t(ji,jj) )
-#else
-               zbtr = 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )
-#endif
-               ! horizontal advective trends
-               zta = - zbtr * ( zt1(ji,jj,jk) - zt1(ji-1,jj  ,jk  )   &
-                  &           + zt2(ji,jj,jk) - zt2(ji  ,jj-1,jk  ) )
-               zsa = - zbtr * ( zs1(ji,jj,jk) - zs1(ji-1,jj  ,jk  )   &
-                  &           + zs2(ji,jj,jk) - zs2(ji  ,jj-1,jk  ) ) 
-               ! add it to the general tracer trends
-               ta(ji,jj,jk) = ta(ji,jj,jk) + zta
-               sa(ji,jj,jk) = sa(ji,jj,jk) + zsa
-            END DO
-        END DO
-      END DO        
-
-      ! Save the horizontal advective trends for diagnostic
-      IF( l_trdtra ) THEN
-         ztrdt(:,:,:) = 0.e0   ;   ztrds(:,:,:) = 0.e0
-         !
-         ! T/S ZONAL advection trends
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  !-- Compute zonal divergence by splitting hdivn (see divcur.F90)
-                  !   N.B. This computation is not valid along OBCs (if any)
-#if defined key_zco
-                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) )
-                  z_hdivn_x = (  e2u(ji  ,jj) * pun(ji  ,jj,jk)                              &
-                     &         - e2u(ji-1,jj) * pun(ji-1,jj,jk) ) * zbtr
-#else
-                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  z_hdivn_x = (  e2u(ji  ,jj) * fse3u(ji  ,jj,jk) * pun(ji  ,jj,jk)          &
-                     &         - e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * pun(ji-1,jj,jk) ) * zbtr
-#endif
-                  ztrdt(ji,jj,jk) = - zbtr * ( zt1(ji,jj,jk) - zt1(ji-1,jj,jk) ) + tn(ji,jj,jk) * z_hdivn_x
-                  ztrds(ji,jj,jk) = - zbtr * ( zs1(ji,jj,jk) - zs1(ji-1,jj,jk) ) + sn(ji,jj,jk) * z_hdivn_x
-               END DO
-            END DO
-         END DO
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_xad, 'TRA', kt)
-
-         ! T/S MERIDIONAL advection trends
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  !-- Compute merid. divergence by splitting hdivn (see divcur.F90)
-                  !   N.B. This computation is not valid along OBCs (if any)
-#if defined key_zco
-                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) )
-                  z_hdivn_y = (  e1v(ji,jj  ) * pvn(ji,jj  ,jk)                              &
-                     &         - e1v(ji,jj-1) * pvn(ji,jj-1,jk) ) * zbtr
-#else
-                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  z_hdivn_y = (  e1v(ji,  jj) * fse3v(ji,jj  ,jk) * pvn(ji,jj  ,jk)          &
-                     &         - e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * pvn(ji,jj-1,jk) ) * zbtr
-#endif
-                  ztrdt(ji,jj,jk) = - zbtr * ( zt2(ji,jj,jk) - zt2(ji,jj-1,jk) ) + tn(ji,jj,jk) * z_hdivn_y          
-                  ztrds(ji,jj,jk) = - zbtr * ( zs2(ji,jj,jk) - zs2(ji,jj-1,jk) ) + sn(ji,jj,jk) * z_hdivn_y
-               END DO
-            END DO
-         END DO
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_yad, 'TRA', kt)
-
-         ! Save the up-to-date ta and sa trends
-         ztrdt(:,:,:) = ta(:,:,:) 
-         ztrds(:,:,:) = sa(:,:,:) 
-         !
-      ENDIF
-
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' muscl2 had  - Ta: ', mask1=tmask,   &
-         &                       tab3d_2=sa, clinfo2=              ' Sa: ', mask2=tmask, clinfo3='tra')
-
-      ! "zonal" mean advective heat and salt transport
-      IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN
-         IF( lk_zco ) THEN
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                    zt2(ji,jj,jk) = zt2(ji,jj,jk) * fse3v(ji,jj,jk)
-                    zs2(ji,jj,jk) = zs2(ji,jj,jk) * fse3v(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
-         ENDIF
-         pht_adv(:) = ptr_vj( zt2(:,:,:) )
-         pst_adv(:) = ptr_vj( zs2(:,:,:) )
-      ENDIF
-
-      ! II. Vertical advective fluxes
-      ! -----------------------------
-      
-      ! First guess of the slope
-      ! interior values
-      DO jk = 2, jpkm1
-         zt1(:,:,jk) = tmask(:,:,jk) * ( tb(:,:,jk-1) - tb(:,:,jk) )
-         zs1(:,:,jk) = tmask(:,:,jk) * ( sb(:,:,jk-1) - sb(:,:,jk) )
-      END DO
-      ! surface & bottom boundary conditions
-      zt1 (:,:, 1 ) = 0.e0    ;    zt1 (:,:,jpk) = 0.e0
-      zs1 (:,:, 1 ) = 0.e0    ;    zs1 (:,:,jpk) = 0.e0
-
-      ! Slopes
-      DO jk = 2, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ztp1(ji,jj,jk) =                    ( zt1(ji,jj,jk) + zt1(ji,jj,jk+1) )   &
-                  &           * ( 0.25 + SIGN( 0.25, zt1(ji,jj,jk) * zt1(ji,jj,jk+1) ) )
-               zsp1(ji,jj,jk) =                    ( zs1(ji,jj,jk) + zs1(ji,jj,jk+1) )   &
-                  &           * ( 0.25 + SIGN( 0.25, zs1(ji,jj,jk) * zs1(ji,jj,jk+1) ) )
-            END DO
-         END DO
-      END DO
-
-      ! Slopes limitation
-      ! interior values
-      DO jk = 2, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               ztp1(ji,jj,jk) = SIGN( 1., ztp1(ji,jj,jk) )   &
-                  &           * MIN(    ABS( ztp1(ji,jj,jk  ) ),   &
-                  &                  2.*ABS( zt1 (ji,jj,jk+1) ),   &
-                  &                  2.*ABS( zt1 (ji,jj,jk  ) ) )
-               zsp1(ji,jj,jk) = SIGN( 1., zsp1(ji,jj,jk) )   &
-                  &           * MIN(    ABS( zsp1(ji,jj,jk  ) ),   &
-                  &                  2.*ABS( zs1 (ji,jj,jk+1) ),   &
-                  &                  2.*ABS( zs1 (ji,jj,jk  ) ) )
-            END DO
-         END DO
-      END DO
-      ! surface values
-      ztp1(:,:,1) = 0.e0
-      zsp1(:,:,1) = 0.e0
-
-      ! vertical advective flux
-      ! interior values
-      DO jk = 1, jpkm1
-         zstep  = z2 * rdttra(jk)
-         DO jj = 2, jpjm1      
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zew = pwn(ji,jj,jk+1)
-               z0w = SIGN( 0.5, pwn(ji,jj,jk+1) )
-               zalpha = 0.5 + z0w
-               zw  = z0w - 0.5 * pwn(ji,jj,jk+1)*zstep / fse3w(ji,jj,jk+1)
-               zzt1 = tb(ji,jj,jk+1) + zw*ztp1(ji,jj,jk+1)
-               zzt2 = tb(ji,jj,jk  ) + zw*ztp1(ji,jj,jk  )
-               zzs1 = sb(ji,jj,jk+1) + zw*zsp1(ji,jj,jk+1)
-               zzs2 = sb(ji,jj,jk  ) + zw*zsp1(ji,jj,jk  )
-               zt1(ji,jj,jk+1) = zew * ( zalpha * zzt1 + (1.-zalpha)*zzt2 )
-               zs1(ji,jj,jk+1) = zew * ( zalpha * zzs1 + (1.-zalpha)*zzs2 )
-            END DO
-         END DO
-      END DO
-      DO jk = 2, jpkm1
-        DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               IF( tmask(ji,jj,jk+1) == 0. ) THEN
-                  IF( pwn(ji,jj,jk) > 0. ) THEN
-                     zt1(ji,jj,jk) = pwn(ji,jj,jk) * ( tb(ji,jj,jk-1) + tb(ji,jj,jk) ) * 0.5
-                     zs1(ji,jj,jk) = pwn(ji,jj,jk) * ( sb(ji,jj,jk-1) + sb(ji,jj,jk) ) * 0.5
-                  ENDIF
-               ENDIF
-            END DO
-         END DO
-      END DO
-
-      ! surface values
-      IF( lk_vvl ) THEN
-         ! variable volume : flux set to zero
-         zt1(:,:, 1 ) = 0.e0
-         zs1(:,:, 1 ) = 0.e0
-      ELSE
-         ! free surface-constant volume
-         zt1(:,:, 1 ) = pwn(:,:,1) * tb(:,:,1)
-         zs1(:,:, 1 ) = pwn(:,:,1) * sb(:,:,1)
-      ENDIF
-
-      ! bottom values
-      zt1(:,:,jpk) = 0.e0
-      zs1(:,:,jpk) = 0.e0
-
-
-      ! Compute & add the vertical advective trend
-
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1      
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zbtr = 1. / fse3t(ji,jj,jk)
-               ! horizontal advective trends
-               zta = - zbtr * ( zt1(ji,jj,jk) - zt1(ji,jj,jk+1) )
-               zsa = - zbtr * ( zs1(ji,jj,jk) - zs1(ji,jj,jk+1) )
-               ! add it to the general tracer trends
-               ta(ji,jj,jk) =  ta(ji,jj,jk) + zta
-               sa(ji,jj,jk) =  sa(ji,jj,jk) + zsa
-            END DO
-         END DO
-      END DO
-
-      ! Save the vertical advective trends for diagnostic
-      IF( l_trdtra )   THEN
-         ! Recompute the vertical advection zta & zsa trends computed 
-         ! at the step 2. above in making the difference between the new 
-         ! trends and the previous one: ta()/sa - ztrdt()/ztrds() and substract
-         ! the term tn()/sn()*hdivn() to recover the W gradz(T/S) trends
-
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-#if defined key_zco
-                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) )
-                  z_hdivn_x = e2u(ji,jj)*pun(ji,jj,jk) - e2u(ji-1,jj)*pun(ji-1,jj,jk)
-                  z_hdivn_y = e1v(ji,jj)*pvn(ji,jj,jk) - e1v(ji,jj-1)*pvn(ji,jj-1,jk)
-#else
-                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  z_hdivn_x = e2u(ji,jj)*fse3u(ji,jj,jk)*pun(ji,jj,jk) - e2u(ji-1,jj)*fse3u(ji-1,jj,jk)*pun(ji-1,jj,jk)
-                  z_hdivn_y = e1v(ji,jj)*fse3v(ji,jj,jk)*pvn(ji,jj,jk) - e1v(ji,jj-1)*fse3v(ji,jj-1,jk)*pvn(ji,jj-1,jk)
-#endif
-                  z_hdivn   = (z_hdivn_x + z_hdivn_y) * zbtr
-                  ztrdt(ji,jj,jk) = ta(ji,jj,jk) - ztrdt(ji,jj,jk) - tn(ji,jj,jk) * z_hdivn 
-                  ztrds(ji,jj,jk) = sa(ji,jj,jk) - ztrds(ji,jj,jk) - sn(ji,jj,jk) * z_hdivn
-               END DO
-            END DO
-         END DO
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_zad, 'TRA', kt)
-         !
-      ENDIF
-
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' muscl2 zad  - Ta: ', mask1=tmask,   &
-         &                       tab3d_2=sa, clinfo2=              ' Sa: ', mask2=tmask, clinfo3='tra' )
       !
    END SUBROUTINE tra_adv_muscl2
Index: trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90	(revision 2528)
@@ -2,20 +2,21 @@
    !!==============================================================================
    !!                       ***  MODULE  traadv_qck  ***
-   !! Ocean active tracers:  horizontal & vertical advective trend
+   !! Ocean tracers:  horizontal & vertical advective trend
    !!==============================================================================
    !! History :  3.0  !  2008-07  (G. Reffray)  Original code
+   !!            3.3  !  2010-05  (C.Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
    !!----------------------------------------------------------------------
 
    !!----------------------------------------------------------------------
-   !!   tra_adv_qck      : update the tracer trend with the horizontal advection
-   !!                      trends using a 3rd order finite difference scheme
-   !!   tra_adv_qck_i  : 
-   !!   tra_adv_qck_j  : 
+   !!   tra_adv_qck    : update the tracer trend with the horizontal advection
+   !!                    trends using a 3rd order finite difference scheme
+   !!   tra_adv_qck_i  : apply QUICK scheme in i-direction
+   !!   tra_adv_qck_j  : apply QUICK scheme in j-direction
    !!   tra_adv_cen2_k : 2nd centered scheme for the vertical advection
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and active tracers
    USE dom_oce         ! ocean space and time domain
-   USE trdmod          ! ocean active tracers trends 
-   USE trdmod_oce      ! ocean variables trends
+   USE trdmod_oce      ! ocean space and time domain
+   USE trdtra          ! ocean tracers trends 
    USE trabbl          ! advective term in the BBL
    USE lib_mpp         ! distribued memory computing
@@ -24,5 +25,5 @@
    USE in_out_manager  ! I/O manager
    USE diaptr          ! poleward transport diagnostics
-   USE prtctl          ! Print control
+   USE trc_oce         ! share passive tracers/Ocean variables
 
    IMPLICIT NONE
@@ -31,6 +32,6 @@
    PUBLIC   tra_adv_qck   ! routine called by step.F90
 
-   REAL(wp), DIMENSION(jpi,jpj) ::   btr2
-   REAL(wp)                     ::   r1_6
+   LOGICAL  :: l_trd           ! flag to compute trends
+   REAL(wp) :: r1_6 = 1./ 6.   ! 1/6 ratio
 
    !! * Substitutions
@@ -38,12 +39,12 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
-   SUBROUTINE tra_adv_qck( kt, pun, pvn, pwn )
+   SUBROUTINE tra_adv_qck ( kt, cdtype, p2dt, pun, pvn, pwn,      &
+      &                                       ptb, ptn, pta, kjpt )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_adv_qck  ***
@@ -69,5 +70,5 @@
       !!         dt = 2*rdtra and the scalar values are tb and sb
       !!
-      !!       On the vertical, the simple centered scheme used tn and sn
+      !!       On the vertical, the simple centered scheme used ptn
       !!
       !!               The fluxes are bounded by the ULTIMATE limiter to
@@ -75,391 +76,332 @@
       !!            prevent the appearance of spurious numerical oscillations
       !!
-      !! ** Action : - update (ta,sa) with the now advective tracer trends
-      !!             - save the trends ('key_trdtra')
+      !! ** Action : - update (pta) with the now advective tracer trends
+      !!             - save the trends 
       !!
       !! ** Reference : Leonard (1979, 1991)
       !!----------------------------------------------------------------------
-      USE oce, ONLY :   ztrdt => ua   ! use ua as workspace
-      USE oce, ONLY :   ztrds => va   ! use va as workspace
-      !!
-      INTEGER , INTENT(in)                         ::  kt  ! ocean time-step index
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::  pun ! effective ocean velocity, u_component
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::  pvn ! effective ocean velocity, v_component
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::  pwn ! effective ocean velocity, w_component
-      !!
-      INTEGER  ::   ji, jj, jk                          ! dummy loop indices
-      REAL(wp) ::   z_hdivn_x, z_hdivn_y, z_hdivn       ! temporary scalars
-      REAL(wp) ::   zbtr, z2                            !    "         "
-      !!----------------------------------------------------------------------
-
-      IF( kt == nit000 ) THEN
+      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
+      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 )  THEN
          IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_adv_qck : 3rd order quickest advection scheme'
+         IF(lwp) WRITE(numout,*) 'tra_adv_qck : 3rd order quickest advection scheme on ', cdtype
          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
          IF(lwp) WRITE(numout,*)
-         btr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) )
-         r1_6      = 1. / 6.
+         !
+         l_trd = .FALSE.
+         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.
       ENDIF
 
-      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;    z2 = 1.
-      ELSE                                        ;    z2 = 2.
-      ENDIF
-
       ! I. The horizontal fluxes are computed with the QUICKEST + ULTIMATE scheme
-      !---------------------------------------------------------------------------
-
-      CALL tra_adv_qck_i( pun, tb, tn, ta, ztrdt, z2)
-      CALL tra_adv_qck_i( pun, sb, sn, sa, ztrds, z2)
-
-      IF( l_trdtra ) CALL trd_mod(ztrdt, ztrds, jptra_trd_xad, 'TRA', kt)
-
-      CALL tra_adv_qck_j( kt, pvn, tb, tn, ta, ztrdt, pht_adv, z2)
-      CALL tra_adv_qck_j( kt, pvn, sb, sn, sa, ztrds, pst_adv, z2)  
-
-      IF( l_trdtra ) THEN
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_yad, 'TRA', kt)
-         !
-         ztrdt(:,:,:) = ta(:,:,:)    ! Save the horizontal up-to-date ta/sa trends
-         ztrds(:,:,:) = sa(:,:,:)
-      END IF
-
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' qck had  - Ta: ', mask1=tmask, &
-         &                       tab3d_2=sa, clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' )
+      CALL tra_adv_qck_i( kt, cdtype, p2dt, pun, ptb, ptn, pta, kjpt ) 
+      CALL tra_adv_qck_j( kt, cdtype, p2dt, pvn, ptb, ptn, pta, kjpt ) 
 
       ! II. The vertical fluxes are computed with the 2nd order centered scheme
-      !-------------------------------------------------------------------------
-      !
-      CALL tra_adv_cen2_k( pwn, tn, ta )
-      CALL tra_adv_cen2_k( pwn, sn, sa )
-      !
-      !Save the vertical advective trends for diagnostic
-      ! ----------------------------------------------------
-      IF( l_trdtra )   THEN
-         ! Recompute the vertical advection zta & zsa trends computed
-         ! at the step 2. above in making the difference between the new
-         ! trends and the previous one: ta()/sa - ztrdt()/ztrds() and substract
-         ! the term tn()/sn()*hdivn() to recover the W gradz(T/S) trends
-
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-#if defined key_zco
-                  zbtr      = btr2(ji,jj)
-                  z_hdivn_x = e2u(ji,jj)*pun(ji,jj,jk) - e2u(ji-1,jj)*pun(ji-1,jj,jk)
-                  z_hdivn_y = e1v(ji,jj)*pvn(ji,jj,jk) - e1v(ji,jj-1)*pvn(ji,jj-1,jk)
-#else
-                  zbtr      = btr2(ji,jj) / fse3t(ji,jj,jk)
-                  z_hdivn_x = e2u(ji,jj)*fse3u(ji,jj,jk)*pun(ji,jj,jk) - e2u(ji-1,jj)*fse3u(ji-1,jj,jk)*pun(ji-1,jj,jk)
-                  z_hdivn_y = e1v(ji,jj)*fse3v(ji,jj,jk)*pvn(ji,jj,jk) - e1v(ji,jj-1)*fse3v(ji,jj-1,jk)*pvn(ji,jj-1,jk)
-#endif
-                  z_hdivn   = (z_hdivn_x + z_hdivn_y) * zbtr
-                  ztrdt(ji,jj,jk) = ta(ji,jj,jk) - ztrdt(ji,jj,jk) - tn(ji,jj,jk) * z_hdivn
-                  ztrds(ji,jj,jk) = sa(ji,jj,jk) - ztrds(ji,jj,jk) - sn(ji,jj,jk) * z_hdivn
-               END DO
-            END DO
-         END DO
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_zad, 'TRA', kt)
-      ENDIF
-
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' qck zad  - Ta: ', mask1=tmask, &
-         &                       tab3d_2=sa, clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' )
+      CALL tra_adv_cen2_k( kt, cdtype, pwn,         ptn, pta, kjpt )
       !
    END SUBROUTINE tra_adv_qck
 
 
-   SUBROUTINE tra_adv_qck_i ( pun, tra, tran, traa, ztrdtra, z2 )
-      !!----------------------------------------------------------------------
-      !!
-      !!----------------------------------------------------------------------
-      REAL,     INTENT(in)                            :: z2
-      REAL(wp), INTENT(in)   , DIMENSION(jpi,jpj,jpk) :: pun, tra, tran  ! horizontal effective velocity
-      REAL(wp), INTENT(out)  , DIMENSION(jpi,jpj,jpk) :: ztrdtra
-      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: traa
-      !
-      INTEGER  :: ji, jj, jk
-      REAL(wp) :: za, zbtr, dir, dx, dt     ! temporary scalars
-      REAL(wp) :: z_hdivn_x
-      REAL(wp), DIMENSION(jpi,jpj)     ::  zmask, zupst, zdwst, zc_cfl
-      REAL(wp), DIMENSION(jpi,jpj)     ::  zfu, zfc, zfd, zfho, zmskl, zsc_e 
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zflux
+   SUBROUTINE tra_adv_qck_i( kt, cdtype, p2dt, pun,                  &
+      &                                        ptb, ptn, pta, kjpt   )
+      !!----------------------------------------------------------------------
+      !!
+      !!----------------------------------------------------------------------
+      USE oce         , zwx => ua   ! use ua as workspace
+      !!
+      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
+      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun             ! i-velocity components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+      !!
+      INTEGER  :: ji, jj, jk, jn           ! dummy loop indices
+      REAL(wp) :: ztra, zbtr               ! local scalars
+      REAL(wp) :: zdir, zdx, zdt, zmsk     ! local scalars
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zfu, zfc, zfd   ! 3D wokspace
       !----------------------------------------------------------------------
 
-      zfu   (:,jpj) = 0.e0   ;   zfc   (:,jpj) = 0.e0
-      zfd   (:,jpj) = 0.e0   ;   zc_cfl(:,jpj) = 0.e0
-      zsc_e (:,jpj) = 0.e0   ;   zmskl (:,jpj) = 0.e0
-      zfho  (:,jpj) = 0.e0
-                                                       ! ===============
-      DO jk = 1, jpkm1                                 ! Horizontal slab
-         !                                             ! ===============
-         !--- Computation of the ustream and downstream value of the tracer and the mask
-         DO jj = 2, jpjm1
-            DO ji = 2, fs_jpim1   ! vector opt.
-               ! Upstream in the x-direction for the tracer
-               zupst(ji,jj)=tra(ji-1,jj,jk)
-               ! Downstream in the x-direction for the tracer
-               zdwst(ji,jj)=tra(ji+1,jj,jk)
-               ! Mask at the T-points in the x-direction (mask=0 or mask=1)
-               zmask(ji,jj)=tmask(ji-1,jj,jk)+tmask(ji,jj,jk)+tmask(ji+1,jj,jk)-2
-            END DO
-         END DO
-         !
-         !--- Lateral boundary conditions 
-         CALL lbc_lnk( zupst(:,:), 'T', 1. )
-         CALL lbc_lnk( zdwst(:,:), 'T', 1. ) 
-         CALL lbc_lnk( zmask(:,:), 'T', 1. ) 
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         zfu(:,:,:) = 0.0     ;   zfc(:,:,:) = 0.0  
+         zfd(:,:,:) = 0.0     ;   zwx(:,:,:) = 0.0     
+         !                                                  
+         DO jk = 1, jpkm1                                
+            !                                             
+            !--- Computation of the ustream and downstream value of the tracer and the mask
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ! Upstream in the x-direction for the tracer
+                  zfc(ji,jj,jk) = ptb(ji-1,jj,jk,jn)
+                  ! Downstream in the x-direction for the tracer
+                  zfd(ji,jj,jk) = ptb(ji+1,jj,jk,jn)
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( zfc(:,:,:), 'T', 1. )   ;   CALL lbc_lnk( zfd(:,:,:), 'T', 1. )   ! Lateral boundary conditions 
+         
          !
          ! Horizontal advective fluxes
          ! ---------------------------
          !
-         dt = z2 * rdttra(jk)
-         !--- tracer flux at u-points
-         DO jj = 1, jpjm1
-            DO ji = 1, jpi
-#if defined key_zco
-               zsc_e(ji,jj) = e2u(ji,jj)
-#else
-               zsc_e(ji,jj) = e2u(ji,jj) * fse3u(ji,jj,jk)
-#endif
-               dir = 0.5 + sign(0.5,pun(ji,jj,jk))                             ! if pun>0 : dir = 1 otherwise dir = 0
-               dx = dir * e1t(ji,jj) + (1-dir)* e1t(ji+1,jj)
-               zc_cfl (ji,jj) = ABS(pun(ji,jj,jk))*dt/dx                       ! (0<zc_cfl<1 : Courant number on x-direction)
-
-               zfu(ji,jj)   = dir*zupst(ji  ,jj   )+(1-dir)*zdwst(ji+1,jj   )  ! FU in the x-direction for T
-               zfc(ji,jj)   = dir*tra  (ji  ,jj,jk)+(1-dir)*tra  (ji+1,jj,jk)  ! FC in the x-direction for T
-               zfd(ji,jj)   = dir*tra  (ji+1,jj,jk)+(1-dir)*tra  (ji  ,jj,jk)  ! FD in the x-direction for T
-               zmskl(ji,jj) = dir*zmask(ji  ,jj)   +(1-dir)*zmask(ji+1,jj)
-           END DO
-         END DO
-         !
+         DO jk = 1, jpkm1                             
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.         
+                  zdir = 0.5 + SIGN( 0.5, pun(ji,jj,jk) )   ! if pun > 0 : zdir = 1 otherwise zdir = 0 
+                  zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji+1,jj,jk)  ! FU in the x-direction for T 
+               END DO
+            END DO
+         END DO
+         !
+         DO jk = 1, jpkm1  
+            zdt =  p2dt(jk)
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.   
+                  zdir = 0.5 + SIGN( 0.5, pun(ji,jj,jk) )   ! if pun > 0 : zdir = 1 otherwise zdir = 0 
+                  zdx  = ( zdir * e1t(ji,jj) + ( 1. - zdir ) * e1t(ji+1,jj) ) * e2u(ji,jj) * fse3u(ji,jj,jk)
+                  zwx(ji,jj,jk)  = ABS( pun(ji,jj,jk) ) * zdt / zdx    ! (0<zc_cfl<1 : Courant number on x-direction)
+                  zfc(ji,jj,jk)  = zdir * ptb(ji  ,jj,jk,jn) + ( 1. - zdir ) * ptb(ji+1,jj,jk,jn)  ! FC in the x-direction for T
+                  zfd(ji,jj,jk)  = zdir * ptb(ji+1,jj,jk,jn) + ( 1. - zdir ) * ptb(ji  ,jj,jk,jn)  ! FD in the x-direction for T
+               END DO
+            END DO
+         END DO 
+         !--- Lateral boundary conditions 
+         CALL lbc_lnk( zfu(:,:,:), 'T', 1. )   ;   CALL lbc_lnk( zfd(:,:,:), 'T', 1. )
+         CALL lbc_lnk( zfc(:,:,:), 'T', 1. )   ;   CALL lbc_lnk( zwx(:,:,:), 'T', 1. )
+
          !--- QUICKEST scheme
+         CALL quickest( zfu, zfd, zfc, zwx )
+         !
+         ! Mask at the T-points in the x-direction (mask=0 or mask=1)
+         DO jk = 1, jpkm1  
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.               
+                  zfu(ji,jj,jk) = tmask(ji-1,jj,jk) + tmask(ji,jj,jk) + tmask(ji+1,jj,jk) - 2.
+               ENDDO
+            END DO
+         END DO
+         CALL lbc_lnk( zfu(:,:,:), 'T', 1. )      ! Lateral boundary conditions 
+
+         !
          ! Tracer flux on the x-direction
-         CALL quickest(zfu,zfd,zfc,zfho,zc_cfl)
-         !--- If the second ustream point is a land point
-         !--- the flux is computed by the 1st order UPWIND scheme
-         zfho(:,:) = zmskl(:,:)*zfho(:,:) + (1.-zmskl(:,:))*zfc(:,:)
-         !--- Computation of fluxes
-         zflux(:,:,jk) = zsc_e(:,:)*pun(:,:,jk)*zfho(:,:)
-         !
-         !--- Tracer flux divergence at t-point added to the general trend
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               !--- horizontal advective trends
-#if defined key_zco
-               zbtr = btr2(ji,jj)
-#else
-               zbtr = btr2(ji,jj) / fse3t(ji,jj,jk)              
-#endif
-               za = - zbtr * ( zflux(ji,jj,jk) - zflux(ji-1,jj,jk) )
-               !--- add it to the general tracer trends
-               traa(ji,jj,jk) = traa(ji,jj,jk) + za
-            END DO
-         END DO
-         !                                             ! ===============
-      END DO                                           !   End of slab
-      !                                                ! ===============
+         DO jk = 1, jpkm1  
+            !
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.               
+                  zdir = 0.5 + SIGN( 0.5, pun(ji,jj,jk) )   ! if pun > 0 : zdir = 1 otherwise zdir = 0 
+                  !--- If the second ustream point is a land point
+                  !--- the flux is computed by the 1st order UPWIND scheme
+                  zmsk = zdir * zfu(ji,jj,jk) + ( 1. - zdir ) * zfu(ji+1,jj,jk)
+                  zwx(ji,jj,jk) = zmsk * zwx(ji,jj,jk) + ( 1. - zmsk ) * zfc(ji,jj,jk)
+                  zwx(ji,jj,jk) = zwx(ji,jj,jk) * pun(ji,jj,jk)
+               END DO
+            END DO
+            !
+            ! Computation of the trend
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.  
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ! horizontal advective trends
+                  ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj,jk) )
+                  !--- add it to the general tracer trends
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
+               END DO
+            END DO
+            !
+         END DO
+         !                                 ! trend diagnostics (contribution of upstream fluxes)
+         IF( l_trd )  CALL trd_tra( kt, cdtype, jn, jptra_trd_xad, zwx, pun, ptn(:,:,:,jn) )
+         !
+      END DO
       !
-      !  Save the horizontal advective trends for diagnostic
-      ! -----------------------------------------------------
-      IF( l_trdtra ) THEN
-         ! T/S ZONAL advection trends
-         ztrdtra(:,:,:) = 0.e0
-         !
-         DO jk = 1, jpkm1
+   END SUBROUTINE tra_adv_qck_i
+
+
+   SUBROUTINE tra_adv_qck_j( kt, cdtype, p2dt, pvn,                &
+      &                                        ptb, ptn, pta, kjpt )
+      !!----------------------------------------------------------------------
+      !!
+      !!----------------------------------------------------------------------
+      USE oce         , zwy => ua   ! use ua as workspace
+      !!
+      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
+      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pvn             ! j-velocity components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+      !!
+      INTEGER  :: ji, jj, jk, jn           ! dummy loop indices
+      REAL(wp) :: ztra, zbtr               ! local scalars
+      REAL(wp) :: zdir, zdx, zdt, zmsk     ! local scalars
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zfu, zfc, zfd   ! 3D wokspace
+      !----------------------------------------------------------------------
+
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         zfu(:,:,:) = 0.0     ;   zfc(:,:,:) = 0.0  
+         zfd(:,:,:) = 0.0     ;   zwy(:,:,:) = 0.0     
+         !                                                  
+         DO jk = 1, jpkm1                                
+            !                                             
+            !--- Computation of the ustream and downstream value of the tracer and the mask
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  !-- Compute zonal divergence by splitting hdivn (see divcur.F90)
-                  !   N.B. This computation is not valid along OBCs (if any)
-#if defined key_zco
-                  zbtr      = btr2(ji,jj)
-                  z_hdivn_x = (  e2u(ji  ,jj) * pun(ji  ,jj,jk)                              &
-                     &         - e2u(ji-1,jj) * pun(ji-1,jj,jk) ) * zbtr
-#else
-                  zbtr      = btr2(ji,jj) / fse3t(ji,jj,jk)
-                  z_hdivn_x = (  e2u(ji  ,jj) * fse3u(ji  ,jj,jk) * pun(ji  ,jj,jk)          &
-                     &         - e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * pun(ji-1,jj,jk) ) * zbtr
-#endif
-                  ztrdtra(ji,jj,jk) = - zbtr * ( zflux(ji,jj,jk) - zflux(ji-1,jj,jk) ) + tran(ji,jj,jk) * z_hdivn_x
-               END DO
-            END DO
-         END DO
-      END IF
-
-   END SUBROUTINE tra_adv_qck_i
-
-
-   SUBROUTINE tra_adv_qck_j ( kt, pvn, tra, tran, traa, ztrdtra, trd_adv, z2 )
-      !!----------------------------------------------------------------------
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER,  INTENT(in)                            :: kt              ! ocean time-step index
-      REAL,     INTENT(in)                            :: z2
-      REAL(wp), INTENT(in)   , DIMENSION(jpi,jpj,jpk) :: pvn, tra, tran  ! horizontal effective velocity
-      REAL(wp), INTENT(out)  , DIMENSION(jpj)         :: trd_adv
-      REAL(wp), INTENT(out)  , DIMENSION(jpi,jpj,jpk) :: ztrdtra
-      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: traa
-      !!
-      INTEGER  :: ji, jj, jk
-      REAL(wp) :: za, zbtr, dir, dx, dt     ! temporary scalars
-      REAL(wp) :: z_hdivn_y
-      REAL(wp), DIMENSION(jpi,jpj)     ::  zmask, zupst, zdwst, zc_cfl
-      REAL(wp), DIMENSION(jpi,jpj)     ::  zfu, zfc, zfd, zfho, zmskl, zsc_e
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zflux
-      !----------------------------------------------------------------------
-      ! II. Part 2 : y-direction
-      !----------------------------------------------------------------------
-
-      zfu   (:,jpj) = 0.e0   ;   zfc   (:,jpj) = 0.e0
-      zfd   (:,jpj) = 0.e0   ;   zc_cfl(:,jpj) = 0.e0
-      zsc_e (:,jpj) = 0.e0   ;   zmskl (:,jpj) = 0.e0
-      zfho  (:,jpj) = 0.e0
-
-                                                       ! ===============
-      DO jk = 1, jpkm1                                 ! Horizontal slab
-         !                                             ! ===============
-         !--- Computation of the ustream and downstream value of the tracer and the mask
-         DO jj = 2, jpjm1
-            DO ji = 2, fs_jpim1   ! vector opt.
-               ! Upstream in the x-direction for the tracer
-               zupst(ji,jj)=tra(ji,jj-1,jk)
-               ! Downstream in the x-direction for the tracer
-               zdwst(ji,jj)=tra(ji,jj+1,jk)
-               ! Mask at the T-points in the x-direction (mask=0 or mask=1)
-               zmask(ji,jj)=tmask(ji,jj-1,jk)+tmask(ji,jj,jk)+tmask(ji,jj+1,jk)-2
-            END DO
-         END DO
-         !
-         !--- Lateral boundary conditions
-         CALL lbc_lnk( zupst(:,:), 'T', 1. )
-         CALL lbc_lnk( zdwst(:,:), 'T', 1. )
-         CALL lbc_lnk( zmask(:,:), 'T', 1. )
+                  ! Upstream in the x-direction for the tracer
+                  zfc(ji,jj,jk) = ptb(ji,jj-1,jk,jn)
+                  ! Downstream in the x-direction for the tracer
+                  zfd(ji,jj,jk) = ptb(ji,jj+1,jk,jn)
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( zfc(:,:,:), 'T', 1. )   ;   CALL lbc_lnk( zfd(:,:,:), 'T', 1. )   ! Lateral boundary conditions 
+
+         
          !
          ! Horizontal advective fluxes
          ! ---------------------------
          !
-         dt = z2 * rdttra(jk)
-         !--- tracer flux at v-points
-         DO jj = 1, jpjm1
-            DO ji = 1, jpi
-#if defined key_zco
-               zsc_e(ji,jj) = e1v(ji,jj)
-#else
-               zsc_e(ji,jj) = e1v(ji,jj) * fse3v(ji,jj,jk)
-#endif
-               dir = 0.5 + sign(0.5,pvn(ji,jj,jk))                             ! if pvn>0 : dir = 1 otherwise dir = 0
-               dx = dir * e2t(ji,jj) + (1-dir)* e2t(ji,jj+1)
-               zc_cfl(ji,jj) = ABS(pvn(ji,jj,jk))*dt/dx                        ! (0<zc_cfl<1 : Courant number on y-direction)
-
-               zfu(ji,jj)   = dir*zupst(ji,jj     )+(1-dir)*zdwst(ji,jj+1   )  ! FU in the y-direction for T
-               zfc(ji,jj)   = dir*tra  (ji,jj  ,jk)+(1-dir)*tra  (ji,jj+1,jk)  ! FC in the y-direction for T
-               zfd(ji,jj)   = dir*tra  (ji,jj+1,jk)+(1-dir)*tra  (ji,jj  ,jk)  ! FD in the y-direction for T
-               zmskl(ji,jj) = dir*zmask(ji,jj     )+(1-dir)*zmask(ji,jj+1)
-            END DO
-         END DO
-         !
+         DO jk = 1, jpkm1                             
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.         
+                  zdir = 0.5 + SIGN( 0.5, pvn(ji,jj,jk) )   ! if pun > 0 : zdir = 1 otherwise zdir = 0 
+                  zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji,jj+1,jk)  ! FU in the x-direction for T 
+               END DO
+            END DO
+         END DO
+         !
+         DO jk = 1, jpkm1  
+            zdt =  p2dt(jk)
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.   
+                  zdir = 0.5 + SIGN( 0.5, pvn(ji,jj,jk) )   ! if pun > 0 : zdir = 1 otherwise zdir = 0 
+                  zdx  = ( zdir * e2t(ji,jj) + ( 1. - zdir ) * e2t(ji,jj+1) ) * e1v(ji,jj) * fse3v(ji,jj,jk)
+                  zwy(ji,jj,jk)  = ABS( pvn(ji,jj,jk) ) * zdt / zdx    ! (0<zc_cfl<1 : Courant number on x-direction)
+                  zfc(ji,jj,jk)  = zdir * ptb(ji,jj  ,jk,jn) + ( 1. - zdir ) * ptb(ji,jj+1,jk,jn)  ! FC in the x-direction for T
+                  zfd(ji,jj,jk)  = zdir * ptb(ji,jj+1,jk,jn) + ( 1. - zdir ) * ptb(ji,jj  ,jk,jn)  ! FD in the x-direction for T
+               END DO
+            END DO
+         END DO
+
+         !--- Lateral boundary conditions 
+         CALL lbc_lnk( zfu(:,:,:), 'T', 1. )      ;     CALL lbc_lnk( zfd(:,:,:), 'T', 1. )
+         CALL lbc_lnk( zfc(:,:,:), 'T', 1. )      ;     CALL lbc_lnk( zwy(:,:,:), 'T', 1. )
+
          !--- QUICKEST scheme
-         ! Tracer flux on the y-direction
-         CALL quickest(zfu,zfd,zfc,zfho,zc_cfl)
-         !--- If the second ustream point is a land point
-         !--- the flux is computed by the 1st order UPWIND scheme
-         zfho(:,:) = zmskl(:,:)*zfho(:,:) + (1.-zmskl(:,:))*zfc(:,:)
-         !--- Computation of fluxes
-         zflux(:,:,jk) = zsc_e(:,:)*pvn(:,:,jk)*zfho(:,:)
-         !
-         !--- Tracer flux divergence at t-point added to the general trend
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               !--- horizontal advective trends
-#if defined key_zco
-               zbtr = btr2(ji,jj)
-#else
-               zbtr = btr2(ji,jj) / fse3t(ji,jj,jk)
-#endif
-               za = - zbtr * ( zflux(ji,jj,jk) - zflux(ji,jj-1,jk) )
-               !--- add it to the general tracer trends
-               traa(ji,jj,jk) = traa(ji,jj,jk) + za
-            END DO
-         END DO
-         !                                             ! ===============
-      END DO                                           !   End of slab
-      !                                                ! ===============
-      !
-      !  Save the horizontal advective trends for diagnostic
-      ! -----------------------------------------------------
-      IF( l_trdtra ) THEN
-         ! T/S MERIDIONAL advection trends
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  !-- Compute merid. divergence by splitting hdivn (see divcur.F90)
-                  !   N.B. This computation is not valid along OBCs (if any)
-#if defined key_zco
-                  zbtr      = btr2(ji,jj)
-                  z_hdivn_y = (  e1v(ji,jj  ) * pvn(ji,jj  ,jk)                              &
-                     &         - e1v(ji,jj-1) * pvn(ji,jj-1,jk) ) * zbtr
-#else
-                  zbtr      = btr2(ji,jj) / fse3t(ji,jj,jk)
-                  z_hdivn_y = (  e1v(ji,  jj) * fse3v(ji,jj  ,jk) * pvn(ji,jj  ,jk)          &
-                     &         - e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * pvn(ji,jj-1,jk) ) * zbtr
-#endif
-                  ztrdtra(ji,jj,jk) = - zbtr * ( zflux(ji,jj,jk) - zflux(ji,jj-1,jk) ) + tran(ji,jj,jk) * z_hdivn_y
-               END DO
-            END DO
-         END DO
-      END IF
-
-      ! "zonal" mean advective heat and salt transport
-      ! ----------------------------------------------
-
-      IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN
-         IF( lk_zco ) THEN
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                    zflux(ji,jj,jk) = zflux(ji,jj,jk) * fse3v(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
+         CALL quickest( zfu, zfd, zfc, zwy )
+         !
+         ! Mask at the T-points in the x-direction (mask=0 or mask=1)
+         DO jk = 1, jpkm1  
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.               
+                  zfu(ji,jj,jk) = tmask(ji,jj-1,jk) + tmask(ji,jj,jk) + tmask(ji,jj+1,jk) - 2.
+               END DO
+            END DO
+         END DO
+         !--- Lateral boundary conditions 
+         CALL lbc_lnk( zfu(:,:,:), 'T', 1. ) 
+         !
+         ! Tracer flux on the x-direction
+         DO jk = 1, jpkm1  
+            !
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.               
+                  zdir = 0.5 + SIGN( 0.5, pvn(ji,jj,jk) )   ! if pun > 0 : zdir = 1 otherwise zdir = 0 
+                  !--- If the second ustream point is a land point
+                  !--- the flux is computed by the 1st order UPWIND scheme
+                  zmsk = zdir * zfu(ji,jj,jk) + ( 1. - zdir ) * zfu(ji,jj+1,jk)
+                  zwy(ji,jj,jk) = zmsk * zwy(ji,jj,jk) + ( 1. - zmsk ) * zfc(ji,jj,jk)
+                  zwy(ji,jj,jk) = zwy(ji,jj,jk) * pvn(ji,jj,jk)
+               END DO
+            END DO
+            !
+            ! Computation of the trend
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.  
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ! horizontal advective trends
+                  ztra = - zbtr * ( zwy(ji,jj,jk) - zwy(ji,jj-1,jk) )
+                  !--- add it to the general tracer trends
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
+               END DO
+            END DO
+            !
+         END DO
+         !                                 ! trend diagnostics (contribution of upstream fluxes)
+         IF( l_trd )  CALL trd_tra( kt, cdtype, jn, jptra_trd_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(:,:,:) )
          ENDIF
-         trd_adv(:) = ptr_vj( zflux(:,:,:) )
-      ENDIF
-
-   END SUBROUTINE tra_adv_qck_j
-
-
-   SUBROUTINE tra_adv_cen2_k ( pwn, ptn, pta )
-      !!----------------------------------------------------------------------
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,jpk)  :: pwn   ! vertical effective velocity
-      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,jpk)  :: ptn   ! now tracer
-      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk)  :: pta   ! tracer general trend
-      !!
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zflux   ! 3D workspace
-      !!----------------------------------------------------------------------
-      !
-      !                         !==  Vertical advective fluxes  ==!
-      zflux(:,:,jpk) = 0.e0             ! Bottom value : flux set to zero
-      !
-      !                                 ! Surface value
-      IF( lk_vvl ) THEN   ;   zflux(:,:, 1 ) = 0.e0                      ! Variable volume : flux set to zero
-      ELSE                ;   zflux(:,:, 1 ) = pwn(:,:,1) * ptn(:,:,1)   ! Constant volume : advective flux through the surface
-      ENDIF
-      !
-      DO jk = 2, jpkm1                  ! Interior point: second order centered tracer flux at w-point
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zflux(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk-1) + ptn(ji,jj,jk) )
-            END DO
-         END DO
+         !
       END DO
       !
-      DO jk = 1, jpkm1          !==  Tracer flux divergence added to the general trend  ==!
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               pta(ji,jj,jk) =  pta(ji,jj,jk) - ( zflux(ji,jj,jk) - zflux(ji,jj,jk+1) )   &
-                  &                           /   fse3t(ji,jj,jk)
-            END DO
-         END DO
+   END SUBROUTINE tra_adv_qck_j
+
+
+   SUBROUTINE tra_adv_cen2_k( kt, cdtype, pwn,           &
+     &                                    ptn, pta, kjpt )
+      !!----------------------------------------------------------------------
+      !!
+      !!----------------------------------------------------------------------
+      USE oce         , zwz => ua   ! use ua as workspace
+      !!
+      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pwn             ! vertical velocity 
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptn             ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+      !!
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::   zbtr , ztra      ! temporary scalars
+      !!----------------------------------------------------------------------
+
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         ! 1. Bottom value : flux set to zero
+         zwz(:,:,jpk) = 0.e0             ! Bottom value : flux set to zero
+         !
+         !                                 ! Surface value
+         IF( lk_vvl ) THEN   ;   zwz(:,:, 1 ) = 0.e0                      ! Variable volume : flux set to zero
+         ELSE                ;   zwz(:,:, 1 ) = pwn(:,:,1) * ptn(:,:,1,jn)   ! Constant volume : advective flux through the surface
+         ENDIF
+         !
+         DO jk = 2, jpkm1                  ! Interior point: second order centered tracer flux at w-point
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk-1,jn) + ptn(ji,jj,jk,jn) )
+               END DO
+            END DO
+         END DO
+         !
+         DO jk = 1, jpkm1          !==  Tracer flux divergence added to the general trend  ==!
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ! k- vertical advective trends 
+                  ztra = - zbtr * ( zwz(ji,jj,jk) - zwz(ji,jj,jk+1) ) 
+                  ! added to the general tracer trends
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
+               END DO
+            END DO
+         END DO
+         !                                 ! Save the vertical advective trends for diagnostic
+         IF( l_trd )  CALL trd_tra( kt, cdtype, jn, jptra_trd_zad, zwz, pwn, ptn(:,:,:,jn) )
+         !
       END DO
       !
@@ -467,34 +409,50 @@
 
 
-   SUBROUTINE quickest( fu, fd, fc, fho, fc_cfl )
-      !!----------------------------------------------------------------------
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), INTENT(in)  , DIMENSION(jpi,jpj) :: fu, fd, fc, fc_cfl  
-      REAL(wp), INTENT(out) , DIMENSION(jpi,jpj) :: fho
-      REAL(wp)              , DIMENSION(jpi,jpj) :: zcurv, zcoef1, zcoef2, zcoef3  ! temporary scalars
-      !
-      zcurv (:,:) = fd(:,:) + fu(:,:) - 2.*fc(:,:)
-      zcoef1(:,:) = 0.5*( fc(:,:) + fd(:,:) )
-      zcoef2(:,:) = 0.5*fc_cfl(:,:)*( fd(:,:) - fc(:,:) )
-      zcoef3(:,:) = ( ( 1. - ( fc_cfl(:,:)*fc_cfl(:,:) ) )*r1_6 )*zcurv(:,:)
-      fho   (:,:) = zcoef1(:,:) - zcoef2(:,:) - zcoef3(:,:)                         ! phi_f QUICKEST 
-      !
-      zcoef1(:,:) = fd(:,:) - fu(:,:)                                               ! DEL
-      zcoef2(:,:) = ABS( zcoef1(:,:) )                                              ! ABS(DEL)
-      zcoef3(:,:) = ABS( zcurv(:,:) )                                               ! ABS(CURV)
-      !
-      WHERE ( zcoef3(:,:) >= zcoef2(:,:) ) 
-        fho(:,:) = fc(:,:)
-      ELSEWHERE
-        zcoef3(:,:) = fu(:,:) + ( ( fc(:,:) - fu(:,:) )/MAX(fc_cfl(:,:),1.e-9) )    ! phi_REF
-          WHERE ( zcoef1(:,:) >= 0.e0 )
-            fho(:,:) = MAX(fc(:,:),fho(:,:))
-            fho(:,:) = MIN(fho(:,:),MIN(zcoef3(:,:),fd(:,:)))
-          ELSEWHERE
-            fho(:,:) = MIN(fc(:,:),fho(:,:))
-            fho(:,:) = MAX(fho(:,:),MAX(zcoef3(:,:),fd(:,:)))
-          ENDWHERE
-      ENDWHERE
+   SUBROUTINE quickest( pfu, pfd, pfc, puc )
+      !!----------------------------------------------------------------------
+      !!
+      !! ** Purpose :  Computation of advective flux with Quickest scheme
+      !!
+      !! ** Method :   
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pfu   ! second upwind point
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pfd   ! first douwning point
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pfc   ! the central point (or the first upwind point)
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   puc   ! input as Courant number ; output as flux
+      !!
+      INTEGER  ::  ji, jj, jk               ! dummy loop indices 
+      REAL(wp) ::  zcoef1, zcoef2, zcoef3   ! local scalars          
+      REAL(wp) ::  zc, zcurv, zfho          !   -      -
+      !----------------------------------------------------------------------
+
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zc     = puc(ji,jj,jk)                         ! Courant number
+               zcurv  = pfd(ji,jj,jk) + pfu(ji,jj,jk) - 2. * pfc(ji,jj,jk)
+               zcoef1 = 0.5 *      ( pfc(ji,jj,jk) + pfd(ji,jj,jk) )
+               zcoef2 = 0.5 * zc * ( pfd(ji,jj,jk) - pfc(ji,jj,jk) )
+               zcoef3 = ( 1. - ( zc * zc ) ) * r1_6 * zcurv
+               zfho   = zcoef1 - zcoef2 - zcoef3              !  phi_f QUICKEST 
+               !
+               zcoef1 = pfd(ji,jj,jk) - pfu(ji,jj,jk)
+               zcoef2 = ABS( zcoef1 )
+               zcoef3 = ABS( zcurv )
+               IF( zcoef3 >= zcoef2 ) THEN
+                  zfho = pfc(ji,jj,jk) 
+               ELSE
+                  zcoef3 = pfu(ji,jj,jk) + ( ( pfc(ji,jj,jk) - pfu(ji,jj,jk) ) / MAX( zc, 1.e-9 ) )    ! phi_REF
+                  IF( zcoef1 >= 0. ) THEN
+                     zfho = MAX( pfc(ji,jj,jk), zfho ) 
+                     zfho = MIN( zfho, MIN( zcoef3, pfd(ji,jj,jk) ) ) 
+                  ELSE
+                     zfho = MIN( pfc(ji,jj,jk), zfho ) 
+                     zfho = MAX( zfho, MAX( zcoef3, pfd(ji,jj,jk) ) ) 
+                  ENDIF
+               ENDIF
+               puc(ji,jj,jk) = zfho
+            END DO
+         END DO
+      END DO
       !
    END SUBROUTINE quickest
Index: trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90	(revision 2528)
@@ -2,17 +2,17 @@
    !!==============================================================================
    !!                       ***  MODULE  traadv_tvd  ***
-   !! Ocean active tracers:  horizontal & vertical advective trend
+   !! Ocean  tracers:  horizontal & vertical advective trend
    !!==============================================================================
-   !! History :       !  95-12  (L. Mortier)  Original code
-   !!                 !  00-01  (H. Loukos)  adapted to ORCA 
-   !!                 !  00-10  (MA Foujols E.Kestenare)  include file not routine
-   !!                 !  00-12  (E. Kestenare M. Levy)  fix bug in trtrd indexes
-   !!                 !  01-07  (E. Durand G. Madec)  adaptation to ORCA config
-   !!            8.5  !  02-06  (G. Madec)  F90: Free form and module
-   !!            9.0  !  04-01  (A. de Miranda, G. Madec, J.M. Molines ): advective bbl
-   !!            9.0  !  08-04  (S. Cravatte) add the i-, j- & k- trends computation
-   !!            " "  !  05-11  (V. Garnier) Surface pressure gradient organization
-   !!----------------------------------------------------------------------
-
+   !! History :  OPA  !  1995-12  (L. Mortier)  Original code
+   !!                 !  2000-01  (H. Loukos)  adapted to ORCA 
+   !!                 !  2000-10  (MA Foujols E.Kestenare)  include file not routine
+   !!                 !  2000-12  (E. Kestenare M. Levy)  fix bug in trtrd indexes
+   !!                 !  2001-07  (E. Durand G. Madec)  adaptation to ORCA config
+   !!            8.5  !  2002-06  (G. Madec)  F90: Free form and module
+   !!    NEMO    1.0  !  2004-01  (A. de Miranda, G. Madec, J.M. Molines ): advective bbl
+   !!            2.0  !  2008-04  (S. Cravatte) add the i-, j- & k- trends computation
+   !!             -   !  2009-11  (V. Garnier) Surface pressure gradient organization
+   !!            3.3  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
+   !!----------------------------------------------------------------------
 
    !!----------------------------------------------------------------------
@@ -24,13 +24,12 @@
    USE oce             ! ocean dynamics and active tracers
    USE dom_oce         ! ocean space and time domain
-   USE trdmod          ! ocean active tracers trends 
-   USE trdmod_oce      ! ocean variables trends
+   USE trdmod_oce      ! tracers trends
+   USE trdtra      ! tracers trends
    USE in_out_manager  ! I/O manager
    USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient
-   USE trabbl          ! Advective term of BBL
    USE lib_mpp
    USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
    USE diaptr          ! poleward transport diagnostics
-   USE prtctl          ! Print control
+   USE trc_oce         ! share passive tracers/Ocean variables
 
 
@@ -39,4 +38,6 @@
 
    PUBLIC   tra_adv_tvd    ! routine called by step.F90
+
+   LOGICAL  :: l_trd       ! flag to compute trends
 
    !! * Substitutions
@@ -44,12 +45,12 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2006) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
-   SUBROUTINE tra_adv_tvd( kt, pun, pvn, pwn )
+   SUBROUTINE tra_adv_tvd ( kt, cdtype, p2dt, pun, pvn, pwn,      &
+      &                                       ptb, ptn, pta, kjpt )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_adv_tvd  ***
@@ -62,321 +63,186 @@
       !!       note: - this advection scheme needs a leap-frog time scheme
       !!
-      !! ** Action : - update (ta,sa) with the now advective tracer trends
-      !!             - save the trends in (ztrdt,ztrds) ('key_trdtra')
-      !!----------------------------------------------------------------------
-      USE oce              , ztrdt => ua   ! use ua as workspace
-      USE oce              , ztrds => va   ! use va as workspace
-      !!
-      INTEGER , INTENT(in)                         ::   kt    ! ocean time-step index
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pun   ! ocean velocity u-component
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pvn   ! ocean velocity v-component
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pwn   ! ocean velocity w-component
-      !!
-      INTEGER  ::   ji, jj, jk              ! dummy loop indices
-      REAL(wp) ::                        &  ! temporary scalar
-         ztat, zsat,                     &  !    "         "   
-         z_hdivn_x, z_hdivn_y, z_hdivn
-      REAL(wp) ::   &
-         z2dtt, zbtr, zeu, zev,          &  ! temporary scalar
-         zew, z2, zbtr1,                 &  ! temporary scalar
-         zfp_ui, zfp_vj, zfp_wk,         &  !    "         "
-         zfm_ui, zfm_vj, zfm_wk             !    "         "
-      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zti, ztu, ztv, ztw   ! temporary workspace
-      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zsi, zsu, zsv, zsw   !    "           "
-      !!----------------------------------------------------------------------
-
-      zti(:,:,:) = 0.e0   ;   zsi(:,:,:) = 0.e0
-
-      IF( kt == nit000 .AND. lwp ) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'tra_adv_tvd : TVD advection scheme'
-         WRITE(numout,*) '~~~~~~~~~~~'
+      !! ** Action : - update (pta) with the now advective tracer trends
+      !!             - save the trends 
+      !!----------------------------------------------------------------------
+      USE oce         , zwx => ua   ! use ua as workspace
+      USE oce         , zwy => va   ! use va as workspace
+      !!
+      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
+      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+      !!
+      INTEGER  ::   ji, jj, jk, jn           ! dummy loop indices  
+      REAL(wp) ::   z2dtt, zbtr, ztra        ! local scalar
+      REAL(wp) ::   zfp_ui, zfp_vj, zfp_wk   !   -      -
+      REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk   !   -      -
+      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zwi, zwz   ! 3D workspace
+      REAL(wp), DIMENSION (:,:,:), ALLOCATABLE ::   ztrdx, ztrdy, ztrdz
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_adv_tvd : TVD advection scheme on ', cdtype
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+         !
+         l_trd = .FALSE.
+         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.
       ENDIF
-
-      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;    z2 = 1.
-      ELSE                                        ;    z2 = 2.
-      ENDIF
-
-      ! 1. Bottom value : flux set to zero
-      ! ---------------
-      ztu(:,:,jpk) = 0.e0   ;   zsu(:,:,jpk) = 0.e0
-      ztv(:,:,jpk) = 0.e0   ;   zsv(:,:,jpk) = 0.e0
-      ztw(:,:,jpk) = 0.e0   ;   zsw(:,:,jpk) = 0.e0
-      zti(:,:,jpk) = 0.e0   ;   zsi(:,:,jpk) = 0.e0
-
-
-      ! 2. upstream advection with initial mass fluxes & intermediate update
-      ! --------------------------------------------------------------------
-      ! upstream tracer flux in the i and j direction
-      DO jk = 1, jpkm1
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               zeu = 0.5 * e2u(ji,jj) * fse3u(ji,jj,jk) * pun(ji,jj,jk)
-               zev = 0.5 * e1v(ji,jj) * fse3v(ji,jj,jk) * pvn(ji,jj,jk)
-               ! upstream scheme
-               zfp_ui = zeu + ABS( zeu )
-               zfm_ui = zeu - ABS( zeu )
-               zfp_vj = zev + ABS( zev )
-               zfm_vj = zev - ABS( zev )
-               ztu(ji,jj,jk) = zfp_ui * tb(ji,jj,jk) + zfm_ui * tb(ji+1,jj  ,jk)
-               ztv(ji,jj,jk) = zfp_vj * tb(ji,jj,jk) + zfm_vj * tb(ji  ,jj+1,jk)
-               zsu(ji,jj,jk) = zfp_ui * sb(ji,jj,jk) + zfm_ui * sb(ji+1,jj  ,jk)
-               zsv(ji,jj,jk) = zfp_vj * sb(ji,jj,jk) + zfm_vj * sb(ji  ,jj+1,jk)
-            END DO
-         END DO
-      END DO
-
-      ! upstream tracer flux in the k direction
-      ! Surface value
-      IF( lk_vvl ) THEN
-         ! variable volume : flux set to zero
-         ztw(:,:,1) = 0.e0
-         zsw(:,:,1) = 0.e0
-      ELSE
-         ! free surface-constant volume
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zew = e1t(ji,jj) * e2t(ji,jj) * pwn(ji,jj,1)
-               ztw(ji,jj,1) = zew * tb(ji,jj,1)
-               zsw(ji,jj,1) = zew * sb(ji,jj,1)
-            END DO
-         END DO
-      ENDIF
-
-      ! Interior value
-      DO jk = 2, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zew = 0.5 * e1t(ji,jj) * e2t(ji,jj) * pwn(ji,jj,jk)
-               zfp_wk = zew + ABS( zew )
-               zfm_wk = zew - ABS( zew )
-               ztw(ji,jj,jk) = zfp_wk * tb(ji,jj,jk) + zfm_wk * tb(ji,jj,jk-1)
-               zsw(ji,jj,jk) = zfp_wk * sb(ji,jj,jk) + zfm_wk * sb(ji,jj,jk-1)
-            END DO
-         END DO
-      END DO
-
-      ! total advective trend
-      DO jk = 1, jpkm1
-         z2dtt = z2 * rdttra(jk)
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zbtr = 1./ ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               ! total intermediate advective trends
-               ztat = - ( ztu(ji,jj,jk) - ztu(ji-1,jj  ,jk  )   &
-                  &     + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk  )   &
-                  &     + ztw(ji,jj,jk) - ztw(ji  ,jj  ,jk+1) ) * zbtr
-               zsat = - ( zsu(ji,jj,jk) - zsu(ji-1,jj  ,jk  )   & 
-                  &     + zsv(ji,jj,jk) - zsv(ji  ,jj-1,jk  )   &
-                  &     + zsw(ji,jj,jk) - zsw(ji  ,jj  ,jk+1) ) * zbtr
-               ! update and guess with monotonic sheme
-               ta(ji,jj,jk) =  ta(ji,jj,jk) + ztat
-               sa(ji,jj,jk) =  sa(ji,jj,jk) + zsat
-               zti (ji,jj,jk) = ( tb(ji,jj,jk) + z2dtt * ztat ) * tmask(ji,jj,jk)
-               zsi (ji,jj,jk) = ( sb(ji,jj,jk) + z2dtt * zsat ) * tmask(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-
-      ! "zonal" mean advective heat and salt transport
-      IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN
-         pht_adv(:) = ptr_vj( ztv(:,:,:) )
-         pst_adv(:) = ptr_vj( zsv(:,:,:) )
-      ENDIF
-
-      ! Save the intermediate i / j / k advective trends for diagnostics
-      ! -------------------------------------------------------------------
-      ! Warning : We should use zun instead of un in the computations below, but we
-      ! also use hdivn which is computed with un, vn (check ???). So we use un, vn
-      ! for consistency. Results are therefore approximate with key_trabbl_adv.
-
-      IF( l_trdtra ) THEN
-         ztrdt(:,:,:) = 0.e0   ;   ztrds(:,:,:) = 0.e0
-         ! 
-         ! T/S ZONAL advection trends
+      !
+      IF( l_trd )  THEN
+        ALLOCATE( ztrdx(jpi,jpj,jpk) )      ;      ztrdx(:,:,:) = 0.e0
+        ALLOCATE( ztrdy(jpi,jpj,jpk) )      ;      ztrdy(:,:,:) = 0.e0
+        ALLOCATE( ztrdz(jpi,jpj,jpk) )      ;      ztrdz(:,:,:) = 0.e0
+      END IF
+      !
+      zwi(:,:,:) = 0.e0
+      !
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         ! 1. Bottom value : flux set to zero
+         ! ----------------------------------
+         zwx(:,:,jpk) = 0.e0    ;    zwz(:,:,jpk) = 0.e0
+         zwy(:,:,jpk) = 0.e0    ;    zwi(:,:,jpk) = 0.e0
+
+         ! 2. upstream advection with initial mass fluxes & intermediate update
+         ! --------------------------------------------------------------------
+         ! upstream tracer flux in the i and j direction
          DO jk = 1, jpkm1
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  ! upstream scheme
+                  zfp_ui = pun(ji,jj,jk) + ABS( pun(ji,jj,jk) )
+                  zfm_ui = pun(ji,jj,jk) - ABS( pun(ji,jj,jk) )
+                  zfp_vj = pvn(ji,jj,jk) + ABS( pvn(ji,jj,jk) )
+                  zfm_vj = pvn(ji,jj,jk) - ABS( pvn(ji,jj,jk) )
+                  zwx(ji,jj,jk) = 0.5 * ( zfp_ui * ptb(ji,jj,jk,jn) + zfm_ui * ptb(ji+1,jj  ,jk,jn) )
+                  zwy(ji,jj,jk) = 0.5 * ( zfp_vj * ptb(ji,jj,jk,jn) + zfm_vj * ptb(ji  ,jj+1,jk,jn) )
+               END DO
+            END DO
+         END DO
+
+         ! upstream tracer flux in the k direction
+         ! Surface value
+         IF( lk_vvl ) THEN   ;   zwz(:,:, 1 ) = 0.e0                         ! volume variable
+         ELSE                ;   zwz(:,:, 1 ) = pwn(:,:,1) * ptb(:,:,1,jn)   ! linear free surface 
+         ENDIF
+         ! 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) )
+               END DO
+            END DO
+         END DO
+
+         ! total advective trend
+         DO jk = 1, jpkm1
+            z2dtt = p2dt(jk)
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  ztrdt(ji,jj,jk) = - ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) ) * zbtr
-                  ztrds(ji,jj,jk) = - ( zsu(ji,jj,jk) - zsu(ji-1,jj,jk) ) * zbtr
-               END DO
-            END DO
-         END DO
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_xad, 'TRA', kt)    ! save the trends
+                  ! total intermediate advective trends
+                  ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
+                     &             + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   &
+                     &             + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) )
+                  ! update and guess with monotonic sheme
+                  pta(ji,jj,jk,jn) =   pta(ji,jj,jk,jn)         + ztra
+                  zwi(ji,jj,jk)    = ( ptb(ji,jj,jk,jn) + z2dtt * ztra ) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !                             ! Lateral boundary conditions on zwi  (unchanged sign)
+         CALL lbc_lnk( zwi, 'T', 1. )  
+
+         !                                 ! trend diagnostics (contribution of upstream fluxes)
+         IF( l_trd )  THEN 
+            ! store intermediate advective trends
+            ztrdx(:,:,:) = zwx(:,:,:)   ;    ztrdy(:,:,:) = zwy(:,:,:)  ;   ztrdz(:,:,:) = zwz(:,:,:)
+         END IF
+         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         IF( cdtype == 'TRA' .AND. ln_diaptr .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(:,:,:) )
+         ENDIF
+
+         ! 3. antidiffusive flux : high order minus low order
+         ! --------------------------------------------------
+         ! antidiffusive flux on i and j
+         DO jk = 1, jpkm1
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwx(ji,jj,jk) = 0.5 * pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj,jk,jn) ) - zwx(ji,jj,jk)
+                  zwy(ji,jj,jk) = 0.5 * pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj+1,jk,jn) ) - zwy(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+      
+         ! antidiffusive flux on k
+         zwz(:,:,1) = 0.e0         ! Surface value
          !
-         ! T/S MERIDIONAL advection trends
+         DO jk = 2, jpkm1          ! Interior value
+            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
+         CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. )         ! Lateral bondary conditions
+         CALL lbc_lnk( zwz, 'W',  1. )
+
+         ! 4. monotonicity algorithm
+         ! -------------------------
+         CALL nonosc( ptb(:,:,:,jn), zwx, zwy, zwz, zwi, p2dt )
+
+
+         ! 5. final trend with corrected fluxes
+         ! ------------------------------------
          DO jk = 1, jpkm1
             DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  ztrdt(ji,jj,jk) = - ( ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) * zbtr
-                  ztrds(ji,jj,jk) = - ( zsv(ji,jj,jk) - zsv(ji,jj-1,jk) ) * zbtr
-               END DO
-            END DO
-         END DO
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_yad, 'TRA', kt)     ! save the trends
+               DO ji = fs_2, fs_jpim1   ! vector opt.  
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ! total advective trends
+                  ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
+                     &             + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   &
+                     &             + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) )
+                  ! add them to the general tracer trends
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
+               END DO
+            END DO
+         END DO
+
+         !                                 ! trend diagnostics (contribution of upstream fluxes)
+         IF( l_trd )  THEN 
+            ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< Add to previously computed
+            ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed
+            ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  ! <<< Add to previously computed
+            
+            CALL trd_tra( kt, cdtype, jn, jptra_trd_xad, ztrdx, pun, ptn(:,:,:,jn) )   
+            CALL trd_tra( kt, cdtype, jn, jptra_trd_yad, ztrdy, pvn, ptn(:,:,:,jn) )  
+            CALL trd_tra( kt, cdtype, jn, jptra_trd_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 
+         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(:)
+         ENDIF
          !
-         ! T/S VERTICAL advection trends
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.         
-                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  ztrdt(ji,jj,jk) = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * zbtr
-                  ztrds(ji,jj,jk) = - ( zsw(ji,jj,jk) - zsw(ji,jj,jk+1) ) * zbtr
-               END DO
-            END DO
-         END DO
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_zad, 'TRA', kt)     ! save the trends
-         !
-      ENDIF
-
-      ! Lateral boundary conditions on zti, zsi   (unchanged sign)
-      CALL lbc_lnk( zti, 'T', 1. )
-      CALL lbc_lnk( zsi, 'T', 1. )
-
-
-      ! 3. antidiffusive flux : high order minus low order
-      ! --------------------------------------------------
-      ! antidiffusive flux on i and j
-      DO jk = 1, jpkm1
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               zeu = 0.5 * e2u(ji,jj) * fse3u(ji,jj,jk) * pun(ji,jj,jk)
-               zev = 0.5 * e1v(ji,jj) * fse3v(ji,jj,jk) * pvn(ji,jj,jk)
-               ztu(ji,jj,jk) = zeu * ( tn(ji,jj,jk) + tn(ji+1,jj,jk) ) - ztu(ji,jj,jk)
-               zsu(ji,jj,jk) = zeu * ( sn(ji,jj,jk) + sn(ji+1,jj,jk) ) - zsu(ji,jj,jk)
-               ztv(ji,jj,jk) = zev * ( tn(ji,jj,jk) + tn(ji,jj+1,jk) ) - ztv(ji,jj,jk)
-               zsv(ji,jj,jk) = zev * ( sn(ji,jj,jk) + sn(ji,jj+1,jk) ) - zsv(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-      
-      ! antidiffusive flux on k
-      ! Surface value
-      ztw(:,:,1) = 0.e0
-      zsw(:,:,1) = 0.e0
-
-      ! Interior value
-      DO jk = 2, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zew = 0.5 * e1t(ji,jj) * e2t(ji,jj) * pwn(ji,jj,jk)
-               ztw(ji,jj,jk) = zew * ( tn(ji,jj,jk) + tn(ji,jj,jk-1) ) - ztw(ji,jj,jk)
-               zsw(ji,jj,jk) = zew * ( sn(ji,jj,jk) + sn(ji,jj,jk-1) ) - zsw(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-
-      ! Lateral bondary conditions
-      CALL lbc_lnk( ztu, 'U', -1. )   ;   CALL lbc_lnk( zsu, 'U', -1. )
-      CALL lbc_lnk( ztv, 'V', -1. )   ;   CALL lbc_lnk( zsv, 'V', -1. )
-      CALL lbc_lnk( ztw, 'W',  1. )   ;   CALL lbc_lnk( zsw, 'W',  1. )
-
-      ! 4. monotonicity algorithm
-      ! -------------------------
-      CALL nonosc( tb, ztu, ztv, ztw, zti, z2 )
-      CALL nonosc( sb, zsu, zsv, zsw, zsi, z2 )
-
-
-      ! 5. final trend with corrected fluxes
-      ! ------------------------------------
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.  
-               zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               ! total advective trends
-               ztat = - ( ztu(ji,jj,jk) - ztu(ji-1,jj  ,jk  )   &
-                  &     + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk  )   &
-                  &     + ztw(ji,jj,jk) - ztw(ji  ,jj  ,jk+1) ) * zbtr
-               zsat = - ( zsu(ji,jj,jk) - zsu(ji-1,jj  ,jk  )   &
-                  &     + zsv(ji,jj,jk) - zsv(ji  ,jj-1,jk  )   &
-                  &     + zsw(ji,jj,jk) - zsw(ji  ,jj  ,jk+1) ) * zbtr
-               ! add them to the general tracer trends
-               ta(ji,jj,jk) = ta(ji,jj,jk) + ztat
-               sa(ji,jj,jk) = sa(ji,jj,jk) + zsat
-            END DO
-         END DO
-      END DO
-
-
-      ! Save the advective trends for diagnostics
-      ! --------------------------------------------
-
-      IF( l_trdtra ) THEN
-         ztrdt(:,:,:) = 0.e0   ;   ztrds(:,:,:) = 0.e0
-         !
-         ! T/S ZONAL advection trends
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  !-- Compute zonal divergence by splitting hdivn (see divcur.F90)
-                  !   N.B. This computation is not valid along OBCs (if any)
-                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  z_hdivn_x = (  e2u(ji  ,jj) * fse3u(ji  ,jj,jk) * pun(ji  ,jj,jk)          &
-                     &         - e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * pun(ji-1,jj,jk) ) * zbtr
-                  !-- Compute T/S zonal advection trends
-                  ztrdt(ji,jj,jk) = - ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) ) * zbtr + tn(ji,jj,jk) * z_hdivn_x
-                  ztrds(ji,jj,jk) = - ( zsu(ji,jj,jk) - zsu(ji-1,jj,jk) ) * zbtr + sn(ji,jj,jk) * z_hdivn_x
-               END DO
-            END DO
-         END DO
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_xad, 'TRA', kt, cnbpas='bis')   ! <<< ADD TO PREVIOUSLY COMPUTED
-         !
-         ! T/S MERIDIONAL advection trends
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  !-- Compute merid. divergence by splitting hdivn (see divcur.F90)
-                  !   N.B. This computation is not valid along OBCs (if any)
-                  zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  z_hdivn_y = (  e1v(ji,  jj) * fse3v(ji,jj  ,jk) * pvn(ji,jj  ,jk)          &
-                     &         - e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * pvn(ji,jj-1,jk) ) * zbtr
-                  !-- Compute T/S meridional advection trends
-                  ztrdt(ji,jj,jk) = - ( ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) * zbtr + tn(ji,jj,jk) * z_hdivn_y          
-                  ztrds(ji,jj,jk) = - ( zsv(ji,jj,jk) - zsv(ji,jj-1,jk) ) * zbtr + sn(ji,jj,jk) * z_hdivn_y          
-               END DO
-            END DO
-         END DO
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_yad, 'TRA', kt, cnbpas='bis')   ! <<< ADD TO PREVIOUSLY COMPUTED
-         !
-         ! T/S VERTICAL advection trends
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr1     = 1. / ( e1t(ji,jj) * e2t(ji,jj) )
-#if defined key_zco
-                  zbtr      = zbtr1
-                  z_hdivn_x = e2u(ji,jj)*pun(ji,jj,jk) - e2u(ji-1,jj)*pun(ji-1,jj,jk)
-                  z_hdivn_y = e1v(ji,jj)*pvn(ji,jj,jk) - e1v(ji,jj-1)*pvn(ji,jj-1,jk)
-#else
-                  zbtr      = zbtr1 / fse3t(ji,jj,jk)
-                  z_hdivn_x = e2u(ji,jj)*fse3u(ji,jj,jk)*pun(ji,jj,jk) - e2u(ji-1,jj)*fse3u(ji-1,jj,jk)*pun(ji-1,jj,jk)
-                  z_hdivn_y = e1v(ji,jj)*fse3v(ji,jj,jk)*pvn(ji,jj,jk) - e1v(ji,jj-1)*fse3v(ji,jj-1,jk)*pvn(ji,jj-1,jk)
-#endif
-                  z_hdivn   = (z_hdivn_x + z_hdivn_y) * zbtr
-                  zbtr      = zbtr1 / fse3t(ji,jj,jk)
-                  ztrdt(ji,jj,jk) = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * zbtr - tn(ji,jj,jk) * z_hdivn
-                  ztrds(ji,jj,jk) = - ( zsw(ji,jj,jk) - zsw(ji,jj,jk+1) ) * zbtr - sn(ji,jj,jk) * z_hdivn
-               END DO
-            END DO
-         END DO
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_zad, 'TRA', kt, cnbpas='bis')   ! <<< ADD TO PREVIOUSLY COMPUTED
-         !
-      ENDIF
-
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' tvd adv  - Ta: ', mask1=tmask,   &
-         &                       tab3d_2=sa, clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' )
-
-      ! "zonal" mean advective heat and salt transport
-      IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN
-         pht_adv(:) = ptr_vj( ztv(:,:,:) ) + pht_adv(:)
-         pst_adv(:) = ptr_vj( zsv(:,:,:) ) + pst_adv(:)
-      ENDIF
+      ENDDO
+      !
+      IF( l_trd )  THEN
+        DEALLOCATE( ztrdx )     ;     DEALLOCATE( ztrdy )     ;      DEALLOCATE( ztrdz )  
+      END IF
       !
    END SUBROUTINE tra_adv_tvd
 
 
-   SUBROUTINE nonosc( pbef, paa, pbb, pcc, paft, prdt )
+   SUBROUTINE nonosc( pbef, paa, pbb, pcc, paft, p2dt )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE nonosc  ***
@@ -391,11 +257,7 @@
       !!       in-space based differencing for fluid
       !!----------------------------------------------------------------------
-      REAL(wp), INTENT( in ) ::   prdt   ! ???
-      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT( inout ) ::   &
-         pbef,                            & ! before field
-         paft,                            & ! after field
-         paa,                             & ! monotonic flux in the i direction
-         pbb,                             & ! monotonic flux in the j direction
-         pcc                                ! monotonic flux in the k direction
+      REAL(wp), DIMENSION(jpk)         , INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step
+      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pbef, paft      ! before & after field
+      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(inout) ::   paa, pbb, pcc   ! monotonic fluxes in the 3 directions
       !!
       INTEGER ::   ji, jj, jk               ! dummy loop indices
@@ -423,5 +285,5 @@
       DO jk = 1, jpkm1
          ikm1 = MAX(jk-1,1)
-         z2dtt = prdt * rdttra(jk)
+         z2dtt = p2dt(jk)
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
@@ -456,8 +318,6 @@
          END DO
       END DO
-
-      ! lateral boundary condition on zbetup & zbetdo   (unchanged sign)
-      CALL lbc_lnk( zbetup, 'T', 1. )
-      CALL lbc_lnk( zbetdo, 'T', 1. )
+      CALL lbc_lnk( zbetup, 'T', 1. )   ;   CALL lbc_lnk( zbetdo, 'T', 1. )   ! lateral boundary cond. (unchanged sign)
+
 
 
@@ -486,8 +346,5 @@
          END DO
       END DO
-
-      ! lateral boundary condition on paa, pbb, pcc
-      CALL lbc_lnk( paa, 'U', -1. )      ! changed sign
-      CALL lbc_lnk( pbb, 'V', -1. )      ! changed sign
+      CALL lbc_lnk( paa, 'U', -1. )   ;   CALL lbc_lnk( pbb, 'V', -1. )   ! lateral boundary condition (changed sign)
       !
    END SUBROUTINE nonosc
Index: trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90	(revision 2528)
@@ -4,5 +4,6 @@
    !! Ocean active tracers:  horizontal & vertical advective trend
    !!==============================================================================
-   !! History :  9.0  !  06-08  (L. Debreu, R. Benshila)  Original code
+   !! History :  1.0  !  2006-08  (L. Debreu, R. Benshila)  Original code
+   !!            3.3  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
    !!----------------------------------------------------------------------
 
@@ -13,6 +14,6 @@
    USE oce             ! ocean dynamics and active tracers
    USE dom_oce         ! ocean space and time domain
-   USE trdmod
-   USE trdmod_oce
+   USE trdmod_oce         ! ocean space and time domain
+   USE trdtra
    USE lib_mpp
    USE lbclnk          ! ocean lateral boundary condition (or mpp link)
@@ -20,5 +21,5 @@
    USE diaptr          ! poleward transport diagnostics
    USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient
-   USE prtctl
+   USE trc_oce         ! share passive tracers/Ocean variables
 
    IMPLICIT NONE
@@ -27,5 +28,5 @@
    PUBLIC   tra_adv_ubs   ! routine called by traadv module
 
-   REAL(wp), DIMENSION(jpi,jpj) ::   e1e2tr   ! = 1/(e1t * e2t)
+   LOGICAL :: l_trd  ! flag to compute trends or not
 
    !! * Substitutions
@@ -33,12 +34,12 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2006)  
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
-   SUBROUTINE tra_adv_ubs( kt, pun, pvn, pwn )
+   SUBROUTINE tra_adv_ubs ( kt, cdtype, p2dt, pun, pvn, pwn,      &
+      &                                       ptb, ptn, pta, kjpt )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_adv_ubs  ***
@@ -67,401 +68,206 @@
       !!      the UBS have been found to be too diffusive.
       !!
-      !! ** Action : - update (ta,sa) with the now advective tracer trends
+      !! ** Action : - update (pta) with the now advective tracer trends
       !!
       !! Reference : Shchepetkin, A. F., J. C. McWilliams, 2005, Ocean Modelling, 9, 347-404. 
       !!             Farrow, D.E., Stevens, D.P., 1995, J. Phys. Ocean. 25, 1731Ð1741. 
       !!----------------------------------------------------------------------
-      USE oce, ONLY :   zwx => ua   ! use ua as workspace
-      USE oce, ONLY :   zwy => va   ! use va as workspace
-      !!
-      INTEGER , INTENT(in)                         ::   kt             ! ocean time-step index
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::  pun   ! effective ocean velocity, u_component
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::  pvn   ! effective ocean velocity, v_component
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::  pwn   ! effective ocean velocity, w_component
-      !!
-      INTEGER  ::   ji, jj, jk                 ! dummy loop indices
-      REAL(wp) ::   zta, zsa, zbtr, zcoef                  ! temporary scalars
-      REAL(wp) ::   zfui, zfp_ui, zfm_ui, zcenut, zcenus   !    "         "
-      REAL(wp) ::   zfvj, zfp_vj, zfm_vj, zcenvt, zcenvs   !    "         "
-      REAL(wp) ::   z_hdivn_x, z_hdivn_y, z_hdivn          !    "         "
-      REAL(wp), DIMENSION(jpi,jpj)     ::   zeeu, zeev     ! temporary 2D workspace
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwz , zww                        ! temporary 3D workspace
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztu , ztv , zltu , zltv, ztrdt   !    "              "
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zsu , zsv , zlsu , zlsv, ztrds   !    "              "
-      !!----------------------------------------------------------------------
-
-      zltu(:,:,:) = 0.e0
-      zltv(:,:,:) = 0.e0
-      zlsu(:,:,:) = 0.e0
-      zlsv(:,:,:) = 0.e0
-
-      IF( kt == nit000 ) THEN
+      USE oce         , zwx => ua   ! use ua as workspace
+      USE oce         , zwy => va   ! use va as workspace
+      !!
+      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers
+      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+      !!
+      INTEGER  ::   ji, jj, jk, jn          ! dummy loop indices
+      REAL(wp) ::   ztra, zbtr, zcoef       ! local scalars
+      REAL(wp) ::   zfp_ui, zfm_ui, zcenut  !   -      -
+      REAL(wp) ::   zfp_vj, zfm_vj, zcenvt  !   -      -
+      REAL(wp) ::   z2dtt                   !   -      -
+      REAL(wp) ::   ztak, zfp_wk, zfm_wk    !   -      -
+      REAL(wp) ::   zeeu, zeev, z_hdivn     !   -      -
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztu, ztv, zltu , zltv   ! 3D workspace
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zti, ztw                !  -      -
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 )  THEN
          IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_adv_ubs :  horizontal UBS advection scheme'
+         IF(lwp) WRITE(numout,*) 'tra_adv_ubs :  horizontal UBS advection scheme on ', cdtype
          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
          !
-         e1e2tr(:,:) = 1. / ( e1t(:,:) * e2t(:,:) )
+         l_trd = .FALSE.
+         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.
       ENDIF
-
-      ! Save ta and sa trends
-      ztrdt(:,:,:) = ta(:,:,:)
-      ztrds(:,:,:) = sa(:,:,:)
-
-      zcoef = 1./6.
-      !                                                ! ===============
-      DO jk = 1, jpkm1                                 ! Horizontal slab
-         !                                             ! ===============
-
-         !  Initialization of metric arrays (for z- or s-coordinates)
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-#if defined key_zco
-               ! z-coordinates, no vertical scale factors
-               zeeu(ji,jj) = e2u(ji,jj) / e1u(ji,jj) * umask(ji,jj,jk)
-               zeev(ji,jj) = e1v(ji,jj) / e2v(ji,jj) * vmask(ji,jj,jk)
-#else
-               ! s-coordinates, vertical scale factor are used
-               zeeu(ji,jj) = e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj) * umask(ji,jj,jk)
-               zeev(ji,jj) = e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj) * vmask(ji,jj,jk)
-#endif
-            END DO
-         END DO
-
-         !  Laplacian
-         ! First derivative (gradient)
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               ztu(ji,jj,jk) = zeeu(ji,jj) * ( tb(ji+1,jj  ,jk) - tb(ji,jj,jk) )
-               zsu(ji,jj,jk) = zeeu(ji,jj) * ( sb(ji+1,jj  ,jk) - sb(ji,jj,jk) )
-               ztv(ji,jj,jk) = zeev(ji,jj) * ( tb(ji  ,jj+1,jk) - tb(ji,jj,jk) )
-               zsv(ji,jj,jk) = zeev(ji,jj) * ( sb(ji  ,jj+1,jk) - sb(ji,jj,jk) )
-            END DO
-         END DO
-         ! Second derivative (divergence)
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-#if ! defined key_zco
-               zcoef = 1. / ( 6. * fse3t(ji,jj,jk) )
-#endif         
-               zltu(ji,jj,jk) = (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)  ) * zcoef
-               zlsu(ji,jj,jk) = (  zsu(ji,jj,jk) - zsu(ji-1,jj,jk)  ) * zcoef
-               zltv(ji,jj,jk) = (  ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  ) * zcoef
-               zlsv(ji,jj,jk) = (  zsv(ji,jj,jk) - zsv(ji,jj-1,jk)  ) * zcoef
-            END DO
-         END DO
-         !                                             ! =================
-      END DO                                           !    End of slab
-      !                                                ! =================
-
-      ! Lateral boundary conditions on the laplacian (zlt,zls)   (unchanged sgn)
-      CALL lbc_lnk( zltu, 'T', 1. )   ;    CALL lbc_lnk( zlsu, 'T', 1. )
-      CALL lbc_lnk( zltv, 'T', 1. )   ;    CALL lbc_lnk( zlsv, 'T', 1. )
-
-      !                                                ! ===============
-      DO jk = 1, jpkm1                                 ! Horizontal slab
-         !                                             ! ===============
-         !  Horizontal advective fluxes
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               ! volume fluxes * 1/2
-#if defined key_zco
-               zfui = 0.5 * e2u(ji,jj) * pun(ji,jj,jk)
-               zfvj = 0.5 * e1v(ji,jj) * pvn(ji,jj,jk)
-#else
-               zfui = 0.5 * e2u(ji,jj) * fse3u(ji,jj,jk) * pun(ji,jj,jk)
-               zfvj = 0.5 * e1v(ji,jj) * fse3v(ji,jj,jk) * pvn(ji,jj,jk)
-#endif
-               ! upstream scheme
-               zfp_ui = zfui + ABS( zfui )
-               zfp_vj = zfvj + ABS( zfvj )
-               zfm_ui = zfui - ABS( zfui )
-               zfm_vj = zfvj - ABS( zfvj )
-               ! centered scheme
-               zcenut = zfui * ( tn(ji,jj,jk) + tn(ji+1,jj  ,jk) )
-               zcenvt = zfvj * ( tn(ji,jj,jk) + tn(ji  ,jj+1,jk) )
-               zcenus = zfui * ( sn(ji,jj,jk) + sn(ji+1,jj  ,jk) )
-               zcenvs = zfvj * ( sn(ji,jj,jk) + sn(ji  ,jj+1,jk) )
-               ! mixed centered / upstream scheme
-               zwx(ji,jj,jk) = zcenut - zfp_ui * zltu(ji,jj,jk) -zfm_ui * zltu(ji+1,jj,jk)
-               zwy(ji,jj,jk) = zcenvt - zfp_vj * zltv(ji,jj,jk) -zfm_vj * zltv(ji,jj+1,jk)
-               zww(ji,jj,jk) = zcenus - zfp_ui * zlsu(ji,jj,jk) -zfm_ui * zlsu(ji+1,jj,jk)
-               zwz(ji,jj,jk) = zcenvs - zfp_vj * zlsv(ji,jj,jk) -zfm_vj * zlsv(ji,jj+1,jk)
-            END DO
-         END DO
-
-         !  Tracer flux divergence at t-point added to the general trend
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ! horizontal advective trends
-#if defined key_zco
-               zbtr = e1e2tr(ji,jj)
-#else
-               zbtr = e1e2tr(ji,jj) / fse3t(ji,jj,jk)
-#endif
-               zta = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk)   &
-                  &            + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk)  )
-               zsa = - zbtr * (  zww(ji,jj,jk) - zww(ji-1,jj  ,jk)   &
-                  &            + zwz(ji,jj,jk) - zwz(ji  ,jj-1,jk)  )
-               ! add it to the general tracer trends
-               ta(ji,jj,jk) = ta(ji,jj,jk) + zta
-               sa(ji,jj,jk) = sa(ji,jj,jk) + zsa
-            END DO
-         END DO
-         !                                             ! ===============
-      END DO                                           !   End of slab
-      !                                                ! ===============
-
-      ! Horizontal trend used in tra_adv_ztvd subroutine
-      zltu(:,:,:) = ta(:,:,:) - ztrdt(:,:,:) 
-      zlsu(:,:,:) = sa(:,:,:) - ztrds(:,:,:) 
-
-      ! 3. Save the horizontal advective trends for diagnostic
-      ! ------------------------------------------------------
-      IF( l_trdtra )   THEN
-         ! Recompute the hoizontal advection zta & zsa trends computed 
-         ! at the step 2. above in making the difference between the new 
-         ! trends and the previous one ta()/sa - ztrdt()/ztrds() and add
-         ! the term tn()/sn()*hdivn() to recover the Uh gradh(T/S) trends
-         ztrdt(:,:,:) = 0.e0   ;   ztrds(:,:,:) = 0.e0
-         !
-         ! T/S ZONAL advection trends
+      !
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         ! 1. Bottom value : flux set to zero
+         ! ----------------------------------
+         zltu(:,:,jpk) = 0.e0       ;      zltv(:,:,jpk) = 0.e0
+         !                                              
+         DO jk = 1, jpkm1                                 ! Horizontal slab
+            !                                   
+            !  Laplacian
+            DO jj = 1, jpjm1            ! First derivative (gradient)
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zeeu = e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj) * umask(ji,jj,jk)
+                  zeev = e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj) * vmask(ji,jj,jk)
+                  ztu(ji,jj,jk) = zeeu * ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) )
+                  ztv(ji,jj,jk) = zeev * ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )
+               END DO
+            END DO
+            DO jj = 2, jpjm1            ! Second derivative (divergence)
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zcoef = 1. / ( 6. * fse3t(ji,jj,jk) )
+                  zltu(ji,jj,jk) = (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)  ) * zcoef
+                  zltv(ji,jj,jk) = (  ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  ) * zcoef
+               END DO
+            END DO
+            !                                    
+         END DO                                           ! End of slab         
+         CALL lbc_lnk( zltu, 'T', 1. )   ;    CALL lbc_lnk( zltv, 'T', 1. )   ! Lateral boundary cond. (unchanged sgn)
+
+         !    
+         !  Horizontal advective fluxes               
+         DO jk = 1, jpkm1                                 ! Horizontal slab
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  ! upstream transport
+                  zfp_ui = pun(ji,jj,jk) + ABS( pun(ji,jj,jk) )
+                  zfm_ui = pun(ji,jj,jk) - ABS( pun(ji,jj,jk) )
+                  zfp_vj = pvn(ji,jj,jk) + ABS( pvn(ji,jj,jk) )
+                  zfm_vj = pvn(ji,jj,jk) - ABS( pvn(ji,jj,jk) )
+                  ! centered scheme
+                  zcenut = 0.5 * pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj  ,jk,jn) )
+                  zcenvt = 0.5 * pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji  ,jj+1,jk,jn) )
+                  ! UBS scheme
+                  zwx(ji,jj,jk) =  zcenut - zfp_ui * zltu(ji,jj,jk) - zfm_ui * zltu(ji+1,jj,jk) 
+                  zwy(ji,jj,jk) =  zcenvt - zfp_vj * zltv(ji,jj,jk) - zfm_vj * zltv(ji,jj+1,jk) 
+               END DO
+            END DO
+         END DO                                           ! End of slab         
+
+         zltu(:,:,:) = pta(:,:,:,jn)      ! store pta trends
+
+         ! Horizontal advective trends
          DO jk = 1, jpkm1
+            !  Tracer flux divergence at t-point added to the general trend
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  !-- Compute zonal divergence by splitting hdivn (see divcur.F90)
-#if defined key_zco
-                  zbtr = e1e2tr(ji,jj)
-                  z_hdivn_x = (  e2u(ji  ,jj) * pun(ji  ,jj,jk)          &
-                     &         - e2u(ji-1,jj) * pun(ji-1,jj,jk) ) * zbtr
-#else
-                  zbtr = e1e2tr(ji,jj) / fse3t(ji,jj,jk)
-                  z_hdivn_x = (  e2u(ji  ,jj) * fse3u(ji  ,jj,jk) * pun(ji  ,jj,jk)          &
-                     &         - e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * pun(ji-1,jj,jk) ) * zbtr
-#endif
-                  ztrdt(ji,jj,jk) = - ( zwx(ji,jj,jk) - zwx(ji-1,jj,jk) ) * zbtr + tn(ji,jj,jk) * z_hdivn_x
-                  ztrds(ji,jj,jk) = - ( zww(ji,jj,jk) - zww(ji-1,jj,jk) ) * zbtr + sn(ji,jj,jk) * z_hdivn_x
-               END DO
-            END DO
-         END DO
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_xad, 'TRA', kt)    ! save the trends
-         !
-         ! T/S MERIDIONAL advection trends
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ! horizontal advective
+                  ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk)   &
+                     &             + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk)  )
+                  ! add it to the general tracer trends
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
+               END DO
+            END DO
+            !                                             
+         END DO                                           !   End of slab
+
+         ! Horizontal trend used in tra_adv_ztvd subroutine
+         zltu(:,:,:) = pta(:,:,:,jn) - zltu(:,:,:)
+
+         ! 3. Save the horizontal advective trends for diagnostic
+         ! ------------------------------------------------------
+         !                                 ! trend diagnostics (contribution of upstream fluxes)
+         IF( l_trd ) THEN
+             CALL trd_tra( kt, cdtype, jn, jptra_trd_xad, zwx, pun, ptn(:,:,:,jn) )
+             CALL trd_tra( kt, cdtype, jn, jptra_trd_yad, zwy, pvn, ptn(:,:,:,jn) )
+         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(:,:,:) )
+         ENDIF
+         
+         ! TVD scheme for the vertical direction  
+         ! ----------------------
+         IF( l_trd )   zltv(:,:,:) = pta(:,:,:,jn)          ! store pta if trend diag.
+
+         !  Bottom value : flux set to zero
+         ztw(:,:,jpk) = 0.e0   ;   zti(:,:,jpk) = 0.e0
+
+         ! Surface value
+         IF( lk_vvl ) THEN   ;   ztw(:,:,1) = 0.e0                      ! variable volume : flux set to zero
+         ELSE                ;   ztw(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)   ! free constant surface 
+         ENDIF
+         !  upstream advection with initial mass fluxes & intermediate update
+         ! -------------------------------------------------------------------
+         ! Interior value
+         DO jk = 2, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                   zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) )
+                   zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) )
+                   ztw(ji,jj,jk) = 0.5 * (  zfp_wk * ptb(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn)  )
+               END DO
+            END DO
+         END DO 
+         ! update and guess with monotonic sheme
          DO jk = 1, jpkm1
+            z2dtt = p2dt(jk)
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  !-- Compute merid. divergence by splitting hdivn (see divcur.F90)
-#if defined key_zco
-                  zbtr      = e1e2tr(ji,jj)
-                  z_hdivn_y = (  e1v(ji,  jj) * pvn(ji,jj  ,jk)          &
-                     &         - e1v(ji,jj-1) * pvn(ji,jj-1,jk) ) * zbtr
-#else
-                  zbtr      = e1e2tr(ji,jj) / fse3t(ji,jj,jk)
-                  z_hdivn_y = (  e1v(ji,  jj) * fse3v(ji,jj  ,jk) * pvn(ji,jj  ,jk)          &
-                     &         - e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * pvn(ji,jj-1,jk) ) * zbtr
-#endif
-                  ztrdt(ji,jj,jk) = - ( zwy(ji,jj,jk) - zwy(ji,jj-1,jk) ) * zbtr + tn(ji,jj,jk) * z_hdivn_y          
-                  ztrds(ji,jj,jk) = - ( zwz(ji,jj,jk) - zwz(ji,jj-1,jk) ) * zbtr + sn(ji,jj,jk) * z_hdivn_y
-               END DO
-            END DO
-         END DO
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_yad, 'TRA', kt)     ! save the trends
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * zbtr
+                  pta(ji,jj,jk,jn) =   pta(ji,jj,jk,jn) +  ztak 
+                  zti(ji,jj,jk)    = ( ptb(ji,jj,jk,jn) + z2dtt * ( ztak + zltu(ji,jj,jk) ) ) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
          !
-      ENDIF
-
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' ubs had  - Ta: ', mask1=tmask,   &
-         &                       tab3d_2=sa, clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' )
-
-      ! "zonal" mean advective heat and salt transport 
-      IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN
-         IF( lk_zco ) THEN
-            DO jk = 1, jpkm1
+         CALL lbc_lnk( zti, 'T', 1. )      ! Lateral boundary conditions on zti, zsi   (unchanged sign)
+
+         !  antidiffusive flux : high order minus low order
+         ztw(:,:,1) = 0.e0       ! Surface value
+         DO jk = 2, jpkm1        ! Interior value
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ztw(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) ) - ztw(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !
+         CALL nonosc_z( ptb(:,:,:,jn), ztw, zti, p2dt )      !  monotonicity algorithm
+
+         !  final trend with corrected fluxes
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1 
+               DO ji = fs_2, fs_jpim1   ! vector opt.   
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ! k- vertical advective trends  
+                  ztra = - zbtr * ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) )
+                  ! added to the general tracer trends
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
+               END DO
+            END DO
+         END DO
+
+         !  Save the final vertical advective trends
+         IF( l_trd )  THEN                        ! vertical advective trend diagnostics
+            DO jk = 1, jpkm1                       ! (compute -w.dk[ptn]= -dk[w.ptn] + ptn.dk[w])
                DO jj = 2, jpjm1
                   DO ji = fs_2, fs_jpim1   ! vector opt.
-                     zwy(ji,jj,jk) = zwy(ji,jj,jk) * fse3v(ji,jj,jk)
-                     zwz(ji,jj,jk) = zwz(ji,jj,jk) * fse3v(ji,jj,jk)
+                     zbtr = 1.e0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                     z_hdivn = (  pwn(ji,jj,jk) - pwn(ji,jj,jk+1)  ) * zbtr
+                     zltv(ji,jj,jk) = pta(ji,jj,jk,jn) - zltv(ji,jj,jk) + ptn(ji,jj,jk,jn) * z_hdivn
                   END DO
                END DO
             END DO
+            CALL trd_tra( kt, cdtype, jn, jptra_trd_zad, zltv )
          ENDIF
-         pht_adv(:) = ptr_vj( zwy(:,:,:) )
-         pst_adv(:) = ptr_vj( zwz(:,:,:) )
-      ENDIF
-
-      ! II. Vertical advection
-      ! ----------------------
-      IF( l_trdtra ) THEN          ! Save ta and sa trends
-         ztrdt(:,:,:) = ta(:,:,:)
-         ztrds(:,:,:) = sa(:,:,:)
-      ENDIF
-    
-      ! TVD scheme the vertical direction  
-      CALL tra_adv_ztvd(kt, pwn, zltu, zlsu)
-
-      IF( l_trdtra )   THEN         !  Save the final vertical advective trends
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-#if defined key_zco
-                  zbtr      = e1e2tr(ji,jj)
-                  z_hdivn_x = e2u(ji,jj)*pun(ji,jj,jk) - e2u(ji-1,jj)*pun(ji-1,jj,jk)
-                  z_hdivn_y = e1v(ji,jj)*pvn(ji,jj,jk) - e1v(ji,jj-1)*pvn(ji,jj-1,jk)
-#else
-                  zbtr      = e1e2tr(ji,jj) / fse3t(ji,jj,jk)
-                  z_hdivn_x = e2u(ji,jj)*fse3u(ji,jj,jk)*pun(ji,jj,jk) - e2u(ji-1,jj)*fse3u(ji-1,jj,jk)*pun(ji-1,jj,jk)
-                  z_hdivn_y = e1v(ji,jj)*fse3v(ji,jj,jk)*pvn(ji,jj,jk) - e1v(ji,jj-1)*fse3v(ji,jj-1,jk)*pvn(ji,jj-1,jk)
-#endif
-                  z_hdivn   = (z_hdivn_x + z_hdivn_y) * zbtr
-                  zbtr      = e1e2tr(ji,jj) / fse3t(ji,jj,jk)
-                  ztrdt(ji,jj,jk) = ta(ji,jj,jk) - ztrdt(ji,jj,jk) - tn(ji,jj,jk) * z_hdivn
-                  ztrds(ji,jj,jk) = sa(ji,jj,jk) - ztrds(ji,jj,jk) - sn(ji,jj,jk) * z_hdivn
-               END DO
-            END DO
-         END DO
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_zad, 'TRA', kt)   ! <<< ADD TO PREVIOUSLY COMPUTED
          !
-      ENDIF
-
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' ubs zad  - Ta: ', mask1=tmask,   &
-         &                       tab3d_2=sa, clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra')
+      ENDDO
       !
    END SUBROUTINE tra_adv_ubs
 
 
-   SUBROUTINE tra_adv_ztvd( kt, pwn, zttrd, zstrd )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_adv_ztvd  ***
-      !! 
-      !! **  Purpose :   Compute the now trend due to total advection of 
-      !!       tracers and add it to the general trend of tracer equations
-      !!
-      !! **  Method  :   TVD scheme, i.e. 2nd order centered scheme with
-      !!       corrected flux (monotonic correction)
-      !!       note: - this advection scheme needs a leap-frog time scheme
-      !!
-      !! ** Action : - update (ta,sa) with the now advective tracer trends
-      !!             - save the trends in (ztrdt,ztrds) ('key_trdtra')
-      !!----------------------------------------------------------------------
-      INTEGER , INTENT(in)                         ::   kt             ! ocean time-step
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pwn            ! verical effective velocity
-      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   zttrd, zstrd   ! lateral advective trends on T & S 
-      !!
-      INTEGER  ::   ji, jj, jk              ! dummy loop indices
-      REAL(wp) ::   z2dtt, zbtr, zew, z2    ! temporary scalar  
-      REAL(wp) ::   ztak, zfp_wk            !    "         "
-      REAL(wp) ::   zsak, zfm_wk            !    "         "
-      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zti, ztw   ! temporary 3D workspace
-      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zsi, zsw   !    "              "
-      !!----------------------------------------------------------------------
-
-      IF( kt == nit000 .AND. lwp ) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'tra_adv_ztvd : vertical TVD advection scheme'
-         WRITE(numout,*) '~~~~~~~~~~~~'
-      ENDIF
-
-      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;    z2 = 1.
-      ELSE                                        ;    z2 = 2.
-      ENDIF
-
-      !  Bottom value : flux set to zero
-      ! --------------
-      ztw(:,:,jpk) = 0.e0   ;   zsw(:,:,jpk) = 0.e0
-      zti  (:,:,:) = 0.e0   ;   zsi  (:,:,:) = 0.e0
-
-
-      !  upstream advection with initial mass fluxes & intermediate update
-      ! -------------------------------------------------------------------
-      ! Surface value
-      IF( lk_vvl ) THEN
-         ! variable volume : flux set to zero
-         ztw(:,:,1) = 0.e0
-         zsw(:,:,1) = 0.e0
-      ELSE
-         ! free surface-constant volume
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zew = e1t(ji,jj) * e2t(ji,jj) * pwn(ji,jj,1)
-               ztw(ji,jj,1) = zew * tb(ji,jj,1)
-               zsw(ji,jj,1) = zew * sb(ji,jj,1)
-            END DO
-         END DO
-      ENDIF
-
-      ! Interior value
-      DO jk = 2, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zew = 0.5 * e1t(ji,jj) * e2t(ji,jj) * pwn(ji,jj,jk)
-               zfp_wk = zew + ABS( zew )
-               zfm_wk = zew - ABS( zew )
-               ztw(ji,jj,jk) = zfp_wk * tb(ji,jj,jk) + zfm_wk * tb(ji,jj,jk-1)
-               zsw(ji,jj,jk) = zfp_wk * sb(ji,jj,jk) + zfm_wk * sb(ji,jj,jk-1)
-            END DO
-         END DO
-      END DO
-
-      ! update and guess with monotonic sheme
-      DO jk = 1, jpkm1
-         z2dtt = z2 * rdttra(jk)
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zbtr = 1./ ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * zbtr
-               zsak = - ( zsw(ji,jj,jk) - zsw(ji,jj,jk+1) ) * zbtr
-               ta(ji,jj,jk) =  ta(ji,jj,jk) + ztak
-               sa(ji,jj,jk) =  sa(ji,jj,jk) + zsak 
-               zti (ji,jj,jk) = ( tb(ji,jj,jk) + z2dtt * ( ztak + zttrd(ji,jj,jk) ) ) * tmask(ji,jj,jk)
-               zsi (ji,jj,jk) = ( sb(ji,jj,jk) + z2dtt * ( zsak + zstrd(ji,jj,jk) ) ) * tmask(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-
-      ! Lateral boundary conditions on zti, zsi   (unchanged sign)
-      CALL lbc_lnk( zti, 'T', 1. )
-      CALL lbc_lnk( zsi, 'T', 1. )
-
-
-      !  antidiffusive flux : high order minus low order
-      ! -------------------------------------------------      
-      ! Surface value
-      ztw(:,:,1) = 0.e0   ;   zsw(:,:,1) = 0.e0
-
-      ! Interior value
-      DO jk = 2, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zew = 0.5 * e1t(ji,jj) * e2t(ji,jj) * pwn(ji,jj,jk)
-               ztw(ji,jj,jk) = zew * ( tn(ji,jj,jk) + tn(ji,jj,jk-1) ) - ztw(ji,jj,jk)
-               zsw(ji,jj,jk) = zew * ( sn(ji,jj,jk) + sn(ji,jj,jk-1) ) - zsw(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-
-      !  monotonicity algorithm
-      ! ------------------------
-      CALL nonosc_z( tb, ztw, zti, z2 )
-      CALL nonosc_z( sb, zsw, zsi, z2 )
-
-
-      !  final trend with corrected fluxes
-      ! -----------------------------------
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.  
-               zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               ! k- vertical advective trends
-               ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * zbtr
-               zsak = - ( zsw(ji,jj,jk) - zsw(ji,jj,jk+1) ) * zbtr
-               ! add them to the general tracer trends
-               ta(ji,jj,jk) = ta(ji,jj,jk) + ztak
-               sa(ji,jj,jk) = sa(ji,jj,jk) + zsak
-            END DO
-         END DO
-      END DO
-      !
-   END SUBROUTINE tra_adv_ztvd
-
-
-   SUBROUTINE nonosc_z( pbef, pcc, paft, prdt )
+   SUBROUTINE nonosc_z( pbef, pcc, paft, p2dt )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE nonosc_z  ***
@@ -476,6 +282,6 @@
       !!       in-space based differencing for fluid
       !!----------------------------------------------------------------------
-      REAL(wp), INTENT(in   )                          ::   prdt   ! ???
-      REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) ::   pbef   ! before field
+      REAL(wp), INTENT(in   ), DIMENSION(jpk)          ::   p2dt   ! vertical profile of tracer time-step
+      REAL(wp),                DIMENSION (jpi,jpj,jpk) ::   pbef   ! before field
       REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) ::   paft   ! after field
       REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) ::   pcc    ! monotonic flux in the k direction
@@ -525,5 +331,5 @@
       pbef(:,:,:) = pbef(:,:,:) * tmask(:,:,:)
       paft(:,:,:) = paft(:,:,:) * tmask(:,:,:)
- 
+
 
       ! 2. Positive and negative part of fluxes and beta terms
@@ -531,5 +337,5 @@
 
       DO jk = 1, jpkm1
-         z2dtt = prdt * rdttra(jk)
+         z2dtt = p2dt(jk)
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
@@ -544,5 +350,4 @@
          END DO
       END DO
-
       ! monotonic flux in the k direction, i.e. pcc
       ! -------------------------------------------
@@ -550,5 +355,4 @@
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
-
                za = MIN( 1., zbetdo(ji,jj,jk), zbetup(ji,jj,jk-1) )
                zb = MIN( 1., zbetup(ji,jj,jk), zbetdo(ji,jj,jk-1) )
Index: trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90	(revision 2528)
@@ -2,22 +2,22 @@
    !!==============================================================================
    !!                       ***  MODULE  trabbc  ***
-   !! Ocean active tracers:  bottom boundary condition
+   !! Ocean active tracers:  bottom boundary condition (geothermal heat flux)
    !!==============================================================================
-   !! History :  8.1  ! 99-10 (G. Madec)  original code
-   !!            8.5  ! 02-08 (G. Madec)  free form + modules
-   !!            8.5  ! 02-11 (A. Bozec)  tra_bbc_init: original code
+   !! History :  OPA  ! 1999-10 (G. Madec)  original code
+   !!   NEMO     1.0  ! 2002-08 (G. Madec)  free form + modules
+   !!             -   ! 2002-11 (A. Bozec)  tra_bbc_init: original code
+   !!            3.3  ! 2010-10 (G. Madec)  dynamical allocation + suppression of key_trabbc
+   !!             -   ! 2010-11 (G. Madec)  use mbkt array (deepest ocean t-level)
    !!----------------------------------------------------------------------
-#if   defined key_trabbc   ||   defined key_esopa
-   !!----------------------------------------------------------------------
-   !!   'key_trabbc'                                  geothermal heat flux
+
    !!----------------------------------------------------------------------
    !!   tra_bbc      : update the tracer trend at ocean bottom 
    !!   tra_bbc_init : initialization of geothermal heat flux trend
    !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and active tracers
-   USE dom_oce         ! ocean space and time domain
+   USE oce             ! ocean variables
+   USE dom_oce         ! domain: ocean
    USE phycst          ! physical constants
-   USE trdmod          ! ocean trends 
-   USE trdmod_oce      ! ocean variables trends
+   USE trdmod_oce      ! trends: ocean variables 
+   USE trdtra          ! trends: active tracers 
    USE in_out_manager  ! I/O manager
    USE prtctl          ! Print control
@@ -27,23 +27,20 @@
 
    PUBLIC tra_bbc          ! routine called by step.F90
+   PUBLIC tra_bbc_init     ! routine called by opa.F90
 
-   !! to be transfert in the namelist ???!   
-   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbc = .TRUE.   !: bbc flag
+   !                                                !!* Namelist nambbc: bottom boundary condition *
+   LOGICAL, PUBLIC ::   ln_trabbc     = .FALSE.      !: Geothermal heat flux flag
+   INTEGER         ::   nn_geoflx     = 1            !  Geothermal flux (=1:constant flux, =2:read in file )
+   REAL(wp)        ::   rn_geoflx_cst = 86.4e-3_wp   !  Constant value of geothermal heat flux
 
-   !                                         !!* Namelist nambbc: bottom boundary condition *
-   INTEGER  ::   nn_geoflx     = 1            ! Geothermal flux (0:no flux, 1:constant flux, 2:read in file )
-   REAL(wp) ::   rn_geoflx_cst = 86.4e-3      ! Constant value of geothermal heat flux
-
-   INTEGER , DIMENSION(jpi,jpj) ::   nbotlevt   ! ocean bottom level index at T-pt
-   REAL(wp), DIMENSION(jpi,jpj) ::   qgh_trd0   ! geothermal heating trend
+   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   qgh_trd0   ! geothermal heating trend
  
    !! * Substitutions
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -61,5 +58,5 @@
       !!       ocean bottom can be computed once and is added to the temperature
       !!       trend juste above the bottom at each time step:
-      !!            ta = ta + Qsf / (rau0 rcp e3T) for k= mbathy -1
+      !!            ta = ta + Qsf / (rau0 rcp e3T) for k= mbkt
       !!       Where Qsf is the geothermal heat flux.
       !!
@@ -70,44 +67,36 @@
       !!              Emile-Geay and Madec, 2009, Ocean Science.
       !!----------------------------------------------------------------------
-      USE oce, ONLY :   ztrdt => ua   ! use ua as 3D workspace   
-      USE oce, ONLY :   ztrds => va   ! use va as 3D workspace   
-      !!
       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
       !!
-      INTEGER  ::   ji, jj    ! dummy loop indices
-      REAL(wp) ::   zqgh_trd  ! geothermal heat flux trend
+      INTEGER  ::   ji, jj, ik    ! dummy loop indices
+      REAL(wp) ::   zqgh_trd      ! geothermal heat flux trend
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt
       !!----------------------------------------------------------------------
-
-      IF( kt == nit000 )   CALL tra_bbc_init      ! Initialization
-
+      !
       IF( l_trdtra )   THEN         ! Save ta and sa trends
-         ztrdt(:,:,:) = ta(:,:,:) 
-         ztrds(:,:,:) = 0.e0
-      ENDIF
-
-      ! Add the geothermal heat flux trend on temperature
-
-      SELECT CASE ( nn_geoflx )
-      !
-      CASE ( 1:2 )                !  geothermal heat flux
-#if defined key_vectopt_loop
-         DO jj = 1, 1
-            DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
-#else
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-#endif
-               zqgh_trd = ro0cpr * qgh_trd0(ji,jj) / fse3t(ji,jj,nbotlevt(ji,jj))
-               ta(ji,jj,nbotlevt(ji,jj)) = ta(ji,jj,nbotlevt(ji,jj)) + zqgh_trd
-            END DO
-         END DO
-      END SELECT
-
-      IF( l_trdtra ) THEN        ! Save the geothermal heat flux trend for diagnostics
-         ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:)
-         CALL trd_mod( ztrdt, ztrds, jptra_trd_bbc, 'TRA', kt )
+         ALLOCATE( ztrdt(jpi,jpj,jpk) )     ;   ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
       ENDIF
       !
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' bbc  - Ta: ', mask1=tmask, clinfo3='tra-ta' )
+      !                             !  Add the geothermal heat flux trend on temperature
+#if defined key_vectopt_loop
+      DO jj = 1, 1
+         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
+#else
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+#endif
+            ik = mbkt(ji,jj)
+            zqgh_trd = qgh_trd0(ji,jj) / fse3t(ji,jj,ik)
+            tsa(ji,jj,ik,jp_tem) = tsa(ji,jj,ik,jp_tem) + zqgh_trd
+         END DO
+      END DO
+      !
+      IF( l_trdtra ) THEN        ! Save the geothermal heat flux trend for diagnostics
+         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_bbc, ztrdt )
+         DEALLOCATE( ztrdt )
+      ENDIF
+      !
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' bbc  - Ta: ', mask1=tmask, clinfo3='tra-ta' )
       !
    END SUBROUTINE tra_bbc
@@ -128,5 +117,4 @@
       !!
       !! ** Action  : - read/fix the geothermal heat qgh_trd0
-      !!              - compute the bottom ocean level nbotlevt
       !!----------------------------------------------------------------------
       USE iom
@@ -135,64 +123,50 @@
       INTEGER  ::   inum                ! temporary logical unit
       !!
-      NAMELIST/nambbc/nn_geoflx, rn_geoflx_cst 
+      NAMELIST/nambbc/ln_trabbc, nn_geoflx, rn_geoflx_cst 
       !!----------------------------------------------------------------------
 
-      REWIND ( numnam )              ! Read Namelist nambbc : bottom momentum boundary condition
-      READ   ( numnam, nambbc )
+      REWIND( numnam )                 ! Read Namelist nambbc : bottom momentum boundary condition
+      READ  ( numnam, nambbc )
 
-      IF(lwp) THEN                   ! Control print
+      IF(lwp) THEN                     ! Control print
          WRITE(numout,*)
-         WRITE(numout,*) 'tra_bbc : temperature Bottom Boundary Condition (bbc), Geothermal heatflux'
+         WRITE(numout,*) 'tra_bbc : Bottom Boundary Condition (bbc), apply a Geothermal heating'
          WRITE(numout,*) '~~~~~~~   '
          WRITE(numout,*) '   Namelist nambbc : set bbc parameters'
-         WRITE(numout,*) '      Geothermal flux            nn_geoflx     = ', nn_geoflx
-         WRITE(numout,*) '      Constant geothermal flux   rn_geoflx_cst = ', rn_geoflx_cst
+         WRITE(numout,*) '      Apply a geothermal heating at ocean bottom   ln_trabbc     = ', ln_trabbc
+         WRITE(numout,*) '      type of geothermal flux                      nn_geoflx     = ', nn_geoflx
+         WRITE(numout,*) '      Constant geothermal flux value               rn_geoflx_cst = ', rn_geoflx_cst
          WRITE(numout,*)
       ENDIF
 
-      !                              ! level of the ocean bottom at T-point
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            nbotlevt(ji,jj) = MAX( mbathy(ji,jj)-1, 1 )
-         END DO
-      END DO
-
-      SELECT CASE ( nn_geoflx )      ! initialization of geothermal heat flux
-      !
-      CASE ( 0 )                ! no geothermal heat flux
+      IF( ln_trabbc ) THEN             !==  geothermal heating  ==!
+         !
+         ALLOCATE( qgh_trd0(jpi,jpj) )    ! allocation
+         !
+         SELECT CASE ( nn_geoflx )        ! geothermal heat flux / (rauO * Cp)
+         !
+         CASE ( 1 )                          !* constant flux
+            IF(lwp) WRITE(numout,*) '      *** constant heat flux  =   ', rn_geoflx_cst
+            qgh_trd0(:,:) = ro0cpr * rn_geoflx_cst
+            !
+         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(:,:) = ro0cpr * qgh_trd0(:,:) * 1.e-3     ! conversion in W/m2
+            !
+         CASE DEFAULT
+            WRITE(ctmp1,*) '     bad flag value for nn_geoflx = ', nn_geoflx
+            CALL ctl_stop( ctmp1 )
+            !
+         END SELECT
+         !
+      ELSE
          IF(lwp) WRITE(numout,*) '      *** no geothermal heat flux'
-         !
-      CASE ( 1 )                ! constant flux
-         IF(lwp) WRITE(numout,*) '      *** constant heat flux  =   ', rn_geoflx_cst
-         !
-         qgh_trd0(:,:) = rn_geoflx_cst
-         !
-      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(:,:) = qgh_trd0(:,:) * 1.e-3 ! conversion in W/m2
-         !
-      CASE DEFAULT
-         WRITE(ctmp1,*) '     bad flag value for nn_geoflx = ', nn_geoflx
-         CALL ctl_stop( ctmp1 )
-         !
-      END SELECT
+      ENDIF
       !
    END SUBROUTINE tra_bbc_init
 
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option                                         Empty module
-   !!----------------------------------------------------------------------
-   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbc = .FALSE.  !: bbc flag
-CONTAINS
-   SUBROUTINE tra_bbc( kt )           ! Empty routine
-      WRITE(*,*) 'tra_bbc: You should not have seen this print! error?', kt
-   END SUBROUTINE tra_bbc
-#endif
-
    !!======================================================================
 END MODULE trabbc
Index: trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90	(revision 2528)
@@ -4,54 +4,62 @@
    !! Ocean physics :  advective and/or diffusive bottom boundary layer scheme
    !!==============================================================================
-   !! History :  8.0  !  96-06  (L. Mortier)  Original code
-   !!            8.0  !  97-11  (G. Madec)  Optimization
-   !!            8.5  !  02-08  (G. Madec)  free form + modules
-   !!----------------------------------------------------------------------
-#if   defined key_trabbl_dif   ||   defined key_trabbl_adv   || defined key_esopa
-   !!----------------------------------------------------------------------
-   !!   'key_trabbl_dif'   or            diffusive bottom boundary layer
-   !!   'key_trabbl_adv'                 advective bottom boundary layer
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !!   tra_bbl_dif  : update the active tracer trends due to the bottom
-   !!                  boundary layer (diffusive only)
-   !!   tra_bbl_adv  : update the active tracer trends due to the bottom
-   !!                  boundary layer (advective and/or diffusive)
-   !!   tra_bbl_init : initialization, namlist read, parameters control
-   !!----------------------------------------------------------------------
-   USE oce                ! ocean dynamics and active tracers
-   USE dom_oce            ! ocean space and time domain
-   USE trdmod             ! ocean active tracers trends
-   USE trdmod_oce         ! ocean variables trends
-   USE in_out_manager     ! I/O manager
-   USE lbclnk             ! ocean lateral boundary conditions
-   USE prtctl             ! Print control
+   !! History :  OPA  ! 1996-06  (L. Mortier)  Original code
+   !!            8.0  ! 1997-11  (G. Madec)    Optimization
+   !!   NEMO     1.0  ! 2002-08  (G. Madec)  free form + modules
+   !!             -   ! 2004-01  (A. de Miranda, G. Madec, J.M. Molines ) add advective bbl
+   !!            3.3  ! 2009-11  (G. Madec)  merge trabbl and trabbl_adv + style + optimization 
+   !!             -   ! 2010-04  (G. Madec)  Campin & Goosse advective bbl 
+   !!             -   ! 2010-06  (C. Ethe, G. Madec)  merge TRA-TRC
+   !!             -   ! 2010-11  (G. Madec) add mbk. arrays associated to the deepest ocean level
+   !!----------------------------------------------------------------------
+#if   defined key_trabbl   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_trabbl'   or                             bottom boundary layer
+   !!----------------------------------------------------------------------
+   !!   tra_bbl       : update the tracer trends due to the bottom boundary layer (advective and/or diffusive)
+   !!   tra_bbl_dif   : generic routine to compute bbl diffusive trend
+   !!   tra_bbl_adv   : generic routine to compute bbl advective trend
+   !!   bbl           : computation of bbl diffu. flux coef. & transport in bottom boundary layer
+   !!   tra_bbl_init  : initialization, namelist read, parameters control
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and active tracers
+   USE dom_oce        ! ocean space and time domain
+   USE phycst         ! physical constant
+   USE eosbn2         ! equation of state
+   USE trdmod_oce     ! trends: ocean variables
+   USE trdtra         ! trends: active tracers
+   USE iom            ! IOM server               
+   USE in_out_manager ! I/O manager
+   USE lbclnk         ! ocean lateral boundary conditions
+   USE prtctl         ! Print control
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC tra_bbl_dif    ! routine called by step.F90
-   PUBLIC tra_bbl_adv    ! routine called by step.F90
-
-   !!* Namelist nambbl: bottom boundary layer
-   REAL(wp), PUBLIC ::   rn_ahtbbl = 1.e+3   !: lateral coeff. for bottom boundary layer scheme (m2/s)
-
-# if defined key_trabbl_dif
-   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl_dif = .TRUE.          !: diffusive bottom boundary layer flag
-# else
-   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl_dif = .FALSE.         !: diffusive bottom boundary layer flag
-# endif
-
-# if defined key_trabbl_adv
-   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl_adv = .TRUE.   !: advective bottom boundary layer flag
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   u_bbl      !: 3 components of the velocity
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   v_bbl      !: associated with advective BBL
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   w_bbl      !: (only affect tracer)
-# else
-   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl_adv = .FALSE.  !: advective bottom boundary layer flag
-# endif
-
-   INTEGER, DIMENSION(jpi,jpj) ::   mbkt          ! vertical index of the bottom ocean T-level
-   INTEGER, DIMENSION(jpi,jpj) ::   mbku, mbkv    ! vertical index of the bottom ocean U/V-level
+   PUBLIC   tra_bbl       !  routine called by step.F90
+   PUBLIC   tra_bbl_init  !  routine called by opa.F90
+   PUBLIC   tra_bbl_dif   !  routine called by trcbbl.F90
+   PUBLIC   tra_bbl_adv   !  -          -          -              -
+   PUBLIC   bbl           !  routine called by trcbbl.F90 and dtadyn.F90
+
+   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl = .TRUE.    !: bottom boundary layer flag
+
+   !                                           !!* Namelist nambbl * 
+   INTEGER , PUBLIC ::   nn_bbl_ldf = 0         !: =1   : diffusive bbl or not (=0)
+   INTEGER , PUBLIC ::   nn_bbl_adv = 0         !: =1/2 : advective bbl or not (=0)
+   !                                            !  =1 : advective bbl using the bottom ocean velocity
+   !                                            !  =2 :     -      -  using utr_bbl proportional to grad(rho)
+   REAL(wp), PUBLIC ::   rn_ahtbbl  = 1.e3_wp   !: along slope bbl diffusive coefficient [m2/s]
+   REAL(wp), PUBLIC ::   rn_gambbl  = 10.0_wp   !: lateral coeff. for bottom boundary layer scheme [s]
+
+   REAL(wp), DIMENSION(jpi,jpj), PUBLIC ::   utr_bbl  , vtr_bbl   ! u- (v-) transport in the bottom boundary layer
+   REAL(wp), DIMENSION(jpi,jpj), PUBLIC ::   ahu_bbl  , ahv_bbl   ! masked diffusive bbl coefficients at u and v-points
+
+   INTEGER , DIMENSION(jpi,jpj) ::   mbku_d   , mbkv_d      ! vertical index of the "lower" bottom ocean U/V-level
+   INTEGER , DIMENSION(jpi,jpj) ::   mgrhu    , mgrhv       ! = +/-1, sign of grad(H) in u-(v-)direction
+   REAL(wp), DIMENSION(jpi,jpj) ::   ahu_bbl_0, ahv_bbl_0   ! diffusive bbl flux coefficients at u and v-points
+   REAL(wp), DIMENSION(jpi,jpj) ::   e3u_bbl_0, e3v_bbl_0   ! thichness of the bbl (e3) at u and v-points
+   REAL(wp), DIMENSION(jpi,jpj) ::   e1e2t_r   ! thichness of the bbl (e3) at u and v-points
+   LOGICAL, PUBLIC              ::   l_bbl                    !: flag to compute bbl diffu. flux coef and transport
 
    !! * Substitutions
@@ -59,387 +67,530 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2006) 
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
-   SUBROUTINE tra_bbl_dif( kt )
-      !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE tra_bbl_dif  ***
-      !!
+   SUBROUTINE tra_bbl( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE bbl  ***
+      !!                   
       !! ** Purpose :   Compute the before tracer (t & s) trend associated 
-      !!      with the bottom boundary layer and add it to the general trend 
-      !!      of tracer equations. The bottom boundary layer is supposed to be
-      !!      a purely diffusive bottom boundary layer.
-      !!
-      !! ** Method  :   When the product grad( rho) * grad(h) < 0 (where grad 
-      !!      is an along bottom slope gradient) an additional lateral diffu-
-      !!      sive trend along the bottom slope is added to the general tracer
-      !!      trend, otherwise nothing is done.
-      !!      Second order operator (laplacian type) with variable coefficient
-      !!      computed as follow for temperature (idem on s): 
-      !!         difft = 1/(e1t*e2t*e3t) { di-1[ ahbt e2u*e3u/e1u di[ztb] ]
-      !!                                 + dj-1[ ahbt e1v*e3v/e2v dj[ztb] ] }
-      !!      where ztb is a 2D array: the bottom ocean temperature and ahtb
-      !!      is a time and space varying diffusive coefficient defined by:
-      !!         ahbt = zahbp    if grad(rho).grad(h) < 0
-      !!              = 0.       otherwise.
-      !!      Note that grad(.) is the along bottom slope gradient. grad(rho)
-      !!      is evaluated using the local density (i.e. referenced at the
-      !!      local depth). Typical value of ahbt is 2000 m2/s (equivalent to
+      !!              with the bottom boundary layer and add it to the general
+      !!              trend of tracer equations.
+      !!
+      !! ** Method  :   Depending on namtra_bbl namelist parameters the bbl
+      !!              diffusive and/or advective contribution to the tracer trend
+      !!              is added to the general tracer trend
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step 
+      !!
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt, ztrds
+      !!----------------------------------------------------------------------
+
+      IF( l_trdtra )   THEN                    !* Save ta and sa trends
+         ALLOCATE( ztrdt(jpi,jpj,jpk) )   ;    ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
+         ALLOCATE( ztrds(jpi,jpj,jpk) )   ;    ztrds(:,:,:) = tsa(:,:,:,jp_sal)
+      ENDIF
+
+      IF( l_bbl )   CALL bbl( kt, 'TRA' )       !* bbl coef. and transport (only if not already done in trcbbl)
+
+
+      IF( nn_bbl_ldf == 1 ) THEN                !* Diffusive bbl
+         CALL tra_bbl_dif( tsb, tsa, jpts )
+         IF( ln_ctl )  &
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' bbl_ldf  - Ta: ', mask1=tmask, &
+         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' )
+         ! lateral boundary conditions ; just need for outputs                          
+         CALL lbc_lnk( ahu_bbl, 'U', 1. )     ;     CALL lbc_lnk( ahv_bbl, 'V', 1. )
+         CALL iom_put( "ahu_bbl", ahu_bbl )   ! bbl diffusive flux i-coef     
+         CALL iom_put( "ahv_bbl", ahv_bbl )   ! bbl diffusive flux j-coef
+      END IF
+
+      IF( nn_bbl_adv /= 0 ) THEN                !* Advective bbl
+         CALL tra_bbl_adv( tsb, tsa, jpts )
+         IF(ln_ctl)   &
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' bbl_adv  - Ta: ', mask1=tmask,   &
+         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' )
+         ! lateral boundary conditions ; just need for outputs                          
+         CALL lbc_lnk( utr_bbl, 'U', 1. )     ;   CALL lbc_lnk( vtr_bbl, 'V', 1. )
+         CALL iom_put( "uoce_bbl", utr_bbl )  ! bbl i-transport     
+         CALL iom_put( "voce_bbl", vtr_bbl )  ! bbl j-transport
+      END IF
+
+      IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics
+         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
+         ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:)
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_bbl, ztrdt )
+         CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_bbl, ztrds )
+         DEALLOCATE( ztrdt )      ;     DEALLOCATE( ztrds ) 
+      ENDIF
+      !
+   END SUBROUTINE tra_bbl
+
+
+   SUBROUTINE tra_bbl_dif( ptb, pta, kjpt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_bbl_dif  ***
+      !!                   
+      !! ** Purpose :   Computes the bottom boundary horizontal and vertical
+      !!                advection terms. 
+      !!
+      !! ** Method  :   
+      !!        * diffusive bbl (nn_bbl_ldf=1) :
+      !!        When the product grad( rho) * grad(h) < 0 (where grad is an
+      !!      along bottom slope gradient) an additional lateral 2nd order
+      !!      diffusion along the bottom slope is added to the general
+      !!      tracer trend, otherwise the additional trend is set to 0.
+      !!      A typical value of ahbt is 2000 m2/s (equivalent to
       !!      a downslope velocity of 20 cm/s if the condition for slope
       !!      convection is satified)
-      !!      Add this before trend to the general trend (ta,sa) of the 
-      !!      botton ocean tracer point:
-      !!         ta = ta + difft
-      !!
-      !! ** Action  : - update (ta,sa) at the bottom level with the bottom
-      !!                boundary layer trend
-      !!              - save the trends in ztrdt/ztrds ('key_trdtra')
+      !!
+      !! ** Action  :   pta   increased by the bbl diffusive trend
       !!
       !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591.
-      !!----------------------------------------------------------------------
-      USE oce, ONLY :   ztrdt => ua   ! use ua as 3D workspace   
-      USE oce, ONLY :   ztrds => va   ! use va as 3D workspace   
-      USE eosbn2                      ! equation of state
-      !!
-      INTEGER, INTENT( in ) ::   kt   ! ocean time-step
-      !!
-      INTEGER  ::   ji, jj                  ! dummy loop indices
-      INTEGER  ::   ik
-      INTEGER  ::   ii0, ii1, ij0, ij1      ! temporary integers
-      INTEGER  ::   iku1, iku2, ikv1,ikv2   ! temporary intergers
-      REAL(wp) ::   ze3u, ze3v              ! temporary scalars
-      INTEGER  ::   iku, ikv
-      REAL(wp) ::   zsign, zt, zs, zh, zalbet   ! temporary scalars
-      REAL(wp) ::   zgdrho, zbtr, zta, zsa
-      REAL(wp), DIMENSION(jpi,jpj) ::   zki, zkj, zkw, zkx, zky, zkz             ! 2D workspace
-      REAL(wp), DIMENSION(jpi,jpj) ::   ztnb, zsnb, zdep, ztbb, zsbb, zahu, zahv
-      !!
-      REAL(wp) ::    fsalbt, pft, pfs, pfh   ! statement function
-      !!----------------------------------------------------------------------
-      ! ratio alpha/beta
-      ! ================
-      !  fsalbt: ratio of thermal over saline expension coefficients
-      !       pft :  potential temperature in degrees celcius
-      !       pfs :  salinity anomaly (s-35) in psu
-      !       pfh :  depth in meters
-
-      fsalbt( pft, pfs, pfh ) =                                              &
+      !!              Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430.
+      !!----------------------------------------------------------------------  
+      INTEGER                              , INTENT(in   ) ::   kjpt    ! number of tracers
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb   ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta   ! tracer trend 
+      !!
+      INTEGER  ::   ji, jj, jn   ! dummy loop indices
+      INTEGER  ::   ik           ! local integers
+      REAL(wp) ::   zbtr         ! local scalars
+      REAL(wp), DIMENSION(jpi,jpj) ::   zptb   ! tracer trend 
+      !!----------------------------------------------------------------------
+      !
+      DO jn = 1, kjpt                                     ! tracer loop
+         !                                                ! ===========
+#  if defined key_vectopt_loop
+         DO jj = 1, 1   ! vector opt. (forced unrolling)
+            DO ji = 1, jpij
+#else
+         DO jj = 1, jpj
+            DO ji = 1, jpi 
+#endif
+               ik = mbkt(ji,jj)                        ! bottom T-level index
+               zptb(ji,jj) = ptb(ji,jj,ik,jn)              ! bottom before T and S
+            END DO
+         END DO
+         !                                                ! Compute the trend
+#  if defined key_vectopt_loop
+         DO jj = 1, 1   ! vector opt. (forced unrolling)
+            DO ji = jpi+1, jpij-jpi-1
+#  else
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+#  endif
+               ik = mbkt(ji,jj)                            ! bottom T-level index
+               zbtr = e1e2t_r(ji,jj)  / fse3t(ji,jj,ik)
+               pta(ji,jj,ik,jn) = pta(ji,jj,ik,jn)                                                         &
+                  &               + (   ahu_bbl(ji  ,jj  ) * ( zptb(ji+1,jj  ) - zptb(ji  ,jj  ) )   &
+                  &                   - ahu_bbl(ji-1,jj  ) * ( zptb(ji  ,jj  ) - zptb(ji-1,jj  ) )   &
+                  &                   + ahv_bbl(ji  ,jj  ) * ( zptb(ji  ,jj+1) - zptb(ji  ,jj  ) )   &
+                  &                   - ahv_bbl(ji  ,jj-1) * ( zptb(ji  ,jj  ) - zptb(ji  ,jj-1) )   ) * zbtr
+            END DO
+         END DO
+         !                                                  ! ===========
+      END DO                                                ! end tracer
+      !                                                     ! ===========
+   END SUBROUTINE tra_bbl_dif
+   
+
+   SUBROUTINE tra_bbl_adv( ptb, pta, kjpt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_bbl  ***
+      !!
+      !! ** Purpose :   Compute the before passive tracer trend associated 
+      !!     with the bottom boundary layer and add it to the general trend
+      !!     of tracer equations.
+      !! ** Method  :   advective bbl (nn_bbl_adv = 1 or 2) :
+      !!      nn_bbl_adv = 1   use of the ocean near bottom velocity as bbl velocity
+      !!      nn_bbl_adv = 2   follow Campin and Goosse (1999) implentation i.e. 
+      !!                       transport proportional to the along-slope density gradient                   
+      !!
+      !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591.
+      !!              Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430.
+      !!----------------------------------------------------------------------  
+      INTEGER                              , INTENT(in   ) ::   kjpt    ! number of tracers
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb   ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta   ! tracer trend 
+      !!
+      INTEGER  ::   ji, jj, jk, jn           ! dummy loop indices
+      INTEGER  ::   iis , iid , ijs , ijd    ! local integers
+      INTEGER  ::   ikus, ikud, ikvs, ikvd   !   -       -
+      REAL(wp) ::   zbtr, ztra               ! local scalars
+      REAL(wp) ::   zu_bbl, zv_bbl           !   -      -
+      !!----------------------------------------------------------------------
+      !
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========         
+# if defined key_vectopt_loop
+         DO jj = 1, 1
+            DO ji = 1, jpij-jpi-1   ! vector opt. (forced unrolling)
+# else
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1            ! CAUTION start from i=1 to update i=2 when cyclic east-west
+# endif
+               IF( utr_bbl(ji,jj) /= 0.e0 ) THEN            ! non-zero i-direction bbl advection
+                  ! down-slope i/k-indices (deep)      &   up-slope i/k indices (shelf)
+                  iid  = ji + MAX( 0, mgrhu(ji,jj) )   ;   iis  = ji + 1 - MAX( 0, mgrhu(ji,jj) )
+                  ikud = mbku_d(ji,jj)                 ;   ikus = mbku(ji,jj)
+                  zu_bbl = ABS( utr_bbl(ji,jj) )
+                  !
+                  !                                               ! up  -slope T-point (shelf bottom point)
+                  zbtr = e1e2t_r(iis,jj) / fse3t(iis,jj,ikus)
+                  ztra = zu_bbl * ( ptb(iid,jj,ikus,jn) - ptb(iis,jj,ikus,jn) ) * zbtr
+                  pta(iis,jj,ikus,jn) = pta(iis,jj,ikus,jn) + ztra
+                  !                   
+                  DO jk = ikus, ikud-1                            ! down-slope upper to down T-point (deep column)
+                     zbtr = e1e2t_r(iid,jj) / fse3t(iid,jj,jk)
+                     ztra = zu_bbl * ( ptb(iid,jj,jk+1,jn) - ptb(iid,jj,jk,jn) ) * zbtr
+                     pta(iid,jj,jk,jn) = pta(iid,jj,jk,jn) + ztra
+                  END DO
+                  ! 
+                  zbtr = e1e2t_r(iid,jj) / fse3t(iid,jj,ikud)
+                  ztra = zu_bbl * ( ptb(iis,jj,ikus,jn) - ptb(iid,jj,ikud,jn) ) * zbtr
+                  pta(iid,jj,ikud,jn) = pta(iid,jj,ikud,jn) + ztra
+               ENDIF
+               !
+               IF( vtr_bbl(ji,jj) /= 0.e0 ) THEN            ! non-zero j-direction bbl advection
+                  ! down-slope j/k-indices (deep)        &   up-slope j/k indices (shelf)
+                  ijd  = jj + MAX( 0, mgrhv(ji,jj) )     ;   ijs  = jj + 1 - MAX( 0, mgrhv(ji,jj) )
+                  ikvd = mbkv_d(ji,jj)                   ;   ikvs = mbkv(ji,jj)
+                  zv_bbl = ABS( vtr_bbl(ji,jj) )
+                  ! 
+                  ! up  -slope T-point (shelf bottom point)
+                  zbtr = e1e2t_r(ji,ijs) / fse3t(ji,ijs,ikvs)
+                  ztra = zv_bbl * ( ptb(ji,ijd,ikvs,jn) - ptb(ji,ijs,ikvs,jn) ) * zbtr
+                  pta(ji,ijs,ikvs,jn) = pta(ji,ijs,ikvs,jn) + ztra
+                  !                   
+                  DO jk = ikvs, ikvd-1                            ! down-slope upper to down T-point (deep column)
+                     zbtr = e1e2t_r(ji,ijd) / fse3t(ji,ijd,jk)
+                     ztra = zv_bbl * ( ptb(ji,ijd,jk+1,jn) - ptb(ji,ijd,jk,jn) ) * zbtr
+                     pta(ji,ijd,jk,jn) = pta(ji,ijd,jk,jn)  + ztra
+                  END DO
+                  !                                               ! down-slope T-point (deep bottom point)
+                  zbtr = e1e2t_r(ji,ijd) / fse3t(ji,ijd,ikvd)
+                  ztra = zv_bbl * ( ptb(ji,ijs,ikvs,jn) - ptb(ji,ijd,ikvd,jn) ) * zbtr
+                  pta(ji,ijd,ikvd,jn) = pta(ji,ijd,ikvd,jn) + ztra
+               ENDIF
+            END DO
+            !
+         END DO
+         !                                                  ! ===========
+      END DO                                                ! end tracer
+      !                                                     ! ===========
+   END SUBROUTINE tra_bbl_adv
+
+
+   SUBROUTINE bbl( kt, cdtype )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE bbl  ***
+      !!                   
+      !! ** Purpose :   Computes the bottom boundary horizontal and vertical
+      !!                advection terms. 
+      !!
+      !! ** Method  :   
+      !!        * diffusive bbl (nn_bbl_ldf=1) :
+      !!        When the product grad( rho) * grad(h) < 0 (where grad is an
+      !!      along bottom slope gradient) an additional lateral 2nd order
+      !!      diffusion along the bottom slope is added to the general
+      !!      tracer trend, otherwise the additional trend is set to 0.
+      !!      A typical value of ahbt is 2000 m2/s (equivalent to
+      !!      a downslope velocity of 20 cm/s if the condition for slope
+      !!      convection is satified)
+      !!        * advective bbl (nn_bbl_adv=1 or 2) :
+      !!      nn_bbl_adv = 1   use of the ocean velocity as bbl velocity
+      !!      nn_bbl_adv = 2   follow Campin and Goosse (1999) implentation
+      !!        i.e. transport proportional to the along-slope density gradient
+      !!
+      !!      NB: the along slope density gradient is evaluated using the
+      !!      local density (i.e. referenced at a common local depth).
+      !!
+      !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591.
+      !!              Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430.
+      !!----------------------------------------------------------------------  
+      INTEGER         , INTENT(in   ) ::   kt       ! ocean time-step index
+      CHARACTER(len=3), INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator)
+      !!
+      INTEGER  ::   ji, jj                    ! dummy loop indices
+      INTEGER  ::   ik                        ! local integers
+      INTEGER  ::   iis , iid , ijs , ijd     !   -       -
+      INTEGER  ::   ikus, ikud, ikvs, ikvd    !   -       -
+      REAL(wp) ::   zsign, zsigna, zgbbl      ! local scalars
+      REAL(wp) ::   zgdrho, zt, zs, zh        !   -      -
+      REAL(wp), DIMENSION(jpi,jpj) ::   zub, zvb, ztb, zsb, zdep  !  2D workspace
+      !!
+      REAL(wp) ::   fsalbt, fsbeta, pft, pfs, pfh   ! statement function
+      !!----------------------- zv_bbl-----------------------------------------------
+      ! ratio alpha/beta = fsalbt : ratio of thermal over saline expension coefficients
+      ! ================            pft :  potential temperature in degrees celcius
+      !                             pfs :  salinity anomaly (s-35) in psu
+      !                             pfh :  depth in meters
+      ! nn_eos = 0  (Jackett and McDougall 1994 formulation)
+      fsalbt( pft, pfs, pfh ) =                                              &   ! alpha/beta
          ( ( ( -0.255019e-07 * pft + 0.298357e-05 ) * pft                    &
-         &                         - 0.203814e-03 ) * pft                    &
-         &                         + 0.170907e-01 ) * pft                    &
-         &                         + 0.665157e-01                            &
+                                   - 0.203814e-03 ) * pft                    &
+                                   + 0.170907e-01 ) * pft                    &
+                                   + 0.665157e-01                            &
          +(-0.678662e-05 * pfs - 0.846960e-04 * pft + 0.378110e-02 ) * pfs   &
          +  ( ( - 0.302285e-13 * pfh                                         &
-         &      - 0.251520e-11 * pfs                                         &
-         &      + 0.512857e-12 * pft * pft          ) * pfh                  &
-         &                           - 0.164759e-06   * pfs                  &
-         &   +(   0.791325e-08 * pft - 0.933746e-06 ) * pft                  &
-         &                           + 0.380374e-04 ) * pfh   
-      !!----------------------------------------------------------------------
-
-      IF( kt == nit000 )   CALL tra_bbl_init
-
-      IF( l_trdtra )   THEN         ! Save ta and sa trends
-         ztrdt(:,:,:) = ta(:,:,:) 
-         ztrds(:,:,:) = sa(:,:,:) 
+                - 0.251520e-11 * pfs                                         &
+                + 0.512857e-12 * pft * pft          ) * pfh                  &
+                                     - 0.164759e-06   * pfs                  &
+             +(   0.791325e-08 * pft - 0.933746e-06 ) * pft                  &
+                                     + 0.380374e-04 ) * pfh
+      fsbeta( pft, pfs, pfh ) =                                              &   ! beta
+         ( ( -0.415613e-09 * pft + 0.555579e-07 ) * pft                      &
+                                 - 0.301985e-05 ) * pft                      &
+                                 + 0.785567e-03                              &
+         + (     0.515032e-08 * pfs                                          &
+               + 0.788212e-08 * pft - 0.356603e-06 ) * pfs                   &
+               +(  (   0.121551e-17 * pfh                                    &
+                     - 0.602281e-15 * pfs                                    &
+                     - 0.175379e-14 * pft + 0.176621e-12 ) * pfh             &
+                                          + 0.408195e-10   * pfs             &
+                 + ( - 0.213127e-11 * pft + 0.192867e-09 ) * pft             &
+                                          - 0.121555e-07 ) * pfh
+      !!----------------------------------------------------------------------
+      
+      IF( kt == nit000 )  THEN
+         IF(lwp)  WRITE(numout,*)
+         IF(lwp)  WRITE(numout,*) 'trabbl:bbl : Compute bbl velocities and diffusive coefficients in ', cdtype
+         IF(lwp)  WRITE(numout,*) '~~~~~~~~~~'
       ENDIF
-
-      ! 0. 2D fields of bottom temperature and salinity, and bottom slope
-      ! -----------------------------------------------------------------
-      ! mbathy= number of w-level, minimum value=1 (cf dommsk.F)
-#  if defined key_vectopt_loop
-      DO jj = 1, 1
-         DO ji = 1, jpij   ! vector opt. (forced unrolling)
-#  else
+      
+      !                                        !* bottom temperature, salinity, velocity and depth
+#if defined key_vectopt_loop
+      DO jj = 1, 1   ! vector opt. (forced unrolling)
+         DO ji = 1, jpij
+#else
       DO jj = 1, jpj
          DO ji = 1, jpi
-#  endif
-            ik = mbkt(ji,jj)                              ! index of the bottom ocean T-level
-            ztnb(ji,jj) = tn(ji,jj,ik) * tmask(ji,jj,1)   ! masked now T and S at ocean bottom 
-            zsnb(ji,jj) = sn(ji,jj,ik) * tmask(ji,jj,1)
-            ztbb(ji,jj) = tb(ji,jj,ik) * tmask(ji,jj,1)   ! masked before T and S at ocean bottom 
-            zsbb(ji,jj) = sb(ji,jj,ik) * tmask(ji,jj,1)
-            zdep(ji,jj) = fsdept(ji,jj,ik)                ! depth of the ocean bottom T-level
+#endif
+            ik = mbkt(ji,jj)                        ! bottom T-level index
+            ztb (ji,jj) = tsb(ji,jj,ik,jp_tem) * tmask(ji,jj,1)      ! bottom before T and S
+            zsb (ji,jj) = tsb(ji,jj,ik,jp_sal) * tmask(ji,jj,1)
+            zdep(ji,jj) = fsdept_0(ji,jj,ik)        ! bottom T-level reference depth
+            !
+            zub(ji,jj) = un(ji,jj,mbku(ji,jj))      ! bottom velocity
+            zvb(ji,jj) = vn(ji,jj,mbkv(ji,jj)) 
          END DO
       END DO
-
-      IF( ln_zps ) THEN      ! partial steps correction 
-# if defined key_vectopt_loop
-         DO jj = 1, 1
-            DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
-# else
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-# endif
-               iku1 = MAX( mbathy(ji+1,jj  )-1, 1 )
-               iku2 = MAX( mbathy(ji  ,jj  )-1, 1 )
-               ikv1 = MAX( mbathy(ji  ,jj+1)-1, 1 )
-               ikv2 = MAX( mbathy(ji  ,jj  )-1, 1 )
-               ze3u = MIN( fse3u(ji,jj,iku1), fse3u(ji,jj,iku2) ) 
-               ze3v = MIN( fse3v(ji,jj,ikv1), fse3v(ji,jj,ikv2) ) 
-               zahu(ji,jj) = rn_ahtbbl * e2u(ji,jj) * ze3u / e1u(ji,jj) * umask(ji,jj,1)
-               zahv(ji,jj) = rn_ahtbbl * e1v(ji,jj) * ze3v / e2v(ji,jj) * vmask(ji,jj,1)
-            END DO
-         END DO
-      ELSE                    ! z-coordinate - full steps or s-coordinate
-#   if defined key_vectopt_loop
-         DO jj = 1, 1
-            DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
-#   else
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-#   endif
-               iku = mbku(ji,jj)
-               ikv = mbkv(ji,jj)
-               zahu(ji,jj) = rn_ahtbbl * e2u(ji,jj) * fse3u(ji,jj,iku) / e1u(ji,jj) * umask(ji,jj,1)
-               zahv(ji,jj) = rn_ahtbbl * e1v(ji,jj) * fse3v(ji,jj,ikv) / e2v(ji,jj) * vmask(ji,jj,1)
-            END DO
-         END DO
-      ENDIF
-
-      ! 1. Criteria of additional bottom diffusivity: grad(rho).grad(h)<0
-      ! --------------------------------------------
-      ! Sign of the local density gradient along the i- and j-slopes
-      ! multiplied by the slope of the ocean bottom
-
-      SELECT CASE ( nn_eos )
-      !
-      CASE ( 0 )                 !==  Jackett and McDougall (1994) formulation  ==!
-#  if defined key_vectopt_loop
-         DO jj = 1, 1
-            DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
-#  else
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-#  endif
-               ! temperature, salinity anomalie and depth
-               zt = 0.5 * ( ztnb(ji,jj) + ztnb(ji+1,jj) )
-               zs = 0.5 * ( zsnb(ji,jj) + zsnb(ji+1,jj) ) - 35.0
+      
+      !                                   !-------------------!
+      IF( nn_bbl_ldf == 1 ) THEN          !   diffusive bbl   !
+         !                                !-------------------!
+         DO jj = 1, jpjm1                      ! (criteria for non zero flux: grad(rho).grad(h) < 0 )
+            DO ji = 1, jpim1              
+               !                                                ! i-direction 
+               zt = 0.5 * ( ztb (ji,jj) + ztb (ji+1,jj) )  ! T, S anomalie, and depth
+               zs = 0.5 * ( zsb (ji,jj) + zsb (ji+1,jj) ) - 35.0
                zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) )
-               ! masked ratio alpha/beta
-               zalbet = fsalbt( zt, zs, zh )*umask(ji,jj,1)
-               ! local density gradient along i-bathymetric slope
-               zgdrho = zalbet * ( ztnb(ji+1,jj) - ztnb(ji,jj) )   &
-                      -          ( zsnb(ji+1,jj) - zsnb(ji,jj) )
-               ! sign of local i-gradient of density multiplied by the i-slope
-               zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) )
-               zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj)
+               !                                                         ! masked bbl i-gradient of density
+               zgdrho = (  fsalbt( zt, zs, zh ) * ( ztb(ji+1,jj) - ztb(ji,jj) )    &
+                  &                             - ( zsb(ji+1,jj) - zsb(ji,jj) )  ) * umask(ji,jj,1)
+               !                                                     
+               zsign          = SIGN(  0.5, - zgdrho * REAL( mgrhu(ji,jj) )  )    ! sign of ( i-gradient * i-slope )
+               ahu_bbl(ji,jj) = ( 0.5 - zsign ) * ahu_bbl_0(ji,jj)                  ! masked diffusive flux coeff.
                !
-               ! temperature, salinity anomalie and depth
-               zt = 0.5 * ( ztnb(ji,jj+1) + ztnb(ji,jj) )
-               zs = 0.5 * ( zsnb(ji,jj+1) + zsnb(ji,jj) ) - 35.0
+               !                                                ! j-direction 
+               zt = 0.5 * ( ztb (ji,jj+1) + ztb (ji,jj) )                ! T, S anomalie, and depth
+               zs = 0.5 * ( zsb (ji,jj+1) + zsb (ji,jj) ) - 35.0
                zh = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) )
-               ! masked ratio alpha/beta
-               zalbet = fsalbt( zt, zs, zh )*vmask(ji,jj,1)
-               ! local density gradient along j-bathymetric slope
-               zgdrho = zalbet * ( ztnb(ji,jj+1) - ztnb(ji,jj) )   &
-                      -          ( zsnb(ji,jj+1) - zsnb(ji,jj) )
-               ! sign of local j-gradient of density multiplied by the j-slope
-               zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) )
-               zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj)
+               !                                                         ! masked bbl j-gradient of density
+               zgdrho = (  fsalbt( zt, zs, zh ) * ( ztb(ji,jj+1) - ztb(ji,jj) )    &
+                  &                             - ( zsb(ji,jj+1) - zsb(ji,jj) )  ) * vmask(ji,jj,1)
+               !                                                    
+               zsign          = SIGN(  0.5, -zgdrho * REAL( mgrhv(ji,jj) )  )     ! sign of ( j-gradient * j-slope )
+               ahv_bbl(ji,jj) = ( 0.5 - zsign ) * ahv_bbl_0(ji,jj)
+               !
             END DO
          END DO
          !
-      CASE ( 1 )               !==  Linear formulation function of temperature only  ==!
-#  if defined key_vectopt_loop
-         DO jj = 1, 1
-            DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
-#  else
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-#  endif
-               ! local 'density/temperature' gradient along i-bathymetric slope
-               zgdrho =  ztnb(ji+1,jj) - ztnb(ji,jj) 
-               ! sign of local i-gradient of density multiplied by the i-slope
-               zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) )
-               zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj)
-               !
-               ! local density gradient along j-bathymetric slope
-               zgdrho =  ztnb(ji,jj+1) - ztnb(ji,jj) 
-               ! sign of local j-gradient of density multiplied by the j-slope
-               zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) )
-               zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj)
+      ENDIF
+
+      !                                   !-------------------!
+      IF( nn_bbl_adv /= 0 ) THEN          !   advective bbl   !
+         !                                !-------------------!
+         SELECT CASE ( nn_bbl_adv )             !* bbl transport type
+         !
+         CASE( 1 )                                   != use of upper velocity
+            DO jj = 1, jpjm1                                 ! criteria: grad(rho).grad(h)<0  and grad(rho).grad(h)<0
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  !                                               ! i-direction
+                  zt = 0.5 * ( ztb (ji,jj) + ztb (ji+1,jj) )                  ! T, S anomalie, and depth
+                  zs = 0.5 * ( zsb (ji,jj) + zsb (ji+1,jj) ) - 35.0
+                  zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) )
+                  !                                                           ! masked bbl i-gradient of density
+                  zgdrho = (  fsalbt( zt, zs, zh ) * ( ztb(ji+1,jj) - ztb(ji,jj) )    &  
+                     &                             - ( zsb(ji+1,jj) - zsb(ji,jj) )  ) * umask(ji,jj,1)
+                  !                                                         
+                  zsign = SIGN(  0.5, - zgdrho   * REAL( mgrhu(ji,jj) )  )    ! sign of i-gradient * i-slope
+                  zsigna= SIGN(  0.5, zub(ji,jj) * REAL( mgrhu(ji,jj) )  )    ! sign of u * i-slope
+                  !
+                  !                                                           ! bbl velocity
+                  utr_bbl(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * e2u(ji,jj) * e3u_bbl_0(ji,jj) * zub(ji,jj)
+                  !
+                  !                                               ! j-direction
+                  zt = 0.5 * ( ztb (ji,jj+1) + ztb (ji,jj) )                  ! T, S anomalie, and depth
+                  zs = 0.5 * ( zsb (ji,jj+1) + zsb (ji,jj) ) - 35.0
+                  zh = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) )
+                  !                                                           ! masked bbl j-gradient of density
+                  zgdrho = (  fsalbt( zt, zs, zh ) * ( ztb(ji,jj+1) - ztb(ji,jj) )    &  
+                     &                             - ( zsb(ji,jj+1) - zsb(ji,jj) )  ) * vmask(ji,jj,1)
+                  zsign = SIGN(  0.5, - zgdrho   * REAL( mgrhv(ji,jj) )  )    ! sign of j-gradient * j-slope
+                  zsigna= SIGN(  0.5, zvb(ji,jj) * REAL( mgrhv(ji,jj) )  )    ! sign of u * i-slope
+                  !
+                  !                                                           ! bbl velocity
+                  vtr_bbl(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * e1v(ji,jj) * e3v_bbl_0(ji,jj) * zvb(ji,jj)
+               END DO
             END DO
+            !
+         CASE( 2 )                                 != bbl velocity = F( delta rho )
+            zgbbl = grav * rn_gambbl
+            DO jj = 1, jpjm1                            ! criteria: rho_up > rho_down
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  !                                         ! i-direction
+                  ! down-slope T-point i/k-index (deep)  &   up-slope T-point i/k-index (shelf)
+                  iid  = ji + MAX( 0, mgrhu(ji,jj) )     ;    iis  = ji + 1 - MAX( 0, mgrhu(ji,jj) )
+                  ikud = mbku_d(ji,jj)                   ;    ikus = mbku(ji,jj)
+                  !
+                  !                                             ! mid-depth density anomalie (up-slope minus down-slope)
+                  zt = 0.5 * ( ztb (ji,jj) + ztb (ji+1,jj) )           ! mid slope depth of T, S, and depth
+                  zs = 0.5 * ( zsb (ji,jj) + zsb (ji+1,jj) ) - 35.0
+                  zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) )
+                  zgdrho =    fsbeta( zt, zs, zh )                                    &
+                     &   * (  fsalbt( zt, zs, zh ) * ( ztb(iid,jj) - ztb(iis,jj) )    &  
+                     &                             - ( zsb(iid,jj) - zsb(iis,jj) )  ) * umask(ji,jj,1)
+                  zgdrho = MAX( 0.e0, zgdrho )                         ! only if shelf is denser than deep
+                  !
+                  !                                             ! bbl transport (down-slope direction)
+                  utr_bbl(ji,jj) = e2u(ji,jj) * e3u_bbl_0(ji,jj) * zgbbl * zgdrho * REAL( mgrhu(ji,jj) )
+                  !
+                  !                                         ! j-direction
+                  !  down-slope T-point j/k-index (deep)  &   of the up  -slope T-point j/k-index (shelf)
+                  ijd  = jj + MAX( 0, mgrhv(ji,jj) )      ;    ijs  = jj + 1 - MAX( 0, mgrhv(ji,jj) )
+                  ikvd = mbkv_d(ji,jj)                    ;    ikvs = mbkv(ji,jj)
+                  !
+                  !                                             ! mid-depth density anomalie (up-slope minus down-slope)
+                  zt = 0.5 * ( ztb (ji,jj) + ztb (ji,jj+1) )           ! mid slope depth of T, S, and depth
+                  zs = 0.5 * ( zsb (ji,jj) + zsb (ji,jj+1) ) - 35.0
+                  zh = 0.5 * ( zdep(ji,jj) + zdep(ji,jj+1) )
+                  zgdrho =    fsbeta( zt, zs, zh )                                    &
+                     &   * (  fsalbt( zt, zs, zh ) * ( ztb(ji,ijd) - ztb(ji,ijs) )    &  
+                     &                             - ( zsb(ji,ijd) - zsb(ji,ijs) )  ) * vmask(ji,jj,1)
+                  zgdrho = MAX( 0.e0, zgdrho )                         ! only if shelf is denser than deep
+                  !
+                  !                                             ! bbl transport (down-slope direction)
+                  vtr_bbl(ji,jj) = e1v(ji,jj) * e3v_bbl_0(ji,jj) * zgbbl * zgdrho * REAL( mgrhv(ji,jj) )
+               END DO
+            END DO
+         END SELECT
+         !
+      ENDIF
+      !
+   END SUBROUTINE bbl
+
+
+   SUBROUTINE tra_bbl_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_bbl_init  ***
+      !!
+      !! ** Purpose :   Initialization for the bottom boundary layer scheme.
+      !!
+      !! ** Method  :   Read the nambbl namelist and check the parameters
+      !!              called by tra_bbl at the first timestep (nit000)
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj               ! dummy loop indices
+      INTEGER ::   ii0, ii1, ij0, ij1   ! temporary integer
+      REAL(wp), DIMENSION(jpi,jpj) ::   zmbk   ! 2D workspace 
+      !!
+      NAMELIST/nambbl/ nn_bbl_ldf, nn_bbl_adv, rn_ahtbbl, rn_gambbl
+      !!----------------------------------------------------------------------
+
+      REWIND ( numnam )              !* Read Namelist nambbl : bottom boundary layer scheme
+      READ   ( numnam, nambbl )
+      !
+      l_bbl = .TRUE.                 !* flag to compute bbl coef and transport
+      !
+      IF(lwp) THEN                   !* Parameter control and print
+         WRITE(numout,*)
+         WRITE(numout,*) 'tra_bbl_init : bottom boundary layer initialisation'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '       Namelist nambbl : set bbl parameters'
+         WRITE(numout,*) '          diffusive bbl (=1)   or not (=0)    nn_bbl_ldf = ', nn_bbl_ldf
+         WRITE(numout,*) '          advective bbl (=1/2) or not (=0)    nn_bbl_adv = ', nn_bbl_adv
+         WRITE(numout,*) '          diffusive bbl coefficient           rn_ahtbbl  = ', rn_ahtbbl, ' m2/s'
+         WRITE(numout,*) '          advective bbl coefficient           rn_gambbl  = ', rn_gambbl, ' s'
+      ENDIF
+      
+      IF( nn_bbl_adv == 1 )    WRITE(numout,*) '       * Advective BBL using upper velocity'
+      IF( nn_bbl_adv == 2 )    WRITE(numout,*) '       * Advective BBL using velocity = F( delta rho)'
+
+      IF( nn_eos /= 0 )   CALL ctl_stop ( ' bbl parameterisation requires eos = 0. We stop.' )
+
+
+      !                             !* inverse of surface of T-cells
+      e1e2t_r(:,:) = 1.0 / ( e1t(:,:) * e2t(:,:) )
+      
+      !                             !* vertical index of  "deep" bottom u- and v-points
+      DO jj = 1, jpjm1                    ! (the "shelf" bottom k-indices are mbku and mbkv)
+         DO ji = 1, jpim1
+            mbku_d(ji,jj) = MAX(  mbkt(ji+1,jj  ) , mbkt(ji,jj)  )   ! >= 1 as mbkt=1 over land
+            mbkv_d(ji,jj) = MAX(  mbkt(ji  ,jj+1) , mbkt(ji,jj)  )
          END DO
-         !
-      CASE ( 2 )               !==  Linear formulation function of temperature and salinity  ==!
-#  if defined key_vectopt_loop
-         DO jj = 1, 1
-            DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
-#  else
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-#  endif      
-               ! local density gradient along i-bathymetric slope
-               zgdrho = - ( rn_beta *( zsnb(ji+1,jj) - zsnb(ji,jj) )   &
-                  &       - rn_alpha*( ztnb(ji+1,jj) - ztnb(ji,jj) ) )
-               ! sign of local i-gradient of density multiplied by the i-slope
-               zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) )
-               zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj)
-               !
-               ! local density gradient along j-bathymetric slope
-               zgdrho = - ( rn_beta *( zsnb(ji,jj+1) - zsnb(ji,jj) )   &
-                  &       - rn_alpha*( ztnb(ji,jj+1) - ztnb(ji,jj) ) )   
-               ! sign of local j-gradient of density multiplied by the j-slope
-               zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) )
-               zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj)
-            END DO
+      END DO
+      ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 
+      zmbk(:,:) = REAL( mbku_d(:,:), wp )   ;   CALL lbc_lnk(zmbk,'U',1.)   ;   mbku_d(:,:) = MAX( INT( zmbk(:,:) ), 1 )
+      zmbk(:,:) = REAL( mbkv_d(:,:), wp )   ;   CALL lbc_lnk(zmbk,'V',1.)   ;   mbkv_d(:,:) = MAX( INT( zmbk(:,:) ), 1 )
+
+                                        !* sign of grad(H) at u- and v-points
+      mgrhu(jpi,:) = 0.    ;    mgrhu(:,jpj) = 0.   ;    mgrhv(jpi,:) = 0.    ;    mgrhv(:,jpj) = 0.
+      DO jj = 1, jpjm1                
+         DO ji = 1, jpim1
+            mgrhu(ji,jj) = INT(  SIGN( 1.e0, fsdept_0(ji+1,jj,mbkt(ji+1,jj)) - fsdept_0(ji,jj,mbkt(ji,jj)) )  )
+            mgrhv(ji,jj) = INT(  SIGN( 1.e0, fsdept_0(ji,jj+1,mbkt(ji,jj+1)) - fsdept_0(ji,jj,mbkt(ji,jj)) )  )
          END DO
-         !
-      END SELECT
-
-      ! 2. Additional second order diffusive trends
-      ! -------------------------------------------
-
-      ! first derivative (gradient)
-#  if defined key_vectopt_loop
-      jj = 1
-      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
-#  else
-      DO jj = 1, jpjm1
-         DO ji = 1, jpim1
-#  endif
-            zkx(ji,jj) = zki(ji,jj) * ( ztbb(ji+1,jj) - ztbb(ji,jj) )
-            zkz(ji,jj) = zki(ji,jj) * ( zsbb(ji+1,jj) - zsbb(ji,jj) )
-
-            zky(ji,jj) = zkj(ji,jj) * ( ztbb(ji,jj+1) - ztbb(ji,jj) )
-            zkw(ji,jj) = zkj(ji,jj) * ( zsbb(ji,jj+1) - zsbb(ji,jj) )
-#  if ! defined key_vectopt_loop
-         END DO
-#  endif
       END DO
 
-      IF( cp_cfg == "orca" ) THEN
+      DO jj = 1, jpjm1              !* bbl thickness at u- (v-) point 
+         DO ji = 1, jpim1                 ! minimum of top & bottom e3u_0 (e3v_0)
+            e3u_bbl_0(ji,jj) = MIN( fse3u_0(ji,jj,mbkt(ji+1,jj  )), fse3u_0(ji,jj,mbkt(ji,jj)) )  
+            e3v_bbl_0(ji,jj) = MIN( fse3v_0(ji,jj,mbkt(ji  ,jj+1)), fse3v_0(ji,jj,mbkt(ji,jj)) )  
+         END DO 
+      END DO
+      CALL lbc_lnk( e3u_bbl_0, 'U', 1. )   ;   CALL lbc_lnk( e3v_bbl_0, 'V', 1. )      ! lateral boundary conditions
+
+      !                             !* masked diffusive flux coefficients 
+      ahu_bbl_0(:,:) = rn_ahtbbl * e2u(:,:) * e3u_bbl_0(:,:) / e1u(:,:)  * umask(:,:,1)
+      ahv_bbl_0(:,:) = rn_ahtbbl * e1v(:,:) * e3v_bbl_0(:,:) / e2v(:,:)  * vmask(:,:,1)
+
+
+      IF( cp_cfg == "orca" ) THEN   !* ORCA configuration : regional enhancement of ah_bbl
          !
          SELECT CASE ( jp_cfg )
-         !                                           ! =======================
-         CASE ( 2 )                                  !  ORCA_R2 configuration
-            !                                        ! =======================
-            ! Gibraltar enhancement of BBL
-            ij0 = 102   ;   ij1 = 102
+         CASE ( 2 )                          ! ORCA_R2
+            ij0 = 102   ;   ij1 = 102              ! Gibraltar enhancement of BBL
             ii0 = 139   ;   ii1 = 140  
-            zkx( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 4.e0 * zkx( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) )
-            zky( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 4.e0 * zky( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) )
+            ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) =  4.e0*ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))
+            ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) =  4.e0*ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))
             !
-            ! Red Sea enhancement of BBL
-            ij0 =  88   ;   ij1 =  88
+            ij0 =  88   ;   ij1 =  88              ! Red Sea enhancement of BBL
             ii0 = 161   ;   ii1 = 162
-            zkx( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 10.e0 * zkx( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) )
-            zky( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 10.e0 * zky( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) )
+            ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) = 10.e0*ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))
+            ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) = 10.e0*ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))
             !
-            !                                        ! =======================
-         CASE ( 4 )                                  !  ORCA_R4 configuration
-            !                                        ! =======================
-            ! Gibraltar enhancement of BBL
-            ij0 =  52   ;   ij1 =  52
+         CASE ( 4 )                          ! ORCA_R4
+            ij0 =  52   ;   ij1 =  52              ! Gibraltar enhancement of BBL
             ii0 =  70   ;   ii1 =  71  
-            zkx( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 4.e0 * zkx( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) )
-            zky( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 4.e0 * zky( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) )
-            !
+            ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) =  4.e0*ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))
+            ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) =  4.e0*ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))
          END SELECT
-      !
+         !
       ENDIF
-
-
-      ! second derivative (divergence) and add to the general tracer trend
-#  if defined key_vectopt_loop
-      DO jj = 1, 1
-         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
-#  else
-      DO jj = 2, jpjm1
-         DO ji = 2, jpim1
-#  endif
-            ik = max( mbathy(ji,jj)-1, 1 )
-            zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,ik) )
-            zta = (  zkx(ji,jj) - zkx(ji-1,jj  )    &
-                   + zky(ji,jj) - zky(ji  ,jj-1)  ) * zbtr
-            zsa = (  zkz(ji,jj) - zkz(ji-1,jj  )    &
-                   + zkw(ji,jj) - zkw(ji  ,jj-1)  ) * zbtr
-            ta(ji,jj,ik) = ta(ji,jj,ik) + zta
-            sa(ji,jj,ik) = sa(ji,jj,ik) + zsa
-         END DO
-      END DO
-
-      IF( l_trdtra ) THEN      ! save the BBL lateral diffusion trends for diagnostic
-         ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:)
-         ztrds(:,:,:) = sa(:,:,:) - ztrds(:,:,:)
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_bbl, 'TRA', kt)
-      ENDIF
-
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' bbl  - Ta: ', mask1=tmask,   &
-         &                       tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-      !
-   END SUBROUTINE tra_bbl_dif
-
-# if defined key_trabbl_adv
-   !!----------------------------------------------------------------------
-   !!   'key_trabbl_adv'                    advective bottom boundary layer
-   !!----------------------------------------------------------------------
-#  include "trabbl_adv.h90"
-# else
-   !!----------------------------------------------------------------------
-   !!   Default option :                 NO advective bottom boundary layer
-   !!----------------------------------------------------------------------
-   SUBROUTINE tra_bbl_adv (kt )              ! Empty routine
-      INTEGER, INTENT(in) :: kt
-      WRITE(*,*) 'tra_bbl_adv: You should not have seen this print! error?', kt
-   END SUBROUTINE tra_bbl_adv
-# endif
-
-   SUBROUTINE tra_bbl_init
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_bbl_init  ***
-      !!
-      !! ** Purpose :   Initialization for the bottom boundary layer scheme.
-      !!
-      !! ** Method  :   Read the nambbl namelist and check the parameters
-      !!      called by tra_bbl at the first timestep (nit000)
-      !!----------------------------------------------------------------------
-      INTEGER ::   ji, jj      ! dummy loop indices
-      REAL(wp),  DIMENSION(jpi,jpj) :: zmbk  
-
-      NAMELIST/nambbl/ rn_ahtbbl
-      !!----------------------------------------------------------------------
-
-      REWIND ( numnam )              ! Read Namelist nambbl : bottom boundary layer scheme
-      READ   ( numnam, nambbl )
-
-      IF(lwp) THEN                   ! Parameter control and print
-         WRITE(numout,*)
-         WRITE(numout,*) 'tra_bbl_init : '
-         WRITE(numout,*) '~~~~~~~~~~~~'
-         IF( lk_trabbl_dif )   WRITE(numout,*) '               * Diffusive Bottom Boundary Layer'
-         IF( lk_trabbl_adv )   WRITE(numout,*) '               * Advective Bottom Boundary Layer'
-         WRITE(numout,*) '       Namelist nambbl : set bbl parameters'
-         WRITE(numout,*) '          bottom boundary layer coef.    rn_ahtbbl = ', rn_ahtbbl
-      ENDIF
- 
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            mbkt(ji,jj) = MAX( mbathy(ji,jj) - 1, 1 )   ! vertical index of the bottom ocean T-level
-         END DO
-      END DO
-      DO jj = 1, jpjm1
-         DO ji = 1, jpim1
-            mbku(ji,jj) = MAX( MIN( mbathy(ji+1,jj  ), mbathy(ji,jj) ) - 1, 1 )
-            mbkv(ji,jj) = MAX( MIN( mbathy(ji  ,jj+1), mbathy(ji,jj) ) - 1, 1 )
-         END DO
-      END DO
-
-      zmbk(:,:) = FLOAT( mbku (:,:) )   
-      CALL lbc_lnk(zmbk,'U',1.)
-      mbku(:,:) = MAX( INT( zmbk(:,:) ), 1 ) 
-
-      zmbk(:,:) = FLOAT( mbkv (:,:) )   
-      CALL lbc_lnk(zmbk,'V',1.)
-      mbkv(:,:) = MAX( INT( zmbk(:,:) ), 1 ) 
-
-# if defined key_trabbl_adv
-      w_bbl(:,:,:) = 0.e0          ! initialisation of w_bbl to zero
-# endif
       !
    END SUBROUTINE tra_bbl_init
@@ -449,13 +600,11 @@
    !!   Dummy module :                      No bottom boundary layer scheme
    !!----------------------------------------------------------------------
-   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl_dif = .FALSE.   !: diff bbl flag
-   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl_adv = .FALSE.   !: adv  bbl flag
+   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl = .FALSE.   !: bbl flag
 CONTAINS
-   SUBROUTINE tra_bbl_dif( kt )              ! Empty routine
-      WRITE(*,*) 'tra_bbl_dif: You should not have seen this print! error?', kt
-   END SUBROUTINE tra_bbl_dif
-   SUBROUTINE tra_bbl_adv( kt )              ! Empty routine
-      WRITE(*,*) 'tra_bbl_adv: You should not have seen this print! error?', kt
-   END SUBROUTINE tra_bbl_adv
+   SUBROUTINE tra_bbl_init               ! Dummy routine
+   END SUBROUTINE tra_bbl_init
+   SUBROUTINE tra_bbl( kt )              ! Dummy routine
+      WRITE(*,*) 'tra_bbl: You should not have seen this print! error?', kt
+   END SUBROUTINE tra_bbl
 #endif
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl_adv.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl_adv.h90	(revision 2527)
+++ 	(revision )
@@ -1,426 +1,0 @@
-   !!----------------------------------------------------------------------
-   !!                     ***  trabbl_adv.h90  ***
-   !!----------------------------------------------------------------------
-   !! History :  8.5  !  02-12  (A. de Miranda, G. Madec)  Original Code 
-   !!            9.0  !  04-01  (A. de Miranda, G. Madec, J.M. Molines )
-   !!----------------------------------------------------------------------     
-
-   !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE tra_bbl_adv( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_bbl_adv  ***
-      !!                   
-      !! ** Purpose :   Compute the before tracer (t & s) trend associated 
-      !!     with the bottom boundary layer and add it to the general trend
-      !!     of tracer equations. The bottom boundary layer is supposed to be 
-      !!     both an advective and diffusive bottom boundary layer.
-      !!
-      !! ** Method  :   Computes the bottom boundary horizontal and vertical 
-      !!      advection terms. Add it to the general trend : ta =ta + adv_bbl.
-      !!        When the product grad( rho) * grad(h) < 0 (where grad is a
-      !!      along bottom slope gradient) an additional lateral 2nd order
-      !!      diffusion along the bottom slope is added to the general
-      !!      tracer trend, otherwise the additional trend is set to 0.
-      !!      Second order operator (laplacian type) with variable coefficient
-      !!      computed as follow for temperature (idem on s):
-      !!         difft = 1/(e1t*e2t*e3t) { di-1[ ahbt e2u*e3u/e1u di[ztb] ]
-      !!                                 + dj-1[ ahbt e1v*e3v/e2v dj[ztb] ] }
-      !!      where ztb is a 2D array: the bottom ocean te;perature and ahtb
-      !!      is a time and space varying diffusive coefficient defined by:
-      !!         ahbt = zahbp    if grad(rho).grad(h) < 0
-      !!              = 0.       otherwise.
-      !!      Note that grad(.) is the along bottom slope gradient. grad(rho)
-      !!      is evaluated using the local density (i.e. referenced at the
-      !!      local depth). Typical value of ahbt is 2000 m2/s (equivalent to
-      !!      a downslope velocity of 20 cm/s if the condition for slope
-      !!      convection is satified)
-      !!        Add this before trend to the general trend (ta,sa) of the
-      !!      botton ocean tracer point:
-      !!              ta = ta + difft
-      !!
-      !! ** Action  : - update (ta,sa) at the bottom level with the bottom
-      !!                boundary layer trend
-      !!
-      !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591.
-      !!----------------------------------------------------------------------     
-      USE eosbn2                      ! equation of state
-      USE oce, ONLY :   ztrdt => ua   ! use ua as 3D workspace   
-      USE oce, ONLY :   ztrds => va   ! use va as 3D workspace 
-      USE iom                           
-      !!
-      INTEGER, INTENT( in ) ::   kt   ! ocean time-step 
-      !!
-      INTEGER  ::   ji, jj, jk        ! dummy loop indices
-      INTEGER  ::   ik                ! temporary integers
-      INTEGER  ::   iku, iku1, iku2   !    "          "
-      INTEGER  ::   ikv, ikv1, ikv2   !    "          "
-      REAL(wp) ::   zsign, zh, zalbet     ! temporary scalars
-      REAL(wp) ::   zgdrho, zbtr          !    "         " 
-      REAL(wp) ::   zbt, zsigna           !    "         "
-      REAL(wp) ::   zfui, ze3u, zt, zta   !    "         "
-      REAL(wp) ::   zfvj, ze3v, zs, zsa   !    "         "
-      REAL(wp), DIMENSION(jpi,jpj)     ::   zalphax, zwu, zunb   ! temporary 2D workspace
-      REAL(wp), DIMENSION(jpi,jpj)     ::   zalphay, zwv, zvnb   !    "             "
-      REAL(wp), DIMENSION(jpi,jpj)     ::   zwx, zwy, zww, zwz   !    "             "
-      REAL(wp), DIMENSION(jpi,jpj)     ::   ztbb, zsbb           !    "             "
-      REAL(wp), DIMENSION(jpi,jpj)     ::   ztnb, zsnb, zdep     !    "             "
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zhdivn               ! temporary 3D workspace
-      REAL(wp) ::   fsalbt, pft, pfs, pfh   ! statement function
-      !!----------------------------------------------------------------------
-      ! ratio alpha/beta
-      ! ================
-      !  fsalbt: ratio of thermal over saline expension coefficients
-      !       pft :  potential temperature in degrees celcius
-      !       pfs :  salinity anomaly (s-35) in psu
-      !       pfh :  depth in meters
-
-      fsalbt( pft, pfs, pfh ) =                                              &
-         ( ( ( -0.255019e-07 * pft + 0.298357e-05 ) * pft                    &
-                                   - 0.203814e-03 ) * pft                    &
-                                   + 0.170907e-01 ) * pft                    &
-                                   + 0.665157e-01                            &
-         +(-0.678662e-05 * pfs - 0.846960e-04 * pft + 0.378110e-02 ) * pfs   &
-         +  ( ( - 0.302285e-13 * pfh                                         &
-                - 0.251520e-11 * pfs                                         &
-                + 0.512857e-12 * pft * pft          ) * pfh                  &
-                                     - 0.164759e-06   * pfs                  &
-             +(   0.791325e-08 * pft - 0.933746e-06 ) * pft                  &
-                                     + 0.380374e-04 ) * pfh
-      !!----------------------------------------------------------------------
-
-      IF( kt == nit000 )   CALL tra_bbl_init    ! initialization at first time-step
-
-      ! 1. 2D fields of bottom temperature and salinity, and bottom slope
-      ! -----------------------------------------------------------------
-      ! mbathy= number of w-level, minimum value=1 (cf dommsk.F)
-
-#if defined key_vectopt_loop
-      DO jj = 1, 1
-         DO ji = 1, jpij   ! vector opt. (forced unrolling)
-#else
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-#endif
-            ik = mbkt(ji,jj)                               ! index of the bottom ocean T-level
-            ztnb(ji,jj) = tn(ji,jj,ik)
-            zsnb(ji,jj) = sn(ji,jj,ik)
-            ztbb(ji,jj) = tb(ji,jj,ik)
-            zsbb(ji,jj) = sb(ji,jj,ik) 
-            zdep(ji,jj) = fsdept(ji,jj,ik)                 ! depth of the ocean bottom T-level
-
-            zunb(ji,jj) = un(ji,jj,mbku(ji,jj)) 
-            zvnb(ji,jj) = vn(ji,jj,mbkv(ji,jj)) 
-         END DO
-      END DO
-
-
-      ! 2. Criteria of additional bottom diffusivity: grad(rho).grad(h)<0
-      ! --------------------------------------------
-      ! Sign of the local density gradient along the i- and j-slopes
-      ! multiplied by the slope of the ocean bottom
-
-      SELECT CASE ( nn_eos )
-      !
-      CASE ( 0 )               ! Jackett and McDougall (1994) formulation
-         !
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               !   ... temperature, salinity anomalie and depth
-               zt = 0.5 * ( ztnb(ji,jj) + ztnb(ji+1,jj) )
-               zs = 0.5 * ( zsnb(ji,jj) + zsnb(ji+1,jj) ) - 35.0
-               zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) )
-               !   ... masked ratio alpha/beta
-               zalbet = fsalbt( zt, zs, zh ) * umask(ji,jj,1)
-               !   ... local density gradient along i-bathymetric slope
-               zgdrho = zalbet * ( ztnb(ji+1,jj) - ztnb(ji,jj) )   &
-                  &       -      ( zsnb(ji+1,jj) - zsnb(ji,jj) )
-               zgdrho = zgdrho * umask(ji,jj,1)
-               !   ... sign of local i-gradient of density multiplied by the i-slope
-               zsign = SIGN( 0.5, -zgdrho     * ( zdep(ji+1,jj) - zdep(ji,jj) ) )
-               zsigna= SIGN( 0.5, zunb(ji,jj) * ( zdep(ji+1,jj) - zdep(ji,jj) ) )
-               zalphax(ji,jj)=( 0.5 + zsigna ) * ( 0.5 - zsign ) * umask(ji,jj,1)
-               !
-               !   ... temperature, salinity anomalie and depth
-               zt = 0.5 * ( ztnb(ji,jj+1) + ztnb(ji,jj) )
-               zs = 0.5 * ( zsnb(ji,jj+1) + zsnb(ji,jj) ) - 35.0
-               zh = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) )
-               !   ... masked ratio alpha/beta
-               zalbet = fsalbt( zt, zs, zh ) * vmask(ji,jj,1)
-               !   ... local density gradient along j-bathymetric slope
-               zgdrho = zalbet * ( ztnb(ji,jj+1) - ztnb(ji,jj) )   &
-                  &       -      ( zsnb(ji,jj+1) - zsnb(ji,jj) )
-               zgdrho = zgdrho*vmask(ji,jj,1)
-               !   ... sign of local j-gradient of density multiplied by the j-slope
-               zsign = SIGN( 0.5, -zgdrho     * ( zdep(ji,jj+1) - zdep(ji,jj) ) )
-               zsigna= SIGN( 0.5, zvnb(ji,jj) * ( zdep(ji,jj+1) - zdep(ji,jj) ) )
-               zalphay(ji,jj)=( 0.5 + zsigna ) * ( 0.5 - zsign ) * vmask(ji,jj,1)
-            END DO
-         END DO
-         !
-      CASE ( 1 )               ! Linear formulation function of temperature only
-         !
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               ! local 'density/temperature' gradient along i-bathymetric slope
-               zgdrho =  ( ztnb(ji+1,jj) - ztnb(ji,jj) )
-               ! sign of local i-gradient of density multiplied by the i-slope
-               zsign = SIGN( 0.5, - zgdrho    * ( zdep(ji+1,jj) - zdep(ji,jj) ) )
-               zsigna= SIGN( 0.5, zunb(ji,jj) * ( zdep(ji+1,jj) - zdep(ji,jj) ) )
-               zalphax(ji,jj)=( 0.5 + zsigna ) * ( 0.5 - zsign ) * umask(ji,jj,1)
-               ! 
-               ! local density gradient along j-bathymetric slope
-               zgdrho =  ( ztnb(ji,jj+1) - ztnb(ji,jj) )
-               ! sign of local j-gradient of density multiplied by the j-slope
-               zsign = SIGN( 0.5, -zgdrho     * ( zdep(ji,jj+1) - zdep(ji,jj) ) )
-               zsigna= SIGN( 0.5, zvnb(ji,jj) * ( zdep(ji,jj+1) - zdep(ji,jj) ) )
-               zalphay(ji,jj)=( 0.5 + zsigna ) * ( 0.5 - zsign ) * vmask(ji,jj,1)
-            END DO
-         END DO
-         !
-      CASE ( 2 )               ! Linear formulation function of temperature and salinity
-         !
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.            
-               ! local density gradient along i-bathymetric slope
-               zgdrho = - ( rn_beta *( zsnb(ji+1,jj) - zsnb(ji,jj) )   &
-                  &       - rn_alpha*( ztnb(ji+1,jj) - ztnb(ji,jj) ) )
-               ! sign of local i-gradient of density multiplied by the i-slope
-               zsign = SIGN( 0.5, - zgdrho    * ( zdep(ji+1,jj) - zdep(ji,jj) ) )
-               zsigna= SIGN( 0.5, zunb(ji,jj) * ( zdep(ji+1,jj) - zdep(ji,jj) ) )
-               zalphax(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * umask(ji,jj,1)
-               ! 
-               ! local density gradient along j-bathymetric slope
-               zgdrho = - ( rn_beta *( zsnb(ji,jj+1) - zsnb(ji,jj) )   &
-                  &       - rn_alpha*( ztnb(ji,jj+1) - ztnb(ji,jj) ) )   
-               ! sign of local j-gradient of density multiplied by the j-slope
-               zsign = SIGN( 0.5, - zgdrho    * ( zdep(ji,jj+1) - zdep(ji,jj) ) )
-               zsigna= SIGN( 0.5, zvnb(ji,jj) * ( zdep(ji,jj+1) - zdep(ji,jj) ) )
-               zalphay(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * vmask(ji,jj,1)
-            END DO
-         END DO
-         !
-      END SELECT
-
-      ! lateral boundary conditions on zalphax and zalphay   (unchanged sign)
-       CALL lbc_lnk( zalphax, 'U', 1. )   ;   CALL lbc_lnk( zalphay, 'V', 1. )
-
-
-      ! 3. Velocities that are exchanged between ajacent bottom boxes.
-      !---------------------------------------------------------------
-
-      ! ... is equal to zero but where bbl will work.
-      u_bbl(:,:,:) = 0.e0
-      v_bbl(:,:,:) = 0.e0
-
-      IF( ln_zps ) THEN     ! partial steps correction   
-      
-# if defined key_vectopt_loop
-         DO jj = 1, 1
-            DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
-# else   
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-# endif
-               iku  = mbku(ji  ,jj  )
-               ikv  = mbkv(ji  ,jj  )  
-               iku1 = mbkt(ji+1,jj  )
-               iku2 = mbkt(ji  ,jj  )
-               ikv1 = mbkt(ji  ,jj+1)
-               ikv2 = mbkt(ji  ,jj  )
-               ze3u = MIN( fse3u(ji,jj,iku1), fse3u(ji,jj,iku2) ) 
-               ze3v = MIN( fse3v(ji,jj,ikv1), fse3v(ji,jj,ikv2) ) 
-               
-               IF( MAX(iku,ikv) >  1 ) THEN
-                  u_bbl(ji,jj,iku) = zalphax(ji,jj) * un(ji,jj,iku) * ze3u / fse3u(ji,jj,iku)
-                  v_bbl(ji,jj,ikv) = zalphay(ji,jj) * vn(ji,jj,ikv) * ze3v / fse3v(ji,jj,ikv)       
-               ENDIF
-            END DO
-         END DO
-
-         ! lateral boundary conditions on u_bbl and v_bbl   (changed sign)
-         CALL lbc_lnk( u_bbl, 'U', -1. )   ;   CALL lbc_lnk( v_bbl, 'V', -1. )
-       
-      ELSE       ! if not partial step loop over the whole domain no lbc call
-
-#if defined key_vectopt_loop
-         DO jj = 1, 1
-            DO ji = 1, jpij   ! vector opt. (forced unrolling)
-#else
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-#endif   
-               iku = mbku(ji,jj)
-               ikv = mbkv(ji,jj)
-               IF( MAX(iku,ikv) >  1 ) THEN
-                  u_bbl(ji,jj,iku) = zalphax(ji,jj) * un(ji,jj,iku) 
-                  v_bbl(ji,jj,ikv) = zalphay(ji,jj) * vn(ji,jj,ikv)       
-               ENDIF
-            END DO
-         END DO
-       
-      ENDIF
-
-
-      ! 5. Along sigma advective trend
-      ! -------------------------------
-      ! ... Second order centered tracer flux at u and v-points
-
-# if defined key_vectopt_loop
-      DO jj = 1, 1
-         DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
-# else
-      DO jj = 1, jpjm1
-         DO ji = 1, jpim1
-# endif
-            iku = mbku(ji,jj)
-            ikv = mbkv(ji,jj)
-            zfui = e2u(ji,jj) * fse3u(ji,jj,iku) * u_bbl(ji,jj,iku)
-            zfvj = e1v(ji,jj) * fse3v(ji,jj,ikv) * v_bbl(ji,jj,ikv)
-            ! centered scheme
-!           zwx(ji,jj) = 0.5* zfui * ( ztnb(ji,jj) + ztnb(ji+1,jj) )
-!           zwy(ji,jj) = 0.5* zfvj * ( ztnb(ji,jj) + ztnb(ji,jj+1) )
-!           zww(ji,jj) = 0.5* zfui * ( zsnb(ji,jj) + zsnb(ji+1,jj) )
-!           zwz(ji,jj) = 0.5* zfvj * ( zsnb(ji,jj) + zsnb(ji,jj+1) )
-            ! upstream scheme
-            zwx(ji,jj) = ( ( zfui + ABS( zfui ) ) * ztbb(ji  ,jj  )   &
-               &          +( zfui - ABS( zfui ) ) * ztbb(ji+1,jj  ) ) * 0.5
-            zwy(ji,jj) = ( ( zfvj + ABS( zfvj ) ) * ztbb(ji  ,jj  )   &
-               &          +( zfvj - ABS( zfvj ) ) * ztbb(ji  ,jj+1) ) * 0.5
-            zww(ji,jj) = ( ( zfui + ABS( zfui ) ) * zsbb(ji  ,jj  )   &
-               &          +( zfui - ABS( zfui ) ) * zsbb(ji+1,jj  ) ) * 0.5
-            zwz(ji,jj) = ( ( zfvj + ABS( zfvj ) ) * zsbb(ji  ,jj  )   &
-               &          +( zfvj - ABS( zfvj ) ) * zsbb(ji  ,jj+1) ) * 0.5
-         END DO
-      END DO
-# if defined key_vectopt_loop
-      DO jj = 1, 1
-         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
-# else
-      DO jj = 2, jpjm1
-         DO ji = 2, jpim1
-# endif
-            ik = mbkt(ji,jj)
-            zbtr = 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,ik) )
-            ! horizontal advective trends
-            zta = - zbtr * (  zwx(ji,jj) - zwx(ji-1,jj  )   &
-               &            + zwy(ji,jj) - zwy(ji  ,jj-1)  )
-            zsa = - zbtr * (  zww(ji,jj) - zww(ji-1,jj  )   &
-               &            + zwz(ji,jj) - zwz(ji  ,jj-1)  )
-
-            ! add it to the general tracer trends
-            ta(ji,jj,ik) = ta(ji,jj,ik) + zta
-            sa(ji,jj,ik) = sa(ji,jj,ik) + zsa
-         END DO
-      END DO
-
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' bbl  - Ta: ', mask1=tmask,   &
-         &                       tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-
-      ! 6. Vertical advection velocities
-      ! --------------------------------
-      ! ... computes divergence perturbation (velocties to be removed from upper t boxes :
-      DO jk= 1, jpkm1
-         DO jj=1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               zwu(ji,jj) = -e2u(ji,jj) * u_bbl(ji,jj,jk) * fse3u(ji,jj,jk)
-               zwv(ji,jj) = -e1v(ji,jj) * v_bbl(ji,jj,jk) * fse3v(ji,jj,jk)
-            END DO
-         END DO
-
-      ! ... horizontal divergence
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
-               zhdivn(ji,jj,jk) = (  zwu(ji,jj) - zwu(ji-1,jj  )   &
-                                   + zwv(ji,jj) - zwv(ji  ,jj-1)  ) / zbt
-            END DO
-         END DO
-      END DO
-
-
-      ! ... horizontal bottom divergence
-
-      IF( ln_zps ) THEN
- 
-# if defined key_vectopt_loop
-         DO jj = 1, 1
-            DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
-# else
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-# endif
-               iku  = mbku(ji  ,jj  )
-               ikv  = mbkv(ji  ,jj  )  
-               iku1 = mbkt(ji+1,jj  )
-               iku2 = mbkt(ji  ,jj  )
-               ikv1 = mbkt(ji  ,jj+1)
-               ikv2 = mbkt(ji  ,jj  )
-               ze3u = MIN( fse3u(ji,jj,iku1), fse3u(ji,jj,iku2) ) 
-               ze3v = MIN( fse3v(ji,jj,ikv1), fse3v(ji,jj,ikv2) ) 
-
-               zwu(ji,jj) = zalphax(ji,jj) * e2u(ji,jj) * ze3u  
-               zwv(ji,jj) = zalphay(ji,jj) * e1v(ji,jj) * ze3v
-            END DO
-         END DO  
-         !
-      ELSE
-         !
-# if defined key_vectopt_loop
-         DO jj = 1, 1
-            DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
-# else
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-# endif
-               iku = mbku(ji,jj)
-               ikv = mbkv(ji,jj)
-               zwu(ji,jj) = zalphax(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,iku) 
-               zwv(ji,jj) = zalphay(ji,jj) * e1v(ji,jj) * fse3v(ji,jj,ikv) 
-            END DO
-         END DO
-         !
-      ENDIF
- 
-
-# if defined key_vectopt_loop
-      DO jj = 1, 1
-         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
-# else
-      DO jj = 2, jpjm1
-         DO ji = 2, jpim1
-# endif
-            ik = mbkt(ji,jj)
-            zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,ik)
-            zhdivn(ji,jj,ik) =   &
-               &   (  zwu(ji  ,jj  ) * ( zunb(ji  ,jj  ) - un(ji  ,jj  ,ik) )   &
-               &    - zwu(ji-1,jj  ) * ( zunb(ji-1,jj  ) - un(ji-1,jj  ,ik) )   &
-               &    + zwv(ji  ,jj  ) * ( zvnb(ji  ,jj  ) - vn(ji  ,jj  ,ik) )   &
-               &    - zwv(ji  ,jj-1) * ( zvnb(ji  ,jj-1) - vn(ji  ,jj-1,ik) )   &
-               &   ) / zbt
-
-         END DO
-      END DO
-
-      ! 7. compute additional vertical velocity to be used in t boxes
-      ! -------------------------------------------------------------
-      ! ... Computation from the bottom
-      ! Note that w_bbl(:,:,jpk) has been set to 0 in tra_bbl_init
-      DO jk = jpkm1, 1, -1
-         DO jj= 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               w_bbl(ji,jj,jk) = w_bbl(ji,jj,jk+1) - fse3t(ji,jj,jk)*zhdivn(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-      CALL lbc_lnk( w_bbl, 'W', 1. )      ! Boundary condition on w_bbl   (unchanged sign)
-
-      CALL iom_put( "uoce_bbl", u_bbl )   ! bbl i-current      
-      CALL iom_put( "voce_bbl", v_bbl )   ! bbl j-current
-      CALL iom_put( "woce_bbl", w_bbl )   ! bbl vert. current
-      !
-   END SUBROUTINE tra_bbl_adv
Index: trunk/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90	(revision 2528)
@@ -13,32 +13,36 @@
    !!  NEMO      1.0  ! 2002-08  (G. Madec, E. Durand)  free form + modules
    !!            3.2  ! 2009-08  (G. Madec, C. Talandier)  DOCTOR norm for namelist parameter
+   !!            3.3  ! 2010-06  (C. Ethe, G. Madec) merge TRA-TRC 
    !!----------------------------------------------------------------------
 #if   defined key_tradmp   ||   defined key_esopa
    !!----------------------------------------------------------------------
-   !!   key_tradmp                                         internal damping
+   !!   'key_tradmp'                                       internal damping
    !!----------------------------------------------------------------------
-   !!   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
+   !!   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 dynamics and tracers variables
-   USE dom_oce         ! ocean space and time domain variables
-   USE trdmod          ! ocean active tracers trends 
-   USE trdmod_oce      ! ocean variables trends
-   USE zdf_oce         ! ocean vertical physics
-   USE phycst          ! Define parameters for the routines
-   USE dtatem          ! temperature data
-   USE dtasal          ! salinity data
-   USE zdfmxl          ! mixed layer depth
-   USE in_out_manager  ! I/O manager
-   USE lib_mpp         ! distribued memory computing
-   USE prtctl          ! Print control
+   USE oce            ! ocean: variables
+   USE dom_oce        ! ocean: domain variables
+   USE trdmod_oce     ! ocean: trend variables
+   USE trdtra         ! active tracers: trends
+   USE zdf_oce        ! ocean: vertical physics
+   USE phycst         ! physical constants
+   USE dtatem         ! data: temperature
+   USE dtasal         ! data: salinity
+   USE zdfmxl         ! vertical physics: mixed layer depth
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE prtctl         ! Print control
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   tra_dmp    ! routine called by step.F90
+   PUBLIC   tra_dmp      ! routine called by step.F90
+   PUBLIC   tra_dmp_init ! routine called by opa.F90
+   PUBLIC   dtacof       ! routine called by in both tradmp.F90 and trcdmp.F90
+   PUBLIC   dtacof_zoom  ! routine called by in both tradmp.F90 and trcdmp.F90
 
 #if ! defined key_agrif
@@ -47,13 +51,15 @@
    LOGICAL, PUBLIC            ::   lk_tradmp = .TRUE.     !: internal damping flag
 #endif
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   strdmp   !: damping salinity trend (psu/s)
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   ttrdmp   !: damping temperature trend (Celcius/s)
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   resto    !: restoring coeff. on T and S (s-1)
    
-   !                             !!* Namelist namtra_dmp : T & S newtonian damping *
-   INTEGER  ::   nn_hdmp =   -1   ! = 0/-1/'latitude' for damping over T and S
-   INTEGER  ::   nn_zdmp =    0   ! = 0/1/2 flag for damping in the mixed layer
-   REAL(wp) ::   rn_surf =   50.  ! surface time scale for internal damping        [days]
-   REAL(wp) ::   rn_bot  =  360.  ! bottom time scale for internal damping         [days]
-   REAL(wp) ::   rn_dep  =  800.  ! depth of transition between rn_surf and rn_bot [meters]
-   INTEGER  ::   nn_file =    2   ! = 1 create a damping.coeff NetCDF file 
+   !                                !!* Namelist namtra_dmp : T & S newtonian damping *
+   INTEGER  ::   nn_hdmp =   -1      ! = 0/-1/'latitude' for damping over T and S
+   INTEGER  ::   nn_zdmp =    0      ! = 0/1/2 flag for damping in the mixed layer
+   REAL(wp) ::   rn_surf =   50._wp  ! surface time scale for internal damping        [days]
+   REAL(wp) ::   rn_bot  =  360._wp  ! bottom time scale for internal damping         [days]
+   REAL(wp) ::   rn_dep  =  800._wp  ! depth of transition between rn_surf and rn_bot [meters]
+   INTEGER  ::   nn_file =    2      ! = 1 create a damping.coeff NetCDF file 
 
    !! * Substitutions
@@ -61,9 +67,8 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -86,20 +91,11 @@
       !! ** Action  : - (ta,sa)   tracer trends updated with the damping trend
       !!----------------------------------------------------------------------
-      USE oce, ONLY :   ztrdt => ua   ! use ua as 3D workspace   
-      USE oce, ONLY :   ztrds => va   ! use va as 3D workspace   
-      !!
       INTEGER, INTENT(in) ::   kt   ! ocean time-step index
       !!
-      INTEGER ::   ji, jj, jk   ! dummy loop indices
-      !!----------------------------------------------------------------------
-
-      IF( kt == nit000 )   CALL tra_dmp_init      ! Initialization
-
-      IF( l_trdtra )   THEN                       ! Save ta and sa trends
-         ztrdt(:,:,:) = ta(:,:,:) 
-         ztrds(:,:,:) = sa(:,:,:) 
-      ENDIF
-
-      SELECT CASE ( nn_zdmp ) 
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zta, zsa     ! local scalars
+      !!----------------------------------------------------------------------
+      !
+      SELECT CASE ( nn_zdmp )     !==    type of damping   ==!
       !
       CASE( 0 )                   !==  newtonian damping throughout the water column  ==!
@@ -107,6 +103,10 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ta(ji,jj,jk) = ta(ji,jj,jk) + resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tb(ji,jj,jk) )
-                  sa(ji,jj,jk) = sa(ji,jj,jk) + resto(ji,jj,jk) * ( s_dta(ji,jj,jk) - sb(ji,jj,jk) )
+                  zta = resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_tem) )
+                  zsa = resto(ji,jj,jk) * ( s_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_sal) )
+                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta
+                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa
+                  strdmp(ji,jj,jk) = zsa           ! save the salinity trend (used in asmtrj)
+                  ttrdmp(ji,jj,jk) = zta
                END DO
             END DO
@@ -117,8 +117,15 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  IF( avt(ji,jj,jk) <= 5.e-4 ) THEN
-                     ta(ji,jj,jk) = ta(ji,jj,jk) + resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tb(ji,jj,jk) )
-                     sa(ji,jj,jk) = sa(ji,jj,jk) + resto(ji,jj,jk) * ( s_dta(ji,jj,jk) - sb(ji,jj,jk) )
+                  IF( avt(ji,jj,jk) <= 5.e-4_wp ) THEN
+                     zta = resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_tem) )
+                     zsa = resto(ji,jj,jk) * ( s_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_sal) )
+                  ELSE
+                     zta = 0._wp
+                     zsa = 0._wp  
                   ENDIF
+                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta
+                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa
+                  strdmp(ji,jj,jk) = zsa           ! save the salinity trend (used in asmtrj)
+                  ttrdmp(ji,jj,jk) = zta
                END DO
             END DO
@@ -130,7 +137,14 @@
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN
-                     ta(ji,jj,jk) = ta(ji,jj,jk) + resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tb(ji,jj,jk) )
-                     sa(ji,jj,jk) = sa(ji,jj,jk) + resto(ji,jj,jk) * ( s_dta(ji,jj,jk) - sb(ji,jj,jk) )
+                     zta = resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_tem) )
+                     zsa = resto(ji,jj,jk) * ( s_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_sal) )
+                  ELSE
+                     zta = 0._wp
+                     zsa = 0._wp  
                   ENDIF
+                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta
+                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa
+                  strdmp(ji,jj,jk) = zsa           ! save the salinity trend (used in asmtrj)
+                  ttrdmp(ji,jj,jk) = zta
                END DO
             END DO
@@ -138,13 +152,12 @@
          !
       END SELECT
-
+      !
       IF( l_trdtra )   THEN       ! trend diagnostic
-         ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:)
-         ztrds(:,:,:) = sa(:,:,:) - ztrds(:,:,:)
-         CALL trd_mod( ztrdt, ztrds, jptra_trd_dmp, 'TRA', kt )
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_dmp, ttrdmp )
+         CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_dmp, strdmp )
       ENDIF
       !                           ! Control print
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' dmp  - Ta: ', mask1=tmask,   &
-         &                       tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' dmp  - Ta: ', mask1=tmask,   &
+         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
       !
    END SUBROUTINE tra_dmp
@@ -164,5 +177,6 @@
       REWIND ( numnam )                  ! Read Namelist namtra_dmp : temperature and salinity damping term
       READ   ( numnam, namtra_dmp )
-      IF( lzoom )   nn_zdmp = 0           ! restoring to climatology at closed north or south boundaries
+      
+      IF( lzoom )   nn_zdmp = 0          ! restoring to climatology at closed north or south boundaries
 
       IF(lwp) THEN                       ! Namelist print
@@ -199,7 +213,10 @@
          &   CALL ctl_stop( 'no temperature and/or salinity data define key_dtatem and key_dtasal' )
 
+      strdmp(:,:,:) = 0._wp       ! internal damping salinity trend (used in asmtrj)
+      ttrdmp(:,:,:) = 0._wp
       !                          ! Damping coefficients initialization
-      IF( lzoom ) THEN   ;   CALL dtacof_zoom
-      ELSE               ;   CALL dtacof
+      IF( lzoom ) THEN   ;   CALL dtacof_zoom( resto )
+      ELSE               ;   CALL dtacof( nn_hdmp, rn_surf, rn_bot, rn_dep,  &
+                             &            nn_file, 'TRA'  , resto            )
       ENDIF
       !
@@ -207,5 +224,5 @@
 
 
-   SUBROUTINE dtacof_zoom
+   SUBROUTINE dtacof_zoom( presto )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE dtacof_zoom  ***
@@ -220,25 +237,27 @@
       !! ** Action  : - resto, the damping coeff. for T and S
       !!----------------------------------------------------------------------
-      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices
-      REAL(wp) ::   zlat, zlat0, zlat1, zlat2   ! temporary scalar
-      REAL(wp), DIMENSION(6)  ::   zfact        ! temporary workspace
-      !!----------------------------------------------------------------------
-
-      zfact(1) =  1.
-      zfact(2) =  1. 
-      zfact(3) = 11./12.
-      zfact(4) =  8./12.
-      zfact(5) =  4./12.
-      zfact(6) =  1./12.
-      zfact(:) = zfact(:) / ( 5. * rday )    ! 5 days max restoring time scale
-
-      resto(:,:,:) = 0.e0
+      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
+      !!----------------------------------------------------------------------
+
+      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 )   resto( mi0(jn+jpizoom):mi1(jn+jpizoom), : , : )                    = zfact(jn)   ! west  closed
-         IF( lzoom_s )   resto( : , mj0(jn+jpjzoom):mj1(jn+jpjzoom), : )                    = zfact(jn)   ! south closed 
-         IF( lzoom_e )   resto( mi0(jpiglo+jpizoom-1-jn):mi1(jpiglo+jpizoom-1-jn) , : , : ) = zfact(jn)   ! east  closed 
-         IF( lzoom_n )   resto( : , mj0(jpjglo+jpjzoom-1-jn):mj1(jpjglo+jpjzoom-1-jn) , : ) = zfact(jn)   ! north closed
+         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
 
@@ -252,8 +271,9 @@
          !
          !                          ! Initialization : 
-         resto(:,:,:) = 0.e0
-         zlat0 = 10.                     ! zlat0 : latitude strip where resto decreases
-         zlat1 = 30.                     ! zlat1 : resto = 1 before zlat1
-         zlat2 = zlat1 + zlat0           ! zlat2 : resto decreases from 1 to 0 between zlat1 and zlat2
+         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
@@ -262,7 +282,7 @@
                   zlat = ABS( gphit(ji,jj) )
                   IF( zlat1 <= zlat .AND. zlat <= zlat2 ) THEN
-                     resto(ji,jj,jk) = 0.5 * ( 1./(5.*rday) ) * ( 1. - cos(rpi*(zlat2-zlat)/zlat0) ) 
+                     presto(ji,jj,jk) = 0.5_wp * z1_5d * (  1._wp - COS( rpi*(zlat2-zlat)/zlat0 )  ) 
                   ELSEIF( zlat < zlat1 ) THEN
-                     resto(ji,jj,jk) = 1./(5.*rday)
+                     presto(ji,jj,jk) = z1_5d
                   ENDIF
                END DO
@@ -272,10 +292,11 @@
       ENDIF
       !                             ! Mask resto array
-      resto(:,:,:) = resto(:,:,:) * tmask(:,:,:)
+      presto(:,:,:) = presto(:,:,:) * tmask(:,:,:)
       !
    END SUBROUTINE dtacof_zoom
 
 
-   SUBROUTINE dtacof
+   SUBROUTINE dtacof( kn_hdmp, pn_surf, pn_bot, pn_dep,  &
+      &               kn_file, cdtype , presto           )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE dtacof  ***
@@ -292,32 +313,38 @@
       USE ioipsl
       !!
-      INTEGER ::   ji, jj, jk                   ! dummy loop indices
-      INTEGER ::   ii0, ii1, ij0, ij1           !    -          -
-      INTEGER ::   inum0                        ! logical unit for file restoring damping term
-      INTEGER ::   icot                         ! logical unit for file distance to the coast
-      REAL(wp) ::   zinfl, zlon                 ! temporary scalars
-      REAL(wp) ::   zlat, zlat0, zlat1, zlat2   !    -         -
-      REAL(wp) ::   zsdmp, zbdmp                !    -         -
+      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 or TRC (tracer 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                !   -      -
       REAL(wp), DIMENSION(jpk)         ::   zhfac
       REAL(wp), DIMENSION(jpi,jpj)     ::   zmrs
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdct
-      !!----------------------------------------------------------------------
-
-      ! ====================================
-      !  ORCA configuration : global domain
-      ! ====================================
-
+      CHARACTER(len=20)                ::   cfile
+      !!----------------------------------------------------------------------
+
+      !                                   ! ====================
+      !                                   !  ORCA configuration : global domain
+      !                                   ! ====================
+      !
       IF(lwp) WRITE(numout,*)
       IF(lwp) WRITE(numout,*) '              dtacof : Global domain of ORCA'
       IF(lwp) WRITE(numout,*) '              ------------------------------'
-
-      ! ... Initialization : 
-      resto(:,:,:) = 0.e0
-
-      !                           !-----------------------------------------!
-      IF( nn_hdmp > 0 ) THEN      !  Damping poleward of 'nn_hdmp' degrees  !
+      !
+      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 ', nn_hdmp,' deg.'
+         IF(lwp) WRITE(numout,*) '              Damping poleward of ', kn_hdmp, ' deg.'
          !
          CALL iom_open ( 'dist.coast.nc', icot, ldstop = .FALSE. )
@@ -331,7 +358,7 @@
 
          !                            ! Compute arrays resto 
-         zinfl = 1000.e3                   ! distance of influence for damping term
-         zlat0 = 10.                       ! latitude strip where resto decreases
-         zlat1 = REAL( nn_hdmp )           ! resto = 0 between -zlat1 and zlat1
+         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|
 
@@ -340,18 +367,18 @@
                zlat = ABS( gphit(ji,jj) )
                IF ( zlat1 <= zlat .AND. zlat <= zlat2 ) THEN
-                  resto(ji,jj,1) = 0.5 * ( 1. - cos(rpi*(zlat-zlat1)/zlat0 ) )
+                  presto(ji,jj,1) = 0.5_wp * (  1._wp - COS( rpi*(zlat-zlat1)/zlat0 )  )
                ELSEIF ( zlat > zlat2 ) THEN
-                  resto(ji,jj,1) = 1.
+                  presto(ji,jj,1) = 1._wp
                ENDIF
             END DO
          END DO
 
-         IF ( nn_hdmp == 20 ) THEN       ! North Indian ocean (20N/30N x 45E/100E) : resto=0
+         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. )
-                  IF ( zlat1 < zlat .AND. zlat < zlat2 .AND. 45. < zlon .AND. zlon < 100. ) THEN
-                     resto(ji,jj,1) = 0.e0
+                  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
@@ -359,6 +386,6 @@
          ENDIF
 
-         zsdmp = 1./(rn_surf * rday)
-         zbdmp = 1./(rn_bot  * rday)
+         zsdmp = 1._wp / ( pn_surf * rday )
+         zbdmp = 1._wp / ( pn_bot  * rday )
          DO jk = 2, jpkm1
             DO jj = 1, jpj
@@ -366,7 +393,7 @@
                   zdct(ji,jj,jk) = MIN( zinfl, zdct(ji,jj,jk) )
                   !   ... Decrease the value in the vicinity of the coast
-                  resto(ji,jj,jk) = resto(ji,jj,1) * 0.5 * ( 1. - COS( rpi*zdct(ji,jj,jk)/zinfl) )
+                  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)
-                  resto(ji,jj,jk) = resto(ji,jj,jk)      * ( zbdmp + (zsdmp-zbdmp)*EXP(-fsdept(ji,jj,jk)/rn_dep) )
+                  presto(ji,jj,jk) = presto(ji,jj,jk) * (  zbdmp + (zsdmp-zbdmp) * EXP(-fsdept(ji,jj,jk)/pn_dep)  )
                END DO
             END DO
@@ -375,98 +402,93 @@
       ENDIF
 
-
-      IF( cp_cfg == "orca" .AND. ( nn_hdmp > 0 .OR. nn_hdmp == -1 ) ) THEN
-
-         !                                         ! =========================
-         !                                         !  Med and Red Sea damping
-         !                                         ! =========================
+      !                                  ! =========================
+      !                                  !  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.e0                             ! damping term on the Med or Red Sea
-
+         !
+         zmrs(:,:) = 0._wp
+         !
          SELECT CASE ( jp_cfg )
          !                                           ! =======================
          CASE ( 4 )                                  !  ORCA_R4 configuration 
             !                                        ! =======================
-            ! Mediterranean Sea
-            ij0 =  50   ;   ij1 =  56
-            ii0 =  81   ;   ii1 =  91   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0
+            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.e0
+            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.e0
+            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*( 1.- COS( rpi*(jk-1)/16. ) ) / rday
+               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./rday
+               zhfac (jk) = 1._wp / rday
             END DO
             !                                        ! =======================
          CASE ( 2 )                                  !  ORCA_R2 configuration 
             !                                        ! =======================
-            ! Mediterranean Sea
-            ij0 =  96   ;   ij1 = 110
-            ii0 = 157   ;   ii1 = 181   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0
+            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.e0
+            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.e0
-            ! Decrease before Gibraltar Strait
-            ij0 = 101   ;   ij1 = 102
-            ii0 = 139   ;   ii1 = 141   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.e0
-            ii0 = 142   ;   ii1 = 142   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0 / 90.e0
-            ii0 = 143   ;   ii1 = 143   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40e0
-            ii0 = 144   ;   ii1 = 144   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.75e0
-            ! Red Sea
-            ij0 =  87   ;   ij1 =  96
-            ii0 = 147   ;   ii1 = 163   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0
-            ! Decrease before Bab el Mandeb Strait
-            ij0 =  91   ;   ij1 =  91
-            ii0 = 153   ;   ii1 = 160   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.80e0
+            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.40e0
+            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.e0 / 90.e0
+            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.e0
+            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*( 1.- COS( rpi*(jk-1)/16. ) ) / rday
+               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./rday
+               zhfac (jk) = 1._wp / rday
             END DO
             !                                        ! =======================
          CASE ( 05 )                                 !  ORCA_R05 configuration
             !                                        ! =======================
-            ! Mediterranean Sea
-            ii0 = 568   ;   ii1 = 574 
-            ij0 = 324   ;   ij1 = 333   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0
+            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.e0
-            ! Black Sea (remaining part
-            ii0 = 641   ;   ii1 = 651
-            ij0 = 367   ;   ij1 = 372   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0
-            ! Decrease before Gibraltar Strait
-            ij0 = 324   ;   ij1 = 333
-            ii0 = 565   ;   ii1 = 565   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0 / 90.e0
-            ii0 = 566   ;   ii1 = 566   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40
-            ii0 = 567   ;   ii1 = 567   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.75
-            ! Red Sea
-            ii0 = 641   ;   ii1 = 665
-            ij0 = 270   ;   ij1 = 310   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0
-            ! Decrease before Bab el Mandeb Strait
-            ii0 = 666   ;   ii1 = 675
+            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 * ABS( FLOAT(ji - mi1(ii1)) )
+               zmrs( ji , mj0(ij0):mj1(ij1) ) = 0.1_wp * ABS( FLOAT(ji - mi1(ii1)) )
             END DO 
-            zsdmp = 1./(rn_surf * rday)
-            zbdmp = 1./(rn_bot * rday)
+            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)/rn_dep) )
+               zhfac(jk) = (  zbdmp + (zsdmp-zbdmp) * EXP( -fsdept(1,1,jk)/pn_dep )  )
             END DO
             !                                       ! ========================
@@ -478,11 +500,11 @@
 
          DO jk = 1, jpkm1
-            resto(:,:,jk) = zmrs(:,:) * zhfac(jk) + ( 1. - zmrs(:,:) ) * resto(:,:,jk)
+            presto(:,:,jk) = zmrs(:,:) * zhfac(jk) + ( 1._wp - zmrs(:,:) ) * presto(:,:,jk)
          END DO
 
          ! Mask resto array and set to 0 first and last levels
-         resto(:,:, : ) = resto(:,:,:) * tmask(:,:,:)
-         resto(:,:, 1 ) = 0.e0
-         resto(:,:,jpk) = 0.e0
+         presto(:,:, : ) = presto(:,:,:) * tmask(:,:,:)
+         presto(:,:, 1 ) = 0._wp
+         presto(:,:,jpk) = 0._wp
          !                         !--------------------!
       ELSE                         !     No damping     !
@@ -492,9 +514,12 @@
 
       !                            !--------------------------------!
-      IF( nn_file == 1 ) THEN      !  save damping coef. in a file  !
+      IF( kn_file == 1 ) THEN      !  save damping coef. in a file  !
          !                         !--------------------------------!
          IF(lwp) WRITE(numout,*) '              create damping.coeff.nc file'
-         CALL iom_open  ( 'damping.coeff', inum0, ldwrt = .TRUE., kiolib = jprstlib )
-         CALL iom_rstput( 0, 0, inum0, 'Resto', resto )
+         IF( cdtype == 'TRA' ) cfile = 'damping.coeff'
+         IF( cdtype == 'TRC' ) cfile = 'damping.coeff.trc'
+         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
@@ -549,8 +574,8 @@
            &               '         create the "dist.coast.nc" file using IDL' )
 
-      pdct(:,:,:) = 0.e0
-      zxt(:,:) = cos( rad * gphit(:,:) ) * cos( rad * glamt(:,:) )
-      zyt(:,:) = cos( rad * gphit(:,:) ) * sin( rad * glamt(:,:) )
-      zzt(:,:) = sin( rad * gphit(:,:) )
+      pdct(:,:,:) = 0._wp
+      zxt(:,:) = COS( rad * gphit(:,:) ) * COS( rad * glamt(:,:) )
+      zyt(:,:) = COS( rad * gphit(:,:) ) * SIN( rad * glamt(:,:) )
+      zzt(:,:) = SIN( rad * gphit(:,:) )
 
 
@@ -565,7 +590,7 @@
                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. ) 
-               llcotv(ji,jj) = ( tmask(ji,jj  ,jk) + tmask(ji  ,jj+1,jk) == 1. ) 
-               llcotf(ji,jj) = ( zmask(ji,jj) > 0. ) .AND. ( zmask(ji,jj) < 4. )
+               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
@@ -633,5 +658,4 @@
          ! Compute cartesian coordinates of coastline points
          ! and the number of coastline points
-
          icoast = 0
          DO jj = 1, jpj
@@ -659,9 +683,8 @@
 
          ! Distance for the T-points
-
          DO jj = 1, jpj
             DO ji = 1, jpi
-               IF( tmask(ji,jj,jk) == 0. ) THEN
-                  pdct(ji,jj,jk) = 0.
+               IF( tmask(ji,jj,jk) == 0._wp ) THEN
+                  pdct(ji,jj,jk) = 0._wp
                ELSE
                   DO jl = 1, icoast
@@ -682,6 +705,6 @@
       ! ----------------------------------------------------------    
       clname = 'dist.coast'
-      itime = 0
-      CALL ymds2ju( 0     , 1      , 1     , 0.e0 , zdate0 )
+      itime  = 0
+      CALL ymds2ju( 0     , 1      , 1     , 0._wp , zdate0 )
       CALL restini( 'NONE', jpi    , jpj   , glamt, gphit ,   &
          &          jpk   , gdept_0, clname, itime, zdate0,   &
@@ -689,5 +712,5 @@
       CALL restput( icot, 'Tcoast', jpi, jpj, jpk, 0, pdct )
       CALL restclo( icot )
-
+      !
    END SUBROUTINE cofdis
 
@@ -701,4 +724,6 @@
       WRITE(*,*) 'tra_dmp: You should not have seen this print! error?', kt
    END SUBROUTINE tra_dmp
+   SUBROUTINE tra_dmp_init        ! Empty routine
+   END SUBROUTINE tra_dmp_init
 #endif
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90	(revision 2528)
@@ -4,11 +4,12 @@
    !! Ocean Active tracers : lateral diffusive trends 
    !!=====================================================================
-   !! History :  9.0  ! 05-11 (G. Madec)  Original code
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   tra_ldf     : update the tracer trend with the lateral diffusion
-   !!       ldf_ctl : initialization, namelist read, and parameters control
-   !!       ldf_ano : compute lateral diffusion for constant T-S profiles
+   !! History :  9.0  ! 2005-11 (G. Madec)  Original code
+   !!       NEMO 3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_ldf      : update the tracer trend with the lateral diffusion
+   !!   tra_ldf_init : initialization, namelist read, and parameters control
+   !!       ldf_ano  : compute lateral diffusion for constant T-S profiles
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and tracers
@@ -20,7 +21,8 @@
    USE traldf_bilap    ! lateral mixing             (tra_ldf_bilap routine)
    USE traldf_iso      ! lateral mixing               (tra_ldf_iso routine)
+   USE traldf_iso_grif ! lateral mixing          (tra_ldf_iso_grif routine)
    USE traldf_lap      ! lateral mixing               (tra_ldf_lap routine)
-   USE trdmod          ! ocean active tracers trends
-   USE trdmod_oce      ! ocean variables trends
+   USE trdmod_oce      ! ocean space and time domain
+   USE trdtra          ! ocean active tracers trends
    USE prtctl          ! Print control
    USE in_out_manager  ! I/O manager
@@ -31,11 +33,10 @@
    PRIVATE
 
-   PUBLIC   tra_ldf    ! called by step.F90 
-
-   INTEGER, PUBLIC ::   nldf = 0   ! type of lateral diffusion used defined from ln_traldf_... namlist logicals)
-                                   ! (need to be public to be used in vertical diffusion routine)
+   PUBLIC   tra_ldf         ! called by step.F90 
+   PUBLIC   tra_ldf_init    ! called by opa.F90 
+   !
+   INTEGER ::   nldf = 0   ! type of lateral diffusion used defined from ln_traldf_... namlist logicals)
 #if defined key_traldf_ano
-   REAL, DIMENSION(jpi,jpj,jpk) ::   t0_ldf, s0_ldf   ! lateral diffusion trends of T & S
-      !                                               ! for a constant vertical profile
+   REAL, DIMENSION(jpi,jpj,jpk) ::   t0_ldf, s0_ldf   ! lateral diffusion trends of T & S for a constant profile
 #endif
 
@@ -44,9 +45,8 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2006) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
@@ -56,58 +56,67 @@
       !! 
       !! ** Purpose :   compute the lateral ocean tracer physics.
-      !!
       !!----------------------------------------------------------------------
       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
       !!
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztrdt, ztrds   ! 3D temporary workspace
-      !!----------------------------------------------------------------------
-
-      IF( kt == nit000 )   CALL ldf_ctl          ! initialisation & control of options
-
-      IF( l_trdtra )   THEN                      ! temporary save of ta and sa trends
-         ztrdt(:,:,:) = ta(:,:,:) 
-         ztrds(:,:,:) = sa(:,:,:) 
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt, ztrds
+      !!----------------------------------------------------------------------
+
+      IF( l_trdtra )   THEN                    !* Save ta and sa trends
+         ALLOCATE( ztrdt(jpi,jpj,jpk) )   ;    ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
+         ALLOCATE( ztrds(jpi,jpj,jpk) )   ;    ztrds(:,:,:) = tsa(:,:,:,jp_sal)
       ENDIF
 
       SELECT CASE ( nldf )                       ! compute lateral mixing trend and add it to the general trend
-      CASE ( 0 )   ;   CALL tra_ldf_lap   ( kt )      ! iso-level laplacian
-      CASE ( 1 )   ;   CALL tra_ldf_iso   ( kt )      ! rotated laplacian (except dk[ dk[.] ] part)
-      CASE ( 2 )   ;   CALL tra_ldf_bilap ( kt )      ! iso-level bilaplacian
-      CASE ( 3 )   ;   CALL tra_ldf_bilapg( kt )      ! s-coord. horizontal bilaplacian
+      CASE ( 0 )   ;   CALL tra_ldf_lap     ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts        )  ! iso-level laplacian
+      CASE ( 1 )                                                                              ! rotated laplacian
+         IF( ln_traldf_grif ) THEN                                                          
+                       CALL tra_ldf_iso_grif( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )      ! Griffies operator
+         ELSE                                                                                
+                       CALL tra_ldf_iso     ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )      ! Madec operator
+         ENDIF
+      CASE ( 2 )   ;   CALL tra_ldf_bilap   ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts        )  ! iso-level bilaplacian
+      CASE ( 3 )   ;   CALL tra_ldf_bilapg  ( kt, 'TRA',             tsb, tsa, jpts        )  ! s-coord. geopot. bilap.
          !
-      CASE ( -1 )                                     ! esopa: test all possibility with control print
-         CALL tra_ldf_lap    ( kt )
-         CALL prt_ctl( tab3d_1=ta, clinfo1=' ldf0 - Ta: ', mask1=tmask,               &
-            &          tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-         CALL tra_ldf_iso    ( kt )
-         CALL prt_ctl( tab3d_1=ta, clinfo1=' ldf1 - Ta: ', mask1=tmask,               &
-            &          tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-         CALL tra_ldf_bilap  ( kt )
-         CALL prt_ctl( tab3d_1=ta, clinfo1=' ldf2 - Ta: ', mask1=tmask,               &
-            &          tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-         CALL tra_ldf_bilapg ( kt )
-         CALL prt_ctl( tab3d_1=ta, clinfo1=' ldf3 - Ta: ', mask1=tmask,               &
-            &          tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+      CASE ( -1 )                                ! esopa: test all possibility with control print
+         CALL tra_ldf_lap   ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts        ) 
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf0 - Ta: ', mask1=tmask,               &
+         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+         IF( ln_traldf_grif ) THEN
+            CALL tra_ldf_iso_grif( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )
+         ELSE
+            CALL tra_ldf_iso     ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )  
+         ENDIF
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf1 - Ta: ', mask1=tmask,               &
+         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+         CALL tra_ldf_bilap ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts        ) 
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf2 - Ta: ', mask1=tmask,               &
+         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+         CALL tra_ldf_bilapg( kt, 'TRA',             tsb, tsa, jpts        ) 
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf3 - Ta: ', mask1=tmask,               &
+         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
       END SELECT
 
 #if defined key_traldf_ano
-      ta(:,:,:) = ta(:,:,:) - t0_ldf(:,:,:)      ! anomaly: substract the reference diffusivity
-      sa(:,:,:) = sa(:,:,:) - s0_ldf(:,:,:)
+      tsa(:,:,:,jp_tem) = tsa(:,:,:,jp_tem) - t0_ldf(:,:,:)      ! anomaly: substract the reference diffusivity
+      tsa(:,:,:,jp_sal) = tsa(:,:,:,jp_sal) - s0_ldf(:,:,:)
 #endif
+
       IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics
-         ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:)
-         ztrds(:,:,:) = sa(:,:,:) - ztrds(:,:,:)
-         CALL trd_mod( ztrdt, ztrds, jptra_trd_ldf, 'TRA', kt )
+         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
+         ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:)
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_ldf, ztrdt )
+         CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_ldf, ztrds )
+         DEALLOCATE( ztrdt )      ;     DEALLOCATE( ztrds ) 
       ENDIF
       !                                          ! print mean trends (used for debugging)
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' ldf  - Ta: ', mask1=tmask,               &
-         &                       tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf  - Ta: ', mask1=tmask,               &
+         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
       !
    END SUBROUTINE tra_ldf
 
 
-   SUBROUTINE ldf_ctl
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE ldf_ctl  ***
+   SUBROUTINE tra_ldf_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_ldf_init  ***
       !! 
       !! ** Purpose :   Choice of the operator for the lateral tracer diffusion
@@ -122,7 +131,4 @@
       INTEGER ::   ioptio, ierr         ! temporary integers 
 !      
-!     NAMELIST/namtra_ldf/ ln_traldf_lap  , ln_traldf_bilap,                  &
-!        &                 ln_traldf_level, ln_traldf_hor  , ln_traldf_iso,   &
-!        &                 rn_aht_0       , rn_ahtb_0      , rn_aeiv_0
       !!----------------------------------------------------------------------
 
@@ -130,17 +136,11 @@
       ! ===============================================
     
-!     REWIND( numnam )                ! Namelist namtra_ldf already read in ldftra module
-!     READ  ( numnam, namtra_ldf )    
-
       IF(lwp) THEN                    ! Namelist print
          WRITE(numout,*)
-         WRITE(numout,*) 'tra:ldf_ctl : lateral tracer diffusive operator'
+         WRITE(numout,*) 'tra_ldf_init : lateral tracer diffusive operator'
          WRITE(numout,*) '~~~~~~~~~~~'
-         WRITE(numout,*) '   Namelist namtra_ldf : set lateral mixing parameters (type, direction, coefficients)'
-         WRITE(numout,*) '      laplacian operator          ln_traldf_lap   = ', ln_traldf_lap
-         WRITE(numout,*) '      bilaplacian operator        ln_traldf_bilap = ', ln_traldf_bilap
-         WRITE(numout,*) '      iso-level                   ln_traldf_level = ', ln_traldf_level
-         WRITE(numout,*) '      horizontal (geopotential)   ln_traldf_hor   = ', ln_traldf_hor
-         WRITE(numout,*) '      iso-neutral                 ln_traldf_iso   = ', ln_traldf_iso
+         WRITE(numout,*) '   Namelist namtra_ldf already read in ldftra module'
+         WRITE(numout,*) '   see ldf_tra_init report for lateral mixing parameters'
+         WRITE(numout,*)
       ENDIF
 
@@ -225,5 +225,5 @@
       CALL ldf_ano
       !
-   END SUBROUTINE ldf_ctl
+   END SUBROUTINE tra_ldf_init
 
 #if defined key_traldf_ano
@@ -271,16 +271,16 @@
       t0_ldf(:,:,:) = 0.e0
       s0_ldf(:,:,:) = 0.e0
-      ztb   (:,:,:) = tb (:,:,:)
-      zsb   (:,:,:) = sb (:,:,:)
-      ua    (:,:,:) = ta (:,:,:)
-      va    (:,:,:) = sa (:,:,:)
+      ztb   (:,:,:) = tsb (:,:,:,jp_tem)
+      zsb   (:,:,:) = tsb (:,:,:,jp_sal)
+      ua    (:,:,:) = tsa (:,:,:,jp_tem)
+      va    (:,:,:) = tsa (:,:,:,jp_sal)
       zavt  (:,:,:) = avt(:,:,:)
       IF( lk_zdfddm ) THEN CALL ctl_stop( ' key_traldf_ano with key_zdfddm not implemented' )
       ! set tb, sb to reference values and avr to zero
-      tb (:,:,:) = zt_ref(:,:,:)
-      sb (:,:,:) = zs_ref(:,:,:)
-      ta (:,:,:) = 0.e0
-      sa (:,:,:) = 0.e0
-      avt(:,:,:) = 0.e0
+      tsb (:,:,:,jp_tem) = zt_ref(:,:,:)
+      tsb (:,:,:,jp_sal) = zs_ref(:,:,:)
+      tsa (:,:,:,jp_tem) = 0.e0
+      tsa (:,:,:,jp_sal) = 0.e0
+      avt(:,:,:)         = 0.e0
 
       ! Compute the ldf trends
@@ -295,17 +295,17 @@
       IF( neuler == 1)   z12 = 1.e0
       IF( ln_zdfexp ) THEN      ! ta,sa are the trends
-         t0_ldf(:,:,:) = ta(:,:,:)
-         s0_ldf(:,:,:) = sa(:,:,:)
+         t0_ldf(:,:,:) = tsa(:,:,:,jp_tem)
+         s0_ldf(:,:,:) = tsa(:,:,:,jp_sal)
       ELSE
          DO jk = 1, jpkm1
-            t0_ldf(:,:,jk) = ( ta(:,:,jk) - tb(:,:,jk) ) / ( z12 *rdttra(jk) )
-            s0_ldf(:,:,jk) = ( sa(:,:,jk) - tb(:,:,jk) ) / ( z12 *rdttra(jk) )
+            t0_ldf(:,:,jk) = ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / ( z12 *rdttra(jk) )
+            s0_ldf(:,:,jk) = ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / ( z12 *rdttra(jk) )
          END DO
       ENDIF
-      tb    (:,:,:) = ztb (:,:,:)
-      sb    (:,:,:) = zsb (:,:,:)
-      ta    (:,:,:) = ua  (:,:,:)
-      sa    (:,:,:) = va  (:,:,:)
-      avt   (:,:,:) = zavt(:,:,:)
+      tsb(:,:,:,jp_tem) = ztb (:,:,:)
+      tsb(:,:,:,jp_sal) = zsb (:,:,:)
+      tsa(:,:,:,jp_tem) = ua  (:,:,:)
+      tsa(:,:,:,jp_sal) = va  (:,:,:)
+      avt(:,:,:)        = zavt(:,:,:)
       !
    END SUBROUTINE ldf_ano
Index: trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90	(revision 2528)
@@ -2,5 +2,16 @@
    !!==============================================================================
    !!                   ***  MODULE  traldf_bilap  ***
-   !! Ocean active tracers:  horizontal component of the lateral tracer mixing trend
+   !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend
+   !!==============================================================================
+   !! History :  OPA  !  1991-11  (G. Madec)  Original code
+   !!                 !  1993-03  (M. Guyon)  symetrical conditions
+   !!                 !  1995-11  (G. Madec)  suppress volumetric scale factors
+   !!                 !  1996-01  (G. Madec)  statement function for e3
+   !!                 !  1996-01  (M. Imbard)  mpp exchange
+   !!                 !  1997-07  (G. Madec)  optimization, and ahtt
+   !!            8.5  !  2002-08  (G. Madec)  F90: Free form and module
+   !!   NEMO     1.0  !  2004-08  (C. Talandier) New trends organization
+   !!             -   !  2005-11  (G. Madec)  zps or sco as default option
+   !!            3.3  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA 
    !!==============================================================================
 
@@ -9,21 +20,17 @@
    !!                   using a iso-level biharmonic operator
    !!----------------------------------------------------------------------
-   !! * Modules used
    USE oce             ! ocean dynamics and active tracers
    USE dom_oce         ! ocean space and time domain
    USE ldftra_oce      ! ocean tracer   lateral physics
-   USE trdmod          ! ocean active tracers trends 
-   USE trdmod_oce      ! ocean variables trends
    USE in_out_manager  ! I/O manager
    USE ldfslp          ! iso-neutral slopes 
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
    USE diaptr          ! poleward transport diagnostics
-   USE prtctl          ! Print control
+   USE trc_oce         ! share passive tracers/Ocean variables
 
    IMPLICIT NONE
    PRIVATE
 
-   !! * Routine accessibility
-   PUBLIC tra_ldf_bilap   ! routine called by step.F90
+   PUBLIC   tra_ldf_bilap   ! routine called by step.F90
 
    !! * Substitutions
@@ -33,21 +40,21 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
-   
-   SUBROUTINE tra_ldf_bilap( kt )
+ 
+   SUBROUTINE tra_ldf_bilap( kt, cdtype, pgu, pgv,      &
+      &                                  ptb, pta, kjpt )  
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_ldf_bilap  ***
       !!
-      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive 
+      !! ** Purpose :   Compute the before horizontal tracer diffusive 
       !!      trend and add it to the general trend of tracer equation.
       !!
       !! ** Method  :   4th order diffusive operator along model level surfaces 
       !!      evaluated using before fields (forward time scheme). The hor.
-      !!      diffusive trends of temperature (idem for salinity) is given by:
+      !!      diffusive trends  is given by:
       !!      Laplacian of tb:
       !!         zlt   = 1/(e1t*e2t*e3t) {  di-1[ e2u*e3u/e1u di(tb) ]
@@ -59,167 +66,98 @@
       !!         difft = 1/(e1t*e2t*e3t) {  di-1[ e2u*e3u/e1u di(zlt) ]
       !!                                  + dj-1[ e1v*e3v/e2v dj(zlt) ]  }
-      !!      Note: if key_zco defined, e3t=e3u=e3v, they are simplified.
       !!
-      !!      Add this trend to the general trend (ta,sa):
-      !!         (ta,sa) = (ta,sa) + ( difft , diffs )
+      !!      Add this trend to the general trend
+      !!         (pta) = (pta) + ( difft )
       !!
-      !! ** Action : - Update (ta,sa) arrays with the before iso-level
+      !! ** Action : - Update pta arrays with the before iso-level
       !!               biharmonic mixing trend.
+      !!----------------------------------------------------------------------
+      USE oce         , ztu => ua   ! use ua as workspace
+      USE oce         , ztv => va   ! use va as workspace
       !!
-      !! History :
-      !!        !  91-11  (G. Madec)  Original code
-      !!        !  93-03  (M. Guyon)  symetrical conditions
-      !!        !  95-11  (G. Madec)  suppress volumetric scale factors
-      !!        !  96-01  (G. Madec)  statement function for e3
-      !!        !  96-01  (M. Imbard)  mpp exchange
-      !!        !  97-07  (G. Madec)  optimization, and ahtt
-      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
-      !!   9.0  !  04-08  (C. Talandier) New trends organization
-      !!        !  05-11  (G. Madec)  zps or sco as default option
-      !!----------------------------------------------------------------------
-      !! * Modules used
-      USE oce           , ztu => ua,  &  ! use ua as workspace
-         &                ztv => va      ! use va as workspace
-
-      !! * Arguments
-      INTEGER, INTENT( in ) ::   kt       ! ocean time-step index
-
-      !! * Local declarations
-      INTEGER ::   ji, jj, jk             ! dummy loop indices
-      INTEGER ::   iku, ikv               ! temporary integers
-      REAL(wp) ::   zta, zsa              ! temporary scalars
-      REAL(wp), DIMENSION(jpi,jpj) ::   & 
-         zeeu, zeev, zbtr,              & ! 2D workspace
-         zlt, zls
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
-         zsu, zsv                         ! 3D workspace 
+      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
+      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
+      !!
+      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::  zbtr, ztra       ! local scalars
+      REAL(wp), DIMENSION(jpi,jpj) ::   zeeu, zeev, zlt   ! 2D workspace
       !!----------------------------------------------------------------------
 
-      IF( kt == nit000 ) THEN
+      IF( kt == nit000 )  THEN
          IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_ldf_bilap : iso-level biharmonic operator'
+         IF(lwp) WRITE(numout,*) 'tra_ldf_bilap : iso-level biharmonic operator on ', cdtype
          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~'
       ENDIF
-
-
-      !                                                ! ===============
-      DO jk = 1, jpkm1                                 ! Horizontal slab
-         !                                             ! ===============
-
-         ! 0. Initialization of metric arrays (for z- or s-coordinates)
-         ! ----------------------------------
-
-         IF( lk_zco ) THEN      ! z-coordinate (1D arrays): no vertical scale factors
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         !                                               
+         DO jk = 1, jpkm1                                        ! Horizontal slab
+            !                                             
+            !                          !==  Initialization of metric arrays (for z- or s-coordinates)  ==!
             DO jj = 1, jpjm1
                DO ji = 1, fs_jpim1   ! vector opt.
-                  zbtr(ji,jj) = 1. / ( e1t(ji,jj)*e2t(ji,jj) )
-                  zeeu(ji,jj) = e2u(ji,jj) / e1u(ji,jj) * umask(ji,jj,jk)
-                  zeev(ji,jj) = e1v(ji,jj) / e2v(ji,jj) * vmask(ji,jj,jk)
-               END DO
-            END DO
-         ELSE                   ! All coordinates (3D arrays): vertical scale factor are used
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zbtr(ji,jj) = 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )
                   zeeu(ji,jj) = e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj) * umask(ji,jj,jk)
                   zeev(ji,jj) = e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj) * vmask(ji,jj,jk)
                END DO
             END DO
-         ENDIF
 
-
-         ! 1. Laplacian
-         ! ------------
-
-         ! First derivative (gradient)
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               ztu(ji,jj,jk) = zeeu(ji,jj) * ( tb(ji+1,jj  ,jk) - tb(ji,jj,jk) )
-               zsu(ji,jj,jk) = zeeu(ji,jj) * ( sb(ji+1,jj  ,jk) - sb(ji,jj,jk) )
-               ztv(ji,jj,jk) = zeev(ji,jj) * ( tb(ji  ,jj+1,jk) - tb(ji,jj,jk) )
-               zsv(ji,jj,jk) = zeev(ji,jj) * ( sb(ji  ,jj+1,jk) - sb(ji,jj,jk) )
-            END DO
-         END DO
-         IF( ln_zps ) THEN      ! set gradient at partial step level
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1
-                  ! last level
-                  iku = MIN ( mbathy(ji,jj), mbathy(ji+1,jj  ) ) - 1
-                  ikv = MIN ( mbathy(ji,jj), mbathy(ji  ,jj+1) ) - 1
-                  IF( iku == jk ) THEN
-                     ztu(ji,jj,jk) = zeeu(ji,jj) * gtu(ji,jj)
-                     zsu(ji,jj,jk) = zeeu(ji,jj) * gsu(ji,jj)
-                  ENDIF
-                  IF( ikv == jk ) THEN
-                     ztv(ji,jj,jk) = zeev(ji,jj) * gtv(ji,jj)
-                     zsv(ji,jj,jk) = zeev(ji,jj) * gsv(ji,jj)
-                  ENDIF
+            !                          !==  Laplacian  ==!
+            !
+            DO jj = 1, jpjm1                 ! First derivative (gradient)
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  ztu(ji,jj,jk) = zeeu(ji,jj) * ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) )
+                  ztv(ji,jj,jk) = zeev(ji,jj) * ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )
                END DO
             END DO
-         ENDIF
-
-         ! Second derivative (divergence)
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zlt(ji,jj) = zbtr(ji,jj) * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  )
-               zls(ji,jj) = zbtr(ji,jj) * (  zsu(ji,jj,jk) - zsu(ji-1,jj,jk) + zsv(ji,jj,jk) - zsv(ji,jj-1,jk)  )
-            END DO
-         END DO
-
-         ! Multiply by the eddy diffusivity coefficient
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zlt(ji,jj) = fsahtt(ji,jj,jk) * zlt(ji,jj)
-               zls(ji,jj) = fsahtt(ji,jj,jk) * zls(ji,jj)
-            END DO
-         END DO
-
-         ! Lateral boundary conditions on the laplacian (zlt,zls)   (unchanged sgn)
-         CALL lbc_lnk( zlt, 'T', 1. )   ;    CALL lbc_lnk( zls, 'T', 1. )
-
-         ! 2. Bilaplacian
-         ! --------------
-
-         ! third derivative (gradient)
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               ztu(ji,jj,jk) = zeeu(ji,jj) * ( zlt(ji+1,jj  ) - zlt(ji,jj) )
-               zsu(ji,jj,jk) = zeeu(ji,jj) * ( zls(ji+1,jj  ) - zls(ji,jj) )
-               ztv(ji,jj,jk) = zeev(ji,jj) * ( zlt(ji  ,jj+1) - zlt(ji,jj) )
-               zsv(ji,jj,jk) = zeev(ji,jj) * ( zls(ji  ,jj+1) - zls(ji,jj) )
-            END DO
-         END DO
-
-         ! fourth derivative (divergence) and add to the general tracer trend
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ! horizontal diffusive trends
-               zta = zbtr(ji,jj) * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  )
-               zsa = zbtr(ji,jj) * (  zsu(ji,jj,jk) - zsu(ji-1,jj,jk) + zsv(ji,jj,jk) - zsv(ji,jj-1,jk)  )
-               ! add it to the general tracer trends
-               ta(ji,jj,jk) = ta(ji,jj,jk) + zta
-               sa(ji,jj,jk) = sa(ji,jj,jk) + zsa
-            END DO
-         END DO
-         !                                             ! ===============
-      END DO                                           ! Horizontal slab
-      !                                                ! ===============
-
-      ! "zonal" mean lateral diffusive heat and salt transport
-      IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN
-         IF( lk_zco ) THEN      ! z-coordinate (1D arrays): multiply by the vertical scale factor
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ztv(ji,jj,jk) = ztv(ji,jj,jk) * fse3v(ji,jj,jk)
-                     zsv(ji,jj,jk) = zsv(ji,jj,jk) * fse3v(ji,jj,jk)
+            IF( ln_zps ) THEN                ! set gradient at partial step level (last ocean level)
+               DO jj = 1, jpjm1
+                  DO ji = 1, jpim1
+                     IF( mbku(ji,jj) == jk )  ztu(ji,jj,jk) = zeeu(ji,jj) * pgu(ji,jj,jn)
+                     IF( mbkv(ji,jj) == jk )  ztv(ji,jj,jk) = zeev(ji,jj) * pgv(ji,jj,jn)
                   END DO
                END DO
+            ENDIF
+            DO jj = 2, jpjm1                 ! Second derivative (divergence) time the eddy diffusivity coefficient
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = 1.0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  zlt(ji,jj) = fsahtt(ji,jj,jk) * zbtr * (   ztu(ji,jj,jk) - ztu(ji-1,jj,jk)   &
+                     &                                     + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)   )
+               END DO
             END DO
+            CALL lbc_lnk( zlt, 'T', 1. )     ! Lateral boundary conditions (unchanged sgn)
+
+            !                          !==  Bilaplacian  ==!
+            !
+            DO jj = 1, jpjm1                 ! third derivative (gradient)
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  ztu(ji,jj,jk) = zeeu(ji,jj) * ( zlt(ji+1,jj  ) - zlt(ji,jj) )
+                  ztv(ji,jj,jk) = zeev(ji,jj) * ( zlt(ji  ,jj+1) - zlt(ji,jj) )
+               END DO
+            END DO
+            DO jj = 2, jpjm1                 ! fourth derivative (divergence) and add to the general tracer trend
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ! horizontal diffusive trends
+                  zbtr = 1.0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ztra = zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  )
+                  ! add it to the general tracer trends
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
+               END DO
+            END DO
+            !                                             
+         END DO                                           ! Horizontal slab
+         !                                                
+         ! "zonal" mean lateral diffusive heat and salt transport
+         IF( cdtype == 'TRA' .AND. ln_diaptr .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(:,:,:) )
          ENDIF
-         pht_ldf(:) = ptr_vj( ztv(:,:,:) )
-         pst_ldf(:) = ptr_vj( zsv(:,:,:) )
-      ENDIF
-
+         !                                                ! ===========
+      END DO                                              ! tracer loop
+      !                                                   ! ===========
    END SUBROUTINE tra_ldf_bilap
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90	(revision 2528)
@@ -2,5 +2,9 @@
    !!==============================================================================
    !!                       ***  MODULE  traldf_bilapg  ***
-   !! Ocean active tracers:  horizontal component of the lateral tracer mixing trend
+   !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend
+   !!==============================================================================
+   !! History : 8.0   ! 1997-07  (G. Madec)  Original code
+   !!   NEMO    1.0   ! 2002-08  (G. Madec)  F90: Free form and module
+   !!           3.3   ! 2010-06  (C. Ethe, G. Madec) Merge TRA-TRC
    !!==============================================================================
 #if defined key_ldfslp   ||   defined key_esopa
@@ -12,21 +16,17 @@
    !!   ldfght         :  ???
    !!----------------------------------------------------------------------
-   !! * Modules used
    USE oce             ! ocean dynamics and tracers variables
    USE dom_oce         ! ocean space and time domain variables
    USE ldftra_oce      ! ocean active tracers: lateral physics
-   USE trdmod          ! ocean active tracers trends 
-   USE trdmod_oce      ! ocean variables trends
    USE in_out_manager  ! I/O manager
    USE ldfslp          ! iso-neutral slopes available
    USE lbclnk          ! ocean lateral boundary condition (or mpp link)
    USE diaptr          ! poleward transport diagnostics 
-   USE prtctl          ! Print control
+   USE trc_oce         ! share passive tracers/Ocean variables
 
    IMPLICIT NONE
    PRIVATE
 
-   !! * Routine accessibility
-   PUBLIC tra_ldf_bilapg    ! routine called by step.F90
+   PUBLIC   tra_ldf_bilapg   ! routine called by step.F90
 
    !! * Substitutions
@@ -35,16 +35,15 @@
 #  include "ldfeiv_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-   
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
-   SUBROUTINE tra_ldf_bilapg( kt )
+   SUBROUTINE tra_ldf_bilapg( kt, cdtype, ptb, pta, kjpt )
       !!----------------------------------------------------------------------
       !!                 ***  ROUTINE tra_ldf_bilapg  ***
       !!                    
-      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive 
+      !! ** Purpose :   Compute the before horizontal tracer diffusive 
       !!      trend and add it to the general trend of tracer equation.
       !!
@@ -54,84 +53,67 @@
       !!      computed in routine inildf.
       !!         -1- compute the geopotential harmonic operator applied to
-      !!      (tb,sb) and multiply it by the eddy diffusivity coefficient
-      !!      (done by a call to ldfght routine, result in (wk1,wk2) arrays).
+      !!        ptb and multiply it by the eddy diffusivity coefficient
+      !!       (done by a call to ldfght routine, result in wk1 arrays).
       !!      Applied the domain lateral boundary conditions by call to lbc_lnk
       !!         -2- compute the geopotential harmonic operator applied to
-      !!      (wk1,wk2) by a second call to ldfght routine (result in (wk3,wk4)
+      !!      wk1 by a second call to ldfght routine (result in wk2)
       !!      arrays).
-      !!         -3- Add this trend to the general trend (ta,sa):
-      !!            (ta,sa) = (ta,sa) + (wk3,wk4)
-      !!
-      !! ** Action : - Update (ta,sa) arrays with the before geopotential 
+      !!         -3- Add this trend to the general trend 
+      !!            pta = pta + wk2
+      !!
+      !! ** Action : - Update pta arrays with the before geopotential 
       !!               biharmonic mixing trend.
-      !!
-      !! History :
-      !!   8.0  !  97-07  (G. Madec)  Original code
-      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
-      !!   9.0  !  04-08  (C. Talandier) New trends organization
-      !!----------------------------------------------------------------------
-      !! * Modules used
-      USE oce           , wk1 => ua,  &  ! use ua as workspace
-         &                wk2 => va      ! use va as workspace
-
-      !! * Arguments
-      INTEGER, INTENT( in ) ::   kt           ! ocean time-step index
-
-      !! * Local declarations
-      INTEGER ::   ji, jj, jk                 ! dummy loop indices
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
-         wk3, wk4                ! work array used for rotated biharmonic
-         !                       ! operator on tracers and/or momentum
-      !!----------------------------------------------------------------------
-
-      IF( kt == nit000 ) THEN
+      !!----------------------------------------------------------------------
+      INTEGER         , INTENT(in   )                      ::   kt       ! ocean time-step index
+      CHARACTER(len=3), INTENT(in   )                      ::   cdtype   ! =TRA or TRC (tracer indicator)
+      INTEGER         , INTENT(in   )                      ::   kjpt     ! number of tracers
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb      ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta      ! tracer trend 
+      !!
+      INTEGER ::   ji, jj, jk, jn                 ! dummy loop indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt) ::   wk1, wk2   ! 4D workspace
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 )  THEN
          IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_ldf_bilapg : horizontal biharmonic operator in s-coordinate'
+         IF(lwp) WRITE(numout,*) 'tra_ldf_bilapg : horizontal biharmonic operator in s-coordinate on ', cdtype
          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~'
       ENDIF
 
-      ! 1. Laplacian of (tb,sb) * aht
+      ! 1. Laplacian of ptb * aht
       ! ----------------------------- 
-      ! rotated harmonic operator applied to (tb,sb)
-      ! and multiply by aht (output in (wk1,wk2) )
-
-      CALL ldfght ( kt, tb, sb, wk1, wk2, 1 )
-
-
-      ! Lateral boundary conditions on (wk1,wk2)   (unchanged sign)
-      CALL lbc_lnk( wk1, 'T', 1. )   ;   CALL lbc_lnk( wk2, 'T', 1. )
-
-      ! 2. Bilaplacian of (tb,sb)
+      CALL ldfght( kt, cdtype, ptb, wk1, kjpt, 1 )      ! rotated harmonic operator applied to ptb and multiply by aht 
+      !                                                 ! output in wk1 
+      !
+      DO jn = 1, kjpt
+         CALL lbc_lnk( wk1(:,:,:,jn) , 'T', 1. )        ! Lateral boundary conditions on wk1   (unchanged sign)
+      END DO
+
+      ! 2. Bilaplacian of ptb
       ! -------------------------
-      ! rotated harmonic operator applied to (wk1,wk2)
-      ! (output in (wk3,wk4) )
-
-      CALL ldfght ( kt, wk1, wk2, wk3, wk4, 2 )
+      CALL ldfght( kt, cdtype, wk1, wk2, kjpt, 2 )      ! rotated harmonic operator applied to wk1 ; output in wk2
 
 
       ! 3. Update the tracer trends                    (j-slab :   2, jpj-1)
       ! ---------------------------
-      !                                                ! ===============
-      DO jj = 2, jpjm1                                 !  Vertical slab
-         !                                             ! ===============
-         DO jk = 1, jpkm1
-            DO ji = 2, jpim1
-               ! add it to the general tracer trends
-               ta(ji,jj,jk) = ta(ji,jj,jk) + wk3(ji,jj,jk)
-               sa(ji,jj,jk) = sa(ji,jj,jk) + wk4(ji,jj,jk)
+      DO jn = 1, kjpt
+         DO jj = 2, jpjm1
+            DO jk = 1, jpkm1
+               DO ji = 2, jpim1
+                  ! add it to the general tracer trends
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + wk2(ji,jj,jk,jn)
+               END DO
             END DO
          END DO
-         !                                             ! ===============
-      END DO                                           !   End of slab
-      !                                                ! ===============
-
+      END DO
+      !
    END SUBROUTINE tra_ldf_bilapg
 
 
-   SUBROUTINE ldfght ( kt, pt, ps, plt, pls, kaht )
+   SUBROUTINE ldfght ( kt, cdtype, pt, plt, kjpt, kaht )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE ldfght  ***
       !!          
-      !! ** Purpose :   Apply a geopotential harmonic operator to (pt,ps) and 
+      !! ** Purpose :   Apply a geopotential harmonic operator to (pt) and 
       !!      multiply it by the eddy diffusivity coefficient (if kaht=1).
       !!      Routine only used in s-coordinates (l_sco=T) with bilaplacian
@@ -140,5 +122,5 @@
       !!
       !! ** Method  :   The harmonic operator rotated along geopotential 
-      !!      surfaces is applied to (pt,ps) using the slopes of geopotential
+      !!      surfaces is applied to (pt) using the slopes of geopotential
       !!      surfaces computed in inildf routine. The result is provided in
       !!      (plt,pls) arrays. It is computed in 2 steps:
@@ -166,224 +148,177 @@
       !!         plt  =  1  / (e1t*e2t*e3t) { plt + dk[ zftw ] }
       !!
-      !! * Action :
-      !!      'key_trdtra' defined: the trend is saved for diagnostics.
-      !!
-      !! History :
-      !!   8.0  !  97-07  (G. Madec)  Original code
-      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      INTEGER, INTENT( in ) ::   kt           ! ocean time-step index
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in  ) ::   &
-         pt, ps           ! tracer fields (before t and s for 1st call
-      !                   ! and laplacian of these fields for 2nd call.
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) ::   &
-         plt, pls         ! partial harmonic operator applied to
-      !                   ! pt & ps components except
-      !                   ! second order vertical derivative term)
-      INTEGER, INTENT( in ) ::   &
-         kaht             ! =1 multiply the laplacian by the eddy diffusivity coeff.
-      !                   ! =2 no multiplication
-
-      !! * Local declarations
-      INTEGER ::   ji, jj, jk             ! dummy loop indices
-      REAL(wp) ::   &
-         zabe1, zabe2, zmku, zmkv,     &  ! temporary scalars
-         zbtr, ztah, zsah, ztav, zsav, &
-         zcof0, zcof1, zcof2,          &
-         zcof3, zcof4
-      REAL(wp), DIMENSION(jpi,jpj) ::  &
-         zftu, zfsu,                   &  ! workspace
-         zdkt, zdk1t,                  &
-         zdks, zdk1s
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
-         zftv, zfsv                       ! workspace (only v components for ptr)
-      REAL(wp), DIMENSION(jpi,jpk) ::  &
-         zftw, zfsw,                   &  ! workspace
-         zdit, zdjt, zdj1t,            &
-         zdis, zdjs, zdj1s
-      !!----------------------------------------------------------------------
-
-      !                               ! ********** !   ! ===============
-      DO jk = 1, jpkm1                ! First step !   ! Horizontal slab
-         !                            ! ********** !   ! ===============
-
-         ! I.1 Vertical gradient of pt and ps at level jk and jk+1
-         ! -------------------------------------------------------
-         !     surface boundary condition: zdkt(jk=1)=zdkt(jk=2)
-
-         zdk1t(:,:) = ( pt(:,:,jk) - pt(:,:,jk+1) ) * tmask(:,:,jk+1)
-         zdk1s(:,:) = ( ps(:,:,jk) - ps(:,:,jk+1) ) * tmask(:,:,jk+1)
-
-         IF( jk == 1 ) THEN
-            zdkt(:,:) = zdk1t(:,:)
-            zdks(:,:) = zdk1s(:,:)
-         ELSE
-            zdkt(:,:) = ( pt(:,:,jk-1) - pt(:,:,jk) ) * tmask(:,:,jk)
-            zdks(:,:) = ( ps(:,:,jk-1) - ps(:,:,jk) ) * tmask(:,:,jk)
+      !!----------------------------------------------------------------------
+      USE oce         , zftv => ua     ! use ua as workspace
+      !!
+      INTEGER         , INTENT(in )                              ::  kt      ! ocean time-step index
+      CHARACTER(len=3), INTENT(in )                              ::  cdtype  ! =TRA or TRC (tracer indicator) 
+      INTEGER         , INTENT(in )                              ::  kjpt    !: dimension of 
+      REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) ::  pt      ! tracer fields ( before for 1st call
+      !                                                         ! and laplacian of these fields for 2nd call. 
+      REAL(wp)        , INTENT(out), DIMENSION(jpi,jpj,jpk,kjpt) ::  plt     !: partial harmonic operator applied to  pt  components except
+      !                                                             !: second order vertical derivative term  
+      INTEGER         , INTENT(in )                              ::  kaht    !: =1 multiply the laplacian by the eddy diffusivity coeff.
+      !                                                             !: =2 no multiplication 
+      !!
+      INTEGER ::   ji, jj, jk,jn          ! dummy loop indices
+      !                                   ! temporary scalars
+      REAL(wp) ::  zabe1, zabe2, zmku, zmkv 
+      REAL(wp) ::  zbtr, ztah, ztav
+      REAL(wp) ::  zcof0, zcof1, zcof2, zcof3, zcof4
+      REAL(wp), DIMENSION(jpi,jpj) ::  zftu,  zdkt, zdk1t       ! workspace
+      REAL(wp), DIMENSION(jpi,jpk) ::  zftw, zdit, zdjt, zdj1t  ! 
+      !!----------------------------------------------------------------------
+
+      !
+      DO jn = 1, kjpt
+         !                               ! ********** !   ! ===============
+         DO jk = 1, jpkm1                ! First step !   ! Horizontal slab
+            !                            ! ********** !   ! ===============
+            
+            ! I.1 Vertical gradient of pt and ps at level jk and jk+1
+            ! -------------------------------------------------------
+            !     surface boundary condition: zdkt(jk=1)=zdkt(jk=2)
+            
+            zdk1t(:,:) = ( pt(:,:,jk,jn) - pt(:,:,jk+1,jn) ) * tmask(:,:,jk+1)
+            IF( jk == 1 ) THEN
+               zdkt(:,:) = zdk1t(:,:)
+            ELSE
+               zdkt(:,:) = ( pt(:,:,jk-1,jn) - pt(:,:,jk,jn) ) * tmask(:,:,jk)
+            ENDIF
+
+
+            ! I.2 Horizontal fluxes
+            ! ---------------------
+            
+            DO jj = 1, jpjm1
+               DO ji = 1, jpim1
+                  zabe1 = e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj)
+                  zabe2 = e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj)
+                  
+                  zmku = 1./MAX( tmask(ji+1,jj,jk  )+tmask(ji,jj,jk+1)   &
+                     &          +tmask(ji+1,jj,jk+1)+tmask(ji,jj,jk  ),1. )
+                  zmkv = 1./MAX( tmask(ji,jj+1,jk  )+tmask(ji,jj,jk+1)   &
+                     &          +tmask(ji,jj+1,jk+1)+tmask(ji,jj,jk  ),1. )
+                  
+                  zcof1 = -e2u(ji,jj) * uslp(ji,jj,jk) * zmku
+                  zcof2 = -e1v(ji,jj) * vslp(ji,jj,jk) * zmkv
+                  
+                  zftu(ji,jj)= umask(ji,jj,jk) *   &
+                     &         (  zabe1 *( pt   (ji+1,jj,jk,jn) - pt(ji,jj,jk,jn) )   &
+                     &          + zcof1 *( zdkt (ji+1,jj) + zdk1t(ji,jj)     &
+                     &                    +zdk1t(ji+1,jj) + zdkt (ji,jj) )  )
+                  
+                  zftv(ji,jj,jk)= vmask(ji,jj,jk) *   &
+                     &         (  zabe2 *( pt(ji,jj+1,jk,jn) - pt(ji,jj,jk,jn) )   &
+                     &          + zcof2 *( zdkt (ji,jj+1) + zdk1t(ji,jj)     &
+                     &                    +zdk1t(ji,jj+1) + zdkt (ji,jj) )  )                  
+               END DO
+            END DO
+
+
+            ! I.3 Second derivative (divergence) (not divided by the volume)
+            ! ---------------------
+            
+            DO jj = 2 , jpjm1
+               DO ji = 2 , jpim1
+                  ztah = zftu(ji,jj) - zftu(ji-1,jj) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)
+                  plt(ji,jj,jk,jn) = ztah
+               END DO
+            END DO
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+         ! "Poleward" diffusive heat or salt transport
+         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( kaht == 2 ) .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN
+            IF( jn == jp_tem)   htr_ldf(:) = ptr_vj( zftv(:,:,:) )
+            IF( jn == jp_sal)   str_ldf(:) = ptr_vj( zftv(:,:,:) )
          ENDIF
 
-
-         ! I.2 Horizontal fluxes
-         ! ---------------------
-
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-               zabe1 = e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj)
-               zabe2 = e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj)
-
-               zmku=1./MAX( tmask(ji+1,jj,jk  )+tmask(ji,jj,jk+1)   &
-                           +tmask(ji+1,jj,jk+1)+tmask(ji,jj,jk  ),1. )
-               zmkv=1./MAX( tmask(ji,jj+1,jk  )+tmask(ji,jj,jk+1)   &
-                           +tmask(ji,jj+1,jk+1)+tmask(ji,jj,jk  ),1. )
-
-               zcof1= -e2u(ji,jj) * uslp(ji,jj,jk) * zmku
-               zcof2= -e1v(ji,jj) * vslp(ji,jj,jk) * zmkv
-
-               zftu(ji,jj)= umask(ji,jj,jk) *   &
-                  (  zabe1 *( pt(ji+1,jj,jk) - pt(ji,jj,jk) )   &
-                   + zcof1 *( zdkt (ji+1,jj) + zdk1t(ji,jj)     &
-                             +zdk1t(ji+1,jj) + zdkt (ji,jj) )  )
-
-               zftv(ji,jj,jk)= vmask(ji,jj,jk) *   &
-                  (  zabe2 *( pt(ji,jj+1,jk) - pt(ji,jj,jk) )   &
-                   + zcof2 *( zdkt (ji,jj+1) + zdk1t(ji,jj)     &
-                             +zdk1t(ji,jj+1) + zdkt (ji,jj) )  )
-
-               zfsu(ji,jj)= umask(ji,jj,jk) *   &
-                  (  zabe1 *( ps(ji+1,jj,jk) - ps(ji,jj,jk) )   &
-                   + zcof1 *( zdks (ji+1,jj) + zdk1s(ji,jj)     &
-                             +zdk1s(ji+1,jj) + zdks (ji,jj) )  )
-
-               zfsv(ji,jj,jk)= vmask(ji,jj,jk) *   &
-                  (  zabe2 *( ps(ji,jj+1,jk) - ps(ji,jj,jk) )   &
-                   + zcof2 *( zdks (ji,jj+1) + zdk1s(ji,jj)     &
-                             +zdk1s(ji,jj+1) + zdks (ji,jj) )  )
-            END DO
-         END DO
-
-
-         ! I.3 Second derivative (divergence) (not divided by the volume)
-         ! ---------------------
-
-         DO jj = 2 , jpjm1
-            DO ji = 2 , jpim1
-               ztah = zftu(ji,jj) - zftu(ji-1,jj) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)
-               zsah = zfsu(ji,jj) - zfsu(ji-1,jj) + zfsv(ji,jj,jk) - zfsv(ji,jj-1,jk)
-               plt(ji,jj,jk) = ztah
-               pls(ji,jj,jk) = zsah
-            END DO
-         END DO
-         !                                             ! ===============
-      END DO                                           !   End of slab
-      !                                                ! ===============
- 
-      !!but this should be done somewhere after 
-      ! "zonal" mean diffusive heat and salt transport
-      IF( ln_diaptr .AND. ( kaht == 2 ) .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN
-         pht_ldf(:) = ptr_vj( zftv(:,:,:) )
-         pst_ldf(:) = ptr_vj( zfsv(:,:,:) )
-      ENDIF
-
-      !                             ! ************ !   ! ===============
-      DO jj = 2, jpjm1              !  Second step !   ! Horizontal slab
-         !                          ! ************ !   ! ===============
-
-         ! II.1 horizontal tracer gradient
-         ! -------------------------------
-
-         DO jk = 1, jpk
-            DO ji = 1, jpim1
-               zdit (ji,jk) = ( pt(ji+1,jj  ,jk) - pt(ji,jj  ,jk) ) * umask(ji,jj  ,jk)
-               zdis (ji,jk) = ( ps(ji+1,jj  ,jk) - ps(ji,jj  ,jk) ) * umask(ji,jj  ,jk)
-               zdjt (ji,jk) = ( pt(ji  ,jj+1,jk) - pt(ji,jj  ,jk) ) * vmask(ji,jj  ,jk)
-               zdjs (ji,jk) = ( ps(ji  ,jj+1,jk) - ps(ji,jj  ,jk) ) * vmask(ji,jj  ,jk)
-               zdj1t(ji,jk) = ( pt(ji  ,jj  ,jk) - pt(ji,jj-1,jk) ) * vmask(ji,jj-1,jk)
-               zdj1s(ji,jk) = ( ps(ji  ,jj  ,jk) - ps(ji,jj-1,jk) ) * vmask(ji,jj-1,jk)
-            END DO
-         END DO
-
-
-         ! II.2 Vertical fluxes
-         ! --------------------
-
-         ! Surface and bottom vertical fluxes set to zero
-         zftw(:, 1 ) = 0.e0
-         zfsw(:, 1 ) = 0.e0
-         zftw(:,jpk) = 0.e0
-         zfsw(:,jpk) = 0.e0
-
-         ! interior (2=<jk=<jpk-1)
-         DO jk = 2, jpkm1
-            DO ji = 2, jpim1
-               zcof0 = e1t(ji,jj) * e2t(ji,jj) / fse3w(ji,jj,jk)   &
-                     * (  wslpi(ji,jj,jk) * wslpi(ji,jj,jk)        &
-                        + wslpj(ji,jj,jk) * wslpj(ji,jj,jk)  )
-
-               zmku =1./MAX(  umask(ji  ,jj,jk-1)+umask(ji-1,jj,jk)   &
-                             +umask(ji-1,jj,jk-1)+umask(ji  ,jj,jk), 1. )
-
-               zmkv =1./MAX(  vmask(ji,jj  ,jk-1)+vmask(ji,jj-1,jk)   &
-                             +vmask(ji,jj-1,jk-1)+vmask(ji,jj  ,jk), 1. )
-
-               zcof3 = - e2t(ji,jj) * wslpi (ji,jj,jk) * zmku
-               zcof4 = - e1t(ji,jj) * wslpj (ji,jj,jk) * zmkv
-
-               zftw(ji,jk) = tmask(ji,jj,jk) *   &
-                  (  zcof0 * ( pt  (ji,jj,jk-1) - pt  (ji,jj,jk) )   &
-                   + zcof3 * ( zdit (ji  ,jk-1) + zdit (ji-1,jk)     &
-                              +zdit (ji-1,jk-1) + zdit (ji  ,jk) )   &
-                   + zcof4 * ( zdjt (ji  ,jk-1) + zdj1t(ji  ,jk)     &
-                              +zdj1t(ji  ,jk-1) + zdjt (ji  ,jk) )  )
-
-               zfsw(ji,jk) = tmask(ji,jj,jk) *   &
-                  (  zcof0 * ( ps  (ji,jj,jk-1) - ps  (ji,jj,jk) )   &
-                   + zcof3 * ( zdis (ji  ,jk-1) + zdis (ji-1,jk)     &
-                              +zdis (ji-1,jk-1) + zdis (ji  ,jk) )   &
-                   + zcof4 * ( zdjs (ji  ,jk-1) + zdj1s(ji  ,jk)     &
-                              +zdj1s(ji  ,jk-1) + zdjs (ji  ,jk) )  )
-            END DO
-         END DO
-
-
-         ! II.3 Divergence of vertical fluxes added to the horizontal divergence
-         ! ---------------------------------------------------------------------
-
-         IF( kaht == 1 ) THEN
-            ! multiply the laplacian by the eddy diffusivity coefficient
-            DO jk = 1, jpkm1
+         !                             ! ************ !   ! ===============
+         DO jj = 2, jpjm1              !  Second step !   ! Horizontal slab
+            !                          ! ************ !   ! ===============
+            
+            ! II.1 horizontal tracer gradient
+            ! -------------------------------
+            
+            DO jk = 1, jpk
+               DO ji = 1, jpim1
+                  zdit (ji,jk) = ( pt(ji+1,jj  ,jk,jn) - pt(ji,jj  ,jk,jn) ) * umask(ji,jj  ,jk)
+                  zdjt (ji,jk) = ( pt(ji  ,jj+1,jk,jn) - pt(ji,jj  ,jk,jn) ) * vmask(ji,jj  ,jk)
+                  zdj1t(ji,jk) = ( pt(ji  ,jj  ,jk,jn) - pt(ji,jj-1,jk,jn) ) * vmask(ji,jj-1,jk)
+               END DO
+            END DO
+
+
+            ! II.2 Vertical fluxes
+            ! --------------------
+            
+            ! Surface and bottom vertical fluxes set to zero
+            zftw(:, 1 ) = 0.e0
+            zftw(:,jpk) = 0.e0
+            
+            ! interior (2=<jk=<jpk-1)
+            DO jk = 2, jpkm1
                DO ji = 2, jpim1
-                  ! eddy coef. divided by the volume element
-                  zbtr = fsahtt(ji,jj,jk) / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )
-                  ! vertical divergence
-                  ztav = zftw(ji,jk) - zftw(ji,jk+1)
-                  zsav = zfsw(ji,jk) - zfsw(ji,jk+1)
-                  ! harmonic operator applied to (pt,ps) and multiply by aht
-                  plt(ji,jj,jk) = ( plt(ji,jj,jk) + ztav ) * zbtr
-                  pls(ji,jj,jk) = ( pls(ji,jj,jk) + zsav ) * zbtr
-               END DO
-            END DO
-         ELSEIF( kaht == 2 ) THEN
-            ! second call, no multiplication
-            DO jk = 1, jpkm1
-               DO ji = 2, jpim1
-                  ! inverse of the volume element
-                  zbtr = 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )
-                  ! vertical divergence
-                  ztav = zftw(ji,jk) - zftw(ji,jk+1)
-                  zsav = zfsw(ji,jk) - zfsw(ji,jk+1)
-                  ! harmonic operator applied to (pt,ps) 
-                  plt(ji,jj,jk) = ( plt(ji,jj,jk) + ztav ) * zbtr
-                  pls(ji,jj,jk) = ( pls(ji,jj,jk) + zsav ) * zbtr
-               END DO
-            END DO
-         ELSE
-            IF(lwp) WRITE(numout,*) ' ldfght: kaht= 1 or 2, here =', kaht
-            IF(lwp) WRITE(numout,*) '         We stop'
-            STOP 'ldfght'
-         ENDIF
-         !                                             ! ===============
-      END DO                                           !   End of slab
-      !                                                ! ===============
+                  zcof0 = e1t(ji,jj) * e2t(ji,jj) / fse3w(ji,jj,jk)   &
+                     &     * (  wslpi(ji,jj,jk) * wslpi(ji,jj,jk)        &
+                     &        + wslpj(ji,jj,jk) * wslpj(ji,jj,jk)  )
+                  
+                  zmku = 1./MAX(  umask(ji  ,jj,jk-1)+umask(ji-1,jj,jk)   &
+                     &           +umask(ji-1,jj,jk-1)+umask(ji  ,jj,jk), 1. )
+                  
+                  zmkv = 1./MAX(  vmask(ji,jj  ,jk-1)+vmask(ji,jj-1,jk)   &
+                     &           +vmask(ji,jj-1,jk-1)+vmask(ji,jj  ,jk), 1. )
+                  
+                  zcof3 = - e2t(ji,jj) * wslpi (ji,jj,jk) * zmku
+                  zcof4 = - e1t(ji,jj) * wslpj (ji,jj,jk) * zmkv
+                  
+                  zftw(ji,jk) = tmask(ji,jj,jk) *   &
+                     &    (  zcof0 * ( pt   (ji,jj,jk-1,jn) - pt   (ji  ,jj,jk,jn) )   &
+                     &     + zcof3 * ( zdit (ji   ,jk-1   ) + zdit (ji-1,jk      )     &
+                     &                +zdit (ji-1 ,jk-1   ) + zdit (ji  ,jk      ) )   &
+                     &     + zcof4 * ( zdjt (ji   ,jk-1   ) + zdj1t(ji  ,jk)     &
+                     &                +zdj1t(ji   ,jk-1   ) + zdjt (ji  ,jk      ) )  )                 
+               END DO
+            END DO
+
+
+            ! II.3 Divergence of vertical fluxes added to the horizontal divergence
+            ! ---------------------------------------------------------------------
+            
+            IF( kaht == 1 ) THEN
+               ! multiply the laplacian by the eddy diffusivity coefficient
+               DO jk = 1, jpkm1
+                  DO ji = 2, jpim1
+                     ! eddy coef. divided by the volume element
+                     zbtr = 1.0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                     ! vertical divergence
+                     ztav = fsahtt(ji,jj,jk) * ( zftw(ji,jk) - zftw(ji,jk+1) )
+                     ! harmonic operator applied to (pt,ps) and multiply by aht
+                     plt(ji,jj,jk,jn) = ( plt(ji,jj,jk,jn) + ztav ) * zbtr
+                  END DO
+               END DO
+            ELSEIF( kaht == 2 ) THEN
+               ! second call, no multiplication
+               DO jk = 1, jpkm1
+                  DO ji = 2, jpim1
+                     ! inverse of the volume element
+                     zbtr = 1.0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                     ! vertical divergence
+                     ztav = zftw(ji,jk) - zftw(ji,jk+1)
+                     ! harmonic operator applied to (pt,ps) 
+                     plt(ji,jj,jk,jn) = ( plt(ji,jj,jk,jn) + ztav ) * zbtr
+                  END DO
+               END DO
+            ELSE
+               IF(lwp) WRITE(numout,*) ' ldfght: kaht= 1 or 2, here =', kaht
+               IF(lwp) WRITE(numout,*) '         We stop'
+               STOP 'ldfght'
+            ENDIF
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+      END DO
+      !
    END SUBROUTINE ldfght
 
@@ -393,6 +328,8 @@
    !!----------------------------------------------------------------------
 CONTAINS
-   SUBROUTINE tra_ldf_bilapg( kt )               ! Dummy routine
-      WRITE(*,*) 'tra_ldf_bilapg: You should not have seen this print! error?', kt
+   SUBROUTINE tra_ldf_bilapg( kt, cdtype, ptb, pta, kjpt )      ! Empty routine
+      CHARACTER(len=3) ::   cdtype
+      REAL, DIMENSION(:,:,:,:) ::   ptb, pta
+      WRITE(*,*) 'tra_ldf_iso: You should not have seen this print! error?', kt, cdtype, ptb(1,1,1,1), pta(1,1,1,1), kjpt
    END SUBROUTINE tra_ldf_bilapg
 #endif
Index: trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90	(revision 2528)
@@ -2,15 +2,15 @@
    !!======================================================================
    !!                   ***  MODULE  traldf_iso  ***
-   !! Ocean active tracers:  horizontal component of the lateral tracer mixing trend
+   !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend
    !!======================================================================
-   !! History :        !  94-08  (G. Madec, M. Imbard)
-   !!                  !  97-05  (G. Madec)  split into traldf and trazdf
-   !!             8.5  !  02-08  (G. Madec)  Free form, F90
-   !!             9.0  !  05-11  (G. Madec)  merge traldf and trazdf :-)
+   !! History :  OPA  !  1994-08  (G. Madec, M. Imbard)
+   !!            8.0  !  1997-05  (G. Madec)  split into traldf and trazdf
+   !!            NEMO !  2002-08  (G. Madec)  Free form, F90
+   !!            1.0  !  2005-11  (G. Madec)  merge traldf and trazdf :-)
+   !!            3.3  !  2010-09  (C. Ethe, G. Madec) Merge TRA-TRC
    !!----------------------------------------------------------------------
 #if   defined key_ldfslp   ||   defined key_esopa
    !!----------------------------------------------------------------------
    !!   'key_ldfslp'               slope of the lateral diffusive direction
-   !!----------------------------------------------------------------------
    !!----------------------------------------------------------------------
    !!   tra_ldf_iso  : update the tracer trend with the horizontal 
@@ -21,13 +21,11 @@
    USE oce             ! ocean dynamics and active tracers
    USE dom_oce         ! ocean space and time domain
+   USE trc_oce         ! share passive tracers/Ocean variables
+   USE zdf_oce         ! ocean vertical physics
    USE ldftra_oce      ! ocean active tracers: lateral physics
-   USE trdmod          ! ocean active tracers trends 
-   USE trdmod_oce      ! ocean variables trends
-   USE zdf_oce         ! ocean vertical physics
-   USE in_out_manager  ! I/O manager
-   USE iom             !
    USE ldfslp          ! iso-neutral slopes
    USE diaptr          ! poleward transport diagnostics
-   USE prtctl          ! Print control
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O library
 #if defined key_diaar5
    USE phycst          ! physical constants
@@ -45,12 +43,12 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
-   SUBROUTINE tra_ldf_iso( kt )
+   SUBROUTINE tra_ldf_iso( kt, cdtype, pgu, pgv,              &
+      &                                ptb, pta, kjpt, pahtb0 )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_ldf_iso  ***
@@ -66,5 +64,5 @@
       !!      nal or geopotential slopes computed in routine ldfslp.
       !!
-      !!      1st part :  masked horizontal derivative of T & S ( di[ t ] )
+      !!      1st part :  masked horizontal derivative of T  ( di[ t ] )
       !!      ========    with partial cell update if ln_zps=T.
       !!
@@ -88,246 +86,204 @@
       !!         difft = 1/(e1t*e2t*e3t) dk[ zftw ]
       !!      Add this trend to the general trend (ta,sa):
-      !!         ta = ta + difft
-      !!
-      !! ** Action :   Update (ta,sa) arrays with the before rotated diffusion
-      !!            trend (except the dk[ dk[.] ] term)
+      !!         pta = pta + difft
+      !!
+      !! ** Action :   Update pta arrays with the before rotated diffusion
       !!----------------------------------------------------------------------
-      USE oce           , zftv => ua   ! use ua as workspace
-      USE oce           , zfsv => va   ! use va as workspace
-      !!
-      INTEGER, INTENT( in ) ::   kt    ! ocean time-step index
-      !!
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      INTEGER  ::   iku, ikv     ! temporary integer
-      REAL(wp) ::   zmsku, zabe1, zcof1, zcoef3, zta   ! temporary scalars
-      REAL(wp) ::   zmskv, zabe2, zcof2, zcoef4, zsa   !    "         "
-      REAL(wp) ::   zcoef0, zbtr                       !    "         "
-      REAL(wp), DIMENSION(jpi,jpj)     ::   zdkt , zdk1t         ! 2D workspace
-      REAL(wp), DIMENSION(jpi,jpj)     ::   zdks , zdk1s, zfsu   !  "         "
+      USE oce         , zftu => ua   ! use ua as workspace
+      USE oce         , zftv => va   ! use va as workspace
+      !!
+      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
+      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
+      REAL(wp)                             , INTENT(in   ) ::   pahtb0     ! background diffusion coef
+      !!
+      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::  zmsku, zabe1, zcof1, zcoef3   ! local scalars
+      REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4   !   -      -
+      REAL(wp) ::  zcoef0, zbtr, ztra            !   -      -
+      REAL(wp), DIMENSION(jpi,jpj)     ::   zdkt, zdk1t         ! 2D workspace
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdit, zdjt, ztfw    ! 3D workspace
 #if defined key_diaar5
-      REAL(wp), DIMENSION(jpi,jpj)     ::   z2d                  !  "         "
-      REAL(wp)                         ::   zztmp                !  "         "
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zftu                 ! 3D workspace
-#else
-      REAL(wp), DIMENSION(jpi,jpj)     ::   zftu                 ! 2D workspace
+      REAL(wp), DIMENSION(jpi,jpj)     ::   z2d                 ! 2D workspace
+      REAL(wp)                         ::   zztmp               ! local scalar
 #endif
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdit, zdjt, ztfw     ! 3D workspace
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdis, zdjs, zsfw     !  "      "
       !!----------------------------------------------------------------------
 
-      IF( kt == nit000 ) THEN
+      IF( kt == nit000 )  THEN
          IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_ldf_iso : rotated laplacian diffusion operator'
+         IF(lwp) WRITE(numout,*) 'tra_ldf_iso : rotated laplacian diffusion operator on ', cdtype
          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
       ENDIF
-
-      !!----------------------------------------------------------------------
-      !!   I - masked horizontal derivative of T & S
-      !!----------------------------------------------------------------------
-!!bug ajout.... why?   ( 1,jpj,:) and (jpi,1,:) should be sufficient....
-      zdit (1,:,:) = 0.e0     ;     zdit (jpi,:,:) = 0.e0
-      zdis (1,:,:) = 0.e0     ;     zdis (jpi,:,:) = 0.e0
-      zdjt (1,:,:) = 0.e0     ;     zdjt (jpi,:,:) = 0.e0
-      zdjs (1,:,:) = 0.e0     ;     zdjs (jpi,:,:) = 0.e0
-!!end
-
-      ! Horizontal temperature and salinity gradient 
-      DO jk = 1, jpkm1
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               zdit(ji,jj,jk) = ( tb(ji+1,jj  ,jk) - tb(ji,jj,jk) ) * umask(ji,jj,jk)
-               zdis(ji,jj,jk) = ( sb(ji+1,jj  ,jk) - sb(ji,jj,jk) ) * umask(ji,jj,jk)
-               zdjt(ji,jj,jk) = ( tb(ji  ,jj+1,jk) - tb(ji,jj,jk) ) * vmask(ji,jj,jk)
-               zdjs(ji,jj,jk) = ( sb(ji  ,jj+1,jk) - sb(ji,jj,jk) ) * vmask(ji,jj,jk)
+      !
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         !                                               
+         !!----------------------------------------------------------------------
+         !!   I - masked horizontal derivative 
+         !!----------------------------------------------------------------------
+         !!bug ajout.... why?   ( 1,jpj,:) and (jpi,1,:) should be sufficient....
+         zdit (1,:,:) = 0.e0     ;     zdit (jpi,:,:) = 0.e0
+         zdjt (1,:,:) = 0.e0     ;     zdjt (jpi,:,:) = 0.e0
+         !!end
+
+         ! Horizontal tracer gradient 
+         DO jk = 1, jpkm1
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zdit(ji,jj,jk) = ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) ) * umask(ji,jj,jk)
+                  zdjt(ji,jj,jk) = ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) * vmask(ji,jj,jk)
+               END DO
             END DO
          END DO
-      END DO
-      IF( ln_zps ) THEN      ! partial steps correction at the last level 
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               ! last level
-               iku = MIN( mbathy(ji,jj), mbathy(ji+1,jj  ) ) - 1
-               ikv = MIN( mbathy(ji,jj), mbathy(ji  ,jj+1) ) - 1
-               zdit(ji,jj,iku) = gtu(ji,jj) 
-               zdis(ji,jj,iku) = gsu(ji,jj)               
-               zdjt(ji,jj,ikv) = gtv(ji,jj) 
-               zdjs(ji,jj,ikv) = gsv(ji,jj)               
+         IF( ln_zps ) THEN      ! partial steps correction at the last ocean level 
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn)          
+                  zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn)      
+               END DO
+            END DO
+         ENDIF
+
+         !!----------------------------------------------------------------------
+         !!   II - horizontal trend  (full)
+         !!----------------------------------------------------------------------
+!CDIR PARALLEL DO PRIVATE( zdk1t ) 
+         !                                                ! ===============
+         DO jk = 1, jpkm1                                 ! Horizontal slab
+            !                                             ! ===============
+            ! 1. Vertical tracer gradient at level jk and jk+1
+            ! ------------------------------------------------
+            ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2)
+            zdk1t(:,:) = ( ptb(:,:,jk,jn) - ptb(:,:,jk+1,jn) ) * tmask(:,:,jk+1)
+            !
+            IF( jk == 1 ) THEN   ;   zdkt(:,:) = zdk1t(:,:)
+            ELSE                 ;   zdkt(:,:) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * tmask(:,:,jk)
+            ENDIF
+
+            ! 2. Horizontal fluxes
+            ! --------------------   
+            DO jj = 1 , jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zabe1 = ( fsahtu(ji,jj,jk) + pahtb0 ) * e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj)
+                  zabe2 = ( fsahtv(ji,jj,jk) + pahtb0 ) * e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj)
+                  !
+                  zmsku = 1. / MAX(  tmask(ji+1,jj,jk  ) + tmask(ji,jj,jk+1)   &
+                     &             + tmask(ji+1,jj,jk+1) + tmask(ji,jj,jk  ), 1. )
+                  !
+                  zmskv = 1. / MAX(  tmask(ji,jj+1,jk  ) + tmask(ji,jj,jk+1)   &
+                     &             + tmask(ji,jj+1,jk+1) + tmask(ji,jj,jk  ), 1. )
+                  !
+                  zcof1 = - fsahtu(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku
+                  zcof2 = - fsahtv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv
+                  !
+                  zftu(ji,jj,jk ) = (  zabe1 * zdit(ji,jj,jk)   &
+                     &              + zcof1 * (  zdkt (ji+1,jj) + zdk1t(ji,jj)      &
+                     &                         + zdk1t(ji+1,jj) + zdkt (ji,jj)  )  ) * umask(ji,jj,jk)
+                  zftv(ji,jj,jk) = (  zabe2 * zdjt(ji,jj,jk)   &
+                     &              + zcof2 * (  zdkt (ji,jj+1) + zdk1t(ji,jj)      &
+                     &                         + zdk1t(ji,jj+1) + zdkt (ji,jj)  )  ) * vmask(ji,jj,jk)                  
+               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.
+                  zbtr = 1.0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ztra = zbtr * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  )
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
+               END DO
+            END DO
+            !                                          ! ===============
+         END DO                                        !   End of slab  
+         !                                             ! ===============
+         !
+         ! "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(:,:,:) )
+            IF( jn == jp_sal)   str_ldf(:) = ptr_vj( 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 i-direction
+         END IF
+#endif
+
+         !!----------------------------------------------------------------------
+         !!   III - vertical trend of T & S (extra diagonal terms only)
+         !!----------------------------------------------------------------------
+         
+         ! Local constant initialization
+         ! -----------------------------
+         ztfw(1,:,:) = 0.e0     ;     ztfw(jpi,:,:) = 0.e0
+         
+         ! Vertical fluxes
+         ! ---------------
+         
+         ! Surface and bottom vertical fluxes set to zero
+         ztfw(:,:, 1 ) = 0.e0      ;      ztfw(:,:,jpk) = 0.e0
+         
+         ! interior (2=<jk=<jpk-1)
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zcoef0 = - fsahtw(ji,jj,jk) * tmask(ji,jj,jk)
+                  !
+                  zmsku = 1./MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)      &
+                     &            + umask(ji-1,jj,jk-1) + umask(ji  ,jj,jk), 1.  )
+                  zmskv = 1./MAX(   vmask(ji,jj  ,jk-1) + vmask(ji,jj-1,jk)      &
+                     &            + vmask(ji,jj-1,jk-1) + vmask(ji,jj  ,jk), 1.  )
+                  !
+                  zcoef3 = zcoef0 * e2t(ji,jj) * zmsku * wslpi (ji,jj,jk)
+                  zcoef4 = zcoef0 * e1t(ji,jj) * zmskv * wslpj (ji,jj,jk)
+                  !
+                  ztfw(ji,jj,jk) = zcoef3 * (   zdit(ji  ,jj  ,jk-1) + zdit(ji-1,jj  ,jk)      &
+                     &                        + zdit(ji-1,jj  ,jk-1) + zdit(ji  ,jj  ,jk)  )   &
+                     &           + zcoef4 * (   zdjt(ji  ,jj  ,jk-1) + zdjt(ji  ,jj-1,jk)      &
+                     &                        + zdjt(ji  ,jj-1,jk-1) + zdjt(ji  ,jj  ,jk)  )
+               END DO
             END DO
          END DO
-      ENDIF
-
-      !!----------------------------------------------------------------------
-      !!   II - horizontal trend of T & S (full)
-      !!----------------------------------------------------------------------
-      
-#if defined key_diaar5
-!CDIR PARALLEL DO PRIVATE( zdk1t, zdk1s, zfsu ) 
-#else
-!CDIR PARALLEL DO PRIVATE( zdk1t, zdk1s, zftu, zfsu ) 
-#endif
-      !                                                ! ===============
-      DO jk = 1, jpkm1                                 ! Horizontal slab
-         !                                             ! ===============
-         ! 1. Vertical tracer gradient at level jk and jk+1
-         ! ------------------------------------------------
-         ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2)
-
-         zdk1t(:,:) = ( tb(:,:,jk) - tb(:,:,jk+1) ) * tmask(:,:,jk+1)
-         zdk1s(:,:) = ( sb(:,:,jk) - sb(:,:,jk+1) ) * tmask(:,:,jk+1)
-
-         IF( jk == 1 ) THEN
-            zdkt(:,:) = zdk1t(:,:)
-            zdks(:,:) = zdk1s(:,:)
-         ELSE
-            zdkt(:,:) = ( tb(:,:,jk-1) - tb(:,:,jk) ) * tmask(:,:,jk)
-            zdks(:,:) = ( sb(:,:,jk-1) - sb(:,:,jk) ) * tmask(:,:,jk)
-         ENDIF
-
-
-         ! 2. Horizontal fluxes
-         ! --------------------
-
-         DO jj = 1 , jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               zabe1 = ( fsahtu(ji,jj,jk) + ahtb0 ) * e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj)
-               zabe2 = ( fsahtv(ji,jj,jk) + ahtb0 ) * e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj)
-
-               zmsku = 1. / MAX(  tmask(ji+1,jj,jk  ) + tmask(ji,jj,jk+1)   &
-                  &             + tmask(ji+1,jj,jk+1) + tmask(ji,jj,jk  ), 1. )
-
-               zmskv = 1. / MAX(  tmask(ji,jj+1,jk  ) + tmask(ji,jj,jk+1)   &
-                  &             + tmask(ji,jj+1,jk+1) + tmask(ji,jj,jk  ), 1. )
-
-               zcof1 = -fsahtu(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku
-               zcof2 = -fsahtv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv
-
-#if defined key_diaar5
-               zftu(ji,jj,jk) = (  zabe1 * zdit(ji,jj,jk)   &
-#else
-               zftu(ji,jj   ) = (  zabe1 * zdit(ji,jj,jk)   &
-#endif
-                  &              + zcof1 * (  zdkt (ji+1,jj) + zdk1t(ji,jj)      &
-                  &                         + zdk1t(ji+1,jj) + zdkt (ji,jj)  )  ) * umask(ji,jj,jk)
-               zftv(ji,jj,jk) = (  zabe2 * zdjt(ji,jj,jk)   &
-                  &              + zcof2 * (  zdkt (ji,jj+1) + zdk1t(ji,jj)      &
-                  &                         + zdk1t(ji,jj+1) + zdkt (ji,jj)  )  ) * vmask(ji,jj,jk)
-               zfsu(ji,jj   ) = (  zabe1 * zdis(ji,jj,jk)   &
-                  &              + zcof1 * (  zdks (ji+1,jj) + zdk1s(ji,jj)      &
-                  &                         + zdk1s(ji+1,jj) + zdks (ji,jj)  )  ) * umask(ji,jj,jk)
-               zfsv(ji,jj,jk) = (  zabe2 * zdjs(ji,jj,jk)   &
-                  &              + zcof2 * (  zdks (ji,jj+1) + zdk1s(ji,jj)      &
-                  &                         + zdk1s(ji,jj+1) + zdks (ji,jj)  )  ) * vmask(ji,jj,jk)
+         
+         
+         ! I.5 Divergence of vertical fluxes added to the general tracer trend
+         ! -------------------------------------------------------------------
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = 1.0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ztra = (  ztfw(ji,jj,jk) - ztfw(ji,jj,jk+1)  ) * zbtr
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
+               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.
-               zbtr= 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )
-#if defined key_diaar5
-               zta = zbtr * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  )
-#else
-               zta = zbtr * ( zftu(ji,jj   ) - zftu(ji-1,jj   ) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  )
-#endif
-               zsa = zbtr * ( zfsu(ji,jj   ) - zfsu(ji-1,jj   ) + zfsv(ji,jj,jk) - zfsv(ji,jj-1,jk)  )
-               ta (ji,jj,jk) = ta (ji,jj,jk) + zta
-               sa (ji,jj,jk) = sa (ji,jj,jk) + zsa
-            END DO
-         END DO
-         !                                          ! ===============
-      END DO                                        !   End of slab  
-      !                                             ! ===============
-
-      IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN   ! Poleward diffusive heat and salt transports
-         pht_ldf(:) = ptr_vj( zftv(:,:,:) )
-         pst_ldf(:) = ptr_vj( zfsv(:,:,:) )
-      ENDIF
-#if defined key_diaar5
-      zztmp = 0.5 * rau0 * rcp 
-      z2d(:,:) = 0.e0 
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-      z2d(:,:) =  z2d(:,:) * zztmp
-      CALL lbc_lnk( z2d, 'U', -1. )
-      CALL iom_put( "udiff_heattr", z2d )                  ! heat transport in i-direction
-      z2d(:,:) = 0.e0 
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-      z2d(:,:) =  z2d(:,:) * zztmp
-      CALL lbc_lnk( z2d, 'V', -1. )
-      CALL iom_put( "vdiff_heattr", z2d )                  !  heat transport in i-direction
-#endif
-
-      !!----------------------------------------------------------------------
-      !!   III - vertical trend of T & S (extra diagonal terms only)
-      !!----------------------------------------------------------------------
-
-      ! Local constant initialization
-      ! -----------------------------
-      ztfw(1,:,:) = 0.e0     ;     ztfw(jpi,:,:) = 0.e0
-      zsfw(1,:,:) = 0.e0     ;     zsfw(jpi,:,:) = 0.e0
-
-
-      ! Vertical fluxes
-      ! ---------------
-
-      ! Surface and bottom vertical fluxes set to zero
-      ztfw(:,:, 1 ) = 0.e0      ;      ztfw(:,:,jpk) = 0.e0
-      zsfw(:,:, 1 ) = 0.e0      ;      zsfw(:,:,jpk) = 0.e0
-
-      ! interior (2=<jk=<jpk-1)
-      DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zcoef0 = - fsahtw(ji,jj,jk) * tmask(ji,jj,jk)
-
-               zmsku = 1./MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)      &
-                  &            + umask(ji-1,jj,jk-1) + umask(ji  ,jj,jk), 1.  )
-
-               zmskv = 1./MAX(   vmask(ji,jj  ,jk-1) + vmask(ji,jj-1,jk)      &
-                  &            + vmask(ji,jj-1,jk-1) + vmask(ji,jj  ,jk), 1.  )
-
-               zcoef3 = zcoef0 * e2t(ji,jj) * zmsku * wslpi (ji,jj,jk)
-               zcoef4 = zcoef0 * e1t(ji,jj) * zmskv * wslpj (ji,jj,jk)
-
-               ztfw(ji,jj,jk) = zcoef3 * (   zdit(ji  ,jj  ,jk-1) + zdit(ji-1,jj  ,jk)      &
-                  &                        + zdit(ji-1,jj  ,jk-1) + zdit(ji  ,jj  ,jk)  )   &
-                  &           + zcoef4 * (   zdjt(ji  ,jj  ,jk-1) + zdjt(ji  ,jj-1,jk)      &
-                  &                        + zdjt(ji  ,jj-1,jk-1) + zdjt(ji  ,jj  ,jk)  )
-
-               zsfw(ji,jj,jk) = zcoef3 * (   zdis(ji  ,jj  ,jk-1) + zdis(ji-1,jj  ,jk)      &
-                  &                        + zdis(ji-1,jj  ,jk-1) + zdis(ji  ,jj  ,jk)  )   &
-                  &           + zcoef4 * (   zdjs(ji  ,jj  ,jk-1) + zdjs(ji  ,jj-1,jk)      &
-                  &                        + zdjs(ji  ,jj-1,jk-1) + zdjs(ji  ,jj  ,jk)  )
-            END DO
-         END DO
-      END DO
-
-
-      ! I.5 Divergence of vertical fluxes added to the general tracer trend
-      ! -------------------------------------------------------------------
-
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zbtr =  1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )
-               zta  = (  ztfw(ji,jj,jk) - ztfw(ji,jj,jk+1)  ) * zbtr
-               zsa  = (  zsfw(ji,jj,jk) - zsfw(ji,jj,jk+1)  ) * zbtr
-               ta(ji,jj,jk) = ta(ji,jj,jk) + zta
-               sa(ji,jj,jk) = sa(ji,jj,jk) + zsa
-            END DO
-         END DO
+         !
       END DO
       !
@@ -339,6 +295,10 @@
    !!----------------------------------------------------------------------
 CONTAINS
-   SUBROUTINE tra_ldf_iso( kt )               ! Empty routine
-      WRITE(*,*) 'tra_ldf_iso: You should not have seen this print! error?', kt
+   SUBROUTINE tra_ldf_iso( kt, cdtype, pgu, pgv, ptb, pta, kjpt, pahtb0 )      ! Empty routine
+      CHARACTER(len=3) ::   cdtype
+      REAL, DIMENSION(:,:,:) ::   pgu, pgv   ! tracer gradient at pstep levels
+      REAL, DIMENSION(:,:,:,:) ::   ptb, pta
+      WRITE(*,*) 'tra_ldf_iso: You should not have seen this print! error?', kt, cdtype, pgu(1,1,1), pgv(1,1,1),   &
+         &                                                             ptb(1,1,1,1), pta(1,1,1,1), kjpt, pahtb0
    END SUBROUTINE tra_ldf_iso
 #endif
Index: trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90	(revision 2528)
@@ -0,0 +1,361 @@
+MODULE traldf_iso_grif
+   !!======================================================================
+   !!                   ***  MODULE  traldf_iso_grif  ***
+   !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend
+   !!======================================================================
+   !! History : 3.3  ! 2010-10  (G. Nurser, C. Harris, G. Madec)  
+   !!                !          Griffies operator version adapted from traldf_iso.F90
+   !!----------------------------------------------------------------------
+#if   defined key_ldfslp   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_ldfslp'               slope of the lateral diffusive direction
+   !!----------------------------------------------------------------------
+   !!   tra_ldf_iso_grif  : update the tracer trend with the horizontal component  
+   !!                       of the Griffies iso-neutral laplacian operator 
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and active tracers
+   USE dom_oce         ! ocean space and time domain
+   USE trc_oce         ! share passive tracers/Ocean variables
+   USE zdf_oce         ! ocean vertical physics
+   USE ldftra_oce      ! ocean active tracers: lateral physics
+   USE ldfslp          ! iso-neutral slopes
+   USE diaptr          ! poleward transport diagnostics
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O library
+#if defined key_diaar5
+   USE phycst          ! physical constants
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+#endif
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC tra_ldf_iso_grif   ! routine called by traldf.F90
+
+   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::   psix_eiv
+   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::   psiy_eiv
+   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::   ah_wslp2
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "ldftra_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+#  include "ldfeiv_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+  SUBROUTINE tra_ldf_iso_grif( kt, cdtype, pgu, pgv,              &
+       &                                   ptb, pta, kjpt, pahtb0 )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_ldf_iso_grif  ***
+      !!
+      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive 
+      !!      trend for a laplacian tensor (ezxcept the dz[ dz[.] ] term) and 
+      !!      add it to the general trend of tracer equation.
+      !!
+      !! ** Method  :   The horizontal component of the lateral diffusive trends 
+      !!      is provided by a 2nd order operator rotated along neural or geopo-
+      !!      tential surfaces to which an eddy induced advection can be added
+      !!      It is computed using before fields (forward in time) and isopyc-
+      !!      nal or geopotential slopes computed in routine ldfslp.
+      !!
+      !!      1st part :  masked horizontal derivative of T  ( di[ t ] )
+      !!      ========    with partial cell update if ln_zps=T.
+      !!
+      !!      2nd part :  horizontal fluxes of the lateral mixing operator
+      !!      ========    
+      !!         zftu = (aht+ahtb0) e2u*e3u/e1u di[ tb ]
+      !!               - aht       e2u*uslp    dk[ mi(mk(tb)) ]
+      !!         zftv = (aht+ahtb0) e1v*e3v/e2v dj[ tb ]
+      !!               - aht       e2u*vslp    dk[ mj(mk(tb)) ]
+      !!      take the horizontal divergence of the fluxes:
+      !!         difft = 1/(e1t*e2t*e3t) {  di-1[ zftu ] +  dj-1[ zftv ]  }
+      !!      Add this trend to the general trend (ta,sa):
+      !!         ta = ta + difft
+      !!
+      !!      3rd part: vertical trends of the lateral mixing operator
+      !!      ========  (excluding the vertical flux proportional to dk[t] )
+      !!      vertical fluxes associated with the rotated lateral mixing:
+      !!         zftw =-aht {  e2t*wslpi di[ mi(mk(tb)) ]
+      !!                     + e1t*wslpj dj[ mj(mk(tb)) ]  }
+      !!      take the horizontal divergence of the fluxes:
+      !!         difft = 1/(e1t*e2t*e3t) dk[ zftw ]
+      !!      Add this trend to the general trend (ta,sa):
+      !!         pta = pta + difft
+      !!
+      !! ** Action :   Update pta arrays with the before rotated diffusion
+      !!----------------------------------------------------------------------
+      USE oce,   zftu => ua   ! use ua as workspace
+      USE oce,   zftv => va   ! use va as workspace
+      !!
+      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
+      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
+      REAL(wp)                             , INTENT(in   ) ::   pahtb0     ! background diffusion coef
+      !!
+      INTEGER  ::  ji, jj, jk,jn   ! dummy loop indices
+      INTEGER  ::  ip,jp,kp        ! dummy loop indices
+      INTEGER  ::  ierr            ! temporary integer
+      REAL(wp) ::  zmsku, zabe1, zcof1, zcoef3   ! local scalars
+      REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4   !   -      -
+      REAL(wp) ::  zcoef0, zbtr                  !   -      -
+      REAL(wp), DIMENSION(jpi,jpj,0:1) ::   zdkt               ! 2D+1 workspace
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdit, zdjt, ztfw   ! 3D workspace
+      !
+      REAL(wp) ::   zslope_skew, zslope_iso, zslope2, zbu, zbv
+      REAL(wp) ::   ze1ur, zdxt, ze2vr, ze3wr, zdyt, zdzt
+      REAL(wp) ::   zah, zah_slp, zaei_slp
+#if defined key_diaar5
+      REAL(wp), DIMENSION(jpi,jpj)     ::   z2d                ! 2D workspace
+      REAL(wp)                         ::   zztmp              ! local scalar
+#endif
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_ldf_iso_grif : rotated laplacian diffusion operator on ', cdtype
+         IF(lwp) WRITE(numout,*) '                   WARNING: STILL UNDER TEST, NOT RECOMMENDED. USE AT YOUR OWN PERIL'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+         ALLOCATE( ah_wslp2(jpi,jpj,jpk) , STAT=ierr )
+         IF( ierr > 0 ) THEN
+            CALL ctl_stop( 'tra_ldf_iso_grif : unable to allocate Griffies operator ah_wslp2 ' )   ;   RETURN
+         ENDIF
+         IF( ln_traldf_gdia ) THEN
+            ALLOCATE( psix_eiv(jpi,jpj,jpk) , psiy_eiv(jpi,jpj,jpk) , STAT=ierr )
+            IF( ierr > 0 ) THEN
+               CALL ctl_stop( 'tra_ldf_iso_grif : unable to allocate Griffies operator diagnostics ' )   ;   RETURN
+            ENDIF
+         ENDIF
+      ENDIF
+
+      !!----------------------------------------------------------------------
+      !!   0 - calculate  ah_wslp2, psix_eiv, psiy_eiv 
+      !!----------------------------------------------------------------------
+
+!!gm Future development: consider using Ah defined at T-points and attached to the 4 t-point triads
+
+      ah_wslp2(:,:,:) = 0._wp
+      IF( ln_traldf_gdia ) THEN
+         psix_eiv(:,:,:) = 0._wp
+         psiy_eiv(:,:,:) = 0._wp
+      ENDIF
+
+      DO ip = 0, 1
+         DO kp = 0, 1
+            DO jk = 1, jpkm1
+               DO jj = 1, jpjm1
+                  DO ji = 1, fs_jpim1
+                     ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp)
+                     zbu   = 0.25_wp * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)
+                     zah   = fsahtu(ji,jj,jk)                                  !  fsaht(ji+ip,jj,jk)
+                     zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp)
+                     zslope2 = zslope_skew - ( fsdept(ji+1,jj,jk) - fsdept(ji ,jj ,jk) ) * ze1ur * umask(ji,jj,jk+kp)
+                     zslope2 = zslope2 *zslope2
+                     ah_wslp2(ji+ip,jj,jk+kp) = ah_wslp2(ji+ip,jj,jk+kp)    &
+                        &                     + zah * ( zbu * ze3wr / ( e1t(ji+ip,jj) * e2t(ji+ip,jj) ) ) * zslope2
+                     IF( ln_traldf_gdia ) THEN
+                        zaei_slp = fsaeiw(ji+ip,jj,jk) * zslope_skew        !fsaeit(ji+ip,jj,jk)*zslope_skew
+                        psix_eiv(ji,jj,jk+kp) = psix_eiv(ji,jj,jk+kp) + 0.25_wp * zaei_slp
+                     ENDIF
+                  END DO
+               END DO
+            END DO
+         END DO
+      END DO
+      !
+      DO jp = 0, 1
+         DO kp = 0, 1
+            DO jk = 1, jpkm1
+               DO jj = 1, jpjm1
+                  DO ji=1,fs_jpim1
+                     ze3wr = 1.0_wp / fse3w(ji,jj+jp,jk+kp)
+                     zbv   = 0.25_wp * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)
+                     zah   = fsahtu(ji,jj,jk)                                       !fsaht(ji,jj+jp,jk)
+                     zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp)
+                     zslope2 = zslope_skew - ( fsdept(ji,jj+1,jk) - fsdept(ji,jj,jk) ) * ze2vr * vmask(ji,jj,jk+kp)
+                     zslope2 = zslope2 * zslope2
+                     ah_wslp2(ji,jj+jp,jk+kp) = ah_wslp2(ji,jj+jp,jk+kp)   &
+                        &                     + zah * ( zbv * ze3wr / ( e1t(ji,jj+jp) * e2t(ji,jj+jp) ) ) * zslope2
+                     IF( ln_traldf_gdia ) THEN
+                        zaei_slp = fsaeiw(ji,jj+jp,jk) * zslope_skew     !fsaeit(ji,jj+jp,jk)*zslope_skew
+                        psiy_eiv(ji,jj,jk+kp) = psiy_eiv(ji,jj,jk+kp) + 0.25_wp * zaei_slp
+                     ENDIF
+                  END DO
+               END DO
+            END DO
+         END DO
+      END DO
+      !
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         ! Zero fluxes for each tracer
+         ztfw(:,:,:) = 0._wp
+         zftu(:,:,:) = 0._wp
+         zftv(:,:,:) = 0._wp
+         !                                               
+         DO jk = 1, jpkm1                          !==  before lateral T & S gradients at T-level jk  ==!
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zdit(ji,jj,jk) = ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) ) * umask(ji,jj,jk)
+                  zdjt(ji,jj,jk) = ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) * vmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         IF( ln_zps ) THEN                               ! partial steps: correction at the last level
+# if defined key_vectopt_loop
+            DO jj = 1, 1
+               DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
+# else
+            DO jj = 1, jpjm1
+               DO ji = 1, jpim1
+# endif
+                  zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn)          
+                  zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn)      
+               END DO
+            END DO
+         ENDIF
+
+         !!----------------------------------------------------------------------
+         !!   II - horizontal trend  (full)
+         !!----------------------------------------------------------------------
+         !
+         DO jk = 1, jpkm1
+            !
+            !                    !==  Vertical tracer gradient at level jk and jk+1
+            zdkt(:,:,1) = ( ptb(:,:,jk,jn) - ptb(:,:,jk+1,jn) ) * tmask(:,:,jk+1)
+            !
+            !                          ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2)
+            IF( jk == 1 ) THEN   ;   zdkt(:,:,0) = zdkt(:,:,1)
+            ELSE                 ;   zdkt(:,:,0) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * tmask(:,:,jk)
+            ENDIF
+
+            IF( .NOT. l_triad_iso ) THEN
+               triadi = triadi_g
+               triadj = triadj_g
+            ENDIF
+
+            DO ip = 0, 1              !==  Horizontal & vertical fluxes
+               DO kp = 0, 1
+                  DO jj = 1, jpjm1
+                     DO ji = 1, fs_jpim1
+                        ze1ur = 1._wp / e1u(ji,jj)
+                        zdxt = zdit(ji,jj,jk) * ze1ur
+                        ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp)
+                        zdzt  = zdkt(ji+ip,jj,kp) * ze3wr
+                        zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp)
+                        zslope_iso  = triadi(ji+ip,jj,jk,1-ip,kp)
+
+                        zbu = 0.25_wp * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)
+                        zah = fsahtu(ji,jj,jk)   !*umask(ji,jj,jk+kp)         !fsaht(ji+ip,jj,jk)           ===>>  ????
+                        zah_slp  = zah * zslope_iso
+                        zaei_slp = fsaeiw(ji+ip,jj,jk) * zslope_skew    !fsaeit(ji+ip,jj,jk)*zslope_skew
+                        zftu(ji,jj,jk) = zftu(ji,jj,jk) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur
+                        ztfw(ji+ip,jj,jk+kp) = ztfw(ji+ip,jj,jk+kp) - (zah_slp + zaei_slp) * zdxt * zbu * ze3wr
+                     END DO
+                  END DO
+               END DO
+            END DO
+
+            DO jp = 0, 1
+               DO kp = 0, 1
+                  DO jj = 1, jpjm1
+                     DO ji = 1, fs_jpim1
+                        ze2vr = 1._wp / e2v(ji,jj)
+                        zdyt = zdjt(ji,jj,jk) * ze2vr
+                        ze3wr = 1._wp / fse3w(ji,jj+jp,jk+kp)
+                        zdzt = zdkt(ji,jj+jp,kp) * ze3wr
+                        zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp)
+                        zslope_iso  = triadj(ji,jj+jp,jk,1-jp,kp)
+                        zbv = 0.25_wp * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)
+                        zah = fsahtv(ji,jj,jk)        !*vmask(ji,jj,jk+kp)         !fsaht(ji,jj+jp,jk)
+                        zah_slp = zah * zslope_iso
+                        zaei_slp = fsaeiw(ji,jj+jp,jk) * zslope_skew    !fsaeit(ji,jj+jp,jk)*zslope_skew
+                        zftv(ji,jj,jk) = zftv(ji,jj,jk) - ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr
+                        ztfw(ji,jj+jp,jk+kp) = ztfw(ji,jj+jp,jk+kp) - (zah_slp + zaei_slp) * zdyt * zbv * ze3wr
+                     END DO
+                  END DO
+               END DO
+            END DO
+
+            !                        !==  divergence and add to the general trend  ==!
+            DO jj = 2 , jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = 1._wp / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zbtr * (   zftu(ji-1,jj,jk) - zftu(ji,jj,jk)   &
+                     &                                           + zftv(ji,jj-1,jk) - zftv(ji,jj,jk)   )
+               END DO
+            END DO
+            !
+         END DO
+         !
+         DO jk = 1, jpkm1            !== Divergence of vertical fluxes added to the general tracer trend
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + (  ztfw(ji,jj,jk+1) - ztfw(ji,jj,jk)  )   &
+                     &                                / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               END DO
+            END DO
+         END DO
+         !
+         !                            ! "Poleward" diffusive heat or salt transports (T-S case only)
+         IF( cdtype == 'TRA' .AND. ln_diaptr .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(:,:,:) )
+         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 i-direction
+         END IF
+#endif
+         !
+      END DO
+      !
+  END SUBROUTINE tra_ldf_iso_grif
+
+#else
+   !!----------------------------------------------------------------------
+   !!   default option :   Dummy code   NO rotation of the diffusive tensor
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE tra_ldf_iso_grif( kt, cdtype, pgu, pgv, ptb, pta, kjpt, pahtb0 )      ! Empty routine
+      CHARACTER(len=3) ::   cdtype
+      REAL, DIMENSION(:,:,:) ::   pgu, pgv   ! tracer gradient at pstep levels
+      REAL, DIMENSION(:,:,:,:) ::   ptb, pta
+      WRITE(*,*) 'tra_ldf_iso_grif: You should not have seen this print! error?', kt, cdtype,    &
+         &                  pgu(1,1,1), pgv(1,1,1), ptb(1,1,1,1), pta(1,1,1,1), kjpt, pahtb0
+   END SUBROUTINE tra_ldf_iso_grif
+#endif
+
+   !!==============================================================================
+END MODULE traldf_iso_grif
Index: trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90	(revision 2528)
@@ -2,6 +2,15 @@
    !!==============================================================================
    !!                       ***  MODULE  traldf_lap  ***
-   !! Ocean active tracers:  horizontal component of the lateral tracer mixing trend
+   !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend
    !!==============================================================================
+   !! History :  OPA  !  87-06  (P. Andrich, D. L Hostis)  Original code
+   !!                 !  91-11  (G. Madec)
+   !!                 !  95-11  (G. Madec)  suppress volumetric scale factors
+   !!                 !  96-01  (G. Madec)  statement function for e3
+   !!            NEMO !  02-06  (G. Madec)  F90: Free form and module
+   !!            1.0  !  04-08  (C. Talandier) New trends organization
+   !!                 !  05-11  (G. Madec)  add zps case
+   !!            3.0  !  10-06  (C. Ethe, G. Madec) Merge TRA-TRC
+   !!----------------------------------------------------------------------
 
    !!----------------------------------------------------------------------
@@ -9,20 +18,17 @@
    !!                 using a iso-level harmonic (laplacien) operator.
    !!----------------------------------------------------------------------
-   !! * Modules used
    USE oce             ! ocean dynamics and active tracers
    USE dom_oce         ! ocean space and time domain
    USE ldftra_oce      ! ocean active tracers: lateral physics
-   USE trdmod          ! ocean active tracers trends 
-   USE trdmod_oce      ! ocean variables trends
    USE in_out_manager  ! I/O manager
    USE diaptr          ! poleward transport diagnostics
-   USE prtctl          ! Print control
-
+   USE trc_oce         ! share passive tracers/Ocean variables
 
    IMPLICIT NONE
    PRIVATE
 
-   !! * Routine accessibility
-   PUBLIC tra_ldf_lap  ! routine called by step.F90
+   PUBLIC   tra_ldf_lap   ! routine called by step.F90
+
+   REAL(wp), DIMENSION(jpi,jpj) ::   e1ur, e2vr   ! scale factor coefficients
 
    !! * Substitutions
@@ -31,12 +37,12 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-   
 CONTAINS
 
-   SUBROUTINE tra_ldf_lap( kt )
+   SUBROUTINE tra_ldf_lap( kt, cdtype, pgu, pgv,      &
+      &                                ptb, pta, kjpt ) 
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_ldf_lap  ***
@@ -47,134 +53,91 @@
       !! ** Method  :   Second order diffusive operator evaluated using before
       !!      fields (forward time scheme). The horizontal diffusive trends of 
-      !!      temperature (idem for salinity) is given by:
+      !!      the tracer is given by:
       !!          difft = 1/(e1t*e2t*e3t) {  di-1[ aht e2u*e3u/e1u di(tb) ]
       !!                                   + dj-1[ aht e1v*e3v/e2v dj(tb) ] }
-      !!     Note: key_zco defined, the e3t=e3u=e3v, the trend becomes:  
-      !!          difft = 1/(e1t*e2t) {  di-1[ aht e2u/e1u di(tb) ]
-      !!                               + dj-1[ aht e1v/e2v dj(tb) ] }
-      !!      Add this trend to the general tracer trend (ta,sa):
-      !!          (ta,sa) = (ta,sa) + ( difft , diffs )
+      !!      Add this trend to the general tracer trend pta :
+      !!          pta = pta + difft
       !!
-      !! ** Action  : - Update (ta,sa) arrays with the before iso-level 
+      !! ** Action  : - Update pta arrays with the before iso-level 
       !!                harmonic mixing trend.
+      !!----------------------------------------------------------------------
+      USE oce         , ztu => ua   ! use ua as workspace
+      USE oce         , ztv => va   ! use va as workspace
       !!
-      !! History :
-      !!   1.0  !  87-06  (P. Andrich, D. L Hostis)  Original code
-      !!        !  91-11  (G. Madec)
-      !!        !  95-11  (G. Madec)  suppress volumetric scale factors
-      !!        !  96-01  (G. Madec)  statement function for e3
-      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
-      !!   9.0  !  04-08  (C. Talandier) New trends organization
-      !!        !  05-11  (G. Madec)  add zps case
-      !!----------------------------------------------------------------------
-      USE oce              , ztu => ua,  &  ! use ua as workspace
-         &                   zsu => va      ! use va as workspace
-
-      !! * Arguments
-      INTEGER, INTENT( in ) ::   kt       ! ocean time-step index
-      
-      !! * Local save
-      REAL(wp), DIMENSION(jpi,jpj), SAVE ::   &
-         ze1ur, ze2vr, zbtr2              ! scale factor coefficients
-      
-      !! * Local declarations
-      INTEGER ::   ji, jj, jk             ! dummy loop indices
-      INTEGER ::   iku, ikv               ! temporary integers
-      REAL(wp) ::   &
-         zabe1, zta,                   &  ! temporary scalars
-         zabe2, zsa, zbtr                 !    "         "
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
-         ztv, zsv                         ! 3D workspace
+      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
+      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
+      !!
+      INTEGER  ::   ji, jj, jk, jn       ! dummy loop indices
+      INTEGER  ::   iku, ikv             ! local integers
+      REAL(wp) ::   zabe1, zabe2, zbtr   ! local scalars
       !!----------------------------------------------------------------------
       
-      IF( kt == nit000 ) THEN
+      IF( kt == nit000 )  THEN
          IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion'
+         IF(lwp) WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion on ', cdtype
          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ '
-         ze1ur(:,:) = e2u(:,:) / e1u(:,:)
-         ze2vr(:,:) = e1v(:,:) / e2v(:,:)
-         zbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) )
+         e1ur(:,:) = e2u(:,:) / e1u(:,:)
+         e2vr(:,:) = e1v(:,:) / e2v(:,:)
       ENDIF
-      
-      !                                                  ! =============
-      DO jk = 1, jpkm1                                   ! Vertical slab
-         !                                               ! =============
-         ! 1. First derivative (gradient)
-         ! -------------------
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-#if defined key_zco
-               zabe1 = fsahtu(ji,jj,jk) * umask(ji,jj,jk) * ze1ur(ji,jj)
-               zabe2 = fsahtv(ji,jj,jk) * vmask(ji,jj,jk) * ze2vr(ji,jj)
-#else
-               zabe1 = fsahtu(ji,jj,jk) * umask(ji,jj,jk) * ze1ur(ji,jj) * fse3u(ji,jj,jk)
-               zabe2 = fsahtv(ji,jj,jk) * vmask(ji,jj,jk) * ze2vr(ji,jj) * fse3v(ji,jj,jk)
-#endif
-               ztu(ji,jj,jk) = zabe1 * ( tb(ji+1,jj  ,jk) - tb(ji,jj,jk) )
-               zsu(ji,jj,jk) = zabe1 * ( sb(ji+1,jj  ,jk) - sb(ji,jj,jk) )
-               ztv(ji,jj,jk) = zabe2 * ( tb(ji  ,jj+1,jk) - tb(ji,jj,jk) )
-               zsv(ji,jj,jk) = zabe2 * ( sb(ji  ,jj+1,jk) - sb(ji,jj,jk) )
-            END DO  
-         END DO  
-         IF( ln_zps ) THEN      ! set gradient at partial step level
+
+      !                                                          ! =========== !
+      DO jn = 1, kjpt                                            ! tracer loop !
+         !                                                       ! =========== !    
+         DO jk = 1, jpkm1                                            ! slab loop
+            !                                           
+            ! 1. First derivative (gradient)
+            ! -------------------
             DO jj = 1, jpjm1
                DO ji = 1, fs_jpim1   ! vector opt.
-                  ! last level
-                  iku = MIN ( mbathy(ji,jj), mbathy(ji+1,jj  ) ) - 1
-                  ikv = MIN ( mbathy(ji,jj), mbathy(ji  ,jj+1) ) - 1
-                  IF( iku == jk ) THEN
-                     zabe1 = fsahtu(ji,jj,iku) * umask(ji,jj,iku) * ze1ur(ji,jj) * fse3u(ji,jj,iku)
-                     ztu(ji,jj,jk) = zabe1 * gtu(ji,jj)
-                     zsu(ji,jj,jk) = zabe1 * gsu(ji,jj)
-                  ENDIF
-                  IF( ikv == jk ) THEN
-                     zabe2 = fsahtv(ji,jj,ikv) * vmask(ji,jj,ikv) * ze2vr(ji,jj) * fse3v(ji,jj,ikv)
-                     ztv(ji,jj,jk) = zabe2 * gtv(ji,jj)
-                     zsv(ji,jj,jk) = zabe2 * gsv(ji,jj)
-                  ENDIF
+                  zabe1 = fsahtu(ji,jj,jk) * umask(ji,jj,jk) * e1ur(ji,jj) * fse3u(ji,jj,jk)
+                  zabe2 = fsahtv(ji,jj,jk) * vmask(ji,jj,jk) * e2vr(ji,jj) * fse3v(ji,jj,jk)
+                  ztu(ji,jj,jk) = zabe1 * ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) )
+                  ztv(ji,jj,jk) = zabe2 * ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )
                END DO
             END DO
-         ENDIF
+            IF( ln_zps ) THEN      ! set gradient at partial step level
+               DO jj = 1, jpjm1
+                  DO ji = 1, fs_jpim1   ! vector opt.
+                     ! last level
+                     iku = mbku(ji,jj)
+                     ikv = mbkv(ji,jj)
+                     IF( iku == jk ) THEN
+                        zabe1 = fsahtu(ji,jj,iku) * umask(ji,jj,iku) * e1ur(ji,jj) * fse3u(ji,jj,iku)
+                        ztu(ji,jj,jk) = zabe1 * pgu(ji,jj,jn)
+                     ENDIF
+                     IF( ikv == jk ) THEN
+                        zabe2 = fsahtv(ji,jj,ikv) * vmask(ji,jj,ikv) * e2vr(ji,jj) * fse3v(ji,jj,ikv)
+                        ztv(ji,jj,jk) = zabe2 * pgv(ji,jj,jn)
+                     ENDIF
+                  END DO
+               END DO
+            ENDIF
          
          
-         ! 2. Second derivative (divergence)
-         ! --------------------
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-#if defined key_zco
-               zbtr = zbtr2(ji,jj)
-#else
-               zbtr = zbtr2(ji,jj) / fse3t(ji,jj,jk)
-#endif
-               ! horizontal diffusive trends
-               zta = zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)   &
-                  &          + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  )
-               zsa = zbtr * (  zsu(ji,jj,jk) - zsu(ji-1,jj,jk)   &
-                  &          + zsv(ji,jj,jk) - zsv(ji,jj-1,jk)  )
-               ! add it to the general tracer trends
-               ta(ji,jj,jk) = ta(ji,jj,jk) + zta
-               sa(ji,jj,jk) = sa(ji,jj,jk) + zsa
-            END DO  
-         END DO  
-         !                                               ! =============
-      END DO                                             !  End of slab  
-      !                                                  ! =============
-
-      ! "zonal" mean lateral diffusive heat and salt transport 
-      IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN
-         IF( lk_zco ) THEN   ! z-coordinate - full step (1D arrays)
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                    ztv(ji,jj,jk) = ztv(ji,jj,jk) * fse3v(ji,jj,jk)
-                    zsv(ji,jj,jk) = zsv(ji,jj,jk) * fse3v(ji,jj,jk)
-                  END DO
+            ! 2. Second derivative (divergence) added to the general tracer trends
+            ! ---------------------------------------------------------------------
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = 1.0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ! horizontal diffusive trends added to the general tracer trends
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)   &
+                     &                                          + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  )
                END DO
             END DO
+            !
+         END DO                                             !  End of slab  
+         !
+         ! "Poleward" diffusive heat or salt transports
+         IF( cdtype == 'TRA' .AND. ln_diaptr .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(:,:,:) )
          ENDIF
-         pht_ldf(:) = ptr_vj( ztv(:,:,:) )
-         pst_ldf(:) = ptr_vj( zsv(:,:,:) )
-      ENDIF
-
+         !                                                  ! ==================
+      END DO                                                ! end of tracer loop
+      !                                                     ! ==================
    END SUBROUTINE tra_ldf_lap
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90	(revision 2528)
@@ -8,4 +8,5 @@
    !!   NEMO     1.0  ! 2002-06  (G. Madec)  free form F90
    !!            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
    !!----------------------------------------------------------------------
 
@@ -16,6 +17,6 @@
    USE dom_oce         ! ocean space and time domain
    USE zdf_oce         ! ocean vertical physics
-   USE trdmod          ! ocean active tracer trends
-   USE trdmod_oce      ! ocean variables trends
+   USE trdmod_oce      ! ocean active tracer trends
+   USE trdtra      ! ocean active tracer trends
    USE eosbn2          ! equation of state (eos routine) 
    USE lbclnk          ! lateral boundary conditions (or mpp link)
@@ -30,9 +31,8 @@
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
@@ -55,7 +55,4 @@
       !! References : Madec, et al., 1991, JPO, 21, 9, 1349-1371.
       !!----------------------------------------------------------------------
-      USE oce, ONLY :    ztrdt => ua   ! use ua as 3D workspace   
-      USE oce, ONLY :    ztrds => va   ! use va as 3D workspace   
-      !! 
       INTEGER, INTENT(in) ::   kt   ! ocean time-step index
       !!
@@ -68,4 +65,5 @@
       REAL(wp), DIMENSION(jpi,jpk)     ::   zwx, zwy, zwz   ! 2D arrays
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zrhop           ! 3D arrays
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt, ztrds
       !!----------------------------------------------------------------------
 
@@ -75,10 +73,9 @@
          inpci = 0
 
-         CALL eos( ta, sa, rhd, zrhop )         ! Potential density
-
-
-         IF( l_trdtra )   THEN                  ! Save ta and sa trends
-            ztrdt(:,:,:) = ta(:,:,:) 
-            ztrds(:,:,:) = sa(:,:,:) 
+         CALL eos( tsa, rhd, zrhop )         ! Potential density
+
+         IF( l_trdtra )   THEN                    !* Save ta and sa trends
+            ALLOCATE( ztrdt(jpi,jpj,jpk) )  ;    ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
+            ALLOCATE( ztrds(jpi,jpj,jpk) )  ;    ztrds(:,:,:) = tsa(:,:,:,jp_sal)
          ENDIF
 
@@ -133,5 +130,5 @@
                   IF( zwy(ji,1) /= 0.e0 ) THEN
                      !
-                     ikbot = mbathy(ji,jj)      ! ikbot: ocean bottom level
+                     ikbot = mbkt(ji,jj)        ! ikbot: ocean bottom T-level
                      !
                      DO jiter = 1, jpk          ! vertical iteration
@@ -142,5 +139,5 @@
 220                     CONTINUE
                         ik = ik + 1
-                        IF( ik >= ikbot-1 ) GO TO 200
+                        IF( ik >= ikbot ) GO TO 200
                         zwx(ji,ik) = zrhop(ji,jj,ik) - zrhop(ji,jj,ik+1)
                         IF( zwx(ji,ik) <= 0.e0 ) GO TO 220
@@ -151,6 +148,6 @@
                         !
                         ze3tot= fse3t(ji,jj,ikup)
-                        zta   = ta   (ji,jj,ikup)
-                        zsa   = sa   (ji,jj,ikup)
+                        zta   = tsa  (ji,jj,ikup,jp_tem)
+                        zsa   = tsa  (ji,jj,ikup,jp_sal)
                         zraua = zrhop(ji,jj,ikup)
                         !
@@ -162,6 +159,6 @@
                            ze3dwn =  fse3t(ji,jj,jkdown)
                            ze3tot =  ze3tot + ze3dwn
-                           zta   = ( zta*(ze3tot-ze3dwn) + ta(ji,jj,jkdown)*ze3dwn )/ze3tot
-                           zsa   = ( zsa*(ze3tot-ze3dwn) + sa(ji,jj,jkdown)*ze3dwn )/ze3tot
+                           zta   = ( zta*(ze3tot-ze3dwn) + tsa(ji,jj,jkdown,jp_tem)*ze3dwn )/ze3tot
+                           zsa   = ( zsa*(ze3tot-ze3dwn) + tsa(ji,jj,jkdown,jp_sal)*ze3dwn )/ze3tot
                            zraua = ( zraua*(ze3tot-ze3dwn) + zrhop(ji,jj,jkdown)*ze3dwn )/ze3tot
                            inpci = inpci+1
@@ -171,12 +168,12 @@
                         !
                         DO jkp = ikup, ikdown-1
-                           ta(ji,jj,jkp) = zta
-                           sa(ji,jj,jkp) = zsa
-                           zrhop(ji,jj,jkp) = zraua
+                           tsa  (ji,jj,jkp,jp_tem) = zta
+                           tsa  (ji,jj,jkp,jp_sal) = zsa
+                           zrhop(ji,jj,jkp       ) = zraua
                         END DO
                         IF (ikdown == ikbot-1 .AND. zraua >= zrhop(ji,jj,ikdown) ) THEN
-                           ta(ji,jj,ikdown) = zta
-                           sa(ji,jj,ikdown) = zsa
-                           zrhop(ji,jj,ikdown) = zraua
+                           tsa  (ji,jj,jkp,jp_tem) = zta
+                           tsa  (ji,jj,jkp,jp_sal) = zsa
+                           zrhop(ji,jj,ikdown    ) = zraua
                         ENDIF
                      END DO
@@ -191,13 +188,15 @@
          ! 
          IF( l_trdtra )   THEN         ! save the Non penetrative mixing trends for diagnostic
-            ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:)
-            ztrds(:,:,:) = sa(:,:,:) - ztrds(:,:,:)
-            CALL trd_mod(ztrdt, ztrds, jptra_trd_npc, 'TRA', kt)
+            ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
+            ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:)
+            CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_npc, ztrdt )
+            CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_npc, ztrds )
+            DEALLOCATE( ztrdt )      ;     DEALLOCATE( ztrds ) 
          ENDIF
       
          ! Lateral boundary conditions on ( ta, sa )   ( Unchanged sign)
          ! ------------------------------============
-         CALL lbc_lnk( ta, 'T', 1. )
-         CALL lbc_lnk( sa, 'T', 1. )
+         CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. )
+         CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. )
       
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90	(revision 2528)
@@ -15,44 +15,55 @@
    !!            3.0  !  2008-06  (G. Madec)  time stepping always done in trazdf
    !!            3.1  !  2009-02  (G. Madec, R. Benshila)  re-introduce the vvl option
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   tra_nxt       : time stepping on temperature and salinity
-   !!   tra_nxt_fix   : time stepping on temperature and salinity : fixed    volume case
-   !!   tra_nxt_vvl   : time stepping on temperature and salinity : variable volume case
+   !!            3.3  !  2010-04  (M. Leclair, G. Madec)  semi-implicit hpg with asselin filter + modified LF-RA
+   !!             -   !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_nxt       : time stepping on tracers
+   !!   tra_nxt_fix   : time stepping on tracers : fixed    volume case
+   !!   tra_nxt_vvl   : time stepping on tracers : variable volume case
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and tracers variables
    USE dom_oce         ! ocean space and time domain variables 
+   USE sbc_oce         ! surface boundary condition: ocean
    USE zdf_oce         ! ???
    USE domvvl          ! variable volume
    USE dynspg_oce      ! surface     pressure gradient variables
    USE dynhpg          ! hydrostatic pressure gradient 
-   USE trdmod_oce      ! ocean variables trends
-   USE trdmod          ! ocean active tracers trends 
+   USE trdmod_oce      ! ocean space and time domain variables 
+   USE trdtra          ! ocean active tracers trends 
    USE phycst
+   USE obc_oce
    USE obctra          ! open boundary condition (obc_tra routine)
-   USE bdytra          ! Unstructured open boundary condition (bdy_tra routine)
+   USE bdy_par         ! Unstructured open boundary condition (bdy_tra_frs routine)
+   USE bdytra          ! Unstructured open boundary condition (bdy_tra_frs routine)
    USE in_out_manager  ! I/O manager
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
    USE prtctl          ! Print control
+   USE traqsr          ! penetrative solar radiation (needed for nksr)
+   USE traswp          ! swap array
+   USE obc_oce 
+#if defined key_agrif
    USE agrif_opa_update
    USE agrif_opa_interp
-   USE obc_oce 
+#endif
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   tra_nxt    ! routine called by step.F90
-
-   REAL(wp), DIMENSION(jpk) ::   r2dt_t   ! vertical profile time step, =2*rdttra (leapfrog) or =rdttra (Euler)
+   PUBLIC   tra_nxt       ! routine called by step.F90
+   PUBLIC   tra_nxt_fix   ! to be used in trcnxt
+   PUBLIC   tra_nxt_vvl   ! to be used in trcnxt
+
+   REAL(wp)                 ::   rbcp            ! Brown & Campana parameters for semi-implicit hpg
+   REAL(wp), DIMENSION(jpk) ::   r2dt   ! vertical profile time step, =2*rdttra (leapfrog) or =rdttra (Euler)
 
    !! * Substitutions
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
-   !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
+   !! NEMO/OPA 3.3 , NEMO-Consortium (2010) 
+   !! $Id $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
@@ -81,11 +92,9 @@
       !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T)
       !!----------------------------------------------------------------------
-      USE oce, ONLY :    ztrdt => ua   ! use ua as 3D workspace   
-      USE oce, ONLY :    ztrds => va   ! use va as 3D workspace   
-      !!
       INTEGER, INTENT(in) ::   kt    ! ocean time-step index
       !!
-      INTEGER  ::   jk    ! dummy loop indices
-      REAL(wp) ::   zfact ! temporary scalars
+      INTEGER  ::   jk, jn    ! dummy loop indices
+      REAL(wp) ::   zfact     ! local scalars
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt, ztrds
       !!----------------------------------------------------------------------
 
@@ -94,60 +103,82 @@
          IF(lwp) WRITE(numout,*) 'tra_nxt : achieve the time stepping by Asselin filter and array swap'
          IF(lwp) WRITE(numout,*) '~~~~~~~'
+         !
+         rbcp    = 0.25 * (1. + atfp) * (1. + atfp) * ( 1. - atfp)       ! Brown & Campana parameter for semi-implicit hpg
       ENDIF
 
       ! Update after tracer on domain lateral boundaries
       ! 
-      CALL lbc_lnk( ta, 'T', 1. )      ! local domain boundaries  (T-point, unchanged sign)
-      CALL lbc_lnk( sa, 'T', 1. )
-      !
-#if defined key_obc
+      CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. )      ! local domain boundaries  (T-point, unchanged sign)
+      CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. )
+      !
+#if defined key_obc || defined key_bdy || defined key_agrif
+      CALL tra_unswap
+#endif
+
+#if defined key_obc 
       IF( lk_obc )   CALL obc_tra( kt )  ! OBC open boundaries
 #endif
-#if defined key_bdy
-      CALL bdy_tra( kt )               ! BDY open boundaries
+#if defined key_bdy 
+      IF( lk_bdy )   CALL bdy_tra_frs( kt )  ! BDY open boundaries
 #endif
 #if defined key_agrif
-      CALL Agrif_tra                   ! AGRIF zoom boundaries
+      CALL Agrif_tra                     ! AGRIF zoom boundaries
+#endif
+
+#if defined key_obc || defined key_bdy || defined key_agrif
+      CALL tra_swap
 #endif
  
       ! set time step size (Euler/Leapfrog)
-      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   r2dt_t(:) =     rdttra(:)      ! at nit000             (Euler)
-      ELSEIF( kt <= nit000 + 1 )           THEN   ;   r2dt_t(:) = 2.* rdttra(:)      ! at nit000 or nit000+1 (Leapfrog)
+      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   r2dt(:) =     rdttra(:)      ! at nit000             (Euler)
+      ELSEIF( kt <= nit000 + 1 )           THEN   ;   r2dt(:) = 2.* rdttra(:)      ! at nit000 or nit000+1 (Leapfrog)
       ENDIF
 
       ! trends computation initialisation
-      IF( l_trdtra ) THEN              ! store now fields before applying the Asselin filter
-         ztrdt(:,:,:) = tn(:,:,:)      
-         ztrds(:,:,:) = sn(:,:,:)
-      ENDIF
-
-      ! Leap-Frog + Asselin filter time stepping
-      IF( lk_vvl )   THEN   ;   CALL tra_nxt_vvl( kt )      ! variable volume level (vvl)
-      ELSE                  ;   CALL tra_nxt_fix( kt )      ! fixed    volume level
-      ENDIF
+      IF( l_trdtra )   THEN                    ! store now fields before applying the Asselin filter
+         ALLOCATE( ztrdt(jpi,jpj,jpk) )   ;    ztrdt(:,:,:) = tsn(:,:,:,jp_tem) 
+         ALLOCATE( ztrds(jpi,jpj,jpk) )   ;    ztrds(:,:,:) = tsn(:,:,:,jp_sal)
+      ENDIF
+
+      IF( neuler == 0 .AND. kt == nit000 ) THEN       ! Euler time-stepping at first time-step (only swap)
+         DO jn = 1, jpts
+            DO jk = 1, jpkm1
+               tsn(:,:,jk,jn) = tsa(:,:,jk,jn)    
+            END DO
+         END DO
+      ELSE                                            ! Leap-Frog + Asselin filter time stepping
+         !
+         IF( lk_vvl )  THEN   ;   CALL tra_nxt_vvl( kt, 'TRA', tsb, tsn, tsa, jpts )  ! variable volume level (vvl)     
+         ELSE                 ;   CALL tra_nxt_fix( kt, 'TRA', tsb, tsn, tsa, jpts )  ! fixed    volume level 
+         ENDIF
+      ENDIF 
 
 #if defined key_agrif
       ! Update tracer at AGRIF zoom boundaries
+      CALL tra_unswap
       IF( .NOT.Agrif_Root() )    CALL Agrif_Update_Tra( kt )      ! children only
+      CALL tra_swap
 #endif      
 
       ! trends computation
-      IF( l_trdtra ) THEN              ! trend of the Asselin filter (tb filtered - tb)/dt     
+      IF( l_trdtra ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt     
          DO jk = 1, jpkm1
-            zfact = 1.e0 / r2dt_t(jk)             
-            ztrdt(:,:,jk) = ( tb(:,:,jk) - ztrdt(:,:,jk) ) * zfact
-            ztrds(:,:,jk) = ( sb(:,:,jk) - ztrds(:,:,jk) ) * zfact
+            zfact = 1.e0 / r2dt(jk)             
+            ztrdt(:,:,jk) = ( tsb(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact
+            ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact
          END DO
-         CALL trd_mod( ztrdt, ztrds, jptra_trd_atf, 'TRA', kt )
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_atf, ztrdt )
+         CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_atf, ztrds )
+         DEALLOCATE( ztrdt )      ;     DEALLOCATE( ztrds ) 
       END IF
 
       !                        ! control print
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tn, clinfo1=' nxt  - Tn: ', mask1=tmask,   &
-         &                       tab3d_2=sn, clinfo2=       ' Sn: ', mask2=tmask )
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' nxt  - Tn: ', mask1=tmask,   &
+         &                       tab3d_2=tsn(:,:,:,jp_sal), clinfo2=       ' Sn: ', mask2=tmask )
       !
    END SUBROUTINE tra_nxt
 
 
-   SUBROUTINE tra_nxt_fix( kt )
+   SUBROUTINE tra_nxt_fix( kt, cdtype, ptb, ptn, pta, kjpt )
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE tra_nxt_fix  ***
@@ -162,8 +193,9 @@
       !!              - swap tracer fields to prepare the next time_step.
       !!                This can be summurized for tempearture as:
-      !!             ztm = (ta+2tn+tb)/4       ln_dynhpg_imp = T
-      !!             ztm = 0                   otherwise
+      !!             ztm = tn + rbcp * [ta -2 tn + tb ]       ln_dynhpg_imp = T
+      !!             ztm = 0                                   otherwise
+      !!                   with rbcp=1/4 * (1-atfp^4) / (1-atfp)
       !!             tb  = tn + atfp*[ tb - 2 tn + ta ]
-      !!             tn  = ta 
+      !!             tn  = ta  
       !!             ta  = ztm       (NB: reset to 0 after eos_bn2 call)
       !!
@@ -171,12 +203,17 @@
       !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T)
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
-      !!
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp) ::   ztm, ztf     ! temporary scalars
-      REAL(wp) ::   zsm, zsf     !    -         -
-      !!----------------------------------------------------------------------
-
-      IF( kt == nit000 ) THEN
+      INTEGER         , INTENT(in   )                               ::  kt       ! ocean 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  ::   ji, jj, jk, jn   ! dummy loop indices
+      LOGICAL  ::   ll_tra_hpg       ! local logical
+      REAL(wp) ::   ztn, ztd         ! local scalars
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 )  THEN
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) 'tra_nxt_fix : time stepping'
@@ -184,68 +221,30 @@
       ENDIF
       !
-      !                                              ! ----------------------- !
-      IF( ln_dynhpg_imp ) THEN                       ! semi-implicite hpg case !
-         !                                           ! ----------------------- !
+      IF( cdtype == 'TRA' )  THEN   ;   ll_tra_hpg = ln_dynhpg_imp    ! active  tracers case  and  semi-implicit hpg    
+      ELSE                          ;   ll_tra_hpg = .FALSE.          ! passive tracers case or NO semi-implicit hpg
+      ENDIF
+      !
+      DO jn = 1, kjpt
          !
-         IF( neuler == 0 .AND. kt == nit000 ) THEN        ! Euler time-stepping at first time-step
-            DO jk = 1, jpkm1                              ! (only swap)
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     tn(ji,jj,jk) = ta(ji,jj,jk)                                           ! tb <-- tn
-                     sn(ji,jj,jk) = sa(ji,jj,jk)
-                  END DO
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ztn = ptn(ji,jj,jk,jn)                                    
+                  ztd = pta(ji,jj,jk,jn) - 2. * ztn + ptb(ji,jj,jk,jn)      !  time laplacian on tracers
+                  !
+                  ptb(ji,jj,jk,jn) = ztn + atfp * ztd                       ! ptb <-- filtered ptn 
+                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)                       ! ptn <-- pta
+                  !
+                  IF( ll_tra_hpg )   pta(ji,jj,jk,jn) = ztn + rbcp * ztd    ! pta <-- Brown & Campana average
                END DO
-            END DO
-         ELSE                                             ! general case (Leapfrog + Asselin filter
-            DO jk = 1, jpkm1
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     ztm = 0.25 * ( ta(ji,jj,jk) + 2.* tn(ji,jj,jk) + tb(ji,jj,jk) )       ! mean t
-                     zsm = 0.25 * ( sa(ji,jj,jk) + 2.* sn(ji,jj,jk) + sb(ji,jj,jk) )
-                     ztf = atfp * ( ta(ji,jj,jk) - 2.* tn(ji,jj,jk) + tb(ji,jj,jk) )       ! Asselin filter on t 
-                     zsf = atfp * ( sa(ji,jj,jk) - 2.* sn(ji,jj,jk) + sb(ji,jj,jk) )
-                     tb(ji,jj,jk) = tn(ji,jj,jk) + ztf                                     ! tb <-- filtered tn 
-                     sb(ji,jj,jk) = sn(ji,jj,jk) + zsf
-                     tn(ji,jj,jk) = ta(ji,jj,jk)                                           ! tn <-- ta
-                     sn(ji,jj,jk) = sa(ji,jj,jk)
-                     ta(ji,jj,jk) = ztm                                                    ! ta <-- mean t
-                     sa(ji,jj,jk) = zsm
-                  END DO
-               END DO
-            END DO
-         ENDIF
-         !                                           ! ----------------------- !
-      ELSE                                           !    explicit hpg case    !
-         !                                           ! ----------------------- !
+           END DO
+         END DO
          !
-         IF( neuler == 0 .AND. kt == nit000 ) THEN        ! Euler time-stepping at first time-step
-            DO jk = 1, jpkm1
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     tn(ji,jj,jk) = ta(ji,jj,jk)                                           ! tn <-- ta
-                     sn(ji,jj,jk) = sa(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
-         ELSE                                             ! general case (Leapfrog + Asselin filter
-            DO jk = 1, jpkm1
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     ztf = atfp * ( ta(ji,jj,jk) - 2.* tn(ji,jj,jk) + tb(ji,jj,jk) )       ! Asselin filter on t 
-                     zsf = atfp * ( sa(ji,jj,jk) - 2.* sn(ji,jj,jk) + sb(ji,jj,jk) )
-                     tb(ji,jj,jk) = tn(ji,jj,jk) + ztf                                     ! tb <-- filtered tn 
-                     sb(ji,jj,jk) = sn(ji,jj,jk) + zsf
-                     tn(ji,jj,jk) = ta(ji,jj,jk)                                           ! tn <-- ta
-                     sn(ji,jj,jk) = sa(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
-         ENDIF
-      ENDIF
+      END DO
       !
    END SUBROUTINE tra_nxt_fix
 
 
-   SUBROUTINE tra_nxt_vvl( kt )
+   SUBROUTINE tra_nxt_vvl( kt, cdtype, ptb, ptn, pta, kjpt )
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE tra_nxt_vvl  ***
@@ -260,7 +259,7 @@
       !!              - swap tracer fields to prepare the next time_step.
       !!                This can be summurized for tempearture as:
-      !!             ztm = (e3t_a*ta+2*e3t_n*tn+e3t_b*tb)   ln_dynhpg_imp = T
-      !!                  /(e3t_a   +2*e3t_n   +e3t_b   )    
-      !!             ztm = 0                                otherwise
+      !!             ztm = ( e3t_n*tn + rbcp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )   ln_dynhpg_imp = T
+      !!                  /( e3t_n    + rbcp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )   
+      !!             ztm = 0                                                       otherwise
       !!             tb  = ( e3t_n*tn + atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )
       !!                  /( e3t_n    + atfp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )
@@ -271,11 +270,18 @@
       !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T)
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
+      INTEGER         , INTENT(in   )                               ::  kt       ! ocean 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  ::   ji, jj, jk             ! dummy loop indices
-      REAL(wp) ::   ztm , ztc_f , ztf , ztca, ztcn, ztcb   ! temporary scalar
-      REAL(wp) ::   zsm , zsc_f , zsf , zsca, zscn, zscb   !    -         -
-      REAL(wp) ::   ze3mr, ze3fr                           !    -         -
-      REAL(wp) ::   ze3t_b, ze3t_n, ze3t_a, ze3t_f         !    -         -
+      LOGICAL  ::   ll_tra, ll_tra_hpg, ll_traqsr   ! local logical
+      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices
+      REAL(wp) ::   ztc_a , ztc_n , ztc_b       ! local scalar
+      REAL(wp) ::   ztc_f , ztc_d               !   -      -
+      REAL(wp) ::   ze3t_b, ze3t_n, ze3t_a      !   -      -
+      REAL(wp) ::   ze3t_f, ze3t_d              !   -      -
+      REAL(wp) ::   zfact1, zfact2              !   -      -
       !!----------------------------------------------------------------------
 
@@ -285,101 +291,55 @@
          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
       ENDIF
-
-      !                                              ! ----------------------- !
-      IF( ln_dynhpg_imp ) THEN                       ! semi-implicite hpg case !
-         !                                           ! ----------------------- !
-         !
-         IF( neuler == 0 .AND. kt == nit000 ) THEN        ! Euler time-stepping at first time-step
-            DO jk = 1, jpkm1                              ! (only swap)
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     tn(ji,jj,jk) = ta(ji,jj,jk)                    ! tn <-- ta
-                     sn(ji,jj,jk) = sa(ji,jj,jk)
-                  END DO
+      !
+      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
+      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
+      ENDIF
+      !
+      DO jn = 1, kjpt      
+         DO jk = 1, jpkm1
+            zfact1 = atfp * rdttra(jk)
+            zfact2 = zfact1 / rau0
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ze3t_b = fse3t_b(ji,jj,jk)
+                  ze3t_n = fse3t_n(ji,jj,jk)
+                  ze3t_a = fse3t_a(ji,jj,jk)
+                  !                                         ! tracer content at Before, now and after
+                  ztc_b  = ptb(ji,jj,jk,jn) * ze3t_b
+                  ztc_n  = ptn(ji,jj,jk,jn) * ze3t_n
+                  ztc_a  = pta(ji,jj,jk,jn) * ze3t_a
+                  !
+                  ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b
+                  ztc_d  = ztc_a  - 2. * ztc_n  + ztc_b
+                  !
+                  ze3t_f = ze3t_n + atfp * ze3t_d
+                  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) )
+                  ENDIF
+                  IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )   &     ! solar penetration (temperature only)
+                     &     ztc_f  = ztc_f  - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) ) 
+
+                   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
-         ELSE
-            DO jk = 1, jpkm1
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     ze3t_b = fse3t_b(ji,jj,jk)
-                     ze3t_n = fse3t_n(ji,jj,jk)
-                     ze3t_a = fse3t_a(ji,jj,jk)
-                     !                                         ! tracer content at Before, now and after
-                     ztcb = tb(ji,jj,jk) *  ze3t_b   ;   zscb = sb(ji,jj,jk) * ze3t_b
-                     ztcn = tn(ji,jj,jk) *  ze3t_n   ;   zscn = sn(ji,jj,jk) * ze3t_n
-                     ztca = ta(ji,jj,jk) *  ze3t_a   ;   zsca = sa(ji,jj,jk) * ze3t_a
-                     !
-                     !                                         ! Asselin filter on thickness and tracer content
-                     ze3t_f = atfp * ( ze3t_a - 2.* ze3t_n + ze3t_b )
-                     ztc_f  = atfp * ( ztca   - 2.* ztcn   + ztcb   ) 
-                     zsc_f  = atfp * ( zsca   - 2.* zscn   + zscb   ) 
-                     !
-                     !                                         ! filtered tracer including the correction 
-                     ze3fr = 1.e0  / ( ze3t_n + ze3t_f )
-                     ztf   = ze3fr * ( ztcn   + ztc_f  )
-                     zsf   = ze3fr * ( zscn   + zsc_f  )
-                     !                                         ! mean thickness and tracer
-                     ze3mr = 1.e0  / ( ze3t_a + 2.* ze3t_n + ze3t_b )
-                     ztm   = ze3mr * ( ztca   + 2.* ztcn   + ztcb   )
-                     zsm   = ze3mr * ( zsca   + 2.* zscn   + zscb   )
-!!gm mean e3t have to be saved and used in dynhpg  or it can be recomputed in dynhpg !!
-!!gm                 e3t_m(ji,jj,jk) = 0.25 / ze3mr
-                     !                                         ! swap of arrays
-                     tb(ji,jj,jk) = ztf                             ! tb <-- tn + filter
-                     sb(ji,jj,jk) = zsf
-                     tn(ji,jj,jk) = ta(ji,jj,jk)                    ! tn <-- ta
-                     sn(ji,jj,jk) = sa(ji,jj,jk)
-                     ta(ji,jj,jk) = ztm                             ! ta <-- mean t
-                     sa(ji,jj,jk) = zsm
-                  END DO
-               END DO
-            END DO
-         ENDIF
-         !                                           ! ----------------------- !
-      ELSE                                           !    explicit hpg case    !
-         !                                           ! ----------------------- !
-         !
-         IF( neuler == 0 .AND. kt == nit000 ) THEN        ! case of Euler time-stepping at first time-step
-            DO jk = 1, jpkm1                              ! No filter nor thickness weighting computation required
-               DO jj = 1, jpj                             ! ONLY swap
-                  DO ji = 1, jpi
-                     tn(ji,jj,jk) = ta(ji,jj,jk)                                 ! tn <-- ta
-                     sn(ji,jj,jk) = sa(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
-            !                                             ! general case (Leapfrog + Asselin filter)
-         ELSE                                             ! apply filter on thickness weighted tracer and swap
-            DO jk = 1, jpkm1
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     ze3t_b = fse3t_b(ji,jj,jk)
-                     ze3t_n = fse3t_n(ji,jj,jk)
-                     ze3t_a = fse3t_a(ji,jj,jk)
-                     !                                         ! tracer content at Before, now and after
-                     ztcb = tb(ji,jj,jk) *  ze3t_b   ;   zscb = sb(ji,jj,jk) * ze3t_b
-                     ztcn = tn(ji,jj,jk) *  ze3t_n   ;   zscn = sn(ji,jj,jk) * ze3t_n
-                     ztca = ta(ji,jj,jk) *  ze3t_a   ;   zsca = sa(ji,jj,jk) * ze3t_a
-                     !
-                     !                                         ! Asselin filter on thickness and tracer content
-                     ze3t_f = atfp * ( ze3t_a - 2.* ze3t_n + ze3t_b )
-                     ztc_f  = atfp * ( ztca   - 2.* ztcn   + ztcb   ) 
-                     zsc_f  = atfp * ( zsca   - 2.* zscn   + zscb   ) 
-                     !
-                     !                                         ! filtered tracer including the correction 
-                     ze3fr = 1.e0 / ( ze3t_n + ze3t_f )
-                     ztf   =  ( ztcn  + ztc_f ) * ze3fr
-                     zsf   =  ( zscn  + zsc_f ) * ze3fr
-                     !                                         ! swap of arrays
-                     tb(ji,jj,jk) = ztf                             ! tb <-- tn filtered
-                     sb(ji,jj,jk) = zsf
-                     tn(ji,jj,jk) = ta(ji,jj,jk)                    ! tn <-- ta
-                     sn(ji,jj,jk) = sa(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
-         ENDIF
-      ENDIF
+         END DO
+         ! 
+      END DO
       !
    END SUBROUTINE tra_nxt_vvl
Index: trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90	(revision 2528)
@@ -21,5 +21,5 @@
    USE trc_oce         ! share SMS/Ocean variables
    USE trdmod_oce      ! ocean variables trends
-   USE trdmod          ! ocean active tracers trends 
+   USE trdtra          ! ocean active tracers trends 
    USE in_out_manager  ! I/O manager
    USE phycst          ! physical constants
@@ -27,9 +27,11 @@
    USE iom             ! I/O manager
    USE fldread         ! read input fields
+   USE restart         ! ocean restart
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   tra_qsr        ! routine called by step.F90 (ln_traqsr=T)
+   PUBLIC   tra_qsr       ! routine called by step.F90 (ln_traqsr=T)
+   PUBLIC   tra_qsr_init  ! routine called by opa.F90
 
    !                                           !!* Namelist namtra_qsr: penetrative solar radiation
@@ -42,9 +44,10 @@
    REAL(wp), PUBLIC ::   rn_si0     = 0.35_wp   !: very near surface depth of extinction      (RGB & 2 bands)
    REAL(wp), PUBLIC ::   rn_si1     = 23.0_wp   !: deepest depth of extinction (water type I)       (2 bands)
-   REAL(wp), PUBLIC ::   rn_si2     = 61.8_wp   !: deepest depth of extinction (blue & 0.01 mg.m-3)     (RGB)
    
    ! Module variables
+   REAL(wp) ::   xsi0r                           !: inverse of rn_si0
+   REAL(wp) ::   xsi1r                           !: inverse of rn_si1
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_chl   ! structure of input Chl (file informations, fields read)
-   INTEGER ::   nksr   ! levels below which the light cannot penetrate ( depth larger than 391 m)
+   INTEGER, PUBLIC ::   nksr              ! levels below which the light cannot penetrate ( depth larger than 391 m)
    REAL(wp), DIMENSION(3,61) ::   rkrgb   !: tabulated attenuation coefficients for RGB absorption
 
@@ -53,7 +56,7 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -87,6 +90,4 @@
       !!              Lengaigne et al. 2007, Clim. Dyn., V28, 5, 503-516.
       !!----------------------------------------------------------------------
-      USE oce, ONLY :   ztrdt => ua   ! use ua as 3D workspace   
-      USE oce, ONLY :   ztrds => va   ! use va as 3D workspace   
       !!
       INTEGER, INTENT(in) ::   kt     ! ocean time-step
@@ -94,8 +95,11 @@
       INTEGER  ::   ji, jj, jk           ! dummy loop indices
       INTEGER  ::   irgb                 ! temporary integers
-      REAL(wp) ::   zchl, zcoef, zsi0r   ! temporary scalars
+      REAL(wp) ::   zchl, zcoef          ! temporary scalars
       REAL(wp) ::   zc0, zc1, zc2, zc3   !    -         -
+      REAL(wp) ::   zz0, zz1             !    -         -
+      REAL(wp) ::   z1_e3t, zfact        !    -         -
       REAL(wp), DIMENSION(jpi,jpj)     ::   zekb, zekg, zekr            ! 2D workspace
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze0, ze1 , ze2, ze3, zea    ! 3D workspace
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt
       !!----------------------------------------------------------------------
 
@@ -104,13 +108,31 @@
          IF(lwp) WRITE(numout,*) 'tra_qsr : penetration of the surface solar radiation'
          IF(lwp) WRITE(numout,*) '~~~~~~~'
-         CALL tra_qsr_init
          IF( .NOT.ln_traqsr )   RETURN
       ENDIF
 
       IF( l_trdtra ) THEN      ! Save ta and sa trends
-         ztrdt(:,:,:) = ta(:,:,:) 
-         ztrds(:,:,:) = 0.e0
-      ENDIF
-
+         ALLOCATE( ztrdt(jpi,jpj,jpk) )   ;    ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
+      ENDIF
+
+      !                                        Set before qsr tracer content field
+      !                                        ***********************************
+      IF( kt == nit000 ) THEN                     ! Set the forcing field at nit000 - 1
+         !                                        ! -----------------------------------
+         IF( ln_rstart .AND.    &                    ! Restart: read in restart file
+              & iom_varid( numror, 'qsr_hc_b', ldstop = .FALSE. ) > 0 ) THEN
+            IF(lwp) WRITE(numout,*) '          nit000-1 qsr tracer content forcing field red in the restart file'
+            zfact = 0.5e0
+            CALL iom_get( numror, jpdom_autoglo, 'qsr_hc_b', qsr_hc_b )   ! before heat content trend due to Qsr flux
+         ELSE                                           ! No restart or restart not found: Euler forward time stepping
+            zfact = 1.e0
+            qsr_hc_b(:,:,:) = 0.e0
+         ENDIF
+      ELSE                                        ! Swap of forcing field
+         !                                        ! ---------------------
+         zfact = 0.5e0
+         qsr_hc_b(:,:,:) = qsr_hc(:,:,:)
+      ENDIF
+      !                                        Compute now qsr tracer content field
+      !                                        ************************************
       
       !                                           ! ============================================== !
@@ -118,7 +140,12 @@
          !                                        ! ============================================== !
          DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
+            qsr_hc(:,:,jk) = ro0cpr * ( etot3(:,:,jk) - etot3(:,:,jk+1) )
+         END DO
+         !                                        Add to the general trend
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1 
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ta(ji,jj,jk) = ta(ji,jj,jk) + ro0cpr * ( etot3(ji,jj,jk) - etot3(ji,jj,jk+1) ) / fse3t(ji,jj,jk) 
+                  z1_e3t = zfact / fse3t(ji,jj,jk)
+                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + ( qsr_hc_b(ji,jj,jk) + qsr_hc(ji,jj,jk) ) * z1_e3t
                END DO
             END DO
@@ -133,22 +160,30 @@
             !                                             ! ------------------------- !
             ! Set chlorophyl concentration
-            IF( nn_chldta ==1 ) THEN                             !*  Variable Chlorophyll
-               !
-               CALL fld_read( kt, 1, sf_chl )                         ! Read Chl data and provides it at the current time step
-               !         
+            IF( nn_chldta == 1 .OR. lk_vvl ) THEN            !*  Variable Chlorophyll or ocean volume
+               !
+               IF( nn_chldta == 1 ) THEN                             !*  Variable Chlorophyll
+                  !
+                  CALL fld_read( kt, 1, sf_chl )                         ! Read Chl data and provides it at the current time step
+                  !         
 !CDIR COLLAPSE
 !CDIR NOVERRCHK
-               DO jj = 1, jpj                                         ! Separation in R-G-B depending of the surface Chl
+                  DO jj = 1, jpj                                         ! Separation in R-G-B depending of the surface Chl
 !CDIR NOVERRCHK
-                  DO ji = 1, jpi
-                     zchl = MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj) ) )
-                     irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 )
-                     zekb(ji,jj) = rkrgb(1,irgb)
-                     zekg(ji,jj) = rkrgb(2,irgb)
-                     zekr(ji,jj) = rkrgb(3,irgb)
-                  END DO
-               END DO
-               !
-               zsi0r = 1.e0 / rn_si0
+                     DO ji = 1, jpi
+                        zchl = MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj,1) ) )
+                        irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 )
+                        zekb(ji,jj) = rkrgb(1,irgb)
+                        zekg(ji,jj) = rkrgb(2,irgb)
+                        zekr(ji,jj) = rkrgb(3,irgb)
+                     END DO
+                  END DO
+               ELSE                                            ! Variable ocean volume but constant chrlorophyll
+                  zchl = 0.05                                     ! constant chlorophyll
+                  irgb = NINT( 41 + 20.*LOG10( zchl ) + 1.e-15 )
+                  zekb(:,:) = rkrgb(1,irgb)                       ! Separation in R-G-B depending of the chlorophyll 
+                  zekg(:,:) = rkrgb(2,irgb)
+                  zekr(:,:) = rkrgb(3,irgb)
+               ENDIF
+               !
                zcoef  = ( 1. - rn_abs ) / 3.e0                        ! equi-partition in R-G-B
                ze0(:,:,1) = rn_abs  * qsr(:,:)
@@ -163,5 +198,5 @@
 !CDIR NOVERRCHK   
                      DO ji = 1, jpi
-                        zc0 = ze0(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zsi0r     )
+                        zc0 = ze0(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * xsi0r     )
                         zc1 = ze1(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zekb(ji,jj) )
                         zc2 = ze2(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zekg(ji,jj) )
@@ -177,5 +212,5 @@
                !
                DO jk = 1, nksr                                        ! compute and add qsr trend to ta
-                  ta(:,:,jk) = ta(:,:,jk) + ro0cpr * ( zea(:,:,jk) - zea(:,:,jk+1) ) / fse3t(:,:,jk)
+                  qsr_hc(:,:,jk) = ro0cpr * ( zea(:,:,jk) - zea(:,:,jk+1) )
                END DO
                zea(:,:,nksr+1:jpk) = 0.e0     ! below 400m set to zero
@@ -184,5 +219,5 @@
             ELSE                                                 !*  Constant Chlorophyll
                DO jk = 1, nksr
-                  ta(:,:,jk) = ta(:,:,jk) + etot3(:,:,jk) * qsr(:,:)
+                  qsr_hc(:,:,jk) =  etot3(:,:,jk) * qsr(:,:)
                END DO
             ENDIF
@@ -193,22 +228,58 @@
             !                                             ! ------------------------- !
             !
-            DO jk = 1, nksr
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ta(ji,jj,jk) = ta(ji,jj,jk) + etot3(ji,jj,jk) * qsr(ji,jj)
-                  END DO
+            IF( lk_vvl ) THEN                                  !* variable volume
+               zz0   =        rn_abs   * ro0cpr
+               zz1   = ( 1. - rn_abs ) * ro0cpr
+               DO jk = 1, nksr                    ! solar heat absorbed at T-point in the top 400m 
+                  DO jj = 2, jpjm1
+                     DO ji = 2, jpim1
+                        zc0 = zz0 * EXP( -fsdepw(ji,jj,jk  )*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk  )*xsi1r )
+                        zc1 = zz0 * EXP( -fsdepw(ji,jj,jk+1)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk+1)*xsi1r )
+                        qsr_hc(ji,jj,jk) = qsr(ji,jj) * ( zc0*tmask(ji,jj,jk) - zc1*tmask(ji,jj,jk+1) ) 
+                     END DO
+                  END DO
+               END DO
+            ELSE                                               !* constant volume: coef. computed one for all
+               DO jk = 1, nksr
+                  DO jj = 2, jpjm1
+                     DO ji = fs_2, fs_jpim1   ! vector opt.
+                        qsr_hc(ji,jj,jk) =  etot3(ji,jj,jk) * qsr(ji,jj)
+                     END DO
+                  END DO
+               END DO
+               !
+            ENDIF
+            !
+         ENDIF
+         !
+         !                                        Add to the general trend
+         DO jk = 1, nksr
+            DO jj = 2, jpjm1 
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  z1_e3t = zfact / fse3t(ji,jj,jk)
+                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + ( qsr_hc_b(ji,jj,jk) + qsr_hc(ji,jj,jk) ) * z1_e3t
                END DO
             END DO
-            !
-         ENDIF
+         END DO
+         !
+      ENDIF
+      !
+      IF( lrst_oce ) THEN   !                  Write in the ocean restart file
+         !                                     *******************************
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'qsr tracer content forcing field written in ocean restart file ',   &
+            &                    'at it= ', kt,' date= ', ndastp
+         IF(lwp) WRITE(numout,*) '~~~~'
+         CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b', qsr_hc )
          !
       ENDIF
 
       IF( l_trdtra ) THEN     ! qsr tracers trends saved for diagnostics
-         ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:)
-         CALL trd_mod( ztrdt, ztrds, jptra_trd_qsr, 'TRA', kt )
+         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_qsr, ztrdt )
+         DEALLOCATE( ztrdt )
       ENDIF
       !                       ! print mean trends (used for debugging)
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' qsr  - Ta: ', mask1=tmask, clinfo3='tra-ta' )
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' qsr  - Ta: ', mask1=tmask, clinfo3='tra-ta' )
       !
    END SUBROUTINE tra_qsr
@@ -235,7 +306,7 @@
       INTEGER  ::   irgb, ierror          ! temporary integer
       INTEGER  ::   ioptio, nqsr          ! temporary integer
-      REAL(wp) ::   zc0  , zc1            ! temporary scalars
+      REAL(wp) ::   zc0  , zc1, zcoef     ! temporary scalars
       REAL(wp) ::   zc2  , zc3  , zchl    !    -         -
-      REAL(wp) ::   zsi0r, zsi1r, zcoef   !    -         -
+      REAL(wp) ::   zz0  , zz1            !    -         -
       REAL(wp), DIMENSION(jpi,jpj)     ::   zekb, zekg, zekr              ! 2D workspace
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze0 , ze1 , ze2 , ze3 , zea   ! 3D workspace
@@ -244,5 +315,5 @@
       TYPE(FLD_N)        ::   sn_chl   ! informations about the chlorofyl field to be read
       NAMELIST/namtra_qsr/  sn_chl, cn_dir, ln_traqsr, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio,   &
-         &                  nn_chldta, rn_abs, rn_si0, rn_si1, rn_si2
+         &                  nn_chldta, rn_abs, rn_si0, rn_si1
       !!----------------------------------------------------------------------
 
@@ -269,5 +340,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,*) '      3 bands: longest depth of extinction         rn_si2 = ', rn_si2
       ENDIF
 
@@ -284,12 +354,7 @@
          IF( ln_qsr_bio  )   ioptio = ioptio + 1
          !
-         IF( ioptio /= 1 ) THEN
-            ln_qsr_rgb = .TRUE.
-            nn_chldta  = 0
-            ln_qsr_2bd = .FALSE.
-            ln_qsr_bio = .FALSE.
-            CALL ctl_warn( '          Choose ONE type of light penetration in namelist namtra_qsr',   &
-           &               ' otherwise, we force the model to run with RGB light penetration' )
-         ENDIF
+         IF( ioptio /= 1 ) &
+            CALL ctl_stop( '          Choose ONE type of light penetration in namelist namtra_qsr',  &
+            &              ' 2 bands, 3 RGB bands or bio-model light penetration' )
          !
          IF( ln_qsr_rgb .AND. nn_chldta == 0 )   nqsr =  1 
@@ -300,7 +365,7 @@
          IF(lwp) THEN                   ! Print the choice
             WRITE(numout,*)
-            IF( nqsr ==  1 )   WRITE(numout,*) '         R-G-B  light penetration - Constant Chlorophyll'
-            IF( nqsr ==  2 )   WRITE(numout,*) '         R-G-B  light penetration - Chl data '
-            IF( nqsr ==  3 )   WRITE(numout,*) '         2 band light penetration'
+            IF( nqsr ==  1 )   WRITE(numout,*) '         R-G-B   light penetration - Constant Chlorophyll'
+            IF( nqsr ==  2 )   WRITE(numout,*) '         R-G-B   light penetration - Chl data '
+            IF( nqsr ==  3 )   WRITE(numout,*) '         2 bands light penetration'
             IF( nqsr ==  4 )   WRITE(numout,*) '         bio-model light penetration'
          ENDIF
@@ -311,19 +376,18 @@
          !                       ! ===================================== !
          !
-         zsi0r = 1.e0 / rn_si0
-         zsi1r = 1.e0 / rn_si1
+         xsi0r = 1.e0 / rn_si0
+         xsi1r = 1.e0 / rn_si1
          !                                ! ---------------------------------- !
          IF( ln_qsr_rgb ) THEN            !  Red-Green-Blue light penetration  !
             !                             ! ---------------------------------- !
             !
-            !                                ! level of light extinction
-            nksr = trc_oce_ext_lev( rn_si2, 0.33e2 )
-            IF(lwp) THEN
-               WRITE(numout,*)
-               WRITE(numout,*) '        level max of computation of qsr = ', nksr, ' ref depth = ', gdepw_0(nksr+1), ' m'
-            ENDIF
-            !
             CALL trc_oce_rgb( rkrgb )           !* tabulated attenuation coef.
-!!gm            CALL trc_oce_rgb_read( rkrgb )           !* tabulated attenuation coef.
+            !
+            !                                   !* level of light extinction
+            IF(  ln_sco ) THEN   ;   nksr = jpkm1
+            ELSE                 ;   nksr = trc_oce_ext_lev( r_si2, 0.33e2 )
+            ENDIF
+
+            IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksr, ' ref depth = ', gdepw_0(nksr+1), ' m'
             !
             IF( nn_chldta == 1 ) THEN           !* Chl data : set sf_chl structure
@@ -334,6 +398,6 @@
                   CALL ctl_stop( 'tra_qsr_init: unable to allocate sf_chl structure' )   ;   RETURN
                ENDIF
-               ALLOCATE( sf_chl(1)%fnow(jpi,jpj)   )
-               ALLOCATE( sf_chl(1)%fdta(jpi,jpj,2) )
+               ALLOCATE( sf_chl(1)%fnow(jpi,jpj,1)   )
+               IF( sn_chl%ln_tint )ALLOCATE( sf_chl(1)%fdta(jpi,jpj,1,2) )
                !                                        ! fill sf_chl with sn_chl and control print
                CALL fld_fill( sf_chl, (/ sn_chl /), cn_dir, 'tra_qsr_init',   &
@@ -343,41 +407,45 @@
                IF(lwp) WRITE(numout,*)
                IF(lwp) WRITE(numout,*) '        Constant Chlorophyll concentration = 0.05'
-               IF(lwp) WRITE(numout,*) '        light distribution computed once for all'
-               !
-               zchl = 0.05                                 ! constant chlorophyll
-               irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 )
-               zekb(:,:) = rkrgb(1,irgb)                   ! Separation in R-G-B depending of the chlorophyl concentration
-               zekg(:,:) = rkrgb(2,irgb)
-               zekr(:,:) = rkrgb(3,irgb)
-               !
-               zcoef = ( 1. - rn_abs ) / 3.e0              ! equi-partition in R-G-B
-               ze0(:,:,1) = rn_abs
-               ze1(:,:,1) = zcoef
-               ze2(:,:,1) = zcoef 
-               ze3(:,:,1) = zcoef
-               zea(:,:,1) = tmask(:,:,1)                   ! = ( ze0+ze1+z2+ze3 ) * tmask
+               IF( lk_vvl ) THEN                   ! variable volume
+                  IF(lwp) WRITE(numout,*) '        key_vvl: light distribution will be computed at each time step'
+               ELSE                                ! constant volume: computes one for all
+                  IF(lwp) WRITE(numout,*) '        fixed volume: light distribution computed one for all'
+                  !
+                  zchl = 0.05                                 ! constant chlorophyll
+                  irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 )
+                  zekb(:,:) = rkrgb(1,irgb)                   ! Separation in R-G-B depending of the chlorophyll 
+                  zekg(:,:) = rkrgb(2,irgb)
+                  zekr(:,:) = rkrgb(3,irgb)
+                  !
+                  zcoef = ( 1. - rn_abs ) / 3.e0              ! equi-partition in R-G-B
+                  ze0(:,:,1) = rn_abs
+                  ze1(:,:,1) = zcoef
+                  ze2(:,:,1) = zcoef 
+                  ze3(:,:,1) = zcoef
+                  zea(:,:,1) = tmask(:,:,1)                   ! = ( ze0+ze1+z2+ze3 ) * tmask
                
-               DO jk = 2, nksr+1
+                  DO jk = 2, nksr+1
 !CDIR NOVERRCHK
-                  DO jj = 1, jpj
+                     DO jj = 1, jpj
 !CDIR NOVERRCHK   
-                     DO ji = 1, jpi
-                        zc0 = ze0(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zsi0r     )
-                        zc1 = ze1(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zekb(ji,jj) )
-                        zc2 = ze2(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zekg(ji,jj) )
-                        zc3 = ze3(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zekr(ji,jj) )
-                        ze0(ji,jj,jk) = zc0                 
-                        ze1(ji,jj,jk) = zc1
-                        ze2(ji,jj,jk) = zc2     
-                        ze3(ji,jj,jk) = zc3
-                        zea(ji,jj,jk) = ( zc0 + zc1 + zc2 + zc3 ) * tmask(ji,jj,jk)
-                     END DO
-                  END DO
-               END DO 
-               !
-               DO jk = 1, nksr
-                  etot3(:,:,jk) = ro0cpr * ( zea(:,:,jk) - zea(:,:,jk+1) ) / fse3t(:,:,jk)
-               END DO
-               etot3(:,:,nksr+1:jpk) = 0.e0                ! below 400m set to zero
+                        DO ji = 1, jpi
+                           zc0 = ze0(ji,jj,jk-1) * EXP( - fse3t_0(ji,jj,jk-1) * xsi0r     )
+                           zc1 = ze1(ji,jj,jk-1) * EXP( - fse3t_0(ji,jj,jk-1) * zekb(ji,jj) )
+                           zc2 = ze2(ji,jj,jk-1) * EXP( - fse3t_0(ji,jj,jk-1) * zekg(ji,jj) )
+                           zc3 = ze3(ji,jj,jk-1) * EXP( - fse3t_0(ji,jj,jk-1) * zekr(ji,jj) )
+                           ze0(ji,jj,jk) = zc0
+                           ze1(ji,jj,jk) = zc1
+                           ze2(ji,jj,jk) = zc2
+                           ze3(ji,jj,jk) = zc3
+                           zea(ji,jj,jk) = ( zc0 + zc1 + zc2 + zc3 ) * tmask(ji,jj,jk)
+                        END DO
+                     END DO
+                  END DO 
+                  !
+                  DO jk = 1, nksr
+                     etot3(:,:,jk) = ro0cpr * ( zea(:,:,jk) - zea(:,:,jk+1) ) 
+                  END DO
+                  etot3(:,:,nksr+1:jpk) = 0.e0                ! below 400m set to zero
+               ENDIF
             ENDIF
             !
@@ -391,18 +459,24 @@
             IF(lwp) THEN
                WRITE(numout,*)
-               WRITE(numout,*) '        level max of computation of qsr = ', nksr, ' ref depth = ', gdepw_0(nksr+1), ' m'
-            ENDIF
-            !
-            DO jk = 1, nksr                    !*  solar heat absorbed at T-point computed once for all
-               DO jj = 1, jpj                              ! top 400 meters
-                  DO ji = 1, jpi
-                     zc0 = rn_abs * EXP( -fsdepw(ji,jj,jk  )*zsi0r ) + (1.-rn_abs) * EXP( -fsdepw(ji,jj,jk  )*zsi1r )
-                     zc1 = rn_abs * EXP( -fsdepw(ji,jj,jk+1)*zsi0r ) + (1.-rn_abs) * EXP( -fsdepw(ji,jj,jk+1)*zsi1r )
-                     etot3(ji,jj,jk) = ro0cpr * (  zc0 * tmask(ji,jj,jk) - zc1 * tmask(ji,jj,jk+1)  ) / fse3t(ji,jj,jk)
-                  END DO
-               END DO
-            END DO 
-            etot3(:,:,nksr+1:jpk) = 0.e0                   ! below 400m set to zero
-            !
+            IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksr, ' ref depth = ', gdepw_0(nksr+1), ' m'
+            ENDIF
+            !
+            IF( lk_vvl ) THEN                   ! variable volume
+               IF(lwp) WRITE(numout,*) '        key_vvl: light distribution will be computed at each time step'
+            ELSE                                ! constant volume: computes one for all
+               zz0 =        rn_abs   * ro0cpr
+               zz1 = ( 1. - rn_abs ) * ro0cpr
+               DO jk = 1, nksr                    !*  solar heat absorbed at T-point computed once for all
+                  DO jj = 1, jpj                              ! top 400 meters
+                     DO ji = 1, jpi
+                        zc0 = zz0 * EXP( -fsdepw(ji,jj,jk  )*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk  )*xsi1r )
+                        zc1 = zz0 * EXP( -fsdepw(ji,jj,jk+1)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk+1)*xsi1r )
+                        etot3(ji,jj,jk) = (  zc0 * tmask(ji,jj,jk) - zc1 * tmask(ji,jj,jk+1)  ) 
+                     END DO
+                  END DO
+               END DO
+               etot3(:,:,nksr+1:jpk) = 0.e0                   ! below 400m set to zero
+               !
+            ENDIF
          ENDIF
          !                       ! ===================================== !
Index: trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90	(revision 2528)
@@ -4,7 +4,9 @@
    !! Ocean active tracers:  surface boundary condition
    !!==============================================================================
-   !! History :  8.2  !  98-10  (G. Madec, G. Roullet, M. Imbard)  Original code
-   !!            8.2  !  01-02  (D. Ludicone)  sea ice and free surface
-   !!            8.5  !  02-06  (G. Madec)  F90: Free form and module
+   !! History :  OPA  !  1998-10  (G. Madec, G. Roullet, M. Imbard)  Original code
+   !!            8.2  !  2001-02  (D. Ludicone)  sea ice and free surface
+   !!  NEMO      1.0  !  2002-06  (G. Madec)  F90: Free form and module
+   !!            3.3  !  2010-04  (M. Leclair, G. Madec)  Forcing averaged over 2 time steps
+   !!             -   !  2010-09  (C. Ethe, G. Madec) Merge TRA-TRC
    !!----------------------------------------------------------------------
 
@@ -17,8 +19,13 @@
    USE phycst          ! physical constant
    USE traqsr          ! solar radiation penetration
-   USE trdmod          ! ocean trends 
-   USE trdmod_oce      ! ocean variables trends
+   USE trdmod_oce      ! ocean trends 
+   USE trdtra          ! ocean trends
    USE in_out_manager  ! I/O manager
    USE prtctl          ! Print control
+   USE restart         ! ocean restart
+   USE sbcrnf          ! River runoff  
+   USE sbcmod          ! ln_rnf  
+   USE iom
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
 
    IMPLICIT NONE
@@ -31,7 +38,7 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -98,11 +105,9 @@
       !!              - save the trend it in ttrd ('key_trdtra')
       !!----------------------------------------------------------------------
-      USE oce, ONLY :   ztrdt => ua   ! use ua as 3D workspace   
-      USE oce, ONLY :   ztrds => va   ! use va as 3D workspace   
-      !!
-      INTEGER, INTENT(in) ::   kt     ! ocean time-step index
-      !!
-      INTEGER  ::   ji, jj                   ! dummy loop indices
-      REAL(wp) ::   zta, zsa, zsrau, zse3t   ! temporary scalars
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !!
+      INTEGER  ::   ji, jj, jk, jn           ! dummy loop indices  
+      REAL(wp) ::   zfact, z1_e3t, zsrau, zdep
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt, ztrds
       !!----------------------------------------------------------------------
 
@@ -114,44 +119,119 @@
 
       zsrau = 1. / rau0             ! initialization
-#if defined key_zco
-      zse3t = 1. / e3t_0(1)
-#endif
-
-      IF( l_trdtra ) THEN           ! Save ta and sa trends
-         ztrdt(:,:,:) = ta(:,:,:) 
-         ztrds(:,:,:) = sa(:,:,:) 
-      ENDIF
-
-      IF( .NOT.ln_traqsr )   qsr(:,:) = 0.e0   ! no solar radiation penetration
-
-      ! Concentration dillution effect on (t,s)
-      DO jj = 2, jpj
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-#if ! defined key_zco
-            zse3t = 1. / fse3t(ji,jj,1)
-#endif
-            IF( lk_vvl) THEN
-               zta = ro0cpr * qns(ji,jj) * zse3t &                   ! temperature : heat flux
-                &    - emp(ji,jj) * zsrau * tn(ji,jj,1)  * zse3t     ! & cooling/heating effet of EMP flux
-               zsa = ( emps(ji,jj) - emp(ji,jj) ) &
-                &                 * zsrau * sn(ji,jj,1)  * zse3t     ! concent./dilut. effect due to sea-ice 
-                                                                     ! melt/formation and (possibly) SSS restoration
-            ELSE
-               zta = ro0cpr * qns(ji,jj) * zse3t     ! temperature : heat flux
-               zsa = emps(ji,jj) * zsrau * sn(ji,jj,1)   * zse3t     ! salinity :  concent./dilut. effect
-            ENDIF
-            ta(ji,jj,1) = ta(ji,jj,1) + zta                          ! add the trend to the general tracer trend
-            sa(ji,jj,1) = sa(ji,jj,1) + zsa
+
+      IF( l_trdtra )   THEN                    !* Save ta and sa trends
+         ALLOCATE( ztrdt(jpi,jpj,jpk) )   ;    ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
+         ALLOCATE( ztrds(jpi,jpj,jpk) )   ;    ztrds(:,:,:) = tsa(:,:,:,jp_sal)
+      ENDIF
+
+!!gm      IF( .NOT.ln_traqsr )   qsr(:,:) = 0.e0   ! no solar radiation penetration
+      IF( .NOT.ln_traqsr ) THEN     ! no solar radiation penetration
+         qns(:,:) = qns(:,:) + qsr(:,:)      ! total heat flux in qns
+         qsr(:,:) = 0.e0                     ! qsr set to zero
+      ENDIF
+
+      !----------------------------------------
+      !        EMP, EMPS and QNS effects
+      !----------------------------------------
+      !                                          Set before sbc tracer content fields
+      !                                          ************************************
+      IF( kt == nit000 ) THEN                      ! Set the forcing field at nit000 - 1
+         !                                         ! -----------------------------------
+         IF( ln_rstart .AND.    &                     ! Restart: read in restart file
+              & iom_varid( numror, 'sbc_hc_b', ldstop = .FALSE. ) > 0 ) THEN
+            IF(lwp) WRITE(numout,*) '          nit000-1 surface tracer content forcing fields red in the restart file'
+            zfact = 0.5e0
+            CALL iom_get( numror, jpdom_autoglo, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem) )   ! before heat content sbc trend
+            CALL iom_get( numror, jpdom_autoglo, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal) )   ! before salt content sbc trend
+         ELSE                                         ! No restart or restart not found: Euler forward time stepping
+            zfact = 1.e0
+            sbc_tsc_b(:,:,:) = 0.e0
+         ENDIF
+      ELSE                                         ! Swap of forcing fields
+         !                                         ! ----------------------
+         zfact = 0.5e0
+         sbc_tsc_b(:,:,:) = sbc_tsc(:,:,:)
+      ENDIF
+      !                                          Compute now sbc tracer content fields
+      !                                          *************************************
+
+                                                   ! Concentration dilution effect on (t,s) due to  
+                                                   ! evaporation, precipitation and qns, but not river runoff 
+                                               
+      IF( lk_vvl ) THEN                            ! Variable Volume case
+         DO jj = 2, jpj
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ! temperature : heat flux + cooling/heating effet of EMP flux
+               sbc_tsc(ji,jj,jp_tem) = ro0cpr * qns(ji,jj) - zsrau * emp(ji,jj) * tsn(ji,jj,1,jp_tem)
+               ! concent./dilut. effect due to sea-ice melt/formation and (possibly) SSS restoration
+               sbc_tsc(ji,jj,jp_sal) = ( emps(ji,jj) - emp(ji,jj) ) * zsrau * tsn(ji,jj,1,jp_sal)
+            END DO
+         END DO
+      ELSE                                         ! Constant Volume case
+         DO jj = 2, jpj
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ! temperature : heat flux
+               sbc_tsc(ji,jj,jp_tem) = ro0cpr * qns(ji,jj)
+               ! salinity    : salt flux + concent./dilut. effect (both in emps)
+               sbc_tsc(ji,jj,jp_sal) = zsrau * emps(ji,jj) * tsn(ji,jj,1,jp_sal)
+            END DO
+         END DO
+      ENDIF
+      ! Concentration dilution effect on (t,s) due to evapouration, precipitation and qns, but not river runoff  
+      DO jn = 1, jpts
+         DO jj = 2, jpj
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               z1_e3t = zfact / fse3t(ji,jj,1)
+               tsa(ji,jj,1,jn) = tsa(ji,jj,1,jn) + ( sbc_tsc_b(ji,jj,jn) + sbc_tsc(ji,jj,jn) ) * z1_e3t
+            END DO
          END DO
       END DO
-
-      IF( l_trdtra ) THEN      ! save the sbc trends for diagnostic
-         ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:)
-         ztrds(:,:,:) = sa(:,:,:) - ztrds(:,:,:)
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_nsr, 'TRA', kt)
-      ENDIF
-      !
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' sbc  - Ta: ', mask1=tmask,   &
-         &                       tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+      !                                          Write in the ocean restart file
+      !                                          *******************************
+      IF( lrst_oce ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'sbc : ocean surface tracer content forcing fields written in ocean restart file ',   &
+            &                    'at it= ', kt,' date= ', ndastp
+         IF(lwp) WRITE(numout,*) '~~~~'
+         CALL iom_rstput( kt, nitrst, numrow, 'sbc_hc_b', sbc_tsc(:,:,jp_tem) )
+         CALL iom_rstput( kt, nitrst, numrow, 'sbc_sc_b', sbc_tsc(:,:,jp_sal) )
+      ENDIF
+      !
+      !----------------------------------------
+      !        River Runoff effects
+      !----------------------------------------
+      !
+      zfact = 0.5e0
+
+      ! Effect on (t,s) due to river runoff (dilution effect automatically applied via vertical tracer advection) 
+      IF( ln_rnf ) THEN  
+         DO jj = 2, jpj 
+            DO ji = fs_2, fs_jpim1
+               zdep = 1. / h_rnf(ji,jj)
+               zdep = zfact * zdep  
+               IF ( rnf(ji,jj) .ne. 0.0 ) THEN
+                  DO jk = 1, nk_rnf(ji,jj)
+                                        tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)   &
+                                          &               +  ( rnf_tsc_b(ji,jj,jp_tem) + rnf_tsc(ji,jj,jp_tem) ) * zdep
+                     IF( ln_rnf_sal )   tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)   &
+                                          &               +  ( rnf_tsc_b(ji,jj,jp_sal) + rnf_tsc(ji,jj,jp_sal) ) * zdep 
+                  ENDDO
+               ENDIF
+            ENDDO  
+         ENDDO  
+      ENDIF  
+!!gm  It should be useless
+      CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. )    ;    CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. )
+
+      IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics
+         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
+         ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:)
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_nsr, ztrdt )
+         CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_nsr, ztrds )
+         DEALLOCATE( ztrdt )      ;     DEALLOCATE( ztrds )
+      ENDIF
+      !
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' sbc  - Ta: ', mask1=tmask,   &
+         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
       !
    END SUBROUTINE tra_sbc
Index: trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traswp.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traswp.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traswp.F90	(revision 2528)
@@ -0,0 +1,52 @@
+MODULE traswp
+   !!==============================================================================
+   !!                       ***  MODULE  traswp  ***
+   !! Ocean active tracers: swapping array 
+   !!==============================================================================
+   USE par_oce         ! ocean parameters
+   USE oce             ! ocean dynamics and active tracers
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_swap     ! routine called by step.F90
+   PUBLIC   tra_unswap   ! routine called by step.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE tra_swap 
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_swp  ***
+      !!                   
+      !! ** Purpose : Store temperature and salinity aaray into a 4D array 
+      !!
+      !!----------------------------------------------------------------------
+      !
+      tsn(:,:,:,jp_tem) = tn(:,:,:)      ;      tsn(:,:,:,jp_sal) = sn(:,:,:)
+      tsb(:,:,:,jp_tem) = tb(:,:,:)      ;      tsb(:,:,:,jp_sal) = sb(:,:,:)
+      tsa(:,:,:,jp_tem) = ta(:,:,:)      ;      tsa(:,:,:,jp_sal) = sa(:,:,:)
+      !
+   END SUBROUTINE tra_swap
+
+   SUBROUTINE tra_unswap 
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_unswap  ***
+      !!                   
+      !! ** Purpose : Store temperature and salinity aaray into a 4D array 
+      !!
+      !!----------------------------------------------------------------------
+      !
+      tn(:,:,:) = tsn(:,:,:,jp_tem)      ;      sn(:,:,:) = tsn(:,:,:,jp_sal)
+      tb(:,:,:) = tsb(:,:,:,jp_tem)      ;      sb(:,:,:) = tsb(:,:,:,jp_sal)
+      ta(:,:,:) = tsa(:,:,:,jp_tem)      ;      sa(:,:,:) = tsa(:,:,:,jp_sal)
+      !
+   END SUBROUTINE tra_unswap
+
+   !!======================================================================
+END MODULE traswp
Index: trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90	(revision 2528)
@@ -4,10 +4,11 @@
    !! Ocean active tracers:  vertical component of the tracer mixing trend
    !!==============================================================================
-   !! History :  9.0  !  05-11  (G. Madec)  Original code
+   !! History :  1.0  ! 2005-11  (G. Madec)  Original code
+   !!            3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA
    !!----------------------------------------------------------------------
 
    !!----------------------------------------------------------------------
    !!   tra_zdf      : Update the tracer trend with the vertical diffusion
-   !!       zdf_ctl  : ???
+   !!   tra_zdf_init : initialisation of the computation
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and tracers variables
@@ -21,6 +22,6 @@
 
    USE ldftra_oce      ! ocean active tracers: lateral physics
-   USE trdmod          ! ocean active tracers trends 
-   USE trdmod_oce      ! ocean variables trends
+   USE trdmod_oce      ! ocean active tracers: lateral physics
+   USE trdtra      ! ocean tracers trends 
    USE in_out_manager  ! I/O manager
    USE prtctl          ! Print control
@@ -33,9 +34,9 @@
    PRIVATE
 
-   PUBLIC tra_zdf   !  routine called by step.F90
+   PUBLIC tra_zdf      !  routine called by step.F90
+   PUBLIC tra_zdf_init !  routine called by opa.F90
 
    INTEGER ::   nzdf = 0               ! type vertical diffusion algorithm used
       !                                ! defined from ln_zdf...  namlist logicals)
-
    REAL(wp), DIMENSION(jpk) ::   r2dt  ! vertical profile time-step, = 2 rdttra
       !                                ! except at nit000 (=rdttra) if neuler=0
@@ -46,7 +47,7 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -60,10 +61,8 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
-
+      !!
       INTEGER  ::   jk                   ! Dummy loop indices
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztrdt, ztrds   ! 3D workspace
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdt, ztrds   ! 3D workspace
       !!---------------------------------------------------------------------
-
-      IF( kt == nit000 )   CALL zdf_ctl          ! initialisation & control of options
 
       !                                          ! set time step
@@ -74,44 +73,41 @@
       ENDIF
 
-      IF( l_trdtra )   THEN                      ! temporary save of ta and sa trends
-         ztrdt(:,:,:) = ta(:,:,:)
-         ztrds(:,:,:) = sa(:,:,:)
+      IF( l_trdtra )   THEN                    !* Save ta and sa trends
+         ALLOCATE( ztrdt(jpi,jpj,jpk) )   ;    ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
+         ALLOCATE( ztrds(jpi,jpj,jpk) )   ;    ztrds(:,:,:) = tsa(:,:,:,jp_sal)
       ENDIF
 
       SELECT CASE ( nzdf )                       ! compute lateral mixing trend and add it to the general trend
+      CASE ( 0 )    ;    CALL tra_zdf_exp( kt, 'TRA', r2dt, nn_zdfexp, tsb, tsa, jpts )  !   explicit scheme 
+      CASE ( 1 )    ;    CALL tra_zdf_imp( kt, 'TRA', r2dt,            tsb, tsa, jpts )  !   implicit scheme 
       CASE ( -1 )                                       ! esopa: test all possibility with control print
-         CALL tra_zdf_exp    ( kt, r2dt )
-         CALL prt_ctl( tab3d_1=ta, clinfo1=' zdf0 - Ta: ', mask1=tmask,               &
-            &          tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-         CALL tra_zdf_imp    ( kt, r2dt )
-         CALL prt_ctl( tab3d_1=ta, clinfo1=' zdf1 - Ta: ', mask1=tmask,               &
-            &          tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
-
-      CASE ( 0 )                                       ! explicit scheme
-         CALL tra_zdf_exp    ( kt, r2dt )
-
-      CASE ( 1 )                                       ! implicit scheme 
-         CALL tra_zdf_imp    ( kt, r2dt )
-
+         CALL tra_zdf_exp( kt, 'TRA', r2dt, nn_zdfexp, tsb, tsa, jpts )
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' zdf0 - Ta: ', mask1=tmask,               &
+         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+         CALL tra_zdf_imp( kt, 'TRA', r2dt,            tsb, tsa, jpts ) 
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' zdf1 - Ta: ', mask1=tmask,               &
+         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
       END SELECT
 
       IF( l_trdtra )   THEN                      ! save the vertical diffusive trends for further diagnostics
          DO jk = 1, jpkm1
-            ztrdt(:,:,jk) = ( ( ta(:,:,jk) - tb(:,:,jk) ) / r2dt(jk) ) - ztrdt(:,:,jk)
-            ztrds(:,:,jk) = ( ( sa(:,:,jk) - sb(:,:,jk) ) / r2dt(jk) ) - ztrds(:,:,jk)
+            ztrdt(:,:,jk) = ( ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / r2dt(jk) ) - ztrdt(:,:,jk)
+            ztrds(:,:,jk) = ( ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / r2dt(jk) ) - ztrds(:,:,jk)
          END DO
-         CALL trd_mod( ztrdt, ztrds, jptra_trd_zdf, 'TRA', kt )
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_zdf, ztrdt )
+         CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_zdf, ztrds )
+         DEALLOCATE( ztrdt )      ;     DEALLOCATE( ztrds ) 
       ENDIF
 
       !                                          ! print mean trends (used for debugging)
-      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' zdf  - Ta: ', mask1=tmask,               &
-         &                       tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' zdf  - Ta: ', mask1=tmask,               &
+         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
 
    END SUBROUTINE tra_zdf
 
 
-   SUBROUTINE zdf_ctl
+   SUBROUTINE tra_zdf_init
       !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE zdf_ctl  ***
+      !!                 ***  ROUTINE tra_zdf_init  ***
       !!
       !! ** Purpose :   Choose the vertical mixing scheme
@@ -123,28 +119,20 @@
       !!      the implicit scheme is required.
       !!----------------------------------------------------------------------
-      USE zdftke_old
       USE zdftke
+      USE zdfgls
       USE zdfkpp
       !!----------------------------------------------------------------------
 
-      !  Define the vertical tracer physics scheme
-      ! ==========================================
-
       ! Choice from ln_zdfexp already read in namelist in zdfini module
-      IF( ln_zdfexp ) THEN               ! use explicit scheme
-         nzdf = 0
-      ELSE                               ! use implicit scheme
-         nzdf = 1
+      IF( ln_zdfexp ) THEN   ;   nzdf = 0           ! use explicit scheme
+      ELSE                   ;   nzdf = 1           ! use implicit scheme
       ENDIF
 
       ! Force implicit schemes
-      IF( lk_zdftke_old .OR. lk_zdftke .OR. lk_zdfkpp )   nzdf = 1      ! TKE or KPP physics
-      IF( ln_traldf_iso                               )   nzdf = 1      ! iso-neutral lateral physics
-      IF( ln_traldf_hor .AND. ln_sco                  )   nzdf = 1      ! horizontal lateral physics in s-coordinate
-
-      IF( ln_zdfexp .AND. nzdf == 1 )   THEN
-         CALL ctl_stop( 'tra_zdf : If using the rotation of lateral mixing operator or TKE ', &
-            &           '          or KPP scheme, the implicit scheme is required, set ln_zdfexp = .false.' )
-      ENDIF
+      IF( lk_zdftke .OR. lk_zdfgls .OR. lk_zdfkpp )   nzdf = 1      ! TKE, GLS or KPP physics
+      IF( ln_traldf_iso                           )   nzdf = 1      ! iso-neutral lateral physics
+      IF( ln_traldf_hor .AND. ln_sco              )   nzdf = 1      ! horizontal lateral physics in s-coordinate
+      IF( ln_zdfexp .AND. nzdf == 1 )   CALL ctl_stop( 'tra_zdf : If using the rotation of lateral mixing operator',   &
+            &                         ' TKE or KPP scheme, the implicit scheme is required, set ln_zdfexp = .false.' )
 
       ! Test: esopa
@@ -153,5 +141,5 @@
       IF(lwp) THEN
          WRITE(numout,*)
-         WRITE(numout,*) 'tra:zdf_ctl : vertical tracer physics scheme'
+         WRITE(numout,*) 'tra_zdf_init : vertical tracer physics scheme'
          WRITE(numout,*) '~~~~~~~~~~~'
          IF( nzdf == -1 )   WRITE(numout,*) '              ESOPA test All scheme used'
@@ -159,6 +147,6 @@
          IF( nzdf ==  1 )   WRITE(numout,*) '              Implicit (euler backward) scheme'
       ENDIF
-
-   END SUBROUTINE zdf_ctl
+      !
+   END SUBROUTINE tra_zdf_init
 
    !!==============================================================================
Index: trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_exp.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_exp.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_exp.F90	(revision 2528)
@@ -2,6 +2,6 @@
    !!==============================================================================
    !!                    ***  MODULE  trazdf_exp  ***
-   !! Ocean active tracers:  vertical component of the tracer mixing trend using
-   !!                        a split-explicit time-stepping 
+   !! Ocean  tracers:  vertical component of the tracer mixing trend using
+   !!                  a split-explicit time-stepping 
    !!==============================================================================
    !! History :  OPA  !  1990-10  (B. Blanke)  Original code
@@ -16,4 +16,5 @@
    !!             -   !  2005-11  (G. Madec)  New organisation
    !!            3.0  !  2008-04  (G. Madec)  leap-frog time stepping done in trazdf
+   !!            3.3  !  2010-06  (C. Ethe, G. Madec) Merge TRA-TRC
    !!----------------------------------------------------------------------
 
@@ -24,11 +25,9 @@
    USE oce             ! ocean dynamics and active tracers 
    USE dom_oce         ! ocean space and time domain 
-   USE domvvl          ! variablevolume levels
-   USE trdmod          ! ocean active tracers trends 
-   USE trdmod_oce      ! ocean variables trends
+   USE domvvl          ! variable volume levels
    USE zdf_oce         ! ocean vertical physics
    USE zdfddm          ! ocean vertical physics: double diffusion
    USE in_out_manager  ! I/O manager
-   USE prtctl          ! Print control
+   USE trc_oce         ! share passive tracers/Ocean variables
 
    IMPLICIT NONE
@@ -42,12 +41,13 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA  3.2 , LOCEAN-IPSL (2009) 
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
 CONTAINS
 
-   SUBROUTINE tra_zdf_exp( kt, p2dt )
+   SUBROUTINE tra_zdf_exp( kt, cdtype, p2dt, kn_zdfexp,   &
+      &                                ptb , pta      , kjpt )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_zdf_exp  ***
@@ -58,7 +58,7 @@
       !! ** Method  : - The after tracer fields due to the vertical diffusion
       !!      of tracers alone is given by:
-      !!                zwx = tb + p2dt difft
-      !!      where difft = dz( avt dz(tb) ) = 1/e3t dk+1( avt/e3w dk(tb) )
-      !!           (if lk_zdfddm=T use avs on salinity instead of avt)
+      !!                zwx = ptb + p2dt difft
+      !!      where difft = dz( avt dz(ptb) ) = 1/e3t dk+1( avt/e3w dk(ptb) )
+      !!           (if lk_zdfddm=T use avs on salinity and passive tracers instead of avt)
       !!      difft is evaluated with an Euler split-explit scheme using a
       !!      no flux boundary condition at both surface and bottomi boundaries.
@@ -66,23 +66,28 @@
       !!              - the after tracer fields due to the whole trend is 
       !!      obtained in leap-frog environment by :
-      !!          ta = zwx + p2dt ta
+      !!          pta = zwx + p2dt pta
       !!              - in case of variable level thickness (lk_vvl=T) the 
       !!     the leap-frog is applied on thickness weighted tracer. That is:
-      !!          ta = [ tb*e3tb + e3tn*( zwx - tb + p2dt ta ) ] / e3tn
+      !!          pta = [ ptb*e3tb + e3tn*( zwx - ptb + p2dt pta ) ] / e3tn
       !!
-      !! ** Action : - after tracer fields (ta,sa) 
+      !! ** Action : - after tracer fields pta
       !!---------------------------------------------------------------------
-      INTEGER , INTENT(in)                 ::   kt     ! ocean time-step index
-      REAL(wp), INTENT(in), DIMENSION(jpk) ::   p2dt   ! vertical profile of tracer time-step
-      !!
-      INTEGER  ::   ji, jj, jk, jl            ! dummy loop indices
-      REAL(wp) ::   zlavmr, zave3r, ze3tr     ! temporary scalars
-      REAL(wp) ::   zta, zsa, ze3tb           ! temporary scalars
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwx, zwy, zwz, zww   ! 3D workspace
+      INTEGER                              , INTENT(in   ) ::   kt          ! ocean time-step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype      ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt        ! number of tracers
+      INTEGER                              , INTENT(in   ) ::   kn_zdfexp   ! number of sub-time step
+      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt        ! vertical profile of tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb         ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta         ! tracer trend 
+      !! 
+      INTEGER  ::  ji, jj, jk, jn, jl        ! dummy loop indices
+      REAL(wp) ::  zlavmr, zave3r, ze3tr     ! local scalars
+      REAL(wp) ::  ztra, ze3tb               !   -      -
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwx, zwy   ! 3D workspace
       !!---------------------------------------------------------------------
 
-      IF( kt == nit000 ) THEN
+      IF( kt == nit000 )  THEN
          IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_zdf_exp : explicit vertical mixing'
+         IF(lwp) WRITE(numout,*) 'tra_zdf_exp : explicit vertical mixing on ', cdtype
          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
       ENDIF
@@ -90,62 +95,66 @@
       ! Initializations
       ! ---------------
-      zlavmr = 1. / float( nn_zdfexp )                           ! Local constant
+      zlavmr = 1. / float( kn_zdfexp )         ! Local constant
       !
-      zwy(:,:, 1 ) = 0.e0        ;   zww(:,:, 1 ) = 0.e0        ! surface boundary conditions: no flux
-      zwy(:,:,jpk) = 0.e0        ;   zww(:,:,jpk) = 0.e0        ! bottom  boundary conditions: no flux
       !
-      zwx(:,:,:)   = tb(:,:,:)   ;   zwz(:,:,:)   = sb(:,:,:)   ! zwx and zwz arrays set to before tracer values
+      DO jn = 1, kjpt                          ! loop over tracers
+         !
+         zwy(:,:, 1 ) = 0.e0     ! surface boundary conditions: no flux
+         zwy(:,:,jpk) = 0.e0     ! bottom  boundary conditions: no flux
+         !
+         zwx(:,:,:)   = ptb(:,:,:,jn)  ! zwx array set to before tracer values
 
-      ! Split-explicit loop  (after tracer due to the vertical diffusion alone)
-      ! -------------------
-      !
-      DO jl = 1, nn_zdfexp
-         !                     ! first vertical derivative
-         DO jk = 2, jpk
-            DO jj = 2, jpjm1 
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zave3r = 1.e0 / fse3w_n(ji,jj,jk) 
-                  zwy(ji,jj,jk) =   avt(ji,jj,jk) * ( zwx(ji,jj,jk-1) - zwx(ji,jj,jk) ) * zave3r
-                  zww(ji,jj,jk) = fsavs(ji,jj,jk) * ( zwz(ji,jj,jk-1) - zwz(ji,jj,jk) ) * zave3r
+         ! Split-explicit loop  (after tracer due to the vertical diffusion alone)
+         ! -------------------
+         !
+         DO jl = 1, kn_zdfexp
+            !                     ! first vertical derivative
+            DO jk = 2, jpk
+               DO jj = 2, jpjm1 
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     zave3r = 1.e0 / fse3w_n(ji,jj,jk) 
+                     IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN  ! temperature : use of avt
+                        zwy(ji,jj,jk) =   avt(ji,jj,jk) * ( zwx(ji,jj,jk-1) - zwx(ji,jj,jk) ) * zave3r
+                     ELSE                                           ! salinity or pass. tracer : use of avs
+                        zwy(ji,jj,jk) = fsavs(ji,jj,jk) * ( zwx(ji,jj,jk-1) - zwx(ji,jj,jk) ) * zave3r
+                     END IF
+                  END DO
                END DO
             END DO
-         END DO
-         !
-         DO jk = 1, jpkm1      ! second vertical derivative   ==> tracer at kt+l*2*rdt/nn_zdfexp
-            DO jj = 2, jpjm1 
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ze3tr = zlavmr / fse3t_n(ji,jj,jk)
-                  zwx(ji,jj,jk) = zwx(ji,jj,jk) + p2dt(jk) * ( zwy(ji,jj,jk) - zwy(ji,jj,jk+1) ) * ze3tr
-                  zwz(ji,jj,jk) = zwz(ji,jj,jk) + p2dt(jk) * ( zww(ji,jj,jk) - zww(ji,jj,jk+1) ) * ze3tr
+            !
+            DO jk = 1, jpkm1      ! second vertical derivative   ==> tracer at kt+l*2*rdt/nn_zdfexp
+               DO jj = 2, jpjm1 
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     ze3tr = zlavmr / fse3t_n(ji,jj,jk)
+                     zwx(ji,jj,jk) = zwx(ji,jj,jk) + p2dt(jk) * ( zwy(ji,jj,jk) - zwy(ji,jj,jk+1) ) * ze3tr
+                  END DO
                END DO
             END DO
+            !
          END DO
+
+         ! After tracer due to all trends
+         ! ------------------------------
+         IF( lk_vvl ) THEN          ! variable level thickness : leap-frog on tracer*e3t
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1 
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     ze3tb = fse3t_b(ji,jj,jk) / fse3t(ji,jj,jk)                          ! before e3t
+                     ztra  = zwx(ji,jj,jk) - ptb(ji,jj,jk,jn) + p2dt(jk) * pta(ji,jj,jk,jn)       ! total trends * 2*rdt 
+                     pta(ji,jj,jk,jn) = ( ze3tb * ptb(ji,jj,jk,jn) + ztra ) * tmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+         ELSE                       ! fixed level thickness : leap-frog on tracers
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1 
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     pta(ji,jj,jk,jn) = ( zwx(ji,jj,jk) + p2dt(jk) * pta(ji,jj,jk,jn) ) * tmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+         ENDIF
          !
       END DO
-
-      ! After tracer due to all trends
-      ! ------------------------------
-      IF( lk_vvl ) THEN          ! variable level thickness : leap-frog on tracer*e3t
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1 
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ze3tb = fse3t_b(ji,jj,jk) / fse3t(ji,jj,jk)                          ! before e3t
-                  zta   = zwx(ji,jj,jk) - tb(ji,jj,jk) + p2dt(jk) * ta(ji,jj,jk)       ! total trends * 2*rdt
-                  zsa   = zwz(ji,jj,jk) - sb(ji,jj,jk) + p2dt(jk) * sa(ji,jj,jk)     
-                  ta(ji,jj,jk) = (  ze3tb * tb(ji,jj,jk) + zta  ) * tmask(ji,jj,jk)
-                  sa(ji,jj,jk) = (  ze3tb * sb(ji,jj,jk) + zsa  ) * tmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-      ELSE                       ! fixed level thickness : leap-frog on tracers
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1 
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ta(ji,jj,jk) = ( zwx(ji,jj,jk) + p2dt(jk) * ta(ji,jj,jk) ) * tmask(ji,jj,jk)
-                  sa(ji,jj,jk) = ( zwz(ji,jj,jk) + p2dt(jk) * sa(ji,jj,jk) ) * tmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-      ENDIF
       !
    END SUBROUTINE tra_zdf_exp
Index: trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90	(revision 2528)
@@ -2,5 +2,5 @@
    !!======================================================================
    !!                 ***  MODULE  trazdf_imp  ***
-   !! Ocean active tracers:  vertical component of the tracer mixing trend
+   !! Ocean  tracers:  vertical component of the tracer mixing trend
    !!======================================================================
    !! History :  OPA  !  1990-10  (B. Blanke)  Original code
@@ -14,4 +14,5 @@
    !!            2.0  !  2006-11  (G. Madec) New step reorganisation
    !!            3.2  !  2009-03  (G. Madec)  heat and salt content trends
+   !!            3.3  !  2010-06  (C. Ethe, G. Madec) Merge TRA-TRC
    !!----------------------------------------------------------------------
   
@@ -23,14 +24,13 @@
    USE dom_oce         ! ocean space and time domain variables 
    USE zdf_oce         ! ocean vertical physics variables
+   USE trc_oce         ! share passive tracers/ocean variables
+   USE domvvl          ! variable volume
    USE ldftra_oce      ! ocean active tracers: lateral physics
+   USE ldftra          ! lateral mixing type
    USE ldfslp          ! lateral physics: slope of diffusion
-   USE trdmod          ! ocean active tracers trends 
-   USE trdmod_oce      ! ocean variables trends
    USE zdfddm          ! ocean vertical physics: double diffusion
+   USE traldf_iso_grif ! active tracers: Griffies operator
    USE in_out_manager  ! I/O manager
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE prtctl          ! Print control
-   USE domvvl          ! variable volume
-   USE ldftra          ! lateral mixing type
 
    IMPLICIT NONE
@@ -45,11 +45,11 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 CONTAINS
-   
-   SUBROUTINE tra_zdf_imp( kt, p2dt )
+ 
+   SUBROUTINE tra_zdf_imp( kt, cdtype, p2dt, ptb, pta, kjpt ) 
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_zdf_imp  ***
@@ -71,5 +71,5 @@
       !!                  associated with the lateral mixing, through the
       !!                  update of avt)
-      !!      The vertical diffusion of tracers (t & s) is given by:
+      !!      The vertical diffusion of the tracer t  is given by:
       !!             difft = dz( avt dz(t) ) = 1/e3t dk+1( avt/e3w dk(t) )
       !!      It is computed using a backward time scheme (t=ta).
@@ -78,48 +78,50 @@
       !!      Add this trend to the general trend ta,sa :
       !!         ta = ta + dz( avt dz(t) )
-      !!         (sa = sa + dz( avs dz(t) ) if lk_zdfddm=T )
+      !!         if lk_zdfddm=T, use avs for salinity or for passive tracers
+      !!         (sa = sa + dz( avs dz(t) ) 
       !!
       !!      Third part: recover avt resulting from the vertical physics
       !!      ==========  alone, for further diagnostics (for example to
       !!                  compute the turbocline depth in zdfmxl.F90).
-      !!         avt = zavt
+      !!         if lk_zdfddm=T, use avt = zavt
       !!         (avs = zavs if lk_zdfddm=T )
       !!
-      !! ** Action  : - Update (ta,sa) with before vertical diffusion trend
-      !!
+      !! ** Action  : - Update (ta) with before vertical diffusion trend
       !!---------------------------------------------------------------------
       USE oce    , ONLY :   zwd   => ua   ! ua used as workspace
       USE oce    , ONLY :   zws   => va   ! va  -          -
-      !!
-      INTEGER                 , INTENT(in) ::   kt     ! ocean time-step index
-      REAL(wp), DIMENSION(jpk), INTENT(in) ::   p2dt   ! vertical profile of tracer time-step
-      !!
-      INTEGER  ::   ji, jj, jk            ! dummy loop indices
-      REAL(wp) ::   zavi, zrhs, znvvl     ! temporary scalars
-      REAL(wp) ::   ze3tb, ze3tn, ze3ta   ! variable vertical scale factors
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwi, zwt, zavsi   ! workspace arrays
+      !! 
+      INTEGER                              , INTENT(in   ) ::   kt       ! ocean time-step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt     ! number of tracers
+      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt     ! vertical profile of tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb      ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta      ! tracer trend 
+      !!
+      INTEGER  ::  ji, jj, jk, jn        ! dummy loop indices
+      REAL(wp) ::  zavi, zrhs, znvvl     ! local scalars
+      REAL(wp) ::  ze3tb, ze3tn, ze3ta   ! variable vertical scale factors
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwi, zwt   ! workspace arrays
       !!---------------------------------------------------------------------
 
-      IF( kt == nit000 ) THEN
+      IF( kt == nit000 )  THEN
          IF(lwp)WRITE(numout,*)
-         IF(lwp)WRITE(numout,*) 'tra_zdf_imp : implicit vertical mixing'
+         IF(lwp)WRITE(numout,*) 'tra_zdf_imp : implicit vertical mixing on ', cdtype
          IF(lwp)WRITE(numout,*) '~~~~~~~~~~~ '
-         zavi = 0.e0      ! avoid warning at compilation phase when lk_ldfslp=F
+         zavi = 0._wp      ! avoid warning at compilation phase when lk_ldfslp=F
       ENDIF
-
+      !
       ! I. Local initialization
       ! -----------------------
-      zwd  (1,:, : ) = 0.e0     ;     zwd  (jpi,:,:) = 0.e0
-      zws  (1,:, : ) = 0.e0     ;     zws  (jpi,:,:) = 0.e0
-      zwi  (1,:, : ) = 0.e0     ;     zwi  (jpi,:,:) = 0.e0
-      zwt  (1,:, : ) = 0.e0     ;     zwt  (jpi,:,:) = 0.e0
-      zavsi(1,:, : ) = 0.e0     ;     zavsi(jpi,:,:) = 0.e0
-      zwt  (:,:,jpk) = 0.e0     ;     zwt  ( : ,:,1) = 0.e0
-      zavsi(:,:,jpk) = 0.e0     ;     zavsi( : ,:,1) = 0.e0
+      zwd(1,:, : ) = 0._wp     ;     zwd(jpi,:,:) = 0._wp
+      zws(1,:, : ) = 0._wp     ;     zws(jpi,:,:) = 0._wp
+      zwi(1,:, : ) = 0._wp     ;     zwi(jpi,:,:) = 0._wp
+      zwt(1,:, : ) = 0._wp     ;     zwt(jpi,:,:) = 0._wp
+      zwt(:,:,jpk) = 0._wp     ;     zwt( : ,:,1) = 0._wp
 
       ! I.1 Variable volume : to take into account vertical variable vertical scale factors
       ! -------------------
-      IF( lk_vvl ) THEN   ;    znvvl = 1.
-      ELSE                ;    znvvl = 0.e0
+      IF( lk_vvl ) THEN   ;    znvvl = 1._wp
+      ELSE                ;    znvvl = 0._wp
       ENDIF
 
@@ -130,233 +132,172 @@
       !     dk[ avt dk[ (t,s) ] ] diffusive trends
 
-
+      !
       ! II.0 Matrix construction
       ! ------------------------
-
+      DO jn = 1, kjpt
+         !
+         !  Matrix construction
+         ! ------------------------
+         IF( cdtype == 'TRA' .AND. jn == jp_tem )  THEN 
 #if defined key_ldfslp
-      ! update and save of avt (and avs if double diffusive mixing)
-      IF( l_traldf_rot ) THEN
-         DO jk = 2, jpkm1
+            IF( ln_traldf_grif ) THEN
+               DO jk = 2, jpkm1
+                  DO jj = 2, jpjm1
+                     DO ji = fs_2, fs_jpim1   ! vector opt.
+                        ! zavi = fsahtw(ji,jj,jk) * wslp2(ji,jj,jk)         ! vertical mixing coef. due to lateral mixing
+                        zavi = ah_wslp2(ji,jj,jk)                ! vertical mixing coef. due to lateral mixing
+                        zwt(ji,jj,jk) = avt(ji,jj,jk) + zavi              ! zwt=avt+zavi (total vertical mixing coef. on temperature)
+                     END DO
+                  END DO
+               END DO
+            ! update and save of avt (and avs if double diffusive mixing)
+            ELSE IF( l_traldf_rot ) THEN
+               DO jk = 2, jpkm1
+                  DO jj = 2, jpjm1
+                     DO ji = fs_2, fs_jpim1   ! vector opt.
+                        zavi = fsahtw(ji,jj,jk)                       &   ! vertical mixing coef. due to lateral mixing
+                           & * (  wslpi(ji,jj,jk) * wslpi(ji,jj,jk)   &
+                           &    + wslpj(ji,jj,jk) * wslpj(ji,jj,jk)  )
+                        zwt(ji,jj,jk) = avt(ji,jj,jk) + zavi              ! zwt=avt+zavi (total vertical mixing coef. on temperature)
+                     END DO
+                  END DO
+               END DO
+            ELSE                         ! no rotation but key_ldfslp defined
+               zwt(:,:,:) = avt(:,:,:)
+            ENDIF
+#else
+            ! No isopycnal diffusion
+            zwt(:,:,:) = avt(:,:,:)           
+#endif
+            ! Diagonal, inferior, superior  (including the bottom boundary condition via avt masked)
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     ze3ta =  ( 1. - znvvl ) +        znvvl   * fse3t_a(ji,jj,jk)   ! after scale factor at T-point
+                     ze3tn =         znvvl   + ( 1. - znvvl ) * fse3t_n(ji,jj,jk)   ! now   scale factor at T-point
+                     zwi(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk  ) / ( ze3tn * fse3w(ji,jj,jk  ) )
+                     zws(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk+1) / ( ze3tn * fse3w(ji,jj,jk+1) )
+                     zwd(ji,jj,jk) = ze3ta - zwi(ji,jj,jk) - zws(ji,jj,jk)
+                 END DO
+               END DO
+            END DO
+            ! first recurrence:   Tk = Dk - Ik Sk-1 / Tk-1   (increasing k)
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  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
+               END DO
+            END DO
+            !
+         ELSE IF( ( cdtype == 'TRA' .AND. jn == jp_sal ) .OR. ( cdtype == 'TRC' .AND. jn == 1 ) ) THEN
+#if defined key_ldfslp
+            IF( ln_traldf_grif ) THEN
+               DO jk = 2, jpkm1
+                  DO jj = 2, jpjm1
+                     DO ji = fs_2, fs_jpim1   ! vector opt.
+                        zavi = ah_wslp2(ji,jj,jk)                ! vertical mixing coef. due to lateral mixing
+                        ! zavi = fsahtw(ji,jj,jk) * wslp2(ji,jj,jk)         ! vertical mixing coef. due to lateral mixing
+                        zwt(ji,jj,jk) = fsavs(ji,jj,jk) + zavi              ! zwt=avt+zavi (total vertical mixing coef. on temperature)
+                     END DO
+                  END DO
+               END DO
+            ELSE IF( l_traldf_rot ) THEN
+               DO jk = 2, jpkm1
+                  DO jj = 2, jpjm1
+                     DO ji = fs_2, fs_jpim1   ! vector opt.
+                        zavi = fsahtw(ji,jj,jk)                       &   ! vertical mixing coef. due to lateral mixing
+                           & * (  wslpi(ji,jj,jk) * wslpi(ji,jj,jk)   &
+                           &    + wslpj(ji,jj,jk) * wslpj(ji,jj,jk)  )
+                        zwt(ji,jj,jk) = fsavs(ji,jj,jk) + zavi              ! zwt=avt+zavi (total vertical mixing coef. on salinity)
+                     END DO
+                  END DO
+               END DO
+            ELSE                         ! no rotation but key_ldfslp defined
+               zwt(:,:,:) = fsavs(:,:,:)
+            ENDIF
+#else
+            ! No isopycnal diffusion
+            zwt(:,:,:) = fsavs(:,:,:)           
+#endif
+            ! Diagonal, inferior, superior  (including the bottom boundary condition via avt masked)
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     ze3ta =  ( 1. - znvvl ) +        znvvl   * fse3t_a(ji,jj,jk)   ! after scale factor at T-point
+                     ze3tn =         znvvl   + ( 1. - znvvl ) * fse3t_n(ji,jj,jk)   ! now   scale factor at T-point
+                     zwi(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk  ) / ( ze3tn * fse3w(ji,jj,jk  ) )
+                     zws(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk+1) / ( ze3tn * fse3w(ji,jj,jk+1) )
+                     zwd(ji,jj,jk) = ze3ta - zwi(ji,jj,jk) - zws(ji,jj,jk)
+                 END DO
+               END DO
+            END DO
+            ! Surface boudary conditions
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zavi = fsahtw(ji,jj,jk)                       &   ! vertical mixing coef. due to lateral mixing
-                     & * (  wslpi(ji,jj,jk) * wslpi(ji,jj,jk)   &
-                     &    + wslpj(ji,jj,jk) * wslpj(ji,jj,jk)  )
-                  zwt(ji,jj,jk) = avt(ji,jj,jk) + zavi              ! zwt=avt+zavi (total vertical mixing coef. on temperature)
-# if defined key_zdfddm
-                  zavsi(ji,jj,jk) = fsavs(ji,jj,jk) + zavi          ! dd mixing: zavsi = total vertical mixing coef. on salinity
-# endif
-               END DO
-            END DO
-         END DO
-      ELSE                         ! no rotation but key_ldfslp defined
-         zwt  (:,:,:) = avt(:,:,:)
-# if defined key_zdfddm
-         zavsi(:,:,:) = avs(:,:,:)       ! avs /= avt (double diffusion mixing)
-# endif
-      ENDIF   
-#else
-      ! No isopycnal diffusion
-      zwt(:,:,:) = avt(:,:,:)
-# if defined key_zdfddm
-      zavsi(:,:,:) = avs(:,:,:)
-# endif
-
-#endif
-
-      ! Diagonal, inferior, superior  (including the bottom boundary condition via avt masked)
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ze3ta =  ( 1. - znvvl )   &                            ! after scale factor at T-point
-                  &   +        znvvl    * fse3t_a(ji,jj,jk) 
-               ze3tn =    znvvl          &                            ! now   scale factor at T-point
-                  &   + ( 1. - znvvl ) * fse3t_n(ji,jj,jk)
-               zwi(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk  ) / ( ze3tn * fse3w(ji,jj,jk  ) )
-               zws(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk+1) / ( ze3tn * fse3w(ji,jj,jk+1) )
-               zwd(ji,jj,jk) = ze3ta - zwi(ji,jj,jk) - zws(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-
-      ! Surface boudary conditions
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            ze3ta = ( 1. - znvvl )        &                           ! after scale factor at T-point
-               &   +       znvvl      * fse3t_a(ji,jj,1) 
-            zwi(ji,jj,1) = 0.e0
-            zwd(ji,jj,1) = ze3ta - zws(ji,jj,1)
-         END DO
-      END DO
-
-
-      ! II.1. Vertical diffusion on t
-      ! ---------------------------
-
-      !! Matrix inversion from the first level
-      !!----------------------------------------------------------------------
-      !   solve m.x = y  where m is a tri diagonal matrix ( jpk*jpk )
-      !
-      !        ( zwd1 zws1   0    0    0  )( zwx1 ) ( zwy1 )
-      !        ( zwi2 zwd2 zws2   0    0  )( zwx2 ) ( zwy2 )
-      !        (  0   zwi3 zwd3 zws3   0  )( zwx3 )=( zwy3 )
-      !        (        ...               )( ...  ) ( ...  )
-      !        (  0    0    0   zwik zwdk )( zwxk ) ( zwyk )
-      !
-      !   m is decomposed in the product of an upper and lower triangular matrix
-      !   The 3 diagonal terms are in 2d arrays: zwd, zws, zwi
-      !   The second member is in 2d array zwy
-      !   The solution is in 2d array zwx
-      !   The 3d arry zwt is a work space array
-      !   zwy is used and then used as a work space array : its value is modified!
-
-      ! first recurrence:   Tk = Dk - Ik Sk-1 / Tk-1   (increasing k)
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1
-            zwt(ji,jj,1) = zwd(ji,jj,1)
-         END DO
-      END DO
-      DO jk = 2, jpkm1
+                 ze3ta = ( 1. - znvvl ) +  znvvl * fse3t_a(ji,jj,1)    ! after scale factor at T-point
+                 zwi(ji,jj,1) = 0._wp
+                 zwd(ji,jj,1) = ze3ta - zws(ji,jj,1)
+               END DO
+            END DO
+            !
+            ! first recurrence:   Tk = Dk - Ik Sk-1 / Tk-1   (increasing k)
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  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
+               END DO
+            END DO
+            !
+         END IF 
+
+         ! II.1. Vertical diffusion on tracer
+         ! ---------------------------
+         
+         ! second recurrence:    Zk = Yk - Ik / Tk-1  Zk-1
          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)
+               ze3tb = ( 1. - znvvl ) + znvvl * fse3t_b(ji,jj,1)
+               ze3tn = ( 1. - znvvl ) + znvvl * 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
-      END DO
-
-      ! second recurrence:    Zk = Yk - Ik / Tk-1  Zk-1
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1
-            ze3tb = ( 1. - znvvl ) + znvvl * fse3t_b(ji,jj,1)
-            ze3tn = ( 1. - znvvl ) + znvvl * fse3t(ji,jj,1)
-            ta(ji,jj,1) = ze3tb * tb(ji,jj,1) + p2dt(1) * ze3tn * ta(ji,jj,1)
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  ze3tb = ( 1. - znvvl ) + znvvl * fse3t_b(ji,jj,jk)
+                  ze3tn = ( 1. - znvvl ) + znvvl * fse3t  (ji,jj,jk)
+                  zrhs = ze3tb * ptb(ji,jj,jk,jn) + p2dt(jk) * ze3tn * pta(ji,jj,jk,jn)   ! zrhs=right hand side 
+                  pta(ji,jj,jk,jn) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * pta(ji,jj,jk-1,jn)
+               END DO
+            END DO
          END DO
-      END DO
-      DO jk = 2, jpkm1
+
+         ! third recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1
-               ze3tb = ( 1. - znvvl ) + znvvl * fse3t_b(ji,jj,jk)
-               ze3tn = ( 1. - znvvl ) + znvvl * fse3t  (ji,jj,jk)
-               zrhs = ze3tb * tb(ji,jj,jk) + p2dt(jk) * ze3tn * ta(ji,jj,jk)   ! zrhs=right hand side 
-               ta(ji,jj,jk) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * ta(ji,jj,jk-1)
+               pta(ji,jj,jpkm1,jn) = pta(ji,jj,jpkm1,jn) / zwt(ji,jj,jpkm1) * tmask(ji,jj,jpkm1)
             END DO
          END DO
-      END DO
-
-      ! third recurrence: Xk = (Zk - Sk Xk+1 ) / Tk
-      ! Save the masked temperature after in ta
-      ! (c a u t i o n:  temperature not its trend, Leap-frog scheme done it will not be done in tranxt)
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1
-            ta(ji,jj,jpkm1) = ta(ji,jj,jpkm1) / zwt(ji,jj,jpkm1) * tmask(ji,jj,jpkm1)
+         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)
+               END DO
+            END DO
          END DO
-      END DO
-      DO jk = jpk-2, 1, -1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               ta(ji,jj,jk) = ( ta(ji,jj,jk) - zws(ji,jj,jk) * ta(ji,jj,jk+1) ) / zwt(ji,jj,jk) * tmask(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-
-      ! II.2 Vertical diffusion on salinity
-      ! -----------------------------------
-
-#if defined key_zdfddm
-      ! Rebuild the Matrix as avt /= avs
-
-      ! Diagonal, inferior, superior  (including the bottom boundary condition via avs masked)
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ze3ta =  ( 1. - znvvl )                        &         ! after scale factor at T-point
-                  &   +        znvvl   * fse3t_a(ji,jj,jk)           
-               ze3tn =    znvvl                               &         ! now   scale factor at T-point
-                  &   + ( 1. - znvvl ) * fse3t_n(ji,jj,jk)
-               zwi(ji,jj,jk) = - p2dt(jk) * zavsi(ji,jj,jk  ) / ( ze3tn * fse3w(ji,jj,jk  ) )
-               zws(ji,jj,jk) = - p2dt(jk) * zavsi(ji,jj,jk+1) / ( ze3tn * fse3w(ji,jj,jk+1) )
-               zwd(ji,jj,jk) = ze3ta - zwi(ji,jj,jk) - zws(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-
-      ! Surface boudary conditions
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            ze3ta = ( 1. - znvvl ) + znvvl * fse3t_a(ji,jj,1)
-            zwi(ji,jj,1) = 0.e0
-            zwd(ji,jj,1) = ze3ta - zws(ji,jj,1)
-         END DO
-      END DO
-#endif
-
-
-      !! Matrix inversion from the first level
-      !!----------------------------------------------------------------------
-      !   solve m.x = y  where m is a tri diagonal matrix ( jpk*jpk )
-      !
-      !        ( zwd1 zws1   0    0    0  )( zwx1 ) ( zwy1 )
-      !        ( zwi2 zwd2 zws2   0    0  )( zwx2 ) ( zwy2 )
-      !        (  0   zwi3 zwd3 zws3   0  )( zwx3 )=( zwy3 )
-      !        (        ...               )( ...  ) ( ...  )
-      !        (  0    0    0   zwik zwdk )( zwxk ) ( zwyk )
-      !
-      !   m is decomposed in the product of an upper and lower triangular
-      !   matrix
-      !   The 3 diagonal terms are in 2d arrays: zwd, zws, zwi
-      !   The second member is in 2d array zwy
-      !   The solution is in 2d array zwx
-      !   The 3d arry zwt is a work space array
-      !   zwy is used and then used as a work space array : its value is modified!
-
-      ! first recurrence:   Tk = Dk - Ik Sk-1 / Tk-1   (increasing k)
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1
-            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
-         END DO
-      END DO
-
-      ! second recurrence:    Zk = Yk - Ik / Tk-1  Zk-1
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1
-            ze3tb = ( 1. - znvvl )   &                                           ! before scale factor at T-point
-               &   +  znvvl       * fse3t_b(ji,jj,1)
-            ze3tn = ( 1. - znvvl ) + znvvl * fse3t  (ji,jj,1)                    ! now    scale factor at T-point
-            sa(ji,jj,1) = ze3tb * sb(ji,jj,1) + p2dt(1) * ze3tn * sa(ji,jj,1)
-         END DO
-      END DO
-      DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               ze3tb = ( 1. - znvvl )   &                                        ! before scale factor at T-point
-                  &   +  znvvl       * fse3t_b(ji,jj,jk)
-               ze3tn = ( 1. - znvvl ) + znvvl * fse3t  (ji,jj,jk)                ! now    scale factor at T-point
-               zrhs = ze3tb * sb(ji,jj,jk) + p2dt(jk) * ze3tn * sa(ji,jj,jk)     ! zrhs=right hand side
-               sa(ji,jj,jk) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) *sa(ji,jj,jk-1)
-            END DO
-         END DO
-      END DO
-
-      ! third recurrence: Xk = (Zk - Sk Xk+1 ) / Tk
-      ! Save the masked temperature after in ta
-      ! (c a u t i o n:  temperature not its trend, Leap-frog scheme done it will not be done in tranxt)
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1
-            sa(ji,jj,jpkm1) = sa(ji,jj,jpkm1) / zwt(ji,jj,jpkm1) * tmask(ji,jj,jpkm1)
-         END DO
-      END DO
-      DO jk = jpk-2, 1, -1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               sa(ji,jj,jk) = ( sa(ji,jj,jk) - zws(ji,jj,jk) * sa(ji,jj,jk+1) ) / zwt(ji,jj,jk) * tmask(ji,jj,jk)
-            END DO
-         END DO
+         !
       END DO
       !
Index: trunk/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90	(revision 2528)
@@ -1,7 +1,12 @@
 MODULE zpshde
-   !!==============================================================================
+   !!======================================================================
    !!                       ***  MODULE zpshde   ***
-   !! z-coordinate - partial step : Horizontal Derivative
-   !!==============================================================================
+   !! z-coordinate + partial step : Horizontal Derivative at ocean bottom level
+   !!======================================================================
+   !! History :  OPA  !  2002-04  (A. Bozec)  Original code
+   !!   NEMO     1.0  !  2002-08  (G. Madec E. Durand)  Optimization and Free form
+   !!             -   !  2004-03  (C. Ethe)  adapted for passive tracers
+   !!            3.3  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA 
+   !!======================================================================
    
    !!----------------------------------------------------------------------
@@ -9,10 +14,9 @@
    !!                   ocean level (Z-coord. with Partial Steps)
    !!----------------------------------------------------------------------
-   !! * Modules used
-   USE dom_oce         ! ocean space domain variables
-   USE oce             ! ocean dynamics and tracers variables
+   USE oce             ! ocean: dynamics and tracers variables
+   USE dom_oce         ! domain: ocean variables
    USE phycst          ! physical constants
+   USE eosbn2          ! ocean equation of state
    USE in_out_manager  ! I/O manager
-   USE eosbn2          ! ocean equation of state
    USE lbclnk          ! lateral boundary conditions (or mpp link)
 
@@ -20,10 +24,5 @@
    PRIVATE
 
-   !! * Routine accessibility
-   PUBLIC zps_hde          ! routine called by step.F90
-
-   !! * module variables
-   INTEGER, DIMENSION(jpi,jpj) ::   &
-      mbatu, mbatv      ! bottom ocean level index at U- and V-points
+   PUBLIC   zps_hde    ! routine called by step.F90
 
    !! * Substitutions
@@ -31,18 +30,16 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 CONTAINS
 
-   SUBROUTINE zps_hde ( kt, ptem, psal, prd ,   &
-                            pgtu, pgsu, pgru,   &
-                            pgtv, pgsv, pgrv  )
+   SUBROUTINE zps_hde( kt, kjpt, pta, pgtu, pgtv,   &
+                                 prd, pgru, pgrv    )
       !!----------------------------------------------------------------------
       !!                     ***  ROUTINE zps_hde  ***
       !!                    
-      !! ** Purpose :   Compute the horizontal derivative of T, S and rd
+      !! ** 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.
@@ -78,162 +75,129 @@
       !!      formulation 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  : - pgtu, pgsu, pgru: horizontal gradient of T, S
-      !!                and rd at U-points 
-      !!              - pgtv, pgsv, pgrv: horizontal gradient of T, S
-      !!                and rd at V-points 
-      !!
-      !! History :
-      !!   8.5  !  02-04  (A. Bozec)  Original code
-      !!   8.5  !  02-08  (G. Madec E. Durand)  Optimization and Free form
+      !!          di(rho) = rd~ - rd(i,j,k) or rd(i+1,j,k) - rd~
+      !!
+      !! ** Action  : - pgtu, pgtv: horizontal gradient of tracer at u- & v-points
+      !!              - pgru, pgrv: horizontal gradient of rho (if present) at u- & v-points 
       !!----------------------------------------------------------------------
-      !! * Arguments
-      INTEGER, INTENT( in ) ::   kt ! ocean time-step index
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::   &
-         ptem, psal, prd            ! 3D T, S and rd fields
-      REAL(wp), DIMENSION(jpi,jpj), INTENT( out ) ::   &
-         pgtu, pgsu, pgru,       &  ! horizontal grad. of T, S and rd at u- 
-         pgtv, pgsv, pgrv           ! and v-points of the partial step level
-
-      !! * Local declarations
-      INTEGER ::   ji, jj,       &  ! Dummy loop indices
-                   iku,ikv          ! partial step level at u- and v-points
-      REAL(wp), DIMENSION(jpi,jpj) ::   &
-         zti, ztj, zsi, zsj,     &  ! interpolated value of T, S 
-         zri, zrj,               &  ! and rd
-         zhgi, zhgj                 ! depth of interpolation for eos2d
-      REAL(wp) ::   &
-         ze3wu, ze3wv,           &  ! temporary scalars
-         zmaxu1, zmaxu2,         &  !    "         "
-         zmaxv1, zmaxv2             !    "         "
-
-      ! Initialization (first time-step only): compute mbatu and mbatv
-      IF( kt == nit000 ) THEN
-         mbatu(:,:) = 0
-         mbatv(:,:) = 0
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               mbatu(ji,jj) = MAX( MIN( mbathy(ji,jj), mbathy(ji+1,jj  ) ) - 1, 2 )
-               mbatv(ji,jj) = MAX( MIN( mbathy(ji,jj), mbathy(ji  ,jj+1) ) - 1, 2 )
-            END DO
-         END DO
-         zti(:,:) = FLOAT( mbatu(:,:) )
-         ztj(:,:) = FLOAT( mbatv(:,:) )
-         ! lateral boundary conditions: T-point, sign unchanged
-         CALL lbc_lnk( zti , 'U', 1. )
-         CALL lbc_lnk( ztj , 'V', 1. )
-         mbatu(:,:) = MAX( INT( zti(:,:) ), 2 )
-         mbatv(:,:) = MAX( INT( ztj(:,:) ), 2 )
-      ENDIF
-      
-
-      ! Interpolation of T and S at the last ocean level
+      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 
+      !!
+      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), DIMENSION(jpi,jpj,kjpt) ::   zti, ztj     ! interpolated value of tracer
+      REAL(wp), DIMENSION(jpi,jpj)      ::   zri, zrj     ! interpolated value of rd
+      REAL(wp), DIMENSION(jpi,jpj)      ::   zhi, zhj     ! depth of interpolation for eos2d
+      REAL(wp) ::  ze3wu, ze3wv, zmaxu, zmaxv  ! temporary scalars
+      !!----------------------------------------------------------------------
+
+      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==!
+         !
 # if defined key_vectopt_loop
          jj = 1
          DO ji = 1, jpij-jpi   ! vector opt. (forced unrolled)
 # else
-      DO jj = 1, jpjm1
-         DO ji = 1, jpim1
-# endif
-            ! last level
-            iku = mbatu(ji,jj)
-            ikv = mbatv(ji,jj)
-
-            ze3wu  = fse3w(ji+1,jj  ,iku) - fse3w(ji,jj,iku)
-            ze3wv  = fse3w(ji  ,jj+1,ikv) - fse3w(ji,jj,ikv)
-            zmaxu1 =  ze3wu / fse3w(ji+1,jj  ,iku)
-            zmaxu2 = -ze3wu / fse3w(ji  ,jj  ,iku)
-            zmaxv1 =  ze3wv / fse3w(ji  ,jj+1,ikv)
-            zmaxv2 = -ze3wv / fse3w(ji  ,jj  ,ikv)
-
-            ! i- direction
-
-            IF( ze3wu >= 0. ) THEN      ! case 1
-               ! interpolated values of T and S
-               zti(ji,jj) = ptem(ji+1,jj,iku) + zmaxu1 * ( ptem(ji+1,jj,iku-1) - ptem(ji+1,jj,iku) )
-               zsi(ji,jj) = psal(ji+1,jj,iku) + zmaxu1 * ( psal(ji+1,jj,iku-1) - psal(ji+1,jj,iku) )
-               ! depth of the partial step level
-               zhgi(ji,jj) = fsdept(ji,jj,iku)
-               ! gradient of T and S
-               pgtu(ji,jj) = umask(ji,jj,1) * ( zti(ji,jj) - ptem(ji,jj,iku) )
-               pgsu(ji,jj) = umask(ji,jj,1) * ( zsi(ji,jj) - psal(ji,jj,iku) )
-
-            ELSE                        ! case 2
-               ! interpolated values of T and S
-               zti(ji,jj) = ptem(ji,jj,iku) + zmaxu2 * ( ptem(ji,jj,iku-1) - ptem(ji,jj,iku) )
-               zsi(ji,jj) = psal(ji,jj,iku) + zmaxu2 * ( psal(ji,jj,iku-1) - psal(ji,jj,iku) )
-               ! depth of the partial step level
-               zhgi(ji,jj) = fsdept(ji+1,jj,iku)
-               ! gradient of T and S 
-               pgtu(ji,jj) = umask(ji,jj,1) * ( ptem(ji+1,jj,iku) - zti (ji,jj) )
-               pgsu(ji,jj) = umask(ji,jj,1) * ( psal(ji+1,jj,iku) - zsi (ji,jj) )
-            ENDIF
-
-            ! j- direction
-
-            IF( ze3wv >= 0. ) THEN      ! case 1
-               ! interpolated values of T and S
-               ztj(ji,jj) = ptem(ji,jj+1,ikv) + zmaxv1 * ( ptem(ji,jj+1,ikv-1) - ptem(ji,jj+1,ikv) )
-               zsj(ji,jj) = psal(ji,jj+1,ikv) + zmaxv1 * ( psal(ji,jj+1,ikv-1) - psal(ji,jj+1,ikv) )
-               ! depth of the partial step level
-               zhgj(ji,jj) = fsdept(ji,jj,ikv) 
-               ! gradient of T and S
-               pgtv(ji,jj) = vmask(ji,jj,1) * ( ztj(ji,jj) - ptem(ji,jj,ikv) )
-               pgsv(ji,jj) = vmask(ji,jj,1) * ( zsj(ji,jj) - psal(ji,jj,ikv) )
-
-            ELSE                        ! case 2
-               ! interpolated values of T and S
-               ztj(ji,jj) = ptem(ji,jj,ikv) + zmaxv2 * ( ptem(ji,jj,ikv-1) - ptem(ji,jj,ikv) )
-               zsj(ji,jj) = psal(ji,jj,ikv) + zmaxv2 * ( psal(ji,jj,ikv-1) - psal(ji,jj,ikv) ) 
-               ! depth of the partial step level
-               zhgj(ji,jj) = fsdept(ji,jj+1,ikv) 
-               ! gradient of T and S
-               pgtv(ji,jj) = vmask(ji,jj,1) * ( ptem(ji,jj+1,ikv) - ztj(ji,jj) )
-               pgsv(ji,jj) = vmask(ji,jj,1) * ( psal(ji,jj+1,ikv) - zsj(ji,jj) )
-            ENDIF
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+# endif
+               iku = mbku(ji,jj)   ;   ikum1 = MAX( iku , 1 )        ! last and before last ocean level at u- & v-points
+               ikv = mbkv(ji,jj)   ;   ikvm1 = MAX( ikv , 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
 # if ! defined key_vectopt_loop
+            END DO
+# endif
          END DO
-# endif
+         CALL lbc_lnk( pgtu(:,:,jn), 'U', -1. )   ;   CALL lbc_lnk( pgtv(:,:,jn), 'V', -1. )   ! Lateral boundary cond.
+         !
       END DO
 
-      ! Compute interpolated rd from zti, zsi, ztj, zsj for the 2 cases at the depth of the partial
-      ! step and store it in  zri, zrj for each  case
-      CALL eos( zti, zsi, zhgi, zri )
-      CALL eos( ztj, zsj, zhgj, zrj )
-
-
-      ! Gradient of density at the last level 
+      ! horizontal derivative of density anomalies (rd)
+      IF( PRESENT( prd ) ) THEN         ! depth of the partial step level
 # if defined key_vectopt_loop
          jj = 1
          DO ji = 1, jpij-jpi   ! vector opt. (forced unrolled)
 # else
-      DO jj = 1, jpjm1
-         DO ji = 1, jpim1
-# endif
-            iku = mbatu(ji,jj)
-            ikv = mbatv(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. ) THEN    ! i-direction: case 1
-               pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji,jj) - prd(ji,jj,iku) )
-            ELSE                      ! i-direction: case 2
-               pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj) )
-            ENDIF
-            IF( ze3wv >= 0. ) THEN    ! j-direction: case 1
-               pgrv(ji,jj) = vmask(ji,jj,1) * ( zrj(ji,jj) - prd(ji,jj,ikv) )  
-            ELSE                      ! j-direction: case 2
-               pgrv(ji,jj) = vmask(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj) )
-            ENDIF
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+# endif
+               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
 # if ! defined key_vectopt_loop
+            END DO
+# endif
          END DO
-# endif
-      END DO
-
-      ! Lateral boundary conditions on each gradient
-      CALL lbc_lnk( pgtu , 'U', -1. )   ;   CALL lbc_lnk( pgtv , 'V', -1. )
-      CALL lbc_lnk( pgsu , 'U', -1. )   ;   CALL lbc_lnk( pgsv , 'V', -1. )
-      CALL lbc_lnk( pgru , 'U', -1. )   ;   CALL lbc_lnk( pgrv , 'V', -1. )
-
+
+         ! 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 
+# if defined key_vectopt_loop
+         jj = 1
+         DO ji = 1, jpij-jpi   ! vector opt. (forced unrolled)
+# else
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+# endif
+               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
+# if ! defined key_vectopt_loop
+            END DO
+# endif
+         END DO
+         CALL lbc_lnk( pgru , 'U', -1. )   ;   CALL lbc_lnk( pgrv , 'V', -1. )   ! Lateral boundary conditions
+         !
+      END IF
+      !
    END SUBROUTINE zps_hde
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdicp.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdicp.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdicp.F90	(revision 2528)
@@ -4,9 +4,5 @@
    !! Ocean diagnostics:  ocean tracers and dynamic trends
    !!=====================================================================
-   !! History :       !  91-12 (G. Madec)
-   !!                 !  92-06 (M. Imbard) add time step frequency
-   !!                 !  96-01 (G. Madec)  terrain following coordinates
-   !!            8.5  !  02-06 (G. Madec)  F90: Free form and module
-   !!            9.0  !  04-08 (C. Talandier) New trends organization
+   !! History :  1.0  !  2004-08 (C. Talandier) New trends organization
    !!----------------------------------------------------------------------
 #if  defined key_trdtra   ||   defined key_trddyn   ||   defined key_esopa
@@ -14,5 +10,4 @@
    !!   'key_trdtra'  or                  active tracers trends diagnostics
    !!   'key_trddyn'                            momentum trends diagnostics
-   !!----------------------------------------------------------------------
    !!----------------------------------------------------------------------
    !!   trd_icp          : compute the basin averaged properties for tra/dyn 
@@ -48,12 +43,12 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
 CONTAINS
 
-   SUBROUTINE trd_2d( ptrd2dx, ptrd2dy, ktrd , ctype, clpas )
+   SUBROUTINE trd_2d( ptrd2dx, ptrd2dy, ktrd , ctype )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE trd_2d  ***
@@ -66,15 +61,10 @@
       INTEGER                     , INTENT(in   ) ::   ktrd                ! tracer trend index
       CHARACTER(len=3)            , INTENT(in   ) ::   ctype               ! momentum ('DYN') or tracers ('TRA') trends
-      CHARACTER(len=3)            , INTENT(in   ), OPTIONAL ::   clpas     ! number of passage
       !!
       INTEGER  ::   ji, jj                                                 ! loop indices
-      CHARACTER(len=3) ::   cpas                                           ! number of passage
       REAL(wp) ::   zmsku, zbtu, zbt                                       ! temporary scalars
       REAL(wp) ::   zmskv, zbtv                                            !    "         "
       !!----------------------------------------------------------------------
 
-      ! Control of optional arguments
-      cpas = 'fst'
-      IF( PRESENT(clpas) )  cpas = clpas
 
       ! 1. Mask trends
@@ -123,8 +113,6 @@
          !
       CASE( 'TRA' )              ! Tracers
-         IF( cpas == 'fst' )   THEN
-            tmo(ktrd) = 0.e0
-            smo(ktrd) = 0.e0
-         ENDIF
+         tmo(ktrd) = 0.e0
+         smo(ktrd) = 0.e0
          DO jj = 1, jpj
             DO ji = 1, jpi
@@ -156,8 +144,6 @@
          !
       CASE( 'TRA' )              ! Tracers
-         IF( cpas == 'fst' )   THEN
-            t2(ktrd) = 0.e0
-            s2(ktrd) = 0.e0
-         ENDIF
+         t2(ktrd) = 0.e0
+         s2(ktrd) = 0.e0
          DO jj = 1, jpj
             DO ji = 1, jpi
@@ -173,5 +159,5 @@
 
 
-   SUBROUTINE trd_3d( ptrd3dx, ptrd3dy, ktrd, ctype, clpas )
+   SUBROUTINE trd_3d( ptrd3dx, ptrd3dy, ktrd, ctype )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE trd_3d  ***
@@ -184,14 +170,8 @@
       INTEGER,                          INTENT(in   ) ::   ktrd               ! momentum or tracer trend index
       CHARACTER(len=3),                 INTENT(in   ) ::   ctype              ! momentum ('DYN') or tracers ('TRA') trends
-      CHARACTER(len=3),                 INTENT(in   ), OPTIONAL ::   clpas    ! number of passage
       !!
       INTEGER ::   ji, jj, jk
-      CHARACTER(len=3) ::   cpas                                              ! number of passage
       REAL(wp) ::   zbt, zbtu, zbtv, zmsku, zmskv                             ! temporary scalars
       !!----------------------------------------------------------------------
-
-      ! Control of optional arguments
-      cpas = 'fst'
-      IF( PRESENT(clpas) )  cpas = clpas
 
       ! 1. Mask the trends
@@ -242,8 +222,6 @@
          !
       CASE( 'TRA' )              ! Tracers
-         IF( cpas == 'fst' )   THEN
-            tmo(ktrd) = 0.e0
-            smo(ktrd) = 0.e0
-         ENDIF
+         tmo(ktrd) = 0.e0
+         smo(ktrd) = 0.e0
          DO jk = 1, jpkm1
             DO jj = 1, jpj
@@ -279,8 +257,6 @@
          !
       CASE( 'TRA' )              ! Tracers
-         IF( cpas == 'fst' )   THEN
-            t2(ktrd) = 0.e0
-            s2(ktrd) = 0.e0
-         ENDIF
+         t2(ktrd) = 0.e0
+         s2(ktrd) = 0.e0
          DO jk = 1, jpk
             DO jj = 1, jpj
@@ -389,5 +365,5 @@
          zkepe(:,:,:) = 0.e0
    
-         CALL eos( tn, sn, rhd, rhop )       ! now potential and in situ densities
+         CALL eos( tsn, rhd, rhop )       ! now potential and in situ densities
 
          ! Density flux at w-point
@@ -600,5 +576,6 @@
             WRITE (numout,*)
             WRITE (numout,9400) kt
-            WRITE (numout,9401) (tmo(jpicpt_xad)+tmo(jpicpt_yad))/ tvolt, (smo(jpicpt_xad)+smo(jpicpt_yad))/ tvolt
+            WRITE (numout,9401)  tmo(jpicpt_xad) / tvolt, smo(jpicpt_xad) / tvolt
+            WRITE (numout,9411)  tmo(jpicpt_yad) / tvolt, smo(jpicpt_yad) / tvolt
             WRITE (numout,9402)  tmo(jpicpt_zad) / tvolt, smo(jpicpt_zad) / tvolt
             WRITE (numout,9403)  tmo(jpicpt_ldf) / tvolt, smo(jpicpt_ldf) / tvolt
@@ -617,5 +594,6 @@
 9400     FORMAT(' tracer trend at it= ',i6,' :     temperature',   &
               '              salinity',/' ============================')
-9401     FORMAT(' horizontal advection        ',e20.13,'     ',e20.13)
+9401     FORMAT(' zonal      advection        ',e20.13,'     ',e20.13)
+9411     FORMAT(' meridional advection        ',e20.13,'     ',e20.13)
 9402     FORMAT(' vertical advection          ',e20.13,'     ',e20.13)
 9403     FORMAT(' horizontal diffusion        ',e20.13,'     ',e20.13)
@@ -633,5 +611,6 @@
             WRITE (numout,*)
             WRITE (numout,9420) kt
-            WRITE (numout,9421) ( t2(jpicpt_xad)+t2(jpicpt_yad) )/ tvolt, ( s2(jpicpt_xad)+s2(jpicpt_yad) )/ tvolt
+            WRITE (numout,9421)   t2(jpicpt_xad) / tvolt, s2(jpicpt_xad) / tvolt
+            WRITE (numout,9431)   t2(jpicpt_yad) / tvolt, s2(jpicpt_yad) / tvolt
             WRITE (numout,9422)   t2(jpicpt_zad) / tvolt, s2(jpicpt_zad) / tvolt
             WRITE (numout,9423)   t2(jpicpt_ldf) / tvolt, s2(jpicpt_ldf) / tvolt
@@ -650,5 +629,6 @@
 9420     FORMAT(' tracer**2 trend at it= ', i6, ' :      temperature',   &
             '               salinity', /, ' ===============================')
-9421     FORMAT(' horizontal advection      * t   ', e20.13, '     ', e20.13)
+9421     FORMAT(' zonal      advection      * t   ', e20.13, '     ', e20.13)
+9431     FORMAT(' meridional advection      * t   ', e20.13, '     ', e20.13)
 9422     FORMAT(' vertical advection        * t   ', e20.13, '     ', e20.13)
 9423     FORMAT(' horizontal diffusion      * t   ', e20.13, '     ', e20.13)
@@ -705,19 +685,17 @@
 
 CONTAINS
-   SUBROUTINE trd_2d( ptrd2dx, ptrd2dy, ktrd , ctype, clpas )       ! Empty routine
+   SUBROUTINE trd_2d( ptrd2dx, ptrd2dy, ktrd , ctype )       ! Empty routine
       REAL, DIMENSION(:,:) ::   ptrd2dx, ptrd2dy
       INTEGER                     , INTENT(in   ) ::   ktrd         ! tracer trend index
       CHARACTER(len=3)            , INTENT(in   ) ::   ctype        ! momentum ('DYN') or tracers ('TRA') trends
-      CHARACTER(len=3), INTENT(in), OPTIONAL ::   clpas             ! number of passage
       WRITE(*,*) 'trd_2d: You should not have seen this print! error ?', &
-          &       ptrd2dx(1,1), ptrd2dy(1,1), ktrd, ctype, clpas
+          &       ptrd2dx(1,1), ptrd2dy(1,1), ktrd, ctype
    END SUBROUTINE trd_2d
-   SUBROUTINE trd_3d( ptrd3dx, ptrd3dy, ktrd , ctype, clpas )       ! Empty routine
+   SUBROUTINE trd_3d( ptrd3dx, ptrd3dy, ktrd , ctype )       ! Empty routine
       REAL, DIMENSION(:,:,:) ::   ptrd3dx, ptrd3dy
       INTEGER                     , INTENT(in   ) ::   ktrd         ! tracer trend index
       CHARACTER(len=3)            , INTENT(in   ) ::   ctype        ! momentum ('DYN') or tracers ('TRA') trends
-      CHARACTER(len=3), INTENT(in), OPTIONAL ::   clpas             ! number of passage
       WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', &
-          &       ptrd3dx(1,1,1), ptrd3dy(1,1,1), ktrd, ctype, clpas
+          &       ptrd3dx(1,1,1), ptrd3dy(1,1,1), ktrd, ctype
    END SUBROUTINE trd_3d
    SUBROUTINE trd_icp_init               ! Empty routine
Index: trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdicp_oce.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdicp_oce.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdicp_oce.F90	(revision 2528)
@@ -84,7 +84,7 @@
 #endif
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!======================================================================
 END MODULE trdicp_oce
Index: trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld.F90	(revision 2528)
@@ -56,7 +56,7 @@
 #  include "zdfddm_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -757,5 +757,5 @@
       END IF
 
-      IF( ( lk_trdmld ) .AND. ( n_cla == 1 ) ) THEN
+      IF( ( lk_trdmld ) .AND. ( nn_cla == 1 ) ) THEN
          WRITE(numout,cform_war)
          WRITE(numout,*) '                You set n_cla = 1. Note that the Mixed-Layer diagnostics  '
@@ -873,5 +873,5 @@
       IF(lwp) WRITE(numout,*) ' Name of NETCDF file ', clhstnam
       CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,                                            &
-      &             1, jpi, 1, jpj, nit000-1, zjulian, rdt, nh_t, nidtrd, domain_id=nidom )
+      &             1, jpi, 1, jpj, nit000-1, zjulian, rdt, nh_t, nidtrd, domain_id=nidom, snc4chunks=snc4set )
 
       !-- Define the ML depth variable
@@ -925,5 +925,5 @@
 
       !-- Leave IOIPSL/NetCDF define mode
-      CALL histend( nidtrd )
+      CALL histend( nidtrd, snc4set )
 
 #endif        /* key_dimgout */
Index: trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld_oce.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld_oce.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld_oce.F90	(revision 2528)
@@ -83,7 +83,7 @@
 #endif
    !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!======================================================================
 END MODULE trdmld_oce
Index: trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld_rst.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld_rst.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld_rst.F90	(revision 2528)
@@ -23,7 +23,7 @@
 
    !!---------------------------------------------------------------------------------
-   !! OPA 9.0 , LOCEAN-IPSL (2006) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!---------------------------------------------------------------------------------
   
Index: trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod.F90	(revision 2528)
@@ -4,6 +4,7 @@
    !! Ocean diagnostics:  ocean tracers and dynamic trends
    !!=====================================================================
-   !! History :  9.0  !  04-08  (C. Talandier) Original code
-   !!                 !  05-04  (C. Deltel)    Add Asselin trend in the ML budget
+   !! History :  1.0  !  2004-08  (C. Talandier) Original code
+   !!             -   !  2005-04  (C. Deltel)    Add Asselin trend in the ML budget
+   !!            3.3  ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase
    !!----------------------------------------------------------------------
 #if  defined key_trdtra || defined key_trddyn || defined key_trdmld || defined key_trdvor || defined key_esopa
@@ -36,12 +37,12 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
 CONTAINS
 
-   SUBROUTINE trd_mod( ptrdx, ptrdy, ktrd, ctype, kt, cnbpas )
+   SUBROUTINE trd_mod( ptrdx, ptrdy, ktrd, ctype, kt )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE trd_mod  ***
@@ -53,10 +54,8 @@
       INTEGER, INTENT( in ) ::   ktrd                              ! tracer trend index
       CHARACTER(len=3), INTENT( in ) ::   ctype                    ! momentum or tracers trends type 'DYN'/'TRA'
-      CHARACTER(len=3), INTENT( in ), OPTIONAL ::   cnbpas         ! number of passage
       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   ptrdx ! Temperature or U trend 
       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   ptrdy ! Salinity    or V trend
       !!
       INTEGER ::   ji, jj
-      CHARACTER(len=3) ::   ccpas                                  ! number of passage
       REAL(wp), DIMENSION(jpi,jpj) ::   ztswu, ztswv               ! 2D workspace
       REAL(wp), DIMENSION(jpi,jpj) ::   ztbfu, ztbfv               ! 2D workspace
@@ -65,8 +64,4 @@
 
       z2dx(:,:)   = 0.e0   ;   z2dy(:,:)   = 0.e0                  ! initialization of workspace arrays
-
-      ! Control of optional arguments
-      ccpas = 'fst'
-      IF( PRESENT(cnbpas) )  ccpas = cnbpas
 
       IF( neuler == 0 .AND. kt == nit000    ) THEN   ;   r2dt =      rdt      ! = rdtra (restarting with Euler time stepping)
@@ -95,5 +90,5 @@
             CASE ( jptra_trd_yad )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_yad, ctype )   ! y- horiz adv
             CASE ( jptra_trd_zad )                                                         ! z- vertical adv 
-               CALL trd_icp( ptrdx, ptrdy, jpicpt_zad, ctype, clpas=ccpas )   
+               CALL trd_icp( ptrdx, ptrdy, jpicpt_zad, ctype )   
                ! compute the surface flux condition wn(:,:,1)*tn(:,:,1)
                z2dx(:,:) = wn(:,:,1)*tn(:,:,1)/fse3t(:,:,1)
@@ -222,8 +217,8 @@
 
       ENDIF
-
+      !
    END SUBROUTINE trd_mod
 
-#   else
+#else
    !!----------------------------------------------------------------------
    !!   Default case :                                         Empty module
@@ -235,20 +230,12 @@
 
 CONTAINS
-   SUBROUTINE trd_mod(ptrd3dx, ptrd3dy, ktrd , ctype, kt, cnbpas)   ! Empty routine
-      REAL, DIMENSION(:,:,:), INTENT( in ) ::   &
-          ptrd3dx,                     &                           ! Temperature or U trend 
-          ptrd3dy                                                  ! Salinity    or V trend
-      INTEGER, INTENT( in ) ::   ktrd                              ! momentum or tracer trend index
-      INTEGER, INTENT( in ) ::   kt                                ! Time step
-      CHARACTER(len=3), INTENT( in ) ::  ctype                     ! momentum or tracers trends type
-      CHARACTER(len=3), INTENT( in ), OPTIONAL ::   cnbpas         ! number of passage
-      WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', ptrd3dx(1,1,1)
-      WRITE(*,*) ' "   ": You should not have seen this print! error ?', ptrd3dy(1,1,1)
-      WRITE(*,*) ' "   ": You should not have seen this print! error ?', ktrd
-      WRITE(*,*) ' "   ": You should not have seen this print! error ?', ctype
-      WRITE(*,*) ' "   ": You should not have seen this print! error ?', kt
-      WRITE(*,*) ' "   ": You should not have seen this print! error ?', cnbpas
+   SUBROUTINE trd_mod(ptrd3dx, ptrd3dy, ktrd , ctype, kt )   ! Empty routine
+      REAL    ::   ptrd3dx(:,:,:), ptrd3dy(:,:,:)
+      INTEGER ::   ktrd, kt                            
+      CHARACTER(len=3) ::  ctype                  
+      WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', ptrd3dx(1,1,1), ptrd3dy(1,1,1)
+      WRITE(*,*) ' "   ": You should not have seen this print! error ?', ktrd, ctype, kt
    END SUBROUTINE trd_mod
-#   endif
+#endif
 
    SUBROUTINE trd_mod_init
@@ -259,5 +246,5 @@
       !!----------------------------------------------------------------------
       USE in_out_manager          ! I/O manager
-
+      !!    
       NAMELIST/namtrd/ nn_trd, nn_ctls, cn_trdrst_in, cn_trdrst_out, ln_trdmld_restart, rn_ucf, ln_trdmld_instant
       !!----------------------------------------------------------------------
Index: trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod_oce.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod_oce.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod_oce.F90	(revision 2528)
@@ -4,5 +4,5 @@
    !! Ocean trends :   set tracer and momentum trend variables
    !!======================================================================
-   !! History :  9.0  !  04-08  (C. Talandier) Original code
+   !! History :  1.0  !  2004-08  (C. Talandier) Original code
    !!----------------------------------------------------------------------
    USE trdicp_oce              ! ocean momentum/tracers bassin properties trends variables
@@ -24,46 +24,56 @@
 
 # if defined key_trdtra   ||   defined key_trdmld
-   LOGICAL , PUBLIC ::   l_trdtra = .TRUE.              !: tracers  trend flag
+   LOGICAL , PUBLIC ::   l_trdtra = .TRUE.                !: tracers  trend flag
 # else
-   LOGICAL , PUBLIC ::   l_trdtra = .FALSE.             !: tracers  trend flag
+   LOGICAL , PUBLIC ::   l_trdtra = .FALSE.               !: tracers  trend flag
 # endif
 # if defined key_trddyn   ||   defined key_trdvor
-   LOGICAL , PUBLIC ::   l_trddyn = .TRUE.              !: momentum trend flag
+   LOGICAL , PUBLIC ::   l_trddyn = .TRUE.                !: momentum trend flag
 # else
-   LOGICAL , PUBLIC ::   l_trddyn = .FALSE.             !: momentum trend flag
+   LOGICAL , PUBLIC ::   l_trddyn = .FALSE.               !: momentum trend flag
 # endif
-
-   !                                                   !!! Active tracers trends indexes
-   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_xad =  1   !: x- horizontal advection
-   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_yad =  2   !: y- horizontal advection
-   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_zad =  3   !: z- vertical   advection
-   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_ldf =  4   !: lateral       diffusion
-   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_zdf =  5   !: vertical diffusion (Kz)
-   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_bbc =  6   !: Bottom Boundary Condition (geoth. flux) 
-   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_bbl =  7   !: Bottom Boundary Layer (diffusive/convective)
-   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_npc =  8   !: static instability mixing
-   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_dmp =  9   !: damping
-   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_qsr = 10   !: penetrative solar radiation
-   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_nsr = 11   !: non solar radiation
-   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_atf = 12   !: Asselin correction
+# if ( defined key_trdtrc && defined key_iomput )  ||  defined key_trdmld_trc
+   LOGICAL , PUBLIC ::   l_trdtrc = .TRUE.                !: tracers  trend flag
+# else
+   LOGICAL , PUBLIC ::   l_trdtrc = .FALSE.               !: tracers  trend flag
+# endif
+   !                                                     !!!* Active tracers trends indexes
+   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_xad =  1     !: x- horizontal advection
+   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_yad =  2     !: y- horizontal advection
+   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_zad =  3     !: z- vertical   advection
+   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_ldf =  4     !: lateral       diffusion
+   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_zdf =  5     !: vertical diffusion (Kz)
+   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_bbc =  6     !: Bottom Boundary Condition (geoth. flux) 
+   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_bbl =  7     !: Bottom Boundary Layer (diffusive/convective)
+   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_npc =  8     !: static instability mixing
+   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_dmp =  9     !: damping
+   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_qsr = 10     !: penetrative solar radiation
+   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_nsr = 11     !: non solar radiation
+   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_atf = 12     !: Asselin correction
+#if defined key_top
+   !                                                     !!!* Passive tracers trends indexes
+   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_sms  = 13    !: sources m. sinks
+   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_radn = 14    !: corr. trn<0 in trcrad
+   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_radb = 15    !: corr. trb<0 in trcrad (like atf)
+#endif
    
-   !                                                   !!! Momentum trends indexes
-   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_hpg =  1   !: hydrostatic pressure gradient 
-   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_keg =  2   !: kinetic energy gradient
-   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_rvo =  3   !: relative vorticity
-   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_pvo =  4   !: planetary vorticity
-   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_ldf =  5   !: lateral diffusion
-   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_had =  6   !: horizontal advection
-   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_zad =  7   !: vertical advection
-   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_zdf =  8   !: vertical diffusion
-   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_spg =  9   !: surface pressure gradient
-   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_dat = 10   !: damping term
-   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_swf = 11   !: surface wind forcing
-   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_bfr = 12   !: bottom friction 
+   !                                                     !!!* Momentum trends indexes
+   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_hpg =  1     !: hydrostatic pressure gradient 
+   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_keg =  2     !: kinetic energy gradient
+   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_rvo =  3     !: relative vorticity
+   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_pvo =  4     !: planetary vorticity
+   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_ldf =  5     !: lateral diffusion
+   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_had =  6     !: horizontal advection
+   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_zad =  7     !: vertical advection
+   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_zdf =  8     !: vertical diffusion
+   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_spg =  9     !: surface pressure gradient
+   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_dat = 10     !: damping term
+   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_swf = 11     !: surface wind forcing
+   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_bfr = 12     !: bottom friction 
 
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!======================================================================
 END MODULE trdmod_oce
Index: trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod_trc.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod_trc.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod_trc.F90	(revision 2528)
@@ -0,0 +1,24 @@
+MODULE trdmod_trc
+   !!======================================================================
+   !!                       ***  MODULE trdmod_trc  ***
+   !!  Dummy module
+   !!======================================================================
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   Dummy module                                             NO TOP use
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trd_mod_trc( ptrtrd, kjn, ktrd, kt )
+      INTEGER ::   kt, kjn, ktrd   
+      REAL    ::   ptrtrd(:,:,:)  
+      WRITE(*,*) 'trd_mod_trc_trp : You should not have seen this print! error?', ptrtrd(1,1,1)
+      WRITE(*,*) '  "      "      : You should not have seen this print! error?', kjn, ktrd, kt
+   END SUBROUTINE trd_mod_trc
+
+   !!======================================================================
+END MODULE trdmod_trc
Index: trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90	(revision 2528)
@@ -0,0 +1,194 @@
+MODULE trdtra
+   !!======================================================================
+   !!                       ***  MODULE  trdtra  ***
+   !! Ocean diagnostics:  ocean tracers trends
+   !!=====================================================================
+   !! History :  9.0  !  2004-08  (C. Talandier) Original code
+   !!                 !  2005-04  (C. Deltel)    Add Asselin trend in the ML budget
+   !!      NEMO  3.3  !  2010-06  (C. Ethe) merge TRA-TRC 
+   !!----------------------------------------------------------------------
+#if  defined key_trdtra || defined key_trdmld || defined key_trdmld_trc 
+   !!----------------------------------------------------------------------
+   !!   trd_tra      : Call the trend to be computed
+   !!----------------------------------------------------------------------
+   USE dom_oce            ! ocean domain 
+   USE trdmod_oce         ! ocean active mixed layer tracers trends 
+   USE trdmod             ! ocean active mixed layer tracers trends 
+   USE trdmod_trc         ! ocean passive mixed layer tracers trends 
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC trd_tra          ! called by all  traXX modules
+ 
+   !! * Module declaration
+   REAL(wp), DIMENSION(jpi,jpj,jpk), SAVE :: trdtx, trdty, trdt  !:
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trd_tra( kt, ctype, ktra, ktrd, ptrd, pun, ptra )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_tra  ***
+      !! 
+      !! ** Purpose : Dispatch all trends computation, e.g. vorticity, mld or 
+      !!              integral constraints
+      !!
+      !! ** Method/usage : For the mixed-layer trend, the control surface can be either
+      !!       a mixed layer depth (time varying) or a fixed surface (jk level or bowl). 
+      !!      Choose control surface with nn_ctls in namelist NAMTRD :
+      !!        nn_ctls = 0  : use mixed layer with density criterion 
+      !!        nn_ctls = 1  : read index from file 'ctlsurf_idx'
+      !!        nn_ctls > 1  : use fixed level surface jk = nn_ctls
+      !!----------------------------------------------------------------------
+      INTEGER                         , INTENT(in)           ::  kt      ! time step
+      CHARACTER(len=3)                , INTENT(in)           ::  ctype   ! tracers trends type 'TRA'/'TRC'
+      INTEGER                         , INTENT(in)           ::  ktra    ! tracer index
+      INTEGER                         , INTENT(in)           ::  ktrd    ! tracer trend index
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)           ::  ptrd    ! tracer trend  or flux
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  pun     ! velocity 
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  ptra    ! Tracer variable 
+      !!
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  ztrds    !  
+      !!----------------------------------------------------------------------
+
+      ! Control of optional arguments
+      IF( ctype == 'TRA' .AND. ktra == jp_tem ) THEN 
+         IF( PRESENT( ptra ) ) THEN    
+            SELECT CASE( ktrd )            ! shift depending on the direction
+            CASE( jptra_trd_xad )  ;  CALL trd_tra_adv( ptrd, pun, ptra, 'X', trdtx ) 
+            CASE( jptra_trd_yad )  ;  CALL trd_tra_adv( ptrd, pun, ptra, 'Y', trdty ) 
+            CASE( jptra_trd_zad )  ;  CALL trd_tra_adv( ptrd, pun, ptra, 'Z', trdt  ) 
+            END SELECT
+         ELSE
+            trdt(:,:,:) = ptrd(:,:,:)
+            IF( ktrd == jptra_trd_bbc .OR. ktrd == jptra_trd_qsr ) THEN
+               ztrds(:,:,:) = 0.
+               CALL trd_mod( trdt, ztrds, ktrd, ctype, kt )
+            END IF
+         END IF
+      END IF
+
+      IF( ctype == 'TRA' .AND. ktra == jp_sal ) THEN 
+         IF( PRESENT( ptra ) ) THEN    
+            SELECT CASE( ktrd )            ! shift depending on the direction
+            CASE( jptra_trd_xad )  
+                                CALL trd_tra_adv( ptrd, pun, ptra, 'X', ztrds ) 
+                                CALL trd_mod( trdtx, ztrds, ktrd, ctype, kt   )
+            CASE( jptra_trd_yad )  
+                                CALL trd_tra_adv( ptrd, pun, ptra, 'Y', ztrds ) 
+                                CALL trd_mod( trdty, ztrds, ktrd, ctype, kt   )
+            CASE( jptra_trd_zad )    
+                                CALL trd_tra_adv( ptrd, pun, ptra, 'Z', ztrds ) 
+                                CALL trd_mod( trdt , ztrds, ktrd, ctype, kt   )
+            END SELECT
+         ELSE
+            ztrds(:,:,:) = ptrd(:,:,:)
+            CALL trd_mod( trdt, ztrds, ktrd, ctype, kt )  
+         END IF
+      END IF
+
+      IF( ctype == 'TRC' ) THEN
+         !
+         IF( PRESENT( ptra ) ) THEN  
+            SELECT CASE( ktrd )            ! shift depending on the direction
+            CASE( jptra_trd_xad )  
+                                CALL trd_tra_adv( ptrd, pun, ptra, 'X', ztrds ) 
+                                CALL trd_mod_trc( ztrds, ktra, ktrd, kt       )
+            CASE( jptra_trd_yad )  
+                                CALL trd_tra_adv( ptrd, pun, ptra, 'Y', ztrds ) 
+                                CALL trd_mod_trc( ztrds, ktra, ktrd, kt       )
+            CASE( jptra_trd_zad )    
+                                CALL trd_tra_adv( ptrd, pun, ptra, 'Z', ztrds ) 
+                                CALL trd_mod_trc( ztrds, ktra, ktrd, kt       )
+            END SELECT
+         ELSE
+            ztrds(:,:,:) = ptrd(:,:,:)
+            CALL trd_mod_trc( ztrds, ktra, ktrd, kt       )  
+         END IF
+         !
+      ENDIF
+      !
+   END SUBROUTINE trd_tra
+
+   SUBROUTINE trd_tra_adv( pf, pun, ptn, cdir, ptrd )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_tra_adv  ***
+      !! 
+      !! ** Purpose :   transformed the i-, j- or k-advective flux into thes
+      !!              i-, j- or k-advective trends, resp.
+      !! ** Method  :   i-advective trends = -un. di-1[T] = -( di-1[fi] - tn di-1[un] )
+      !!                k-advective trends = -un. di-1[T] = -( dj-1[fi] - tn dj-1[un] )
+      !!                k-advective trends = -un. di+1[T] = -( dk+1[fi] - tn dk+1[un] )
+      !!----------------------------------------------------------------------
+      REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk)           ::   pf      ! advective flux in one direction
+      REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk)           ::   pun     ! now velocity  in one direction
+      REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk)           ::   ptn     ! now or before tracer 
+      CHARACTER(len=1), INTENT(in )                                   ::   cdir    ! X/Y/Z direction
+      REAL(wp)        , INTENT(out), DIMENSION(jpi,jpj,jpk)           ::   ptrd    ! advective trend in one direction
+      !!
+      INTEGER                          ::   ji, jj, jk   ! dummy loop indices
+      INTEGER                          ::   ii, ij, ik   ! index shift function of the direction
+      REAL(wp)                         ::   zbtr         ! temporary scalar
+      !!----------------------------------------------------------------------
+
+      SELECT CASE( cdir )            ! shift depending on the direction
+      CASE( 'X' )   ;   ii = 1   ; ij = 0   ;   ik = 0      ! i-advective trend
+      CASE( 'Y' )   ;   ii = 0   ; ij = 1   ;   ik = 0      ! j-advective trend
+      CASE( 'Z' )   ;   ii = 0   ; ij = 0   ;   ik =-1      ! k-advective trend
+      END SELECT
+
+      !                              ! set to zero uncomputed values
+      ptrd(jpi,:,:) = 0.e0   ;   ptrd(1,:,:) = 0.e0
+      ptrd(:,jpj,:) = 0.e0   ;   ptrd(:,1,:) = 0.e0
+      ptrd(:,:,jpk) = 0.e0
+      !
+      !
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zbtr    = 1.e0/ ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               ptrd(ji,jj,jk) = - zbtr * (      pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik)                    &
+                 &                          - ( pun(ji,jj,jk) - pun(ji-ii,jj-ij,jk-ik) ) * ptn(ji,jj,jk)  )
+            END DO
+         END DO
+      END DO
+      !
+   END SUBROUTINE trd_tra_adv
+
+#   else
+   !!----------------------------------------------------------------------
+   !!   Default case :                                         Empty module
+   !!----------------------------------------------------------------------
+   USE par_oce      ! ocean variables trends
+
+CONTAINS
+
+   SUBROUTINE trd_tra( kt, ctype, ktra, ktrd, ptrd, pu, ptra )
+      !!----------------------------------------------------------------------
+      INTEGER                         , INTENT(in)           ::  kt      ! time step
+      CHARACTER(len=3)                , INTENT(in)           ::  ctype   ! tracers trends type 'TRA'/'TRC'
+      INTEGER                         , INTENT(in)           ::  ktra    ! tracer index
+      INTEGER                         , INTENT(in)           ::  ktrd    ! tracer trend index
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)           ::  ptrd    ! tracer trend 
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  pu      ! velocity 
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  ptra    ! Tracer variable 
+      WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', ptrd(1,1,1)
+      WRITE(*,*) ' "   ": You should not have seen this print! error ?', ptra(1,1,1)
+      WRITE(*,*) ' "   ": You should not have seen this print! error ?', pu(1,1,1)
+      WRITE(*,*) ' "   ": You should not have seen this print! error ?', ktrd
+      WRITE(*,*) ' "   ": You should not have seen this print! error ?', ktra
+      WRITE(*,*) ' "   ": You should not have seen this print! error ?', ctype
+      WRITE(*,*) ' "   ": You should not have seen this print! error ?', kt
+   END SUBROUTINE trd_tra
+#   endif
+   !!======================================================================
+END MODULE trdtra
Index: trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90	(revision 2528)
@@ -10,5 +10,4 @@
    !!----------------------------------------------------------------------
    !!   'key_trdvor'   : momentum trend diagnostics
-   !!----------------------------------------------------------------------
    !!----------------------------------------------------------------------
    !!   trd_vor      : momentum trends averaged over the depth
@@ -39,21 +38,16 @@
    PUBLIC   trd_vor_init   ! routine called by opa.F90
 
-   INTEGER ::                &
-      nh_t, nmoydpvor  ,     &
-      nidvor, nhoridvor,     &
-      ndexvor1(jpi*jpj),     &
-      ndimvor1, icount,      &
-      idebug                    ! (0/1) set it to 1 in case of problem to have more print
-
-   REAL(wp), DIMENSION(jpi,jpj) ::  &
-     vor_avr    ,     &  ! average
-     vor_avrb   ,     &  ! before vorticity (kt-1)
-     vor_avrbb  ,     &  ! vorticity at begining of the nwrite-1 timestep averaging period
-     vor_avrbn  ,     &  ! after vorticity at time step after the
-     rotot      ,     &  ! begining of the NWRITE-1 timesteps
-     vor_avrtot ,     &
-     vor_avrres
-
-   REAL(wp), DIMENSION(jpi,jpj,jpltot_vor)::   vortrd  !: curl of trends
+   INTEGER ::   nh_t, nmoydpvor, nidvor, nhoridvor, ndexvor1(jpi*jpj), ndimvor1, icount   ! needs for IOIPSL output
+   INTEGER ::   ndebug     ! (0/1) set it to 1 in case of problem to have more print
+
+   REAL(wp), DIMENSION(jpi,jpj) ::   vor_avr      ! average
+   REAL(wp), DIMENSION(jpi,jpj) ::   vor_avrb     ! before vorticity (kt-1)
+   REAL(wp), DIMENSION(jpi,jpj) ::   vor_avrbb    ! vorticity at begining of the nwrite-1 timestep averaging period
+   REAL(wp), DIMENSION(jpi,jpj) ::   vor_avrbn    ! after vorticity at time step after the
+   REAL(wp), DIMENSION(jpi,jpj) ::   rotot        ! begining of the NWRITE-1 timesteps
+   REAL(wp), DIMENSION(jpi,jpj) ::   vor_avrtot   !
+   REAL(wp), DIMENSION(jpi,jpj) ::   vor_avrres   !
+
+   REAL(wp), DIMENSION(jpi,jpj,jpltot_vor) ::   vortrd  ! curl of trends
          
    CHARACTER(len=12) ::   cvort
@@ -64,9 +58,8 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-  
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
@@ -76,22 +69,9 @@
       !!
       !! ** Purpose :   computation of vertically integrated vorticity budgets
-      !!      from ocean surface down to control surface (NetCDF output)
-      !!
-      !! ** Method/usage :
-      !!      integration done over nwrite-1 time steps
-      !!
-      !!
-      !! ** Action :
-      !!            /comvor/   :
-      !!                         vor_avr          average
-      !!                         vor_avrb         vorticity at kt-1
-      !!                         vor_avrbb        vorticity at begining of the NWRITE-1
-      !!                                          time steps averaging period
-      !!                         vor_avrbn         vorticity at time step after the
-      !!                                          begining of the NWRITE-1 time
-      !!                                          steps averaging period
-      !!
-      !!                 trends :
-      !!
+      !!              from ocean surface down to control surface (NetCDF output)
+      !!
+      !! ** Method/usage :   integration done over nwrite-1 time steps
+      !!
+      !! ** Action :   trends :
       !!                  vortrd (,, 1) = Pressure Gradient Trend
       !!                  vortrd (,, 2) = KE Gradient Trend
@@ -104,5 +84,5 @@
       !!                  vortrd (,, 9) = Beta V
       !!                  vortrd (,,10) = forcing term
-      !!		  vortrd (,,11) = bottom friction term
+      !!		              vortrd (,,11) = bottom friction term
       !!                  rotot(,) : total cumulative trends over nwrite-1 time steps
       !!                  vor_avrtot(,) : first membre of vrticity equation
@@ -110,21 +90,19 @@
       !!
       !!      trends output in netCDF format using ioipsl
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   ktrd         ! ocean trend index
-      REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) ::   &
-         putrdvor,                         &  ! u vorticity trend 
-         pvtrdvor                             ! v vorticity trend
-      !!
-      INTEGER ::   ji, jj
-      INTEGER ::   ikbu, ikbum1, ikbv, ikbvm1
+      !!----------------------------------------------------------------------
+      INTEGER                     , INTENT(in   ) ::   ktrd       ! ocean trend index
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   putrdvor   ! u vorticity trend 
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pvtrdvor   ! v vorticity trend
+      !!
+      INTEGER ::   ji, jj       ! dummy loop indices
+      INTEGER ::   ikbu, ikbv   ! local integers
       REAL(wp), DIMENSION(jpi,jpj) ::   zudpvor, zvdpvor   ! total cmulative trends
       !!----------------------------------------------------------------------
 
       ! Initialization
-      zudpvor(:,:) = 0.e0
-      zvdpvor(:,:) = 0.e0
-
-      CALL lbc_lnk( putrdvor,  'U' , -1. )
+      zudpvor(:,:) = 0._wp
+      zvdpvor(:,:) = 0._wp
+      !
+      CALL lbc_lnk( putrdvor,  'U' , -1. )         ! lateral boundary condition on input momentum trends
       CALL lbc_lnk( pvtrdvor,  'V' , -1. )
 
@@ -134,24 +112,19 @@
 
       SELECT CASE (ktrd) 
-
+      !
       CASE (jpvor_bfr)        ! bottom friction
-
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1 
-               ikbu   = min( mbathy(ji+1,jj), mbathy(ji,jj) )
-               ikbum1 = max( ikbu-1, 1 )
-               ikbv   = min( mbathy(ji,jj+1), mbathy(ji,jj) )
-               ikbvm1 = max( ikbv-1, 1 )
-            
-               zudpvor(ji,jj) = putrdvor(ji,jj) * fse3u(ji,jj,ikbum1) * e1u(ji,jj) * umask(ji,jj,ikbum1)
-               zvdpvor(ji,jj) = pvtrdvor(ji,jj) * fse3v(ji,jj,ikbvm1) * e2v(ji,jj) * vmask(ji,jj,ikbvm1)
+               ikbu = mbkv(ji,jj)
+               ikbv = mbkv(ji,jj)            
+               zudpvor(ji,jj) = putrdvor(ji,jj) * fse3u(ji,jj,ikbu) * e1u(ji,jj) * umask(ji,jj,ikbu)
+               zvdpvor(ji,jj) = pvtrdvor(ji,jj) * fse3v(ji,jj,ikbv) * e2v(ji,jj) * vmask(ji,jj,ikbv)
             END DO
          END DO
-
+         !
       CASE (jpvor_swf)        ! wind stress
-
          zudpvor(:,:) = putrdvor(:,:) * fse3u(:,:,1) * e1u(:,:) * umask(:,:,1)
          zvdpvor(:,:) = pvtrdvor(:,:) * fse3v(:,:,1) * e2v(:,:) * vmask(:,:,1)
-
+         !
       END SELECT
 
@@ -163,14 +136,11 @@
       DO ji=1,jpim1
          DO jj=1,jpjm1
-            vortrd(ji,jj,ktrd) = ( zvdpvor(ji+1,jj) - zvdpvor(ji,jj)        &
-                 &                - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) ) ) &
-                 &               / ( e1f(ji,jj) * e2f(ji,jj) )
+            vortrd(ji,jj,ktrd) = (    zvdpvor(ji+1,jj) - zvdpvor(ji,jj)       &
+                 &                - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) )   ) / ( e1f(ji,jj) * e2f(ji,jj) )
          END DO
       END DO
-
-      ! Surface mask
-      vortrd(:,:,ktrd) = vortrd(:,:,ktrd) * fmask(:,:,1)
-
-      IF( idebug /= 0 ) THEN
+      vortrd(:,:,ktrd) = vortrd(:,:,ktrd) * fmask(:,:,1)      ! Surface mask
+
+      IF( ndebug /= 0 ) THEN
          IF(lwp) WRITE(numout,*) ' debuging trd_vor_zint: I done'
          CALL FLUSH(numout)
@@ -185,22 +155,9 @@
       !!
       !! ** Purpose :   computation of vertically integrated vorticity budgets
-      !!      from ocean surface down to control surface (NetCDF output)
-      !!
-      !! ** Method/usage :
-      !!      integration done over nwrite-1 time steps
-      !!
-      !!
-      !! ** Action :
-      !!            /comvor/   :
-      !!                         vor_avr          average
-      !!                         vor_avrb         vorticity at kt-1
-      !!                         vor_avrbb        vorticity at begining of the NWRITE-1
-      !!                                          time steps averaging period
-      !!                         vor_avrbn         vorticity at time step after the
-      !!                                          begining of the NWRITE-1 time
-      !!                                          steps averaging period
-      !!
-      !!                 trends :
-      !!
+      !!              from ocean surface down to control surface (NetCDF output)
+      !!
+      !! ** Method/usage :   integration done over nwrite-1 time steps
+      !!
+      !! ** Action :     trends :
       !!                  vortrd (,,1) = Pressure Gradient Trend
       !!                  vortrd (,,2) = KE Gradient Trend
@@ -219,32 +176,26 @@
       !!
       !!      trends output in netCDF format using ioipsl
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   ktrd         ! ocean trend index
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   &
-         putrdvor,                         &  ! u vorticity trend 
-         pvtrdvor                             ! v vorticity trend
+      !!----------------------------------------------------------------------
+      INTEGER                         , INTENT(in   ) ::   ktrd       ! ocean trend index
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   putrdvor   ! u vorticity trend 
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pvtrdvor   ! v vorticity trend
       !!
       INTEGER ::   ji, jj, jk
-      REAL(wp), DIMENSION(jpi,jpj) ::   &
-         zubet,                         &  ! u Beta.V case
-         zvbet,                         &  ! v Beta.V case
-         zudpvor,                       &  ! total cmulative trends
-         zvdpvor                           !   "      "        "
+      REAL(wp), DIMENSION(jpi,jpj) ::   zubet  , zvbet     ! Beta.V 
+      REAL(wp), DIMENSION(jpi,jpj) ::   zudpvor, zvdpvor   ! total cmulative trends
       !!----------------------------------------------------------------------
      
       ! Initialization
-      zubet(:,:) = 0.e0
-      zvbet(:,:) = 0.e0
-      zudpvor(:,:) = 0.e0
-      zvdpvor(:,:) = 0.e0
+      zubet  (:,:) = 0._wp
+      zvbet  (:,:) = 0._wp
+      zudpvor(:,:) = 0._wp
+      zvdpvor(:,:) = 0._wp
+      !
+      CALL lbc_lnk( putrdvor, 'U' , -1. )         ! lateral boundary condition on input momentum trends
+      CALL lbc_lnk( pvtrdvor, 'V' , -1. )
 
       !  =====================================
       !  I vertical integration of 3D trends
       !  =====================================
-
-      CALL lbc_lnk( putrdvor, 'U' , -1. )
-      CALL lbc_lnk( pvtrdvor, 'V' , -1. )
-
       ! putrdvor and pvtrdvor terms
       DO jk = 1,jpk
@@ -267,7 +218,6 @@
       DO ji=1,jpim1
          DO jj=1,jpjm1
-            vortrd(ji,jj,ktrd) = (  zvdpvor(ji+1,jj) - zvdpvor(ji,jj) -   &
-                 &                ( zudpvor(ji,jj+1) - zudpvor(ji,jj) ) ) &
-                 &               / ( e1f(ji,jj) * e2f(ji,jj) )
+            vortrd(ji,jj,ktrd) = (    zvdpvor(ji+1,jj) - zvdpvor(ji,jj)     &
+               &                  - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) )
          END DO
       END DO
@@ -281,7 +231,6 @@
          DO ji=1,jpim1
             DO jj=1,jpjm1
-               vortrd(ji,jj,jpvor_bev) = (  zvbet(ji+1,jj) - zvbet(ji,jj) -   &
-                    &                    ( zubet(ji,jj+1) - zubet(ji,jj) ) ) &
-                    &                   / ( e1f(ji,jj) * e2f(ji,jj) )
+               vortrd(ji,jj,jpvor_bev) = (    zvbet(ji+1,jj) - zvbet(ji,jj)     &
+                  &                       - ( zubet(ji,jj+1) - zubet(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) )
             END DO
          END DO
@@ -294,5 +243,5 @@
       ENDIF
    
-      IF( idebug /= 0 ) THEN
+      IF( ndebug /= 0 ) THEN
          IF(lwp) WRITE(numout,*) ' debuging trd_vor_zint: I done'
          CALL FLUSH(numout)
@@ -309,9 +258,10 @@
       !!               and make outputs (NetCDF or DIMG format)
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
-      !!
-      INTEGER  ::   ji, jj, jk, jl, it, itmod
-      REAL(wp) ::   zmean
-      REAL(wp), DIMENSION(jpi,jpj) ::   zun, zvn
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !!
+      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
+      INTEGER  ::   it, itmod        ! local integers
+      REAL(wp) ::   zmean            ! local scalars
+      REAL(wp), DIMENSION(jpi,jpj) ::   zun, zvn   ! 2D workspace
       !!----------------------------------------------------------------------
 
@@ -324,9 +274,7 @@
       ! ---------------------------------------------------
 
-      IF( kt > nit000 ) THEN
-         vor_avrb(:,:) = vor_avr(:,:)
-      ENDIF
-
-       IF( idebug /= 0 ) THEN
+      IF( kt > nit000 )   vor_avrb(:,:) = vor_avr(:,:)
+
+      IF( ndebug /= 0 ) THEN
           WRITE(numout,*) ' debuging trd_vor: I.1 done '
           CALL FLUSH(numout)
@@ -336,30 +284,28 @@
       !  ----------------------------------
 
-      vor_avr(:,:) = 0.
-      zun(:,:)=0
-      zvn(:,:)=0
-      vor_avrtot(:,:)=0
-      vor_avrres(:,:)=0
+      vor_avr   (:,:) = 0._wp
+      zun       (:,:) = 0._wp
+      zvn       (:,:) = 0._wp
+      vor_avrtot(:,:) = 0._wp
+      vor_avrres(:,:) = 0._wp
       
       ! Vertically averaged velocity
       DO jk = 1, jpk - 1
-         zun(:,:)=zun(:,:) + e1u(:,:)*un(:,:,jk)*fse3u(:,:,jk)
-         zvn(:,:)=zvn(:,:) + e2v(:,:)*vn(:,:,jk)*fse3v(:,:,jk)
+         zun(:,:) = zun(:,:) + e1u(:,:) * un(:,:,jk) * fse3u(:,:,jk)
+         zvn(:,:) = zvn(:,:) + e2v(:,:) * vn(:,:,jk) * fse3v(:,:,jk)
       END DO
  
-      zun(:,:)=zun(:,:)*hur(:,:)
-      zvn(:,:)=zvn(:,:)*hvr(:,:)
+      zun(:,:) = zun(:,:) * hur(:,:)
+      zvn(:,:) = zvn(:,:) * hvr(:,:)
 
       ! Curl
       DO ji=1,jpim1
          DO jj=1,jpjm1
-            vor_avr(ji,jj) = ((zvn(ji+1,jj)-zvn(ji,jj))-   &
-                              (zun(ji,jj+1)-zun(ji,jj)))   &
-                             /( e1f(ji,jj) * e2f(ji,jj) )
-            vor_avr(ji,jj) = vor_avr(ji,jj)*fmask(ji,jj,1)
+            vor_avr(ji,jj) = (  ( zvn(ji+1,jj) - zvn(ji,jj) )    &
+               &              - ( zun(ji,jj+1) - zun(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) * fmask(ji,jj,1)
          END DO
       END DO
       
-      IF(idebug /= 0) THEN
+      IF( ndebug /= 0 ) THEN
          WRITE(numout,*) ' debuging trd_vor: I.2 done'
          CALL FLUSH(numout)
@@ -377,5 +323,5 @@
       ENDIF
 
-      IF( idebug /= 0 ) THEN
+      IF( ndebug /= 0 ) THEN
          WRITE(numout,*) ' debuging trd_vor: I1.1 done'
          CALL FLUSH(numout)
@@ -395,5 +341,5 @@
       ENDIF
 
-      IF( idebug /= 0 ) THEN
+      IF( ndebug /= 0 ) THEN
          WRITE(numout,*) ' debuging trd_vor: II.2 done'
          CALL FLUSH(numout)
@@ -405,5 +351,5 @@
 
       ! define time axis
-      it = kt
+      it    = kt
       itmod = kt - nit000 + 1
 
@@ -412,10 +358,8 @@
          ! III.1 compute total trend
          ! ------------------------
-         zmean = float(nmoydpvor)
-
-         vor_avrtot(:,:) = ( vor_avr(:,:) - vor_avrbn(:,:) + vor_avrb(:,:) - &
-                             vor_avrbb(:,:) ) /  (zmean * 2. * rdt)
-
-         IF( idebug /= 0 ) THEN
+         zmean = 1._wp / (  REAL( nmoydpvor, wp ) * 2._wp * rdt  )
+         vor_avrtot(:,:) = (  vor_avr(:,:) - vor_avrbn(:,:) + vor_avrb(:,:) - vor_avrbb(:,:) ) * zmean
+
+         IF( ndebug /= 0 ) THEN
              WRITE(numout,*) ' zmean = ',zmean
              WRITE(numout,*) ' debuging trd_vor: III.1 done'
@@ -425,4 +369,5 @@
          ! III.2 compute residual
          ! ---------------------
+         zmean = 1._wp / REAL( nmoydpvor, wp )
          vor_avrres(:,:) = vor_avrtot(:,:) - rotot(:,:) / zmean
 
@@ -431,5 +376,5 @@
          CALL lbc_lnk( vor_avrres, 'F', 1. )
 
-         IF( idebug /= 0 ) THEN
+         IF( ndebug /= 0 ) THEN
             WRITE(numout,*) ' debuging trd_vor: III.2 done'
             CALL FLUSH(numout)
@@ -439,13 +384,13 @@
          ! ------------------------------
          vor_avrbb(:,:) = vor_avrb(:,:)
-         vor_avrbn(:,:) = vor_avr(:,:)
-
-         IF( idebug /= 0 ) THEN
+         vor_avrbn(:,:) = vor_avr (:,:)
+
+         IF( ndebug /= 0 ) THEN
             WRITE(numout,*) ' debuging trd_vor: III.3 done'
             CALL FLUSH(numout)
          ENDIF
-
-         nmoydpvor=0
-
+         !
+         nmoydpvor = 0
+         !
       ENDIF
 
@@ -475,5 +420,5 @@
          CALL histwrite( nidvor,"sovorgap",it,vor_avrres    ,ndimvor1,ndexvor1) ! gap between 1st and 2 nd mbre
          !
-         IF( idebug /= 0 ) THEN
+         IF( ndebug /= 0 ) THEN
             WRITE(numout,*) ' debuging trd_vor: III.4 done'
             CALL FLUSH(numout)
@@ -508,5 +453,5 @@
 
       ! Open specifier
-      idebug = 0      ! set it to 1 in case of problem to have more Print
+      ndebug = 0      ! set it to 1 in case of problem to have more Print
 
       IF(lwp) THEN
@@ -528,5 +473,5 @@
       vor_avrres(:,:)=0
 
-      IF( idebug /= 0 ) THEN
+      IF( ndebug /= 0 ) THEN
          WRITE(numout,*) ' debuging trd_vor_init: I. done'
          CALL FLUSH(numout)
@@ -568,5 +513,5 @@
       IF(lwp) WRITE(numout,*) ' Name of NETCDF file ', clhstnam
       CALL histbeg( clhstnam, jpi, glamf, jpj, gphif,1, jpi,   &  ! Horizontal grid : glamt and gphit
-         &          1, jpj, nit000-1, zjulian, rdt, nh_t, nidvor, domain_id=nidom )
+         &          1, jpj, nit000-1, zjulian, rdt, nh_t, nidvor, domain_id=nidom, snc4chunks=snc4set )
       CALL wheneq( jpi*jpj, fmask, 1, 1., ndexvor1, ndimvor1 )    ! surface
 
@@ -598,7 +543,7 @@
       CALL histdef( nidvor, "sovorgap", cvort//"gap", "s-2",             & ! gap between 1st and 2 nd mbre
          &          jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
-      CALL histend( nidvor )
-
-      IF( idebug /= 0 ) THEN
+      CALL histend( nidvor, snc4set )
+
+      IF( ndebug /= 0 ) THEN
          WRITE(numout,*) ' debuging trd_vor_init: II. done'
          CALL FLUSH(numout)
@@ -621,14 +566,10 @@
       REAL, DIMENSION(:,:), INTENT( inout ) ::   putrdvor, pvtrdvor
       INTEGER, INTENT( in ) ::   ktrd         ! ocean trend index
-      WRITE(*,*) 'trd_vor_zint_2d: You should not have seen this print! error?', putrdvor(1,1)
-      WRITE(*,*) '  "      "     : You should not have seen this print! error?', pvtrdvor(1,1)
-      WRITE(*,*) '  "      "     : You should not have seen this print! error?', ktrd
+      WRITE(*,*) 'trd_vor_zint_2d: You should not have seen this print! error?', putrdvor(1,1), pvtrdvor(1,1), ktrd
    END SUBROUTINE trd_vor_zint_2d
    SUBROUTINE trd_vor_zint_3d( putrdvor, pvtrdvor, ktrd )
       REAL, DIMENSION(:,:,:), INTENT( inout ) ::   putrdvor, pvtrdvor
       INTEGER, INTENT( in ) ::   ktrd         ! ocean trend index
-      WRITE(*,*) 'trd_vor_zint_3d: You should not have seen this print! error?', putrdvor(1,1,1)
-      WRITE(*,*) '  "      "     : You should not have seen this print! error?', pvtrdvor(1,1,1)
-      WRITE(*,*) '  "      "     : You should not have seen this print! error?', ktrd
+      WRITE(*,*) 'trd_vor_zint_3d: You should not have seen this print! error?', putrdvor(1,1,1), pvtrdvor(1,1,1), ktrd
    END SUBROUTINE trd_vor_zint_3d
    SUBROUTINE trd_vor_init              ! Empty routine
Index: trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor_oce.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor_oce.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor_oce.F90	(revision 2528)
@@ -34,7 +34,7 @@
 
    !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!======================================================================
 END MODULE trdvor_oce
Index: trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce.F90	(revision 2528)
@@ -33,13 +33,14 @@
 
 
-   REAL(wp), PUBLIC, DIMENSION        (jpk) ::   avmb, avtb   !: background profile of avm and avt
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   avtb_2d      !: set in tke_init, for other modif than ice
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   avmu, avmv   !: vertical viscosity coeff. at uw- & vw-points   [m2/s]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   avm , avt    !: vertical viscosity & diffusivity coeff. at  w-point   [m2/s]
+   REAL(wp), PUBLIC, DIMENSION        (jpk) ::   avmb , avtb    !: background profile of avm and avt
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   avtb_2d        !: set in tke_init, for other modif than ice
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   bfrua, bfrva   !: Bottom friction coefficients set in zdfbfr
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   avmu , avmv    !: vertical viscosity coef at uw- & vw-pts        [m2/s]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   avm  , avt     !: vertical viscosity & diffusivity coef at w-pt  [m2/s]
  
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!======================================================================
 END MODULE zdf_oce
Index: trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90	(revision 2528)
@@ -7,4 +7,5 @@
    !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module
    !!            3.2  ! 2009-09  (A.C.Coward)  Correction to include barotropic contribution
+   !!            3.3  ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase
    !!----------------------------------------------------------------------
 
@@ -12,6 +13,5 @@
    !!   zdf_bfr      : update momentum Kz at the ocean bottom due to the type of bottom friction chosen
    !!   zdf_bfr_init : read in namelist and control the bottom friction parameters.
-   !!   zdf_bfr_2d   : read in namelist and control the bottom friction
-   !!                  parameters.
+   !!   zdf_bfr_2d   : read in namelist and control the bottom friction parameters.
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and tracers variables
@@ -26,8 +26,7 @@
    PRIVATE
 
-   PUBLIC   zdf_bfr    ! called by step.F90
+   PUBLIC   zdf_bfr         ! called by step.F90
+   PUBLIC   zdf_bfr_init    ! called by opa.F90
    
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   bfrua , bfrva   !: Bottom friction coefficients set in zdfbfr
-
    !                                    !!* Namelist nambfr: bottom friction namelist *
    INTEGER  ::   nn_bfr    = 0           ! = 0/1/2/3 type of bottom friction 
@@ -35,5 +34,5 @@
    REAL(wp) ::   rn_bfri2  = 1.0e-3_wp   ! bottom drag coefficient (non linear case)
    REAL(wp) ::   rn_bfeb2  = 2.5e-3_wp   ! background bottom turbulent kinetic energy  [m2/s2]
-   REAL(wp) ::   rn_bfrien = 30_wp       ! local factor to enhance coefficient bfri
+   REAL(wp) ::   rn_bfrien = 30._wp      ! local factor to enhance coefficient bfri
    LOGICAL  ::   ln_bfr2d  = .false.     ! logical switch for 2D enhancement
    
@@ -41,11 +40,11 @@
 
    !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
@@ -68,12 +67,8 @@
       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
       !!
-      INTEGER  ::   ji, jj         ! dummy loop indices
-      INTEGER  ::   ikbu, ikbum1   ! temporary integers
-      INTEGER  ::   ikbv, ikbvm1   !    -          -
+      INTEGER  ::   ji, jj       ! dummy loop indices
+      INTEGER  ::   ikbu, ikbv   ! local integers
       REAL(wp) ::   zvu, zuv, zecu, zecv   ! temporary scalars
       !!----------------------------------------------------------------------
-
-
-      IF( kt == nit000 )   CALL zdf_bfr_init   ! initialisation
 
       IF( nn_bfr == 2 ) THEN                 ! quadratic botton friction
@@ -93,19 +88,17 @@
             DO ji = 2, jpim1
 # endif
-               ikbu   = MIN( mbathy(ji+1,jj  ), mbathy(ji,jj) )
-               ikbv   = MIN( mbathy(ji  ,jj+1), mbathy(ji,jj) )
-               ikbum1 = MAX( ikbu-1, 1 )
-               ikbvm1 = MAX( ikbv-1, 1 )
+               ikbu = mbku(ji,jj)         ! ocean bottom level at u- and v-points 
+               ikbv = mbkv(ji,jj)         ! (deepest ocean u- and v-points)
                !
-               zvu  = 0.25 * (  vn(ji,jj  ,ikbum1) + vn(ji+1,jj  ,ikbum1)     &
-                  &           + vn(ji,jj-1,ikbum1) + vn(ji+1,jj-1,ikbum1)  )
-               zuv  = 0.25 * (  un(ji,jj  ,ikbvm1) + un(ji-1,jj  ,ikbvm1)     &
-                  &           + un(ji,jj+1,ikbvm1) + un(ji-1,jj+1,ikbvm1)  )
+               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,ikbum1) * un(ji,jj,ikbum1) + zvu*zvu + rn_bfeb2  )
-               zecv = SQRT(  vn(ji,jj,ikbvm1) * vn(ji,jj,ikbvm1) + zuv*zuv + rn_bfeb2  )
+               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  )
                !
-               bfrua(ji,jj) = - 0.5 * ( bfrcoef2d(ji,jj) + bfrcoef2d(ji+1,jj  ) ) * zecu 
-               bfrva(ji,jj) = - 0.5 * ( bfrcoef2d(ji,jj) + bfrcoef2d(ji  ,jj+1) ) * zecv
+               bfrua(ji,jj) = - 0.5_wp * ( bfrcoef2d(ji,jj) + bfrcoef2d(ji+1,jj  ) ) * zecu 
+               bfrva(ji,jj) = - 0.5_wp * ( bfrcoef2d(ji,jj) + bfrcoef2d(ji  ,jj+1) ) * zecv
             END DO
          END DO
@@ -131,10 +124,10 @@
       USE iom   ! I/O module for ehanced bottom friction file
       !!
-      INTEGER ::   inum                         ! logical unit for enhanced bottom friction file
-      INTEGER ::   ji, jj                       ! dummy loop indexes
-      INTEGER ::   ikbu, ikbv, ikbum1, ikbvm1   ! temporary integers
-      INTEGER ::   ictu, ictv                   !    -          -
-      REAL(wp) ::  zminbfr, zmaxbfr             ! temporary scalars
-      REAL(wp) ::  zfru, zfrv                   !    -         -
+      INTEGER ::   inum         ! logical unit for enhanced bottom friction file
+      INTEGER ::   ji, jj       ! dummy loop indexes
+      INTEGER ::   ikbu, ikbv   ! temporary integers
+      INTEGER ::   ictu, ictv   !    -          -
+      REAL(wp) ::  zminbfr, zmaxbfr   ! temporary scalars
+      REAL(wp) ::  zfru, zfrv         !    -         -
       !!
       NAMELIST/nambfr/ nn_bfr, rn_bfri1, rn_bfri2, rn_bfeb2, ln_bfr2d, rn_bfrien
@@ -218,14 +211,12 @@
          DO ji = 2, jpim1
 #  endif
-             ikbu = MIN( mbathy(ji+1,jj  ), mbathy(ji,jj) )
-             ikbv = MIN( mbathy(ji  ,jj+1), mbathy(ji,jj) )
-             ikbum1 = MAX( ikbu-1, 1 )
-             ikbvm1 = MAX( ikbv-1, 1 )
-             zfru = 0.5 * fse3u(ji,jj,ikbum1) / rdt
-             zfrv = 0.5 * fse3v(ji,jj,ikbvm1) / rdt
+             ikbu = mbku(ji,jj)       ! deepest ocean level at u- and v-points
+             ikbv = mbkv(ji,jj)
+             zfru = 0.5 * fse3u(ji,jj,ikbu) / rdt
+             zfrv = 0.5 * fse3v(ji,jj,ikbv) / rdt
              IF( ABS( bfrcoef2d(ji,jj) ) > zfru ) THEN
                 IF( ln_ctl ) THEN
-                   WRITE(numout,*) 'BFR ',narea,nimpp+ji,njmpp+jj,ikbu
-                   WRITE(numout,*) 'BFR ',ABS( bfrcoef2d(ji,jj) ), zfru
+                   WRITE(numout,*) 'BFR ', narea, nimpp+ji, njmpp+jj, ikbu
+                   WRITE(numout,*) 'BFR ', ABS( bfrcoef2d(ji,jj) ), zfru
                 ENDIF
                 ictu = ictu + 1
@@ -248,5 +239,5 @@
          CALL mpp_max( zmaxbfr )
       ENDIF
-      IF( lwp .AND. ictu + ictv .GT. 0 ) 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 '
Index: trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90	(revision 2528)
@@ -6,4 +6,5 @@
    !! History :  OPA  ! 2000-08  (G. Madec)  double diffusive mixing
    !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module
+   !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase
    !!----------------------------------------------------------------------
 #if defined key_zdfddm   ||   defined key_esopa
@@ -24,5 +25,6 @@
    PRIVATE
 
-   PUBLIC   zdf_ddm    ! called by step.F90
+   PUBLIC   zdf_ddm       ! called by step.F90
+   PUBLIC   zdf_ddm_init  ! called by opa.F90
 
    LOGICAL , PUBLIC, PARAMETER ::   lk_zdfddm = .TRUE.  !: double diffusive mixing flag
@@ -38,7 +40,7 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -86,6 +88,4 @@
       !!----------------------------------------------------------------------
 
-      IF ( kt == nit000 )   CALL zdf_ddm_init          ! Initialization (first time-step only)
-
       !                                                ! ===============
       DO jk = 2, jpkm1                                 ! Horizontal slab
@@ -98,33 +98,23 @@
             DO ji = 1, jpi
                ! stability indicator: msks=1 if rn2>0; 0 elsewhere
-               IF( rn2(ji,jj,jk) + 1.e-12  <= 0. ) THEN
-                  zmsks(ji,jj) = 0.e0
-               ELSE
-                  zmsks(ji,jj) = 1.e0
+               IF( rn2(ji,jj,jk) + 1.e-12  <= 0. ) THEN   ;   zmsks(ji,jj) = 0.e0
+               ELSE                                       ;   zmsks(ji,jj) = 1.e0
                ENDIF
                ! salt fingering indicator: msksf=1 if rrau>1; 0 elsewhere            
-               IF( rrau(ji,jj,jk) <= 1. ) THEN
-                  zmskf(ji,jj) = 0.e0
-               ELSE
-                  zmskf(ji,jj) = 1.e0
+               IF( rrau(ji,jj,jk) <= 1.          ) THEN   ;   zmskf(ji,jj) = 0.e0
+               ELSE                                       ;   zmskf(ji,jj) = 1.e0
                ENDIF
                ! diffusive layering indicators: 
-               !   mskdl1=1 if 0<rrau<1; 0 elsewhere
-               IF( rrau(ji,jj,jk) >= 1. ) THEN
-                  zmskd1(ji,jj) = 0.e0
-               ELSE
-                  zmskd1(ji,jj) = 1.e0
-               ENDIF
-               !   mskdl2=1 if 0<rrau<0.5; 0 elsewhere
-               IF( rrau(ji,jj,jk) >= 0.5 ) THEN
-                  zmskd2(ji,jj) = 0.e0
-               ELSE
-                  zmskd2(ji,jj) = 1.e0
+               !     ! mskdl1=1 if 0<rrau<1; 0 elsewhere
+               IF( rrau(ji,jj,jk) >= 1.          ) THEN   ;   zmskd1(ji,jj) = 0.e0
+               ELSE                                       ;   zmskd1(ji,jj) = 1.e0
+               ENDIF
+               !     ! mskdl2=1 if 0<rrau<0.5; 0 elsewhere
+               IF( rrau(ji,jj,jk) >= 0.5         ) THEN   ;   zmskd2(ji,jj) = 0.e0
+               ELSE                                       ;   zmskd2(ji,jj) = 1.e0
                ENDIF
                !   mskdl3=1 if 0.5<rrau<1; 0 elsewhere
-               IF( rrau(ji,jj,jk) <= 0.5 .OR. rrau(ji,jj,jk) >= 1. ) THEN
-                  zmskd3(ji,jj) = 0.e0
-               ELSE
-                  zmskd3(ji,jj) = 1.e0
+               IF( rrau(ji,jj,jk) <= 0.5 .OR. rrau(ji,jj,jk) >= 1. ) THEN   ;   zmskd3(ji,jj) = 0.e0
+               ELSE                                                         ;   zmskd3(ji,jj) = 1.e0
                ENDIF
             END DO
@@ -227,4 +217,6 @@
       WRITE(*,*) 'zdf_ddm: You should not have seen this print! error?', kt
    END SUBROUTINE zdf_ddm
+   SUBROUTINE zdf_ddm_init            ! Dummy routine
+   END SUBROUTINE zdf_ddm_init
 #endif
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm_substitute.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm_substitute.h90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm_substitute.h90	(revision 2528)
@@ -6,7 +6,7 @@
    !!----------------------------------------------------------------------
    !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 #if defined key_zdfddm
Index: trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90	(revision 2528)
@@ -31,7 +31,7 @@
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90	(revision 2528)
@@ -0,0 +1,1252 @@
+MODULE zdfgls
+   !!======================================================================
+   !!                       ***  MODULE  zdfgls  ***
+   !! Ocean physics:  vertical mixing coefficient computed from the gls 
+   !!                 turbulent closure parameterization
+   !!======================================================================
+   !! History :   3.0  !  2009-09  (G. Reffray)  Original code
+   !!             3.3  !  2010-10  (C. Bricaud)  Add in the reference
+   !!----------------------------------------------------------------------
+#if defined key_zdfgls   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_zdfgls'                 Generic Length Scale vertical physics
+   !!----------------------------------------------------------------------
+   !!   zdf_gls      : update momentum and tracer Kz from a gls scheme
+   !!   zdf_gls_init : initialization, namelist read, and parameters control
+   !!   gls_rst      : read/write gls restart in ocean restart file
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and active tracers 
+   USE dom_oce        ! ocean space and time domain
+   USE domvvl         ! ocean space and time domain : variable volume layer
+   USE zdf_oce        ! ocean vertical physics
+   USE sbc_oce        ! surface boundary condition: ocean
+   USE phycst         ! physical constants
+   USE zdfmxl         ! mixed layer
+   USE restart        ! only for lrst_oce
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE prtctl         ! Print control
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O manager library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   zdf_gls        ! routine called in step module
+   PUBLIC   zdf_gls_init   ! routine called in opa module
+   PUBLIC   gls_rst        ! routine called in step module
+
+   LOGICAL , PUBLIC, PARAMETER              ::   lk_zdfgls = .TRUE.  !: TKE vertical mixing flag
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   en                  !: now turbulent kinetic energy
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   mxln                !: now mixing length
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   zwall               !: wall function
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   ustars2             !: Squared surface velocity scale at T-points
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   ustarb2             !: Squared bottom  velocity scale at T-points
+
+   !                                         !!! ** Namelist  namzdf_gls  **
+   LOGICAL  ::   ln_crban      = .FALSE.      ! =T use Craig and Banner scheme
+   LOGICAL  ::   ln_length_lim = .FALSE.      ! use limit on the dissipation rate under stable stratification (Galperin et al. 1988)
+   LOGICAL  ::   ln_sigpsi     = .FALSE.      ! Activate Burchard (2003) modification for k-eps closure & wave breaking mixing
+   INTEGER  ::   nn_tkebc_surf = 0            ! TKE surface boundary condition (=0/1)
+   INTEGER  ::   nn_tkebc_bot  = 0            ! TKE bottom boundary condition (=0/1)
+   INTEGER  ::   nn_psibc_surf = 0            ! PSI surface boundary condition (=0/1)
+   INTEGER  ::   nn_psibc_bot  = 0            ! PSI bottom boundary condition (=0/1)
+   INTEGER  ::   nn_stab_func  = 0            ! stability functions G88, KC or Canuto (=0/1/2)
+   INTEGER  ::   nn_clos       = 0            ! closure 0/1/2/3 MY82/k-eps/k-w/gen
+   REAL(wp) ::   rn_clim_galp  = 0.53_wp      ! Holt 2008 value for k-eps: 0.267
+   REAL(wp) ::   rn_epsmin     = 1.e-12_wp    ! minimum value of dissipation (m2/s3)
+   REAL(wp) ::   rn_emin       = 1.e-6_wp     ! minimum value of TKE (m2/s2)
+   REAL(wp) ::   rn_charn      = 2.e+5_wp     ! Charnock constant for surface breaking waves mixing : 1400. (standard) or 2.e5 (Stacey value)
+   REAL(wp) ::   rn_crban      = 100._wp      ! 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) ::   rcm_sf        =  0.73_wp     ! Shear free turbulence parameters
+   REAL(wp) ::   ra_sf         = -2.0_wp      ! Must be negative -2 < ra_sf < -1 
+   REAL(wp) ::   rl_sf         =  0.2_wp      ! 0 <rl_sf<vkarmn    
+   REAL(wp) ::   rghmin        = -0.28_wp
+   REAL(wp) ::   rgh0          =  0.0329_wp
+   REAL(wp) ::   rghcri        =  0.03_wp
+   REAL(wp) ::   ra1           =  0.92_wp
+   REAL(wp) ::   ra2           =  0.74_wp
+   REAL(wp) ::   rb1           = 16.60_wp
+   REAL(wp) ::   rb2           = 10.10_wp         
+   REAL(wp) ::   re2           =  1.33_wp         
+   REAL(wp) ::   rl1           =  0.107_wp
+   REAL(wp) ::   rl2           =  0.0032_wp
+   REAL(wp) ::   rl3           =  0.0864_wp
+   REAL(wp) ::   rl4           =  0.12_wp
+   REAL(wp) ::   rl5           = 11.9_wp
+   REAL(wp) ::   rl6           =  0.4_wp
+   REAL(wp) ::   rl7           =  0.0_wp
+   REAL(wp) ::   rl8           =  0.48_wp
+   REAL(wp) ::   rm1           =  0.127_wp
+   REAL(wp) ::   rm2           =  0.00336_wp
+   REAL(wp) ::   rm3           =  0.0906_wp
+   REAL(wp) ::   rm4           =  0.101_wp
+   REAL(wp) ::   rm5           = 11.2_wp
+   REAL(wp) ::   rm6           =  0.4_wp
+   REAL(wp) ::   rm7           =  0.0_wp
+   REAL(wp) ::   rm8           =  0.318_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) ::   rc0, rc2, rc3, rf6, rcff, rc_diff                !     -           -           -        -
+   REAL(wp) ::   rs0, rs1, rs2, rs4, rs5, rs6                     !     -           -           -        -
+   REAL(wp) ::   rd0, rd1, rd2, rd3, rd4, rd5                     !     -           -           -        -
+   REAL(wp) ::   rsc_tke, rsc_psi, rpsi1, rpsi2, rpsi3, rsc_psi0  !     -           -           -        -
+   REAL(wp) ::   rpsi3m, rpsi3p, rpp, rmm, rnn                    !     -           -           -        -
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE zdf_gls( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE zdf_gls  ***
+      !!
+      !! ** Purpose :   Compute the vertical eddy viscosity and diffusivity
+      !!              coefficients using the GLS turbulent closure scheme.
+      !!----------------------------------------------------------------------
+      USE oce,     z_elem_a  =>   ua   ! use ua as workspace
+      USE oce,     z_elem_b  =>   va   ! use va as workspace
+      USE oce,     z_elem_c  =>   ta   ! use ta as workspace
+      USE oce,     psi       =>   sa   ! use sa as workspace
+      !
+      INTEGER, INTENT(in) ::   kt ! ocean time step
+      INTEGER  ::   ji, jj, jk, ibot, ibotm1, dir  ! dummy loop arguments
+      REAL(wp) ::   zesh2, zsigpsi, zcoef, zex1, zex2   ! local scalars
+      REAL(wp) ::   ztx2, zty2, zup, zdown, zcof        !   -      - 
+      REAL(wp) ::   zratio, zrn2, zflxb, sh             !   -      -
+      REAL(wp) ::   prod, buoy, diss, zdiss, sm         !   -      -
+      REAL(wp) ::   gh, gm, shr, dif, zsqen, zav        !   -      -
+      REAL(wp), DIMENSION(jpi,jpj)     ::   zdep        !
+      REAL(wp), DIMENSION(jpi,jpj)     ::   zflxs       ! Turbulence fluxed induced by internal waves 
+      REAL(wp), DIMENSION(jpi,jpj)     ::   zhsro       ! Surface roughness (surface waves)
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   eb          ! tke at time before
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   mxlb        ! mixing length at time before
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   shear       ! vertical shear
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   eps         ! dissipation rate
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwall_psi   ! Wall function use in the wb case (ln_sigpsi.AND.ln_crban=T)
+      !!--------------------------------------------------------------------
+
+      ! Preliminary computing
+
+      ustars2 = 0._wp   ;   ustarb2 = 0._wp   ;   psi  = 0._wp   ;   zwall_psi = 0._wp
+
+      ! 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 
+            ustars2(ji,jj) = rau0r * 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
+
+      ! Compute shear and dissipation rate
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               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) )
+               eps(ji,jj,jk)  = rc03 * en(ji,jj,jk) * SQRT(en(ji,jj,jk)) / mxln(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+      ! Lateral boundary conditions (avmu,avmv) (sign unchanged)
+      CALL lbc_lnk( avmu, 'U', 1. )   ;   CALL lbc_lnk( avmv, 'V', 1. )
+
+      ! Save tke at before time step
+      eb  (:,:,:) = en  (:,:,:)
+      mxlb(:,:,:) = mxln(:,:,:)
+
+      IF( nn_clos == 0 ) THEN    ! Mellor-Yamada
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1 
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zup   = mxln(ji,jj,jk) * fsdepw(ji,jj,mbkt(ji,jj)+1)
+                  zdown = vkarmn * fsdepw(ji,jj,jk) * ( -fsdepw(ji,jj,jk) + fsdepw(ji,jj,mbkt(ji,jj)+1) )
+                  zcoef = ( zup / MAX( zdown, rsmall ) )
+                  zwall (ji,jj,jk) = ( 1._wp + re2 * zcoef*zcoef ) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+      !!---------------------------------!!
+      !!   Equation to prognostic k      !!
+      !!---------------------------------!!
+      !
+      ! Now Turbulent kinetic energy (output in en)
+      ! -------------------------------
+      ! Resolution of a tridiagonal linear system by a "methode de chasse"
+      ! computation from level 2 to jpkm1  (e(1) computed after and e(jpk)=0 ).
+      ! The surface boundary condition are set after
+      ! The bottom boundary condition are also set after. In standard e(bottom)=0.
+      ! z_elem_b : diagonal z_elem_c : upper diagonal z_elem_a : lower diagonal
+      ! Warning : after this step, en : right hand side of the matrix
+
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               !
+               ! shear prod. at w-point weightened by mask
+               shear(ji,jj,jk) =  ( avmu(ji-1,jj,jk) + avmu(ji,jj,jk) ) / MAX( 1.e0 , umask(ji-1,jj,jk) + umask(ji,jj,jk) )   &
+                  &             + ( avmv(ji,jj-1,jk) + avmv(ji,jj,jk) ) / MAX( 1.e0 , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) )
+               !
+               ! stratif. destruction
+               buoy = - avt(ji,jj,jk) * rn2(ji,jj,jk)
+               !
+               ! shear prod. - stratif. destruction
+               diss = eps(ji,jj,jk)
+               !
+               dir = 0.5_wp + SIGN( 0.5_wp, shear(ji,jj,jk) + buoy )   ! dir =1(=0) if shear(ji,jj,jk)+buoy >0(<0)
+               !
+               zesh2 = dir*(shear(ji,jj,jk)+buoy)+(1._wp-dir)*shear(ji,jj,jk)          ! production term
+               zdiss = dir*(diss/en(ji,jj,jk))   +(1._wp-dir)*(diss-buoy)/en(ji,jj,jk) ! dissipation term
+               !
+               ! Compute a wall function from 1. to rsc_psi*zwall/rsc_psi0
+               ! Note that as long that Dirichlet boundary conditions are NOT set at the first and last levels (GOTM style)
+               ! there is no need to set a boundary condition for zwall_psi at the top and bottom boundaries.
+               ! Otherwise, this should be rsc_psi/rsc_psi0
+               IF( ln_sigpsi ) THEN
+                  zsigpsi = MIN( 1._wp, zesh2 / eps(ji,jj,jk) )     ! 0. <= zsigpsi <= 1.
+                  zwall_psi(ji,jj,jk) = rsc_psi / (  zsigpsi * rsc_psi + (1._wp-zsigpsi) * rsc_psi0 / MAX( zwall(ji,jj,jk), 1._wp )  )
+               ELSE
+                  zwall_psi(ji,jj,jk) = 1._wp
+               ENDIF
+               !
+               ! building the matrix
+               zcof = rfact_tke * tmask(ji,jj,jk)
+               !
+               ! lower diagonal
+               z_elem_a(ji,jj,jk) = zcof * ( avm  (ji,jj,jk  ) + avm  (ji,jj,jk-1) )   &
+                  &                      / ( fse3t(ji,jj,jk-1) * fse3w(ji,jj,jk  ) )
+               !
+               ! upper diagonal
+               z_elem_c(ji,jj,jk) = zcof * ( avm  (ji,jj,jk+1) + avm  (ji,jj,jk  ) )   &
+                  &                      / ( fse3t(ji,jj,jk  ) * fse3w(ji,jj,jk) )
+               !
+               ! diagonal
+               z_elem_b(ji,jj,jk) = 1._wp - z_elem_a(ji,jj,jk) - z_elem_c(ji,jj,jk)  &
+                  &                       + rdt * zdiss * tmask(ji,jj,jk) 
+               !
+               ! right hand side in en
+               en(ji,jj,jk) = en(ji,jj,jk) + rdt * zesh2 * tmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+      z_elem_b(:,:,jpk) = 1._wp
+      !
+      ! 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
+
+      ! Surface boundary condition on tke
+      ! ---------------------------------
+      !
+      SELECT CASE ( nn_tkebc_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
+         !
+      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
+         !
+      END SELECT
+
+      ! Bottom boundary condition on tke
+      ! --------------------------------
+      !
+      SELECT CASE ( nn_tkebc_bot )
+      !
+      CASE ( 0 )             ! Dirichlet 
+         !                      ! en(ibot) = u*^2 / Co2 and mxln(ibot) = rn_lmin
+         !                      ! Balance between the production and the dissipation terms
+!CDIR NOVERRCHK
+         DO jj = 2, jpjm1
+!CDIR NOVERRCHK
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point
+               ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1
+               !
+               ! Bottom level Dirichlet condition:
+               z_elem_a(ji,jj,ibot  ) = 0._wp
+               z_elem_c(ji,jj,ibot  ) = 0._wp
+               z_elem_b(ji,jj,ibot  ) = 1._wp
+               en(ji,jj,ibot  ) = MAX( rc02r * ustarb2(ji,jj), rn_emin )
+               !
+               ! Just above last level, Dirichlet condition again
+               z_elem_a(ji,jj,ibotm1) = 0._wp
+               z_elem_c(ji,jj,ibotm1) = 0._wp
+               z_elem_b(ji,jj,ibotm1) = 1._wp
+               en(ji,jj,ibotm1) = MAX( rc02r * ustarb2(ji,jj), rn_emin ) 
+            END DO
+         END DO
+         !
+      CASE ( 1 )             ! Neumman boundary condition
+         !                      
+!CDIR NOVERRCHK
+         DO jj = 2, jpjm1
+!CDIR NOVERRCHK
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point
+               ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1
+               !
+               ! Bottom level Dirichlet condition:
+               z_elem_a(ji,jj,ibot) = 0._wp
+               z_elem_c(ji,jj,ibot) = 0._wp
+               z_elem_b(ji,jj,ibot) = 1._wp
+               en(ji,jj,ibot) = MAX( rc02r * ustarb2(ji,jj), rn_emin )
+               !
+               ! Just above last level: Neumann condition
+               z_elem_b(ji,jj,ibotm1) = z_elem_b(ji,jj,ibotm1) + z_elem_c(ji,jj,ibotm1)   ! Remove z_elem_c from z_elem_b
+               z_elem_c(ji,jj,ibotm1) = 0._wp
+            END DO
+         END DO
+         !
+      END SELECT
+
+      ! Matrix inversion (en prescribed at surface and the bottom)
+      ! ----------------------------------------------------------
+      !
+      DO jk = 2, jpkm1                             ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1    ! vector opt.
+               z_elem_b(ji,jj,jk) = z_elem_b(ji,jj,jk) - z_elem_a(ji,jj,jk) * z_elem_c(ji,jj,jk-1) / z_elem_b(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+      DO jk = 2, jpk                               ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1    ! vector opt.
+               z_elem_a(ji,jj,jk) = en(ji,jj,jk) - z_elem_a(ji,jj,jk) / z_elem_b(ji,jj,jk-1) * z_elem_a(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+      DO jk = jpk-1, 2, -1                         ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1    ! vector opt.
+               en(ji,jj,jk) = ( z_elem_a(ji,jj,jk) - z_elem_c(ji,jj,jk) * en(ji,jj,jk+1) ) / z_elem_b(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !                                            ! set the minimum value of tke 
+      en(:,:,:) = MAX( en(:,:,:), rn_emin )
+      
+      !!----------------------------------------!!
+      !!   Solve prognostic equation for psi    !!
+      !!----------------------------------------!!
+
+      ! Set psi to previous time step value
+      !
+      SELECT CASE ( nn_clos )
+      !
+      CASE( 0 )               ! k-kl  (Mellor-Yamada)
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  psi(ji,jj,jk)  = en(ji,jj,jk) * mxln(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !
+      CASE( 1 )               ! k-eps
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  psi(ji,jj,jk)  = eps(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !
+      CASE( 2 )               ! k-w
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  psi(ji,jj,jk)  = SQRT( en(ji,jj,jk) ) / ( rc0 * mxln(ji,jj,jk) )
+               END DO
+            END DO
+         END DO
+         !
+      CASE( 3 )               ! generic
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  psi(ji,jj,jk)  = rc02 * en(ji,jj,jk) * mxln(ji,jj,jk)**rnn 
+               END DO
+            END DO
+         END DO
+         !
+      END SELECT
+      !
+      ! Now gls (output in psi)
+      ! -------------------------------
+      ! Resolution of a tridiagonal linear system by a "methode de chasse"
+      ! computation from level 2 to jpkm1  (e(1) already computed and e(jpk)=0 ).
+      ! z_elem_b : diagonal z_elem_c : upper diagonal z_elem_a : lower diagonal
+      ! Warning : after this step, en : right hand side of the matrix
+
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               !
+               ! psi / k
+               zratio = psi(ji,jj,jk) / eb(ji,jj,jk) 
+               !
+               ! psi3+ : stable : B=-KhN²<0 => N²>0 if rn2>0 dir = 1 (stable) otherwise dir = 0 (unstable)
+               dir = 0.5_wp + SIGN( 0.5_wp, rn2(ji,jj,jk) )
+               !
+               rpsi3 = dir * rpsi3m + ( 1._wp - dir ) * rpsi3p
+               !
+               ! shear prod. - stratif. destruction
+               prod = rpsi1 * zratio * shear(ji,jj,jk)
+               !
+               ! stratif. destruction
+               buoy = rpsi3 * zratio * (- avt(ji,jj,jk) * rn2(ji,jj,jk) )
+               !
+               ! shear prod. - stratif. destruction
+               diss = rpsi2 * zratio * zwall(ji,jj,jk) * eps(ji,jj,jk)
+               !
+               dir = 0.5_wp + SIGN( 0.5_wp, prod + buoy )   ! dir =1(=0) if shear(ji,jj,jk)+buoy >0(<0)
+               !
+               zesh2 = dir * ( prod + buoy )          + (1._wp - dir ) * prod                        ! production term
+               zdiss = dir * ( diss / psi(ji,jj,jk) ) + (1._wp - dir ) * (diss-buoy) / psi(ji,jj,jk) ! dissipation term
+               !                                                        
+               ! building the matrix
+               zcof = rfact_psi * zwall_psi(ji,jj,jk) * tmask(ji,jj,jk)
+               ! lower diagonal
+               z_elem_a(ji,jj,jk) = zcof * ( avm  (ji,jj,jk  ) + avm  (ji,jj,jk-1) )   &
+                  &                      / ( fse3t(ji,jj,jk-1) * fse3w(ji,jj,jk  ) )
+               ! upper diagonal
+               z_elem_c(ji,jj,jk) = zcof * ( avm  (ji,jj,jk+1) + avm  (ji,jj,jk  ) )   &
+                  &                      / ( fse3t(ji,jj,jk  ) * fse3w(ji,jj,jk) )
+               ! diagonal
+               z_elem_b(ji,jj,jk) = 1._wp - z_elem_a(ji,jj,jk) - z_elem_c(ji,jj,jk)  &
+                  &                       + rdt * zdiss * tmask(ji,jj,jk)
+               !
+               ! right hand side in psi
+               psi(ji,jj,jk) = psi(ji,jj,jk) + rdt * zesh2 * tmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+      z_elem_b(:,:,jpk) = 1._wp
+
+      ! Surface boundary condition on psi
+      ! ---------------------------------
+      !
+      SELECT CASE ( nn_psibc_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
+         !
+      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
+         !
+      END SELECT
+
+      ! Bottom boundary condition on psi
+      ! --------------------------------
+      !
+      SELECT CASE ( nn_psibc_bot )
+      !
+      CASE ( 0 )             ! Dirichlet 
+         !                      ! en(ibot) = u*^2 / Co2 and mxln(ibot) = vkarmn * hbro
+         !                      ! Balance between the production and the dissipation terms
+!CDIR NOVERRCHK
+         DO jj = 2, jpjm1
+!CDIR NOVERRCHK
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               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
+               psi (ji,jj,ibot) = rc0**rpp * en(ji,jj,ibot)**rmm * zdep(ji,jj)**rnn
+               z_elem_a(ji,jj,ibot) = 0._wp
+               z_elem_c(ji,jj,ibot) = 0._wp
+               z_elem_b(ji,jj,ibot) = 1._wp
+               !
+               ! Just above last level, Dirichlet condition again (GOTM like)
+               zdep(ji,jj) = vkarmn * ( hbro + 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
+               z_elem_c(ji,jj,ibotm1) = 0._wp
+               z_elem_b(ji,jj,ibotm1) = 1._wp
+            END DO
+         END DO
+         !
+      CASE ( 1 )             ! Neumman boundary condition
+         !                      
+!CDIR NOVERRCHK
+         DO jj = 2, jpjm1
+!CDIR NOVERRCHK
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point
+               ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1
+               !
+               ! Bottom level Dirichlet condition:
+               zdep(ji,jj) = vkarmn * hbro
+               psi (ji,jj,ibot) = rc0**rpp * en(ji,jj,ibot)**rmm * zdep(ji,jj)**rnn
+               !
+               z_elem_a(ji,jj,ibot) = 0._wp
+               z_elem_c(ji,jj,ibot) = 0._wp
+               z_elem_b(ji,jj,ibot) = 1._wp
+               !
+               ! Just above last level: Neumann condition with flux injection
+               z_elem_b(ji,jj,ibotm1) = z_elem_b(ji,jj,ibotm1) + z_elem_c(ji,jj,ibotm1) ! Remove z_elem_c from z_elem_b
+               z_elem_c(ji,jj,ibotm1) = 0.
+               !
+               ! Set psi vertical flux at the bottom:
+               zdep(ji,jj) = hbro + 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)
+               psi(ji,jj,ibotm1) = psi(ji,jj,ibotm1) + zflxb / fse3w(ji,jj,ibotm1)
+            END DO
+         END DO
+         !
+      END SELECT
+
+      ! Matrix inversion
+      ! ----------------
+      !
+      DO jk = 2, jpkm1                             ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1    ! vector opt.
+               z_elem_b(ji,jj,jk) = z_elem_b(ji,jj,jk) - z_elem_a(ji,jj,jk) * z_elem_c(ji,jj,jk-1) / z_elem_b(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+      DO jk = 2, jpk                               ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1    ! vector opt.
+               z_elem_a(ji,jj,jk) = psi(ji,jj,jk) - z_elem_a(ji,jj,jk) / z_elem_b(ji,jj,jk-1) * z_elem_a(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+      DO jk = jpk-1, 2, -1                         ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1    ! vector opt.
+               psi(ji,jj,jk) = ( z_elem_a(ji,jj,jk) - z_elem_c(ji,jj,jk) * psi(ji,jj,jk+1) ) / z_elem_b(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+
+      ! Set dissipation
+      !----------------
+
+      SELECT CASE ( nn_clos )
+      !
+      CASE( 0 )               ! k-kl  (Mellor-Yamada)
+         DO jk = 1, jpkm1
+            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)
+               END DO
+            END DO
+         END DO
+         !
+      CASE( 1 )               ! k-eps
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  eps(ji,jj,jk) = psi(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !
+      CASE( 2 )               ! k-w
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  eps(ji,jj,jk) = rc04 * en(ji,jj,jk) * psi(ji,jj,jk) 
+               END DO
+            END DO
+         END DO
+         !
+      CASE( 3 )               ! generic
+         zcoef = rc0**( 3._wp  + rpp/rnn )
+         zex1  =      ( 1.5_wp + rmm/rnn )
+         zex2  = -1._wp / rnn
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  eps(ji,jj,jk) = zcoef * en(ji,jj,jk)**zex1 * psi(ji,jj,jk)**zex2
+               END DO
+            END DO
+         END DO
+         !
+      END SELECT
+
+      ! Limit dissipation rate under stable stratification
+      ! --------------------------------------------------
+      DO jk = 1, jpkm1 ! Note that this set boundary conditions on mxln at the same time
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1    ! vector opt.
+               ! limitation
+               eps(ji,jj,jk)  = MAX( eps(ji,jj,jk), rn_epsmin )
+               mxln(ji,jj,jk)  = rc03 * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / eps(ji,jj,jk)
+               ! 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)  )
+            END DO
+         END DO
+      END DO 
+
+      !
+      ! Stability function and vertical viscosity and diffusivity
+      ! ---------------------------------------------------------
+      !
+      SELECT CASE ( nn_stab_func )
+      !
+      CASE ( 0 , 1 )             ! Galperin or Kantha-Clayson stability functions
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ! zcof =  l²/q²
+                  zcof = mxlb(ji,jj,jk) * mxlb(ji,jj,jk) / ( 2._wp*eb(ji,jj,jk) )
+                  ! Gh = -N²l²/q²
+                  gh = - rn2(ji,jj,jk) * zcof
+                  gh = MIN( gh, rgh0   )
+                  gh = MAX( gh, rghmin )
+                  ! Stability functions from Kantha and Clayson (if C2=C3=0 => Galperin)
+                  sh = ra2*( 1._wp-6._wp*ra1/rb1 ) / ( 1.-3.*ra2*gh*(6.*ra1+rb2*( 1._wp-rc3 ) ) )
+                  sm = ( rb1**(-1._wp/3._wp) + ( 18._wp*ra1*ra1 + 9._wp*ra1*ra2*(1._wp-rc2) )*sh*gh ) / (1._wp-9._wp*ra1*ra2*gh)
+                  !
+                  ! Store stability function in avmu and avmv
+                  avmu(ji,jj,jk) = rc_diff * sh * tmask(ji,jj,jk)
+                  avmv(ji,jj,jk) = rc_diff * sm * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !
+      CASE ( 2, 3 )               ! Canuto stability functions
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ! zcof =  l²/q²
+                  zcof = mxlb(ji,jj,jk)*mxlb(ji,jj,jk) / ( 2._wp * eb(ji,jj,jk) )
+                  ! Gh = -N²l²/q²
+                  gh = - rn2(ji,jj,jk) * zcof
+                  gh = MIN( gh, rgh0   )
+                  gh = MAX( gh, rghmin )
+                  gh = gh * rf6
+                  ! Gm =  M²l²/q² Shear number
+                  shr = shear(ji,jj,jk) / MAX( avm(ji,jj,jk), rsmall )
+                  gm = MAX( shr * zcof , 1.e-10 )
+                  gm = gm * rf6
+                  gm = MIN ( (rd0 - rd1*gh + rd3*gh*gh) / (rd2-rd4*gh) , gm )
+                  ! Stability functions from Canuto
+                  rcff = rd0 - rd1*gh +rd2*gm + rd3*gh*gh - rd4*gh*gm + rd5*gm*gm
+                  sm = (rs0 - rs1*gh + rs2*gm) / rcff
+                  sh = (rs4 - rs5*gh + rs6*gm) / rcff
+                  !
+                  ! Store stability function in avmu and avmv
+                  avmu(ji,jj,jk) = rc_diff * sh * tmask(ji,jj,jk)
+                  avmv(ji,jj,jk) = rc_diff * sm * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !
+      END SELECT
+
+      ! 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 )
+      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
+         END DO
+      END DO
+
+      ! Compute diffusivities/viscosities
+      ! The computation below could be restrained to jk=2 to jpkm1 if GOTM style Dirichlet conditions are used
+      DO jk = 1, jpk
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zsqen         = SQRT( 2._wp * en(ji,jj,jk) ) * mxln(ji,jj,jk)
+               zav           = zsqen * avmu(ji,jj,jk)
+               avt(ji,jj,jk) = MAX( zav, avtb(jk) )*tmask(ji,jj,jk) ! apply mask for zdfmxl routine
+               zav           = zsqen * avmv(ji,jj,jk)
+               avm(ji,jj,jk) = MAX( zav, avmb(jk) ) ! Note that avm is not masked at the surface and the bottom
+            END DO
+         END DO
+      END DO
+      !
+      ! Lateral boundary conditions (sign unchanged)
+      avt(:,:,1)  = 0._wp
+      CALL lbc_lnk( avm, 'W', 1. )   ;   CALL lbc_lnk( avt, 'W', 1. )
+
+      DO jk = 2, jpkm1            !* vertical eddy viscosity at u- and v-points
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               avmu(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk) + avm(ji+1,jj  ,jk) ) * umask(ji,jj,jk)
+               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
+      avmu(:,:,1) = 0._wp             ;   avmv(:,:,1) = 0._wp                 ! set surface to zero
+      CALL lbc_lnk( avmu, 'U', 1. )   ;   CALL lbc_lnk( avmv, 'V', 1. )       ! Lateral boundary conditions
+
+      IF(ln_ctl) THEN
+         CALL prt_ctl( tab3d_1=en  , clinfo1=' gls  - e: ', tab3d_2=avt, clinfo2=' t: ', ovlap=1, kdim=jpk)
+         CALL prt_ctl( tab3d_1=avmu, clinfo1=' gls  - u: ', mask1=umask,                   &
+            &          tab3d_2=avmv, clinfo2=       ' v: ', mask2=vmask, ovlap=1, kdim=jpk )
+      ENDIF
+      !
+   END SUBROUTINE zdf_gls
+
+
+   SUBROUTINE zdf_gls_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zdf_gls_init  ***
+      !!                     
+      !! ** Purpose :   Initialization of the vertical eddy diffivity and 
+      !!      viscosity when using a gls turbulent closure scheme
+      !!
+      !! ** Method  :   Read the namzdf_gls namelist and check the parameters
+      !!      called at the first timestep (nit000)
+      !!
+      !! ** input   :   Namlist namzdf_gls
+      !!
+      !! ** Action  :   Increase by 1 the nstop flag is setting problem encounter
+      !!
+      !!----------------------------------------------------------------------
+      USE dynzdf_exp
+      USE trazdf_exp
+      !
+      INTEGER ::   jk    ! dummy loop indices
+      REAL(wp)::   zcr   ! local scalar
+      !!
+      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,           &
+         &            nn_stab_func, nn_clos
+      !!----------------------------------------------------------
+
+      REWIND ( numnam )                !* Read Namelist namzdf_gls
+      READ   ( numnam, namzdf_gls )
+
+      IF(lwp) THEN                     !* Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'zdf_gls_init : gls turbulent closure scheme'
+         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,*) '      Craig and Banner coefficient                  rn_crban       = ', rn_crban
+         WRITE(numout,*) '      Charnock coefficient                          rn_charn       = ', rn_charn
+         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
+      ENDIF
+
+      !                                !* 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_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' )
+
+      ! Initialisation of the parameters for the choosen closure
+      ! --------------------------------------------------------
+      !
+      SELECT CASE ( nn_clos )
+      !
+      CASE( 0 )               ! k-kl  (Mellor-Yamada)
+         !
+         IF(lwp) WRITE(numout,*) 'The choosen closure is k-kl closed to the classical Mellor-Yamada'
+         rpp     = 0._wp
+         rmm     = 1._wp
+         rnn     = 1._wp
+         rsc_tke = 1.96_wp
+         rsc_psi = 1.96_wp
+         rpsi1   = 0.9_wp
+         rpsi3p  = 1._wp
+         rpsi2   = 0.5_wp
+         !
+         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( 3 )      ;   rpsi3m = 2.38          ! Canuto B stability functions (caution : constant not identified)
+         END SELECT
+         !
+      CASE( 1 )               ! k-eps
+         !
+         IF(lwp) WRITE(numout,*) 'The choosen closure is k-eps'
+         rpp     =  3._wp
+         rmm     =  1.5_wp
+         rnn     = -1._wp
+         rsc_tke =  1._wp
+         rsc_psi =  1.3_wp  ! Schmidt number for psi
+         rpsi1   =  1.44_wp
+         rpsi3p  =  1._wp
+         rpsi2   =  1.92_wp
+         !
+         SELECT CASE ( nn_stab_func )
+         CASE( 0, 1 )   ;   rpsi3m = -0.52_wp      ! G88 or KC stability functions
+         CASE( 2 )      ;   rpsi3m = -0.629_wp     ! Canuto A stability functions
+         CASE( 3 )      ;   rpsi3m = -0.566        ! Canuto B stability functions
+         END SELECT
+         !
+      CASE( 2 )               ! k-omega
+         !
+         IF(lwp) WRITE(numout,*) 'The choosen closure is k-omega'
+         rpp     = -1._wp
+         rmm     =  0.5_wp
+         rnn     = -1._wp
+         rsc_tke =  2._wp
+         rsc_psi =  2._wp
+         rpsi1   =  0.555_wp
+         rpsi3p  =  1._wp
+         rpsi2   =  0.833_wp
+         !
+         SELECT CASE ( nn_stab_func )
+         CASE( 0, 1 )   ;   rpsi3m = -0.58_wp       ! G88 or KC stability functions
+         CASE( 2 )      ;   rpsi3m = -0.64_wp       ! Canuto A stability functions
+         CASE( 3 )      ;   rpsi3m = -0.64_wp       ! Canuto B stability functions caution : constant not identified)
+         END SELECT
+         !
+      CASE( 3 )               ! generic
+         !
+         IF(lwp) WRITE(numout,*) 'The choosen closure is generic'
+         rpp     = 2._wp
+         rmm     = 1._wp
+         rnn     = -0.67_wp
+         rsc_tke = 0.8_wp
+         rsc_psi = 1.07_wp
+         rpsi1   = 1._wp
+         rpsi3p  = 1._wp
+         rpsi2   = 1.22_wp
+         !
+         SELECT CASE ( nn_stab_func )
+         CASE( 0, 1 )   ;   rpsi3m = 0.1_wp         ! G88 or KC stability functions
+         CASE( 2 )      ;   rpsi3m = 0.05_wp        ! Canuto A stability functions
+         CASE( 3 )      ;   rpsi3m = 0.05_wp        ! Canuto B stability functions caution : constant not identified)
+         END SELECT
+         !
+      END SELECT
+
+      ! Initialisation of the parameters of the stability functions
+      ! -----------------------------------------------------------
+      !
+      SELECT CASE ( nn_stab_func )
+      !
+      CASE ( 0 )             ! Galperin stability functions
+         !
+         IF(lwp) WRITE(numout,*) 'Stability functions from Galperin'
+         rc2     =  0._wp
+         rc3     =  0._wp
+         rc_diff =  1._wp
+         rc0     =  0.5544_wp
+         rcm_sf  =  0.9884_wp
+         rghmin  = -0.28_wp
+         rgh0    =  0.0233_wp
+         rghcri  =  0.02_wp
+         !
+      CASE ( 1 )             ! Kantha-Clayson stability functions
+         !
+         IF(lwp) WRITE(numout,*) 'Stability functions from Kantha-Clayson'
+         rc2     =  0.7_wp
+         rc3     =  0.2_wp
+         rc_diff =  1._wp
+         rc0     =  0.5544_wp
+         rcm_sf  =  0.9884_wp
+         rghmin  = -0.28_wp
+         rgh0    =  0.0233_wp
+         rghcri  =  0.02_wp
+         !
+      CASE ( 2 )             ! Canuto A stability functions
+         !
+         IF(lwp) WRITE(numout,*) 'Stability functions from Canuto A'
+         rs0 = 1.5_wp * rl1 * rl5*rl5
+         rs1 = -rl4*(rl6+rl7) + 2._wp*rl4*rl5*(rl1-(1._wp/3._wp)*rl2-rl3) + 1.5_wp*rl1*rl5*rl8
+         rs2 = -(3._wp/8._wp) * rl1*(rl6*rl6-rl7*rl7)
+         rs4 = 2._wp * rl5
+         rs5 = 2._wp * rl4
+         rs6 = (2._wp/3._wp) * rl5 * ( 3._wp*rl3*rl3 - rl2*rl2 ) - 0.5_wp * rl5*rl1 * (3._wp*rl3-rl2)   &
+            &                                                    + 0.75_wp * rl1 * ( rl6 - rl7 )
+         rd0 = 3._wp * rl5*rl5
+         rd1 = rl5 * ( 7._wp*rl4 + 3._wp*rl8 )
+         rd2 = rl5*rl5 * ( 3._wp*rl3*rl3 - rl2*rl2 ) - 0.75_wp*(rl6*rl6 - rl7*rl7 )
+         rd3 = rl4 * ( 4._wp*rl4 + 3._wp*rl8)
+         rd4 = rl4 * ( rl2 * rl6 - 3._wp*rl3*rl7 - rl5*(rl2*rl2 - rl3*rl3 ) ) + rl5*rl8 * ( 3._wp*rl3*rl3 - rl2*rl2 )
+         rd5 = 0.25_wp * ( rl2*rl2 - 3._wp *rl3*rl3 ) * ( rl6*rl6 - rl7*rl7 )
+         rc0 = 0.5268_wp
+         rf6 = 8._wp / (rc0**6._wp)
+         rc_diff = SQRT(2._wp) / (rc0**3._wp)
+         rcm_sf  =  0.7310_wp
+         rghmin  = -0.28_wp
+         rgh0    =  0.0329_wp
+         rghcri  =  0.03_wp
+         !
+      CASE ( 3 )             ! Canuto B stability functions
+         !
+         IF(lwp) WRITE(numout,*) 'Stability functions from Canuto B'
+         rs0 = 1.5_wp * rm1 * rm5*rm5
+         rs1 = -rm4 * (rm6+rm7) + 2._wp * rm4*rm5*(rm1-(1._wp/3._wp)*rm2-rm3) + 1.5_wp * rm1*rm5*rm8
+         rs2 = -(3._wp/8._wp) * rm1 * (rm6*rm6-rm7*rm7 )
+         rs4 = 2._wp * rm5
+         rs5 = 2._wp * rm4
+         rs6 = (2._wp/3._wp) * rm5 * (3._wp*rm3*rm3-rm2*rm2) - 0.5_wp * rm5*rm1*(3._wp*rm3-rm2) + 0.75_wp * rm1*(rm6-rm7)
+         rd0 = 3._wp * rm5*rm5
+         rd1 = rm5 * (7._wp*rm4 + 3._wp*rm8)
+         rd2 = rm5*rm5 * (3._wp*rm3*rm3 - rm2*rm2) - 0.75_wp * (rm6*rm6 - rm7*rm7)
+         rd3 = rm4 * ( 4._wp*rm4 + 3._wp*rm8 )
+         rd4 = rm4 * ( rm2*rm6 -3._wp*rm3*rm7 - rm5*(rm2*rm2 - rm3*rm3) ) + rm5 * rm8 * ( 3._wp*rm3*rm3 - rm2*rm2 )
+         rd5 = 0.25_wp * ( rm2*rm2 - 3._wp*rm3*rm3 ) * ( rm6*rm6 - rm7*rm7 )
+         rc0 = 0.5268_wp            !!       rc0 = 0.5540_wp (Warner ...) to verify !
+         rf6 = 8._wp / ( rc0**6._wp )
+         rc_diff = SQRT(2._wp)/(rc0**3.)
+         rcm_sf  =  0.7470_wp
+         rghmin  = -0.28_wp
+         rgh0    =  0.0444_wp
+         rghcri  =  0.0414_wp
+         !
+      END SELECT
+    
+      ! Set Schmidt number for psi diffusion in the wave breaking case
+      ! See equation 13 of Carniel et al, Ocean modelling, 30, 225-239, 2009
+      ! or equation (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 )                                 
+      ELSE
+         rsc_psi0 = rsc_psi
+      ENDIF
+ 
+      ! 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 )                                                              )
+
+      !
+      IF(lwp) THEN      ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'Limit values'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) 'Parameter  m = ',rmm
+         WRITE(numout,*) 'Parameter  n = ',rnn
+         WRITE(numout,*) 'Parameter  p = ',rpp
+         WRITE(numout,*) 'rpsi1   = ',rpsi1
+         WRITE(numout,*) 'rpsi2   = ',rpsi2
+         WRITE(numout,*) 'rpsi3m  = ',rpsi3m
+         WRITE(numout,*) 'rpsi3p  = ',rpsi3p
+         WRITE(numout,*) 'rsc_tke = ',rsc_tke
+         WRITE(numout,*) 'rsc_psi = ',rsc_psi
+         WRITE(numout,*) 'rsc_psi0 = ',rsc_psi0
+         WRITE(numout,*) 'rc0     = ',rc0
+         WRITE(numout,*)
+         WRITE(numout,*) 'Shear free turbulence parameters:'
+         WRITE(numout,*) 'rcm_sf  = ',rcm_sf
+         WRITE(numout,*) 'ra_sf   = ',ra_sf
+         WRITE(numout,*) 'rl_sf   = ',rl_sf
+         WRITE(numout,*)
+      ENDIF
+
+      ! Constants initialization
+      rc02  = rc0  * rc0   ;   rc02r = 1. / rc02
+      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
+
+      !                                !* Wall proximity function
+      zwall (:,:,:) = 1._wp * tmask(:,:,:)
+
+      !                                !* 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)
+      END DO
+      !                                !* read or initialize all required files 
+      CALL gls_rst( nit000, 'READ' )
+      !
+   END SUBROUTINE zdf_gls_init
+
+
+   SUBROUTINE gls_rst( kt, cdrw )
+      !!---------------------------------------------------------------------
+      !!                   ***  ROUTINE ts_rst  ***
+      !!                     
+      !! ** Purpose :   Read or write TKE file (en) in restart file
+      !!
+      !! ** Method  :   use of IOM library
+      !!                if the restart does not contain TKE, en is either 
+      !!                set to rn_emin or recomputed (nn_igls/=0)
+      !!----------------------------------------------------------------------
+      INTEGER         , INTENT(in) ::   kt         ! ocean time-step
+      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
+      !
+      INTEGER ::   jit, jk   ! dummy loop indices
+      INTEGER ::   id1, id2, id3, id4, id5, id6, id7, id8
+      INTEGER ::   ji, jj, ikbu, ikbv
+      REAL(wp)::   cbx, cby
+      !!----------------------------------------------------------------------
+      !
+      IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise 
+         !                                   ! ---------------
+         IF( ln_rstart ) THEN                   !* Read the restart file
+            id1 = iom_varid( numror, 'en'   , ldstop = .FALSE. )
+            id2 = iom_varid( numror, 'avt'  , ldstop = .FALSE. )
+            id3 = iom_varid( numror, 'avm'  , ldstop = .FALSE. )
+            id4 = iom_varid( numror, 'avmu' , ldstop = .FALSE. )
+            id5 = iom_varid( numror, 'avmv' , ldstop = .FALSE. )
+            id6 = iom_varid( numror, 'mxln' , ldstop = .FALSE. )
+            !
+            IF( MIN( id1, id2, id3, id4, id5, id6, id7, id8 ) > 0 ) THEN        ! all required arrays exist
+               CALL iom_get( numror, jpdom_autoglo, 'en'    , en     )
+               CALL iom_get( numror, jpdom_autoglo, 'avt'   , avt    )
+               CALL iom_get( numror, jpdom_autoglo, 'avm'   , avm    )
+               CALL iom_get( numror, jpdom_autoglo, 'avmu'  , avmu   )
+               CALL iom_get( numror, jpdom_autoglo, 'avmv'  , avmv   )
+               CALL iom_get( numror, jpdom_autoglo, 'mxln'  , mxln   )
+            ELSE                        
+               IF(lwp) WRITE(numout,*) ' ===>>>> : previous run without gls scheme, en and mxln computed by iterative loop'
+               en  (:,:,:) = rn_emin
+               mxln(:,:,:) = 0.001        
+               DO jit = nit000 + 1, nit000 + 10   ;   CALL zdf_gls( jit )   ;   END DO
+            ENDIF
+         ELSE                                   !* Start from rest
+            IF(lwp) WRITE(numout,*) ' ===>>>> : Initialisation of en and mxln by background values'
+            en  (:,:,:) = rn_emin
+            mxln(:,:,:) = 0.001       
+         ENDIF
+         !
+      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file
+         !                                   ! -------------------
+         IF(lwp) WRITE(numout,*) '---- gls-rst ----'
+         CALL iom_rstput( kt, nitrst, numrow, 'en'   , en    )
+         CALL iom_rstput( kt, nitrst, numrow, 'avt'  , avt   )
+         CALL iom_rstput( kt, nitrst, numrow, 'avm'  , avm   )
+         CALL iom_rstput( kt, nitrst, numrow, 'avmu' , avmu  )
+         CALL iom_rstput( kt, nitrst, numrow, 'avmv' , avmv  )
+         CALL iom_rstput( kt, nitrst, numrow, 'mxln' , mxln  )
+         !
+      ENDIF
+      !
+   END SUBROUTINE gls_rst
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :                                        NO TKE scheme
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_zdfgls = .FALSE.   !: TKE flag
+CONTAINS
+   SUBROUTINE zdf_gls_init           ! Empty routine
+      WRITE(*,*) 'zdf_gls_init: You should not have seen this print! error?'
+   END SUBROUTINE zdf_gls_init
+   SUBROUTINE zdf_gls( kt )          ! Empty routine
+      WRITE(*,*) 'zdf_gls: You should not have seen this print! error?', kt
+   END SUBROUTINE zdf_gls
+   SUBROUTINE gls_rst( kt, cdrw )          ! Empty routine
+      INTEGER         , INTENT(in) ::   kt         ! ocean time-step
+      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
+      WRITE(*,*) 'gls_rst: You should not have seen this print! error?', kt, cdrw
+   END SUBROUTINE gls_rst
+#endif
+
+   !!======================================================================
+END MODULE zdfgls
+
Index: trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90	(revision 2528)
@@ -18,6 +18,6 @@
    USE zdf_oce         ! TKE vertical mixing          
    USE lib_mpp         ! distribued memory computing
-   USE zdftke_old      ! TKE vertical mixing  (old scheme)
    USE zdftke          ! TKE vertical mixing
+   USE zdfgls          ! GLS vertical mixing
    USE zdfkpp          ! KPP vertical mixing          
    USE zdfddm          ! double diffusion mixing      
@@ -37,7 +37,7 @@
    
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
    
@@ -98,10 +98,10 @@
          ioptio = ioptio+1
       ENDIF
-      IF( lk_zdftke_old ) THEN
+      IF( lk_zdftke ) THEN
          IF(lwp) WRITE(numout,*) '      TKE dependent eddy coefficients'
          ioptio = ioptio+1
       ENDIF
-      IF( lk_zdftke ) THEN
-         IF(lwp) WRITE(numout,*) '      TKE dependent eddy coefficients'
+      IF( lk_zdfgls ) THEN
+         IF(lwp) WRITE(numout,*) '      GLS dependent eddy coefficients'
          ioptio = ioptio+1
       ENDIF
@@ -125,6 +125,9 @@
          ioptio = ioptio+1
       ENDIF
-      IF( lk_zdftke_old .OR. lk_zdftke ) THEN
+      IF( lk_zdftke ) THEN
          IF(lwp) WRITE(numout,*) '      use the 1.5 turbulent closure'
+      ENDIF
+      IF( lk_zdfgls ) THEN
+         IF(lwp) WRITE(numout,*) '      use the GLS closure scheme'
       ENDIF
       IF( lk_zdfkpp ) THEN
@@ -136,6 +139,6 @@
       ENDIF
       IF ( ioptio > 1 .AND. .NOT. lk_esopa )   CALL ctl_stop( ' chose between ln_zdfnpc and ln_zdfevd' )
-      IF( ioptio == 0 .AND. .NOT.( lk_zdftke_old .OR. lk_zdftke .OR. lk_zdfkpp ) ) &
-         CALL ctl_stop( ' except for TKE sor KPP physics, a convection scheme is', &
+      IF( ioptio == 0 .AND. .NOT.( lk_zdftke .OR. lk_zdfgls .OR. lk_zdfkpp ) ) &
+         CALL ctl_stop( ' except for TKE, GLS or KPP physics, a convection scheme is', &
          &              ' required: ln_zdfevd or ln_zdfnpc logicals' )
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfkpp.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfkpp.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfkpp.F90	(revision 2528)
@@ -5,8 +5,9 @@
    !!                 turbulent closure parameterization
    !!=====================================================================
-   !! History :  8.1  ! 00-03 (W.G. Large, J. Chanut) Original code
-   !!            8.1  ! 02-06 (J.M. Molines) for real case CLIPPER  
-   !!            8.2  ! 03-10 (Chanut J.) re-writting
-   !!            9.0  ! 05-01 (C. Ethe) Free form, F90
+   !! History :  OPA  ! 2000-03 (W.G. Large, J. Chanut) Original code
+   !!            8.1  ! 2002-06 (J.M. Molines) for real case CLIPPER  
+   !!            8.2  ! 2003-10 (Chanut J.) re-writting
+   !!   NEMO     1.0  ! 2005-01 (C. Ethe, G. Madec) Free form, F90 + creation of tra_kpp routine
+   !!            3.3  ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA
    !!----------------------------------------------------------------------
 #if defined key_zdfkpp   ||   defined key_esopa
@@ -14,7 +15,8 @@
    !!   'key_zdfkpp'                                             KPP scheme
    !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
    !!   zdf_kpp      : update momentum and tracer Kz from a kpp scheme
    !!   zdf_kpp_init : initialization, namelist read, and parameters control
+   !!   tra_kpp      : compute and add to the T & S trend the non-local flux
+   !!   trc_kpp      : compute and add to the passive tracer trend the non-local flux (lk_top=T)
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and active tracers 
@@ -28,11 +30,16 @@
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
    USE prtctl          ! Print control
-   USE trdmod          ! momentum/tracers trends 
+   USE trdmod_oce      ! ocean trends definition
+   USE trdtra          ! tracers trends
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   zdf_kpp   ! routine called by step.F90
-   PUBLIC   tra_kpp   ! routine called by step.F90
+   PUBLIC   zdf_kpp       ! routine called by step.F90
+   PUBLIC   zdf_kpp_init  ! routine called by opa.F90
+   PUBLIC   tra_kpp       ! routine called by step.F90
+#if defined key_top
+   PUBLIC   trc_kpp       ! routine called by trcstp.F90
+#endif
 
    LOGICAL , PUBLIC, PARAMETER ::   lk_zdfkpp = .TRUE.    !: KPP vertical mixing flag
@@ -53,82 +60,81 @@
 
 #if defined key_zdfddm
-   REAL(wp) ::                 & !!! ** Double diffusion Mixing
-      difssf  = 1.e-03_wp   ,  &  ! maximum salt fingering mixing 
-      Rrho0   = 1.9_wp      ,  &  ! limit for salt  fingering mixing 
-      difsdc  = 1.5e-06_wp       ! maximum diffusive convection mixing
+   !                                        !!! ** Double diffusion Mixing
+   REAL(wp) ::   difssf  = 1.e-03_wp         ! maximum salt fingering mixing 
+   REAL(wp) ::   Rrho0   = 1.9_wp            ! limit for salt  fingering mixing 
+   REAL(wp) ::   difsdc  = 1.5e-06_wp        ! maximum diffusive convection mixing
 #endif
    LOGICAL  ::   ln_kpprimix  = .TRUE.       ! Shear instability mixing 
 
-   REAL(wp) ::                 & !!! ** General constants  **
-      epsln   = 1.0e-20_wp   , &  ! a small positive number    
-      pthird  = 1._wp/3._wp  , &  ! 1/3
-      pfourth = 1._wp/4._wp       ! 1/4
-
-   REAL(wp) ::                 & !!! ** Boundary Layer Turbulence Parameters  **
-      vonk     = 0.4_wp     ,  &  ! von Karman's constant
-      epsilon  = 0.1_wp     ,  &  ! nondimensional extent of the surface layer
-      rconc1   = 5.0_wp     ,  &  ! standard flux profile function parmaeters
-      rconc2   = 16.0_wp    ,  &  !         "        "
-      rconcm   = 8.38_wp    ,  &  ! momentum flux profile fit
-      rconam   = 1.26_wp    ,  &  !         "       "
-      rzetam   = -.20_wp    ,  &  !         "       "       
-      rconcs   = 98.96_wp   ,  &  !  scalar  flux profile fit
-      rconas   = -28.86_wp  ,  &  !         "       "
-      rzetas   = -1.0_wp          !         "       "  
-   REAL(wp) ::                 & !!! ** Boundary Layer Depth Diagnostic  **
-      Ricr     = 0.3_wp     ,  &  ! critical bulk Richardson Number
-      rcekman  = 0.7_wp     ,  &  ! coefficient for ekman depth  
-      rcmonob  = 1.0_wp     ,  &  ! coefficient for Monin-Obukhov depth 
-      rconcv   = 1.7_wp     ,  &  ! ratio of interior buoyancy frequency to buoyancy frequency at entrainment depth
-      hbf      = 1.0_wp     ,  &  ! fraction of bound. layer depth to which absorbed solar 
-      !                           ! rad. and contributes to surf. buo. forcing
-      Vtc                         ! function of rconcv,rconcs,epsilon,vonk,Ricr
-   REAL(wp) ::                 & !!! ** Nonlocal Boundary Layer Mixing **
-      rcstar   = 5.0_wp     ,  &  ! coefficient for convective nonlocal transport
-      rcs      = 1.0e-3_wp  ,  &  ! conversion: mm/s ==> m/s   
-      rcg                         ! non-dimensional coefficient for nonlocal transport
+   !                                        !!! ** General constants  **
+   REAL(wp) ::   epsln   = 1.0e-20_wp        ! a small positive number    
+   REAL(wp) ::   pthird  = 1._wp/3._wp       ! 1/3
+   REAL(wp) ::   pfourth = 1._wp/4._wp       ! 1/4
+
+   !                                        !!! ** Boundary Layer Turbulence Parameters  **
+   REAL(wp) ::   vonk     = 0.4_wp           ! von Karman's constant
+   REAL(wp) ::   epsilon  = 0.1_wp           ! nondimensional extent of the surface layer
+   REAL(wp) ::   rconc1   = 5.0_wp           ! standard flux profile function parmaeters
+   REAL(wp) ::   rconc2   = 16.0_wp          !         "        "
+   REAL(wp) ::   rconcm   = 8.38_wp          ! momentum flux profile fit
+   REAL(wp) ::   rconam   = 1.26_wp          !         "       "
+   REAL(wp) ::   rzetam   = -.20_wp          !         "       "       
+   REAL(wp) ::   rconcs   = 98.96_wp         !  scalar  flux profile fit
+   REAL(wp) ::   rconas   = -28.86_wp        !         "       "
+   REAL(wp) ::   rzetas   = -1.0_wp          !         "       "  
+   
+   !                                        !!! ** Boundary Layer Depth Diagnostic  **
+   REAL(wp) ::   Ricr     = 0.3_wp           ! critical bulk Richardson Number
+   REAL(wp) ::   rcekman  = 0.7_wp           ! coefficient for ekman depth  
+   REAL(wp) ::   rcmonob  = 1.0_wp           ! coefficient for Monin-Obukhov depth 
+   REAL(wp) ::   rconcv   = 1.7_wp           ! ratio of interior buoyancy frequency to its value at entrainment depth
+   REAL(wp) ::   hbf      = 1.0_wp           ! fraction of bound. layer depth to which absorbed solar 
+      !                                      ! rad. and contributes to surf. buo. forcing
+   REAL(wp) ::   Vtc                         ! function of rconcv,rconcs,epsilon,vonk,Ricr
+   
+   !                                        !!! ** Nonlocal Boundary Layer Mixing **
+   REAL(wp) ::   rcstar   = 5.0_wp           ! coefficient for convective nonlocal transport
+   REAL(wp) ::   rcs      = 1.0e-3_wp        ! conversion: mm/s ==> m/s   
+   REAL(wp) ::   rcg                         ! non-dimensional coefficient for nonlocal transport
 
 #if ! defined key_kppcustom
-   REAL(wp), DIMENSION(jpk,jpk) ::   del   ! array for reference mean values of vertical integration 
+   REAL(wp), DIMENSION(jpk,jpk) ::   del     ! array for reference mean values of vertical integration 
 #endif
 
 #if defined key_kpplktb
-   INTEGER, PARAMETER ::       & !!! ** Parameters for lookup table for turbulent velocity scales ** 
-      nilktb   = 892        ,  &  ! number of values for zehat in KPP lookup table
-      njlktb   = 482        ,  &  ! number of values for ustar in KPP lookup table
-      nilktbm1 = nilktb - 1 ,  &  !
-      njlktbm1 = njlktb - 1       !
-
-   REAL(wp), DIMENSION(nilktb,njlktb) ::   wmlktb   ! lookup table for the turbulent vertical velocity scale for momentum
-   REAL(wp), DIMENSION(nilktb,njlktb) ::   wslktb   ! lookup table for the turbulent vertical velocity scale for tracers
-
-   REAL(wp) ::                 &
-      dehatmin = -4.e-7_wp  ,  &  ! minimum limit for zhat in lookup table (m3/s3) 
-      dehatmax = 0._wp      ,  &  ! maximum limit for zhat in lookup table (m3/s3)
-      ustmin   = 0._wp      ,  &  ! minimum limit for ustar in lookup table (m/s)
-      ustmax   = 0.04_wp    ,  &  ! maximum limit for ustar in lookup table (m/s)    
-      dezehat               ,  &  ! delta zhat in lookup table
-      deustar                     ! delta ustar in lookup table
+   !                                         !!! ** Parameters for lookup table for turbulent velocity scales ** 
+   INTEGER, PARAMETER ::   nilktb   = 892     ! number of values for zehat in KPP lookup table
+   INTEGER, PARAMETER ::   njlktb   = 482     ! number of values for ustar in KPP lookup table
+   INTEGER, PARAMETER ::   nilktbm1 = nilktb-1   !
+   INTEGER, PARAMETER ::   njlktbm1 = njlktb-1   !
+
+   REAL(wp), DIMENSION(nilktb,njlktb) ::   wmlktb   ! lookup table for the turbulent vertical velocity scale (momentum)
+   REAL(wp), DIMENSION(nilktb,njlktb) ::   wslktb   ! lookup table for the turbulent vertical velocity scale (tracers)
+
+   REAL(wp) ::   dehatmin = -4.e-7_wp    ! minimum limit for zhat in lookup table (m3/s3) 
+   REAL(wp) ::   dehatmax = 0._wp        ! maximum limit for zhat in lookup table (m3/s3)
+   REAL(wp) ::   ustmin   = 0._wp        ! minimum limit for ustar in lookup table (m/s)
+   REAL(wp) ::   ustmax   = 0.04_wp      ! maximum limit for ustar in lookup table (m/s)    
+   REAL(wp) ::   dezehat                 ! delta zhat in lookup table
+   REAL(wp) ::   deustar                 ! delta ustar in lookup table
 #endif
    REAL(wp), DIMENSION(jpk) ::   ratt   ! attenuation coef  (already defines in module traqsr, 
    !                                    ! but only if the solar radiation penetration is considered)
-   REAL(wp) ::                 & !!! * penetrative solar radiation coefficient *
-      rabs = 0.58_wp        ,  &  ! fraction associated with xsi1
-      xsi1 = 0.35_wp        ,  &  ! first depth of extinction 
-      xsi2 = 23.0_wp              ! second depth of extinction 
+   
+   !                                    !!! * penetrative solar radiation coefficient *
+   REAL(wp) ::   rabs = 0.58_wp          ! fraction associated with xsi1
+   REAL(wp) ::   xsi1 = 0.35_wp          ! first depth of extinction 
+   REAL(wp) ::   xsi2 = 23.0_wp          ! second depth of extinction 
       !                           ! (default values: water type Ib) 
 
-   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
-      etmean                ,  &  ! coefficient used for horizontal smoothing
-      eumean                ,  &  ! at t-, u- and v-points
-      evmean  
+   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   etmean, eumean, evmean   ! coeff. used for hor. smoothing at t-, u- & v-points
+        
  
 #if defined key_c1d
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &
-      rig                   ,  &  ! gradient Richardson number
-      rib                   ,  &  ! bulk Richardson number
-      buof                  ,  &  ! buoyancy forcing
-      mols                        ! moning-Obukhov length scale 
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ekdp   ! Ekman depth
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   rig    !: gradient Richardson number
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   rib    !: bulk Richardson number
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   buof   !: buoyancy forcing
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   mols   !: moning-Obukhov length scale 
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   ekdp   !: Ekman depth
 #endif
 
@@ -140,12 +146,12 @@
 #  include  "zdfddm_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL   (2009)
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
 CONTAINS
 
-   SUBROUTINE zdf_kpp ( kt )
+   SUBROUTINE zdf_kpp( kt )
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE zdf_kpp  ***
@@ -183,10 +189,10 @@
       !!----------------------------------------------------------------------
 #if defined  key_zdfddm
-      USE oce     , zviscos => ua,      &  ! temp. array for viscosities use ua as workspace
-         &          zdiffut => ta,      &  ! temp. array for diffusivities use sa as workspace
-         &          zdiffus => sa          ! temp. array for diffusivities use sa as workspace
+      USE oce     , zviscos => ua   ! temp. array for viscosities use ua as workspace
+      USE oce     , zdiffut => ta   ! temp. array for diffusivities use sa as workspace
+      USE oce     , zdiffus => sa   ! temp. array for diffusivities use sa as workspace
 #else
-      USE oce     , zviscos => ua,      &  ! temp. array for viscosities use ua as workspace
-         &          zdiffut => ta          ! temp. array for diffusivities use sa as workspace
+      USE oce     , zviscos => ua   ! temp. array for viscosities use ua as workspace
+      USE oce     , zdiffut => ta   ! temp. array for diffusivities use sa as workspace
 #endif
       !!
@@ -196,107 +202,43 @@
       INTEGER ::   ikbot, jkmax, jkm1, jkp2   !
 
-      REAL(wp), DIMENSION(jpi,jpj) ::   & !!! Surface buoyancy forcing, friction velocity
-         zBo, zBosol, zustar              !
-                      !
-      REAL(wp) ::                       &  !
-         ztx, zty, zflageos,            &  !
-         zstabl, zbuofdep,zucube,       &  !
-         zrhos, zalbet, zbeta,          &  !
-         zthermal, zhalin, zatt1           !
-     
-      REAL(wp) ::                       & !!! Bulk richardson number
-         zref, zt, zs, zh,              &  !
-         zu, zv, zrh,                   &  !
-         zrib, zrinum,                  &  !
-         zdVsq, zVtsq                      !
-      
-      REAL(wp) ::                       & !!! Velocity scales
-         zehat, zeta, zhrib, zsig,      &  !
-         zscale, zwst, zws, zwm
-
+      REAL(wp), DIMENSION(jpi,jpj) ::   zBo, zBosol, zustar         ! Surface buoyancy forcing, friction velocity
+      REAL(wp) ::   ztx, zty, zflageos, zstabl, zbuofdep,zucube     !
+      REAL(wp) ::   zrhos, zalbet, zbeta, zthermal, zhalin, zatt1   !
+      REAL(wp) ::   zref, zt, zs, zh, zu, zv, zrh                   ! Bulk richardson number
+      REAL(wp) ::   zrib, zrinum, zdVsq, zVtsq                      !
+      REAL(wp) ::   zehat, zeta, zhrib, zsig, zscale, zwst, zws, zwm   ! Velocity scales
 #if defined key_kpplktb
-      INTEGER ::                        & !!! Lookup table or Analytical functions 
-         il, jl                            !
-      REAL(wp) ::                       &  !
-         ud, zfrac, ufrac,              &  !
-         zwam, zwbm, zwas, zwbs            !
+      INTEGER ::    il, jl                                          ! Lookup table or Analytical functions 
+      REAL(wp) ::   ud, zfrac, ufrac, zwam, zwbm, zwas, zwbs        !
 #else
-     REAL(wp) ::                        &  !
-        zwsun, zwmun,                   & 
-        zcons, zconm, zwcons, zwconm      !
-#endif
- 
-     REAL(wp) ::                       & !!! In situ density
-         zsr, zbw, ze,                  &  !
-         zb, zd, zc, zaw, za,           &  !
-         zb1, za1, zkw, zk0,            &  !
-         zcomp , zrhd, zrhdr,zbvzed       !
-
+      REAL(wp) ::   zwsun, zwmun, zcons, zconm, zwcons, zwconm      !
+#endif
+      REAL(wp) ::   zsr, zbw, ze, zb, zd, zc, zaw, za, zb1, za1, zkw, zk0, zcomp , zrhd,zrhdr,zbvzed   ! In situ density
 #if ! defined key_kppcustom     
-     !! * local declarations
-      INTEGER ::                        &
-         jm                                ! dummy loop indices
-      REAL(wp) ::                       & !!! Compression terms
-         zr1, zr2, zr3, zr4,            &  !
-         zrhop                             !
-#endif
- 
-      REAL(wp) ::                       &  !
-         zflag, ztemp, zrn2,            &  !
-         zdep21, zdep32, zdep43
-
-      REAL(wp) ::                       & !!! Interior richardson mixing
-         zdku2, zdkv2, ze3sqr,          &  !
-         zsh2, zri, zfri                   !
-
-      REAL(wp), DIMENSION(jpi,0:2) ::  &  !!! Moning-Obukov limitation
-         zmoek
-      REAL(wp), DIMENSION(jpi)     ::  &
-         zmoa, zekman                
-      REAL(wp)                     ::  &
-         zmob, zek
-
-      REAL(wp), DIMENSION(jpi,4) ::     &  !!! The pipe 
-         zdepw, zdift, zvisc
-      REAL(wp), DIMENSION(jpi,3) ::     & 
-         zdept
-      REAL(wp), DIMENSION(jpi,2) ::     &  
-         zriblk
-      REAL(wp), DIMENSION(jpi,jpk) ::   &  !
-         zmask                          
-      REAL(wp), DIMENSION(jpi) ::       &  ! 
-         zhmax, zria, zhbl 
-      REAL(wp) ::                       &  !
-         zflagri, zflagek,              &  !
-         zflagmo, zflagh, zflagkb          !
-      REAL(wp), DIMENSION(jpi)     ::   & !!! Shape function (G)
-         za2m, za3m, zkmpm,             &
-         za2t, za3t, zkmpt
-      REAL(wp) ::                       &  !
-         zdelta, zdelta2,               &  !
-         zdzup, zdzdn, zdzh,            &  !
-         zvath, zgat1, zdat1,           &  !
-         zkm1m, zkm1t
-      REAL(wp), DIMENSION(jpi,jpk) ::   & !!! Boundary layer diffusivities/viscosities
-         zblcm, zblct                          
+      INTEGER  ::   jm                          ! dummy loop indices
+      REAL(wp) ::   zr1, zr2, zr3, zr4, zrhop   ! Compression terms
+#endif
+      REAL(wp) ::   zflag, ztemp, zrn2, zdep21, zdep32, zdep43
+      REAL(wp) ::   zdku2, zdkv2, ze3sqr, zsh2, zri, zfri          ! Interior richardson mixing
+      REAL(wp), DIMENSION(jpi,0:2) ::   zmoek                      ! Moning-Obukov limitation
+      REAL(wp), DIMENSION(jpi)     ::   zmoa, zekman                
+      REAL(wp)                     ::   zmob, zek
+      REAL(wp), DIMENSION(jpi,4)   ::   zdepw, zdift, zvisc   ! The pipe 
+      REAL(wp), DIMENSION(jpi,3)   ::   zdept
+      REAL(wp), DIMENSION(jpi,2)   ::   zriblk
+      REAL(wp), DIMENSION(jpi,jpk) ::   zmask                          
+      REAL(wp), DIMENSION(jpi)     ::   zhmax, zria, zhbl 
+      REAL(wp) ::   zflagri, zflagek, zflagmo, zflagh, zflagkb   !
+      REAL(wp), DIMENSION(jpi)     ::   za2m, za3m, zkmpm, za2t, za3t, zkmpt   ! Shape function (G)
+      REAL(wp) ::   zdelta, zdelta2, zdzup, zdzdn, zdzh, zvath, zgat1, zdat1, zkm1m, zkm1t
+      REAL(wp), DIMENSION(jpi,jpk) ::   zblcm, zblct   ! Boundary layer diffusivities/viscosities
 #if defined key_zdfddm
-      REAL(wp) ::                       & !!! double diffusion mixing
-         zrrau, zds,                    &
-         zavdds, zavddt,zinr 
-      REAL(wp), DIMENSION(jpi,4) ::     &  
-        zdifs
-      REAL(wp), DIMENSION(jpi)     ::   &
-         za2s, za3s, zkmps
-      REAL(wp) ::                       & 
-         zkm1s
-      REAL(wp), DIMENSION(jpi,jpk) ::   & 
-         zblcs                     
+      REAL(wp) ::   zrrau, zds, zavdds, zavddt,zinr   ! double diffusion mixing
+      REAL(wp), DIMENSION(jpi,4) ::     zdifs
+      REAL(wp), DIMENSION(jpi)     ::   za2s, za3s, zkmps
+      REAL(wp) ::                       zkm1s
+      REAL(wp), DIMENSION(jpi,jpk) ::   zblcs                     
 #endif
       !!--------------------------------------------------------------------
-
-
-      ! Initialization (first time-step only)
-      ! --------------
-      IF( kt == nit000  )   CALL zdf_kpp_init
      
       zviscos(:,:,:) = 0.
@@ -453,9 +395,9 @@
             zBosol(ji,jj) = grav * zthermal * qsr(ji,jj)
             ! Non radiative surface buoyancy force
-            zBo   (ji,jj) = grav * zthermal * qns(ji,jj) -  grav * zhalin * emps(ji,jj)
+            zBo   (ji,jj) = grav * zthermal * qns(ji,jj) -  grav * zhalin * ( emps(ji,jj)-rnf(ji,jj) ) 
             ! Surface Temperature flux for non-local term
             wt0(ji,jj) = - ( qsr(ji,jj) + qns(ji,jj) )* ro0cpr * tmask(ji,jj,1)
             ! Surface salinity flux for non-local term
-            ws0(ji,jj) = - ( emps(ji,jj) * sn(ji,jj,1) * rcs ) * tmask(ji,jj,1)
+            ws0(ji,jj) = - ( ( emps(ji,jj)-rnf(ji,jj) ) * sn(ji,jj,1) * rcs ) * tmask(ji,jj,1) 
          ENDDO
       ENDDO
@@ -497,5 +439,5 @@
             zria(ji ) = 0.
             ! Maximum boundary layer depth
-            ikbot     = mbathy(ji,jj) - 1 ! ikbot is the last T point in the water
+            ikbot     = mbkt(ji,jj)    ! ikbot is the last T point in the water
             zhmax(ji) = fsdept(ji,jj,ikbot) - 0.001      
             ! Compute Monin obukhov length scale at the surface and Ekman depth:
@@ -1236,15 +1178,9 @@
       !!                  ***  ROUTINE tra_kpp  ***
       !!
-      !! ** Purpose :   compute and add to the tracer trend the non-local
-      !!      tracer flux
+      !! ** Purpose :   compute and add to the tracer trend the non-local tracer flux
       !!
       !! ** Method  :   ???
-      !!
-      !! history :
-      !!     9.0  ! 05-11 (G. Madec)  Original code
       !!----------------------------------------------------------------------
-      !! * Modules used
-      USE oce, ONLY :    ztrdt => ua,       & ! use ua as 3D workspace
-                         ztrds => va          ! use va as 3D workspace
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdt, ztrds   ! 3D workspace
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) :: kt
@@ -1252,26 +1188,24 @@
 
       IF( kt == nit000 ) THEN
-         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 
          IF(lwp) WRITE(numout,*) 'tra_kpp : KPP non-local tracer fluxes'
          IF(lwp) WRITE(numout,*) '~~~~~~~   '
       ENDIF
 
-
-      ! Save ta and sa trends
-      IF( l_trdtra )   THEN
-         ztrdt(:,:,:) = ta(:,:,:)
-         ztrds(:,:,:) = sa(:,:,:)
+      IF( l_trdtra )   THEN                    !* Save ta and sa trends
+         ALLOCATE( ztrdt(jpi,jpj,jpk) )   ;    ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
+         ALLOCATE( ztrds(jpi,jpj,jpk) )   ;    ztrds(:,:,:) = tsa(:,:,:,jp_sal)
       ENDIF
 
       ! add non-local temperature and salinity flux ( in convective case only)
       DO jk = 1, jpkm1
-         DO jj = 2, jpjm1
+         DO jj = 2, jpjm1 
             DO ji = fs_2, fs_jpim1
-               ta(ji,jj,jk) =  ta(ji,jj,jk)                           &
-                  &         - ( ghats(ji,jj,jk  ) * avt(ji,jj,jk  )   &
-                  &           - ghats(ji,jj,jk+1) * avt(ji,jj,jk+1) ) * wt0(ji,jj) / fse3t(ji,jj,jk)
-               sa(ji,jj,jk) = sa(ji,jj,jk)                              &
-                  &         - ( ghats(ji,jj,jk  ) * fsavs(ji,jj,jk  )   &
-                  &           - ghats(ji,jj,jk+1) * fsavs(ji,jj,jk+1) ) * ws0(ji,jj) / fse3t(ji,jj,jk)
+               tsa(ji,jj,jk,jp_tem) =  tsa(ji,jj,jk,jp_tem)                      &
+                  &                 - (  ghats(ji,jj,jk  ) * avt  (ji,jj,jk  )   & 
+                  &                    - ghats(ji,jj,jk+1) * avt  (ji,jj,jk+1) ) * wt0(ji,jj) / fse3t(ji,jj,jk)
+               tsa(ji,jj,jk,jp_sal) =  tsa(ji,jj,jk,jp_sal)                      &
+                  &                 - (  ghats(ji,jj,jk  ) * fsavs(ji,jj,jk  )   & 
+                  &                    - ghats(ji,jj,jk+1) * fsavs(ji,jj,jk+1) ) * ws0(ji,jj) / fse3t(ji,jj,jk)
             END DO
          END DO
@@ -1280,17 +1214,84 @@
       ! save the non-local tracer flux trends for diagnostic
       IF( l_trdtra )   THEN
-         ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:)
-         ztrds(:,:,:) = sa(:,:,:) - ztrds(:,:,:)
+         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
+         ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:)
 !!bug gm jpttdzdf ==> jpttkpp
-         CALL trd_mod(ztrdt, ztrds, jptra_trd_zdf, 'TRA', kt)
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_zdf, ztrdt )
+         CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_zdf, ztrds )
+         DEALLOCATE( ztrdt )      ;     DEALLOCATE( ztrds )
       ENDIF
 
-      IF(ln_ctl) THEN  
-         CALL prt_ctl( tab3d_1=ta, clinfo1=' kpp  - Ta: ', mask1=tmask,   &
-         &             tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+      IF(ln_ctl) THEN
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' kpp  - Ta: ', mask1=tmask,   &
+         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
       ENDIF
 
    END SUBROUTINE tra_kpp
 
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   SUBROUTINE trc_kpp( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_kpp  ***
+      !!
+      !! ** Purpose :   compute and add to the tracer trend the non-local
+      !!                tracer flux
+      !!
+      !! ** Method  :   ???
+      !!
+      !! history :
+      !!            9.0  ! 2005-11 (G. Madec)  Original code
+      !!       NEMO 3.3  ! 2010-06 (C. Ethe )  Adapted to passive tracers
+      !!----------------------------------------------------------------------
+      USE trc
+      USE prtctl_trc          ! Print control
+      !! * Arguments
+      INTEGER ,                         INTENT( in    )  :: kt     ! ocean time-step index
+      !! * Local declarations
+      INTEGER  ::   ji, jj, jk, jn      ! Dummy loop indices
+      REAL(wp) ::   ztra, zflx
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*) 
+         IF(lwp) WRITE(numout,*) 'trc_kpp : KPP non-local tracer fluxes'
+         IF(lwp) WRITE(numout,*) '~~~~~~~   '
+      ENDIF
+
+      IF( l_trdtrc )  ALLOCATE( ztrtrd(jpi,jpj,jpk) )
+      !
+      DO jn = 1, jptra
+         !
+         IF( l_trdtrc )  ztrtrd(:,:,:)  = tra(:,:,:,jn)
+         ! add non-local on passive tracer flux ( in convective case only)
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1 
+               DO ji = fs_2, fs_jpim1
+                  ! Surface tracer flux for non-local term 
+                  zflx = - ( emps(ji,jj) * tra(ji,jj,1,jn) * rcs ) * tmask(ji,jj,1)
+                  ! compute the trend
+                  ztra = - ( ghats(ji,jj,jk  ) * fsavs(ji,jj,jk  )   &
+                  &        - ghats(ji,jj,jk+1) * fsavs(ji,jj,jk+1) ) * zflx / fse3t(ji,jj,jk)
+                  ! add the trend to the general trend
+                  tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn)  + ztra
+               END DO
+            END DO
+         END DO
+         ! save the non-local tracer flux trends for diagnostic
+         IF( l_trdtrc )  ztrtrd(:,:,:)  = tra(:,:,:,jn) - ztrtrd(:,:,:)
+         CALL trd_tra( kt, 'TRC', jn, jptra_trd_zdf, ztrtrd(:,:,:,jn) )
+         !
+      END DO
+      IF( l_trdtrc )  DEALLOCATE( ztrtrd )
+      IF( ln_ctl )   THEN
+         WRITE(charout, FMT="(' kpp')")  ;  CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=clname, clinfo2='trd' )
+      ENDIF
+      !
+   END SUBROUTINE trc_kpp
+#endif
 
    SUBROUTINE zdf_kpp_init
@@ -1305,33 +1306,16 @@
       !!
       !! ** input   :   Namlist namkpp
-      !!
-      !!
-      !! history :
-      !!     8.1  ! 00-02 (J. Chanut) KPP Mixing
-      !!     9.0  ! 05-01 (C. Ethe) F90 : free form
       !!----------------------------------------------------------------------
-      !! * local declarations
-
-      INTEGER    ::   &
-         ji, jj, jk             ! dummy loop indices
-      
+      INTEGER  ::   ji, jj, jk     ! dummy loop indices
 #if ! defined key_kppcustom
-      INTEGER    ::   &
-         jm                       ! dummy loop indices     
-      REAL(wp)   ::              & !!! tempory scalars
-         zref, zdist
-#endif
-
+      INTEGER  ::   jm             ! dummy loop indices     
+      REAL(wp) ::   zref, zdist    ! tempory scalars
+#endif
 #if defined key_kpplktb
-      REAL(wp)   ::              & !!! tempory scalars
-         zustar,    &
-         zucube, zustvk,         & 
-         zeta, zehat
-#endif
-      REAL(wp)   ::             & !!! tempory scalars
-         zhbf
-      LOGICAL ::                &
-         ll_kppcustom,          &  ! 1st ocean level taken as surface layer
-         ll_kpplktb                ! Lookup table for turbul. velocity scales 
+      REAL(wp) ::   zustar, zucube, zustvk, zeta, zehat   ! tempory scalars
+#endif
+      REAL(wp) ::   zhbf           ! tempory scalars
+      LOGICAL  ::   ll_kppcustom   ! 1st ocean level taken as surface layer
+      LOGICAL  ::   ll_kpplktb     ! Lookup table for turbul. velocity scales 
       !!
       NAMELIST/namzdf_kpp/ ln_kpprimix, rn_difmiw, rn_difsiw, rn_riinfty, rn_difri, rn_bvsqcon, rn_difcon, nn_ave
@@ -1540,10 +1524,18 @@
    LOGICAL, PUBLIC, PARAMETER ::   lk_zdfkpp = .FALSE.   !: KPP flag
 CONTAINS
-   SUBROUTINE zdf_kpp( kt )          ! Empty routine
+   SUBROUTINE zdf_kpp_init           ! Dummy routine
+      WRITE(*,*) 'zdf_kpp_init: You should not have seen this print! error?'
+   END SUBROUTINE zdf_kpp_init
+   SUBROUTINE zdf_kpp( kt )          ! Dummy routine
       WRITE(*,*) 'zdf_kpp: You should not have seen this print! error?', kt
    END SUBROUTINE zdf_kpp
-   SUBROUTINE tra_kpp( kt )          ! Empty routine
+   SUBROUTINE tra_kpp( kt )          ! Dummy routine
       WRITE(*,*) 'tra_kpp: You should not have seen this print! error?', kt
    END SUBROUTINE tra_kpp
+#if defined key_top
+   SUBROUTINE trc_kpp( kt )          ! Dummy routine
+      WRITE(*,*) 'trc_kpp: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_kpp
+#endif
 #endif
 
Index: trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90	(revision 2528)
@@ -29,7 +29,7 @@
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -69,6 +69,6 @@
 
       ! w-level of the mixing and mixed layers
-      nmln(:,:) = mbathy(:,:)          ! Initialization to the number of w ocean point mbathy
-      imld(:,:) = mbathy(:,:)
+      nmln(:,:) = mbkt(:,:) + 1        ! Initialization to the number of w ocean point
+      imld(:,:) = mbkt(:,:) + 1
       DO jk = jpkm1, nlb10, -1         ! from the bottom to nlb10
          DO jj = 1, jpj
Index: trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90	(revision 2528)
@@ -10,4 +10,5 @@
    !!            8.0  ! 1997-06 (G. Madec)  complete rewriting of zdfmix
    !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module
+   !!            3.3  ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase
    !!----------------------------------------------------------------------
 #if defined key_zdfric   ||   defined key_esopa
@@ -28,5 +29,6 @@
    PRIVATE
 
-   PUBLIC   zdf_ric    ! called by step.F90
+   PUBLIC   zdf_ric         ! called by step.F90
+   PUBLIC   zdf_ric_init    ! called by opa.F90
 
    LOGICAL, PUBLIC, PARAMETER ::   lk_zdfric = .TRUE.   !: Richardson vertical mixing flag
@@ -42,7 +44,7 @@
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 CONTAINS
@@ -82,6 +84,4 @@
       !!----------------------------------------------------------------------
 
-      IF( kt == nit000  ) CALL zdf_ric_init            ! Initialization (first time-step only)
-
       !                                                ! ===============
       DO jk = 2, jpkm1                                 ! Horizontal slab
@@ -193,4 +193,6 @@
    LOGICAL, PUBLIC, PARAMETER ::   lk_zdfric = .FALSE.   !: Richardson mixing flag
 CONTAINS
+   SUBROUTINE zdf_ric_init         ! Dummy routine
+   END SUBROUTINE zdf_ric_init
    SUBROUTINE zdf_ric( kt )        ! Dummy routine
       WRITE(*,*) 'zdf_ric: You should not have seen this print! error?', kt
Index: trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90	(revision 2528)
@@ -25,4 +25,5 @@
    !!            3.2  !  2009-06  (G. Madec, S. Masson) TKE restart compatible with key_cpl 
    !!                 !                                + cleaning of the parameters + bugs correction
+   !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase
    !!----------------------------------------------------------------------
 #if defined key_zdftke   ||   defined key_esopa
@@ -30,63 +31,64 @@
    !!   'key_zdftke'                                   TKE vertical physics
    !!----------------------------------------------------------------------
-   !!   zdf_tke       : update momentum and tracer Kz from a tke scheme
-   !!   tke_tke       : tke time stepping: update tke at now time step (en)
-   !!   tke_avn       : compute mixing length scale and deduce avm and avt
-   !!   tke_init      : initialization, namelist read, and parameters control
-   !!   tke_rst       : read/write tke restart in ocean restart file
+   !!   zdf_tke      : update momentum and tracer Kz from a tke scheme
+   !!   tke_tke      : tke time stepping: update tke at now time step (en)
+   !!   tke_avn      : compute mixing length scale and deduce avm and avt
+   !!   zdf_tke_init : initialization, namelist read, and parameters control
+   !!   tke_rst      : read/write tke restart in ocean restart file
    !!----------------------------------------------------------------------
-   USE oce            ! ocean dynamics and active tracers 
-   USE dom_oce        ! ocean space and time domain
-   USE domvvl         ! ocean space and time domain : variable volume layer
-   USE zdf_oce        ! ocean vertical physics
+   USE oce            ! ocean: dynamics and active tracers variables
+   USE phycst         ! physical constants
+   USE dom_oce        ! domain: ocean
+   USE domvvl         ! domain: variable volume layer
    USE sbc_oce        ! surface boundary condition: ocean
-   USE phycst         ! physical constants
-   USE zdfmxl         ! mixed layer
-   USE restart        ! only for lrst_oce
+   USE zdf_oce        ! vertical physics: ocean variables
+   USE zdfmxl         ! vertical physics: mixed layer
+   USE restart        ! ocean restart
    USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
    USE prtctl         ! Print control
    USE in_out_manager ! I/O manager
    USE iom            ! I/O manager library
-   USE zdfbfr          ! bottom friction
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   zdf_tke    ! routine called in step module
-   PUBLIC   tke_rst    ! routine called in step module
+   PUBLIC   zdf_tke        ! routine called in step module
+   PUBLIC   zdf_tke_init   ! routine called in opa module
+   PUBLIC   tke_rst        ! routine called in step module
 
    LOGICAL , PUBLIC, PARAMETER              ::   lk_zdftke = .TRUE.  !: TKE vertical mixing flag
 
 #if defined key_c1d
-   !                                                                !!* 1D cfg only *
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   e_dis, e_mix        !: dissipation and mixing turbulent lengh scales
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   e_pdl, e_ric        !: prandl and local Richardson numbers
+   !                                                           !!** 1D cfg only  **   ('key_c1d')
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   e_dis, e_mix   !: dissipation and mixing turbulent lengh scales
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   e_pdl, e_ric   !: prandl and local Richardson numbers
 #endif
 
-   !                                       !!! ** Namelist  namzdf_tke  **
-   LOGICAL  ::   ln_mxl0   = .FALSE.         ! mixing length scale surface value as function of wind stress or not
-   INTEGER  ::   nn_mxl    =  2              ! type of mixing length (=0/1/2/3)
-   REAL(wp) ::   rn_lmin0  = 0.4_wp          ! surface  min value of mixing length   [m]
-   REAL(wp) ::   rn_lmin   = 0.1_wp          ! interior min value of mixing length   [m]
-   INTEGER  ::   nn_pdl    =  1              ! Prandtl number or not (ratio avt/avm) (=0/1)
-   REAL(wp) ::   rn_ediff  = 0.1_wp          ! coefficient for avt: avt=rn_ediff*mxl*sqrt(e)
-   REAL(wp) ::   rn_ediss  = 0.7_wp          ! coefficient of the Kolmogoroff dissipation 
-   REAL(wp) ::   rn_ebb    = 3.75_wp         ! coefficient of the surface input of tke
-   REAL(wp) ::   rn_emin   = 0.7071e-6_wp    ! minimum value of tke           [m2/s2]
-   REAL(wp) ::   rn_emin0  = 1.e-4_wp        ! surface minimum value of tke   [m2/s2]
-   REAL(wp) ::   rn_bshear = 1.e-20          ! background shear (>0)
-   INTEGER  ::   nn_etau   = 0               ! type of depth penetration of surface tke (=0/1/2)
-   INTEGER  ::   nn_htau   = 0               ! type of tke profile of penetration (=0/1)
-   REAL(wp) ::   rn_efr    = 1.0_wp          ! fraction of TKE surface value which penetrates in the ocean
-   REAL(wp) ::   rn_addhft = 0.0_wp          ! add offset   applied to HF tau
-   REAL(wp) ::   rn_sclhft = 1.0_wp          ! scale factor applied to HF tau
-   LOGICAL  ::   ln_lc     = .FALSE.         ! Langmuir cells (LC) as a source term of TKE or not
-   REAL(wp) ::   rn_lc     = 0.15_wp         ! coef to compute vertical velocity of Langmuir cells
-
-   REAL(wp) ::   ri_cri   ! critic Richardson number (deduced from rn_ediff and rn_ediss values)
-
-   REAL(wp), DIMENSION(jpi,jpj)     ::   htau      ! depth of tke penetration (nn_htau)
-   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   en        ! now turbulent kinetic energy   [m2/s2]
-   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   dissl     ! now mixing lenght of dissipation
+   !                                      !!** Namelist  namzdf_tke  **
+   LOGICAL  ::   ln_mxl0   = .FALSE.       ! mixing length scale surface value as function of wind stress or not
+   INTEGER  ::   nn_mxl    =  2            ! type of mixing length (=0/1/2/3)
+   REAL(wp) ::   rn_mxl0   = 0.04_wp       ! surface  min value of mixing length (kappa*z_o=0.4*0.1 m)  [m]
+   INTEGER  ::   nn_pdl    =  1            ! Prandtl number or not (ratio avt/avm) (=0/1)
+   REAL(wp) ::   rn_ediff  = 0.1_wp        ! coefficient for avt: avt=rn_ediff*mxl*sqrt(e)
+   REAL(wp) ::   rn_ediss  = 0.7_wp        ! coefficient of the Kolmogoroff dissipation 
+   REAL(wp) ::   rn_ebb    = 3.75_wp       ! coefficient of the surface input of tke
+   REAL(wp) ::   rn_emin   = 0.7071e-6_wp  ! minimum value of tke           [m2/s2]
+   REAL(wp) ::   rn_emin0  = 1.e-4_wp      ! surface minimum value of tke   [m2/s2]
+   REAL(wp) ::   rn_bshear = 1.e-20_wp     ! background shear (>0) currently a numerical threshold (do not change it)
+   INTEGER  ::   nn_etau   = 0             ! type of depth penetration of surface tke (=0/1/2/3)
+   INTEGER  ::   nn_htau   = 0             ! type of tke profile of penetration (=0/1)
+   REAL(wp) ::   rn_efr    = 1.0_wp        ! fraction of TKE surface value which penetrates in the ocean
+   LOGICAL  ::   ln_lc     = .FALSE.       ! Langmuir cells (LC) as a source term of TKE or not
+   REAL(wp) ::   rn_lc     = 0.15_wp       ! coef to compute vertical velocity of Langmuir cells
+
+   REAL(wp) ::   ri_cri                    ! critic Richardson number (deduced from rn_ediff and rn_ediss values)
+   REAL(wp) ::   rmxl_min                  ! minimum mixing length value (deduced from rn_ediff and rn_emin values)  [m]
+   REAL(wp) ::   rhftau_add = 1.e-3_wp     ! add offset   applied to HF part of taum  (nn_etau=3)
+   REAL(wp) ::   rhftau_scl = 1.0_wp       ! scale factor applied to HF part of taum  (nn_etau=3)
+
+   REAL(wp), DIMENSION(jpi,jpj,jpk), PUBLIC ::   en   ! now turbulent kinetic energy   [m2/s2]
+   
+   REAL(wp), DIMENSION(jpi,jpj)     ::   htau    ! depth of tke penetration (nn_htau)
+   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   dissl   ! now mixing lenght of dissipation
 
    !! * Substitutions
@@ -94,9 +96,8 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
-   !! $Id: zdftke2.F90 1201 2008-09-24 13:24:21Z rblod $
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -149,9 +150,7 @@
       !!----------------------------------------------------------------------
       !
-      IF( kt == nit000 )   CALL tke_init     ! initialisation 
-                           !
-                           CALL tke_tke      ! now tke (en)
-                           !
-                           CALL tke_avn      ! now avt, avm, avmu, avmv
+      CALL tke_tke      ! now tke (en)
+      !
+      CALL tke_avn      ! now avt, avm, avmu, avmv
       !
    END SUBROUTINE zdf_tke
@@ -165,5 +164,5 @@
       !!
       !! ** Method  : - TKE surface boundary condition
-      !!              - source term due to Langmuir cells (ln_lc=T)
+      !!              - source term due to Langmuir cells (Axell JGR 2002) (ln_lc=T)
       !!              - source term due to shear (saved in avmu, avmv arrays)
       !!              - Now TKE : resolution of the TKE equation by inverting
@@ -180,6 +179,6 @@
       !!
       INTEGER  ::   ji, jj, jk                      ! dummy loop arguments
-!!$      INTEGER  ::   ikbu, ikbv, ikbum1, ikbvm1      ! temporary scalar
-!!$      INTEGER  ::   ikbt, ikbumm1, ikbvmm1          ! temporary scalar
+!!bfr      INTEGER  ::   ikbu, ikbv, ikbum1, ikbvm1      ! temporary scalar
+!!bfr      INTEGER  ::   ikbt, ikbumm1, ikbvmm1          ! temporary scalar
       REAL(wp) ::   zrhoa  = 1.22                   ! Air density kg/m3
       REAL(wp) ::   zcdrag = 1.5e-3                 ! drag coefficient
@@ -190,5 +189,5 @@
       REAL(wp) ::   zus   , zwlc  , zind            !    -         -
       REAL(wp) ::   zzd_up, zzd_lw                  !    -         -
-!!$      REAL(wp) ::   zebot                           !    -         -
+!!bfr      REAL(wp) ::   zebot                           !    -         -
       INTEGER , DIMENSION(jpi,jpj)     ::   imlc    ! 2D workspace
       REAL(wp), DIMENSION(jpi,jpj)     ::   zhlc    !  -      -
@@ -197,7 +196,7 @@
       !
       zbbrau = rn_ebb / rau0       ! Local constant initialisation
-      zfact1 = -.5 * rdt 
-      zfact2 = 1.5 * rdt * rn_ediss
-      zfact3 = 0.5       * rn_ediss
+      zfact1 = -.5_wp * rdt 
+      zfact2 = 1.5_wp * rdt * rn_ediss
+      zfact3 = 0.5_wp       * rn_ediss
       !
       !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
@@ -209,5 +208,6 @@
          END DO
       END DO
-      !
+      
+!!bfr   - start commented area
       !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
       !                     !  Bottom boundary condition on tke
@@ -219,5 +219,4 @@
       ! computational cost is justified
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-      !
       !                     en(bot)   = (rn_ebb0/rau0)*0.5*sqrt(u_botfr^2+v_botfr^2) (min value rn_emin)
 !CDIR NOVERRCHK
@@ -225,35 +224,26 @@
 !CDIR NOVERRCHK
 !!       DO ji = fs_2, fs_jpim1   ! vector opt.
-!!          ikbu = MIN( mbathy(ji+1,jj), mbathy(ji,jj) )
-!!          ikbv = MIN( mbathy(ji,jj+1), mbathy(ji,jj) )
-!!          ikbum1 = MAX( ikbu-1, 1 )
-!!          ikbvm1 = MAX( ikbv-1, 1 )
-!!          ikbu = MIN( mbathy(ji,jj), mbathy(ji-1,jj) )
-!!          ikbv = MIN( mbathy(ji,jj), mbathy(ji,jj-1) )
-!!          ikbumm1 = MAX( ikbu-1, 1 )
-!!          ikbvmm1 = MAX( ikbv-1, 1 )
-!!          ikbt = MAX( mbathy(ji,jj), 1 )
-!!          ztx2 = bfrua(ji-1,jj) * ub(ji-1,jj,ikbumm1) + &
-!!                 bfrua(ji  ,jj) * ub(ji  ,jj  ,ikbum1 )
-!!          zty2 = bfrva(ji,jj  ) * vb(ji  ,jj  ,ikbvm1) + &
-!!                 bfrva(ji,jj-1) * vb(ji  ,jj-1,ikbvmm1 )
+!!          ztx2 = bfrua(ji-1,jj) * ub(ji-1,jj,mbku(ji-1,jj)) + &
+!!                 bfrua(ji  ,jj) * ub(ji  ,jj,mbku(ji  ,jj) )
+!!          zty2 = bfrva(ji,jj  ) * vb(ji,jj  ,mbkv(ji,jj  )) + &
+!!                 bfrva(ji,jj-1) * vb(ji,jj-1,mbkv(ji,jj-1) )
 !!          zebot = 0.001875_wp * SQRT( ztx2 * ztx2 + zty2 * zty2 )   !  where 0.001875 = (rn_ebb0/rau0) * 0.5 = 3.75*0.5/1000.
-!!          en (ji,jj,ikbt) = MAX( zebot, rn_emin ) * tmask(ji,jj,1)
+!!          en (ji,jj,mbkt(ji,jj)+1) = MAX( zebot, rn_emin ) * tmask(ji,jj,1)
 !!       END DO
 !!    END DO
-      !
-      !
-      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-      IF( ln_lc ) THEN      !  Langmuir circulation source term added to tke
+!!bfr   - end commented area
+      !
+      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      IF( ln_lc ) THEN      !  Langmuir circulation source term added to tke       (Axell JGR 2002)
          !                  !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
          !
          !                        !* total energy produce by LC : cumulative sum over jk
-         zpelc(:,:,1) =  MAX( rn2b(:,:,1), 0. ) * fsdepw(:,:,1) * fse3w(:,:,1)
+         zpelc(:,:,1) =  MAX( rn2b(:,:,1), 0._wp ) * fsdepw(:,:,1) * fse3w(:,:,1)
          DO jk = 2, jpk
-            zpelc(:,:,jk)  = zpelc(:,:,jk-1) + MAX( rn2b(:,:,jk), 0. ) * fsdepw(:,:,jk) * fse3w(:,:,jk)
+            zpelc(:,:,jk)  = zpelc(:,:,jk-1) + MAX( rn2b(:,:,jk), 0._wp ) * fsdepw(:,:,jk) * fse3w(:,:,jk)
          END DO
          !                        !* finite Langmuir Circulation depth
          zcof = 0.5 * 0.016 * 0.016 / ( zrhoa * zcdrag )
-         imlc(:,:) = mbathy(:,:)         ! Initialization to the number of w ocean point mbathy
+         imlc(:,:) = mbkt(:,:) + 1       ! Initialization to the number of w ocean point (=2 over land)
          DO jk = jpkm1, 2, -1
             DO jj = 1, jpj               ! Last w-level at which zpelc>=0.5*us*us 
@@ -275,7 +265,4 @@
             END DO
          END DO
-# if defined key_c1d
-         hlc(:,:) = zhlc(:,:) * tmask(:,:,1)      ! c1d configuration: save finite Langmuir Circulation depth
-# endif
          zcof = 0.016 / SQRT( zrhoa * zcdrag )
 !CDIR NOVERRCHK
@@ -328,10 +315,10 @@
                   &          / ( 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.e0 , umask(ji-1,jj,jk) + umask(ji,jj,jk) )   &
-                  &    + ( avmv(ji,jj-1,jk) + avmv(ji,jj,jk) ) / MAX( 1.e0 , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) )    
+               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) )    
                   !
                zd_up(ji,jj,jk) = zzd_up            ! Matrix (zdiag, zd_up, zd_lw)
                zd_lw(ji,jj,jk) = zzd_lw
-               zdiag(ji,jj,jk) = 1.e0 - zzd_lw - zzd_up + zfact2 * dissl(ji,jj,jk) * tmask(ji,jj,jk)
+               zdiag(ji,jj,jk) = 1._wp - zzd_lw - zzd_up + zfact2 * dissl(ji,jj,jk) * tmask(ji,jj,jk)
                !
                !                                   ! right hand side in en
@@ -384,22 +371,22 @@
       !                            !  TKE due to surface and internal wave breaking
       !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-      IF( nn_etau == 1 ) THEN           !* penetration throughout the water column
+      IF( nn_etau == 1 ) THEN           !* penetration below the mixed layer (rn_efr fraction)
          DO jk = 2, jpkm1
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) )   &
-                     &                                               * ( 1.e0 - fr_i(ji,jj) )  * tmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-      ELSEIF( nn_etau == 2 ) THEN       !* act only at the base of the mixed layer (jk=nmln)
+                     &                                               * ( 1._wp - fr_i(ji,jj) )  * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+      ELSEIF( nn_etau == 2 ) THEN       !* act only at the base of the mixed layer (jk=nmln)  (rn_efr fraction)
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1   ! vector opt.
                jk = nmln(ji,jj)
                en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) )   &
-                  &                                               * ( 1.e0 - fr_i(ji,jj) )  * tmask(ji,jj,jk)
-            END DO
-         END DO
-      ELSEIF( nn_etau == 3 ) THEN       !* penetration throughout the water column
+                  &                                               * ( 1._wp - fr_i(ji,jj) )  * tmask(ji,jj,jk)
+            END DO
+         END DO
+      ELSEIF( nn_etau == 3 ) THEN       !* penetration belox the mixed layer (HF variability)
 !CDIR NOVERRCHK
          DO jk = 2, jpkm1
@@ -410,9 +397,9 @@
                   ztx2 = utau(ji-1,jj  ) + utau(ji,jj)
                   zty2 = vtau(ji  ,jj-1) + vtau(ji,jj)
-                  ztau = 0.5 * SQRT( ztx2 * ztx2 + zty2 * zty2 )      ! module of the mean stress 
-                  zdif = taum(ji,jj) - ztau                           ! mean of the module - module of the mean 
-                  zdif = rn_sclhft * MAX( 0.e0, zdif + rn_addhft )    ! apply some modifications...
+                  ztau = 0.5_wp * SQRT( ztx2 * ztx2 + zty2 * zty2 )    ! module of the mean stress 
+                  zdif = taum(ji,jj) - ztau                            ! mean of modulus - modulus of the mean 
+                  zdif = rhftau_scl * MAX( 0._wp, zdif + rhftau_add )  ! apply some modifications...
                   en(ji,jj,jk) = en(ji,jj,jk) + zbbrau * zdif * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) )   &
-                     &                                        * ( 1.e0 - fr_i(ji,jj) ) * tmask(ji,jj,jk)
+                     &                                        * ( 1._wp - fr_i(ji,jj) ) * tmask(ji,jj,jk)
                END DO
             END DO
@@ -439,5 +426,5 @@
       !!                      mxl = sqrt(2*en) / N  
       !!      where N is the brunt-vaisala frequency, with a minimum value set
-      !!      to rn_lmin (rn_lmin0) in the interior (surface) ocean.
+      !!      to rmxl_min (rn_mxl0) in the interior (surface) ocean.
       !!        The mixing and dissipative length scale are bound as follow : 
       !!         nn_mxl=0 : mxl bounded by the distance to surface and bottom.
@@ -479,21 +466,14 @@
       !                     !* Buoyancy length scale: l=sqrt(2*e/n**2)
       !
-      IF( ln_mxl0 ) THEN         ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rau0*g)
-!!gm  this should be useless
-         zmxlm(:,:,1) = 0.e0
-!!gm end
-         zraug = vkarmn * 2.e5 / ( rau0 * grav )
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zmxlm(ji,jj,1) = MAX(  rn_lmin0,  zraug * taum(ji,jj)  )
-            END DO
-         END DO
-      ELSE                       ! surface set to the minimum value
-         zmxlm(:,:,1) = rn_lmin0
+      IF( ln_mxl0 ) THEN            ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rau0*g)
+         zraug = vkarmn * 2.e5_wp / ( rau0 * grav )
+         zmxlm(:,:,1) = MAX(  rn_mxl0,  zraug * taum(:,:)  )
+      ELSE                          ! surface set to the minimum value
+         zmxlm(:,:,1) = rn_mxl0
       ENDIF
-      zmxlm(:,:,jpk) = rn_lmin   ! bottom set to the interior minium value
-      !
-!CDIR NOVERRCHK
-      DO jk = 2, jpkm1           ! interior value : l=sqrt(2*e/n**2)
+      zmxlm(:,:,jpk)  = rmxl_min     ! last level set to the interior minium value
+      !
+!CDIR NOVERRCHK
+      DO jk = 2, jpkm1              ! interior value : l=sqrt(2*e/n^2)
 !CDIR NOVERRCHK
          DO jj = 2, jpjm1
@@ -501,15 +481,14 @@
             DO ji = fs_2, fs_jpim1   ! vector opt.
                zrn2 = MAX( rn2(ji,jj,jk), rsmall )
-               zmxlm(ji,jj,jk) = MAX(  rn_lmin,  SQRT( 2. * en(ji,jj,jk) / zrn2 )  )
-            END DO
-         END DO
-      END DO
-      !
-!!gm  CAUTION: to be added here the bottom boundary condition on zmxlm
+               zmxlm(ji,jj,jk) = MAX(  rmxl_min,  SQRT( 2._wp * en(ji,jj,jk) / zrn2 )  )
+            END DO
+         END DO
+      END DO
+      !
       !
       !                     !* Physical limits for the mixing length
       !
-      zmxld(:,:, 1 ) = zmxlm(:,:,1)   ! surface set to the minimum value
-      zmxld(:,:,jpk) = rn_lmin        ! bottom  set to the minimum value
+      zmxld(:,:, 1 ) = zmxlm(:,:,1)   ! surface set to the zmxlm   value
+      zmxld(:,:,jpk) = rmxl_min       ! last level  set to the minimum value
       !
       SELECT CASE ( nn_mxl )
@@ -520,5 +499,5 @@
                DO ji = fs_2, fs_jpim1   ! vector opt.
                   zemxl = MIN( fsdepw(ji,jj,jk), zmxlm(ji,jj,jk),   &
-                  &            fsdepw(ji,jj,mbathy(ji,jj)) - fsdepw(ji,jj,jk) )
+                  &            fsdepw(ji,jj,mbkt(ji,jj)+1) - fsdepw(ji,jj,jk) )
                   zmxlm(ji,jj,jk) = zemxl
                   zmxld(ji,jj,jk) = zemxl
@@ -625,5 +604,5 @@
             DO jj = 2, jpjm1
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zcoef = 0.5 / ( fse3w(ji,jj,jk) * fse3w(ji,jj,jk) )
+                  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) )   &
@@ -632,8 +611,8 @@
                     &  + 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. ) * avm(ji,jj,jk) / (zcoef * (zdku + zdkv + rn_bshear ) )
-                  zpdlr = MAX(  0.1,  0.2 / MAX( 0.2 , zri )  )
+                  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,  ri_crit / MAX( ri_crit , zri )  )
+!!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)
 # if defined key_c1d
@@ -656,7 +635,7 @@
 
 
-   SUBROUTINE tke_init
+   SUBROUTINE zdf_tke_init
       !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tke_init  ***
+      !!                  ***  ROUTINE zdf_tke_init  ***
       !!                     
       !! ** Purpose :   Initialization of the vertical eddy diffivity and 
@@ -672,9 +651,8 @@
       INTEGER ::   ji, jj, jk   ! dummy loop indices
       !!
-      NAMELIST/namzdf_tke/ rn_ediff, rn_ediss , rn_ebb   , rn_emin  ,   &
-         &                 rn_emin0, rn_bshear, nn_mxl   , ln_mxl0  ,   &
-         &                 rn_lmin , rn_lmin0 , nn_pdl   , nn_etau  ,   &
-         &                 nn_htau , rn_efr   , rn_addhft, rn_sclhft,   &
-         &                 ln_lc   , rn_lc 
+      NAMELIST/namzdf_tke/ rn_ediff, rn_ediss , rn_ebb , rn_emin  ,   &
+         &                 rn_emin0, rn_bshear, nn_mxl , ln_mxl0  ,   &
+         &                 rn_mxl0 , nn_pdl   , ln_lc  , rn_lc    ,   &
+         &                 nn_etau , nn_htau  , rn_efr   
       !!----------------------------------------------------------------------
 
@@ -682,10 +660,11 @@
       READ   ( numnam, namzdf_tke )
       
-      ri_cri = 2. / ( 2. + rn_ediss / rn_ediff )      ! resulting critical Richardson number
+      ri_cri   = 2._wp    / ( 2._wp + rn_ediss / rn_ediff )   ! resulting critical Richardson number
+      rmxl_min = 1.e-6_wp / ( rn_ediff * SQRT( rn_emin ) )    ! resulting minimum length to recover molecular viscosity
 
       IF(lwp) THEN                    !* Control print
          WRITE(numout,*)
-         WRITE(numout,*) 'zdf_tke : tke turbulent closure scheme - initialisation'
-         WRITE(numout,*) '~~~~~~~~'
+         WRITE(numout,*) 'zdf_tke_init : tke turbulent closure scheme - initialisation'
+         WRITE(numout,*) '~~~~~~~~~~~~'
          WRITE(numout,*) '   Namelist namzdf_tke : set tke mixing parameters'
          WRITE(numout,*) '      coef. to compute avt                        rn_ediff  = ', rn_ediff
@@ -698,13 +677,10 @@
          WRITE(numout,*) '      prandl number flag                          nn_pdl    = ', nn_pdl
          WRITE(numout,*) '      surface mixing length = F(stress) or not    ln_mxl0   = ', ln_mxl0
-         WRITE(numout,*) '      surface  mixing length minimum value        rn_lmin0  = ', rn_lmin0
-         WRITE(numout,*) '      interior mixing length minimum value        rn_lmin0  = ', rn_lmin0
+         WRITE(numout,*) '      surface  mixing length minimum value        rn_mxl0   = ', rn_mxl0
+         WRITE(numout,*) '      flag to take into acc.  Langmuir circ.      ln_lc     = ', ln_lc
+         WRITE(numout,*) '      coef to compute verticla velocity of LC     rn_lc     = ', rn_lc
          WRITE(numout,*) '      test param. to add tke induced by wind      nn_etau   = ', nn_etau
          WRITE(numout,*) '      flag for computation of exp. tke profile    nn_htau   = ', nn_htau
          WRITE(numout,*) '      fraction of en which pene. the thermocline  rn_efr    = ', rn_efr
-         WRITE(numout,*) '      add offset   applied to HF tau              rn_addhft = ', rn_addhft
-         WRITE(numout,*) '      scale factor applied to HF tau              rn_sclhft = ', rn_sclhft
-         WRITE(numout,*) '      flag to take into acc.  Langmuir circ.      ln_lc     = ', ln_lc
-         WRITE(numout,*) '      coef to compute verticla velocity of LC     rn_lc     = ', rn_lc
          WRITE(numout,*)
          WRITE(numout,*) '      critical Richardson nb with your parameters  ri_cri = ', ri_cri
@@ -712,11 +688,16 @@
 
       !                               !* Check of some namelist values
-      IF( nn_mxl  < 0     .OR.  nn_mxl  > 3   )   CALL ctl_stop( 'bad flag: nn_mxl is  0, 1 or 2 ' )
-      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 > 2   )   CALL ctl_stop( 'bad flag: nn_htau is 0, 1 or 2 ' )
-      IF( rn_lc   < 0.15  .OR.  rn_lc   > 0.2 )   CALL ctl_stop( 'bad value: rn_lc must be between 0.15 and 0.2 ' )
-      IF( rn_sclhft == 0. .AND. nn_etau == 3  )   CALL ctl_stop( 'force null HF tau to penetrate the thermocline...' )
-      IF( .NOT. lhftau    .AND. nn_etau == 3  )   CALL ctl_stop( 'bad flag: nn_etau == 3 must be used with HF tau' )
-
+      IF( nn_mxl  < 0  .OR.  nn_mxl  > 3 )   CALL ctl_stop( 'bad flag: nn_mxl is  0, 1 or 2 ' )
+      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 ! key_coupled
+      IF( nn_etau == 3 )   CALL ctl_stop( 'nn_etau == 3 : HF taum only known in coupled mode' )
+#endif
+
+      IF( ln_mxl0 ) THEN
+         IF(lwp) WRITE(numout,*) '   use a surface mixing length = F(stress) :   set rn_mxl0 = rmxl_min'
+         rn_mxl0 = rmxl_min
+      ENDIF
+      
       IF( nn_etau == 2  )   CALL zdf_mxl( nit000 )      ! Initialization of nmln 
 
@@ -724,14 +705,8 @@
       IF( nn_etau /= 0 ) THEN      
          SELECT CASE( nn_htau )             ! Choice of the depth of penetration
-         CASE( 0 )                                    ! constant depth penetration (here 10 meters)
-            htau(:,:) = 10.e0
-         CASE( 1 )                                    ! F(latitude) : 0.5m to 30m at high lat.
-            DO jj = 1, jpj
-               DO ji = 1, jpi  
-                  htau(ji,jj) = MAX( 0.5, 3./4. * MIN( 40., 60.*ABS( SIN( rpi/180. * gphit(ji,jj) ) ) )   )
-               END DO
-            END DO
-         CASE( 2 )                                    ! constant depth penetration (here 30 meters)
-            htau(:,:) = 30.e0
+         CASE( 0 )                                 ! constant depth penetration (here 10 meters)
+            htau(:,:) = 10._wp
+         CASE( 1 )                                 ! F(latitude) : 0.5m to 30m poleward of 40 degrees
+            htau(:,:) = MAX(  0.5_wp, MIN( 30._wp, 45._wp* ABS( SIN( rpi/180._wp * gphit(:,:) ) ) )   )            
          END SELECT
       ENDIF
@@ -744,9 +719,9 @@
          avmv(:,:,jk) = avmb(jk) * vmask(:,:,jk)
       END DO
-      dissl(:,:,:) = 1.e-12
+      dissl(:,:,:) = 1.e-12_wp
       !                               !* read or initialize all required files 
       CALL tke_rst( nit000, 'READ' )
       !
-   END SUBROUTINE tke_init
+   END SUBROUTINE zdf_tke_init
 
 
@@ -825,5 +800,7 @@
    LOGICAL, PUBLIC, PARAMETER ::   lk_zdftke = .FALSE.   !: TKE flag
 CONTAINS
-   SUBROUTINE zdf_tke( kt )          ! Empty routine
+   SUBROUTINE zdf_tke_init           ! Dummy routine
+   END SUBROUTINE zdf_tke_init
+   SUBROUTINE zdf_tke( kt )          ! Dummy routine
       WRITE(*,*) 'zdf_tke: You should not have seen this print! error?', kt
    END SUBROUTINE zdf_tke
Index: trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke_old.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke_old.F90	(revision 2527)
+++ 	(revision )
@@ -1,909 +1,0 @@
-MODULE zdftke_old
-   !!======================================================================
-   !!                       ***  MODULE  zdftke_old  ***
-   !! Ocean physics:  vertical mixing coefficient computed from the tke 
-   !!                 turbulent closure parameterization
-   !!=====================================================================
-   !! History :   OPA  !  1991-03  (b. blanke)  Original code
-   !!             7.0  !  1991-11  (G. Madec)   bug fix
-   !!             7.1  !  1992-10  (G. Madec)   new mixing length and eav
-   !!             7.2  !  1993-03  (M. Guyon)   symetrical conditions
-   !!             7.3  !  1994-08  (G. Madec, M. Imbard)  nn_pdl flag
-   !!             7.5  !  1996-01  (G. Madec)   s-coordinates
-   !!             8.0  !  1997-07  (G. Madec)   lbc
-   !!             8.1  !  1999-01  (E. Stretta) new option for the mixing length
-   !!  NEMO       1.0  !  2002-06  (G. Madec) add zdf_tke_init routine
-   !!              -   !  2002-08  (G. Madec)  rn_cri and Free form, F90
-   !!              -   !  2004-10  (C. Ethe )  1D configuration
-   !!             2.0  !  2006-07  (S. Masson)  distributed restart using iom
-   !!             3.0  !  2008-05  (C. Ethe,  G.Madec) : update TKE physics:
-   !!                              - tke penetration (wind steering)
-   !!                              - suface condition for tke & mixing length
-   !!                              - Langmuir cells
-   !!              -   !  2008-05  (J.-M. Molines, G. Madec)  2D form of avtb
-   !!              -   !  2008-06  (G. Madec)  style + DOCTOR name for namelist parameters
-   !!----------------------------------------------------------------------
-#if defined key_zdftke_old   ||   defined key_esopa
-   !!----------------------------------------------------------------------
-   !!   'key_zdftke_old'                               TKE vertical physics
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !!   zdf_tke_old  : update momentum and tracer Kz from a tke scheme
-   !!   zdf_tke_init : initialization, namelist read, and parameters control
-   !!   tke_rst      : read/write tke restart in ocean restart file
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and active tracers 
-   USE dom_oce         ! ocean space and time domain
-   USE zdf_oce         ! ocean vertical physics
-   USE sbc_oce         ! surface boundary condition: ocean
-   USE phycst          ! physical constants
-   USE zdfmxl          ! mixed layer
-   USE restart         ! only for lrst_oce
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE prtctl          ! Print control
-   USE in_out_manager  ! I/O manager
-   USE iom             ! I/O manager library
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   zdf_tke_old   ! routine called in step module
-
-   LOGICAL , PUBLIC, PARAMETER              ::   lk_zdftke_old = .TRUE.  !: TKE vertical mixing flag
-   REAL(wp), PUBLIC                         ::   eboost              !: multiplicative coeff of the shear product.
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   en                  !: now turbulent kinetic energy
-# if defined key_vectopt_memory
-   !                                                                !!! key_vectopt_memory
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   etmean              !: coefficient used for horizontal smoothing
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   eumean, evmean      !: at t-, u- and v-points
-# endif
-#if defined key_c1d
-   !                                                                !!! 1D cfg only
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   e_dis, e_mix        !: dissipation and mixing turbulent lengh scales
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   e_pdl, e_ric        !: prandl and local Richardson numbers
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   hlc                 !: save finite Langmuir Circulation depth
-#endif
-
-   !                                       !!! ** Namelist  namzdf_tke  **
-   LOGICAL  ::   ln_mxl0  = .FALSE.         ! mixing length scale surface value as function of wind stress or not
-   LOGICAL  ::   ln_lc    = .FALSE.         ! Langmuir cells (LC) as a source term of TKE or not
-   INTEGER  ::   nn_mxl   =  2              ! type of mixing length (=0/1/2/3)
-   INTEGER  ::   nn_pdl   =  1              ! Prandtl number or not (ratio avt/avm) (=0/1)
-   REAL(wp) ::   rn_ediff = 0.1_wp          ! coefficient for avt: avt=rn_ediff*mxl*sqrt(e)
-   REAL(wp) ::   rn_ediss = 0.7_wp          ! coefficient of the Kolmogoroff dissipation 
-   REAL(wp) ::   rn_ebb   = 3.75_wp         ! coefficient of the surface input of tke
-   REAL(wp) ::   rn_emin  = 0.7071e-6_wp    ! minimum value of tke (m2/s2)
-   REAL(wp) ::   rn_emin0 = 1.e-4_wp        ! surface minimum value of tke (m2/s2)
-   REAL(wp) ::   rn_bshear= 1.e-20_wp       ! background shear (>0)    (Not used in old TKE)
-   INTEGER  ::   nn_etau  = 0               ! type of depth penetration of surface tke (=0/1/2)
-   INTEGER  ::   nn_htau  = 0               ! type of tke profile of penetration (=0/1)
-   REAL(wp) ::   rn_lmin0 = 0.4_wp          ! surface  min value of mixing length
-   REAL(wp) ::   rn_lmin  = 0.1_wp          ! interior min value of mixing length
-   REAL(wp) ::   rn_efr   = 1.0_wp          ! fraction of TKE surface value which penetrates in the ocean
-   REAL(wp) ::   rn_addhft= 0.0_wp          ! add offset   applied to HF tau    (Not used in old TKE)
-   REAL(wp) ::   rn_sclhft= 1.0_wp          ! scale factor applied to HF tau    (Not used in old TKE)
-   REAL(wp) ::   rn_lc    = 0.15_wp         ! coef to compute vertical velocity of Langmuir cells
-
-  !                                       !! ** old namelist value: now hard coded **
-   INTEGER  ::   nn_ave   =  1              ! horizontal average or not on avt, avmu, avmv (=0/1)
-   REAL(wp) ::   rn_efave = 1._wp           ! coefficient for ave : ave=rn_efave*avm
-   REAL(wp) ::   rn_cri   = 2._wp / 9._wp   ! critic Richardson number
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
-   !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE zdf_tke_old( kt )
-      !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE zdf_tke_old  ***
-      !!
-      !! ** Purpose :   Compute the vertical eddy viscosity and diffusivity
-      !!      coefficients using a 1.5 turbulent closure scheme.
-      !!
-      !! ** Method  :   The time evolution of the turbulent kinetic energy 
-      !!      (tke) is computed from a prognostic equation :
-      !!         d(en)/dt = eboost eav (d(u)/dz)**2         ! shear production
-      !!                  + d( rn_efave eav d(en)/dz )/dz   ! diffusion of tke
-      !!                  + grav/rau0 pdl eav d(rau)/dz     ! stratif. destruc.
-      !!                  - rn_ediss / emxl en**(2/3)       ! dissipation
-      !!      with the boundary conditions:
-      !!         surface: en = max( rn_emin0, rn_ebb sqrt(utau^2 + vtau^2) )
-      !!         bottom : en = rn_emin
-      !!      -1- The dissipation and mixing turbulent lengh scales are computed
-      !!         from the usual diagnostic buoyancy length scale:  
-      !!         mxl= sqrt(2*en)/N  where N is the brunt-vaisala frequency
-      !!         with mxl = rn_lmin at the bottom minimum value of 0.4
-      !!      Four cases : 
-      !!         nn_mxl=0 : mxl bounded by the distance to surface and bottom.
-      !!                  zmxld = zmxlm = mxl
-      !!         nn_mxl=1 : mxl bounded by the vertical scale factor.
-      !!                  zmxld = zmxlm = mxl
-      !!         nn_mxl=2 : mxl bounded such that the vertical derivative of mxl 
-      !!                  is less than 1 (|d/dz(xml)|<1). 
-      !!                  zmxld = zmxlm = mxl
-      !!         nn_mxl=3 : lup = mxl bounded using |d/dz(xml)|<1 from the surface 
-      !!                        to the bottom
-      !!                  ldown = mxl bounded using |d/dz(xml)|<1 from the bottom 
-      !!                        to the surface
-      !!                  zmxld = sqrt (lup*ldown) ; zmxlm = min(lup,ldown)
-      !!      -2- Compute the now Turbulent kinetic energy. The time differencing
-      !!      is implicit for vertical diffusion term, linearized for kolmo-
-      !!      goroff dissipation term, and explicit forward for both buoyancy
-      !!      and dynamic production terms. Thus a tridiagonal linear system is
-      !!      solved.
-      !!         Note that - the shear production is multiplied by eboost in order
-      !!      to set the critic richardson number to rn_cri (namelist parameter)
-      !!                   - the destruction by stratification term is multiplied
-      !!      by the Prandtl number (defined by an empirical funtion of the local 
-      !!      Richardson number) if nn_pdl=1 (namelist parameter)
-      !!      coefficient (zesh2):
-      !!      -3- Compute the now vertical eddy vicosity and diffusivity
-      !!      coefficients from en (before the time stepping) and zmxlm:
-      !!              avm = max( avtb, rn_ediff*zmxlm*en^1/2 )
-      !!              avt = max( avmb, pdl*avm )  (pdl=1 if nn_pdl=0)
-      !!              eav = max( avmb, avm )
-      !!      avt and avm are horizontally averaged to avoid numerical insta-
-      !!      bilities.
-      !!        N.B. The computation is done from jk=2 to jpkm1 except for
-      !!      en. Surface value of avt avmu avmv are set once a time to
-      !!      their background value in routine zdf_tke_init.
-      !!
-      !! ** Action  :   compute en (now turbulent kinetic energy)
-      !!                update avt, avmu, avmv (before vertical eddy coef.)
-      !!
-      !! References : Gaspar et al., JGR, 1990,
-      !!              Blanke and Delecluse, JPO, 1991
-      !!              Mellor and Blumberg, JPO 2004
-      !!              Axell, JGR, 2002
-      !!----------------------------------------------------------------------
-      USE oce,     zwd    =>   ua   ! use ua as workspace
-      USE oce,     zmxlm  =>   va   ! use va as workspace
-      USE oce,     zmxld  =>   ta   ! use ta as workspace
-      USE oce,     ztkelc =>   sa   ! use sa as workspace
-      !
-      INTEGER, INTENT(in) ::   kt   ! ocean time step
-      !
-      INTEGER  ::   ji, jj, jk                      ! dummy loop arguments
-      REAL(wp) ::   zbbrau, zrn2, zesurf            ! temporary scalars
-      REAL(wp) ::   zfact1, ztx2, zdku              !    -         -
-      REAL(wp) ::   zfact2, zty2, zdkv              !    -         -
-      REAL(wp) ::   zfact3, zcoef, zcof, zav        !    -         -
-      REAL(wp) ::   zsh2, zpdl, zri, zsqen, zesh2   !    -         -
-      REAL(wp) ::   zemxl, zemlm, zemlp             !    -         -
-      REAL(wp) ::   zraug, zus, zwlc, zind          !    -         -
-      INTEGER , DIMENSION(jpi,jpj)     ::   imlc    ! 2D workspace
-      REAL(wp), DIMENSION(jpi,jpj)     ::   zhtau   !  -      -
-      REAL(wp), DIMENSION(jpi,jpj)     ::   zhlc    !  -      -
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zpelc   ! 3D workspace
-      !!--------------------------------------------------------------------
-
-      IF( kt == nit000  )   CALL zdf_tke_init      ! Initialization (first time-step only)
-
-      !                                            ! Local constant initialization
-      zbbrau =  .5 * rn_ebb / rau0
-      zfact1 = -.5 * rdt * rn_efave
-      zfact2 = 1.5 * rdt * rn_ediss
-      zfact3 = 0.5 * rdt * rn_ediss
-
-      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-      ! I.  Mixing length
-      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-
-      ! Buoyancy length scale: l=sqrt(2*e/n**2)
-      ! ---------------------
-      IF( ln_mxl0 ) THEN         ! surface mixing length = F(stress) : l=vkarmn*2.e5*sqrt(utau^2 + vtau^2)/(rau0*g)
-!!gm  this should be useless
-         zmxlm(:,:,1) = 0.e0
-!!gm end
-         zraug = 0.5 * vkarmn * 2.e5 / ( rau0 * grav )
-         DO jj = 2, jpjm1
-!CDIR NOVERRCHK
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ztx2 = utau(ji-1,jj  ) + utau(ji,jj)
-               zty2 = vtau(ji  ,jj-1) + vtau(ji,jj)
-               zmxlm(ji,jj,1) = MAX(  rn_lmin0,  zraug * SQRT( ztx2 * ztx2 + zty2 * zty2 )  )
-            END DO
-         END DO
-      ELSE                       ! surface set to the minimum value
-         zmxlm(:,:,1) = rn_lmin0
-      ENDIF
-      zmxlm(:,:,jpk) = rn_lmin   ! bottom set to the interior minium value
-      !
-!CDIR NOVERRCHK
-      DO jk = 2, jpkm1           ! interior value : l=sqrt(2*e/n**2)
-!CDIR NOVERRCHK
-         DO jj = 2, jpjm1
-!CDIR NOVERRCHK
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zrn2 = MAX( rn2b(ji,jj,jk), rsmall )
-               zmxlm(ji,jj,jk) = MAX(  rn_lmin,  SQRT( 2. * en(ji,jj,jk) / zrn2 )  )
-            END DO
-         END DO
-      END DO
-
-      ! Physical limits for the mixing length
-      ! -------------------------------------
-      zmxld(:,:, 1 ) = zmxlm(:,:,1)   ! surface set to the minimum value
-      zmxld(:,:,jpk) = rn_lmin        ! bottom  set to the minimum value
-
-      SELECT CASE ( nn_mxl )
-      !
-      CASE ( 0 )           ! bounded by the distance to surface and bottom
-         DO jk = 2, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zemxl = MIN( fsdepw(ji,jj,jk), zmxlm(ji,jj,jk),   &
-                  &            fsdepw(ji,jj,mbathy(ji,jj)) - fsdepw(ji,jj,jk) )
-                  zmxlm(ji,jj,jk) = zemxl
-                  zmxld(ji,jj,jk) = zemxl
-               END DO
-            END DO
-         END DO
-         !
-      CASE ( 1 )           ! bounded by the vertical scale factor
-         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
-                  zmxld(ji,jj,jk) = zemxl
-               END DO
-            END DO
-         END DO
-         !
-      CASE ( 2 )           ! |dk[xml]| bounded by e3t :
-         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
-            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
-                  zmxld(ji,jj,jk) = zemxl
-               END DO
-            END DO
-         END DO
-         !
-      CASE ( 3 )           ! lup and ldown, |dk[xml]| bounded by e3t :
-         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
-            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
-            END DO
-         END DO
-!CDIR NOVERRCHK
-         DO jk = 2, jpkm1
-!CDIR NOVERRCHK
-            DO jj = 2, jpjm1
-!CDIR NOVERRCHK
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zemlm = MIN ( zmxld(ji,jj,jk),  zmxlm(ji,jj,jk) )
-                  zemlp = SQRT( zmxld(ji,jj,jk) * zmxlm(ji,jj,jk) )
-                  zmxlm(ji,jj,jk) = zemlm
-                  zmxld(ji,jj,jk) = zemlp
-               END DO
-            END DO
-         END DO
-         !
-      END SELECT
-
-# if defined key_c1d
-      ! c1d configuration : save mixing and dissipation turbulent length scales
-      e_dis(:,:,:) = zmxld(:,:,:)
-      e_mix(:,:,:) = zmxlm(:,:,:)
-# endif
-
-      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-      ! II  TKE Langmuir circulation source term
-      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-      IF( ln_lc ) THEN
-         !
-         ! Computation of total energy produce by LC : cumulative sum over jk
-         zpelc(:,:,1) =  MAX( rn2b(:,:,1), 0. ) * fsdepw(:,:,1) * fse3w(:,:,1)
-         DO jk = 2, jpk
-            zpelc(:,:,jk)  = zpelc(:,:,jk-1) + MAX( rn2b(:,:,jk), 0. ) * fsdepw(:,:,jk) * fse3w(:,:,jk)
-         END DO
-         !
-         ! Computation of finite Langmuir Circulation depth
-         ! Initialization to the number of w ocean point mbathy
-         imlc(:,:) = mbathy(:,:)
-         DO jk = jpkm1, 2, -1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  ! Last w-level at which zpelc>=0.5*us*us with us=0.016*wind(starting from jpk-1)
-                  zus  = 0.000128 * wndm(ji,jj) * wndm(ji,jj)
-                  IF( zpelc(ji,jj,jk) > zus )   imlc(ji,jj) = jk
-               END DO
-            END DO
-         END DO
-         !
-         ! finite LC depth
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               zhlc(ji,jj) = fsdepw(ji,jj,imlc(ji,jj))
-            END DO
-         END DO
-         !
-# if defined key_c1d
-         hlc(:,:) = zhlc(:,:) * tmask(:,:,1)      ! c1d configuration: save finite Langmuir Circulation depth
-# endif
-         !
-         ! TKE Langmuir circulation source term
-!CDIR NOVERRCHK
-         DO jk = 2, jpkm1
-!CDIR NOVERRCHK
-            DO jj = 2, jpjm1
-!CDIR NOVERRCHK
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ! Stokes drift
-                  zus  = 0.016 * wndm(ji,jj)
-                  ! computation of vertical velocity due to LC
-                  zind = 0.5 - SIGN( 0.5, fsdepw(ji,jj,jk) - zhlc(ji,jj) )
-                  zwlc = zind * rn_lc * zus * SIN( rpi * fsdepw(ji,jj,jk) / zhlc(ji,jj) )
-                  ! TKE Langmuir circulation source term
-                  ztkelc(ji,jj,jk) = ( zwlc * zwlc * zwlc ) / zhlc(ji,jj)
-               END DO
-            END DO
-         END DO
-         !
-      ENDIF
-
-      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-      ! III  Tubulent kinetic energy time stepping
-      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-
-      ! 1. Vertical eddy viscosity on tke (put in zmxlm) and first estimate of avt
-      ! ---------------------------------------------------------------------
-!CDIR NOVERRCHK
-      DO jk = 2, jpkm1
-!CDIR NOVERRCHK
-         DO jj = 2, jpjm1
-!CDIR NOVERRCHK
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zsqen = SQRT( en(ji,jj,jk) )
-               zav   = rn_ediff * zmxlm(ji,jj,jk) * zsqen
-               avt  (ji,jj,jk) = MAX( zav, avtb_2d(ji,jj) * avtb(jk) ) * tmask(ji,jj,jk)
-               zmxlm(ji,jj,jk) = MAX( zav, avmb(jk) ) * tmask(ji,jj,jk)
-               zmxld(ji,jj,jk) = zsqen / zmxld(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-
-      ! 2. Surface boundary condition on tke and its eddy viscosity (zmxlm)
-      ! -------------------------------------------------
-      ! en(1)   = rn_ebb sqrt(utau^2+vtau^2) / rau0  (min value rn_emin0)
-      ! zmxlm(1) = avmb(1) and zmxlm(jpk) = 0.
-!CDIR NOVERRCHK
-      DO jj = 2, jpjm1
-!CDIR NOVERRCHK
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            ztx2 = utau(ji-1,jj  ) + utau(ji,jj)
-            zty2 = vtau(ji  ,jj-1) + vtau(ji,jj)
-            zesurf = zbbrau * SQRT( ztx2 * ztx2 + zty2 * zty2 )
-            en (ji,jj,1) = MAX( zesurf, rn_emin0 ) * tmask(ji,jj,1)
-            zav  =  rn_ediff * zmxlm(ji,jj,1) * SQRT( en(ji,jj,1) )
-            zmxlm(ji,jj,1  ) = MAX( zav, avmb(1)                  ) * tmask(ji,jj,1)
-            avt  (ji,jj,1  ) = MAX( zav, avtb(1) * avtb_2d(ji,jj) ) * tmask(ji,jj,1)
-            zmxlm(ji,jj,jpk) = 0.e0
-         END DO
-      END DO
-
-      ! 3. Now Turbulent kinetic energy (output in en)
-      ! -------------------------------
-      ! Resolution of a tridiagonal linear system by a "methode de chasse"
-      ! computation from level 2 to jpkm1  (e(1) already computed and e(jpk)=0 ). 
-
-      SELECT CASE ( nn_pdl )
-      !
-      CASE ( 0 )           ! No Prandtl number
-         DO jk = 2, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  !                                                             ! shear prod. - stratif. destruction
-                  zcoef = 0.5 / fse3w(ji,jj,jk)
-                  zdku = zcoef * (  ub(ji-1, jj ,jk-1) + ub(ji,jj,jk-1)   &          ! shear
-                     &            - ub(ji-1, jj ,jk  ) - ub(ji,jj,jk  )  )
-                  zdkv = zcoef * (  vb( ji ,jj-1,jk-1) + vb(ji,jj,jk-1)   &
-                     &            - vb( ji ,jj-1,jk  ) - vb(ji,jj,jk  )  )
-                  zesh2 =  eboost * ( zdku*zdku + zdkv*zdkv ) - rn2b(ji,jj,jk)        ! coefficient (zesh2)
-                  !
-                  !                                                             ! Matrix
-                  zcof = zfact1 * tmask(ji,jj,jk)
-                  !                                                                  ! lower diagonal
-                  avmv(ji,jj,jk) = zcof * ( zmxlm(ji,jj,jk  ) + zmxlm(ji,jj,jk-1) )   &
-                     &                  / ( fse3t(ji,jj,jk-1) * fse3w(ji,jj,jk  ) )
-                  !                                                                  ! upper diagonal
-                  avmu(ji,jj,jk) = zcof * ( zmxlm(ji,jj,jk+1) + zmxlm(ji,jj,jk  ) )   &
-                     &                  / ( fse3t(ji,jj,jk  ) * fse3w(ji,jj,jk) )
-                  !                                                                  ! diagonal
-                  zwd(ji,jj,jk) = 1. - avmv(ji,jj,jk) - avmu(ji,jj,jk) + zfact2 * zmxld(ji,jj,jk)
-                  !
-                  !                                                             ! right hand side in en 
-                  IF( .NOT. ln_lc ) THEN                                             ! No Langmuir cells
-                     en(ji,jj,jk) = en(ji,jj,jk) + zfact3 * zmxld (ji,jj,jk) * en(ji,jj,jk)   &
-                        &                        +   rdt  * zmxlm (ji,jj,jk) * zesh2
-                  ELSE                                                               ! Langmuir cell source term
-                     en(ji,jj,jk) = en(ji,jj,jk) + zfact3 * zmxld (ji,jj,jk) * en(ji,jj,jk)   &
-                        &                        +   rdt  * zmxlm (ji,jj,jk) * zesh2          &
-                        &                        +   rdt  * ztkelc(ji,jj,jk)
-                  ENDIF
-               END DO
-            END DO
-         END DO
-         !
-      CASE ( 1 )           ! Prandtl number
-         DO jk = 2, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  !                                                             ! shear prod. - stratif. destruction
-                  zcoef = 0.5 / fse3w(ji,jj,jk)                                     
-                  zdku = zcoef * (  ub(ji-1,jj  ,jk-1) + ub(ji,jj,jk-1)   &          ! shear
-                  &               - ub(ji-1,jj  ,jk  ) - ub(ji,jj,jk  )  )
-                  zdkv = zcoef * (  vb(ji  ,jj-1,jk-1) + vb(ji,jj,jk-1)   &
-                  &               - vb(ji  ,jj-1,jk  ) - vb(ji,jj,jk  )  )
-                  zsh2 = zdku * zdku + zdkv * zdkv                                   ! square of shear
-                  zri  = MAX( rn2b(ji,jj,jk), 0. ) / ( zsh2 + 1.e-20 )                ! local Richardson number
-# if defined key_c1d
-                  e_ric(ji,jj,jk) = zri * tmask(ji,jj,jk)                            ! c1d config. : save Ri 
-# endif
-                  zpdl = 1.0                                                         ! Prandtl number
-                  IF( zri >= 0.2 )   zpdl = 0.2 / zri
-                  zpdl = MAX( 0.1, zpdl )
-                  zesh2 = eboost * zsh2 - zpdl * rn2b(ji,jj,jk)                       ! coefficient (esh2)
-                  !
-                  !                                                             ! Matrix
-                  zcof = zfact1 * tmask(ji,jj,jk)
-                  !                                                                 ! lower diagonal
-                  avmv(ji,jj,jk) = zcof * ( zmxlm(ji,jj,jk  ) + zmxlm(ji,jj,jk-1) )   &
-                  &                     / ( fse3t(ji,jj,jk-1) * fse3w(ji,jj,jk  ) )
-                  !                                                                 ! upper diagonal
-                  avmu(ji,jj,jk) = zcof * ( zmxlm(ji,jj,jk+1) + zmxlm(ji,jj,jk  ) )   &
-                  &                     / ( fse3t(ji,jj,jk  ) * fse3w(ji,jj,jk) )
-                  !                                                                 ! diagonal
-                  zwd(ji,jj,jk) = 1. - avmv(ji,jj,jk) - avmu(ji,jj,jk) + zfact2 * zmxld(ji,jj,jk)
-                  !
-                  !                                                             ! right hand side in en 
-                  IF( .NOT. ln_lc ) THEN                                             ! No Langmuir cells
-                     en(ji,jj,jk) = en(ji,jj,jk) + zfact3 * zmxld (ji,jj,jk) * en   (ji,jj,jk)   &
-                        &                        +   rdt  * zmxlm (ji,jj,jk) * zesh2
-                  ELSE                                                               ! Langmuir cell source term
-                     en(ji,jj,jk) = en(ji,jj,jk) + zfact3 * zmxld (ji,jj,jk) * en   (ji,jj,jk)   &
-                        &                        +   rdt  * zmxlm (ji,jj,jk) * zesh2             &
-                        &                        +   rdt  * ztkelc(ji,jj,jk)
-                  ENDIF
-                  zmxld(ji,jj,jk) = zpdl * tmask(ji,jj,jk)                      ! store masked Prandlt number in zmxld array
-               END DO
-            END DO
-         END DO
-         !
-      END SELECT
-
-# if defined key_c1d
-      e_pdl(:,:,2:jpkm1) = zmxld(:,:,2:jpkm1)      ! c1d configuration : save masked Prandlt number
-      e_pdl(:,:,      1) = e_pdl(:,:,      2)
-      e_pdl(:,:,    jpk) = e_pdl(:,:,  jpkm1)      
-# endif
-
-      ! 4. 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.
-               zwd(ji,jj,jk) = zwd(ji,jj,jk) - avmv(ji,jj,jk) * avmu(ji,jj,jk-1) / zwd(ji,jj,jk-1)
-            END DO
-         END DO
-      END DO
-      DO jj = 2, jpjm1                             ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1
-         DO ji = fs_2, fs_jpim1    ! vector opt.
-            avmv(ji,jj,2) = en(ji,jj,2) - avmv(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.
-               avmv(ji,jj,jk) = en(ji,jj,jk) - avmv(ji,jj,jk) / zwd(ji,jj,jk-1) *avmv(ji,jj,jk-1)
-            END DO
-         END DO
-      END DO
-      DO jj = 2, jpjm1                             ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk
-         DO ji = fs_2, fs_jpim1    ! vector opt.
-            en(ji,jj,jpkm1) = avmv(ji,jj,jpkm1) / zwd(ji,jj,jpkm1)
-         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) = ( avmv(ji,jj,jk) - avmu(ji,jj,jk) * en(ji,jj,jk+1) ) / zwd(ji,jj,jk)
-            END DO
-         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 ) * tmask(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-     
-      ! 5. Add extra TKE due to surface and internal wave breaking (nn_etau /= 0)
-      !!----------------------------------------------------------
-      IF( nn_etau /= 0 ) THEN        ! extra tke : en = en + rn_efr * en(1) * exp( -z/zhtau )
-         !
-         SELECT CASE( nn_htau )           ! Choice of the depth of penetration
-         CASE( 0 )                                    ! constant depth penetration (here 10 meters)
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zhtau(ji,jj) = 10.
-               END DO
-            END DO
-         CASE( 1 )                                    ! meridional profile  1
-            DO jj = 2, jpjm1                          ! ( 0.5m in the tropics to a maximum of 30 m at high lat.)
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zhtau(ji,jj) = MAX( 0.5, 3./4. * MIN( 40., 60.*ABS( SIN( rpi/180. * gphit(ji,jj) ) ) )   )
-               END DO
-            END DO
-         END SELECT
-         ! 
-         IF( nn_etau == 1 ) THEN          ! extra term throughout the water column
-            DO jk = 2, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     en(ji,jj,jk) = en(ji,jj,jk)   &
-                        &         + rn_efr * en(ji,jj,1)*EXP( -fsdepw(ji,jj,jk) / zhtau(ji,jj) ) &
-                        &                  * ( 1.e0 - fr_i(ji,jj) )  * tmask(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
-         ELSEIF( nn_etau == 2 ) THEN      ! extra term only at the base of the mixed layer
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  jk = nmln(ji,jj)
-                  en(ji,jj,jk) = en(ji,jj,jk)    &
-                     &         + rn_efr * en(ji,jj,1)*EXP( -fsdepw(ji,jj,jk) / zhtau(ji,jj) ) &
-                     &                   * ( 1.e0 - fr_i(ji,jj) )  * tmask(ji,jj,jk)
-               END DO
-            END DO
-         ENDIF
-         !
-      ENDIF
-
-
-      ! Lateral boundary conditions (sign unchanged)
-      CALL lbc_lnk( en, 'W', 1. )   ;   CALL lbc_lnk( avt, 'W', 1. )
-
-
-      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-      ! IV.  Before vertical eddy vicosity and diffusivity coefficients
-      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-      !
-      SELECT CASE ( nn_ave )
-      CASE ( 0 )                                     ! no horizontal average 
-         DO jk = 2, jpkm1                                 ! only vertical eddy viscosity 
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  avmu(ji,jj,jk) = ( avt  (ji,jj,jk) + avt  (ji+1,jj  ,jk) ) * umask(ji,jj,jk)   &
-                  &     / MAX( 1.,   tmask(ji,jj,jk) + tmask(ji+1,jj  ,jk) )
-                  avmv(ji,jj,jk) = ( avt  (ji,jj,jk) + avt  (ji  ,jj+1,jk) ) * vmask(ji,jj,jk)   &
-                  &     / MAX( 1.,   tmask(ji,jj,jk) + tmask(ji  ,jj+1,jk) )
-               END DO
-            END DO
-         END DO
-         CALL lbc_lnk( avmu, 'U', 1. )   ;   CALL lbc_lnk( avmv, 'V', 1. )      ! Lateral boundary conditions
-         !
-      CASE ( 1 )                                     ! horizontal average                         ( 1/2  1/2 )
-         !                                                ! Vertical eddy viscosity    avmu = 1/4 ( 1    1   )
-         !                                                !                                       ( 1/2  1/2 )
-         !                                                !
-         !                                                !                                       ( 1/2  1   1/2 )            
-         !                                                !                            avmv = 1/4 ( 1/2  1   1/2 )      
-         DO jk = 2, jpkm1                                
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-# if defined key_vectopt_memory
-                  !                                       ! caution : vectopt_memory change the solution
-                  !                                       !           (last digit of the solver stat)
-                  avmu(ji,jj,jk) = (      avt(ji,jj  ,jk) + avt(ji+1,jj  ,jk)   &
-                     &              +.5*( avt(ji,jj-1,jk) + avt(ji+1,jj-1,jk)   &
-                     &                   +avt(ji,jj+1,jk) + avt(ji+1,jj+1,jk) ) ) * eumean(ji,jj,jk)
-
-                  avmv(ji,jj,jk) = (      avt(ji  ,jj,jk) + avt(ji  ,jj+1,jk)   &
-                     &              +.5*( avt(ji-1,jj,jk) + avt(ji-1,jj+1,jk)   &
-                     &                   +avt(ji+1,jj,jk) + avt(ji+1,jj+1,jk) ) ) * evmean(ji,jj,jk)
-# else
-                  avmu(ji,jj,jk) = (   avt  (ji,jj  ,jk) + avt  (ji+1,jj  ,jk)   &
-                     &           +.5*( avt  (ji,jj-1,jk) + avt  (ji+1,jj-1,jk)   &
-                     &                +avt  (ji,jj+1,jk) + avt  (ji+1,jj+1,jk) ) ) * umask(ji,jj,jk)   &
-                     &    / MAX( 1.,   tmask(ji,jj  ,jk) + tmask(ji+1,jj  ,jk)   &
-                     &           +.5*( tmask(ji,jj-1,jk) + tmask(ji+1,jj-1,jk)   &
-                     &                +tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk) )  )
-
-                  avmv(ji,jj,jk) = (   avt  (ji  ,jj,jk) + avt  (ji  ,jj+1,jk)   &
-                     &           +.5*( avt  (ji-1,jj,jk) + avt  (ji-1,jj+1,jk)   &
-                     &                +avt  (ji+1,jj,jk) + avt  (ji+1,jj+1,jk) ) ) * vmask(ji,jj,jk)   &
-                     &   /  MAX( 1.,   tmask(ji  ,jj,jk) + tmask(ji  ,jj+1,jk)   &
-                     &           +.5*( tmask(ji-1,jj,jk) + tmask(ji-1,jj+1,jk)   &
-                     &                +tmask(ji+1,jj,jk) + tmask(ji+1,jj+1,jk) )  )
-# endif
-               END DO
-            END DO
-         END DO
-         CALL lbc_lnk( avmu, 'U', 1. )   ;   CALL lbc_lnk( avmv, 'V', 1. )      ! Lateral boundary conditions 
-         !
-         !                                                ! Vertical eddy diffusivity             (1 2 1)
-         !                                                !                            avt = 1/16 (2 4 2)
-         !                                                !                                       (1 2 1)
-         DO jk = 2, jpkm1         
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-#  if defined key_vectopt_memory
-                  avt(ji,jj,jk) = ( avmu(ji,jj,jk) + avmu(ji-1,jj  ,jk)                          &
-                     &            + avmv(ji,jj,jk) + avmv(ji  ,jj-1,jk)  ) * etmean(ji,jj,jk)
-#  else
-                  avt(ji,jj,jk) = ( avmu (ji,jj,jk) + avmu (ji-1,jj  ,jk)                        &
-                     &            + avmv (ji,jj,jk) + avmv (ji  ,jj-1,jk)  ) * tmask(ji,jj,jk)   &
-                     &  / MAX( 1.,  umask(ji,jj,jk) + umask(ji-1,jj  ,jk)                        &
-                     &            + vmask(ji,jj,jk) + vmask(ji  ,jj-1,jk)  )
-#  endif
-               END DO
-            END DO
-         END DO
-         !
-      END SELECT
-      !
-      IF( nn_pdl == 1 ) THEN                            ! Ponderation by the Prandtl number (nn_pdl=1)
-         DO jk = 2, jpkm1 
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zpdl = zmxld(ji,jj,jk)
-                  avt(ji,jj,jk) = MAX( zpdl * avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * tmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-      ENDIF
-      !
-      DO jk = 2, jpkm1                                  ! Minimum value on the eddy viscosity
-         avmu(:,:,jk) = MAX( avmu(:,:,jk), avmb(jk) ) * umask(:,:,jk)
-         avmv(:,:,jk) = MAX( avmv(:,:,jk), avmb(jk) ) * vmask(:,:,jk)
-      END DO
-
-      CALL lbc_lnk( avt, 'W', 1. )                      ! Lateral boundary conditions on avt  (sign unchanged)
-
-      IF( lrst_oce )   CALL tke_rst( kt, 'WRITE' )      ! write en in restart file
-
-      IF(ln_ctl) THEN
-         CALL prt_ctl( tab3d_1=en  , clinfo1=' tke  - e: ', tab3d_2=avt, clinfo2=' t: ', ovlap=1, kdim=jpk)
-         CALL prt_ctl( tab3d_1=avmu, clinfo1=' tke  - u: ', mask1=umask,                   &
-            &          tab3d_2=avmv, clinfo2=       ' v: ', mask2=vmask, ovlap=1, kdim=jpk )
-      ENDIF
-      !
-   END SUBROUTINE zdf_tke_old
-
-
-   SUBROUTINE zdf_tke_init
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE zdf_tke_init  ***
-      !!                     
-      !! ** Purpose :   Initialization of the vertical eddy diffivity and 
-      !!      viscosity when using a tke turbulent closure scheme
-      !!
-      !! ** Method  :   Read the namzdf_tke namelist and check the parameters
-      !!      called at the first timestep (nit000)
-      !!
-      !! ** input   :   Namlist namzdf_tke
-      !!
-      !! ** Action  :   Increase by 1 the nstop flag is setting problem encounter
-      !!
-      !!----------------------------------------------------------------------
-      USE dynzdf_exp
-      USE trazdf_exp
-      !
-# if defined key_vectopt_memory
-      INTEGER ::   ji, jj, jk   ! dummy loop indices
-# else
-      INTEGER ::           jk   ! dummy loop indices
-# endif
-      !!
-      NAMELIST/namzdf_tke/ rn_ediff, rn_ediss , rn_ebb   , rn_emin  ,   &
-         &                 rn_emin0, rn_bshear, nn_mxl   , ln_mxl0  ,   &
-         &                 rn_lmin , rn_lmin0 , nn_pdl   , nn_etau  ,   &
-         &                 nn_htau , rn_efr   , rn_addhft, rn_sclhft,   &
-         &                 ln_lc   , rn_lc 
-      !!----------------------------------------------------------------------
-
-      ! Read Namelist namzdf_tke : Turbulente Kinetic Energy
-      ! --------------------
-      REWIND ( numnam )
-      READ   ( numnam, namzdf_tke )
-
-      ! Compute boost associated with the Richardson critic
-      !     (control values: rn_cri = 0.3   ==> eboost=1.25 for nn_pdl=1)
-      !     (                rn_cri = 0.222 ==> eboost=1.               )
-      eboost = rn_cri * ( 2. + rn_ediss / rn_ediff ) / 2.
-
-
-
-      ! Parameter control and print
-      ! ---------------------------
-      ! Control print
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'zdf_tke_init : tke turbulent closure scheme (old scheme)'
-         WRITE(numout,*) '~~~~~~~~~~~~'
-         WRITE(numout,*) '          Namelist namzdf_tke : set tke mixing parameters'
-         WRITE(numout,*) '             coef. to compute avt                      rn_ediff = ', rn_ediff
-         WRITE(numout,*) '             Kolmogoroff dissipation coef.             rn_ediss = ', rn_ediss
-         WRITE(numout,*) '             tke surface input coef.                   rn_ebb   = ', rn_ebb
-         WRITE(numout,*) '             minimum value of tke                      rn_emin  = ', rn_emin
-         WRITE(numout,*) '             surface minimum value of tke              rn_emin0 = ', rn_emin0
-         WRITE(numout,*) '             mixing length type                        nn_mxl   = ', nn_mxl
-         WRITE(numout,*) '             prandl number flag                        nn_pdl   = ', nn_pdl
-         WRITE(numout,*) '             horizontal average flag                   nn_ave   = ', nn_ave
-         WRITE(numout,*) '             critic Richardson nb                      rn_cri   = ', rn_cri
-         WRITE(numout,*) '                and its associated coeff.              eboost   = ', eboost
-         WRITE(numout,*) '             surface mixing length = F(stress) or not  ln_mxl0  = ', ln_mxl0
-         WRITE(numout,*) '             surface  mixing length minimum value      rn_lmin0 = ', rn_lmin0
-         WRITE(numout,*) '             interior mixing length minimum value      rn_lmin0 = ', rn_lmin0
-         WRITE(numout,*) '             test param. to add tke induced by wind    nn_etau  = ', nn_etau
-         WRITE(numout,*) '             flag for computation of exp. tke profile  nn_htau  = ', nn_htau
-         WRITE(numout,*) '             % of rn_emin0 which pene. the thermocline rn_efr   = ', rn_efr
-         WRITE(numout,*) '             flag to take into acc.  Langmuir circ.    ln_lc    = ', ln_lc
-         WRITE(numout,*) '             coef to compute verticla velocity of LC   rn_lc    = ', rn_lc
-         WRITE(numout,*)
-      ENDIF
-
-      ! Check of some namelist values
-      IF( nn_mxl  < 0    .OR. nn_mxl  > 3   )   CALL ctl_stop( 'bad flag: nn_mxl is  0, 1 or 2 ' )
-      IF( nn_pdl  < 0    .OR. nn_pdl  > 1   )   CALL ctl_stop( 'bad flag: nn_pdl is  0 or 1    ' )
-      IF( nn_ave  < 0    .OR. nn_ave  > 1   )   CALL ctl_stop( 'bad flag: nn_ave is  0 or 1    ' )
-      IF( nn_htau < 0    .OR. nn_htau > 1   )   CALL ctl_stop( 'bad flag: nn_htau is 0 or 1    ' )
-      IF( rn_lc   < 0.15 .OR. rn_lc   > 0.2 )   CALL ctl_stop( 'bad value: rn_lc must be between 0.15 and 0.2 ' )
-
-      IF( nn_etau == 2 )   CALL zdf_mxl( nit000 )      ! Initialization of nmln 
-
-      ! Horizontal average : initialization of weighting arrays 
-      ! -------------------
-      !
-      SELECT CASE ( nn_ave )
-      ! Notice: mean arrays have not to by defined at local domain boundaries due to the vertical nature of TKE
-      !
-      CASE ( 0 )                ! no horizontal average
-         IF(lwp) WRITE(numout,*) '          no horizontal average on avt, avmu, avmv'
-         IF(lwp) WRITE(numout,*) '          only in very high horizontal resolution !'
-# if defined key_vectopt_memory
-         ! caution vectopt_memory change the solution (last digit of the solver stat)
-         ! weighting mean arrays etmean, eumean and evmean
-         !           ( 1  1 )                                          ( 1 )
-         ! avt = 1/4 ( 1  1 )     avmu = 1/2 ( 1  1 )       avmv=  1/2 ( 1 )
-         !                          
-         etmean(:,:,:) = 0.e0
-         eumean(:,:,:) = 0.e0
-         evmean(:,:,:) = 0.e0
-         !
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  etmean(ji,jj,jk) = tmask(ji,jj,jk) / MAX( 1.,  umask(ji,jj,jk) + umask(ji-1,jj  ,jk)   &
-                  &                                            + vmask(ji,jj,jk) + vmask(ji  ,jj-1,jk) )
-                  eumean(ji,jj,jk) = umask(ji,jj,jk) / MAX( 1.,  tmask(ji,jj,jk) + tmask(ji+1,jj  ,jk) )
-                  evmean(ji,jj,jk) = vmask(ji,jj,jk) / MAX( 1.,  tmask(ji,jj,jk) + tmask(ji  ,jj+1,jk) )
-               END DO
-            END DO
-         END DO
-# endif
-         !
-      CASE ( 1 )                ! horizontal average 
-         IF(lwp) WRITE(numout,*) '          horizontal average on avt, avmu, avmv'
-# if defined key_vectopt_memory
-         ! caution vectopt_memory change the solution (last digit of the solver stat)
-         ! weighting mean arrays etmean, eumean and evmean
-         !           ( 1  1 )              ( 1/2  1/2 )             ( 1/2  1  1/2 )
-         ! avt = 1/4 ( 1  1 )   avmu = 1/4 ( 1    1   )   avmv= 1/4 ( 1/2  1  1/2 )
-         !                                 ( 1/2  1/2 )
-         etmean(:,:,:) = 0.e0
-         eumean(:,:,:) = 0.e0
-         evmean(:,:,:) = 0.e0
-         !
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  etmean(ji,jj,jk) = tmask(ji,jj,jk) / MAX( 1.,   umask(ji-1,jj  ,jk) + umask(ji  ,jj  ,jk)   &
-                  &                                       +       vmask(ji  ,jj-1,jk) + vmask(ji  ,jj  ,jk) )
-                  eumean(ji,jj,jk) = umask(ji,jj,jk) / MAX( 1.,   tmask(ji  ,jj  ,jk) + tmask(ji+1,jj  ,jk)   &
-                  &                                       +.5 * ( tmask(ji  ,jj-1,jk) + tmask(ji+1,jj-1,jk)   &
-                  &                                             + tmask(ji  ,jj+1,jk) + tmask(ji+1,jj+1,jk) )  )
-                  evmean(ji,jj,jk) = vmask(ji,jj,jk) / MAX( 1.,   tmask(ji  ,jj  ,jk) + tmask(ji  ,jj+1,jk)   &
-                  &                                       +.5 * ( tmask(ji-1,jj  ,jk) + tmask(ji-1,jj+1,jk)   &
-                  &                                             + tmask(ji+1,jj  ,jk) + tmask(ji+1,jj+1,jk) )  )
-               END DO
-            END DO
-         END DO
-# endif
-         !
-      END SELECT
-
-      ! Initialization of vertical eddy coef. to the background value
-      ! -------------------------------------------------------------
-      DO jk = 1, jpk
-         avt (:,:,jk) = avtb(jk) * tmask(:,:,jk)
-         avmu(:,:,jk) = avmb(jk) * umask(:,:,jk)
-         avmv(:,:,jk) = avmb(jk) * vmask(:,:,jk)
-      END DO
-
-
-      ! read or initialize turbulent kinetic energy ( en )
-      ! -------------------------------------------------
-      CALL tke_rst( nit000, 'READ' )
-      !
-   END SUBROUTINE zdf_tke_init
-
-
-   SUBROUTINE tke_rst( kt, cdrw )
-     !!---------------------------------------------------------------------
-     !!                   ***  ROUTINE ts_rst  ***
-     !!                     
-     !! ** Purpose :   Read or write TKE file (en) in restart file
-     !!
-     !! ** Method  :   use of IOM library
-     !!                if the restart does not contain TKE, en is either 
-     !!                set to rn_emin or recomputed (nn_itke/=0)
-     !!----------------------------------------------------------------------
-     INTEGER         , INTENT(in) ::   kt         ! ocean time-step
-     CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
-     !
-     INTEGER ::   jit   ! dummy loop indices
-     !!----------------------------------------------------------------------
-     !
-     IF( TRIM(cdrw) == 'READ' ) THEN
-        IF( ln_rstart ) THEN
-           IF( iom_varid( numror, 'en', ldstop = .FALSE. ) > 0 ) THEN 
-              CALL iom_get( numror, jpdom_autoglo, 'en', en )
-           ELSE
-              IF(lwp)  WRITE(numout,*) ' ===>>>> : previous run without tke scheme'
-              IF(lwp)  WRITE(numout,*) ' ===>>>> : en is set by iterative loop'
-              en (:,:,:) = rn_emin * tmask(:,:,:)
-              DO jit = 2, 51
-                 CALL zdf_tke_old( jit )
-              END DO
-           ENDIF
-        ELSE
-           en(:,:,:) = rn_emin * tmask(:,:,:)      ! no restart: en set to its minimum value
-        ENDIF
-     ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
-        CALL iom_rstput( kt, nitrst, numrow, 'en', en )
-     ENDIF
-     !
-   END SUBROUTINE tke_rst
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Dummy module :                                        NO TKE scheme
-   !!----------------------------------------------------------------------
-   LOGICAL, PUBLIC, PARAMETER ::   lk_zdftke_old = .FALSE.   !: TKE flag
-CONTAINS
-   SUBROUTINE zdf_tke_old( kt )          ! Empty routine
-      WRITE(*,*) 'zdf_tke_old: You should not have seen this print! error?', kt
-   END SUBROUTINE zdf_tke_old
-#endif
-
-   !!======================================================================
-END MODULE zdftke_old
Index: trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90	(revision 2528)
@@ -6,4 +6,5 @@
    !! History :  1.0  !  2004-04  (L. Bessieres, G. Madec)  Original code
    !!             -   !  2006-08  (A. Koch-Larrouy) Indonesian strait
+   !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase
    !!----------------------------------------------------------------------
 #if defined key_zdftmx
@@ -27,5 +28,6 @@
    PRIVATE
 
-   PUBLIC   zdf_tmx    ! called in step module 
+   PUBLIC   zdf_tmx         ! called in step module 
+   PUBLIC   zdf_tmx_init    ! called in opa module 
 
    LOGICAL, PUBLIC, PARAMETER ::   lk_zdftmx = .TRUE.    !: tidal mixing flag
@@ -47,7 +49,7 @@
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -96,7 +98,4 @@
       REAL(wp), DIMENSION(jpi,jpj) ::   zkz   ! temporary 2D workspace
       !!----------------------------------------------------------------------
-
-      !                        
-      IF( kt == nit000  )   CALL zdf_tmx_init      ! Initialization (first time-step only)
 
       !                          ! ----------------------- !
@@ -372,5 +371,5 @@
       DO jj = 1, jpj                ! part independent of the level
          DO ji = 1, jpi
-            zhdep(ji,jj) = fsdepw(ji,jj,mbathy(ji,jj))       ! depth of the ocean
+            zhdep(ji,jj) = fsdepw(ji,jj,mbkt(ji,jj)+1)       ! depth of the ocean
             zfact(ji,jj) = rau0 * rn_htmx * ( 1. - EXP( -zhdep(ji,jj) / rn_htmx ) )
             IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = en_tmx(ji,jj) / zfact(ji,jj)
@@ -488,5 +487,5 @@
          !
       ENDIF
-
+      !
    END SUBROUTINE zdf_tmx_init
 
@@ -497,5 +496,8 @@
    LOGICAL, PUBLIC, PARAMETER ::   lk_zdftmx = .FALSE.   !: tidal mixing flag
 CONTAINS
-   SUBROUTINE zdf_tmx( kt )          ! Empty routine
+   SUBROUTINE zdf_tmx_init           ! Dummy routine
+      WRITE(*,*) 'zdf_tmx: You should not have seen this print! error?'
+   END SUBROUTINE zdf_tmx_init
+   SUBROUTINE zdf_tmx( kt )          ! Dummy routine
       WRITE(*,*) 'zdf_tmx: You should not have seen this print! error?', kt
    END SUBROUTINE zdf_tmx
Index: trunk/NEMOGCM/NEMO/OPA_SRC/agrif_opa_interp.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/agrif_opa_interp.F90	(revision 2527)
+++ 	(revision )
@@ -1,15 +1,0 @@
-MODULE agrif_opa_interp
-   !!======================================================================
-   !!                       ***  MODULE agrif_opa_interp  ***
-   !!  Dummy module
-   !!======================================================================
-
-   !!----------------------------------------------------------------------
-   !!   Dummy module                                     NO agrif use
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-END MODULE agrif_opa_interp
Index: trunk/NEMOGCM/NEMO/OPA_SRC/agrif_opa_sponge.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/agrif_opa_sponge.F90	(revision 2527)
+++ 	(revision )
@@ -1,15 +1,0 @@
-MODULE agrif_opa_sponge
-   !!======================================================================
-   !!                       ***  MODULE agrif_opa_sponge  ***
-   !!  Dummy module
-   !!======================================================================
-
-   !!----------------------------------------------------------------------
-   !!   Dummy module                                     NO agrif use
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-END MODULE agrif_opa_sponge
Index: trunk/NEMOGCM/NEMO/OPA_SRC/agrif_opa_update.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/agrif_opa_update.F90	(revision 2527)
+++ 	(revision )
@@ -1,15 +1,0 @@
-MODULE agrif_opa_update
-   !!======================================================================
-   !!                       ***  MODULE agrif_opa_update  ***
-   !!  Dummy module
-   !!======================================================================
-
-   !!----------------------------------------------------------------------
-   !!   Dummy module                                     NO agrif use
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-END MODULE agrif_opa_update
Index: trunk/NEMOGCM/NEMO/OPA_SRC/cla.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/cla.F90	(revision 2527)
+++ 	(revision )
@@ -1,781 +1,0 @@
-MODULE cla
-   !!==============================================================================
-   !!                         ***  MODULE  cla  ***
-   !! Cross Land Advection : parameterize ocean exchanges through straits by a
-   !!                        specified advection across land.
-   !!==============================================================================
-#if defined key_orca_r2
-   !!----------------------------------------------------------------------
-   !!   'key_orca_r2'   :                             ORCA R2 configuration
-   !!----------------------------------------------------------------------
-   !!   tra_cla           : update the tracer trend with the horizontal 
-   !!                       and vertical advection trends at straits
-   !!   tra_bab_el_mandeb : 
-   !!   tra_gibraltar     :
-   !!   tra_hormuz        :
-   !!   tra_cla_init      :
-   !!----------------------------------------------------------------------
-   !! * Modules used
-   USE oce             ! ocean dynamics and tracers variables
-   USE dom_oce         ! ocean space and time domain variables 
-   USE sbc_oce         ! surface boundary condition: ocean
-   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
-
-   !! * Routine accessibility
-   PUBLIC tra_cla        ! routine called by step.F90
-
-   !! * Modules variables   
-   REAL(wp) :: zempmed, zempred
-
-   REAL(wp) :: zisw_rs, zurw_rs, zbrw_rs          ! Imposed transport Red Sea 
-   REAL(wp) :: zisw_ms, zmrw_ms, zurw_ms, zbrw_ms ! Imposed transport Med Sea 
-   REAL(wp) :: zisw_pg, zbrw_pg                   ! Imposed transport Persic Gulf 
-
-   REAL(wp), DIMENSION(jpk) ::   &
-      zu1_rs_i, zu2_rs_i, zu3_rs_i,              &  ! Red Sea velocities
-      zu1_ms_i, zu2_ms_i, zu3_ms_i,              &  ! Mediterranean Sea velocities
-      zu_pg                                         ! Persic Gulf velocities
-   REAL(wp), DIMENSION (jpk) :: zthor, zshor        ! Temperature, salinity Hormuz 
-   
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE tra_cla( kt )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE tra_cla  ***
-      !!                   
-      !! ** Purpose :   Update the now trend due to the advection of tracers
-      !!      and add it to the general trend of passive tracer equations
-      !!      at some straits ( Bab el Mandeb, Gibraltar, Hormuz ).
-      !!
-      !! ** Method  :   ...
-      !!         Add this trend now to the general trend of tracer (ta,sa):
-      !!            (ta,sa) = (ta,sa) + ( zta , zsa )
-      !!
-      !! ** Action  :   update (ta,sa) with the now advective tracer trends
-      !!
-      !! History :
-      !!        !         (A. Bozec)  original code  
-      !!   8.5  !  02-11  (A. Bozec)  F90: Free form and module
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
-      !!----------------------------------------------------------------------
- 
-      ! cross land advection for straits
-
-      ! Initialization
-      IF( kt == nit000 )   CALL tra_cla_init
-
-
-      ! Bab el Mandeb strait horizontal advection
-
-      CALL tra_bab_el_mandeb 
-
-      ! Gibraltar strait horizontal advection
-
-      CALL tra_gibraltar
-
-      ! Hormuz Strait ( persian Gulf) horizontal advection
-
-      CALL tra_hormuz 
-
-   END SUBROUTINE tra_cla
-
-
-   SUBROUTINE tra_bab_el_mandeb
-      !!---------------------------------------------------------------------
-      !!             ***  ROUTINE tra_bab_el_mandeb  ***
-      !!
-      !! ** Purpose :   Update the horizontal advective trend of tracers
-      !!      correction in Bab el Mandeb strait and
-      !!      add it to the general trend of tracer equations.
-      !!
-      !! ** Method :
-      !!     We impose transport at Bab el Mandeb and knowing T and S in
-      !!     surface and depth at each side of the  strait, we deduce T and S
-      !!     of the deep outflow of the Red Sea in the Indian ocean . 
-      !!                                          |
-      !!            |/ \|            N          |\ /|
-      !!            |_|_|______      |          |___|______
-      !!        88  |   |<-       W - - E    88 |   |<-
-      !!        87  |___|______      |       87 |___|->____
-      !!             160 161         S           160 161 
-      !!       horizontal view                horizontal view
-      !!          surface                        depth
-      !!    
-      !!     The horizontal advection is evaluated by a second order cen-
-      !!     tered scheme using now fields (leap-frog scheme). In specific
-      !!     areas (vicinity of major river mouths, some straits, or tn
-      !!     approaching the freezing point) it is mixed with an upstream 
-      !!     scheme for stability reasons. 
-      !!
-      !!         C A U T I O N : the trend saved is the centered trend only.
-      !!      It doesn't take into account the upstream part of the scheme.
-      !!
-      !! ** history :
-      !!           !  02-11  (A. Bozec) Original code 
-      !!      8.5  !  02-11  (A. Bozec) F90: Free form and module
-      !!---------------------------------------------------------------------
-      !! * Local declarations
-      INTEGER ::  ji, jj, jk               ! dummy loop indices
-      REAL(wp) :: zsu, zvt
-      REAL(wp) :: zsumt, zsumt1, zsumt2, zsumt3, zsumt4
-      REAL(wp) :: zsums, zsums1, zsums2, zsums3, zsums4
-      REAL(wp) :: zt, zs
-      REAL(wp) :: zwei
-      REAL(wp), DIMENSION (jpk) ::  zu1_rs, zu2_rs, zu3_rs
-      !!---------------------------------------------------------------------
-
-      ! Initialization of vertical sum for T and S transport
-      ! ----------------------------------------------------
-
-      zsumt  = 0.e0       ! East  Bab el Mandeb surface north point (T)
-      zsums  = 0.e0       ! East  Bab el Mandeb surface north point (S)
-      zsumt1 = 0.e0       ! East  Bab el Mandeb depth   south point (T)
-      zsums1 = 0.e0       ! East  Bab el Mandeb depth   south point (S)
-      zsumt2 = 0.e0       ! West  Bab el Mandeb surface             (T)
-      zsums2 = 0.e0       ! West  Bab el Mandeb surface             (S)
-      zsumt3 = 0.e0       ! West  Bab el Mandeb depth               (T)
-      zsums3 = 0.e0       ! West  Bab el Mandeb depth               (S)
-      zsumt4 = 0.e0       ! East  Bab el Mandeb depth   north point (T) 
-      zsums4 = 0.e0       ! East  Bab el Mandeb depth   north point (S) 
-      
-      ! EMP of the Red Sea 
-      ! ------------------
-
-      zempred = 0.e0
-      zwei = 0.e0
-      DO jj = mj0(87), mj1(96)
-         DO ji = mi0(148), mi1(160)
-            zwei    = tmask(ji,jj,1) * e1t(ji,jj) * e2t(ji,jj)
-            zempred = zempred + emp(ji,jj) * zwei
-         END DO
-      END DO
-      IF( lk_mpp )   CALL mpp_sum( zempred )      ! sum with other processors value
-
-      ! convert in m3
-      zempred = zempred * 1.e-3
-
-      ! Velocity profile at each point
-      ! ------------------------------
-
-      zu1_rs(:) = zu1_rs_i(:)
-      zu2_rs(:) = zu2_rs_i(:)
-      zu3_rs(:) = zu3_rs_i(:)
-
-      ! velocity profile at 161,88 East Bab el Mandeb North point 
-      ! we imposed zisw_rs + EMP above the Red Sea 
-      DO jk = 1, 8                                      
-         DO jj = mj0(88), mj1(88) 
-            DO ji = mi0(160), mi1(160) 
-               zu1_rs(jk) = zu1_rs(jk) - ( zempred / 8. ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )     
-            END DO
-         END DO
-      END DO
-
-      ! velocity profile at 161, 88 West Bab el Mandeb 
-      ! we imposed zisw_rs + EMP above the Red Sea 
-      DO jk = 1,  10                                     
-         DO jj = mj0(88), mj1(88) 
-            DO ji = mi0(160), mi1(160) 
-               zu3_rs(jk) = zu3_rs(jk) + ( zempred / 10. ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )
-            END DO
-         END DO
-      END DO
-      
-      ! Balance of temperature and salinity
-      ! -----------------------------------
-
-      ! east Bab el Mandeb surface vertical sum of transport* S,T
-      DO jk =  1, 19
-         DO jj = mj0(88), mj1(88) 
-            DO ji = mi0(161), mi1(161) 
-               zsumt  = zsumt  + tn(ji,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zu1_rs(jk)  
-               zsums  = zsums  + sn(ji,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zu1_rs(jk) 
-            END DO
-         END DO
-      END DO
-
-      ! west Bab el Mandeb surface vertical sum of transport* S,T
-      DO jk =  1, 10
-         DO jj = mj0(88), mj1(88) 
-            DO ji = mi0(161), mi1(161) 
-               zsumt2 = zsumt2 + tn(ji,jj,jk) * e1v(ji-1,jj) * fse3v(ji-1,jj,jk) * zu3_rs(jk)
-               zsums2 = zsums2 + sn(ji,jj,jk) * e1v(ji-1,jj) * fse3v(ji-1,jj,jk) * zu3_rs(jk)
-            END DO
-         END DO
-      END DO
-
-      ! west Bab el Mandeb deeper
-      DO jj = mj0(89), mj1(89) 
-         DO ji = mi0(160), mi1(160) 
-            zsumt3 = tn(ji,jj,16) * e1v(ji,jj-1) * fse3v(ji,jj-1,16) * zu3_rs(16)
-            zsums3 = sn(ji,jj,16) * e1v(ji,jj-1) * fse3v(ji,jj-1,16) * zu3_rs(16)
-         END DO
-      END DO
-
-      ! east  Bab el Mandeb deeper  
-      DO jk =  20, 21
-         DO jj = mj0(88), mj1(88) 
-            DO ji = mi0(161), mi1(161) 
-               zsumt4 =  zsumt4 + tn(ji,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zu1_rs(jk)
-               zsums4 =  zsums4 + sn(ji,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zu1_rs(jk) 
-            END DO
-         END DO
-      END DO
-
-      ! Total transport  
-      zsumt1 = -( zsumt3 + zsumt2 + zsumt + zsumt4 )
-      zsums1 = -( zsums3 + zsums2 + zsums + zsums4 )
-
-      ! Temperature and Salinity at East Bab el Mandeb, Level 21
-      DO jj = mj0(88), mj1(88) 
-         DO ji = mi0(160), mi1(160) 
-            zt = zsumt1 / ( zu2_rs(21) * e2u(ji,jj-1) * fse3u(ji,jj-1,21) )
-            zs = zsums1 / ( zu2_rs(21) * e2u(ji,jj-1) * fse3u(ji,jj-1,21) )
-         END DO
-      END DO
-      
-      ! New Temperature and Salinity at East Bab el Mandeb
-      ! --------------------------------------------------
-
-      ! north point 	
-      DO jk = 1, jpk
-         DO jj = mj0(88), mj1(88) 
-            DO ji = mi0(161), mi1(161) 
-               zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
-               zsu = e2u(ji-1,jj) * fse3u(ji-1,jj,jk)
-               ta(ji,jj,jk) = ta(ji,jj,jk) + ( 1. / zvt ) * zsu * zu1_rs(jk) * tn(ji,jj,jk)
-               sa(ji,jj,jk) = sa(ji,jj,jk) + ( 1. / zvt ) * zsu * zu1_rs(jk) * sn(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-
-      ! south point
-      jk =  21
-      DO jj = mj0(87), mj1(87) 
-         DO ji = mi0(161), mi1(161) 
-            zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
-            zsu = e2u(ji-1,jj) * fse3u(ji-1,jj,jk)
-            ta(ji,jj,jk) = ta(ji,jj,jk) + ( 1. / zvt ) * zsu * zu2_rs(jk) * zt
-            sa(ji,jj,jk) = sa(ji,jj,jk) + ( 1. / zvt ) * zsu * zu2_rs(jk) * zs
-         END DO
-      END DO
-
-
-      ! New Temperature and Salinity at West Bab el Mandeb 
-      ! --------------------------------------------------
-
-      ! surface	
-      DO jk = 1, 10
-         DO jj = mj0(89), mj1(89) 
-            DO ji = mi0(160), mi1(160) 
-               zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
-               zsu = e1v(ji,jj-1) * fse3v(ji,jj-1,jk)
-               ta(ji,jj,jk) = ta(ji,jj,jk) + ( 1. / zvt ) * zsu * zu3_rs(jk) * tn(ji+1,jj-1,jk)
-               sa(ji,jj,jk) = sa(ji,jj,jk) + ( 1. / zvt ) * zsu * zu3_rs(jk) * sn(ji+1,jj-1,jk)
-            END DO
-         END DO
-      END DO
-      ! deeper
-      jk =  16
-      DO jj = mj0(89), mj1(89) 
-         DO ji = mi0(160), mi1(160) 
-            zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
-            zsu = e1v(ji,jj-1) * fse3v(ji,jj-1,jk)
-            ta(ji,jj,jk) = ta(ji,jj,jk) + ( 1. / zvt ) * zsu * zu3_rs(jk) * tn(ji,jj,jk)
-            sa(ji,jj,jk) = sa(ji,jj,jk) + ( 1. / zvt ) * zsu * zu3_rs(jk) * sn(ji,jj,jk)
-         END DO
-      END DO
-
-   END SUBROUTINE tra_bab_el_mandeb
-
-
-   SUBROUTINE tra_gibraltar
-      !!---------------------------------------------------------------------
-      !!               ***  ROUTINE tra_gibraltar  ***
-      !!
-      !! ** Purpose :
-      !!        Update the horizontal advective trend of tracers (t & s)
-      !!        correction in Gibraltar  and
-      !!        add it to the general trend of tracer equations.
-      !!
-      !! ** Method :
-      !!      We impose transport at Gibraltar and knowing T and S in
-      !!      surface and deeper at each side of the strait, we deduce T and S
-      !!      of the outflow of the Mediterranean Sea in the Atlantic ocean .
-      !!                                
-      !!          ________________      N        ________________
-      !! 102           |    |->         |           <-|    |<-
-      !! 101      ___->|____|_____   W - - E     ___->|____|_____
-      !!           139   140  141       |         139   140  141
-      !!          horizontal view       S        horizontal view
-      !!            surface                          depth
-      !!         C A U T I O N : the trend saved is the centered trend only.
-      !!      It doesn't take into account the upstream part of the scheme.
-      !!
-      !! ** history :
-      !!           !  02-06  (A. Bozec) Original code 
-      !!      8.5  !  02-11  (A. Bozec) F90: Free form and module
-      !!---------------------------------------------------------------------
-      !! * Local declarations
-      INTEGER ::  ji, jj, jk               ! dummy loop indices
-      REAL(wp) :: zsu, zvt
-      REAL(wp) :: zsumt, zsumt1, zsumt2, zsumt3, zsumt4
-      REAL(wp) :: zsums, zsums1, zsums2, zsums3, zsums4
-      REAL(wp) :: zt, zs
-      REAL(wp) :: zwei
-      REAL(wp), DIMENSION (jpk) ::  zu1_ms, zu2_ms, zu3_ms
-      !!---------------------------------------------------------------------
-      
-      ! Initialization of vertical sum for T and S transport
-      ! ----------------------------------------------------
-
-      zsumt  = 0.e0        ! West Gib. surface south point ( T )
-      zsums  = 0.e0        ! West Gib. surface south point ( S )
-      zsumt1 = 0.e0        ! East Gib. surface north point ( T )
-      zsums1 = 0.e0        ! East Gib. surface north point ( S )
-      zsumt2 = 0.e0        ! East Gib. depth   north point ( T )
-      zsums2 = 0.e0        ! East Gib. depth   north point ( S )
-      zsumt3 = 0.e0        ! West Gib. depth   south point ( T ) 
-      zsums3 = 0.e0        ! West Gib. depth   south point ( S ) 
-      zsumt4 = 0.e0        ! West Gib. depth   north point ( T ) 
-      zsums4 = 0.e0        ! West Gib. depth   north point ( S ) 
-      
-      ! EMP of Mediterranean Sea 
-      ! ------------------------
- 
-      zempmed = 0.e0
-      zwei = 0.e0
-      DO jj = mj0(96),mj1(110)
-         DO ji = mi0(141),mi1(181)
-            zwei    = tmask(ji,jj,1) * e1t(ji,jj) * e2t(ji,jj)
-            zempmed = zempmed + emp(ji,jj) * zwei
-         END DO
-      END DO
-      IF( lk_mpp )   CALL mpp_sum( zempmed )      ! sum with other processors value
-
-
-      ! minus 2 points in Red Sea and 3 in Atlantic ocean
-      DO jj = mj0(96),mj1(96)
-         DO ji = mi0(148),mi1(148)
-            zempmed = zempmed  -  emp(ji  ,jj) * tmask(ji  ,jj,1) * e1t(ji  ,jj) * e2t(ji  ,jj)   &
-                               -  emp(ji+1,jj) * tmask(ji+1,jj,1) * e1t(ji+1,jj) * e2t(ji+1,jj)   
-         END DO
-      END DO
-
-      ! convert in m3
-      zempmed = zempmed * 1.e-3
-
-      ! Velocity profile at each point
-      ! ------------------------------
-
-      zu1_ms(:) = zu1_ms_i(:)
-      zu2_ms(:) = zu2_ms_i(:)
-      zu3_ms(:) = zu3_ms_i(:)
-
-      ! velocity profile at 139,101  South point + emp on surface 
-      DO jk = 1, 14                      
-         DO jj = mj0(102), mj1(102) 
-            DO ji = mi0(140), mi1(140) 
-               zu1_ms(jk) = zu1_ms(jk) + ( zempmed / 14. ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,jk) ) 
-            END DO
-         END DO
-      END DO
-
-      ! profile at East Gibraltar    
-      ! velocity profile at 141,102  + emp on surface 
-      DO  jk = 1, 14                     
-         DO jj = mj0(102), mj1(102) 
-            DO ji = mi0(140), mi1(140) 
-               zu3_ms(jk) = zu3_ms(jk) +  ( zempmed / 14. ) / ( e2u(ji, jj) * fse3u(ji, jj,jk) ) 
-            END DO
-         END DO
-      END DO
-     
-      ! Balance of temperature and salinity
-      ! -----------------------------------
-
-      ! west gibraltar surface vertical sum of transport* S,T
-      DO  jk =  1, 14 
-         DO jj = mj0(101), mj1(101) 
-            DO ji = mi0(139), mi1(139) 
-               zsumt  = zsumt + tn(ji, jj,jk) * e2u(ji, jj) * fse3u(ji, jj,jk) * zu1_ms(jk)  
-               zsums  = zsums + sn(ji, jj,jk) * e2u(ji, jj) * fse3u(ji, jj,jk) * zu1_ms(jk) 
-            END DO
-         END DO
-      END DO
-
-      ! east Gibraltar surface  vertical sum of transport* S,T
-      DO  jk =  1, 14 
-         DO jj = mj0(101), mj1(101) 
-            DO ji = mi0(139), mi1(139) 
-               zsumt1 = zsumt1 + tn(ji, jj,jk) * e2u(ji+1, jj+1) * fse3u(ji+1, jj+1,jk) * zu3_ms(jk)
-               zsums1 = zsums1 + sn(ji, jj,jk) * e2u(ji+1, jj+1) * fse3u(ji+1, jj+1,jk) * zu3_ms(jk)
-            END DO
-         END DO
-      END DO
-
-      ! east Gibraltar deeper  vertical sum of transport* S,T
-      DO jj = mj0(102), mj1(102) 
-         DO ji = mi0(141), mi1(141) 
-            zsumt2 = tn(ji, jj,21) * e2u(ji-1, jj) * fse3u(ji-1, jj,21) * zu3_ms(21)
-            zsums2 = sn(ji, jj,21) * e2u(ji-1, jj) * fse3u(ji-1, jj,21) * zu3_ms(21)
-         END DO
-      END DO
-      
-      ! west Gibraltar deeper vertical sum of transport* S,T
-      DO  jk =  21, 22 
-         DO jj = mj0(101), mj1(101) 
-            DO ji = mi0(139), mi1(139) 
-               zsumt3 = zsumt3 + tn(ji, jj,jk) * e2u(ji, jj) * fse3u(ji, jj,jk) * zu1_ms(jk)
-               zsums3 = zsums3 + sn(ji, jj,jk) * e2u(ji, jj) * fse3u(ji, jj,jk) * zu1_ms(jk)
-            END DO
-         END DO
-      END DO
-
-      ! Total transport = 0.
-      zsumt4 = zsumt2 + zsumt1 - zsumt - zsumt3
-      zsums4 = zsums2 + zsums1 - zsums - zsums3
-
-      ! Temperature and Salinity at West gibraltar , Level 22
-      DO jj = mj0(102), mj1(102) 
-         DO ji = mi0(140), mi1(140) 
-            zt = zsumt4 / ( zu2_ms(22) * e2u(ji-1, jj) * fse3u(ji-1, jj, 22) )
-            zs = zsums4 / ( zu2_ms(22) * e2u(ji-1, jj) * fse3u(ji-1, jj, 22) )
-         END DO
-      END DO
-      
-      ! New Temperature and Salinity trend at West Gibraltar
-      ! ----------------------------------------------------
-
-      ! south point 	
-      DO jk = 1, 22
-         DO jj = mj0(101), mj1(101) 
-            DO ji = mi0(139), mi1(139) 
-               zvt = e1t(ji, jj) * e2t(ji, jj) * fse3t(ji, jj,jk)
-               zsu = e2u(ji, jj) * fse3u(ji, jj,jk)
-               ta(ji, jj,jk) = ta(ji, jj,jk) - ( 1. / zvt ) * zsu * zu1_ms(jk) * tn(ji, jj,jk)
-               sa(ji, jj,jk) = sa(ji, jj,jk) - ( 1. / zvt ) * zsu * zu1_ms(jk) * sn(ji, jj,jk)
-            END DO
-         END DO
-      END DO
-
-      ! north point 
-      DO jk = 15, 20
-         DO jj = mj0(102), mj1(102) 
-            DO ji = mi0(139), mi1(139) 
-               zvt = e1t(ji, jj) * e2t(ji, jj) * fse3t(ji, jj,jk)
-               zsu = e2u(ji, jj) * fse3u(ji, jj,jk)
-               ta(ji, jj,jk) = ta(ji, jj,jk) - ( 1. / zvt ) * zsu * zu2_ms(jk) * tn(ji, jj-1,jk)
-               sa(ji, jj,jk) = sa(ji, jj,jk) - ( 1. / zvt ) * zsu * zu2_ms(jk) * sn(ji, jj-1,jk)
-            END DO
-         END DO
-      END DO
-
-      ! Gibraltar outflow, north point deeper
-      jk =  22
-      DO jj = mj0(102), mj1(102) 
-         DO ji = mi0(139), mi1(139) 
-            zvt = e1t(ji, jj) * e2t(ji, jj) * fse3t(ji, jj,jk)
-            zsu = e2u(ji, jj) * fse3u(ji, jj,jk)
-            ta(ji, jj,jk) = ta(ji, jj,jk) - ( 1. / zvt ) * zsu * zu2_ms(jk) * zt
-            sa(ji, jj,jk) = sa(ji, jj,jk) - ( 1. / zvt ) * zsu * zu2_ms(jk) * zs
-         END DO
-      END DO
-
-
-      ! New Temperature and Salinity at East Gibraltar 
-      ! ----------------------------------------------
-
-      ! surface	
-      DO jk = 1, 14
-         DO jj = mj0(102), mj1(102) 
-            DO ji = mi0(141), mi1(141) 
-               zvt = e1t(ji, jj) * e2t(ji, jj) * fse3t(ji, jj,jk)
-               zsu = e2u(ji-1, jj) * fse3u(ji-1, jj,jk)
-               ta(ji, jj,jk) = ta(ji, jj,jk) + ( 1. / zvt ) * zsu * zu3_ms(jk) * tn(ji-2, jj-1,jk)
-               sa(ji, jj,jk) = sa(ji, jj,jk) + ( 1. / zvt ) * zsu * zu3_ms(jk) * sn(ji-2, jj-1,jk)
-            END DO
-         END DO
-      END DO
-      ! deeper
-      jk =  21
-      DO jj = mj0(102), mj1(102) 
-         DO ji = mi0(141), mi1(141) 
-            zvt = e1t(ji, jj) * e2t(ji, jj) * fse3t(ji, jj,jk)
-            zsu = e2u(ji-1, jj) * fse3u(ji-1, jj,jk)
-            ta(ji, jj,jk) = ta(ji, jj,jk) + ( 1. / zvt ) * zsu * zu3_ms(jk) * tn(ji, jj,jk)
-            sa(ji, jj,jk) = sa(ji, jj,jk) + ( 1. / zvt ) * zsu * zu3_ms(jk) * sn(ji, jj,jk)
-         END DO
-      END DO
-
-   END SUBROUTINE tra_gibraltar
-
-
-   SUBROUTINE tra_hormuz
-      !!---------------------------------------------------------------------
-      !!               ***  ROUTINE tra_hormuz  ***
-      !!
-      !! ** Purpose :   Update the horizontal advective trend of tracers
-      !!        correction in Hormuz.
-      !!
-      !! ** Method :   We impose transport at Hormuz .
-      !!                                
-      !! ** history :
-      !!           !  02-11  (A. Bozec) Original code 
-      !!      8.5  !  02-11  (A. Bozec) F90: Free form and module
-      !!---------------------------------------------------------------------
-      !! * Local declarations
-      INTEGER ::  ji, jj, jk              ! dummy loop indices
-      REAL(wp) :: zsu, zvt
-      !!---------------------------------------------------------------------
-      
-      ! New trend at Hormuz strait
-      ! --------------------------
-      DO jk = 1, 8   
-         DO jj = mj0(94), mj1(94) 
-            DO ji = mi0(172), mi1(172) 
-               zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
-               zsu = e2u(ji-1,jj) * fse3u(ji-1,jj,jk)
-               ta(ji,jj,jk) = ta(ji,jj,jk) + ( 1. / zvt ) * zsu * zu_pg(jk) * tn(ji,jj,jk) 
-               sa(ji,jj,jk) = sa(ji,jj,jk) + ( 1. / zvt ) * zsu * zu_pg(jk) * sn(ji,jj,jk) 
-            END DO
-         END DO
-      END DO
-      DO jk = 16, 18
-         DO jj = mj0(94), mj1(94) 
-            DO ji = mi0(172), mi1(172) 
-               zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
-               zsu = e2u(ji-1,jj) * fse3u(ji-1,jj,jk)
-               ta(ji,jj,jk) = ta(ji,jj,jk) + ( 1. / zvt ) * zsu * zu_pg(jk) * zthor(jk)
-               sa(ji,jj,jk) = sa(ji,jj,jk) + ( 1. / zvt ) * zsu * zu_pg(jk) * zshor(jk)
-            END DO
-         END DO
-      END DO
-
-   END SUBROUTINE tra_hormuz
-
-
-   SUBROUTINE tra_cla_init
-      !!---------------------------------------------------------------------
-      !!               ***  ROUTINE tra_cla_init  ***
-      !!
-      !! ** Purpose :   Initialization of variables
-      !!
-      !! ** history :
-      !!      9.0  !  02-11  (A. Bozec) Original code
-      !!---------------------------------------------------------------------
-      !! * Local declarations
-      INTEGER ::  ji, jj, jk              ! dummy loop indices
-      !!---------------------------------------------------------------------
-
-      ! Control print
-      ! -------------
-
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'tra_cla_init : cross land advection on tracer '
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
-
-      ! Initialization at Bab el Mandeb
-      ! -------------------------------
-
-      ! imposed transport
-      zisw_rs = 0.4e6        ! inflow surface water
-      zurw_rs = 0.2e6        ! upper recirculation water
-!!Alex      zbrw_rs = 1.2e6        ! bottom  recirculation water
-      zbrw_rs = 0.5e6        ! bottom  recirculation water
-
-      ! initialization of the velocity at Bab el Mandeb
-      zu1_rs_i(:) = 0.e0      ! velocity profile at 161,88 South point
-      zu2_rs_i(:) = 0.e0      ! velocity profile at 161,87 North point
-      zu3_rs_i(:) = 0.e0      ! velocity profile at 160,88 East  point
-
-      ! velocity profile at 161,88 East Bab el Mandeb North point 
-      ! we imposed zisw_rs + EMP above the Red Sea 
-      DO jk = 1, 8                                      
-         DO jj = mj0(88), mj1(88) 
-            DO ji = mi0(160), mi1(160) 
-               zu1_rs_i(jk) = -( zisw_rs / 8. ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )     
-            END DO
-         END DO
-      END DO
-
-      ! recirculation water 
-      DO jj = mj0(88), mj1(88) 
-         DO ji = mi0(160), mi1(160) 
-            zu1_rs_i(20) = -(           zurw_rs ) / ( e2u(ji,jj) * fse3u(ji,jj,20) )
-            zu1_rs_i(21) = -( zbrw_rs - zurw_rs ) / ( e2u(ji,jj) * fse3u(ji,jj,21) )
-         END DO
-      END DO
-      
-      ! velocity profile at 161,87 East Bab el Mandeb South point
-      DO jj = mj0(87), mj1(87) 
-         DO ji = mi0(160), mi1(160) 
-            zu2_rs_i(21) =  ( zbrw_rs + zisw_rs ) / ( e2u(ji,jj) * fse3u(ji,jj,21) )
-         END DO
-      END DO
-
-      ! velocity profile at 161, 88 West Bab el Mandeb 
-      ! we imposed zisw_rs + EMP above the Red Sea 
-      DO jk = 1,  10                                     
-         DO jj = mj0(88), mj1(88) 
-            DO ji = mi0(160), mi1(160) 
-               zu3_rs_i(jk) =  ( zisw_rs / 10. ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )
-            END DO
-         END DO
-      END DO
-
-      ! deeper
-      DO jj = mj0(88), mj1(88) 
-         DO ji = mi0(160), mi1(160) 
-            zu3_rs_i(16)  = - zisw_rs /( e1v(ji,jj) * fse3v(ji,jj,16) )
-         END DO
-      END DO
-
-
-      ! Initialization at Gibraltar
-      ! ---------------------------
-
-      ! imposed transport
-      zisw_ms = 0.8e6         ! atlantic-mediterranean  water
-      zmrw_ms = 0.7e6         ! middle recirculation water
-      zurw_ms = 2.5e6         ! upper  recirculation water 
-      zbrw_ms = 3.5e6         ! bottom recirculation water 
-
-      ! initialization of the velocity
-      zu1_ms_i(:) = 0.e0       ! velocity profile at 139,101 South point
-      zu2_ms_i(:) = 0.e0       ! velocity profile at 139,102 North point
-      zu3_ms_i(:) = 0.e0       ! velocity profile at 141,102 East  point
-
-      ! velocity profile at 139,101  South point
-      DO jk = 1, 14                      
-         DO jj = mj0(102), mj1(102) 
-            DO ji = mi0(140), mi1(140) 
-               zu1_ms_i(jk) = ( zisw_ms / 14. ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,jk)) 
-            END DO
-         END DO
-      END DO
-
-      ! middle recirculation ( uncounting in the balance )
-      DO jk = 15, 20                      
-         DO jj = mj0(102), mj1(102) 
-            DO ji = mi0(140), mi1(140) 
-               zu1_ms_i(jk) = ( zmrw_ms / 6. ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,jk) ) 
-            END DO
-         END DO
-      END DO
-
-      DO jj = mj0(102), mj1(102) 
-         DO ji = mi0(140), mi1(140) 
-            zu1_ms_i(21) =  (           zurw_ms ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,21) )
-            zu1_ms_i(22) =  ( zbrw_ms - zurw_ms ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,22) )
-         END DO
-      END DO
-
-      ! velocity profile at 139,102  North point
-      ! middle recirculation ( uncounting in the balance )
-      DO jk = 15, 20                      
-         DO jj = mj0(102), mj1(102) 
-            DO ji = mi0(140), mi1(140) 
-               zu2_ms_i(jk) = -( zmrw_ms / 6. ) / ( e2u(ji-1, jj) * fse3u(ji-1, jj,jk) ) 
-            END DO
-         END DO
-      END DO 
-
-      DO jj = mj0(102), mj1(102) 
-         DO ji = mi0(140), mi1(140) 
-            zu2_ms_i(22) = -( zisw_ms + zbrw_ms ) / ( e2u(ji-1, jj) * fse3u(ji-1, jj,22) )
-         END DO
-      END DO 
-
-      ! profile at East Gibraltar   
-      ! velocity profile at 141,102 
-      DO  jk = 1, 14                     
-         DO jj = mj0(102), mj1(102) 
-            DO ji = mi0(140), mi1(140) 
-               zu3_ms_i(jk) =  ( zisw_ms / 14. ) / ( e2u(ji, jj) * fse3u(ji, jj,jk) ) 
-            END DO
-         END DO
-      END DO
-
-      ! deeper 
-      DO jj = mj0(102), mj1(102) 
-         DO ji = mi0(140), mi1(140) 
-            zu3_ms_i(21) = -zisw_ms / ( e2u(ji, jj) * fse3u(ji, jj,21) )
-         END DO
-      END DO
-
-
-      ! Initialization at Hormuz
-      ! ------------------------
-
-      ! imposed transport
-      zisw_pg = 4. * 0.25e6      ! surface and bottom  water
-
-      ! initialization of the velocity
-      zu_pg(:) = 0.e0       ! velocity profile at 139,101 South point
-
-      ! Velocity profile 
-      DO jk = 1, 8 
-         DO jj = mj0(94), mj1(94) 
-            DO ji = mi0(172), mi1(172) 
-               zu_pg(jk) = -( zisw_pg / 8. ) /  ( e2u(ji-1,jj) * fse3u(ji-1,jj,jk) )
-            END DO
-         END DO
-      END DO
-     DO jk = 16, 18
-         DO jj = mj0(94), mj1(94) 
-            DO ji = mi0(172), mi1(172) 
-               zu_pg(jk) =  ( zisw_pg / 3. )  / ( e2u(ji-1,jj) * fse3u(ji-1,jj,jk) )
-            END DO
-         END DO
-      END DO
-
-      ! Temperature and Salinity at Hormuz
-      zthor(:) = 0.e0
-      zshor(:) = 0.e0
-
-      zthor(16) = 18.4
-      zshor(16) = 36.27
-      !
-      zthor(17) = 17.8
-      zshor(17) = 36.4
-      !
-      zthor(18) = 16.
-      zshor(18) = 36.27
- 
-   END SUBROUTINE tra_cla_init
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option                              NO cross land advection
-   !!----------------------------------------------------------------------
-   USE in_out_manager  ! I/O manager
-CONTAINS
-   SUBROUTINE tra_cla( kt ) 
-      INTEGER, INTENT(in) ::   kt    ! ocean time-step indice
-      IF( kt == nit000 .AND. lwp ) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'tra_cla : No use of cross land advection'
-         WRITE(numout,*) '~~~~~~~'
-      ENDIF
-   END SUBROUTINE tra_cla
-#endif
-
-   !!======================================================================
-END MODULE cla
Index: trunk/NEMOGCM/NEMO/OPA_SRC/cla_div.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/cla_div.F90	(revision 2527)
+++ 	(revision )
@@ -1,541 +1,0 @@
-MODULE cla_div
-   !!==============================================================================
-   !!                    ***  MODULE  cla_div  ***
-   !! Ocean diagnostic variable : specific update of the horizontal divergence
-   !!                             CAUTION: Specific to ORCA_R2
-   !!==============================================================================
-#if defined key_orca_r2
-   !!----------------------------------------------------------------------
-   !!   'key_orca_r2'                                 global ocean model R2
-   !!----------------------------------------------------------------------
-   !!   div_cla      : 
-   !!   div_bab_el_mandeb
-   !!   div_gibraltar
-   !!   div_hormuz
-   !!   div_cla_init :
-   !!----------------------------------------------------------------------
-   !! * Modules used
-   USE oce             ! ocean dynamics and tracers
-   USE dom_oce         ! ocean space and time domain
-   USE sbc_oce         ! surface boundary condition: ocean
-   USE in_out_manager  ! I/O manager
-   USE lib_mpp         ! distributed memory computing library
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-
-   IMPLICIT NONE
-   PRIVATE
-
-   !! * Module variables
-   REAL(wp) :: zempmed, zempred       ! EMP of Mediterranean and Red Sea 
-
-   REAL(wp) :: zisw_rs, zbrw_rs, zurw_rs          ! imposed transport at Red Sea
-   REAL(wp) :: zisw_ms, zbrw_ms, zurw_ms, zmrw_ms ! imposed transport at Mediterranean Sea
-   REAL(wp) :: zisw_pg, zbrw_pg                   ! imposed transport at Persic Gulf
-
-   REAL(wp), DIMENSION (jpk) ::   &
-      zu1_rs_i, zu2_rs_i, zu3_rs_i,                   & ! Red Sea velocities
-      zu1_ms_i, zu2_ms_i, zu3_ms_i,                   & ! Mediterranean Sea velocities
-      zu_pg                                             ! Persic Gulf velocities
-   
-   !! * Routine accessibility
-   PUBLIC div_cla     ! routine called by step.F90
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-   !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE div_cla ( kt )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE div_cla  ***
-      !!
-      !! ** Purpose :   update the horizontal divergence of the velocity field
-      !!      for at some straits ( Gibraltar, Bab el Mandeb and Hormuz ).
-      !!
-      !! ** Method  :   With imposed transport at each strait, we compute 
-      !!      corresponding velocities and update horizontal divergence.
-      !!        Apply lateral boundary conditions on hdivn through a call
-      !!      to routine lbc_lnk.
-      !!
-      !! ** Action  :   update hdivn array : the now horizontal divergence
-      !!
-      !! History :
-      !!   8.5  !  02-11 (A. Bozec)  Free form, F90
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
-      !!----------------------------------------------------------------------
-
-      ! Correction of the Divergence at some straits
-            
-      IF( kt == nit000 )     CALL div_cla_init    ! Initialization
-
-      CALL div_bab_el_mandeb                        ! New divergence at Bab el Mandeb 
-
-      CALL div_gibraltar                            ! New divergence at Gibraltar
-
-      CALL div_hormuz                               ! Hormuz Strait ( persian Gulf)
-
-      ! Lateral boundary conditions on hdivn
-      CALL lbc_lnk( hdivn, 'T', 1. )
-
-   END SUBROUTINE div_cla
-
-   SUBROUTINE div_bab_el_mandeb
-      !!----------------------------------------------------------------------
-      !!                ***  ROUTINE div_bab_el_mandeb  ***
-      !!       
-      !! ** Purpose :   Update  the now horizontal divergence of the velocity 
-      !!     field in Bab el Mandeb ( Red Sea strait ).
-      !!
-      !! ** Method  :   Set the velocity field at each side of the strait :
-      !!                                          |
-      !!            |/ \|            N          |\ /|
-      !!            |_|_|______      |          |___|______
-      !!        88  |   |<-       W - - E    88 |   |<-
-      !!        87  |___|______      |       87 |___|->____
-      !!             160 161         S           160 161 
-      !!       horizontal view                horizontal view
-      !!          surface                        depth
-      !!      The now divergence is given by :
-      !!         hdivn = 1/(e1t*e2t) [ di(e2u  un) + dj(e1v  vn) ]
-      !!
-      !! ** History :
-      !!           !         (A. Bozec) Original code 
-      !!      8.5  !  02-11  (A. Bozec) F90: Free form and module
-      !!----------------------------------------------------------------------
-      !! * Local declarations
-      INTEGER  :: ji, jj, jk   ! dummy loop indices
-      REAL(wp) :: zsu, zvt, zwei   ! temporary scalar
-      REAL(wp), DIMENSION (jpk) ::  zu1_rs, zu2_rs, zu3_rs
-      !!---------------------------------------------------------------------
-      
-      ! EMP on the Red Sea 
-      ! ------------------
-
-      zempred = 0.e0
-      zwei = 0.e0
-      DO jj = mj0(87), mj1(96)
-         DO ji = mi0(148), mi1(160) 
-            zwei    = tmask(ji,jj,1) * e1t(ji,jj) * e2t(ji,jj)
-            zempred = zempred + emp(ji,jj) * zwei
-         END DO
-      END DO
-      IF( lk_mpp )   CALL mpp_sum( zempred )      ! sum with other processors value
-
-
-      ! convert in m3
-      zempred = zempred * 1.e-3         
-
-      ! Velocity profile at each point
-      ! ------------------------------
-
-      zu1_rs(:) = zu1_rs_i(:)
-      zu2_rs(:) = zu2_rs_i(:)
-      zu3_rs(:) = zu3_rs_i(:)
-
-      ! velocity profile at 161,88 North point 
-      ! we imposed zisw_rs + EMP above the Red Sea 
-      DO jk = 1,  8                                      
-         DO jj = mj0(88), mj1(88) 
-            DO ji = mi0(160), mi1(160) 
-               zu1_rs(jk) = zu1_rs(jk) - ( zempred / 8. ) / ( e2u(ji, jj) * fse3u(ji, jj,jk) )
-            END DO
-         END DO
-      END DO
-
-      ! velocity profile at 160,88 North  point
-      ! we imposed zisw_rs + EMP above the Red Sea 
-      DO jk = 1,  10                                     
-         DO jj = mj0(88), mj1(88) 
-            DO ji = mi0(160), mi1(160) 
-               zu3_rs(jk) = zu3_rs(jk) + ( zempred / 10. ) / ( e1v(ji, jj) * fse3v(ji, jj,jk) )
-            END DO
-         END DO
-      END DO
-       
-      ! Divergence at each point of the straits
-      ! ---------------------------------------
-
-      ! compute the new divergence at 161,88 
-      DO jk = 1, 21
-         DO jj = mj0(88), mj1(88) 
-            DO ji = mi0(161), mi1(161) 
-               zvt = e1t(ji, jj) * e2t(ji, jj) * fse3t(ji, jj,jk)
-               zsu = e2u(ji-1, jj) * fse3u(ji-1, jj,jk)
-               hdivn(ji, jj  ,jk) = hdivn(ji, jj  ,jk) - ( 1. / zvt ) * zsu * zu1_rs(jk)
-            END DO
-         END DO
-      END DO
-
-      ! compute the new divergence at 161,87 
-      DO jk = 1, 21
-         DO jj = mj0(87), mj1(87) 
-            DO ji = mi0(161), mi1(161) 
-               zvt = e1t(ji, jj) * e2t(ji, jj) * fse3t(ji, jj,jk)
-               zsu = e2u(ji-1, jj) * fse3u(ji-1, jj,jk)
-               hdivn(ji, jj,jk) = hdivn(ji, jj,jk) - ( 1. / zvt ) * zsu * zu2_rs(jk)
-            END DO
-         END DO
-      END DO
-
-      ! compute the divergence at 160,89 
-      DO jk = 1, 18
-         DO jj = mj0(89), mj1(89) 
-            DO ji = mi0(160), mi1(160) 
-               zvt = e1t(ji, jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
-               zsu = e1v(ji, jj-1) * fse3v(ji, jj-1,jk)
-               hdivn(ji, jj,jk) = hdivn(ji, jj,jk) - ( 1. / zvt ) * zsu * zu3_rs(jk)
-            END DO
-         END DO
-      END DO
-
-   END SUBROUTINE div_bab_el_mandeb
-
-   SUBROUTINE div_gibraltar
-      !! -------------------------------------------------------------------
-      !!                 ***  ROUTINE div_gibraltar  ***
-      !!        
-      !! ** Purpose :   update the now horizontal divergence of the velocity 
-      !!     field in Gibraltar.
-      !!
-      !! ** Method :
-      !!          ________________      N        ________________
-      !! 102           |    |->         |           <-|    |<-
-      !! 101      ___->|____|_____   W - - E     ___->|____|_____
-      !!           139   140  141       |         139   140  141
-      !!          horizontal view       S        horizontal view
-      !!            surface                          depth
-      !!      The now divergence is given by :
-      !!         hdivn = 1/(e1t*e2t) [ di(e2u  un) + dj(e1v  vn) ]
-      !!
-      !! ** History :
-      !!           !         (A. Bozec) Original code 
-      !!      8.5  !  02-10  (A. Bozec) F90: Free form and module
-      !!---------------------------------------------------------------------
-      !! * Local declarations
-      INTEGER  :: ji, jj, jk   ! dummy loop indices
-      REAL(wp) :: zsu, zvt
-      REAL(wp) :: zwei
-      REAL(wp), DIMENSION (jpk) ::  zu1_ms, zu2_ms, zu3_ms
-      !!---------------------------------------------------------------------
-      
-      ! EMP on the Mediterranean Sea 
-      ! ----------------------------
-
-      zempmed = 0.e0
-      zwei = 0.e0
-      DO jj = mj0(96), mj1(110)
-         DO ji = mi0(141),mi1(181)
-            zwei    = tmask(ji,jj,1) * e1t(ji,jj) * e2t(ji,jj)
-            zempmed = zempmed + emp(ji,jj) * zwei
-         END DO
-      END DO
-      IF( lk_mpp )   CALL mpp_sum( zempmed )      ! sum with other processors value
-
-      ! minus 2 points in Red Sea and 3 in Atlantic 
-      DO jj = mj0(96), mj1(96)
-         DO ji = mi0(148),mi1(148)
-            zempmed = zempmed -  emp(ji  , jj) * tmask(ji  , jj,1) * e1t(ji  , jj) * e2t(ji  , jj)   &
-                              -  emp(ji+1, jj) * tmask(ji+1, jj,1) * e1t(ji+1, jj) * e2t(ji+1, jj)   
-         END DO
-      END DO
-
-      ! convert in m3
-      zempmed = zempmed * 1.e-3
-
-      ! Velocity profile at each point
-      ! ------------------------------
-
-      zu1_ms(:) = zu1_ms_i(:)
-      zu2_ms(:) = zu2_ms_i(:)
-      zu3_ms(:) = zu3_ms_i(:)
-
-      ! velocity profile at 139,101 South point 
-      ! we imposed zisw + EMP above the Mediterranean Sea 
-      DO jk = 1, 14                      
-         DO jj = mj0(102), mj1(102) 
-            DO ji = mi0(140), mi1(140) 
-               zu1_ms(jk) =  zu1_ms(jk) + ( zempmed / 14. ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,jk) ) 
-            END DO
-         END DO
-      END DO
-      
-      ! velocity profile at 141,102  East point
-      ! flux in surface inflow of the Atlantic ocean + EMP   
-      DO  jk = 1, 14                     
-         DO jj = mj0(102), mj1(102) 
-            DO ji = mi0(140), mi1(140) 
-               zu3_ms(jk) = zu3_ms(jk) +  ( zempmed / 14. ) / ( e2u(ji, jj) * fse3u(ji, jj,jk) ) 
-            END DO
-         END DO
-      END DO
-     
-      ! Divergence at each point of the straits
-      ! ---------------------------------------
-
-      ! compute the new divergence at 139,101 South point  
-      DO jk = 1, jpk
-         DO jj = mj0(101), mj1(101) 
-            DO ji = mi0(139), mi1(139) 
-               zvt = e1t(ji, jj) * e2t(ji, jj) * fse3t(ji, jj,jk)
-               zsu = e2u(ji, jj) * fse3u(ji, jj,jk)
-               hdivn(ji, jj,jk) = hdivn(ji, jj,jk) + ( 1. / zvt ) * zsu * zu1_ms(jk) 
-            END DO
-         END DO
-      END DO
-
-      ! compute the new divergence at 139,102 deep North point
-      DO jk = 1, jpk
-         DO jj = mj0(102), mj1(102) 
-            DO ji = mi0(139), mi1(139) 
-               zvt = e1t(ji, jj) * e2t(ji, jj) * fse3t(ji, jj,jk)
-               zsu = e2u(ji, jj) * fse3u(ji, jj,jk)
-               hdivn(ji, jj,jk) = hdivn(ji, jj,jk) + ( 1. / zvt ) * zsu * zu2_ms(jk) 
-            END DO
-         END DO
-      END DO
-
-      ! compute the divergence at 141,102 East point
-      DO jk = 1, jpk
-         DO jj = mj0(102), mj1(102) 
-            DO ji = mi0(141), mi1(141) 
-               zvt = e1t(ji, jj) * e2t(ji, jj) * fse3t(ji, jj,jk)
-               zsu = e2u(ji-1, jj) * fse3u(ji-1, jj,jk)
-               hdivn(ji, jj,jk) = hdivn(ji, jj,jk) - ( 1. / zvt ) * zsu * zu3_ms(jk)
-            END DO
-         END DO
-      END DO
-
-   END SUBROUTINE div_gibraltar
-
-   SUBROUTINE div_hormuz
-      !! -------------------------------------------------------------------
-      !!                   ***  ROUTINE div_hormuz  ***
-      !!              
-      !! ** Purpose :   update the now horizontal divergence of the velocity 
-      !!     field in Hormuz ( Persic Gulf strait ) .
-      !!
-      !! ** Method :
-      !!      The now divergence is given by :
-      !!         hdivn = 1/(e1t*e2t) [ di(e2u  un) + dj(e1v  vn) ]
-      !!
-      !! ** History :
-      !!           !         (A. Bozec) Original code 
-      !!      8.5  !  02-10  (A. Bozec) F90: Free form and module
-      !!---------------------------------------------------------------------
-      !! * Local declarations
-      INTEGER  :: ji, jj, jk   ! dummy loop indices
-      REAL(wp) :: zsu, zvt     ! temporary scalars
-      !!---------------------------------------------------------------------
-
-      ! New divergence at Hormuz 
-      ! ------------------------
-      DO jk = 1, jpk
-         DO jj = mj0(94), mj1(94) 
-            DO ji = mi0(172), mi1(172) 
-               zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
-               zsu = e2u(ji-1,jj) * fse3u(ji-1,jj,jk)
-               hdivn(ji,jj,jk) = hdivn(ji,jj,jk) - ( 1. / zvt ) * zsu * zu_pg(jk)
-            END DO
-         END DO
-      END DO
-
-   END SUBROUTINE div_hormuz
-
-
-   SUBROUTINE div_cla_init
-      !! -------------------------------------------------------------------
-      !!                   ***  ROUTINE div_cla_init  ***
-      !!           
-      !! ** Purpose :   Initialization of variables at all straits  
-      !!
-      !! ** History :
-      !!           !         (A. Bozec) Original code 
-      !!      8.5  !  02-10  (A. Bozec) F90: Free form and module
-      !!---------------------------------------------------------------------
-      !! * Local declarations
-      INTEGER  :: ji, jj, jk   ! dummy loop indices
-      !!---------------------------------------------------------------------
-
-      ! Control print
-      ! -------------
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'divmod_cross_land : cross land advection on divergence '
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~'
-      IF(lwp) WRITE(numout,*) ' '
-
-      ! Initialization at Bab el Mandeb
-      ! -------------------------------
-
-      ! imposed transport
-      zisw_rs = 0.4e6             ! inflow surface water
-      zurw_rs = 0.2e6             ! upper recirculation water
-!Alex      zbrw = 1.2e6        ! bottom  recirculation water
-      zbrw_rs = 0.5e6             ! bottom  recirculation water
-
-      ! initialization of the velocity
-      zu1_rs_i(:) = 0.e0          ! velocity profile at 161,88 South point
-      zu2_rs_i(:) = 0.e0          ! velocity profile at 161,87 North point
-      zu3_rs_i(:) = 0.e0          ! velocity profile at 160,88 East  point
-
-      ! velocity profile at 161,88 North point 
-      ! we imposed zisw_rs + EMP above the Red Sea 
-      DO jk = 1,  8                                      
-         DO jj = mj0(88), mj1(88) 
-            DO ji = mi0(160), mi1(160) 
-               zu1_rs_i(jk) = -( zisw_rs / 8. ) / ( e2u(ji, jj) * fse3u(ji, jj,jk) )
-            END DO
-         END DO
-      END DO
-
-      ! recirculation water 
-      DO jj = mj0(88), mj1(88) 
-         DO ji = mi0(160), mi1(160) 
-            zu1_rs_i(20) =            - zurw_rs   / ( e2u(ji, jj) * fse3u(ji, jj,20) )
-            zu1_rs_i(21) = -( zbrw_rs - zurw_rs ) / ( e2u(ji, jj) * fse3u(ji, jj,21) )
-         END DO
-      END DO
-      
-      ! velocity profile at 161,87 South point
-      DO jj = mj0(88), mj1(88) 
-         DO ji = mi0(160), mi1(160) 
-            zu2_rs_i(21) =  ( zbrw_rs + zisw_rs ) / ( e2u(ji, jj-1 ) * fse3u(ji, jj-1,21) )
-         END DO
-      END DO
-
-      ! velocity profile at 160,88 North  point
-      ! we imposed zisw_rs + EMP above the Red Sea 
-      DO jk = 1,  10                                     
-         DO jj = mj0(88), mj1(88) 
-            DO ji = mi0(160), mi1(160) 
-               zu3_rs_i(jk) = ( zisw_rs / 10. ) / ( e1v(ji, jj) * fse3v(ji, jj,jk) )
-            END DO
-         END DO
-      END DO
-
-      ! deeper
-      DO jj = mj0(88), mj1(88) 
-         DO ji = mi0(160), mi1(160) 
-            zu3_rs_i(16)  = - zisw_rs / ( e1v(ji, jj) * fse3v(ji, jj,16) )
-         END DO
-      END DO
-      
-
-      ! Initialization at Gibraltar
-      ! ---------------------------
-
-      ! imposed transport
-      zisw_ms = 0.8e6             ! inflow surface  water
-      zmrw_ms = 0.7e6             ! middle recirculation water
-      zurw_ms = 2.5e6             ! upper  recirculation water
-      zbrw_ms = 3.5e6             ! bottom recirculation water
-
-      ! initialization of the velocity
-      zu1_ms_i(:) = 0.e0          ! velocity profile at 139,101 South point
-      zu2_ms_i(:) = 0.e0          ! velocity profile at 139,102 North point
-      zu3_ms_i(:) = 0.e0          ! velocity profile at 141,102 East  point
-
-      ! velocity profile at 139,101 South point 
-      DO jk = 1, 14                      
-         DO jj = mj0(102), mj1(102) 
-            DO ji = mi0(140), mi1(140) 
-               zu1_ms_i(jk) =  ( zisw_ms / 14. ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,jk) ) 
-            END DO
-         END DO
-      END DO
-
-      ! recirculation water 
-      DO jk = 15, 20                      
-         DO jj = mj0(102), mj1(102) 
-            DO ji = mi0(140), mi1(140) 
-               zu1_ms_i(jk) =  ( zmrw_ms / 6. ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,jk) ) 
-            END DO
-         END DO
-      END DO
-
-      DO jj = mj0(102), mj1(102) 
-         DO ji = mi0(140), mi1(140) 
-            zu1_ms_i(21) =  (           zurw_ms ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,21) )
-            zu1_ms_i(22) =  ( zbrw_ms - zurw_ms ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,22) )
-         END DO
-      END DO
-      
-      ! velocity profile at 139,102 North point
-      DO jk = 15, 20                      
-         DO jj = mj0(102), mj1(102) 
-            DO ji = mi0(140), mi1(140) 
-               zu2_ms_i(jk) = -( zmrw_ms / 6. ) / ( e2u(ji-1, jj) * fse3u(ji-1, jj,jk) ) 
-            END DO
-         END DO
-      END DO
-
-      ! outflow of Mediterranean sea + recirculation
-      DO jj = mj0(102), mj1(102) 
-         DO ji = mi0(140), mi1(140) 
-            zu2_ms_i(22) = -( zisw_ms + zbrw_ms ) / ( e2u(ji-1, jj) * fse3u(ji-1, jj,22) )
-         END DO
-      END DO
-      
-      ! velocity profile at 141,102  East point
-      ! flux in surface inflow of the Atlantic ocean    
-      DO  jk = 1, 14                     
-         DO jj = mj0(102), mj1(102) 
-            DO ji = mi0(140), mi1(140) 
-               zu3_ms_i(jk) =  ( zisw_ms / 14. ) / ( e2u(ji, jj) * fse3u(ji, jj,jk) ) 
-            END DO
-         END DO
-      END DO
-
-      ! deeper 
-      DO jj = mj0(102), mj1(102) 
-         DO ji = mi0(140), mi1(140) 
-            zu3_ms_i(21) = - zisw_ms / ( e2u(ji, jj) * fse3u(ji, jj,21) )
-         END DO
-      END DO
-
-      ! Initialization at Hormuz
-      ! ------------------------
-
-      ! imposed transport
-      zisw_pg = 4. * 0.25e6       ! inflow surface  water
-      zbrw_pg = 4. * 0.25e6       ! bottom recirculation water
-
-      ! initialization of the velocity
-      zu_pg(:) = 0.e0           ! velocity profile at 172,94 
-
-      ! velocity profile 
-      DO jk = 1, 8 
-         DO jj = mj0(94), mj1(94) 
-            DO ji = mi0(172), mi1(172) 
-               zu_pg(jk) = -( zisw_pg / 8. ) / ( e2u(ji-1,jj) * fse3u(ji-1,jj, jk) )
-            END DO
-         END DO
-      END DO
-
-      DO jk = 16, 18
-         DO jj = mj0(94), mj1(94) 
-            DO ji = mi0(172), mi1(172) 
-               zu_pg(jk) =  ( zbrw_pg / 3. ) / ( e2u(ji-1,jj) * fse3u(ji-1,jj, jk) )
-            END DO
-         END DO
-      END DO
-
-   END SUBROUTINE div_cla_init
-#else
-   !!----------------------------------------------------------------------
-   !!   Default key                                            Dummy module
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE div_cla( kt )
-      WRITE(*,*) 'div_cla: You should have not see this print! error?', kt
-   END SUBROUTINE div_cla
-#endif
-   
-   !!======================================================================
-END MODULE cla_div
Index: trunk/NEMOGCM/NEMO/OPA_SRC/cla_dynspg.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/cla_dynspg.F90	(revision 2527)
+++ 	(revision )
@@ -1,241 +1,0 @@
-MODULE cla_dynspg
-   !!======================================================================
-   !!                       ***  cla_dynspg  ***
-   !!======================================================================
-   !!   dyn_spg      : update the momentum trend with the surface pressure
-   !!                  gradient in the free surface constant volume case
-   !!                  with vector optimization
-   !!----------------------------------------------------------------------
-   !! * Modules used
-   USE oce             ! ocean dynamics and tracers 
-   USE dom_oce         ! ocean space and time domain 
-   USE zdf_oce         ! ocean vertical physics
-   USE obc_oce         ! Lateral open boundary condition
-   USE sol_oce         ! solver variables
-   USE sbc_oce         ! surface boundary condition: ocean
-   USE phycst          ! physical constants
-   USE solpcg          ! preconditionned conjugate gradient solver
-   USE solsor          ! Successive Over-relaxation solver
-   USE obcdyn          ! ocean open boundary condition (obc_dyn routines)
-   USE obcvol          ! ocean open boundary condition (obc_vol routines)
-   USE in_out_manager  ! I/O manager
-   USE lib_mpp         ! distribued memory computing
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-
-   IMPLICIT NONE
-   PRIVATE
-
-   !! * Accessibility
-   PUBLIC dyn_spg_cla   ! routine called by step.F90
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE dyn_spg_cla( kt ) 
-      !!----------------------------------------------------------------------
-      !!              ***  routine dyn_spg_cross_land  ***
-      !!
-      !! ** Purpose :
-      !!
-      !! ** Method :
-      !!
-      !! ** Action :
-      !!
-      !! History :
-      !!        !         (A. Bozec)  Original code
-      !!   8.5  !  02-11  (A. Bozec)  F90: Free form and module
-      !!---------------------------------------------------------------------
-      !! * Arguments
-      INTEGER, INTENT( in ) ::   kt           ! ocean time-step
-      !! * Local declarations
-      INTEGER  ::   ji, jj, jk                ! dummy loop indices
-      INTEGER  ::   ii0, ii1, ij0, ij1        ! temporary integer
-      REAL(wp) ::    &    
-         zempmed, zempred,   &                ! EMP on Med Sea ans Red Sea
-         zwei,   &                            !              
-         zisw_rs, zurw_rs, zbrw_rs,      &    ! imposed transport Red sea
-         zisw_ms, zurw_ms, zbrw_ms, zmrw_ms   ! imposed transport Med Sea
-      !!----------------------------------------------------------------------
-
-      ! Different velocities for straits ( Gibraltar, Bab el Mandeb...)
-         
-      ! Control print
-      ! -------------
-      IF( kt == nit000 ) THEN 
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'dynspg_cross_land : cross land advection on surface '
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~   pressure '
-         IF(lwp) WRITE(numout,*) ' '
-      ENDIF
-
-      ! EMP on Mediterranean Sea and Red Sea 
-      ! ------------------------------------
-      ! compute the emp in Mediterranean Sea
-      zempmed = 0.e0
-      zwei = 0.e0
-      ij0 =  96   ;   ij1 = 110
-      ii0 = 141   ;   ii1 = 181
-      DO jj = mj0(ij0), mj1(ij1)
-         DO ji = mi0(ii0),mi1(ii1)
-            zwei    = tmask(ji,jj,1) * e1t(ji,jj) * e2t(ji,jj)
-            zempmed = zempmed + emp(ji,jj) * zwei
-         END DO
-      END DO
-      IF( lk_mpp )   CALL mpp_sum( zempmed )      ! sum with other processors value
-
-      ! minus 2 points in Red Sea and 3 in Atlantic 
-      ij0 =  96   ;   ij1 =  96
-      ii0 = 148   ;   ii1 = 148
-      DO jj = mj0(ij0), mj1(ij1)
-         DO ji = mi0(ii0),mi1(ii1)
-            zempmed = zempmed - emp(ji  ,jj) * tmask(ji  ,jj,1) * e1t(ji  ,jj) * e2t(ji  ,jj)   &
-               &              - emp(ji+1,jj) * tmask(ji+1,jj,1) * e1t(ji+1,jj) * e2t(ji+1,jj)   
-         END DO
-      END DO
-      ! we convert in m3
-      zempmed = zempmed * 1.e-3
-
-      ! compute the emp in Red Sea   
-      zempred = 0.e0
-      zwei = 0.e0
-      ij0 =  87   ;   ij1 =  96
-      ii0 = 148   ;   ii1 = 160
-      DO jj = mj0(ij0), mj1(ij1)
-         DO ji = mi0(ii0),mi1(ii1)
-            zwei      = tmask(ji,jj,1) * e1t(ji,jj) * e2t(ji,jj)
-            zempred   = zempred + emp(ji,jj) * zwei
-         END DO
-      END DO
-      IF( lk_mpp )   CALL mpp_sum( zempred )      ! sum with other processors value
-
-      ! we convert in m3
-      zempred = zempred * 1.e-3
-
-      ! New Transport at Bab el Mandeb and Gibraltar
-      ! --------------------------------------------
-
-      ! imposed transport at Bab el Mandeb
-      zisw_rs = 0.4e6        ! inflow surface water
-      zurw_rs = 0.2e6        ! upper recirculation water
-!!Alex      zbrw_rs = 1.2e6        ! bottom  recirculation water
-      zbrw_rs = 0.5e6        ! bottom  recirculation water
-
-      ! imposed transport at Gibraltar
-      zisw_ms  = 0.8e6          ! atlantic-mediterranean  water
-      zmrw_ms  = 0.7e6          ! middle recirculation water
-      zurw_ms  = 2.5e6          ! upper  recirculation water 
-      zbrw_ms  = 3.5e6          ! bottom recirculation water 
-
-      ! Different velocities for straits ( Gibraltar, Bab el Mandeb )
-      ! -------------------------------------------------------------
-
-      ! Bab el Mandeb
-      ! -------------
-      ! 160,88 north point Bab el Mandeb
-      ij0 =  88   ;   ij1 =  88
-      ii0 = 160   ;   ii1 = 160
-      DO jj = mj0(ij0), mj1(ij1)
-         DO ji = mi0(ii0),mi1(ii1)
-            ua(ji,jj  ,: ) = 0.e0  !  North East Bab el Mandeb 
-         END DO
-      END DO
-      !                              ! surface
-      DO jk = 1,  8                                      
-         DO jj = mj0(ij0), mj1(ij1)
-            DO ji = mi0(ii0),mi1(ii1)
-               ua(ji, jj,jk) = -( ( zisw_rs + zempred ) / 8. ) / ( e2u(ji, jj) * fse3t(ji, jj,jk) )     
-            END DO
-         END DO
-      END DO
-      !                              ! deeper
-      DO jj = mj0(ij0), mj1(ij1)
-         DO ji = mi0(ii0),mi1(ii1)
-            ua(ji, jj,21) = - zbrw_rs / ( e2u(ji, jj) * fse3t(ji, jj,21) )
-         END DO
-      END DO
-
-      ! 160,87 south point Bab el Mandeb
-      ij0 =  87   ;   ij1 =  87
-      ii0 = 160   ;   ii1 = 160
-      DO jj = mj0(ij0), mj1(ij1)
-         DO ji = mi0(ii0),mi1(ii1)
-            ua(ji,jj  ,: ) = 0.e0  !  South East Bab el Mandeb 
-         END DO
-      END DO
-      DO jj = mj0(ij0), mj1(ij1)
-         DO ji = mi0(ii0),mi1(ii1)
-            ua(ji, jj,21) =  ( zisw_rs + zbrw_rs ) / ( e2u(ji,jj )*fse3t(ji, jj,21) )      
-         END DO
-      END DO
-
-      ! Gibraltar
-      ! ---------
-
-      ! initialisation of velocity at concerned points 
-      ! 139, 101 south point in Gibraltar 
-      ij0 = 101   ;   ij1 = 101
-      ii0 = 139   ;   ii1 = 139
-      DO jj = mj0(ij0), mj1(ij1)
-         DO ji = mi0(ii0),mi1(ii1)
-            ua(ji,jj  ,: ) = 0.e0  !  South West Gibraltar
-            ua(ji,jj+1,: ) = 0.e0  !  North West Gibraltar
-         END DO
-      END DO
-      !                            ! surface
-      DO jk = 1, 14                      
-         DO jj = mj0(ij0), mj1(ij1)
-            DO ji = mi0(ii0),mi1(ii1)
-               ua(ji,jj,jk) =  ( ( zisw_ms + zempmed ) / 14. ) / ( e2u(ji,jj) * fse3t(ji,jj,jk) ) 
-            END DO
-         END DO
-      END DO
-      !                            ! middle circulation
-      DO jk = 15, 20                      
-         DO jj = mj0(ij0), mj1(ij1)
-            DO ji = mi0(ii0),mi1(ii1)
-               ua(ji,jj,jk) =  ( zmrw_ms / 6. ) / ( e2u(ji,jj) * fse3t(ji,jj,jk) ) 
-            END DO
-         END DO
-      END DO
-      !                            ! deeper 
-      DO jj = mj0(ij0), mj1(ij1)
-         DO ji = mi0(ii0),mi1(ii1)
-            ua(ji,jj,21) =             zurw_ms   / ( e2u(ji,jj) * fse3t(ji,jj,21) )
-            ua(ji,jj,22) = ( zbrw_ms - zurw_ms ) / ( e2u(ji,jj) * fse3t(ji,jj,22) )
-         END DO
-      END DO
-
-      ! 139,102 north point in Gibraltar
-      ij0 = 102   ;   ij1 = 102
-      ii0 = 139   ;   ii1 = 139
-      DO jj = mj0(ij0), mj1(ij1)
-         DO ji = mi0(ii0),mi1(ii1)
-            ua(ji,jj  ,: ) = 0.e0  !  North West Gibraltar
-         END DO
-      END DO
-      DO jk = 15, 20                      
-         DO jj = mj0(ij0), mj1(ij1)
-            DO ji = mi0(ii0),mi1(ii1)
-               ua(ji,jj,jk) = -( zmrw_ms / 6. ) / ( e2u(ji,jj) * fse3t(ji,jj,jk) ) 
-            END DO
-         END DO
-      END DO
-      !                            ! deeper
-      DO jj = mj0(ij0), mj1(ij1)
-         DO ji = mi0(ii0),mi1(ii1)
-            ua(ji,jj,22) = -( zisw_ms + zbrw_ms ) / ( e2u(ji,jj) * fse3t(ji,jj,22) )
-         END DO
-      END DO
-
-   END SUBROUTINE dyn_spg_cla
-
-   !!======================================================================
-END MODULE cla_dynspg
Index: trunk/NEMOGCM/NEMO/OPA_SRC/istate.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/istate.F90	(revision 2527)
+++ 	(revision )
@@ -1,553 +1,0 @@
-MODULE istate
-   !!======================================================================
-   !!                     ***  MODULE  istate  ***
-   !! Ocean state   :  initial state setting
-   !!=====================================================================
-   !! History :   4.0  !  89-12  (P. Andrich)  Original code
-   !!             5.0  !  91-11  (G. Madec)  rewritting
-   !!             6.0  !  96-01  (G. Madec)  terrain following coordinates
-   !!             8.0  !  01-09  (M. Levy, M. Ben Jelloul)  istate_eel
-   !!             8.0  !  01-09  (M. Levy, M. Ben Jelloul)  istate_uvg
-   !!             9.0  !  03-08  (G. Madec)  F90: Free form, modules
-   !!             9.0  !  03-09  (G. Madec, C. Talandier)  add EEL R5
-   !!             9.0  !  04-05  (A. Koch-Larrouy)  istate_gyre 
-   !!             9.0  !  06-07  (S. Masson)  distributed restart using iom
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   istate_init   : initial state setting
-   !!   istate_tem    : analytical profile for initial Temperature
-   !!   istate_sal    : analytical profile for initial Salinity
-   !!   istate_eel    : initial state setting of EEL R5 configuration
-   !!   istate_gyre   : initial state setting of GYRE configuration
-   !!   istate_uvg    : initial velocity in geostropic balance
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and active tracers 
-   USE dom_oce         ! ocean space and time domain 
-   USE daymod          ! 
-   USE ldftra_oce      ! ocean active tracers: lateral physics
-   USE zdf_oce         ! ocean vertical physics
-   USE phycst          ! physical constants
-   USE dtatem          ! temperature data                 (dta_tem routine)
-   USE dtasal          ! salinity data                    (dta_sal routine)
-   USE restart         ! ocean restart                   (rst_read routine)
-   USE in_out_manager  ! I/O manager
-   USE iom
-   USE c1d             ! re-initialization of u-v mask for the 1D configuration
-   USE zpshde          ! partial step: hor. derivative (zps_hde routine)
-   USE eosbn2          ! equation of state            (eos bn2 routine)
-   USE domvvl          ! varying vertical mesh
-   USE dynspg_oce      ! pressure gradient schemes
-   USE dynspg_flt      ! pressure gradient schemes
-   USE dynspg_exp      ! pressure gradient schemes
-   USE dynspg_ts       ! pressure gradient schemes
-   
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   istate_init   ! routine called by step.F90
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2006) 
-   !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE istate_init
-      !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE istate_init  ***
-      !! 
-      !! ** Purpose :   Initialization of the dynamics and tracer fields.
-      !!----------------------------------------------------------------------
-      USE eosbn2          ! eq. of state, Brunt Vaisala frequency (eos     routine)
-
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'istate_ini : Initialization of the dynamics and tracers'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
-
-      rhd  (:,:,:) = 0.e0
-      rhop (:,:,:) = 0.e0
-      rn2  (:,:,:) = 0.e0 
-
-      IF( ln_rstart ) THEN                    ! Restart from a file
-         !                                    ! -------------------
-         neuler = 1                              ! Set time-step indicator at nit000 (leap-frog)
-         CALL rst_read                           ! Read the restart file
-         CALL day_init                           ! model calendar (using both namelist and restart infos)
-      ELSE
-         !                                    ! Start from rest
-         !                                    ! ---------------
-         numror = 0                              ! define numror = 0 -> no restart file to read
-         neuler = 0                              ! Set time-step indicator at nit000 (euler forward)
-         CALL day_init                           ! model calendar (using both namelist and restart infos)
-         !                                       ! Initialization of ocean to zero
-         !     before fields       !       now fields          
-             ub   (:,:,:) = 0.e0   ;   un   (:,:,:) = 0.e0   ; sshb(:,:) = 0.e0
-             vb   (:,:,:) = 0.e0   ;   vn   (:,:,:) = 0.e0   ; sshn(:,:) = 0.e0
-             rotb (:,:,:) = 0.e0   ;   rotn (:,:,:) = 0.e0
-             hdivb(:,:,:) = 0.e0   ;   hdivn(:,:,:) = 0.e0
-         !
-         IF( cp_cfg == 'eel' ) THEN
-            CALL istate_eel                      ! EEL   configuration : start from pre-defined
-            !                                    !                       velocity and thermohaline fields
-         ELSEIF( cp_cfg == 'gyre' ) THEN         
-            CALL istate_gyre                     ! GYRE  configuration : start from pre-defined temperature
-            !                                    !                       and salinity fields 
-         ELSE
-            !                                    ! Other configurations: Initial temperature and salinity fields
-#if defined key_dtatem
-            CALL dta_tem( nit000 )                  ! read 3D temperature data
-            tb(:,:,:) = t_dta(:,:,:)                ! use temperature data read
-            tn(:,:,:) = t_dta(:,:,:)
-#else
-            IF(lwp) WRITE(numout,*)                 ! analytical temperature profile
-            IF(lwp) WRITE(numout,*)'             Temperature initialization using an analytic profile'
-            CALL istate_tem
-#endif
-#if defined key_dtasal
-            CALL dta_sal( nit000 )                  ! read 3D salinity data
-            sb(:,:,:) = s_dta(:,:,:)                ! use salinity data read
-            sn(:,:,:) = s_dta(:,:,:)
-#else
-            ! No salinity data
-            IF(lwp)WRITE(numout,*)                  ! analytical salinity profile
-            IF(lwp)WRITE(numout,*)'             Salinity initialisation using a constant value'
-            CALL istate_sal
-#endif
-         ENDIF
-
-         CALL eos( tb, sb, rhd, rhop )        ! before potential and in situ densities
-         
-         IF( ln_zps .AND. .NOT. lk_c1d )   &
-            &             CALL zps_hde( nit000, tb, sb, rhd,  &  ! Partial steps: before Horizontal DErivative
-            &                                  gtu, gsu, gru, &  ! of t, s, rd at the bottom ocean level
-            &                                  gtv, gsv, grv )
-         
-      ENDIF
-      !
-      IF( lk_agrif ) THEN
-         ! read free surface arrays in restart file
-         IF( ln_rstart ) THEN
-            IF( lk_dynspg_flt )   CALL flt_rst( nit000, 'READ' )      ! read or initialize the following fields
-            !                                                         ! gcx, gcxb for agrif_opa_init
-         ENDIF                                                        ! explicit case not coded yet with AGRIF
-      ENDIF
-      !
-   END SUBROUTINE istate_init
-
-
-   SUBROUTINE istate_tem
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE istate_tem  ***
-      !!   
-      !! ** Purpose :   Intialization of the temperature field with an 
-      !!      analytical profile or a file (i.e. in EEL configuration)
-      !!
-      !! ** Method  :   Use Philander analytic profile of temperature
-      !!
-      !! References :  Philander ???
-      !!----------------------------------------------------------------------
-      INTEGER :: ji, jj, jk
-      !!----------------------------------------------------------------------
-      !
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'istate_tem : initial temperature profile'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
-
-      DO jk = 1, jpk
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               tn(ji,jj,jk) = (  ( ( 7.5 - 0.*ABS(gphit(ji,jj))/30. )   &
-                  &               *( 1.-TANH((fsdept(ji,jj,jk)-80.)/30.) )   &
-                  &            + 10.*(5000.-fsdept(ji,jj,jk))/5000.)  ) * tmask(ji,jj,jk)
-               tb(ji,jj,jk) = tn(ji,jj,jk)
-          END DO
-        END DO
-      END DO
-
-      IF(lwp) CALL prizre( tn    , jpi   , jpj   , jpk   , jpj/2 ,   &
-         &                 1     , jpi   , 5     , 1     , jpk   ,   &
-         &                 1     , 1.    , numout                  )
-      !
-   END SUBROUTINE istate_tem
-
-
-   SUBROUTINE istate_sal
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE istate_sal  ***
-      !!
-      !! ** Purpose :   Intialize the salinity field with an analytic profile
-      !!
-      !! ** Method  :   Use to a constant value 35.5
-      !!              
-      !! ** Action  :   Initialize sn and sb
-      !!----------------------------------------------------------------------
-      REAL(wp) ::   zsal = 35.50_wp
-      !!----------------------------------------------------------------------
-
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'istate_sal : initial salinity : ', zsal
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
-
-      sn(:,:,:) = zsal * tmask(:,:,:)
-      sb(:,:,:) = sn(:,:,:)
-      
-   END SUBROUTINE istate_sal
-
-
-   SUBROUTINE istate_eel
-      !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE istate_eel  ***
-      !! 
-      !! ** Purpose :   Initialization of the dynamics and tracers for EEL R5
-      !!      configuration (channel with or without a topographic bump)
-      !!
-      !! ** Method  : - set temprature field
-      !!              - set salinity field
-      !!              - set velocity field including horizontal divergence
-      !!                and relative vorticity fields
-      !!----------------------------------------------------------------------
-      USE eosbn2     ! eq. of state, Brunt Vaisala frequency (eos     routine)
-      USE divcur     ! hor. divergence & rel. vorticity      (div_cur routine)
-      USE iom
- 
-      INTEGER  ::   inum              ! temporary logical unit
-      INTEGER  ::   ji, jj, jk        ! dummy loop indices
-      INTEGER  ::   ijloc
-      REAL(wp) ::   zh1, zh2, zslope, zcst, zfcor   ! temporary scalars
-      REAL(wp) ::   zt1  = 15._wp,               &  ! surface temperature value (EEL R5)
-         &          zt2  =  5._wp,               &  ! bottom  temperature value (EEL R5)
-         &          zsal = 35.0_wp,              &  ! constant salinity (EEL R2, R5 and R6)
-         &          zueel = 0.1_wp                  ! constant uniform zonal velocity (EEL R5)
-      REAL(wp), DIMENSION(jpiglo,jpjglo) ::   zssh  ! initial ssh over the global domain
-      !!----------------------------------------------------------------------
-
-      SELECT CASE ( jp_cfg ) 
-         !                                              ! ====================
-         CASE ( 5 )                                     ! EEL R5 configuration
-            !                                           ! ====================
-
-            ! set temperature field with a linear profile
-            ! -------------------------------------------
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) 'istate_eel : EEL R5: linear temperature profile'
-            IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
-
-            zh1 = gdept_0(  1  )
-            zh2 = gdept_0(jpkm1)
-
-            zslope = ( zt1 - zt2 ) / ( zh1 - zh2 )
-            zcst   = ( zt1 * ( zh1 - zh2) - ( zt1 - zt2 ) * zh1 ) / ( zh1 - zh2 )
-
-            DO jk = 1, jpk
-               tn(:,:,jk) = ( zt2 + zt1 * exp( - fsdept(:,:,jk) / 1000 ) ) * tmask(:,:,jk)
-               tb(:,:,jk) = tn(:,:,jk)
-            END DO
-
-            IF(lwp) CALL prizre( tn    , jpi   , jpj   , jpk   , jpj/2 ,   &
-               &                 1     , jpi   , 5     , 1     , jpk   ,   &
-               &                 1     , 1.    , numout                  )
-
-            ! set salinity field to a constant value
-            ! --------------------------------------
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) 'istate_eel : EEL R5: constant salinity field, S = ', zsal
-            IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
-
-            sn(:,:,:) = zsal * tmask(:,:,:)
-            sb(:,:,:) = sn(:,:,:)
-      
-
-            ! set the dynamics: U,V, hdiv, rot (and ssh if necessary)
-            ! ----------------
-            ! Start EEL5 configuration with barotropic geostrophic velocities 
-            ! according the sshb and sshn SSH imposed.
-            ! we assume a uniform grid (hence the use of e1t(1,1) for delta_y)
-            ! we use the Coriolis frequency at mid-channel.   
-    
-            ub(:,:,:) = zueel * umask(:,:,:)
-            un(:,:,:) = ub(:,:,:)
-            ijloc = mj0(INT(jpjglo-1)/2)
-            zfcor = ff(1,ijloc)
-
-            DO jj = 1, jpjglo
-               zssh(:,jj) = - (FLOAT(jj)- FLOAT(jpjglo-1)/2.)*zueel*e1t(1,1)*zfcor/grav 
-            END DO
-
-            IF(lwp) THEN
-               WRITE(numout,*) ' Uniform zonal velocity for EEL R5:',zueel
-               WRITE(numout,*) ' Geostrophic SSH profile as a function of y:'
-               WRITE(numout,'(12(1x,f6.2))') zssh(1,:)
-            ENDIF
-
-            DO jj = 1, nlcj
-               DO ji = 1, nlci
-                  sshb(ji,jj) = zssh( mig(ji) , mjg(jj) ) * tmask(ji,jj,1)
-               END DO
-            END DO
-            sshb(nlci+1:jpi,      :   ) = 0.e0      ! set to zero extra mpp columns
-            sshb(      :   ,nlcj+1:jpj) = 0.e0      ! set to zero extra mpp rows
-
-            sshn(:,:) = sshb(:,:)                   ! set now ssh to the before value
-
-            IF( nn_rstssh /= 0 ) THEN  
-               nn_rstssh = 0                           ! hand-made initilization of ssh 
-               CALL ctl_warn( 'istate_eel: force nn_rstssh = 0' )
-            ENDIF
-
-            ! horizontal divergence and relative vorticity (curl)
-            CALL div_cur( nit000 )
-
-            ! N.B. the vertical velocity will be computed from the horizontal divergence field
-            ! in istate by a call to wzv routine
-
-
-            !                                     ! ==========================
-         CASE ( 2 , 6 )                           ! EEL R2 or R6 configuration
-            !                                     ! ==========================
- 
-            ! set temperature field with a NetCDF file
-            ! ----------------------------------------
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) 'istate_eel : EEL R2 or R6: read initial temperature in a NetCDF file'
-            IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
-
-            CALL iom_open ( 'eel.initemp', inum )
-            CALL iom_get ( inum, jpdom_data, 'initemp', tb ) ! read before temprature (tb)
-            CALL iom_close( inum )
-     
-            tn(:,:,:) = tb(:,:,:)                            ! set nox temperature to tb
-
-            IF(lwp) CALL prizre( tn    , jpi   , jpj   , jpk   , jpj/2 ,   &
-               &                 1     , jpi   , 5     , 1     , jpk   ,   &
-               &                 1     , 1.    , numout                  )
-
-
-            ! set salinity field to a constant value
-            ! --------------------------------------
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) 'istate_eel : EEL R5: constant salinity field, S = ', zsal
-            IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
- 
-            sn(:,:,:) = zsal * tmask(:,:,:)
-            sb(:,:,:) = sn(:,:,:)
-
-            !                                    ! ===========================
-         CASE DEFAULT                            ! NONE existing configuration
-            !                                    ! ===========================
-            WRITE(ctmp1,*) 'EEL with a ', jp_cfg,' km resolution is not coded'
-            CALL ctl_stop( ctmp1 )
-
-      END SELECT
-
-   END SUBROUTINE istate_eel
-
-
-   SUBROUTINE istate_gyre
-      !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE istate_gyre  ***
-      !! 
-      !! ** Purpose :   Initialization of the dynamics and tracers for GYRE
-      !!      configuration (double gyre with rotated domain)
-      !!
-      !! ** Method  : - set temprature field
-      !!              - set salinity field
-      !!----------------------------------------------------------------------
-      INTEGER :: ji, jj, jk  ! dummy loop indices
-      INTEGER            ::   inum          ! temporary logical unit
-      INTEGER, PARAMETER ::   ntsinit = 0   ! (0/1) (analytical/input data files) T&S initialization
-      !!----------------------------------------------------------------------
-
-      SELECT CASE ( ntsinit)
-
-      CASE ( 0 )                  ! analytical T/S profil deduced from LEVITUS
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'istate_gyre : initial analytical T and S profil deduced from LEVITUS '
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
-
-         DO jk = 1, jpk
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  tn(ji,jj,jk) = (  16. - 12. * TANH( (fsdept(ji,jj,jk) - 400) / 700 )         )   &
-                       &           * (-TANH( (500-fsdept(ji,jj,jk)) / 150 ) + 1) / 2               &
-                       &       + (      15. * ( 1. - TANH( (fsdept(ji,jj,jk)-50.) / 1500.) )       &
-                       &                - 1.4 * TANH((fsdept(ji,jj,jk)-100.) / 100.)               &    
-                       &                + 7.  * (1500. - fsdept(ji,jj,jk)) / 1500.             )   & 
-                       &           * (-TANH( (fsdept(ji,jj,jk) - 500) / 150) + 1) / 2
-                  tn(ji,jj,jk) = tn(ji,jj,jk) * tmask(ji,jj,jk)
-                  tb(ji,jj,jk) = tn(ji,jj,jk)
-
-                  sn(ji,jj,jk) =  (  36.25 - 1.13 * TANH( (fsdept(ji,jj,jk) - 305) / 460 )  )  &
-                     &              * (-TANH((500 - fsdept(ji,jj,jk)) / 150) + 1) / 2          &
-                     &          + (  35.55 + 1.25 * (5000. - fsdept(ji,jj,jk)) / 5000.         &
-                     &                - 1.62 * TANH( (fsdept(ji,jj,jk) - 60.  ) / 650. )       &
-                     &                + 0.2  * TANH( (fsdept(ji,jj,jk) - 35.  ) / 100. )       &
-                     &                + 0.2  * TANH( (fsdept(ji,jj,jk) - 1000.) / 5000.)    )  &
-                     &              * (-TANH((fsdept(ji,jj,jk) - 500) / 150) + 1) / 2 
-                  sn(ji,jj,jk) = sn(ji,jj,jk) * tmask(ji,jj,jk)
-                  sb(ji,jj,jk) = sn(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-
-      CASE ( 1 )                  ! T/S data fields read in dta_tem.nc/data_sal.nc files
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'istate_gyre : initial T and S read from dta_tem.nc/data_sal.nc files'
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
-         IF(lwp) WRITE(numout,*) '              NetCDF FORMAT'
-
-         ! Read temperature field
-         ! ----------------------
-         CALL iom_open ( 'data_tem', inum )
-         CALL iom_get ( inum, jpdom_data, 'votemper', tn ) 
-         CALL iom_close( inum )
-
-         tn(:,:,:) = tn(:,:,:) * tmask(:,:,:) 
-         tb(:,:,:) = tn(:,:,:)
-
-         ! Read salinity field
-         ! -------------------
-         CALL iom_open ( 'data_sal', inum )
-         CALL iom_get ( inum, jpdom_data, 'vosaline', sn ) 
-         CALL iom_close( inum )
-
-         sn(:,:,:)  = sn(:,:,:) * tmask(:,:,:) 
-         sb(:,:,:)  = sn(:,:,:)
-
-      END SELECT
-
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) '              Initial temperature and salinity profiles:'
-         WRITE(numout, "(9x,' level   gdept_0   temperature   salinity   ')" )
-         WRITE(numout, "(10x, i4, 3f10.2)" ) ( jk, gdept_0(jk), tn(2,2,jk), sn(2,2,jk), jk = 1, jpk )
-      ENDIF
-
-   END SUBROUTINE istate_gyre
-
-
-   SUBROUTINE istate_uvg
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE istate_uvg  ***
-      !!
-      !! ** Purpose :   Compute the geostrophic velocities from (tn,sn) fields
-      !!
-      !! ** Method  :   Using the hydrostatic hypothesis the now hydrostatic 
-      !!      pressure is computed by integrating the in-situ density from the
-      !!      surface to the bottom.
-      !!                 p=integral [ rau*g dz ]
-      !!----------------------------------------------------------------------
-      USE dynspg          ! surface pressure gradient             (dyn_spg routine)
-      USE divcur          ! hor. divergence & rel. vorticity      (div_cur routine)
-      USE lbclnk          ! ocean lateral boundary condition (or mpp link)
-
-      INTEGER ::   ji, jj, jk        ! dummy loop indices
-      INTEGER ::   indic             ! ???
-      REAL(wp) ::   zmsv, zphv, zmsu, zphu, zalfg     ! temporary scalars
-      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zprn     ! workspace
-      !!----------------------------------------------------------------------
-
-      IF(lwp) WRITE(numout,*) 
-      IF(lwp) WRITE(numout,*) 'istate_uvg : Start from Geostrophy'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
-
-      ! Compute the now hydrostatic pressure
-      ! ------------------------------------
-
-      zalfg = 0.5 * grav * rau0
-      
-      zprn(:,:,1) = zalfg * fse3w(:,:,1) * ( 1 + rhd(:,:,1) )       ! Surface value
-
-      DO jk = 2, jpkm1                                              ! Vertical integration from the surface
-         zprn(:,:,jk) = zprn(:,:,jk-1)   &
-            &         + zalfg * fse3w(:,:,jk) * ( 2. + rhd(:,:,jk) + rhd(:,:,jk-1) )
-      END DO  
-
-      ! Compute geostrophic balance
-      ! ---------------------------
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vertor opt.
-               zmsv = 1. / MAX(  umask(ji-1,jj+1,jk) + umask(ji  ,jj+1,jk)   &
-                               + umask(ji-1,jj  ,jk) + umask(ji  ,jj  ,jk) , 1.  )
-               zphv = ( zprn(ji  ,jj+1,jk) - zprn(ji-1,jj+1,jk) ) * umask(ji-1,jj+1,jk) / e1u(ji-1,jj+1)   &
-                    + ( zprn(ji+1,jj+1,jk) - zprn(ji  ,jj+1,jk) ) * umask(ji  ,jj+1,jk) / e1u(ji  ,jj+1)   &
-                    + ( zprn(ji  ,jj  ,jk) - zprn(ji-1,jj  ,jk) ) * umask(ji-1,jj  ,jk) / e1u(ji-1,jj  )   &
-                    + ( zprn(ji+1,jj  ,jk) - zprn(ji  ,jj  ,jk) ) * umask(ji  ,jj  ,jk) / e1u(ji  ,jj  )
-               zphv = 1. / rau0 * zphv * zmsv * vmask(ji,jj,jk)
-
-               zmsu = 1. / MAX(  vmask(ji+1,jj  ,jk) + vmask(ji  ,jj  ,jk)   &
-                               + vmask(ji+1,jj-1,jk) + vmask(ji  ,jj-1,jk) , 1.  )
-               zphu = ( zprn(ji+1,jj+1,jk) - zprn(ji+1,jj  ,jk) ) * vmask(ji+1,jj  ,jk) / e2v(ji+1,jj  )   &
-                    + ( zprn(ji  ,jj+1,jk) - zprn(ji  ,jj  ,jk) ) * vmask(ji  ,jj  ,jk) / e2v(ji  ,jj  )   &
-                    + ( zprn(ji+1,jj  ,jk) - zprn(ji+1,jj-1,jk) ) * vmask(ji+1,jj-1,jk) / e2v(ji+1,jj-1)   &
-                    + ( zprn(ji  ,jj  ,jk) - zprn(ji  ,jj-1,jk) ) * vmask(ji  ,jj-1,jk) / e2v(ji  ,jj-1)
-               zphu = 1. / rau0 * zphu * zmsu * umask(ji,jj,jk)
-
-               ! Compute the geostrophic velocities
-               un(ji,jj,jk) = -2. * zphu / ( ff(ji,jj) + ff(ji  ,jj-1) )
-               vn(ji,jj,jk) =  2. * zphv / ( ff(ji,jj) + ff(ji-1,jj  ) )
-            END DO
-         END DO
-      END DO
-
-      IF(lwp) WRITE(numout,*) '         we force to zero bottom velocity'
-
-      ! Susbtract the bottom velocity (level jpk-1 for flat bottom case)
-      ! to have a zero bottom velocity
-
-      DO jk = 1, jpkm1
-         un(:,:,jk) = ( un(:,:,jk) - un(:,:,jpkm1) ) * umask(:,:,jk)
-         vn(:,:,jk) = ( vn(:,:,jk) - vn(:,:,jpkm1) ) * vmask(:,:,jk)
-      END DO
-
-      CALL lbc_lnk( un, 'U', -1. )
-      CALL lbc_lnk( vn, 'V', -1. )
-      
-      ub(:,:,:) = un(:,:,:)
-      vb(:,:,:) = vn(:,:,:)
-      
-      ! WARNING !!!!!
-      ! after initializing u and v, we need to calculate the initial streamfunction bsf.
-      ! Otherwise, only the trend will be computed and the model will blow up (inconsistency).
-      ! to do that, we call dyn_spg with a special trick:
-      ! we fill ua and va with the velocities divided by dt, and the streamfunction will be brought to the
-      ! right value assuming the velocities have been set up in one time step.
-      ! we then set bsfd to zero (first guess for next step is d(psi)/dt = 0.)
-      !  sets up s false trend to calculate the barotropic streamfunction.
-
-      ua(:,:,:) = ub(:,:,:) / rdt
-      va(:,:,:) = vb(:,:,:) / rdt
-
-      ! calls dyn_spg. we assume euler time step, starting from rest.
-      indic = 0
-      CALL dyn_spg( nit000, indic )       ! surface pressure gradient
-
-      ! the new velocity is ua*rdt
-
-      CALL lbc_lnk( ua, 'U', -1. )
-      CALL lbc_lnk( va, 'V', -1. )
-
-      ub(:,:,:) = ua(:,:,:) * rdt
-      vb(:,:,:) = va(:,:,:) * rdt
-      ua(:,:,:) = 0.e0
-      va(:,:,:) = 0.e0
-      un(:,:,:) = ub(:,:,:)
-      vn(:,:,:) = vb(:,:,:)
-       
-      ! Compute the divergence and curl
-
-      CALL div_cur( nit000 )            ! now horizontal divergence and curl
-
-      hdivb(:,:,:) = hdivn(:,:,:)       ! set the before to the now value
-      rotb (:,:,:) = rotn (:,:,:)       ! set the before to the now value
-      !
-   END SUBROUTINE istate_uvg
-
-   !!=====================================================================
-END MODULE istate
Index: trunk/NEMOGCM/NEMO/OPA_SRC/lbclnk.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/lbclnk.F90	(revision 2527)
+++ 	(revision )
@@ -1,309 +1,0 @@
-MODULE lbclnk
-   !!======================================================================
-   !!                       ***  MODULE  lbclnk  ***
-   !! Ocean        : lateral boundary conditions
-   !!=====================================================================
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-#if   defined key_mpp_mpi   ||   defined key_mpp_shmem
-   !!----------------------------------------------------------------------
-   !!   'key_mpp_mpi'     OR      MPI massively parallel processing library
-   !!   'key_mpp_shmem'         SHMEM massively parallel processing library
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !!   lbc_lnk      : generic interface for mpp_lnk_3d and mpp_lnk_2d
-   !!                  routines defined in lib_mpp
-   !!   lbc_lnk_e    : generic interface for mpp_lnk_2d_e
-   !!                   routinee defined in lib_mpp
-   !!----------------------------------------------------------------------
-   !! * Modules used
-   USE lib_mpp          ! distributed memory computing library
-
-   INTERFACE lbc_lnk
-      MODULE PROCEDURE mpp_lnk_3d_gather, mpp_lnk_3d, mpp_lnk_2d
-   END INTERFACE
-
-   INTERFACE lbc_lnk_e
-      MODULE PROCEDURE mpp_lnk_2d_e
-   END INTERFACE
-
-   PUBLIC lbc_lnk       ! ocean lateral boundary conditions
-   PUBLIC lbc_lnk_e
-   !!----------------------------------------------------------------------
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option                              shared memory computing
-   !!----------------------------------------------------------------------
-   !!   lbc_lnk      : generic interface for lbc_lnk_3d and lbc_lnk_2d
-   !!   lbc_lnk_3d   : set the lateral boundary condition on a 3D variable
-   !!                  on OPA ocean mesh
-   !!   lbc_lnk_2d   : set the lateral boundary condition on a 2D variable
-   !!                  on OPA ocean mesh
-   !!----------------------------------------------------------------------
-   !! * Modules used
-   USE oce             ! ocean dynamics and tracers   
-   USE dom_oce         ! ocean space and time domain 
-   USE in_out_manager  ! I/O manager
-   USE lbcnfd          ! north fold
-
-   IMPLICIT NONE
-   PRIVATE
-
-   INTERFACE lbc_lnk
-      MODULE PROCEDURE lbc_lnk_3d_gather, lbc_lnk_3d, lbc_lnk_2d
-   END INTERFACE
-
-   INTERFACE lbc_lnk_e
-      MODULE PROCEDURE lbc_lnk_2d
-   END INTERFACE
-
-   PUBLIC lbc_lnk       ! ocean/ice  lateral boundary conditions
-   PUBLIC  lbc_lnk_e 
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn )
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE lbc_lnk_3d_gather  ***
-      !!
-      !! ** Purpose :   set lateral boundary conditions (non mpp case)
-      !!
-      !! ** Method  :
-      !!
-      !! History :
-      !!        !  97-06  (G. Madec)     Original code
-      !!   8.5  !  02-09  (G. Madec)     F90: Free form and module
-      !!        !  09-03  (R. Benshila)  External north fold treatment  
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      CHARACTER(len=1), INTENT( in ) ::   &
-         cd_type1, cd_type2       ! nature of pt3d grid-points
-      !             !   = T ,  U , V , F or W  gridpoints
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   &
-         pt3d1, pt3d2          ! 3D array on which the boundary condition is applied
-      REAL(wp), INTENT( in ) ::   &
-         psgn          ! control of the sign change
-      !             !   =-1 , the sign is changed if north fold boundary
-      !             !   = 1 , no sign change
-      !             !   = 0 , no sign change and > 0 required (use the inner
-      !             !         row/column if closed boundary)
-
-      CALL lbc_lnk_3d( pt3d1, cd_type1, psgn)
-      CALL lbc_lnk_3d( pt3d2, cd_type2, psgn)
-
-   END SUBROUTINE lbc_lnk_3d_gather
-
-
-   SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp, pval )
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE lbc_lnk_3d  ***
-      !!
-      !! ** Purpose :   set lateral boundary conditions (non mpp case)
-      !!
-      !! ** Method  :
-      !!
-      !! History :
-      !!        !  97-06  (G. Madec)  Original code
-      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
-      !!        !  09-03  (R. Benshila)  External north fold treatment  
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      CHARACTER(len=1), INTENT( in ) ::   &
-         cd_type       ! nature of pt3d grid-points
-      !             !   = T ,  U , V , F or W  gridpoints
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   &
-         pt3d          ! 3D array on which the boundary condition is applied
-      REAL(wp), INTENT( in ) ::   &
-         psgn          ! control of the sign change
-      !             !   =-1 , the sign is changed if north fold boundary
-      !             !   = 1 , no sign change
-      !             !   = 0 , no sign change and > 0 required (use the inner
-      !             !         row/column if closed boundary)
-      CHARACTER(len=3), INTENT( in ), OPTIONAL ::    &
-         cd_mpp        ! fill the overlap area only (here do nothing)
-      REAL(wp)        , INTENT(in   ), OPTIONAL           ::   pval      ! background value (used at closed boundaries)
-
-      !! * Local declarations
-      REAL(wp) ::   zland
-
-      IF( PRESENT( pval ) ) THEN      ! set land value (zero by default)
-         zland = pval
-      ELSE
-         zland = 0.e0
-      ENDIF
-
-
-      IF( PRESENT( cd_mpp ) ) THEN
-         ! only fill the overlap area and extra allows 
-         ! this is in mpp case. In this module, just do nothing
-      ELSE
-
-         !                                     !  East-West boundaries
-         !                                     ! ======================
-         SELECT CASE ( nperio )
-         !
-         CASE ( 1 , 4 , 6 )                       !**  cyclic east-west
-            pt3d( 1 ,:,:) = pt3d(jpim1,:,:)            ! all points
-            pt3d(jpi,:,:) = pt3d(  2  ,:,:)
-            !
-         CASE DEFAULT                             !**  East closed  --  West closed
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
-               pt3d( 1 ,:,:) = zland
-               pt3d(jpi,:,:) = zland
-            CASE ( 'F' )                               ! F-point
-               pt3d(jpi,:,:) = zland
-            END SELECT
-            !
-         END SELECT
-
-         !                                     ! North-South boundaries
-         !                                     ! ======================
-         SELECT CASE ( nperio )
-         !
-         CASE ( 2 )                               !**  South symmetric  --  North closed
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
-               pt3d(:, 1 ,:) = pt3d(:,3,:)
-               pt3d(:,jpj,:) = zland
-            CASE ( 'V' , 'F' )                         ! V-, F-points
-               pt3d(:, 1 ,:) = psgn * pt3d(:,2,:)
-               pt3d(:,jpj,:) = zland
-            END SELECT
-            !
-         CASE ( 3 , 4 , 5 , 6 )                   !**  North fold  T or F-point pivot  --  South closed
-            SELECT CASE ( cd_type )                    ! South : closed
-            CASE ( 'T' , 'U' , 'V' , 'W' , 'I' )             ! all points except F-point
-               pt3d(:, 1 ,:) = zland
-            END SELECT
-            !                                          ! North fold
-            pt3d( 1 ,jpj,:) = zland
-            pt3d(jpi,jpj,:) = zland
-            CALL lbc_nfd( pt3d(:,:,:), cd_type, psgn )
-            !
-         CASE DEFAULT                             !**  North closed  --  South closed
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
-               pt3d(:, 1 ,:) = zland
-               pt3d(:,jpj,:) = zland
-            CASE ( 'F' )                               ! F-point
-               pt3d(:,jpj,:) = zland
-            END SELECT
-            !
-         END SELECT
-
-      ENDIF
-
-   END SUBROUTINE lbc_lnk_3d
-
-
-   SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval )
-      !!---------------------------------------------------------------------
-      !!                 ***  ROUTINE lbc_lnk_2d  ***
-      !!
-      !! ** Purpose :   set lateral boundary conditions (non mpp case)
-      !!
-      !! ** Method  :
-      !!
-      !! History :
-      !!        !  97-06  (G. Madec)  Original code
-      !!        !  01-05  (E. Durand)  correction
-      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
-      !!        !  09-03  (R. Benshila)  External north fold treatment  
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      CHARACTER(len=1), INTENT( in ) ::   &
-         cd_type       ! nature of pt2d grid-point
-         !             !   = T , U , V , F or W  gridpoints
-         !             !   = I sea-ice U-V gridpoint (= F ocean grid point with indice shift)
-      REAL(wp), INTENT( in ) ::   &
-         psgn          ! control of the sign change
-         !             !   =-1 , the sign is modified following the type of b.c. used
-         !             !   = 1 , no sign change
-      REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) ::   &
-         pt2d          ! 2D array on which the boundary condition is applied
-      CHARACTER(len=3), INTENT( in ), OPTIONAL ::    &
-         cd_mpp        ! fill the overlap area only (here do nothing)
-      REAL(wp)        , INTENT(in   ), OPTIONAL           ::   pval      ! background value (used at closed boundaries)
-
-      !! * Local declarations
-      REAL(wp) ::   zland
-
-      IF( PRESENT( pval ) ) THEN      ! set land value (zero by default)
-         zland = pval
-      ELSE
-         zland = 0.e0
-      ENDIF
-
-      IF (PRESENT(cd_mpp)) THEN
-         ! only fill the overlap area and extra allows 
-         ! this is in mpp case. In this module, just do nothing
-      ELSE      
-      
-         !                                     ! East-West boundaries
-         !                                     ! ====================
-         SELECT CASE ( nperio )
-         !
-         CASE ( 1 , 4 , 6 )                       !** cyclic east-west
-            pt2d( 1 ,:) = pt2d(jpim1,:)               ! all points
-            pt2d(jpi,:) = pt2d(  2  ,:)
-            !
-         CASE DEFAULT                             !** East closed  --  West closed
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'U' , 'V' , 'W' )            ! T-, U-, V-, W-points
-               pt2d( 1 ,:) = zland
-               pt2d(jpi,:) = zland
-            CASE ( 'F' )                              ! F-point
-               pt2d(jpi,:) = zland
-            END SELECT
-            !
-         END SELECT
- 
-         !                                     ! North-South boundaries
-         !                                     ! ======================
-         SELECT CASE ( nperio )
-         !
-         CASE ( 2 )                               !**  South symmetric  --  North closed
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
-               pt2d(:, 1 ) = pt2d(:,3)
-               pt2d(:,jpj) = zland
-            CASE ( 'V' , 'F' )                         ! V-, F-points
-               pt2d(:, 1 ) = psgn * pt2d(:,2)
-               pt2d(:,jpj) = zland
-            END SELECT
-            !
-         CASE ( 3 , 4 , 5 , 6 )                   !**  North fold  T or F-point pivot  --  South closed
-            SELECT CASE ( cd_type )                    ! South : closed
-            CASE ( 'T' , 'U' , 'V' , 'W' , 'I' )             ! all points except F-point
-               pt2d(:, 1 ) = zland
-            END SELECT
-            !                                          ! North fold
-            pt2d( 1 ,1  ) = zland 
-            pt2d( 1 ,jpj) = zland 
-            pt2d(jpi,jpj) = zland
-            CALL lbc_nfd( pt2d(:,:), cd_type, psgn )
-            !
-         CASE DEFAULT                             !**  North closed  --  South closed
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
-               pt2d(:, 1 ) = zland
-               pt2d(:,jpj) = zland
-            CASE ( 'F' )                               ! F-point
-               pt2d(:,jpj) = zland
-            END SELECT
-            !
-         END SELECT
-
-      ENDIF
-      
-   END SUBROUTINE lbc_lnk_2d
-
-#endif
-
-   !!======================================================================
-END MODULE lbclnk
Index: trunk/NEMOGCM/NEMO/OPA_SRC/lbcnfd.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/lbcnfd.F90	(revision 2527)
+++ 	(revision )
@@ -1,319 +1,0 @@
-MODULE lbcnfd
-   !!======================================================================
-   !!                       ***  MODULE  lbcnfd  ***
-   !! Ocean        : north fold  boundary conditions
-   !!======================================================================
-   !!             9.0  !  09-03  (R. Benshila) Initial version 
-   !!----------------------------------------------------------------------
-   !! * Modules used
-   USE oce             ! ocean dynamics and tracers   
-   USE dom_oce         ! ocean space and time domain 
-   USE in_out_manager  ! I/O manager
-
-   IMPLICIT NONE
-   PRIVATE
-
-   INTERFACE lbc_nfd
-      MODULE PROCEDURE lbc_nfd_3d, lbc_nfd_2d
-   END INTERFACE
-
-   PUBLIC lbc_nfd       ! north fold conditions
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE lbc_nfd_3d( pt3d, cd_type, psgn )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine lbc_nfd_3d  ***
-      !!
-      !! ** Purpose :   3D lateral boundary condition : North fold treatment
-      !!       without processor exchanges. 
-      !!
-      !! ** Method  :   
-      !!
-      !! ** Action  :   pt3d with update value at its periphery
-      !!
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      CHARACTER(len=1) , INTENT( in ) ::   &
-         cd_type       ! define the nature of ptab array grid-points
-      !             ! = T , U , V , F , W points
-      !             ! = S : T-point, north fold treatment ???
-      !             ! = G : F-point, north fold treatment ???
-      REAL(wp), INTENT( in ) ::   &
-         psgn          ! control of the sign change
-      !             !   = -1. , the sign is changed if north fold boundary
-      !             !   =  1. , the sign is kept  if north fold boundary
-      REAL(wp), DIMENSION(:,:,:), INTENT( inout ) ::   &
-         pt3d          ! 3D array on which the boundary condition is applied
-
-      !! * Local declarations
-      INTEGER  ::   ji, jk
-      INTEGER  ::   ijt, iju, ijpj, ijpjm1
-
-
-      SELECT CASE ( jpni )
-      CASE ( 1 )  ! only one proc along I
-         ijpj = nlcj
-      CASE DEFAULT 
-         ijpj   = 4
-      END SELECT
-      ijpjm1 = ijpj-1
-
-      DO jk = 1, jpk
-
-         SELECT CASE ( npolj )
-
-         CASE ( 3 , 4 )                        ! *  North fold  T-point pivot
-
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'W' )                         ! T-, W-point
-               DO ji = 2, jpiglo
-                  ijt = jpiglo-ji+2
-                  pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-2,jk)
-               END DO
-               DO ji = jpiglo/2+1, jpiglo
-                  ijt = jpiglo-ji+2
-                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(ijt,ijpjm1,jk)
-               END DO
-            CASE ( 'U' )                               ! U-point
-               DO ji = 1, jpiglo-1
-                  iju = jpiglo-ji+1
-                  pt3d(ji,ijpj,jk) = psgn * pt3d(iju,ijpj-2,jk)
-               END DO
-               DO ji = jpiglo/2, jpiglo-1
-                  iju = jpiglo-ji+1
-                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(iju,ijpjm1,jk)
-               END DO
-            CASE ( 'V' )                               ! V-point
-               DO ji = 2, jpiglo
-                  ijt = jpiglo-ji+2
-                  pt3d(ji,ijpj-1,jk) = psgn * pt3d(ijt,ijpj-2,jk)
-                  pt3d(ji,ijpj  ,jk) = psgn * pt3d(ijt,ijpj-3,jk)
-               END DO
-            CASE ( 'F' )                               ! F-point
-               DO ji = 1, jpiglo-1
-                  iju = jpiglo-ji+1
-                  pt3d(ji,ijpj-1,jk) = psgn * pt3d(iju,ijpj-2,jk)
-                  pt3d(ji,ijpj  ,jk) = psgn * pt3d(iju,ijpj-3,jk)
-               END DO
-            END SELECT
-
-         CASE ( 5 , 6 )                        ! *  North fold  F-point pivot
-
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'W' )                         ! T-, W-point
-               DO ji = 1, jpiglo
-                  ijt = jpiglo-ji+1
-                  pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-1,jk)
-               END DO
-            CASE ( 'U' )                               ! U-point
-               DO ji = 1, jpiglo-1
-                  iju = jpiglo-ji
-                  pt3d(ji,ijpj,jk) = psgn * pt3d(iju,ijpj-1,jk)
-               END DO
-            CASE ( 'V' )                               ! V-point
-               DO ji = 1, jpiglo
-                  ijt = jpiglo-ji+1
-                  pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-2,jk)
-               END DO
-               DO ji = jpiglo/2+1, jpiglo
-                  ijt = jpiglo-ji+1
-                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(ijt,ijpjm1,jk)
-               END DO
-            CASE ( 'F' )                               ! F-point
-               DO ji = 1, jpiglo-1
-                  iju = jpiglo-ji
-                  pt3d(ji,ijpj  ,jk) = psgn * pt3d(iju,ijpj-2,jk)
-               END DO
-               DO ji = jpiglo/2+1, jpiglo-1
-                  iju = jpiglo-ji
-                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(iju,ijpjm1,jk)
-               END DO
-            END SELECT
-
-         CASE DEFAULT                           ! *  closed : the code probably never go through
-
-            SELECT CASE ( cd_type)
-            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
-               pt3d(:, 1  ,jk) = 0.e0
-               pt3d(:,ijpj,jk) = 0.e0
-            CASE ( 'F' )                               ! F-point
-               pt3d(:,ijpj,jk) = 0.e0
-            END SELECT
-
-         END SELECT     !  npolj
-
-      END DO
-
-   END SUBROUTINE lbc_nfd_3d
-
-
-   SUBROUTINE lbc_nfd_2d( pt2d, cd_type, psgn, pr2dj )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine lbc_nfd_2d  ***
-      !!
-      !! ** Purpose :   2D lateral boundary condition : North fold treatment
-      !!       without processor exchanges. 
-      !!
-      !! ** Method  :   
-      !!
-      !! ** Action  :   pt2d with update value at its periphery
-      !!
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      CHARACTER(len=1) , INTENT( in ) ::   &
-         cd_type       ! define the nature of ptab array grid-points
-      !             ! = T , U , V , F , W points
-      !             ! = S : T-point, north fold treatment ???
-      !             ! = G : F-point, north fold treatment ???
-      REAL(wp), INTENT( in ) ::   &
-         psgn          ! control of the sign change
-      !             !   = -1. , the sign is changed if north fold boundary
-      !             !   =  1. , the sign is kept  if north fold boundary
-      REAL(wp), DIMENSION(:,:), INTENT( inout ) ::   &
-         pt2d          ! 3D array on which the boundary condition is applied
-      INTEGER, OPTIONAL, INTENT(in) :: pr2dj
-
-      !! * Local declarations
-      INTEGER  ::   ji, jl, ipr2dj
-      INTEGER  ::   ijt, iju, ijpj, ijpjm1
-
-      SELECT CASE ( jpni )
-      CASE ( 1 )  ! only one proc along I
-         ijpj = nlcj
-      CASE DEFAULT 
-         ijpj = 4
-      END SELECT
-
-
-      IF( PRESENT(pr2dj) ) THEN
-         ipr2dj = pr2dj
-         IF (jpni .GT. 1) ijpj = ijpj + ipr2dj
-      ELSE
-         ipr2dj = 0 
-      ENDIF
-
-      ijpjm1 = ijpj-1
-
-
-      SELECT CASE ( npolj )
-
-      CASE ( 3, 4 )                       ! *  North fold  T-point pivot
-
-         SELECT CASE ( cd_type )
-
-         CASE ( 'T', 'S', 'W' )
-            DO jl = 0, ipr2dj
-               DO ji = 2, jpiglo
-                  ijt=jpiglo-ji+2
-                  pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-2-jl)
-               END DO
-            END DO
-            DO ji = jpiglo/2+1, jpiglo
-               ijt=jpiglo-ji+2
-               pt2d(ji,ijpj-1) = psgn * pt2d(ijt,ijpj-1)
-            END DO
-         CASE ( 'U' )                                     ! U-point
-            DO jl =0, ipr2dj
-               DO ji = 1, jpiglo-1
-                  iju = jpiglo-ji+1
-                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-2-jl)
-               END DO
-            END DO
-            DO ji = jpiglo/2, jpiglo-1
-               iju = jpiglo-ji+1
-               pt2d(ji,ijpjm1) = psgn * pt2d(iju,ijpjm1)
-            END DO
-         CASE ( 'V' )                                     ! V-point
-            DO jl =-1, ipr2dj
-               DO ji = 2, jpiglo
-                  ijt = jpiglo-ji+2
-                  pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-3-jl)
-               END DO
-            END DO
-         CASE ( 'F' , 'G' )                               ! F-point
-            DO jl =-1, ipr2dj
-               DO ji = 1, jpiglo-1
-                  iju = jpiglo-ji+1
-                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-3-jl)
-               END DO
-            END DO
-         CASE ( 'I' )                                     ! ice U-V point
-            DO jl =0, ipr2dj
-               pt2d(2,ijpj+jl) = psgn * pt2d(3,ijpj-1+jl)
-               DO ji = 3, jpiglo
-                  iju = jpiglo - ji + 3
-                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl)
-               END DO
-            END DO
-         END SELECT
-
-      CASE ( 5, 6 )                        ! *  North fold  F-point pivot
-
-         SELECT CASE ( cd_type )
-         CASE ( 'T' , 'W' ,'S' )                          ! T-, W-point
-            DO jl = 0, ipr2dj
-               DO ji = 1, jpiglo
-                  ijt = jpiglo-ji+1
-                  pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-1-jl)
-               END DO
-            END DO
-         CASE ( 'U' )                                     ! U-point
-            DO jl = 0, ipr2dj
-               DO ji = 1, jpiglo-1
-                  iju = jpiglo-ji
-                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl)
-               END DO
-            END DO
-         CASE ( 'V' )                                     ! V-point
-            DO jl = 0, ipr2dj
-               DO ji = 1, jpiglo
-                  ijt = jpiglo-ji+1
-                  pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-2-jl)
-               END DO
-            END DO
-            DO ji = jpiglo/2+1, jpiglo
-               ijt = jpiglo-ji+1
-               pt2d(ji,ijpjm1) = psgn * pt2d(ijt,ijpjm1)
-            END DO
-         CASE ( 'F' , 'G' )                               ! F-point
-            DO jl = 0, ipr2dj
-               DO ji = 1, jpiglo-1
-                  iju = jpiglo-ji
-                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-2-jl)
-               END DO
-            END DO
-            DO ji = jpiglo/2+1, jpiglo-1
-               iju = jpiglo-ji
-               pt2d(ji,ijpjm1) = psgn * pt2d(iju,ijpjm1)
-            END DO
-         CASE ( 'I' )                                  ! ice U-V point
-            pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0.e0
-            DO jl = 0, ipr2dj
-               DO ji = 2 , jpiglo-1
-                  ijt = jpiglo - ji + 2
-                  pt2d(ji,ijpj+jl)= 0.5 * ( pt2d(ji,ijpj-1-jl) + psgn * pt2d(ijt,ijpj-1-jl) )
-               END DO
-            END DO
-         END SELECT
-
-      CASE DEFAULT                           ! *  closed : the code probably never go through
-
-         SELECT CASE ( cd_type)
-         CASE ( 'T' , 'U' , 'V' , 'W' )                 ! T-, U-, V-, W-points
-            pt2d(:, 1:1-ipr2dj     ) = 0.e0
-            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
-         CASE ( 'F' )                                   ! F-point
-            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
-         CASE ( 'I' )                                   ! ice U-V point
-            pt2d(:, 1:1-ipr2dj     ) = 0.e0
-            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
-         END SELECT
-
-      END SELECT
-
-   END SUBROUTINE lbc_nfd_2d
-
-   !!======================================================================
-END MODULE lbcnfd
Index: trunk/NEMOGCM/NEMO/OPA_SRC/lib_cray.f90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/lib_cray.f90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/lib_cray.f90	(revision 2528)
@@ -10,5 +10,5 @@
 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
 !!----------------------------------------------------------------------
-     SUBROUTINE wheneq ( i, x, j, t, ind, nn )
+SUBROUTINE wheneq ( i, x, j, t, ind, nn )
         IMPLICIT NONE
 
@@ -28,3 +28,3 @@
         END DO 
 
-     END SUBROUTINE wheneq
+END SUBROUTINE wheneq
Index: trunk/NEMOGCM/NEMO/OPA_SRC/lib_fortran.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/lib_fortran.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/lib_fortran.F90	(revision 2528)
@@ -0,0 +1,439 @@
+MODULE lib_fortran
+   !!======================================================================
+   !!                       ***  MODULE  lib_fortran  ***
+   !! Fortran utilities:  includes some low levels fortran functionality
+   !!======================================================================
+   !! History :  3.2  !  2010-05  (M. Dunphy, R. Benshila)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   glob_sum    : generic interface for global masked summation over 
+   !!                 the interior domain for 1 or 2 2D or 3D arrays
+   !!                 it works only for T points   
+   !!   SIGN        : generic interface for SIGN to overwrite f95 behaviour
+   !!                 of intrinsinc sign function
+   !!----------------------------------------------------------------------
+   USE par_oce          ! Ocean parameter
+   USE lib_mpp          ! distributed memory computing
+   USE dom_oce          ! ocean domain
+   USE in_out_manager   ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC glob_sum
+#if defined key_nosignedzero
+   PUBLIC SIGN
+#endif
+
+   INTERFACE glob_sum
+      MODULE PROCEDURE glob_sum_2d, glob_sum_3d,glob_sum_2d_a, glob_sum_3d_a 
+   END INTERFACE
+
+#if defined key_nosignedzero   
+   INTERFACE SIGN
+      MODULE PROCEDURE SIGN_SCALAR, SIGN_ARRAY_1D, SIGN_ARRAY_2D, SIGN_ARRAY_3D,   &
+         &             SIGN_ARRAY_1D_A, SIGN_ARRAY_2D_A, SIGN_ARRAY_3D_A,          & 
+         &             SIGN_ARRAY_1D_B, SIGN_ARRAY_2D_B, SIGN_ARRAY_3D_B 
+   END INTERFACE
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS 
+
+#if ! defined key_mpp_rep
+   FUNCTION glob_sum_2d( ptab ) RESULT( glob_sum )
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_sum_2D  ***
+      !!
+      !! ** Purpose : perform a masked sum on the inner global domain of a 2D array
+      !!-----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab       ! input 2D array
+      REAL(wp)                             ::   glob_sum   ! global masked sum
+      !!-----------------------------------------------------------------------
+      !
+      glob_sum = SUM( ptab(:,:)*tmask_i(:,:) )
+      IF( lk_mpp )   CALL mpp_sum( glob_sum )
+      !
+   END FUNCTION glob_sum_2d
+   
+   
+   FUNCTION glob_sum_3d( ptab ) RESULT( glob_sum )
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_sum_3D  ***
+      !!
+      !! ** Purpose : perform a masked sum on the inner global domain of a 3D array
+      !!-----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab       ! input 3D array
+      REAL(wp)                               ::   glob_sum   ! global masked sum
+      !!
+      INTEGER :: jk
+      !!-----------------------------------------------------------------------
+      !
+      glob_sum = 0.e0
+      DO jk = 1, jpk
+         glob_sum = glob_sum + SUM( ptab(:,:,jk)*tmask_i(:,:) )
+      END DO
+      IF( lk_mpp )   CALL mpp_sum( glob_sum )
+      !
+   END FUNCTION glob_sum_3d
+
+
+   FUNCTION glob_sum_2d_a( ptab1, ptab2 ) RESULT( glob_sum )
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_sum_2D _a ***
+      !!
+      !! ** Purpose : perform a masked sum on the inner global domain of two 2D array
+      !!-----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab1, ptab2   ! input 2D array
+      REAL(wp)            , DIMENSION(2)   ::   glob_sum       ! global masked sum
+      !!-----------------------------------------------------------------------
+      !             
+      glob_sum(1) = SUM( ptab1(:,:)*tmask_i(:,:) )
+      glob_sum(2) = SUM( ptab2(:,:)*tmask_i(:,:) )
+      IF( lk_mpp )   CALL mpp_sum( glob_sum, 2 )
+      !
+   END FUNCTION glob_sum_2d_a
+ 
+ 
+   FUNCTION glob_sum_3d_a( ptab1, ptab2 ) RESULT( glob_sum )
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_sum_3D_a ***
+      !!
+      !! ** Purpose : perform a masked sum on the inner global domain of two 3D array
+      !!-----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab1, ptab2   ! input 3D array
+      REAL(wp)            , DIMENSION(2)     ::   glob_sum       ! global masked sum
+      !!
+      INTEGER :: jk
+      !!-----------------------------------------------------------------------
+      !
+      glob_sum(:) = 0.e0
+      DO jk = 1, jpk
+         glob_sum(1) = glob_sum(1) + SUM( ptab1(:,:,jk)*tmask_i(:,:) )
+         glob_sum(2) = glob_sum(2) + SUM( ptab2(:,:,jk)*tmask_i(:,:) )
+      END DO
+      IF( lk_mpp )   CALL mpp_sum( glob_sum, 2 )
+      !
+   END FUNCTION glob_sum_3d_a
+
+#else  
+   !!----------------------------------------------------------------------
+   !!   'key_mpp_rep'                                   MPP reproducibility
+   !!----------------------------------------------------------------------
+   
+   FUNCTION glob_sum_2d( ptab ) RESULT( glob_sum )
+      !!----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_sum_2d ***
+      !!
+      !! ** Purpose : perform a sum in calling DDPDD routine
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(jpi,jpj) ::   ptab
+      REAL(wp)                                 ::   glob_sum   ! global masked sum
+      !!
+      COMPLEX(wp)::   ctmp
+      REAL(wp)   ::   ztmp
+      INTEGER    ::   ji, jj   ! dummy loop indices
+      !!-----------------------------------------------------------------------
+      !
+      ztmp = 0.e0
+      ctmp = CMPLX( 0.e0, 0.e0, wp )
+      DO jj = 1, jpj
+         DO ji =1, jpi
+         ztmp =  ptab(ji,jj) * tmask_i(ji,jj)
+         CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
+         END DO
+      END DO
+      IF( lk_mpp )   CALL mpp_sum( ctmp )   ! sum over the global domain
+      glob_sum = REAL(ctmp,wp)
+      !
+   END FUNCTION glob_sum_2d   
+
+
+   FUNCTION glob_sum_3d( ptab ) RESULT( glob_sum )
+      !!----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_sum_3d ***
+      !!
+      !! ** Purpose : perform a sum on a 3D array in calling DDPDD routine
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   ptab
+      REAL(wp)                                     ::   glob_sum   ! global masked sum
+      !!
+      COMPLEX(wp)::   ctmp
+      REAL(wp)   ::   ztmp
+      INTEGER    ::   ji, jj, jk   ! dummy loop indices
+      !!-----------------------------------------------------------------------
+      !
+      ztmp = 0.e0
+      ctmp = CMPLX( 0.e0, 0.e0, wp )
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji =1, jpi
+            ztmp =  ptab(ji,jj,jk) * tmask_i(ji,jj)
+            CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
+            END DO
+         END DO    
+      END DO
+      IF( lk_mpp )   CALL mpp_sum( ctmp )   ! sum over the global domain
+      glob_sum = REAL(ctmp,wp)
+      !
+   END FUNCTION glob_sum_3d   
+
+
+   FUNCTION glob_sum_2d_a( ptab1, ptab2 ) RESULT( glob_sum )
+      !!----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_sum_2d_a ***
+      !!
+      !! ** Purpose : perform a sum on two 2D arrays in calling DDPDD routine
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(jpi,jpj) ::   ptab1, ptab2
+      REAL(wp)                                 ::   glob_sum   ! global masked sum
+      !!
+      COMPLEX(wp)::   ctmp
+      REAL(wp)   ::   ztmp
+      INTEGER    ::   ji, jj   ! dummy loop indices
+      !!-----------------------------------------------------------------------
+      !
+      ztmp = 0.e0
+      ctmp = CMPLX( 0.e0, 0.e0, wp )
+      DO jj = 1, jpj
+         DO ji =1, jpi
+         ztmp =  ptab1(ji,jj) * tmask_i(ji,jj)
+         CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
+         ztmp =  ptab2(ji,jj) * tmask_i(ji,jj)
+         CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
+         END DO
+      END DO
+      IF( lk_mpp )   CALL mpp_sum( ctmp )   ! sum over the global domain
+      glob_sum = REAL(ctmp,wp)
+      !
+   END FUNCTION glob_sum_2d_a   
+
+
+   FUNCTION glob_sum_3d_a( ptab1, ptab2 ) RESULT( glob_sum )
+      !!----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_sum_3d_a ***
+      !!
+      !! ** Purpose : perform a sum on two 3D array in calling DDPDD routine
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   ptab1, ptab2
+      REAL(wp)                                     ::   glob_sum   ! global masked sum
+      !!
+      COMPLEX(wp)::   ctmp
+      REAL(wp)   ::   ztmp
+      INTEGER    ::   ji, jj, jk   ! dummy loop indices
+      !!-----------------------------------------------------------------------
+      !
+      ztmp = 0.e0
+      ctmp = CMPLX( 0.e0, 0.e0, wp )
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji =1, jpi
+            ztmp =  ptab1(ji,jj,jk) * tmask_i(ji,jj)
+            CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
+            ztmp =  ptab2(ji,jj,jk) * tmask_i(ji,jj)
+            CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
+            END DO
+         END DO    
+      END DO
+      IF( lk_mpp )   CALL mpp_sum( ctmp )   ! sum over the global domain
+      glob_sum = REAL(ctmp,wp)
+      !
+   END FUNCTION glob_sum_3d_a   
+
+
+   SUBROUTINE DDPDD( ydda, yddb )
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE DDPDD ***
+      !!          
+      !! ** Purpose : Add a scalar element to a sum
+      !!             
+      !!
+      !! ** Method  : The code uses the compensated summation with doublet 
+      !!              (sum,error) emulated useing complex numbers. ydda is the
+      !!               scalar to add to the summ yddb 
+      !! 
+      !! ** Action  : This does only work for MPI. 
+      !!
+      !! References : Using Acurate Arithmetics to Improve Numerical
+      !!              Reproducibility and Sability in Parallel Applications
+      !!              Yun HE and Chris H. Q. DING, Journal of Supercomputing 18, 259-277, 2001 
+      !!----------------------------------------------------------------------
+      COMPLEX(wp), INTENT(in   ) ::   ydda
+      COMPLEX(wp), INTENT(inout) ::   yddb
+      !
+      REAL(wp) :: zerr, zt1, zt2  ! local work variables
+      !!-----------------------------------------------------------------------
+      !
+      ! Compute ydda + yddb using Knuth's trick.
+      zt1  = REAL(ydda) + REAL(yddb)
+      zerr = zt1 - REAL(ydda)
+      zt2  = ( (REAL(yddb) - zerr) + (REAL(ydda) - (zt1 - zerr)) )   &
+         &   + AIMAG(ydda)         + AIMAG(yddb)
+      !
+      ! The result is t1 + t2, after normalization.
+      yddb = CMPLX( zt1 + zt2, zt2 - ((zt1 + zt2) - zt1), wp )
+      !
+   END SUBROUTINE DDPDD
+#endif
+
+#if defined key_nosignedzero
+   !!----------------------------------------------------------------------
+   !!   'key_nosignedzero'                                         F90 SIGN
+   !!----------------------------------------------------------------------
+   
+   FUNCTION SIGN_SCALAR( pa, pb )
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION SIGN_SCALAR  ***
+      !!
+      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
+      !!-----------------------------------------------------------------------
+      REAL(wp) :: pa,pb          ! input
+      REAL(wp) :: SIGN_SCALAR    ! result
+      !!-----------------------------------------------------------------------
+      IF ( pb >= 0.e0) THEN   ;   SIGN_SCALAR = ABS(pa)
+      ELSE                    ;   SIGN_SCALAR =-ABS(pa)
+      ENDIF
+   END FUNCTION SIGN_SCALAR
+
+
+   FUNCTION SIGN_ARRAY_1D( pa, pb ) 
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION SIGN_ARRAY_1D  ***
+      !!
+      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
+      !!-----------------------------------------------------------------------
+      REAL(wp) :: pa,pb(:)                   ! input
+      REAL(wp) :: SIGN_ARRAY_1D(SIZE(pb,1))  ! result
+      !!-----------------------------------------------------------------------
+      WHERE ( pb >= 0.e0 )   ;   SIGN_ARRAY_1D = ABS(pa)
+      ELSEWHERE              ;   SIGN_ARRAY_1D =-ABS(pa)
+      END WHERE
+   END FUNCTION SIGN_ARRAY_1D
+
+
+   FUNCTION SIGN_ARRAY_2D(pa,pb) 
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION SIGN_ARRAY_2D  ***
+      !!
+      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
+      !!-----------------------------------------------------------------------
+      REAL(wp) :: pa,pb(:,:)      ! input
+      REAL(wp) :: SIGN_ARRAY_2D(SIZE(pb,1),SIZE(pb,2))  ! result
+      !!-----------------------------------------------------------------------
+      WHERE ( pb >= 0.e0 )   ;   SIGN_ARRAY_2D = ABS(pa)
+      ELSEWHERE              ;   SIGN_ARRAY_2D =-ABS(pa)
+      END WHERE
+   END FUNCTION SIGN_ARRAY_2D
+
+   FUNCTION SIGN_ARRAY_3D(pa,pb) 
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION SIGN_ARRAY_3D  ***
+      !!
+      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
+      !!-----------------------------------------------------------------------
+      REAL(wp) :: pa,pb(:,:,:)      ! input
+      REAL(wp) :: SIGN_ARRAY_3D(SIZE(pb,1),SIZE(pb,2),SIZE(pb,3))  ! result
+      !!-----------------------------------------------------------------------
+      WHERE ( pb >= 0.e0 )   ;   SIGN_ARRAY_3D = ABS(pa)
+      ELSEWHERE              ;   SIGN_ARRAY_3D =-ABS(pa)
+      END WHERE
+   END FUNCTION SIGN_ARRAY_3D
+
+
+   FUNCTION SIGN_ARRAY_1D_A(pa,pb) 
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION SIGN_ARRAY_1D_A  ***
+      !!
+      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
+      !!-----------------------------------------------------------------------
+      REAL(wp) :: pa(:),pb(:)      ! input
+      REAL(wp) :: SIGN_ARRAY_1D_A(SIZE(pb,1))  ! result
+      !!-----------------------------------------------------------------------
+      WHERE ( pb >= 0.e0 )   ;   SIGN_ARRAY_1D_A = ABS(pa)
+      ELSEWHERE              ;   SIGN_ARRAY_1D_A =-ABS(pa)
+      END WHERE
+   END FUNCTION SIGN_ARRAY_1D_A
+
+
+   FUNCTION SIGN_ARRAY_2D_A(pa,pb) 
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION SIGN_ARRAY_2D_A  ***
+      !!
+      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
+      !!-----------------------------------------------------------------------
+      REAL(wp) :: pa(:,:),pb(:,:)      ! input
+      REAL(wp) :: SIGN_ARRAY_2D_A(SIZE(pb,1),SIZE(pb,2))  ! result
+      !!-----------------------------------------------------------------------
+      WHERE ( pb >= 0.e0 )   ;   SIGN_ARRAY_2D_A = ABS(pa)
+      ELSEWHERE              ;   SIGN_ARRAY_2D_A =-ABS(pa)
+      END WHERE
+   END FUNCTION SIGN_ARRAY_2D_A
+
+
+   FUNCTION SIGN_ARRAY_3D_A(pa,pb) 
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION SIGN_ARRAY_3D_A  ***
+      !!
+      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
+      !!-----------------------------------------------------------------------
+      REAL(wp) :: pa(:,:,:),pb(:,:,:)  ! input
+      REAL(wp) :: SIGN_ARRAY_3D_A(SIZE(pb,1),SIZE(pb,2),SIZE(pb,3)) ! result
+      !!-----------------------------------------------------------------------
+      WHERE ( pb >= 0.e0 )   ;   SIGN_ARRAY_3D_A = ABS(pa)
+      ELSEWHERE              ;   SIGN_ARRAY_3D_A =-ABS(pa)
+      END WHERE
+   END FUNCTION SIGN_ARRAY_3D_A
+
+
+   FUNCTION SIGN_ARRAY_1D_B(pa,pb) 
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION SIGN_ARRAY_1D_B  ***
+      !!
+      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
+      !!-----------------------------------------------------------------------
+      REAL(wp) :: pa(:),pb      ! input
+      REAL(wp) :: SIGN_ARRAY_1D_B(SIZE(pa,1))  ! result
+      !!-----------------------------------------------------------------------
+      IF( pb >= 0.e0 ) THEN   ;   SIGN_ARRAY_1D_B = ABS(pa)
+      ELSE                    ;   SIGN_ARRAY_1D_B =-ABS(pa)
+      ENDIF
+   END FUNCTION SIGN_ARRAY_1D_B
+
+
+   FUNCTION SIGN_ARRAY_2D_B(pa,pb) 
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION SIGN_ARRAY_2D_B  ***
+      !!
+      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
+      !!-----------------------------------------------------------------------
+      REAL(wp) :: pa(:,:),pb      ! input
+      REAL(wp) :: SIGN_ARRAY_2D_B(SIZE(pa,1),SIZE(pa,2))  ! result
+      !!-----------------------------------------------------------------------
+      IF( pb >= 0.e0 ) THEN   ;   SIGN_ARRAY_2D_B = ABS(pa)
+      ELSE                    ;   SIGN_ARRAY_2D_B =-ABS(pa)
+      ENDIF
+   END FUNCTION SIGN_ARRAY_2D_B
+
+
+   FUNCTION SIGN_ARRAY_3D_B(pa,pb) 
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION SIGN_ARRAY_3D_B  ***
+      !!
+      !! ** Purpose : overwrite f95 behaviour of intrinsinc sign function
+      !!-----------------------------------------------------------------------
+      REAL(wp) :: pa(:,:,:),pb      ! input
+      REAL(wp) :: SIGN_ARRAY_3D_B(SIZE(pa,1),SIZE(pa,2),SIZE(pa,3))  ! result
+      !!-----------------------------------------------------------------------
+      IF( pb >= 0.e0 ) THEN   ;   SIGN_ARRAY_3D_B = ABS(pa)
+      ELSE                    ;   SIGN_ARRAY_3D_B =-ABS(pa)
+      ENDIF
+   END FUNCTION SIGN_ARRAY_3D_B
+#endif
+
+   !!======================================================================
+END MODULE lib_fortran
Index: trunk/NEMOGCM/NEMO/OPA_SRC/lib_mpp.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/lib_mpp.F90	(revision 2527)
+++ 	(revision )
@@ -1,2463 +1,0 @@
-MODULE lib_mpp
-   !!======================================================================
-   !!                       ***  MODULE  lib_mpp  ***
-   !! Ocean numerics:  massively parallel processing library
-   !!=====================================================================
-   !! History :  OPA  !  1994  (M. Guyon, J. Escobar, M. Imbard)  Original code
-   !!            7.0  !  1997  (A.M. Treguier)  SHMEM additions
-   !!            8.0  !  1998  (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI
-   !!                 !  1998  (J.M. Molines) Open boundary conditions
-   !!   NEMO     1.0  !  2003  (J.-M. Molines, G. Madec)  F90, free form
-   !!                 !  2003  (J.M. Molines) add mpp_ini_north(_3d,_2d)
-   !!             -   !  2004  (R. Bourdalle Badie)  isend option in mpi
-   !!                 !  2004  (J.M. Molines) minloc, maxloc
-   !!             -   !  2005  (G. Madec, S. Masson)  npolj=5,6 F-point & ice cases
-   !!             -   !  2005  (R. Redler) Replacement of MPI_COMM_WORLD except for MPI_Abort
-   !!             -   !  2005  (R. Benshila, G. Madec)  add extra halo case
-   !!             -   !  2008  (R. Benshila) add mpp_ini_ice
-   !!            3.2  !  2009  (R. Benshila) SHMEM suppression, north fold in lbc_nfd
-   !!            3.2  !  2009  (O. Marti)    add mpp_ini_znl 
-   !!----------------------------------------------------------------------
-#if   defined key_mpp_mpi  
-   !!----------------------------------------------------------------------
-   !!   'key_mpp_mpi'             MPI massively parallel processing library
-   !!----------------------------------------------------------------------
-   !!   mynode      : indentify the processor unit
-   !!   mpp_lnk     : interface (defined in lbclnk) for message passing of 2d or 3d arrays (mpp_lnk_2d, mpp_lnk_3d)
-   !!   mpp_lnk_3d_gather :  Message passing manadgement for two 3D arrays
-   !!   mpp_lnk_e   : interface (defined in lbclnk) for message passing of 2d array with extra halo (mpp_lnk_2d_e)
-   !!   mpprecv     :
-   !!   mppsend     :   SUBROUTINE mpp_ini_znl
-   !!   mppscatter  :
-   !!   mppgather   :
-   !!   mpp_min     : generic interface for mppmin_int , mppmin_a_int , mppmin_real, mppmin_a_real
-   !!   mpp_max     : generic interface for mppmax_int , mppmax_a_int , mppmax_real, mppmax_a_real
-   !!   mpp_sum     : generic interface for mppsum_int , mppsum_a_int , mppsum_real, mppsum_a_real
-   !!   mpp_minloc  :
-   !!   mpp_maxloc  :
-   !!   mppsync     :
-   !!   mppstop     :
-   !!   mppobc      : variant of mpp_lnk for open boundary condition
-   !!   mpp_ini_north : initialisation of north fold
-   !!   mpp_lbc_north : north fold processors gathering
-   !!   mpp_lbc_north_e : variant of mpp_lbc_north for extra outer halo
-   !!----------------------------------------------------------------------
-   !! History :
-   !!        !  94 (M. Guyon, J. Escobar, M. Imbard)  Original code
-   !!        !  97  (A.M. Treguier)  SHMEM additions
-   !!        !  98  (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI
-   !!   9.0  !  03  (J.-M. Molines, G. Madec)  F90, free form
-   !!        !  04  (R. Bourdalle Badie)  isend option in mpi
-   !!        !  05  (G. Madec, S. Masson)  npolj=5,6 F-point & ice cases
-   !!        !  05  (R. Redler) Replacement of MPI_COMM_WORLD except for MPI_Abort
-   !!        !  09  (R. Benshila) SHMEM suppression, north fold in lbc_nfd
-   !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!---------------------------------------------------------------------
-   !! * Modules used
-   USE dom_oce                    ! ocean space and time domain 
-   USE in_out_manager             ! I/O manager
-   USE lbcnfd                     ! north fold treatment
-
-   IMPLICIT NONE
-   PRIVATE
-   
-   PUBLIC   mynode, mppstop, mppsync, mpp_comm_free
-   PUBLIC   mpp_ini_north, mpp_lbc_north, mpp_lbc_north_e
-   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   mpprecv, mppsend, mppscatter, mppgather
-   PUBLIC   mppobc, mpp_ini_ice, mpp_ini_znl
-#if defined key_oasis3 || defined key_oasis4
-   PUBLIC   mppsize, mpprank
-#endif
-
-   !! * Interfaces
-   !! define generic interface for these routine as they are called sometimes
-   !! with scalar arguments instead of array arguments, which causes problems
-   !! for the compilation on AIX system as well as NEC and SGI. Ok on COMPACQ
-   INTERFACE mpp_min
-      MODULE PROCEDURE mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real
-   END INTERFACE
-   INTERFACE mpp_max
-      MODULE PROCEDURE mppmax_a_int, mppmax_int, mppmax_a_real, mppmax_real
-   END INTERFACE
-   INTERFACE mpp_sum
-      MODULE PROCEDURE mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real
-   END INTERFACE
-   INTERFACE mpp_lbc_north
-      MODULE PROCEDURE mpp_lbc_north_3d, mpp_lbc_north_2d 
-   END INTERFACE
-   INTERFACE mpp_minloc
-      MODULE PROCEDURE mpp_minloc2d ,mpp_minloc3d
-   END INTERFACE
-   INTERFACE mpp_maxloc
-      MODULE PROCEDURE mpp_maxloc2d ,mpp_maxloc3d
-   END INTERFACE
-
-
-   !! ========================= !!
-   !!  MPI  variable definition !!
-   !! ========================= !!
-!$AGRIF_DO_NOT_TREAT
-   INCLUDE 'mpif.h'
-!$AGRIF_END_DO_NOT_TREAT
-   
-   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .TRUE.    !: mpp flag
-
-   INTEGER, PARAMETER         ::   nprocmax = 2**10   ! maximun dimension (required to be a power of 2)
-   
-   INTEGER ::   mppsize        ! number of process
-   INTEGER ::   mpprank        ! process number  [ 0 - size-1 ]
-!$AGRIF_DO_NOT_TREAT
-   INTEGER, PUBLIC ::   mpi_comm_opa   ! opa local communicator
-!$AGRIF_END_DO_NOT_TREAT
-
-   ! variables used in case of sea-ice
-   INTEGER, PUBLIC ::   ncomm_ice       !: communicator made by the processors with sea-ice
-   INTEGER ::   ngrp_ice        !  group ID for the ice processors (for rheology)
-   INTEGER ::   ndim_rank_ice   !  number of 'ice' processors
-   INTEGER ::   n_ice_root      !  number (in the comm_ice) of proc 0 in the ice comm
-   INTEGER, DIMENSION(:), ALLOCATABLE ::   nrank_ice     ! dimension ndim_rank_ice
-
-   ! variables used for zonal integration
-   INTEGER, PUBLIC ::   ncomm_znl       !: communicator made by the processors on the same zonal average
-   LOGICAL, PUBLIC ::   l_znl_root      ! True on the 'left'most processor on the same row
-   INTEGER ::   ngrp_znl        ! group ID for the znl processors
-   INTEGER ::   ndim_rank_znl   ! number of processors on the same zonal average
-   INTEGER, DIMENSION(:), ALLOCATABLE ::   nrank_znl  ! dimension ndim_rank_znl, number of the procs into the same znl domain
-   
-   ! North fold condition in mpp_mpi with jpni > 1
-   INTEGER ::   ngrp_world        ! group ID for the world processors
-   INTEGER ::   ngrp_opa          ! group ID for the opa processors
-   INTEGER ::   ngrp_north        ! group ID for the northern processors (to be fold)
-   INTEGER ::   ncomm_north       ! communicator made by the processors belonging to ngrp_north
-   INTEGER ::   ndim_rank_north   ! number of 'sea' processor in the northern line (can be /= jpni !)
-   INTEGER ::   njmppmax          ! value of njmpp for the processors of the northern line
-   INTEGER ::   north_root        ! number (in the comm_opa) of proc 0 in the northern comm
-   INTEGER, DIMENSION(:), ALLOCATABLE ::   nrank_north   ! dimension ndim_rank_north
-
-   ! Type of send : standard, buffered, immediate
-   CHARACTER(len=1) ::   cn_mpi_send = 'S'    ! type od mpi send/recieve (S=standard, B=bsend, I=isend)
-   LOGICAL          ::   l_isend = .FALSE.   ! isend use indicator (T if cn_mpi_send='I')
-   INTEGER          ::   nn_buffer = 0       ! size of the buffer in case of mpi_bsend 
-      
-   REAL(wp), ALLOCATABLE, DIMENSION(:) :: tampon  ! buffer in case of bsend
-
-   ! message passing arrays
-   REAL(wp), DIMENSION(jpi,jprecj,jpk,2,2) ::   t4ns, t4sn   ! 2 x 3d for north-south & south-north
-   REAL(wp), DIMENSION(jpj,jpreci,jpk,2,2) ::   t4ew, t4we   ! 2 x 3d for east-west & west-east
-   REAL(wp), DIMENSION(jpi,jprecj,jpk,2,2) ::   t4p1, t4p2   ! 2 x 3d for north fold
-   REAL(wp), DIMENSION(jpi,jprecj,jpk,2)   ::   t3ns, t3sn   ! 3d for north-south & south-north
-   REAL(wp), DIMENSION(jpj,jpreci,jpk,2)   ::   t3ew, t3we   ! 3d for east-west & west-east
-   REAL(wp), DIMENSION(jpi,jprecj,jpk,2)   ::   t3p1, t3p2   ! 3d for north fold
-   REAL(wp), DIMENSION(jpi,jprecj,2)       ::   t2ns, t2sn   ! 2d for north-south & south-north
-   REAL(wp), DIMENSION(jpj,jpreci,2)       ::   t2ew, t2we   ! 2d for east-west & west-east
-   REAL(wp), DIMENSION(jpi,jprecj,2)       ::   t2p1, t2p2   ! 2d for north fold
-   REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,jprecj+jpr2dj,2) ::   tr2ns, tr2sn  ! 2d for north-south & south-north + extra outer halo
-   REAL(wp), DIMENSION(1-jpr2dj:jpj+jpr2dj,jpreci+jpr2di,2) ::   tr2ew, tr2we  ! 2d for east-west   & west-east   + extra outer halo
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
-   !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   FUNCTION mynode(ldtxt, localComm)
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mynode  ***
-      !!                    
-      !! ** Purpose :   Find processor unit
-      !!
-      !!----------------------------------------------------------------------
-      CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt 
-      INTEGER, OPTIONAL            , INTENT(in   ) ::   localComm
-      INTEGER ::   mynode, ierr, code
-      LOGICAL ::   mpi_was_called
-      
-      NAMELIST/nammpp/ cn_mpi_send, nn_buffer
-      !!----------------------------------------------------------------------
-      !
-      WRITE(ldtxt(1),*)
-      WRITE(ldtxt(2),*) 'mynode : mpi initialisation'
-      WRITE(ldtxt(3),*) '~~~~~~ '
-      !
-      REWIND( numnam )               ! Namelist namrun : parameters of the run
-      READ  ( numnam, nammpp )
-      !                              ! control print
-      WRITE(ldtxt(4),*) '   Namelist nammpp'
-      WRITE(ldtxt(5),*) '      mpi send type                      cn_mpi_send = ', cn_mpi_send
-      WRITE(ldtxt(6),*) '      size in bytes of exported buffer   nn_buffer   = ', nn_buffer
-
-      CALL mpi_initialized ( mpi_was_called, code )
-      IF( code /= MPI_SUCCESS ) THEN
-         WRITE(*, cform_err)
-         WRITE(*, *) 'lib_mpp: Error in routine mpi_initialized'
-         CALL mpi_abort( mpi_comm_world, code, ierr )
-      ENDIF
-
-      IF( mpi_was_called ) THEN
-         !
-         SELECT CASE ( cn_mpi_send )
-         CASE ( 'S' )                ! Standard mpi send (blocking)
-            WRITE(ldtxt(7),*) '           Standard blocking mpi send (send)'
-         CASE ( 'B' )                ! Buffer mpi send (blocking)
-            WRITE(ldtxt(7),*) '           Buffer blocking mpi send (bsend)'
-            CALL mpi_init_opa( ierr ) 
-         CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
-            WRITE(ldtxt(7),*) '           Immediate non-blocking send (isend)'
-            l_isend = .TRUE.
-         CASE DEFAULT
-            WRITE(ldtxt(7),cform_err)
-            WRITE(ldtxt(8),*) '           bad value for cn_mpi_send = ', cn_mpi_send
-            nstop = nstop + 1
-         END SELECT
-      ELSE IF ( PRESENT(localComm) .and. .not. mpi_was_called ) THEN
-         WRITE(ldtxt(7),*) ' lib_mpp: You cannot provide a local communicator '
-         WRITE(ldtxt(8),*) '          without calling MPI_Init before ! '
-         nstop = nstop + 1
-      ELSE
-         SELECT CASE ( cn_mpi_send )
-         CASE ( 'S' )                ! Standard mpi send (blocking)
-            WRITE(ldtxt(7),*) '           Standard blocking mpi send (send)'
-            CALL mpi_init( ierr )
-         CASE ( 'B' )                ! Buffer mpi send (blocking)
-            WRITE(ldtxt(7),*) '           Buffer blocking mpi send (bsend)'
-            CALL mpi_init_opa( ierr )
-         CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
-            WRITE(ldtxt(7),*) '           Immediate non-blocking send (isend)'
-            l_isend = .TRUE.
-            CALL mpi_init( ierr )
-         CASE DEFAULT
-            WRITE(ldtxt(7),cform_err)
-            WRITE(ldtxt(8),*) '           bad value for cn_mpi_send = ', cn_mpi_send
-            nstop = nstop + 1
-         END SELECT
-         !
-      ENDIF
-
-      IF( PRESENT(localComm) ) THEN 
-         IF( Agrif_Root() ) THEN
-            mpi_comm_opa = localComm
-         ENDIF
-      ELSE
-         CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code)
-         IF( code /= MPI_SUCCESS ) THEN
-            WRITE(*, cform_err)
-            WRITE(*, *) ' lib_mpp: Error in routine mpi_comm_dup'
-            CALL mpi_abort( mpi_comm_world, code, ierr )
-         ENDIF
-      ENDIF 
-
-      CALL mpi_comm_rank( mpi_comm_opa, mpprank, ierr )
-      CALL mpi_comm_size( mpi_comm_opa, mppsize, ierr )
-      mynode = mpprank
-      !
-   END FUNCTION mynode
-
-
-   SUBROUTINE mpp_lnk_3d( ptab, cd_type, psgn, cd_mpp, pval )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_3d  ***
-      !!
-      !! ** Purpose :   Message passing manadgement
-      !!
-      !! ** Method  :   Use mppsend and mpprecv function for passing mask 
-      !!      between processors following neighboring subdomains.
-      !!            domain parameters
-      !!                    nlci   : first dimension of the local subdomain
-      !!                    nlcj   : second dimension of the local subdomain
-      !!                    nbondi : mark for "east-west local boundary"
-      !!                    nbondj : mark for "north-south local boundary"
-      !!                    noea   : number for local neighboring processors 
-      !!                    nowe   : number for local neighboring processors
-      !!                    noso   : number for local neighboring processors
-      !!                    nono   : number for local neighboring processors
-      !!
-      !! ** Action  :   ptab with update value at its periphery
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied
-      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
-      !                                                             ! = T , U , V , F , W points
-      REAL(wp)                        , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
-      !                                                             ! =  1. , the sign is kept
-      CHARACTER(len=3), OPTIONAL      , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only 
-      REAL(wp)        , OPTIONAL      , INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
-      !!
-      INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices
-      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
-      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
-      REAL(wp) ::   zland
-      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
-      !!----------------------------------------------------------------------
-
-      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
-      ELSE                         ;   zland = 0.e0      ! zero by default
-      ENDIF
-
-      ! 1. standard boundary treatment
-      ! ------------------------------
-      IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values
-         !
-         ! WARNING ptab is defined only between nld and nle
-         DO jk = 1, jpk
-            DO jj = nlcj+1, jpj                 ! added line(s)   (inner only)
-               ptab(nldi  :nlei  , jj          ,jk) = ptab(nldi:nlei,     nlej,jk)   
-               ptab(1     :nldi-1, jj          ,jk) = ptab(nldi     ,     nlej,jk)
-               ptab(nlei+1:nlci  , jj          ,jk) = ptab(     nlei,     nlej,jk)
-            END DO
-            DO ji = nlci+1, jpi                 ! added column(s) (full)
-               ptab(ji           ,nldj  :nlej  ,jk) = ptab(     nlei,nldj:nlej,jk)
-               ptab(ji           ,1     :nldj-1,jk) = ptab(     nlei,nldj     ,jk)
-               ptab(ji           ,nlej+1:jpj   ,jk) = ptab(     nlei,     nlej,jk)
-            END DO
-         END DO
-         !
-      ELSE                              ! standard close or cyclic treatment 
-         !
-         !                                   ! East-West boundaries
-         !                                        !* Cyclic east-west
-         IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
-            ptab( 1 ,:,:) = ptab(jpim1,:,:)
-            ptab(jpi,:,:) = ptab(  2  ,:,:)
-         ELSE                                     !* closed
-            IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:,:) = zland    ! south except F-point
-                                         ptab(nlci-jpreci+1:jpi   ,:,:) = zland    ! north
-         ENDIF
-         !                                   ! North-South boundaries (always closed)
-         IF( .NOT. cd_type == 'F' )   ptab(:,     1       :jprecj,:) = zland       ! south except F-point
-                                      ptab(:,nlcj-jprecj+1:jpj   ,:) = zland       ! north
-         !
-      ENDIF
-
-      ! 2. East and west directions exchange
-      ! ------------------------------------
-      ! we play with the neigbours AND the row number because of the periodicity 
-      !
-      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
-            t3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)
-            t3we(:,jl,:,1) = ptab(iihom +jl,:,:)
-         END DO
-      END SELECT  
-      !
-      !                           ! Migrations
-      imigr = jpreci * jpj * jpk
-      !
-      SELECT CASE ( nbondi ) 
-      CASE ( -1 )
-         CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req1 )
-         CALL mpprecv( 1, t3ew(1,1,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 )
-         CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req2 )
-         CALL mpprecv( 1, t3ew(1,1,1,2), imigr )
-         CALL mpprecv( 2, t3we(1,1,1,2), imigr )
-         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, t3ew(1,1,1,1), imigr, nowe, ml_req1 )
-         CALL mpprecv( 2, t3we(1,1,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      iihom = nlci-jpreci
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         DO jl = 1, jpreci
-            ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)
-         END DO
-      CASE ( 0 ) 
-         DO jl = 1, jpreci
-            ptab(jl      ,:,:) = t3we(:,jl,:,2)
-            ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jpreci
-            ptab(jl      ,:,:) = t3we(:,jl,:,2)
-         END DO
-      END SELECT
-
-
-      ! 3. North and south directions
-      ! -----------------------------
-      ! always closed : we play only with the neigbours
-      !
-      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
-         ijhom = nlcj-nrecj
-         DO jl = 1, jprecj
-            t3sn(:,jl,:,1) = ptab(:,ijhom +jl,:)
-            t3ns(:,jl,:,1) = ptab(:,jprecj+jl,:)
-         END DO
-      ENDIF
-      !
-      !                           ! Migrations
-      imigr = jprecj * jpi * jpk
-      !
-      SELECT CASE ( nbondj )     
-      CASE ( -1 )
-         CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req1 )
-         CALL mpprecv( 3, t3ns(1,1,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 )
-         CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req2 )
-         CALL mpprecv( 3, t3ns(1,1,1,2), imigr )
-         CALL mpprecv( 4, t3sn(1,1,1,2), imigr )
-         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, t3ns(1,1,1,1), imigr, noso, ml_req1 )
-         CALL mpprecv( 4, t3sn(1,1,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      ijhom = nlcj-jprecj
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         DO jl = 1, jprecj
-            ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)
-         END DO
-      CASE ( 0 ) 
-         DO jl = 1, jprecj
-            ptab(:,jl      ,:) = t3sn(:,jl,:,2)
-            ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jprecj
-            ptab(:,jl,:) = t3sn(:,jl,:,2)
-         END DO
-      END SELECT
-
-
-      ! 4. north fold treatment
-      ! -----------------------
-      !
-      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
-         !
-         SELECT CASE ( jpni )
-         CASE ( 1 )     ;   CALL lbc_nfd      ( ptab, cd_type, psgn )   ! only 1 northern proc, no mpp
-         CASE DEFAULT   ;   CALL mpp_lbc_north( ptab, cd_type, psgn )   ! for all northern procs.
-         END SELECT
-         !
-      ENDIF
-      !
-   END SUBROUTINE mpp_lnk_3d
-
-
-   SUBROUTINE mpp_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_2d  ***
-      !!                  
-      !! ** Purpose :   Message passing manadgement for 2d array
-      !!
-      !! ** Method  :   Use mppsend and mpprecv function for passing mask 
-      !!      between processors following neighboring subdomains.
-      !!            domain parameters
-      !!                    nlci   : first dimension of the local subdomain
-      !!                    nlcj   : second dimension of the local subdomain
-      !!                    nbondi : mark for "east-west local boundary"
-      !!                    nbondj : mark for "north-south local boundary"
-      !!                    noea   : number for local neighboring processors 
-      !!                    nowe   : number for local neighboring processors
-      !!                    noso   : number for local neighboring processors
-      !!                    nono   : number for local neighboring processors
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d     ! 2D array on which the boundary condition is applied
-      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
-      !                                                         ! = T , U , V , F , W and I points
-      REAL(wp)                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
-      !                                                         ! =  1. , the sign is kept
-      CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only 
-      REAL(wp)        , OPTIONAL  , INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
-      !!
-      INTEGER  ::   ji, jj, jl   ! dummy loop indices
-      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
-      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
-      REAL(wp) ::   zland
-      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
-      !!----------------------------------------------------------------------
-
-      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
-      ELSE                         ;   zland = 0.e0      ! zero by default
-      ENDIF
-
-      ! 1. standard boundary treatment
-      ! ------------------------------
-      !
-      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(nldi  :nlei  , jj          ) = pt2d(nldi:nlei,     nlej)   
-            pt2d(1     :nldi-1, jj          ) = pt2d(nldi     ,     nlej)
-            pt2d(nlei+1:nlci  , jj          ) = pt2d(     nlei,     nlej)
-         END DO
-         DO ji = nlci+1, jpi                 ! added column(s) (full)
-            pt2d(ji           ,nldj  :nlej  ) = pt2d(     nlei,nldj:nlej)
-            pt2d(ji           ,1     :nldj-1) = pt2d(     nlei,nldj     )
-            pt2d(ji           ,nlej+1:jpj   ) = 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( 1 ,:) = pt2d(jpim1,:)                                    ! west
-            pt2d(jpi,:) = pt2d(  2  ,:)                                    ! east
-         ELSE                                     ! closed
-            IF( .NOT. cd_type == 'F' )   pt2d(     1       :jpreci,:) = zland    ! south except F-point
-                                         pt2d(nlci-jpreci+1:jpi   ,:) = zland    ! north
-         ENDIF
-         !                                   ! North-South boundaries (always closed)
-            IF( .NOT. cd_type == 'F' )   pt2d(:,     1       :jprecj) = zland    !south except F-point
-                                         pt2d(:,nlcj-jprecj+1:jpj   ) = zland    ! north
-         !
-      ENDIF
-
-      ! 2. East and west directions exchange
-      ! ------------------------------------
-      ! we play with the neigbours AND the row number because of the periodicity 
-      !
-      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
-            t2ew(:,jl,1) = pt2d(jpreci+jl,:)
-            t2we(:,jl,1) = pt2d(iihom +jl,:)
-         END DO
-      END SELECT
-      !
-      !                           ! Migrations
-      imigr = jpreci * jpj
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 )
-         CALL mpprecv( 1, t2ew(1,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      CASE ( 0 )
-         CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )
-         CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 )
-         CALL mpprecv( 1, t2ew(1,1,2), imigr )
-         CALL mpprecv( 2, t2we(1,1,2), imigr )
-         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, t2ew(1,1,1), imigr, nowe, ml_req1 )
-         CALL mpprecv( 2, t2we(1,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      iihom = nlci - jpreci
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         DO jl = 1, jpreci
-            pt2d(iihom+jl,:) = t2ew(:,jl,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jpreci
-            pt2d(jl      ,:) = t2we(:,jl,2)
-            pt2d(iihom+jl,:) = t2ew(:,jl,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jpreci
-            pt2d(jl      ,:) = t2we(:,jl,2)
-         END DO
-      END SELECT
-
-
-      ! 3. North and south directions
-      ! -----------------------------
-      ! always closed : we play only with the neigbours
-      !
-      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
-         ijhom = nlcj-nrecj
-         DO jl = 1, jprecj
-            t2sn(:,jl,1) = pt2d(:,ijhom +jl)
-            t2ns(:,jl,1) = pt2d(:,jprecj+jl)
-         END DO
-      ENDIF
-      !
-      !                           ! Migrations
-      imigr = jprecj * jpi
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 )
-         CALL mpprecv( 3, t2ns(1,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      CASE ( 0 )
-         CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )
-         CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 )
-         CALL mpprecv( 3, t2ns(1,1,2), imigr )
-         CALL mpprecv( 4, t2sn(1,1,2), imigr )
-         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, t2ns(1,1,1), imigr, noso, ml_req1 )
-         CALL mpprecv( 4, t2sn(1,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      ijhom = nlcj - jprecj
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         DO jl = 1, jprecj
-            pt2d(:,ijhom+jl) = t2ns(:,jl,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jprecj
-            pt2d(:,jl      ) = t2sn(:,jl,2)
-            pt2d(:,ijhom+jl) = t2ns(:,jl,2)
-         END DO
-      CASE ( 1 ) 
-         DO jl = 1, jprecj
-            pt2d(:,jl      ) = t2sn(:,jl,2)
-         END DO
-      END SELECT
-
-
-      ! 4. north fold treatment
-      ! -----------------------
-      !
-      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
-         !
-         SELECT CASE ( jpni )
-         CASE ( 1 )     ;   CALL lbc_nfd      ( pt2d, cd_type, psgn )   ! only 1 northern proc, no mpp
-         CASE DEFAULT   ;   CALL mpp_lbc_north( pt2d, cd_type, psgn )   ! for all northern procs.
-         END SELECT
-         !
-      ENDIF
-      !
-   END SUBROUTINE mpp_lnk_2d
-
-
-   SUBROUTINE mpp_lnk_3d_gather( ptab1, cd_type1, ptab2, cd_type2, psgn )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_3d_gather  ***
-      !!
-      !! ** Purpose :   Message passing manadgement for two 3D 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
-      !!
-      !! ** Action  :   ptab1 and ptab2  with update value at its periphery
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab1     ! first and second 3D array on which 
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab2     ! the boundary condition is applied
-      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1  ! nature of ptab1 and ptab2 arrays 
-      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type2  ! i.e. grid-points = T , U , V , F or W points
-      REAL(wp)                        , INTENT(in   ) ::   psgn      ! =-1 the sign change across the north fold boundary
-      !!                                                             ! =  1. , the sign is kept
-      INTEGER  ::   jl   ! dummy loop indices
-      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
-      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
-      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
-      !!----------------------------------------------------------------------
-
-      ! 1. standard boundary treatment
-      ! ------------------------------
-      !                                      ! East-West boundaries
-      !                                           !* Cyclic east-west
-      IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
-         ptab1( 1 ,:,:) = ptab1(jpim1,:,:)
-         ptab1(jpi,:,:) = ptab1(  2  ,:,:)
-         ptab2( 1 ,:,:) = ptab2(jpim1,:,:)
-         ptab2(jpi,:,:) = ptab2(  2  ,:,:)
-      ELSE                                        !* closed
-         IF( .NOT. cd_type1 == 'F' )   ptab1(     1       :jpreci,:,:) = 0.e0    ! south except at F-point
-         IF( .NOT. cd_type2 == 'F' )   ptab2(     1       :jpreci,:,:) = 0.e0
-                                       ptab1(nlci-jpreci+1:jpi   ,:,:) = 0.e0    ! north
-                                       ptab2(nlci-jpreci+1:jpi   ,:,:) = 0.e0
-      ENDIF
-
-      
-      !                                      ! North-South boundaries
-      IF( .NOT. cd_type1 == 'F' )   ptab1(:,     1       :jprecj,:) = 0.e0    ! south except at F-point
-      IF( .NOT. cd_type2 == 'F' )   ptab2(:,     1       :jprecj,:) = 0.e0
-                                    ptab1(:,nlcj-jprecj+1:jpj   ,:) = 0.e0    ! north
-                                    ptab2(:,nlcj-jprecj+1:jpj   ,:) = 0.e0
-
-
-      ! 2. East and west directions exchange
-      ! ------------------------------------
-      ! we play with the neigbours AND the row number because of the periodicity 
-      !
-      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
-            t4ew(:,jl,:,1,1) = ptab1(jpreci+jl,:,:)
-            t4we(:,jl,:,1,1) = ptab1(iihom +jl,:,:)
-            t4ew(:,jl,:,2,1) = ptab2(jpreci+jl,:,:)
-            t4we(:,jl,:,2,1) = ptab2(iihom +jl,:,:)
-         END DO
-      END SELECT
-      !
-      !                           ! Migrations
-      imigr = jpreci * jpj * jpk *2
-      !
-      SELECT CASE ( nbondi ) 
-      CASE ( -1 )
-         CALL mppsend( 2, t4we(1,1,1,1,1), imigr, noea, ml_req1 )
-         CALL mpprecv( 1, t4ew(1,1,1,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         CALL mppsend( 1, t4ew(1,1,1,1,1), imigr, nowe, ml_req1 )
-         CALL mppsend( 2, t4we(1,1,1,1,1), imigr, noea, ml_req2 )
-         CALL mpprecv( 1, t4ew(1,1,1,1,2), imigr )
-         CALL mpprecv( 2, t4we(1,1,1,1,2), imigr )
-         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, t4ew(1,1,1,1,1), imigr, nowe, ml_req1 )
-         CALL mpprecv( 2, t4we(1,1,1,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      iihom = nlci - jpreci
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         DO jl = 1, jpreci
-            ptab1(iihom+jl,:,:) = t4ew(:,jl,:,1,2)
-            ptab2(iihom+jl,:,:) = t4ew(:,jl,:,2,2)
-         END DO
-      CASE ( 0 ) 
-         DO jl = 1, jpreci
-            ptab1(jl      ,:,:) = t4we(:,jl,:,1,2)
-            ptab1(iihom+jl,:,:) = t4ew(:,jl,:,1,2)
-            ptab2(jl      ,:,:) = t4we(:,jl,:,2,2)
-            ptab2(iihom+jl,:,:) = t4ew(:,jl,:,2,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jpreci
-            ptab1(jl      ,:,:) = t4we(:,jl,:,1,2)
-            ptab2(jl      ,:,:) = t4we(:,jl,:,2,2)
-         END DO
-      END SELECT
-
-
-      ! 3. North and south directions
-      ! -----------------------------
-      ! always closed : we play only with the neigbours
-      !
-      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
-         ijhom = nlcj - nrecj
-         DO jl = 1, jprecj
-            t4sn(:,jl,:,1,1) = ptab1(:,ijhom +jl,:)
-            t4ns(:,jl,:,1,1) = ptab1(:,jprecj+jl,:)
-            t4sn(:,jl,:,2,1) = ptab2(:,ijhom +jl,:)
-            t4ns(:,jl,:,2,1) = ptab2(:,jprecj+jl,:)
-         END DO
-      ENDIF
-      !
-      !                           ! Migrations
-      imigr = jprecj * jpi * jpk * 2
-      !
-      SELECT CASE ( nbondj )     
-      CASE ( -1 )
-         CALL mppsend( 4, t4sn(1,1,1,1,1), imigr, nono, ml_req1 )
-         CALL mpprecv( 3, t4ns(1,1,1,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         CALL mppsend( 3, t4ns(1,1,1,1,1), imigr, noso, ml_req1 )
-         CALL mppsend( 4, t4sn(1,1,1,1,1), imigr, nono, ml_req2 )
-         CALL mpprecv( 3, t4ns(1,1,1,1,2), imigr )
-         CALL mpprecv( 4, t4sn(1,1,1,1,2), imigr )
-         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, t4ns(1,1,1,1,1), imigr, noso, ml_req1 )
-         CALL mpprecv( 4, t4sn(1,1,1,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      ijhom = nlcj - jprecj
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         DO jl = 1, jprecj
-            ptab1(:,ijhom+jl,:) = t4ns(:,jl,:,1,2)
-            ptab2(:,ijhom+jl,:) = t4ns(:,jl,:,2,2)
-         END DO
-      CASE ( 0 ) 
-         DO jl = 1, jprecj
-            ptab1(:,jl      ,:) = t4sn(:,jl,:,1,2)
-            ptab1(:,ijhom+jl,:) = t4ns(:,jl,:,1,2)
-            ptab2(:,jl      ,:) = t4sn(:,jl,:,2,2)
-            ptab2(:,ijhom+jl,:) = t4ns(:,jl,:,2,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jprecj
-            ptab1(:,jl,:) = t4sn(:,jl,:,1,2)
-            ptab2(:,jl,:) = t4sn(:,jl,:,2,2)
-         END DO
-      END SELECT
-
-
-      ! 4. north fold treatment
-      ! -----------------------
-      IF( npolj /= 0 ) THEN
-         !
-         SELECT CASE ( jpni )
-         CASE ( 1 )                                           
-            CALL lbc_nfd      ( ptab1, cd_type1, psgn )   ! only for northern procs.
-            CALL lbc_nfd      ( ptab2, cd_type2, psgn )
-         CASE DEFAULT
-            CALL mpp_lbc_north( ptab1, cd_type1, psgn )   ! for all northern procs.
-            CALL mpp_lbc_north (ptab2, cd_type2, psgn)
-         END SELECT 
-         !
-      ENDIF
-      !
-   END SUBROUTINE mpp_lnk_3d_gather
-
-
-   SUBROUTINE mpp_lnk_2d_e( pt2d, cd_type, psgn )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_2d_e  ***
-      !!                  
-      !! ** Purpose :   Message passing manadgement for 2d array (with halo)
-      !!
-      !! ** 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
-      !!                    jpr2di : number of rows for extra outer halo
-      !!                    jpr2dj : number of columns for extra outer halo
-      !!                    nbondi : mark for "east-west local boundary"
-      !!                    nbondj : mark for "north-south local boundary"
-      !!                    noea   : number for local neighboring processors 
-      !!                    nowe   : number for local neighboring processors
-      !!                    noso   : number for local neighboring processors
-      !!                    nono   : number for local neighboring processors
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj), INTENT(inout) ::   pt2d     ! 2D array with extra halo
-      CHARACTER(len=1)                                            , INTENT(in   ) ::   cd_type  ! nature of ptab array grid-points
-      !                                                                                         ! = T , U , V , F , W and I points
-      REAL(wp)                                                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the
-      !!                                                                                        ! north boundary, =  1. otherwise
-      INTEGER  ::   jl   ! dummy loop indices
-      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
-      INTEGER  ::   ipreci, iprecj             ! temporary integers
-      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
-      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
-      !!----------------------------------------------------------------------
-
-      ipreci = jpreci + jpr2di      ! take into account outer extra 2D overlap area
-      iprecj = jprecj + jpr2dj
-
-
-      ! 1. standard boundary treatment
-      ! ------------------------------
-      ! Order matters Here !!!!
-      !
-      !                                      !* North-South boundaries (always colsed)
-      IF( .NOT. cd_type == 'F' )   pt2d(:,  1-jpr2dj   :  jprecj  ) = 0.e0    ! south except at F-point
-                                   pt2d(:,nlcj-jprecj+1:jpj+jpr2dj) = 0.e0    ! north
-                                
-      !                                      ! East-West boundaries
-      !                                           !* Cyclic east-west
-      IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
-         pt2d(1-jpr2di:     1    ,:) = pt2d(jpim1-jpr2di:  jpim1 ,:)       ! east
-         pt2d(   jpi  :jpi+jpr2di,:) = pt2d(     2      :2+jpr2di,:)       ! west
-         !
-      ELSE                                        !* closed
-         IF( .NOT. cd_type == 'F' )   pt2d(  1-jpr2di   :jpreci    ,:) = 0.e0    ! south except at F-point
-                                      pt2d(nlci-jpreci+1:jpi+jpr2di,:) = 0.e0    ! north
-      ENDIF
-      !
-
-      ! north fold treatment
-      ! -----------------------
-      IF( npolj /= 0 ) THEN
-         !
-         SELECT CASE ( jpni )
-         CASE ( 1 )     ;   CALL lbc_nfd        ( pt2d(1:jpi,1:jpj+jpr2dj), cd_type, psgn, pr2dj=jpr2dj )
-         CASE DEFAULT   ;   CALL mpp_lbc_north_e( pt2d                    , cd_type, psgn               )
-         END SELECT 
-         !
-      ENDIF
-
-      ! 2. East and west directions exchange
-      ! ------------------------------------
-      ! we play with the neigbours AND the row number because of the periodicity 
-      !
-      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
-      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
-         iihom = nlci-nreci-jpr2di
-         DO jl = 1, ipreci
-            tr2ew(:,jl,1) = pt2d(jpreci+jl,:)
-            tr2we(:,jl,1) = pt2d(iihom +jl,:)
-         END DO
-      END SELECT
-      !
-      !                           ! Migrations
-      imigr = ipreci * ( jpj + 2*jpr2dj)
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         CALL mppsend( 2, tr2we(1-jpr2dj,1,1), imigr, noea, ml_req1 )
-         CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      CASE ( 0 )
-         CALL mppsend( 1, tr2ew(1-jpr2dj,1,1), imigr, nowe, ml_req1 )
-         CALL mppsend( 2, tr2we(1-jpr2dj,1,1), imigr, noea, ml_req2 )
-         CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr )
-         CALL mpprecv( 2, tr2we(1-jpr2dj,1,2), imigr )
-         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, tr2ew(1-jpr2dj,1,1), imigr, nowe, ml_req1 )
-         CALL mpprecv( 2, tr2we(1-jpr2dj,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      iihom = nlci - jpreci
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         DO jl = 1, ipreci
-            pt2d(iihom+jl,:) = tr2ew(:,jl,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, ipreci
-            pt2d(jl-jpr2di,:) = tr2we(:,jl,2)
-            pt2d( iihom+jl,:) = tr2ew(:,jl,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, ipreci
-            pt2d(jl-jpr2di,:) = tr2we(:,jl,2)
-         END DO
-      END SELECT
-
-
-      ! 3. North and south directions
-      ! -----------------------------
-      ! always closed : we play only with the neigbours
-      !
-      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
-         ijhom = nlcj-nrecj-jpr2dj
-         DO jl = 1, iprecj
-            tr2sn(:,jl,1) = pt2d(:,ijhom +jl)
-            tr2ns(:,jl,1) = pt2d(:,jprecj+jl)
-         END DO
-      ENDIF
-      !
-      !                           ! Migrations
-      imigr = iprecj * ( jpi + 2*jpr2di )
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         CALL mppsend( 4, tr2sn(1-jpr2di,1,1), imigr, nono, ml_req1 )
-         CALL mpprecv( 3, tr2ns(1-jpr2di,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      CASE ( 0 )
-         CALL mppsend( 3, tr2ns(1-jpr2di,1,1), imigr, noso, ml_req1 )
-         CALL mppsend( 4, tr2sn(1-jpr2di,1,1), imigr, nono, ml_req2 )
-         CALL mpprecv( 3, tr2ns(1-jpr2di,1,2), imigr )
-         CALL mpprecv( 4, tr2sn(1-jpr2di,1,2), imigr )
-         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, tr2ns(1-jpr2di,1,1), imigr, noso, ml_req1 )
-         CALL mpprecv( 4, tr2sn(1-jpr2di,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      ijhom = nlcj - jprecj  
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         DO jl = 1, iprecj
-            pt2d(:,ijhom+jl) = tr2ns(:,jl,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, iprecj
-            pt2d(:,jl-jpr2dj) = tr2sn(:,jl,2)
-            pt2d(:,ijhom+jl ) = tr2ns(:,jl,2)
-         END DO
-      CASE ( 1 ) 
-         DO jl = 1, iprecj
-            pt2d(:,jl-jpr2dj) = tr2sn(:,jl,2)
-         END DO
-      END SELECT
-
-   END SUBROUTINE mpp_lnk_2d_e
-
-
-   SUBROUTINE mppsend( ktyp, pmess, kbytes, kdest, md_req )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppsend  ***
-      !!                   
-      !! ** Purpose :   Send messag passing array
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), INTENT(inout) ::   pmess(*)   ! array of real
-      INTEGER , INTENT(in   ) ::   kbytes     ! size of the array pmess
-      INTEGER , INTENT(in   ) ::   kdest      ! receive process number
-      INTEGER , INTENT(in   ) ::   ktyp       ! tag of the message
-      INTEGER , INTENT(in   ) ::   md_req     ! argument for isend
-      !!
-      INTEGER ::   iflag
-      !!----------------------------------------------------------------------
-      !
-      SELECT CASE ( cn_mpi_send )
-      CASE ( 'S' )                ! Standard mpi send (blocking)
-         CALL mpi_send ( pmess, kbytes, mpi_double_precision, kdest , ktyp, mpi_comm_opa        , iflag )
-      CASE ( 'B' )                ! Buffer mpi send (blocking)
-         CALL mpi_bsend( pmess, kbytes, mpi_double_precision, kdest , ktyp, mpi_comm_opa        , iflag )
-      CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
-         ! be carefull, one more argument here : the mpi request identifier..
-         CALL mpi_isend( pmess, kbytes, mpi_double_precision, kdest , ktyp, mpi_comm_opa, md_req, iflag )
-      END SELECT
-      !
-   END SUBROUTINE mppsend
-
-
-   SUBROUTINE mpprecv( ktyp, pmess, kbytes )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpprecv  ***
-      !!
-      !! ** Purpose :   Receive messag passing array
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), INTENT(inout) ::   pmess(*)   ! array of real
-      INTEGER , INTENT(in   ) ::   kbytes     ! suze of the array pmess
-      INTEGER , INTENT(in   ) ::   ktyp       ! Tag of the recevied message
-      !!
-      INTEGER :: istatus(mpi_status_size)
-      INTEGER :: iflag
-      !!----------------------------------------------------------------------
-      !
-      CALL mpi_recv( pmess, kbytes, mpi_double_precision, mpi_any_source, ktyp, mpi_comm_opa, istatus, iflag )
-      !
-   END SUBROUTINE mpprecv
-
-
-   SUBROUTINE mppgather( ptab, kp, pio )
-      !!----------------------------------------------------------------------
-      !!                   ***  routine mppgather  ***
-      !!                   
-      !! ** Purpose :   Transfert between a local subdomain array and a work 
-      !!     array which is distributed following the vertical level.
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj),       INTENT(in   ) ::   ptab   ! subdomain input array
-      INTEGER ,                           INTENT(in   ) ::   kp     ! record length
-      REAL(wp), DIMENSION(jpi,jpj,jpnij), INTENT(  out) ::   pio    ! subdomain input array
-      !!
-      INTEGER :: itaille, ierror   ! temporary integer
-      !!---------------------------------------------------------------------
-      !
-      itaille = jpi * jpj
-      CALL mpi_gather( ptab, itaille, mpi_double_precision, pio, itaille     ,   &
-         &                            mpi_double_precision, kp , mpi_comm_opa, ierror ) 
-      !
-   END SUBROUTINE mppgather
-
-
-   SUBROUTINE mppscatter( pio, kp, ptab )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppscatter  ***
-      !!
-      !! ** Purpose :   Transfert between awork array which is distributed 
-      !!      following the vertical level and the local subdomain array.
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpnij)  ::  pio        ! output array
-      INTEGER                             ::   kp        ! Tag (not used with MPI
-      REAL(wp), DIMENSION(jpi,jpj)        ::  ptab       ! subdomain array input
-      !!
-      INTEGER :: itaille, ierror   ! temporary integer
-      !!---------------------------------------------------------------------
-      !
-      itaille=jpi*jpj
-      !
-      CALL mpi_scatter( pio, itaille, mpi_double_precision, ptab, itaille     ,   &
-         &                            mpi_double_precision, kp  , mpi_comm_opa, ierror )
-      !
-   END SUBROUTINE mppscatter
-
-
-   SUBROUTINE mppmax_a_int( ktab, kdim, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppmax_a_int  ***
-      !! 
-      !! ** Purpose :   Find maximum value in an integer layout array
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER , INTENT(in   )                  ::   kdim   ! size of array
-      INTEGER , INTENT(inout), DIMENSION(kdim) ::   ktab   ! input array
-      INTEGER , INTENT(in   ), OPTIONAL        ::   kcom   ! 
-      !!
-      INTEGER :: ierror, localcomm   ! temporary integer
-      INTEGER, DIMENSION(kdim) ::   iwork
-      !!----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-      CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer, mpi_max, localcomm, ierror )
-      !
-      ktab(:) = iwork(:)
-      !
-   END SUBROUTINE mppmax_a_int
-
-
-   SUBROUTINE mppmax_int( ktab, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppmax_int  ***
-      !!
-      !! ** Purpose :   Find maximum value in an integer layout array
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(inout)           ::   ktab      ! ???
-      INTEGER, INTENT(in   ), OPTIONAL ::   kcom      ! ???
-      !! 
-      INTEGER ::   ierror, iwork, localcomm   ! temporary integer
-      !!----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa 
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-      CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_max, localcomm, ierror)
-      !
-      ktab = iwork
-      !
-   END SUBROUTINE mppmax_int
-
-
-   SUBROUTINE mppmin_a_int( ktab, kdim, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppmin_a_int  ***
-      !! 
-      !! ** Purpose :   Find minimum value in an integer layout array
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER , INTENT( in  )                  ::   kdim        ! size of array
-      INTEGER , INTENT(inout), DIMENSION(kdim) ::   ktab        ! input array
-      INTEGER , INTENT( in  ), OPTIONAL        ::   kcom        ! input array
-      !!
-      INTEGER ::   ierror, localcomm   ! temporary integer
-      INTEGER, DIMENSION(kdim) ::   iwork
-      !!----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-      CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer, mpi_min, localcomm, ierror )
-      !
-      ktab(:) = iwork(:)
-      !
-   END SUBROUTINE mppmin_a_int
-
-
-   SUBROUTINE mppmin_int( ktab, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppmin_int  ***
-      !!
-      !! ** Purpose :   Find minimum value in an integer layout array
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(inout) ::   ktab      ! ???
-      INTEGER , INTENT( in  ), OPTIONAL        ::   kcom        ! input array
-      !!
-      INTEGER ::  ierror, iwork, localcomm
-      !!----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-     CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_min, localcomm, ierror )
-      !
-      ktab = iwork
-      !
-   END SUBROUTINE mppmin_int
-
-
-   SUBROUTINE mppsum_a_int( ktab, kdim )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppsum_a_int  ***
-      !!                    
-      !! ** Purpose :   Global integer sum, 1D array case
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in   )                   ::   kdim      ! ???
-      INTEGER, INTENT(inout), DIMENSION (kdim) ::   ktab      ! ???
-      !!
-      INTEGER :: ierror
-      INTEGER, DIMENSION (kdim) ::  iwork
-      !!----------------------------------------------------------------------
-      !
-      CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer, mpi_sum, mpi_comm_opa, ierror )
-      !
-      ktab(:) = iwork(:)
-      !
-   END SUBROUTINE mppsum_a_int
-
-
-   SUBROUTINE mppsum_int( ktab )
-      !!----------------------------------------------------------------------
-      !!                 ***  routine mppsum_int  ***
-      !!                  
-      !! ** Purpose :   Global integer sum
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(inout) ::   ktab
-      !! 
-      INTEGER :: ierror, iwork
-      !!----------------------------------------------------------------------
-      !
-      CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_sum, mpi_comm_opa, ierror )
-      !
-      ktab = iwork
-      !
-   END SUBROUTINE mppsum_int
-
-
-   SUBROUTINE mppmax_a_real( ptab, kdim, kcom )
-      !!----------------------------------------------------------------------
-      !!                 ***  routine mppmax_a_real  ***
-      !!                  
-      !! ** Purpose :   Maximum
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER , INTENT(in   )                  ::   kdim
-      REAL(wp), INTENT(inout), DIMENSION(kdim) ::   ptab
-      INTEGER , INTENT(in   ), OPTIONAL        ::   kcom
-      !!
-      INTEGER :: ierror, localcomm
-      REAL(wp), DIMENSION(kdim) ::  zwork
-      !!----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) ) localcomm = kcom
-      !
-      CALL mpi_allreduce( ptab, zwork, kdim, mpi_double_precision, mpi_max, localcomm, ierror )
-      ptab(:) = zwork(:)
-      !
-   END SUBROUTINE mppmax_a_real
-
-
-   SUBROUTINE mppmax_real( ptab, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppmax_real  ***
-      !!                    
-      !! ** Purpose :   Maximum
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), INTENT(inout)           ::   ptab   ! ???
-      INTEGER , INTENT(in   ), OPTIONAL ::   kcom   ! ???
-      !!
-      INTEGER  ::   ierror, localcomm
-      REAL(wp) ::   zwork
-      !!----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa 
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-      CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision, mpi_max, localcomm, ierror )
-      ptab = zwork
-      !
-   END SUBROUTINE mppmax_real
-
-
-   SUBROUTINE mppmin_a_real( ptab, kdim, kcom )
-      !!----------------------------------------------------------------------
-      !!                 ***  routine mppmin_a_real  ***
-      !!                  
-      !! ** Purpose :   Minimum of REAL, array case
-      !!
-      !!-----------------------------------------------------------------------
-      INTEGER , INTENT(in   )                  ::   kdim
-      REAL(wp), INTENT(inout), DIMENSION(kdim) ::   ptab
-      INTEGER , INTENT(in   ), OPTIONAL        ::   kcom
-      !!
-      INTEGER :: ierror, localcomm
-      REAL(wp), DIMENSION(kdim) ::   zwork
-      !!-----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa 
-      IF( PRESENT(kcom) ) localcomm = kcom
-      !
-      CALL mpi_allreduce( ptab, zwork, kdim, mpi_double_precision, mpi_min, localcomm, ierror )
-      ptab(:) = zwork(:)
-      !
-   END SUBROUTINE mppmin_a_real
-
-
-   SUBROUTINE mppmin_real( ptab, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppmin_real  ***
-      !! 
-      !! ** Purpose :   minimum of REAL, scalar case
-      !!
-      !!-----------------------------------------------------------------------
-      REAL(wp), INTENT(inout)           ::   ptab        ! 
-      INTEGER , INTENT(in   ), OPTIONAL :: kcom
-      !!
-      INTEGER  ::   ierror
-      REAL(wp) ::   zwork
-      INTEGER :: localcomm
-      !!-----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa 
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-      CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision, mpi_min, localcomm, ierror )
-      ptab = zwork
-      !
-   END SUBROUTINE mppmin_real
-
-
-   SUBROUTINE mppsum_a_real( ptab, kdim, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppsum_a_real  ***
-      !! 
-      !! ** Purpose :   global sum, REAL ARRAY argument case
-      !!
-      !!-----------------------------------------------------------------------
-      INTEGER , INTENT( in )                     ::   kdim      ! size of ptab
-      REAL(wp), DIMENSION(kdim), INTENT( inout ) ::   ptab      ! input array
-      INTEGER , INTENT( in ), OPTIONAL           :: kcom
-      !!
-      INTEGER                   ::   ierror    ! temporary integer
-      INTEGER                   ::   localcomm 
-      REAL(wp), DIMENSION(kdim) ::   zwork     ! temporary workspace 
-      !!-----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa 
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-      CALL mpi_allreduce( ptab, zwork, kdim, mpi_double_precision, mpi_sum, localcomm, ierror )
-      ptab(:) = zwork(:)
-      !
-   END SUBROUTINE mppsum_a_real
-
-
-   SUBROUTINE mppsum_real( ptab, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppsum_real  ***
-      !!              
-      !! ** Purpose :   global sum, SCALAR argument case
-      !!
-      !!-----------------------------------------------------------------------
-      REAL(wp), INTENT(inout)           ::   ptab   ! input scalar
-      INTEGER , INTENT(in   ), OPTIONAL ::   kcom
-      !!
-      INTEGER  ::   ierror, localcomm 
-      REAL(wp) ::   zwork
-      !!-----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa 
-      IF( PRESENT(kcom) ) localcomm = kcom
-      !
-      CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision, mpi_sum, localcomm, ierror )
-      ptab = zwork
-      !
-   END SUBROUTINE mppsum_real
-
-
-   SUBROUTINE mpp_minloc2d( ptab, pmask, pmin, ki,kj )
-      !!------------------------------------------------------------------------
-      !!             ***  routine mpp_minloc  ***
-      !!
-      !! ** Purpose :   Compute the global minimum of an array ptab
-      !!              and also give its global position
-      !!
-      !! ** Method  :   Use MPI_ALLREDUCE with MPI_MINLOC
-      !!
-      !!--------------------------------------------------------------------------
-      REAL(wp), DIMENSION (jpi,jpj), INTENT(in   ) ::   ptab    ! Local 2D array
-      REAL(wp), DIMENSION (jpi,jpj), INTENT(in   ) ::   pmask   ! Local mask
-      REAL(wp)                     , INTENT(  out) ::   pmin    ! Global minimum of ptab
-      INTEGER                      , INTENT(  out) ::   ki, kj   ! index of minimum in global frame
-      !!
-      INTEGER , DIMENSION(2)   ::   ilocs
-      INTEGER :: ierror
-      REAL(wp) ::   zmin   ! local minimum
-      REAL(wp), DIMENSION(2,1) ::   zain, zaout
-      !!-----------------------------------------------------------------------
-      !
-      zmin  = MINVAL( ptab(:,:) , mask= pmask == 1.e0 )
-      ilocs = MINLOC( ptab(:,:) , mask= pmask == 1.e0 )
-      !
-      ki = ilocs(1) + nimpp - 1
-      kj = ilocs(2) + njmpp - 1
-      !
-      zain(1,:)=zmin
-      zain(2,:)=ki+10000.*kj
-      !
-      CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MINLOC,MPI_COMM_OPA,ierror)
-      !
-      pmin = zaout(1,1)
-      kj = INT(zaout(2,1)/10000.)
-      ki = INT(zaout(2,1) - 10000.*kj )
-      !
-   END SUBROUTINE mpp_minloc2d
-
-
-   SUBROUTINE mpp_minloc3d( ptab, pmask, pmin, ki, kj ,kk)
-      !!------------------------------------------------------------------------
-      !!             ***  routine mpp_minloc  ***
-      !!
-      !! ** Purpose :   Compute the global minimum of an array ptab
-      !!              and also give its global position
-      !!
-      !! ** Method  :   Use MPI_ALLREDUCE with MPI_MINLOC
-      !!
-      !!--------------------------------------------------------------------------
-      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   ptab         ! Local 2D array
-      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pmask        ! Local mask
-      REAL(wp)                         , INTENT(  out) ::   pmin         ! Global minimum of ptab
-      INTEGER                          , INTENT(  out) ::   ki, kj, kk   ! index of minimum in global frame
-      !!
-      INTEGER  ::   ierror
-      REAL(wp) ::   zmin     ! local minimum
-      INTEGER , DIMENSION(3)   ::   ilocs
-      REAL(wp), DIMENSION(2,1) ::   zain, zaout
-      !!-----------------------------------------------------------------------
-      !
-      zmin  = MINVAL( ptab(:,:,:) , mask= pmask == 1.e0 )
-      ilocs = MINLOC( ptab(:,:,:) , mask= pmask == 1.e0 )
-      !
-      ki = ilocs(1) + nimpp - 1
-      kj = ilocs(2) + njmpp - 1
-      kk = ilocs(3)
-      !
-      zain(1,:)=zmin
-      zain(2,:)=ki+10000.*kj+100000000.*kk
-      !
-      CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MINLOC,MPI_COMM_OPA,ierror)
-      !
-      pmin = zaout(1,1)
-      kk   = INT( zaout(2,1) / 100000000. )
-      kj   = INT( zaout(2,1) - kk * 100000000. ) / 10000
-      ki   = INT( zaout(2,1) - kk * 100000000. -kj * 10000. )
-      !
-   END SUBROUTINE mpp_minloc3d
-
-
-   SUBROUTINE mpp_maxloc2d( ptab, pmask, pmax, ki, kj )
-      !!------------------------------------------------------------------------
-      !!             ***  routine mpp_maxloc  ***
-      !!
-      !! ** Purpose :   Compute the global maximum of an array ptab
-      !!              and also give its global position
-      !!
-      !! ** Method  :   Use MPI_ALLREDUCE with MPI_MINLOC
-      !!
-      !!--------------------------------------------------------------------------
-      REAL(wp), DIMENSION (jpi,jpj), INTENT(in   ) ::   ptab     ! Local 2D array
-      REAL(wp), DIMENSION (jpi,jpj), INTENT(in   ) ::   pmask    ! Local mask
-      REAL(wp)                     , INTENT(  out) ::   pmax     ! Global maximum of ptab
-      INTEGER                      , INTENT(  out) ::   ki, kj   ! index of maximum in global frame
-      !!  
-      INTEGER  :: ierror
-      INTEGER, DIMENSION (2)   ::   ilocs
-      REAL(wp) :: zmax   ! local maximum
-      REAL(wp), DIMENSION(2,1) ::   zain, zaout
-      !!-----------------------------------------------------------------------
-      !
-      zmax  = MAXVAL( ptab(:,:) , mask= pmask == 1.e0 )
-      ilocs = MAXLOC( ptab(:,:) , mask= pmask == 1.e0 )
-      !
-      ki = ilocs(1) + nimpp - 1
-      kj = ilocs(2) + njmpp - 1
-      !
-      zain(1,:) = zmax
-      zain(2,:) = ki + 10000. * kj
-      !
-      CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MAXLOC,MPI_COMM_OPA,ierror)
-      !
-      pmax = zaout(1,1)
-      kj   = INT( zaout(2,1) / 10000.     )
-      ki   = INT( zaout(2,1) - 10000.* kj )
-      !
-   END SUBROUTINE mpp_maxloc2d
-
-
-   SUBROUTINE mpp_maxloc3d( ptab, pmask, pmax, ki, kj, kk )
-      !!------------------------------------------------------------------------
-      !!             ***  routine mpp_maxloc  ***
-      !!
-      !! ** Purpose :  Compute the global maximum of an array ptab
-      !!              and also give its global position
-      !!
-      !! ** Method : Use MPI_ALLREDUCE with MPI_MINLOC
-      !!
-      !!--------------------------------------------------------------------------
-      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   ptab         ! Local 2D array
-      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pmask        ! Local mask
-      REAL(wp)                         , INTENT(  out) ::   pmax         ! Global maximum of ptab
-      INTEGER                          , INTENT(  out) ::   ki, kj, kk   ! index of maximum in global frame
-      !!   
-      REAL(wp) :: zmax   ! local maximum
-      REAL(wp), DIMENSION(2,1) ::   zain, zaout
-      INTEGER , DIMENSION(3)   ::   ilocs
-      INTEGER :: ierror
-      !!-----------------------------------------------------------------------
-      !
-      zmax  = MAXVAL( ptab(:,:,:) , mask= pmask == 1.e0 )
-      ilocs = MAXLOC( ptab(:,:,:) , mask= pmask == 1.e0 )
-      !
-      ki = ilocs(1) + nimpp - 1
-      kj = ilocs(2) + njmpp - 1
-      kk = ilocs(3)
-      !
-      zain(1,:)=zmax
-      zain(2,:)=ki+10000.*kj+100000000.*kk
-      !
-      CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MAXLOC,MPI_COMM_OPA,ierror)
-      !
-      pmax = zaout(1,1)
-      kk   = INT( zaout(2,1) / 100000000. )
-      kj   = INT( zaout(2,1) - kk * 100000000. ) / 10000
-      ki   = INT( zaout(2,1) - kk * 100000000. -kj * 10000. )
-      !
-   END SUBROUTINE mpp_maxloc3d
-
-
-   SUBROUTINE mppsync()
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppsync  ***
-      !!                   
-      !! ** Purpose :   Massively parallel processors, synchroneous
-      !!
-      !!-----------------------------------------------------------------------
-      INTEGER :: ierror
-      !!-----------------------------------------------------------------------
-      !
-      CALL mpi_barrier( mpi_comm_opa, ierror )
-      !
-   END SUBROUTINE mppsync
-
-
-   SUBROUTINE mppstop
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppstop  ***
-      !!                   
-      !! ** purpose :   Stop massilively parallel processors method
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER ::   info
-      !!----------------------------------------------------------------------
-      !
-      CALL mppsync
-      CALL mpi_finalize( info )
-      !
-   END SUBROUTINE mppstop
-
-
-   SUBROUTINE mppobc( ptab, kd1, kd2, kl, kk, ktype, kij )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppobc  ***
-      !! 
-      !! ** Purpose :   Message passing manadgement for open boundary
-      !!     conditions array
-      !!
-      !! ** 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 , INTENT(in   )                     ::   kd1, kd2   ! starting and ending indices
-      INTEGER , INTENT(in   )                     ::   kl         ! index of open boundary
-      INTEGER , INTENT(in   )                     ::   kk         ! vertical dimension
-      INTEGER , INTENT(in   )                     ::   ktype      ! define north/south or east/west cdt
-      !                                                           !  = 1  north/south  ;  = 2  east/west
-      INTEGER , INTENT(in   )                     ::   kij        ! horizontal dimension
-      REAL(wp), INTENT(inout), DIMENSION(kij,kk)  ::   ptab       ! variable array
-      !! 
-      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
-      INTEGER  ::   iipt0, iipt1, ilpt1   ! temporary integers
-      INTEGER  ::   ijpt0, ijpt1          !    -          -
-      INTEGER  ::   imigr, iihom, ijhom   !    -          -
-      INTEGER ::   ml_req1, ml_req2, ml_err    ! for key_mpi_isend
-      INTEGER ::   ml_stat(MPI_STATUS_SIZE)    ! for key_mpi_isend
-      REAL(wp), DIMENSION(jpi,jpj) ::   ztab   ! temporary workspace
-      !!----------------------------------------------------------------------
-
-      ! boundary condition initialization
-      ! ---------------------------------
-      ztab(:,:) = 0.e0
-      !
-      IF( ktype==1 ) THEN                                  ! north/south boundaries
-         iipt0 = MAX( 1, MIN(kd1 - nimpp+1, nlci     ) )
-         iipt1 = MAX( 0, MIN(kd2 - nimpp+1, nlci - 1 ) )
-         ilpt1 = MAX( 1, MIN(kd2 - nimpp+1, nlci     ) )
-         ijpt0 = MAX( 1, MIN(kl  - njmpp+1, nlcj     ) )
-         ijpt1 = MAX( 0, MIN(kl  - njmpp+1, nlcj - 1 ) )
-      ELSEIF( ktype==2 ) THEN                              ! east/west boundaries
-         iipt0 = MAX( 1, MIN(kl  - nimpp+1, nlci     ) )
-         iipt1 = MAX( 0, MIN(kl  - nimpp+1, nlci - 1 ) )
-         ijpt0 = MAX( 1, MIN(kd1 - njmpp+1, nlcj     ) )
-         ijpt1 = MAX( 0, MIN(kd2 - njmpp+1, nlcj - 1 ) )
-         ilpt1 = MAX( 1, MIN(kd2 - njmpp+1, nlcj     ) )
-      ELSE
-         CALL ctl_stop( 'mppobc: bad ktype' )
-      ENDIF
-      
-      ! Communication level by level
-      ! ----------------------------
-!!gm Remark : this is very time consumming!!!
-      !                                         ! ------------------------ !
-      DO jk = 1, kk                             !   Loop over the levels   !
-         !                                      ! ------------------------ !
-         !
-         IF( ktype == 1 ) THEN                               ! north/south boundaries
-            DO jj = ijpt0, ijpt1
-               DO ji = iipt0, iipt1
-                  ztab(ji,jj) = ptab(ji,jk)
-               END DO
-            END DO
-         ELSEIF( ktype == 2 ) THEN                           ! east/west boundaries
-            DO jj = ijpt0, ijpt1
-               DO ji = iipt0, iipt1
-                  ztab(ji,jj) = ptab(jj,jk)
-               END DO
-            END DO
-         ENDIF
-
-
-         ! 1. East and west directions
-         ! ---------------------------
-         !
-         IF( nbondi /= 2 ) THEN         ! Read Dirichlet lateral conditions
-            iihom = nlci-nreci
-            DO jl = 1, jpreci
-               t2ew(:,jl,1) = ztab(jpreci+jl,:)
-               t2we(:,jl,1) = ztab(iihom +jl,:)
-            END DO
-         ENDIF
-         !
-         !                              ! Migrations
-         imigr=jpreci*jpj
-         !
-         IF( nbondi == -1 ) THEN
-            CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 )
-            CALL mpprecv( 1, t2ew(1,1,2), imigr )
-            IF(l_isend)   CALL mpi_wait( ml_req1, ml_stat, ml_err )
-         ELSEIF( nbondi == 0 ) THEN
-            CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )
-            CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 )
-            CALL mpprecv( 1, t2ew(1,1,2), imigr )
-            CALL mpprecv( 2, t2we(1,1,2), imigr )
-            IF(l_isend)   CALL mpi_wait( ml_req1, ml_stat, ml_err )
-            IF(l_isend)   CALL mpi_wait( ml_req2, ml_stat, ml_err )
-         ELSEIF( nbondi == 1 ) THEN
-            CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )
-            CALL mpprecv( 2, t2we(1,1,2), imigr )
-            IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err )
-         ENDIF
-         !
-         !                              ! Write Dirichlet lateral conditions
-         iihom = nlci-jpreci
-         !
-         IF( nbondi == 0 .OR. nbondi == 1 ) THEN
-            DO jl = 1, jpreci
-               ztab(jl,:) = t2we(:,jl,2)
-            END DO
-         ENDIF
-         IF( nbondi == -1 .OR. nbondi == 0 ) THEN
-            DO jl = 1, jpreci
-               ztab(iihom+jl,:) = t2ew(:,jl,2)
-            END DO
-         ENDIF
-
-
-         ! 2. North and south directions
-         ! -----------------------------
-         !
-         IF( nbondj /= 2 ) THEN         ! Read Dirichlet lateral conditions
-            ijhom = nlcj-nrecj
-            DO jl = 1, jprecj
-               t2sn(:,jl,1) = ztab(:,ijhom +jl)
-               t2ns(:,jl,1) = ztab(:,jprecj+jl)
-            END DO
-         ENDIF
-         !
-         !                              ! Migrations
-         imigr = jprecj * jpi
-         !
-         IF( nbondj == -1 ) THEN
-            CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 )
-            CALL mpprecv( 3, t2ns(1,1,2), imigr )
-            IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err )
-         ELSEIF( nbondj == 0 ) THEN
-            CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )
-            CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 )
-            CALL mpprecv( 3, t2ns(1,1,2), imigr )
-            CALL mpprecv( 4, t2sn(1,1,2), imigr )
-            IF( l_isend )   CALL mpi_wait( ml_req1, ml_stat, ml_err )
-            IF( l_isend )   CALL mpi_wait( ml_req2, ml_stat, ml_err )
-         ELSEIF( nbondj == 1 ) THEN
-            CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )
-            CALL mpprecv( 4, t2sn(1,1,2), imigr)
-            IF( l_isend )   CALL mpi_wait( ml_req1, ml_stat, ml_err )
-         ENDIF
-         !
-         !                              ! Write Dirichlet lateral conditions
-         ijhom = nlcj - jprecj
-         IF( nbondj == 0 .OR. nbondj == 1 ) THEN
-            DO jl = 1, jprecj
-               ztab(:,jl) = t2sn(:,jl,2)
-            END DO
-         ENDIF
-         IF( nbondj == 0 .OR. nbondj == -1 ) THEN
-            DO jl = 1, jprecj
-               ztab(:,ijhom+jl) = t2ns(:,jl,2)
-            END DO
-         ENDIF
-         IF( ktype==1 .AND. kd1 <= jpi+nimpp-1 .AND. nimpp <= kd2 ) THEN
-            DO jj = ijpt0, ijpt1            ! north/south boundaries
-               DO ji = iipt0,ilpt1
-                  ptab(ji,jk) = ztab(ji,jj)  
-               END DO
-            END DO
-         ELSEIF( ktype==2 .AND. kd1 <= jpj+njmpp-1 .AND. njmpp <= kd2 ) THEN
-            DO jj = ijpt0, ilpt1            ! east/west boundaries
-               DO ji = iipt0,iipt1
-                  ptab(jj,jk) = ztab(ji,jj) 
-               END DO
-            END DO
-         ENDIF
-         !
-      END DO
-      !
-   END SUBROUTINE mppobc
-   
-
-   SUBROUTINE mpp_comm_free( kcom )
-      !!----------------------------------------------------------------------
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kcom
-      !!
-      INTEGER :: ierr
-      !!----------------------------------------------------------------------
-      !
-      CALL MPI_COMM_FREE(kcom, ierr)
-      !
-   END SUBROUTINE mpp_comm_free
-
-
-   SUBROUTINE mpp_ini_ice( pindic )
-      !!----------------------------------------------------------------------
-      !!               ***  routine mpp_ini_ice  ***
-      !!
-      !! ** Purpose :   Initialize special communicator for ice areas
-      !!      condition together with global variables needed in the ddmpp folding
-      !!
-      !! ** Method  : - Look for ice processors in ice routines
-      !!              - Put their number in nrank_ice
-      !!              - Create groups for the world processors and the ice processors
-      !!              - Create a communicator for ice processors
-      !!
-      !! ** output
-      !!      njmppmax = njmpp for northern procs
-      !!      ndim_rank_ice = number of processors with ice
-      !!      nrank_ice (ndim_rank_ice) = ice processors
-      !!      ngrp_world = group ID for the world processors
-      !!      ngrp_ice = group ID for the ice processors
-      !!      ncomm_ice = communicator for the ice procs.
-      !!      n_ice_root = number (in the world) of proc 0 in the ice comm.
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) :: pindic
-      !!
-      INTEGER :: ierr
-      INTEGER :: jjproc
-      INTEGER :: ii
-      INTEGER, DIMENSION(jpnij) :: kice
-      INTEGER, DIMENSION(jpnij) :: zwork
-      !!----------------------------------------------------------------------
-      !
-      ! Look for how many procs with sea-ice
-      !
-      kice = 0
-      DO jjproc = 1, jpnij
-         IF( jjproc == narea .AND. pindic .GT. 0 )   kice(jjproc) = 1    
-      END DO
-      !
-      zwork = 0
-      CALL MPI_ALLREDUCE( kice, zwork, jpnij, mpi_integer, mpi_sum, mpi_comm_opa, ierr )
-      ndim_rank_ice = SUM( zwork )          
-
-      ! Allocate the right size to nrank_north
-#if ! defined key_agrif
-      IF( ALLOCATED ( nrank_ice ) )   DEALLOCATE( nrank_ice )
-#else
-      IF( ASSOCIATED( nrank_ice ) )   DEALLOCATE( nrank_ice )
-#endif
-      ALLOCATE( nrank_ice(ndim_rank_ice) )
-      !
-      ii = 0     
-      nrank_ice = 0
-      DO jjproc = 1, jpnij
-         IF( zwork(jjproc) == 1) THEN
-            ii = ii + 1
-            nrank_ice(ii) = jjproc -1 
-         ENDIF
-      END DO
-
-      ! Create the world group
-      CALL MPI_COMM_GROUP( mpi_comm_opa, ngrp_world, ierr )
-
-      ! Create the ice group from the world group
-      CALL MPI_GROUP_INCL( ngrp_world, ndim_rank_ice, nrank_ice, ngrp_ice, ierr )
-
-      ! Create the ice communicator , ie the pool of procs with sea-ice
-      CALL MPI_COMM_CREATE( mpi_comm_opa, ngrp_ice, ncomm_ice, ierr )
-
-      ! Find proc number in the world of proc 0 in the north
-      ! The following line seems to be useless, we just comment & keep it as reminder
-      ! CALL MPI_GROUP_TRANSLATE_RANKS(ngrp_ice,1,0,ngrp_world,n_ice_root,ierr)
-      !
-   END SUBROUTINE mpp_ini_ice
-
-
-   SUBROUTINE mpp_ini_znl
-      !!----------------------------------------------------------------------
-      !!               ***  routine mpp_ini_znl  ***
-      !!
-      !! ** Purpose :   Initialize special communicator for computing zonal sum
-      !!
-      !! ** Method  : - Look for processors in the same row
-      !!              - Put their number in nrank_znl
-      !!              - Create group for the znl processors
-      !!              - Create a communicator for znl processors
-      !!              - Determine if processor should write znl files
-      !!
-      !! ** output
-      !!      ndim_rank_znl = number of processors on the same row
-      !!      ngrp_znl = group ID for the znl processors
-      !!      ncomm_znl = communicator for the ice procs.
-      !!      n_znl_root = number (in the world) of proc 0 in the ice comm.
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER :: ierr
-      INTEGER :: jproc
-      INTEGER :: ii
-      INTEGER, DIMENSION(jpnij) :: kwork
-      !
-      !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ngrp_world     : ', ngrp_world
-      !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - mpi_comm_world : ', mpi_comm_world
-      !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - mpi_comm_opa   : ', mpi_comm_opa
-      !
-      IF ( jpnj == 1 ) THEN
-         ngrp_znl  = ngrp_world
-         ncomm_znl = mpi_comm_opa
-      ELSE
-         !
-         CALL MPI_ALLGATHER ( njmpp, 1, mpi_integer, kwork, 1, mpi_integer, mpi_comm_opa, ierr )
-         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - kwork pour njmpp : ', kwork
-         !-$$        CALL flush(numout)
-         !
-         ! Count number of processors on the same row
-         ndim_rank_znl = 0
-         DO jproc=1,jpnij
-            IF ( kwork(jproc) == njmpp ) THEN
-               ndim_rank_znl = ndim_rank_znl + 1
-            ENDIF
-         END DO
-         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ndim_rank_znl : ', ndim_rank_znl
-         !-$$        CALL flush(numout)
-         ! Allocate the right size to nrank_znl
-#if ! defined key_agrif
-         IF (ALLOCATED (nrank_znl)) DEALLOCATE(nrank_znl)
-#else
-         IF (ASSOCIATED(nrank_znl)) DEALLOCATE(nrank_znl)
-#endif
-         ALLOCATE(nrank_znl(ndim_rank_znl))
-         ii = 0     
-         nrank_znl (:) = 0
-         DO jproc=1,jpnij
-            IF ( kwork(jproc) == njmpp) THEN
-               ii = ii + 1
-               nrank_znl(ii) = jproc -1 
-            ENDIF
-         END DO
-         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - nrank_znl : ', nrank_znl
-         !-$$        CALL flush(numout)
-
-         ! Create the opa group
-         CALL MPI_COMM_GROUP(mpi_comm_opa,ngrp_opa,ierr)
-         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ngrp_opa : ', ngrp_opa
-         !-$$        CALL flush(numout)
-
-         ! Create the znl group from the opa group
-         CALL MPI_GROUP_INCL  ( ngrp_opa, ndim_rank_znl, nrank_znl, ngrp_znl, ierr )
-         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ngrp_znl ', ngrp_znl
-         !-$$        CALL flush(numout)
-
-         ! Create the znl communicator from the opa communicator, ie the pool of procs in the same row
-         CALL MPI_COMM_CREATE ( mpi_comm_opa, ngrp_znl, ncomm_znl, ierr )
-         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ncomm_znl ', ncomm_znl
-         !-$$        CALL flush(numout)
-         !
-      END IF
-
-      ! Determines if processor if the first (starting from i=1) on the row
-      IF ( jpni == 1 ) THEN 
-         l_znl_root = .TRUE.
-      ELSE
-         l_znl_root = .FALSE.
-         kwork (1) = nimpp
-         CALL mpp_min ( kwork(1), kcom = ncomm_znl)
-         IF ( nimpp == kwork(1)) l_znl_root = .TRUE.
-      END IF
-
-   END SUBROUTINE mpp_ini_znl
-
-
-   SUBROUTINE mpp_ini_north
-      !!----------------------------------------------------------------------
-      !!               ***  routine mpp_ini_north  ***
-      !!
-      !! ** Purpose :   Initialize special communicator for north folding 
-      !!      condition together with global variables needed in the mpp folding
-      !!
-      !! ** Method  : - Look for northern processors
-      !!              - Put their number in nrank_north
-      !!              - Create groups for the world processors and the north processors
-      !!              - Create a communicator for northern processors
-      !!
-      !! ** output
-      !!      njmppmax = njmpp for northern procs
-      !!      ndim_rank_north = number of processors in the northern line
-      !!      nrank_north (ndim_rank_north) = number  of the northern procs.
-      !!      ngrp_world = group ID for the world processors
-      !!      ngrp_north = group ID for the northern processors
-      !!      ncomm_north = communicator for the northern procs.
-      !!      north_root = number (in the world) of proc 0 in the northern comm.
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER ::   ierr
-      INTEGER ::   jjproc
-      INTEGER ::   ii, ji
-      !!----------------------------------------------------------------------
-      !
-      njmppmax = MAXVAL( njmppt )
-      !
-      ! Look for how many procs on the northern boundary
-      ndim_rank_north = 0
-      DO jjproc = 1, jpnij
-         IF( njmppt(jjproc) == njmppmax )   ndim_rank_north = ndim_rank_north + 1
-      END DO
-      !
-      ! Allocate the right size to nrank_north
-#if ! defined key_agrif
-      IF (ALLOCATED (nrank_north)) DEALLOCATE(nrank_north)
-#else
-      IF (ASSOCIATED(nrank_north)) DEALLOCATE(nrank_north)
-#endif
-      ALLOCATE( nrank_north(ndim_rank_north) )
-
-      ! Fill the nrank_north array with proc. number of northern procs.
-      ! Note : the rank start at 0 in MPI
-      ii = 0
-      DO ji = 1, jpnij
-         IF ( njmppt(ji) == njmppmax   ) THEN
-            ii=ii+1
-            nrank_north(ii)=ji-1
-         END IF
-      END DO
-      !
-      ! create the world group
-      CALL MPI_COMM_GROUP( mpi_comm_opa, ngrp_world, ierr )
-      !
-      ! Create the North group from the world group
-      CALL MPI_GROUP_INCL( ngrp_world, ndim_rank_north, nrank_north, ngrp_north, ierr )
-      !
-      ! Create the North communicator , ie the pool of procs in the north group
-      CALL MPI_COMM_CREATE( mpi_comm_opa, ngrp_north, ncomm_north, ierr )
-      !
-   END SUBROUTINE mpp_ini_north
-
-
-   SUBROUTINE mpp_lbc_north_3d( pt3d, cd_type, psgn )
-      !!---------------------------------------------------------------------
-      !!                   ***  routine mpp_lbc_north_3d  ***
-      !!
-      !! ** Purpose :   Ensure proper north fold horizontal bondary condition 
-      !!              in mpp configuration in case of jpn1 > 1
-      !!
-      !! ** Method  :   North fold condition and mpp with more than one proc
-      !!              in i-direction require a specific treatment. We gather 
-      !!              the 4 northern lines of the global domain on 1 processor
-      !!              and apply lbc north-fold on this sub array. Then we
-      !!              scatter the north fold array back to the processors.
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d      ! 3D array on which the b.c. is applied
-      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
-      !                                                              !   = T ,  U , V , F or W  gridpoints
-      REAL(wp)                        , INTENT(in   ) ::   psgn      ! = -1. the sign change across the north fold 
-      !!                                                             ! =  1. , the sign is kept
-      INTEGER ::   ji, jj, jr
-      INTEGER ::   ierr, itaille, ildi, ilei, iilb
-      INTEGER ::   ijpj, ijpjm1, ij, iproc
-      REAL(wp), DIMENSION(jpiglo,4,jpk)      ::   ztab
-      REAL(wp), DIMENSION(jpi   ,4,jpk)      ::   znorthloc
-      REAL(wp), DIMENSION(jpi   ,4,jpk,jpni) ::   znorthgloio
-      !!----------------------------------------------------------------------
-      !   
-      ijpj   = 4
-      ijpjm1 = 3
-      ztab(:,:,:) = 0.e0
-      !
-      DO jj = nlcj - ijpj +1, nlcj          ! put in znorthloc the last 4 jlines of pt3d
-         ij = jj - nlcj + ijpj
-         znorthloc(:,ij,:) = pt3d(:,jj,:)
-      END DO
-      !
-      !                                     ! Build in procs of ncomm_north the znorthgloio
-      itaille = jpi * jpk * ijpj
-      CALL MPI_ALLGATHER( znorthloc  , itaille, MPI_DOUBLE_PRECISION,                &
-         &                znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
-      !
-      !                                     ! recover the global north array
-      DO jr = 1, ndim_rank_north
-         iproc = nrank_north(jr) + 1
-         ildi  = nldit (iproc)
-         ilei  = nleit (iproc)
-         iilb  = nimppt(iproc)
-         DO jj = 1, 4
-            DO ji = ildi, ilei
-               ztab(ji+iilb-1,jj,:) = znorthgloio(ji,jj,:,jr)
-            END DO
-         END DO
-      END DO
-      !
-      CALL lbc_nfd( ztab, cd_type, psgn )   ! North fold boundary condition
-      !
-      DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt3d
-         ij = jj - nlcj + ijpj
-         DO ji= 1, nlci
-            pt3d(ji,jj,:) = ztab(ji+nimpp-1,ij,:)
-         END DO
-      END DO
-      !
-   END SUBROUTINE mpp_lbc_north_3d
-
-
-   SUBROUTINE mpp_lbc_north_2d( pt2d, cd_type, psgn)
-      !!---------------------------------------------------------------------
-      !!                   ***  routine mpp_lbc_north_2d  ***
-      !!
-      !! ** Purpose :   Ensure proper north fold horizontal bondary condition 
-      !!              in mpp configuration in case of jpn1 > 1 (for 2d array )
-      !!
-      !! ** Method  :   North fold condition and mpp with more than one proc
-      !!              in i-direction require a specific treatment. We gather 
-      !!              the 4 northern lines of the global domain on 1 processor
-      !!              and apply lbc north-fold on this sub array. Then we
-      !!              scatter the north fold array back to the processors.
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d      ! 3D array on which the b.c. is applied
-      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
-      !                                                          !   = T ,  U , V , F or W  gridpoints
-      REAL(wp)                    , INTENT(in   ) ::   psgn      ! = -1. the sign change across the north fold 
-      !!                                                             ! =  1. , the sign is kept
-      INTEGER ::   ji, jj, jr
-      INTEGER ::   ierr, itaille, ildi, ilei, iilb
-      INTEGER ::   ijpj, ijpjm1, ij, iproc
-      REAL(wp), DIMENSION(jpiglo,4)      ::   ztab
-      REAL(wp), DIMENSION(jpi   ,4)      ::   znorthloc
-      REAL(wp), DIMENSION(jpi   ,4,jpni) ::   znorthgloio
-      !!----------------------------------------------------------------------
-      !
-      ijpj   = 4
-      ijpjm1 = 3
-      ztab(:,:) = 0.e0
-      !
-      DO jj = nlcj-ijpj+1, nlcj             ! put in znorthloc the last 4 jlines of pt2d
-         ij = jj - nlcj + ijpj
-         znorthloc(:,ij) = pt2d(:,jj)
-      END DO
-
-      !                                     ! Build in procs of ncomm_north the znorthgloio
-      itaille = jpi * ijpj
-      CALL MPI_ALLGATHER( znorthloc  , itaille, MPI_DOUBLE_PRECISION,        &
-         &                znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
-      !
-      DO jr = 1, ndim_rank_north            ! recover the global north array
-         iproc = nrank_north(jr) + 1
-         ildi=nldit (iproc)
-         ilei=nleit (iproc)
-         iilb=nimppt(iproc)
-         DO jj = 1, 4
-            DO ji = ildi, ilei
-               ztab(ji+iilb-1,jj) = znorthgloio(ji,jj,jr)
-            END DO
-         END DO
-      END DO
-      !
-      CALL lbc_nfd( ztab, cd_type, psgn )   ! North fold boundary condition
-      !
-      !
-      DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt2d
-         ij = jj - nlcj + ijpj
-         DO ji = 1, nlci
-            pt2d(ji,jj) = ztab(ji+nimpp-1,ij)
-         END DO
-      END DO
-      !
-   END SUBROUTINE mpp_lbc_north_2d
-
-
-   SUBROUTINE mpp_lbc_north_e( pt2d, cd_type, psgn)
-      !!---------------------------------------------------------------------
-      !!                   ***  routine mpp_lbc_north_2d  ***
-      !!
-      !! ** Purpose :   Ensure proper north fold horizontal bondary condition 
-      !!              in mpp configuration in case of jpn1 > 1 and for 2d 
-      !!              array with outer extra halo
-      !!
-      !! ** Method  :   North fold condition and mpp with more than one proc
-      !!              in i-direction require a specific treatment. We gather 
-      !!              the 4+2*jpr2dj northern lines of the global domain on 1 
-      !!              processor and apply lbc north-fold on this sub array. 
-      !!              Then we scatter the north fold array back to the processors.
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj), INTENT(inout) ::   pt2d     ! 2D array with extra halo
-      CHARACTER(len=1)                                            , INTENT(in   ) ::   cd_type  ! nature of pt3d grid-points
-      !                                                                                         !   = T ,  U , V , F or W -points
-      REAL(wp)                                                    , INTENT(in   ) ::   psgn     ! = -1. the sign change across the  
-      !!                                                                                        ! north fold, =  1. otherwise
-      INTEGER ::   ji, jj, jr
-      INTEGER ::   ierr, itaille, ildi, ilei, iilb
-      INTEGER ::   ijpj, ij, iproc
-      REAL(wp), DIMENSION(jpiglo,4+2*jpr2dj)      ::   ztab
-      REAL(wp), DIMENSION(jpi   ,4+2*jpr2dj)      ::   znorthloc
-      REAL(wp), DIMENSION(jpi   ,4+2*jpr2dj,jpni) ::   znorthgloio
-      !!----------------------------------------------------------------------
-      !
-      ijpj=4
-      ztab(:,:) = 0.e0
-
-      ij=0
-      ! put in znorthloc the last 4 jlines of pt2d
-      DO jj = nlcj - ijpj + 1 - jpr2dj, nlcj +jpr2dj
-         ij = ij + 1
-         DO ji = 1, jpi
-            znorthloc(ji,ij)=pt2d(ji,jj)
-         END DO
-      END DO
-      !
-      itaille = jpi * ( ijpj + 2 * jpr2dj )
-      CALL MPI_ALLGATHER( znorthloc(1,1)    , itaille, MPI_DOUBLE_PRECISION,    &
-         &                znorthgloio(1,1,1), itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
-      !
-      DO jr = 1, ndim_rank_north            ! recover the global north array
-         iproc = nrank_north(jr) + 1
-         ildi = nldit (iproc)
-         ilei = nleit (iproc)
-         iilb = nimppt(iproc)
-         DO jj = 1, ijpj+2*jpr2dj
-            DO ji = ildi, ilei
-               ztab(ji+iilb-1,jj) = znorthgloio(ji,jj,jr)
-            END DO
-         END DO
-      END DO
-
-
-      ! 2. North-Fold boundary conditions
-      ! ----------------------------------
-      CALL lbc_nfd( ztab(:,:), cd_type, psgn, pr2dj = jpr2dj )
-
-      ij = jpr2dj
-      !! Scatter back to pt2d
-      DO jj = nlcj - ijpj + 1 , nlcj +jpr2dj
-      ij  = ij +1 
-         DO ji= 1, nlci
-            pt2d(ji,jj) = ztab(ji+nimpp-1,ij)
-         END DO
-      END DO
-      !
-   END SUBROUTINE mpp_lbc_north_e
-
-
-   SUBROUTINE mpi_init_opa( code )
-      !!---------------------------------------------------------------------
-      !!                   ***  routine mpp_init.opa  ***
-      !!
-      !! ** Purpose :: export and attach a MPI buffer for bsend
-      !!
-      !! ** Method  :: define buffer size in namelist, if 0 no buffer attachment
-      !!            but classical mpi_init
-      !! 
-      !! History :: 01/11 :: IDRIS initial version for IBM only  
-      !!            08/04 :: R. Benshila, generalisation
-      !!---------------------------------------------------------------------
-      INTEGER                                 :: code, ierr
-      LOGICAL                                 :: mpi_was_called
-      !!---------------------------------------------------------------------
-      !
-      CALL mpi_initialized( mpi_was_called, code )      ! MPI initialization
-      IF ( code /= MPI_SUCCESS ) THEN
-         CALL ctl_stop( ' lib_mpp: Error in routine mpi_initialized' )
-         CALL mpi_abort( mpi_comm_world, code, ierr )
-      ENDIF
-      !
-      IF( .NOT. mpi_was_called ) THEN
-         CALL mpi_init( code )
-         CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code )
-         IF ( code /= MPI_SUCCESS ) THEN
-            CALL ctl_stop( ' lib_mpp: Error in routine mpi_comm_dup' )
-            CALL mpi_abort( mpi_comm_world, code, ierr )
-         ENDIF
-      ENDIF
-      !
-      IF( nn_buffer > 0 ) THEN
-         IF ( lwp ) WRITE(numout,*) 'mpi_bsend, buffer allocation of  : ', nn_buffer
-         ! Buffer allocation and attachment
-         ALLOCATE( tampon(nn_buffer) )
-         CALL mpi_buffer_attach( tampon, nn_buffer,code )
-      ENDIF
-      !
-   END SUBROUTINE mpi_init_opa
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default case:            Dummy module        share memory computing
-   !!----------------------------------------------------------------------
-   INTERFACE mpp_sum
-      MODULE PROCEDURE mpp_sum_a2s, mpp_sum_as, mpp_sum_ai, mpp_sum_s, mpp_sum_i
-   END INTERFACE
-   INTERFACE mpp_max
-      MODULE PROCEDURE mppmax_a_int, mppmax_int, mppmax_a_real, mppmax_real
-   END INTERFACE
-   INTERFACE mpp_min
-      MODULE PROCEDURE mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real
-   END INTERFACE
-   INTERFACE mppobc
-      MODULE PROCEDURE mppobc_1d, mppobc_2d, mppobc_3d, mppobc_4d
-   END INTERFACE
-   INTERFACE mpp_minloc
-      MODULE PROCEDURE mpp_minloc2d ,mpp_minloc3d
-   END INTERFACE
-   INTERFACE mpp_maxloc
-      MODULE PROCEDURE mpp_maxloc2d ,mpp_maxloc3d
-   END INTERFACE
-
-
-   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .FALSE.      !: mpp flag
-   INTEGER :: ncomm_ice
-
-CONTAINS
-
-   FUNCTION mynode( ldtxt, localComm ) RESULT (function_value)
-      CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt 
-      INTEGER, OPTIONAL            , INTENT(in   ) ::   localComm
-      IF( PRESENT( localComm ) .OR. .NOT.PRESENT( localComm ) )   function_value = 0
-      IF( .FALSE. )   ldtxt(:) = 'never done'
-   END FUNCTION mynode
-
-   SUBROUTINE mppsync                       ! Dummy routine
-   END SUBROUTINE mppsync
-
-   SUBROUTINE mpp_sum_as( parr, kdim, kcom )      ! Dummy routine
-      REAL   , DIMENSION(:) :: parr
-      INTEGER               :: kdim
-      INTEGER, OPTIONAL     :: kcom 
-      WRITE(*,*) 'mpp_sum_as: You should not have seen this print! error?', kdim, parr(1), kcom
-   END SUBROUTINE mpp_sum_as
-
-   SUBROUTINE mpp_sum_a2s( parr, kdim, kcom )      ! Dummy routine
-      REAL   , DIMENSION(:,:) :: parr
-      INTEGER               :: kdim
-      INTEGER, OPTIONAL     :: kcom 
-      WRITE(*,*) 'mpp_sum_a2s: You should not have seen this print! error?', kdim, parr(1,1), kcom
-   END SUBROUTINE mpp_sum_a2s
-
-   SUBROUTINE mpp_sum_ai( karr, kdim, kcom )      ! Dummy routine
-      INTEGER, DIMENSION(:) :: karr
-      INTEGER               :: kdim
-      INTEGER, OPTIONAL     :: kcom 
-      WRITE(*,*) 'mpp_sum_ai: You should not have seen this print! error?', kdim, karr(1), kcom
-   END SUBROUTINE mpp_sum_ai
-
-   SUBROUTINE mpp_sum_s( psca, kcom )            ! Dummy routine
-      REAL                  :: psca
-      INTEGER, OPTIONAL     :: kcom 
-      WRITE(*,*) 'mpp_sum_s: You should not have seen this print! error?', psca, kcom
-   END SUBROUTINE mpp_sum_s
-
-   SUBROUTINE mpp_sum_i( kint, kcom )            ! Dummy routine
-      integer               :: kint
-      INTEGER, OPTIONAL     :: kcom 
-      WRITE(*,*) 'mpp_sum_i: You should not have seen this print! error?', kint, kcom
-   END SUBROUTINE mpp_sum_i
-
-   SUBROUTINE mppmax_a_real( parr, kdim, kcom )
-      REAL   , DIMENSION(:) :: parr
-      INTEGER               :: kdim
-      INTEGER, OPTIONAL     :: kcom 
-      WRITE(*,*) 'mppmax_a_real: You should not have seen this print! error?', kdim, parr(1), kcom
-   END SUBROUTINE mppmax_a_real
-
-   SUBROUTINE mppmax_real( psca, kcom )
-      REAL                  :: psca
-      INTEGER, OPTIONAL     :: kcom 
-      WRITE(*,*) 'mppmax_real: You should not have seen this print! error?', psca, kcom
-   END SUBROUTINE mppmax_real
-
-   SUBROUTINE mppmin_a_real( parr, kdim, kcom )
-      REAL   , DIMENSION(:) :: parr
-      INTEGER               :: kdim
-      INTEGER, OPTIONAL     :: kcom 
-      WRITE(*,*) 'mppmin_a_real: You should not have seen this print! error?', kdim, parr(1), kcom
-   END SUBROUTINE mppmin_a_real
-
-   SUBROUTINE mppmin_real( psca, kcom )
-      REAL                  :: psca
-      INTEGER, OPTIONAL     :: kcom 
-      WRITE(*,*) 'mppmin_real: You should not have seen this print! error?', psca, kcom
-   END SUBROUTINE mppmin_real
-
-   SUBROUTINE mppmax_a_int( karr, kdim ,kcom)
-      INTEGER, DIMENSION(:) :: karr
-      INTEGER               :: kdim
-      INTEGER, OPTIONAL     :: kcom 
-      WRITE(*,*) 'mppmax_a_int: You should not have seen this print! error?', kdim, karr(1), kcom
-   END SUBROUTINE mppmax_a_int
-
-   SUBROUTINE mppmax_int( kint, kcom)
-      INTEGER               :: kint
-      INTEGER, OPTIONAL     :: kcom 
-      WRITE(*,*) 'mppmax_int: You should not have seen this print! error?', kint, kcom
-   END SUBROUTINE mppmax_int
-
-   SUBROUTINE mppmin_a_int( karr, kdim, kcom )
-      INTEGER, DIMENSION(:) :: karr
-      INTEGER               :: kdim
-      INTEGER, OPTIONAL     :: kcom 
-      WRITE(*,*) 'mppmin_a_int: You should not have seen this print! error?', kdim, karr(1), kcom
-   END SUBROUTINE mppmin_a_int
-
-   SUBROUTINE mppmin_int( kint, kcom )
-      INTEGER               :: kint
-      INTEGER, OPTIONAL     :: kcom 
-      WRITE(*,*) 'mppmin_int: You should not have seen this print! error?', kint, kcom
-   END SUBROUTINE mppmin_int
-
-   SUBROUTINE mppobc_1d( parr, kd1, kd2, kl, kk, ktype, kij )
-      INTEGER  ::   kd1, kd2, kl , kk, ktype, kij
-      REAL, DIMENSION(:) ::   parr           ! variable array
-      WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1), kd1, kd2, kl, kk, ktype, kij
-   END SUBROUTINE mppobc_1d
-
-   SUBROUTINE mppobc_2d( parr, kd1, kd2, kl, kk, ktype, kij )
-      INTEGER  ::   kd1, kd2, kl , kk, ktype, kij
-      REAL, DIMENSION(:,:) ::   parr           ! variable array
-      WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1), kd1, kd2, kl, kk, ktype, kij
-   END SUBROUTINE mppobc_2d
-
-   SUBROUTINE mppobc_3d( parr, kd1, kd2, kl, kk, ktype, kij )
-      INTEGER  ::   kd1, kd2, kl , kk, ktype, kij
-      REAL, DIMENSION(:,:,:) ::   parr           ! variable array
-      WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1,1), kd1, kd2, kl, kk, ktype, kij
-   END SUBROUTINE mppobc_3d
-
-   SUBROUTINE mppobc_4d( parr, kd1, kd2, kl, kk, ktype, kij )
-      INTEGER  ::   kd1, kd2, kl , kk, ktype, kij
-      REAL, DIMENSION(:,:,:,:) ::   parr           ! variable array
-      WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1,1,1), kd1, kd2, kl, kk, ktype, kij
-   END SUBROUTINE mppobc_4d
-
-   SUBROUTINE mpp_minloc2d( ptab, pmask, pmin, ki, kj )
-      REAL                   :: pmin
-      REAL , DIMENSION (:,:) :: ptab, pmask
-      INTEGER :: ki, kj
-      WRITE(*,*) 'mpp_minloc2d: You should not have seen this print! error?', pmin, ki, kj, ptab(1,1), pmask(1,1)
-   END SUBROUTINE mpp_minloc2d
-
-   SUBROUTINE mpp_minloc3d( ptab, pmask, pmin, ki, kj, kk )
-      REAL                     :: pmin
-      REAL , DIMENSION (:,:,:) :: ptab, pmask
-      INTEGER :: ki, kj, kk
-      WRITE(*,*) 'mpp_minloc3d: You should not have seen this print! error?', pmin, ki, kj, kk, ptab(1,1,1), pmask(1,1,1)
-   END SUBROUTINE mpp_minloc3d
-
-   SUBROUTINE mpp_maxloc2d( ptab, pmask, pmax, ki, kj )
-      REAL                   :: pmax
-      REAL , DIMENSION (:,:) :: ptab, pmask
-      INTEGER :: ki, kj
-      WRITE(*,*) 'mpp_maxloc2d: You should not have seen this print! error?', pmax, ki, kj, ptab(1,1), pmask(1,1)
-   END SUBROUTINE mpp_maxloc2d
-
-   SUBROUTINE mpp_maxloc3d( ptab, pmask, pmax, ki, kj, kk )
-      REAL                     :: pmax
-      REAL , DIMENSION (:,:,:) :: ptab, pmask
-      INTEGER :: ki, kj, kk
-      WRITE(*,*) 'mpp_maxloc3d: You should not have seen this print! error?', pmax, ki, kj, kk, ptab(1,1,1), pmask(1,1,1)
-   END SUBROUTINE mpp_maxloc3d
-
-   SUBROUTINE mppstop
-      WRITE(*,*) 'mppstop: You should not have seen this print! error?'
-   END SUBROUTINE mppstop
-
-   SUBROUTINE mpp_ini_ice( kcom )
-      INTEGER :: kcom
-      WRITE(*,*) 'mpp_ini_ice: You should not have seen this print! error?', kcom
-   END SUBROUTINE mpp_ini_ice
-
-   SUBROUTINE mpp_ini_znl
-      WRITE(*,*) 'mpp_ini_znl: You should not have seen this print! error?'
-   END SUBROUTINE mpp_ini_znl
-
-   SUBROUTINE mpp_comm_free( kcom )
-      INTEGER :: kcom
-      WRITE(*,*) 'mpp_comm_free: You should not have seen this print! error?', kcom
-   END SUBROUTINE mpp_comm_free
-
-#endif
-   !!----------------------------------------------------------------------
-END MODULE lib_mpp
Index: trunk/NEMOGCM/NEMO/OPA_SRC/lib_print.f90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/lib_print.f90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/lib_print.f90	(revision 2528)
@@ -20,7 +20,7 @@
    !!----------------------------------------------------------------------
    !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 CONTAINS
Index: trunk/NEMOGCM/NEMO/OPA_SRC/model.f90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/model.f90	(revision 2527)
+++ 	(revision )
@@ -1,21 +1,0 @@
-PROGRAM model
-   !!----------------------------------------------------------------------
-   !!                     ***  PROGRAM model  ***
-   !!
-   !! ** Purpose :   encapsulate the opa model so that opa can also be 
-   !!      called together with the adjoint and linear tangent models
-   !!
-   !! History :
-   !!   8.0  !  01-02  (M. Imbard, A. Weaver)  Original code
-   !!   9.0  !  03-10  (G. Madec) F90
-   !!----------------------------------------------------------------------
-   USE opa                  ! OPA system     (opa_model routine)
-   !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
-   !!----------------------------------------------------------------------
- 
-   CALL opa_model           ! OPA system
- 
-END PROGRAM model
Index: trunk/NEMOGCM/NEMO/OPA_SRC/module_example
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/module_example	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/module_example	(revision 2528)
@@ -7,7 +7,6 @@
    !! History : 3.0  !  2008-06  (Author Names)  Original code
    !!            -   !  2008-08  (Author names)  brief description of modifications
-   !!           3.1  !  2008-12  (Author names)        -              -
+   !!           3.3  !  2010-11  (Author names)        -              -
    !!----------------------------------------------------------------------
-
 #if defined key_example
    !!----------------------------------------------------------------------
@@ -26,4 +25,9 @@
    PUBLIC   exa_mpl   ! routine called in xxx.F90 module
 
+   TYPE ::   FLD_E                !: Structure type definition
+      CHARACTER(lc) ::   clname      ! clname description (default length, lc, is 256, see par_kind.F90)
+      INTEGER       ::   nfreqh      ! nfreqh description 
+   END TYPE FLD_E 
+
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   var1         !: var1 description. CAUTION always use !: to describe
    !                                                          !  a PUBLIC variable: simplify its search : 
@@ -32,9 +36,10 @@
    !                                                          !  DO NOT use continuation lines in declaration
 
-   !                             !!! ** namelist nam_xxx **
-   LOGICAL  ::   ln_opt = 1       ! give the default value of each namelist parameter
-   CHARACTER::   cn_tex = 'T'     ! short description  of the variable
-   INTEGER  ::   nn_opt = 1       ! please respect the DOCTOR norm for namelist variable
-   REAL(wp) ::   rn_var = 2._wp   ! (it becomes easy to identify them in the code)
+   !                               !!* namelist nam_xxx *
+   LOGICAL   ::   ln_opt = .TRUE.   ! give the default value of each namelist parameter
+   CHARACTER ::   cn_tex = 'T'      ! short description  of the variable
+   INTEGER   ::   nn_opt = 1        ! please respect the DOCTOR norm for namelist variable
+   REAL(wp)  ::   rn_var = 2._wp    ! (it becomes easy to identify them in the code)
+   TYPE(FLD) ::   sn_ex             ! structure
 
    INTEGER                          ::   nint    ! nint  description (local permanent variable)
@@ -45,9 +50,8 @@
 #  include "exampl_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -111,6 +115,6 @@
          !
       END SELECT
-
-      CALL mpplnk2( avmu, 'U', 1. )              ! Lateral boundary conditions (avmu)   (unchanged sign)
+      !
+      CALL mpplnk2( avmu, 'U', 1. )              ! Lateral boundary conditions (unchanged sign)
       !
    END SUBROUTINE exa_mpl
@@ -131,24 +135,28 @@
       INTEGER ::   ji, jj, jk, jit   ! dummy loop indices
       !!
-      NAMELIST/namexa/ exa_v1, exa_v2, nexa_0       
+      NAMELIST/namexa/ exa_v1, exa_v2, nexa_0, sn_ex     
       !!----------------------------------------------------------------------
       !
-      REWIND ( numnam )                          ! Read Namelist namexa : example parameters
-      READ   ( numnam, namexa )
+      sn_ex%clname ='toto'                      ! set default namelist values
+      sn_ex%nfreqh = 2 
       !
-      IF(lwp) THEN                               ! Control print
+      REWIND( numnam )                          ! Read Namelist namexa : example parameters
+      READ  ( numnam, namexa )
+      !
+      IF(lwp) THEN                              ! Control print
          WRITE(numout,*)
          WRITE(numout,*) 'exa_mpl_init : example '
          WRITE(numout,*) '~~~~~~~~~~~~'
-         WRITE(numout,*) '          Namelist namexa : set example parameters'
-         WRITE(numout,*) '             brief desciption               exa_v1  = ', exa_v1
-         WRITE(numout,*) '             brief desciption               exa_v1  = ', exa_v1
-         WRITE(numout,*) '             brief desciption               nexa_0  = ', nexa_0
+         WRITE(numout,*) '   Namelist namexa : set example parameters'
+         WRITE(numout,*) '      brief desciption               exa_v1  = ', exa_v1
+         WRITE(numout,*) '      brief desciption               exa_v1  = ', exa_v1
+         WRITE(numout,*) '      brief desciption               nexa_0  = ', nexa_0
+         WRITE(numout,*) '      brief desciption          sn_ex%clname = ', sn_ex%clname
+         WRITE(numout,*) '      brief desciption          sn_ex%nfreqh = ', sn_ex%nfreqh
       ENDIF
       !
       !                                          ! Parameter control
-      IF( ln_opt  )   CALL ctl_stop( 'this work and option xxx are incompatible'   )
-      IF( ln_opt2 )   CALL ctl_warn( 'this work and option yyy may cause problems' )
-      ENDIF
+      IF( ln_opt      )   CALL ctl_stop( 'exa_mpl_init: this work and option xxx are incompatible'   )
+      IF( nn_opt == 2 )   CALL ctl_warn( 'exa_mpl_init: this work and option yyy may cause problems' )
       !
    END SUBROUTINE exa_mpl_init
Index: trunk/NEMOGCM/NEMO/OPA_SRC/mppini.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/mppini.F90	(revision 2527)
+++ 	(revision )
@@ -1,493 +1,0 @@
-MODULE mppini
-   !!==============================================================================
-   !!                       ***  MODULE mppini   ***
-   !! Ocean initialization : distributed memory computing initialization
-   !!==============================================================================
-
-   !!----------------------------------------------------------------------
-   !!   mpp_init       : Lay out the global domain over processors
-   !!   mpp_init2      : Lay out the global domain over processors 
-   !!                    with land processor elimination
-   !!   mpp_init_ioispl: IOIPSL initialization in mpp
-   !!----------------------------------------------------------------------
-   !! * Modules used
-   USE dom_oce         ! ocean space and time domain 
-   USE in_out_manager  ! I/O Manager
-   USE lib_mpp         ! distribued memory computing library
-   USE ioipsl
-
-   IMPLICIT NONE
-   PRIVATE
-
-   !! * Routine accessibility
-   PUBLIC mpp_init       ! called by opa.F90
-   PUBLIC mpp_init2      ! called by opa.F90
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-   !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-#if ! defined key_mpp_mpi
-   !!----------------------------------------------------------------------
-   !!   Default option :                            shared memory computing
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE mpp_init
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE mpp_init  ***
-      !!
-      !! ** Purpose :   Lay out the global domain over processors.
-      !!
-      !! ** Method  :   Shared memory computing, set the local processor
-      !!      variables to the value of the global domain
-      !!
-      !! History :
-      !!   9.0  !  04-01  (G. Madec, J.M. Molines)  F90 : free form, north fold jpni >1
-      !!----------------------------------------------------------------------
-
-      ! No mpp computation
-      nimpp  = 1
-      njmpp  = 1
-      nlci   = jpi
-      nlcj   = jpj
-      nldi   = 1
-      nldj   = 1
-      nlei   = jpi
-      nlej   = jpj
-      nperio = jperio
-      nbondi = 2
-      nbondj = 2
-      nidom  = FLIO_DOM_NONE
-      npolj = jperio
-
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'mpp_init(2) : NO massively parallel processing'
-         WRITE(numout,*) '~~~~~~~~~~~: '
-         WRITE(numout,*) '         nperio = ', nperio
-         WRITE(numout,*) '         npolj  = ', npolj
-         WRITE(numout,*) '         nimpp  = ', nimpp
-         WRITE(numout,*) '         njmpp  = ', njmpp
-      ENDIF
-
-      IF(  jpni /= 1 .OR. jpnj /= 1 .OR. jpnij /= 1 ) &
-          CALL ctl_stop( 'equality  jpni = jpnj = jpnij = 1 is not satisfied',   &
-          &              'the domain is lay out for distributed memory computing! ' )
-
-   END SUBROUTINE mpp_init
-
-
-   SUBROUTINE mpp_init2 
-      CALL mpp_init                             ! same routine as mpp_init
-   END SUBROUTINE mpp_init2
-
-#else
-   !!----------------------------------------------------------------------
-   !!   'key_mpp_mpi'          OR         MPI massively parallel processing
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE mpp_init
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE mpp_init  ***
-      !!                    
-      !! ** Purpose :   Lay out the global domain over processors.
-      !!
-      !! ** Method  :   Global domain is distributed in smaller local domains.
-      !!      Periodic condition is a function of the local domain position
-      !!      (global boundary or neighbouring domain) and of the global
-      !!      periodic
-      !!      Type :         jperio global periodic condition
-      !!                     nperio local  periodic condition
-      !!
-      !! ** Action  : - set domain parameters
-      !!                    nimpp     : longitudinal index 
-      !!                    njmpp     : latitudinal  index
-      !!                    nperio    : lateral condition type 
-      !!                    narea     : number for local area
-      !!                    nlci      : first dimension
-      !!                    nlcj      : second dimension
-      !!                    nbondi    : mark for "east-west local boundary"
-      !!                    nbondj    : mark for "north-south local boundary"
-      !!                    nproc     : number for local processor
-      !!                    noea      : number for local neighboring processor
-      !!                    nowe      : number for local neighboring processor
-      !!                    noso      : number for local neighboring processor
-      !!                    nono      : number for local neighboring processor
-      !!
-      !! History :
-      !!        !  94-11  (M. Guyon)  Original code
-      !!        !  95-04  (J. Escobar, M. Imbard)
-      !!        !  98-02  (M. Guyon)  FETI method
-      !!        !  98-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions
-      !!   8.5  !  02-08  (G. Madec)  F90 : free form
-      !!----------------------------------------------------------------------
-      !! * Local variables
-      INTEGER ::   ji, jj, jn               ! dummy loop indices
-      INTEGER ::   &
-         ii, ij, ifreq, il1, il2,        &  ! temporary integers
-         iresti, irestj, ijm1, imil,     &  !    "          "
-         inum                               ! temporary logical unit
-
-      INTEGER, DIMENSION(jpni,jpnj) ::   &
-         iimppt, ijmppt, ilcit, ilcjt       ! temporary workspace
-      REAL(wp) ::   zidom, zjdom            ! temporary scalars
-      !!----------------------------------------------------------------------
-
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'mpp_init : Message Passing MPI'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~'
-
-
-      !  1. Dimension arrays for subdomains
-      ! -----------------------------------
-      !  Computation of local domain sizes ilcit() ilcjt()
-      !  These dimensions depend on global sizes jpni,jpnj and jpiglo,jpjglo
-      !  The subdomains are squares leeser than or equal to the global
-      !  dimensions divided by the number of processors minus the overlap
-      !  array (cf. par_oce.F90).
-      
-      nreci  = 2 * jpreci
-      nrecj  = 2 * jprecj
-      iresti = MOD( jpiglo - nreci , jpni )
-      irestj = MOD( jpjglo - nrecj , jpnj )
-
-      IF(  iresti == 0 )   iresti = jpni
-      DO jj = 1, jpnj
-         DO ji = 1, iresti
-            ilcit(ji,jj) = jpi
-         END DO
-         DO ji = iresti+1, jpni
-            ilcit(ji,jj) = jpi -1
-         END DO
-      END DO
-      
-      IF( irestj == 0 )   irestj = jpnj
-      DO ji = 1, jpni
-         DO jj = 1, irestj
-            ilcjt(ji,jj) = jpj
-         END DO
-         DO jj = irestj+1, jpnj
-            ilcjt(ji,jj) = jpj -1
-         END DO
-      END DO
-      
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) '           defines mpp subdomains'
-         WRITE(numout,*) '           ----------------------'
-         WRITE(numout,*) '           iresti=',iresti,' irestj=',irestj
-         WRITE(numout,*) '           jpni  =',jpni  ,' jpnj  =',jpnj
-         ifreq = 4
-         il1   = 1
-         DO jn = 1, (jpni-1)/ifreq+1
-            il2 = MIN( jpni, il1+ifreq-1 )
-            WRITE(numout,*)
-            WRITE(numout,9200) ('***',ji = il1,il2-1)
-            DO jj = jpnj, 1, -1
-               WRITE(numout,9203) ('   ',ji = il1,il2-1)
-               WRITE(numout,9202) jj, ( ilcit(ji,jj),ilcjt(ji,jj),ji = il1,il2 )
-               WRITE(numout,9203) ('   ',ji = il1,il2-1)
-               WRITE(numout,9200) ('***',ji = il1,il2-1)
-            END DO
-            WRITE(numout,9201) (ji,ji = il1,il2)
-            il1 = il1+ifreq
-         END DO
- 9200    FORMAT('     ***',20('*************',a3))
- 9203    FORMAT('     *     ',20('         *   ',a3))
- 9201    FORMAT('        ',20('   ',i3,'          '))
- 9202    FORMAT(' ',i3,' *  ',20(i3,'  x',i3,'   *   '))
-      ENDIF
-
-      zidom = nreci
-      DO ji = 1, jpni
-         zidom = zidom + ilcit(ji,1) - nreci
-      END DO
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*)' sum ilcit(i,1) = ', zidom, ' jpiglo = ', jpiglo
-      
-      zjdom = nrecj
-      DO jj = 1, jpnj
-         zjdom = zjdom + ilcjt(1,jj) - nrecj
-      END DO
-      IF(lwp) WRITE(numout,*)' sum ilcit(1,j) = ', zjdom, ' jpjglo = ', jpjglo
-      IF(lwp) WRITE(numout,*)
-      
-
-      !  2. Index arrays for subdomains
-      ! -------------------------------
-      
-      iimppt(:,:) = 1
-      ijmppt(:,:) = 1
-      
-      IF( jpni > 1 ) THEN
-         DO jj = 1, jpnj
-            DO ji = 2, jpni
-               iimppt(ji,jj) = iimppt(ji-1,jj) + ilcit(ji-1,jj) - nreci
-            END DO
-         END DO
-      ENDIF
-
-      IF( jpnj > 1 ) THEN
-         DO jj = 2, jpnj
-            DO ji = 1, jpni
-               ijmppt(ji,jj) = ijmppt(ji,jj-1)+ilcjt(ji,jj-1)-nrecj
-            END DO
-         END DO
-      ENDIF
-      
-      ! 3. Subdomain description
-      ! ------------------------
-
-      DO jn = 1, jpnij
-         ii = 1 + MOD( jn-1, jpni )
-         ij = 1 + (jn-1) / jpni
-         nimppt(jn) = iimppt(ii,ij)
-         njmppt(jn) = ijmppt(ii,ij)
-         nlcit (jn) = ilcit (ii,ij)     
-         nlci       = nlcit (jn)     
-         nlcjt (jn) = ilcjt (ii,ij)     
-         nlcj       = nlcjt (jn)
-         nbondj = -1                                   ! general case
-         IF( jn   >  jpni          )   nbondj = 0      ! first row of processor
-         IF( jn   >  (jpnj-1)*jpni )   nbondj = 1      ! last  row of processor
-         IF( jpnj == 1             )   nbondj = 2      ! one processor only in j-direction
-         ibonjt(jn) = nbondj
-         
-         nbondi = 0                                    ! 
-         IF( MOD( jn, jpni ) == 1 )   nbondi = -1      !
-         IF( MOD( jn, jpni ) == 0 )   nbondi =  1      !
-         IF( jpni            == 1 )   nbondi =  2      ! one processor only in i-direction
-         ibonit(jn) = nbondi
-         
-         nldi =  1   + jpreci
-         nlei = nlci - jpreci
-         IF( nbondi == -1 .OR. nbondi == 2 )   nldi = 1
-         IF( nbondi ==  1 .OR. nbondi == 2 )   nlei = nlci
-         nldj =  1   + jprecj
-         nlej = nlcj - jprecj
-         IF( nbondj == -1 .OR. nbondj == 2 )   nldj = 1
-         IF( nbondj ==  1 .OR. nbondj == 2 )   nlej = nlcj
-         nldit(jn) = nldi
-         nleit(jn) = nlei
-         nldjt(jn) = nldj
-         nlejt(jn) = nlej
-      END DO
-      
-
-      ! 4. From global to local
-      ! -----------------------
-
-      nperio = 0
-      IF( jperio == 2 .AND. nbondj == -1 )   nperio = 2
-
-
-      ! 5. Subdomain neighbours
-      ! ----------------------
-
-      nproc = narea - 1
-      noso  = nproc - jpni
-      nowe  = nproc - 1
-      noea  = nproc + 1
-      nono  = nproc + jpni
-      ! great neighbours
-      npnw = nono - 1
-      npne = nono + 1
-      npsw = noso - 1
-      npse = noso + 1
-      nbsw = 1
-      nbnw = 1
-      IF( MOD( nproc, jpni ) == 0 ) THEN
-         nbsw = 0
-         nbnw = 0
-      ENDIF
-      nbse = 1
-      nbne = 1
-      IF( MOD( nproc, jpni ) == jpni-1 ) THEN
-         nbse = 0
-         nbne = 0
-      ENDIF
-      IF(nproc < jpni) THEN
-         nbsw = 0
-         nbse = 0
-      ENDIF
-      IF( nproc >= (jpnj-1)*jpni ) THEN
-         nbnw = 0
-         nbne = 0
-      ENDIF
-      nlcj = nlcjt(narea)  
-      nlci = nlcit(narea)  
-      nldi = nldit(narea)
-      nlei = nleit(narea)
-      nldj = nldjt(narea)
-      nlej = nlejt(narea)
-      nbondi = ibonit(narea)
-      nbondj = ibonjt(narea)
-      nimpp  = nimppt(narea)  
-      njmpp  = njmppt(narea)  
-
-     ! Save processor layout in layout.dat file 
-       IF (lwp) THEN
-        CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )
-        WRITE(inum,'(a)') '   jpnij     jpi     jpj     jpk  jpiglo  jpjglo'
-        WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo
-        WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp'
-
-        DO  jn = 1, jpnij
-         WRITE(inum,'(9i5)') jn, nlcit(jn), nlcjt(jn), &
-                                      nldit(jn), nldjt(jn), &
-                                      nleit(jn), nlejt(jn), &
-                                      nimppt(jn), njmppt(jn)
-        END DO
-        CLOSE(inum)   
-      END IF
-
-
-      ! w a r n i n g  narea (zone) /= nproc (processors)!
-
-      IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
-         IF( jpni == 1 )THEN
-            nbondi = 2
-            nperio = 1
-         ELSE
-            nbondi = 0
-         ENDIF
-         IF( MOD( narea, jpni ) == 0 ) THEN
-            noea = nproc-(jpni-1)
-            npne = npne-jpni
-            npse = npse-jpni
-         ENDIF
-         IF( MOD( narea, jpni ) == 1 ) THEN
-            nowe = nproc+(jpni-1)
-            npnw = npnw+jpni
-            npsw = npsw+jpni
-         ENDIF
-         nbsw = 1
-         nbnw = 1
-         nbse = 1
-         nbne = 1
-         IF( nproc < jpni ) THEN
-            nbsw = 0
-            nbse = 0
-         ENDIF
-         IF( nproc >= (jpnj-1)*jpni ) THEN
-            nbnw = 0
-            nbne = 0
-         ENDIF
-      ENDIF
-      npolj = 0
-      IF( jperio == 3 .OR. jperio == 4 ) THEN
-         ijm1 = jpni*(jpnj-1)
-         imil = ijm1+(jpni+1)/2
-         IF( narea > ijm1 ) npolj = 3
-         IF( MOD(jpni,2) == 1 .AND. narea == imil ) npolj = 4
-         IF( npolj == 3 ) nono = jpni*jpnj-narea+ijm1
-      ENDIF
-      IF( jperio == 5 .OR. jperio == 6 ) THEN
-          ijm1 = jpni*(jpnj-1)
-          imil = ijm1+(jpni+1)/2
-          IF( narea > ijm1) npolj = 5
-          IF( MOD(jpni,2) == 1 .AND. narea == imil ) npolj = 6
-          IF( npolj == 5 ) nono = jpni*jpnj-narea+ijm1
-      ENDIF
-
-      ! Periodicity : no corner if nbondi = 2 and nperio != 1
-
-      IF(lwp) THEN
-         WRITE(numout,*) ' nproc  = ', nproc
-         WRITE(numout,*) ' nowe   = ', nowe  , ' noea   =  ', noea
-         WRITE(numout,*) ' nono   = ', nono  , ' noso   =  ', noso
-         WRITE(numout,*) ' nbondi = ', nbondi
-         WRITE(numout,*) ' nbondj = ', nbondj
-         WRITE(numout,*) ' npolj  = ', npolj
-         WRITE(numout,*) ' nperio = ', nperio
-         WRITE(numout,*) ' nlci   = ', nlci
-         WRITE(numout,*) ' nlcj   = ', nlcj
-         WRITE(numout,*) ' nimpp  = ', nimpp
-         WRITE(numout,*) ' njmpp  = ', njmpp
-         WRITE(numout,*) ' nbse   = ', nbse  , ' npse   = ', npse
-         WRITE(numout,*) ' nbsw   = ', nbsw  , ' npsw   = ', npsw
-         WRITE(numout,*) ' nbne   = ', nbne  , ' npne   = ', npne
-         WRITE(numout,*) ' nbnw   = ', nbnw  , ' npnw   = ', npnw
-      ENDIF
-
-      IF( nperio == 1 .AND. jpni /= 1 ) CALL ctl_stop( ' mpp_init: error on cyclicity' )
-
-      ! Prepare mpp north fold
-
-      IF (jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
-         CALL mpp_ini_north
-      END IF
-
-      ! Prepare NetCDF output file (if necessary)
-      CALL mpp_init_ioipsl
-
-   END SUBROUTINE mpp_init
-
-#  include "mppini_2.h90"
-
-# if defined key_dimgout
-   !!----------------------------------------------------------------------
-   !!   'key_dimgout'                  NO use of NetCDF files
-   !!----------------------------------------------------------------------
-   SUBROUTINE mpp_init_ioipsl       ! Dummy routine
-   END SUBROUTINE mpp_init_ioipsl  
-# else
-   SUBROUTINE mpp_init_ioipsl
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE mpp_init_ioipsl  ***
-      !!
-      !! ** Purpose :   
-      !!
-      !! ** Method  :   
-      !!
-      !! History :
-      !!   9.0  !  04-03  (G. Madec )  MPP-IOIPSL 
-      !!   " "  !  08-12  (A. Coward)  addition in case of jpni*jpnj < jpnij
-      !!----------------------------------------------------------------------
-      !! Local declarations
-
-      INTEGER, DIMENSION(2) ::   &
-         iglo, iloc, iabsf, iabsl, ihals, ihale, idid
-      !!----------------------------------------------------------------------
-
-      ! The domain is split only horizontally along i- or/and j- direction
-      ! So we need at the most only 1D arrays with 2 elements.
-      ! Set idompar values equivalent to the jpdom_local_noextra definition
-      ! used in IOM. This works even if jpnij .ne. jpni*jpnj.
-      iglo(1) = jpiglo
-      iglo(2) = jpjglo
-      iloc(1) = nlci
-      iloc(2) = nlcj
-      iabsf(1) = nimppt(narea)
-      iabsf(2) = njmppt(narea)
-      iabsl(:) = iabsf(:) + iloc(:) - 1
-      ihals(1) = nldi - 1
-      ihals(2) = nldj - 1
-      ihale(1) = nlci - nlei
-      ihale(2) = nlcj - nlej
-      idid(1) = 1
-      idid(2) = 2
-
-      IF(lwp) THEN
-          WRITE(numout,*)
-          WRITE(numout,*) 'mpp_init_ioipsl :   iloc  = ', iloc (1), iloc (2)
-          WRITE(numout,*) '~~~~~~~~~~~~~~~     iabsf = ', iabsf(1), iabsf(2)
-          WRITE(numout,*) '                    ihals = ', ihals(1), ihals(2)
-          WRITE(numout,*) '                    ihale = ', ihale(1), ihale(2)
-      ENDIF
-
-      CALL flio_dom_set ( jpnij, nproc, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom)
-
-   END SUBROUTINE mpp_init_ioipsl  
-
-# endif
-#endif
-
-   !!======================================================================
-END MODULE mppini
Index: trunk/NEMOGCM/NEMO/OPA_SRC/mppini_2.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/mppini_2.h90	(revision 2527)
+++ 	(revision )
@@ -1,525 +1,0 @@
-   SUBROUTINE mpp_init2
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE mpp_init2  ***
-      !!
-      !! * Purpose :   Lay out the global domain over processors.
-      !!     FOR USING THIS VERSION, A PREPROCESSING TRAITMENT IS RECOMMENDED
-      !!     FOR DEFINING BETTER CUTTING OUT.
-      !!       This routine is used with a the bathymetry file.
-      !!       In this version, the land processors are avoided and the adress
-      !!     processor (nproc, narea,noea, ...) are calculated again.
-      !!     The jpnij parameter can be lesser than jpni x jpnj
-      !!     and this jpnij parameter must be calculated before with an
-      !!     algoritmic preprocessing program.
-      !!
-      !! ** Method  :   Global domain is distributed in smaller local domains.
-      !!      Periodic condition is a function of the local domain position
-      !!      (global boundary or neighbouring domain) and of the global
-      !!      periodic
-      !!      Type :         jperio global periodic condition
-      !!                     nperio local  periodic condition
-      !!
-      !! ** Action :        nimpp     : longitudinal index 
-      !!                    njmpp     : latitudinal  index
-      !!                    nperio    : lateral condition type 
-      !!                    narea     : number for local area
-      !!                    nlci      : first dimension
-      !!                    nlcj      : second dimension
-      !!                    nproc     : number for local processor
-      !!                    noea      : number for local neighboring processor
-      !!                    nowe      : number for local neighboring processor
-      !!                    noso      : number for local neighboring processor
-      !!                    nono      : number for local neighboring processor
-      !!
-      !! History :
-      !!        !  94-11  (M. Guyon)  Original code
-      !!        !  95-04  (J. Escobar, M. Imbard)
-      !!        !  98-02  (M. Guyon)  FETI method
-      !!        !  98-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions
-      !!   9.0  !  04-01  (G. Madec, J.M Molines)  F90 : free form , north fold jpni > 1
-      !!----------------------------------------------------------------------
-      USE in_out_manager  ! I/O Manager
-      USE iom
-      !! 
-      INTEGER :: ji, jj, jn, jproc, jarea     ! dummy loop indices
-      INTEGER ::  inum                        ! temporary logical unit
-      INTEGER ::   &
-         ii, ij, ifreq, il1, il2,          &  ! temporary integers
-         icont, ili, ilj,                  &  !    "          "
-         isurf, ijm1, imil,                &  !    "          "
-         iino, ijno, iiso, ijso,           &  !    "          " 
-         iiea, ijea, iiwe, ijwe,           &  !    "          "
-         iinw, ijnw, iine, ijne,           &  !    "          "
-         iisw, ijsw, iise, ijse,           &  !    "          "
-         iresti, irestj, iproc                !    "          "
-      INTEGER, DIMENSION(jpnij) ::   &
-         iin, ijn          
-      INTEGER, DIMENSION(jpni,jpnj) ::   &
-         iimppt, ijmppt, ilci  , ilcj  ,   &  ! temporary workspace
-         ipproc, ibondj, ibondi, ipolj ,   &  !    "           "
-         ilei  , ilej  , ildi  , ildj  ,   &  !    "           "
-         ioea  , iowe  , ioso  , iono  ,   &  !    "           "
-         ione  , ionw  , iose  , iosw  ,   &  !    "           "
-         ibne  , ibnw  , ibse  , ibsw         !    "           "
-      INTEGER,  DIMENSION(jpiglo,jpjglo) ::   &
-         imask                                ! temporary global workspace
-      REAL(wp), DIMENSION(jpiglo,jpjglo) ::   &
-         zdta                   ! temporary data workspace
-      REAL(wp) ::   zidom , zjdom          ! temporary scalars
-
-      ! read namelist for ln_zco
-      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco
-
-      !!----------------------------------------------------------------------
-      !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-      !! $Id$
-      !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
-      !!----------------------------------------------------------------------
-      
-      REWIND ( numnam )              ! Read Namelist namzgr : vertical coordinate'
-      READ   ( numnam, namzgr )
-
-      IF(lwp)WRITE(numout,*)
-      IF(lwp)WRITE(numout,*) 'mpp_init : Message Passing MPI'
-      IF(lwp)WRITE(numout,*) '~~~~~~~~'
-      IF(lwp)WRITE(numout,*) ' '
-
-      IF( jpni*jpnj < jpnij ) CALL ctl_stop( ' jpnij > jpni x jpnj impossible' )
-
-      ! 0. initialisation
-      ! -----------------
-
-      ! 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 
-      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/) )
-      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/) )
-      ENDIF
-      CALL iom_close (inum)
-
-      ! land/sea mask over the global/zoom domain
-
-      imask(:,:)=1
-      WHERE ( zdta(:,:) <= 0. ) imask = 0
-
-      !  1. Dimension arrays for subdomains
-      ! -----------------------------------
-
-      !  Computation of local domain sizes ilci() ilcj()
-      !  These dimensions depend on global sizes jpni,jpnj and jpiglo,jpjglo
-      !  The subdomains are squares leeser than or equal to the global
-      !  dimensions divided by the number of processors minus the overlap
-      !  array.
-
-      nreci=2*jpreci
-      nrecj=2*jprecj
-      iresti = 1 + MOD( jpiglo - nreci -1 , jpni )
-      irestj = 1 + MOD( jpjglo - nrecj -1 , jpnj )
-
-      ilci(1:iresti      ,:) = jpi
-      ilci(iresti+1:jpni ,:) = jpi-1
-
-      ilcj(:,      1:irestj) = jpj
-      ilcj(:, irestj+1:jpnj) = jpj-1
-
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) ' mpp_init2: defines mpp subdomains'
-      IF(lwp) WRITE(numout,*) ' ~~~~~~  ----------------------'
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'iresti=',iresti,' irestj=',irestj
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'jpni=',jpni,' jpnj=',jpnj
-
-      zidom = nreci + sum(ilci(:,1) - nreci ) 
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*)' sum ilci(i,1)=',zidom,' jpiglo=',jpiglo
-
-      zjdom = nrecj + sum(ilcj(1,:) - nrecj ) 
-      IF(lwp) WRITE(numout,*) ' sum ilcj(1,j)=',zjdom,' jpjglo=',jpjglo
-      IF(lwp) WRITE(numout,*)
-
-
-      !  2. Index arrays for subdomains
-      ! -------------------------------
-
-      iimppt(:,:) = 1
-      ijmppt(:,:) = 1
-      ipproc(:,:) = -1
-
-      IF( jpni > 1 )THEN
-         DO jj = 1, jpnj
-            DO ji = 2, jpni
-               iimppt(ji,jj) = iimppt(ji-1,jj) + ilci(ji-1,jj) - nreci
-            END DO
-         END DO
-      ENDIF
-
-      IF( jpnj > 1 )THEN
-         DO jj = 2, jpnj
-            DO ji = 1, jpni
-               ijmppt(ji,jj) = ijmppt(ji,jj-1) + ilcj(ji,jj-1) - nrecj
-            END DO
-         END DO
-      ENDIF
-
-
-      ! 3. Subdomain description in the Regular Case
-      ! --------------------------------------------
-
-      nperio = 0
-      icont = -1
-      DO jarea = 1, jpni*jpnj
-         ii = 1 + MOD(jarea-1,jpni)
-         ij = 1 +    (jarea-1)/jpni
-         ili = ilci(ii,ij)
-         ilj = ilcj(ii,ij)
-
-         ibondj(ii,ij) = -1
-         IF( jarea >  jpni          )   ibondj(ii,ij) = 0
-         IF( jarea >  (jpnj-1)*jpni )   ibondj(ii,ij) = 1
-         IF( jpnj  == 1             )   ibondj(ii,ij) = 2
-
-         ibondi(ii,ij) = 0
-         IF( MOD(jarea,jpni) == 1 )   ibondi(ii,ij) = -1
-         IF( MOD(jarea,jpni) == 0 )   ibondi(ii,ij) =  1
-         IF( jpni            == 1 )   ibondi(ii,ij) =  2
-
-         ! 2.4 Subdomain neighbors
-
-         iproc = jarea - 1
-         ioso(ii,ij) = iproc - jpni
-         iowe(ii,ij) = iproc - 1
-         ioea(ii,ij) = iproc + 1
-         iono(ii,ij) = iproc + jpni
-         ildi(ii,ij) = 1 + jpreci
-         ilei(ii,ij) = ili -jpreci
-         ionw(ii,ij) = iono(ii,ij) - 1
-         ione(ii,ij) = iono(ii,ij) + 1
-         iosw(ii,ij) = ioso(ii,ij) - 1
-         iose(ii,ij) = ioso(ii,ij) + 1
-         ibsw(ii,ij) = 1
-         ibnw(ii,ij) = 1
-         IF( MOD(iproc,jpni) == 0 ) THEN
-            ibsw(ii,ij) = 0
-            ibnw(ii,ij) = 0
-         ENDIF
-         ibse(ii,ij) = 1
-         ibne(ii,ij) = 1
-         IF( MOD(iproc,jpni) == jpni-1 ) THEN
-            ibse(ii,ij) = 0
-            ibne(ii,ij) = 0
-         ENDIF
-         IF( iproc < jpni ) THEN
-            ibsw(ii,ij) = 0
-            ibse(ii,ij) = 0
-         ENDIF
-         IF( iproc >= (jpnj-1)*jpni ) THEN
-            ibnw(ii,ij) = 0
-            ibne(ii,ij) = 0
-         ENDIF
-         IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 ) ildi(ii,ij) = 1
-         IF( ibondi(ii,ij) ==  1 .OR. ibondi(ii,ij) == 2 ) ilei(ii,ij) = ili
-         ildj(ii,ij) =  1  + jprecj
-         ilej(ii,ij) = ilj - jprecj
-         IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) = 1
-         IF( ibondj(ii,ij) ==  1 .OR. ibondj(ii,ij) == 2 ) ilej(ii,ij) = ilj
-
-         ! warning ii*ij (zone) /= nproc (processors)!
-
-         IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
-            IF( jpni == 1 )THEN
-               ibondi(ii,ij) = 2
-               nperio = 1
-            ELSE
-               ibondi(ii,ij) = 0
-            ENDIF
-            IF( MOD(jarea,jpni) == 0 ) THEN
-               ioea(ii,ij) = iproc - (jpni-1)
-               ione(ii,ij) = ione(ii,ij) - jpni
-               iose(ii,ij) = iose(ii,ij) - jpni
-            ENDIF
-            IF( MOD(jarea,jpni) == 1 ) THEN
-               iowe(ii,ij) = iproc + jpni - 1
-               ionw(ii,ij) = ionw(ii,ij) + jpni
-               iosw(ii,ij) = iosw(ii,ij) + jpni 
-            ENDIF
-            ibsw(ii,ij) = 1
-            ibnw(ii,ij) = 1
-            ibse(ii,ij) = 1
-            ibne(ii,ij) = 1
-            IF( iproc < jpni ) THEN
-               ibsw(ii,ij) = 0
-               ibse(ii,ij) = 0
-            ENDIF
-            IF( iproc >= (jpnj-1)*jpni ) THEN
-               ibnw(ii,ij) = 0
-               ibne(ii,ij) = 0
-            ENDIF
-         ENDIF
-         ipolj(ii,ij) = 0
-         IF( jperio == 3 .OR. jperio == 4 ) THEN
-            ijm1 = jpni*(jpnj-1)
-            imil = ijm1+(jpni+1)/2
-            IF( jarea > ijm1 ) ipolj(ii,ij) = 3
-            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 4
-            IF( ipolj(ii,ij) == 3 ) iono(ii,ij) = jpni*jpnj-jarea+ijm1
-         ENDIF
-         IF( jperio == 5 .OR. jperio == 6 ) THEN
-            ijm1 = jpni*(jpnj-1)
-            imil = ijm1+(jpni+1)/2
-            IF( jarea > ijm1) ipolj(ii,ij) = 5
-            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 6
-            IF( ipolj(ii,ij) == 5) iono(ii,ij) = jpni*jpnj-jarea+ijm1
-         ENDIF
-
-         isurf = 0
-         DO jj = 1+jprecj, ilj-jprecj
-            DO  ji = 1+jpreci, ili-jpreci
-               IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1) isurf = isurf+1
-            END DO
-         END DO
-         IF(isurf /= 0) THEN
-            icont = icont + 1
-            ipproc(ii,ij) = icont
-            iin(icont+1) = ii
-            ijn(icont+1) = ij
-         ENDIF
-      END DO
-
-      ! Control
-      IF(icont+1 /= jpnij) THEN
-         WRITE(ctmp1,*) ' jpni =',jpni,' jpnj =',jpnj
-         WRITE(ctmp2,*) ' jpnij =',jpnij, '< jpni x jpnj' 
-         WRITE(ctmp3,*) ' ***********, mpp_init2 finds jpnij=',icont+1
-         CALL ctl_stop( ' Eliminate land processors algorithm', '', ctmp1, ctmp2, '', ctmp3 )
-      ENDIF
-
-      ! 4. Subdomain print
-      ! ------------------
-
-      IF(lwp) THEN
-         ifreq = 4
-         il1 = 1
-         DO jn = 1,(jpni-1)/ifreq+1
-            il2 = MIN(jpni,il1+ifreq-1)
-            WRITE(numout,*)
-            WRITE(numout,9400) ('***',ji=il1,il2-1)
-            DO jj = jpnj, 1, -1
-               WRITE(numout,9403) ('   ',ji=il1,il2-1)
-               WRITE(numout,9402) jj, (ilci(ji,jj),ilcj(ji,jj),ji=il1,il2)
-               WRITE(numout,9404) (ipproc(ji,jj),ji=il1,il2)
-               WRITE(numout,9403) ('   ',ji=il1,il2-1)
-               WRITE(numout,9400) ('***',ji=il1,il2-1)
-            END DO
-            WRITE(numout,9401) (ji,ji=il1,il2)
-            il1 = il1+ifreq
-         END DO
- 9400     FORMAT('     ***',20('*************',a3))
- 9403     FORMAT('     *     ',20('         *   ',a3))
- 9401     FORMAT('        ',20('   ',i3,'          '))
- 9402     FORMAT(' ',i3,' *  ',20(i3,'  x',i3,'   *   '))
- 9404     FORMAT('     *  ',20('      ',i3,'   *   '))
-      ENDIF
-
-
-      ! 5. neighbour treatment
-      ! ----------------------
-
-      DO jarea = 1, jpni*jpnj
-         iproc = jarea-1
-         ii = 1 + MOD(jarea-1,jpni)
-         ij = 1 +    (jarea-1)/jpni
-         IF( ipproc(ii,ij) == -1 .AND. iono(ii,ij) >= 0   &
-            .AND. iono(ii,ij) <= jpni*jpnj-1 ) THEN
-            iino = 1 + MOD(iono(ii,ij),jpni)
-            ijno = 1 +    (iono(ii,ij))/jpni
-            IF( ibondj(iino,ijno) == 1 ) ibondj(iino,ijno)=2
-            IF( ibondj(iino,ijno) == 0 ) ibondj(iino,ijno) = -1
-         ENDIF
-         IF( ipproc(ii,ij) == -1 .AND. ioso(ii,ij) >= 0   &
-            .AND. ioso(ii,ij) <= jpni*jpnj-1 ) THEN
-            iiso = 1 + MOD(ioso(ii,ij),jpni)
-            ijso = 1 +    (ioso(ii,ij))/jpni
-            IF( ibondj(iiso,ijso) == -1 ) ibondj(iiso,ijso) = 2
-            IF( ibondj(iiso,ijso) ==  0 ) ibondj(iiso,ijso) = 1
-         ENDIF
-         IF( ipproc(ii,ij) == -1 .AND. ioea(ii,ij) >= 0   &
-            .AND. ioea(ii,ij) <= jpni*jpnj-1) THEN
-            iiea = 1 + MOD(ioea(ii,ij),jpni)
-            ijea = 1 +    (ioea(ii,ij))/jpni
-            IF( ibondi(iiea,ijea) == 1 ) ibondi(iiea,ijea) = 2
-            IF( ibondi(iiea,ijea) == 0 ) ibondi(iiea,ijea) = -1
-         ENDIF
-         IF( ipproc(ii,ij) == -1 .AND. iowe(ii,ij) >= 0   &
-            .AND. iowe(ii,ij) <= jpni*jpnj-1) THEN
-            iiwe = 1 + MOD(iowe(ii,ij),jpni)
-            ijwe = 1 +    (iowe(ii,ij))/jpni
-            IF( ibondi(iiwe,ijwe) == -1 ) ibondi(iiwe,ijwe) = 2
-            IF( ibondi(iiwe,ijwe) ==  0 ) ibondi(iiwe,ijwe) = 1
-         ENDIF
-         IF( ipproc(ii,ij) == -1 .AND. ibne(ii,ij) == 1 ) THEN
-            iine = 1 + MOD(ione(ii,ij),jpni)
-            ijne = 1 +    (ione(ii,ij))/jpni
-            IF( ibsw(iine,ijne) == 1 ) ibsw(iine,ijne) = 0
-         ENDIF
-         IF( ipproc(ii,ij) == -1 .AND. ibsw(ii,ij) == 1 ) THEN
-            iisw = 1 + MOD(iosw(ii,ij),jpni)
-            ijsw = 1 +    (iosw(ii,ij))/jpni
-            IF( ibne(iisw,ijsw) == 1 ) ibne(iisw,ijsw) = 0
-         ENDIF
-         IF( ipproc(ii,ij) == -1 .AND. ibnw(ii,ij) == 1 ) THEN
-            iinw = 1 + MOD(ionw(ii,ij),jpni)
-            ijnw = 1 +    (ionw(ii,ij))/jpni
-            IF( ibse(iinw,ijnw) == 1 ) ibse(iinw,ijnw)=0
-         ENDIF
-         IF( ipproc(ii,ij) == -1 .AND. ibse(ii,ij) == 1 ) THEN
-            iise = 1 + MOD(iose(ii,ij),jpni)
-            ijse = 1 +    (iose(ii,ij))/jpni
-            IF( ibnw(iise,ijse) == 1 ) ibnw(iise,ijse) = 0
-         ENDIF
-      END DO
-
-
-      ! 6. Change processor name
-      ! ------------------------
-
-      nproc = narea-1
-      ii = iin(narea)
-      ij = ijn(narea)
-      IF( ioso(ii,ij) >= 0 .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN 
-         iiso = 1 + MOD(ioso(ii,ij),jpni)
-         ijso = 1 +    (ioso(ii,ij))/jpni
-         noso = ipproc(iiso,ijso)
-      ENDIF
-      IF( iowe(ii,ij) >= 0 .AND. iowe(ii,ij) <= (jpni*jpnj-1) ) THEN 
-         iiwe = 1 + MOD(iowe(ii,ij),jpni)
-         ijwe = 1 +    (iowe(ii,ij))/jpni
-         nowe = ipproc(iiwe,ijwe)
-      ENDIF
-      IF( ioea(ii,ij) >= 0 .AND. ioea(ii,ij) <= (jpni*jpnj-1) ) THEN 
-         iiea = 1 + MOD(ioea(ii,ij),jpni)
-         ijea = 1 +    (ioea(ii,ij))/jpni
-         noea = ipproc(iiea,ijea)
-      ENDIF
-      IF( iono(ii,ij) >= 0 .AND. iono(ii,ij) <= (jpni*jpnj-1) ) THEN 
-         iino = 1 + MOD(iono(ii,ij),jpni)
-         ijno = 1 +    (iono(ii,ij))/jpni
-         nono = ipproc(iino,ijno)
-      ENDIF
-      IF( iose(ii,ij) >= 0 .AND. iose(ii,ij) <= (jpni*jpnj-1) ) THEN 
-         iise = 1 + MOD(iose(ii,ij),jpni)
-         ijse = 1 +    (iose(ii,ij))/jpni
-         npse = ipproc(iise,ijse)
-      ENDIF
-      IF( iosw(ii,ij) >= 0 .AND. iosw(ii,ij) <= (jpni*jpnj-1) ) THEN 
-         iisw = 1 + MOD(iosw(ii,ij),jpni)
-         ijsw = 1 +    (iosw(ii,ij))/jpni
-         npsw = ipproc(iisw,ijsw)
-      ENDIF
-      IF( ione(ii,ij) >= 0 .AND. ione(ii,ij) <= (jpni*jpnj-1) ) THEN 
-         iine = 1 + MOD(ione(ii,ij),jpni)
-         ijne = 1 +    (ione(ii,ij))/jpni
-         npne = ipproc(iine,ijne)
-      ENDIF
-      IF( ionw(ii,ij) >= 0 .AND. ionw(ii,ij) <= (jpni*jpnj-1) ) THEN 
-         iinw = 1 + MOD(ionw(ii,ij),jpni)
-         ijnw = 1 +    (ionw(ii,ij))/jpni
-         npnw = ipproc(iinw,ijnw)
-      ENDIF
-      nbnw = ibnw(ii,ij)
-      nbne = ibne(ii,ij)
-      nbsw = ibsw(ii,ij)
-      nbse = ibse(ii,ij)
-      nlcj = ilcj(ii,ij)  
-      nlci = ilci(ii,ij)  
-      nldi = ildi(ii,ij)
-      nlei = ilei(ii,ij)
-      nldj = ildj(ii,ij)
-      nlej = ilej(ii,ij)
-      nbondi = ibondi(ii,ij)
-      nbondj = ibondj(ii,ij)
-      nimpp = iimppt(ii,ij)  
-      njmpp = ijmppt(ii,ij)  
-      DO jproc = 1, jpnij
-         ii = iin(jproc)
-         ij = ijn(jproc)
-         nimppt(jproc) = iimppt(ii,ij)  
-         njmppt(jproc) = ijmppt(ii,ij)  
-         nlcjt(jproc) = ilcj(ii,ij)
-         nlcit(jproc) = ilci(ii,ij)
-         nldit(jproc) = ildi(ii,ij)
-         nleit(jproc) = ilei(ii,ij)
-         nldjt(jproc) = ildj(ii,ij)
-         nlejt(jproc) = ilej(ii,ij)
-      END DO
-
-      ! Save processor layout in ascii file
-      IF (lwp) THEN
-         CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )
-         WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo
-         WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp'
-
-        DO  jproc = 1, jpnij
-         WRITE(inum,'(9i5)') jproc, nlcit(jproc), nlcjt(jproc), &
-                                      nldit(jproc), nldjt(jproc), &
-                                      nleit(jproc), nlejt(jproc), &
-                                      nimppt(jproc), njmppt(jproc)
-        END DO
-        CLOSE(inum)   
-      END IF
-
-      IF( nperio == 1 .AND.jpni /= 1 ) CALL ctl_stop( ' mpp_init2:  error on cyclicity' )
-
-      ! Prepare mpp north fold
-
-      IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
-         CALL mpp_ini_north
-         IF(lwp) WRITE(numout,*) ' mpp_init2 : North fold boundary prepared for jpni >1'
-      ENDIF
-
-      ! Defined npolj, either 0, 3 , 4 , 5 , 6
-      ! In this case the important thing is that npolj /= 0
-      ! Because if we go through these line it is because jpni >1 and thus
-      ! we must use lbcnorthmpp, which tests only npolj =0 or npolj /= 0
-
-      npolj = 0
-      ij = ijn(narea)
-
-      IF( jperio == 3 .OR. jperio == 4 ) THEN
-         IF( ij == jpnj ) npolj = 3
-      ENDIF
-
-      IF( jperio == 5 .OR. jperio == 6 ) THEN
-         IF( ij == jpnj ) npolj = 5
-      ENDIF
-
-      ! Prepare NetCDF output file (if necessary)
-      CALL mpp_init_ioipsl
-
-      ! Periodicity : no corner if nbondi = 2 and nperio != 1
-
-      IF(lwp) THEN
-         WRITE(numout,*) ' nproc=  ',nproc
-         WRITE(numout,*) ' nowe=   ',nowe
-         WRITE(numout,*) ' noea=   ',noea
-         WRITE(numout,*) ' nono=   ',nono
-         WRITE(numout,*) ' noso=   ',noso
-         WRITE(numout,*) ' nbondi= ',nbondi
-         WRITE(numout,*) ' nbondj= ',nbondj
-         WRITE(numout,*) ' npolj=  ',npolj
-         WRITE(numout,*) ' nperio= ',nperio
-         WRITE(numout,*) ' nlci=   ',nlci
-         WRITE(numout,*) ' nlcj=   ',nlcj
-         WRITE(numout,*) ' nimpp=  ',nimpp
-         WRITE(numout,*) ' njmpp=  ',njmpp
-         WRITE(numout,*) ' nbse=   ',nbse,' npse= ',npse
-         WRITE(numout,*) ' nbsw=   ',nbsw,' npsw= ',npsw
-         WRITE(numout,*) ' nbne=   ',nbne,' npne= ',npne
-         WRITE(numout,*) ' nbnw=   ',nbnw,' npnw= ',npnw
-      ENDIF
-
-   END SUBROUTINE mpp_init2
Index: trunk/NEMOGCM/NEMO/OPA_SRC/nemo.f90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/nemo.f90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/nemo.f90	(revision 2528)
@@ -0,0 +1,21 @@
+PROGRAM nemo
+   !!======================================================================
+   !!                     ***  PROGRAM nemo  ***
+   !!
+   !! ** Purpose :   encapsulate nemo_gcm so that it can also be called
+   !!              together with the linear tangent and adjoint models
+   !!======================================================================
+   !! History :   OPA  ! 2001-02  (M. Imbard, A. Weaver)  Original code
+   !!   NEMO      1.0  ! 2003-10  (G. Madec) F90
+   !!----------------------------------------------------------------------
+   USE nemogcm   ! NEMO system   (nemo_gcm routine)
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   !
+   CALL nemo_gcm           ! NEMO direct code
+   ! 
+   !!======================================================================
+END PROGRAM nemo
Index: trunk/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90	(revision 2528)
@@ -0,0 +1,430 @@
+MODULE nemogcm
+   !!======================================================================
+   !!                       ***  MODULE nemogcm   ***
+   !! Ocean system   : NEMO GCM (ocean dynamics, on-line tracers, biochemistry and sea-ice)
+   !!======================================================================
+   !! History :  OPA  ! 1990-10  (C. Levy, G. Madec)  Original code
+   !!            7.0  ! 1991-11  (M. Imbard, C. Levy, G. Madec)
+   !!            7.1  ! 1993-03  (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar, 
+   !!                             P. Delecluse, C. Perigaud, G. Caniaux, B. Colot, C. Maes) release 7.1 
+   !!             -   ! 1992-06  (L.Terray)  coupling implementation
+   !!             -   ! 1993-11  (M.A. Filiberti) IGLOO sea-ice 
+   !!            8.0  ! 1996-03  (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar, 
+   !!                             P. Delecluse, L.Terray, M.A. Filiberti, J. Vialar, A.M. Treguier, M. Levy) release 8.0
+   !!            8.1  ! 1997-06  (M. Imbard, G. Madec)
+   !!            8.2  ! 1999-11  (M. Imbard, H. Goosse)  LIM sea-ice model 
+   !!                 ! 1999-12  (V. Thierry, A-M. Treguier, M. Imbard, M-A. Foujols)  OPEN-MP 
+   !!                 ! 2000-07  (J-M Molines, M. Imbard)  Open Boundary Conditions  (CLIPPER)
+   !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90: Free form and modules
+   !!             -   ! 2004-06  (R. Redler, NEC CCRLE, Germany) add OASIS[3/4] coupled interfaces
+   !!             -   ! 2004-08  (C. Talandier) New trends organization
+   !!             -   ! 2005-06  (C. Ethe) Add the 1D configuration possibility
+   !!             -   ! 2005-11  (V. Garnier) Surface pressure gradient organization
+   !!             -   ! 2006-03  (L. Debreu, C. Mazauric)  Agrif implementation
+   !!             -   ! 2006-04  (G. Madec, R. Benshila)  Step reorganization
+   !!             -   ! 2007-07  (J. Chanut, A. Sellar) Unstructured open boundaries (BDY)
+   !!            3.2  ! 2009-08  (S. Masson)  open/write in the listing file in mpp
+   !!            3.3  ! 2010-05  (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface 
+   !!             -   ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   nemo_gcm       : solve ocean dynamics, tracer, biogeochemistry and/or sea-ice
+   !!   nemo_init      : initialization of the NEMO system
+   !!   nemo_ctl       : initialisation of the contol print 
+   !!   nemo_closefile : close remaining open files
+   !!----------------------------------------------------------------------
+   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 mppini          ! shared/distributed memory setting (mpp_init routine)
+   USE domain          ! domain initialization             (dom_init routine)
+   USE obcini          ! open boundary cond. initialization (obc_ini routine)
+   USE bdyini          ! unstructured open boundary cond. initialization (bdy_init routine)
+   USE istate          ! initial state setting          (istate_init routine)
+   USE ldfdyn          ! lateral viscosity setting      (ldfdyn_init routine)
+   USE ldftra          ! lateral diffusivity setting    (ldftra_init routine)
+   USE zdfini          ! vertical physics setting          (zdf_init routine)
+   USE phycst          ! physical constant                  (par_cst routine)
+   USE trdmod          ! momentum/tracers trends       (trd_mod_init routine)
+   USE asminc          ! assimilation increments       (asm_inc_init routine)
+   USE asmtrj          ! writing out state trajectory
+   USE sshwzv          ! vertical velocity used in asm
+   USE diaptr          ! poleward transports           (dia_ptr_init routine)
+   USE diaobs          ! Observation diagnostics       (dia_obs_init routine)
+   USE step            ! NEMO time-stepping                 (stp     routine)
+#if defined key_oasis3
+   USE cpl_oasis3      ! OASIS3 coupling
+#elif defined key_oasis4
+   USE cpl_oasis4      ! OASIS4 coupling (not working)
+#endif
+   USE c1d             ! 1D configuration
+   USE step_c1d        ! Time stepping loop for the 1D configuration
+#if defined key_top
+   USE trcini          ! passive tracer initialisation
+#endif
+   USE lib_mpp         ! distributed memory computing
+#if defined key_iomput
+   USE mod_ioclient
+#endif
+
+   PRIVATE
+
+   PUBLIC   nemo_gcm    ! called by model.F90
+   PUBLIC   nemo_init   ! needed by AGRIF
+
+   CHARACTER(lc) ::   cform_aaa="( /, 'AAAAAAAA', / ) "     ! flag for output listing
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE nemo_gcm
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_gcm  ***
+      !!
+      !! ** Purpose :   NEMO solves the primitive equations on an orthogonal 
+      !!              curvilinear mesh on the sphere.
+      !!
+      !! ** Method  : - model general initialization
+      !!              - launch the time-stepping (stp routine)
+      !!              - finalize the run by closing files and communications
+      !!
+      !! References : Madec, Delecluse,Imbard, and Levy, 1997:  internal report, IPSL.
+      !!              Madec, 2008, internal report, IPSL.
+      !!----------------------------------------------------------------------
+      INTEGER ::   istp       ! time step index
+      !!----------------------------------------------------------------------
+      !
+#if defined key_agrif
+      CALL Agrif_Init_Grids()      ! AGRIF: set the meshes
+#endif
+
+      !                            !-----------------------!
+      CALL nemo_init               !==  Initialisations  ==!
+      !                            !-----------------------!
+
+      ! check that all process are still there... If some process have an error,
+      ! they will never enter in step and other processes will wait until the end of the cpu time!
+      IF( lk_mpp )   CALL mpp_max( nstop )
+
+      IF(lwp) WRITE(numout,cform_aaa)   ! Flag AAAAAAA
+
+      !                            !-----------------------!
+      !                            !==   time stepping   ==!
+      !                            !-----------------------!
+      istp = nit000
+#if defined key_c1d
+         DO WHILE ( istp <= nitend .AND. nstop == 0 )
+            CALL stp_c1d( istp )
+            istp = istp + 1
+         END DO
+#else
+          IF( lk_asminc ) THEN
+             IF( ln_bkgwri ) CALL asm_bkg_wri( nit000 - 1 )    ! Output background fields
+             IF( ln_trjwri ) CALL asm_trj_wri( nit000 - 1 )    ! Output trajectory fields
+             IF( ln_asmdin ) THEN                        ! Direct initialization
+                IF( ln_trainc ) CALL tra_asm_inc( nit000 - 1 )    ! Tracers
+                IF( ln_dyninc ) THEN 
+                   CALL dyn_asm_inc( nit000 - 1 )    ! Dynamics
+                   IF ( ln_asmdin ) CALL ssh_wzv ( nit000 - 1 )      ! update vertical velocity 
+                ENDIF
+                IF( ln_sshinc ) CALL ssh_asm_inc( nit000 - 1 )    ! SSH
+             ENDIF
+          ENDIF
+        
+         DO WHILE ( istp <= nitend .AND. nstop == 0 )
+#if defined key_agrif
+            CALL Agrif_Step( stp )           ! AGRIF: time stepping
+#else
+            CALL stp( istp )                 ! standard time stepping
+#endif
+            istp = istp + 1
+            IF( lk_mpp )   CALL mpp_max( nstop )
+         END DO
+#endif
+
+      IF( lk_diaobs ) CALL dia_obs_wri
+       
+      !                            !------------------------!
+      !                            !==  finalize the run  ==!
+      !                            !------------------------!
+      IF(lwp) WRITE(numout,cform_aaa)   ! Flag AAAAAAA
+      !
+      IF( nstop /= 0 .AND. lwp ) THEN   ! error print
+         WRITE(numout,cform_err)
+         WRITE(numout,*) nstop, ' error have been found' 
+      ENDIF
+      !
+      CALL nemo_closefile
+#if defined key_oasis3 || defined key_oasis4
+      CALL cpl_prism_finalize           ! end coupling and mpp communications with OASIS
+#else
+      IF( lk_mpp )   CALL mppstop       ! end mpp communications
+#endif
+      !
+   END SUBROUTINE nemo_gcm
+
+
+   SUBROUTINE nemo_init
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_init  ***
+      !!
+      !! ** Purpose :   initialization of the NEMO GCM
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji          ! dummy loop indices
+      INTEGER :: ilocal_comm   ! local integer
+      CHARACTER(len=80), DIMENSION(10) ::   cltxt
+      !!
+      NAMELIST/namctl/ ln_ctl  , nn_print, nn_ictls, nn_ictle,   &
+         &             nn_isplt, nn_jsplt, nn_jctls, nn_jctle, nn_bench
+      !!----------------------------------------------------------------------
+      !
+      cltxt = ''
+      !
+      !                             ! open Namelist file
+      CALL ctl_opn( numnam, 'namelist', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+      !
+      READ( numnam, namctl )        ! Namelist namctl : Control prints & Benchmark
+      !
+      !                             !--------------------------------------------!
+      !                             !  set communicator & select the local node  !
+      !                             !--------------------------------------------!
+#if defined key_iomput
+      IF( Agrif_Root() ) THEN
+# if defined key_oasis3 || defined key_oasis4
+         CALL cpl_prism_init( ilocal_comm )   ! nemo local communicator given by oasis
+# endif
+         CALL  init_ioclient( ilocal_comm )   ! exchange io_server nemo local communicator with the io_server
+      ENDIF
+      narea = mynode( cltxt, ilocal_comm )    ! Nodes selection
+#else
+# if defined key_oasis3 || defined key_oasis4
+      IF( Agrif_Root() ) THEN
+         CALL cpl_prism_init( ilocal_comm )   ! nemo local communicator given by oasis
+      ENDIF
+      narea = mynode( cltxt, ilocal_comm )    ! Nodes selection (control print return in cltxt)
+# else
+      ilocal_comm = 0
+      narea = mynode( cltxt )                 ! Nodes selection (control print return in cltxt)
+# endif
+#endif
+      narea = narea + 1                       ! mynode return the rank of proc (0 --> jpnij -1 )
+
+      lwp = (narea == 1) .OR. ln_ctl          ! control of all listing output print
+
+      IF(lwp) THEN                            ! open listing units
+         !
+         CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
+         !
+         WRITE(numout,*)
+         WRITE(numout,*) '         CNRS - NERC - Met OFFICE - MERCATOR-ocean'
+         WRITE(numout,*) '                       NEMO team'
+         WRITE(numout,*) '            Ocean General Circulation Model'
+         WRITE(numout,*) '                  version 3.3  (2010) '
+         WRITE(numout,*)
+         WRITE(numout,*)
+         DO ji = 1, SIZE(cltxt) 
+            IF( TRIM(cltxt(ji)) /= '' )   WRITE(numout,*) cltxt(ji)      ! control print of mynode
+         END DO
+         WRITE(numout,cform_aaa)                                         ! Flag AAAAAAA
+         !
+      ENDIF
+      !                             !-------------------------------!
+      !                             !  NEMO general initialization  !
+      !                             !-------------------------------!
+
+      CALL nemo_ctl                          ! Control prints & Benchmark
+
+      !                                      ! Domain decomposition
+      IF( jpni*jpnj == jpnij ) THEN   ;   CALL mpp_init      ! standard cutting out
+      ELSE                            ;   CALL mpp_init2     ! eliminate land processors
+      ENDIF
+      !
+      !                                      ! General initialization
+                            CALL     phy_cst    ! Physical constants
+                            CALL     eos_init   ! Equation of state
+                            CALL     dom_cfg    ! Domain configuration
+                            CALL     dom_init   ! Domain
+
+      IF( ln_ctl        )   CALL prt_ctl_init   ! Print control
+
+      IF( lk_obc        )   CALL     obc_init   ! Open boundaries 
+      IF( lk_bdy        )   CALL     bdy_init   ! Unstructured open boundaries
+
+                            CALL  istate_init   ! ocean initial state (Dynamics and tracers)
+
+      !                                     ! Ocean physics
+                            CALL     sbc_init   ! Forcings : surface module 
+      !                                         ! Vertical physics
+                            CALL     zdf_init      ! namelist read
+                            CALL zdf_bfr_init      ! bottom friction
+      IF( lk_zdfric     )   CALL zdf_ric_init      ! Richardson number dependent Kz
+      IF( lk_zdftke     )   CALL zdf_tke_init      ! TKE closure scheme
+      IF( lk_zdfgls     )   CALL zdf_gls_init      ! GLS closure scheme
+      IF( lk_zdfkpp     )   CALL zdf_kpp_init      ! KPP closure scheme
+      IF( lk_zdftmx     )   CALL zdf_tmx_init      ! tidal vertical mixing
+      IF( lk_zdfddm .AND. .NOT. lk_zdfkpp )   & 
+         &                  CALL zdf_ddm_init      ! double diffusive mixing
+      !                                         ! Lateral physics
+                            CALL ldf_tra_init      ! Lateral ocean tracer physics
+                            CALL ldf_dyn_init      ! Lateral ocean momentum physics
+      IF( lk_ldfslp     )   CALL ldf_slp_init      ! slope of lateral mixing
+
+      !                                     ! Active tracers
+                            CALL tra_qsr_init   ! penetrative solar radiation qsr
+                            CALL tra_bbc_init   ! bottom heat flux
+      IF( lk_trabbl     )   CALL tra_bbl_init   ! advective (and/or diffusive) bottom boundary layer scheme
+      IF( lk_tradmp     )   CALL tra_dmp_init   ! internal damping trends
+                            CALL tra_adv_init   ! horizontal & vertical advection
+                            CALL tra_ldf_init   ! lateral mixing
+                            CALL tra_zdf_init   ! vertical mixing and after tracer fields
+
+      !                                     ! Dynamics
+                            CALL dyn_adv_init   ! advection (vector or flux form)
+                            CALL dyn_vor_init   ! vorticity term including Coriolis
+                            CALL dyn_ldf_init   ! lateral mixing
+                            CALL dyn_hpg_init   ! horizontal gradient of Hydrostatic pressure
+                            CALL dyn_zdf_init   ! vertical diffusion
+                            CALL dyn_spg_init   ! surface pressure gradient
+                            
+      !                                     ! Misc. options
+      IF( nn_cla == 1   )   CALL cla_init       ! Cross Land Advection
+      
+#if defined key_top
+      !                                     ! Passive tracers
+                            CALL     trc_init
+#endif
+      !                                     ! Diagnostics
+                            CALL     iom_init   ! iom_put initialization
+      IF( lk_floats     )   CALL     flo_init   ! drifting Floats
+      IF( lk_diaar5     )   CALL dia_ar5_init   ! ar5 diag
+                            CALL dia_ptr_init   ! Poleward TRansports initialization
+                            CALL dia_hsb_init   ! heat content, salt content and volume budgets
+                            CALL trd_mod_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( lk_asminc     )   CALL asm_inc_init   ! Initialize assimilation increments
+      IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler
+      !
+   END SUBROUTINE nemo_init
+
+
+   SUBROUTINE nemo_ctl
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_ctl  ***
+      !!
+      !! ** Purpose :   control print setting 
+      !!
+      !! ** Method  : - print namctl information and check some consistencies
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'nemo_ctl: Control prints & Benchmark'
+         WRITE(numout,*) '~~~~~~~ '
+         WRITE(numout,*) '   Namelist namctl'
+         WRITE(numout,*) '      run control (for debugging)     ln_ctl     = ', ln_ctl
+         WRITE(numout,*) '      level of print                  nn_print   = ', nn_print
+         WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls
+         WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle
+         WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls
+         WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle
+         WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt
+         WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt
+         WRITE(numout,*) '      benchmark parameter (0/1)       nn_bench   = ', nn_bench
+      ENDIF
+      !
+      nprint    = nn_print          ! convert DOCTOR namelist names into OLD names
+      nictls    = nn_ictls
+      nictle    = nn_ictle
+      njctls    = nn_jctls
+      njctle    = nn_jctle
+      isplt     = nn_isplt
+      jsplt     = nn_jsplt
+      nbench    = nn_bench
+      !                             ! Parameter control
+      !
+      IF( ln_ctl ) THEN                 ! sub-domain area indices for the control prints
+         IF( lk_mpp ) THEN
+            isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain
+         ELSE
+            IF( isplt == 1 .AND. jsplt == 1  ) THEN
+               CALL ctl_warn( ' - isplt & jsplt are equal to 1',   &
+                  &           ' - the print control will be done over the whole domain' )
+            ENDIF
+            ijsplt = isplt * jsplt            ! total number of processors ijsplt
+         ENDIF
+         IF(lwp) WRITE(numout,*)'          - The total number of processors over which the'
+         IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt
+         !
+         !                              ! indices used for the SUM control
+         IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area
+            lsp_area = .FALSE.                        
+         ELSE                                             ! print control done over a specific  area
+            lsp_area = .TRUE.
+            IF( nictls < 1 .OR. nictls > jpiglo )   THEN
+               CALL ctl_warn( '          - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )
+               nictls = 1
+            ENDIF
+            IF( nictle < 1 .OR. nictle > jpiglo )   THEN
+               CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )
+               nictle = jpiglo
+            ENDIF
+            IF( njctls < 1 .OR. njctls > jpjglo )   THEN
+               CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )
+               njctls = 1
+            ENDIF
+            IF( njctle < 1 .OR. njctle > jpjglo )   THEN
+               CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )
+               njctle = jpjglo
+            ENDIF
+         ENDIF
+      ENDIF
+      !
+      IF( nbench == 1 ) THEN              ! Benchmark 
+         SELECT CASE ( cp_cfg )
+         CASE ( 'gyre' )   ;   CALL ctl_warn( ' The Benchmark is activated ' )
+         CASE DEFAULT      ;   CALL ctl_stop( ' The Benchmark is based on the GYRE configuration:',   &
+            &                                 ' key_gyre must be used or set nbench = 0' )
+         END SELECT
+      ENDIF
+      !
+      IF( lk_c1d .AND. .NOT.lk_iomput )   CALL ctl_stop( 'nemo_ctl: The 1D configuration must be used ',   &
+         &                                               'with the IOM Input/Output manager. '         ,   &
+         &                                               'Compile with key_iomput enabled' )
+      !
+   END SUBROUTINE nemo_ctl
+
+
+   SUBROUTINE nemo_closefile
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_closefile  ***
+      !!
+      !! ** Purpose :   Close the files
+      !!----------------------------------------------------------------------
+      !
+      IF( lk_mpp )   CALL mppsync
+      !
+      CALL iom_close                                 ! close all input/output files managed by iom_*
+      !
+      IF( numstp     /= -1 )   CLOSE( numstp     )   ! time-step file
+      IF( numsol     /= -1 )   CLOSE( numsol     )   ! solver file
+      IF( numnam     /= -1 )   CLOSE( numnam     )   ! oce namelist
+      IF( numnam_ice /= -1 )   CLOSE( numnam_ice )   ! ice namelist
+      IF( numevo_ice /= -1 )   CLOSE( numevo_ice )   ! ice variables (temp. evolution)
+      IF( numout     /=  6 )   CLOSE( numout     )   ! standard model output file
+      !
+      numout = 6                                     ! redefine numout in case it is used after this point...
+      !
+   END SUBROUTINE nemo_closefile
+
+   !!======================================================================
+END MODULE nemogcm
Index: trunk/NEMOGCM/NEMO/OPA_SRC/oce.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/oce.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/oce.F90	(revision 2528)
@@ -4,7 +4,7 @@
    !! Ocean        :  dynamics and active tracers defined in memory 
    !!======================================================================
-   !! History :  0.1  !  2002-11  (G. Madec)  F90: Free form and module
-   !!            1.0  !  2005-11  (V. Garnier) Surface pressure gradient organization
+   !! History :  1.0  !  2002-11  (G. Madec)  F90: Free form and module
    !!            3.1  !  2009-02  (G. Madec, M. Leclair)  pure z* coordinate
+   !!            3.3  !  2010-09  (C. Ethe) TRA-TRC merge: add ts, gtsu, gtsv 4D arrays
    !!----------------------------------------------------------------------
    USE par_oce      ! ocean parameters
@@ -13,32 +13,20 @@
    PRIVATE
 
-   LOGICAL, PUBLIC ::   l_traldf_rot    = .FALSE.  !: rotated laplacian operator for lateral diffusion
+   LOGICAL         , PUBLIC ::   l_traldf_rot = .FALSE.  !: rotated laplacian operator for lateral diffusion
 
-   !! dynamics and tracer fields             !  before  !  now     !  after   ! the after trends becomes the fields
-   !! --------------------------             !  fields  !  fields  !  trends  ! only after tra_zdf and dyn_spg
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   ub     ,  un      ,  ua      !: i-horizontal velocity      [m/s]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   vb     ,  vn      ,  va      !: j-horizontal velocity      [m/s]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::             wn                 !: vertical velocity          [m/s]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   rotb   ,  rotn               !: relative vorticity         [s-1]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   hdivb  ,  hdivn              !: horizontal divergence      [s-1]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   tb     ,  tn      ,  ta      !: potential temperature      [Celcius]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   sb     ,  sn      ,  sa      !: salinity                   [psu]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   rn2b   ,  rn2                !: brunt-vaisala frequency**2 [s-2]
+   !! dynamics and tracer fields                  ! before ! now    ! after   ! the after trends becomes the fields
+   !! --------------------------                  ! fields ! fields ! trends  ! only after tra_zdf and dyn_spg
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)      ::   ub   ,  un    , ua      !: i-horizontal velocity        [m/s]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)      ::   vb   ,  vn    , va      !: j-horizontal velocity        [m/s]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)      ::           wn              !: vertical velocity            [m/s]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)      ::   rotb ,  rotn            !: relative vorticity           [s-1]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)      ::   hdivb,  hdivn           !: horizontal divergence        [s-1]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)      ::   tb   ,  tn    , ta      !: potential temperature    [Celcius]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)      ::   sb   ,  sn    , sa      !: salinity                     [psu]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk,jpts) ::   tsb  ,  tsn   , tsa     !: 4D T-S fields        [Celcius,psu] 
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)      ::   rn2b ,  rn2             !: brunt-vaisala frequency**2   [s-2]
    !
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   rhd    !: in situ density anomalie rhd=(rho-rau0)/rau0     [no units]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   rhd    !: in situ density anomalie rhd=(rho-rau0)/rau0  [no units]
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   rhop   !: potential volumic mass                           [kg/m3]
-
-   !! advection scheme choice
-   !! -----------------------
-   CHARACTER(len=3), PUBLIC  ::   l_adv   !: flag for the advection scheme used (= 'ce2', 'tvd', 'mus' or ...)
-
-   !! surface pressure gradient
-   !! -------------------------
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   spgu, spgv      !: horizontal surface pressure gradient
-
-   !! interpolated gradient (only used in zps case)
-   !! ---------------------
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   gtu, gsu, gru   !: horizontal gradient of T, S and rd at bottom u-point
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   gtv, gsv, grv   !: horizontal gradient of T, S and rd at bottom v-point 
 
    !! free surface                       !  before  !  now     !  after   !
@@ -47,10 +35,17 @@
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sshu_b ,  sshu_n  ,  sshu_a  !: sea surface height at u-point [m]
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sshv_b ,  sshv_n  ,  sshv_a  !: sea surface height at u-point [m]
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sshf_b ,  sshf_n  ,  sshf_a  !: sea surface height at f-point [m]
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::             sshf_n             !: sea surface height at f-point [m]
+   !
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   spgu, spgv                   !: horizontal surface pressure gradient
+
+   !! interpolated gradient (only used in zps case)
+   !! ---------------------
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpts) ::   gtsu, gtsv   !: horizontal gradient of T, S bottom u-point
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)      ::   gru , grv    !: horizontal gradient of rd at bottom u-point
 
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2008) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!======================================================================
 END MODULE oce
Index: trunk/NEMOGCM/NEMO/OPA_SRC/opa.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/opa.F90	(revision 2527)
+++ 	(revision )
@@ -1,405 +1,0 @@
-MODULE opa
-   !!==============================================================================
-   !!                       ***  MODULE opa   ***
-   !! Ocean system   : OPA ocean dynamics (including on-line tracers and sea-ice)
-   !!==============================================================================
-   !! History :  OPA  ! 1990-10  (C. Levy, G. Madec)  Original code
-   !!            7.0  ! 1991-11  (M. Imbard, C. Levy, G. Madec)
-   !!            7.1  ! 1993-03  (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar, 
-   !!                             P. Delecluse, C. Perigaud, G. Caniaux, B. Colot, C. Maes )  release 7.1 
-   !!             -   ! 1992-06  (L.Terray)  coupling implementation
-   !!             -   ! 1993-11  (M.A. Filiberti) IGLOO sea-ice 
-   !!            8.0  ! 1996-03  (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar, 
-   !!                             P. Delecluse, L.Terray, M.A. Filiberti, J. Vialar, A.M. Treguier, M. Levy)  release 8.0
-   !!            8.1  ! 1997-06  (M. Imbard, G. Madec)
-   !!            8.2  ! 1999-11  (M. Imbard, H. Goosse)  LIM sea-ice model 
-   !!                 ! 1999-12  (V. Thierry, A-M. Treguier, M. Imbard, M-A. Foujols)  OPEN-MP 
-   !!                 ! 2000-07  (J-M Molines, M. Imbard)  Open Boundary Conditions  (CLIPPER)
-   !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90: Free form and modules
-   !!             -   ! 2004-06  (R. Redler, NEC CCRLE, Germany) add OASIS[3/4] coupled interfaces
-   !!             -   ! 2004-08  (C. Talandier) New trends organization
-   !!             -   ! 2005-06  (C. Ethe) Add the 1D configuration possibility
-   !!             -   ! 2005-11  (V. Garnier) Surface pressure gradient organization
-   !!             -   ! 2006-03  (L. Debreu, C. Mazauric)  Agrif implementation
-   !!             -   ! 2006-04  (G. Madec, R. Benshila)  Step reorganization
-   !!             -   ! 2007-07  (J. Chanut, A. Sellar) Unstructured open boundaries (BDY)
-   !!            3.2  ! 2009-08  (S. Masson)  open/write in the listing file in mpp
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   opa_model      : solve ocean dynamics, tracer and/or sea-ice
-   !!   opa_init       : initialization of the opa model
-   !!   opa_flg        : initialisation of algorithm flag 
-   !!   opa_closefile  : close remaining files
-   !!----------------------------------------------------------------------
-   USE oce             ! dynamics and tracers variables
-   USE dom_oce         ! ocean space domain variables
-   USE sbc_oce         ! surface boundary condition: ocean
-   USE trdmod_oce      ! ocean variables trends
-   USE domcfg          ! domain configuration               (dom_cfg routine)
-   USE mppini          ! shared/distributed memory setting (mpp_init routine)
-   USE domain          ! domain initialization             (dom_init routine)
-   USE obc_par         ! open boundary cond. parameters
-   USE obcini          ! open boundary cond. initialization (obc_ini routine)
-   USE bdy_par         ! unstructured open boundary cond. parameters
-   USE bdyini          ! unstructured open boundary cond. initialization (bdy_init routine)
-   USE istate          ! initial state setting          (istate_init routine)
-   USE sbcmod          ! surface boundary condition 
-   USE eosbn2          ! equation of state                 (eos_init routine)
-   USE dynhpg          ! hydrostatic pressure gradient
-   USE ldfdyn          ! lateral viscosity setting      (ldfdyn_init routine)
-   USE ldftra          ! lateral diffusivity setting    (ldftra_init routine)
-   USE zdfini
-   USE phycst          ! physical constant                  (par_cst routine)
-   USE trdmod          ! momentum/tracers trends       (trd_mod_init routine)
-   USE diaptr          ! poleward transports           (dia_ptr_init routine)
-   USE step            ! OPA time-stepping                  (stp     routine)
-#if defined key_oasis3
-   USE cpl_oasis3      ! OASIS3 coupling
-#elif defined key_oasis4
-   USE cpl_oasis4      ! OASIS4 coupling (not working)
-#endif
-   USE dynspg_oce      ! Control choice of surface pressure gradient schemes
-   USE prtctl          ! Print control                 (prt_ctl_init routine)
-   USE c1d             ! 1D configuration
-   USE dyncor_c1d      ! Coriolis factor at T-point
-   USE step_c1d        ! Time stepping loop for the 1D configuration
-#if defined key_top
-   USE trcini          ! passive tracer initialisation
-#endif
-   
-   USE iom
-   USE in_out_manager  ! I/O manager
-   USE lib_mpp         ! distributed memory computing
-#if defined key_iomput
-   USE mod_ioclient
-#endif
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   opa_model   ! called by model.F90
-   PUBLIC   opa_init    ! needed by AGRIF
-
-   CHARACTER (len=64) ::   cform_aaa="( /, 'AAAAAAAA', / ) "     ! flag for output listing
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
-   !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE opa_model
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE opa  ***
-      !!
-      !! ** Purpose :   opa solves the primitive equations on an orthogonal 
-      !!              curvilinear mesh on the sphere.
-      !!
-      !! ** Method  : - model general initialization
-      !!              - launch the time-stepping (stp routine)
-      !!              - finalize the run by closing files and communications
-      !!
-      !! References : Madec, Delecluse,Imbard, and Levy, 1997:  internal report, IPSL.
-      !!              Madec, 2008, internal report, IPSL.
-      !!----------------------------------------------------------------------
-      INTEGER ::   istp       ! time step index
-      !!----------------------------------------------------------------------
-
-#if defined key_agrif
-      CALL Agrif_Init_Grids()      ! AGRIF: set the meshes
-#endif
-
-      !                            !-----------------------!
-      CALL opa_init                !==  Initialisations  ==!
-      !                            !-----------------------!
-
-      ! check that all process are still there... If some process have an error,
-      ! they will never enter in step and other processes will wait until the end of the cpu time!
-      IF( lk_mpp )   CALL mpp_max( nstop )
-
-      IF(lwp) WRITE(numout,cform_aaa)   ! Flag AAAAAAA
-
-      !                            !-----------------------!
-      !                            !==   time stepping   ==!
-      !                            !-----------------------!
-      istp = nit000
-      IF( lk_c1d ) THEN                 !==  1D configuration  ==!
-         DO WHILE ( istp <= nitend .AND. nstop == 0 )
-            CALL stp_c1d( istp )
-            istp = istp + 1
-         END DO
-      ELSE                              !==  3D ocean with  ==!
-         DO WHILE ( istp <= nitend .AND. nstop == 0 )
-#if defined key_agrif
-            CALL Agrif_Step( stp )           ! AGRIF: time stepping
-#else
-            CALL stp( istp )                 ! standard time stepping
-#endif
-            istp = istp + 1
-            IF( lk_mpp )   CALL mpp_max( nstop )
-         END DO
-      ENDIF
-       
-      !                            !------------------------!
-      !                            !==  finalize the run  ==!
-      !                            !------------------------!
-      IF(lwp) WRITE(numout,cform_aaa)   ! Flag AAAAAAA
-      !
-      IF( nstop /= 0 .AND. lwp ) THEN   ! error print
-         WRITE(numout,cform_err)
-         WRITE(numout,*) nstop, ' error have been found' 
-      ENDIF
-      !
-      CALL opa_closefile
-#if defined key_oasis3 || defined key_oasis4
-      IF( Agrif_Root() ) THEN
-         CALL cpl_prism_finalize           ! end coupling and mpp communications with OASIS
-     ENDIF 
-#else
-      IF( lk_mpp )   CALL mppstop       ! end mpp communications
-#endif
-      !
-   END SUBROUTINE opa_model
-
-
-   SUBROUTINE opa_init
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE opa_init  ***
-      !!
-      !! ** Purpose :   initialization of the opa model
-      !!
-      !!----------------------------------------------------------------------
-#if defined key_oasis3 || defined key_oasis4 || defined key_iomput
-      INTEGER :: ilocal_comm
-#endif
-      CHARACTER(len=80),dimension(10) ::   cltxt = ''
-      INTEGER                         ::   ji   ! local loop indices
-      !!
-      NAMELIST/namctl/ ln_ctl  , nn_print, nn_ictls, nn_ictle,   &
-         &             nn_isplt, nn_jsplt, nn_jctls, nn_jctle, nn_bench, nn_bit_cmp
-      !!----------------------------------------------------------------------
-      !
-      !                             ! open Namelist file
-      CALL ctl_opn( numnam, 'namelist', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
-      !
-      READ( numnam, namctl )        ! Namelist namctl : Control prints & Benchmark
-      !
-      !                             !--------------------------------------------!
-      !                             !  set communicator & select the local node  !
-      !                             !--------------------------------------------!
-#if defined key_iomput
-      IF( Agrif_Root() ) THEN
-# if defined key_oasis3 || defined key_oasis4
-         CALL cpl_prism_init( ilocal_comm )      ! nemo local communicator given by oasis
-# endif
-         CALL  init_ioclient( ilocal_comm )      ! exchange io_server nemo local communicator with the io_server
-      ENDIF
-      narea = mynode( cltxt, ilocal_comm )    ! Nodes selection
-#else
-# if defined key_oasis3 || defined key_oasis4
-      IF( Agrif_Root() ) THEN
-         CALL cpl_prism_init( ilocal_comm )      ! nemo local communicator given by oasis
-      ENDIF
-      narea = mynode( cltxt, ilocal_comm )    ! Nodes selection (control print return in cltxt)
-# else
-      narea = mynode( cltxt )                 ! Nodes selection (control print return in cltxt)
-# endif
-#endif
-      narea = narea + 1                       ! mynode return the rank of proc (0 --> jpnij -1 )
-
-      lwp = (narea == 1) .OR. ln_ctl          ! control of all listing output print
-
-      IF(lwp) THEN                            ! open listing units
-         !
-         CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
-         !
-         WRITE(numout,*)
-         WRITE(numout,*) '         CNRS - NERC - Met OFFICE - MERCATOR-ocean'
-         WRITE(numout,*) '                       NEMO team'
-         WRITE(numout,*) '            Ocean General Circulation Model'
-         WRITE(numout,*) '                  version 3.2  (2009) '
-         WRITE(numout,*)
-         WRITE(numout,*)
-         DO ji = 1, SIZE(cltxt) 
-            IF( TRIM(cltxt(ji)) /= '' )   WRITE(numout,*) cltxt(ji)      ! control print of mynode
-         END DO
-         WRITE(numout,cform_aaa)                                         ! Flag AAAAAAA
-         !
-      ENDIF
-      !                             !--------------------------------!
-      !                             !  Model general initialization  !
-      !                             !--------------------------------!
-
-      CALL opa_flg                          ! Control prints & Benchmark
-
-                                            ! Domain decomposition
-      IF( jpni*jpnj == jpnij ) THEN   ;   CALL mpp_init      ! standard cutting out
-      ELSE                            ;   CALL mpp_init2     ! eliminate land processors
-      ENDIF
-      
-      CALL phy_cst                          ! Physical constants
-      CALL eos_init                         ! Equation of state
-      CALL dom_cfg                          ! Domain configuration
-      CALL dom_init                         ! Domain
-!!gm c1d case can be moved in dom_init routine
-      IF( lk_c1d ) THEN                          ! 1D configuration 
-         CALL cor_c1d                            ! Coriolis defined at T-point
-         umask(:,:,:) = tmask(:,:,:)             ! U, V and T-points are the same
-         vmask(:,:,:) = tmask(:,:,:)             ! 
-      ENDIF
-!!gm c1d end
-
-      IF( ln_ctl )   CALL prt_ctl_init      ! Print control
-
-      IF( lk_obc )   CALL obc_init          ! Open boundaries 
-      IF( lk_bdy )   CALL bdy_init          ! Unstructured open boundaries
-
-      CALL istate_init                      ! ocean initial state (Dynamics and tracers)
-
-      !                                     ! Ocean physics
-      CALL sbc_init                             ! Read namsbc namelist : surface module (needed for iom_init)
-      CALL ldf_tra_init                         ! Lateral ocean tracer physics
-      CALL ldf_dyn_init                         ! Lateral ocean momentum physics
-      CALL zdf_init                             ! Vertical ocean physics
-
-#if defined key_top
-      CALL trc_ini                          ! Passive tracers
-#endif
-
-      !                                     ! diagnostics
-      CALL iom_init                             ! iom_put initialization
-      CALL dia_ptr_init                         ! Poleward TRansports initialization
-      CALL trd_mod_init                         ! Mixed-layer/Vorticity/Integral constraints trends
-      !
-   END SUBROUTINE opa_init
-
-
-   SUBROUTINE opa_flg
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE opa  ***
-      !!
-      !! ** Purpose :   Initialise logical flags that control the choice of
-      !!              some algorithm or control print
-      !!
-      !! ** Method  : - print namctl information
-      !!              - Read in namilist namflg logical flags
-      !!----------------------------------------------------------------------
-      NAMELIST/namdyn_hpg/ ln_hpg_zco   , ln_hpg_zps   , ln_hpg_sco, ln_hpg_hel,   &
-         &                 ln_hpg_wdj   , ln_hpg_djc   , ln_hpg_rot, rn_gamma  ,   &
-         &                 ln_dynhpg_imp
-      !!----------------------------------------------------------------------
-
-      IF(lwp) THEN                 ! Parameter print
-         WRITE(numout,*)
-         WRITE(numout,*) 'opa_flg: Control prints & Benchmark'
-         WRITE(numout,*) '~~~~~~~ '
-         WRITE(numout,*) '   Namelist namctl'
-         WRITE(numout,*) '      run control (for debugging)     ln_ctl     = ', ln_ctl
-         WRITE(numout,*) '      level of print                  nn_print   = ', nn_print
-         WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls
-         WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle
-         WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls
-         WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle
-         WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt
-         WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt
-         WRITE(numout,*) '      benchmark parameter (0/1)       nn_bench   = ', nn_bench
-         WRITE(numout,*) '      bit comparison mode (0/1)       nn_bit_cmp = ', nn_bit_cmp
-      ENDIF
-
-      nprint    = nn_print          ! convert DOCTOR namelist names into OLD names
-      nictls    = nn_ictls
-      nictle    = nn_ictle
-      njctls    = nn_jctls
-      njctle    = nn_jctle
-      isplt     = nn_isplt
-      jsplt     = nn_jsplt
-      nbench    = nn_bench
-      nbit_cmp  = nn_bit_cmp
-
-      !                           ! Parameter control
-      !
-      IF( ln_ctl ) THEN                 ! sub-domain area indices for the control prints
-         IF( lk_mpp ) THEN
-            isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real splitted domain
-         ELSE
-            IF( isplt == 1 .AND. jsplt == 1  ) THEN
-               CALL ctl_warn( ' - isplt & jsplt are equal to 1',   &
-                  &           ' - the print control will be done over the whole domain' )
-            ENDIF
-            ijsplt = isplt * jsplt            ! total number of processors ijsplt
-         ENDIF
-         IF(lwp) WRITE(numout,*)'          - The total number of processors over which the'
-         IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt
-         !
-         !                              ! indices used for the SUM control
-         IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area
-            lsp_area = .FALSE.                        
-         ELSE                                             ! print control done over a specific  area
-            lsp_area = .TRUE.
-            IF( nictls < 1 .OR. nictls > jpiglo )   THEN
-               CALL ctl_warn( '          - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )
-               nictls = 1
-            ENDIF
-            IF( nictle < 1 .OR. nictle > jpiglo )   THEN
-               CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )
-               nictle = jpiglo
-            ENDIF
-            IF( njctls < 1 .OR. njctls > jpjglo )   THEN
-               CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )
-               njctls = 1
-            ENDIF
-            IF( njctle < 1 .OR. njctle > jpjglo )   THEN
-               CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )
-               njctle = jpjglo
-            ENDIF
-         ENDIF
-      ENDIF
-
-      IF( nbench == 1 )   THEN            ! Benchmark 
-         SELECT CASE ( cp_cfg )
-         CASE ( 'gyre' )   ;   CALL ctl_warn( ' The Benchmark is activated ' )
-         CASE DEFAULT      ;   CALL ctl_stop( ' The Benchmark is based on the GYRE configuration:',   &
-            &                                 ' key_gyre must be used or set nbench = 0' )
-         END SELECT
-      ENDIF
-
-      IF( nbit_cmp == 1 )   THEN          ! Bit compare
-         CALL ctl_warn( ' Bit comparison enabled. Single and multiple processor results must bit compare', &
-              &         ' WARNING: RESULTS ARE NOT PHYSICAL.' )
-      ENDIF
-
-      REWIND( numnam )              ! Read Namelist namdyn_hpg : ln_dynhpg_imp must be read at the initialisation phase
-      READ  ( numnam, namdyn_hpg )
-      !
-   END SUBROUTINE opa_flg
-
-
-   SUBROUTINE opa_closefile
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE opa_closefile  ***
-      !!
-      !! ** Purpose :   Close the files
-      !!----------------------------------------------------------------------
-      USE dtatem        ! temperature data
-      USE dtasal        ! salinity data
-      !!----------------------------------------------------------------------
-      !
-      IF( lk_mpp )   CALL mppsync
-      !
-      CALL iom_close                                 ! close all input/output files managed by iom_*
-      !
-      IF( numstp     /= -1 )   CLOSE( numstp     )   ! time-step file
-      IF( numsol     /= -1 )   CLOSE( numsol     )   ! solver file
-      IF( numnam     /= -1 )   CLOSE( numnam     )   ! oce namelist
-      IF( numnam_ice /= -1 )   CLOSE( numnam_ice )   ! ice namelist
-      IF( numevo_ice /= -1 )   CLOSE( numevo_ice )   ! ice variables (temp. evolution)
-      IF( numout     /=  6 )   CLOSE( numout     )   ! standard model output file
-      numout = 6   ! redefine numout in case it is used after this point...
-      !
-   END SUBROUTINE opa_closefile
-
-   !!======================================================================
-END MODULE opa
Index: trunk/NEMOGCM/NEMO/OPA_SRC/par_EEL_R2.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/par_EEL_R2.h90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/par_EEL_R2.h90	(revision 2528)
@@ -4,7 +4,7 @@
    !!---------------------------------------------------------------------
    !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
    CHARACTER (len=16)      &
@@ -94,3 +94,9 @@
       &     ppdzmin = pp_not_used           ,  &  !: (meters) vertical thickness of the top layer
       &     pphmax  = pp_not_used                 !: (meters) Maximum depth of the ocean gdepw(jpk)
+   LOGICAL,  PARAMETER ::        &
+      &     ldbletanh = .FALSE.                   !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp), PARAMETER ::        &
+      &     ppa2    = pp_not_used           ,  &  !: Double tanh function parameters
+      &     ppkth2  = pp_not_used           ,  &  !:
+      &     ppacr2  = pp_not_used                 !:
    !!---------------------------------------------------------------------
Index: trunk/NEMOGCM/NEMO/OPA_SRC/par_EEL_R5.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/par_EEL_R5.h90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/par_EEL_R5.h90	(revision 2528)
@@ -4,7 +4,7 @@
    !!---------------------------------------------------------------------
    !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
    CHARACTER (len=16)      &
@@ -94,3 +94,9 @@
       &     ppdzmin = pp_not_used           ,  &  !: (meters) vertical thickness of the top layer
       &     pphmax  = pp_not_used                 !: (meters) Maximum depth of the ocean gdepw(jpk)
+   LOGICAL,  PARAMETER ::        &
+      &     ldbletanh = .FALSE.                   !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp), PARAMETER ::        &
+      &     ppa2    = pp_not_used           ,  &  !: Double tanh function parameters
+      &     ppkth2  = pp_not_used           ,  &  !:
+      &     ppacr2  = pp_not_used                 !:
    !!---------------------------------------------------------------------
Index: trunk/NEMOGCM/NEMO/OPA_SRC/par_EEL_R6.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/par_EEL_R6.h90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/par_EEL_R6.h90	(revision 2528)
@@ -4,7 +4,7 @@
    !!---------------------------------------------------------------------
    !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
    CHARACTER (len=16)      &
@@ -94,3 +94,9 @@
       &     ppdzmin = pp_not_used           ,  &  !: (meters) vertical thickness of the top layer
       &     pphmax  = pp_not_used                 !: (meters) Maximum depth of the ocean gdepw(jpk)
+   LOGICAL,  PARAMETER ::        &
+      &     ldbletanh = .FALSE.                   !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp), PARAMETER ::        &
+      &     ppa2    = pp_not_used           ,  &  !: Double tanh function parameters
+      &     ppkth2  = pp_not_used           ,  &  !:
+      &     ppacr2  = pp_not_used                 !:
    !!---------------------------------------------------------------------
Index: trunk/NEMOGCM/NEMO/OPA_SRC/par_GYRE.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/par_GYRE.h90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/par_GYRE.h90	(revision 2528)
@@ -4,7 +4,7 @@
    !!---------------------------------------------------------------------
    !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
    CHARACTER (len=16)      &
@@ -98,4 +98,10 @@
       &     pphmax  = pp_not_used         !: (meters): maximum depth of the ocean
       !                             !            depth of the last "w" level
+   LOGICAL,  PARAMETER ::        &
+      &     ldbletanh = .FALSE.                   !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp), PARAMETER ::        &
+      &     ppa2    = pp_not_used           ,  &  !: Double tanh function parameters
+      &     ppkth2  = pp_not_used           ,  &  !:
+      &     ppacr2  = pp_not_used                 !:
 
    !!---------------------------------------------------------------------
Index: trunk/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R025.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R025.h90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R025.h90	(revision 2528)
@@ -5,7 +5,7 @@
    !!---------------------------------------------------------------------
    !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
    CHARACTER (len=16)      &
@@ -24,5 +24,9 @@
       jpidta  = 1442,        &  !: first horizontal dimension > or = to jpi
       jpjdta  = 1021,        &  !: second                     > or = to jpj
+#if key_orca_r025==75
+      jpkdta  = 75 ,         &  !: number of levels           > or = to jpk
+#else
       jpkdta  = 46 ,         &  !: number of levels           > or = to jpk
+#endif
       ! total domain matrix size
       jpiglo  = jpidta,      &  !: first  dimension of global domain --> i
@@ -68,22 +72,56 @@
    !!  Coefficients associated with the vertical coordinate system
 
+#if key_orca_r025==75
    REAL(wp), PARAMETER  ::       &
-      &     ppsur = pp_to_be_computed ,  &  !: Computed in domzgr, set ppdzmin and pphmax below
-      &     ppa0  = pp_to_be_computed ,  &  !:    "           "
-      &     ppa1  = pp_to_be_computed ,  &  !:    "           "
-      !
-      &     ppkth =  23.563_wp        ,  &  !: (non dimensional): gives the approximate
-      !                                     !: layer number above which  stretching will
-      !                                     !: be maximum. Usually of order jpk/2.
-      &     ppacr =    9.00000000000_wp     !: (non dimensional): stretching factor
-      !                                     !: for the grid. The highest zacr, the smallest
-      !                                     !: the stretching.
-
+      &     ppsur =  -3958.951371276829_wp  ,  &  !: ORCA r025 coefficients
+      &     ppa0  =   103.9530096000000_wp  ,  &  !: (75 levels case)
+      &     ppa1  =   2.415951269000000_wp  ,  &  !:
+      &     ppkth =   15.35101370000000_wp  ,  &  !: (non dimensional): gives the approximate
+      !                                           !: layer number above which  stretching will
+      !                                           !: be maximum. Usually of order jpk/2.
+      &     ppacr =       7.00000000000_wp        !: (non dimensional): stretching factor
+      !                                           !: for the grid. The higher zacr, the smaller
+      !                                           !: the stretching.
    !!
-   !!  If both ppa0 ppa1 and ppsur are specified to 0, then
+   !!  If both ppa0 ppa1 and ppsur are specified to pp_to_be_computed, then
    !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
    !!
-   REAL(wp), PARAMETER ::        &
-      &     ppdzmin = 6._wp           ,  &  !: (meters) vertical thickness of the top layer
-      &     pphmax  = 5750._wp              !: (meters) Maximum depth of the ocean gdepw(jpk)
+   REAL(wp), PARAMETER ::                      &
+      &     ppdzmin = pp_not_used           ,  &  !: (meters) vertical thickness of the top layer
+      &     pphmax  = pp_not_used                 !: (meters) Maximum depth of the ocean gdepw(jpk)
+   !!
+   LOGICAL,  PARAMETER ::                      &
+      &     ldbletanh = .TRUE.                    !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp), PARAMETER ::                      &
+      &     ppa2  =   100.7609285000000_wp  ,  &  !: Double tanh function parameters
+      &     ppkth2=   48.02989372000000_wp  ,  &  !:
+      &     ppacr2=    13.00000000000_wp          !:
+      !
+#else
+   REAL(wp), PARAMETER  ::       &
+      &     ppsur = pp_to_be_computed ,        &  !: Computed in domzgr, set ppdzmin and pphmax below
+      &     ppa0  = pp_to_be_computed ,        &  !:    "           "
+      &     ppa1  = pp_to_be_computed ,        &  !:    "           "
+      !
+      &     ppkth =  23.563_wp        ,        &  !: (non dimensional): gives the approximate
+      !                                           !: layer number above which  stretching will
+      !                                           !: be maximum. Usually of order jpk/2.
+      &     ppacr =   9.00000000000_wp            !: (non dimensional): stretching factor
+      !                                           !: for the grid. The highest zacr, the smallest
+      !                                           !: the stretching.
+   !!
+   !!  If both ppa0 ppa1 and ppsur are specified to pp_to_be_computed, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   !!
+   REAL(wp), PARAMETER ::                      &
+      &     ppdzmin = 6._wp           ,        &  !: (meters) vertical thickness of the top layer
+      &     pphmax  = 5750._wp                    !: (meters) Maximum depth of the ocean gdepw(jpk)
+   !!
+   LOGICAL,  PARAMETER ::                      &
+      &     ldbletanh = .FALSE.                   !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp), PARAMETER ::                      &
+      &     ppa2    = pp_not_used           ,  &  !: Double tanh function parameters
+      &     ppkth2  = pp_not_used           ,  &  !:
+      &     ppacr2  = pp_not_used                 !:
+#endif
    !!---------------------------------------------------------------------
Index: trunk/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R05.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R05.h90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R05.h90	(revision 2528)
@@ -5,7 +5,7 @@
    !!---------------------------------------------------------------------
    !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
    CHARACTER (len=16)      &
@@ -131,3 +131,9 @@
       &     ppdzmin = pp_not_used           ,  &  !: (meters) vertical thickness of the top layer
       &     pphmax  = pp_not_used                 !: (meters) Maximum depth of the ocean gdepw(jpk)
+   LOGICAL,  PARAMETER ::        &
+      &     ldbletanh = .FALSE.                   !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp), PARAMETER ::        &
+      &     ppa2    = pp_not_used           ,  &  !: Double tanh function parameters
+      &     ppkth2  = pp_not_used           ,  &  !:
+      &     ppacr2  = pp_not_used                 !:
    !!---------------------------------------------------------------------
Index: trunk/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R1.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R1.h90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R1.h90	(revision 2528)
@@ -0,0 +1,130 @@
+   !!---------------------------------------------------------------------
+   !!                     ***  par_ORCA_R1.h90  ***  
+   !!   Ocean Domain : 1 degrees resolution global ocean
+   !!                  (0RCA_R1 configuration)
+   !!---------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: par_ORCA_R1.h90 2379 2010-11-12 14:51:18Z acc $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !! Andrew Coward, 12/11/2010.
+   !! Parameters appropriate to ORCA1
+   !! Use: key_orca_r1=75 to set 75 levels
+   !!----------------------------------------------------------------------
+   CHARACTER (len=16)      &
+#if !defined key_agrif
+      , PARAMETER  &
+#endif
+      ::    &  
+      cp_cfg = "orca"           !: name of the configuration
+   INTEGER     &
+#if !defined key_agrif
+      , PARAMETER  &
+#endif
+      :: &
+      jp_cfg = 1    ,        &  !: resolution of the configuration (degrees)
+      ! Original data size
+      jpidta  =  362,        &  !: first horizontal dimension > or = to jpi
+      jpjdta  =  292,        &  !: second                     > or = to jpj
+#if key_orca_r1==75
+      jpkdta  = 75 ,         &  !: number of levels           > or = to jpk
+#else
+      jpkdta  = 46 ,         &  !: number of levels           > or = to jpk
+#endif
+      ! total domain matrix size
+      jpiglo  = jpidta,      &  !: first  dimension of global domain --> i
+      jpjglo  = jpjdta,      &  !: second dimension of global domain --> j
+      jpk     = jpkdta,      &  !: number of vertical levels
+      ! starting position of the zoom
+      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  !: in data indices
+      ! Domain characteristics
+      jperio  =   6             !: lateral cond. type (between 0 and 6)
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL,PARAMETER      ::  pp_not_used = 999999_wp , &
+      &                    pp_to_be_computed = 0._wp
+   !!
+   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
+   !!
+   INTEGER, PARAMETER ::     & !
+      jphgr_msh = 0            !: type of horizontal mesh
+      !                        !  = 0 curvilinear coordinate on the sphere
+      !                        !      read in coordinate.nc file
+      !                        !  = 1 geographical mesh on the sphere
+      !                        !      with regular grid-spacing
+      !                        !  = 2 f-plane with regular grid-spacing
+      !                        !  = 3 beta-plane with regular grid-spacing
+      !                        !  = 4 Mercator grid with T/U point at the equator  with
+      !                        !      isotropic resolution (e1_deg)
+
+      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
+      !   The mercator grid starts only approximately at gphi0 because
+      !   of the constraint that the equator be a T point.
+   REAL(wp), PARAMETER ::       &  !
+      ppglam0  = pp_not_used,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
+      ppgphi0  = pp_not_used,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
+      !                            !  latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
+      ppe1_deg = pp_not_used,   &  !: zonal      grid-spacing (degrees)
+      ppe2_deg = pp_not_used,   &  !: meridional grid-spacing (degrees)
+      !
+      ppe1_m   = pp_not_used,   &  !: zonal      grid-spacing (meters )
+      ppe2_m   = pp_not_used       !: meridional grid-spacing (meters )
+
+   !!  Coefficients associated with the vertical coordinate system
+
+#if key_orca_r1==75
+   REAL(wp), PARAMETER  ::       &
+      &     ppsur =  -3958.951371276829_wp  ,  &  !: ORCA r1 coefficients
+      &     ppa0  =   103.9530096000000_wp  ,  &  !: (75 levels case)
+      &     ppa1  =   2.415951269000000_wp  ,  &  !:
+      &     ppkth =   15.35101370000000_wp  ,  &  !: (non dimensional): gives the approximate
+      !                                           !: layer number above which  stretching will
+      !                                           !: be maximum. Usually of order jpk/2.
+      &     ppacr =       7.00000000000_wp        !: (non dimensional): stretching factor
+      !                                           !: for the grid. The higher zacr, the smaller
+      !                                           !: the stretching.
+   !!
+   !!  If both ppa0 ppa1 and ppsur are specified to pp_to_be_computed, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   !!
+   REAL(wp), PARAMETER ::                      &
+      &     ppdzmin = pp_not_used           ,  &  !: (meters) vertical thickness of the top layer
+      &     pphmax  = pp_not_used                 !: (meters) Maximum depth of the ocean gdepw(jpk)
+   !!
+   LOGICAL,  PARAMETER ::                      &
+      &     ldbletanh = .TRUE.                    !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp), PARAMETER ::                      &
+      &     ppa2  =   100.7609285000000_wp  ,  &  !: Double tanh function parameters
+      &     ppkth2=   48.02989372000000_wp  ,  &  !:
+      &     ppacr2=    13.00000000000_wp          !:
+      !
+#else
+   REAL(wp), PARAMETER  ::       &
+      &     ppsur = pp_to_be_computed ,        &  !: Computed in domzgr, set ppdzmin and pphmax below
+      &     ppa0  = pp_to_be_computed ,        &  !:    "           "
+      &     ppa1  = pp_to_be_computed ,        &  !:    "           "
+      !
+      &     ppkth =  23.563_wp        ,        &  !: (non dimensional): gives the approximate
+      !                                           !: layer number above which  stretching will
+      !                                           !: be maximum. Usually of order jpk/2.
+      &     ppacr =   9.00000000000_wp            !: (non dimensional): stretching factor
+      !                                           !: for the grid. The highest zacr, the smallest
+      !                                           !: the stretching.
+   !!
+   !!  If both ppa0 ppa1 and ppsur are specified to pp_to_be_computed, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   !!
+   REAL(wp), PARAMETER ::                      &
+      &     ppdzmin = 6._wp           ,        &  !: (meters) vertical thickness of the top layer
+      &     pphmax  = 5750._wp                    !: (meters) Maximum depth of the ocean gdepw(jpk)
+   !!
+   LOGICAL,  PARAMETER ::                      &
+      &     ldbletanh = .FALSE.                   !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp), PARAMETER ::                      &
+      &     ppa2    = pp_not_used           ,  &  !: Double tanh function parameters
+      &     ppkth2  = pp_not_used           ,  &  !:
+      &     ppacr2  = pp_not_used                 !:
+#endif
+   !!---------------------------------------------------------------------
Index: trunk/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R2.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R2.h90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R2.h90	(revision 2528)
@@ -5,7 +5,7 @@
    !!---------------------------------------------------------------------
    !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
    CHARACTER (len=16)      &
@@ -82,6 +82,8 @@
       ! jpizoom =   61   ,    &  !: left bottom (i,j) indices of the zoom
       ! jpjzoom =   27   ,    &  !: in data domain indices (160W,60S)
-      jpizoom =   61   ,    &  !: left bottom (i,j) indices of the zoom
-      jpjzoom =    7   ,    &  !: in data domain indices (160W,75S)
+      ! jpizoom =   61   ,    &  !: left bottom (i,j) indices of the zoom
+      ! jpjzoom =    7   ,    &  !: in data domain indices (160W,75S)
+      jpizoom =   110   ,    &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   97   ,    &  !: in data domain indices (64W,31.5N) BATS site
       ! Domain characteristics
       jperio  =   0            !: lateral cond. type (between 0 and 6)
@@ -158,3 +160,9 @@
       &     ppdzmin = pp_not_used           ,  &  !: (meters) vertical thickness of the top layer
       &     pphmax  = pp_not_used                 !: (meters) Maximum depth of the ocean gdepw(jpk)
+   LOGICAL,  PARAMETER ::        &
+      &     ldbletanh = .FALSE.                   !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp), PARAMETER ::        &
+      &     ppa2    = pp_not_used           ,  &  !: Double tanh function parameters
+      &     ppkth2  = pp_not_used           ,  &  !:
+      &     ppacr2  = pp_not_used                 !:
    !!---------------------------------------------------------------------
Index: trunk/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R4.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R4.h90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R4.h90	(revision 2528)
@@ -5,7 +5,7 @@
    !!---------------------------------------------------------------------
    !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
    CHARACTER (len=16)      &
@@ -87,3 +87,9 @@
       &     ppdzmin = pp_not_used           ,  &  !: (meters) vertical thickness of the top layer
       &     pphmax  = pp_not_used                 !: (meters) Maximum depth of the ocean gdepw(jpk)
+   LOGICAL,  PARAMETER ::        &
+      &     ldbletanh = .FALSE.                   !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp), PARAMETER ::        &
+      &     ppa2    = pp_not_used           ,  &  !: Double tanh function parameters
+      &     ppkth2  = pp_not_used           ,  &  !:
+      &     ppacr2  = pp_not_used                 !:
    !!---------------------------------------------------------------------
Index: trunk/NEMOGCM/NEMO/OPA_SRC/par_POMME_R025.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/par_POMME_R025.h90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/par_POMME_R025.h90	(revision 2528)
@@ -5,7 +5,7 @@
    !!---------------------------------------------------------------------
    !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/par_ORCA_R025.h90,v 1.6 2006/03/10 10:55:34 opalod Exp $ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
    CHARACTER (len=16)      &
@@ -97,3 +97,9 @@
       &     ppdzmin = 6._wp           ,  &  !: (meters) vertical thickness of the top layer
       &     pphmax  = 5750._wp              !: (meters) Maximum depth of the ocean gdepw(jpk)
+   LOGICAL,  PARAMETER ::        &
+      &     ldbletanh = .FALSE.             !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp), PARAMETER ::        &
+      &     ppa2    = pp_not_used     ,  &  !: Double tanh function parameters
+      &     ppkth2  = pp_not_used     ,  &  !:
+      &     ppacr2  = pp_not_used           !:
    !!---------------------------------------------------------------------
Index: trunk/NEMOGCM/NEMO/OPA_SRC/par_kind.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/par_kind.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/par_kind.F90	(revision 2528)
@@ -4,10 +4,6 @@
    !! Ocean :  define the kind of real for the whole model
    !!======================================================================
-   !! History :
-   !!   8.5   02/06  (G. Madec)  Original code
-   !!----------------------------------------------------------------------
-   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! History :  1.0  ! 2002-06  (G. Madec)  Original code
+   !!            3.3  ! 2010-12  (G. Madec)  add a standard length of character strings
    !!----------------------------------------------------------------------
 
@@ -15,8 +11,6 @@
    PRIVATE
 
-   INTEGER, PUBLIC, PARAMETER ::    &  !:
-      jpbyt   = 8       ,           &  !: real size for mpp communications
-      jpbytda = 4       ,           &  !: real size in input data files 4 or 8
-      jpbi3e  = 4                      !: real size for T3E
+   INTEGER, PUBLIC, PARAMETER ::   jpbyt   = 8    !: real size for mpp communications
+   INTEGER, PUBLIC, PARAMETER ::   jpbytda = 4    !: real size in input data files 4 or 8
 
    ! Number model from which the SELECTED_*_KIND are requested:
@@ -27,13 +21,20 @@
    !            exponent = 37     exponent = 307
 
-   INTEGER, PUBLIC, PARAMETER ::        &  !: Floating point section
-      sp = SELECTED_REAL_KIND( 6, 37),  &  !: single precision (real 4)
-      dp = SELECTED_REAL_KIND(12,307),  &  !: double precision (real 8)
-      wp = dp                              !: working precision
+   !                                                                !!** Floating point **
+   INTEGER, PUBLIC, PARAMETER ::   sp = SELECTED_REAL_KIND( 6, 37)   !: single precision (real 4)
+   INTEGER, PUBLIC, PARAMETER ::   dp = SELECTED_REAL_KIND(12,307)   !: double precision (real 8)
+   INTEGER, PUBLIC, PARAMETER ::   wp = dp                              !: working precision
 
-   INTEGER, PUBLIC, PARAMETER ::        &  !: Integer section
-      i4 = SELECTED_INT_KIND(9) ,       &  !: single precision (integer 4)
-      i8 = SELECTED_INT_KIND(14)           !: double precision (integer 8)
+   !                                                                !!** Integer **
+   INTEGER, PUBLIC, PARAMETER ::   i4 = SELECTED_INT_KIND( 9)        !: single precision (integer 4)
+   INTEGER, PUBLIC, PARAMETER ::   i8 = SELECTED_INT_KIND(14)        !: double precision (integer 8)
+   
+   !                                                                !!** Integer **
+   INTEGER, PUBLIC, PARAMETER ::   lc = 256                          !: Lenght of Character strings
 
-!!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 END MODULE par_kind
Index: trunk/NEMOGCM/NEMO/OPA_SRC/par_oce.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/par_oce.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/par_oce.F90	(revision 2528)
@@ -4,14 +4,8 @@
    !! Ocean :   set the ocean parameters
    !!======================================================================
-   !! History :
-   !!   4.0  !  91     (Imbard, Levy, Madec)  Original code
-   !!   9.0  !  04-01  (G. Madec, J.-M. Molines)  Free form and module
-   !!    "   !  05-11  (V. Garnier) Surface pressure gradient organization
-   !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
-   !!----------------------------------------------------------------------
-   !! * Modules used
+   !! History :  OPA  !  1991     (Imbard, Levy, Madec)  Original code
+   !!   NEMO     1.0  !  2004-01  (G. Madec, J.-M. Molines)  Free form and module
+   !!            3.3  !  2010-09  (C. Ethe) TRA-TRC merge: add jpts, jp_tem & jp_sal
+   !!----------------------------------------------------------------------
    USE par_kind          ! kind parameters
 
@@ -22,26 +16,32 @@
    !!   Domain decomposition
    !!----------------------------------------------------------------------
-   !! * if we dont use massively parallel computer (parameters jpni=jpnj=1)
-   !!      so jpiglo=jpi and jpjglo=jpj
-
+   !! if we dont use massively parallel computer (parameters jpni=jpnj=1) so jpiglo=jpi and jpjglo=jpj
 #if ! defined key_mpp_dyndist 
-   INTEGER, PUBLIC, PARAMETER ::    &  !: 
-      jpni   = 1,                   &  !: number of processors following i 
+   INTEGER, PUBLIC, PARAMETER ::    &  !:
+# if ! defined key_nproci
+      jpni   = 1,                   &  !: number of processors following i
       jpnj   = 1,                   &  !: number of processors following j
       jpnij  = 1                       !: nb of local domain = nb of processors 
       !                                !  ( <= jpni x jpnj )
-#else
-   INTEGER, PUBLIC ::               &  !
-      jpni      ,                   &  !: number of processors following i 
-      jpnj      ,                   &  !: number of processors following j
-      jpnij                            !: nb of local domain = nb of processors 
+# else
+      jpni   = key_nproci,          &  !: number of processors following i
+      jpnj   = key_nprocj,          &  !: number of processors following j
+#  if ! defined key_nprocij
+      jpnij  = key_nproci * key_nprocj !: nb of local domain = nb of processors 
       !                                !  ( <= jpni x jpnj )
-#endif
-
-   INTEGER, PUBLIC, PARAMETER ::    &  !:
-      jpr2di = 0,                   &  !: number of columns for extra outer halo 
-      jpr2dj = 0,                   &  !: number of rows    for extra outer halo 
-      jpreci = 1,                   &  !: number of columns for overlap 
-      jprecj = 1                       !: number of rows    for overlap 
+#  else
+      jpnij  = key_nprocij             !: nb of local domain = nb of processors 
+      !                                !  ( <= jpni x jpnj )
+#  endif
+# endif
+#else
+   INTEGER, PUBLIC            ::   jpni         !: number of processors following i 
+   INTEGER, PUBLIC            ::   jpnj         !: number of processors following j
+   INTEGER, PUBLIC            ::   jpnij        !: nb of local domain = nb of processors ( <= jpni x jpnj )
+#endif
+   INTEGER, PUBLIC, PARAMETER ::   jpr2di = 0   !: number of columns for extra outer halo 
+   INTEGER, PUBLIC, PARAMETER ::   jpr2dj = 0   !: number of rows    for extra outer halo 
+   INTEGER, PUBLIC, PARAMETER ::   jpreci = 1   !: number of columns for overlap 
+   INTEGER, PUBLIC, PARAMETER ::   jprecj = 1   !: number of rows    for overlap 
 
    !! Ocean Domain sizes
@@ -61,4 +61,9 @@
    !!---------------------------------------------------------------------
 #             include "par_ORCA_R2.h90"
+#elif defined key_orca_r1
+   !!---------------------------------------------------------------------
+   !!   'key_orca_r1'   :                           global ocean : ORCA R1
+   !!---------------------------------------------------------------------
+#             include "par_ORCA_R1.h90"
 #elif defined key_orca_r05
    !!---------------------------------------------------------------------
@@ -100,105 +105,102 @@
    !!   default option  :                               small closed basin
    !!---------------------------------------------------------------------
-   CHARACTER(len=16), PUBLIC, PARAMETER ::   &  !:
-      cp_cfg = "default"               !: name of the configuration
-   INTEGER, PARAMETER ::            &  !:
-      jp_cfg = 0  ,                 &  !: resolution of the configuration
-
-      ! data size                     !!! * size of all input files *
-      jpidta  = 10,                 &  !: 1st lateral dimension ( >= jpi )
-      jpjdta  = 12,                 &  !: 2nd    "         "    ( >= jpj )
-      jpkdta  = 31,                 &  !: number of levels      ( >= jpk )
-
-      ! global or zoom domain size    !!! * computational domain *
-      jpiglo  = jpidta,             &  !: 1st dimension of global domain --> i
-      jpjglo  = jpjdta,             &  !: 2nd    "                  "    --> j
-      jpk     = jpkdta,             &  !: number of vertical levels
-      ! zoom starting position 
-      jpizoom =   1   ,             &  !: left bottom (i,j) indices of the zoom
-      jpjzoom =   1   ,             &  !: in data domain indices
-
-      ! Domain characteristics
-      jperio  =  0                     !: lateral cond. type (between 0 and 6)
-         !                             !  = 0 closed
-         !                             !  = 1 cyclic East-West
-         !                             !  = 2 equatorial symmetric
-         !                             !  = 3 North fold T-point pivot
-         !                             !  = 4 cyclic East-West AND North fold T-point pivot
-         !                             !  = 5 North fold F-point pivot
-         !                             !  = 6 cyclic East-West AND North fold F-point pivot
-
-      !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
-      !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
-      REAL(wp), PARAMETER ::   &  !:
-         pp_not_used       = 999999._wp , &  !:
-         pp_to_be_computed = 999999._wp      !:
+   CHARACTER(len=16), PUBLIC, PARAMETER ::   cp_cfg = "default"   !: name of the configuration
+   INTEGER          , PUBLIC, PARAMETER ::   jp_cfg = 0           !: resolution of the configuration
+
+   ! data size                                       !!! * size of all input files *
+   INTEGER, PUBLIC, PARAMETER ::   jpidta  = 10       !: 1st lateral dimension ( >= jpi )
+   INTEGER, PUBLIC, PARAMETER ::   jpjdta  = 12       !: 2nd    "         "    ( >= jpj )
+   INTEGER, PUBLIC, PARAMETER ::   jpkdta  = 31       !: number of levels      ( >= jpk )
+
+   ! global or zoom domain size                      !!! * computational domain *
+   INTEGER, PUBLIC, PARAMETER ::   jpiglo  = jpidta   !: 1st dimension of global domain --> i
+   INTEGER, PUBLIC, PARAMETER ::   jpjglo  = jpjdta   !: 2nd    -                  -    --> j
+   INTEGER, PUBLIC, PARAMETER ::   jpk     = jpkdta   !: number of vertical levels
+   ! zoom starting position 
+   INTEGER, PUBLIC, PARAMETER ::   jpizoom =   1      !: left bottom (i,j) indices of the zoom
+   INTEGER, PUBLIC, PARAMETER ::   jpjzoom =   1      !: in data domain indices
+
+   ! Domain characteristics
+   INTEGER, PUBLIC, PARAMETER ::   jperio  =  0       !: lateral cond. type (between 0 and 6)
+   !                                                  !  = 0 closed                 ;   = 1 cyclic East-West
+   !                                                  !  = 2 equatorial symmetric   ;   = 3 North fold T-point pivot
+   !                                                  !  = 4 cyclic East-West AND North fold T-point pivot
+   !                                                  !  = 5 North fold F-point pivot
+   !                                                  !  = 6 cyclic East-West AND North fold F-point pivot
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL(wp), PUBLIC, PARAMETER ::   pp_not_used       = 999999._wp   !: vertical grid parameter
+   REAL(wp), PUBLIC, PARAMETER ::   pp_to_be_computed = 999999._wp   !:    -      -       -
 
 
    !! Horizontal grid parameters for domhgr
    !! =====================================
-
-   INTEGER, PUBLIC, PARAMETER   ::   &  !:
-      jphgr_msh = 0            !: type of horizontal mesh
-      !                        !  = 0 curvilinear coordinate on the sphere
-      !                        !      read in coordinate.nc file
-      !                        !  = 1 geographical mesh on the sphere
-      !                        !      with regular grid-spacing
-      !                        !  = 2 f-plane with regular grid-spacing
-      !                        !  = 3 beta-plane with regular grid-spacing
-      !                        !  = 4 Mercator grid with T/U point at the equator  with
-      !                        !      isotropic resolution (e1_deg)
-
-   REAL(wp) , PUBLIC, PARAMETER ::   &   !:
-      ppglam0  =    0.0_wp,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
-      ppgphi0  =  -35.0_wp,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
-      !                          !  latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
-      ppe1_deg =    1.0_wp,   &  !: zonal      grid-spacing (degrees)
-      ppe2_deg =    0.5_wp,   &  !: meridional grid-spacing (degrees)
-      ppe1_m   = 5000.0_wp,   &  !: zonal      grid-spacing (degrees)
-      ppe2_m   = 5000.0_wp       !: meridional grid-spacing (degrees)
+   INTEGER, PUBLIC, PARAMETER  ::   jphgr_msh = 0   !: type of horizontal mesh
+   !                                                !  = 0 curvilinear coordinate on the sphere read in coordinate.nc
+   !                                                !  = 1 geographical mesh on the sphere with regular grid-spacing
+   !                                                !  = 2 f-plane with regular grid-spacing
+   !                                                !  = 3 beta-plane with regular grid-spacing
+   !                                                !  = 4 Mercator grid with T/U point at the equator
+
+   REAL(wp) , PUBLIC, PARAMETER ::   ppglam0  =    0.0_wp   !: longitude of first raw and column T-point (jphgr_msh = 1)
+   REAL(wp) , PUBLIC, PARAMETER ::   ppgphi0  =  -35.0_wp   !: latitude  of first raw and column T-point (jphgr_msh = 1)
+   !                                                        !  used for Coriolis & Beta parameters (jphgr_msh = 2 or 3)
+   REAL(wp) , PUBLIC, PARAMETER ::   ppe1_deg =    1.0_wp   !: zonal      grid-spacing (degrees)
+   REAL(wp) , PUBLIC, PARAMETER ::   ppe2_deg =    0.5_wp   !: meridional grid-spacing (degrees)
+   REAL(wp) , PUBLIC, PARAMETER ::   ppe1_m   = 5000.0_wp   !: zonal      grid-spacing (degrees)
+   REAL(wp) , PUBLIC, PARAMETER ::   ppe2_m   = 5000.0_wp   !: meridional grid-spacing (degrees)
 
    !! Vertical grid parameter for domzgr
    !! ==================================
-
-   REAL(wp), PUBLIC, PARAMETER  ::   &  !:
-      &     ppsur = -4762.96143546300_wp ,  &  !: ORCA r4, r2 and r05 coefficients
-      &     ppa0  =   255.58049070440_wp ,  &  !: (default coefficients)
-      &     ppa1  =   245.58132232490_wp ,  &  !:
-      &     ppkth =    21.43336197938_wp ,  &  !:
-      &     ppacr =     3.00000000000_wp       !:
-
-   !!  If both ppa0 ppa1 and ppsur are specified to 0, then
-   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
-
-   REAL(wp), PUBLIC, PARAMETER ::   &  !:
-      &     ppdzmin = 10._wp             ,  &  !: Minimum vertical spacing
-      &     pphmax  = 5000._wp                 !: Maximum depth
-
-   !!---------------------------------------------------------------------
-#endif
-
-   !!---------------------------------------------------------------------
-   !! Domain Matrix size
-   !!---------------------------------------------------------------------
-   INTEGER  &  !:
-#if !defined key_agrif
-      ,PARAMETER  &
-#endif
-    :: &
-      jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ,   &  !: first  dimension
-      jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ,   &  !: second dimension
-      jpim1 = jpi-1,                                             &  !: inner domain indices
-      jpjm1 = jpj-1,                                             &  !:   "            "
-      jpkm1 = jpk-1,                                             &  !:   "            "
-      jpij  = jpi*jpj                                               !:  jpi x jpj
-
+   REAL(wp), PUBLIC, PARAMETER ::   ppsur = -4762.96143546300_wp   !: ORCA r4, r2 and r05 coefficients
+   REAL(wp), PUBLIC, PARAMETER ::   ppa0  =   255.58049070440_wp   !: (default coefficients)
+   REAL(wp), PUBLIC, PARAMETER ::   ppa1  =   245.58132232490_wp   !:
+   REAL(wp), PUBLIC, PARAMETER ::   ppkth =    21.43336197938_wp   !:
+   REAL(wp), PUBLIC, PARAMETER ::   ppacr =     3.00000000000_wp   !:
+   !
+   !  If both ppa0 ppa1 and ppsur are specified to 0, then
+   !  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   REAL(wp), PUBLIC, PARAMETER ::   ppdzmin = 10._wp     !: Minimum vertical spacing
+   REAL(wp), PUBLIC, PARAMETER ::   pphmax  = 5000._wp   !: Maximum depth
+   !
+   LOGICAL , PUBLIC, PARAMETER ::   ldbletanh = .TRUE.   !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp), PUBLIC, PARAMETER ::   ppa2  =   100.760928500000_wp   !: Double tanh function parameters
+   REAL(wp), PUBLIC, PARAMETER ::   ppkth2=    48.029893720000_wp   !:
+   REAL(wp), PUBLIC, PARAMETER ::   ppacr2=    13.000000000000_wp   !:
+   !
+#endif
+
+
+   !!---------------------------------------------------------------------
+   !! Active tracer parameters
+   !!---------------------------------------------------------------------
+   INTEGER, PUBLIC, PARAMETER ::   jpts   = 2    !: Number of active tracers (=2, i.e. T & S )
+   INTEGER, PUBLIC, PARAMETER ::   jp_tem = 1    !: indice for temperature
+   INTEGER, PUBLIC, PARAMETER ::   jp_sal = 2    !: indice for salinity
+
+   !!---------------------------------------------------------------------
+   !! Domain Matrix size  (if AGRIF, they are not all parameters)
+   !!---------------------------------------------------------------------
 #if defined key_agrif
-   !!---------------------------------------------------------------------
-   !! Agrif variables
-   !!---------------------------------------------------------------------
-   INTEGER, PUBLIC, PARAMETER :: nbghostcells = 1
-   INTEGER, PUBLIC :: nbcellsx = jpiglo - 2 - 2*nbghostcells
-   INTEGER, PUBLIC :: nbcellsy = jpjglo - 2 - 2*nbghostcells
-#endif
+   INTEGER, PUBLIC, PARAMETER ::   nbghostcells = 1                             !: number of ghost cells
+   INTEGER, PUBLIC            ::   nbcellsx     = jpiglo - 2 - 2*nbghostcells   !: number of cells in i-direction
+   INTEGER, PUBLIC            ::   nbcellsy     = jpjglo - 2 - 2*nbghostcells   !: number of cells in j-direction
+   !
+   INTEGER, PUBLIC            ::   jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   !: first  dimension
+   INTEGER, PUBLIC            ::   jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   !: second dimension
+   INTEGER, PUBLIC            ::   jpim1 = jpi-1                                            !: inner domain indices
+   INTEGER, PUBLIC            ::   jpjm1 = jpj-1                                            !:   -     -      -
+   INTEGER, PUBLIC            ::   jpkm1 = jpk-1                                            !:   -     -      -
+   INTEGER, PUBLIC            ::   jpij  = jpi*jpj                                          !:  jpi x jpj
+#else
+   INTEGER, PUBLIC, PARAMETER ::   jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   !: first  dimension
+   INTEGER, PUBLIC, PARAMETER ::   jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   !: second dimension
+   INTEGER, PUBLIC, PARAMETER ::   jpim1 = jpi-1                                            !: inner domain indices
+   INTEGER, PUBLIC, PARAMETER ::   jpjm1 = jpj-1                                            !:   -     -      -
+   INTEGER, PUBLIC, PARAMETER ::   jpkm1 = jpk-1                                            !:   -     -      -
+   INTEGER, PUBLIC, PARAMETER ::   jpij  = jpi*jpj                                          !:  jpi x jpj
+#endif
+
    !!---------------------------------------------------------------------
    !! Optimization/control flags
@@ -210,10 +212,4 @@
 #endif
 
-#if defined key_vectopt_memory
-   LOGICAL, PUBLIC, PARAMETER ::   lk_vopt_mem  = .TRUE.   !: vector optimization flag
-#else
-   LOGICAL, PUBLIC, PARAMETER ::   lk_vopt_mem  = .FALSE.  !: vector optimization flag
-#endif
-
 #if defined key_vectopt_loop
    LOGICAL, PUBLIC, PARAMETER ::   lk_vopt_loop = .TRUE.   !: vector optimization flag
@@ -222,4 +218,8 @@
 #endif
 
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!======================================================================
 END MODULE par_oce
Index: trunk/NEMOGCM/NEMO/OPA_SRC/step.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/step.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/step.F90	(revision 2528)
@@ -21,108 +21,24 @@
    !!            3.2  !  2009-02  (G. Madec, R. Benshila)  reintroduicing z*-coordinate
    !!             -   !  2009-06  (S. Masson, G. Madec)  TKE restart compatible with key_cpl
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   stp            : OPA system time-stepping
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers variables
-   USE dom_oce         ! ocean space and time domain variables 
-   USE zdf_oce         ! ocean vertical physics variables
-   USE ldftra_oce      ! ocean tracer   - trends
-   USE ldfdyn_oce      ! ocean dynamics - trends
-   USE in_out_manager  ! I/O manager
-   USE iom             !
-   USE lbclnk
-
-   USE daymod          ! calendar                         (day     routine)
-
-   USE dtatem          ! ocean temperature data           (dta_tem routine)
-   USE dtasal          ! ocean salinity    data           (dta_sal routine)
-   USE sbcmod          ! surface boundary condition       (sbc     routine)
-   USE sbcrnf          ! surface boundary condition: runoff variables
-   USE sbccpl          ! surface boundary condition: coupled formulation (call send at end of step)
-   USE cpl_oasis3, ONLY : lk_cpl
-
+   !!            3.3  !  2010-05  (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface
+   !!             -   !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   stp             : OPA system time-stepping
+   !!----------------------------------------------------------------------
+   USE step_oce         ! time stepping definition modules 
 #if defined key_top
-   USE trcstp          ! passive tracer time-stepping      (trc_stp routine)
-#endif
-
-   USE traqsr          ! solar radiation penetration      (tra_qsr routine)
-   USE trasbc          ! surface boundary condition       (tra_sbc routine)
-   USE trabbc          ! bottom boundary condition        (tra_bbc routine)
-   USE trabbl          ! bottom boundary layer            (tra_bbl routine)
-   USE tradmp          ! internal damping                 (tra_dmp routine)
-   USE traadv          ! advection scheme control     (tra_adv_ctl routine)
-   USE traldf          ! lateral mixing                   (tra_ldf routine)
-   USE cla             ! cross land advection             (tra_cla routine)
-   !   zdfkpp          ! KPP non-local tracer fluxes      (tra_kpp routine)
-   USE trazdf          ! vertical mixing                  (tra_zdf routine)
-   USE tranxt          ! time-stepping                    (tra_nxt routine)
-   USE tranpc          ! non-penetrative convection       (tra_npc routine)
-
-   USE eosbn2          ! equation of state                (eos_bn2 routine)
-
-   USE dynadv          ! advection                        (dyn_adv routine)
-   USE dynbfr          ! Bottom friction terms            (dyn_bfr routine)
-   USE dynvor          ! vorticity term                   (dyn_vor routine)
-   USE dynhpg          ! hydrostatic pressure grad.       (dyn_hpg routine)
-   USE dynldf          ! lateral momentum diffusion       (dyn_ldf routine)
-   USE dynzdf          ! vertical diffusion               (dyn_zdf routine)
-   USE dynspg_oce      ! surface pressure gradient        (dyn_spg routine)
-   USE dynspg          ! surface pressure gradient        (dyn_spg routine)
-   USE dynnxt          ! time-stepping                    (dyn_nxt routine)
-
-   USE obc_par         ! open boundary condition variables
-   USE obcdta          ! open boundary condition data     (obc_dta routine)
-   USE obcrst          ! open boundary cond. restart      (obc_rst routine)
-   USE obcrad          ! open boundary cond. radiation    (obc_rad routine)
-
-   USE bdy_par         ! unstructured open boundary data variables
-   USE bdydta          ! unstructured open boundary data  (bdy_dta routine)
-
-   USE sshwzv          ! vertical velocity and ssh        (ssh_wzv routine)
-
-   USE ldfslp          ! iso-neutral slopes               (ldf_slp routine)
-   USE ldfeiv          ! eddy induced velocity coef.      (ldf_eiv routine)
-
-   USE zdftmx          ! tide-induced vertical mixing     (zdf_tmx routine)
-   USE zdfbfr          ! bottom friction                  (zdf_bfr routine)
-   USE zdftke_old      ! old TKE vertical mixing      (zdf_tke_old routine)
-   USE zdftke          ! TKE vertical mixing              (zdf_tke routine)
-   USE zdfkpp          ! KPP vertical mixing              (zdf_kpp routine)
-   USE zdfddm          ! double diffusion mixing          (zdf_ddm routine)
-   USE zdfevd          ! enhanced vertical diffusion      (zdf_evd routine)
-   USE zdfric          ! Richardson vertical mixing       (zdf_ric routine)
-   USE zdfmxl          ! Mixed-layer depth                (zdf_mxl routine)
-
-   USE zpshde          ! partial step: hor. derivative     (zps_hde routine)
-
-   USE diawri          ! Standard run outputs             (dia_wri routine)
-   USE trdicp          ! Ocean momentum/tracers trends    (trd_wri routine)
-   USE trdmld          ! mixed-layer trends               (trd_mld routine)
-   USE trdmld_rst      ! restart for mixed-layer trends
-   USE trdmod_oce      ! ocean momentum/tracers trends
-   USE trdvor          ! vorticity budget                 (trd_vor routine)
-   USE diagap          ! hor. mean model-data gap         (dia_gap routine)
-   USE diahdy          ! dynamic height                   (dia_hdy routine)
-   USE diaptr          ! poleward transports              (dia_ptr routine)
-   USE diaar5          ! AR5 diagnosics                   (dia_ar5 routine)
-   USE diahth          ! thermocline depth                (dia_hth routine)
-   USE diafwb          ! freshwater budget                (dia_fwb routine)
-   USE flo_oce         ! floats variables
-   USE floats          ! floats computation               (flo_stp routine)
-
-   USE stpctl          ! time stepping control            (stp_ctl routine)
-   USE restart         ! ocean restart                    (rst_wri routine)
-   USE prtctl          ! Print control                    (prt_ctl routine)
-
+   USE trcstp           ! passive tracer time-stepping      (trc_stp routine)
+#endif
 #if defined key_agrif
    USE agrif_opa_sponge ! Momemtum and tracers sponges
 #endif
+   USE asminc           ! assimilation increments    (tra_asm_inc, dyn_asm_inc routines)
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   stp        ! called by opa.F90
+   PUBLIC   stp   ! called by opa.F90
 
    !! * Substitutions
@@ -130,9 +46,8 @@
 #  include "zdfddm_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
@@ -166,16 +81,12 @@
 #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 defined key_iomput
-      IF( Agrif_Nbstepint() == 0) CALL iom_swap
+      IF( Agrif_Nbstepint() == 0 )   CALL iom_swap
 # endif   
 #endif   
-      indic = 1                                       ! reset to no error condition
-
+                             indic = 0                ! reset to no error condition
       IF( kstp /= nit000 )   CALL day( kstp )         ! Calendar (day was already called at nit000 in day_init)
-
-      CALL iom_setkt( kstp )                          ! say to iom that we are at time step kstp
-      
+                             CALL iom_setkt( kstp )   ! say to iom that we are at time step kstp
+
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
       ! Update data, open boundaries, surface boundary condition (including sea-ice)
@@ -186,5 +97,5 @@
       IF( lk_obc     )   CALL obc_dta( kstp )         ! update dynamic and tracer data at open boundaries
       IF( lk_obc     )   CALL obc_rad( kstp )         ! compute phase velocities at open boundaries
-      IF( lk_bdy     )   CALL bdy_dta( kstp )         ! update dynamic and tracer data at unstructured open boundary
+      IF( lk_bdy     )   CALL bdy_dta_frs( kstp )     ! update dynamic and tracer data for FRS conditions (BDY)
 
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
@@ -196,15 +107,16 @@
       ! Ocean physics update                (ua, va, ta, sa used as workspace)
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-                         CALL bn2( tb, sb, rn2b )     ! before Brunt-Vaisala frequency
-                         CALL bn2( tn, sn, rn2  )     ! now    Brunt-Vaisala frequency
+                         CALL bn2( tsb, rn2b )        ! before Brunt-Vaisala frequency
+                         CALL bn2( tsn, rn2  )        ! now    Brunt-Vaisala frequency
       !
       !  VERTICAL PHYSICS   
                          CALL zdf_bfr( kstp )         ! bottom friction
+                         
       !                                               ! Vertical eddy viscosity and diffusivity coefficients
-      IF( lk_zdfric     )   CALL zdf_ric    ( kstp )  ! Richardson number dependent Kz
-      IF( lk_zdftke_old )   CALL zdf_tke_old( kstp )  ! TKE closure scheme for Kz (old scheme)
-      IF( lk_zdftke     )   CALL zdf_tke    ( kstp )  ! TKE closure scheme for Kz
-      IF( lk_zdfkpp     )   CALL zdf_kpp    ( kstp )  ! KPP closure scheme for Kz
-      IF( lk_zdfcst     )   THEN                      ! Constant Kz (reset avt, avm[uv] to the background value)
+      IF( lk_zdfric  )   CALL zdf_ric( kstp )            ! Richardson number dependent Kz
+      IF( lk_zdftke  )   CALL zdf_tke( kstp )            ! TKE closure scheme for Kz
+      IF( lk_zdfgls  )   CALL zdf_gls( kstp )            ! GLS closure scheme for Kz
+      IF( lk_zdfkpp  )   CALL zdf_kpp( kstp )            ! KPP closure scheme for Kz
+      IF( lk_zdfcst  )   THEN                            ! Constant Kz (reset avt, avm[uv] to the background value)
          avt (:,:,:) = rn_avt0 * tmask(:,:,:)
          avmu(:,:,:) = rn_avm0 * umask(:,:,:)
@@ -220,21 +132,26 @@
       IF( lk_zdfddm .AND. .NOT. lk_zdfkpp )   &
          &               CALL zdf_ddm( kstp )         ! double diffusive mixing
+         
                          CALL zdf_mxl( kstp )         ! mixed layer depth
 
-                                                      ! write tke information in the restart file
+                                                      ! write TKE or GLS information in the restart file
       IF( lrst_oce .AND. lk_zdftke )   CALL tke_rst( kstp, 'WRITE' )
+      IF( lrst_oce .AND. lk_zdfgls )   CALL gls_rst( kstp, 'WRITE' )
       !
       !  LATERAL  PHYSICS 
       !
       IF( lk_ldfslp ) THEN                            ! slope of lateral mixing
-                         CALL eos( tb, sb, rhd )                ! before in situ density
-         IF( ln_zps )    CALL zps_hde( kstp, tb, sb, rhd,  &    ! Partial steps: before horizontal gradient
-            &                              gtu, gsu, gru,  &    ! of t, s, rd at the last ocean level
-            &                              gtv, gsv, grv )
-                         CALL ldf_slp( kstp, rhd, rn2b )        ! before slope of the lateral mixing
+                         CALL eos( tsb, rhd )                ! before in situ density
+         IF( ln_zps )    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_traldf_grif ) THEN                           ! before slope for Griffies operator
+                         CALL ldf_slp_grif( kstp )
+         ELSE
+                         CALL ldf_slp( kstp, rhd, rn2b )     ! before slope for Madec operator
+         ENDIF
       ENDIF
 #if defined key_traldf_c2d
       IF( lk_traldf_eiv )   CALL ldf_eiv( kstp )      ! eddy induced velocity coefficient
-#  endif
+#endif
 
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
@@ -243,6 +160,4 @@
       IF( lk_floats  )   CALL flo_stp( kstp )         ! drifting Floats
       IF( lk_diahth  )   CALL dia_hth( kstp )         ! Thermocline depth (20 degres isotherm depth)
-      IF( lk_diagap  )   CALL dia_gap( kstp )         ! basin averaged diagnostics
-      IF( lk_diahdy  )   CALL dia_hdy( kstp )         ! dynamical heigh diagnostics
       IF( lk_diafwb  )   CALL dia_fwb( kstp )         ! Fresh water budget diagnostics
       IF( ln_diaptr  )   CALL dia_ptr( kstp )         ! Poleward TRansports diagnostics
@@ -260,38 +175,38 @@
       ! Active tracers                              (ua, va used as workspace)
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-                             ta(:,:,:) = 0.e0               ! set tracer trends to zero
-                             sa(:,:,:) = 0.e0
-
+                             tsa(:,:,:,:) = 0.e0            ! set tracer trends to zero
+
+      IF(  ln_asmiau .AND. &
+         & ln_trainc     )   CALL tra_asm_inc( kstp )       ! apply tracer assimilation increment
                              CALL tra_sbc    ( kstp )       ! surface boundary condition
       IF( ln_traqsr      )   CALL tra_qsr    ( kstp )       ! penetrative solar radiation qsr
-      IF( lk_trabbc      )   CALL tra_bbc    ( kstp )       ! bottom heat flux
-      IF( lk_trabbl_dif  )   CALL tra_bbl_dif( kstp )       ! diffusive bottom boundary layer scheme
-      IF( lk_trabbl_adv  )   CALL tra_bbl_adv( kstp )       ! advective (and/or diffusive) bottom boundary layer scheme
+      IF( ln_trabbc      )   CALL tra_bbc    ( kstp )       ! bottom heat flux
+      IF( lk_trabbl      )   CALL tra_bbl    ( kstp )       ! advective (and/or diffusive) bottom boundary layer scheme
       IF( lk_tradmp      )   CALL tra_dmp    ( kstp )       ! internal damping trends
                              CALL tra_adv    ( kstp )       ! horizontal & vertical advection
-      IF( n_cla == 1     )   CALL tra_cla    ( kstp )       ! Cross Land Advection (Update Hor. advection)
-      IF( lk_zdfkpp )        CALL tra_kpp    ( kstp )       ! KPP non-local tracer fluxes
+      IF( lk_zdfkpp      )   CALL tra_kpp    ( kstp )       ! KPP non-local tracer fluxes
                              CALL tra_ldf    ( kstp )       ! lateral mixing
 #if defined key_agrif
+                             CALL tra_unswap
       IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_tra          ! tracers sponge
+                             CALL tra_swap
 #endif
                              CALL tra_zdf    ( kstp )       ! vertical mixing and after tracer fields
 
       IF( ln_dynhpg_imp  ) THEN                             ! semi-implicit hpg (time stepping then eos)
-         IF( ln_zdfnpc   )   CALL tra_npc    ( kstp )            ! update after fields by non-penetrative convection
-                             CALL tra_nxt    ( kstp )            ! tracer fields at next time step
-                             CALL eos( ta, sa, rhd, rhop )       ! Time-filtered in situ density for hpg computation
-         IF( ln_zps      )   CALL zps_hde( kstp, ta, sa, rhd,   &   ! Partial steps: time filtered hor. derivative
-            &                                   gtu, gsu, gru,  &   ! of t, s, rd at the bottom ocean level
-            &                                   gtv, gsv, grv )
+         IF( ln_zdfnpc   )   CALL tra_npc( kstp )                ! update after fields by non-penetrative convection
+                             CALL tra_nxt( kstp )                ! tracer fields at next time step
+                             CALL eos    ( tsa, rhd, rhop )      ! Time-filtered in situ density for hpg computation
+         IF( ln_zps      )   CALL zps_hde( kstp, jpts, tsa, gtsu, gtsv,  &    ! zps: time filtered hor. derivative
+            &                                          rhd, gru , grv  )      ! of t, s, rd at the last ocean level
          
       ELSE                                                  ! centered hpg  (eos then time stepping)
-                             CALL eos( tn, sn, rhd, rhop )       ! now in situ density for hpg computation
-         IF( ln_zps      )   CALL zps_hde( kstp, tn, sn, rhd,   &   ! Partial steps: now horizontal derivative
-            &                                   gtu, gsu, gru,  &   ! of t, s, rd at the bottom ocean level
-            &                                   gtv, gsv, grv )
-         IF( ln_zdfnpc   )   CALL tra_npc    ( kstp )       ! update after fields by non-penetrative convection
-                             CALL tra_nxt    ( kstp )       ! tracer fields at next time step
+                             CALL eos    ( tsn, rhd, rhop )      ! now in situ density for hpg computation
+         IF( ln_zps      )   CALL zps_hde( kstp, jpts, tsn, gtsu, gtsv,  &    ! zps: now hor. derivative
+            &                                          rhd, gru , grv  )      ! of t, s, rd at the last ocean level
+         IF( ln_zdfnpc   )   CALL tra_npc( kstp )                ! update after fields by non-penetrative convection
+                             CALL tra_nxt( kstp )                ! tracer fields at next time step
       ENDIF 
+                             CALL tra_unswap                ! udate T & S 3D arrays  (to be suppressed)
 
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
@@ -301,4 +216,6 @@
                                va(:,:,:) = 0.e0
 
+      IF(  ln_asmiau .AND. &
+         & ln_dyninc       )   CALL dyn_asm_inc( kstp )     ! apply dynamics assimilation increment
                                CALL dyn_adv( kstp )         ! advection (vector or flux form)
                                CALL dyn_vor( kstp )         ! vorticity term including Coriolis
@@ -308,11 +225,13 @@
 #endif
                                CALL dyn_hpg( kstp )         ! horizontal gradient of Hydrostatic pressure
-                               CALL dyn_bfr( kstp )           ! bottom friction   
+                               CALL dyn_bfr( kstp )         ! bottom friction   
                                CALL dyn_zdf( kstp )         ! vertical diffusion
-                               indic=0
                                CALL dyn_spg( kstp, indic )  ! surface pressure gradient
                                CALL dyn_nxt( kstp )         ! lateral velocity at next time step
 
                                CALL ssh_nxt( kstp )         ! sea surface height at next time step
+
+      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)
 
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Index: trunk/NEMOGCM/NEMO/OPA_SRC/step_oce.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/step_oce.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/step_oce.F90	(revision 2528)
@@ -0,0 +1,106 @@
+MODULE step_oce
+   !!======================================================================
+   !!                       ***  MODULE step_oce  ***
+   !! Ocean time-stepping : module used in both initialisation phase and time stepping
+   !!======================================================================
+   !! History :   3.3  ! 2010-08  (C. Ethe)  Original code - reorganisation of the initial phase
+   !!----------------------------------------------------------------------
+   USE oce              ! ocean dynamics and tracers variables
+   USE dom_oce          ! ocean space and time domain variables 
+   USE zdf_oce          ! ocean vertical physics variables
+   USE ldftra_oce       ! ocean tracer   - trends
+   USE ldfdyn_oce       ! ocean dynamics - trends
+   USE in_out_manager   ! I/O manager
+   USE iom              !
+   USE lbclnk
+
+   USE daymod           ! calendar                         (day     routine)
+
+   USE dtatem           ! ocean temperature data           (dta_tem routine)
+   USE dtasal           ! ocean salinity    data           (dta_sal routine)
+   USE sbcmod           ! surface boundary condition       (sbc     routine)
+   USE sbcrnf           ! surface boundary condition: runoff variables
+   USE sbccpl           ! surface boundary condition: coupled formulation (call send at end of step)
+   USE cpl_oasis3, ONLY : lk_cpl
+
+   USE traqsr           ! solar radiation penetration      (tra_qsr routine)
+   USE trasbc           ! surface boundary condition       (tra_sbc routine)
+   USE trabbc           ! bottom boundary condition        (tra_bbc routine)
+   USE trabbl           ! bottom boundary layer            (tra_bbl routine)
+   USE tradmp           ! internal damping                 (tra_dmp routine)
+   USE traadv           ! advection scheme control     (tra_adv_ctl routine)
+   USE traldf           ! lateral mixing                   (tra_ldf routine)
+   !   zdfkpp           ! KPP non-local tracer fluxes      (tra_kpp routine)
+   USE trazdf           ! vertical mixing                  (tra_zdf routine)
+   USE tranxt           ! time-stepping                    (tra_nxt routine)
+   USE tranpc           ! non-penetrative convection       (tra_npc routine)
+
+   USE eosbn2           ! equation of state                (eos_bn2 routine)
+
+   USE dynadv           ! advection                        (dyn_adv routine)
+   USE dynbfr           ! Bottom friction terms            (dyn_bfr routine)
+   USE dynvor           ! vorticity term                   (dyn_vor routine)
+   USE dynhpg           ! hydrostatic pressure grad.       (dyn_hpg routine)
+   USE dynldf           ! lateral momentum diffusion       (dyn_ldf routine)
+   USE dynzdf           ! vertical diffusion               (dyn_zdf routine)
+   USE dynspg_oce       ! surface pressure gradient        (dyn_spg routine)
+   USE dynspg           ! surface pressure gradient        (dyn_spg routine)
+   USE dynnxt           ! time-stepping                    (dyn_nxt routine)
+
+   USE obc_par          ! open boundary condition variables
+   USE obcdta           ! open boundary condition data     (obc_dta routine)
+   USE obcrst           ! open boundary cond. restart      (obc_rst routine)
+   USE obcrad           ! open boundary cond. radiation    (obc_rad routine)
+
+   USE bdy_par          ! unstructured open boundary data variables
+   USE bdydta           ! unstructured open boundary data  (bdy_dta routine)
+
+   USE sshwzv           ! vertical velocity and ssh        (ssh_wzv routine)
+
+   USE ldfslp           ! iso-neutral slopes               (ldf_slp routine)
+   USE ldfeiv           ! eddy induced velocity coef.      (ldf_eiv routine)
+
+   USE zdftmx           ! tide-induced vertical mixing     (zdf_tmx routine)
+   USE zdfbfr           ! bottom friction                  (zdf_bfr routine)
+   USE zdftke           ! TKE vertical mixing              (zdf_tke routine)
+   USE zdfgls           ! GLS vertical mixing              (zdf_gls routine)
+   USE zdfkpp           ! KPP vertical mixing              (zdf_kpp routine)
+   USE zdfddm           ! double diffusion mixing          (zdf_ddm routine)
+   USE zdfevd           ! enhanced vertical diffusion      (zdf_evd routine)
+   USE zdfric           ! Richardson vertical mixing       (zdf_ric routine)
+   USE zdfmxl           ! Mixed-layer depth                (zdf_mxl routine)
+
+   USE zpshde           ! partial step: hor. derivative     (zps_hde routine)
+
+   USE diawri           ! Standard run outputs             (dia_wri routine)
+   USE trdicp           ! Ocean momentum/tracers trends    (trd_wri routine)
+   USE trdmld           ! mixed-layer trends               (trd_mld routine)
+   USE trdmld_rst       ! restart for mixed-layer trends
+   USE trdmod_oce       ! ocean momentum/tracers trends
+   USE trdmod           ! momentum/tracers trends   
+   USE trdvor           ! vorticity budget                 (trd_vor routine)
+   USE diaptr           ! poleward transports              (dia_ptr routine)
+   USE diaar5           ! AR5 diagnosics                   (dia_ar5 routine)
+   USE diahth           ! thermocline depth                (dia_hth routine)
+   USE diafwb           ! freshwater budget                (dia_fwb routine)
+   USE diahsb           ! heat, salt and volume budgets    (dia_hsb routine)
+   USE flo_oce          ! floats variables
+   USE floats           ! floats computation               (flo_stp routine)
+
+   USE stpctl           ! time stepping control            (stp_ctl routine)
+   USE restart          ! ocean restart                    (rst_wri routine)
+   USE prtctl           ! Print control                    (prt_ctl routine)
+
+   USE traswp           ! Swap arrays           (tra_swp, tra_unswp routine)
+
+   USE diaobs           ! Observation operator
+
+#if defined key_agrif
+   USE agrif_opa_sponge ! Momemtum and tracers sponges
+#endif
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE step_oce
Index: trunk/NEMOGCM/NEMO/OPA_SRC/stpctl.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/stpctl.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/stpctl.F90	(revision 2528)
@@ -21,4 +21,5 @@
    USE lib_mpp         ! distributed memory computing
    USE dynspg_oce      ! pressure gradient schemes 
+   USE c1d             ! 1D vertical configuration
 
    IMPLICIT NONE
@@ -27,7 +28,7 @@
    PUBLIC stp_ctl           ! routine called by step.F90
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -139,4 +140,7 @@
 9500  FORMAT (' kt=',i6,' min SSS: ',1pg11.4,', i j: ',2i5)
 
+      
+      IF( lk_c1d )  RETURN          ! No log file in case of 1D vertical configuration
+
       ! log file (solver or ssh statistics)
       ! --------
Index: trunk/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90	(revision 2528)
@@ -20,5 +20,6 @@
    PUBLIC   trc_oce_rgb_read   ! routine called by traqsr.F90
    PUBLIC   trc_oce_ext_lev    ! function called by traqsr.F90 at least
-   
+ 
+   REAL(wp), PUBLIC                          ::   r_si2   !: largest depth of extinction (blue & 0.01 mg.m-3)  (RGB)
    REAL(wp), PUBLIC , DIMENSION(jpi,jpj,jpk) ::   etot3   !: light absortion coefficient
 
@@ -35,10 +36,22 @@
 #endif
 
+#if defined key_offline
+   !!----------------------------------------------------------------------
+   !!   'key_offline'                                     OFFLINE mode          
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_offline = .TRUE.   !: offline flag
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                   NO  OFFLINE mode          
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_offline = .FALSE.   !: offline flag
+#endif
+
    !! * Substitutions
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -138,4 +151,7 @@
       prgb(:,:) = zrgb(2:4,:)
       !
+      r_si2 = 1.e0 / zrgb(2, 1)        ! blue with the smallest chlorophyll concentration)
+      IF(lwp) WRITE(numout,*) '      RGB longest depth of extinction    r_si2 = ', r_si2
+      !
       DO jc = 1, 61                         ! check
          zchl = zrgb(1,jc)
@@ -164,14 +180,9 @@
       REAL(wp), DIMENSION(3,61), INTENT(out) ::   prgb   ! tabulated attenuation coefficient
       !!
-      INTEGER  ::   jchl, jband   ! dummy loop indices
+      INTEGER  ::   jc, jb ! dummy loop indice
+      INTEGER  ::   irgb   ! temporary integer
+      REAL(wp) ::   zchl   ! temporary scalar
       INTEGER  ::   numlight
-      REAL(wp) ::   zchl
-      !!----------------------------------------------------------------------
-      !
-      CALL ctl_opn( numlight, 'kRGB61.txt', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )
-      DO jchl = 1, 61
-         READ(numlight,*) zchl, ( prgb(jband,jchl), jband=1,3 )
-      END DO
-      CLOSE( numlight )
+      !!----------------------------------------------------------------------
       !
       IF(lwp) THEN                         ! control print
@@ -179,5 +190,21 @@
          WRITE(numout,*) ' trc_oce_rgb_read : optical look-up table read in kRGB61.txt file'
          WRITE(numout,*) ' ~~~~~~~~~~~~~~~~'
+         WRITE(numout,*) 
       ENDIF
+      !
+      CALL ctl_opn( numlight, 'kRGB61.txt', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )
+      DO jc = 1, 61
+         READ(numlight,*) zchl, ( prgb(jb,jc), jb = 1, 3 )
+         irgb = NINT( 41 + 20.* LOG10( zchl ) + 1.e-15 )   
+         IF(lwp) WRITE(numout,*) '    jc =', jc, '  Chl = ', zchl, '  irgb = ', irgb  
+         IF( irgb /= jc ) THEN  
+            IF(lwp) WRITE(numout,*) '    jc =', jc, '  Chl = ', zchl, '  Chl class = ', irgb
+            CALL ctl_stop( 'trc_oce_rgb_read : inconsistency in Chl tabulated attenuation coeff.' )
+         ENDIF
+      END DO
+      CLOSE( numlight )
+      !
+      r_si2 = 1.e0 / prgb(1, 1)      ! blue with the smallest chlorophyll concentration)
+      IF(lwp) WRITE(numout,*) '      RGB longest depth of extinction    r_si2 = ', r_si2
       !
    END SUBROUTINE trc_oce_rgb_read
Index: trunk/NEMOGCM/NEMO/OPA_SRC/vectopt_loop_substitute.h90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/vectopt_loop_substitute.h90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/vectopt_loop_substitute.h90	(revision 2528)
@@ -6,7 +6,7 @@
    !!----------------------------------------------------------------------
    !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 #if defined key_vectopt_loop
Index: trunk/NEMOGCM/NEMO/TOP_SRC/C14b/par_c14b.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/C14b/par_c14b.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/C14b/par_c14b.F90	(revision 2528)
@@ -6,7 +6,7 @@
    !! History :   2.0  !  2008-12  (C. Ethe, G. Madec)  revised architecture
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
-   !! $Id: par_cfc.F90 1152 2008-06-26 14:11:13Z rblod $ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
    USE par_lobster, ONLY : jp_lobster      !: number of tracers in LOBSTER
Index: trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trcctl_c14b.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trcctl_c14b.F90	(revision 2527)
+++ 	(revision )
@@ -1,80 +1,0 @@
-MODULE trcctl_c14b
-   !!======================================================================
-   !!                         ***  trcctl_c14b.F90  ***
-   !! TOP :                Control of C14 chemical model
-   !!======================================================================
-   !!----------------------------------------------------------------------
-   !! History :   1.0  !  2005-10 (C. Ethe) assign a parameter to name individual tracers
-   !!----------------------------------------------------------------------
-
-#if defined key_c14b
-
-   USE oce_trc
-   USE trc
-
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC trc_ctl_c14b      ! called by ???
-
-   !!----------------------------------------------------------------------
-   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) 
-   !! $Id: trcctl_cfc.F90 1146 2008-06-25 11:42:56Z rblod $ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE trc_ctl_c14b
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE trc_ctl_c14b  ***
-      !!
-      !! ** Purpose :   control the cpp options, namelist and files 
-      !!----------------------------------------------------------------------
-      IF(lwp) THEN
-          WRITE(numout,*) ' C14 bomb Model '
-          WRITE(numout,*) ' '
-      ENDIF
-
-      ! Check number of tracers
-      ! -----------------------   
-      IF( jp_c14b > 1) CALL ctl_stop( ' Change jp_c14b to be equal 1 in par_c14b.F90' )
-
-      ! Check tracer names
-      ! ------------------
-      IF ( ctrcnm(jpc14) /= 'C14B' ) THEN
-           ctrcnm(jpc14)  = 'C14B'
-           ctrcnl(jpc14)  = 'Bomb C14 concentration'
-      ENDIF
-
-      IF(lwp) THEN
-         CALL ctl_warn( ' we force tracer names' )
-         WRITE(numout,*) ' tracer nb: ',jpc14,' name = ',ctrcnm(jpc14), ctrcnl(jpc14)
-         WRITE(numout,*) ' '
-      ENDIF
-
-      ! Check tracer units
-      ! ------------------
-      IF( ctrcun(jpc14) /= 'ration' ) THEN
-          ctrcun(jpc14) = 'ration'
-          IF(lwp) THEN
-             CALL ctl_warn( ' we force tracer unit' )
-             WRITE(numout,*) ' tracer  ',ctrcnm(jpc14), 'UNIT= ',ctrcun(jpc14)
-             WRITE(numout,*) ' '
-          ENDIF
-       ENDIF
-      !
-   END SUBROUTINE trc_ctl_c14b
-
-#else
-   !!----------------------------------------------------------------------
-   !!  Empty module :                                         No Bomb c14
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE trc_ctl_c14b                      ! Dummy routine
-   END SUBROUTINE trc_ctl_c14b
-#endif
-
-   !!======================================================================
-END MODULE trcctl_c14b
Index: trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trcini_c14b.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trcini_c14b.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trcini_c14b.F90	(revision 2528)
@@ -41,7 +41,7 @@
 
    !!---------------------------------------------------------------------
-   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
-   !! $Id: trcini_cfc.F90 1146 2008-06-25 11:42:56Z rblod $ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -59,6 +59,9 @@
       !!----------------------------------------------------------------------
 
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) ' trc_ini_cfc: initialisation of CFC chemical model'
+      !  Control consitency
+      CALL trc_ctl_c14b
+
+      IF(lwp) WRITE(numout,*) ''
+      IF(lwp) WRITE(numout,*) ' trc_ini_c14b: initialisation of Bomb C14 chemical model'
       IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~'
 
@@ -162,4 +165,45 @@
    END SUBROUTINE trc_ini_c14b
    
+   SUBROUTINE trc_ctl_c14b
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_ctl_c14b  ***
+      !!
+      !! ** Purpose :   control the cpp options, namelist and files 
+      !!----------------------------------------------------------------------
+
+      IF(lwp) THEN
+          WRITE(numout,*) ' C14 bomb Model '
+          WRITE(numout,*) ' '
+      ENDIF
+
+      ! Check number of tracers
+      ! -----------------------   
+      IF( jp_c14b > 1) CALL ctl_stop( ' Change jp_c14b to be equal 1 in par_c14b.F90' )
+
+      ! Check tracer names
+      ! ------------------
+      IF ( ctrcnm(jpc14) /= 'C14B' ) THEN
+           ctrcnm(jpc14)  = 'C14B'
+           ctrcnl(jpc14)  = 'Bomb C14 concentration'
+      ENDIF
+
+      IF(lwp) THEN
+         CALL ctl_warn( ' we force tracer names' )
+         WRITE(numout,*) ' tracer nb: ',jpc14,' name = ',ctrcnm(jpc14), ctrcnl(jpc14)
+         WRITE(numout,*) ' '
+      ENDIF
+
+      ! Check tracer units
+      ! ------------------
+      IF( ctrcun(jpc14) /= 'ration' ) THEN
+          ctrcun(jpc14) = 'ration'
+          IF(lwp) THEN
+             CALL ctl_warn( ' we force tracer unit' )
+             WRITE(numout,*) ' tracer  ',ctrcnm(jpc14), 'UNIT= ',ctrcun(jpc14)
+             WRITE(numout,*) ' '
+          ENDIF
+       ENDIF
+      !
+   END SUBROUTINE trc_ctl_c14b
 #else
    !!----------------------------------------------------------------------
Index: trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trclsm_c14b.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trclsm_c14b.F90	(revision 2527)
+++ 	(revision )
@@ -1,157 +1,0 @@
-MODULE trclsm_c14b
-   !!======================================================================
-   !!                         ***  MODULE trclsm_c14b  ***
-   !! TOP :   initialisation of some run parameters for C14 chemical model
-   !!======================================================================
-   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) from trclsm.cfc.h90
-   !!----------------------------------------------------------------------
-#if defined key_c14b
-   !!----------------------------------------------------------------------
-   !!   'key_c14b'                                         C14 bomb tracer
-   !!----------------------------------------------------------------------
-   !! trc_lsm_c14b      : C14 model initialisation
-   !!----------------------------------------------------------------------
-   USE oce_trc         ! Ocean variables
-   USE par_trc         ! TOP parameters
-   USE trc             ! TOP variables
-   USE trcsms_c14b     ! C14b specific variable
-   USE in_out_manager  ! I/O manager
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   trc_lsm_c14b   ! called by trclsm.F90 module
-
-   !!----------------------------------------------------------------------
-   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
-   !! $Id: trclsm_cfc.F90 1146 2008-06-25 11:42:56Z rblod $ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE trc_lsm_c14b
-      !!-------------------------------------------------------------------
-      !!                  ***  ROUTINE trc_lsm_c14b  ***
-      !!                 
-      !! ** Purpose :   Definition some run parameter for C14 model
-      !!
-      !! ** Method  :   Read the namc14 namelist and check the parameter 
-      !!       values called at the first timestep (nit000)
-      !!
-      !! ** input   :   Namelist namelist_c14b
-      !!----------------------------------------------------------------------
-      INTEGER ::   numnatb
-
-#if defined key_trc_diaadd && ! defined key_iomput
-      ! definition of additional diagnostic as a structure
-      INTEGER ::   jl, jn
-      TYPE DIAG
-         CHARACTER(len = 20)  :: snamedia   !: short name
-         CHARACTER(len = 80 ) :: lnamedia   !: long name
-         CHARACTER(len = 20 ) :: unitdia    !: unit
-      END TYPE DIAG
-
-      TYPE(DIAG) , DIMENSION(jp_c14b_2d) :: c14dia2d
-      TYPE(DIAG) , DIMENSION(jp_c14b_3d) :: c14dia3d
-#endif
-      !!
-      NAMELIST/namc14date/ ndate_beg_b, nyear_res_b
-#if defined key_trc_diaadd && ! defined key_iomput
-      NAMELIST/namc14dia/nwritedia, c14dia2d, c14dia3d     ! additional diagnostics
-#endif
-      !!-------------------------------------------------------------------
-
-      ndate_beg_b = 650101            ! default namelist value
-      nyear_res_b = 1955
-
-      !                             ! Open namelist file
-      CALL ctl_opn( numnatb, 'namelist_c14b', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
-         
-      READ( numnatb , namc14date )     ! read namelist
-
-      IF(lwp) THEN                  ! control print
-         WRITE(numout,*)
-         WRITE(numout,*) ' trc_lsm: Read namdates, namelist for C14 chemical model'
-         WRITE(numout,*) ' ~~~~~~~'
-         WRITE(numout,*) '    initial calendar date (aammjj) for C14  ndate_beg_b = ', ndate_beg_b
-         WRITE(numout,*) '    restoring time constant (year)          nyear_res_b = ', nyear_res_b
-      ENDIF
-      nyear_beg_b = ndate_beg_b / 10000
-      IF(lwp) WRITE(numout,*) '    initial year (aa)                  nyear_beg_b = ', nyear_beg_b
-      !
-#if defined key_trc_diaadd && ! defined key_iomput
-
-      ! Namelist namc14dia
-      ! -------------------
-      nwritedia = 10                   ! default values
-
-      DO jl = 1, jp_c14b_2d
-         jn = jp_c14b0_2d + jl - 1
-         WRITE(ctrc2d(jn),'("2D_",I1)') jn                      ! short name
-         WRITE(ctrc2l(jn),'("2D DIAGNOSTIC NUMBER ",I2)') jn    ! long name
-         ctrc2u(jn) = ' '                                       ! units
-      END DO
-      !                                 ! 3D output arrays
-      DO jl = 1, jp_c14b_3d
-         jn = jp_c14b0_3d + jl - 1
-         WRITE(ctrc3d(jn),'("3D_",I1)') jn                      ! short name
-         WRITE(ctrc3l(jn),'("3D DIAGNOSTIC NUMBER ",I2)') jn    ! long name
-         ctrc3u(jn) = ' '                                       ! units
-      END DO
-
-      REWIND( numnatb )               ! read natrtd
-      READ  ( numnatb, namc14dia )
-
-      DO jl = 1, jp_c14b_2d
-         jn = jp_c14b0_2d + jl - 1
-         ctrc2d(jn) = c14dia2d(jl)%snamedia
-         ctrc2l(jn) = c14dia2d(jl)%lnamedia
-         ctrc2u(jn) = c14dia2d(jl)%unitdia
-      END DO
-
-      DO jl = 1, jp_c14b_3d
-         jn = jp_c14b0_3d + jl - 1
-         ctrc3d(jn) = c14dia3d(jl)%snamedia
-         ctrc3l(jn) = c14dia3d(jl)%lnamedia
-         ctrc3u(jn) = c14dia3d(jl)%unitdia
-      END DO
-
-      IF(lwp) THEN                   ! control print
-         WRITE(numout,*)
-         WRITE(numout,*) ' Namelist : natadd'
-         WRITE(numout,*) '    frequency of outputs for additional arrays nwritedia = ', nwritedia
-         DO jl = 1, jp_c14b_3d
-            jn = jp_c14b0_3d + jl - 1
-            WRITE(numout,*) '   3d output field No : ',jn
-            WRITE(numout,*) '   short name         : ', TRIM(ctrc3d(jn))
-            WRITE(numout,*) '   long name          : ', TRIM(ctrc3l(jn))
-            WRITE(numout,*) '   unit               : ', TRIM(ctrc3u(jn))
-            WRITE(numout,*) ' '
-         END DO
-
-         DO jl = 1, jp_c14b_2d
-            jn = jp_c14b0_2d + jl - 1
-            WRITE(numout,*) '   2d output field No : ',jn
-            WRITE(numout,*) '   short name         : ', TRIM(ctrc2d(jn))
-            WRITE(numout,*) '   long name          : ', TRIM(ctrc2l(jn))
-            WRITE(numout,*) '   unit               : ', TRIM(ctrc2u(jn))
-            WRITE(numout,*) ' '
-         END DO
-      ENDIF
-
-#endif
-
-   END SUBROUTINE trc_lsm_c14b
-   
-#else
-   !!----------------------------------------------------------------------
-   !!  Dummy module :                                                No 14C
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE trc_lsm_c14b                      ! Empty routine
-   END  SUBROUTINE  trc_lsm_c14b
-#endif  
-
-   !!======================================================================
-END MODULE trclsm_c14b
Index: trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trcnam_c14b.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trcnam_c14b.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trcnam_c14b.F90	(revision 2528)
@@ -0,0 +1,157 @@
+MODULE trcnam_c14b
+   !!======================================================================
+   !!                         ***  MODULE trcnam_c14b  ***
+   !! TOP :   initialisation of some run parameters for C14 chemical model
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) from trcnam.cfc.h90
+   !!----------------------------------------------------------------------
+#if defined key_c14b
+   !!----------------------------------------------------------------------
+   !!   'key_c14b'                                         C14 bomb tracer
+   !!----------------------------------------------------------------------
+   !! trc_nam_c14b      : C14 model initialisation
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! Ocean variables
+   USE par_trc         ! TOP parameters
+   USE trc             ! TOP variables
+   USE trcsms_c14b     ! C14b specific variable
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_nam_c14b   ! called by trcnam.F90 module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_nam_c14b
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_nam_c14b  ***
+      !!                 
+      !! ** Purpose :   Definition some run parameter for C14 model
+      !!
+      !! ** Method  :   Read the namc14 namelist and check the parameter 
+      !!       values called at the first timestep (nit000)
+      !!
+      !! ** input   :   Namelist namelist_c14b
+      !!----------------------------------------------------------------------
+      INTEGER ::   numnatb
+
+#if defined key_diatrc && ! defined key_iomput
+      ! definition of additional diagnostic as a structure
+      INTEGER ::   jl, jn
+      TYPE DIAG
+         CHARACTER(len = 20)  :: snamedia   !: short name
+         CHARACTER(len = 80 ) :: lnamedia   !: long name
+         CHARACTER(len = 20 ) :: unitdia    !: unit
+      END TYPE DIAG
+
+      TYPE(DIAG) , DIMENSION(jp_c14b_2d) :: c14dia2d
+      TYPE(DIAG) , DIMENSION(jp_c14b_3d) :: c14dia3d
+#endif
+      !!
+      NAMELIST/namc14date/ ndate_beg_b, nyear_res_b
+#if defined key_diatrc && ! defined key_iomput
+      NAMELIST/namc14dia/nwritedia, c14dia2d, c14dia3d     ! additional diagnostics
+#endif
+      !!-------------------------------------------------------------------
+
+      ndate_beg_b = 650101            ! default namelist value
+      nyear_res_b = 1955
+
+      !                             ! Open namelist file
+      CALL ctl_opn( numnatb, 'namelist_c14b', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+         
+      READ( numnatb , namc14date )     ! read namelist
+
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) ' trc_nam: Read namdates, namelist for C14 chemical model'
+         WRITE(numout,*) ' ~~~~~~~'
+         WRITE(numout,*) '    initial calendar date (aammjj) for C14  ndate_beg_b = ', ndate_beg_b
+         WRITE(numout,*) '    restoring time constant (year)          nyear_res_b = ', nyear_res_b
+      ENDIF
+      nyear_beg_b = ndate_beg_b / 10000
+      IF(lwp) WRITE(numout,*) '    initial year (aa)                  nyear_beg_b = ', nyear_beg_b
+      !
+#if defined key_diatrc && ! defined key_iomput
+
+      ! Namelist namc14dia
+      ! -------------------
+      nwritedia = 10                   ! default values
+
+      DO jl = 1, jp_c14b_2d
+         jn = jp_c14b0_2d + jl - 1
+         WRITE(ctrc2d(jn),'("2D_",I1)') jn                      ! short name
+         WRITE(ctrc2l(jn),'("2D DIAGNOSTIC NUMBER ",I2)') jn    ! long name
+         ctrc2u(jn) = ' '                                       ! units
+      END DO
+      !                                 ! 3D output arrays
+      DO jl = 1, jp_c14b_3d
+         jn = jp_c14b0_3d + jl - 1
+         WRITE(ctrc3d(jn),'("3D_",I1)') jn                      ! short name
+         WRITE(ctrc3l(jn),'("3D DIAGNOSTIC NUMBER ",I2)') jn    ! long name
+         ctrc3u(jn) = ' '                                       ! units
+      END DO
+
+      REWIND( numnatb )               ! read natrtd
+      READ  ( numnatb, namc14dia )
+
+      DO jl = 1, jp_c14b_2d
+         jn = jp_c14b0_2d + jl - 1
+         ctrc2d(jn) = c14dia2d(jl)%snamedia
+         ctrc2l(jn) = c14dia2d(jl)%lnamedia
+         ctrc2u(jn) = c14dia2d(jl)%unitdia
+      END DO
+
+      DO jl = 1, jp_c14b_3d
+         jn = jp_c14b0_3d + jl - 1
+         ctrc3d(jn) = c14dia3d(jl)%snamedia
+         ctrc3l(jn) = c14dia3d(jl)%lnamedia
+         ctrc3u(jn) = c14dia3d(jl)%unitdia
+      END DO
+
+      IF(lwp) THEN                   ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) ' Namelist : natadd'
+         WRITE(numout,*) '    frequency of outputs for additional arrays nwritedia = ', nwritedia
+         DO jl = 1, jp_c14b_3d
+            jn = jp_c14b0_3d + jl - 1
+            WRITE(numout,*) '   3d output field No : ',jn
+            WRITE(numout,*) '   short name         : ', TRIM(ctrc3d(jn))
+            WRITE(numout,*) '   long name          : ', TRIM(ctrc3l(jn))
+            WRITE(numout,*) '   unit               : ', TRIM(ctrc3u(jn))
+            WRITE(numout,*) ' '
+         END DO
+
+         DO jl = 1, jp_c14b_2d
+            jn = jp_c14b0_2d + jl - 1
+            WRITE(numout,*) '   2d output field No : ',jn
+            WRITE(numout,*) '   short name         : ', TRIM(ctrc2d(jn))
+            WRITE(numout,*) '   long name          : ', TRIM(ctrc2l(jn))
+            WRITE(numout,*) '   unit               : ', TRIM(ctrc2u(jn))
+            WRITE(numout,*) ' '
+         END DO
+      ENDIF
+
+#endif
+
+   END SUBROUTINE trc_nam_c14b
+   
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                                No 14C
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_nam_c14b                      ! Empty routine
+   END  SUBROUTINE  trc_nam_c14b
+#endif  
+
+   !!======================================================================
+END MODULE trcnam_c14b
Index: trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trcrst_c14b.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trcrst_c14b.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trcrst_c14b.F90	(revision 2528)
@@ -43,7 +43,5 @@
       IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
       
-      DO jn = jp_c14b0, jp_c14b1
-         CALL iom_get( knum, jpdom_autoglo, 'qint_'//ctrcnm(jn), qint_c14(:,:,jn) ) 
-      END DO
+      CALL iom_get( knum, jpdom_autoglo, 'qint_c14', qint_c14 ) 
 
    END SUBROUTINE trc_rst_read_c14b
@@ -59,5 +57,4 @@
       INTEGER, INTENT(in)  :: kitrst  ! time step of restart write
       INTEGER, INTENT(in)  :: knum    ! unit of the restart file
-      INTEGER              :: jn      ! dummy loop indices
       !!----------------------------------------------------------------------
 
@@ -66,7 +63,5 @@
       IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
 
-      DO jn = jp_c14b0, jp_c14b1
-         CALL iom_rstput( kt, kitrst, kum, 'qint_'//ctrcnm(jn), qint_c14(:,:,jn) )
-      END DO
+      CALL iom_rstput( kt, kitrst, knum, 'qint_c14', qint_c14 )
 
    END SUBROUTINE trc_rst_wri_c14b
Index: trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90	(revision 2528)
@@ -17,6 +17,6 @@
    USE par_trc      ! TOP parameters
    USE trc          ! TOP variables
-   USE trdmld_trc_oce
-   USE trdmld_trc
+   USE trdmod_oce
+   USE trdmod_trc
    USE iom
 
@@ -126,10 +126,10 @@
        zpv  ,        &      !: piston velocity 
        zdemi, ztra
-#if defined key_trc_dia3d  && defined key_iomput
+#if defined key_diatrc  && defined key_iomput
       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d
 #endif
       !!----------------------------------------------------------------------
 
-      IF( kt == nittrc000 )  THEN
+      IF( kt == nit000 )  THEN
          ! Computation of decay coeffcient
          zdemi   = 5730.
@@ -234,7 +234,7 @@
             !  Computation of solubility  
             IF (tmask(ji,jj,1) >  0.) THEN
-               ztp  = ( tn(ji,jj,1) + 273.16 ) * 0.01
+               ztp  = ( tsn(ji,jj,1,jp_tem) + 273.16 ) * 0.01
                zsk  = 0.023517 + ztp * ( -0.023656 + 0.0047036 * ztp )
-               zsol = EXP( -60.2409 + 93.4517 / ztp  + 23.3585 * LOG( ztp ) + zsk * sn(ji,jj,1) )
+               zsol = EXP( -60.2409 + 93.4517 / ztp  + 23.3585 * LOG( ztp ) + zsk * tsn(ji,jj,1,jp_sal) )
                ! convert solubilities [mol/(l * atm)] -> [mol/(m^3 * ppm)]
                zsol = zsol * 1.0e-03
@@ -247,5 +247,5 @@
 
             ! Computes the Schmidt number of CO2 in seawater
-            zt   = tn(ji,jj,1)
+            zt   = tsn(ji,jj,1,jp_tem)
             zsch = 2073.1 + zt * ( -125.62 + zt * (3.6276 - 0.043219 * zt ) )
 
@@ -259,5 +259,5 @@
             qtr_c14(ji,jj) = -zpv * zsol * zpco2at                                   &
                  &                       * ( trb(ji,jj,1,jpc14) - zatmbc14(ji,jj) )  &
-#if defined key_off_degrad
+#if defined key_degrad
                  &                       * facvol(ji,jj,1)                           &
 #endif
@@ -270,5 +270,5 @@
             qint_c14(ji,jj) = qint_c14(ji,jj) + qtr_c14(ji,jj) * rdt
 
-# if defined key_trc_diaadd && ! defined key_iomput
+# if defined key_diatrc && ! defined key_iomput
             ! Save 2D diagnostics
             trc2d(ji,jj,jp_c14b0_2d    ) = qtr_c14 (ji,jj)
@@ -282,5 +282,5 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-#if ! defined key_off_degrad
+#if ! defined key_degrad
                ztra = trn(ji,jj,jk,jpc14) * xaccum
 #else
@@ -288,5 +288,5 @@
 #endif
                tra(ji,jj,jk,jpc14) = tra(ji,jj,jk,jpc14) - ztra / rdt
-#if defined key_trc_dia3d
+#if defined key_diatrc
                ! Save 3D diagnostics
 # if ! defined key_iomput
@@ -300,13 +300,13 @@
       END DO
 
-#if defined key_trc_diaadd  && defined key_iomput
+#if defined key_diatrc  && defined key_iomput
       CALL iom_put( "qtrC14b"  , qtr_c14  )
       CALL iom_put( "qintC14b" , qint_c14 )
 #endif
-#if defined key_trc_dia3d  && defined key_iomput
+#if defined key_diatrc  && defined key_iomput
       CALL iom_put( "fdecay" , zw3d )
 #endif
       IF( l_trdtrc ) THEN
-         CALL trd_mod_trc( tra(:,:,:,jpc14), jpc14, jptrc_trd_sms, kt )   ! save trends
+         CALL trd_mod_trc( tra(:,:,:,jpc14), jpc14, jptra_trd_sms, kt )   ! save trends
       END IF
 
Index: trunk/NEMOGCM/NEMO/TOP_SRC/CFC/par_cfc.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/CFC/par_cfc.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/CFC/par_cfc.F90	(revision 2528)
@@ -6,7 +6,7 @@
    !! History :   2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
    USE par_lobster, ONLY : jp_lobster      !: number of tracers in LOBSTER
Index: trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcctl_cfc.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcctl_cfc.F90	(revision 2527)
+++ 	(revision )
@@ -1,92 +1,0 @@
-MODULE trcctl_cfc
-   !!======================================================================
-   !!                         ***  trcctl.cfc.F90  ***
-   !! TOP :                Control of CFC chemical model
-   !!======================================================================
-   !!----------------------------------------------------------------------
-   !! History :   1.0  !  2005-10 (C. Ethe) assign a parameter to name individual tracers
-   !!----------------------------------------------------------------------
-
-#if defined key_cfc
-
-   USE oce_trc
-   USE trc
-
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC trc_ctl_cfc      ! called by ???
-
-   !!----------------------------------------------------------------------
-   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE trc_ctl_cfc
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE trc_ctl_cfc  ***
-      !!
-      !! ** Purpose :   control the cpp options, namelist and files 
-      !!----------------------------------------------------------------------
-      INTEGER :: jl, jn
-
-      IF(lwp) THEN
-          WRITE(numout,*) ' CFC Model '
-          WRITE(numout,*) ' '
-      ENDIF
-
-      ! Check number of tracers
-      ! -----------------------   
-      IF( jp_cfc > 2 ) CALL ctl_stop( ' change jp_cfc to 1 or 2 in par_cfc.F90.' )
-
-      ! Check tracer names
-      ! ------------------
-      ctrcnm(jpc11) = 'CFC11'
-      ctrcnl(jpc11) = 'Chlorofuorocarbone 11 concentration'
-
-      IF ( jp_cfc == 2 ) THEN
-          ctrcnm(jpc12) = 'CFC12'
-          ctrcnl(jpc12) = 'Chlorofuorocarbone 12 concentration'
-      ENDIF
-
-      IF(lwp) THEN
-         CALL ctl_warn( ' We force tracer names ' )
-         DO jl = 1, jp_cfc
-            jn = jp_cfc0 + jl - 1
-            WRITE(numout,*) ' tracer nb: ',jn,' name = ',ctrcnm(jn), ctrcnl(jn)
-         END DO
-         WRITE(numout,*) ' '
-      ENDIF
-
-
-      ! Check tracer units
-      ! ------------------
-      DO jl = 1, jp_cfc
-         jn = jp_cfc0 + jl - 1
-        IF( ctrcun(jn) /= 'mole/m3' ) THEN
-            ctrcun(jn) = 'mole/m3'
-            IF(lwp) THEN
-               CALL ctl_warn( ' We force tracer units ' )
-               WRITE(numout,*) ' tracer  ',ctrcnm(jn), 'UNIT= ',ctrcun(jn)
-               WRITE(numout,*) ' '
-            ENDIF 
-         ENDIF 
-      END DO              
-      !
-   END SUBROUTINE trc_ctl_cfc
-
-#else
-   !!----------------------------------------------------------------------
-   !!  Empty module :                                                No CFC
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE trc_ctl_cfc                      ! Dummy routine
-   END SUBROUTINE trc_ctl_cfc
-#endif
-
-   !!======================================================================
-END MODULE trcctl_cfc
Index: trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcini_cfc.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcini_cfc.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcini_cfc.F90	(revision 2528)
@@ -30,7 +30,7 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trclsm_cfc.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trclsm_cfc.F90	(revision 2527)
+++ 	(revision )
@@ -1,132 +1,0 @@
-MODULE trclsm_cfc
-   !!======================================================================
-   !!                         ***  MODULE trclsm_cfc  ***
-   !! TOP :   initialisation of some run parameters for CFC chemical model
-   !!======================================================================
-   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) from trclsm.cfc.h90
-   !!----------------------------------------------------------------------
-#if defined key_cfc
-   !!----------------------------------------------------------------------
-   !!   'key_cfc'                                               CFC tracers
-   !!----------------------------------------------------------------------
-   !! trc_lsm_cfc      : CFC model initialisation
-   !!----------------------------------------------------------------------
-   USE oce_trc         ! Ocean variables
-   USE par_trc         ! TOP parameters
-   USE trc             ! TOP variables
-   USE trcsms_cfc      ! CFC specific variable
-   USE in_out_manager  ! I/O manager
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   trc_lsm_cfc   ! called by trclsm.F90 module
-
-   !!----------------------------------------------------------------------
-   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE trc_lsm_cfc
-      !!-------------------------------------------------------------------
-      !!                  ***  ROUTINE trc_lsm_cfc  ***
-      !!                 
-      !! ** Purpose :   Definition some run parameter for CFC model
-      !!
-      !! ** Method  :   Read the namcfc namelist and check the parameter 
-      !!       values called at the first timestep (nit000)
-      !!
-      !! ** input   :   Namelist namcfc
-      !!----------------------------------------------------------------------
-      INTEGER ::   numnatc
-#if defined key_trc_diaadd && ! defined key_iomput
-      ! definition of additional diagnostic as a structure
-      INTEGER :: jl, jn
-      TYPE DIAG
-         CHARACTER(len = 20)  :: snamedia   !: short name
-         CHARACTER(len = 80 ) :: lnamedia   !: long name
-         CHARACTER(len = 20 ) :: unitdia    !: unit
-      END TYPE DIAG
-
-      TYPE(DIAG) , DIMENSION(jp_cfc_2d) :: cfcdia2d
-#endif
-      !!
-      NAMELIST/namcfcdate/ ndate_beg, nyear_res
-#if defined key_trc_diaadd && ! defined key_iomput
-      NAMELIST/namcfcdia/nwritedia, cfcdia2d     ! additional diagnostics
-#endif
-      !!-------------------------------------------------------------------
-
-      ndate_beg = 300101            ! default namelist value
-      nyear_res = 1950
-
-      !                             ! Open namelist file
-      CALL ctl_opn( numnatc, 'namelist_cfc', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
-         
-      READ( numnatc , namcfcdate )     ! read namelist
-
-      IF(lwp) THEN                  ! control print
-         WRITE(numout,*)
-         WRITE(numout,*) ' trc_lsm: Read namdates, namelist for CFC chemical model'
-         WRITE(numout,*) ' ~~~~~~~'
-         WRITE(numout,*) '    initial calendar date (aammjj) for CFC  ndate_beg = ', ndate_beg
-         WRITE(numout,*) '    restoring time constant (year)          nyear_res = ', nyear_res
-      ENDIF
-      nyear_beg = ndate_beg / 10000
-      IF(lwp) WRITE(numout,*) '    initial year (aa)                       nyear_beg = ', nyear_beg
-      !
-#if defined key_trc_diaadd && ! defined key_iomput
-
-      ! Namelist namcfcdia
-      ! -------------------
-      nwritedia = 10                   ! default values
-
-      DO jl = 1, jp_cfc_2d
-         jn = jp_cfc0_2d + jl - 1 
-         WRITE(ctrc2d(jn),'("2D_",I1)') jn                      ! short name
-         WRITE(ctrc2l(jn),'("2D DIAGNOSTIC NUMBER ",I2)') jn    ! long name
-         ctrc2u(jn) = ' '                                       ! units
-      END DO
-
-      REWIND( numnatc )               ! read natrtd
-      READ  ( numnatc, namcfcdia )
-
-      DO jl = 1, jp_cfc_2d
-         jn = jp_cfc0_2d + jl - 1
-         ctrc2d(jn) = cfcdia2d(jl)%snamedia
-         ctrc2l(jn) = cfcdia2d(jl)%lnamedia
-         ctrc2u(jn) = cfcdia2d(jl)%unitdia
-      END DO
-
-
-      IF(lwp) THEN                   ! control print
-         WRITE(numout,*)
-         WRITE(numout,*) ' Namelist : natadd'
-         WRITE(numout,*) '    frequency of outputs for additional arrays nwritedia = ', nwritedia
-         DO jl = 1, jp_cfc_2d
-            jn = jp_cfc0_2d + jl - 1
-            WRITE(numout,*) '   2d output field No : ',jn
-            WRITE(numout,*) '   short name         : ', TRIM(ctrc2d(jn))
-            WRITE(numout,*) '   long name          : ', TRIM(ctrc2l(jn))
-            WRITE(numout,*) '   unit               : ', TRIM(ctrc2u(jn))
-            WRITE(numout,*) ' '
-         END DO
-      ENDIF
-#endif
-
-   END SUBROUTINE trc_lsm_cfc
-   
-#else
-   !!----------------------------------------------------------------------
-   !!  Dummy module :                                                No CFC
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE trc_lsm_cfc                      ! Empty routine
-   END  SUBROUTINE  trc_lsm_cfc
-#endif  
-
-   !!======================================================================
-END MODULE trclsm_cfc
Index: trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcnam_cfc.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcnam_cfc.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcnam_cfc.F90	(revision 2528)
@@ -0,0 +1,132 @@
+MODULE trcnam_cfc
+   !!======================================================================
+   !!                         ***  MODULE trcnam_cfc  ***
+   !! TOP :   initialisation of some run parameters for CFC chemical model
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) from trcnam.cfc.h90
+   !!----------------------------------------------------------------------
+#if defined key_cfc
+   !!----------------------------------------------------------------------
+   !!   'key_cfc'                                               CFC tracers
+   !!----------------------------------------------------------------------
+   !! trc_nam_cfc      : CFC model initialisation
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! Ocean variables
+   USE par_trc         ! TOP parameters
+   USE trc             ! TOP variables
+   USE trcsms_cfc      ! CFC specific variable
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_nam_cfc   ! called by trcnam.F90 module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_nam_cfc
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_nam_cfc  ***
+      !!                 
+      !! ** Purpose :   Definition some run parameter for CFC model
+      !!
+      !! ** Method  :   Read the namcfc namelist and check the parameter 
+      !!       values called at the first timestep (nit000)
+      !!
+      !! ** input   :   Namelist namcfc
+      !!----------------------------------------------------------------------
+      INTEGER ::   numnatc
+#if defined key_diatrc && ! defined key_iomput
+      ! definition of additional diagnostic as a structure
+      INTEGER :: jl, jn
+      TYPE DIAG
+         CHARACTER(len = 20)  :: snamedia   !: short name
+         CHARACTER(len = 80 ) :: lnamedia   !: long name
+         CHARACTER(len = 20 ) :: unitdia    !: unit
+      END TYPE DIAG
+
+      TYPE(DIAG) , DIMENSION(jp_cfc_2d) :: cfcdia2d
+#endif
+      !!
+      NAMELIST/namcfcdate/ ndate_beg, nyear_res
+#if defined key_diatrc && ! defined key_iomput
+      NAMELIST/namcfcdia/nwritedia, cfcdia2d     ! additional diagnostics
+#endif
+      !!-------------------------------------------------------------------
+
+      ndate_beg = 300101            ! default namelist value
+      nyear_res = 1950
+
+      !                             ! Open namelist file
+      CALL ctl_opn( numnatc, 'namelist_cfc', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+         
+      READ( numnatc , namcfcdate )     ! read namelist
+
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) ' trc_nam: Read namdates, namelist for CFC chemical model'
+         WRITE(numout,*) ' ~~~~~~~'
+         WRITE(numout,*) '    initial calendar date (aammjj) for CFC  ndate_beg = ', ndate_beg
+         WRITE(numout,*) '    restoring time constant (year)          nyear_res = ', nyear_res
+      ENDIF
+      nyear_beg = ndate_beg / 10000
+      IF(lwp) WRITE(numout,*) '    initial year (aa)                       nyear_beg = ', nyear_beg
+      !
+#if defined key_diatrc && ! defined key_iomput
+
+      ! Namelist namcfcdia
+      ! -------------------
+      nwritedia = 10                   ! default values
+
+      DO jl = 1, jp_cfc_2d
+         jn = jp_cfc0_2d + jl - 1 
+         WRITE(ctrc2d(jn),'("2D_",I1)') jn                      ! short name
+         WRITE(ctrc2l(jn),'("2D DIAGNOSTIC NUMBER ",I2)') jn    ! long name
+         ctrc2u(jn) = ' '                                       ! units
+      END DO
+
+      REWIND( numnatc )               ! read natrtd
+      READ  ( numnatc, namcfcdia )
+
+      DO jl = 1, jp_cfc_2d
+         jn = jp_cfc0_2d + jl - 1
+         ctrc2d(jn) = cfcdia2d(jl)%snamedia
+         ctrc2l(jn) = cfcdia2d(jl)%lnamedia
+         ctrc2u(jn) = cfcdia2d(jl)%unitdia
+      END DO
+
+
+      IF(lwp) THEN                   ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) ' Namelist : natadd'
+         WRITE(numout,*) '    frequency of outputs for additional arrays nwritedia = ', nwritedia
+         DO jl = 1, jp_cfc_2d
+            jn = jp_cfc0_2d + jl - 1
+            WRITE(numout,*) '   2d output field No : ',jn
+            WRITE(numout,*) '   short name         : ', TRIM(ctrc2d(jn))
+            WRITE(numout,*) '   long name          : ', TRIM(ctrc2l(jn))
+            WRITE(numout,*) '   unit               : ', TRIM(ctrc2u(jn))
+            WRITE(numout,*) ' '
+         END DO
+      ENDIF
+#endif
+
+   END SUBROUTINE trc_nam_cfc
+   
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                                No CFC
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_nam_cfc                      ! Empty routine
+   END  SUBROUTINE  trc_nam_cfc
+#endif  
+
+   !!======================================================================
+END MODULE trcnam_cfc
Index: trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90	(revision 2528)
@@ -18,6 +18,6 @@
    USE par_trc      ! TOP parameters
    USE trc          ! TOP variables
-   USE trdmld_trc_oce
-   USE trdmld_trc
+   USE trdmod_oce
+   USE trdmod_trc
    USE iom
 
@@ -34,6 +34,6 @@
    INTEGER , PUBLIC    ::   npyear         ! Number of years read in CFC1112 file
    
-   REAL(wp), PUBLIC, DIMENSION(jpyear,jphem,2     ) ::   p_cfc    ! partial hemispheric pressure for CFC          
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)             ::   xphem    ! spatial interpolation factor for patm
+   REAL(wp), PUBLIC, DIMENSION(jpyear,jphem, 2    ) ::   p_cfc    ! partial hemispheric pressure for CFC          
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)              ::   xphem    ! spatial interpolation factor for patm
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj     ,jp_cfc) ::   qtr_cfc  ! flux at surface
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj     ,jp_cfc) ::   qint_cfc ! cumulative flux 
@@ -52,7 +52,7 @@
 #  include "top_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -93,5 +93,5 @@
       !!----------------------------------------------------------------------
 
-      IF( kt == nittrc000 )   CALL trc_cfc_cst
+      IF( kt == nit000 )   CALL trc_cfc_cst
 
       ! Temporal interpolation
@@ -129,8 +129,8 @@
                ! coefficient for solubility for CFC-11/12 in  mol/l/atm
                IF( tmask(ji,jj,1) .GE. 0.5 ) THEN
-                  ztap  = ( tn(ji,jj,1) + 273.16 ) * 0.01
+                  ztap  = ( tsn(ji,jj,1,jp_tem) + 273.16 ) * 0.01
                   zdtap = sob(1,jl) + ztap * ( sob(2,jl) + ztap * sob(3,jl) ) 
                   zsol  =  EXP( soa(1,jl) + soa(2,jl) / ztap + soa(3,jl) * LOG( ztap )   &
-                     &                    + soa(4,jl) * ztap * ztap + sn(ji,jj,1) * zdtap ) 
+                     &                    + soa(4,jl) * ztap * ztap + tsn(ji,jj,1,jp_sal) * zdtap ) 
                ELSE
                   zsol  = 0.e0
@@ -143,5 +143,5 @@
                ! Computation of speed transfert
                !    Schmidt number
-               zt1  = tn(ji,jj,1)
+               zt1  = tsn(ji,jj,1,jp_tem)
                zt2  = zt1 * zt1 
                zt3  = zt1 * zt2
@@ -156,5 +156,5 @@
                ! trn in pico-mol/l idem qtr; ak in en m/s
                qtr_cfc(ji,jj,jl) = -zak_cfc * ( trb(ji,jj,1,jn) - zca_cfc )   &
-#if defined key_off_degrad
+#if defined key_degrad
                   &                         * facvol(ji,jj,1)                           &
 #endif
@@ -173,5 +173,5 @@
       !                                                     !----------------!
 
-#if defined key_trc_diaadd 
+#if defined key_diatrc 
       ! Save diagnostics , just for CFC11
 # if ! defined key_iomput
@@ -187,5 +187,5 @@
           DO jn = jp_cfc0, jp_cfc1
             ztrcfc(:,:,:) = tra(:,:,:,jn)
-            CALL trd_mod_trc( ztrcfc, jn, jptrc_trd_sms, kt )   ! save trends
+            CALL trd_mod_trc( ztrcfc, jn, jptra_trd_sms, kt )   ! save trends
           END DO
       END IF
Index: trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/par_lobster.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/par_lobster.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/par_lobster.F90	(revision 2528)
@@ -6,7 +6,7 @@
    !! History :   2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -19,15 +19,15 @@
    LOGICAL, PUBLIC, PARAMETER ::   lk_lobster     = .TRUE.    !: LOBSTER flag 
    INTEGER, PUBLIC, PARAMETER ::   jp_lobster     =  6        !: number of LOBSTER tracers
-   INTEGER, PUBLIC, PARAMETER ::   jp_lobster_2d  = 19        !: additional 2d output arrays ('key_trc_diaadd')
-   INTEGER, PUBLIC, PARAMETER ::   jp_lobster_3d  =  3        !: additional 3d output arrays ('key_trc_diaadd')
+   INTEGER, PUBLIC, PARAMETER ::   jp_lobster_2d  = 19        !: additional 2d output arrays ('key_diatrc')
+   INTEGER, PUBLIC, PARAMETER ::   jp_lobster_3d  =  3        !: additional 3d output arrays ('key_diatrc')
    INTEGER, PUBLIC, PARAMETER ::   jp_lobster_trd = 17       !: number of sms trends for LOBSTER
 
    ! assign an index in trc arrays for each LOBSTER prognostic variables
-   INTEGER, PUBLIC, PARAMETER ::   jpdet          =  1        !: detritus                    [mmoleN/m3]
-   INTEGER, PUBLIC, PARAMETER ::   jpzoo          =  2        !: zooplancton concentration   [mmoleN/m3]
-   INTEGER, PUBLIC, PARAMETER ::   jpphy          =  3        !: phytoplancton concentration [mmoleN/m3]
-   INTEGER, PUBLIC, PARAMETER ::   jpno3          =  4        !: nitrate concentration       [mmoleN/m3]
-   INTEGER, PUBLIC, PARAMETER ::   jpnh4          =  5        !: ammonium concentration      [mmoleN/m3]
-   INTEGER, PUBLIC, PARAMETER ::   jpdom          =  6        !: dissolved organic matter    [mmoleN/m3]
+   INTEGER, PUBLIC, PARAMETER ::   jp_lob_det     =  1        !: detritus                    [mmoleN/m3]
+   INTEGER, PUBLIC, PARAMETER ::   jp_lob_zoo     =  2        !: zooplancton concentration   [mmoleN/m3]
+   INTEGER, PUBLIC, PARAMETER ::   jp_lob_phy     =  3        !: phytoplancton concentration [mmoleN/m3]
+   INTEGER, PUBLIC, PARAMETER ::   jp_lob_no3     =  4        !: nitrate concentration       [mmoleN/m3]
+   INTEGER, PUBLIC, PARAMETER ::   jp_lob_nh4     =  5        !: ammonium concentration      [mmoleN/m3]
+   INTEGER, PUBLIC, PARAMETER ::   jp_lob_dom     =  6        !: dissolved organic matter    [mmoleN/m3]
 
    ! productive layer depth
Index: trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/sms_lobster.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/sms_lobster.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/sms_lobster.F90	(revision 2528)
@@ -23,7 +23,7 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
Index: trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcbio.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcbio.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcbio.F90	(revision 2528)
@@ -20,6 +20,6 @@
    USE lbclnk          ! 
    USE prtctl_trc      ! Print control for debbuging
-   USE trdmld_trc
-   USE trdmld_trc_oce
+   USE trdmod_oce
+   USE trdmod_trc
    USE iom
    
@@ -32,7 +32,7 @@
 #  include "top_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -57,5 +57,5 @@
       !!                                  source      sink
       !!        
-      !!              IF 'key_trc_diabio' defined , the biogeochemical trends
+      !!              IF 'key_diabio' defined , the biogeochemical trends
       !!              for passive tracers are saved for futher diagnostics.
       !!---------------------------------------------------------------------
@@ -71,12 +71,10 @@
       REAL(wp) ::   zfilpz, zfildz, zphya, zzooa, zno3a
       REAL(wp) ::   znh4a, zdeta, zdoma, zzoobod, zboddet, zdomaju
-#if defined key_trc_diaadd
+#if defined key_diatrc
       REAL(wp) ::   ze3t
 #endif
-#if defined key_trc_diaadd && defined key_iomput
+#if defined key_diatrc && defined key_iomput
       REAL(wp), DIMENSION(jpi,jpj,17)     :: zw2d
-# if defined key_trc_dia3d
       REAL(wp), DIMENSION(jpi,jpj,jpk,3) :: zw3d
-# endif
 #endif
       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   ztrbio
@@ -91,14 +89,12 @@
 
       fbod(:,:) = 0.e0
-#if defined key_trc_diaadd && ! defined key_iomput
+#if defined key_diatrc && ! defined key_iomput
       DO jl = jp_lob0_2d, jp_lob1_2d
          trc2d(:,:,jl) = 0.e0
       END DO 
 #endif
-#if defined key_trc_diaadd && defined key_iomput
+#if defined key_diatrc && defined key_iomput
       zw2d(:,:,:) = 0.e0
-# if defined key_trc_dia3d
       zw3d(:,:,:,:) = 0.e0
-# endif
 #endif
 
@@ -117,10 +113,10 @@
 
                ! negative trophic variables DO not contribute to the fluxes
-               zdet = MAX( 0.e0, trn(ji,jj,jk,jpdet) )
-               zzoo = MAX( 0.e0, trn(ji,jj,jk,jpzoo) )
-               zphy = MAX( 0.e0, trn(ji,jj,jk,jpphy) )
-               zno3 = MAX( 0.e0, trn(ji,jj,jk,jpno3) )
-               znh4 = MAX( 0.e0, trn(ji,jj,jk,jpnh4) )
-               zdom = MAX( 0.e0, trn(ji,jj,jk,jpdom) )
+               zdet = MAX( 0.e0, trn(ji,jj,jk,jp_lob_det) )
+               zzoo = MAX( 0.e0, trn(ji,jj,jk,jp_lob_zoo) )
+               zphy = MAX( 0.e0, trn(ji,jj,jk,jp_lob_phy) )
+               zno3 = MAX( 0.e0, trn(ji,jj,jk,jp_lob_no3) )
+               znh4 = MAX( 0.e0, trn(ji,jj,jk,jp_lob_nh4) )
+               zdom = MAX( 0.e0, trn(ji,jj,jk,jp_lob_dom) )
 
                ! Limitations
@@ -194,12 +190,12 @@
 
                ! tracer flux at totox-point added to the general trend
-               tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + zdeta
-               tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) + zzooa
-               tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zphya
-               tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zno3a
-               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + znh4a
-               tra(ji,jj,jk,jpdom) = tra(ji,jj,jk,jpdom) + zdoma
-
-#if defined key_trc_diabio
+               tra(ji,jj,jk,jp_lob_det) = tra(ji,jj,jk,jp_lob_det) + zdeta
+               tra(ji,jj,jk,jp_lob_zoo) = tra(ji,jj,jk,jp_lob_zoo) + zzooa
+               tra(ji,jj,jk,jp_lob_phy) = tra(ji,jj,jk,jp_lob_phy) + zphya
+               tra(ji,jj,jk,jp_lob_no3) = tra(ji,jj,jk,jp_lob_no3) + zno3a
+               tra(ji,jj,jk,jp_lob_nh4) = tra(ji,jj,jk,jp_lob_nh4) + znh4a
+               tra(ji,jj,jk,jp_lob_dom) = tra(ji,jj,jk,jp_lob_dom) + zdoma
+
+#if defined key_diabio
                trbio(ji,jj,jk,jp_lob0_trd     ) = zno3phy
                trbio(ji,jj,jk,jp_lob0_trd +  1) = znh4phy
@@ -238,5 +234,5 @@
                 ENDIF
 
-#if defined key_trc_diaadd
+#if defined key_diatrc
                ! convert fluxes in per day
                ze3t = fse3t(ji,jj,jk) * 86400.
@@ -282,5 +278,5 @@
                zw2d(ji,jj,17) = zw2d(ji,jj,17) + zdetdom * ze3t
 #endif
-#if defined key_trc_dia3d 
+#if defined key_diatrc 
 # if ! defined key_iomput
                trc3d(ji,jj,jk,jp_lob0_3d    ) = zno3phy * 86400     
@@ -307,10 +303,10 @@
                !    trophic variables( det, zoo, phy, no3, nh4, dom)
                !       negative trophic variables DO not contribute to the fluxes
-               zdet = MAX( 0.e0, trn(ji,jj,jk,jpdet) )
-               zzoo = MAX( 0.e0, trn(ji,jj,jk,jpzoo) )
-               zphy = MAX( 0.e0, trn(ji,jj,jk,jpphy) )
-               zno3 = MAX( 0.e0, trn(ji,jj,jk,jpno3) )
-               znh4 = MAX( 0.e0, trn(ji,jj,jk,jpnh4) )
-               zdom = MAX( 0.e0, trn(ji,jj,jk,jpdom) )
+               zdet = MAX( 0.e0, trn(ji,jj,jk,jp_lob_det) )
+               zzoo = MAX( 0.e0, trn(ji,jj,jk,jp_lob_zoo) )
+               zphy = MAX( 0.e0, trn(ji,jj,jk,jp_lob_phy) )
+               zno3 = MAX( 0.e0, trn(ji,jj,jk,jp_lob_no3) )
+               znh4 = MAX( 0.e0, trn(ji,jj,jk,jp_lob_nh4) )
+               zdom = MAX( 0.e0, trn(ji,jj,jk,jp_lob_dom) )
 
                !    Limitations
@@ -363,12 +359,12 @@
 
                ! tracer flux at totox-point added to the general trend
-               tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + zdeta
-               tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) + zzooa
-               tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zphya
-               tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zno3a
-               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + znh4a
-               tra(ji,jj,jk,jpdom) = tra(ji,jj,jk,jpdom) + zdoma
+               tra(ji,jj,jk,jp_lob_det) = tra(ji,jj,jk,jp_lob_det) + zdeta
+               tra(ji,jj,jk,jp_lob_zoo) = tra(ji,jj,jk,jp_lob_zoo) + zzooa
+               tra(ji,jj,jk,jp_lob_phy) = tra(ji,jj,jk,jp_lob_phy) + zphya
+               tra(ji,jj,jk,jp_lob_no3) = tra(ji,jj,jk,jp_lob_no3) + zno3a
+               tra(ji,jj,jk,jp_lob_nh4) = tra(ji,jj,jk,jp_lob_nh4) + znh4a
+               tra(ji,jj,jk,jp_lob_dom) = tra(ji,jj,jk,jp_lob_dom) + zdoma
                !
-#if defined key_trc_diabio
+#if defined key_diabio
                trbio(ji,jj,jk,jp_lob0_trd     ) = zno3phy
                trbio(ji,jj,jk,jp_lob0_trd +  1) = znh4phy
@@ -406,5 +402,5 @@
                   !  trend number 17 in trcexp
                 ENDIF
-#if defined key_trc_diaadd && defined key_trc_dia3d
+#if defined key_diatrc
 # if ! defined key_iomput
                trc3d(ji,jj,jk,jp_lob0_3d    ) =  zno3phy * 86400     
@@ -421,5 +417,5 @@
       END DO
 
-#if defined key_trc_diaadd
+#if defined key_diatrc
       ! Lateral boundary conditions 
 # if ! defined key_iomput
@@ -452,5 +448,5 @@
 #endif
 
-#if defined key_trc_diaadd && defined key_trc_dia3d
+#if defined key_diatrc
       ! Lateral boundary conditions 
 # if ! defined key_iomput
@@ -469,5 +465,5 @@
 #endif
 
-#if defined key_trc_diabio
+#if defined key_diabio
       ! Lateral boundary conditions on trcbio
       DO jl = jp_lob0_trd, jp_lob1_trd
Index: trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcctl_lobster.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcctl_lobster.F90	(revision 2527)
+++ 	(revision )
@@ -1,101 +1,0 @@
-MODULE trcctl_lobster
-   !!======================================================================
-   !!                         ***  trcctl_lobster.F90  ***
-   !! TOP :                Control of LOBSTER biological model
-   !!======================================================================
-   !!----------------------------------------------------------------------
-   !! History :   1.0  !  2000-12 (E. Kestenare) assign a parameter to name individual tracers
-   !!----------------------------------------------------------------------
-
-#if defined key_lobster
-
-   USE oce_trc
-   USE trc
-
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC trc_ctl_lobster     ! called by ???
-
-   !!----------------------------------------------------------------------
-   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE trc_ctl_lobster
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE trc_ctl_lobster  ***
-      !!
-      !! ** Purpose :   control the cpp options, namelist and files 
-      !!----------------------------------------------------------------------
-      INTEGER :: jl, jn
-
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) ' use LOBSTER biological model '
-
-      ! Check number of tracers
-      ! -----------------------
-      IF( jp_lobster /= 6 ) CALL ctl_stop( ' LOBSTER has 6 passive tracers. Change jp_lobster in par_lobster.F90' )
-
-      ! Check tracer names
-      ! ------------------
-      IF(   ctrcnm(jpdet) /= 'DET' .OR. ctrcnm(jpzoo) /= 'ZOO' .OR.   &
-         &  ctrcnm(jpphy) /= 'PHY' .OR. ctrcnm(jpno3) /= 'NO3' .OR.   &
-         &  ctrcnm(jpnh4) /= 'NH4' .OR. ctrcnm(jpdom) /= 'DOM' .OR.   &
-         &  ctrcnl(jpdet) /= 'Detritus'                        .OR.   &
-         &  ctrcnl(jpzoo) /= 'Zooplankton concentration'       .OR.   &
-         &  ctrcnl(jpphy) /= 'Phytoplankton concentration'     .OR.   &
-         &  ctrcnl(jpno3) /= 'Nitrate concentration'           .OR.   &
-         &  ctrcnl(jpnh4) /= 'Ammonium concentration'          .OR.   &
-         &  ctrcnl(jpdom) /= 'Dissolved organic matter' ) THEN
-         ctrcnm(jpdet)='DET'
-         ctrcnl(jpdet)='Detritus'
-         ctrcnm(jpzoo)='ZOO'
-         ctrcnl(jpzoo)='Zooplankton concentration'
-         ctrcnm(jpphy)='PHY'
-         ctrcnl(jpphy)='Phytoplankton concentration'
-         ctrcnm(jpno3)='NO3'
-         ctrcnl(jpno3)='Nitrate concentration'
-         ctrcnm(jpnh4)='NH4'
-         ctrcnl(jpnh4)='Ammonium concentration'
-         ctrcnm(jpdom)='DOM'
-         ctrcnl(jpdom)='Dissolved organic matter'
-         IF(lwp) THEN
-            CALL ctl_warn( ' We force tracer names ' )
-            DO jl = 1, jp_lobster
-               jn = jp_lob0 + jl - 1
-               WRITE(numout,*) ' tracer nb: ',jn,' name = ',ctrcnm(jn), ctrcnl(jn)
-            END DO
-            WRITE(numout,*) ' '
-         ENDIF
-      ENDIF
-
-      ! Check tracer units
-      DO jl = 1, jp_lobster
-         jn = jp_lob0 + jl - 1
-         IF( ctrcun(jn) /= 'mmole-N/m3') THEN
-            ctrcun(jn) = 'mmole-N/m3'
-            IF(lwp) THEN
-               CALL ctl_warn( ' We force tracer units ' )
-               WRITE(numout,*) ' tracer  ',ctrcnm(jn), 'UNIT= ',ctrcun(jn)
-            ENDIF
-         ENDIF
-      END DO
-
-   END SUBROUTINE trc_ctl_lobster
-
-#else
-   !!----------------------------------------------------------------------
-   !!  Empty module :                                          No LOBSTER
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE trc_ctl_lobster                 ! Dummy routine
-   END SUBROUTINE trc_ctl_lobster
-#endif
-
-   !!======================================================================
-END MODULE trcctl_lobster
Index: trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcexp.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcexp.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcexp.F90	(revision 2528)
@@ -19,8 +19,8 @@
    USE lbclnk
    USE trc
-   USE trctrp_lec
+   USE trcnam_trp
    USE prtctl_trc      ! Print control for debbuging
-   USE trdmld_trc
-   USE trdmld_trc_oce
+   USE trdmod_oce
+   USE trdmod_trc
    USE iom
 
@@ -33,7 +33,7 @@
 #  include "top_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -55,6 +55,6 @@
       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index      
       !!
-      INTEGER  ::   ji, jj, jk, jl, ikbot
-      REAL(wp) ::   zgeolpoc, zfact, zwork, ze3t
+      INTEGER  ::   ji, jj, jk, jl, ikt
+      REAL(wp) ::   zgeolpoc, zfact, zwork, ze3t, zsedpocd
       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrbio
       CHARACTER (len=25) :: charout
@@ -75,5 +75,5 @@
       IF( l_trdtrc )THEN
          ALLOCATE( ztrbio(jpi,jpj,jpk) )
-         ztrbio(:,:,:) = tra(:,:,:,jpno3)
+         ztrbio(:,:,:) = tra(:,:,:,jp_lob_no3)
       ENDIF
 
@@ -82,5 +82,5 @@
             DO ji = fs_2, fs_jpim1
                ze3t = 1. / fse3t(ji,jj,jk)
-               tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + ze3t * dmin3(ji,jj,jk) * fbod(ji,jj)
+               tra(ji,jj,jk,jp_lob_no3) = tra(ji,jj,jk,jp_lob_no3) + ze3t * dmin3(ji,jj,jk) * fbod(ji,jj)
             END DO
          END DO
@@ -95,8 +95,8 @@
       DO jj = 2, jpjm1
          DO ji = fs_2, fs_jpim1
-            ikbot = mbathy(ji,jj) - 1
-            tra(ji,jj,ikbot,jpno3) = tra(ji,jj,ikbot,jpno3) + sedlam * sedpocn(ji,jj) / fse3t(ji,jj,ikbot) 
+            ikt = mbkt(ji,jj) 
+            tra(ji,jj,ikt,jp_lob_no3) = tra(ji,jj,ikt,jp_lob_no3) + sedlam * sedpocn(ji,jj) / fse3t(ji,jj,ikt) 
             ! Deposition of organic matter in the sediment
-            zwork = vsed * trn(ji,jj,ikbot,jpdet)
+            zwork = vsed * trn(ji,jj,ikt,jp_lob_det)
             sedpoca(ji,jj) = ( zwork + dminl(ji,jj) * fbod(ji,jj)   &
                &           - sedlam * sedpocn(ji,jj) - sedlostpoc * sedpocn(ji,jj) ) * rdt
@@ -107,5 +107,5 @@
       DO jj = 2, jpjm1
          DO ji = fs_2, fs_jpim1
-            tra(ji,jj,1,jpno3) = tra(ji,jj,1,jpno3) + zgeolpoc * cmask(ji,jj) / areacot / fse3t(ji,jj,1)
+            tra(ji,jj,1,jp_lob_no3) = tra(ji,jj,1,jp_lob_no3) + zgeolpoc * cmask(ji,jj) / areacot / fse3t(ji,jj,1)
          END DO
       END DO
@@ -114,5 +114,5 @@
  
       ! Oa & Ek: diagnostics depending on jpdia2d !          left as example
-#if defined key_trc_diaadd
+#if defined key_diatrc
 # if ! defined key_iomput
       trc2d(:,:,jp_lob0_2d + 18) = sedpocn(:,:)
@@ -122,42 +122,26 @@
 #endif
 
-      ! Leap-frog scheme (only in explicit case, otherwise the 
-      ! ----------------  time stepping is already done in trczdf)
-      IF( l_trczdf_exp .AND. (ln_trcadv_cen2 .OR. ln_trcadv_tvd) ) THEN
-         zfact = 2. * rdttra(jk) * FLOAT( ndttrc ) 
-         IF( neuler == 0 .AND. kt == nittrc000 )   zfact = rdttra(jk) * FLOAT(ndttrc) 
-         sedpoca(:,:) =  sedpocb(:,:) + zfact * sedpoca(:,:) 
-      ENDIF
-
       
       ! Time filter and swap of arrays
       ! ------------------------------
-      IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd  ) THEN         ! centred or tvd scheme
-         IF( neuler == 0 .AND. kt == nittrc000 ) THEN
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  sedpocb(ji,jj) = sedpocn(ji,jj)
-                  sedpocn(ji,jj) = sedpoca(ji,jj)
-                  sedpoca(ji,jj) = 0.e0
-               END DO
-            END DO
-         ELSE
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  sedpocb(ji,jj) = atfp  * ( sedpocb(ji,jj) + sedpoca(ji,jj) )    &
-                     &           + atfp1 *   sedpocn(ji,jj)
-                  sedpocn(ji,jj) = sedpoca(ji,jj)
-                  sedpoca(ji,jj) = 0.e0
-               END DO
-            END DO
-         ENDIF
-      ELSE                                                   !  case of smolar scheme or muscl
-         sedpocb(:,:) = sedpoca(:,:)
-         sedpocn(:,:) = sedpoca(:,:)
-         sedpoca(:,:) = 0.e0
+      IF( neuler == 0 .AND. kt == nit000 ) THEN        ! Euler time-stepping at first time-step
+        !                                             ! (only swap)
+        sedpocn(:,:) = sedpoca(:,:)
+        !                                              
+      ELSE
+        !
+        DO jj = 1, jpj
+           DO ji = 1, jpi
+              zsedpocd = sedpoca(ji,jj) - 2. * sedpocn(ji,jj) + sedpocb(ji,jj)      ! time laplacian on tracers
+              sedpocb(ji,jj) = sedpocn(ji,jj) + atfp * zsedpocd                     ! sedpocb <-- filtered sedpocn
+              sedpocn(ji,jj) = sedpoca(ji,jj)                                       ! sedpocn <-- sedpoca
+           END DO
+        END DO
+        ! 
       ENDIF
+      sedpoca(:,:) = 0.e0
       !
       IF( l_trdtrc ) THEN
-         ztrbio(:,:,:) = tra(:,:,:,jpno3) - ztrbio(:,:,:)
+         ztrbio(:,:,:) = tra(:,:,:,jp_lob_no3) - ztrbio(:,:,:)
          jl = jp_lob0_trd + 16
          CALL trd_mod_trc( ztrbio, jl, kt )   ! handle the trend
Index: trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcini_lobster.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcini_lobster.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcini_lobster.F90	(revision 2528)
@@ -20,4 +20,7 @@
    USE oce_trc         ! ocean variables
    USE trc
+   USE lbclnk 
+   USE lib_mpp 
+   USE lib_fortran 
 
    IMPLICIT NONE
@@ -28,7 +31,7 @@
 #  include "top_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -46,8 +49,11 @@
       !!----------------------------------------------------------------------
 
+      !  Control consitency
+      CALL trc_ctl_lobster
+
+
       IF(lwp) WRITE(numout,*)
       IF(lwp) WRITE(numout,*) ' trc_ini_lobster :   LOBSTER biochemical model initialisation'
       IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~'
-
 
       ! initialization of fields for optical model
@@ -118,5 +124,5 @@
       ! Coastal mask 
       ! ------------   
-      cmask = 0.e0
+      cmask(:,:) = 0.e0
       DO ji = 2, jpi-1
          DO jj = 2, jpj-1
@@ -128,18 +134,9 @@
       END DO
 
-      cmask( 1 ,:) = cmask(jpi-1,:)
-      cmask(jpi,:) = cmask( 2   ,:)
-
-      !!gm BUG !!!!!   not valid in mpp and also not valid for north fold   !!!!!
+      CALL lbc_lnk( cmask, 'T', 1. )
 
       ! Coastal surface
       ! ---------------
-      areacot = 0.e0
-      DO ji = 2, jpi-1
-         DO jj = 2, jpj-1
-            areacot = areacot + e1t(ji,jj) * e2t(ji,jj) * cmask(ji,jj)
-         END DO
-      END DO
-      !
+      areacot = glob_sum( e1t(:,:) * e2t(:,:) * cmask(:,:) )
 
       ! Initialization of tracer concentration in case of  no restart 
@@ -153,73 +150,73 @@
          
          DO jk = 1, 7
-            trn(:,:,jk,jpdet) = 0.016 * tmask(:,:,jk)
-            trn(:,:,jk,jpzoo) = 0.018 * tmask(:,:,jk)
-            trn(:,:,jk,jpphy) = 0.036 * tmask(:,:,jk) 
-            trn(:,:,jk,jpno3) = 1.e-5 * tmask(:,:,jk)
-            trn(:,:,jk,jpnh4) = 5.e-4 * tmask(:,:,jk)
-            trn(:,:,jk,jpdom) = 0.017 * tmask(:,:,jk)
-         END DO
-         
-         trn(:,:, 8,jpdet) = 0.020   * tmask(:,:, 8)
-         trn(:,:, 8,jpzoo) = 0.027   * tmask(:,:, 8)
-         trn(:,:, 8,jpphy) = 0.041   * tmask(:,:, 8)
-         trn(:,:, 8,jpno3) = 0.00022 * tmask(:,:, 8)
-         trn(:,:, 8,jpnh4) = 0.0033  * tmask(:,:, 8)
-         trn(:,:, 8,jpdom) = 0.021   * tmask(:,:, 8)
-         
-         trn(:,:, 9,jpdet) = 0.0556  * tmask(:,:, 9)
-         trn(:,:, 9,jpzoo) = 0.123   * tmask(:,:, 9)
-         trn(:,:, 9,jpphy) = 0.122   * tmask(:,:, 9)
-         trn(:,:, 9,jpno3) = 0.028   * tmask(:,:, 9)
-         trn(:,:, 9,jpnh4) = 0.024   * tmask(:,:, 9)
-         trn(:,:, 9,jpdom) = 0.06    * tmask(:,:, 9)
-         
-         trn(:,:,10,jpdet) = 0.025   * tmask(:,:,10)
-         trn(:,:,10,jpzoo) = 0.016   * tmask(:,:,10)
-         trn(:,:,10,jpphy) = 0.029   * tmask(:,:,10)
-         trn(:,:,10,jpno3) = 2.462   * tmask(:,:,10)
-         trn(:,:,10,jpnh4) = 0.04    * tmask(:,:,10)
-         trn(:,:,10,jpdom) = 0.022   * tmask(:,:,10)
-         
-         trn(:,:,11,jpdet) = 0.0057  * tmask(:,:,11)
-         trn(:,:,11,jpzoo) = 0.0005  * tmask(:,:,11)
-         trn(:,:,11,jpphy) = 0.0006  * tmask(:,:,11)
-         trn(:,:,11,jpno3) = 3.336   * tmask(:,:,11)
-         trn(:,:,11,jpnh4) = 0.005   * tmask(:,:,11)
-         trn(:,:,11,jpdom) = 0.004   * tmask(:,:,11)
-         
-         trn(:,:,12,jpdet) = 0.002   * tmask(:,:,12)
-         trn(:,:,12,jpzoo) = 1.e-6   * tmask(:,:,12)
-         trn(:,:,12,jpphy) = 5.e-6   * tmask(:,:,12)
-         trn(:,:,12,jpno3) = 4.24    * tmask(:,:,12)
-         trn(:,:,12,jpnh4) = 0.001   * tmask(:,:,12)
-         trn(:,:,12,jpdom) = 3.e-5   * tmask(:,:,12)
+            trn(:,:,jk,jp_lob_det) = 0.016 * tmask(:,:,jk)
+            trn(:,:,jk,jp_lob_zoo) = 0.018 * tmask(:,:,jk)
+            trn(:,:,jk,jp_lob_phy) = 0.036 * tmask(:,:,jk) 
+            trn(:,:,jk,jp_lob_no3) = 1.e-5 * tmask(:,:,jk)
+            trn(:,:,jk,jp_lob_nh4) = 5.e-4 * tmask(:,:,jk)
+            trn(:,:,jk,jp_lob_dom) = 0.017 * tmask(:,:,jk)
+         END DO
+         
+         trn(:,:, 8,jp_lob_det) = 0.020   * tmask(:,:, 8)
+         trn(:,:, 8,jp_lob_zoo) = 0.027   * tmask(:,:, 8)
+         trn(:,:, 8,jp_lob_phy) = 0.041   * tmask(:,:, 8)
+         trn(:,:, 8,jp_lob_no3) = 0.00022 * tmask(:,:, 8)
+         trn(:,:, 8,jp_lob_nh4) = 0.0033  * tmask(:,:, 8)
+         trn(:,:, 8,jp_lob_dom) = 0.021   * tmask(:,:, 8)
+         
+         trn(:,:, 9,jp_lob_det) = 0.0556  * tmask(:,:, 9)
+         trn(:,:, 9,jp_lob_zoo) = 0.123   * tmask(:,:, 9)
+         trn(:,:, 9,jp_lob_phy) = 0.122   * tmask(:,:, 9)
+         trn(:,:, 9,jp_lob_no3) = 0.028   * tmask(:,:, 9)
+         trn(:,:, 9,jp_lob_nh4) = 0.024   * tmask(:,:, 9)
+         trn(:,:, 9,jp_lob_dom) = 0.06    * tmask(:,:, 9)
+         
+         trn(:,:,10,jp_lob_det) = 0.025   * tmask(:,:,10)
+         trn(:,:,10,jp_lob_zoo) = 0.016   * tmask(:,:,10)
+         trn(:,:,10,jp_lob_phy) = 0.029   * tmask(:,:,10)
+         trn(:,:,10,jp_lob_no3) = 2.462   * tmask(:,:,10)
+         trn(:,:,10,jp_lob_nh4) = 0.04    * tmask(:,:,10)
+         trn(:,:,10,jp_lob_dom) = 0.022   * tmask(:,:,10)
+         
+         trn(:,:,11,jp_lob_det) = 0.0057  * tmask(:,:,11)
+         trn(:,:,11,jp_lob_zoo) = 0.0005  * tmask(:,:,11)
+         trn(:,:,11,jp_lob_phy) = 0.0006  * tmask(:,:,11)
+         trn(:,:,11,jp_lob_no3) = 3.336   * tmask(:,:,11)
+         trn(:,:,11,jp_lob_nh4) = 0.005   * tmask(:,:,11)
+         trn(:,:,11,jp_lob_dom) = 0.004   * tmask(:,:,11)
+         
+         trn(:,:,12,jp_lob_det) = 0.002   * tmask(:,:,12)
+         trn(:,:,12,jp_lob_zoo) = 1.e-6   * tmask(:,:,12)
+         trn(:,:,12,jp_lob_phy) = 5.e-6   * tmask(:,:,12)
+         trn(:,:,12,jp_lob_no3) = 4.24    * tmask(:,:,12)
+         trn(:,:,12,jp_lob_nh4) = 0.001   * tmask(:,:,12)
+         trn(:,:,12,jp_lob_dom) = 3.e-5   * tmask(:,:,12)
          
          DO jk=13,jpk
-            trn(:,:,jk,jpdet) = 0.e0
-            trn(:,:,jk,jpzoo) = 0.e0
-            trn(:,:,jk,jpphy) = 0.e0
-            trn(:,:,jk,jpnh4) = 0.e0
-            trn(:,:,jk,jpdom) = 0.e0
-         END DO
-         
-         trn(:,:,13,jpno3) = 5.31  * tmask(:,:,13)
-         trn(:,:,14,jpno3) = 6.73  * tmask(:,:,14)
-         trn(:,:,15,jpno3) = 8.32  * tmask(:,:,15)
-         trn(:,:,16,jpno3) = 10.13 * tmask(:,:,16)
-         trn(:,:,17,jpno3) = 11.95 * tmask(:,:,17)
-         trn(:,:,18,jpno3) = 13.57 * tmask(:,:,18)
-         trn(:,:,19,jpno3) = 15.08 * tmask(:,:,19)
-         trn(:,:,20,jpno3) = 16.41 * tmask(:,:,20)
-         trn(:,:,21,jpno3) = 17.47 * tmask(:,:,21)
-         trn(:,:,22,jpno3) = 18.29 * tmask(:,:,22)
-         trn(:,:,23,jpno3) = 18.88 * tmask(:,:,23)
-         trn(:,:,24,jpno3) = 19.30 * tmask(:,:,24)
-         trn(:,:,25,jpno3) = 19.68 * tmask(:,:,25)
-         trn(:,:,26,jpno3) = 19.91 * tmask(:,:,26)
-         trn(:,:,27,jpno3) = 19.99 * tmask(:,:,27)
-         trn(:,:,28,jpno3) = 20.01 * tmask(:,:,28)
-         trn(:,:,29,jpno3) = 20.01 * tmask(:,:,29)
-         trn(:,:,30,jpno3) = 20.01 * tmask(:,:,30)
+            trn(:,:,jk,jp_lob_det) = 0.e0
+            trn(:,:,jk,jp_lob_zoo) = 0.e0
+            trn(:,:,jk,jp_lob_phy) = 0.e0
+            trn(:,:,jk,jp_lob_nh4) = 0.e0
+            trn(:,:,jk,jp_lob_dom) = 0.e0
+         END DO
+         
+         trn(:,:,13,jp_lob_no3) = 5.31  * tmask(:,:,13)
+         trn(:,:,14,jp_lob_no3) = 6.73  * tmask(:,:,14)
+         trn(:,:,15,jp_lob_no3) = 8.32  * tmask(:,:,15)
+         trn(:,:,16,jp_lob_no3) = 10.13 * tmask(:,:,16)
+         trn(:,:,17,jp_lob_no3) = 11.95 * tmask(:,:,17)
+         trn(:,:,18,jp_lob_no3) = 13.57 * tmask(:,:,18)
+         trn(:,:,19,jp_lob_no3) = 15.08 * tmask(:,:,19)
+         trn(:,:,20,jp_lob_no3) = 16.41 * tmask(:,:,20)
+         trn(:,:,21,jp_lob_no3) = 17.47 * tmask(:,:,21)
+         trn(:,:,22,jp_lob_no3) = 18.29 * tmask(:,:,22)
+         trn(:,:,23,jp_lob_no3) = 18.88 * tmask(:,:,23)
+         trn(:,:,24,jp_lob_no3) = 19.30 * tmask(:,:,24)
+         trn(:,:,25,jp_lob_no3) = 19.68 * tmask(:,:,25)
+         trn(:,:,26,jp_lob_no3) = 19.91 * tmask(:,:,26)
+         trn(:,:,27,jp_lob_no3) = 19.99 * tmask(:,:,27)
+         trn(:,:,28,jp_lob_no3) = 20.01 * tmask(:,:,28)
+         trn(:,:,29,jp_lob_no3) = 20.01 * tmask(:,:,29)
+         trn(:,:,30,jp_lob_no3) = 20.01 * tmask(:,:,30)
 
 # elif defined key_gyre
@@ -227,16 +224,16 @@
          ! ----------------------
          ! here:  init NO3=f(density) by asklod AS Kremeur 2005-07
-         trn(:,:,:,jpdet) = 0.1 * tmask(:,:,:)
-         trn(:,:,:,jpzoo) = 0.1 * tmask(:,:,:)
-         trn(:,:,:,jpnh4) = 0.1 * tmask(:,:,:)
-         trn(:,:,:,jpphy) = 0.1 * tmask(:,:,:)
-         trn(:,:,:,jpdom) = 1.0 * tmask(:,:,:)
+         trn(:,:,:,jp_lob_det) = 0.1 * tmask(:,:,:)
+         trn(:,:,:,jp_lob_zoo) = 0.1 * tmask(:,:,:)
+         trn(:,:,:,jp_lob_nh4) = 0.1 * tmask(:,:,:)
+         trn(:,:,:,jp_lob_phy) = 0.1 * tmask(:,:,:)
+         trn(:,:,:,jp_lob_dom) = 1.0 * tmask(:,:,:)
          DO jk = 1, jpk
             DO jj = 1, jpj
                DO ji = 1, jpi
                   IF( rhd(ji,jj,jk) <= 24.5e-3 ) THEN
-                     trn(ji,jj,jk,jpno3) = 2. * tmask(ji,jj,jk)
+                     trn(ji,jj,jk,jp_lob_no3) = 2. * tmask(ji,jj,jk)
                   ELSE
-                     trn(ji,jj,jk,jpno3) = ( 15.55 * ( rhd(ji,jj,jk) * 1000. ) - 380.11 ) * tmask(ji,jj,jk)
+                     trn(ji,jj,jk,jp_lob_no3) = ( 15.55 * ( rhd(ji,jj,jk) * 1000. ) - 380.11 ) * tmask(ji,jj,jk)
                   ENDIF
                END DO
@@ -259,4 +256,66 @@
    END SUBROUTINE trc_ini_lobster
 
+   SUBROUTINE trc_ctl_lobster
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_ctl_lobster  ***
+      !!
+      !! ** Purpose :   control the cpp options, namelist and files 
+      !!----------------------------------------------------------------------
+      INTEGER :: jl, jn
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' use LOBSTER biological model '
+
+      ! Check number of tracers
+      ! -----------------------
+      IF( jp_lobster /= 6 ) CALL ctl_stop( ' LOBSTER has 6 passive tracers. Change jp_lobster in par_lobster.F90' )
+
+      ! Check tracer names
+      ! ------------------
+      IF(   ctrcnm(jp_lob_det) /= 'DET' .OR. ctrcnm(jp_lob_zoo) /= 'ZOO' .OR.   &
+         &  ctrcnm(jp_lob_phy) /= 'PHY' .OR. ctrcnm(jp_lob_no3) /= 'NO3' .OR.   &
+         &  ctrcnm(jp_lob_nh4) /= 'NH4' .OR. ctrcnm(jp_lob_dom) /= 'DOM' .OR.   &
+         &  ctrcnl(jp_lob_det) /= 'Detritus'                        .OR.   &
+         &  ctrcnl(jp_lob_zoo) /= 'Zooplankton concentration'       .OR.   &
+         &  ctrcnl(jp_lob_phy) /= 'Phytoplankton concentration'     .OR.   &
+         &  ctrcnl(jp_lob_no3) /= 'Nitrate concentration'           .OR.   &
+         &  ctrcnl(jp_lob_nh4) /= 'Ammonium concentration'          .OR.   &
+         &  ctrcnl(jp_lob_dom) /= 'Dissolved organic matter' ) THEN
+         ctrcnm(jp_lob_det)='DET'
+         ctrcnl(jp_lob_det)='Detritus'
+         ctrcnm(jp_lob_zoo)='ZOO'
+         ctrcnl(jp_lob_zoo)='Zooplankton concentration'
+         ctrcnm(jp_lob_phy)='PHY'
+         ctrcnl(jp_lob_phy)='Phytoplankton concentration'
+         ctrcnm(jp_lob_no3)='NO3'
+         ctrcnl(jp_lob_no3)='Nitrate concentration'
+         ctrcnm(jp_lob_nh4)='NH4'
+         ctrcnl(jp_lob_nh4)='Ammonium concentration'
+         ctrcnm(jp_lob_dom)='DOM'
+         ctrcnl(jp_lob_dom)='Dissolved organic matter'
+         IF(lwp) THEN
+            CALL ctl_warn( ' We force tracer names ' )
+            DO jl = 1, jp_lobster
+               jn = jp_lob0 + jl - 1
+               WRITE(numout,*) ' tracer nb: ',jn,' name = ',ctrcnm(jn), ctrcnl(jn)
+            END DO
+            WRITE(numout,*) ' '
+         ENDIF
+      ENDIF
+
+      ! Check tracer units
+      DO jl = 1, jp_lobster
+         jn = jp_lob0 + jl - 1
+         IF( ctrcun(jn) /= 'mmole-N/m3') THEN
+            ctrcun(jn) = 'mmole-N/m3'
+            IF(lwp) THEN
+               CALL ctl_warn( ' We force tracer units ' )
+               WRITE(numout,*) ' tracer  ',ctrcnm(jn), 'UNIT= ',ctrcun(jn)
+            ENDIF
+         ENDIF
+      END DO
+
+   END SUBROUTINE trc_ctl_lobster
+
 #else
    !!----------------------------------------------------------------------
Index: trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trclsm_lobster.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trclsm_lobster.F90	(revision 2527)
+++ 	(revision )
@@ -1,393 +1,0 @@
-MODULE trclsm_lobster
-   !!======================================================================
-   !!                      ***  MODULE trclsm_lobster  ***
-   !! TOP :   initialisation of some run parameters for LOBSTER bio-model
-   !!======================================================================
-   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) from trclsm.lobster1.h90
-   !!----------------------------------------------------------------------
-#if defined key_lobster
-   !!----------------------------------------------------------------------
-   !!   'key_lobster'   :                                 LOBSTER bio-model
-   !!----------------------------------------------------------------------
-   !! trc_lsm_lobster      : LOBSTER model namelist read
-   !!----------------------------------------------------------------------
-   USE oce_trc         ! Ocean variables
-   USE par_trc         ! TOP parameters
-   USE trc             ! TOP variables
-   USE sms_lobster     ! sms trends
-   USE in_out_manager  ! I/O manager
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   trc_lsm_lobster   ! called by trclsm.F90 module
-
-   !!----------------------------------------------------------------------
-   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE trc_lsm_lobster
-      !!----------------------------------------------------------------------
-      !!                     ***  trc_lsm_lobster  ***  
-      !!
-      !! ** Purpose :   read LOBSTER namelist
-      !!
-      !! ** input   :   file 'namelist.trc.sms' containing the following
-      !!             namelist: natbio, natopt, and natdbi ("key_trc_diabio")
-      !!----------------------------------------------------------------------
-      INTEGER ::   numnatl
-      !!
-#if defined key_trc_diaadd && ! defined key_iomput
-      INTEGER :: jl, jn
-      ! definition of additional diagnostic as a structure
-      TYPE DIAG
-         CHARACTER(len = 20)  :: snamedia   !: short name
-         CHARACTER(len = 80 ) :: lnamedia   !: long name
-         CHARACTER(len = 20 ) :: unitdia    !: unit
-      END TYPE DIAG
-
-      TYPE(DIAG) , DIMENSION(jp_lobster_2d) :: lobdia2d
-      TYPE(DIAG) , DIMENSION(jp_lobster_3d) :: lobdia3d
-#endif
-#if defined key_trc_diabio || defined key_trdmld_trc
-      INTEGER :: js, jd
-      ! definition of additional diagnostic as a structure
-      TYPE DIABIO
-         CHARACTER(len = 20)  :: snamebio   !: short name
-         CHARACTER(len = 80 ) :: lnamebio   !: long name
-         CHARACTER(len = 20 ) :: unitbio    !: unit
-      END TYPE DIABIO
-
-      TYPE(DIABIO) , DIMENSION(jp_lobster_trd) :: lobdiabio
-#endif
-
-      NAMELIST/namlobphy/ apmin, tmumax, rgamma, fphylab, tmmaxp, tmminp, &
-         &                rcchl, aki, toptp 
-      NAMELIST/namlobnut/ anmin, akno3, aknh4, taunn, psinut
-      NAMELIST/namlobzoo/ azmin, eggzoo, rgz, rppz, taus, aks, rpnaz,     &
-         &                rdnaz, tauzn, fzoolab, fdbod, tmmaxz, tmminz
-      NAMELIST/namlobdet/ admin, taudn, fdetlab, vsed
-      NAMELIST/namlobdom/ taudomn
-      NAMELIST/namlobsed/ sedlam, sedlostpoc
-      NAMELIST/namlobrat/ redf, reddom, slopet, tmaxr, tminr, xhr,        &
-         &                filmax, toptgz, tmaxgz, anumin, afdmin
-
-      NAMELIST/namlobopt/ xkg0, xkr0, xkgp, xkrp, xlg, xlr, rpig
-#if defined key_trc_diaadd && ! defined key_iomput
-      NAMELIST/namlobdia/nwritedia, lobdia3d, lobdia2d     ! additional diagnostics
-#endif
-#if defined key_trc_diabio || defined key_trdmld_trc
-      NAMELIST/namlobdbi/nwritebio, lobdiabio
-#endif
-      !!----------------------------------------------------------------------
-
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) ' trc_lsm_lobster : read LOBSTER namelists'
-      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~'
-
-      !                               ! Open the namelist file
-      !                               ! ----------------------
-      CALL ctl_opn( numnatl, 'namelist_lobster', 'OLD', 'FORMATTED', 'SEQUENTIAL', 1, numout, .FALSE. )
-
-      ! namlobphy : parameters for phytoplankton
-      apmin   = 0. 
-      tmumax  = 0. 
-      rgamma  = 0. 
-      fphylab = 0.  
-      tmmaxp  = 0.
-      tmminp  = 0.
-      rcchl   = 0. 
-      aki     = 0. 
-      toptp   = 0. 
-
-      REWIND( numnatl )
-      READ  ( numnatl, namlobphy )
-
-      IF(lwp) THEN
-          WRITE(numout,*) ' Namelist namlobphy'
-          WRITE(numout,*) '    minimum phytoplancton concentration                  apmin     =', apmin
-          WRITE(numout,*) '    phyto max growth rate                                tmumax    =', 86400 * tmumax, ' d'
-          WRITE(numout,*) '    phytoplankton exudation fraction                     rgamma    =', rgamma
-          WRITE(numout,*) '    NH4 fraction of phytoplankton exsudation             fphylab   =', fphylab
-          WRITE(numout,*) '    maximal phyto mortality rate                         tmmaxp    =', 86400 * tmmaxp
-          WRITE(numout,*) '    minimal phyto mortality rate                         tmminp    =', 86400 * tmminp
-          WRITE(numout,*) '    carbone/chlorophyl ratio                             rcchl     =', rcchl
-          WRITE(numout,*) '    light hlaf saturation constant                       aki       =', aki
-          WRITE(numout,*) '    optimal photosynthesis temperature                   toptp     =', toptp
-          WRITE(numout,*) ' '
-      ENDIF
-
-      ! namlobnut : parameters for nutrients
-      anmin  = 0.
-      psinut = 0.
-      akno3  = 0.
-      aknh4  = 0.
-      taunn  = 0.
-
-      REWIND( numnatl )
-      READ  ( numnatl, namlobnut )
-      IF(lwp) THEN
-          WRITE(numout,*) ' Namelist namlobnut'
-          WRITE(numout,*) '    minimum nutrients     concentration                  anmin     =', anmin
-          WRITE(numout,*) '    half-saturation nutrient for no3 uptake              akno3     =', akno3
-          WRITE(numout,*) '    half-saturation nutrient for nh4 uptake              aknh4     =', aknh4
-          WRITE(numout,*) '    nitrification rate                                   taunn     =', taunn
-          WRITE(numout,*) '    inhibition of no3 uptake by nh4                      psinut    =', psinut
-          WRITE(numout,*) ' '
-      ENDIF
-
-      ! namlobzoo : parameters for zooplankton
-      azmin   = 0.
-      rgz     = 0.
-      rppz    = 0.
-      taus    = 0.
-      aks     = 0.
-      rpnaz   = 0.
-      rdnaz   = 0.
-      eggzoo  = 0.
-      tauzn   = 0.
-      tmmaxz  = 0.
-      tmminz  = 0.
-      fzoolab = 0.
-      fdbod   = 0.
-
-      REWIND( numnatl )
-      READ  ( numnatl, namlobzoo )
-
-      IF(lwp) THEN
-          WRITE(numout,*) ' Namelist namlobzoo'
-          WRITE(numout,*) '    minimum zooplancton   concentration                  azmin     =', azmin
-          WRITE(numout,*) '    minimum  for zoo concentration                       eggzoo    =', eggzoo
-          WRITE(numout,*) '    widtht of zoo temperature FUNCTION                   rgz       =', rgz
-          WRITE(numout,*) '    zoo preference for phyto                             rppz      =', rppz
-          WRITE(numout,*) '    maximal zoo grazing rate                             taus      =', 86400 * taus, ' d'
-          WRITE(numout,*) '    half saturation constant for zoo food                aks       =', aks
-          WRITE(numout,*) '    non-assimilated phyto by zoo                         rpnaz     =', rpnaz
-          WRITE(numout,*) '    non-assimilated detritus by zoo                      rdnaz     =', rdnaz
-          WRITE(numout,*) '    zoo specific excretion rate                          tauzn     =', 86400 * tauzn
-          WRITE(numout,*) '    maximal zoo mortality rate                           tmmaxz    =', 86400 * tmmaxz
-          WRITE(numout,*) '    minimal zoo mortality rate                           tmminz    =', 86400 * tmminz
-          WRITE(numout,*) '    NH4 fraction of zooplankton excretion                fzoolab   =', fzoolab
-          WRITE(numout,*) '    Zooplankton mortality fraction that goes to detritus fdbod     =', fdbod
-          WRITE(numout,*) ' '
-      ENDIF
-
-      ! namlobdet : parameters for detritus
-      admin   = 0.
-      taudn   = 0.
-      vsed    = 0.
-      fdetlab = 0.
-
-      REWIND( numnatl )
-      READ  ( numnatl, namlobdet )
-
-      IF(lwp) THEN
-          WRITE(numout,*) ' Namelist namlobdet'
-          WRITE(numout,*) '    minimum detritus      concentration                  admin     =', admin
-          WRITE(numout,*) '    detrital breakdown rate                              taudn     =', 86400 * taudn , ' d'
-          WRITE(numout,*) '    detritus sedimentation speed                         vsed      =', 86400 * vsed  , ' d'
-          WRITE(numout,*) '    NH4 fraction of detritus dissolution                 fdetlab   =', fdetlab
-          WRITE(numout,*) ' '
-      ENDIF
-
-      ! namlobdom : parameters for DOM
-      taudomn = 0.
-
-      REWIND( numnatl ) 
-      READ  ( numnatl, namlobdom )
-
-      IF(lwp) THEN
-          WRITE(numout,*) ' Namelist namlobdom'
-          WRITE(numout,*) '    dom remineralisation rate                            taudomn   =', taudomn
-          WRITE(numout,*) ' '
-      ENDIF
-
-      ! namlobsed : parameters from aphotic layers to sediment
-      sedlam     = 0.
-      sedlostpoc = 0.
-
-      REWIND( numnatl )
-      READ  ( numnatl, namlobsed )
-
-      IF(lwp) THEN
-          WRITE(numout,*) ' Namelist namlobsed'
-          WRITE(numout,*) '    time coeff of POC in sediments                       sedlam    =', sedlam
-          WRITE(numout,*) '    Sediment geol loss for POC                           sedlostpoc=', sedlostpoc
-          WRITE(numout,*) ' '
-      ENDIF
-
-      ! namlobrat : general coefficient
-      redf   = 0.
-      reddom = 0.
-      slopet = 0.
-      tmaxr  = 1./(     4.*rday)*0.
-      tminr  = 1./(24.*30.*rday)*0.
-      xhr    = 0.
-      filmax = 0.
-      toptgz = 0.
-      tmaxgz = 0.
-      anumin = 0.
-      afdmin = 0.
-
-      REWIND( numnatl )
-      READ  ( numnatl, namlobrat )
-
-      IF(lwp) THEN
-          WRITE(numout,*) ' Namelist namlobrat'
-          WRITE(numout,*) '    redfield ratio  c:n for phyto                        redf      =', redf 
-          WRITE(numout,*) '    redfield ratio  c:n for DOM                          reddom    =', reddom 
-          WRITE(numout,*) '    van t hoff coefficient                               slopet    =', slopet
-          WRITE(numout,*) '    maximum damping for d z or p                         tmaxr     =', tmaxr
-          WRITE(numout,*) '    damping-remineralisation rate                        tminr     =', tminr
-          WRITE(numout,*) '    coeff for martin''s remineralistion                  xhr       =', xhr
-          WRITE(numout,*) '    maximal mass clearance rate for zoo                  filmax    =', filmax
-          WRITE(numout,*) '    optimal temperature for zoo growth                   toptgz    =', toptgz
-          WRITE(numout,*) '    maximal temperature for zoo growth                   tmaxgz    =', tmaxgz
-          WRITE(numout,*) '    nutrient threshold for phyto mort                    anumin    =', anumin
-          WRITE(numout,*) '    food threshold for zoo mort                          afdmin    =', afdmin
-          WRITE(numout,*) ' '
-      ENDIF
-
-
-      ! namlobopt : optical parameters
-      xkg0  = 0. 
-      xkr0  = 0.
-      xkgp  = 0.
-      xkrp  = 0.
-      xlg   = 0.
-      xlr   = 0.
-      rpig  = 0.
-
-      REWIND( numnatl )
-      READ  ( numnatl, namlobopt )
-
-      IF(lwp) THEN                         
-         WRITE(numout,*)
-         WRITE(numout,*) ' Namelist namlobopt'
-         WRITE(numout,*) '    green   water absorption coeff                       xkg0  = ', xkg0
-         WRITE(numout,*) '    red water absorption coeff                           xkr0  = ', xkr0
-         WRITE(numout,*) '    pigment red absorption coeff                         xkrp  = ', xkrp
-         WRITE(numout,*) '    pigment green absorption coeff                       xkgp  = ', xkgp
-         WRITE(numout,*) '    green chl exposant                                   xlg   = ', xlg
-         WRITE(numout,*) '    red   chl exposant                                   xlr   = ', xlr
-         WRITE(numout,*) '    chla/chla+phea ratio                                 rpig  = ', rpig
-         WRITE(numout,*) ' '
-      ENDIF
-
-#if defined key_trc_diaadd && ! defined key_iomput
-
-      ! Namelist namlobdia
-      ! -------------------
-      nwritedia = 10                   ! default values
-
-      DO jl = 1, jp_lobster_2d
-         jn = jp_lob0_2d + jl - 1
-         WRITE(ctrc2d(jn),'("2D_",I1)') jn                      ! short name
-         WRITE(ctrc2l(jn),'("2D DIAGNOSTIC NUMBER ",I2)') jn    ! long name
-         ctrc2u(jn) = ' '                                       ! units
-      END DO
-      !                                 ! 3D output arrays
-      DO jl = 1, jp_lobster_3d
-         jn = jp_lob0_3d + jl - 1
-         WRITE(ctrc3d(jn),'("3D_",I1)') jn                      ! short name
-         WRITE(ctrc3l(jn),'("3D DIAGNOSTIC NUMBER ",I2)') jn    ! long name
-         ctrc3u(jn) = ' '                                       ! units
-      END DO
-
-      REWIND( numnatl )               ! read natrtd
-      READ  ( numnatl, namlobdia )
-
-      DO jl = 1, jp_lobster_2d
-         jn = jp_lob0_2d + jl - 1
-         ctrc2d(jn) = lobdia2d(jl)%snamedia
-         ctrc2l(jn) = lobdia2d(jl)%lnamedia
-         ctrc2u(jn) = lobdia2d(jl)%unitdia
-      END DO
-
-      DO jl = 1, jp_lobster_3d
-         jn = jp_lob0_3d + jl - 1
-         ctrc3d(jn) = lobdia3d(jl)%snamedia
-         ctrc3l(jn) = lobdia3d(jl)%lnamedia
-         ctrc3u(jn) = lobdia3d(jl)%unitdia
-      END DO
-
-      IF(lwp) THEN                   ! control print
-         WRITE(numout,*)
-         WRITE(numout,*) ' Namelist : natadd'
-         WRITE(numout,*) '    frequency of outputs for additional arrays nwritedia = ', nwritedia
-         DO jl = 1, jp_lobster_3d
-            jn = jp_lob0_3d + jl - 1
-            WRITE(numout,*) '   3d output field No : ',jn
-            WRITE(numout,*) '   short name         : ', TRIM(ctrc3d(jn))
-            WRITE(numout,*) '   long name          : ', TRIM(ctrc3l(jn))
-            WRITE(numout,*) '   unit               : ', TRIM(ctrc3u(jn))
-            WRITE(numout,*) ' '
-         END DO
-
-         DO jl = 1, jp_lobster_2d
-            jn = jp_lob0_2d + jl - 1
-            WRITE(numout,*) '   2d output field No : ',jn
-            WRITE(numout,*) '   short name         : ', TRIM(ctrc2d(jn))
-            WRITE(numout,*) '   long name          : ', TRIM(ctrc2l(jn))
-            WRITE(numout,*) '   unit               : ', TRIM(ctrc2u(jn))
-            WRITE(numout,*) ' '
-         END DO
-      ENDIF
-#endif
-
-#if defined key_trc_diabio || defined key_trdmld_trc
-      ! namlobdbi : bio diagnostics
-      nwritebio = 10                     ! default values
-
-      DO js = 1, jp_lobster_trd
-         jd = jp_lob0_trd + js - 1
-         IF(     jd <  10 ) THEN   ;   WRITE (ctrbio(jd),'("BIO_",I1)') jd      ! short name
-         ELSEIF (jd < 100 ) THEN   ;   WRITE (ctrbio(jd),'("BIO_",I2)') jd   
-         ELSE                      ;   WRITE (ctrbio(jd),'("BIO_",I3)') jd
-         ENDIF
-         WRITE(ctrbil(jd),'("BIOLOGICAL TREND NUMBER ",I2)') jd                 ! long name
-         ctrbiu(jd) = 'mmoleN/m3/s '                                            ! units
-      END DO
-
-      REWIND( numnatl )
-      READ  ( numnatl, namlobdbi ) 
- 
-      DO js = 1, jp_lobster_trd
-         jd = jp_lob0_trd + js - 1
-         ctrbio(jd) = lobdiabio(js)%snamebio
-         ctrbil(jd) = lobdiabio(js)%lnamebio
-         ctrbiu(jd) = lobdiabio(js)%unitbio
-      END DO
-
-      IF(lwp) THEN                   ! control print
-         WRITE(numout,*)
-         WRITE(numout,*) ' Namelist : namlobdbi'
-         WRITE(numout,*) '    frequency of outputs for biological trends nwritebio = ', nwritebio
-         DO js = 1, jp_lobster_trd
-            jd = jp_lob0_trd + js - 1
-            WRITE(numout,*) '   biological trend No : ',jd
-            WRITE(numout,*) '   short name         : ', TRIM(ctrbio(jd))
-            WRITE(numout,*) '   long name          : ', TRIM(ctrbil(jd))
-            WRITE(numout,*) '   unit               : ', TRIM(ctrbiu(jd))
-            WRITE(numout,*) ' '
-         END DO
-      END IF
-#endif
-      !
-   END SUBROUTINE trc_lsm_lobster
-   
-#else
-   !!----------------------------------------------------------------------
-   !!  Dummy module :                                            No LOBSTER
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE trc_lsm_lobster                      ! Empty routine
-   END  SUBROUTINE  trc_lsm_lobster
-#endif  
-
-   !!======================================================================
-END MODULE trclsm_lobster
Index: trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcnam_lobster.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcnam_lobster.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcnam_lobster.F90	(revision 2528)
@@ -0,0 +1,393 @@
+MODULE trcnam_lobster
+   !!======================================================================
+   !!                      ***  MODULE trcnam_lobster  ***
+   !! TOP :   initialisation of some run parameters for LOBSTER bio-model
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) from trcnam.lobster1.h90
+   !!----------------------------------------------------------------------
+#if defined key_lobster
+   !!----------------------------------------------------------------------
+   !!   'key_lobster'   :                                 LOBSTER bio-model
+   !!----------------------------------------------------------------------
+   !! trc_nam_lobster      : LOBSTER model namelist read
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! Ocean variables
+   USE par_trc         ! TOP parameters
+   USE trc             ! TOP variables
+   USE sms_lobster     ! sms trends
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_nam_lobster   ! called by trcnam.F90 module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_nam_lobster
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_nam_lobster  ***  
+      !!
+      !! ** Purpose :   read LOBSTER namelist
+      !!
+      !! ** input   :   file 'namelist.trc.sms' containing the following
+      !!             namelist: natbio, natopt, and natdbi ("key_diabio")
+      !!----------------------------------------------------------------------
+      INTEGER ::   numnatl
+      !!
+#if defined key_diatrc && ! defined key_iomput
+      INTEGER :: jl, jn
+      ! definition of additional diagnostic as a structure
+      TYPE DIAG
+         CHARACTER(len = 20)  :: snamedia   !: short name
+         CHARACTER(len = 80 ) :: lnamedia   !: long name
+         CHARACTER(len = 20 ) :: unitdia    !: unit
+      END TYPE DIAG
+
+      TYPE(DIAG) , DIMENSION(jp_lobster_2d) :: lobdia2d
+      TYPE(DIAG) , DIMENSION(jp_lobster_3d) :: lobdia3d
+#endif
+#if defined key_diabio || defined key_trdmld_trc
+      INTEGER :: js, jd
+      ! definition of additional diagnostic as a structure
+      TYPE DIABIO
+         CHARACTER(len = 20)  :: snamebio   !: short name
+         CHARACTER(len = 80 ) :: lnamebio   !: long name
+         CHARACTER(len = 20 ) :: unitbio    !: unit
+      END TYPE DIABIO
+
+      TYPE(DIABIO) , DIMENSION(jp_lobster_trd) :: lobdiabio
+#endif
+
+      NAMELIST/namlobphy/ apmin, tmumax, rgamma, fphylab, tmmaxp, tmminp, &
+         &                rcchl, aki, toptp 
+      NAMELIST/namlobnut/ anmin, akno3, aknh4, taunn, psinut
+      NAMELIST/namlobzoo/ azmin, eggzoo, rgz, rppz, taus, aks, rpnaz,     &
+         &                rdnaz, tauzn, fzoolab, fdbod, tmmaxz, tmminz
+      NAMELIST/namlobdet/ admin, taudn, fdetlab, vsed
+      NAMELIST/namlobdom/ taudomn
+      NAMELIST/namlobsed/ sedlam, sedlostpoc
+      NAMELIST/namlobrat/ redf, reddom, slopet, tmaxr, tminr, xhr,        &
+         &                filmax, toptgz, tmaxgz, anumin, afdmin
+
+      NAMELIST/namlobopt/ xkg0, xkr0, xkgp, xkrp, xlg, xlr, rpig
+#if defined key_diatrc && ! defined key_iomput
+      NAMELIST/namlobdia/nwritedia, lobdia3d, lobdia2d     ! additional diagnostics
+#endif
+#if defined key_diabio || defined key_trdmld_trc
+      NAMELIST/namlobdbi/nwritebio, lobdiabio
+#endif
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_nam_lobster : read LOBSTER namelists'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~'
+
+      !                               ! Open the namelist file
+      !                               ! ----------------------
+      CALL ctl_opn( numnatl, 'namelist_lobster', 'OLD', 'FORMATTED', 'SEQUENTIAL', 1, numout, .FALSE. )
+
+      ! namlobphy : parameters for phytoplankton
+      apmin   = 0. 
+      tmumax  = 0. 
+      rgamma  = 0. 
+      fphylab = 0.  
+      tmmaxp  = 0.
+      tmminp  = 0.
+      rcchl   = 0. 
+      aki     = 0. 
+      toptp   = 0. 
+
+      REWIND( numnatl )
+      READ  ( numnatl, namlobphy )
+
+      IF(lwp) THEN
+          WRITE(numout,*) ' Namelist namlobphy'
+          WRITE(numout,*) '    minimum phytoplancton concentration                  apmin     =', apmin
+          WRITE(numout,*) '    phyto max growth rate                                tmumax    =', 86400 * tmumax, ' d'
+          WRITE(numout,*) '    phytoplankton exudation fraction                     rgamma    =', rgamma
+          WRITE(numout,*) '    NH4 fraction of phytoplankton exsudation             fphylab   =', fphylab
+          WRITE(numout,*) '    maximal phyto mortality rate                         tmmaxp    =', 86400 * tmmaxp
+          WRITE(numout,*) '    minimal phyto mortality rate                         tmminp    =', 86400 * tmminp
+          WRITE(numout,*) '    carbone/chlorophyl ratio                             rcchl     =', rcchl
+          WRITE(numout,*) '    light hlaf saturation constant                       aki       =', aki
+          WRITE(numout,*) '    optimal photosynthesis temperature                   toptp     =', toptp
+          WRITE(numout,*) ' '
+      ENDIF
+
+      ! namlobnut : parameters for nutrients
+      anmin  = 0.
+      psinut = 0.
+      akno3  = 0.
+      aknh4  = 0.
+      taunn  = 0.
+
+      REWIND( numnatl )
+      READ  ( numnatl, namlobnut )
+      IF(lwp) THEN
+          WRITE(numout,*) ' Namelist namlobnut'
+          WRITE(numout,*) '    minimum nutrients     concentration                  anmin     =', anmin
+          WRITE(numout,*) '    half-saturation nutrient for no3 uptake              akno3     =', akno3
+          WRITE(numout,*) '    half-saturation nutrient for nh4 uptake              aknh4     =', aknh4
+          WRITE(numout,*) '    nitrification rate                                   taunn     =', taunn
+          WRITE(numout,*) '    inhibition of no3 uptake by nh4                      psinut    =', psinut
+          WRITE(numout,*) ' '
+      ENDIF
+
+      ! namlobzoo : parameters for zooplankton
+      azmin   = 0.
+      rgz     = 0.
+      rppz    = 0.
+      taus    = 0.
+      aks     = 0.
+      rpnaz   = 0.
+      rdnaz   = 0.
+      eggzoo  = 0.
+      tauzn   = 0.
+      tmmaxz  = 0.
+      tmminz  = 0.
+      fzoolab = 0.
+      fdbod   = 0.
+
+      REWIND( numnatl )
+      READ  ( numnatl, namlobzoo )
+
+      IF(lwp) THEN
+          WRITE(numout,*) ' Namelist namlobzoo'
+          WRITE(numout,*) '    minimum zooplancton   concentration                  azmin     =', azmin
+          WRITE(numout,*) '    minimum  for zoo concentration                       eggzoo    =', eggzoo
+          WRITE(numout,*) '    widtht of zoo temperature FUNCTION                   rgz       =', rgz
+          WRITE(numout,*) '    zoo preference for phyto                             rppz      =', rppz
+          WRITE(numout,*) '    maximal zoo grazing rate                             taus      =', 86400 * taus, ' d'
+          WRITE(numout,*) '    half saturation constant for zoo food                aks       =', aks
+          WRITE(numout,*) '    non-assimilated phyto by zoo                         rpnaz     =', rpnaz
+          WRITE(numout,*) '    non-assimilated detritus by zoo                      rdnaz     =', rdnaz
+          WRITE(numout,*) '    zoo specific excretion rate                          tauzn     =', 86400 * tauzn
+          WRITE(numout,*) '    maximal zoo mortality rate                           tmmaxz    =', 86400 * tmmaxz
+          WRITE(numout,*) '    minimal zoo mortality rate                           tmminz    =', 86400 * tmminz
+          WRITE(numout,*) '    NH4 fraction of zooplankton excretion                fzoolab   =', fzoolab
+          WRITE(numout,*) '    Zooplankton mortality fraction that goes to detritus fdbod     =', fdbod
+          WRITE(numout,*) ' '
+      ENDIF
+
+      ! namlobdet : parameters for detritus
+      admin   = 0.
+      taudn   = 0.
+      vsed    = 0.
+      fdetlab = 0.
+
+      REWIND( numnatl )
+      READ  ( numnatl, namlobdet )
+
+      IF(lwp) THEN
+          WRITE(numout,*) ' Namelist namlobdet'
+          WRITE(numout,*) '    minimum detritus      concentration                  admin     =', admin
+          WRITE(numout,*) '    detrital breakdown rate                              taudn     =', 86400 * taudn , ' d'
+          WRITE(numout,*) '    detritus sedimentation speed                         vsed      =', 86400 * vsed  , ' d'
+          WRITE(numout,*) '    NH4 fraction of detritus dissolution                 fdetlab   =', fdetlab
+          WRITE(numout,*) ' '
+      ENDIF
+
+      ! namlobdom : parameters for DOM
+      taudomn = 0.
+
+      REWIND( numnatl ) 
+      READ  ( numnatl, namlobdom )
+
+      IF(lwp) THEN
+          WRITE(numout,*) ' Namelist namlobdom'
+          WRITE(numout,*) '    dom remineralisation rate                            taudomn   =', taudomn
+          WRITE(numout,*) ' '
+      ENDIF
+
+      ! namlobsed : parameters from aphotic layers to sediment
+      sedlam     = 0.
+      sedlostpoc = 0.
+
+      REWIND( numnatl )
+      READ  ( numnatl, namlobsed )
+
+      IF(lwp) THEN
+          WRITE(numout,*) ' Namelist namlobsed'
+          WRITE(numout,*) '    time coeff of POC in sediments                       sedlam    =', sedlam
+          WRITE(numout,*) '    Sediment geol loss for POC                           sedlostpoc=', sedlostpoc
+          WRITE(numout,*) ' '
+      ENDIF
+
+      ! namlobrat : general coefficient
+      redf   = 0.
+      reddom = 0.
+      slopet = 0.
+      tmaxr  = 1./(     4.*rday)*0.
+      tminr  = 1./(24.*30.*rday)*0.
+      xhr    = 0.
+      filmax = 0.
+      toptgz = 0.
+      tmaxgz = 0.
+      anumin = 0.
+      afdmin = 0.
+
+      REWIND( numnatl )
+      READ  ( numnatl, namlobrat )
+
+      IF(lwp) THEN
+          WRITE(numout,*) ' Namelist namlobrat'
+          WRITE(numout,*) '    redfield ratio  c:n for phyto                        redf      =', redf 
+          WRITE(numout,*) '    redfield ratio  c:n for DOM                          reddom    =', reddom 
+          WRITE(numout,*) '    van t hoff coefficient                               slopet    =', slopet
+          WRITE(numout,*) '    maximum damping for d z or p                         tmaxr     =', tmaxr
+          WRITE(numout,*) '    damping-remineralisation rate                        tminr     =', tminr
+          WRITE(numout,*) '    coeff for martin''s remineralistion                  xhr       =', xhr
+          WRITE(numout,*) '    maximal mass clearance rate for zoo                  filmax    =', filmax
+          WRITE(numout,*) '    optimal temperature for zoo growth                   toptgz    =', toptgz
+          WRITE(numout,*) '    maximal temperature for zoo growth                   tmaxgz    =', tmaxgz
+          WRITE(numout,*) '    nutrient threshold for phyto mort                    anumin    =', anumin
+          WRITE(numout,*) '    food threshold for zoo mort                          afdmin    =', afdmin
+          WRITE(numout,*) ' '
+      ENDIF
+
+
+      ! namlobopt : optical parameters
+      xkg0  = 0. 
+      xkr0  = 0.
+      xkgp  = 0.
+      xkrp  = 0.
+      xlg   = 0.
+      xlr   = 0.
+      rpig  = 0.
+
+      REWIND( numnatl )
+      READ  ( numnatl, namlobopt )
+
+      IF(lwp) THEN                         
+         WRITE(numout,*)
+         WRITE(numout,*) ' Namelist namlobopt'
+         WRITE(numout,*) '    green   water absorption coeff                       xkg0  = ', xkg0
+         WRITE(numout,*) '    red water absorption coeff                           xkr0  = ', xkr0
+         WRITE(numout,*) '    pigment red absorption coeff                         xkrp  = ', xkrp
+         WRITE(numout,*) '    pigment green absorption coeff                       xkgp  = ', xkgp
+         WRITE(numout,*) '    green chl exposant                                   xlg   = ', xlg
+         WRITE(numout,*) '    red   chl exposant                                   xlr   = ', xlr
+         WRITE(numout,*) '    chla/chla+phea ratio                                 rpig  = ', rpig
+         WRITE(numout,*) ' '
+      ENDIF
+
+#if defined key_diatrc && ! defined key_iomput
+
+      ! Namelist namlobdia
+      ! -------------------
+      nwritedia = 10                   ! default values
+
+      DO jl = 1, jp_lobster_2d
+         jn = jp_lob0_2d + jl - 1
+         WRITE(ctrc2d(jn),'("2D_",I1)') jn                      ! short name
+         WRITE(ctrc2l(jn),'("2D DIAGNOSTIC NUMBER ",I2)') jn    ! long name
+         ctrc2u(jn) = ' '                                       ! units
+      END DO
+      !                                 ! 3D output arrays
+      DO jl = 1, jp_lobster_3d
+         jn = jp_lob0_3d + jl - 1
+         WRITE(ctrc3d(jn),'("3D_",I1)') jn                      ! short name
+         WRITE(ctrc3l(jn),'("3D DIAGNOSTIC NUMBER ",I2)') jn    ! long name
+         ctrc3u(jn) = ' '                                       ! units
+      END DO
+
+      REWIND( numnatl )               ! read natrtd
+      READ  ( numnatl, namlobdia )
+
+      DO jl = 1, jp_lobster_2d
+         jn = jp_lob0_2d + jl - 1
+         ctrc2d(jn) = lobdia2d(jl)%snamedia
+         ctrc2l(jn) = lobdia2d(jl)%lnamedia
+         ctrc2u(jn) = lobdia2d(jl)%unitdia
+      END DO
+
+      DO jl = 1, jp_lobster_3d
+         jn = jp_lob0_3d + jl - 1
+         ctrc3d(jn) = lobdia3d(jl)%snamedia
+         ctrc3l(jn) = lobdia3d(jl)%lnamedia
+         ctrc3u(jn) = lobdia3d(jl)%unitdia
+      END DO
+
+      IF(lwp) THEN                   ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) ' Namelist : natadd'
+         WRITE(numout,*) '    frequency of outputs for additional arrays nwritedia = ', nwritedia
+         DO jl = 1, jp_lobster_3d
+            jn = jp_lob0_3d + jl - 1
+            WRITE(numout,*) '   3d output field No : ',jn
+            WRITE(numout,*) '   short name         : ', TRIM(ctrc3d(jn))
+            WRITE(numout,*) '   long name          : ', TRIM(ctrc3l(jn))
+            WRITE(numout,*) '   unit               : ', TRIM(ctrc3u(jn))
+            WRITE(numout,*) ' '
+         END DO
+
+         DO jl = 1, jp_lobster_2d
+            jn = jp_lob0_2d + jl - 1
+            WRITE(numout,*) '   2d output field No : ',jn
+            WRITE(numout,*) '   short name         : ', TRIM(ctrc2d(jn))
+            WRITE(numout,*) '   long name          : ', TRIM(ctrc2l(jn))
+            WRITE(numout,*) '   unit               : ', TRIM(ctrc2u(jn))
+            WRITE(numout,*) ' '
+         END DO
+      ENDIF
+#endif
+
+#if defined key_diabio || defined key_trdmld_trc
+      ! namlobdbi : bio diagnostics
+      nwritebio = 10                     ! default values
+
+      DO js = 1, jp_lobster_trd
+         jd = jp_lob0_trd + js - 1
+         IF(     jd <  10 ) THEN   ;   WRITE (ctrbio(jd),'("BIO_",I1)') jd      ! short name
+         ELSEIF (jd < 100 ) THEN   ;   WRITE (ctrbio(jd),'("BIO_",I2)') jd   
+         ELSE                      ;   WRITE (ctrbio(jd),'("BIO_",I3)') jd
+         ENDIF
+         WRITE(ctrbil(jd),'("BIOLOGICAL TREND NUMBER ",I2)') jd                 ! long name
+         ctrbiu(jd) = 'mmoleN/m3/s '                                            ! units
+      END DO
+
+      REWIND( numnatl )
+      READ  ( numnatl, namlobdbi ) 
+ 
+      DO js = 1, jp_lobster_trd
+         jd = jp_lob0_trd + js - 1
+         ctrbio(jd) = lobdiabio(js)%snamebio
+         ctrbil(jd) = lobdiabio(js)%lnamebio
+         ctrbiu(jd) = lobdiabio(js)%unitbio
+      END DO
+
+      IF(lwp) THEN                   ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) ' Namelist : namlobdbi'
+         WRITE(numout,*) '    frequency of outputs for biological trends nwritebio = ', nwritebio
+         DO js = 1, jp_lobster_trd
+            jd = jp_lob0_trd + js - 1
+            WRITE(numout,*) '   biological trend No : ',jd
+            WRITE(numout,*) '   short name         : ', TRIM(ctrbio(jd))
+            WRITE(numout,*) '   long name          : ', TRIM(ctrbil(jd))
+            WRITE(numout,*) '   unit               : ', TRIM(ctrbiu(jd))
+            WRITE(numout,*) ' '
+         END DO
+      END IF
+#endif
+      !
+   END SUBROUTINE trc_nam_lobster
+   
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                            No LOBSTER
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_nam_lobster                      ! Empty routine
+   END  SUBROUTINE  trc_nam_lobster
+#endif  
+
+   !!======================================================================
+END MODULE trcnam_lobster
Index: trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcopt.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcopt.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcopt.F90	(revision 2528)
@@ -30,7 +30,7 @@
 #  include "top_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -78,6 +78,4 @@
       zparg  (:,:,1) = zpar0m(:,:) * 0.5
 
-!!gm optimisation : introduce zcoef and LOG computed once for all
-
       !                                          ! Photosynthetically Available Radiation (PAR)
       zcoef = 12 * redf / rcchl / rpig           ! --------------------------------------
@@ -85,8 +83,5 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-!!gm           zpig = MAX( TINY(0.), trn(ji,jj,jk-1,jpphy) ) * zcoef
-!!gm           zkr  = xkr0 + xkrp * EXP( xlr * LOG(zpig) )
-!!gm           zkg  = xkg0 + xkgp * EXP( xlg * LOG(zpig) )
-               zpig = LOG(  MAX( TINY(0.), trn(ji,jj,jk-1,jpphy) ) * zcoef  )
+               zpig = LOG(  MAX( TINY(0.), trn(ji,jj,jk-1,jp_lob_phy) ) * zcoef  )
                zkr  = xkr0 + xkrp * EXP( xlr * zpig )
                zkg  = xkg0 + xkgp * EXP( xlg * zpig )
@@ -96,13 +91,10 @@
         END DO
       END DO
-!!gm optimisation : suppress one division
       DO jk = 1, jpkm1                                ! mean par at t-levels
          DO jj = 1, jpj
             DO ji = 1, jpi
-               zpig = LOG(  MAX( TINY(0.), trn(ji,jj,jk,jpphy) ) * zcoef  )
+               zpig = LOG(  MAX( TINY(0.), trn(ji,jj,jk,jp_lob_phy) ) * zcoef  )
                zkr  = xkr0 + xkrp * EXP( xlr * zpig )
                zkg  = xkg0 + xkgp * EXP( xlg * zpig )
-!!gm           zparr(ji,jj,jk) = zparr(ji,jj,jk) / zkr / fse3t(ji,jj,jk) * ( 1 - EXP( -zkr * fse3t(ji,jj,jk) ) )
-!!gm           zparg(ji,jj,jk) = zparg(ji,jj,jk) / zkg / fse3t(ji,jj,jk) * ( 1 - EXP( -zkg * fse3t(ji,jj,jk) ) )
                zparr(ji,jj,jk) = zparr(ji,jj,jk) / ( zkr * fse3t(ji,jj,jk) ) * ( 1 - EXP( -zkr * fse3t(ji,jj,jk) ) )
                zparg(ji,jj,jk) = zparg(ji,jj,jk) / ( zkg * fse3t(ji,jj,jk) ) * ( 1 - EXP( -zkg * fse3t(ji,jj,jk) ) )
Index: trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcrst_lobster.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcrst_lobster.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcrst_lobster.F90	(revision 2528)
@@ -43,6 +43,6 @@
       IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
 
-      CALL iom_get( knum, jpdom_autoglo, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) ) 
-      CALL iom_get( knum, jpdom_autoglo, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) ) 
+      CALL iom_get( knum, jpdom_autoglo, 'SEDB'//ctrcnm(jp_lob_det), sedpocb(:,:) ) 
+      CALL iom_get( knum, jpdom_autoglo, 'SEDN'//ctrcnm(jp_lob_det), sedpocn(:,:) ) 
 
    END SUBROUTINE trc_rst_read_lobster
@@ -64,6 +64,6 @@
       IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
 
-      CALL iom_rstput( kt, kitrst, knum, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) )
-      CALL iom_rstput( kt, kitrst, knum, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) )
+      CALL iom_rstput( kt, kitrst, knum, 'SEDB'//ctrcnm(jp_lob_det), sedpocb(:,:) )
+      CALL iom_rstput( kt, kitrst, knum, 'SEDN'//ctrcnm(jp_lob_det), sedpocn(:,:) )
 
    END SUBROUTINE trc_rst_wri_lobster
Index: trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcsed.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcsed.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcsed.F90	(revision 2528)
@@ -18,6 +18,6 @@
    USE sms_lobster
    USE lbclnk
-   USE trdmld_trc
-   USE trdmld_trc_oce
+   USE trdmod_oce
+   USE trdmod_trc
    USE iom
    USE prtctl_trc      ! Print control for debbuging
@@ -31,7 +31,7 @@
 #  include "top_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -53,5 +53,5 @@
       !!                             tra = tra + dz(trn wn)
       !!        
-      !!              IF 'key_trc_diabio' is defined, the now vertical advection
+      !!              IF 'key_diabio' is defined, the now vertical advection
       !!              trend of passive tracers is saved for futher diagnostics.
       !!---------------------------------------------------------------------
@@ -61,5 +61,5 @@
       REAL(wp) ::   ztra
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwork
-#if defined key_trc_diaadd && defined key_iomput
+#if defined key_diatrc && defined key_iomput
       REAL(wp), DIMENSION(jpi,jpj) ::  zw2d
 #endif
@@ -77,9 +77,9 @@
       ! --------------------------------------------
 
-      ! for detritus sedimentation only - jpdet
+      ! for detritus sedimentation only - jp_lob_det
       zwork(:,:,1  ) = 0.e0      ! surface value set to zero
       zwork(:,:,jpk) = 0.e0      ! bottom value  set to zero
 
-#if defined key_trc_diaadd && defined key_iomput
+#if defined key_diatrc && defined key_iomput
       zw2d(:,:) = 0.
 # endif
@@ -87,10 +87,10 @@
       IF( l_trdtrc )THEN
          ALLOCATE( ztrbio(jpi,jpj,jpk) )
-         ztrbio(:,:,:) = tra(:,:,:,jpdet)
+         ztrbio(:,:,:) = tra(:,:,:,jp_lob_det)
       ENDIF
 
       ! tracer flux at w-point: we use -vsed (downward flux)  with simplification : no e1*e2
       DO jk = 2, jpkm1
-         zwork(:,:,jk) = -vsed * trn(:,:,jk-1,jpdet)
+         zwork(:,:,jk) = -vsed * trn(:,:,jk-1,jp_lob_det)
       END DO
 
@@ -100,9 +100,9 @@
             DO ji = 1,jpi
                ztra  = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / fse3t(ji,jj,jk)
-               tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + ztra
-#if defined key_trc_diabio
+               tra(ji,jj,jk,jp_lob_det) = tra(ji,jj,jk,jp_lob_det) + ztra
+#if defined key_diabio
                trbio(ji,jj,jk,jp_lob0_trd + 7) = ztra
 #endif
-#if defined key_trc_diaadd
+#if defined key_diatrc
 # if ! defined key_iomput
                trc2d(ji,jj,jp_lob0_2d + 7) = trc2d(ji,jj,jp_lob0_2d + 7) + ztra * fse3t(ji,jj,jk) * 86400.
@@ -115,9 +115,9 @@
       END DO
 
-#if defined key_trc_diabio
+#if defined key_diabio
       jl = jp_lob0_trd + 7
       CALL lbc_lnk (trbio(:,:,1,jl), 'T', 1. )    ! Lateral boundary conditions on trcbio
 #endif
-#if defined key_trc_diaadd
+#if defined key_diatrc
 # if ! defined key_iomput
       jl = jp_lob0_2d + 7
@@ -131,5 +131,5 @@
 
       IF( l_trdtrc ) THEN
-         ztrbio(:,:,:) = tra(:,:,:,jpdet) - ztrbio(:,:,:)
+         ztrbio(:,:,:) = tra(:,:,:,jp_lob_det) - ztrbio(:,:,:)
          jl = jp_lob0_trd + 7
          CALL trd_mod_trc( ztrbio, jl, kt )   ! handle the trend
Index: trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcsms_lobster.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcsms_lobster.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcsms_lobster.F90	(revision 2528)
@@ -19,5 +19,7 @@
    USE trcsed
    USE trcexp
-   USE trdmld_trc_oce
+   USE trdmod_oce
+   USE trdmod_trc_oce
+   USE trdmod_trc
    USE trdmld_trc
 
@@ -28,7 +30,7 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -50,9 +52,6 @@
 
       CALL trc_opt( kt )      ! optical model
-
       CALL trc_bio( kt )      ! biological model
-
       CALL trc_sed( kt )      ! sedimentation model
-
       CALL trc_exp( kt )      ! export
 
@@ -60,5 +59,5 @@
           DO jn = jp_lob0, jp_lob1
             ztrlob(:,:,:) = tra(:,:,:,jn)
-            CALL trd_mod_trc( ztrlob, jn, jptrc_trd_sms, kt )   ! save trends
+            CALL trd_mod_trc( ztrlob, jn, jptra_trd_sms, kt )   ! save trends
           END DO
       END IF
Index: trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/par_my_trc.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/par_my_trc.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/par_my_trc.F90	(revision 2528)
@@ -6,7 +6,7 @@
    !! History :   2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
    USE par_lobster, ONLY : jp_lobster      !: number of tracers in LOBSTER
Index: trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcctl_my_trc.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcctl_my_trc.F90	(revision 2527)
+++ 	(revision )
@@ -1,62 +1,0 @@
-MODULE trcctl_my_trc
-   !!======================================================================
-   !!                         ***  trcctl_my_trc.F90  ***
-   !! TOP :                Control of MY_TRC biogeochemical model
-   !!======================================================================
-   !!----------------------------------------------------------------------
-   !! History :   1.0  !  2000-12 (C. Ethe) assign a parameter to name individual tracers
-   !!----------------------------------------------------------------------
-
-#if defined key_my_trc
-
-   USE oce_trc
-   USE trc
-
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC trc_ctl_my_trc     ! called by ???
-
-
-   !!----------------------------------------------------------------------
-   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE trc_ctl_my_trc
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE trc_ctl_pisces  ***
-      !!
-      !! ** Purpose :   control the cpp options, namelist and files 
-      !!----------------------------------------------------------------------
-
-      INTEGER :: jl, jn
-
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) ' use COLOR tracer '
-
-      DO jl = 1, jp_my_trc
-         jn = jp_myt0 + jl - 1
-         WRITE(ctrcnm(jn),'(a,i2.2)') 'CLR',jn
-         ctrcnl(jn)='Color concentration'
-         ctrcun(jn)='N/A'
-      END DO
-
-
-   END SUBROUTINE trc_ctl_my_trc
-
-#else
-   !!----------------------------------------------------------------------
-   !!  Empty module :                                            No PISCES
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE trc_ctl_my_trc               ! Dummy routine
-   END SUBROUTINE trc_ctl_my_trc
-#endif
-
-   !!======================================================================
-END MODULE trcctl_my_trc
Index: trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcini_my_trc.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcini_my_trc.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcini_my_trc.F90	(revision 2528)
@@ -22,7 +22,7 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -37,5 +37,7 @@
       !! ** Method  : - Read the namcfc namelist and check the parameter values
       !!----------------------------------------------------------------------
-      !!----------------------------------------------------------------------
+
+      !  Control consitency
+      CALL trc_ctl_my_trc
 
       IF(lwp) WRITE(numout,*)
@@ -48,4 +50,26 @@
    END SUBROUTINE trc_ini_my_trc
    
+   SUBROUTINE trc_ctl_my_trc
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_ctl_pisces  ***
+      !!
+      !! ** Purpose :   control the cpp options, namelist and files 
+      !!----------------------------------------------------------------------
+
+      INTEGER :: jl, jn
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' use COLOR tracer '
+
+      DO jl = 1, jp_my_trc
+         jn = jp_myt0 + jl - 1
+         WRITE(ctrcnm(jn),'(a,i2.2)') 'CLR',jn
+         ctrcnl(jn)='Color concentration'
+         ctrcun(jn)='N/A'
+      END DO
+
+
+   END SUBROUTINE trc_ctl_my_trc
+
 #else
    !!----------------------------------------------------------------------
Index: trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trclsm_my_trc.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trclsm_my_trc.F90	(revision 2527)
+++ 	(revision )
@@ -1,58 +1,0 @@
-MODULE trclsm_my_trc
-   !!======================================================================
-   !!                      ***  MODULE trclsm_my_trc  ***
-   !! TOP :   initialisation of some run parameters for LOBSTER bio-model
-   !!======================================================================
-   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) Original code
-   !!----------------------------------------------------------------------
-#if defined key_my_trc
-   !!----------------------------------------------------------------------
-   !!   'key_my_trc'   :                                       MY_TRC model
-   !!----------------------------------------------------------------------
-   !! trc_lsm_my_trc      : MY_TRC model initialisation
-   !!----------------------------------------------------------------------
-   USE oce_trc         ! Ocean variables
-   USE par_trc         ! TOP parameters
-   USE trc             ! TOP variables
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   trc_lsm_my_trc   ! called by trclsm.F90 module
-
-   !!----------------------------------------------------------------------
-   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE trc_lsm_my_trc
-      !!----------------------------------------------------------------------
-      !!                     ***  trc_lsm_my_trc  ***  
-      !!
-      !! ** Purpose :   read MY_TRC namelist
-      !!
-      !! ** input   :   file 'namelist.trc.sms' containing the following
-      !!             namelist: natbio, natopt, and natdbi ("key_trc_diabio")
-      !!----------------------------------------------------------------------
-      !!----------------------------------------------------------------------
-      !
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) ' trc_lsm_my_trc : read MY_TRC namelists'
-      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~'
-      !
-   END SUBROUTINE trc_lsm_my_trc
-   
-#else
-   !!----------------------------------------------------------------------
-   !!  Dummy module :                                             No MY_TRC
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE trc_lsm_my_trc                      ! Empty routine
-   END  SUBROUTINE  trc_lsm_my_trc
-#endif  
-
-   !!======================================================================
-END MODULE trclsm_my_trc
Index: trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcnam_my_trc.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcnam_my_trc.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcnam_my_trc.F90	(revision 2528)
@@ -0,0 +1,55 @@
+MODULE trcnam_my_trc
+   !!======================================================================
+   !!                      ***  MODULE trcnam_my_trc  ***
+   !! TOP :   initialisation of some run parameters for LOBSTER bio-model
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) Original code
+   !!----------------------------------------------------------------------
+#if defined key_my_trc
+   !!----------------------------------------------------------------------
+   !!   'key_my_trc'   :                                       MY_TRC model
+   !!----------------------------------------------------------------------
+   !! trc_nam_my_trc      : MY_TRC model initialisation
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! Ocean variables
+   USE par_trc         ! TOP parameters
+   USE trc             ! TOP variables
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_nam_my_trc   ! called by trcnam.F90 module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_nam_my_trc
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_nam_my_trc  ***  
+      !!
+      !! ** Purpose :   read MY_TRC namelist
+      !!
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_nam_my_trc : read MY_TRC namelists'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~'
+      !
+   END SUBROUTINE trc_nam_my_trc
+   
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                             No MY_TRC
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_nam_my_trc                      ! Empty routine
+   END  SUBROUTINE  trc_nam_my_trc
+#endif  
+
+   !!======================================================================
+END MODULE trcnam_my_trc
Index: trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90	(revision 2528)
@@ -15,6 +15,6 @@
    USE oce_trc         ! Ocean variables
    USE trc             ! TOP variables
-   USE trdmld_trc_oce
-   USE trdmld_trc
+   USE trdmod_oce
+   USE trdmod_trc
 
    IMPLICIT NONE
@@ -24,7 +24,7 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -64,5 +64,5 @@
           DO jn = jp_myt0, jp_myt1
             ztrmyt(:,:,:) = tra(:,:,:,jn)
-            CALL trd_mod_trc( ztrmyt, jn, jptrc_trd_sms, kt )   ! save trends
+            CALL trd_mod_trc( ztrmyt, jn, jptra_trd_sms, kt )   ! save trends
           END DO
       END IF
Index: trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zbio.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zbio.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zbio.F90	(revision 2528)
@@ -41,7 +41,7 @@
 #  include "top_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -84,11 +84,11 @@
       CALL p4z_sink ( kt, jnt )     ! vertical flux of particulate organic matter
       CALL p4z_opt  ( kt, jnt )     ! Optic: PAR in the water column
-      CALL p4z_lim  ( kt, jnt )     ! co-limitations by the various nutrients
+      CALL p4z_lim  ( kt      )     ! co-limitations by the various nutrients
       CALL p4z_prod ( kt, jnt )     ! phytoplankton growth rate over the global ocean. 
       !                             ! (for each element : C, Si, Fe, Chl )
-      CALL p4z_rem  ( kt, jnt )     ! remineralization terms of organic matter+scavenging of Fe
-      CALL p4z_mort ( kt, jnt )     ! phytoplankton mortality
+      CALL p4z_rem  ( kt      )     ! remineralization terms of organic matter+scavenging of Fe
+      CALL p4z_mort ( kt      )     ! phytoplankton mortality
       !                             ! zooplankton sources/sinks routines 
-      CALL p4z_micro( kt, jnt )           ! microzooplankton
+      CALL p4z_micro( kt      )           ! microzooplankton
       CALL p4z_meso ( kt, jnt )           ! mesozooplankton
 
Index: trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zche.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zche.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zche.F90	(revision 2528)
@@ -149,7 +149,7 @@
 #include "top_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -181,8 +181,8 @@
 
             !                             ! SET ABSOLUTE TEMPERATURE
-            ztkel = tn(ji,jj,1) + 273.16
+            ztkel = tsn(ji,jj,1,jp_tem) + 273.16
             zqtt  = ztkel * 0.01
             zqtt2 = zqtt * zqtt
-            zsal  = sn(ji,jj,1) + (1.- tmask(ji,jj,1) ) * 35.
+            zsal  = tsn(ji,jj,1,jp_sal) + (1.- tmask(ji,jj,1) ) * 35.
             zlqtt = LOG( zqtt )
 
@@ -214,7 +214,7 @@
 
                ! SET ABSOLUTE TEMPERATURE
-               ztkel   = tn(ji,jj,jk) + 273.16
+               ztkel   = tsn(ji,jj,jk,jp_tem) + 273.16
                zqtt    = ztkel * 0.01
-               zsal    = sn(ji,jj,jk) + ( 1.-tmask(ji,jj,jk) ) * 35.
+               zsal    = tsn(ji,jj,jk,jp_sal) + ( 1.-tmask(ji,jj,jk) ) * 35.
                zsqrt  = SQRT( zsal )
                zsal15  = zsqrt * zsal
@@ -224,5 +224,5 @@
                zis2   = zis * zis
                zisqrt = SQRT( zis )
-               ztc     = tn(ji,jj,jk) + ( 1.- tmask(ji,jj,jk) ) * 20.
+               ztc     = tsn(ji,jj,jk,jp_tem) + ( 1.- tmask(ji,jj,jk) ) * 20.
 
                ! CHLORINITY (WOOSTER ET AL., 1969)
@@ -249,6 +249,6 @@
                   &    + ( cb8 + cb9 * zsqrt + cb10 * zsal ) * zlogt + cb11 * zsqrt * ztkel             &
                   &    + LOG(  ( 1.+ zst / zcks + zft / zckf ) / ( 1.+ zst / zcks )  )
-!!gm zsal**2 to be replaced by a *...
-               zck1    = c10 * ztr + c11 + c12 * zlogt + c13 * zsal + c14 * zsal**2
+
+               zck1    = c10 * ztr + c11 + c12 * zlogt + c13 * zsal + c14 * zsal * zsal
                zck2    = c20 * ztr + c21 + c22 * zsal   + c23 * zsal**2
 
Index: trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zflx.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zflx.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zflx.F90	(revision 2528)
@@ -28,4 +28,5 @@
 #endif
    USE lib_mpp
+   USE lib_fortran
 
    IMPLICIT NONE
@@ -33,28 +34,21 @@
 
    PUBLIC   p4z_flx  
-
-   REAL(wp) :: &  ! pre-industrial atmospheric [co2] (ppm) 	
-      atcox  = 0.20946 ,    &  !:
-      atcco2 = 278.            !:
-
-   REAL(wp) :: &
-      xconv  = 0.01/3600      !: coefficients for conversion 
-
-   INTEGER  ::  nspyr         !: number of timestep per year
-
-#if defined key_cpl_carbon_cycle
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::  &
-      oce_co2            !: ocean carbon flux
-   REAL(wp) :: &
-      t_atm_co2_flx,  &  !: Total atmospheric carbon flux per year
-      t_oce_co2_flx      !: Total ocean carbon flux per year
-#endif
+   PUBLIC   p4z_flx_init  
+
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::  oce_co2            !: ocean carbon flux 
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::  satmco2            !: atmospheric pco2
+   REAL(wp)                             ::  t_oce_co2_flx      !: Total ocean carbon flux 
+   REAL(wp)                             ::  t_atm_co2_flx      !: global mean of atmospheric pco2
+   REAL(wp)                             ::  area               !: ocean surface
+   REAL(wp)                             ::  atcco2 = 278.      !: pre-industrial atmospheric [co2] (ppm) 	
+   REAL(wp)                             ::  atcox  = 0.20946   !:
+   REAL(wp)                             ::  xconv  = 0.01/3600 !: coefficients for conversion 
 
    !!* Substitution
 #  include "top_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -75,17 +69,18 @@
       REAL(wp) ::   zph, zah2, zbot, zdic, zalk, zsch_o2, zalka, zsch_co2
       REAL(wp), DIMENSION(jpi,jpj) ::   zkgco2, zkgo2, zh2co3
-#if defined key_trc_diaadd && defined key_iomput
-      REAL(wp), DIMENSION(jpi,jpj) ::  zcflx, zoflx, zkg, zdpco2, zdpo2
+#if defined key_diatrc && defined key_iomput
+      REAL(wp), DIMENSION(jpi,jpj) ::  zoflx, zkg, zdpco2, zdpo2
 #endif
       CHARACTER (len=25) :: charout
 
       !!---------------------------------------------------------------------
-
-
-      IF( kt == nittrc000  )   CALL p4z_flx_init      ! Initialization (first time-step only)
 
       ! SURFACE CHEMISTRY (PCO2 AND [H+] IN
       !     SURFACE LAYER); THE RESULT OF THIS CALCULATION
       !     IS USED TO COMPUTE AIR-SEA FLUX OF CO2
+
+#if defined key_cpl_carbon_cycle
+      satmco2(:,:) = atm_co2(:,:)
+#endif
 
       DO jrorr = 1, 10
@@ -128,5 +123,5 @@
 !CDIR NOVERRCHK
          DO ji = 1, jpi
-            ztc  = MIN( 35., tn(ji,jj,1) )
+            ztc  = MIN( 35., tsn(ji,jj,1,jp_tem) )
             ztc2 = ztc * ztc
             ztc3 = ztc * ztc2 
@@ -138,5 +133,5 @@
             ! Compute the piston velocity for O2 and CO2
             zkgwan = 0.3 * zws  + 2.5 * ( 0.5246 + 0.016256 * ztc + 0.00049946  * ztc2 )
-# if defined key_off_degrad
+# if defined key_degrad
             zkgwan = zkgwan * xconv * ( 1.- fr_i(ji,jj) ) * tmask(ji,jj,1) * facvol(ji,jj,1)
 #else
@@ -152,14 +147,9 @@
          DO ji = 1, jpi
             ! Compute CO2 flux for the sea and air
-#if ! defined key_cpl_carbon_cycle
-            zfld = atcco2 * tmask(ji,jj,1) * chemc(ji,jj,1) * zkgco2(ji,jj)
+            zfld = satmco2(ji,jj) * tmask(ji,jj,1) * chemc(ji,jj,1) * zkgco2(ji,jj)
             zflu = zh2co3(ji,jj) * tmask(ji,jj,1) * zkgco2(ji,jj)
-#else
-            zfld = atm_co2(ji,jj) * tmask(ji,jj,1) * chemc(ji,jj,1) * zkgco2(ji,jj)
-            zflu = zh2co3(ji,jj) * tmask(ji,jj,1) * zkgco2(ji,jj)
-            ! compute flux of carbon
             oce_co2(ji,jj) = ( zfld - zflu ) * rfact &
                &             * e1t(ji,jj) * e2t(ji,jj) * tmask(ji,jj,1) * 1000.
-#endif
+            ! compute the trend
             tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + ( zfld - zflu ) / fse3t(ji,jj,1)
 
@@ -169,20 +159,18 @@
             tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + ( zfld16 - zflu16 ) / fse3t(ji,jj,1)
 
-#if defined key_trc_diaadd 
+#if defined key_diatrc 
             ! Save diagnostics
 #  if ! defined key_iomput
-            trc2d(ji,jj,jp_pcs0_2d    ) = ( zfld - zflu )     * 1000. * tmask(ji,jj,1)
+            zfact = 1. / ( e1t(ji,jj) * e2t(ji,jj) ) / rfact
+            trc2d(ji,jj,jp_pcs0_2d    ) = oce_co2(ji,jj) * zfact
             trc2d(ji,jj,jp_pcs0_2d + 1) = ( zfld16 - zflu16 ) * 1000. * tmask(ji,jj,1)
             trc2d(ji,jj,jp_pcs0_2d + 2) = zkgco2(ji,jj) * tmask(ji,jj,1)
-            trc2d(ji,jj,jp_pcs0_2d + 3) = ( atcco2 - zh2co3(ji,jj) / ( chemc(ji,jj,1) + rtrn ) ) &
+            trc2d(ji,jj,jp_pcs0_2d + 3) = ( satmco2(ji,jj) - zh2co3(ji,jj) / ( chemc(ji,jj,1) + rtrn ) ) &
                &                            * tmask(ji,jj,1)
 #  else
-            zcflx(ji,jj) = ( zfld - zflu ) * 1000.  * tmask(ji,jj,1)
             zoflx(ji,jj) = ( zfld16 - zflu16 ) * 1000. * tmask(ji,jj,1)
             zkg  (ji,jj) = zkgco2(ji,jj) * tmask(ji,jj,1)
-            zdpco2(ji,jj) = ( atcco2 - zh2co3(ji,jj)      / ( chemc(ji,jj,1) + rtrn ) ) &
-              &             * tmask(ji,jj,1)
-            zdpo2 (ji,jj) = ( atcox  - trn(ji,jj,1,jpoxy) / ( chemc(ji,jj,2) + rtrn ) ) &
-              &             * tmask(ji,jj,1)
+            zdpco2(ji,jj) = ( satmco2(ji,jj) - zh2co3(ji,jj) / ( chemc(ji,jj,1) + rtrn ) ) * tmask(ji,jj,1)
+            zdpo2 (ji,jj) = ( atcox  - trn(ji,jj,1,jpoxy) / ( chemc(ji,jj,2) + rtrn ) ) * tmask(ji,jj,1)
 #  endif
 #endif
@@ -190,35 +178,21 @@
       END DO
 
-#if defined key_cpl_carbon_cycle
-      ! Total Flux of Carbon
-      DO jj = 1, jpj 
-        DO ji = 1, jpi
-           t_atm_co2_flx = t_atm_co2_flx + atm_co2(ji,jj) * tmask_i(ji,jj)
-           t_oce_co2_flx = t_oce_co2_flx + oce_co2(ji,jj) * tmask_i(ji,jj)
-        END DO
-      END DO
-
-      IF( MOD( kt, nspyr ) == 0 ) THEN
-        IF( lk_mpp ) THEN
-          CALL mpp_sum( t_atm_co2_flx )   ! sum over the global domain
-          CALL mpp_sum( t_oce_co2_flx )   ! sum over the global domain
-        ENDIF
-        ! Conversion in GtC/yr ; negative for outgoing from ocean
-        t_oce_co2_flx = (-1.) * t_oce_co2_flx  * 12. / 1.e15
-        !
-        WRITE(numout,*) ' Atmospheric pCO2    :'
-        WRITE(numout,*) '-------------------- : ',kt,'  ',t_atm_co2_flx
-        WRITE(numout,*) '(ppm)'
-        WRITE(numout,*) 'Total Flux of Carbon out of the ocean :'
-        WRITE(numout,*) '-------------------- : ',t_oce_co2_flx
-        WRITE(numout,*) '(GtC/yr)'
-        t_atm_co2_flx = 0.
-        t_oce_co2_flx = 0.
-# if defined key_iomput
-        CALL iom_put( "tatpco2" , t_atm_co2_flx  )
-        CALL iom_put( "tco2flx" , t_oce_co2_flx  )
-#endif
+      t_oce_co2_flx = t_oce_co2_flx + glob_sum( oce_co2(:,:) )                     ! Cumulative Total Flux of Carbon
+      IF( kt == nitend ) THEN
+         t_atm_co2_flx = glob_sum( satmco2(:,:) * e1t(:,:) * e2t(:,:) )            ! Total atmospheric pCO2
+         !
+         t_oce_co2_flx = (-1.) * t_oce_co2_flx  * 12. / 1.e15                      ! Conversion in PgC ; negative for out of the ocean
+         t_atm_co2_flx = t_atm_co2_flx  / area                                     ! global mean of atmospheric pCO2
+         !
+         IF( lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' Global mean of atmospheric pCO2 (ppm) at it= ', kt, ' date= ', ndastp
+            WRITE(numout,*) '------------------------------------------------------- :  ',t_atm_co2_flx
+            WRITE(numout,*)
+            WRITE(numout,*) ' Cumulative total Flux of Carbon out of the ocean (PgC) :'
+            WRITE(numout,*) '-------------------------------------------------------  ',t_oce_co2_flx
+         ENDIF
+         !
       ENDIF
-#endif
 
       IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
@@ -228,6 +202,6 @@
       ENDIF
 
-# if defined key_trc_diaadd && defined key_iomput
-      CALL iom_put( "Cflx" , zcflx  )
+# if defined key_diatrc && defined key_iomput
+      CALL iom_put( "Cflx" , oce_co2(:,:) / ( e1t(:,:) * e2t(:,:) ) / rfact  )
       CALL iom_put( "Oflx" , zoflx  )
       CALL iom_put( "Kg"   , zkg    )
@@ -246,5 +220,5 @@
       !!
       !! ** Method  :   Read the nampisext namelist and check the parameters
-      !!      called at the first timestep (nittrc000)
+      !!      called at the first timestep (nit000)
       !! ** input   :   Namelist nampisext
       !!
@@ -263,13 +237,13 @@
       ENDIF
 
-      ! number of time step per year  
-      nspyr = INT( nyear_len(1) * rday / rdt )
-
-#if defined key_cpl_carbon_cycle
+      ! interior global domain surface
+      area = glob_sum( e1t(:,:) * e2t(:,:) )  
+
       ! Initialization of Flux of Carbon
-      oce_co2(:,:) = 0.
-      t_atm_co2_flx = 0.
-      t_oce_co2_flx = 0.
-#endif
+      oce_co2(:,:)  = 0._wp
+      t_atm_co2_flx = 0._wp
+      ! Initialisation of atmospheric pco2
+      satmco2(:,:)  = atcco2
+      t_oce_co2_flx = 0._wp
 
    END SUBROUTINE p4z_flx_init
Index: trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zint.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zint.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zint.F90	(revision 2528)
@@ -32,7 +32,7 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -55,6 +55,6 @@
       ! -------------------------------------------
 
-      tgfunc (:,:,:) = EXP( 0.063913 * tn(:,:,:) )
-      tgfunc2(:,:,:) = EXP( 0.07608  * tn(:,:,:) )
+      tgfunc (:,:,:) = EXP( 0.063913 * tsn(:,:,:,jp_tem) )
+      tgfunc2(:,:,:) = EXP( 0.07608  * tsn(:,:,:,jp_tem) )
 
       ! Computation of the silicon dependant half saturation
@@ -69,5 +69,5 @@
       END DO
 
-      IF( nday_year == 365 ) THEN
+      IF( nday_year == nyear_len(1) ) THEN
          xksi    = xksimax
          xksimax = 0.e0
Index: trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zlim.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zlim.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zlim.F90	(revision 2528)
@@ -23,4 +23,5 @@
 
    PUBLIC p4z_lim    
+   PUBLIC p4z_lim_init    
 
    !! * Shared module variables
@@ -43,12 +44,12 @@
 #  include "top_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
 CONTAINS
 
-   SUBROUTINE p4z_lim( kt, jnt )
+   SUBROUTINE p4z_lim( kt )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_lim  ***
@@ -59,5 +60,5 @@
       !! ** Method  : - ???
       !!---------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt, jnt ! ocean time step
+      INTEGER, INTENT(in)  :: kt
       INTEGER  ::   ji, jj, jk
       REAL(wp) ::   zlim1, zlim2, zlim3, zlim4, zno3, zferlim
@@ -67,10 +68,7 @@
 
 
-      IF( ( kt * jnt ) == nittrc000  )   CALL p4z_lim_init      ! Initialization (first time-step only)
-
-
-!  Tuning of the iron concentration to a minimum
-!  level that is set to the detection limit
-!  -------------------------------------
+      !  Tuning of the iron concentration to a minimum
+      !  level that is set to the detection limit
+      !  -------------------------------------
 
       DO jk = 1, jpkm1
@@ -85,8 +83,7 @@
       END DO
 
-!  Computation of a variable Ks for iron on diatoms
-!  taking into account that increasing biomass is
-!  made of generally bigger cells
-!  ------------------------------------------------
+      !  Computation of a variable Ks for iron on diatoms taking into account
+      !  that increasing biomass is made of generally bigger cells
+      !  ------------------------------------------------
 
       DO jk = 1, jpkm1
@@ -107,11 +104,9 @@
       END DO
 
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-    
-!      Michaelis-Menten Limitation term for nutrients
-!      Small flagellates
-!      -----------------------------------------------
+     !  Michaelis-Menten Limitation term for nutrients Small flagellates
+     !      -----------------------------------------------
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
               zdenom = 1. / &
                   & ( conc0 * concnnh4 + concnnh4 * trn(ji,jj,jk,jpno3) + conc0 * trn(ji,jj,jk,jpnh4) )
@@ -132,10 +127,9 @@
       END DO
 
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-
-!   Michaelis-Menten Limitation term for nutrients Diatoms
-!   ----------------------------------------------
+      !   Michaelis-Menten Limitation term for nutrients Diatoms
+      !   ----------------------------------------------
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
               zdenom = 1. / &
                   & ( conc1 * concdnh4 + concdnh4 * trn(ji,jj,jk,jpno3) + conc1 * trn(ji,jj,jk,jpnh4) )
@@ -161,5 +155,5 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-               ztemp = MAX( 0., tn(ji,jj,jk) )
+               ztemp = MAX( 0., tsn(ji,jj,jk,jp_tem) )
                xfracal(ji,jj,jk) = caco3r * xlimphy(ji,jj,jk)   &
                   &                       * MAX( 0.0001, ztemp / ( 2.+ ztemp ) )   &
@@ -181,5 +175,5 @@
       !!
       !! ** Method  :   Read the nampislim namelist and check the parameters
-      !!      called at the first timestep (nittrc000)
+      !!      called at the first timestep (nit000)
       !!
       !! ** input   :   Namelist nampislim
Index: trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zlys.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zlys.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zlys.F90	(revision 2528)
@@ -27,5 +27,6 @@
    PRIVATE
 
-   PUBLIC   p4z_lys    ! called in p4zprg.F90
+   PUBLIC   p4z_lys         ! called in trcsms_pisces.F90
+   PUBLIC   p4z_lys_init    ! called in trcsms_pisces.F90
 
    !! * Shared module variables
@@ -42,7 +43,7 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -65,5 +66,5 @@
       REAL(wp) ::   zomegaca, zexcess, zexcess0
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zco3
-#if defined key_trc_dia3d && defined key_iomput
+#if defined key_diatrc && defined key_iomput
       REAL(wp) ::   zrfact2
       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zcaldiss
@@ -72,9 +73,7 @@
       !!---------------------------------------------------------------------
 
-      IF( kt == nittrc000  )   CALL p4z_lys_init      ! Initialization (first time-step only)
-
       zco3(:,:,:) = 0.
 
-# if defined key_trc_dia3d && defined key_iomput
+# if defined key_diatrc && defined key_iomput
       zcaldiss(:,:,:) = 0.
 # endif
@@ -146,5 +145,5 @@
                !       (ACCORDING TO THIS FORMULATION ALSO SOME PARTICULATE
                !       CACO3 GETS DISSOLVED EVEN IN THE CASE OF OVERSATURATION)
-# if defined key_off_degrad
+# if defined key_degrad
               zdispot = kdca * zexcess * trn(ji,jj,jk,jpcal) * facvol(ji,jj,jk)
 # else
@@ -160,5 +159,5 @@
               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) +      zremco3
 
-# if defined key_trc_dia3d && defined key_iomput
+# if defined key_diatrc && defined key_iomput
               zcaldiss(ji,jj,jk) = zremco3  ! calcite dissolution
 # endif
@@ -167,5 +166,5 @@
       END DO
 
-# if defined key_trc_diaadd &&  defined key_trc_dia3d
+# if defined key_diatrc
 #  if ! defined key_iomput
       trc3d(:,:,:,jp_pcs0_3d    ) = hi  (:,:,:)          * tmask(:,:,:)
@@ -197,5 +196,5 @@
       !!
       !! ** Method  :   Read the nampiscal namelist and check the parameters
-      !!      called at the first timestep (nittrc000)
+      !!      called at the first timestep (nit000)
       !!
       !! ** input   :   Namelist nampiscal
Index: trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmeso.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmeso.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmeso.F90	(revision 2528)
@@ -26,5 +26,6 @@
    PRIVATE
 
-   PUBLIC   p4z_meso         ! called in p4zbio.F90
+   PUBLIC   p4z_meso              ! called in p4zbio.F90
+   PUBLIC   p4z_meso_init         ! called in trcsms_pisces.F90
 
    !! * Shared module variables
@@ -47,12 +48,12 @@
 #  include "top_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
 CONTAINS
 
-   SUBROUTINE p4z_meso( kt,jnt )
+   SUBROUTINE p4z_meso( kt, jnt )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_meso  ***
@@ -65,35 +66,18 @@
       INTEGER  :: ji, jj, jk
       REAL(wp) :: zcompadi, zcompaph, zcompapoc, zcompaz
-      REAL(wp) :: zfact, zstep, zcompam, zdenom, zgraze2
+      REAL(wp) :: zfact, zcompam, zdenom, zgraze2, zstep
       REAL(wp) :: zgrarem2, zgrafer2, zgrapoc2, zprcaca, zmortz2
 #if defined key_kriest
       REAL znumpoc
 #endif
-      REAL(wp),DIMENSION(jpi,jpj,jpk) :: zrespz2,ztortz2,zgrazd,zgrazz,zgrazpof
-      REAL(wp),DIMENSION(jpi,jpj,jpk) :: zgrazn,zgrazpoc,zgraznf,zgrazf
-      REAL(wp),DIMENSION(jpi,jpj,jpk) :: zgrazfff,zgrazffe
+      REAL(wp) :: zrespz2,ztortz2,zgrazd,zgrazz,zgrazpof
+      REAL(wp) :: zgrazn,zgrazpoc,zgraznf,zgrazf
+      REAL(wp) :: zgrazfff,zgrazffe
       CHARACTER (len=25) :: charout
-#if defined key_trc_diaadd && defined key_trc_dia3d && defined key_iomput
+#if defined key_diatrc && defined key_iomput
       REAL(wp) :: zrfact2
 #endif
 
       !!---------------------------------------------------------------------
-
-
-      IF( ( kt * jnt ) == nittrc000  )   CALL p4z_meso_init      ! Initialization (first time-step only)
-
-      zrespz2 (:,:,:) = 0.
-      ztortz2 (:,:,:) = 0.
-      zgrazd  (:,:,:) = 0.
-      zgrazz  (:,:,:) = 0.
-      zgrazpof(:,:,:) = 0.
-      zgrazn  (:,:,:) = 0.
-      zgrazpoc(:,:,:) = 0.
-      zgraznf (:,:,:) = 0.
-      zgrazf  (:,:,:) = 0.
-      zgrazfff(:,:,:) = 0.
-      zgrazffe(:,:,:) = 0.
-
-      zstep = rfact2 / rday      ! Time step duration for biology
 
       DO jk = 1, jpkm1
@@ -102,29 +86,22 @@
 
                zcompam = MAX( ( trn(ji,jj,jk,jpmes) - 1.e-9 ), 0.e0 )
-# if defined key_off_degrad
-               zfact   = zstep * tgfunc(ji,jj,jk) * zcompam * facvol(ji,jj,jk)
+# if defined key_degrad
+               zstep   = xstep * facvol(ji,jj,jk)
 # else
+               zstep   = xstep
+# endif
                zfact   = zstep * tgfunc(ji,jj,jk) * zcompam
-# endif
-
-!     Respiration rates of both zooplankton
-!     -------------------------------------
-               zrespz2(ji,jj,jk)  = resrat2 * zfact * ( 1. + 3. * nitrfac(ji,jj,jk) )        &
+
+               !  Respiration rates of both zooplankton
+               !  -------------------------------------
+               zrespz2  = resrat2 * zfact * ( 1. + 3. * nitrfac(ji,jj,jk) )        &
                   &     * trn(ji,jj,jk,jpmes) / ( xkmort + trn(ji,jj,jk,jpmes) )
 
-!     Zooplankton mortality. A square function has been selected with
-!     no real reason except that it seems to be more stable and may
-!     mimic predation.
-!     ---------------------------------------------------------------
-               ztortz2(ji,jj,jk) = mzrat2 * 1.e6 * zfact * trn(ji,jj,jk,jpmes)
+               !  Zooplankton mortality. A square function has been selected with
+               !  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)
                !
-            END DO
-         END DO
-      END DO
-
-
-      DO jk = 1,jpkm1
-         DO jj = 1,jpj
-            DO ji = 1,jpi
+
                zcompadi  = MAX( ( trn(ji,jj,jk,jpdia) - 1.e-8 ), 0.e0 )
                zcompaz   = MAX( ( trn(ji,jj,jk,jpzoo) - 1.e-8 ), 0.e0 )
@@ -132,6 +109,6 @@
                zcompapoc = MAX( ( trn(ji,jj,jk,jppoc) - 1.e-8 ), 0.e0 )
 
-!     Microzooplankton grazing
-!     ------------------------
+               !  Microzooplankton grazing
+               !     ------------------------
                zdenom = 1. / (  xkgraz2 + xprefc   * trn(ji,jj,jk,jpdia)   &
                   &                     + xprefz   * trn(ji,jj,jk,jpzoo)   &
@@ -139,107 +116,65 @@
                   &                     + xprefpoc * trn(ji,jj,jk,jppoc)  )
 
-               zgraze2 = grazrat2 * zstep * Tgfunc2(ji,jj,jk) * zdenom    &
-# if defined key_off_degrad
-                  &     * facvol(ji,jj,jk)          &
+               zgraze2 = grazrat2 * zstep * Tgfunc2(ji,jj,jk) * zdenom * trn(ji,jj,jk,jpmes) 
+
+               zgrazd   = zgraze2  * xprefc   * zcompadi
+               zgrazz   = zgraze2  * xprefz   * zcompaz
+               zgrazn   = zgraze2  * xprefp   * zcompaph
+               zgrazpoc = zgraze2  * xprefpoc * zcompapoc
+
+               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)
+               
+               !  Mesozooplankton flux feeding on GOC
+               !  ----------------------------------
+# if ! defined key_kriest
+               zgrazffe = grazflux * zstep * wsbio4(ji,jj,jk)          &
+                  &                 * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpmes)
+               zgrazfff = zgrazffe * trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn)
+# else
+               !!--------------------------- KRIEST3 -------------------------------------------
+               !!               zgrazffe = 0.5 * 1.3e-2 / 5.5e-7 * 0.3 * zstep * wsbio3(ji,jj,jk)     &
+               !!                  &     * tgfunc(ji,jj,jk) * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpmes)    &
+               !! #  if defined key_degrad
+               !!                  &     * facvol(ji,jj,jk)          &
+               !! #  endif
+               !!                  &     /  (trn(ji,jj,jk,jppoc) * 1.e7 + 0.1)
+               !!--------------------------- KRIEST3 -------------------------------------------
+
+              zgrazffe = grazflux * zstep * wsbio3(ji,jj,jk)     &
+                  &                * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpmes)
+              zgrazfff = zgrazffe * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)
 # endif
-                  &     * trn(ji,jj,jk,jpmes)
-
-               zgrazd(ji,jj,jk)   = zgraze2 * xprefc   * zcompadi
-               zgrazz(ji,jj,jk)   = zgraze2 * xprefz   * zcompaz
-               zgrazn(ji,jj,jk)   = zgraze2 * xprefp   * zcompaph
-               zgrazpoc(ji,jj,jk) = zgraze2 * xprefpoc * zcompapoc
-
-               zgraznf(ji,jj,jk)  = zgrazn(ji,jj,jk)   * trn(ji,jj,jk,jpnfe) &
-                  &                                     / (trn(ji,jj,jk,jpphy) + rtrn)
-               zgrazf(ji,jj,jk)   = zgrazd(ji,jj,jk)   * trn(ji,jj,jk,jpdfe) &
-                  &                                    / (trn(ji,jj,jk,jpdia) + rtrn)
-               zgrazpof(ji,jj,jk) = zgrazpoc(ji,jj,jk) * trn(ji,jj,jk,jpsfe) &
-                  &                                   / (trn(ji,jj,jk,jppoc) + rtrn)
-            END DO
-         END DO
-      END DO
       
-      
-      DO jk = 1,jpkm1
-         DO jj = 1,jpj
-            DO ji = 1,jpi
-               
-!    Mesozooplankton flux feeding on GOC
-!    ----------------------------------
-# if ! defined key_kriest
-#   if ! defined key_off_degrad
-               zgrazffe(ji,jj,jk) = grazflux * zstep * wsbio4(ji,jj,jk)          &
-                  &                 * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpmes)
-#   else
-               zgrazffe(ji,jj,jk) = grazflux * zstep * wsbio4(ji,jj,jk) * facvol(ji,jj,jk)         &
-                  &                 * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpmes)
-#  endif
-               zgrazfff(ji,jj,jk) = zgrazffe(ji,jj,jk)       &
-                  &                 * trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn)
-# else
-!!--------------------------- KRIEST3 -------------------------------------------
-!!               zgrazffe(ji,jj,jk) = 0.5 * 1.3e-2 / 5.5e-7 * 0.3 * zstep * wsbio3(ji,jj,jk)     &
-!!                  &     * tgfunc(ji,jj,jk) * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpmes)    &
-#  if defined key_off_degrad
-!!                  &     * facvol(ji,jj,jk)          &
-#  endif
-!!                  &     /  (trn(ji,jj,jk,jppoc) * 1.e7 + 0.1)
-!!--------------------------- KRIEST3 -------------------------------------------
-
-#  if ! defined key_off_degrad
-              zgrazffe(ji,jj,jk) = grazflux * zstep * wsbio3(ji,jj,jk)     &
-                  &                * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpmes)
-#  else
-              zgrazffe(ji,jj,jk) = grazflux * zstep * wsbio3(ji,jj,jk) * facvol(ji,jj,jk)    &
-                  &               * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpmes)
-#  endif
-
-               zgrazfff(ji,jj,jk) = zgrazffe(ji,jj,jk)      &
-                  &                * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)
-# endif
-            END DO
-         END DO
-      END DO
-      
-#if defined key_trc_dia3d
-      ! Total grazing ( grazing by microzoo is already computed in p4zmicro ) 
-      grazing(:,:,:) = grazing(:,:,:) + (  zgrazd  (:,:,:) + zgrazz  (:,:,:) + zgrazn(:,:,:) &
-                     &                   + zgrazpoc(:,:,:) + zgrazffe(:,:,:)  )
-#endif
-
-
-      DO jk = 1,jpkm1
-         DO jj = 1,jpj
-            DO ji = 1,jpi
-
-!    Mesozooplankton efficiency
-!    --------------------------
-               zgrarem2 = ( zgrazd(ji,jj,jk) + zgrazz(ji,jj,jk) + zgrazn(ji,jj,jk) &
-                  &     + zgrazpoc(ji,jj,jk) + zgrazffe(ji,jj,jk) )   &
-                  &     * ( 1. - epsher2 - unass2 )
+#if defined key_diatrc
+              ! Total grazing ( grazing by microzoo is already computed in p4zmicro ) 
+              grazing(ji,jj,jk) = grazing(ji,jj,jk) + (  zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffe )
+#endif
+
+              !    Mesozooplankton efficiency
+              !    --------------------------
+              zgrarem2 = ( zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffe ) * ( 1. - epsher2 - unass2 )
 #if ! defined key_kriest
-               zgrafer2 = (zgrazf(ji,jj,jk) + zgraznf(ji,jj,jk) + zgrazz(ji,jj,jk) &
-                  &     * ferat3 + zgrazpof(ji,jj,jk) + zgrazfff (ji,jj,jk))*(1.-epsher2-unass2) &
-                  &     + epsher2 * ( &
-                  &      zgrazd(ji,jj,jk)   * MAX((trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn)-ferat3),0.) &
-                  &     + zgrazn(ji,jj,jk)   * MAX((trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn)-ferat3),0.) &
-                  &    + zgrazpoc(ji,jj,jk) * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)-ferat3),0.) &
-                  &    + zgrazffe(ji,jj,jk) * MAX((trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn)-ferat3),0.)  )
+              zgrafer2 = ( zgrazf + zgraznf + zgrazz * ferat3 + zgrazpof + zgrazfff ) * ( 1.- epsher2 - unass2 ) & 
+                  &     + epsher2 * ( zgrazd   * MAX((trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn)-ferat3),0.) &
+                  &                 + zgrazn   * MAX((trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn)-ferat3),0.) &
+                  &                 + zgrazpoc * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)-ferat3),0.) &
+                  &                 + zgrazffe * MAX((trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn)-ferat3),0.)  )
 #else
-               zgrafer2 = (zgrazf(ji,jj,jk) + zgraznf(ji,jj,jk) + zgrazz(ji,jj,jk) &
-                  &    * ferat3 + zgrazpof(ji,jj,jk) + zgrazfff(ji,jj,jk) )*(1.-epsher2-unass2) &
-                  &    + epsher2 * ( &
-                  &    zgrazd(ji,jj,jk)   * MAX((trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn)-ferat3),0.) &
-                  &    + zgrazn(ji,jj,jk)   * MAX((trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn)-ferat3),0.) &
-                  &    + zgrazpoc(ji,jj,jk) * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)-ferat3),0.) &
-                  &    + zgrazffe(ji,jj,jk) * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)-ferat3),0.)  )
-
-#endif
-               zgrapoc2 = (zgrazd(ji,jj,jk) + zgrazz(ji,jj,jk)  + zgrazn(ji,jj,jk) &
-                  &    + zgrazpoc(ji,jj,jk) + zgrazffe(ji,jj,jk)) * unass2
+              zgrafer2 = ( zgrazf + zgraznf + zgrazz * ferat3 + zgrazpof + zgrazfff ) * ( 1. - epsher2 - unass2 ) &
+                  &    + epsher2 * ( zgrazd   * MAX((trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn)-ferat3),0.) &
+                  &                + zgrazn   * MAX((trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn)-ferat3),0.) &
+                  &                + zgrazpoc * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)-ferat3),0.) &
+                  &                + zgrazffe * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)-ferat3),0.)  )
+
+#endif
+               !   Update the arrays TRA which contain the biological sources and sinks
+
+               zgrapoc2 =  zgrazd + zgrazz  + zgrazn + zgrazpoc + zgrazffe
 
                tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarem2 * sigma2
                tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarem2 * sigma2
-               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem2 * (1.-sigma2)
+               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem2 * ( 1. - sigma2 )
                tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarem2 * sigma2
                tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer2
@@ -247,39 +182,23 @@
                
 #if defined key_kriest
-               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc2
-               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc2 * xkr_dmeso
+               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc2 * unass2
+               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc2 * unass2 * xkr_dmeso
 #else
-               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zgrapoc2
-#endif
-            END DO
-         END DO
-      END DO
-
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               !
-               !   Update the arrays TRA which contain the biological sources and sinks
-               !   --------------------------------------------------------------------
-               zmortz2 = ztortz2(ji,jj,jk) + zrespz2(ji,jj,jk)
-               tra(ji,jj,jk,jpmes) = tra(ji,jj,jk,jpmes) - zmortz2  &
-                  &    + epsher2 * ( zgrazd(ji,jj,jk) + zgrazz(ji,jj,jk) + zgrazn(ji,jj,jk) &
-                  &    + zgrazpoc(ji,jj,jk) + zgrazffe(ji,jj,jk) )
-               tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazd(ji,jj,jk)
-               tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zgrazz(ji,jj,jk)
-               tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazn(ji,jj,jk)
-               tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazn(ji,jj,jk) * trn(ji,jj,jk,jpnch)  &
-                  &    / ( trn(ji,jj,jk,jpphy) + rtrn )
-               tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazd(ji,jj,jk) * trn(ji,jj,jk,jpdch) &
-                  &    / ( trn(ji,jj,jk,jpdia) + rtrn )
-               tra(ji,jj,jk,jpbsi) = tra(ji,jj,jk,jpbsi) - zgrazd(ji,jj,jk) * trn(ji,jj,jk,jpbsi) &
-                  &    / ( trn(ji,jj,jk,jpdia) + rtrn )
-               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) +  zgrazd(ji,jj,jk) * trn(ji,jj,jk,jpbsi) &
-                  &    / ( trn(ji,jj,jk,jpdia) + rtrn )
-               tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) -  zgraznf(ji,jj,jk)
-               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) -  zgrazf(ji,jj,jk)
-
-               zprcaca = xfracal(ji,jj,jk) * unass2 * zgrazn(ji,jj,jk)
-#if defined key_trc_dia3d
+               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zgrapoc2 * unass2
+#endif
+               zmortz2 = ztortz2 + zrespz2
+               tra(ji,jj,jk,jpmes) = tra(ji,jj,jk,jpmes) - zmortz2 + epsher2 * zgrapoc2
+               tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazd
+               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,jpbsi) = tra(ji,jj,jk,jpbsi) - zgrazd * trn(ji,jj,jk,jpbsi) / ( trn(ji,jj,jk,jpdia) + rtrn )
+               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zgrazd * trn(ji,jj,jk,jpbsi) / ( trn(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
+
+               zprcaca = xfracal(ji,jj,jk) * unass2 * zgrazn
+#if defined key_diatrc
                prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo)
 #endif
@@ -290,22 +209,15 @@
 #if defined key_kriest
                znumpoc = trn(ji,jj,jk,jpnum) / ( trn(ji,jj,jk,jppoc) + rtrn )
-               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortz2  &
-                  &    - zgrazpoc(ji,jj,jk) - zgrazffe(ji,jj,jk)    
-               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) - zgrazpoc(ji,jj,jk) * znumpoc &
-                  &    + zmortz2  * xkr_dmeso &
-                  &    - zgrazffe(ji,jj,jk)   * znumpoc * wsbio4(ji,jj,jk) &
-                  &    / ( wsbio3(ji,jj,jk) + rtrn )
+               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortz2 - zgrazpoc - zgrazffe
+               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) - zgrazpoc * znumpoc &
+                  &    + zmortz2  * xkr_dmeso - zgrazffe * znumpoc * wsbio4(ji,jj,jk) / ( wsbio3(ji,jj,jk) + rtrn )
                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz2 &
-               &       + unass2 * ( ferat3 * zgrazz(ji,jj,jk) + zgraznf(ji,jj,jk) &
-               &       + zgrazf(ji,jj,jk) + zgrazpof(ji,jj,jk) + zgrazfff(ji,jj,jk) ) &
-               &       - zgrazfff(ji,jj,jk) - zgrazpof(ji,jj,jk)
+               &       + unass2 * ( ferat3 * zgrazz + zgraznf + zgrazf + zgrazpof + zgrazfff ) - zgrazfff - zgrazpof
 #else
-               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zgrazpoc(ji,jj,jk)
-               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zmortz2 - zgrazffe(ji,jj,jk)
-               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zgrazpof(ji,jj,jk)
+               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zgrazpoc
+               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zmortz2 - zgrazffe
+               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zgrazpof
                tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + ferat3 * zmortz2 &
-               &       + unass2 * ( ferat3 * zgrazz(ji,jj,jk) + zgraznf(ji,jj,jk) &
-               &       + zgrazf(ji,jj,jk) + zgrazpof(ji,jj,jk) + zgrazfff(ji,jj,jk) ) &
-               &       - zgrazfff(ji,jj,jk)
+               &       + unass2 * ( ferat3 * zgrazz + zgraznf + zgrazf + zgrazpof + zgrazfff ) - zgrazfff
 #endif
 
@@ -314,5 +226,5 @@
       END DO
       !
-#if defined key_trc_diaadd && defined key_trc_dia3d && defined key_iomput
+#if defined key_diatrc && defined key_iomput
       zrfact2 = 1.e3 * rfact2r
       ! Total grazing of phyto by zoo
@@ -342,5 +254,5 @@
       !!
       !! ** Method  :   Read the nampismes namelist and check the parameters
-      !!      called at the first timestep (nittrc000)
+      !!      called at the first timestep (nit000)
       !!
       !! ** input   :   Namelist nampismes
@@ -373,4 +285,5 @@
       ENDIF
 
+
    END SUBROUTINE p4z_meso_init
 
Index: trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmicro.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmicro.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmicro.F90	(revision 2528)
@@ -26,5 +26,6 @@
    PRIVATE
 
-   PUBLIC   p4z_micro    ! called in p4zbio.F90
+   PUBLIC   p4z_micro         ! called in p4zbio.F90
+   PUBLIC   p4z_micro_init    ! called in trcsms_pisces.F90
 
    !! * Shared module variables
@@ -45,12 +46,12 @@
 #  include "top_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
 CONTAINS
 
-   SUBROUTINE p4z_micro( kt,jnt )
+   SUBROUTINE p4z_micro( kt )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_micro  ***
@@ -60,29 +61,19 @@
       !! ** Method  : - ???
       !!---------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt, jnt ! ocean time step
+      INTEGER, INTENT(in) ::   kt ! ocean time step
       INTEGER  :: ji, jj, jk
       REAL(wp) :: zcompadi, zcompadi2, zcompaz , zcompaph, zcompapoc
-      REAL(wp) :: zgraze  , zdenom  , zdenom2
-      REAL(wp) :: zfact   , zstep   , zinano , zidiat, zipoc
+      REAL(wp) :: zgraze  , zdenom  , zdenom2, zstep
+      REAL(wp) :: zfact   , zinano , zidiat, zipoc
       REAL(wp) :: zgrarem, zgrafer, zgrapoc, zprcaca, zmortz
-      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zrespz,ztortz
-      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazp, zgrazm, zgrazsd
-      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazmf, zgrazsf, zgrazpf
+      REAL(wp) :: zrespz, ztortz
+      REAL(wp) :: zgrazp, zgrazm, zgrazsd
+      REAL(wp) :: zgrazmf, zgrazsf, zgrazpf
       CHARACTER (len=25) :: charout
 
       !!---------------------------------------------------------------------
 
-      IF( ( kt * jnt ) == nittrc000  )   CALL p4z_micro_init      ! Initialization (first time-step only)
-
-      zrespz (:,:,:) = 0.
-      ztortz (:,:,:) = 0.
-      zgrazp (:,:,:) = 0.
-      zgrazm (:,:,:) = 0.
-      zgrazsd(:,:,:) = 0.
-      zgrazmf(:,:,:) = 0.
-      zgrazsf(:,:,:) = 0.
-      zgrazpf(:,:,:) = 0.
-
-#if defined key_trc_dia3d
+
+#if defined key_diatrc
       grazing(:,:,:) = 0.  !: Initialisation of  grazing
 #endif
@@ -93,33 +84,22 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-
                zcompaz = MAX( ( trn(ji,jj,jk,jpzoo) - 1.e-9 ), 0.e0 )
-# if defined key_off_degrad
-               zfact   = zstep * tgfunc(ji,jj,jk) * zcompaz *facvol(ji,jj,jk)
+# if defined key_degrad
+               zstep   = xstep * facvol(ji,jj,jk)
 # else
+               zstep   = xstep
+# endif
                zfact   = zstep * tgfunc(ji,jj,jk) * zcompaz
-# endif
-
-!     Respiration rates of both zooplankton
-!     -------------------------------------
-
-               zrespz(ji,jj,jk) = resrat * zfact  * ( 1.+ 3.* nitrfac(ji,jj,jk) )     &
+
+               !  Respiration rates of both zooplankton
+               !  -------------------------------------
+               zrespz = resrat * zfact  * ( 1.+ 3.* nitrfac(ji,jj,jk) )     &
                   &            * trn(ji,jj,jk,jpzoo) / ( xkmort + trn(ji,jj,jk,jpzoo) )
 
-!     Zooplankton mortality. A square function has been selected with
-!     no real reason except that it seems to be more stable and may
-!     mimic predation.
-!     ---------------------------------------------------------------
-               ztortz(ji,jj,jk) = mzrat * 1.e6 * zfact * trn(ji,jj,jk,jpzoo)
-
-            END DO
-         END DO
-      END DO
-
-
- 
-      DO jk = 1,jpkm1
-         DO jj = 1,jpj
-            DO ji = 1,jpi
+               !  Zooplankton mortality. A square function has been selected with
+               !  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  = MAX( ( trn(ji,jj,jk,jpdia) - 1.e-8 ), 0.e0 )
                zcompadi2 = MIN( zcompadi, 5.e-7 )
@@ -131,9 +111,5 @@
                zdenom2 = 1./ ( xpref2p * zcompaph + xpref2c * zcompapoc + xpref2d * zcompadi2 + rtrn )
 
-               zgraze = grazrat * zstep * tgfunc(ji,jj,jk)     &
-# if defined key_off_degrad
-                  &      * facvol(ji,jj,jk)         &
-# endif
-                  &      * trn(ji,jj,jk,jpzoo)
+               zgraze = grazrat * zstep * tgfunc(ji,jj,jk) * trn(ji,jj,jk,jpzoo)
 
                zinano = xpref2p * zcompaph  * zdenom2
@@ -143,35 +119,25 @@
                zdenom = 1./ ( xkgraz + zinano * zcompaph + zipoc * zcompapoc + zidiat * zcompadi2 )
 
-               zgrazp(ji,jj,jk)  = zgraze * zinano * zcompaph * zdenom
-               zgrazm(ji,jj,jk)  = zgraze * zipoc  * zcompapoc * zdenom
-               zgrazsd(ji,jj,jk) = zgraze * zidiat * zcompadi2 * zdenom
-
-               zgrazpf (ji,jj,jk) = zgrazp(ji,jj,jk)  * trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn)
-               zgrazmf(ji,jj,jk)  = zgrazm(ji,jj,jk)  * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)
-               zgrazsf(ji,jj,jk)  = zgrazsd(ji,jj,jk) * trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn)
-
-            END DO
-         END DO
-      END DO
-      
-#if defined key_trc_dia3d
-      ! Grazing by microzooplankton
-      grazing(:,:,:) = grazing(:,:,:) + zgrazp(:,:,:) + zgrazm(:,:,:) + zgrazsd(:,:,:) 
-#endif
-
-      DO jk = 1,jpkm1
-         DO jj = 1,jpj
-            DO ji = 1,jpi
-!    Various remineralization and excretion terms
-!    --------------------------------------------
-
-               zgrarem = (  zgrazp(ji,jj,jk) + zgrazm(ji,jj,jk)  + zgrazsd(ji,jj,jk)  ) &
-                  &          * ( 1.- epsher - unass )
-               zgrafer = (  zgrazpf(ji,jj,jk) + zgrazsf(ji,jj,jk)  + zgrazmf(ji,jj,jk)  ) &
-                  &        * ( 1.- epsher - unass ) + epsher *  &
-                  &  ( zgrazm(ji,jj,jk)  * MAX((trn(ji,jj,jk,jpsfe) /(trn(ji,jj,jk,jppoc)+ rtrn)-ferat3),0.e0) &
-                  &   + zgrazp(ji,jj,jk)  * MAX((trn(ji,jj,jk,jpnfe)/(trn(ji,jj,jk,jpphy)+ rtrn)-ferat3),0.e0) &
-                  &   + zgrazsd(ji,jj,jk) * MAX((trn(ji,jj,jk,jpdfe)/(trn(ji,jj,jk,jpdia)+ rtrn)-ferat3),0.e0 )  )
-               zgrapoc = (  zgrazp(ji,jj,jk) + zgrazm(ji,jj,jk) + zgrazsd(ji,jj,jk)  ) * unass
+               zgrazp  = zgraze * zinano * zcompaph * zdenom
+               zgrazm  = zgraze * zipoc  * zcompapoc * zdenom
+               zgrazsd = zgraze * zidiat * zcompadi2 * zdenom
+
+               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)
+#if defined key_diatrc
+               ! Grazing by microzooplankton
+               grazing(ji,jj,jk) = grazing(ji,jj,jk) + zgrazp + zgrazm + zgrazsd 
+#endif
+
+               !    Various remineralization and excretion terms
+               !    --------------------------------------------
+               zgrarem = ( zgrazp + zgrazm + zgrazsd ) * ( 1.- epsher - unass )
+               zgrafer = ( zgrazpf + zgrazsf + zgrazmf ) * ( 1.- epsher - unass ) &
+                  &      + epsher * ( zgrazm  * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc)+ rtrn)-ferat3),0.e0) & 
+                  &                 + zgrazp  * MAX((trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy)+ rtrn)-ferat3),0.e0) &
+                  &                 + zgrazsd * MAX((trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia)+ rtrn)-ferat3),0.e0 )  )
+
+               zgrapoc = (  zgrazp + zgrazm + zgrazsd ) 
 
                !  Update of the TRA arrays
@@ -183,42 +149,28 @@
                tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarem * sigma1
                tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer
-               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc
+               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc * unass
                tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarem * sigma1
 #if defined key_kriest
-               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc * xkr_ddiat
-#endif
-            END DO
-         END DO
-      END DO
-
-!
-!   Update the arrays TRA which contain the biological sources and sinks
-!   --------------------------------------------------------------------
-
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-
-               zmortz = ztortz(ji,jj,jk) + zrespz(ji,jj,jk)
-               tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zmortz  &
-                 &     + epsher * ( zgrazp(ji,jj,jk) + zgrazm(ji,jj,jk) + zgrazsd(ji,jj,jk))
-               tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazp(ji,jj,jk)
-               tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazsd(ji,jj,jk)
-               tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazp(ji,jj,jk)  &
-                 &     * trn(ji,jj,jk,jpnch)/(trn(ji,jj,jk,jpphy)+rtrn)
-               tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazsd(ji,jj,jk) &
-                 &     * trn(ji,jj,jk,jpdch)/(trn(ji,jj,jk,jpdia)+rtrn)
-               tra(ji,jj,jk,jpbsi) = tra(ji,jj,jk,jpbsi) - zgrazsd(ji,jj,jk) &
-                 &     * trn(ji,jj,jk,jpbsi)/(trn(ji,jj,jk,jpdia)+rtrn)
-               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zgrazsd(ji,jj,jk) &
-                 &     * trn(ji,jj,jk,jpbsi)/(trn(ji,jj,jk,jpdia)+rtrn)
-               tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgrazpf(ji,jj,jk)
-               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazsf(ji,jj,jk)
-               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortz - zgrazm(ji,jj,jk)
-               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz   &
-                 &     + unass * ( zgrazpf(ji,jj,jk) + zgrazsf (ji,jj,jk)) &
-                 &     - (1.-unass) * zgrazmf(ji,jj,jk)
-               zprcaca = xfracal(ji,jj,jk) * unass * zgrazp(ji,jj,jk)
-#if defined key_trc_dia3d
+               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc * unass * xkr_ddiat
+#endif
+
+               !
+               !   Update the arrays TRA which contain the biological sources and sinks
+               !   --------------------------------------------------------------------
+
+               zmortz = ztortz + zrespz
+               tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zmortz + epsher * zgrapoc 
+               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,jpbsi) = tra(ji,jj,jk,jpbsi) - zgrazsd * trn(ji,jj,jk,jpbsi)/(trn(ji,jj,jk,jpdia)+rtrn)
+               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zgrazsd * trn(ji,jj,jk,jpbsi)/(trn(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
+               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortz - zgrazm
+               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz + unass * ( zgrazpf + zgrazsf ) - (1.-unass) * zgrazmf
+               zprcaca = xfracal(ji,jj,jk) * unass * zgrazp
+#if defined key_diatrc
                prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo)
 #endif
@@ -228,5 +180,5 @@
                tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca
 #if defined key_kriest
-               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + ( zmortz - zgrazm(ji,jj,jk) ) * xkr_ddiat
+               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + ( zmortz - zgrazm ) * xkr_ddiat
 #endif
             END DO
@@ -251,5 +203,5 @@
       !!
       !! ** Method  :   Read the nampiszoo namelist and check the parameters
-      !!      called at the first timestep (nittrc000)
+      !!      called at the first timestep (nit000)
       !!
       !! ** input   :   Namelist nampiszoo
Index: trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmort.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmort.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmort.F90	(revision 2528)
@@ -25,4 +25,5 @@
 
    PUBLIC   p4z_mort    
+   PUBLIC   p4z_mort_init    
 
 
@@ -35,20 +36,16 @@
      mpratm = 0.01_wp           !:
 
-   !! * Module variables
-   REAL(wp) :: zstep
-
-
 
    !!* Substitution
 #  include "top_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
 CONTAINS
 
-   SUBROUTINE p4z_mort( kt, jnt )
+   SUBROUTINE p4z_mort( kt )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_mort  ***
@@ -59,10 +56,6 @@
       !! ** Method  : - ???
       !!---------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt, jnt ! ocean time step
-      !!---------------------------------------------------------------------
-
-      IF( ( kt * jnt ) == nittrc000  )   CALL p4z_mort_init      ! Initialization (first time-step only)
-
-      zstep = rfact2 / rday      ! Time step duration for biology
+      INTEGER, INTENT(in) ::   kt ! ocean time step
+      !!---------------------------------------------------------------------
 
       CALL p4z_nano            ! nanophytoplankton
@@ -83,11 +76,11 @@
       INTEGER  :: ji, jj, jk
       REAL(wp) :: zcompaph
-      REAL(wp) :: zfactfe,zfactch,zprcaca,zfracal
-      REAL(wp) :: ztortp,zrespp,zmortp
+      REAL(wp) :: zfactfe, zfactch, zprcaca, zfracal
+      REAL(wp) :: ztortp , zrespp , zmortp , zstep
       CHARACTER (len=25) :: charout
       !!---------------------------------------------------------------------
 
 
-#if defined key_trc_dia3d
+#if defined key_diatrc
      prodcal(:,:,:) = 0.  !: Initialisation of calcite production variable
 #endif
@@ -99,23 +92,17 @@
                zcompaph = MAX( ( trn(ji,jj,jk,jpphy) - 1e-8 ), 0.e0 )
 
-!     Squared mortality of Phyto similar to a sedimentation term during
-!     blooms (Doney et al. 1996)
-!     -----------------------------------------------------------------
-               zrespp = wchl * 1.e6 * zstep * xdiss(ji,jj,jk)   &
-# if defined key_off_degrad
-                  &        * facvol(ji,jj,jk)     &
+# if defined key_degrad
+               zstep =  xstep * facvol(ji,jj,jk)  
+# else
+               zstep =  xstep  
 # endif
-                  &        * zcompaph * trn(ji,jj,jk,jpphy)
-
-!     Phytoplankton mortality. This mortality loss is slightly
-!     increased when nutrients are limiting phytoplankton growth
-!     as observed for instance in case of iron limitation.
-!     ----------------------------------------------------------
-               ztortp = mprat * zstep * trn(ji,jj,jk,jpphy)          &
-# if defined key_off_degrad
-                  &          * facvol(ji,jj,jk)     &
-# endif
-                  &   / ( xkmort + trn(ji,jj,jk,jpphy) ) * zcompaph
-
+               !     Squared mortality of Phyto similar to a sedimentation term during
+               !     blooms (Doney et al. 1996)
+               zrespp = wchl * 1.e6 * zstep * xdiss(ji,jj,jk) * zcompaph * trn(ji,jj,jk,jpphy) 
+
+               !     Phytoplankton mortality. This mortality loss is slightly
+               !     increased when nutrients are limiting phytoplankton growth
+               !     as observed for instance in case of iron limitation.
+               ztortp = mprat * xstep * trn(ji,jj,jk,jpphy) / ( xkmort + trn(ji,jj,jk,jpphy) ) * zcompaph
 
                zmortp = zrespp + ztortp
@@ -130,5 +117,5 @@
                tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zmortp * zfactfe
                zprcaca = xfracal(ji,jj,jk) * zmortp
-#if defined key_trc_dia3d
+#if defined key_diatrc
                prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo)
 #endif
@@ -169,5 +156,5 @@
       INTEGER  ::  ji, jj, jk
       REAL(wp) ::  zfactfe,zfactsi,zfactch, zcompadi
-      REAL(wp) ::  zrespp2, ztortp2, zmortp2
+      REAL(wp) ::  zrespp2, ztortp2, zmortp2, zstep
       CHARACTER (len=25) :: charout
  
@@ -175,8 +162,8 @@
 
 
-!    Aggregation term for diatoms is increased in case of nutrient
-!    stress as observed in reality. The stressed cells become more
-!    sticky and coagulate to sink quickly out of the euphotic zone
-!     ------------------------------------------------------------
+      !    Aggregation term for diatoms is increased in case of nutrient
+      !    stress as observed in reality. The stressed cells become more
+      !    sticky and coagulate to sink quickly out of the euphotic zone
+      !     ------------------------------------------------------------
 
       DO jk = 1, jpkm1
@@ -186,28 +173,27 @@
                zcompadi = MAX( ( trn(ji,jj,jk,jpdia) - 1e-8), 0. )
 
-!    Aggregation term for diatoms is increased in case of nutrient
-!    stress as observed in reality. The stressed cells become more
-!    sticky and coagulate to sink quickly out of the euphotic zone
-!     ------------------------------------------------------------
-
+               !    Aggregation term for diatoms is increased in case of nutrient
+               !    stress as observed in reality. The stressed cells become more
+               !    sticky and coagulate to sink quickly out of the euphotic zone
+               !     ------------------------------------------------------------
+
+# if defined key_degrad
+               zstep =  xstep * facvol(ji,jj,jk)  
+# else
+               zstep =  xstep  
+# endif
+               !  Phytoplankton respiration 
+               !     ------------------------
                zrespp2  = 1.e6 * zstep * (  wchl + wchld * ( 1.- xlimdia(ji,jj,jk) )  )    &
-# if defined key_off_degrad
-                  &       * facvol(ji,jj,jk)       &
-# endif
                   &       * xdiss(ji,jj,jk) * zcompadi * trn(ji,jj,jk,jpdia)
-                                                                               
-
-!     Phytoplankton mortality. 
-!     ------------------------
-               ztortp2  = mprat2 * zstep * trn(ji,jj,jk,jpdia)     &
-# if defined key_off_degrad
-                  &        * facvol(ji,jj,jk)       &
-# endif
-                  &      / ( xkmort + trn(ji,jj,jk,jpdia) ) * zcompadi
-
-                zmortp2 = zrespp2 + ztortp2
-
-!   Update the arrays tra which contains the biological sources and sinks
-!   ---------------------------------------------------------------------
+
+               !     Phytoplankton mortality. 
+               !     ------------------------
+               ztortp2  = mprat2 * zstep * trn(ji,jj,jk,jpdia)  / ( xkmort + trn(ji,jj,jk,jpdia) ) * zcompadi 
+
+               zmortp2 = zrespp2 + ztortp2
+
+               !   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 )
@@ -249,5 +235,5 @@
       !!
       !! ** Method  :   Read the nampismort namelist and check the parameters
-      !!      called at the first timestep (nittrc000)
+      !!      called at the first timestep
       !!
       !! ** input   :   Namelist nampismort
Index: trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zopt.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zopt.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zopt.F90	(revision 2528)
@@ -16,5 +16,4 @@
    USE trc            ! tracer variables
    USE oce_trc        ! tracer-ocean share variables
-   USE trc_oce        ! ocean-tracer share variables
    USE sms_pisces     ! Source Minus Sink of PISCES
    USE iom
@@ -23,12 +22,12 @@
    PRIVATE
 
-   PUBLIC   p4z_opt   ! called in p4zbio.F90 module
+   PUBLIC   p4z_opt        ! called in p4zbio.F90 module
+   PUBLIC   p4z_opt_init   ! called in trcsms_pisces.F90 module
 
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   etot, enano, ediat   !: PAR for phyto, nano and diat 
    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   emoy                 !: averaged PAR in the mixed layer
 
-   INTEGER  ::   nksrp   ! levels below which the light cannot penetrate ( depth larger than 391 m)
-   REAL(wp) ::   &
-      parlux = 0.43 / 3.e0
+   INTEGER  ::  nksrp   ! levels below which the light cannot penetrate ( depth larger than 391 m)
+   REAL(wp) ::  parlux = 0.43 / 3.e0
 
    REAL(wp), DIMENSION(3,61), PUBLIC ::   xkrgb  !: tabulated attenuation coefficients for RGB absorption
@@ -37,12 +36,12 @@
 #  include "top_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
 CONTAINS
 
-   SUBROUTINE p4z_opt(kt, jnt)
+   SUBROUTINE p4z_opt( kt, jnt )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_opt  ***
@@ -54,5 +53,5 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt, jnt ! ocean time step
-      INTEGER  ::   ji, jj, jk, jc
+      INTEGER  ::   ji, jj, jk
       INTEGER  ::   irgb
       REAL(wp) ::   zchl, zxsi0r
@@ -64,23 +63,6 @@
 
 
-      !                                        !* tabulated attenuation coef. 
-      IF( kt * jnt == nittrc000 ) THEN
-         !                                ! level of light extinction
-         nksrp = trc_oce_ext_lev( rn_si2, 0.33e2 )
-         IF(lwp) THEN
-           WRITE(numout,*)
-           WRITE(numout,*) ' level max of computation of qsr = ', nksrp, ' ref depth = ', gdepw_0(nksrp+1), ' m'
-         ENDIF
-!!         CALL trc_oce_rgb( xkrgb )     ! tabulated attenuation coefficients
-         CALL trc_oce_rgb_read( xkrgb )     ! tabulated attenuation coefficients
-         etot (:,:,:) = 0.e0
-         enano(:,:,:) = 0.e0
-         ediat(:,:,:) = 0.e0
-         IF( ln_qsr_bio ) etot3(:,:,:) = 0.e0
-      ENDIF
-
-
-!     Initialisation of variables used to compute PAR
-!     -----------------------------------------------
+      !     Initialisation of variables used to compute PAR
+      !     -----------------------------------------------
       ze1 (:,:,jpk) = 0.e0
       ze2 (:,:,jpk) = 0.e0
@@ -227,5 +209,5 @@
       END DO
 
-#if defined key_trc_diaadd
+#if defined key_diatrc
 # if ! defined key_iomput
       ! save for outputs
@@ -243,4 +225,24 @@
    END SUBROUTINE p4z_opt
 
+   SUBROUTINE p4z_opt_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE p4z_opt_init  ***
+      !!
+      !! ** Purpose :   Initialization of tabulated attenuation coef
+      !!
+      !!
+      !!----------------------------------------------------------------------
+
+      CALL trc_oce_rgb( xkrgb )                  ! tabulated attenuation coefficients
+!!      CALL trc_oce_rgb_read( xkrgb )               ! tabulated attenuation coefficients
+      nksrp = trc_oce_ext_lev( r_si2, 0.33e2 )     ! max level of light extinction (Blue Chl=0.01)
+      IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksrp, ' ref depth = ', gdepw_0(nksrp+1), ' m'
+      !
+                         etot (:,:,:) = 0.e0
+                         enano(:,:,:) = 0.e0
+                         ediat(:,:,:) = 0.e0
+      IF( ln_qsr_bio )   etot3(:,:,:) = 0.e0
+      ! 
+   END SUBROUTINE p4z_opt_init
 #else
    !!----------------------------------------------------------------------
Index: trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zprod.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zprod.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zprod.F90	(revision 2528)
@@ -23,9 +23,11 @@
 
    USE lib_mpp
+   USE lib_fortran
 
    IMPLICIT NONE
    PRIVATE
 
-   PUBLIC   p4z_prod    ! called in p4zbio.F90
+   PUBLIC   p4z_prod         ! called in p4zbio.F90
+   PUBLIC   p4z_prod_init    ! called in trcsms_pisces.F90
 
    !! * Shared module variables
@@ -41,21 +43,18 @@
      grosip    = 0.151_wp
 
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)  ::        &
-     &                   prmax
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)  ::  prmax 
    
    REAL(wp) ::   &
+      rday1                      ,  &  !: 0.6 / rday
       texcret                    ,  &  !: 1 - excret 
       texcret2                   ,  &  !: 1 - excret2        
-      rpis180                    ,  &  !: rpi / 180
       tpp                              !: Total primary production
-
-   INTEGER  ::  nspyr                  !: number of timesteps per year
 
    !!* Substitution
 #  include "top_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -78,6 +77,6 @@
       REAL(wp) ::   zmxltst, zmxlday, zlim1
       REAL(wp) ::   zpislopen  , zpislope2n
-      REAL(wp) ::   zrum, zcodel, zargu, zvol
-#if defined key_trc_diaadd && defined key_trc_dia3d
+      REAL(wp) ::   zrum, zcodel, zargu, zval, zvol
+#if defined key_diatrc
       REAL(wp) ::   zrfact2
 #endif
@@ -90,8 +89,4 @@
       CHARACTER (len=25) :: charout
       !!---------------------------------------------------------------------
-
-
-      IF( ( kt * jnt ) == nittrc000  )   CALL p4z_prod_init      ! Initialization (first time-step only)
-
 
       zprorca (:,:,:) = 0.0
@@ -109,21 +104,13 @@
       ! Computation of the optimal production
 
-# if defined key_off_degrad
-      prmax(:,:,:) = 0.6 / rday * tgfunc(:,:,:) * facvol(:,:,:)
+# if defined key_degrad
+      prmax(:,:,:) = rday1 * tgfunc(:,:,:) * facvol(:,:,:)
 # else
-      prmax(:,:,:) = 0.6 / rday * tgfunc(:,:,:)
+      prmax(:,:,:) = rday1 * tgfunc(:,:,:)
 # endif
 
       ! compute the day length depending on latitude and the day
-      IF(lwp) write(numout,*)
-      IF(lwp) write(numout,*) 'p4zday : - Julian day ', nday_year
-      IF(lwp) write(numout,*) '~~~~~~'
-
-      IF( nleapy == 1 .AND. MOD( nyear, 4 ) == 0 ) THEN
-         zrum = FLOAT( nday_year - 80 ) / 366.
-      ELSE
-         zrum = FLOAT( nday_year - 80 ) / 365.
-      ENDIF
-      zcodel = ASIN(  SIN( zrum * rpi * 2. ) * SIN( rpis180 * 23.5 )  )
+      zrum = FLOAT( nday_year - 80 ) / REAL(nyear_len(1), wp)
+      zcodel = ASIN(  SIN( zrum * rpi * 2. ) * SIN( rad * 23.5 )  )
 
       ! day length in hours
@@ -131,7 +118,9 @@
       DO jj = 1, jpj
          DO ji = 1, jpi
-            zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rpis180 )
+            zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad )
             zargu = MAX( -1., MIN(  1., zargu ) )
-            zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rpis180 / 15. )
+            zval  = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. )
+            IF( zval < 1.e0 )   zval = 24.
+            zstrn(ji,jj) = 24. / zval
          END DO
       END DO
@@ -147,5 +136,5 @@
                ! Computation of the P-I slope for nanos and diatoms
                IF( etot(ji,jj,jk) > 1.E-3 ) THEN
-                   ztn    = MAX( 0., tn(ji,jj,jk) - 15. )
+                   ztn    = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. )
                    zadap  = 0.+ 1.* ztn / ( 2.+ ztn )
                    zadap2 = 0.e0
@@ -227,7 +216,4 @@
       END DO
 
-
-      WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24.
-      zstrn(:,:) = 24. / zstrn(:,:)
 
 !CDIR NOVERRCHK
@@ -331,27 +317,18 @@
 
      ! Total primary production per year
-     DO jk = 1, jpkm1
-        DO jj = 1, jpj
-          DO ji = 1, jpi
-             zvol = cvol(ji,jj,jk)
-#if defined key_off_degrad
-             zvol = zvol * facvol(ji,jj,jk)
+
+#if defined key_degrad
+     tpp = tpp + glob_sum( ( zprorca(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) * facvol(:,:,:) )
+#else
+     tpp = tpp + glob_sum( ( zprorca(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) )
 #endif
-             tpp  = tpp + ( zprorca(ji,jj,jk) + zprorcad(ji,jj,jk) ) &
-                          * zvol * tmask(ji,jj,jk) * tmask_i(ji,jj)
-          END DO
-        END DO
-      END DO
-
-
-      IF( MOD( kt, nspyr ) == 0 .AND. jnt == nrdttrc ) THEN
-        IF( lk_mpp ) CALL mpp_sum( tpp )
-        WRITE(numout,*) 'Total PP :'
+
+     IF( kt == nitend .AND. jnt == nrdttrc ) THEN
+        WRITE(numout,*) 'Total PP (Gtc) :'
         WRITE(numout,*) '-------------------- : ',tpp * 12. / 1.E12
-        WRITE(numout,*) '(GtC/yr)'
-        tpp = 0.
+        WRITE(numout,*) 
       ENDIF
 
-#if defined key_trc_diaadd && defined key_trc_dia3d && ! defined key_iomput
+#if defined key_diatrc && ! defined key_iomput
       !   Supplementary diagnostics
       zrfact2 = 1.e3 * rfact2r
@@ -367,5 +344,5 @@
 #endif
 
-#if defined key_trc_diaadd && defined key_trc_dia3d && defined key_iomput
+#if defined key_diatrc && defined key_iomput
       zrfact2 = 1.e3 * rfact2r
       IF ( jnt == nrdttrc ) then
@@ -396,5 +373,5 @@
       !!
       !! ** Method  :   Read the nampisprod namelist and check the parameters
-      !!      called at the first timestep (nittrc000)
+      !!      called at the first timestep (nit000)
       !!
       !! ** input   :   Namelist nampisprod
@@ -423,8 +400,5 @@
       ENDIF
 
-      ! number of timesteps per year
-      nspyr  = INT( nyear_len(1) * rday / rdt )
-
-      rpis180   = rpi / 180.
+      rday1     = 0.6 / rday 
       texcret   = 1.0 - excret
       texcret2  = 1.0 - excret2
Index: trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zrem.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zrem.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zrem.F90	(revision 2528)
@@ -27,5 +27,6 @@
    PRIVATE
 
-   PUBLIC   p4z_rem    ! called in p4zbio.F90
+   PUBLIC   p4z_rem         ! called in p4zbio.F90
+   PUBLIC   p4z_rem_init    ! called in trcsms_pisces.F90
 
    !! * Shared module variables
@@ -41,18 +42,16 @@
      &                   denitr                     !: denitrification array
 
-   REAL(wp) ::   &
-     xstep            !: Time step duration for biology
 
    !!* Substitution
 #  include "top_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
 CONTAINS
 
-   SUBROUTINE p4z_rem(kt, jnt)
+   SUBROUTINE p4z_rem( kt )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_rem  ***
@@ -62,5 +61,5 @@
       !! ** Method  : - ???
       !!---------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt, jnt ! ocean time step
+      INTEGER, INTENT(in) ::   kt ! ocean time step
       INTEGER  ::   ji, jj, jk
       REAL(wp) ::   zremip, zremik , zlam1b
@@ -72,5 +71,5 @@
       REAL(wp) ::   zofer2, zdenom, zdenom2
 #endif
-      REAL(wp) ::   zlamfac, zonitr
+      REAL(wp) ::   zlamfac, zonitr, zstep
       REAL(wp), DIMENSION(jpi,jpj)     ::   ztempbac
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdepbac, zfesatur, zolimi
@@ -78,12 +77,4 @@
 
       !!---------------------------------------------------------------------
-
-
-      IF( ( kt * jnt ) == nittrc000  )  THEN
-         CALL p4z_rem_init                ! Initialization (first time-step only)
-         xstep = rfact2 / rday            ! Time step duration for the biology
-         nitrfac(:,:,:) = 0.0
-         denitr (:,:,:) = 0.0  
-      ENDIF
 
 
@@ -94,7 +85,7 @@
        ztempbac(:,:)   = 0.0
 
-!      Computation of the mean phytoplankton concentration as
-!      a crude estimate of the bacterial biomass
-!      --------------------------------------------------
+      !  Computation of the mean phytoplankton concentration as
+      !  a crude estimate of the bacterial biomass
+      !   --------------------------------------------------
 
       DO jk = 1, jpkm1
@@ -114,39 +105,33 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-
-!    DENITRIFICATION FACTOR COMPUTED FROM O2 LEVELS
-!    ----------------------------------------------
-
+               ! 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) )  )
-            END DO
-         END DO
-      END DO
-
-      nitrfac(:,:,:) = MIN( 1., nitrfac(:,:,:) )
-
-
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-
-!     DOC ammonification. Depends on depth, phytoplankton biomass
-!     and a limitation term which is supposed to be a parameterization
-!     of the bacterial activity. 
-!     ----------------------------------------------------------------
-               zremik = xremik * xstep / 1.e-6 * xlimbac(ji,jj,jk)         &
-# if defined key_off_degrad
-                  &            * facvol(ji,jj,jk)              &
+               nitrfac(ji,jj,jk) = MIN( 1., nitrfac(ji,jj,jk) )
+            END DO
+         END DO
+      END DO
+
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+# if defined key_degrad
+               zstep = xstep * facvol(ji,jj,jk)
+# else
+               zstep = xstep
 # endif
-                  &            * zdepbac(ji,jj,jk)
+               ! DOC ammonification. Depends on depth, phytoplankton biomass
+               !     and a limitation term which is supposed to be a parameterization
+               !     of the bacterial activity. 
+               zremik = xremik * zstep / 1.e-6 * xlimbac(ji,jj,jk) * zdepbac(ji,jj,jk) 
                zremik = MAX( zremik, 5.5e-4 * xstep )
 
-!     Ammonification in oxic waters with oxygen consumption
-!     -----------------------------------------------------
+               !     Ammonification in oxic waters with oxygen consumption
+               !     -----------------------------------------------------
                zolimi(ji,jj,jk) = MIN(  ( trn(ji,jj,jk,jpoxy) - rtrn ) / o2ut,  &
                   &                    zremik * ( 1.- nitrfac(ji,jj,jk) ) * trn(ji,jj,jk,jpdoc)  ) 
 
-!     Ammonification in suboxic waters with denitrification
-!     -------------------------------------------------------
+               !     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)  )
@@ -167,22 +152,21 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-
-!    NH4 nitrification to NO3. Ceased for oxygen concentrations
-!    below 2 umol/L. Inhibited at strong light 
-!    ----------------------------------------------------------
-               zonitr  = nitrif * xstep * trn(ji,jj,jk,jpnh4) / ( 1.+ emoy(ji,jj,jk) )     &
-# if defined key_off_degrad
-                  &      * facvol(ji,jj,jk)              &
+# if defined key_degrad
+               zstep = xstep * facvol(ji,jj,jk)
+# else
+               zstep = xstep
 # endif
-                  &      * ( 1.- nitrfac(ji,jj,jk) )
-
-!
-!   Update of the tracers trends
-!   ----------------------------
-
-              tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zonitr
-              tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zonitr
-              tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2nit * zonitr
-              tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - rno3  * zonitr
+               !    NH4 nitrification to NO3. Ceased for oxygen concentrations
+               !    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) ) 
+
+               !   Update of the tracers trends
+               !   ----------------------------
+
+               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zonitr
+               tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zonitr
+               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2nit * zonitr
+               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - rno3  * zonitr
 
             END DO
@@ -200,11 +184,11 @@
             DO ji = 1, jpi
 
-!    Bacterial uptake of iron. No iron is available in DOC. So
-!    Bacteries are obliged to take up iron from the water. Some
-!    studies (especially at Papa) have shown this uptake to be
-!    significant
-!    ----------------------------------------------------------
+               !    Bacterial uptake of iron. No iron is available in DOC. So
+               !    Bacteries are obliged to take up iron from the water. Some
+               !    studies (especially at Papa) have shown this uptake to be significant
+               !    ----------------------------------------------------------
                zbactfer = 15.e-6 * rfact2 * 4.* 0.4 * prmax(ji,jj,jk)           &
-                  &               * ( xlimphy(ji,jj,jk) * zdepbac(ji,jj,jk))**2           &
+                  &               * ( xlimphy(ji,jj,jk) * zdepbac(ji,jj,jk))           &
+                  &               * ( xlimphy(ji,jj,jk) * zdepbac(ji,jj,jk))           &
                   &                  / ( xkgraz2 + zdepbac(ji,jj,jk) )                    &
                   &                  * ( 0.5 + SIGN( 0.5, trn(ji,jj,jk,jpfer) -2.e-11 )  )
@@ -216,5 +200,4 @@
                tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zbactfer
 #endif
-
             END DO
          END DO
@@ -230,18 +213,18 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-
-!    POC disaggregation by turbulence and bacterial activity. 
-!    -------------------------------------------------------------
-               zremip = xremip * xstep * tgfunc(ji,jj,jk)   &
-# if defined key_off_degrad
-                  &            * facvol(ji,jj,jk)              &
+# if defined key_degrad
+               zstep = xstep * facvol(ji,jj,jk)
+# else
+               zstep = xstep
 # endif
-                  &            * ( 1.- 0.5 * nitrfac(ji,jj,jk) )
-
-!    POC disaggregation rate is reduced in anoxic zone as shown by
-!    sediment traps data. In oxic area, the exponent of the martin s
-!    law is around -0.87. In anoxic zone, it is around -0.35. This
-!    means a disaggregation constant about 0.5 the value in oxic zones
-!    -----------------------------------------------------------------
+               !    POC disaggregation by turbulence and bacterial activity. 
+               !    -------------------------------------------------------------
+               zremip = xremip * zstep * tgfunc(ji,jj,jk) * ( 1.- 0.5 * nitrfac(ji,jj,jk) ) 
+
+               !    POC disaggregation rate is reduced in anoxic zone as shown by
+               !    sediment traps data. In oxic area, the exponent of the martin s
+               !    law is around -0.87. In anoxic zone, it is around -0.35. This
+               !    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)
@@ -253,6 +236,6 @@
 #endif
 
-!  Update the appropriate tracers trends
-!  -------------------------------------
+               !  Update the appropriate tracers trends
+               !  -------------------------------------
 
                tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zorem
@@ -282,21 +265,20 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-
-!     Remineralization rate of BSi depedant on T and saturation
-!     ---------------------------------------------------------
+# if defined key_degrad
+               zstep = xstep * facvol(ji,jj,jk)
+# else
+               zstep = xstep
+# endif
+               !     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  = MAX( rtrn, zsatur )
                zsatur2 = zsatur * ( 1. + tn(ji,jj,jk) / 400.)**4
                znusil  = 0.225  * ( 1. + tn(ji,jj,jk) / 15.) * zsatur + 0.775 * zsatur2**9
-#    if defined key_off_degrad
-               zsiremin = xsirem * xstep * znusil * facvol(ji,jj,jk)
-# else
-               zsiremin = xsirem * xstep * znusil
-#    endif
+               zsiremin = xsirem * zstep * znusil
                zosil = zsiremin * trn(ji,jj,jk,jpdsi)
 
                tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zosil
                tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) + zosil
-
                !
             END DO
@@ -317,24 +299,25 @@
 !CDIR NOVERRCHK
             DO ji = 1, jpi
-!
-!      Compute de different ratios for scavenging of iron
-!      --------------------------------------------------
+# if defined key_degrad
+               zstep = xstep * facvol(ji,jj,jk)
+# else
+               zstep = xstep
+# endif
+               !  Compute de different ratios for scavenging of iron
+               !  --------------------------------------------------
 
 #if  defined key_kriest
-                zdenom1 = trn(ji,jj,jk,jppoc) / &
+               zdenom1 = trn(ji,jj,jk,jppoc) / &
            &           ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpdsi) + trn(ji,jj,jk,jpcal) + rtrn )
 #else
-                zdenom = 1. / ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpgoc)  &
+               zdenom = 1. / ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpgoc)  &
            &            + trn(ji,jj,jk,jpdsi) + trn(ji,jj,jk,jpcal) + rtrn )
 
-                zdenom1 = trn(ji,jj,jk,jppoc) * zdenom
-                zdenom2 = trn(ji,jj,jk,jpgoc) * zdenom
-#endif
-
-
-!     scavenging rate of iron. this scavenging rate depends on the
-!     load in particles on which they are adsorbed. The
-!     parameterization has been taken from studies on Th
-!     ------------------------------------------------------------
+               zdenom1 = trn(ji,jj,jk,jppoc) * zdenom
+               zdenom2 = trn(ji,jj,jk,jpgoc) * zdenom
+#endif
+               !  scavenging rate of iron. this scavenging rate depends on the load in particles
+               !  on which they are adsorbed. The  parameterization has been taken from studies on Th
+               !     ------------------------------------------------------------
                zkeq = fekeq(ji,jj,jk)
                zfeequi = ( -( 1. + zfesatur(ji,jj,jk) * zkeq - zkeq * trn(ji,jj,jk,jpfer) )               &
@@ -349,15 +332,10 @@
                   &                      + trn(ji,jj,jk,jpcal) + trn(ji,jj,jk,jpdsi)  ) * 1.e6
 #endif
-
-# if defined key_off_degrad
-               zscave = zfeequi * zlam1b * xstep  * facvol(ji,jj,jk)
-# else
-               zscave = zfeequi * zlam1b * xstep
-# endif
-
-!  Increased scavenging for very high iron concentrations
-!  found near the coasts due to increased lithogenic particles
-!  and let s say it unknown processes (precipitation, ...)
-!  -----------------------------------------------------------
+               zscave = zfeequi * zlam1b * zstep
+
+               !  Increased scavenging for very high iron concentrations
+               !  found near the coasts due to increased lithogenic particles
+               !  and let s say it unknown processes (precipitation, ...)
+               !  -----------------------------------------------------------
                zlamfac = MAX( 0.e0, ( gphit(ji,jj) + 55.) / 30. )
                zlamfac = MIN( 1.  , zlamfac )
@@ -374,9 +352,5 @@
 #endif
 
-# if defined key_off_degrad
-               zaggdfe = zlam1b * xstep * 0.5 * ( trn(ji,jj,jk,jpfer) - zfeequi ) * facvol(ji,jj,jk)
-# else
-               zaggdfe = zlam1b * xstep * 0.5 * ( trn(ji,jj,jk,jpfer) - zfeequi )
-# endif
+               zaggdfe = zlam1b * zstep * 0.5 * ( trn(ji,jj,jk,jpfer) - zfeequi )
 
                tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zscave - zaggdfe
@@ -400,6 +374,6 @@
        ENDIF
 
-!     Update the arrays TRA which contain the biological sources and sinks
-!     --------------------------------------------------------------------
+       !     Update the arrays TRA which contain the biological sources and sinks
+       !     --------------------------------------------------------------------
 
       DO jk = 1, jpkm1
@@ -429,5 +403,5 @@
       !!
       !! ** Method  :   Read the nampisrem namelist and check the parameters
-      !!      called at the first timestep (nittrc000)
+      !!      called at the first timestep
       !!
       !! ** input   :   Namelist nampisrem
@@ -452,9 +426,8 @@
       ENDIF
 
+      nitrfac(:,:,:) = 0.0
+      denitr (:,:,:) = 0.0  
+
    END SUBROUTINE p4z_rem_init
-
-
-
-
 
 #else
Index: trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsed.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsed.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsed.F90	(revision 2528)
@@ -19,4 +19,5 @@
    USE sms_pisces
    USE lib_mpp
+   USE lib_fortran
    USE prtctl_trc
    USE p4zbio
@@ -34,4 +35,5 @@
 
    PUBLIC   p4z_sed   
+   PUBLIC   p4z_sed_init   
 
    !! * Shared module variables
@@ -47,18 +49,19 @@
 
    !! * Module variables
-   INTEGER ::                   &
-     ryyss,                     &  !: number of seconds per year
-     rmtss                         !: number of seconds per month
-
+   REAL(wp) :: ryyss               !: number of seconds per year 
+   REAL(wp) :: ryyss1              !: inverse of ryyss
+   REAL(wp) :: rmtss               !: number of seconds per month
+   REAL(wp) :: rday1               !: inverse of rday
+
+   INTEGER , PARAMETER :: &
+        jpmth = 12, jpyr = 1
    INTEGER ::                   &
       numdust,                  &  !: logical unit for surface fluxes data
       nflx1 , nflx2,            &  !: first and second record used
       nflx11, nflx12      ! ???
-   REAL(wp), DIMENSION(jpi,jpj,2) ::    &  !:
-     dustmo                                !: 2 consecutive set of dust fields 
-   REAL(wp), DIMENSION(jpi,jpj)   ::    &
-     rivinp, cotdep, nitdep, dust
-   REAL(wp), DIMENSION(jpi,jpj,jpk)  ::   &
-     ironsed
+   REAL(wp), DIMENSION(jpi,jpj,jpmth) ::  dustmo    !: set of dust fields
+   REAL(wp), DIMENSION(jpi,jpj)      ::  rivinp, cotdep, nitdep, dust 
+   REAL(wp), DIMENSION(jpi,jpj)      ::  e1e2t
+   REAL(wp), DIMENSION(jpi,jpj,jpk)  ::  ironsed 
    REAL(wp) :: sumdepsi, rivalkinput, rivpo4input, nitdepinput
 
@@ -66,12 +69,12 @@
 #  include "top_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Header:$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
 CONTAINS
 
-   SUBROUTINE p4z_sed(kt, jnt)
+   SUBROUTINE p4z_sed( kt, jnt )
       !!---------------------------------------------------------------------
       !!                     ***  ROUTINE p4z_sed  ***
@@ -84,30 +87,18 @@
       !!---------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt, jnt ! ocean time step
-      INTEGER  ::   ji, jj, jk
-      INTEGER  ::   ikt
+      INTEGER  ::   ji, jj, jk, ikt
 #if ! defined key_sed
       REAL(wp) ::   zsumsedsi, zsumsedpo4, zsumsedcal
+      REAL(wp) ::   zrivalk, zrivsil, zrivpo4
 #endif
-      REAL(wp) ::   zconctmp , zdenitot  , znitrpottot
-      REAL(wp) ::   zlim, zconctmp2, zstep, zfact
+      REAL(wp) ::   zdenitot, znitrpottot, zlim, zfact
+      REAL(wp) ::   zwsbio3, zwsbio4, zwscal
       REAL(wp), DIMENSION(jpi,jpj)     ::   zsidep
+      REAL(wp), DIMENSION(jpi,jpj)     ::   zwork, zwork1
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   znitrpot, zirondep
-#if defined key_diaadd || defined key_trc_dia3d 
-      REAL(wp) :: zrfact2
-# if defined key_iomput
-     REAL(wp), DIMENSION(jpi,jpj)    ::    zw2d 
-# endif
-#endif
       CHARACTER (len=25) :: charout
       !!---------------------------------------------------------------------
 
-
-      IF( ( kt * jnt ) == nittrc000   )   CALL p4z_sed_init      ! Initialization (first time-step only)
-      IF( (jnt == 1) .and. ( ln_dustfer ) )  CALL p4z_sbc( kt )
-
-      zstep = rfact2 / rday      ! Time step duration for the biology
-
-      zirondep(:,:,:) = 0.e0          ! Initialisation of variables used to compute deposition
-      zsidep  (:,:)   = 0.e0
+      IF( jnt == 1  .AND.  ln_dustfer  )  CALL p4z_sbc( kt )
 
       ! Iron and Si deposition at the surface
@@ -116,5 +107,5 @@
       DO jj = 1, jpj
          DO ji = 1, jpi
-            zirondep(ji,jj,1) = ( dustsolub * dust(ji,jj) / ( 55.85 * rmtss ) + 3.e-10 / ryyss )   &
+            zirondep(ji,jj,1) = ( dustsolub * dust(ji,jj) / ( 55.85 * rmtss ) + 3.e-10 * ryyss1 )   &
                &             * rfact2 / fse3t(ji,jj,1)
             zsidep  (ji,jj)   = 8.8 * 0.075 * dust(ji,jj) * rfact2 / ( fse3t(ji,jj,1) * 28.1 * rmtss )
@@ -150,9 +141,4 @@
 
 #if ! defined key_sed
-      ! Initialisation of variables used to compute Sinking Speed
-      zsumsedsi  = 0.e0
-      zsumsedpo4 = 0.e0
-      zsumsedcal = 0.e0
-
       ! Loss of biogenic silicon, Caco3 organic carbon in the sediments. 
       ! First, the total loss is computed.
@@ -161,24 +147,23 @@
       DO jj = 1, jpj
          DO ji = 1, jpi
-            ikt = MAX( mbathy(ji,jj)-1, 1 )
-            zfact = e1t(ji,jj) * e2t(ji,jj) / rday * tmask_i(ji,jj)
+            ikt = mbkt(ji,jj) 
 # if defined key_kriest
-            zsumsedsi  = zsumsedsi  + zfact *  trn(ji,jj,ikt,jpdsi) * wscal (ji,jj,ikt)
-            zsumsedpo4 = zsumsedpo4 + zfact *  trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt)
+            zwork (ji,jj) = trn(ji,jj,ikt,jpdsi) * wscal (ji,jj,ikt)
+            zwork1(ji,jj) = trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt)
 # else
-            zsumsedsi  = zsumsedsi  + zfact *  trn(ji,jj,ikt,jpdsi) * wsbio4(ji,jj,ikt)
-            zsumsedpo4 = zsumsedpo4 + zfact *( trn(ji,jj,ikt,jpgoc) * wsbio4(ji,jj,ikt)   &
-               &       + trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt) )
+            zwork (ji,jj) = trn(ji,jj,ikt,jpdsi) * wsbio4(ji,jj,ikt)
+            zwork1(ji,jj) = trn(ji,jj,ikt,jpgoc) * wsbio4(ji,jj,ikt) + trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt) 
 # endif
-            zsumsedcal = zsumsedcal + zfact *  trn(ji,jj,ikt,jpcal) * wscal (ji,jj,ikt) * 2.e0
-         END DO
-      END DO
-
-      IF( lk_mpp ) THEN
-         CALL mpp_sum( zsumsedsi  )   ! sums over the global domain
-         CALL mpp_sum( zsumsedcal )   ! sums over the global domain
-         CALL mpp_sum( zsumsedpo4 )   ! sums over the global domain
-      ENDIF
-
+         END DO
+      END DO
+      zsumsedsi  = glob_sum( zwork (:,:) * e1e2t(:,:) ) * rday1
+      zsumsedpo4 = glob_sum( zwork1(:,:) * e1e2t(:,:) ) * rday1
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ikt = mbkt(ji,jj) 
+            zwork (ji,jj) = trn(ji,jj,ikt,jpcal) * wscal (ji,jj,ikt)
+         END DO
+      END DO
+      zsumsedcal = glob_sum( zwork (:,:) * e1e2t(:,:) ) * 2.0 * rday1
 #endif
 
@@ -191,70 +176,50 @@
       DO jj = 1, jpj
          DO ji = 1, jpi
-            ikt = MAX( mbathy(ji,jj) - 1, 1 )
-            zconctmp = trn(ji,jj,ikt,jpdsi) * zstep / fse3t(ji,jj,ikt)   &
-# if ! defined key_kriest
-     &             * wscal (ji,jj,ikt)
+            ikt = mbkt(ji,jj)
+            zfact = xstep / fse3t(ji,jj,ikt)
+            zwsbio3 = 1._wp - zfact * wsbio3(ji,jj,ikt)
+            zwsbio4 = 1._wp - zfact * wsbio4(ji,jj,ikt)
+            zwscal  = 1._wp - zfact * wscal (ji,jj,ikt)
+            !
+# if defined key_kriest
+            trn(ji,jj,ikt,jpdsi) = trn(ji,jj,ikt,jpdsi) * zwsbio4
+            trn(ji,jj,ikt,jpnum) = trn(ji,jj,ikt,jpnum) * zwsbio4
+            trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) * zwsbio3
+            trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) * zwsbio3
 # else
-     &             * wsbio4(ji,jj,ikt)
+            trn(ji,jj,ikt,jpdsi) = trn(ji,jj,ikt,jpdsi) * zwscal 
+            trn(ji,jj,ikt,jpgoc) = trn(ji,jj,ikt,jpgoc) * zwsbio4
+            trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) * zwsbio3
+            trn(ji,jj,ikt,jpbfe) = trn(ji,jj,ikt,jpbfe) * zwsbio4
+            trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) * zwsbio3
 # endif
-            trn(ji,jj,ikt,jpdsi) = trn(ji,jj,ikt,jpdsi) - zconctmp
+            trn(ji,jj,ikt,jpcal) = trn(ji,jj,ikt,jpcal) * zwscal
+         END DO
+      END DO
 
 #if ! defined key_sed
-            trn(ji,jj,ikt,jpsil) = trn(ji,jj,ikt,jpsil) + zconctmp   &
-            &      * ( 1.- ( sumdepsi + rivalkinput / ryyss / 6. ) / zsumsedsi )
-#endif
-         END DO
-      END DO
-
+      zrivsil =  1._wp - ( sumdepsi + rivalkinput * ryyss1 / 6. ) / zsumsedsi 
+      zrivalk =  1._wp - ( rivalkinput * ryyss1 ) / zsumsedcal 
+      zrivpo4 =  1._wp - ( rivpo4input * ryyss1 ) / zsumsedpo4 
       DO jj = 1, jpj
          DO ji = 1, jpi
-            ikt = MAX( mbathy(ji,jj) - 1, 1 )
-            zconctmp = trn(ji,jj,ikt,jpcal) * wscal(ji,jj,ikt) * zstep / fse3t(ji,jj,ikt)
-            trn(ji,jj,ikt,jpcal) = trn(ji,jj,ikt,jpcal) - zconctmp
-
-#if ! defined key_sed
-            trn(ji,jj,ikt,jptal) = trn(ji,jj,ikt,jptal) + zconctmp   &
-               &   * ( 1.- ( rivalkinput / ryyss ) / zsumsedcal ) * 2.e0
-            trn(ji,jj,ikt,jpdic) = trn(ji,jj,ikt,jpdic) + zconctmp   &
-               &   * ( 1.- ( rivalkinput / ryyss ) / zsumsedcal )
-#endif
-         END DO
-      END DO
-
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            ikt = MAX( mbathy(ji,jj) - 1, 1 )
-            zfact = zstep / fse3t(ji,jj,ikt)
-# if ! defined key_kriest
-            zconctmp  = trn(ji,jj,ikt,jpgoc)
-            zconctmp2 = trn(ji,jj,ikt,jppoc)
-            trn(ji,jj,ikt,jpgoc) = trn(ji,jj,ikt,jpgoc) - zconctmp  * wsbio4(ji,jj,ikt) * zfact
-            trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) - zconctmp2 * wsbio3(ji,jj,ikt) * zfact
-#if ! defined key_sed
-            trn(ji,jj,ikt,jpdoc) = trn(ji,jj,ikt,jpdoc)    &
-            &      + ( zconctmp  * wsbio4(ji,jj,ikt) + zconctmp2 * wsbio3(ji,jj,ikt) ) * zfact   &
-            &      * ( 1.- rivpo4input / (ryyss * zsumsedpo4 ) )
-#endif
-            trn(ji,jj,ikt,jpbfe) = trn(ji,jj,ikt,jpbfe) - trn(ji,jj,ikt,jpbfe) * wsbio4(ji,jj,ikt) * zfact
-            trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) - trn(ji,jj,ikt,jpsfe) * wsbio3(ji,jj,ikt) * zfact
-
+            ikt = mbkt(ji,jj)
+            zfact = xstep / fse3t(ji,jj,ikt)
+            zwsbio3 = zfact * wsbio3(ji,jj,ikt)
+            zwsbio4 = zfact * wsbio4(ji,jj,ikt)
+            zwscal  = zfact * wscal (ji,jj,ikt)
+            trn(ji,jj,ikt,jptal) =  trn(ji,jj,ikt,jptal) + trn(ji,jj,ikt,jpcal) * zwscal  * zrivalk * 2.0
+            trn(ji,jj,ikt,jpdic) =  trn(ji,jj,ikt,jpdic) + trn(ji,jj,ikt,jpcal) * zwscal  * zrivalk
+# if defined key_kriest
+            trn(ji,jj,ikt,jpsil) =  trn(ji,jj,ikt,jpsil) + trn(ji,jj,ikt,jpdsi) * zwsbio4 * zrivsil 
+            trn(ji,jj,ikt,jpdoc) =  trn(ji,jj,ikt,jpdoc) + trn(ji,jj,ikt,jppoc) * zwsbio3 * zrivpo4 
 # else
-            zconctmp  = trn(ji,jj,ikt,jpnum)
-            zconctmp2 = trn(ji,jj,ikt,jppoc)
-            trn(ji,jj,ikt,jpnum) = trn(ji,jj,ikt,jpnum)   &
-            &      - zconctmp  * wsbio4(ji,jj,ikt) * zfact
-            trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc)   &
-            &      - zconctmp2 * wsbio3(ji,jj,ikt) * zfact
-#if ! defined key_sed
-            trn(ji,jj,ikt,jpdoc) = trn(ji,jj,ikt,jpdoc)    &
-            &      + ( zconctmp2 * wsbio3(ji,jj,ikt) )   &
-            &      * zfact * ( 1.- rivpo4input / ( ryyss * zsumsedpo4 ) )
-#endif
-            trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe)   &
-            &      - trn(ji,jj,ikt,jpsfe) * wsbio3(ji,jj,ikt) * zfact
-
+            trn(ji,jj,ikt,jpsil) =  trn(ji,jj,ikt,jpsil) + trn(ji,jj,ikt,jpdsi) * zwscal  * zrivsil 
+            trn(ji,jj,ikt,jpdoc) =  trn(ji,jj,ikt,jpdoc)   &
+            &                     + ( trn(ji,jj,ikt,jppoc) * zwsbio3 + trn(ji,jj,ikt,jpgoc) * zwsbio4 ) * zrivpo4
 # endif
          END DO
       END DO
+# endif
 
       ! Nitrogen fixation (simple parameterization). The total gain
@@ -263,14 +228,5 @@
       ! -------------------------------------------------------------
 
-      zdenitot = 0.e0
-      DO jk = 1, jpkm1
-         DO jj = 1,jpj
-            DO ji = 1,jpi
-               zdenitot = zdenitot + denitr(ji,jj,jk) * rdenit * cvol(ji,jj,jk) * xnegtr(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-
-      IF( lk_mpp )   CALL mpp_sum( zdenitot )      ! sum over the global domain
+      zdenitot = glob_sum( denitr(:,:,:)  * cvol(:,:,:) * xnegtr(:,:,:) ) * rdenit
 
       ! Potential nitrogen fixation dependant on temperature and iron
@@ -285,6 +241,6 @@
                zlim = ( 1.- xnanono3(ji,jj,jk) - xnanonh4(ji,jj,jk) )
                IF( zlim <= 0.2 )   zlim = 0.01
-               znitrpot(ji,jj,jk) = MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) / rday )   &
-# if defined key_off_degrad
+               znitrpot(ji,jj,jk) = MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) * rday1 )   &
+# if defined key_degrad
                &                  * facvol(ji,jj,jk)   &
 # endif
@@ -295,14 +251,5 @@
       END DO
 
-      znitrpottot = 0.e0
-      DO jk = 1, jpkm1
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               znitrpottot = znitrpottot + znitrpot(ji,jj,jk) * cvol(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-
-      IF( lk_mpp )   CALL mpp_sum( znitrpottot )  ! sum over the global domain
+      znitrpottot = glob_sum( znitrpot(:,:,:) * cvol(:,:,:) )
 
       ! Nitrogen change due to nitrogen fixation
@@ -312,10 +259,5 @@
          DO jj = 1, jpj
             DO ji = 1, jpi
-# if ! defined key_c1d && ( defined key_orca_r4 || defined key_orca_r2 || defined key_orca_r05 || defined key_orca_r025 )
-!!             zfact = znitrpot(ji,jj,jk) * zdenitot / znitrpottot
                zfact = znitrpot(ji,jj,jk) * 1.e-7
-# else
-               zfact = znitrpot(ji,jj,jk) * 1.e-7
-# endif
                trn(ji,jj,jk,jpnh4) = trn(ji,jj,jk,jpnh4) + zfact
                trn(ji,jj,jk,jpoxy) = trn(ji,jj,jk,jpoxy) + zfact   * o2nit
@@ -325,18 +267,18 @@
       END DO
 
-#if defined key_trc_diaadd || defined key_trc_dia3d
-      zrfact2 = 1.e+3 * rfact2r
+#if defined key_diatrc
+      zfact = 1.e+3 * rfact2r
 #  if  ! defined key_iomput
-      trc2d(:,:,jp_pcs0_2d + 11) = zirondep(:,:,1)         * zrfact2 * fse3t(:,:,1) * tmask(:,:,1)
-      trc2d(:,:,jp_pcs0_2d + 12) = znitrpot(:,:,1) * 1.e-7 * zrfact2 * fse3t(:,:,1) * tmask(:,:,1)
-# else
-      ! surface downward net flux of iron
-      zw2d(:,:)   =  ( zirondep(:,:,1) + ironsed(:,:,1) * rfact2 ) * zrfact2 * fse3t(:,:,1) * tmask(:,:,1) 
-      IF( jnt == nrdttrc ) CALL iom_put( "Irondep", zw2d )
-      ! nitrogen fixation at surface
-      zw2d(:,:)   =  znitrpot(:,:,1) * 1.e-7 * zrfact2  * fse3t(:,:,1) * tmask(:,:,1)
-      IF( jnt == nrdttrc ) CALL iom_put( "Nfix" , zw2d )
-# endif
-# endif
+      trc2d(:,:,jp_pcs0_2d + 11) = zirondep(:,:,1)         * zfact * fse3t(:,:,1) * tmask(:,:,1)
+      trc2d(:,:,jp_pcs0_2d + 12) = znitrpot(:,:,1) * 1.e-7 * zfact * fse3t(:,:,1) * tmask(:,:,1)
+#  else
+      zwork (:,:)  =  ( zirondep(:,:,1) + ironsed(:,:,1) * rfact2 ) * zfact * fse3t(:,:,1) * tmask(:,:,1) 
+      zwork1(:,:)  =  znitrpot(:,:,1) * 1.e-7                       * zfact * fse3t(:,:,1) * tmask(:,:,1)
+      IF( jnt == nrdttrc ) THEN
+         CALL iom_put( "Irondep", zwork  )  ! surface downward net flux of iron
+         CALL iom_put( "Nfix"   , zwork1 )  ! nitrogen fixation at surface
+      ENDIF
+#  endif
+#endif
       !
        IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
@@ -348,5 +290,5 @@
    END SUBROUTINE p4z_sed
 
-   SUBROUTINE p4z_sbc(kt)
+   SUBROUTINE p4z_sbc( kt )
 
       !!----------------------------------------------------------------------
@@ -365,10 +307,6 @@
 
       !! * Local declarations
-      INTEGER ::   &
-         imois, imois2,       &  ! temporary integers
-         i15  , iman             !    "          "
-      REAL(wp) ::   &
-         zxy                     !    "         "
-
+      INTEGER :: imois, i15, iman 
+      REAL(wp) :: zxy
 
       !!---------------------------------------------------------------------
@@ -381,28 +319,9 @@
       imois = nmonth + i15 - 1
       IF( imois == 0 ) imois = iman
-      imois2 = nmonth
-
-      ! 1. first call kt=nit000
-      ! -----------------------
-
-      IF( kt == nit000 ) THEN
-         ! initializations
-         nflx1  = 0
-         nflx11 = 0
-         ! open the file
-         IF(lwp) THEN
-            WRITE(numout,*) ' '
-            WRITE(numout,*) ' **** Routine p4z_sbc'
-         ENDIF
-         CALL iom_open ( 'dust.orca.nc', numdust )
-      ENDIF
-
-
-     ! Read monthly file
-      ! ----------------
-
+
+      ! Calendar computation
       IF( kt == nit000 .OR. imois /= nflx1 ) THEN
 
-         ! Calendar computation
+         IF( kt == nit000 )  nflx1  = 0
 
          ! nflx1 number of the first file record used in the simulation
@@ -410,36 +329,20 @@
 
          nflx1 = imois
-         nflx2 = nflx1+1
+         nflx2 = nflx1 + 1
          nflx1 = MOD( nflx1, iman )
          nflx2 = MOD( nflx2, iman )
          IF( nflx1 == 0 )   nflx1 = iman
          IF( nflx2 == 0 )   nflx2 = iman
-         IF(lwp) WRITE(numout,*) 'first record file used nflx1 ',nflx1
-         IF(lwp) WRITE(numout,*) 'last  record file used nflx2 ',nflx2
-
-         ! Read monthly fluxes data
-
-         ! humidity
-         CALL iom_get ( numdust, jpdom_data, 'dust', dustmo(:,:,1), nflx1 )
-         CALL iom_get ( numdust, jpdom_data, 'dust', dustmo(:,:,2), nflx2 )
-
-         IF(lwp .AND. nitend-nit000 <= 100 ) THEN
-            WRITE(numout,*)
-            WRITE(numout,*) ' read clio flx ok'
-            WRITE(numout,*)
-               WRITE(numout,*)
-               WRITE(numout,*) 'Clio month: ',nflx1,'  field: dust'
-               CALL prihre( dustmo(:,:,1),jpi,jpj,1,jpi,20,1,jpj,10,1e9,numout )
-         ENDIF
+         IF(lwp) WRITE(numout,*) 
+         IF(lwp) WRITE(numout,*) ' p4z_sbc : first record file used nflx1 ',nflx1
+         IF(lwp) WRITE(numout,*) ' p4z_sbc : last  record file used nflx2 ',nflx2
 
       ENDIF
 
-     ! 3. at every time step interpolation of fluxes
+      ! 3. at every time step interpolation of fluxes
       ! ---------------------------------------------
 
       zxy = FLOAT( nday + 15 - 30 * i15 ) / 30
-      dust(:,:) = ( (1.-zxy) * dustmo(:,:,1) + zxy * dustmo(:,:,2) )
-
-      IF( kt == nitend ) CALL iom_close (numdust)
+      dust(:,:) = ( (1.-zxy) * dustmo(:,:,nflx1) + zxy * dustmo(:,:,nflx2) )
 
    END SUBROUTINE p4z_sbc
@@ -454,5 +357,5 @@
       !!
       !! ** Method  :   Read the files and compute the budget
-      !!      called at the first timestep (nittrc000)
+      !!      called at the first timestep (nit000)
       !!
       !! ** input   :   external netcdf files
@@ -460,6 +363,5 @@
       !!----------------------------------------------------------------------
 
-      INTEGER ::   ji, jj, jk, jm
-      INTEGER , PARAMETER ::   jpmois = 12, jpan = 1
+      INTEGER :: ji, jj, jk, jm
       INTEGER :: numriv, numbath, numdep
 
@@ -469,5 +371,4 @@
       REAL(wp) , DIMENSION (jpi,jpj)     ::   riverdoc, river, ndepo
       REAL(wp) , DIMENSION (jpi,jpj,jpk) ::   cmask
-      REAL(wp) , DIMENSION(jpi,jpj,12)    ::   zdustmo
 
       NAMELIST/nampissed/ ln_dustfer, ln_river, ln_ndepo, ln_sedinput, sedfeinput, dustsolub
@@ -495,10 +396,10 @@
          IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
          CALL iom_open ( 'dust.orca.nc', numdust )
-         DO jm = 1, jpmois
-            CALL iom_get( numdust, jpdom_data, 'dust', zdustmo(:,:,jm), jm )
+         DO jm = 1, jpmth
+            CALL iom_get( numdust, jpdom_data, 'dust', dustmo(:,:,jm), jm )
          END DO
          CALL iom_close( numdust )
       ELSE
-         zdustmo(:,:,:) = 0.e0
+         dustmo(:,:,:) = 0.e0
          dust(:,:) = 0.0
       ENDIF
@@ -510,6 +411,6 @@
          IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
          CALL iom_open ( 'river.orca.nc', numriv )
-         CALL iom_get  ( numriv, jpdom_data, 'riverdic', river   (:,:), jpan )
-         CALL iom_get  ( numriv, jpdom_data, 'riverdoc', riverdoc(:,:), jpan )
+         CALL iom_get  ( numriv, jpdom_data, 'riverdic', river   (:,:), jpyr )
+         CALL iom_get  ( numriv, jpdom_data, 'riverdoc', riverdoc(:,:), jpyr )
          CALL iom_close( numriv )
       ELSE
@@ -524,5 +425,5 @@
          IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
          CALL iom_open ( 'ndeposition.orca.nc', numdep )
-         CALL iom_get  ( numdep, jpdom_data, 'ndep', ndepo(:,:), jpan )
+         CALL iom_get  ( numdep, jpdom_data, 'ndep', ndepo(:,:), jpyr )
          CALL iom_close( numdep )
       ELSE
@@ -537,5 +438,5 @@
          IF(lwp) WRITE(numout,*) '       from bathy.orca.nc file '
          CALL iom_open ( 'bathy.orca.nc', numbath )
-         CALL iom_get  ( numbath, jpdom_data, 'bathy', cmask(:,:,:), jpan )
+         CALL iom_get  ( numbath, jpdom_data, 'bathy', cmask(:,:,:), jpyr )
          CALL iom_close( numbath )
          !
@@ -546,5 +447,5 @@
                      zmaskt = tmask(ji+1,jj,jk) * tmask(ji-1,jj,jk) * tmask(ji,jj+1,jk)    &
                         &                       * tmask(ji,jj-1,jk) * tmask(ji,jj,jk+1)
-                     IF( zmaskt == 0. )   cmask(ji,jj,jk ) = 0.1
+                     IF( zmaskt == 0. )   cmask(ji,jj,jk ) = MAX( 0.1, cmask(ji,jj,jk) ) 
                   ENDIF
                END DO
@@ -567,20 +468,19 @@
 
 
-      ! Number of seconds per year and per month
-      ryyss = nyear_len(1) * rday
-      rmtss = ryyss / raamo
+      !                                    ! Number of seconds per year and per month
+      ryyss  = nyear_len(1) * rday
+      rmtss  = ryyss / raamo
+      rday1  = 1. / rday
+      ryyss1 = 1. / ryyss
+      !                                    ! ocean surface cell
+      e1e2t(:,:) = e1t(:,:) * e2t(:,:)
 
       ! total atmospheric supply of Si
       ! ------------------------------
       sumdepsi = 0.e0
-      DO jm = 1, jpmois
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               sumdepsi = sumdepsi + zdustmo(ji,jj,jm) / (12.*rmtss) * 8.8        &
-                  &     * 0.075/28.1 * e1t(ji,jj) * e2t(ji,jj) * tmask(ji,jj,1) * tmask_i(ji,jj)
-            END DO
-         END DO
-      END DO
-      IF( lk_mpp )  CALL mpp_sum( sumdepsi )  ! sum over the global domain
+      DO jm = 1, jpmth
+         zcoef = 1. / ( 12. * rmtss ) * 8.8 * 0.075 / 28.1        
+         sumdepsi = sumdepsi + glob_sum( dustmo(:,:,jm) * e1e2t(:,:) ) * zcoef
+      ENDDO
 
       ! N/P and Si releases due to coastal rivers
@@ -588,5 +488,5 @@
       DO jj = 1, jpj
          DO ji = 1, jpi
-            zcoef = ryyss * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,1) * tmask(ji,jj,1) * tmask_i(ji,jj)
+            zcoef = ryyss * e1e2t(ji,jj)  * fse3t(ji,jj,1) * tmask(ji,jj,1) 
             cotdep(ji,jj) =  river(ji,jj)                  *1E9 / ( 12. * zcoef + rtrn )
             rivinp(ji,jj) = (river(ji,jj)+riverdoc(ji,jj)) *1E9 / ( 31.6* zcoef + rtrn )
@@ -597,20 +497,7 @@
       CALL lbc_lnk( cotdep , 'T', 1. )  ;  CALL lbc_lnk( rivinp , 'T', 1. )  ;  CALL lbc_lnk( nitdep , 'T', 1. )
 
-      rivpo4input = 0.e0
-      rivalkinput = 0.e0
-      nitdepinput = 0.e0
-      DO jj = 2 , jpjm1
-         DO ji = fs_2, fs_jpim1
-            zcoef = cvol(ji,jj,1) * ryyss
-            rivpo4input = rivpo4input + rivinp(ji,jj) * zcoef
-            rivalkinput = rivalkinput + cotdep(ji,jj) * zcoef
-            nitdepinput = nitdepinput + nitdep(ji,jj) * zcoef
-         END DO
-     END DO
-      IF( lk_mpp ) THEN
-         CALL mpp_sum( rivpo4input )  ! sum over the global domain
-         CALL mpp_sum( rivalkinput )  ! sum over the global domain
-         CALL mpp_sum( nitdepinput )  ! sum over the global domain
-      ENDIF
+      rivpo4input = glob_sum( rivinp(:,:) * cvol(:,:,1) ) * ryyss
+      rivalkinput = glob_sum( cotdep(:,:) * cvol(:,:,1) ) * ryyss
+      nitdepinput = glob_sum( nitdep(:,:) * cvol(:,:,1) ) * ryyss
 
 
Index: trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsink.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsink.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsink.F90	(revision 2528)
@@ -19,5 +19,6 @@
    PRIVATE
 
-   PUBLIC   p4z_sink    ! called in p4zbio.F90
+   PUBLIC   p4z_sink         ! called in p4zbio.F90
+   PUBLIC   p4z_sink_init    ! called in trcsms_pisces.F90
 
    !! * Shared module variables
@@ -31,7 +32,4 @@
      sinkcal, sinksil,    &    !: CaCO3 and BSi sinking fluxes
      sinkfer                   !: Small BFe sinking flux
-
-   REAL(wp) ::   &
-     xstep , xstep2            !: Time step duration for biology
 
    INTEGER  :: &
@@ -71,7 +69,7 @@
 #  include "top_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -97,5 +95,5 @@
       REAL(wp) :: zdiv , zdiv1, zdiv2, zdiv3, zdiv4, zdiv5
       REAL(wp) :: zval1, zval2, zval3, zval4
-#if defined key_trc_diaadd
+#if defined key_diatrc
       REAL(wp) :: zrfact2
       INTEGER  :: ik1
@@ -106,12 +104,6 @@
       !!---------------------------------------------------------------------
 
-      IF( ( kt * jnt ) == nittrc000  )  THEN 
-          CALL p4z_sink_init   ! Initialization (first time-step only)
-          xstep  = rfact2 / rday      ! Time step duration for biology
-          xstep2 = rfact2 /  2.
-      ENDIF
-
-!     Initialisation of variables used to compute Sinking Speed
-!     ---------------------------------------------------------
+      !     Initialisation of variables used to compute Sinking Speed
+      !     ---------------------------------------------------------
 
        znum3d(:,:,:) = 0.e0
@@ -120,6 +112,6 @@
        zval3 = 1. + xkr_eta
 
-!     Computation of the vertical sinking speed : Kriest et Evans, 2000
-!     -----------------------------------------------------------------
+     !     Computation of the vertical sinking speed : Kriest et Evans, 2000
+     !     -----------------------------------------------------------------
 
       DO jk = 1, jpkm1
@@ -128,9 +120,9 @@
                IF( tmask(ji,jj,jk) /= 0.e0 ) THEN
                   znum = trn(ji,jj,jk,jppoc) / ( trn(ji,jj,jk,jpnum) + rtrn ) / xkr_massp
-! -------------- To avoid sinking speed over 50 m/day -------
+                  ! -------------- To avoid sinking speed over 50 m/day -------
                   znum  = MIN( xnumm(jk), znum )
                   znum  = MAX( 1.1      , znum )
                   znum3d(ji,jj,jk) = znum
-!------------------------------------------------------------
+                  !------------------------------------------------------------
                   zeps  = ( zval1 * znum - 1. )/ ( znum - 1. )
                   zfm   = xkr_frac**( 1. - zeps )
@@ -150,7 +142,6 @@
       wscal(:,:,:) = MAX( wsbio3(:,:,:), 50. )
 
-
-!   INITIALIZE TO ZERO ALL THE SINKING ARRAYS
-!   -----------------------------------------
+      !   INITIALIZE TO ZERO ALL THE SINKING ARRAYS
+      !   -----------------------------------------
 
       sinking (:,:,:) = 0.e0
@@ -160,7 +151,6 @@
       sinksil (:,:,:) = 0.e0
 
-!   Compute the sedimentation term using p4zsink2 for all
-!   the sinking particles
-!   -----------------------------------------------------
+     !   Compute the sedimentation term using p4zsink2 for all the sinking particles
+     !   -----------------------------------------------------
 
       CALL p4z_sink2( wsbio3, sinking , jppoc )
@@ -170,7 +160,6 @@
       CALL p4z_sink2( wscal , sinkcal , jpcal )
 
-!  Exchange between organic matter compartments due to
-!  coagulation/disaggregation
-!  ---------------------------------------------------
+     !  Exchange between organic matter compartments due to coagulation/disaggregation
+     !  ---------------------------------------------------
 
       zval1 = 1. + xkr_zeta
@@ -185,8 +174,8 @@
 
                   znum = trn(ji,jj,jk,jppoc)/(trn(ji,jj,jk,jpnum)+rtrn) / xkr_massp
-! -------------- To avoid sinking speed over 50 m/day -------
+                  !-------------- To avoid sinking speed over 50 m/day -------
                   znum  = min(xnumm(jk),znum)
                   znum  = MAX( 1.1,znum)
-!------------------------------------------------------------
+                  !------------------------------------------------------------
                   zeps  = ( zval1 * znum - 1.) / ( znum - 1.)
                   zdiv  = MAX( 1.e-4, ABS( zeps - zval3) ) * SIGN( 1., zeps - zval3 )
@@ -199,6 +188,6 @@
                   zsm   = xkr_frac**xkr_eta
 
-!    Part I : Coagulation dependant on turbulence
-!    ----------------------------------------------
+                  !    Part I : Coagulation dependant on turbulence
+                  !    ----------------------------------------------
 
                   zagg1 = ( 0.163 * trn(ji,jj,jk,jpnum)**2               &
@@ -207,5 +196,5 @@
                      &            * (zfm*xkr_mass_max**2-xkr_mass_min**2)                  &
                      &            * (zeps-1.)**2/(zdiv2*zdiv3))            &
-# if defined key_off_degrad
+# if defined key_degrad
                      &                 *facvol(ji,jj,jk)       &
 # endif
@@ -219,5 +208,5 @@
                      &                    -zfm*xkr_mass_max**3*(1.+3.*((zeps-1.)/           &
                      &                    (zeps-2.)+(zeps-1.)/zdiv3)+(zeps-1.)/zdiv1))      &
-#    if defined key_off_degrad
+#    if defined key_degrad
                      &                 *facvol(ji,jj,jk)             &
 #    endif
@@ -225,5 +214,5 @@
 
                   zagg3 = (  0.163*trn(ji,jj,jk,jpnum)**2*zfm**2*8. * xkr_mass_max**3   &
-#    if defined key_off_degrad
+#    if defined key_degrad
                      &                 *facvol(ji,jj,jk)             &
 #    endif
@@ -232,7 +221,7 @@
                   zaggsh = ( zagg1 + zagg2 + zagg3 ) * rfact2 * xdiss(ji,jj,jk) / 1000.
 
-!    Aggregation of small into large particles
-!    Part II : Differential settling
-!    ----------------------------------------------
+                 !    Aggregation of small into large particles
+                 !    Part II : Differential settling
+                 !    ----------------------------------------------
 
                   zagg4 = (  2.*3.141*0.125*trn(ji,jj,jk,jpnum)**2*                       &
@@ -242,5 +231,5 @@
                      &                 ((zfm*zfm*xkr_mass_max**2*zsm-xkr_mass_min**2)     &
                      &                 *xkr_eta)/(zdiv*zdiv3*zdiv5) )                     &
-# if defined key_off_degrad
+# if defined key_degrad
                      &                 *facvol(ji,jj,jk)        &
 # endif
@@ -252,5 +241,5 @@
                      &                 /zdiv3-(xkr_mass_min**2-zfm*zsm*xkr_mass_max**2)    &
                      &                 /zdiv)                   &
-# if defined key_off_degrad
+# if defined key_degrad
                      &                 *facvol(ji,jj,jk)        &
 # endif
@@ -261,10 +250,10 @@
                   zagg = 0.5 * xkr_stick * ( zaggsh + zaggsi )
 
-!     Aggregation of DOC to small particles
-!     --------------------------------------
+                  !     Aggregation of DOC to small particles
+                  !     --------------------------------------
 
                   zaggdoc = ( 0.4 * trn(ji,jj,jk,jpdoc)               &
                      &        + 1018.  * trn(ji,jj,jk,jppoc)  ) * xstep    &
-# if defined key_off_degrad
+# if defined key_degrad
                      &        * facvol(ji,jj,jk)                              &
 # endif
@@ -281,5 +270,5 @@
       END DO
 
-#if defined key_trc_diaadd
+#if defined key_diatrc
       zrfact2 = 1.e3 * rfact2r
       ik1 = iksed + 1
@@ -332,5 +321,5 @@
       !!
       !! ** Method  :   Read the nampiskrs namelist and check the parameters
-      !!      called at the first timestep (nittrc000)
+      !!      called at the first timestep 
       !!
       !! ** input   :   Namelist nampiskrs
@@ -473,6 +462,6 @@
       REAL(wp) ::   zagg1, zagg2, zagg3, zagg4
       REAL(wp) ::   zagg , zaggfe, zaggdoc, zaggdoc2
-      REAL(wp) ::   zfact, zwsmax
-#if defined key_trc_dia3d
+      REAL(wp) ::   zfact, zwsmax, zstep
+#if defined key_diatrc
       REAL(wp) ::   zrfact2
       INTEGER  ::   ik1
@@ -481,16 +470,11 @@
       !!---------------------------------------------------------------------
 
-      IF( ( kt * jnt ) == nittrc000  )  THEN
-          xstep  = rfact2 / rday      ! Timestep duration for biology
-          xstep2 = rfact2 /  2.
-      ENDIF
-
-!    Sinking speeds of detritus is increased with depth as shown
-!    by data and from the coagulation theory
-!    -----------------------------------------------------------
+      !    Sinking speeds of detritus is increased with depth as shown
+      !    by data and from the coagulation theory
+      !    -----------------------------------------------------------
       DO jk = 1, jpkm1
          DO jj = 1, jpj
             DO ji=1,jpi
-               zfact = MAX( 0., fsdepw(ji,jj,jk+1)-hmld(ji,jj) ) / 4000.
+               zfact = MAX( 0., fsdepw(ji,jj,jk+1) - hmld(ji,jj) ) / 4000.
                wsbio4(ji,jj,jk) = wsbio2 + ( 200.- wsbio2 ) * zfact
             END DO
@@ -498,15 +482,13 @@
       END DO
 
-!      LIMIT THE VALUES OF THE SINKING SPEEDS 
-!      TO AVOID NUMERICAL INSTABILITIES
-
+      ! limit the values of the sinking speeds to avoid numerical instabilities  
       wsbio3(:,:,:) = wsbio
-!
-! OA Below, this is garbage. the ideal would be to find a time-splitting
-! OA algorithm that does not increase the computing cost by too much
-! OA In ROMS, I have included a time-splitting procedure. But it is 
-! OA too expensive as the loop is computed globally. Thus, a small e3t
-! OA at one place determines the number of subtimesteps globally
-! OA AWFULLY EXPENSIVE !! Not able to find a better approach. Damned !!
+      !
+      ! OA Below, this is garbage. the ideal would be to find a time-splitting 
+      ! OA algorithm that does not increase the computing cost by too much
+      ! OA In ROMS, I have included a time-splitting procedure. But it is 
+      ! OA too expensive as the loop is computed globally. Thus, a small e3t
+      ! OA at one place determines the number of subtimesteps globally
+      ! OA AWFULLY EXPENSIVE !! Not able to find a better approach. Damned !!
 
       DO jk = 1,jpkm1
@@ -522,6 +504,6 @@
       wscal(:,:,:) = wsbio4(:,:,:)
 
-!   INITIALIZE TO ZERO ALL THE SINKING ARRAYS
-!   -----------------------------------------
+      !  Initializa to zero all the sinking arrays 
+      !   -----------------------------------------
 
       sinking (:,:,:) = 0.e0
@@ -532,7 +514,6 @@
       sinkfer2(:,:,:) = 0.e0
 
-!   Compute the sedimentation term using p4zsink2 for all
-!   the sinking particles
-!   -----------------------------------------------------
+      !   Compute the sedimentation term using p4zsink2 for all the sinking particles
+      !   -----------------------------------------------------
 
       CALL p4z_sink2( wsbio3, sinking , jppoc )
@@ -543,45 +524,33 @@
       CALL p4z_sink2( wscal , sinkcal , jpcal )
 
-!  Exchange between organic matter compartments due to
-!  coagulation/disaggregation
-!  ---------------------------------------------------
+      !  Exchange between organic matter compartments due to coagulation/disaggregation
+      !  ---------------------------------------------------
 
       DO jk = 1, jpkm1
          DO jj = 1, jpj
             DO ji = 1, jpi
-               zfact = xstep * xdiss(ji,jj,jk)
+# if defined key_degrad
+               zstep = xstep * facvol(ji,jj,jk)
+# else
+               zstep = xstep 
+# endif
+               zfact = zstep * xdiss(ji,jj,jk)
                !  Part I : Coagulation dependent on turbulence
-# if defined key_off_degrad
-               zagg1 = 940.* zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) * facvol(ji,jj,jk)
-               zagg2 = 1.054e4 * zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) * facvol(ji,jj,jk)
-# else
                zagg1 = 940.* zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc)
                zagg2 = 1.054e4 * zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc)
-# endif
 
                ! Part II : Differential settling
 
                !  Aggregation of small into large particles
-# if defined key_off_degrad
-               zagg3 = 0.66 * xstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) * facvol(ji,jj,jk)
-               zagg4 = 0.e0 * xstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) * facvol(ji,jj,jk)
-# else
-               zagg3 = 0.66 * xstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc)
-               zagg4 = 0.e0 * xstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc)
-# endif
+               zagg3 = 0.66 * zstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc)
+               zagg4 = 0.e0 * zstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc)
+
                zagg   = zagg1 + zagg2 + zagg3 + zagg4
                zaggfe = zagg * trn(ji,jj,jk,jpsfe) / ( trn(ji,jj,jk,jppoc) + rtrn )
 
                ! Aggregation of DOC to small particles
-#if defined key_off_degrad
-               zaggdoc = ( 80.* trn(ji,jj,jk,jpdoc) + 698. * trn(ji,jj,jk,jppoc) )       &
-                  &      * facvol(ji,jj,jk)  * zfact * trn(ji,jj,jk,jpdoc)
-               zaggdoc2 = 1.05e4 * zfact * trn(ji,jj,jk,jpgoc)   &
-                  &      * facvol(ji,jj,jk) * trn(ji,jj,jk,jpdoc)
-#else
-               zaggdoc = ( 80.* trn(ji,jj,jk,jpdoc) + 698. * trn(ji,jj,jk,jppoc) )    &
-                  &      *  zfact * trn(ji,jj,jk,jpdoc)
+               zaggdoc = ( 80.* trn(ji,jj,jk,jpdoc) + 698. * trn(ji,jj,jk,jppoc) ) *  zfact * trn(ji,jj,jk,jpdoc) 
                zaggdoc2 = 1.05e4 * zfact * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpdoc)
-#endif
+
                !  Update the trends
                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zagg + zaggdoc
@@ -595,5 +564,5 @@
       END DO
 
-#if defined key_trc_diaadd
+#if defined key_diatrc
       zrfact2 = 1.e3 * rfact2r
       ik1  = iksed + 1
@@ -623,4 +592,10 @@
    END SUBROUTINE p4z_sink
 
+   SUBROUTINE p4z_sink_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE p4z_sink_init  ***
+      !!----------------------------------------------------------------------
+   END SUBROUTINE p4z_sink_init
+
 #endif
 
@@ -641,5 +616,5 @@
       !!
       INTEGER  ::   ji, jj, jk, jn
-      REAL(wp) ::   zigma,zew,zign, zflx
+      REAL(wp) ::   zigma,zew,zign, zflx, zstep
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::  ztraz, zakz
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zwsink2
@@ -647,9 +622,11 @@
 
 
+      zstep = rfact2 / 2.
+
       ztraz(:,:,:) = 0.e0
       zakz (:,:,:) = 0.e0
 
       DO jk = 1, jpkm1
-# if defined key_off_degrad
+# if defined key_degrad
          zwsink2(:,:,jk+1) = -pwsink(:,:,jk) / rday * tmask(:,:,jk+1) * facvol(:,:,jk)
 # else
@@ -693,7 +670,7 @@
             DO jj = 1, jpj      
                DO ji = 1, jpi    
-                  zigma = zwsink2(ji,jj,jk+1) * xstep2 / fse3w(ji,jj,jk+1)
+                  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) ) * xstep2
+                  psinkflx(ji,jj,jk+1) = -zew * ( trn(ji,jj,jk,jp_tra) - 0.5 * ( 1 + zigma ) * zakz(ji,jj,jk) ) * zstep
                END DO
             END DO
Index: trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/par_pisces.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/par_pisces.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/par_pisces.F90	(revision 2528)
@@ -6,7 +6,7 @@
    !! History :   2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
    USE par_lobster, ONLY : jp_lobster      !: number of tracers in LOBSTER
@@ -17,8 +17,8 @@
    IMPLICIT NONE
 
-   INTEGER, PARAMETER ::   jp_lp      = jp_lobster      !: cumulative number of already defined TRC
-   INTEGER, PARAMETER ::   jp_lp_2d   = jp_lobster_2d   !:
-   INTEGER, PARAMETER ::   jp_lp_3d   = jp_lobster_3d   !:
-   INTEGER, PARAMETER ::   jp_lp_trd  = jp_lobster_trd  !:
+   INTEGER, PUBLIC, PARAMETER ::   jp_lp      = jp_lobster      !: cumulative number of already defined TRC
+   INTEGER, PUBLIC, PARAMETER ::   jp_lp_2d   = jp_lobster_2d   !:
+   INTEGER, PUBLIC, PARAMETER ::   jp_lp_3d   = jp_lobster_3d   !:
+   INTEGER, PUBLIC, PARAMETER ::   jp_lp_trd  = jp_lobster_trd  !:
 
 #if defined key_pisces  &&  defined key_kriest
@@ -29,6 +29,6 @@
    LOGICAL, PUBLIC, PARAMETER ::   lk_kriest     = .TRUE.  !: Kriest flag 
    INTEGER, PUBLIC, PARAMETER ::   jp_pisces     =  23     !: number of passive tracers
-   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_2d  =  13     !: additional 2d output ('key_trc_diaadd')
-   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_3d  =  18     !: additional 3d output ('key_trc_diaadd')
+   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_2d  =  13     !: additional 2d output ('key_diatrc')
+   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_3d  =  18     !: additional 3d output ('key_diatrc')
    INTEGER, PUBLIC, PARAMETER ::   jp_pisces_trd =   1     !: number of sms trends for PISCES
 
@@ -67,6 +67,6 @@
    LOGICAL, PUBLIC, PARAMETER ::   lk_kriest     = .FALSE. !: Kriest flag 
    INTEGER, PUBLIC, PARAMETER ::   jp_pisces     = 24      !: number of PISCES passive tracers
-   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_2d  = 13      !: additional 2d output ('key_trc_diaadd')
-   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_3d  = 11      !: additional 3d output ('key_trc_diaadd')
+   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_2d  = 13      !: additional 2d output ('key_diatrc')
+   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_3d  = 11      !: additional 3d output ('key_diatrc')
    INTEGER, PUBLIC, PARAMETER ::   jp_pisces_trd =  1      !: number of sms trends for PISCES
 
Index: trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90	(revision 2528)
@@ -23,4 +23,5 @@
    REAL(wp) ::   rfact , rfactr    !: ???
    REAL(wp) ::   rfact2, rfact2r   !: ???
+   REAL(wp) ::   xstep             !: Time step duration for biology
 
    !!*  Biological parameters 
@@ -62,5 +63,5 @@
    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   xlimbac    !: ??
    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   xdiss      !: ??
-#if defined key_trc_dia3d
+#if defined key_diatrc
    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   prodcal    !: Calcite production
    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   grazing    !: Total zooplankton grazing
@@ -91,7 +92,7 @@
    
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 3.2 , LOCEAN-IPSL (2009) 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!======================================================================   
 END MODULE sms_pisces    
Index: trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcctl_pisces.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcctl_pisces.F90	(revision 2527)
+++ 	(revision )
@@ -1,60 +1,0 @@
-MODULE trcctl_pisces
-   !!======================================================================
-   !!                         ***  trcctl_pisces.F90  ***
-   !! TOP :                Control of PISCES biogeochemical model
-   !!======================================================================
-   !!----------------------------------------------------------------------
-   !! History :   1.0  !  2000-12 (C. Ethe) assign a parameter to name individual tracers
-   !!----------------------------------------------------------------------
-
-#if defined key_pisces
-
-   USE oce_trc
-   USE trc
-
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC trc_ctl_pisces     ! called by ???
-
-
-   !!----------------------------------------------------------------------
-   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE trc_ctl_pisces
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE trc_ctl_pisces  ***
-      !!
-      !! ** Purpose :   control the cpp options, namelist and files 
-      !!----------------------------------------------------------------------
-
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) ' use PISCES biological model '
-
-   ! Check number of tracers
-   ! -----------------------
-#if  defined key_kriest
-      IF( jp_pisces /= 23) CALL ctl_stop( ' PISCES must have 23 passive tracers. Change jp_pisces in par_pisces.F90' )
-#else
-      IF( jp_pisces /= 24) CALL ctl_stop( ' PISCES must have 24 passive tracers. Change jp_pisces in par_pisces.F90' )
-#endif
-
-   END SUBROUTINE trc_ctl_pisces
-
-#else
-   !!----------------------------------------------------------------------
-   !!  Empty module :                                            No PISCES
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE trc_ctl_pisces                 ! Dummy routine
-   END SUBROUTINE trc_ctl_pisces
-#endif
-
-   !!======================================================================
-END MODULE trcctl_pisces
Index: trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90	(revision 2528)
@@ -40,7 +40,7 @@
 #  include "top_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -55,17 +55,20 @@
 
 
+      !  Control consitency
+      CALL trc_ctl_pisces
+
+
       IF(lwp) WRITE(numout,*)
       IF(lwp) WRITE(numout,*) ' trc_ini_pisces :   PISCES biochemical model initialisation'
       IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
 
-
       !                                            ! Time-step
-      rfact   = rdttra(1) * float(ndttrc)          ! ---------
+      rfact   = rdttrc(1)                          ! ---------
       rfactr  = 1. / rfact
-      rfact2  = rfact / float(nrdttrc)
+      rfact2  = rfact / FLOAT( nrdttrc )
       rfact2r = 1. / rfact2
 
-      IF(lwp) WRITE(numout,*) '    Tracer  time step    rfact  = ', rfact, ' rdt = ', rdt
-      IF(lwp) write(numout,*) '    Biology time step    rfact2 = ', rfact2
+      IF(lwp) WRITE(numout,*) '    Passive Tracer  time step    rfact  = ', rfact, ' rdt = ', rdttra(1)
+      IF(lwp) write(numout,*) '    PISCES  Biology time step    rfact2 = ', rfact2
 
 
@@ -80,6 +83,4 @@
 
       CALL p4z_che        ! initialize the chemical constants
-
-      ndayflxtr = 0      !  Initialize a counter for the computation of chemistry
 
       ! Initialization of tracer concentration in case of  no restart 
@@ -128,5 +129,25 @@
       !
    END SUBROUTINE trc_ini_pisces
-   
+ 
+   SUBROUTINE trc_ctl_pisces
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_ctl_pisces  ***
+      !!
+      !! ** Purpose :   control the cpp options, namelist and files 
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' use PISCES biological model '
+
+   ! Check number of tracers
+   ! -----------------------
+#if  defined key_kriest
+      IF( jp_pisces /= 23) CALL ctl_stop( ' PISCES must have 23 passive tracers. Change jp_pisces in par_pisces.F90' )
+#else
+      IF( jp_pisces /= 24) CALL ctl_stop( ' PISCES must have 24 passive tracers. Change jp_pisces in par_pisces.F90' )
+#endif
+
+   END SUBROUTINE trc_ctl_pisces
+  
 #else
    !!----------------------------------------------------------------------
Index: trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trclsm_pisces.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trclsm_pisces.F90	(revision 2527)
+++ 	(revision )
@@ -1,207 +1,0 @@
-MODULE trclsm_pisces
-   !!======================================================================
-   !!                      ***  MODULE trclsm_lobster  ***
-   !! TOP :   initialisation of some run parameters for PISCES bio-model
-   !!======================================================================
-   !! History :    -   !  1999-10 (M.A. Foujols, M. Levy) original code
-   !!              -   !  2000-01 (L. Bopp) hamocc3, p3zd
-   !!             1.0  !  2003-08 (C. Ethe)  module F90
-   !!             2.0  !  2007-12  (C. Ethe, G. Madec) from trclsm.pisces.h90
-   !!----------------------------------------------------------------------
-#if defined key_pisces
-   !!----------------------------------------------------------------------
-   !!   'key_pisces'   :                                   PISCES bio-model
-   !!----------------------------------------------------------------------
-   !! trc_lsm_pisces       : PISCES model namelist read
-   !!----------------------------------------------------------------------
-   USE oce_trc         ! Ocean variables
-   USE par_trc         ! TOP parameters
-   USE trc             ! TOP variables
-   USE sms_pisces      ! sms trends
-   USE in_out_manager  ! I/O manager
-
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   trc_lsm_pisces   ! called by trclsm.F90 module
-
-
-   !!----------------------------------------------------------------------
-   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE trc_lsm_pisces
-      !!----------------------------------------------------------------------
-      !!                     ***  trc_lsm_pisces  ***  
-      !!
-      !! ** Purpose :   read PISCES namelist
-      !!
-      !! ** input   :   file 'namelist.trc.sms' containing the following
-      !!             namelist: natext, natbio, natsms
-      !!                       natkriest ("key_kriest")
-      !!----------------------------------------------------------------------
-      !!
-#if defined key_trc_diaadd && ! defined key_iomput
-      INTEGER ::  jl, jn
-      ! definition of additional diagnostic as a structure
-      TYPE DIAG
-         CHARACTER(len = 20)  :: snamedia   !: short name
-         CHARACTER(len = 80 ) :: lnamedia   !: long name
-         CHARACTER(len = 20 ) :: unitdia    !: unit
-      END TYPE DIAG
-
-      TYPE(DIAG) , DIMENSION(jp_pisces_2d) :: pisdia2d
-      TYPE(DIAG) , DIMENSION(jp_pisces_3d) :: pisdia3d
-#endif
-
-      NAMELIST/nampisbio/ part, nrdttrc, wsbio, xkmort, ferat3, wsbio2
-#if defined key_kriest
-      NAMELIST/nampiskrp/ xkr_eta, xkr_zeta, xkr_mass_min, xkr_mass_max
-#endif
-#if defined key_trc_diaadd && ! defined key_iomput
-      NAMELIST/nampisdia/ nwritedia, pisdia3d, pisdia2d     ! additional diagnostics
-#endif
-      NAMELIST/nampisdmp/ ln_pisdmp, ln_pisclo
-
-      !!----------------------------------------------------------------------
-
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) ' trc_lsm_pisces : read PISCES namelists'
-      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
-
-
-      !                               ! Open the namelist file
-      !                               ! ----------------------
-      CALL ctl_opn( numnat, 'namelist_pisces', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
-
-      REWIND( numnat )                    
-      READ  ( numnat, nampisbio )
-
-      IF(lwp) THEN                         ! control print
-         WRITE(numout,*) ' Namelist : nampisbio'
-         WRITE(numout,*) '    part of calcite not dissolved in guts     part      =', part
-         WRITE(numout,*) '    frequence pour la biologie                nrdttrc   =', nrdttrc
-         WRITE(numout,*) '    POC sinking speed                         wsbio     =', wsbio
-         WRITE(numout,*) '    half saturation constant for mortality    xkmort    =', xkmort
-         WRITE(numout,*) '    Fe/C in zooplankton                       ferat3    =', ferat3
-         WRITE(numout,*) '    Big particles sinking speed               wsbio2    =', wsbio2
-      ENDIF
-
-#if defined key_kriest
-
-      !                               ! nampiskrp : kriest parameters
-      !                               ! -----------------------------
-      xkr_eta      = 0.62        
-      xkr_zeta     = 1.62        
-      xkr_mass_min = 0.0002     
-      xkr_mass_max = 1.      
-
-      REWIND( numnat )                     ! read natkriest
-      READ  ( numnat, nampiskrp )
-
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) ' Namelist : nampiskrp'
-         WRITE(numout,*) '    Sinking  exponent                        xkr_eta      = ', xkr_eta
-         WRITE(numout,*) '    N content exponent                       xkr_zeta     = ', xkr_zeta
-         WRITE(numout,*) '    Minimum mass for Aggregates              xkr_mass_min = ', xkr_mass_min
-         WRITE(numout,*) '    Maximum mass for Aggregates              xkr_mass_max = ', xkr_mass_max
-         WRITE(numout,*)
-     ENDIF
-
-
-     ! Computation of some variables
-     xkr_massp = 5.7E-6 * 7.6 * xkr_mass_min**xkr_zeta
-
-#endif
-      !
-#if defined key_trc_diaadd && ! defined key_iomput
-
-      ! Namelist namlobdia
-      ! -------------------
-      nwritedia = 10                   ! default values
-
-      DO jl = 1, jp_pisces_2d
-         jn = jp_pcs0_2d + jl - 1
-         WRITE(ctrc2d(jn),'("2D_",I1)') jn                      ! short name
-         WRITE(ctrc2l(jn),'("2D DIAGNOSTIC NUMBER ",I2)') jn    ! long name
-         ctrc2u(jn) = ' '                                       ! units
-      END DO
-      !                                 ! 3D output arrays
-      DO jl = 1, jp_pisces_3d
-         jn = jp_pcs0_3d + jl - 1
-         WRITE(ctrc3d(jn),'("3D_",I1)') jn                      ! short name
-         WRITE(ctrc3l(jn),'("3D DIAGNOSTIC NUMBER ",I2)') jn    ! long name
-         ctrc3u(jn) = ' '                                       ! units
-      END DO
-
-      REWIND( numnat )               ! read natrtd
-      READ  ( numnat, nampisdia )
-
-      DO jl = 1, jp_pisces_2d
-         jn = jp_pcs0_2d + jl - 1
-         ctrc2d(jn) = pisdia2d(jl)%snamedia
-         ctrc2l(jn) = pisdia2d(jl)%lnamedia
-         ctrc2u(jn) = pisdia2d(jl)%unitdia
-      END DO
-
-      DO jl = 1, jp_pisces_3d
-         jn = jp_pcs0_3d + jl - 1
-         ctrc3d(jn) = pisdia3d(jl)%snamedia
-         ctrc3l(jn) = pisdia3d(jl)%lnamedia
-         ctrc3u(jn) = pisdia3d(jl)%unitdia
-      END DO
-
-      IF(lwp) THEN                   ! control print
-         WRITE(numout,*)
-         WRITE(numout,*) ' Namelist : natadd'
-         WRITE(numout,*) '    frequency of outputs for additional arrays nwritedia = ', nwritedia
-         DO jl = 1, jp_pisces_3d
-            jn = jp_pcs0_3d + jl - 1
-            WRITE(numout,*) '   3d output field No : ',jn
-            WRITE(numout,*) '   short name         : ', TRIM(ctrc3d(jn))
-            WRITE(numout,*) '   long name          : ', TRIM(ctrc3l(jn))
-            WRITE(numout,*) '   unit               : ', TRIM(ctrc3u(jn))
-            WRITE(numout,*) ' '
-         END DO
-
-         DO jl = 1, jp_pisces_2d
-            jn = jp_pcs0_2d + jl - 1
-            WRITE(numout,*) '   2d output field No : ',jn
-            WRITE(numout,*) '   short name         : ', TRIM(ctrc2d(jn))
-            WRITE(numout,*) '   long name          : ', TRIM(ctrc2l(jn))
-            WRITE(numout,*) '   unit               : ', TRIM(ctrc2u(jn))
-            WRITE(numout,*) ' '
-         END DO
-      ENDIF
-#endif
-
-      REWIND( numnat )
-      READ  ( numnat, nampisdmp )
-
-      IF(lwp) THEN                         ! control print
-         WRITE(numout,*)
-         WRITE(numout,*) ' Namelist : nampisdmp'
-         WRITE(numout,*) '    Relaxation of tracer to glodap mean value            ln_pisdmp      =', ln_pisdmp
-         WRITE(numout,*) '    Restoring of tracer to initial value  on closed seas  ln_pisclo      =', ln_pisclo
-         WRITE(numout,*) ' '
-      ENDIF
-
-   END SUBROUTINE trc_lsm_pisces
-
-#else
-   !!----------------------------------------------------------------------
-   !!  Dummy module :                                   No PISCES bio-model
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE trc_lsm_pisces                      ! Empty routine
-   END  SUBROUTINE  trc_lsm_pisces
-#endif  
-
-   !!======================================================================
-END MODULE trclsm_pisces
Index: trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcnam_pisces.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcnam_pisces.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcnam_pisces.F90	(revision 2528)
@@ -0,0 +1,207 @@
+MODULE trcnam_pisces
+   !!======================================================================
+   !!                      ***  MODULE trcnam_lobster  ***
+   !! TOP :   initialisation of some run parameters for PISCES bio-model
+   !!======================================================================
+   !! History :    -   !  1999-10 (M.A. Foujols, M. Levy) original code
+   !!              -   !  2000-01 (L. Bopp) hamocc3, p3zd
+   !!             1.0  !  2003-08 (C. Ethe)  module F90
+   !!             2.0  !  2007-12  (C. Ethe, G. Madec) from trcnam.pisces.h90
+   !!----------------------------------------------------------------------
+#if defined key_pisces
+   !!----------------------------------------------------------------------
+   !!   'key_pisces'   :                                   PISCES bio-model
+   !!----------------------------------------------------------------------
+   !! trc_nam_pisces       : PISCES model namelist read
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! Ocean variables
+   USE par_trc         ! TOP parameters
+   USE trc             ! TOP variables
+   USE sms_pisces      ! sms trends
+   USE in_out_manager  ! I/O manager
+
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_nam_pisces   ! called by trcnam.F90 module
+
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_nam_pisces
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_nam_pisces  ***  
+      !!
+      !! ** Purpose :   read PISCES namelist
+      !!
+      !! ** input   :   file 'namelist.trc.sms' containing the following
+      !!             namelist: natext, natbio, natsms
+      !!                       natkriest ("key_kriest")
+      !!----------------------------------------------------------------------
+      !!
+#if defined key_diatrc && ! defined key_iomput
+      INTEGER ::  jl, jn
+      ! definition of additional diagnostic as a structure
+      TYPE DIAG
+         CHARACTER(len = 20)  :: snamedia   !: short name
+         CHARACTER(len = 80 ) :: lnamedia   !: long name
+         CHARACTER(len = 20 ) :: unitdia    !: unit
+      END TYPE DIAG
+
+      TYPE(DIAG) , DIMENSION(jp_pisces_2d) :: pisdia2d
+      TYPE(DIAG) , DIMENSION(jp_pisces_3d) :: pisdia3d
+#endif
+
+      NAMELIST/nampisbio/ part, nrdttrc, wsbio, xkmort, ferat3, wsbio2
+#if defined key_kriest
+      NAMELIST/nampiskrp/ xkr_eta, xkr_zeta, xkr_mass_min, xkr_mass_max
+#endif
+#if defined key_diatrc && ! defined key_iomput
+      NAMELIST/nampisdia/ nwritedia, pisdia3d, pisdia2d     ! additional diagnostics
+#endif
+      NAMELIST/nampisdmp/ ln_pisdmp, ln_pisclo
+
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_nam_pisces : read PISCES namelists'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+
+
+      !                               ! Open the namelist file
+      !                               ! ----------------------
+      CALL ctl_opn( numnat, 'namelist_pisces', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+
+      REWIND( numnat )                    
+      READ  ( numnat, nampisbio )
+
+      IF(lwp) THEN                         ! control print
+         WRITE(numout,*) ' Namelist : nampisbio'
+         WRITE(numout,*) '    part of calcite not dissolved in guts     part      =', part
+         WRITE(numout,*) '    frequence pour la biologie                nrdttrc   =', nrdttrc
+         WRITE(numout,*) '    POC sinking speed                         wsbio     =', wsbio
+         WRITE(numout,*) '    half saturation constant for mortality    xkmort    =', xkmort
+         WRITE(numout,*) '    Fe/C in zooplankton                       ferat3    =', ferat3
+         WRITE(numout,*) '    Big particles sinking speed               wsbio2    =', wsbio2
+      ENDIF
+
+#if defined key_kriest
+
+      !                               ! nampiskrp : kriest parameters
+      !                               ! -----------------------------
+      xkr_eta      = 0.62        
+      xkr_zeta     = 1.62        
+      xkr_mass_min = 0.0002     
+      xkr_mass_max = 1.      
+
+      REWIND( numnat )                     ! read natkriest
+      READ  ( numnat, nampiskrp )
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) ' Namelist : nampiskrp'
+         WRITE(numout,*) '    Sinking  exponent                        xkr_eta      = ', xkr_eta
+         WRITE(numout,*) '    N content exponent                       xkr_zeta     = ', xkr_zeta
+         WRITE(numout,*) '    Minimum mass for Aggregates              xkr_mass_min = ', xkr_mass_min
+         WRITE(numout,*) '    Maximum mass for Aggregates              xkr_mass_max = ', xkr_mass_max
+         WRITE(numout,*)
+     ENDIF
+
+
+     ! Computation of some variables
+     xkr_massp = 5.7E-6 * 7.6 * xkr_mass_min**xkr_zeta
+
+#endif
+      !
+#if defined key_diatrc && ! defined key_iomput
+
+      ! Namelist namlobdia
+      ! -------------------
+      nwritedia = 10                   ! default values
+
+      DO jl = 1, jp_pisces_2d
+         jn = jp_pcs0_2d + jl - 1
+         WRITE(ctrc2d(jn),'("2D_",I1)') jn                      ! short name
+         WRITE(ctrc2l(jn),'("2D DIAGNOSTIC NUMBER ",I2)') jn    ! long name
+         ctrc2u(jn) = ' '                                       ! units
+      END DO
+      !                                 ! 3D output arrays
+      DO jl = 1, jp_pisces_3d
+         jn = jp_pcs0_3d + jl - 1
+         WRITE(ctrc3d(jn),'("3D_",I1)') jn                      ! short name
+         WRITE(ctrc3l(jn),'("3D DIAGNOSTIC NUMBER ",I2)') jn    ! long name
+         ctrc3u(jn) = ' '                                       ! units
+      END DO
+
+      REWIND( numnat )               ! read natrtd
+      READ  ( numnat, nampisdia )
+
+      DO jl = 1, jp_pisces_2d
+         jn = jp_pcs0_2d + jl - 1
+         ctrc2d(jn) = pisdia2d(jl)%snamedia
+         ctrc2l(jn) = pisdia2d(jl)%lnamedia
+         ctrc2u(jn) = pisdia2d(jl)%unitdia
+      END DO
+
+      DO jl = 1, jp_pisces_3d
+         jn = jp_pcs0_3d + jl - 1
+         ctrc3d(jn) = pisdia3d(jl)%snamedia
+         ctrc3l(jn) = pisdia3d(jl)%lnamedia
+         ctrc3u(jn) = pisdia3d(jl)%unitdia
+      END DO
+
+      IF(lwp) THEN                   ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) ' Namelist : natadd'
+         WRITE(numout,*) '    frequency of outputs for additional arrays nwritedia = ', nwritedia
+         DO jl = 1, jp_pisces_3d
+            jn = jp_pcs0_3d + jl - 1
+            WRITE(numout,*) '   3d output field No : ',jn
+            WRITE(numout,*) '   short name         : ', TRIM(ctrc3d(jn))
+            WRITE(numout,*) '   long name          : ', TRIM(ctrc3l(jn))
+            WRITE(numout,*) '   unit               : ', TRIM(ctrc3u(jn))
+            WRITE(numout,*) ' '
+         END DO
+
+         DO jl = 1, jp_pisces_2d
+            jn = jp_pcs0_2d + jl - 1
+            WRITE(numout,*) '   2d output field No : ',jn
+            WRITE(numout,*) '   short name         : ', TRIM(ctrc2d(jn))
+            WRITE(numout,*) '   long name          : ', TRIM(ctrc2l(jn))
+            WRITE(numout,*) '   unit               : ', TRIM(ctrc2u(jn))
+            WRITE(numout,*) ' '
+         END DO
+      ENDIF
+#endif
+
+      REWIND( numnat )
+      READ  ( numnat, nampisdmp )
+
+      IF(lwp) THEN                         ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) ' Namelist : nampisdmp'
+         WRITE(numout,*) '    Relaxation of tracer to glodap mean value            ln_pisdmp      =', ln_pisdmp
+         WRITE(numout,*) '    Restoring of tracer to initial value  on closed seas  ln_pisclo      =', ln_pisclo
+         WRITE(numout,*) ' '
+      ENDIF
+
+   END SUBROUTINE trc_nam_pisces
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                   No PISCES bio-model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_nam_pisces                      ! Empty routine
+   END  SUBROUTINE  trc_nam_pisces
+#endif  
+
+   !!======================================================================
+END MODULE trcnam_pisces
Index: trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcrst_pisces.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcrst_pisces.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcrst_pisces.F90	(revision 2528)
@@ -21,4 +21,6 @@
    USE iom
    USE trcdta
+   USE lib_mpp
+   USE lib_fortran
 
    IMPLICIT NONE
@@ -118,35 +120,20 @@
       IF(lwp)  WRITE(numout,*)
 
-      IF( cp_cfg == "orca" .AND. .NOT. lk_trc_c1d ) THEN      ! ORCA condiguration (not 1D) !
+      IF( cp_cfg == "orca" .AND. .NOT. lk_c1d ) THEN      ! ORCA condiguration (not 1D) !
          !                                                    ! --------------------------- !
          ! set total alkalinity, phosphate, nitrate & silicate
 
-         zalksum = 0.e0
-         zpo4sum = 0.e0
-         zno3sum = 0.e0
-         zsilsum = 0.e0
-         DO jk = 1, jpk
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zvol = cvol(ji,jj,jk)
-#  if defined key_off_degrad
-                  zvol = zvol * facvol(ji,jj,jk)
-#  endif
-                  zalksum = zalksum + trn(ji,jj,jk,jptal) * zvol
-                  zpo4sum = zpo4sum + trn(ji,jj,jk,jppo4) * zvol
-                  zno3sum = zno3sum + trn(ji,jj,jk,jpno3) * zvol
-                  zsilsum = zsilsum + trn(ji,jj,jk,jpsil) * zvol
-               END DO
-            END DO
-         END DO
-         IF( lk_mpp )   CALL mpp_sum( zalksum )     ! sum over the global domain
-         IF( lk_mpp )   CALL mpp_sum( zpo4sum )     ! sum over the global domain
-         IF( lk_mpp )   CALL mpp_sum( zno3sum )     ! sum over the global domain
-         IF( lk_mpp )   CALL mpp_sum( zsilsum )     ! sum over the global domain
          zarea   = 1. / areatot * 1.e6
-         zalksum = zalksum * zarea
-         zpo4sum = zpo4sum * zarea / 122.
-         zno3sum = zno3sum * zarea / 7.6
-         zsilsum = zsilsum * zarea
+# if defined key_degrad
+         zalksum = glob_sum( trn(:,:,:,jptal) * cvol(:,:,:) * facvol(:,:,:) ) * zarea
+         zpo4sum = glob_sum( trn(:,:,:,jppo4) * cvol(:,:,:) * facvol(:,:,:) ) * zarea / 122.
+         zno3sum = glob_sum( trn(:,:,:,jpno3) * cvol(:,:,:) * facvol(:,:,:) ) * zarea / 7.6
+         zsilsum = glob_sum( trn(:,:,:,jpsil) * cvol(:,:,:) * facvol(:,:,:) ) * zarea
+# else
+         zalksum = glob_sum( trn(:,:,:,jptal) * cvol(:,:,:)  ) * zarea
+         zpo4sum = glob_sum( trn(:,:,:,jppo4) * cvol(:,:,:)  ) * zarea / 122.
+         zno3sum = glob_sum( trn(:,:,:,jpno3) * cvol(:,:,:)  ) * zarea / 7.6
+         zsilsum = glob_sum( trn(:,:,:,jpsil) * cvol(:,:,:)  ) * zarea
+# endif
 
          IF(lwp) WRITE(numout,*) '       TALK mean : ', zalksum
@@ -263,5 +250,5 @@
 #if defined key_dtatrc
       ! Restore close seas values to initial data
-      CALL trc_dta( nittrc000 ) 
+      CALL trc_dta( nit000 ) 
       DO jn = 1, jptra
          IF( lutini(jn) ) THEN
Index: trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcsms_pisces.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcsms_pisces.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcsms_pisces.F90	(revision 2528)
@@ -22,10 +22,20 @@
    USE p4zche          ! 
    USE p4zbio          ! 
+   USE p4zsink         ! 
+   USE p4zopt          ! 
+   USE p4zlim          ! 
+   USE p4zprod         !
+   USE p4zmort         !
+   USE p4zmicro        ! 
+   USE p4zmeso         ! 
+   USE p4zrem          ! 
    USE p4zsed          ! 
    USE p4zlys          ! 
    USE p4zflx          ! 
 
-   USE trdmld_trc_oce
-   USE trdmld_trc
+   USE prtctl_trc
+
+   USE trdmod_oce
+   USE trdmod_trc
 
    USE sedmodel
@@ -37,7 +47,7 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -59,11 +69,16 @@
       INTEGER ::   jnt, jn
       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztrpis   ! used for pisces sms trends
+      CHARACTER (len=25) :: charout
       !!---------------------------------------------------------------------
 
-      IF( kt == nittrc000  .AND. .NOT. ln_rsttr )   CALL trc_sms_pisces_init    ! Initialization (first time-step only)
+      IF( kt == nit000 )   CALL trc_sms_pisces_init    ! Initialization (first time-step only)
 
-      IF( ndayflxtr /= nday ) THEN      ! New days
+      IF( ndayflxtr /= nday_year ) THEN      ! New days
          !
-         ndayflxtr = nday
+         ndayflxtr = nday_year
+
+         IF(lwp) write(numout,*)
+         IF(lwp) write(numout,*) ' New chemical constants and various rates for biogeochemistry at new day : ', nday_year
+         IF(lwp) write(numout,*) '~~~~~~'
 
          CALL p4z_che          ! computation of chemical constants
@@ -71,5 +86,4 @@
          !
       ENDIF
-
 
       DO jnt = 1, nrdttrc          ! Potential time splitting if requested
@@ -91,8 +105,9 @@
       END DO
 
+
       IF( l_trdtrc ) THEN
           DO jn = jp_pcs0, jp_pcs1
             ztrpis(:,:,:) = tra(:,:,:,jn)
-            CALL trd_mod_trc( ztrpis, jn, jptrc_trd_sms, kt )   ! save trends
+            CALL trd_mod_trc( ztrpis, jn, jptra_trd_sms, kt )   ! save trends
           END DO
       END IF
@@ -121,18 +136,38 @@
       REAL(wp) ::  ztmas, ztmas1
 
-      ! Initialization of chemical variables of the carbon cycle
-      ! --------------------------------------------------------
-      DO jk = 1, jpk
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               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 )
-               hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1
+      IF( .NOT. ln_rsttr ) THEN
+         ! Initialization of chemical variables of the carbon cycle
+         ! --------------------------------------------------------
+         DO jk = 1, jpk
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  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 )
+                  hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1
+               END DO
             END DO
          END DO
-      END DO
+         !
+      END IF
+
+      ! Time step duration for biology
+      xstep = rfact2 / rday
+
+      CALL p4z_sink_init      ! vertical flux of particulate organic matter
+      CALL p4z_opt_init       ! Optic: PAR in the water column
+      CALL p4z_lim_init       ! co-limitations by the various nutrients
+      CALL p4z_prod_init      ! phytoplankton growth rate over the global ocean. 
+      CALL p4z_rem_init       ! remineralisation
+      CALL p4z_mort_init      ! phytoplankton mortality
+      CALL p4z_micro_init     ! microzooplankton
+      CALL p4z_meso_init      ! mesozooplankton
+      CALL p4z_sed_init       ! sedimentation
+      CALL p4z_lys_init       ! calcite saturation
+      CALL p4z_flx_init       ! gas exchange
+
+      ndayflxtr = 0
 
    END SUBROUTINE trc_sms_pisces_init
Index: trunk/NEMOGCM/NEMO/TOP_SRC/SED/par_sed.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/SED/par_sed.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/SED/par_sed.F90	(revision 2528)
@@ -16,4 +16,6 @@
       jpjm1    =>   jpjm1 ,  & !: jpj - 1
       jpij     =>   jpij       !: jpi x jpj
+      jp_tem   =>   jp_tem     !: indice of temperature
+      jp_sal   =>   jp_sal     !: indice of salintity
 
 #if ! defined key_sed_off
Index: trunk/NEMOGCM/NEMO/TOP_SRC/SED/sed.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/SED/sed.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/SED/sed.F90	(revision 2528)
@@ -17,5 +17,5 @@
       gphit    =>   gphit  ,  & !: latitude  of t-point (degre)
       e3t_0    =>   e3t_0  ,  & !: reference depth of t-points (m)
-      mbathy   =>   mbathy ,  & !: bathymetry
+      mbkt     =>   mbkt   ,  & !: vertical index of the bottom last T- ocean level
       tmask    =>   tmask  ,  & !: land/ocean mask at t-points
       rdt      =>   rdt         !: time step for the dynamics
@@ -34,10 +34,8 @@
 
    USE oce , ONLY :            &
-      tn      =>    tn    ,  & !: pot. temperature (celsius)
-      sn      =>    sn         !: salinity (psu)
+      tsn      =>    tsn       & !: pot. temperature (celsius) and salinity (psu)
 
    USE trc, ONLY :  &
       trn        , & !: tracer 
-      nittrc000  , & !: 1st time step of tracer model
       nwritetrc      !: outputs frequency of tracer model
 
@@ -215,5 +213,4 @@
    INTEGER, PUBLIC :: &
      numsed = 27
-	
 #else
    !!======================================================================
Index: trunk/NEMOGCM/NEMO/TOP_SRC/SED/sedarr.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/SED/sedarr.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/SED/sedarr.F90	(revision 2528)
@@ -28,7 +28,7 @@
 
    !!----------------------------------------------------------------------
-   !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005) 
+   !! 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 $ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 CONTAINS
Index: trunk/NEMOGCM/NEMO/TOP_SRC/SED/sedchem.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/SED/sedchem.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/SED/sedchem.F90	(revision 2528)
@@ -216,5 +216,5 @@
       DO jj = 1,jpj
          DO ji = 1, jpi
-            ikt = MAX( mbathy(ji,jj)-1, 1 )
+            ikt = mbkt(ji,jj) 
             IF ( tmask(ji,jj,ikt) == 1 ) THEN
                zchem_data(ji,jj,1) = ak13 (ji,jj,ikt)
Index: trunk/NEMOGCM/NEMO/TOP_SRC/SED/seddta.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/SED/seddta.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/SED/seddta.F90	(revision 2528)
@@ -118,5 +118,5 @@
          DO jj = 1,jpj
             DO ji = 1, jpi
-               ikt = MAX( mbathy(ji,jj)-1, 1 )
+               ikt = mbkt(ji,jj)
                IF ( tmask(ji,jj,ikt) == 1 ) THEN
                   trc_data(ji,jj,1)  = trn  (ji,jj,ikt,jptal)
@@ -131,12 +131,12 @@
                   trc_data(ji,jj,9 ) = sinking2(ji,jj,ikt)
                   trc_data(ji,jj,10) = sinkcal (ji,jj,ikt)
-                  trc_data(ji,jj,11) = tn      (ji,jj,ikt)
-                  trc_data(ji,jj,12) = sn      (ji,jj,ikt)
+                  trc_data(ji,jj,11) = tsn     (ji,jj,ikt,jp_tem)
+                  trc_data(ji,jj,12) = tsn     (ji,jj,ikt,jp_sal)
 #   else
                   trc_data(ji,jj,7 ) = sinksil (ji,jj,ikt)
                   trc_data(ji,jj,8 ) = sinking (ji,jj,ikt)
                   trc_data(ji,jj,9 ) = sinkcal (ji,jj,ikt)
-                  trc_data(ji,jj,10) = tn      (ji,jj,ikt)
-                  trc_data(ji,jj,11) = sn      (ji,jj,ikt)       
+                  trc_data(ji,jj,10) = tsn     (ji,jj,ikt,jp_tem)
+                  trc_data(ji,jj,11) = tsn     (ji,jj,ikt,jp_sal)       
 #   endif
                ENDIF
Index: trunk/NEMOGCM/NEMO/TOP_SRC/SED/sedini.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/SED/sedini.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/SED/sedini.F90	(revision 2528)
@@ -123,5 +123,5 @@
       DO jj = 1, jpj
          DO ji = 1, jpi
-            ikt = MAX( INT( sbathy(ji,jj) )  - 1, 1 )
+            ikt = MAX( INT( sbathy(ji,jj) ), 1 )
             IF( tmask(ji,jj,ikt) == 1 ) epkbot(ji,jj) = zdta(ji,jj)
          ENDDO
@@ -135,5 +135,5 @@
       DO jj = 1, jpj
          DO ji = 1, jpi
-            ikt = MAX( mbathy(ji,jj) - 1, 1 )
+            ikt = mbkt(ji,jj) 
             IF( tmask(ji,jj,ikt) == 1 ) epkbot(ji,jj) = e3t_0(ikt)
          ENDDO
@@ -443,11 +443,9 @@
 
       dtsed = rdt
+      nitsed000 = nit000
+      nitsedend = nitend
 #if ! defined key_sed_off
-      nitsed000 = nittrc000
-      nitsedend = nitend
       nwrised   = nwritetrc
 #else
-      nitsed000 = nit000
-      nitsedend = nitend
       nwrised   = nwrite
 #endif
Index: trunk/NEMOGCM/NEMO/TOP_SRC/SED/sedsfc.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/SED/sedsfc.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/SED/sedsfc.F90	(revision 2528)
@@ -52,5 +52,5 @@
       DO jj = 1,jpj
          DO ji = 1, jpi
-            ikt = MAX( mbathy(ji,jj)-1, 1 )
+            ikt = mbkt(ji,jj)
             IF ( tmask(ji,jj,ikt) == 1 ) THEN
                trn(ji,jj,ikt,jptal) = trc_data(ji,jj,1)
Index: trunk/NEMOGCM/NEMO/TOP_SRC/SED/sedwri.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/SED/sedwri.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/SED/sedwri.F90	(revision 2528)
@@ -186,5 +186,5 @@
          CALL histbeg ( clhstnam, jpi, glamt, jpj, gphit,     &
             &             iimi, iima-iimi+1, ijmi, ijma-ijmi+1,         &
-            &             nitsed000-1, zjulian, zdt,  nhorised, nised , domain_id=nidom )
+            &             nitsed000-1, zjulian, zdt,  nhorised, nised , domain_id=nidom, snc4chunks=snc4set )
          CALL histvert( nised,'deptht','Vertic.sed.T levels','m',ipk, profsed, ndepsed, 'down' )
          CALL wheneq  ( jpi*jpj*ipk, tmasksed, 1, 1., ndext52, ndimt52 )
@@ -223,5 +223,5 @@
 
 
-         CALL histend( nised )
+         CALL histend( nised, snc4set )
 
          WRITE(numsed,*)
Index: trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90	(revision 2528)
@@ -0,0 +1,184 @@
+MODULE trcadv
+   !!==============================================================================
+   !!                       ***  MODULE  trcadv  ***
+   !! Ocean passive tracers:  advection trend 
+   !!==============================================================================
+   !! History :  2.0  !  05-11  (G. Madec)  Original code
+   !!            3.0  !  10-06  (C. Ethe)   Adapted to passive tracers
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   trc_adv      : compute ocean tracer advection trend
+   !!   trc_adv_ctl  : control the different options of advection scheme
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! ocean dynamics and active tracers
+   USE trc             ! ocean passive tracers variables
+   USE trcnam_trp      ! passive tracers transport namelist variables
+   USE traadv_cen2     ! 2nd order centered scheme (tra_adv_cen2   routine)
+   USE traadv_tvd      ! TVD      scheme           (tra_adv_tvd    routine)
+   USE traadv_muscl    ! MUSCL    scheme           (tra_adv_muscl  routine)
+   USE traadv_muscl2   ! MUSCL2   scheme           (tra_adv_muscl2 routine)
+   USE traadv_ubs      ! UBS      scheme           (tra_adv_ubs    routine)
+   USE traadv_qck      ! QUICKEST scheme           (tra_adv_qck    routine)
+   USE traadv_eiv      ! eddy induced velocity     (tra_adv_eiv    routine)
+   USE ldftra_oce      ! lateral diffusion coefficient on tracers
+   USE in_out_manager  ! I/O manager
+   USE prtctl_trc          ! Print control
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_adv    ! routine called by step module
+
+   INTEGER ::   nadv   ! choice of the type of advection scheme
+   REAL(wp), DIMENSION(jpk) ::   r2dt  ! vertical profile time-step, = 2 rdttra
+      !                                ! except at nit000 (=rdttra) if neuler=0
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_adv( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_adv  ***
+      !!
+      !! ** Purpose :   compute the ocean tracer advection trend.
+      !!
+      !! ** Method  : - Update the tracer with the advection term following nadv
+      !!----------------------------------------------------------------------
+      !!
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      !
+      INTEGER :: jk 
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zun, zvn, zwn   ! effective velocity
+      CHARACTER (len=22) :: charout
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 )   CALL trc_adv_ctl          ! initialisation & control of options
+
+#if ! defined key_pisces
+      IF( neuler == 0 .AND. kt == nit000 ) THEN     ! at nit000
+         r2dt(:) =  rdttrc(:)           ! = rdttrc (restarting with Euler time stepping)
+      ELSEIF( kt <= nit000 + nn_dttrc ) THEN          ! at nit000 or nit000+1
+         r2dt(:) = 2. * rdttrc(:)       ! = 2 rdttrc (leapfrog)
+      ENDIF
+#else
+      r2dt(:) =  rdttrc(:)              ! = rdttrc (for PISCES use Euler time stepping)
+#endif
+
+      !                                                   ! effective transport
+      DO jk = 1, jpkm1
+         !                                                ! eulerian transport only
+         zun(:,:,jk) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk)
+         zvn(:,:,jk) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk)
+         zwn(:,:,jk) = e1t(:,:) * e2t(:,:)      * wn(:,:,jk)
+         !
+      END DO
+      zwn(:,:,jpk) = 0.e0                                 ! no transport trough the bottom
+
+      !                                                   ! add the eiv transport (if necessary)
+      IF( lk_traldf_eiv )   CALL tra_adv_eiv( kt, zun, zvn, zwn, 'TRC' )
+      !
+      SELECT CASE ( nadv )                            !==  compute advection trend and add it to general trend  ==!
+      CASE ( 1 )   ;    CALL tra_adv_cen2  ( kt, 'TRC',       zun, zvn, zwn, trb, trn, tra, jptra )   !  2nd order centered
+      CASE ( 2 )   ;    CALL tra_adv_tvd   ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  TVD 
+      CASE ( 3 )   ;    CALL tra_adv_muscl ( kt, 'TRC', r2dt, zun, zvn, zwn, trb,      tra, jptra )   !  MUSCL 
+      CASE ( 4 )   ;    CALL tra_adv_muscl2( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  MUSCL2 
+      CASE ( 5 )   ;    CALL tra_adv_ubs   ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  UBS 
+      CASE ( 6 )   ;    CALL tra_adv_qck   ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  QUICKEST 
+      !
+      CASE (-1 )                                      !==  esopa: test all possibility with control print  ==!
+         CALL tra_adv_cen2  ( kt, 'TRC',       zun, zvn, zwn, trb, trn, tra, jptra )          
+         WRITE(charout, FMT="('adv1')")  ; CALL prt_ctl_trc_info(charout)
+                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+         CALL tra_adv_tvd   ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )          
+         WRITE(charout, FMT="('adv2')")  ; CALL prt_ctl_trc_info(charout)
+                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+         CALL tra_adv_muscl ( kt, 'TRC', r2dt, zun, zvn, zwn, trb,      tra, jptra )          
+         WRITE(charout, FMT="('adv3')")  ; CALL prt_ctl_trc_info(charout)
+                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+         CALL tra_adv_muscl2( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )          
+         WRITE(charout, FMT="('adv4')")  ; CALL prt_ctl_trc_info(charout)
+                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+         CALL tra_adv_ubs   ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )          
+         WRITE(charout, FMT="('adv5')")  ; CALL prt_ctl_trc_info(charout)
+                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+         CALL tra_adv_qck   ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )          
+         WRITE(charout, FMT="('adv6')")  ; CALL prt_ctl_trc_info(charout)
+                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+         !
+      END SELECT
+
+      !                                              ! print mean trends (used for debugging)
+      IF( ln_ctl )   THEN
+         WRITE(charout, FMT="('adv ')")  ;  CALL prt_ctl_trc_info(charout)
+                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+      END IF
+      !
+   END SUBROUTINE trc_adv
+
+
+   SUBROUTINE trc_adv_ctl
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_adv_ctl  ***
+      !!                
+      !! ** Purpose : Control the consistency between namelist options for 
+      !!              passive tracer advection schemes and set nadv
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio
+      !!----------------------------------------------------------------------
+
+      ioptio = 0                      ! Parameter control
+      IF( ln_trcadv_cen2   )   ioptio = ioptio + 1
+      IF( ln_trcadv_tvd    )   ioptio = ioptio + 1
+      IF( ln_trcadv_muscl  )   ioptio = ioptio + 1
+      IF( ln_trcadv_muscl2 )   ioptio = ioptio + 1
+      IF( ln_trcadv_ubs    )   ioptio = ioptio + 1
+      IF( ln_trcadv_qck    )   ioptio = ioptio + 1
+      IF( lk_esopa         )   ioptio =          1
+
+      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE advection scheme in namelist namtrc_adv' )
+
+      !                              ! Set nadv
+      IF( ln_trcadv_cen2   )   nadv =  1
+      IF( ln_trcadv_tvd    )   nadv =  2
+      IF( ln_trcadv_muscl  )   nadv =  3
+      IF( ln_trcadv_muscl2 )   nadv =  4
+      IF( ln_trcadv_ubs    )   nadv =  5
+      IF( ln_trcadv_qck    )   nadv =  6
+      IF( lk_esopa         )   nadv = -1
+
+      IF(lwp) THEN                   ! Print the choice
+         WRITE(numout,*)
+         IF( nadv ==  1 )   WRITE(numout,*) '         2nd order scheme is used'
+         IF( nadv ==  2 )   WRITE(numout,*) '         TVD       scheme is used'
+         IF( nadv ==  3 )   WRITE(numout,*) '         MUSCL     scheme is used'
+         IF( nadv ==  4 )   WRITE(numout,*) '         MUSCL2    scheme is used'
+         IF( nadv ==  5 )   WRITE(numout,*) '         UBS       scheme is used'
+         IF( nadv ==  6 )   WRITE(numout,*) '         QUICKEST  scheme is used'
+         IF( nadv == -1 )   WRITE(numout,*) '         esopa test: use all advection scheme'
+      ENDIF
+      !
+   END SUBROUTINE trc_adv_ctl
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_adv( kt )
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'trc_adv: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_adv
+#endif
+  !!======================================================================
+END MODULE trcadv
Index: trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv_cen2.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv_cen2.F90	(revision 2527)
+++ 	(revision )
@@ -1,516 +1,0 @@
-MODULE trcadv_cen2
-   !!======================================================================
-   !!                       ***  MODULE  trcadv_cen2  ***
-   !! Ocean passive tracers:  horizontal & vertical advective tracer trend
-   !!======================================================================
-#if defined key_top
-   !!----------------------------------------------------------------------
-   !!   'key_top'                                                TOP models
-   !!----------------------------------------------------------------------
-   !!   trc_adv_cen2 : update the tracer trend with the horizontal
-   !!                  and vertical advection trends using a 2nd order 
-   !!                  centered finite difference scheme
-   !!----------------------------------------------------------------------
-   USE oce_trc             ! ocean dynamics and active tracers variables
-   USE trp_trc             ! ocean passive tracers variables
-   USE trcbbl              ! advective passive tracers in the BBL
-   USE prtctl_trc
-   USE trdmld_trc
-   USE trdmld_trc_oce          ! ocean variables trends
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC trc_adv_cen2    ! routine called by trcstp.F90
-
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   upsmsk    !: mixed upstream/centered scheme near some straits
-   !                                                   !  and in closed seas (orca 2 and 4 configurations)
-
-   !! * Substitutions
-#  include "top_substitute.h90"
-   !!----------------------------------------------------------------------
-   !!   TOP 1.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   !!----------------------------------------------------------------------
-   !!   Default option :             2nd order centered scheme (k-j-i loop)
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE trc_adv_cen2( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE trc_adv_cen2  ***
-      !!                 
-      !! ** Purpose :   Compute the now trend due to the advection of tracers
-      !!      and add it to the general trend of passive tracer equations.
-      !!
-      !! ** Method  :   The advection is evaluated by a second order centered
-      !!      scheme using now fields (leap-frog scheme). In specific areas
-      !!      (vicinity of major river mouths, some straits, or where tn is
-      !!      is approaching the freezing point) it is mixed with an upstream
-      !!      scheme for stability reasons.
-      !!        Part 0 : compute the upstream / centered flag
-      !!                 (3D array, zind, defined at T-point (0<zind<1))
-      !!        Part I : horizontal advection
-      !!      * centered flux:
-      !!         * s-coordinate (ln_sco=T) or
-      !!         * z-coordinate with partial steps (ln_zps=T),
-      !!        the vertical scale factors e3. are inside the derivatives:
-      !!               zcenu = e2u*e3u  un  mi(tn)
-      !!               zcenv = e1v*e3v  vn  mj(tn)
-      !!         * z-coordinate (default key), e3t=e3u=e3v:
-      !!               zcenu = e2u  un  mi(tn)
-      !!               zcenv = e1v  vn  mj(tn)
-      !!      * horizontal advective trend (divergence of the fluxes)
-      !!         * s-coordinate (ln_sco=T) or
-      !!         * z-coordinate with partial steps (ln_zps=T)
-      !!               ztra = 1/(e1t*e2t*e3t) { di-1[zwx] + dj-1[zwy] }
-      !!         * z-coordinate (default key), e3t=e3u=e3v:
-      !!               ztra = 1/(e1t*e2t) { di-1[zwx] + dj-1[zwy] }
-      !!      * Add this trend now to the general trend of tracer tra:
-      !!              tra = tra + ztra
-      !!      * trend diagnostic ('key_trdmld_trc'): the trend is saved
-      !!      for diagnostics. The trends saved is expressed as
-      !!      Uh.gradh(T)
-      !!
-      !!         Part II : vertical advection
-      !!      For any tracer  the advective trend is computed as follows :
-      !!            ztra = 1/e3t dk+1[ zwz ]
-      !!      where the vertical advective flux, zwz, is given by :
-      !!            zwz = zcofk * zupst + (1-zcofk) * zcent
-      !!      with 
-      !!        zupsv = upstream flux = wn * (trb(k) or trb(k-1) ) [wn>0 or <0]
-      !!        zcenu = centered flux = wn * mk(trn)
-      !!         The surface boundary condition is : 
-      !!      variable volume : zero advective flux
-      !!      fixed    volume ("default option) : wn(:,:,1) * trn(:,:,1)
-      !!         Add this trend now to the general trend of tracer tra :
-      !!            tra = tra + ztra
-      !!         Trend diagnostic ('key_trdmld_trc'): the trend is saved for
-      !!      diagnostics. The trends saved is expressed as :
-      !!             save trend =  w.gradz(T) = ztra - trn divn.
-      !!
-      !! ** Action : - update tra with the now advective tracer trends
-      !!             - save the trends in trtrd ('key_trdmld_trc')
-      !!
-      !! History :
-      !!   8.2  !  01-08  (M-A Filiberti, and M.Levy)  trahad+trazad = traadv 
-      !!   8.5  !  02-06  (G. Madec, C. Ethe)  F90: Free form and module
-      !!----------------------------------------------------------------------
-      !! * Modules used
-      USE oce_trc            , zwx => ua,  &  ! use ua as workspace
-         &                     zwy => va      ! use va as workspace
-#if defined key_trcbbl_adv
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  &  ! temporary arrays
-         &         zun, zvn, zwn
-#else
-      USE oce_trc            , zun => un,  &  ! When no bbl, zun == un
-         &                     zvn => vn,  &  ! When no bbl, zvn == vn
-         &                     zwn => wn      ! When no bbl, zwn == wn
-#endif
-
- 
-      !! * Arguments
-      INTEGER, INTENT( in ) ::   kt           ! ocean time-step index
- 
-      !! * Local save
-      REAL(wp), DIMENSION(jpi,jpj), SAVE ::   &
-         zbtr2
- 
-      !! * Local declarations
-      INTEGER  ::   ji, jj, jk, jn             ! dummy loop indices
-      REAL(wp) ::                           &
-         zbtr, ztra, zfui, zfvj,            &  ! temporary scalars
-         zhw, ze3tr, zcofi, zcofj,          &  !    "         "
-         zupsut, zupsvt,                    &  !    "         "
-         zfp_ui, zfp_vj, zfm_ui, zfm_vj,    &  !    "         "
-         zcofk, zupst, zcent,               &  !    "         "
-         zfp_w, zfm_w,                      &  !    "         "
-         zcenut, zcenvt                        ! 
-
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
-         zind                              ! temporary workspace arrays
-
-      REAL(wp) ::                           &
-         ztai, ztaj,                        &  ! temporary scalars
-         zfui1, zfvj1                          !    "         "
-
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd
-#if defined key_lim3 || defined key_lim2
-      REAL(wp) ::                           &
-         ztfreez                               ! freezing point
-#endif
-      CHARACTER (len=22) :: charout
-      !!----------------------------------------------------------------------
-
-      IF( kt == nittrc000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'trc_adv_cen2 : 2nd order centered advection scheme'
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~   Vector optimization case'
-         IF(lwp) WRITE(numout,*)
- 
-         upsmsk(:,:) = 0.e0                              ! not upstream by default
-         IF( cp_cfg == "orca" )   CALL ups_orca_set      ! set mixed Upstream/centered scheme near some straits
-         !                                               ! and in closed seas (orca2 and orca4 only)
-         zbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) )
-      ENDIF
-
-      IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk) )
-
-#if defined key_trcbbl_adv
-
-      ! Advective bottom boundary layer 
-      ! -------------------------------
-      zun(:,:,:) = un(:,:,:) - u_trc_bbl(:,:,:)
-      zvn(:,:,:) = vn(:,:,:) - v_trc_bbl(:,:,:)
-      zwn(:,:,:) = wn(:,:,:) + w_trc_bbl(:,:,:)
-#endif
-
-      ! Upstream / centered scheme indicator
-      ! ------------------------------------
-      DO jk = 1, jpk
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-#if defined key_lim3 || defined key_lim2
-               ztfreez = ( - 0.0575 + 1.710523e-3 * SQRT( sn(ji,jj,1) )   &
-                 &                  - 2.154996e-4 *       sn(ji,jj,1)   ) * sn(ji,jj,1)
-
-               zind(ji,jj,jk) = MAX (   &
-                  rnfmsk(ji,jj) * rnfmsk_z(jk),      &  ! near runoff mouths (& closed sea outflows)
-                  upsmsk(ji,jj)                      &  ! some of some straits
-                  !                                     ! below ice covered area (if tn < "freezing"+0.1 )
-                  , MAX(  0., SIGN( 1., ztfreez + 0.1 - tn(ji,jj,jk) )  ) * tmask(ji,jj,jk)   &
-                  &                  )
-
-#else
-               zind(ji,jj,jk) = MAX (   &
-                  rnfmsk(ji,jj) * rnfmsk_z(jk),      &  ! near runoff mouths (& closed sea outflows)
-                  upsmsk(ji,jj)                      &  ! some of some straits
-                  &                  )
-#endif
-            END DO
-         END DO
-      END DO
-
-
-
-      DO jn = 1, jptra
-         ! I. Horizontal advective fluxes
-         ! ------------------------------
-         
-         ! Second order centered tracer flux at u and v-points
-         
-         !                                                ! ===============
-         DO jk = 1, jpkm1                                 ! Horizontal slab
-            !                                             ! ===============
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-               ! upstream indicator
-                  zcofi = MAX( zind(ji+1,jj,jk), zind(ji,jj,jk) )
-                  zcofj = MAX( zind(ji,jj+1,jk), zind(ji,jj,jk) )
-                  ! volume fluxes * 1/2
-#if ! defined key_zco
-                  zfui = 0.5 * e2u(ji,jj) * fse3u(ji,jj,jk) * zun(ji,jj,jk)
-                  zfvj = 0.5 * e1v(ji,jj) * fse3v(ji,jj,jk) * zvn(ji,jj,jk)
-#else
-                  zfui = 0.5 * e2u(ji,jj) * zun(ji,jj,jk)
-                  zfvj = 0.5 * e1v(ji,jj) * zvn(ji,jj,jk)
-#endif
-               ! upstream scheme
-                  zfp_ui = zfui + ABS( zfui )
-                  zfp_vj = zfvj + ABS( zfvj )
-                  zfm_ui = zfui - ABS( zfui )
-                  zfm_vj = zfvj - ABS( zfvj )
-                  zupsut = zfp_ui * trb(ji,jj,jk,jn) + zfm_ui * trb(ji+1,jj  ,jk,jn)
-                  zupsvt = zfp_vj * trb(ji,jj,jk,jn) + zfm_vj * trb(ji  ,jj+1,jk,jn)
-                  ! centered scheme
-                  zcenut = zfui * ( trn(ji,jj,jk,jn) + trn(ji+1,jj  ,jk,jn) )
-                  zcenvt = zfvj * ( trn(ji,jj,jk,jn) + trn(ji  ,jj+1,jk,jn) )
-                  ! mixed centered / upstream scheme
-                  zwx(ji,jj,jk) = zcofi * zupsut + (1.-zcofi) * zcenut
-                  zwy(ji,jj,jk) = zcofj * zupsvt + (1.-zcofj) * zcenvt                
-               END DO
-            END DO
-
-
-            ! 2. Tracer flux divergence at t-point added to the general trend
-            ! -------------------------
-
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-#if ! defined key_zco
-                  zbtr = zbtr2(ji,jj) / fse3t(ji,jj,jk)
-#else
-                  zbtr = zbtr2(ji,jj) 
-#endif
-                  ! horizontal advective trends
-                  ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk)   &
-                     &             + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk)  )
-
-                  ! add it to the general tracer trends
-                  tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
-
-#if defined key_trc_diatrd
-                  ! recompute the trends in i- and j-direction as Uh gradh(T)
-# if ! defined key_zco
-                  zfui = 0.5 * e2u(ji  ,jj) * fse3u(ji,  jj,jk) * zun(ji,  jj,jk)
-                  zfui1= 0.5 * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zun(ji-1,jj,jk)
-                  zfvj = 0.5 * e1v(ji,jj  ) * fse3v(ji,jj  ,jk) * zvn(ji,jj  ,jk)
-                  zfvj1= 0.5 * e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * zvn(ji,jj-1,jk)
-# else
-                  zfui = 0.5 * e2u(ji  ,jj) * zun(ji,  jj,jk)
-                  zfui1= 0.5 * e2u(ji-1,jj) * zun(ji-1,jj,jk)
-                  zfvj = 0.5 * e1v(ji,jj  ) * zvn(ji,jj  ,jk)
-                  zfvj1= 0.5 * e1v(ji,jj-1) * zvn(ji,jj-1,jk)
-# endif
-                  ztai = - zbtr * ( zfui  * ( trn(ji+1,jj  ,jk,jn) - trn(ji,  jj,jk,jn) )   &
-                     &                + zfui1 * ( trn(ji,  jj,  jk,jn) - trn(ji-1,jj,jk,jn) ) )
-                  ztaj = - zbtr * ( zfvj  * ( trn(ji  ,jj+1,jk,jn) - trn(ji,jj  ,jk,jn) )    &
-                     &                + zfvj1 * ( trn(ji  ,jj  ,jk,jn) - trn(ji,jj-1,jk,jn) ) )
-                  ! save i- and j- advective trends computed as Uh gradh(T)
-                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),1) = ztai
-                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),2) = ztaj
-#endif
-
-               END DO
-            END DO
-            !                                             ! ===============
-         END DO                                           !   End of slab
-         !                                                ! ===============
-
-         ! 3. Save the horizontal advective trends for diagnostics
-         ! -------------------------------------------------------
-         TRDTRC_XY : IF( l_trdtrc )THEN
-
-            ! 3.1) Passive tracer ZONAL advection trends
-            ztrtrd(:,:,:) = 0.e0
-
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1
-                     ! recompute the trends in i-direction as Uh gradh(T)
-# if  ! defined key_zco
-                     zbtr = zbtr2(ji,jj) / fse3t(ji,jj,jk)
-                     zfui = 0.5 * e2u(ji  ,jj) * fse3u(ji,  jj,jk) * zun(ji,  jj,jk)
-                     zfui1= 0.5 * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zun(ji-1,jj,jk)
-# else
-                     zbtr = zbtr2(ji,jj)
-                     zfui = 0.5 * e2u(ji  ,jj) * zun(ji,  jj,jk)
-                     zfui1= 0.5 * e2u(ji-1,jj) * zun(ji-1,jj,jk)
-# endif
-                     ztai = - zbtr * ( zfui  * ( trn(ji+1,jj  ,jk,jn) - trn(ji,  jj,jk,jn) )    &
-                          &          + zfui1 * ( trn(ji,  jj,  jk,jn) - trn(ji-1,jj,jk,jn) ) )
-
-                     ! save i- and j- advective trends computed as Uh gradh(T)
-                     ztrtrd(ji,jj,jk) = ztai
-                  END DO
-               END DO
-            END DO
-
-            IF( luttrd(jn) ) CALL trd_mod_trc(ztrtrd, jn, jptrc_trd_xad, kt)   ! handle the trend
-
-            ! 3.2)  Passive tracer MERIDIONAL advection trends
-            ztrtrd(:,:,:) = 0.e0
-
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1
-                     ! recompute the trends in j-direction as Uh gradh(T)
-# if ! defined key_zco
-                     zbtr = zbtr2(ji,jj) / fse3t(ji,jj,jk)
-                     zfvj = 0.5 * e1v(ji,jj  ) * fse3v(ji,jj  ,jk) * zvn(ji,jj  ,jk)
-                     zfvj1= 0.5 * e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * zvn(ji,jj-1,jk)
-# else
-                     zbtr = zbtr2(ji,jj)
-                     zfvj = 0.5 * e1v(ji,jj  ) * zvn(ji,jj  ,jk)
-                     zfvj1= 0.5 * e1v(ji,jj-1) * zvn(ji,jj-1,jk)
-# endif
-                     ztaj = - zbtr * ( zfvj  * ( trn(ji  ,jj+1,jk,jn) - trn(ji,jj  ,jk,jn) )    &
-                          &          + zfvj1 * ( trn(ji  ,jj  ,jk,jn) - trn(ji,jj-1,jk,jn) ) )
-
-                     ! save i- and j- advective trends computed as Uh gradh(T)
-                     ztrtrd(ji,jj,jk) = ztaj
-                  END DO
-               END DO
-            END DO
-
-            IF( luttrd(jn) ) CALL trd_mod_trc(ztrtrd, jn, jptrc_trd_yad, kt)   ! handle the trend
-
-         ENDIF TRDTRC_XY
-         !                                                    ! ===========
-      END DO                                                  ! tracer loop
-      !                                                       ! ===========
-
-      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
-         WRITE(charout, FMT="('centered2 - had')")
-         CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
-      ENDIF
-      
-      ! II. Vertical advection
-      ! ----------------------
-      DO jn = 1, jptra
-
-         ! Bottom value : flux set to zero
-         zwx(:,:,jpk) = 0.e0 
-
-         ! Surface value
-         IF ( lk_vvl ) THEN
-            ! variable volume: flux set to zero
-            zwx(:,:, 1 ) = 0.e0  
-         ELSE
-            ! free surface-constant volume
-            zwx(:,:, 1 ) = zwn(:,:,1) * trn(:,:,1,jn)
-         ENDIF
-
-         ! 1. Vertical advective fluxes
-         ! ----------------------------
-
-         ! Second order centered tracer flux at w-point
-
-         DO jk = 2, jpk
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ! upstream indicator
-                  zcofk = MAX( zind(ji,jj,jk-1), zind(ji,jj,jk) )
-                  ! velocity * 1/2
-                  zhw = 0.5 * zwn(ji,jj,jk)
-                  ! upstream scheme
-                  zfp_w = zhw + ABS( zhw )
-                  zfm_w = zhw - ABS( zhw )
-                  zupst = zfp_w * trb(ji,jj,jk,jn) + zfm_w * trb(ji,jj,jk-1,jn)
-                  ! centered scheme
-                  zcent = zhw * ( trn(ji,jj,jk,jn) + trn(ji,jj,jk-1,jn) )
-                  ! centered scheme
-                  zwx(ji,jj,jk) = zcofk * zupst + (1.-zcofk) * zcent
-               END DO
-            END DO
-         END DO
-
-
-         ! 2. Tracer flux divergence at t-point added to the general trend
-         ! -------------------------
-
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ze3tr = 1. / fse3t(ji,jj,jk)
-                  ! vertical advective trends
-                  ztra = - ze3tr * ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) )
-                  ! add it to the general tracer trends
-                  tra(ji,jj,jk,jn) =  tra(ji,jj,jk,jn) + ztra
-#if defined key_trc_diatrd
-                  ! save the vertical advective trends computed as w gradz(T)
-                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),3) = ztra - trn(ji,jj,jk,jn) * hdivn(ji,jj,jk)
-#endif
-
-               END DO
-            END DO
-         END DO
-
-         ! 3. Save the vertical advective trends for diagnostic 
-         ! ----------------------------------------------------
-
-         TRDTRC_Z : IF( l_trdtrc )THEN
-            ztrtrd(:,:,:) = 0.e0
-
-            ! Compute T/S vertical advection trends
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1
-                     ze3tr = 1. / fse3t(ji,jj,jk)
-                     ! vertical advective trends 
-                     ztra = - ze3tr * ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) )
-                     ! save the vertical advective trends computed as w gradz(T)
-                     ztrtrd(ji,jj,jk) = ztra - trn(ji,jj,jk,jn) * hdivn(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
-
-            IF( luttrd(jn) ) CALL trd_mod_trc(ztrtrd, jn, jptrc_trd_zad, kt)  ! handle the trend
-
-         ENDIF TRDTRC_Z
-         !                                                    ! ===========
-      END DO                                                  ! tracer loop
-      !                                                       ! ===========
-
-      IF( l_trdtrc ) DEALLOCATE( ztrtrd )
-
-      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
-         WRITE(charout, FMT="('centered - zad')")
-         CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
-      ENDIF
-
-   END SUBROUTINE trc_adv_cen2
-
-   SUBROUTINE ups_orca_set
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE ups_orca_set  ***
-      !!
-      !! ** Purpose :   add a portion of upstream scheme in area where the
-      !!                centered scheme generates too strong overshoot
-      !!
-      !! ** Method  :   orca (R4 and R2) confiiguration setting. Set upsmsk
-      !!                array to nozero value in some straith.
-      !!
-      !! ** Action : - upsmsk set to 1 at some strait, 0 elsewhere for orca
-      !!----------------------------------------------------------------------
-      INTEGER  ::   ii0, ii1, ij0, ij1      ! temporary integers
-      !!----------------------------------------------------------------------
-
-      ! mixed upstream/centered scheme near river mouths
-      ! ------------------------------------------------
-      SELECT CASE ( jp_cfg )
-      !                                        ! =======================
-      CASE ( 4 )                               !  ORCA_R4 configuration
-         !                                     ! =======================
-         !                                          ! Gibraltar Strait
-         ii0 =  70   ;   ii1 =  71
-         ij0 =  52   ;   ij1 =  53   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
-         !
-         !                                     ! =======================
-      CASE ( 2 )                               !  ORCA_R2 configuration
-         !                                     ! =======================
-         !                                          ! Gibraltar Strait
-         ij0 = 102   ;   ij1 = 102
-         ii0 = 138   ;   ii1 = 138   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.20
-         ii0 = 139   ;   ii1 = 139   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40
-         ii0 = 140   ;   ii1 = 140   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
-         ij0 = 101   ;   ij1 = 102
-         ii0 = 141   ;   ii1 = 141   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
-         !                                          ! Bab el Mandeb Strait
-         ij0 =  87   ;   ij1 =  88
-         ii0 = 164   ;   ii1 = 164   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.10
-         ij0 =  88   ;   ij1 =  88
-         ii0 = 163   ;   ii1 = 163   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25
-         ii0 = 162   ;   ii1 = 162   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40
-         ii0 = 160   ;   ii1 = 161   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
-         ij0 =  89   ;   ij1 =  89
-         ii0 = 158   ;   ii1 = 160   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25
-         ij0 =  90   ;   ij1 =  90
-         ii0 = 160   ;   ii1 = 160   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25
-         !                                          ! Sound Strait
-         ij0 = 116   ;   ij1 = 116
-         ii0 = 145   ;   ii1 = 147   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
-         !
-      END SELECT
-
-   END SUBROUTINE ups_orca_set
-
-#else
-
-   !!----------------------------------------------------------------------
-   !!   Default option                                         Empty module
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE trc_adv_cen2( kt )  
-      INTEGER, INTENT(in) :: kt
-      WRITE(*,*) 'trc_adv_cen2: You should not have seen this print! error?', kt
-   END SUBROUTINE trc_adv_cen2
-#endif
-   !!======================================================================
-END MODULE trcadv_cen2
Index: trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv_muscl.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv_muscl.F90	(revision 2527)
+++ 	(revision )
@@ -1,420 +1,0 @@
-MODULE trcadv_muscl
-   !!==============================================================================
-   !!                       ***  MODULE  trcadv_muscl  ***
-   !! Ocean passive tracers:  horizontal & vertical advective trend
-   !!==============================================================================
-#if defined key_top
-   !!----------------------------------------------------------------------
-   !!   'key_top'                                                TOP models
-   !!----------------------------------------------------------------------
-   !!   trc_adv_muscl : update the tracer trend with the horizontal
-   !!                   and vertical advection trends using MUSCL scheme
-   !!----------------------------------------------------------------------
-   !! * Modules used
-   USE oce_trc         ! ocean dynamics and active tracers variables
-   USE trp_trc             ! ocean passive tracers variables
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE trcbbl          ! advective passive tracers in the BBL
-   USE lib_mpp
-   USE prtctl_trc      ! Print control for debbuging
-   USE trdmld_trc
-   USE trdmld_trc_oce          ! ocean variables trends
-
-   IMPLICIT NONE
-   PRIVATE
-
-   !! * Accessibility
-   PUBLIC trc_adv_muscl  ! routine called by trcstp.F90
-
-   !! * Substitutions
-#  include "top_substitute.h90"
-   !!----------------------------------------------------------------------
-   !!   TOP 1.0 , LOCEAN-IPSL (2005) 
-   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcadv_muscl.F90,v 1.13 2007/10/12 09:26:30 opalod Exp $ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE trc_adv_muscl( kt )
-      !!----------------------------------------------------------------------
-      !!                    ***  ROUTINE trc_adv_muscl  ***
-      !!          
-      !! ** Purpose :   Compute the now trend due to total advection of any pas-
-      !!      sive tracer using a MUSCL scheme (Monotone Upstream-centered Scheme
-      !!      for Conservation Laws) and add it to the general tracer trend.
-      !!
-      !! ** Method  :
-      !!
-      !! ** Action  : - update tra with the now advective tracer trends
-      !!              - save trends ('key_trdmld_trc')
-      !!
-      !! References :                
-      !!      Estubier, A., and M. Levy, Notes Techn. Pole de Modelisation
-      !!	IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa)
-      !!
-      !! History :
-      !!        !  06-00  (A.Estublier)  for passive tracers
-      !!   9.0  !  03-04  (C. Ethe, G. Madec)  F90: Free form and module
-      !!----------------------------------------------------------------------
-      !! * modules used
-#if defined key_trcbbl_adv
-      USE oce_trc            , zun => ua,  &  ! use ua as workspace
-         &                     zvn => va      ! use va as workspace
-      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwn
-#else
-      USE oce_trc            , zun => un,  &  ! When no bbl, zun == un
-                               zvn => vn,  &  !              zvn == vn
-                               zwn => wn      !              zwn == wn
-#endif
-
-      !! * Arguments
-      INTEGER, INTENT( in ) ::   kt         ! ocean time-step
-
-      !! * Local declarations
-      INTEGER ::   ji, jj, jk,jn            ! dummy loop indices
-      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   &
-         zt1, zt2, ztp1, ztp2
-
-      REAL(wp) ::   zu, zv, zw, zeu, zev, zew, zbtr, ztra
-      REAL(wp) ::   z0u, z0v, z0w
-      REAL(wp) ::   zzt1, zzt2, zalpha, z2dtt
-      REAL(wp) ::   zfui, zfvj
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd
-#if defined key_trc_diatrd
-      REAL(wp) ::   ztai, ztaj
-#endif
-      CHARACTER (len=22) :: charout
-      !!----------------------------------------------------------------------
-
-
-      IF( kt == nittrc000 .AND. lwp ) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'trc_adv : MUSCL advection scheme'
-         WRITE(numout,*) '~~~~~~~'
-      ENDIF
-
-       IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk) )
-
-#if defined key_trcbbl_adv
-      ! Advective bottom boundary layer
-      ! -------------------------------
-      zun(:,:,:) = un (:,:,:) - u_trc_bbl(:,:,:)
-      zvn(:,:,:) = vn (:,:,:) - v_trc_bbl(:,:,:)
-      zwn(:,:,:) = wn (:,:,:) + w_trc_bbl(:,:,:)
-#endif
-
- 
-
-      DO jn = 1, jptra
-
-         ! I. Horizontal advective fluxes
-         ! ------------------------------
-
-         ! first guess of the slopes
-         ! interior values
-         DO jk = 1, jpkm1
-            DO jj = 1, jpjm1      
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zt1(ji,jj,jk) = umask(ji,jj,jk) * ( trb(ji+1,jj,jk,jn) - trb(ji,jj,jk,jn) )
-                  zt2(ji,jj,jk) = vmask(ji,jj,jk) * ( trb(ji,jj+1,jk,jn) - trb(ji,jj,jk,jn) )
-               END DO
-            END DO
-         END DO
-         ! bottom values
-         zt1(:,:,jpk) = 0.e0
-         zt2(:,:,jpk) = 0.e0
-
-         ! lateral boundary conditions on zt1, zt2
-         CALL lbc_lnk( zt1, 'U', -1. )   
-         CALL lbc_lnk( zt2, 'V', -1. ) 
-
-
-         ! Slopes
-         ! interior values
-         DO jk = 1, jpkm1
-            DO jj = 2, jpj
-               DO ji = fs_2, jpi   ! vector opt.
-                  ztp1(ji,jj,jk) =                    ( zt1(ji,jj,jk) + zt1(ji-1,jj  ,jk) )   &
-                     &           * ( 0.25 + SIGN( 0.25, zt1(ji,jj,jk) * zt1(ji-1,jj  ,jk) ) )
-                  ztp2(ji,jj,jk) =                    ( zt2(ji,jj,jk) + zt2(ji  ,jj-1,jk) )   &
-                     &           * ( 0.25 + SIGN( 0.25, zt2(ji,jj,jk) * zt2(ji  ,jj-1,jk) ) )
-               END DO
-            END DO
-         END DO
-         ! bottom values
-         ztp1(:,:,jpk) = 0.e0
-         ztp2(:,:,jpk) = 0.e0
-
-         ! Slopes limitation
-         DO jk = 1, jpkm1
-            DO jj = 2, jpj
-               DO ji = fs_2, jpi   ! vector opt.
-                  ztp1(ji,jj,jk) = SIGN( 1., ztp1(ji,jj,jk) )   &
-                     &           * MIN(    ABS( ztp1(ji  ,jj,jk) ),   &
-                     &                  2.*ABS( zt1 (ji-1,jj,jk) ),   &
-                     &                  2.*ABS( zt1 (ji  ,jj,jk) ) )
-
-                  ztp2(ji,jj,jk) = SIGN( 1., ztp2(ji,jj,jk) )   &
-                     &           * MIN(    ABS( ztp2(ji,jj  ,jk) ),   &
-                     &                  2.*ABS( zt2 (ji,jj-1,jk) ),   &
-                     &                  2.*ABS( zt2 (ji,jj  ,jk) ) )
-
-               END DO
-            END DO
-         END DO
-
-         ! Advection terms
-         ! interior values
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1      
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ! volume fluxes
-#if ! defined key_zco
-                  zeu = e2u(ji,jj) * fse3u(ji,jj,jk) * zun(ji,jj,jk)
-                  zev = e1v(ji,jj) * fse3v(ji,jj,jk) * zvn(ji,jj,jk)
-#else
-                  zeu = e2u(ji,jj) * zun(ji,jj,jk)
-                  zev = e1v(ji,jj) * zvn(ji,jj,jk)
-#endif
-                  ! MUSCL fluxes
-                  z2dtt = rdttra(jk) * FLOAT(ndttrc)
-                  z0u = SIGN( 0.5, zun(ji,jj,jk) )            
-                  zalpha = 0.5 - z0u
-                  zu  = z0u - 0.5 * zun(ji,jj,jk) * z2dtt / e1u(ji,jj)
-                  zzt1 = trb(ji+1,jj,jk,jn) + zu*ztp1(ji+1,jj,jk)
-                  zzt2 = trb(ji  ,jj,jk,jn) + zu*ztp1(ji  ,jj,jk)
-                  zt1(ji,jj,jk) = zeu * ( zalpha * zzt1 + (1.-zalpha) * zzt2 )
-                  z0v = SIGN( 0.5, zvn(ji,jj,jk) )            
-                  zalpha = 0.5 - z0v
-                  zv  = z0v - 0.5 * zvn(ji,jj,jk) * z2dtt / e2v(ji,jj)
-                  zzt1 = trb(ji,jj+1,jk,jn) + zv*ztp2(ji,jj+1,jk)
-                  zzt2 = trb(ji,jj  ,jk,jn) + zv*ztp2(ji,jj  ,jk)
-                  zt2(ji,jj,jk) = zev * ( zalpha * zzt1 + (1.-zalpha) * zzt2 )
-               END DO
-            END DO
-         END DO
-
-         ! lateral boundary conditions on zt1, zt2 (changed sign)
-         CALL lbc_lnk( zt1, 'U', -1. ) 
-         CALL lbc_lnk( zt2, 'V', -1. ) 
-
-         ! Compute and add the horizontal advective trend
-
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1      
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-#if ! defined key_zco
-                  zbtr = 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )
-#else
-                  zbtr = 1. / ( e1t(ji,jj)*e2t(ji,jj) )
-#endif
-                  ! horizontal advective trends
-                  ztra = - zbtr * ( zt1(ji,jj,jk) - zt1(ji-1,jj  ,jk  )   &
-                     &            + zt2(ji,jj,jk) - zt2(ji  ,jj-1,jk  ) )
-                  ! add it to the general tracer trends
-                  tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
-#if defined key_trc_diatrd
-                  ! recompute the trends in i- and j-direction as Uh gradh(T)
-#   if ! defined key_zco
-                  zfui =  e2u(ji  ,jj) * fse3u(ji,  jj,jk) * un(ji,  jj,jk)   &
-                     & -  e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * un(ji-1,jj,jk)
-                  zfvj =  e1v(ji,jj  ) * fse3v(ji,jj  ,jk) * vn(ji,jj  ,jk)   &
-                     & -  e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * vn(ji,jj-1,jk)
-#   else
-                  zfui = e2u(ji  ,jj) * un(ji,  jj,jk)   &
-                     & - e2u(ji-1,jj) * un(ji-1,jj,jk)
-                  zfvj = e1v(ji,jj  ) * vn(ji,jj  ,jk)   &
-                     & - e1v(ji,jj-1) * vn(ji,jj-1,jk)
-#   endif
-                  ztai =-zbtr * (  zt1(ji,jj,jk) - zt1(ji-1,jj  ,jk) - trn(ji,jj,jk,jn) * zfui  )
-                  ztaj =-zbtr * (  zt2(ji,jj,jk) - zt2(ji  ,jj-1,jk) - trn(ji,jj,jk,jn) * zfvj  )
-                  ! save i- and j- advective trends computed as Uh gradh(T)
-                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),1) = ztai
-                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),2) = ztaj
-#endif
-
-               END DO
-            END DO
-         END DO
-
-         ! 3. Save the horizontal advective trends for diagnostics
-         ! -------------------------------------------------------
-         TRDTRC_XY : IF( l_trdtrc ) THEN
-
-            ! 3.1) Passive tracer ZONAL advection trends
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-#if ! defined key_zco
-                     zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                     zfui = e2u(ji  ,jj) * fse3u(ji,  jj,jk) * zun(ji,  jj,jk)   &
-                        & - e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zun(ji-1,jj,jk)
-#else
-                     zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) )
-                     zfui = e2u(ji  ,jj) * zun(ji,  jj,jk)  - e2u(ji-1,jj) * zun(ji-1,jj,jk)
-#endif
-                     ! recompute the trends in i- direction as Uh gradh(T)
-                     ztrtrd(ji,jj,jk) = - zbtr*( zt1(ji,jj,jk) - zt1(ji-1,jj,jk) - trn(ji,jj,jk,jn)*zfui )
-                  END DO
-               END DO
-            END DO
-
-            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd, jn, jptrc_trd_xad, kt )
-
-            ! 3.2)  Passive tracer MERIDIONAL advection trends
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ! recompute the trends in i- and j-direction as Uh gradh(T)
-#if ! defined key_zco
-                     zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                     zfvj = e1v(ji,jj  ) * fse3v(ji,jj  ,jk) * zvn(ji,jj  ,jk)   &
-                        & - e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * zvn(ji,jj-1,jk)
-#else
-                     zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) )
-                     zfvj = e1v(ji,jj  ) * zvn(ji,jj  ,jk) - e1v(ji,jj-1) * zvn(ji,jj-1,jk)
-#endif
-                     ztrtrd(ji,jj,jk) = - zbtr*( zt2(ji,jj,jk) - zt2(ji,jj-1,jk) - trn(ji,jj,jk,jn)*zfvj )
-                  END DO
-               END DO
-            END DO
-
-            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd, jn, jptrc_trd_yad, kt )
-
-         ENDIF TRDTRC_XY
-
-      ENDDO
-
-      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
-         WRITE(charout, FMT="('muscl - had')")
-         CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
-      ENDIF
-
-         ! II. Vertical advective fluxes
-         ! -----------------------------
-
-      DO jn = 1, jptra
-         ! First guess of the slope
-         ! interior values
-         DO jk = 2, jpkm1
-            zt1(:,:,jk) = tmask(:,:,jk) * ( trb(:,:,jk-1,jn) - trb(:,:,jk,jn) )
-         END DO
-         ! surface and bottom boundary conditions
-         zt1 (:,:, 1 ) = 0.e0 
-         zt1 (:,:,jpk) = 0.e0
-         ! Slopes
-         DO jk = 2, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  ztp1(ji,jj,jk) =                    ( zt1(ji,jj,jk) + zt1(ji,jj,jk+1) )   &
-                     &           * ( 0.25 + SIGN( 0.25, zt1(ji,jj,jk) * zt1(ji,jj,jk+1) ) )
-               END DO
-            END DO
-         END DO
-
-         ! Slopes limitation
-         ! interior values
-         DO jk = 2, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  ztp1(ji,jj,jk) = SIGN( 1., ztp1(ji,jj,jk) )   &
-                     &           * MIN(    ABS( ztp1(ji,jj,jk  ) ),   &
-                     &                  2.*ABS( zt1 (ji,jj,jk+1) ),   &
-                     &                  2.*ABS( zt1 (ji,jj,jk  ) ) )
-               END DO
-            END DO
-         END DO
-         ! surface values
-         ztp1(:,:,1) = 0. 
-         ! vertical advective flux
-         ! interior values
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1      
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  z2dtt = rdttra(jk) * FLOAT(ndttrc)
-                  zew = zwn(ji,jj,jk+1)
-                  z0w = SIGN( 0.5, zwn(ji,jj,jk+1) )
-                  zalpha = 0.5 + z0w
-                  zw  = z0w - 0.5 * zwn(ji,jj,jk+1)*z2dtt / fse3w(ji,jj,jk+1)
-                  zzt1 = trb(ji,jj,jk+1,jn) + zw*ztp1(ji,jj,jk+1)
-                  zzt2 = trb(ji,jj,jk  ,jn) + zw*ztp1(ji,jj,jk  )
-                  zt1(ji,jj,jk+1) = zew * ( zalpha * zzt1 + (1.-zalpha)*zzt2 )
-               END DO
-            END DO
-         END DO
-         ! surface values
-         IF( lk_vvl ) THEN
-            ! variable volume: flux set to zero
-            zt1(:,:, 1 ) = 0.e0
-         ELSE
-            ! free surface-constant volume
-            zt1(:,:, 1 ) = zwn(:,:,1) * trb(:,:,1,jn)
-         ENDIF
-
-         ! bottom values
-         zt1(:,:,jpk) = 0.e0
-
-         ! Compute & add the vertical advective trend
-
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1      
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr = 1. / fse3t(ji,jj,jk)
-                  ! horizontal advective trends
-                  ztra = - zbtr * ( zt1(ji,jj,jk) - zt1(ji,jj,jk+1) )
-                  ! add it to the general tracer trends
-                  tra(ji,jj,jk,jn) =  tra(ji,jj,jk,jn) + ztra
-#if defined key_trc_diatrd
-                  ! save the vertical advective trends computed as w gradz(T)
-                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),3) = ztra - trn(ji,jj,jk,jn) * hdivn(ji,jj,jk)
-#endif
-
-               END DO
-            END DO
-         END DO
-
-         ! 3. Save the vertical advective trends for diagnostic
-         ! ----------------------------------------------------
-         TRDTRC_Z : IF( l_trdtrc )THEN
-
-            ! Compute T/S vertical advection trends
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     zbtr = 1. / fse3t(ji,jj,jk)
-                     ! horizontal advective trends
-                     ztra = - zbtr * ( zt1(ji,jj,jk) - zt1(ji,jj,jk+1) )
-                     ! save the vertical advective trends computed as w gradz(T)
-                     ztrtrd(ji,jj,jk) = ztra - trn(ji,jj,jk,jn) * hdivn(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
-
-            IF (luttrd(jn)) CALL trd_mod_trc(ztrtrd, jn, jptrc_trd_zad, kt)
-
-         END IF TRDTRC_Z
-      END DO
-
-      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
-         WRITE(charout, FMT="('muscl - zad')")
-         CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
-      ENDIF
-
-END SUBROUTINE trc_adv_muscl
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option                                         Empty module
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE trc_adv_muscl( kt )  
-      INTEGER, INTENT(in) :: kt
-      WRITE(*,*) 'trc_adv_muscl: You should not have seen this print! error?', kt
-   END SUBROUTINE trc_adv_muscl
-#endif
-
-   !!======================================================================
-END MODULE trcadv_muscl
Index: trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv_muscl2.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv_muscl2.F90	(revision 2527)
+++ 	(revision )
@@ -1,499 +1,0 @@
-MODULE trcadv_muscl2
-   !!==============================================================================
-   !!                       ***  MODULE  trcadv_muscl2  ***
-   !! Ocean passive tracers:  horizontal & vertical advective trend
-   !!==============================================================================
-#if defined key_top
-   !!----------------------------------------------------------------------
-   !!   'key_top'                                                TOP models
-   !!----------------------------------------------------------------------
-   !!   tra_adv_muscl2 : update the tracer trend with the horizontal
-   !!                    and vertical advection trends using MUSCL2 scheme
-   !!----------------------------------------------------------------------
-   !! * Modules used
-   USE oce_trc         ! ocean dynamics and active tracers variables
-   USE trp_trc             ! ocean passive tracers variables
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE trcbbl          ! advective passive tracers in the BBL
-   USE prtctl_trc          ! Print control for debbuging
-   USE trdmld_trc
-   USE trdmld_trc_oce          ! ocean variables trends
-
-   IMPLICIT NONE
-   PRIVATE
-
-   !! * Accessibility
-   PUBLIC trc_adv_muscl2        ! routine called by trcstp.F90
-
-   !! * Module variable
-   REAL(wp), DIMENSION(jpk) ::   &
-      rdttrc                     ! vertical profile of tracer time-step
-
-   !! * Substitutions
-#  include "top_substitute.h90"
-   !!----------------------------------------------------------------------
-   !!   TOP 1.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE trc_adv_muscl2( kt )
-      !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE trc_adv_muscl2  ***
-      !!
-      !! ** Purpose :   Compute the now trend due to total advection of passi-
-      !!      ve tracer using a MUSCL scheme (Monotone Upstream-
-      !!      Centered Scheme for Conservation Laws) and add it to the general
-      !!      tracer trend.
-      !!
-      !! ** Method : MUSCL scheme plus centered scheme at ocean boundaries
-      !!
-      !! ** Action : - update tra with the now advective tracer trends
-      !!             - save trends ('key_trdmld_trc')
-      !!
-      !! References :                
-      !!      Estubier, A., and M. Levy, Notes Techn. Pole de Modelisation
-      !!	IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa)
-      !!
-      !! History :
-      !!        !  06-00  (A.Estublier)  for passive tracers
-      !!   9.0  !  03-04  (C. Ethe, G. Madec)  F90: Free form and module
-      !!----------------------------------------------------------------------
-      !! * modules used
-#if defined key_trcbbl_adv
-      USE oce_trc            , zun => ua,  &  ! use ua as workspace
-         &                     zvn => va      ! use va as workspace
-      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwn
-#else
-      USE oce_trc            , zun => un,  &  ! When no bbl, zun == un
-                               zvn => vn,  &  !              zvn == vn
-                               zwn => wn      !              zwn == wn
-#endif
-      !! * Arguments
-      INTEGER, INTENT( in ) ::   kt         ! ocean time-step
-
-      !! * Local declarations
-      INTEGER ::   ji, jj, jk,jn               ! dummy loop indices
-      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   &
-         zt1, zt2, ztp1, ztp2
-      REAL(wp) ::   zu, zv, zw, zeu, zev, zew, zbtr, ztra
-      REAL(wp) ::   z0u, z0v, z0w
-      REAL(wp) ::   zzt1, zzt2, zalpha
-      REAL(wp) ::   zfui, zfvj
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd
-#if defined key_trc_diatrd
-      REAL(wp) ::   ztai, ztaj
-#endif
-      CHARACTER (len=22) :: charout
-      !!----------------------------------------------------------------------
-
-      IF( kt == nittrc000 .AND. lwp ) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'trc_adv_muscl2 : MUSCL2 advection scheme'
-         WRITE(numout,*) '~~~~~~~~~~~~~~~'
-         rdttrc(:) =  rdttra(:) * FLOAT(ndttrc)
-      ENDIF
-      
-      IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk) )
-
-#if defined key_trcbbl_adv        
-      ! Advective bottom boundary layer
-      ! -------------------------------
-      zun(:,:,:) = un (:,:,:) - u_trc_bbl(:,:,:)
-      zvn(:,:,:) = vn (:,:,:) - v_trc_bbl(:,:,:)
-      zwn(:,:,:) = wn (:,:,:) + w_trc_bbl( :,:,:)
-#endif
-
-
-      DO jn = 1, jptra
-
-         ! I. Horizontal advective fluxes
-         ! ------------------------------
-
-         ! first guess of the slopes
-         ! interior values
-         DO jk = 1, jpkm1
-            DO jj = 1, jpjm1      
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zt1(ji,jj,jk) = umask(ji,jj,jk) * ( trb(ji+1,jj,jk,jn) - trb(ji,jj,jk,jn) )
-                  zt2(ji,jj,jk) = vmask(ji,jj,jk) * ( trb(ji,jj+1,jk,jn) - trb(ji,jj,jk,jn) )
-               END DO
-            END DO
-         END DO
-         ! bottom values
-         zt1(:,:,jpk) = 0.e0
-         zt2(:,:,jpk) = 0.e0
-
-         ! lateral boundary conditions on zt1, zt2  (changed sign)
-         CALL lbc_lnk( zt1, 'U', -1. )
-         CALL lbc_lnk( zt2, 'V', -1. )
-
-         ! Slopes
-         ! interior values
-         DO jk = 1, jpkm1
-            DO jj = 2, jpj
-               DO ji = fs_2, jpi   ! vector opt.
-                  ztp1(ji,jj,jk) =                    ( zt1(ji,jj,jk) + zt1(ji-1,jj  ,jk) )   &
-                     &           * ( 0.25 + SIGN( 0.25, zt1(ji,jj,jk) * zt1(ji-1,jj  ,jk) ) )
-                  ztp2(ji,jj,jk) =                    ( zt2(ji,jj,jk) + zt2(ji  ,jj-1,jk) )   &
-                     &           * ( 0.25 + SIGN( 0.25, zt2(ji,jj,jk) * zt2(ji  ,jj-1,jk) ) )
-               END DO
-            END DO
-         END DO
-         ! bottom values
-         ztp1(:,:,jpk) = 0.e0 
-         ztp2(:,:,jpk) = 0.e0
-
-         ! Slopes limitation
-         DO jk = 1, jpkm1
-            DO jj = 2, jpj
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ztp1(ji,jj,jk) = SIGN( 1., ztp1(ji,jj,jk) )   &
-                     &           * MIN(    ABS( ztp1(ji  ,jj,jk) ),   &
-                     &                  2.*ABS( zt1 (ji-1,jj,jk) ),   &
-                     &                  2.*ABS( zt1 (ji  ,jj,jk) ) )
-
-                  ztp2(ji,jj,jk) = SIGN( 1., ztp2(ji,jj,jk) )   &
-                     &           * MIN(    ABS( ztp2(ji,jj  ,jk) ),   &
-                     &                  2.*ABS( zt2 (ji,jj-1,jk) ),   &
-                     &                  2.*ABS( zt2 (ji,jj  ,jk) ) )
-               END DO
-            END DO
-         END DO
-
-         ! Advection terms
-         ! interior values
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1      
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ! volume fluxes
-#if ! defined key_zco
-                  zeu = e2u(ji,jj) * fse3u(ji,jj,jk) * zun(ji,jj,jk)
-                  zev = e1v(ji,jj) * fse3v(ji,jj,jk) * zvn(ji,jj,jk)
-#else
-                  zeu = e2u(ji,jj) * zun(ji,jj,jk)
-                  zev = e1v(ji,jj) * zvn(ji,jj,jk)
-#endif
-                  ! MUSCL fluxes
-                  z0u = SIGN( 0.5, zun(ji,jj,jk) )            
-                  zalpha = 0.5 - z0u
-                  zu  = z0u - 0.5 * zun(ji,jj,jk) * rdttrc(jk) / e1u(ji,jj)
-                  zzt1 = trb(ji+1,jj,jk,jn) + zu*ztp1(ji+1,jj,jk)
-                  zzt2 = trb(ji  ,jj,jk,jn) + zu*ztp1(ji  ,jj,jk)
-                  zt1(ji,jj,jk) = zeu * ( zalpha * zzt1 + (1.-zalpha) * zzt2 )
-
-                  z0v = SIGN( 0.5, zvn(ji,jj,jk) )            
-                  zalpha = 0.5 - z0v
-                  zv  = z0v - 0.5 * zvn(ji,jj,jk) * rdttrc(jk) / e2v(ji,jj)
-                  zzt1 = trb(ji,jj+1,jk,jn) + zv*ztp2(ji,jj+1,jk)
-                  zzt2 = trb(ji,jj  ,jk,jn) + zv*ztp2(ji,jj  ,jk)
-                  zt2(ji,jj,jk) = zev * ( zalpha * zzt1 + (1.-zalpha) * zzt2 )
-
-               END DO
-            END DO
-         END DO
-
-
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-#if ! defined key_zco
-                  zev = e1v(ji,jj) * fse3v(ji,jj,jk)
-                  IF( umask(ji,jj,jk) == 0. ) THEN
-                     IF( zun(ji+1,jj,jk) > 0. .AND. ji /= jpi ) THEN
-                        zt1(ji+1,jj,jk) = e2u(ji+1,jj)* fse3u(ji+1,jj,jk)   &
-                           &            * zun(ji+1,jj,jk) * ( trb(ji+1,jj,jk,jn) + trb(ji+2,jj,jk,jn) ) * 0.5
-                     ENDIF
-                     IF( zun(ji-1,jj,jk) < 0. ) THEN
-                        zt1(ji-1,jj,jk) = e2u(ji-1,jj)* fse3u(ji-1,jj,jk)   &
-                           &            * zun(ji-1,jj,jk) * ( trb(ji-1,jj,jk,jn) + trb(ji  ,jj,jk,jn) ) * 0.5
-                     ENDIF
-                  ENDIF
-                  IF( vmask(ji,jj,jk) == 0. ) THEN
-                     IF( zvn(ji,jj+1,jk) > 0. .AND. jj /= jpj ) THEN
-                        zt2(ji,jj+1,jk) = e1v(ji,jj+1) * fse3v(ji,jj+1,jk)   &
-                           &            * zvn(ji,jj+1,jk) * ( trb(ji,jj+1,jk,jn) + trb(ji,jj+2,jk,jn) ) * 0.5
-                     ENDIF
-                     IF( zvn(ji,jj-1,jk) < 0. ) THEN
-                        zt2(ji,jj-1,jk) = e1v(ji,jj-1)* fse3v(ji,jj-1,jk)   &
-                           &            * zvn(ji,jj-1,jk) * ( trb(ji,jj-1,jk,jn) + trb(ji  ,jj,jk,jn) ) * 0.5
-                     ENDIF
-                  ENDIF
-
-#else
-                  IF( umask(ji,jj,jk) == 0. ) THEN
-                     IF( zun(ji+1,jj,jk) > 0. .AND. ji /= jpi ) THEN
-                        zt1(ji+1,jj,jk) = e2u(ji+1,jj) * zun(ji+1,jj,jk) * ( trb(ji+1,jj,jk,jn) + trb(ji+2,jj,jk,jn) ) * 0.5
-                     ENDIF
-                     IF( zun(ji-1,jj,jk) < 0. ) THEN
-                        zt1(ji-1,jj,jk) = e2u(ji-1,jj) * zun(ji-1,jj,jk) * ( trb(ji-1,jj,jk,jn) + trb(ji  ,jj,jk,jn) ) * 0.5
-                     ENDIF
-                  ENDIF
-                  IF( vmask(ji,jj,jk) == 0. ) THEN
-                     IF( zvn(ji,jj+1,jk) > 0. .AND. jj /= jpj ) THEN
-                        zt2(ji,jj+1,jk) = e1v(ji,jj+1) * zvn(ji,jj+1,jk) * ( trb(ji,jj+1,jk,jn) + trb(ji,jj+2,jk,jn) ) * 0.5
-                     ENDIF
-                     IF( zvn(ji,jj-1,jk) < 0. ) THEN
-                        zt2(ji,jj-1,jk) = e1v(ji,jj-1) * zvn(ji,jj-1,jk) * ( trb(ji,jj-1,jk,jn) + trb(ji  ,jj,jk,jn) ) * 0.5
-                     ENDIF
-                  ENDIF
-#endif
-               END DO
-            END DO
-         END DO
-
-         ! lateral boundary conditions on zt1, zt2   (changed sign)
-         CALL lbc_lnk( zt1, 'U', -1. )
-         CALL lbc_lnk( zt2, 'V', -1. )
-
-         ! Compute and add the horizontal advective trend
-
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1      
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-#if ! defined key_zco
-                  zbtr = 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )
-#else
-                  zbtr = 1. / ( e1t(ji,jj)*e2t(ji,jj) )
-#endif
-                  ! horizontal advective trends
-                  ztra = - zbtr * ( zt1(ji,jj,jk) - zt1(ji-1,jj  ,jk  )   &
-                     &            + zt2(ji,jj,jk) - zt2(ji  ,jj-1,jk  ) )
-                  ! add it to the general tracer trends
-                  tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
-#if defined key_trc_diatrd
-                  ! recompute the trends in i- and j-direction as Uh gradh(T)
-#   if ! defined key_zco
-                  zfui =  e2u(ji  ,jj) * fse3u(ji,  jj,jk) * un(ji,  jj,jk)   &
-                     & -  e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * un(ji-1,jj,jk)
-                  zfvj =  e1v(ji,jj  ) * fse3v(ji,jj  ,jk) * vn(ji,jj  ,jk)   &
-                     & -  e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * vn(ji,jj-1,jk)
-#   else
-                  zfui = e2u(ji  ,jj) * un(ji,  jj,jk)   &
-                     & - e2u(ji-1,jj) * un(ji-1,jj,jk)
-                  zfvj = e1v(ji,jj  ) * vn(ji,jj  ,jk)   &
-                     & - e1v(ji,jj-1) * vn(ji,jj-1,jk)
-#   endif
-                  ztai =-zbtr * (  zt1(ji,jj,jk) - zt1(ji-1,jj  ,jk) - trn(ji,jj,jk,jn) * zfui  )
-                  ztaj =-zbtr * (  zt2(ji,jj,jk) - zt2(ji  ,jj-1,jk) - trn(ji,jj,jk,jn) * zfvj  )
-                  ! save i- and j- advective trends computed as Uh gradh(T)
-                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),1) = ztai
-                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),2) = ztaj
-
-#endif
-
-               END DO
-            END DO
-         END DO
-
-         ! 3. Save the horizontal advective trends for diagnostics
-         ! -------------------------------------------------------
-
-         TRDTRC_XY : IF( l_trdtrc ) THEN
-
-            ! 3.1) Passive tracer ZONAL advection trends
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.  
-#if ! defined key_zco
-                     zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                     zfui = e2u(ji  ,jj) * fse3u(ji,  jj,jk) * un(ji,  jj,jk)   &
-                        & - e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * un(ji-1,jj,jk)
-#else
-                     zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) )
-                     zfui = e2u(ji  ,jj) * un(ji,  jj,jk)   &
-                        & - e2u(ji-1,jj) * un(ji-1,jj,jk)
-#endif
-                     ! recompute the trends in i- direction as Uh gradh(T)
-                     ztrtrd(ji,jj,jk) = - zbtr*( zt1(ji,jj,jk) - zt1(ji-1,jj,jk) - trn(ji,jj,jk,jn)*zfui )
-                  END DO
-               END DO
-            END DO
-
-            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd, jn, jptrc_trd_xad, kt )
-
-            ! 3.2)  Passive tracer MERIDIONAL advection trends
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     ! recompute the trends in i- and j-direction as Uh gradh(T)
-#if ! defined key_zco
-                     zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                     zfvj = e1v(ji,jj  ) * fse3v(ji,jj  ,jk) * vn(ji,jj  ,jk)   &
-                        & - e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * vn(ji,jj-1,jk)
-#else
-                     zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) )
-                     zfvj = e1v(ji,jj  ) * vn(ji,jj  ,jk)   &
-                        & - e1v(ji,jj-1) * vn(ji,jj-1,jk)
-#endif
-                     ztrtrd(ji,jj,jk) = - zbtr*( zt2(ji,jj,jk) - zt2(ji,jj-1,jk) - trn(ji,jj,jk,jn)*zfvj )
-                  END DO
-               END DO
-            END DO
-
-            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd, jn, jptrc_trd_yad, kt )
-
-         ENDIF TRDTRC_XY
-
-         !                           !=============
-      END DO                         ! tracer loop
-      !                              !=============
-
-      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
-         WRITE(charout, FMT="('muscl2 - had')")
-         CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
-      ENDIF
-
-      ! II. Vertical advective fluxes
-      ! -----------------------------
-
-      DO jn = 1, jptra
-
-         ! First guess of the slope
-         ! interior values
-         DO jk = 2, jpkm1
-            zt1(:,:,jk) = tmask(:,:,jk) * ( trb(:,:,jk-1,jn) - trb(:,:,jk,jn) )
-         END DO
-         ! surface and bottom boundary conditions
-         zt1 (:,:, 1 ) = 0.e0 
-         zt1 (:,:,jpk) = 0.e0
-
-         ! Slopes
-         DO jk = 2, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  ztp1(ji,jj,jk) =                    ( zt1(ji,jj,jk) + zt1(ji,jj,jk+1) )   &
-                     &           * ( 0.25 + SIGN( 0.25, zt1(ji,jj,jk) * zt1(ji,jj,jk+1) ) )
-               END DO
-            END DO
-         END DO
-
-         ! Slopes limitation
-         ! interior values
-         DO jk = 2, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  ztp1(ji,jj,jk) = SIGN( 1., ztp1(ji,jj,jk) )   &
-                     &           * MIN(    ABS( ztp1(ji,jj,jk  ) ),   &
-                     &                  2.*ABS( zt1 (ji,jj,jk+1) ),   &
-                     &                  2.*ABS( zt1 (ji,jj,jk  ) ) )
-               END DO
-            END DO
-         END DO
-
-         ! surface values
-         ztp1(:,:,1) = 0. 
-
-         ! vertical advective flux
-         ! interior values
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1      
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zew = zwn(ji,jj,jk+1)
-                  z0w = SIGN( 0.5, zwn(ji,jj,jk+1) )
-                  zalpha = 0.5 + z0w
-                  zw  = z0w - 0.5 * zwn(ji,jj,jk+1)* rdttrc(jk)/ fse3w(ji,jj,jk+1)
-                  zzt1 = trb(ji,jj,jk+1,jn) + zw*ztp1(ji,jj,jk+1)
-                  zzt2 = trb(ji,jj,jk  ,jn) + zw*ztp1(ji,jj,jk  )
-                  zt1(ji,jj,jk+1) = zew * ( zalpha * zzt1 + (1.-zalpha)*zzt2 )
-               END DO
-            END DO
-         END DO
-         DO jk = 2, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  IF( tmask(ji,jj,jk+1) == 0. ) THEN
-                     IF( zwn(ji,jj,jk) > 0. ) THEN
-                        zt1(ji,jj,jk) = zwn(ji,jj,jk) * ( trb(ji,jj,jk-1,jn) + trb(ji,jj,jk,jn) ) * 0.5
-                     ENDIF
-                  ENDIF
-               END DO
-            END DO
-         END DO
-
-         ! surface values
-         IF( lk_vvl ) THEN
-            ! variable volume: flux set to zero
-            zt1(:,:, 1 ) = 0.e0
-         ELSE
-            ! free surface-constant volume
-            zt1(:,:, 1 ) = zwn(:,:,1) * trb(:,:,1,jn)
-         ENDIF
-
-         ! bottom values
-         zt1(:,:,jpk) = 0.e0
-
-         ! Compute & add the vertical advective trend
-
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1      
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr = 1. / fse3t(ji,jj,jk)
-                  ! horizontal advective trends
-                  ztra = - zbtr * ( zt1(ji,jj,jk) - zt1(ji,jj,jk+1) )
-                  ! add it to the general tracer trends
-                  tra(ji,jj,jk,jn) =  tra(ji,jj,jk,jn) + ztra
-#if defined key_trc_diatrd
-                  ! save the vertical advective trends computed as w gradz(T)
-                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),3) = ztra - trn(ji,jj,jk,jn) * hdivn(ji,jj,jk)
-#endif
-
-               END DO
-            END DO
-         END DO
-
-
-         ! 3. Save the vertical advective trends for diagnostic
-         ! ----------------------------------------------------
-
-         TRDTRC_Z : IF( l_trdtrc )THEN
-
-            ! Compute T/S vertical advection trends
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     zbtr = 1. / fse3t(ji,jj,jk)
-                     ! horizontal advective trends
-                     ztra = - zbtr * ( zt1(ji,jj,jk) - zt1(ji,jj,jk+1) )
-                     ! save the vertical advective trends computed as w gradz(T)
-                     ztrtrd(ji,jj,jk) = ztra - trn(ji,jj,jk,jn) * hdivn(ji,jj,jk)
-                  END DO 
-               END DO
-            END DO
-
-            IF (luttrd(jn)) CALL trd_mod_trc(ztrtrd, jn, jptrc_trd_zad, kt)
-
-         END IF TRDTRC_Z
-
-         !                            !=============
-      END DO                          ! tracer loop
-      !                               !=============
-
-
-      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
-         WRITE(charout, FMT="('muscl2 - zad')")
-         CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
-      ENDIF
-
-      IF( l_trdtrc ) DEALLOCATE( ztrtrd )
-
-   END SUBROUTINE trc_adv_muscl2
-
-#else
-
-   !!----------------------------------------------------------------------
-   !!   Default option                                         Empty module
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE trc_adv_muscl2( kt ) 
-      INTEGER, INTENT(in) :: kt
-      WRITE(*,*) 'trc_adv_muscl2: You should not have seen this print! error?', kt
-   END SUBROUTINE trc_adv_muscl2
-#endif
-
-   !!======================================================================
-END MODULE trcadv_muscl2
Index: trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv_smolar.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv_smolar.F90	(revision 2527)
+++ 	(revision )
@@ -1,561 +1,0 @@
-MODULE trcadv_smolar
-   !!======================================================================
-   !!                       ***  MODULE  trcadv_smolar  ***
-   !! Ocean passive tracers:  horizontal & vertical advective trend
-   !!======================================================================
-   !! History :       !  87-06  (pa-dl) Original
-   !!                 !  91-11  (G. Madec)
-   !!                 !  94-08  (A. Czaja)
-   !!                 !  95-09  (M. Levy) passive tracers
-   !!                 !  98-03  (M.A. Foujols) lateral boundary conditions
-   !!                 !  99-02  (M.A. Foujols) lbc in conjonction with ORCA
-   !!                 !  00-05  (MA Foujols) add lbc for tracer trends
-   !!                 !  00-10  (MA Foujols and E.Kestenare) INCLUDE instead of routine
-   !!                 !  01-05  (E.Kestenare) fix bug in trtrd indexes
-   !!                 !  02-05  (M-A Filiberti, and M.Levy) correction in trtrd computation
-   !!           9.0   !  03-04  (C. Ethe)  F90: Free form and module
-   !!                 !  07-02  (C. Deltel) Diagnose ML trends for passive tracers
-   !!----------------------------------------------------------------------
-#if defined key_top
-   !!----------------------------------------------------------------------
-   !!   trc_adv_smolar : update the passive tracer trend with the horizontal
-   !!                  and vertical advection trends using a Smolarkiewicz 
-   !!                  FCT scheme
-   !!----------------------------------------------------------------------
-   USE oce_trc             ! ocean dynamics and active tracers variables
-   USE trc                 ! ocean passive tracers variables
-   USE trp_trc
-   USE lbclnk              ! ocean lateral boundary conditions (or mpp link)
-   USE trcbbl              ! advective passive tracers in the BBL
-   USE prtctl_trc          ! Print control for debbuging
-   USE trctrp_lec
-   USE trdmld_trc
-   USE trdmld_trc_oce     
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC trc_adv_smolar   ! routine called by trcstp.F90
-
-   REAL(wp), DIMENSION(jpk) ::   rdttrc    ! vertical profile of tracer time-step
- 
-   !! * Substitutions
-#  include "top_substitute.h90"
-   !!----------------------------------------------------------------------
-   !!   TOP 1.0 , LOCEAN-IPSL (2005) 
-   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcadv_smolar.F90,v 1.11 2006/04/10 15:38:54 opalod Exp $ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE trc_adv_smolar( kt )
-      !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE trc_adv_smolar  ***
-      !!
-      !! ** Purpose :   Compute the now trend due to total advection of passi-
-      !!                ve tracer using a Smolarkiewicz FCT (Flux Corrected
-      !!                Transport) scheme and add it to the general tracer trend.
-      !!
-      !! ** Method  :   Computation of not exactly the advection but the
-      !!                transport term, i.e.  div(u*tra). 
-      !!                Computes the now horizontal and vertical advection with
-      !!                the complete 3d method.
-      !! 
-      !!       Note : - sc is an empirical factor to be used with care
-      !!              - this advection scheme needs an euler-forward time scheme
-      !!
-      !! ** Action : - update tra with the now advective tracer trends
-      !!             - save trends ('key_trdmld_trc')
-      !!
-      !! References :   Smolarkiewicz, 1983, Mon. Wea. Rev. p. 479-486
-      !!----------------------------------------------------------------------
-#if defined key_trcbbl_adv
-      USE oce_trc            , zun => ua,  &  ! use ua as workspace
-         &                     zvn => va      ! use va as workspace
-      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwn
-#else
-      USE oce_trc            , zun => un,  &  ! When no bbl, zun == un
-           &                   zvn => vn,  &  !              zvn == vn
-           &                   zwn => wn      !              zwn == wn
-#endif
-      INTEGER, INTENT( in ) ::   kt                        ! ocean time-step
-      INTEGER :: ji, jj, jk,jt, jn                         ! dummy loop indices
-      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zti, ztj   
-      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zaa, zbb, zcc
-      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zx , zy , zz
-      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zkx, zky, zkz
-      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zbuf
-      REAL(wp) :: zgm, zgz
-      REAL(wp) :: zbtr, ztra
-      REAL(wp) :: zfp_ui, zfp_vj, zfm_ui, zfm_vj, zfp_w, zfm_w
-      CHARACTER (len=22) :: charout
-      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   ztrtrd
-      !!----------------------------------------------------------------------
-
-      IF( kt == nittrc000  .AND. lwp ) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'trc_adv_smolar : SMOLARKIEWICZ advection scheme'
-         WRITE(numout,*) '~~~~~~~~~~~~~~~'
-         rdttrc(:) = rdttra(:) * FLOAT(ndttrc)
-      ENDIF
-      
-      IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk,3) )
-     
-#if defined key_trcbbl_adv        
-      ! Advective bottom boundary layer
-      ! -------------------------------
-      zun(:,:,:) = un (:,:,:) - u_trc_bbl(:,:,:)
-      zvn(:,:,:) = vn (:,:,:) - v_trc_bbl(:,:,:)
-      zwn(:,:,:) = wn (:,:,:) + w_trc_bbl(:,:,:)
-#endif
-
-      !                                                          ! ===========
-      DO jn = 1, jptra                                           ! tracer loop
-         !                                                       ! ===========
-         ! 1. tracer flux in the 3 directions
-         ! ----------------------------------
-         
-         !--1.1 Horizontal advection
-         IF( l_trdtrc ) ztrtrd(:,:,:,:) = 0.e0             ! trends
-
-         DO jk = 1, jpk                                       ! Horizontal slab
-
-            ! ... Initialisations
-            zbuf(:,:,jk) = 0.e0    ;    ztj(:,:,jk) = 0.e0
-            zx  (:,:,jk) = 0.e0    ;    zy (:,:,jk) = 0.e0
-            zz  (:,:,jk) = 0.e0
-            
-            IF( l_trdtrc ) ztrtrd(:,:,:,:) = 0.e0             ! trends
-
-            ! ... Horizontal mass flux at u v and t-points
-            zaa(:,:,jk)  = e2u(:,:) * fse3u(:,:,jk) * zun(:,:,jk)
-            zbb(:,:,jk)  = e1v(:,:) * fse3v(:,:,jk) * zvn(:,:,jk)
-            zcc(:,:,jk)  = e1t(:,:) *   e2t(:,:)    * zwn(:,:,jk)
-            zti(:,:,jk)  = trn(:,:,jk,jn)
-
-#if defined key_trc_diatrd
-            IF (luttrd(jn)) trtrd(:,:,jk,ikeep(jn),1) = 0.
-            IF (luttrd(jn)) trtrd(:,:,jk,ikeep(jn),2) = 0.
-            IF (luttrd(jn)) trtrd(:,:,jk,ikeep(jn),3) = 0.
-#endif
-
-            ! ... Horizontal tracer flux in the i and j direction
-            zkx( 1,  :,jk) = 0.e0     ;      zky(  :,  1,jk) = 0.e0
-            zkx(jpi, :,jk) = 0.e0     ;      zky(  :,jpj,jk) = 0.e0
-            
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1    ! Vector opt.
-                  
-                  ! Upstream advection scheme using mass fluxes calculated above
-                  zfp_ui = 0.5 * ( zaa(ji,jj,jk) + ABS( zaa(ji,jj,jk) ) )
-                  zfp_vj = 0.5 * ( zbb(ji,jj,jk) + ABS( zbb(ji,jj,jk) ) )
-                  zfm_ui = 0.5 * ( zaa(ji,jj,jk) - ABS( zaa(ji,jj,jk) ) )
-                  zfm_vj = 0.5 * ( zbb(ji,jj,jk) - ABS( zbb(ji,jj,jk) ) )
-                  
-                  ! Tracer fluxes
-                  zkx(ji,jj,jk) = zfp_ui * zti(ji,jj,jk) + zfm_ui * zti(ji+1,jj  ,jk) 
-                  zky(ji,jj,jk) = zfp_vj * zti(ji,jj,jk) + zfm_vj * zti(ji  ,jj+1,jk)             
-               END DO
-            END DO
-            
-         END DO                                               ! Horizontal slab
-         
-         ! ... Lateral boundary conditions on zk[xy]
-         CALL lbc_lnk( zkx, 'U', -1. )
-         CALL lbc_lnk( zky, 'V', -1. )
-         
-         !--1.2 Vertical advection
-         IF( lk_vvl ) THEN
-            ! variable volume: flux set to zero
-            zkz(:,:, 1 ) = 0.e0  
-         ELSE
-            ! free surface-constant volume
-            zkz(:,:, 1 ) = zwn(:,:,1) * trn(:,:,1,jn) * tmask(ji,jj,1)
-         ENDIF
-         
-         DO jk = 2, jpk     ! Vector opt. ???
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zfp_w = 0.5 * ( zcc(ji,jj,jk) + ABS( zcc(ji,jj,jk) ) )
-                  zfm_w = 0.5 * ( zcc(ji,jj,jk) - ABS( zcc(ji,jj,jk) ) )        
-                  zkz(ji,jj,jk) = zfp_w * zti(ji,jj,jk) + zfm_w * zti(ji,jj,jk-1)     
-               END DO
-            END DO
-         END DO
-         
-         ! 2. Compute after field using an upstream advection scheme
-         ! ---------------------------------------------------------
-         
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1  ! Vector opt.
-                  zbtr = 1./(e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk))
-                  ztj(ji,jj,jk) = - zbtr *                                &
-                       &         ( zkx(ji,jj,jk) - zkx(ji-1,jj  ,jk  )    &
-                       &         + zky(ji,jj,jk) - zky(ji  ,jj-1,jk  )    &
-                       &         + zkz(ji,jj,jk) - zkz(ji  ,jj  ,jk+1) )
-#if defined key_trc_diatrd
-                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),1) = trtrd(ji,jj,jk,ikeep(jn),1) -  &
-                       &                                        zbtr*( zkx(ji,jj,jk) - zkx(ji-1,jj,jk) )
-
-                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),2) = trtrd(ji,jj,jk,ikeep(jn),2) -  &
-                       &                                        zbtr*( zky(ji,jj,jk) - zky(ji,jj-1,jk) )
-
-                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),3) = trtrd(ji,jj,jk,ikeep(jn),3) -  &
-                       &                                        zbtr*( zkz(ji,jj,jk) - zkz(ji,jj,jk+1) )
-#endif
-
-               END DO
-            END DO
-         END DO
-         
-         ! 3. Diagnose passive tracer trends (part 1/3)
-         ! --------------------------------------------
-
-         IF( l_trdtrc ) THEN
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! Vector opt.
-                     zbtr = 1./(e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk))
-                     ztrtrd(ji,jj,jk,1) = ztrtrd(ji,jj,jk,1) - zbtr*( zkx(ji,jj,jk) - zkx(ji-1,jj  ,jk  ) )
-                     ztrtrd(ji,jj,jk,2) = ztrtrd(ji,jj,jk,2) - zbtr*( zky(ji,jj,jk) - zky(ji  ,jj-1,jk  ) )
-                     ztrtrd(ji,jj,jk,3) = ztrtrd(ji,jj,jk,3) - zbtr*( zkz(ji,jj,jk) - zkz(ji  ,jj  ,jk+1) )
-                  END DO
-               END DO
-            END DO
-         ENDIF
-         
-         ! 4. Antidiffusive correction loop
-         ! --------------------------------
-         !                                      ! -----------------------------
-         DO jt = 1, ncortrc                     ! antidiffusive correction loop
-            !                                   ! -----------------------------
-            
-            !--4.1 Compute intermediate field zti
-            DO jk = 1, jpkm1
-               zti (:,:,jk) = zti (:,:,jk) + rdttrc(jk) * ztj(:,:,jk)
-            END DO
-            zbuf(:,:,:) = zbuf(:,:,:) + ztj(:,:,:)
-            
-            CALL lbc_lnk( zti, 'T', 1. )    ! lateral boundary
-            
-            !--4.2 Compute the antidiffusive fluxes
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1    ! Vector opt.
-                     zx(ji,jj,jk) = ( abs(zaa(ji,jj,jk)) - rdttrc(jk)                     &
-                          &              *zaa(ji,jj,jk)**2/                               &
-                          &              (e1u(ji,jj)*e2u(ji,jj)*fse3u(ji,jj,jk) ) )       &
-                          &              *(zti(ji + 1,jj,jk) - zti( ji ,jj,jk))           &
-                          &              /(zti( ji ,jj,jk) + zti(ji + 1,jj,jk) + rtrn)    &
-                          &              * rsc
-                     
-                     zy(ji,jj,jk) = ( abs(zbb(ji,jj,jk)) - rdttrc(jk)                     &
-                          &              *zbb(ji,jj,jk)**2/                               &
-                          &              (e1v(ji,jj)*e2v(ji,jj)*fse3v(ji,jj,jk) ) )       &
-                          &              *(zti(ji,jj + 1,jk) - zti(ji, jj ,jk))           &
-                          &              /(zti(ji, jj ,jk) + zti(ji,jj + 1,jk) + rtrn)    &
-                          &              * rsc
-                  END DO
-               END DO
-            END DO
-            
-            DO jk = 2, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1    ! Vector opt.
-                     zz(ji,jj,jk) = ( abs(zcc(ji,jj,jk)) - rdttrc(jk)*zcc(ji,jj,jk)**2    &  
-                          &              /( e1t(ji,jj)*e2t(ji,jj)*fse3w(ji,jj,jk) ) )     &
-                          &               *( zti(ji,jj,jk) - zti(ji,jj,jk - 1) )/         &
-                          &                ( zti(ji,jj,jk) + zti(ji,jj,jk - 1) + rtrn )* rsc*( -1.)
-                  END DO
-               END DO
-            END DO
-            
-            !--4.3 Cross terms
-            CROSSTERMS: IF( crosster ) THEN
-               !
-               DO jk = 2, jpkm1
-                  DO jj = 2, jpjm1
-                     DO ji = fs_2, fs_jpim1    ! Vector opt.
-                        zx(ji,jj,jk) = zx(ji,jj,jk)                                               &
-                             &                  - 0.5*rdttrc(jk)*rsc*zaa(ji,jj,jk)*0.25*          &
-                             &                  (    (zbb(ji  ,jj - 1,jk  ) + zbb(ji + 1,jj - 1   &
-                             &                  ,jk  ) + zbb(ji + 1,jj  ,jk  ) + zbb(ji  ,jj      &
-                             &                  ,jk))* (zti(ji  ,jj + 1,jk  ) + zti(ji + 1,jj +   &
-                             &                  1,jk  ) - zti(ji + 1,jj - 1,jk  ) - zti(ji  ,jj   &
-                             &                  - 1,jk  ))/ (zti(ji  ,jj + 1,jk  ) + zti(ji + 1   &
-                             &                  ,jj + 1,jk  ) + zti(ji + 1,jj - 1,jk  ) + zti(ji  &
-                             &                  ,jj - 1,jk  ) + rtrn) + (zcc(ji  ,jj  ,jk  ) +    &
-                             &                  zcc(ji + 1,jj  ,jk  ) + zcc(ji  ,jj  ,jk + 1) +   &
-                             &                  zcc(ji + 1,jj  ,jk + 1))* (zti(ji  ,jj  ,jk - 1)  &
-                             &                  + zti(ji + 1,jj  ,jk - 1) - zti(ji  ,jj  ,jk + 1  &
-                             &                  )- zti(ji + 1,jj  ,jk + 1))/ (zti(ji  ,jj  ,jk -  &
-                             &                  1) + zti(ji + 1,jj  ,jk - 1) + zti(ji  ,jj  ,jk   &
-                             &                  +1) + zti(ji + 1,jj  ,jk + 1) + rtrn))/(e1u(ji    &
-                             &                  ,jj)*e2u(ji,jj)*fse3u(ji,jj,jk))*vmask(ji  ,jj -  &
-                             &                  1,jk  )*vmask(ji + 1,jj - 1,jk  )*vmask(ji + 1    &
-                             &                  ,jj,jk)*vmask(ji  ,jj  ,jk  )*tmask(ji  ,jj  ,jk  &
-                             &                  )*tmask(ji + 1,jj  ,jk  )*tmask(ji  ,jj  ,jk + 1  &
-                             &                  )*tmask(ji + 1,jj  ,jk + 1)
-                        zy(ji,jj,jk) = zy(ji,jj,jk)                                               &   
-                             &                  - 0.5*rdttrc(jk)*rsc*zbb(ji,jj,jk)*0.25*          &   
-                             &                  (    (zaa(ji - 1,jj  ,jk  ) + zaa(ji - 1,jj + 1   &   
-                             &                  ,jk  ) + zaa(ji  ,jj  ,jk  ) + zaa(ji  ,jj + 1    &   
-                             &                  ,jk))* (zti(ji + 1,jj + 1,jk  ) + zti(ji + 1,jj   &   
-                             &                  ,jk  ) - zti(ji - 1,jj + 1,jk  ) - zti(ji - 1,jj  &   
-                             &                  ,jk  ))/ (zti(ji + 1,jj + 1,jk  ) + zti(ji + 1    &   
-                             &                  ,jj  ,jk  ) + zti(ji - 1,jj + 1,jk  ) + zti(ji    &   
-                             &                  - 1,jj  ,jk  ) + rtrn) + (zcc(ji  ,jj  ,jk  )     &   
-                             &                  + zcc(ji  ,jj  ,jk + 1) + zcc(ji  ,jj + 1,jk  )   &   
-                             &                  + zcc(ji  ,jj + 1,jk + 1))* (zti(ji  ,jj  ,jk -   &   
-                             &                  1) + zti(ji  ,jj + 1,jk - 1) - zti(ji  ,jj  ,jk   &   
-                             &                  +1) - zti(ji  ,jj + 1,jk + 1))/ (zti(ji  ,jj      &   
-                             &                  ,jk- 1) + zti(ji  ,jj + 1,jk - 1) + zti(ji  ,jj   &   
-                             &                  ,jk+ 1) + zti(ji  ,jj + 1,jk + 1) + rtrn))        &   
-                             &                  /(e1v(ji,jj)*e2v(ji,jj)*fse3v(ji,jj,jk))          &   
-                             &                  *umask(ji - 1,jj,jk  )*umask(ji - 1,jj + 1,jk  )  &   
-                             &                  *umask(ji  ,jj,jk  )*umask(ji  ,jj + 1,jk  )      &   
-                             &                  *tmask(ji  ,jj,jk)*tmask(ji  ,jj  ,jk + 1)        &   
-                             &                  *tmask(ji  ,jj + 1,jk)*tmask(ji  ,jj + 1,jk + 1)      
-                        zz(ji,jj,jk) = zz(ji,jj,jk)                                               &   
-                             &                  - 0.5*rdttrc(jk)*rsc*zcc(ji,jj,jk)*0.25*          &   
-                             &                  (    (zaa(ji - 1,jj  ,jk  ) + zaa(ji  ,jj  ,jk    &   
-                             &                  ) + zaa(ji  ,jj  ,jk - 1) + zaa(ji - 1,jj  ,jk -  &   
-                             &                  1))*(zti(ji + 1,jj  ,jk - 1) + zti(ji + 1,jj      &   
-                             &                  ,jk  ) - zti(ji - 1,jj  ,jk  ) - zti(ji - 1,jj    &   
-                             &                  ,jk - 1))/(zti(ji + 1,jj  ,jk - 1) + zti(ji + 1   &   
-                             &                  ,jj,jk  ) + zti(ji - 1,jj  ,jk  ) + zti(ji - 1    &   
-                             &                  ,jj,jk - 1) + rtrn) + (zbb(ji  ,jj - 1,jk  )      &   
-                             &                  + zbb(ji  ,jj  ,jk  ) + zbb(ji  ,jj  ,jk - 1)     &   
-                             &                  + zbb(ji  ,jj - 1,jk - 1))*(zti(ji  ,jj + 1,jk -  &   
-                             &                  1) + zti(ji  ,jj + 1,jk  ) - zti(ji  ,jj - 1,jk   &   
-                             &                  ) - zti(ji  ,jj - 1,jk - 1))/(zti(ji  ,jj + 1,jk  &   
-                             &                  - 1) + zti(ji  ,jj + 1,jk  ) + zti(ji  ,jj - 1    &   
-                             &                  ,jk  ) + zti(ji  ,jj - 1,jk - 1) + rtrn))         &   
-                             &                  /(e1t(ji,jj)*e2t(ji,jj)*fse3w(ji,jj,jk))          &   
-                             &                  *umask(ji - 1,jj,jk  )*umask(ji  ,jj  ,jk  )      &   
-                             &                  *umask(ji  ,jj,jk- 1)*umask(ji - 1,jj  ,jk - 1)   &   
-                             &                  *vmask(ji  ,jj- 1,jk)*vmask(ji  ,jj  ,jk  )       &   
-                             &                  *vmask(ji  ,jj  ,jk-1)*vmask(ji  ,jj - 1,jk - 1)       
-                     END DO
-                  END DO
-               END DO
-               
-               DO jj = 2,jpjm1
-                     DO ji = fs_2, fs_jpim1    ! Vector opt.
-                     zx(ji,jj,1) = zx(ji,jj,1)                                                    &   
-                          &                - 0.5*rdttrc(jk)*rsc*zaa(ji,jj,1)*0.25*                &   
-                          &                ( (zbb(ji  ,jj - 1,1  ) + zbb(ji + 1,jj - 1,1  )       &   
-                          &                + zbb(ji + 1,jj  ,1  ) + zbb(ji  ,jj  ,1  ))           &   
-                          &                *(zti(ji  ,jj + 1,1  ) + zti(ji + 1,jj + 1,1  )        &   
-                          &                - zti(ji + 1,jj - 1,1  ) - zti(ji  ,jj - 1,1  ))       &   
-                          &                /(zti(ji  ,jj + 1,1  ) + zti(ji + 1,jj + 1,1  )        &   
-                          &                + zti(ji + 1,jj - 1,1  ) + zti(ji  ,jj - 1,1  ) +      &   
-                          &                rtrn))/(e1u(ji,jj)*e2u(ji,jj)*fse3u(ji,jj,1))          &   
-                          &                *vmask(ji  ,jj - 1,1  )*vmask(ji + 1,jj - 1,1  )       &   
-                          &                *vmask(ji + 1,jj  ,1  )*vmask(ji  ,jj  ,1  )    
-                     zy(ji,jj,1) = zy(ji,jj,1)                                                    &   
-                          &                - 0.5*rdttrc(jk)*rsc*zbb(ji,jj,1)*0.25*                &   
-                          &                ( (zaa(ji-1  ,jj ,1  ) + zaa(ji - 1,jj + 1,1  )        &   
-                          &                + zaa(ji ,jj  ,1  ) + zaa(ji  ,jj + 1  ,1  ))          &   
-                          &                *(zti(ji + 1,jj + 1,1  ) + zti(ji + 1,jj ,1  )         &   
-                          &                - zti(ji - 1,jj + 1,1  ) - zti(ji - 1,jj ,1  ))        &   
-                          &                /(zti(ji + 1,jj + 1,1  ) + zti(ji + 1,jj ,1  )         &   
-                          &                + zti(ji - 1,jj + 1,1  ) + zti(ji - 1,jj ,1  ) +       &   
-                          &                rtrn))/(e1v(ji,jj)*e2v(ji,jj)*fse3v(ji,jj,1))          &   
-                          &                *umask(ji - 1,jj,1  )*umask(ji - 1,jj + 1,1  )         &   
-                          &                *umask(ji    ,jj,1  )*umask(ji  ,jj + 1 ,1  )    
-                  END DO
-               END DO
-               !
-            ENDIF CROSSTERMS
-           
-            ! ... Lateral boundary conditions on z[xyz]
-            CALL lbc_lnk( zx, 'U', -1. )    ;    CALL lbc_lnk( zy, 'V', -1. )
-            CALL lbc_lnk( zz, 'W',  1. )
-
-            !--4.4 Reinitialization
-            zaa(:,:,:) = zx(:,:,:)
-            zbb(:,:,:) = zy(:,:,:)
-            zcc(:,:,:) = zz(:,:,:)
-
-            ! 5. Advection by antidiffusive mass fluxes & upstream scheme
-            ! -----------------------------------------------------------
-            
-            ! ... Horizontal
-            DO jk = 1, jpk
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1    ! Vector opt.
-                     zfp_ui = 0.5 * ( zaa(ji,jj,jk) + ABS( zaa(ji,jj,jk) ) )
-                     zfp_vj = 0.5 * ( zbb(ji,jj,jk) + ABS( zbb(ji,jj,jk) ) )
-                     zfm_ui = 0.5 * ( zaa(ji,jj,jk) - ABS( zaa(ji,jj,jk) ) )
-                     zfm_vj = 0.5 * ( zbb(ji,jj,jk) - ABS( zbb(ji,jj,jk) ) )            
-                     zkx(ji,jj,jk) = zfp_ui * zti(ji,jj,jk) + zfm_ui * zti(ji+1,jj  ,jk) 
-                     zky(ji,jj,jk) = zfp_vj * zti(ji,jj,jk) + zfm_vj * zti(ji  ,jj+1,jk)             
-                  END DO
-               END DO
-            END DO
-
-            ! ... Lateral boundary conditions on zk[xy]
-            CALL lbc_lnk( zkx, 'U', -1. )
-            CALL lbc_lnk( zky, 'V', -1. )
-            
-            ! ... Vertical
-            DO jk = 2, jpk
-               DO jj = 1, jpj
-                  DO ji = fs_2, fs_jpim1    ! Vector opt.
-                     zfp_w = 0.5 * ( zcc(ji,jj,jk) + ABS( zcc(ji,jj,jk) ) )
-                     zfm_w = 0.5 * ( zcc(ji,jj,jk) - ABS( zcc(ji,jj,jk) ) )       
-                     zkz(ji,jj,jk) = zfp_w * zti(ji,jj,jk) + zfm_w * zti(ji,jj,jk-1)     
-                  END DO
-               END DO
-            END DO
-
-            ! ... Compute ztj
-            DO jk = 1,jpkm1
-               DO jj = 2,jpjm1
-                  DO ji = fs_2, fs_jpim1    ! Vector opt.
-                     zbtr = 1./(e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk))
-                     ztj(ji,jj,jk) = - zbtr *                                     &  
-                          &              ( zkx(ji,jj,jk) - zkx(ji-1,jj  ,jk  )    &  
-                          &              + zky(ji,jj,jk) - zky(ji  ,jj-1,jk  )    &  
-                          &              + zkz(ji,jj,jk) - zkz(ji  ,jj  ,jk+1) )
-#if defined key_trc_diatrd
-                     IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),1) = trtrd(ji,jj,jk,ikeep(jn),1) -    &
-                          &                                        zbtr*( zkx(ji,jj,jk) - zkx(ji - 1,jj,jk) )
-
-                     IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),2) = trtrd(ji,jj,jk,ikeep(jn),2) -    &
-                          &                                        zbtr*( zky(ji,jj,jk) - zky(ji,jj - 1,jk) )
-
-                     IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),3) = trtrd(ji,jj,jk,ikeep(jn),3) -    &
-                          &                                        zbtr*( zkz(ji,jj,jk) - zkz(ji,jj,jk + 1) )
-#endif
-
-                  END DO
-               END DO
-            END DO
-
-            ! 6. Diagnose passive tracer trends (part 2/3)
-            ! --------------------------------------------
-            IF( l_trdtrc ) THEN
-               DO jk = 1, jpkm1
-                  DO jj = 2, jpjm1
-                     DO ji = fs_2, fs_jpim1    ! Vector opt.
-                        zbtr = 1./(e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk))
-                        ztrtrd(ji,jj,jk,1) = ztrtrd(ji,jj,jk,1) - zbtr*( zkx(ji,jj,jk) - zkx(ji - 1,jj,jk) )   
-                        ztrtrd(ji,jj,jk,2) = ztrtrd(ji,jj,jk,2) - zbtr*( zky(ji,jj,jk) - zky(ji,jj - 1,jk) )
-                        ztrtrd(ji,jj,jk,3) = ztrtrd(ji,jj,jk,3) - zbtr*( zkz(ji,jj,jk) - zkz(ji,jj,jk + 1) )
-                     END DO
-                  END DO
-               END DO
-            ENDIF
-            !                            ! ------------------------------------
-         END DO                          ! End of antidiffusive correction loop
-         !                               ! ------------------------------------
-
-         ! 7. Trend due to horizontal and vertical advection of tracer jn
-         ! --------------------------------------------------------------
-         
-         DO jk = 1, jpk
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1     ! Vector opt.
-                  ztra = ( zbuf(ji,jj,jk) + ztj(ji,jj,jk) ) * tmask(ji,jj,jk)
-                  tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
-               END DO
-            END DO
-         END DO
-
-
-         ! 8. Convert the transport trend into advection trend (part 3/3)
-         ! --------------------------------------------------------------
-
-         IF( l_trdtrc ) THEN
-            ! ... Update the trends array
-            DO jk = 1, jpk
-               DO jj = 2, jpjm1
-                  DO  ji = fs_2, fs_jpim1
-                     zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                     zgm = zbtr * trn(ji,jj,jk,jn) *                                           &  
-                          &  (   zun(ji  ,jj,jk) * e2u(ji  ,jj) * fse3u(ji  ,jj,jk)            &  
-                          &    - zun(ji-1,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk)  )
-            
-                     zgz = zbtr * trn(ji,jj,jk,jn) *                                           &  
-                          &  (   zvn(ji,jj  ,jk) * e1v(ji,jj  ) * fse3v(ji,jj  ,jk)            &  
-                          &    - zvn(ji,jj-1,jk) * e1v(ji,jj-1) * fse3v(ji,jj-1,jk)  )
-            
-                     ztrtrd(ji,jj,jk,1) = ztrtrd(ji,jj,jk,1) + zgm
-                     ztrtrd(ji,jj,jk,2) = ztrtrd(ji,jj,jk,2) + zgz
-                     ztrtrd(ji,jj,jk,3) = ztrtrd(ji,jj,jk,3) - trn(ji,jj,jk,jn) * hdivn(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
- 
-            ! ... Lateral boundary conditions on trtrd:
-            CALL lbc_lnk( ztrtrd(:,:,:,1), 'T', 1. )
-            CALL lbc_lnk( ztrtrd(:,:,:,2), 'T', 1. )
-            CALL lbc_lnk( ztrtrd(:,:,:,3), 'T', 1. )
- 
-            ! ... Miscellaneous trends diagnostics
-            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd(:,:,:,1), jn, jptrc_trd_xad, kt )
-            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd(:,:,:,2), jn, jptrc_trd_yad, kt )
-            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd(:,:,:,3), jn, jptrc_trd_zad, kt )
-         ENDIF
-
-         !  Convert the transport trend into advection trend
-         ! ---------------------------------------------------
-
-#if defined key_trc_diatrd
-        DO jk = 1,jpk
-          DO jj = 2,jpjm1
-             DO ji = fs_2, fs_jpim1     ! Vector opt.
-                zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                zgm = zbtr * trn(ji,jj,jk,jn) *                                       &
-                     &    (  zun(ji  ,jj,jk) * e2u(ji  ,jj) * fse3u(ji  ,jj,jk)       &
-                     &     - zun(ji-1,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk)    )
-
-                zgz = zbtr * trn(ji,jj,jk,jn) *                                       &
-                     &    (  zvn(ji,jj  ,jk) * e1v(ji,jj  ) * fse3v(ji,jj  ,jk)       &
-                     &     - zvn(ji,jj-1,jk) * e1v(ji,jj-1) * fse3v(ji,jj-1,jk)   )
-
-                IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),1) = trtrd(ji,jj,jk,ikeep(jn),1) + zgm
-                IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),2) = trtrd(ji,jj,jk,ikeep(jn),2) + zgz
-                IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),3) = trtrd(ji,jj,jk,ikeep(jn),3)         &
-                     &                                      - trn(ji,jj,jk,jn) * hdivn(ji,jj,jk)
-             END DO
-          END DO
-       END DO
-
-       ! Lateral boundary conditions on trtrd
-       IF (luttrd(jn)) CALL lbc_lnk( trtrd(:,:,:,ikeep(jn),1), 'T', 1. )
-       IF (luttrd(jn)) CALL lbc_lnk( trtrd(:,:,:,ikeep(jn),2), 'T', 1. )
-       IF (luttrd(jn)) CALL lbc_lnk( trtrd(:,:,:,ikeep(jn),3), 'T', 1. )
-#endif
-
-       
-       !                                                 ! ==================
-    END DO                                               ! END of tracer loop
-    !                                                    ! ==================
-
-    IF( l_trdtrc ) DEALLOCATE( ztrtrd )
- 
-    IF( ln_ctl ) THEN      ! print mean trends (used for debugging)
-       WRITE(charout, FMT="('smolar - adv')")
-       CALL prt_ctl_trc_info(charout)
-       CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
-    ENDIF
-    
-  END SUBROUTINE trc_adv_smolar
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option                                         Empty module
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE trc_adv_smolar( kt ) 
-      INTEGER, INTENT(in) :: kt
-      WRITE(*,*) 'trc_adv_smolar: You should not have seen this print! error?', kt
-   END SUBROUTINE trc_adv_smolar
-#endif
-
-   !!======================================================================
-END MODULE trcadv_smolar
Index: trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv_tvd.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv_tvd.F90	(revision 2527)
+++ 	(revision )
@@ -1,620 +1,0 @@
-MODULE trcadv_tvd
-   !!======================================================================
-   !!                       ***  MODULE  trcadv_tvd  ***
-   !! Ocean passive tracers:  horizontal & vertical advective trend
-   !!======================================================================
-   !! History :       !  95-12  (L. Mortier)  Original code
-   !!                 !  00-01  (H. Loukos)  adapted to ORCA 
-   !!                 !  00-10  (MA Foujols E.Kestenare)  include file not routine
-   !!                 !  00-12  (E. Kestenare M. Levy)  fix bug in trtrd indexes
-   !!                 !  01-07  (E. Durand G. Madec)  adaptation to ORCA config
-   !!            9.0  !  02-06  (C. Ethe, G. Madec)  F90: Free form and module
-   !!                 !  07-02  (C. Deltel) Diagnose ML trends for passive tracers
-   !!----------------------------------------------------------------------
-#if defined key_top
-   !!----------------------------------------------------------------------
-   !!   trc_adv_tvd  : update the passive tracer trend with the horizontal
-   !!                  and vertical advection trends using a TVD scheme
-   !!   nonosc       : compute monotonic tracer fluxes by a nonoscillatory
-   !!                  algorithm 
-   !!----------------------------------------------------------------------
-   USE oce_trc             ! ocean dynamics and active tracers variables
-   USE trc                 ! ocean passive tracers variables
-   USE trp_trc
-   USE lbclnk              ! ocean lateral boundary conditions (or mpp link)
-   USE trcbbl              ! advective passive tracers in the BBL
-   USE prtctl_trc      ! Print control for debbuging
-   USE trdmld_trc
-   USE trdmld_trc_oce     
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC trc_adv_tvd    ! routine called by trcstp.F90
-
-   !! * Substitutions
-#  include "top_substitute.h90"
-   !!----------------------------------------------------------------------
-   !!   TOP 1.0 , LOCEAN-IPSL (2005) 
-   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcadv_tvd.F90,v 1.12 2006/04/10 15:38:54 opalod Exp $ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE trc_adv_tvd( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE trc_adv_tvd  ***
-      !! 
-      !! **  Purpose :   Compute the now trend due to total advection of 
-      !!       tracers and add it to the general trend of tracer equations
-      !!
-      !! **  Method  :   TVD scheme, i.e. 2nd order centered scheme with
-      !!       corrected flux (monotonic correction)
-      !!       note: - this advection scheme needs a leap-frog time scheme
-      !!
-      !! ** Action : - update tra with the now advective tracer trends
-      !!             - save the trends ('key_trdmld_trc)
-      !!----------------------------------------------------------------------
-#if defined key_trcbbl_adv
-      USE oce_trc            , zun => ua,  &  ! use ua as workspace
-           &                   zvn => va      ! use va as workspace
-      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwn
-#else
-      USE oce_trc            , zun => un,  &  ! When no bbl, zun == un
-           &                   zvn => vn,  &  !             zvn == vn
-           &                   zwn => wn      !             zwn == wn
-#endif
-      INTEGER, INTENT( in ) ::   kt                        ! ocean time-step
-      INTEGER  ::   ji, jj, jk, jn                         ! dummy loop indices
-      !!
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztu, ztv
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zti, ztw
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd  ! trends
-      !!
-      REAL(wp) ::   z_hdivn_x, z_hdivn_y                   ! temporary scalars
-      REAL(wp) ::   z2dtt, zbtr, zeu, zev, zew, z2
-      REAL(wp) ::   zfp_ui, zfp_vj, zfp_wk
-      REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk
-#if defined key_trc_diatrd
-      REAL(wp) ::   zgm, zgz
-#endif
-      CHARACTER (len=22) :: charout
-      !!----------------------------------------------------------------------
-
-      zti(:,:,:) = 0.e0
-
-      IF( kt == nittrc000  .AND. lwp ) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'trc_adv_tvd : TVD advection scheme'
-         WRITE(numout,*) '~~~~~~~~~~~'
-      ENDIF
-
-      IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk) )
-
-      IF( neuler == 0 .AND. kt == nittrc000 ) THEN
-         z2=1.
-      ELSE
-         z2=2.
-      ENDIF
-
-#if defined key_trcbbl_adv
-      ! Advective Bottom boundary layer: add the velocity
-      ! -------------------------------------------------
-      zun(:,:,:) = un (:,:,:) - u_trc_bbl(:,:,:)
-      zvn(:,:,:) = vn (:,:,:) - v_trc_bbl(:,:,:)
-      zwn(:,:,:) = wn (:,:,:) + w_trc_bbl(:,:,:)
-#endif
-
-      !                                                          ! ===========
-      DO jn = 1, jptra                                           ! tracer loop
-         !                                                       ! ===========
-
-         ! ============================================================
-         ! I.              Intermediate advective trends
-         ! ============================================================
-
-         ! 1. Bottom value : flux set to zero
-         ! ----------------------------------
-         ztu(:,:,jpk) = 0.e0    ;    ztv(:,:,jpk) = 0.e0
-         ztw(:,:,jpk) = 0.e0    ;    zti(:,:,jpk) = 0.e0
-
-
-         ! 2. Upstream advection with initial mass fluxes & intermediate update
-         ! --------------------------------------------------------------------
-
-         ! ... Upstream tracer flux in the i and j direction
-         DO jk = 1, jpkm1
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-               !??? CD DO ji = fs_2, fs_jpim1    ! Vector opt.
-                  zeu = 0.5 * e2u(ji,jj) * fse3u(ji,jj,jk) * zun(ji,jj,jk)
-                  zev = 0.5 * e1v(ji,jj) * fse3v(ji,jj,jk) * zvn(ji,jj,jk)
-                  zfp_ui = zeu + ABS( zeu )   ! upstream scheme
-                  zfm_ui = zeu - ABS( zeu )
-                  zfp_vj = zev + ABS( zev )
-                  zfm_vj = zev - ABS( zev )
-                  ztu(ji,jj,jk) = zfp_ui * trb(ji,jj,jk,jn) + zfm_ui * trb(ji+1,jj  ,jk,jn)
-                  ztv(ji,jj,jk) = zfp_vj * trb(ji,jj,jk,jn) + zfm_vj * trb(ji  ,jj+1,jk,jn)
-               END DO
-            END DO
-         END DO
-
-         ! ... Upstream tracer flux in the k direction
-         ! Surface value
-         IF( lk_vvl ) THEN
-            ! variable volume: flux set to zero
-            ztw(:,:,1) = 0.e0
-         ELSE
-            ! free surface-constant volume
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zew = e1t(ji,jj) * e2t(ji,jj) * zwn(ji,jj,1)
-                  ztw(ji,jj,1) = zew * trb(ji,jj,1,jn)
-               END DO
-            END DO
-         ENDIF
-
-         ! Interior value
-         DO jk = 2, jpkm1
-            DO jj = 1, jpj
-               DO ji = 1, jpi   ! CD ??? Vector opt. 
-                  zew = 0.5 * e1t(ji,jj) * e2t(ji,jj) * zwn(ji,jj,jk)
-                  zfp_wk = zew + ABS( zew )
-                  zfm_wk = zew - ABS( zew )
-                  ztw(ji,jj,jk) = zfp_wk * trb(ji,jj,jk,jn) + zfm_wk * trb(ji,jj,jk-1,jn)
-               END DO
-            END DO
-         END DO
-
-         ! ... Total intermediate advective trend (flux divergence)
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr = 1./ ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  zti(ji,jj,jk) = - ( ztu(ji,jj,jk) - ztu(ji-1,jj  ,jk  )   &
-                     &              + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk  )   &
-                     &              + ztw(ji,jj,jk) - ztw(ji  ,jj  ,jk+1) ) * zbtr
-#if defined key_trc_diatrd
-                  IF ( luttrd(jn) ) &
-                     trtrd(ji,jj,jk,ikeep(jn),1) = trtrd(ji,jj,jk,ikeep(jn),1) -  &
-                        &                          zbtr * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) )
-                  IF ( luttrd(jn) ) &
-                     trtrd(ji,jj,jk,ikeep(jn),2) = trtrd(ji,jj,jk,ikeep(jn),2) -  &
-                        &                          zbtr * ( ztv(ji,jj,jk) - ztv(ji,jj-1,jk) )
-                  IF ( luttrd(jn) ) &
-                     trtrd(ji,jj,jk,ikeep(jn),3) = trtrd(ji,jj,jk,ikeep(jn),3) -  &
-                        &                          zbtr * ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) )
-#endif
-               END DO
-            END DO
-         END DO
-         
-         ! 3. Save the intermediate i / j / k advective trends for diagnostics
-         ! -------------------------------------------------------------------
-
-         IF( l_trdtrc ) THEN
-
-            ! 3.1) Passive tracer ZONAL advection trends
-            ztrtrd(:,:,:) = 0.e0
-
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-
-                     !-- Compute zonal divergence by splitting hdivn (see divcur.F90)
-                     !   N.B. This computation is not valid along OBCs (if any)
-                     zbtr = 1./ ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                     z_hdivn_x = (  e2u(ji  ,jj) * fse3u(ji  ,jj,jk) * un(ji  ,jj,jk)          &
-                          &       - e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * un(ji-1,jj,jk) ) * zbtr
-
-                     !-- Compute zonal advection trends
-                     ztrtrd(ji,jj,jk) = - ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) ) * zbtr &
-                          &             + trb(ji,jj,jk,jn) * z_hdivn_x
-                  END DO
-               END DO
-            END DO
-
-            IF (luttrd(jn)) CALL trd_mod_trc(ztrtrd, jn, jptrc_trd_xad, kt)    ! save the trends
-
-            ! 3.2) Passive tracer MERIDIONAL advection trends
-            ztrtrd(:,:,:) = 0.e0
- 
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-
-                     !-- Compute merid. divergence by splitting hdivn (see divcur.F90)
-                     !   N.B. This computation is not valid along OBCs (if any)
-                     zbtr      = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                     z_hdivn_y = (  e1v(ji,  jj) * fse3v(ji,jj  ,jk) * vn(ji,jj  ,jk)          &
-                          &       - e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * vn(ji,jj-1,jk) ) * zbtr
-
-                     !-- Compute merid. advection trends
-                     ztrtrd(ji,jj,jk) = - ( ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) * zbtr &
-                          &             + trb(ji,jj,jk,jn) * z_hdivn_y
-                  END DO
-               END DO
-            END DO
-
-            IF (luttrd(jn)) CALL trd_mod_trc(ztrtrd, jn, jptrc_trd_yad, kt)     ! save the trends
-
-            ! 3.3) Passive tracer VERTICAL advection trends
-            ztrtrd(:,:,:) = 0.e0
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! Vector opt.
-                     zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                     ztrtrd(ji,jj,jk) = - ( ztw(ji,jj,jk) - ztw(ji  ,jj  ,jk+1) ) * zbtr   &
-                          &             - trb(ji,jj,jk,jn) * hdivn(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
-
-            IF (luttrd(jn)) CALL trd_mod_trc(ztrtrd, jn, jptrc_trd_zad, kt)     ! save the trends
-
-         ENDIF
-
-         ! 4. Update and guess with monotonic sheme
-         ! ----------------------------------------
-         DO jk = 1, jpkm1
-            z2dtt = z2 * rdttra(jk) * FLOAT(ndttrc)
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  tra(ji,jj,jk,jn) =  tra(ji,jj,jk,jn) + zti(ji,jj,jk)
-                  zti (ji,jj,jk) = ( trb(ji,jj,jk,jn) + z2dtt * zti(ji,jj,jk) ) * tmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-
-         ! 5. Lateral boundary conditions on zti, zsi (unchanged sign)
-         ! -----------------------------------------------------------
-         CALL lbc_lnk( zti, 'T', 1. )
-
-
-         ! ============================================================
-         ! II.              Corrected advective trends
-         ! ============================================================
-
-         ! 1. Antidiffusive flux : high order minus low order
-         ! --------------------------------------------------
-         ! Antidiffusive flux on i and j
-         DO jk = 1, jpkm1
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zeu = 0.5 * e2u(ji,jj) * fse3u(ji,jj,jk) * zun(ji,jj,jk)
-                  zev = 0.5 * e1v(ji,jj) * fse3v(ji,jj,jk) * zvn(ji,jj,jk)
-                  ztu(ji,jj,jk) = zeu * ( trn(ji,jj,jk,jn) + trn(ji+1,jj,jk,jn) ) - ztu(ji,jj,jk)
-                  ztv(ji,jj,jk) = zev * ( trn(ji,jj,jk,jn) + trn(ji,jj+1,jk,jn) ) - ztv(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-
-         ! Antidiffusive flux on k
-         ztw(:,:,1) = 0.e0    ! surface value
-         DO jk = 2, jpkm1     ! interior value
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zew = 0.5 * e1t(ji,jj) * e2t(ji,jj) * zwn(ji,jj,jk)
-                  ztw(ji,jj,jk) = zew * ( trn(ji,jj,jk,jn) + trn(ji,jj,jk-1,jn) ) - ztw(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-
-         ! Lateral bondary conditions
-         CALL lbc_lnk( ztu, 'U', -1. )
-         CALL lbc_lnk( ztv, 'V', -1. )
-         CALL lbc_lnk( ztw, 'W',  1. )
-
-         ! 2. Monotonicity algorithm
-         ! -------------------------
-         CALL nonosc( trb(:,:,:,jn), ztu, ztv, ztw, zti, z2 )
-
-
-         ! 3. Final trend with corrected fluxes
-         ! ------------------------------------
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn)   &
-                     &         - ( ztu(ji,jj,jk) - ztu(ji-1,jj  ,jk  )   &
-                     &           + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk  )   &
-                     &           + ztw(ji,jj,jk) - ztw(ji  ,jj  ,jk+1) ) * zbtr
-#if defined key_trc_diatrd
-                  IF ( luttrd(jn) ) &
-                     trtrd(ji,jj,jk,ikeep(jn),1) = trtrd(ji,jj,jk,ikeep(jn),1) -  &
-                        &                          zbtr * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) )
-                  IF ( luttrd(jn) ) &
-                     trtrd(ji,jj,jk,ikeep(jn),2) = trtrd(ji,jj,jk,ikeep(jn),2) -  &
-                        &                          zbtr * ( ztv(ji,jj,jk) - ztv(ji,jj-1,jk) )
-                  IF ( luttrd(jn) ) &
-                     trtrd(ji,jj,jk,ikeep(jn),3) = trtrd(ji,jj,jk,ikeep(jn),3) -  &
-                        &                          zbtr * ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) )
-#endif
-
-               END DO
-            END DO
-         END DO
-
-#if defined key_trc_diatrd
-         DO jk = 1,jpk
-            DO jj = 2,jpjm1
-               DO  ji = 2,jpim1
-                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  zgm = zbtr * trn(ji,jj,jk,jn) *     &
-                     &         (  zun(ji  ,jj,jk) * e2u(ji  ,jj) * fse3u(ji  ,jj,jk)    &
-                     &          - zun(ji-1,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) )
-
-                  zgz = zbtr * trn(ji,jj,jk,jn) *     &
-                     &         (  zvn(ji,jj  ,jk) * e1v(ji,jj  ) * fse3v(ji,jj  ,jk)    &
-                     &          - zvn(ji,jj-1,jk) * e1v(ji,jj-1) * fse3v(ji,jj-1,jk) )
-
-                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),1) = trtrd(ji,jj,jk,ikeep(jn),1) + zgm
-                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),2) = trtrd(ji,jj,jk,ikeep(jn),2) + zgz
-                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),3) = trtrd(ji,jj,jk,ikeep(jn),3)    &
-                     &            - trn(ji,jj,jk,jn) * hdivn(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-
-         ! Lateral boundary conditions on trtrd:
-
-         IF (luttrd(jn)) CALL lbc_lnk( trtrd(:,:,:,ikeep(jn),1), 'T', 1. )
-         IF (luttrd(jn)) CALL lbc_lnk( trtrd(:,:,:,ikeep(jn),2), 'T', 1. )
-         IF (luttrd(jn)) CALL lbc_lnk( trtrd(:,:,:,ikeep(jn),3), 'T', 1. )
-#endif
-
-         ! 4. Save the advective trends for diagnostics
-         ! --------------------------------------------
-         ! Warning : mass fluxes should probably be converted into advection 
-         ! terms in the computations below ???
-
-         IF( l_trdtrc ) THEN
-            
-            ! 4.1) Passive tracer ZONAL advection trends
-            ztrtrd(:,:,:) = 0.e0
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                     ztrtrd(ji,jj,jk) = - ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) ) * zbtr
-                  END DO
-               END DO
-            END DO
-            
-            IF (luttrd(jn)) CALL trd_mod_trc(ztrtrd, jn, jptrc_trd_xad, kt)   ! <<< ADD TO PREVIOUSLY COMPUTED
-
-            ! 4.2) Passive tracer MERIDIONAL advection trends
-            ztrtrd(:,:,:) = 0.e0
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                     ztrtrd(ji,jj,jk) = - ( ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) * zbtr 
-                  END DO
-               END DO
-            END DO
-            
-            IF (luttrd(jn)) CALL trd_mod_trc(ztrtrd, jn, jptrc_trd_yad, kt)   ! <<< ADD TO PREVIOUSLY COMPUTED
-            
-            ! 4.3) Passive tracer VERTICAL advection trends
-            ztrtrd(:,:,:) = 0.e0
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                     ztrtrd(ji,jj,jk) = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * zbtr
-                  END DO
-               END DO
-            END DO
-            
-            IF (luttrd(jn)) CALL trd_mod_trc(ztrtrd, jn, jptrc_trd_zad, kt)   ! <<< ADD TO PREVIOUSLY COMPUTED
-            
-         ENDIF
-
-
-      END DO
-
-      IF( l_trdtrc ) DEALLOCATE( ztrtrd )
-
-      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
-         WRITE(charout, FMT="('tvd - adv')")
-         CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
-      ENDIF
-
-   END SUBROUTINE trc_adv_tvd
-
-
-   SUBROUTINE nonosc( pbef, paa, pbb, pcc, paft, prdt )
-      !!---------------------------------------------------------------------
-      !!                    ***  ROUTINE nonosc  ***
-      !!     
-      !! **  Purpose :   compute monotonic tracer fluxes from the upstream 
-      !!       scheme and the before field by a nonoscillatory algorithm 
-      !!
-      !! **  Method  :   ... ???
-      !!       warning : pbef and paft must be masked, but the boundaries
-      !!       conditions on the fluxes are not necessary zalezak (1979)
-      !!       drange (1995) multi-dimensional forward-in-time and upstream-
-      !!       in-space based differencing for fluid
-      !!
-      !! History :
-      !!        !  97-04  (L. Mortier) Original code
-      !!        !  00-02  (H. Loukos)  rewritting for opa8
-      !!        !  00-10  (M.A Foujols, E. Kestenare)  lateral b.c.
-      !!        !  01-03  (E. Kestenare)  add key_passivetrc
-      !!        !  01-07  (E. Durand G. Madec)  adapted for T & S
-      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      REAL(wp), INTENT( in ) ::   &
-         prdt                               ! ???
-      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT( inout ) ::   &
-         pbef,                            & ! before field
-         paft,                            & ! after field
-         paa,                             & ! monotonic flux in the i direction
-         pbb,                             & ! monotonic flux in the j direction
-         pcc                                ! monotonic flux in the k direction
-
-      !! * Local declarations
-      INTEGER ::   ji, jj, jk               ! dummy loop indices
-      INTEGER ::   ikm1
-      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zbetup, zbetdo
-      REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn, z2dtt
-      !!----------------------------------------------------------------------
-
-      zbig = 1.e+40
-      zrtrn = 1.e-15
-      zbetup(:,:,:) = 0.e0   ;   zbetdo(:,:,:) = 0.e0
-
-      ! Search local extrema
-      ! --------------------
-      ! large negative value (-zbig) inside land
-      ! large negative value (-zbig) inside land
-      pbef(:,:,:) = pbef(:,:,:) * tmask(:,:,:) - zbig * ( 1.e0 - tmask(:,:,:) )
-      paft(:,:,:) = paft(:,:,:) * tmask(:,:,:) - zbig * ( 1.e0 - tmask(:,:,:) )
-      ! search maximum in neighbourhood
-      DO jk = 1, jpkm1
-         ikm1 = MAX(jk-1,1)
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zbetup(ji,jj,jk) = MAX(  pbef(ji  ,jj  ,jk  ), paft(ji  ,jj  ,jk  ),   &
-                  &                     pbef(ji-1,jj  ,jk  ), pbef(ji+1,jj  ,jk  ),   &
-                  &                     paft(ji-1,jj  ,jk  ), paft(ji+1,jj  ,jk  ),   &
-                  &                     pbef(ji  ,jj-1,jk  ), pbef(ji  ,jj+1,jk  ),   &
-                  &                     paft(ji  ,jj-1,jk  ), paft(ji  ,jj+1,jk  ),   &
-                  &                     pbef(ji  ,jj  ,ikm1), pbef(ji  ,jj  ,jk+1),   &
-                  &                     paft(ji  ,jj  ,ikm1), paft(ji  ,jj  ,jk+1)  )
-            END DO
-         END DO
-      END DO
-      ! large positive value (+zbig) inside land
-      pbef(:,:,:) = pbef(:,:,:) * tmask(:,:,:) + zbig * ( 1.e0 - tmask(:,:,:) )
-      paft(:,:,:) = paft(:,:,:) * tmask(:,:,:) + zbig * ( 1.e0 - tmask(:,:,:) )
-      ! search minimum in neighbourhood
-      DO jk = 1, jpkm1
-         ikm1 = MAX(jk-1,1)
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zbetdo(ji,jj,jk) = MIN(  pbef(ji  ,jj  ,jk  ), paft(ji  ,jj  ,jk  ),   &
-                  &                     pbef(ji-1,jj  ,jk  ), pbef(ji+1,jj  ,jk  ),   &
-                  &                     paft(ji-1,jj  ,jk  ), paft(ji+1,jj  ,jk  ),   &
-                  &                     pbef(ji  ,jj-1,jk  ), pbef(ji  ,jj+1,jk  ),   &
-                  &                     paft(ji  ,jj-1,jk  ), paft(ji  ,jj+1,jk  ),   &
-                  &                     pbef(ji  ,jj  ,ikm1), pbef(ji  ,jj  ,jk+1),   &
-                  &                     paft(ji  ,jj  ,ikm1), paft(ji  ,jj  ,jk+1)  )
-            END DO
-         END DO
-      END DO
-
-      ! restore masked values to zero
-      pbef(:,:,:) = pbef(:,:,:) * tmask(:,:,:)
-      paft(:,:,:) = paft(:,:,:) * tmask(:,:,:)
- 
-
-      ! 2. Positive and negative part of fluxes and beta terms
-      ! ------------------------------------------------------
-
-      DO jk = 1, jpkm1
-         z2dtt = prdt * rdttra(jk) * FLOAT(ndttrc)
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               ! positive & negative part of the flux
-               zpos = MAX( 0., paa(ji-1,jj  ,jk  ) ) - MIN( 0., paa(ji  ,jj  ,jk  ) )   &
-                  & + MAX( 0., pbb(ji  ,jj-1,jk  ) ) - MIN( 0., pbb(ji  ,jj  ,jk  ) )   &
-                  & + MAX( 0., pcc(ji  ,jj  ,jk+1) ) - MIN( 0., pcc(ji  ,jj  ,jk  ) )
-               zneg = MAX( 0., paa(ji  ,jj  ,jk  ) ) - MIN( 0., paa(ji-1,jj  ,jk  ) )   &
-                  & + MAX( 0., pbb(ji  ,jj  ,jk  ) ) - MIN( 0., pbb(ji  ,jj-1,jk  ) )   &
-                  & + MAX( 0., pcc(ji  ,jj  ,jk  ) ) - MIN( 0., pcc(ji  ,jj  ,jk+1) )
-               ! up & down beta terms
-               zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) / z2dtt
-               zbetup(ji,jj,jk) = ( zbetup(ji,jj,jk) - paft(ji,jj,jk) ) / (zpos+zrtrn) * zbt
-               zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zbetdo(ji,jj,jk) ) / (zneg+zrtrn) * zbt
-            END DO
-         END DO
-      END DO
-
-      ! lateral boundary condition on zbetup & zbetdo   (unchanged sign)
-      CALL lbc_lnk( zbetup, 'T', 1. )
-      CALL lbc_lnk( zbetdo, 'T', 1. )
-
-
-      ! 3. monotonic flux in the i direction, i.e. paa
-      ! ----------------------------------------------
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zc = paa(ji,jj,jk)
-               IF( zc >= 0. ) THEN
-                  za = MIN( 1., zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) )
-                  paa(ji,jj,jk) = za * zc
-               ELSE
-                  zb = MIN( 1., zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) )
-                  paa(ji,jj,jk) = zb * zc
-               ENDIF
-            END DO
-         END DO
-      END DO
-
-      ! lateral boundary condition on paa   (changed sign)
-      CALL lbc_lnk( paa, 'U', -1. )
-
-
-      ! 4. monotonic flux in the j direction, i.e. pbb
-      ! ----------------------------------------------
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zc = pbb(ji,jj,jk)
-               IF( zc >= 0. ) THEN
-                  za = MIN( 1., zbetdo(ji,jj,jk), zbetup(ji,jj+1,jk) )
-                  pbb(ji,jj,jk) = za * zc
-               ELSE
-                  zb = MIN( 1., zbetup(ji,jj,jk), zbetdo(ji,jj+1,jk) )
-                  pbb(ji,jj,jk) = zb * zc
-               ENDIF
-            END DO
-         END DO
-      END DO
-
-      ! lateral boundary condition on pbb   (changed sign)
-      CALL lbc_lnk( pbb, 'V', -1. )
-
-
-      ! monotonic flux in the k direction, i.e. pcc
-      ! -------------------------------------------
-      DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zc = pcc(ji,jj,jk)
-               IF( zc >= 0. ) THEN
-                  za = MIN( 1., zbetdo(ji,jj,jk), zbetup(ji,jj,jk-1) )
-                  pcc(ji,jj,jk) = za * zc
-               ELSE
-                  zb = MIN( 1., zbetup(ji,jj,jk), zbetdo(ji,jj,jk-1) )
-                  pcc(ji,jj,jk) = zb * zc
-               ENDIF
-            END DO
-         END DO
-      END DO
-
-      ! lateral boundary condition on pcc   (unchanged sign)
-      CALL lbc_lnk( pcc, 'W', 1. )
-
-   END SUBROUTINE nonosc
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option                                         Empty module
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE trc_adv_tvd( kt )  
-      INTEGER, INTENT(in) :: kt
-      WRITE(*,*) 'trc_adv_tvd: You should not have seen this print! error?', kt
-   END SUBROUTINE trc_adv_tvd
-#endif
-
-   !!======================================================================
-END MODULE trcadv_tvd
Index: trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbc.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbc.F90	(revision 2527)
+++ 	(revision )
@@ -1,251 +1,0 @@
-MODULE trcbbc
-   !!======================================================================
-   !!                       ***  MODULE  trcbbc  ***
-   !! Ocean passive tracers:  bottom boundary condition
-   !!======================================================================
-   !! History :  8.1  !  99-10  (G. Madec)  original code
-   !!            8.5  !  02-08  (G. Madec)  free form + modules
-   !!                 !  02-11  (A. Bozec)  trc_bbc_init
-   !!            9.0  !  04-03  (C. Ethe)  adpated for passive tracers
-   !!                 !  07-02  (C. Deltel)  Diagnose ML trends for passive tracers
-   !!----------------------------------------------------------------------
-#if defined key_top && defined key_trcbbc
-   !!----------------------------------------------------------------------
-   !!   'key_trcbbc'                                  geothermal heat flux
-   !!----------------------------------------------------------------------
-   !!   trc_bbc      : update the tracer trend at ocean bottom 
-   !!   trc_bbc_init : initialization of geothermal heat flux trend
-   !!----------------------------------------------------------------------
-   USE oce_trc             ! ocean dynamics and active tracers variables
-   USE trc                 ! ocean passive tracers variables
-   USE prtctl_trc          ! Print control for debbuging
-   USE trdmld_trc
-   USE trdmld_trc_oce     
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC trc_bbc          ! routine called by trcstp.F90
-
-   !! >>>>>>>>>>>>>>>>>>>>>>>>> MOVE TO NAMELIST >>>>>>>>>>>>>>>>>>>>>>>>>>
-   LOGICAL, PUBLIC, PARAMETER ::   lk_trcbbc = .TRUE.   !: bbc flag
-   
-   INTEGER ::   ngeo_trc_flux = 1              !!! ** bbc namelist (nambbc) **
-   !                                           ! Geothermal flux (0:no flux, 1:constant flux,
-   !                                           !                  2:read in file )
-   REAL(wp) ::   ngeo_trc_flux_const = 86.4e-3 !!! ** bbc namlist **
-   !                                           ! Constant value of geothermal heat flux
-
-   INTEGER, DIMENSION(jpi,jpj) ::   nbotlevt   ! ocean bottom level index at T-pt
-   REAL(wp), DIMENSION(jpi,jpj) ::   qgh_trd   ! geothermal heating trend
-   !! <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-
-   !! * Substitutions
-#  include "top_substitute.h90"
-   !!----------------------------------------------------------------------
-   !!  TOP 1.0 , LOCEAN-IPSL (2005) 
-   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcbbc.F90,v 1.11 2006/09/12 11:10:13 opalod Exp $ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE trc_bbc( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE trc_bbc  ***
-      !!
-      !! ** Purpose :   Compute the bottom boundary contition on passive tracer 
-      !!      associated with geothermal heating and add it to the general
-      !!      trend of tracers equations.
-      !!
-      !! ** Method  :   The geothermal heat flux set to its constant value of 
-      !!       86.4 mW/m2 (Stein and Stein 1992, Huang 1999).
-      !!       The temperature trend associated to this heat flux through the
-      !!       ocean bottom can be computed once and is added to the temperature
-      !!       trend juste above the bottom at each time step:
-      !!            tra = tra + Qsf / (rau0 rcp e3T) for k= mbathy -1
-      !!       Where Qsf is the geothermal heat flux.
-      !!
-      !! ** Action  : - update the temperature trends tra with the trend of
-      !!                the ocean bottom boundary condition
-      !!
-      !! References :
-      !!      Stein, C. A., and S. Stein, 1992, Nature, 359, 123-129.
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt                         ! ocean time-step index
-
-#if defined key_vectopt_loop 
-      INTEGER ::   ji, jn                                   ! dummy loop indices
-#else
-      INTEGER ::   ji, jj, jn                               ! dummy loop indices
-#endif
-      REAL(wp) ::   ztra                                    ! temporary scalar
-      CHARACTER (len=22) :: charout
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd   ! trends
-      !!----------------------------------------------------------------------
-
-      ! 0. Initialization
-      ! -----------------
-
-      IF( kt == nittrc000 )   CALL trc_bbc_init
-
-      IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk) )
-
-
-      ! 1. Add the geothermal heat flux trend on temperature
-      ! ----------------------------------------------------
-
-      SELECT CASE ( ngeo_trc_flux )
-
-      CASE ( 1:2 )                !  geothermal heat flux
-
-         !                                                       ! ===========
-         DO jn = 1, jptra                                        ! tracer loop
-            !                                                    ! ===========
-            IF( l_trdtrc )  ztrtrd(:,:,:) = tra(:,:,:,jn)  ! save trends
-
-
-#if defined key_vectopt_loop
-            DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
-               tra(ji,1,nbotlevt(ji,1),jn) = tra(ji,1,nbotlevt(ji,1),jn) + qgh_trd(ji,1)
-            END DO
-#else
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1
-                  tra(ji,jj,nbotlevt(ji,jj),jn) = tra(ji,jj,nbotlevt(ji,jj),jn) + qgh_trd(ji,jj)
-               END DO
-            END DO
-#endif
-            
-            IF( l_trdtrc ) THEN
-               ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:)
-               IF (luttrd(jn)) CALL trd_mod_trc(ztrtrd, jn, jptrc_trd_bbc, kt)
-            END IF
-
-            !                                                    ! ===========
-         END DO                                                  ! tracer loop
-         !                                                       ! ===========
-
-         IF( l_trdtrc ) DEALLOCATE( ztrtrd )
-
-         IF( ln_ctl ) THEN     ! print mean trends (used for debugging)
-            WRITE(charout, FMT="('bbc')")
-            CALL prt_ctl_trc_info(charout)
-            CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
-         ENDIF
-      END SELECT
-
-   END SUBROUTINE trc_bbc
-
-
-   SUBROUTINE trc_bbc_init
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE trc_bbc_init  ***
-      !!
-      !! ** Purpose :   Compute once for all the trend associated with geo-
-      !!      thermal heating that will be applied at each time step at the
-      !!      bottom ocean level
-      !!
-      !! ** Method  :   Read the namtopbbc namelist and check the parameters.
-      !!      called at the first time step (nittrc000)
-      !!
-      !! ** Input   : - Namlist namtopbbc
-      !!              - NetCDF file  : passivetrc_geothermal_heating.nc 
-      !!                               ( if necessary )
-      !!
-      !! ** Action  : - compute the heat geothermal trend qgh_trd
-      !!              - compute the bottom ocean level nbotlevt
-      !!----------------------------------------------------------------------
-      USE iom
-
-      CHARACTER (len=32) ::   clname
-      INTEGER  ::   ji, jj              ! dummy loop indices
-      INTEGER  ::   inum                ! temporary logical unit
-
-      NAMELIST/namtopbbc/ngeo_trc_flux, ngeo_trc_flux_const 
-      !!----------------------------------------------------------------------
-
-      ! Read Namelist nambbc : bottom momentum boundary condition
-      REWIND ( numnat )
-      READ   ( numnat, namtopbbc )
-
-      ! Control print
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'trc_bbc : Passive tracers Bottom Boundary Condition (bbc)'
-      IF(lwp) WRITE(numout,*) '~~~~~~~   Geothermal heatflux'
-      IF(lwp) WRITE(numout,*) '          Namelist namtrcbbc : set bbc parameters'
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) '             Geothermal flux           ngeo_trc_flux       = ', ngeo_trc_flux
-      IF(lwp) WRITE(numout,*) '             Constant geothermal flux  ngeo_trc_flux_const = ', ngeo_trc_flux_const
-      IF(lwp) WRITE(numout,*)
-
-      ! level of the ocean bottom at T-point
-
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            nbotlevt(ji,jj) = MAX( mbathy(ji,jj)-1, 1 )
-         END DO
-      END DO
-
-      ! initialization of geothermal heat flux
-
-      SELECT CASE ( ngeo_trc_flux )
-
-      CASE ( 0 )                ! no geothermal heat flux
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) '             *** no geothermal heat flux'
-
-      CASE ( 1 )                ! constant flux
-         IF(lwp) WRITE(numout,*) '             *** constant heat flux  =   ', ngeo_trc_flux_const
-         qgh_trd(:,:) = ngeo_trc_flux_const
-
-      CASE ( 2 )                ! variable geothermal heat flux
-         ! read the geothermal fluxes in mW/m2
-         CALL iom_open ( 'geothermal_heating_trc.nc', inum )
-         CALL iom_get ( inum, jpdom_data, 'heatflow', qgh_trd )
-         CALL iom_close (inum)
-
-         qgh_trd(:,:) = qgh_trd(:,:) * 1.e-3 ! conversion in W/m2
-
-      CASE DEFAULT
-         WRITE(ctmp1,*) '     bad flag value for ngeo_flux = ', ngeo_flux
-         CALL ctl_stop( ctmp1 )
-
-      END SELECT
-
-      ! geothermal heat flux trend
-
-      SELECT CASE ( ngeo_trc_flux )
-
-      CASE ( 1:2 )                !  geothermal heat flux
-
-#if defined key_vectopt_loop
-         DO ji = 1, jpij   ! vector opt. (forced unrolling)
-            qgh_trd(ji,1) = ro0cpr * qgh_trd(ji,1) / fse3t(ji,1,nbotlevt(ji,1) )
-         END DO
-#else
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               qgh_trd(ji,jj) = ro0cpr * qgh_trd(ji,jj) / fse3t(ji,jj,nbotlevt(ji,jj))
-            END DO
-         END DO
-#endif
-
-      END SELECT
-
-   END SUBROUTINE trc_bbc_init
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option                                         Empty module
-   !!----------------------------------------------------------------------
-   LOGICAL, PUBLIC, PARAMETER ::   lk_trcbbc = .FALSE.  !: bbc flag
-CONTAINS
-   SUBROUTINE trc_bbc( kt )           ! Empty routine
-      INTEGER, INTENT(in) :: kt
-      WRITE(*,*) 'trc_bbc: You should not have seen this print! error?', kt
-   END SUBROUTINE trc_bbc
-#endif
-
-   !!======================================================================
-END MODULE trcbbc
Index: trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl.F90	(revision 2528)
@@ -1,540 +1,100 @@
 MODULE trcbbl
-   !!======================================================================
+  !!======================================================================
    !!                       ***  MODULE  trcbbl  ***
    !! Ocean passive tracers physics :  advective and/or diffusive bottom boundary 
    !!                                  layer scheme
    !!======================================================================
-   !! History :  8.0  !  96-06  (L. Mortier)  Original code
-   !!            8.0  !  97-11  (G. Madec)  Optimization
-   !!            8.5  !  02-08  (G. Madec)  free form + modules
-   !!            9.0  !  04-03  (C. Ethe)   Adaptation for passive tracers
-   !!                 !  07-02  (C. Deltel)  Diagnose ML trends for passive tracers
+   !!==============================================================================
+   !! History :  OPA  !  1996-06  (L. Mortier)  Original code
+   !!            8.0  !  1997-11  (G. Madec)    Optimization
+   !!   NEMO     1.0  !  2002-08  (G. Madec)  free form + modules
+   !!             -   !  2004-01  (A. de Miranda, G. Madec, J.M. Molines ) add advective bbl
+   !!            3.3  !  2009-11  (G. Madec)  merge trabbl and trabbl_adv + style + optimization 
+   !!             -   !  2010-04  (G. Madec)  Campin & Goosse advective bbl 
+   !!             -   !  2010-06  (C. Ethe, G. Madec)  merge TRA-TRC
    !!----------------------------------------------------------------------
-#if  defined key_top && ( defined key_trcbbl_dif   ||   defined key_trcbbl_adv ) && ! defined key_c1d
+#if  defined key_top &&  defined key_trabbl 
    !!----------------------------------------------------------------------
-   !!   'key_trcbbl_dif'   or            diffusive bottom boundary layer
-   !!   'key_trcbbl_adv'                 advective bottom boundary layer
+   !!   'key_trabbl                      diffusive or/and adevective bottom boundary layer
    !!----------------------------------------------------------------------
-   !!   trc_bbl_dif  : update the passive tracer trends due to the bottom
-   !!                  boundary layer (diffusive only)
-   !!   trc_bbl_adv  : update the passive tracer trends due to the bottom
-   !!                  boundary layer (advective and/or diffusive)
+   !!    trc_bbl       : update the tracer trends due to the bottom boundary layer (advective and/or diffusive)
    !!----------------------------------------------------------------------
    USE oce_trc             ! ocean dynamics and active tracers variables
    USE trc                 ! ocean passive tracers variables
-   USE trctrp_lec          ! passive tracers transport
+   USE trcnam_trp      ! passive tracers transport namelist variables
+   USE trabbl              ! 
    USE prtctl_trc          ! Print control for debbuging
-   USE eosbn2
-   USE lbclnk
-   USE trdmld_trc
-   USE trdmld_trc_oce     
+   USE trdmod_oce
+   USE trdtra
 
-   IMPLICIT NONE
-   PRIVATE
+   PUBLIC   trc_bbl       !  routine called by step.F90
 
-   PUBLIC trc_bbl_dif    ! routine called by step.F90
-   PUBLIC trc_bbl_adv    ! routine called by step.F90
-
-# if defined key_trcbbl_dif
-   LOGICAL, PUBLIC, PARAMETER ::   lk_trcbbl_dif = .TRUE.   !: diffusive bottom boundary layer flag
-# else
-   LOGICAL, PUBLIC, PARAMETER ::   lk_trcbbl_dif = .FALSE.  !: diffusive bottom boundary layer flag
-# endif
-
-# if defined key_trcbbl_adv
-   LOGICAL, PUBLIC, PARAMETER ::   lk_trcbbl_adv = .TRUE.   !: advective bottom boundary layer flag
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   u_trc_bbl  !: veloc. involved in the advective BBL
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   v_trc_bbl  !: veloc. involved in the advective BBL
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   w_trc_bbl  !: vertic. increment of veloc. due to adv. BBL
-   !                                                        !  only affect tracer vertical advection
-# else
-   LOGICAL, PUBLIC, PARAMETER ::   lk_trcbbl_adv = .FALSE.  !: advective bottom boundary layer flag
-# endif
-
-   INTEGER, DIMENSION(jpi,jpj) ::   mbkt, mbku, mbkv
 
    !! * Substitutions
 #  include "top_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   TOP 1.0 , LOCEAN-IPSL (2005) 
-   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcbbl.F90,v 1.12 2006/09/12 11:10:13 opalod Exp $ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
 CONTAINS
 
-   SUBROUTINE trc_bbl_dif( kt )
+
+   SUBROUTINE trc_bbl( kt )
       !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE trc_bbl_dif  ***
+      !!                  ***  ROUTINE bbl  ***
+      !!                   
+      !! ** Purpose :   Compute the before tracer (t & s) trend associated 
+      !!     with the bottom boundary layer and add it to the general trend
+      !!     of tracer equations.
       !!
-      !! ** Purpose :   Compute the before tracer trend associated 
-      !!      with the bottom boundary layer and add it to the general trend 
-      !!      of tracer equations. The bottom boundary layer is supposed to be
-      !!      a purely diffusive bottom boundary layer.
-      !!
-      !! ** Method  :   When the product grad( rho) * grad(h) < 0 (where grad 
-      !!      is an along bottom slope gradient) an additional lateral diffu-
-      !!      sive trend along the bottom slope is added to the general tracer
-      !!      trend, otherwise nothing is done.
-      !!      Second order operator (laplacian type) with variable coefficient
-      !!      computed as follow for temperature (idem on s): 
-      !!         difft = 1/(e1t*e2t*e3t) { di-1[ ahbt e2u*e3u/e1u di[ztb] ]
-      !!                                 + dj-1[ ahbt e1v*e3v/e2v dj[ztb] ] }
-      !!      where ztb is a 2D array: the bottom ocean temperature and ahtb
-      !!      is a time and space varying diffusive coefficient defined by:
-      !!         ahbt = zahbp    if grad(rho).grad(h) < 0
-      !!              = 0.       otherwise.
-      !!      Note that grad(.) is the along bottom slope gradient. grad(rho)
-      !!      is evaluated using the local density (i.e. referenced at the
-      !!      local depth). Typical value of ahbt is 2000 m2/s (equivalent to
-      !!      a downslope velocity of 20 cm/s if the condition for slope
-      !!      convection is satified)
-      !!      Add this before trend to the general trend tra of the 
-      !!      botton ocean tracer point:
-      !!         tra = tra + difft
-      !!
-      !! ** Action  : - update tra at the bottom level with the bottom
-      !!                boundary layer trend
-      !!
-      !! References :
-      !!     Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591.
-      !!----------------------------------------------------------------------
-      USE oce, ONLY :   ztrtrd => ua                      ! use ua as 3D workspace   
-      !!
-      INTEGER, INTENT( in ) ::   kt                         ! ocean time-step
-      INTEGER ::   ji, jj, jn                               ! dummy loop indices
-      INTEGER ::   ik, iku, ikv
-      INTEGER ::   ii0, ii1, ij0, ij1                       ! temporary integers
-      INTEGER ::   iku1, iku2, ikv1, ikv2                   ! temporary intergers
-      REAL(wp) ::  ze3u, ze3v                              ! temporary scalars
-      REAL(wp) ::  zbtr, ztra
-#if ! defined key_off_tra
-      REAL(wp) ::   zgdrho, zalbet, zsign, zt, zs, zh
-      REAL(wp), DIMENSION(jpi,jpj) ::   zki, zkj
-#endif
-      REAL(wp), DIMENSION(jpi,jpj) ::   zkx, zky  ! temporary workspace arrays
-      REAL(wp), DIMENSION(jpi,jpj) ::   ztnb, zsnb, zdep
-      REAL(wp), DIMENSION(jpi,jpj) ::   ztrb, zahu, zahv
-
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step 
       CHARACTER (len=22) :: charout
-      REAL(wp) ::   fsalbt, pft, pfs, pfh                   ! statement function
-      !!----------------------------------------------------------------------
-      ! ratio alpha/beta
-      ! ================
-      !  fsalbt: ratio of thermal over saline expension coefficients
-      !       pft :  potential temperature in degrees celcius
-      !       pfs :  salinity anomaly (s-35) in psu
-      !       pfh :  depth in meters
-
-      fsalbt( pft, pfs, pfh ) =                                              &
-         ( ( ( -0.255019e-07 * pft + 0.298357e-05 ) * pft                    &
-                                   - 0.203814e-03 ) * pft                    &
-                                   + 0.170907e-01 ) * pft                    &
-                                   + 0.665157e-01                            &
-         +(-0.678662e-05 * pfs - 0.846960e-04 * pft + 0.378110e-02 ) * pfs   &
-         +  ( ( - 0.302285e-13 * pfh                                         &
-                - 0.251520e-11 * pfs                                         &
-                + 0.512857e-12 * pft * pft          ) * pfh                  &
-                                     - 0.164759e-06   * pfs                  &
-             +(   0.791325e-08 * pft - 0.933746e-06 ) * pft                  &
-                                     + 0.380374e-04 ) * pfh   
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   ztrtrd
       !!----------------------------------------------------------------------
 
-
-      IF( kt == nittrc000 )   CALL trc_bbl_init
-
-
-      ! 0. 2D fields of bottom temperature and salinity, and bottom slope
-      ! -----------------------------------------------------------------
-      ! mbathy= number of w-level, minimum value=1 (cf dommsk.F)
-
-#  if defined key_vectopt_loop
-      jj = 1
-      DO ji = 1, jpij   ! vector opt. (forced unrolling)
-#  else
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-#  endif
-            ik = mbkt(ji,jj)                              ! index of the bottom ocean T-level
-            ztnb(ji,jj) = tn(ji,jj,ik) * tmask(ji,jj,1)   ! masked now T and S at ocean bottom 
-            zsnb(ji,jj) = sn(ji,jj,ik) * tmask(ji,jj,1)
-            zdep(ji,jj) = fsdept(ji,jj,ik)                ! depth of the ocean bottom T-level
-#  if ! defined key_vectopt_loop
-         END DO
-#  endif
-      END DO
-
-      IF( ln_zps ) THEN      ! partial steps correction
-
-#   if defined key_vectopt_loop
-         jj = 1
-         DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
-#   else
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-#   endif
-               iku1 = MAX( mbathy(ji+1,jj  )-1, 1 )
-               iku2 = MAX( mbathy(ji  ,jj  )-1, 1 )
-               ikv1 = MAX( mbathy(ji  ,jj+1)-1, 1 )
-               ikv2 = MAX( mbathy(ji  ,jj  )-1, 1 )
-               ze3u = MIN( fse3u(ji,jj,iku1), fse3u(ji,jj,iku2) ) 
-               ze3v = MIN( fse3v(ji,jj,ikv1), fse3v(ji,jj,ikv2) ) 
-               zahu(ji,jj) = atrcbbl * e2u(ji,jj) * ze3u / e1u(ji,jj) * umask(ji,jj,1)
-               zahv(ji,jj) = atrcbbl * e1v(ji,jj) * ze3v / e2v(ji,jj) * vmask(ji,jj,1)
-#   if ! defined key_vectopt_loop
-            END DO
-#   endif
-         END DO
-      ELSE                  ! z-coordinate - full steps or s-coordinate
-#   if defined key_vectopt_loop
-         jj = 1
-         DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
-#   else
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-#   endif
-               iku = mbku(ji,jj)
-               ikv = mbkv(ji,jj)
-               zahu(ji,jj) = atrcbbl * e2u(ji,jj) * fse3u(ji,jj,iku) / e1u(ji,jj) * umask(ji,jj,1)
-               zahv(ji,jj) = atrcbbl * e1v(ji,jj) * fse3v(ji,jj,ikv) / e2v(ji,jj) * vmask(ji,jj,1)
-#   if ! defined key_vectopt_loop
-            END DO
-#   endif
-         END DO
+      IF( .NOT. lk_offline ) THEN
+         CALL bbl( kt, 'TRC' )         ! Online coupling with dynamics  : Computation of bbl coef and bbl transport
+         l_bbl = .FALSE.               ! Offline coupling with dynamics : Read bbl coef and bbl transport from input files
       ENDIF
 
-#if defined key_off_tra
-      !!=====================================================================
-      !!                I. OFFLINE VERSION OF DIFFUSIVE BBL
-      !!=====================================================================
-      
-      ! 1. Criteria of additional bottom diffusivity : grad(rho).grad(h) < 0
-      ! --------------------------------------------------------------------
-      
-      !    Only used in the online version of diffusive BBL (see below)
-      
-      ! 2. Additional second order diffusive trends
-      ! -------------------------------------------
-      !                                                          ! ===========
-      DO jn = 1, jptra                                           ! tracer loop
-         !                                                       ! ===========       
-
-         IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)
-     
-         ! first derivative (gradient)         
-#  if defined key_vectopt_loop
-         jj = 1
-         DO ji = 1, jpij   ! vector opt. (forced unrolling)
-#  else
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-#  endif
-               ik = mbkt(ji,jj) 
-               ztrb(ji,jj) = trb(ji,jj,ik,jn) * tmask(ji,jj,1)
-#  if ! defined key_vectopt_loop
-            END DO
-#  endif
-         END DO
-
-#  if defined key_vectopt_loop
-         jj = 1
-         DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
-#  else
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-#  endif
-               zkx(ji,jj) = bblx(ji,jj) * zahu(ji,jj) * ( ztrb(ji+1,jj) - ztrb(ji,jj) )
-               zky(ji,jj) = bbly(ji,jj) * zahv(ji,jj) * ( ztrb(ji,jj+1) - ztrb(ji,jj) )
-#  if ! defined key_vectopt_loop
-            END DO
-#  endif
-         END DO
-
-#else
-      !!=====================================================================
-      !!               II. ONLINE VERSION OF DIFFUSIVE BBL
-      !!=====================================================================
-
-      ! 1. Criteria of additional bottom diffusivity : grad(rho).grad(h) < 0
-      ! --------------------------------------------------------------------
-      ! Sign of the local density gradient along the i- and j-slopes
-      ! multiplied by the slope of the ocean bottom
-      SELECT CASE ( nn_eos )
-
-      CASE ( 0 )                 ! Jackett and McDougall (1994) formulation
-         
-#  if defined key_vectopt_loop
-      jj = 1
-      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
-#  else
-      DO jj = 1, jpjm1
-         DO ji = 1, jpim1
-#  endif
-            ! temperature, salinity anomalie and depth
-            zt = 0.5 * ( ztnb(ji,jj) + ztnb(ji+1,jj) )
-            zs = 0.5 * ( zsnb(ji,jj) + zsnb(ji+1,jj) ) - 35.0
-            zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) )
-            ! masked ratio alpha/beta
-            zalbet = fsalbt( zt, zs, zh )*umask(ji,jj,1)
-            ! local density gradient along i-bathymetric slope
-            zgdrho = zalbet * ( ztnb(ji+1,jj) - ztnb(ji,jj) )   &
-                   -          ( zsnb(ji+1,jj) - zsnb(ji,jj) )
-            ! sign of local i-gradient of density multiplied by the i-slope
-            zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) )
-            zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj)
-#  if ! defined key_vectopt_loop
-         END DO
-#  endif
-      END DO
-
-#  if defined key_vectopt_loop
-      jj = 1
-      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
-#  else
-      DO jj = 1, jpjm1
-         DO ji = 1, jpim1
-#  endif
-            ! temperature, salinity anomalie and depth
-            zt = 0.5 * ( ztnb(ji,jj+1) + ztnb(ji,jj) )
-            zs = 0.5 * ( zsnb(ji,jj+1) + zsnb(ji,jj) ) - 35.0
-            zh = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) )
-            ! masked ratio alpha/beta
-            zalbet = fsalbt( zt, zs, zh )*vmask(ji,jj,1)
-            ! local density gradient along j-bathymetric slope
-            zgdrho = zalbet * ( ztnb(ji,jj+1) - ztnb(ji,jj) )   &
-                   -          ( zsnb(ji,jj+1) - zsnb(ji,jj) )
-            ! sign of local j-gradient of density multiplied by the j-slope
-            zsign = SIGN( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) )
-            zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj)
-#  if ! defined key_vectopt_loop
-         END DO
-#  endif
-      END DO
-      
-      CASE ( 1 )                 ! Linear formulation function of temperature only
-
-#  if defined key_vectopt_loop
-      jj = 1
-      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
-#  else
-      DO jj = 1, jpjm1
-         DO ji = 1, jpim1
-#  endif
-            ! local density gradient along i-bathymetric slope
-            zgdrho =  ( ztnb(ji+1,jj) - ztnb(ji,jj) )
-            ! sign of local i-gradient of density multiplied by the i-slope
-            zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) )
-            zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj)
-#  if ! defined key_vectopt_loop
-         END DO
-#  endif
-      END DO
-
-#  if defined key_vectopt_loop
-      jj = 1
-      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
-#  else
-      DO jj = 1, jpjm1
-         DO ji = 1, jpim1
-#  endif
-            ! local density gradient along j-bathymetric slope
-            zgdrho =  ( ztnb(ji,jj+1) - ztnb(ji,jj) )
-            ! sign of local j-gradient of density multiplied by the j-slope
-            zsign = SIGN( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) )
-            zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj)
-
-#  if ! defined key_vectopt_loop
-         END DO
-#  endif
-      END DO
-
-      CASE ( 2 )                 ! Linear formulation function of temperature and salinity
-
-      DO jj = 1, jpjm1
-        DO ji = 1, fs_jpim1   ! vector opt.
-            ! local density gradient along i-bathymetric slope
-            zgdrho = - ( rn_beta*( zsnb(ji+1,jj) - zsnb(ji,jj) )   &
-                     -  rn_alpha*( ztnb(ji+1,jj) - ztnb(ji,jj) ) )
-            ! sign of local i-gradient of density multiplied by the i-slope
-            zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) )
- 	    zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj)
-        END DO
-      END DO
-
-      DO jj = 1, jpjm1
-        DO ji = 1, fs_jpim1   ! vector opt.
-            ! local density gradient along j-bathymetric slope
-            zgdrho = - ( rn_beta*( zsnb(ji,jj+1) - zsnb(ji,jj) )   &
-                     -  rn_alpha*( ztnb(ji,jj+1) - ztnb(ji,jj) ) )
-            ! sign of local j-gradient of density multiplied by the j-slope
-            zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) )
-            zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj)
-         END DO
-      END DO
-
-      CASE DEFAULT
-
-         WRITE(ctmp1,*) '          bad flag value for nn_eos = ', nn_eos
-         CALL ctl_stop( ctmp1 )
-
-      END SELECT
-      
-      ! 2. Additional second order diffusive trends
-      ! -------------------------------------------
-      !                                                          ! ===========
-      DO jn = 1, jptra                                           ! tracer loop
-         !                                                       ! ===========
-         IF( l_trdtrc )   ztrtrd(:,:,:) = tra(:,:,:,jn)
-
-         ! first derivative (gradient)
-#  if defined key_vectopt_loop
-         jj = 1
-         DO ji = 1, jpij   ! vector opt. (forced unrolling)
-#  else
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-#  endif
-               ik = mbkt(ji,jj)
-               ztrb(ji,jj) = trb(ji,jj,ik,jn) * tmask(ji,jj,1)
-#  if ! defined key_vectopt_loop
-            END DO
-#  endif
-         END DO
-#  if defined key_vectopt_loop
-         jj = 1
-         DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
-#  else
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-#  endif
-               zkx(ji,jj) = zki(ji,jj) * ( ztrb(ji+1,jj) - ztrb(ji,jj) )
-               zky(ji,jj) = zkj(ji,jj) * ( ztrb(ji,jj+1) - ztrb(ji,jj) )
-#  if ! defined key_vectopt_loop
-            END DO
-#  endif
-         END DO
-#endif
-
-      !!=====================================================================
-      !!     III. COMMON CODE FOR OFFLINE/ONLINE VERSIONS OF DIFFUSIVE BBL
-      !!=====================================================================
-
-         IF( cp_cfg == "orca" ) THEN
-            
-            SELECT CASE ( jp_cfg )
-               !                                        ! =======================
-            CASE ( 2 )                                  !  ORCA_R2 configuration
-               !                                        ! =======================
-               ! Gibraltar enhancement of BBL
-               ij0 = 102   ;   ij1 = 102
-               ii0 = 139   ;   ii1 = 140  
-               zkx( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 4.e0 * zkx( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) )
-               zky( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 4.e0 * zky( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) )
-               
-               ! Red Sea enhancement of BBL
-               ij0 =  88   ;   ij1 =  88
-               ii0 = 161   ;   ii1 = 162
-               zkx( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 10.e0 * zkx( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) )
-               zky( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 10.e0 * zky( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) )
-               
-               !                                        ! =======================
-            CASE ( 4 )                                  !  ORCA_R4 configuration
-               !                                        ! =======================
-               ! Gibraltar enhancement of BBL
-               ij0 =  52   ;   ij1 =  52
-               ii0 =  70   ;   ii1 =  71  
-               zkx( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 4.e0 * zkx( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) )
-               zky( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 4.e0 * zky( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) )
-               
-            END SELECT
-            
-         ENDIF
-         
-         ! second derivative (divergence) and add to the general tracer trend
-#  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
-               ik = MAX( mbathy(ji,jj)-1, 1 )
-               zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,ik) )
-               ztra = (  zkx(ji,jj) - zkx(ji-1,jj  )    &
-                  &    + zky(ji,jj) - zky(ji  ,jj-1)  ) * zbtr
-               tra(ji,jj,ik,jn) = tra(ji,jj,ik,jn) + ztra
-#  if ! defined key_vectopt_loop
-            END DO
-#  endif
-         END DO
-
-         ! save the trends for diagnostic
-         IF( l_trdtrc ) THEN
-            ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:)
-            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd, jn, jptrc_trd_bbl, kt )
-         END IF
-         !                                                       ! ===========
-      END DO                                                     ! tracer loop
-      !                                                          ! ===========
-
-      IF( ln_ctl ) THEN    ! print mean trends (used for debugging)
-         WRITE(charout, FMT="('bbl - dif')")
-         CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+      IF( l_trdtrc )  THEN
+         ALLOCATE( ztrtrd(jpi,jpj,jpk,jptra) )   ! temporary save of trends
+         ztrtrd(:,:,:,:)  = tra(:,:,:,:)
       ENDIF
 
-   END SUBROUTINE trc_bbl_dif
+      !* Diffusive bbl :
+      IF( nn_bbl_ldf == 1 ) THEN
+         !
+         CALL tra_bbl_dif( trb, tra, jptra )  
+         IF( ln_ctl )   THEN
+            WRITE(charout, FMT="(' bbl_dif')")  ;  CALL prt_ctl_trc_info(charout)
+            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+         ENDIF
+         !
+      END IF
 
-# if defined key_trcbbl_adv
-   !!----------------------------------------------------------------------
-   !!   'key_trcbbl_adv'                    advective bottom boundary layer
-   !!----------------------------------------------------------------------
-#  include "trcbbl_adv.h90"
-# else
-   !!----------------------------------------------------------------------
-   !!   Default option :                 NO advective bottom boundary layer
-   !!----------------------------------------------------------------------
-   SUBROUTINE trc_bbl_adv (kt )              ! Empty routine
-      INTEGER, INTENT(in) :: kt
-      WRITE(*,*) 'trc_bbl_adv: You should not have seen this print! error?', kt
-   END SUBROUTINE trc_bbl_adv
-# endif
+      !* Advective bbl : bbl upstream advective trends added to the tracer trends
+      IF( nn_bbl_adv /= 0 ) THEN
+         !
+         CALL tra_bbl_adv( trb, tra, jptra )  
+         IF( ln_ctl )   THEN
+            WRITE(charout, FMT="(' bbl_adv')")  ;  CALL prt_ctl_trc_info(charout)
+            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+         ENDIF
+         !
+      END IF
 
-   SUBROUTINE trc_bbl_init
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE trc_bbl_init  ***
-      !!
-      !! ** Purpose :   Initialization for the bottom boundary layer scheme.
-      !!----------------------------------------------------------------------
-      INTEGER ::   ji, jj
-      REAL(wp),  DIMENSION(jpi,jpj) ::   zmbk  
-      !!----------------------------------------------------------------------
-
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            mbkt(ji,jj) = MAX( mbathy(ji,jj) - 1, 1 )   ! vertical index of the bottom ocean T-level
-         END DO
-      END DO
-      
-      DO jj = 1, jpjm1
-         DO ji = 1, jpim1
-            mbku(ji,jj) = MAX( MIN( mbathy(ji+1,jj  ), mbathy(ji,jj) ) - 1, 1 )
-            mbkv(ji,jj) = MAX( MIN( mbathy(ji  ,jj+1), mbathy(ji,jj) ) - 1, 1 )
-         END DO
-      END DO
-
-      zmbk(:,:) = FLOAT( mbku (:,:) )   
-      CALL lbc_lnk(zmbk,'U',1.)
-      mbku (:,:) = MAX( INT( zmbk(:,:) ), 1 ) 
-	
-      zmbk(:,:) = FLOAT( mbkv (:,:) )   
-      CALL lbc_lnk(zmbk,'V',1.)
-      mbkv (:,:) = MAX( INT( zmbk(:,:) ), 1 ) 
-
-# if defined key_trcbbl_adv
-      w_trc_bbl(:,:,:) = 0.e0    ! initialisation of w_trc_bbl to zero
-# endif
-
-   END SUBROUTINE trc_bbl_init
+      IF( l_trdtrc )   THEN                      ! save the horizontal diffusive trends for further diagnostics
+        DO jn = 1, jptra
+           ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn)
+           CALL trd_tra( kt, 'TRC', jn, jptra_trd_ldf, ztrtrd(:,:,:,jn) )
+        END DO
+        DEALLOCATE( ztrtrd )
+      ENDIF
+      !
+   END SUBROUTINE trc_bbl
 
 #else
@@ -542,15 +102,8 @@
    !!   Dummy module :                      No bottom boundary layer scheme
    !!----------------------------------------------------------------------
-   LOGICAL, PUBLIC, PARAMETER ::   lk_trcbbl_dif = .FALSE.   !: diff bbl flag
-   LOGICAL, PUBLIC, PARAMETER ::   lk_trcbbl_adv = .FALSE.   !: adv  bbl flag
 CONTAINS
-   SUBROUTINE trc_bbl_dif (kt )              ! Empty routine
-      INTEGER, INTENT(in) :: kt
-      WRITE(*,*) 'trc_bbl_dif: You should not have seen this print! error?', kt
-   END SUBROUTINE trc_bbl_dif
-   SUBROUTINE trc_bbl_adv (kt )              ! Empty routine
-      INTEGER, INTENT(in) :: kt
-      WRITE(*,*) 'trc_bbl_adv: You should not have seen this print! error?', kt
-   END SUBROUTINE trc_bbl_adv
+   SUBROUTINE trc_bbl( kt )              ! Empty routine
+      WRITE(*,*) 'tra_bbl: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_bbl
 #endif
 
Index: trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl_adv.h90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl_adv.h90	(revision 2527)
+++ 	(revision )
@@ -1,490 +1,0 @@
-   !!----------------------------------------------------------------------
-   !!                     ***  trcbbl_adv.h90  ***
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   TOP 1.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE trc_bbl_adv( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE trc_bbl_adv  ***
-      !!                   
-      !! ** Purpose :   Compute the before tracer trend associated 
-      !!     with the bottom boundary layer and add it to the general trend
-      !!     of tracer equations. The bottom boundary layer is supposed to be 
-      !!     both an advective and diffusive bottom boundary layer.
-      !!
-      !! ** Method  :   Computes the bottom boundary horizontal and vertical 
-      !!      advection terms. Add it to the general trend : tra =tra + adv_bbl.
-      !!        When the product grad( rho) * grad(h) < 0 (where grad is a
-      !!      along bottom slope gradient) an additional lateral 2nd order
-      !!      diffusion along the bottom slope is added to the general
-      !!      tracer trend, otherwise the additional trend is set to 0.
-      !!      Second order operator (laplacian type) with variable coefficient
-      !!      computed as follow for temperature (idem on s):
-      !!         difft = 1/(e1t*e2t*e3t) { di-1[ ahbt e2u*e3u/e1u di[ztb] ]
-      !!                                 + dj-1[ ahbt e1v*e3v/e2v dj[ztb] ] }
-      !!      where ztb is a 2D array: the bottom ocean te;perature and ahtb
-      !!      is a time and space varying diffusive coefficient defined by:
-      !!         ahbt = zahbp    if grad(rho).grad(h) < 0
-      !!              = 0.       otherwise.
-      !!      Note that grad(.) is the along bottom slope gradient. grad(rho)
-      !!      is evaluated using the local density (i.e. referenced at the
-      !!      local depth). Typical value of ahbt is 2000 m2/s (equivalent to
-      !!      a downslope velocity of 20 cm/s if the condition for slope
-      !!      convection is satified)
-      !!        Add this before trend to the general trend tra of the
-      !!      botton ocean tracer point:
-      !!              tra = tra + difft
-      !!
-      !! ** Action  : - update tra at the bottom level with the bottom
-      !!                boundary layer trend
-      !!
-      !! References :
-      !!     Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591.
-      !!
-      !! History :
-      !!   8.5  !  02-12  (A. de Miranda, G. Madec)  Original Code 
-      !!   9.0  !  04-01  (A. de Miranda, G. Madec, J.M. Molines )
-      !!   9.0  !  04-03  (C. Ethe) Adaptation for Passive tracers 
-      !!----------------------------------------------------------------------     
-      !gh
-      
-      !! * Arguments
-      INTEGER, INTENT( in ) ::   kt        ! ocean time-step 
-      
-      !! * Local declarations
-      INTEGER :: ji, jj, jk, jn            ! dummy loop indices
-      INTEGER :: ik, iku, ikv              ! temporary integers
-
-      REAL(wp) ::   &
-         zsign, zt, zs, zh, zalbet,     &  ! temporary scalars
-         zgdrho, zbtr, ztra                !    "         " 
-      REAL(wp), DIMENSION(jpi,jpj) ::   &  
-      	 ztnb, zsnb, zdep, ztrb  	   ! temporary workspace arrays 
-      REAL(wp), DIMENSION(jpi,jpj) ::   &  ! temporary workspace arrays
-         zalphax, zwu, zunb,            &  !    "                  "
-         zalphay, zwv, zvnb,            &  !    "                  "
-         zwx, zwy, zww, zwz,            &  !    "                  "
-         zti, zsi ,ztmin,ztmax, zsmin,zsmax!    "                  "
-	                           !    "                  "
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
-         zhdivn                            ! temporary workspace arrays
-      REAL(wp) ::   &
-         zfui, zfvj, zbt,  zsigna,  	&  ! temporary scalars
-	 iku1,iku2,ikv1,ikv2,  		&  ! temporary scalars
-	 ze3u,ze3v,  			&  ! temporary scalars
-	 z2,z2dtt           			! temporary scalars
-      REAL(wp) ::   &
-         fsalbt, pft, pfs, pfh             ! statement function
-      CHARACTER (len=22) :: charout
-      !!----------------------------------------------------------------------
-      ! ratio alpha/beta
-      ! ================
-      !  fsalbt: ratio of thermal over saline expension coefficients
-      !       pft :  potential temperature in degrees celcius
-      !       pfs :  salinity anomaly (s-35) in psu
-      !       pfh :  depth in meters
-
-      fsalbt( pft, pfs, pfh ) =                                              &
-         ( ( ( -0.255019e-07 * pft + 0.298357e-05 ) * pft                    &
-                                   - 0.203814e-03 ) * pft                    &
-                                   + 0.170907e-01 ) * pft                    &
-                                   + 0.665157e-01                            &
-         +(-0.678662e-05 * pfs - 0.846960e-04 * pft + 0.378110e-02 ) * pfs   &
-         +  ( ( - 0.302285e-13 * pfh                                         &
-                - 0.251520e-11 * pfs                                         &
-                + 0.512857e-12 * pft * pft          ) * pfh                  &
-                                     - 0.164759e-06   * pfs                  &
-             +(   0.791325e-08 * pft - 0.933746e-06 ) * pft                  &
-                                     + 0.380374e-04 ) * pfh
-      !!----------------------------------------------------------------------
-
-	IF( kt == nit000 )   CALL trc_bbl_init    ! initialization at first time-step
-	
-      ! 1. 2D fields of bottom temperature and salinity, and bottom slope
-      ! -----------------------------------------------------------------
-      ! mbathy= number of w-level, minimum value=1 (cf dommsk.F)
-
-#if defined key_vectopt_loop
-      jj = 1
-      DO ji = 1, jpij   ! vector opt. (forced unrolling)
-#else
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-#endif
-            ik = mbkt(ji,jj)                    ! index of the bottom ocean T-level
-            ztnb(ji,jj) = tn(ji,jj,ik)   	! masked now T at the ocean bottom 
-            zsnb(ji,jj) = sn(ji,jj,ik)  	! masked now S at the ocean bottom
-            zdep(ji,jj) = fsdept(ji,jj,ik)                 ! depth of the ocean bottom T-level
-!gh
-            zunb(ji,jj) = un(ji,jj,mbku(ji,jj)) 
-            zvnb(ji,jj) = vn(ji,jj,mbkv(ji,jj)) 
-#if ! defined key_vectopt_loop
-         END DO
-#endif
-      END DO
-
-      ! 2. Criteria of additional bottom diffusivity: grad(rho).grad(h)<0
-      ! --------------------------------------------
-      ! Sign of the local density gradient along the i- and j-slopes
-      ! multiplied by the slope of the ocean bottom
-
-      SELECT CASE ( nn_eos )
-
-      CASE ( 0 )               ! Jackett and McDougall (1994) formulation
-
-      DO jj = 1, jpjm1
-        DO ji = 1, fs_jpim1   ! vector opt.
-      !   ... temperature, salinity anomalie and depth
-          zt = 0.5 * ( ztnb(ji,jj) + ztnb(ji+1,jj) )
-          zs = 0.5 * ( zsnb(ji,jj) + zsnb(ji+1,jj) ) - 35.0
-          zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) )
-      !   ... masked ratio alpha/beta
-          zalbet = fsalbt( zt, zs, zh )*umask(ji,jj,1)
-      !   ... local density gradient along i-bathymetric slope
-          zgdrho = zalbet*( ztnb(ji+1,jj) - ztnb(ji,jj) )   &
-                     -    ( zsnb(ji+1,jj) - zsnb(ji,jj) )
-          zgdrho = zgdrho * umask(ji,jj,1)
-      !   ... sign of local i-gradient of density multiplied by the i-slope
-          zsign = SIGN( 0.5, -zgdrho     * ( zdep(ji+1,jj) - zdep(ji,jj) ) )
-	  zsigna= SIGN( 0.5, zunb(ji,jj) * ( zdep(ji+1,jj) - zdep(ji,jj) ) )
-          zalphax(ji,jj) = ( 0.5 + zsigna ) * ( 0.5-zsign ) * umask(ji,jj,1)
-        END DO
-      END DO
-
-      DO jj = 1, jpjm1
-        DO ji = 1, fs_jpim1   ! vector opt.
-      !   ... temperature, salinity anomalie and depth
-          zt = 0.5 * ( ztnb(ji,jj+1) + ztnb(ji,jj) )
-          zs = 0.5 * ( zsnb(ji,jj+1) + zsnb(ji,jj) ) - 35.0
-          zh = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) )
-      !   ... masked ratio alpha/beta
-          zalbet = fsalbt( zt, zs, zh )*vmask(ji,jj,1)
-      !   ... local density gradient along j-bathymetric slope
-          zgdrho = zalbet*( ztnb(ji,jj+1) - ztnb(ji,jj) )   &
-                     -    ( zsnb(ji,jj+1) - zsnb(ji,jj) )
-          zgdrho = zgdrho * vmask(ji,jj,1)
-      !   ... sign of local j-gradient of density multiplied by the j-slope
-          zsign = SIGN( 0.5, -zgdrho     * ( zdep(ji,jj+1) - zdep(ji,jj) ) )
-	  zsigna= SIGN( 0.5, zvnb(ji,jj) * ( zdep(ji,jj+1) - zdep(ji,jj) ) )
-          zalphay(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * vmask(ji,jj,1)
-        END DO
-      END DO
-
-
-      CASE ( 1 )               ! Linear formulation function of temperature only
-
-      DO jj = 1, jpjm1
-        DO ji = 1, fs_jpim1   ! vector opt.
-            ! temperature, salinity anomalie and depth
-            zt = 0.5 * ( ztnb(ji,jj) + ztnb(ji+1,jj) )
-            zs = 0.5 * ( zsnb(ji,jj) + zsnb(ji+1,jj) ) - 35.0
-            zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) )
-!gh            ! masked ratio alpha/beta
-            ! local density gradient along i-bathymetric slope
-            zgdrho =  ( ztnb(ji+1,jj) - ztnb(ji,jj) )   
-            ! sign of local i-gradient of density multiplied by the i-slope
-            zsign = SIGN( 0.5, - zgdrho    * ( zdep(ji+1,jj) - zdep(ji,jj) ) )
-	    zsigna= SIGN( 0.5, zunb(ji,jj) * ( zdep(ji+1,jj) - zdep(ji,jj) ) )
-            zalphax(ji,jj) = ( 0.5 - zsigna ) * ( 0.5 - zsign ) * umask(ji,jj,1)
-         END DO
-      END DO
-
-      DO jj = 1, jpjm1
-        DO ji = 1, fs_jpim1   ! vector opt.
-            ! temperature, salinity anomalie and depth
-            zt = 0.5 * ( ztnb(ji,jj+1) + ztnb(ji,jj) )
-            zs = 0.5 * ( zsnb(ji,jj+1) + zsnb(ji,jj) ) - 35.0
-            zh = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) )
-!gh             ! masked ratio alpha/beta
-            ! local density gradient along j-bathymetric slope
-            zgdrho =  ( ztnb(ji,jj+1) - ztnb(ji,jj) )   
-            ! sign of local j-gradient of density multiplied by the j-slope
-            zsign = SIGN( 0.5, -zgdrho     * ( zdep(ji,jj+1) - zdep(ji,jj) ) )
-	    zsigna= SIGN( 0.5, zvnb(ji,jj) * ( zdep(ji,jj+1) - zdep(ji,jj) ) )
-            zalphay(ji,jj) = ( 0.5 - zsigna ) * ( 0.5 - zsign ) * vmask(ji,jj,1)
-         END DO
-      END DO
-       
-      CASE ( 2 )               ! Linear formulation function of temperature and salinity
- DO jj = 1, jpjm1
-        DO ji = 1, fs_jpim1   ! vector opt.
-	    ! local density gradient along i-bathymetric slope
-            zgdrho = - ( rn_beta*( zsnb(ji+1,jj) - zsnb(ji,jj) )   &
-                     -  rn_alpha*( ztnb(ji+1,jj) - ztnb(ji,jj) ) )
-            ! sign of local i-gradient of density multiplied by the i-slope
-            zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) )
-	    zsigna= SIGN( 0.5, zunb(ji,jj)*(  zdep(ji+1,jj) - zdep(ji,jj) ))
-            zalphax(ji,jj)=(0.5-zsigna)*(0.5-zsign)*umask(ji,jj,1)
-        END DO
-      END DO
-
-      DO jj = 1, jpjm1
-        DO ji = 1, fs_jpim1   ! vector opt.
-	   ! local density gradient along j-bathymetric slope
-            zgdrho = - ( rn_beta*( zsnb(ji,jj+1) - zsnb(ji,jj) )   &
-                   -    rn_alpha*( ztnb(ji,jj+1) - ztnb(ji,jj) ) )   
-            ! sign of local j-gradient of density multiplied by the j-slope
-            zsign = SIGN( 0.5, -zgdrho     * ( zdep(ji,jj+1) - zdep(ji,jj) ) )  
-	    zsigna= SIGN( 0.5, zvnb(ji,jj) * ( zdep(ji,jj+1) - zdep(ji,jj) ) )
-            zalphay(ji,jj) = ( 0.5 - zsigna ) * ( 0.5 - zsign ) * vmask(ji,jj,1)
-         END DO
-      END DO
-
-       
-      CASE DEFAULT
-
-         IF(lwp) WRITE(numout,cform_err)
-         IF(lwp) WRITE(numout,*) '          bad flag value for nn_eos = ', nn_eos
-         nstop = nstop + 1
-
-      END SELECT
-
-      ! lateral boundary conditions on zalphax and zalphay   (unchanged sign)
-       CALL lbc_lnk( zalphax, 'U', 1. )   ;   CALL lbc_lnk( zalphay, 'V', 1. )
-
-
-      ! 3. Velocities that are exchanged between ajacent bottom boxes.
-      !---------------------------------------------------------------
-      ! ... is equal to zero but where bbl will work.
-       u_trc_bbl(:,:,:) = 0.e0
-       v_trc_bbl(:,:,:) = 0.e0
-       
-       
-!gh	  
-       IF( ln_zps ) THEN
-      ! partial steps correction   
-      
-#if defined key_vectopt_loop
-       jj = 1
-       DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
-#else
-       DO jj = 1, jpjm1
-          DO ji = 1, jpim1
-#endif
-             iku  = mbku(ji  ,jj  )
-             ikv  = mbkv(ji  ,jj  )  
-             iku1 = mbkt(ji+1,jj  )
-             iku2 = mbkt(ji  ,jj  )
-             ikv1 = mbkt(ji  ,jj+1)
-             ikv2 = mbkt(ji  ,jj  )
-             ze3u = MIN( fse3u(ji,jj,iku1), fse3u(ji,jj,iku2) ) 
-             ze3v = MIN( fse3v(ji,jj,ikv1), fse3v(ji,jj,ikv2) ) 
-             
-             IF( MAX(iku,ikv) >  1 ) THEN
-                u_trc_bbl(ji,jj,iku) = zalphax(ji,jj) * un(ji,jj,iku) * ze3u / fse3u(ji,jj,iku)
-                v_trc_bbl(ji,jj,ikv) = zalphay(ji,jj) * vn(ji,jj,ikv) * ze3v / fse3v(ji,jj,ikv)       
-             ENDIF
-#if ! defined key_vectopt_loop
-          END DO
-#endif
-       END DO
-
-      ! lateral boundary conditions on u_trc_bbl and v_trc_bbl   (changed sign)
-       CALL lbc_lnk( u_trc_bbl, 'U', -1. )   ;   CALL lbc_lnk( v_trc_bbl, 'V', -1. )
-       
-    ELSE    ! z-coordinate - full steps or s-coordinate	 
-       ! if not partial step loop over the whole domain no lbc call
-
-#if defined key_vectopt_loop
-      jj = 1
-      DO ji = 1, jpij   ! vector opt. (forced unrolling)
-#else
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-#endif
-            iku = mbku(ji,jj)
-            ikv = mbkv(ji,jj)
-            IF( MAX(iku,ikv) >  1 ) THEN
-               u_trc_bbl(ji,jj,iku) = zalphax(ji,jj) * un(ji,jj,iku) 
-               v_trc_bbl(ji,jj,ikv) = zalphay(ji,jj) * vn(ji,jj,ikv)       
-            ENDIF
-#if ! defined key_vectopt_loop
-         END DO
-#endif
-          END DO
-       
-       ENDIF
-       
-       DO jn = 1, jptra
-
-#if defined key_vectopt_loop
-          jj = 1
-          DO ji = 1, jpij   ! vector opt. (forced unrolling)
-#else
-          DO jj = 1, jpj
-             DO ji = 1, jpi
-#endif
-                ik = mbkt(ji,jj)                               ! index of the bottom ocean T-level
-                ztrb(ji,jj) = trb(ji,jj,ik,jn) * tmask(ji,jj,1)    ! masked now T at the ocean bottom 
-#if ! defined key_vectopt_loop
-             END DO
-#endif
-          END DO
-
-
-
-          ! 5. Along sigma advective trend
-          ! -------------------------------
-          ! ... Second order centered tracer flux at u and v-points
-       
-# if defined key_vectopt_loop
-          jj = 1
-          DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
-# else
-          DO jj = 1, jpjm1
-             DO ji = 1, jpim1
-# endif
-                iku = mbku(ji,jj)
-                ikv = mbkv(ji,jj)
-                zfui = e2u(ji,jj) * fse3u(ji,jj,iku) * u_trc_bbl(ji,jj,iku)
-                zfvj = e1v(ji,jj) * fse3v(ji,jj,ikv) * v_trc_bbl(ji,jj,ikv)
-                ! upstream scheme
-                zwx(ji,jj) = ( ( zfui + ABS( zfui ) ) * ztrb(ji  ,jj  )   &
-                   &          +( zfui - ABS( zfui ) ) * ztrb(ji+1,jj  ) ) * 0.5
-                zwy(ji,jj) = ( ( zfvj + ABS( zfvj ) ) * ztrb(ji  ,jj  )   &
-                   &          +( zfvj - ABS( zfvj ) ) * ztrb(ji  ,jj+1) ) * 0.5
-#if ! defined key_vectopt_loop
-             END DO
-#endif
-          END DO
-	  
-# 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
-                ik = mbkt(ji,jj)
-                zbtr = 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,ik) )
-                ! horizontal advective trends
-                ztra = - zbtr * (  zwx(ji,jj) - zwx(ji-1,jj  )   &
-                   &             + zwy(ji,jj) - zwy(ji  ,jj-1)  )
- 
-                ! add it to the general tracer trends
-                tra(ji,jj,ik,jn) = tra(ji,jj,ik,jn) + ztra
-#if ! defined key_vectopt_loop
-             END DO
-#endif
-          END DO
-	  
-        END DO
-	
-        IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
-         WRITE(charout, FMT="('bbl - adv')")
-         CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
-      ENDIF         
-       
-       ! 6. Vertical advection velocities
-       ! --------------------------------
-       ! ... computes divergence perturbation (velocties to be removed from upper t boxes :
-       DO jk= 1, jpkm1
-
-          DO jj=1, jpjm1
-             DO ji = 1, fs_jpim1   ! vertor opt.
-                zwu(ji,jj) = -e2u(ji,jj) * u_trc_bbl(ji,jj,jk) * fse3u(ji,jj,jk)
-                zwv(ji,jj) = -e1v(ji,jj) * v_trc_bbl(ji,jj,jk) * fse3v(ji,jj,jk)
-             END DO
-          END DO
-
-          ! ... horizontal divergence
-          DO jj = 2, jpjm1
-             DO ji = fs_2, fs_jpim1   ! vector opt.
-                zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
-                zhdivn(ji,jj,jk) = (  zwu(ji,jj) - zwu(ji-1,jj  )   &
-                   &                + zwv(ji,jj) - zwv(ji  ,jj-1)  ) / zbt
-             END DO
-          END DO
-       END DO
-
-
-       ! ... horizontal bottom divergence
-!gh
-       IF( ln_zps ) THEN 
-	  
-# if defined key_vectopt_loop
-          jj = 1
-          DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
-# else
-          DO jj = 1, jpjm1
-             DO ji = 1, jpim1
-# endif
-                iku  = mbku(ji  ,jj  )
-                ikv  = mbkv(ji  ,jj  )  
-                iku1 = mbkt(ji+1,jj  )
-                iku2 = mbkt(ji  ,jj  )
-                ikv1 = mbkt(ji  ,jj+1)
-                ikv2 = mbkt(ji  ,jj  )
-                ze3u = MIN( fse3u(ji,jj,iku1), fse3u(ji,jj,iku2) ) 
-                ze3v = MIN( fse3v(ji,jj,ikv1), fse3v(ji,jj,ikv2) ) 
-                
-                zwu(ji,jj) = zalphax(ji,jj) * e2u(ji,jj) * ze3u  
-                zwv(ji,jj) = zalphay(ji,jj) * e1v(ji,jj) * ze3v
-#if ! defined key_vectopt_loop
-             END DO
-#endif
-          END DO
-	
-       ELSE
-
-# if defined key_vectopt_loop
-          jj = 1
-          DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
-# else
-          DO jj = 1, jpjm1
-             DO ji = 1, jpim1
-# endif
-                iku = mbku(ji,jj)
-                ikv = mbkv(ji,jj)
-                zwu(ji,jj) = zalphax(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,iku) 
-                zwv(ji,jj) = zalphay(ji,jj) * e1v(ji,jj) * fse3v(ji,jj,ikv) 
-#if ! defined key_vectopt_loop 
-             END DO
-#endif
-          END DO
-       ENDIF
-
-# 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
-             ik = mbkt(ji,jj)
-             zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,ik)
-             zhdivn(ji,jj,ik) =   &
-                &   (  zwu(ji  ,jj  ) * ( zunb(ji  ,jj  ) - un(ji  ,jj  ,ik) )   &
-                &    - zwu(ji-1,jj  ) * ( zunb(ji-1,jj  ) - un(ji-1,jj  ,ik) )   &
-                &    + zwv(ji  ,jj  ) * ( zvnb(ji  ,jj  ) - vn(ji  ,jj  ,ik) )   &
-                &    - zwv(ji  ,jj-1) * ( zvnb(ji  ,jj-1) - vn(ji  ,jj-1,ik) )   &
-                &   ) / zbt
-
-# if ! defined key_vectopt_loop
-          END DO
-# endif
-       END DO
-
-       ! 7. compute additional vertical velocity to be used in t boxes
-       ! -------------------------------------------------------------
-       
-       ! ... Computation from the bottom
-       ! Note that w_trc_bbl(:,:,jpk) has been set to 0 in trc_bbl_init
-       DO jk = jpkm1, 1, -1
-          DO jj= 2, jpjm1
-             DO ji = fs_2, fs_jpim1   ! vector opt.
-                w_trc_bbl(ji,jj,jk) = w_trc_bbl(ji,jj,jk+1) - fse3t(ji,jj,jk)*zhdivn(ji,jj,jk)
-             END DO
-          END DO
-       END DO
-
-      ! Boundary condition on w_bbl   (unchanged sign)
-      CALL lbc_lnk( w_trc_bbl, 'W', 1. )
-
-   END SUBROUTINE trc_bbl_adv
Index: trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90	(revision 2528)
@@ -4,10 +4,10 @@
    !! Ocean physics: internal restoring trend on passive tracers
    !!======================================================================
-   !! History :  7.0  !         (G. Madec)  Original code
-   !!                 !  96-01  (G. Madec) 
-   !!                 !  97-05  (H. Loukos)  adapted for passive tracers
-   !!            8.5  !  02-08  (G. Madec )  free form + modules
-   !!            9.0  !  04-03  (C. Ethe)    free form + modules
-   !!                 !  07-02  (C. Deltel)  Diagnose ML trends for passive tracers
+   !! History :  OPA  !  1991-03  (O. Marti, G. Madec)  Original code
+   !!                 !  1996-01  (G. Madec) statement function for e3
+   !!                 !  1997-05  (H. Loukos)  adapted for passive tracers
+   !!    NEMO    9.0  !  2004-03  (C. Ethe)    free form + modules
+   !!            3.2  !  2007-02  (C. Deltel)  Diagnose ML trends for passive tracers
+   !!            3.3  !  2010-06  (C. Ethe, G. Madec) merge TRA-TRC 
    !!----------------------------------------------------------------------
 #if  defined key_top && defined key_trcdmp 
@@ -17,15 +17,12 @@
    !!   trc_dmp      : update the tracer trend with the internal damping
    !!   trc_dmp_init : initialization, namlist read, parameters control
-   !!   trccof_zoom  : restoring coefficient for zoom domain
-   !!   trccof       : restoring coefficient for global domain
-   !!   cofdis       : compute the distance to the coastline
    !!----------------------------------------------------------------------
    USE oce_trc         ! ocean dynamics and tracers variables
    USE trc             ! ocean passive tracers variables
-   USE trctrp_lec      ! passive tracers transport
+   USE trcnam_trp      ! passive tracers transport namelist variables
    USE trcdta
+   USE tradmp
    USE prtctl_trc      ! Print control for debbuging
-   USE trdmld_trc
-   USE trdmld_trc_oce     
+   USE trdtra
 
    IMPLICIT NONE
@@ -35,12 +32,20 @@
 
    LOGICAL , PUBLIC, PARAMETER ::   lk_trcdmp = .TRUE.   !: internal damping flag
-   REAL(wp), DIMENSION(jpi,jpj,jpk,jptra) ::   restotr   ! restoring coeff. on tracers (s-1)
+   !                             !!* Namelist namtrc_dmp : passive tracer newtonian damping *
+   INTEGER  ::   nn_hdmp_tr =   -1   ! = 0/-1/'latitude' for damping over passive tracer
+   INTEGER  ::   nn_zdmp_tr =    0   ! = 0/1/2 flag for damping in the mixed layer
+   REAL(wp) ::   rn_surf_tr =   50.  ! surface time scale for internal damping        [days]
+   REAL(wp) ::   rn_bot_tr  =  360.  ! bottom time scale for internal damping         [days]
+   REAL(wp) ::   rn_dep_tr  =  800.  ! depth of transition between rn_surf and rn_bot [meters]
+   INTEGER  ::   nn_file_tr =    2   ! = 1 create a damping.coeff NetCDF file 
+
+   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   restotr   ! restoring coeff. on tracers (s-1)
 
    !! * Substitutions
 #  include "top_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   TOP 1.0 , LOCEAN-IPSL (2005) 
+   !! 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 $ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -66,26 +71,23 @@
       !!              - save the trends ('key_trdmld_trc')
       !!----------------------------------------------------------------------
-      USE oce, ONLY :   ztrtrd => ua  ! use ua as 3D workspace   
       !!
       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+      !!
       INTEGER  ::   ji, jj, jk, jn       ! dummy loop indices
-      REAL(wp) ::   ztest, ztra !!!, zdt    ! temporary scalars
+      REAL(wp) ::   ztra                 ! temporary scalars
       CHARACTER (len=22) :: charout
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd
       !!----------------------------------------------------------------------
 
       ! 0. Initialization (first time-step only)
       !    --------------
-      IF( kt == nittrc000 ) CALL trc_dmp_init
-
+      IF( kt == nit000 ) CALL trc_dmp_init
+
+      IF( l_trdtrc )   ALLOCATE( ztrtrd(jpi,jpj,jpk) )   ! temporary save of trends
 
       ! 1. Newtonian damping trends on tracer fields
       ! --------------------------------------------
-      !    compute the newtonian damping trends depending on nmldmptr
-
-!!!      zdt  = rdt * FLOAT( ndttrc )
-
       ! Initialize the input fields for newtonian damping
-      CALL dta_trc( kt )
-
+      CALL trc_dta( kt )
       !                                                          ! ===========
       DO jn = 1, jptra                                           ! tracer loop
@@ -94,43 +96,30 @@
 
          IF( lutini(jn) ) THEN
-
-            SELECT CASE ( nmldmptr )
-
-            CASE( 0 )                ! newtonian damping throughout the water column
-
+            !
+            SELECT CASE ( nn_zdmp_trc )
+            !
+            CASE( 0 )                !==  newtonian damping throughout the water column  ==!
                DO jk = 1, jpkm1
                   DO jj = 2, jpjm1
                      DO ji = fs_2, fs_jpim1   ! vector opt.
-                        ztra = restotr(ji,jj,jk,jn) * ( trdta(ji,jj,jk,jn) - trb(ji,jj,jk,jn) )
-                        ! add the trends to the general tracer trends
-!!                        trn(ji,jj,jk,jn) = trn(ji,jj,jk,jn) + ztra * zdt
+                        ztra = restotr(ji,jj,jk) * ( trdta(ji,jj,jk,jn) - trb(ji,jj,jk,jn) )
                         tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
                      END DO
                   END DO
                END DO
-
-            CASE ( 1 )                ! no damping in the turbocline (avt > 5 cm2/s)
+            !
+            CASE ( 1 )                !==  no damping in the turbocline (avt > 5 cm2/s)  ==!
                DO jk = 1, jpkm1
                   DO jj = 2, jpjm1
                      DO ji = fs_2, fs_jpim1   ! vector opt.
-                        ztest = avt(ji,jj,jk) - 5.e-4
-                        IF( ztest < 0. ) THEN
-                           ztra = restotr(ji,jj,jk,jn) * ( trdta(ji,jj,jk,jn) - trb(ji,jj,jk,jn) )
-                        ELSE
-                           ztra = 0.e0
+                        IF( avt(ji,jj,jk) <= 5.e-4 )  THEN 
+                           ztra = restotr(ji,jj,jk) * ( trdta(ji,jj,jk,jn) - trb(ji,jj,jk,jn) )
+                           tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
                         ENDIF
-                        ! add the trends to the general tracer trends
-!!                        trn(ji,jj,jk,jn) = trn(ji,jj,jk,jn) + ztra * zdt
-                        tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 
-#    if defined key_trc_diatrd
-                        ! save the trends for diagnostics
-                        IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),jpdiatrc) = ztra
-#    endif
-
                      END DO
                   END DO
                END DO
-
-            CASE ( 2 )                ! no damping in the mixed layer 
+            !
+            CASE ( 2 )               !==  no damping in the mixed layer   ==! 
                DO jk = 1, jpkm1
                   DO jj = 2, jpjm1
@@ -138,39 +127,28 @@
                         IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN
                            ztra = restotr(ji,jj,jk,jn) * ( trdta(ji,jj,jk,jn) - trb(ji,jj,jk,jn) )
-                        ELSE
-                           ztra = 0.e0
-                        ENDIF
-                        ! add the trends to the general tracer trends
-!!                        trn(ji,jj,jk,jn) = trn(ji,jj,jk,jn) + ztra * zdt
-                        tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
-#    if defined key_trc_diatrd
-                        ! save the trends for diagnostics
-                        IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),jpdiatrc) = ztra
-#    endif
-
+                           tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
+                        END IF
                      END DO
                   END DO
                END DO
-               
+            !  
             END SELECT
-
+            ! 
          ENDIF
-
+         !
          IF( l_trdtrc ) THEN
             ztrtrd(:,:,:) = tra(:,:,:,jn) -  ztrtrd(:,:,:)
-            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd, jn, jptrc_trd_dmp, kt )        ! trends diags.
+            CALL trd_tra( kt, 'TRC', jn, jptra_trd_dmp, ztrtrd )
          END IF
          !                                                       ! ===========
       END DO                                                     ! tracer loop
       !                                                          ! ===========
-
-      IF( ln_ctl ) THEN    ! print mean trends (used for debugging)
-         WRITE(charout, FMT="('dmp')")
-         CALL prt_ctl_trc_info( charout )
-         CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd' )
+      IF( l_trdtrc )  DEALLOCATE( ztrtrd )
+      !                                          ! print mean trends (used for debugging)
+      IF( ln_ctl )   THEN
+         WRITE(charout, FMT="('dmp ')") ;  CALL prt_ctl_trc_info(charout)
+                                           CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
       ENDIF
-  
-      trb(:,:,:,:) = trn(:,:,:,:)
-   
+      !
    END SUBROUTINE trc_dmp
 
@@ -186,644 +164,34 @@
       !!----------------------------------------------------------------------
 
-      SELECT CASE ( ndmptr )
-
-      CASE ( -1 )               ! ORCA: damping in Red & Med Seas only
-         IF(lwp) WRITE(numout,*) '          tracer damping in the Med & Red seas only'
-
-      CASE ( 1:90 )             ! Damping poleward of 'ndmptr' degrees
-         IF(lwp) WRITE(numout,*) '          tracer damping poleward of', ndmptr, ' degrees'
-
+      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 ndmptr = ', ndmptr
+         WRITE(ctmp1,*) '          bad flag value for nn_hdmp_tr = ', nn_hdmp_tr
          CALL ctl_stop(ctmp1)
-
       END SELECT
 
-
-      SELECT CASE ( nmldmptr )
-
-      CASE ( 0 )                ! newtonian damping throughout the water column
-         IF(lwp) WRITE(numout,*) '          tracer damping throughout the water column'
-
-      CASE ( 1 )                ! no damping in the turbocline (avt > 5 cm2/s)
-         IF(lwp) WRITE(numout,*) '          no tracer damping in the turbocline'
-
-      CASE ( 2 )                ! no damping in the mixed layer 
-         IF(lwp) WRITE(numout,*) '          no tracer damping in the mixed layer'
-
+      SELECT CASE ( nn_zdmp_tr )
+      CASE ( 0 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping throughout the water column'
+      CASE ( 1 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the turbocline (avt > 5 cm2/s)'
+      CASE ( 2 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixed layer'
       CASE DEFAULT
-         WRITE(ctmp1,*) '          bad flag value for nmldmptr = ', nmldmptr
+         WRITE(ctmp1,*) 'bad flag value for nn_zdmp_tr = ', nn_zdmp_tr
          CALL ctl_stop(ctmp1)
-
       END SELECT
 
-      ! Damping coefficients initialization
-      ! -----------------------------------
-      IF( lzoom ) THEN
-         CALL trccof_zoom
-      ELSE
-         CALL trccof
+      IF( .NOT. lk_dtatrc )   &
+         &   CALL ctl_stop( 'no passive tracer data define key_dtatrc' )
+
+      IF( .NOT. lk_tradmp )   &
+         &   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
- 
+      !
    END SUBROUTINE trc_dmp_init
-
-
-   SUBROUTINE trccof_zoom
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE trccof_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  : - restotr, the damping coeff. passive tracers
-      !!
-      !! History :
-      !!   9.0  !  03-09  (G. Madec)  Original code
-      !!   9.0  !  04-03  (C. Ethe)   adapted for passive tracers
-      !!----------------------------------------------------------------------
-      !! * Local declarations
-      INTEGER ::   ji, jj, jk, jn       ! dummy loop indices
-      REAL(wp) ::   &
-         zlat, zlat0, zlat1, zlat2     ! temporary scalar
-      REAL(wp), DIMENSION(6)  ::   &
-         zfact                         ! temporary workspace
-      !!----------------------------------------------------------------------
-
-      zfact(1) =  1.
-      zfact(2) =  1. 
-      zfact(3) = 11./12.
-      zfact(4) =  8./12.
-      zfact(5) =  4./12.
-      zfact(6) =  1./12.
-      zfact(:) = zfact(:) / ( 5. * rday )    ! 5 days max restoring time scale
-
-      restotr(:,:,:,:) = 0.e0
-
-      ! damping along the forced closed boundary over 6 grid-points
-      DO jn = 1, 6
-         IF( lzoom_w )   restotr( mi0(jn+jpizoom):mi1(jn+jpizoom), : , : , : ) = zfact(jn) ! west  closed
-         IF( lzoom_s )   restotr( : , mj0(jn+jpjzoom):mj1(jn+jpjzoom), : , : ) = zfact(jn) ! south closed 
-         IF( lzoom_e )   restotr( mi0(jpiglo+jpizoom-1-jn):mi1(jpiglo+jpizoom-1-jn) , : , : , : ) &
-                       &              = zfact(jn)                                 ! east  closed 
-         IF( lzoom_n )   restotr( : , mj0(jpjglo+jpjzoom-1-jn):mj1(jpjglo+jpjzoom-1-jn) , : , : ) &
-                       &              = zfact(jn)                                 ! north closed
-      END DO
-
-
-      IF( lzoom_arct .AND. lzoom_anta ) THEN
-
-         ! ====================================================
-         !  ORCA configuration : arctic zoom or antarctic zoom
-         ! ====================================================
-
-         IF(lwp) WRITE(numout,*)
-         IF(lwp .AND. lzoom_arct ) WRITE(numout,*) '              trccof_zoom : ORCA    Arctic zoom'
-         IF(lwp .AND. lzoom_arct ) WRITE(numout,*) '              trccof_zoom : ORCA Antarctic zoom'
-         IF(lwp) WRITE(numout,*)
-
-         ! ... Initialization : 
-         !     zlat0 : latitude strip where resto decreases
-         !     zlat1 : resto = 1 before zlat1
-         !     zlat2 : resto decreases from 1 to 0 between zlat1 and zlat2
-         restotr(:,:,:,:) = 0.e0
-         zlat0 = 10.
-         zlat1 = 30.
-         zlat2 = zlat1 + zlat0
-
-         ! ... Compute arrays resto ; value for internal damping : 5 days
-         DO jn = 1, jptra
-            DO jk = 2, jpkm1 
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     zlat = ABS( gphit(ji,jj) )
-                     IF ( zlat1 <= zlat .AND. zlat <= zlat2 ) THEN
-                        restotr(ji,jj,jk,jn) = 0.5 * ( 1./(5.*rday) ) *   &
-                           ( 1. - COS(rpi*(zlat2-zlat)/zlat0) ) 
-                     ELSE IF ( zlat < zlat1 ) THEN
-                        restotr(ji,jj,jk,jn) = 1./(5.*rday)
-                     ENDIF
-                  END DO
-               END DO
-            END DO
-         END DO
-
-      ENDIF
-
-      ! ... Mask resto array
-        DO jn = 1, jptra
-           restotr(:,:,:,jn) = restotr(:,:,:,jn) * tmask(:,:,:)
-        END DO
-
-
-   END SUBROUTINE trccof_zoom
-
-   SUBROUTINE trccof
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE trccof  ***
-      !!
-      !! ** Purpose :   Compute the damping coefficient
-      !!
-      !! ** Method  :   Arrays defining the damping are computed for each grid
-      !!      point passive tracers (restotr)
-      !!      Damping depends on distance to coast, depth and latitude
-      !!
-      !! ** Action  : - restotr, the damping coeff. for passive tracers
-      !!
-      !! History :
-      !!   5.0  !  91-03  (O. Marti, G. Madec)  Original code
-      !!        !  92-06  (M. Imbard)  doctor norme
-      !!        !  96-01  (G. Madec) statement function for e3
-      !!        !  98-07  (M. Imbard, G. Madec) ORCA version
-      !!        !  00-08  (G. Madec, D. Ludicone) 
-      !!   8.2  !  04-03  (H. Loukos) adapted for passive tracers
-      !!        !  04-02  (O. Aumont, C. Ethe) rewritten for debuging and update
-      !!----------------------------------------------------------------------
-      !! * Modules used
-      USE iom
-      USE ioipsl
-
-      !! * Local declarations
-      INTEGER ::  ji, jj, jk, jn    ! dummy loop indices
-      INTEGER ::   itime
-      INTEGER ::  ii0, ii1, ij0, ij1  !    "          "
-      INTEGER ::   &
-         idmp,     &  ! logical unit for file restoring damping term
-         icot         ! logical unit for file distance to the coast
-
-      CHARACTER (len=32) ::   clname3
-      REAL(wp) ::   &
-         zdate0, zinfl, zlon,         & ! temporary scalars
-         zlat, zlat0, zlat1, zlat2,   & !    "         "
-         zsdmp, zbdmp                   !    "         "
-      REAL(wp), DIMENSION(jpk) ::   &
-         gdept, zhfac
-      REAL(wp), DIMENSION(jpi,jpj) ::   &
-         zmrs
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
-         zdct
-      !!----------------------------------------------------------------------
-
-      ! ====================================
-      !  ORCA configuration : global domain
-      ! ====================================
-
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) '              trccof : Global domain of ORCA'
-      IF(lwp) WRITE(numout,*) '              ------------------------------'
-
-
-      ! ... Initialization : 
-      !   zdct()      : distant to the coastline
-      !   resto()     : array of restoring coeff. 
-      
-      zdct (:,:,:) = 0.e0
-      restotr(:,:,:,:) = 0.e0
-
-
-      IF ( ndmptr > 0 ) THEN
-
-         !    ------------------------------------
-         !     Damping poleward of 'ndmptr' degrees
-         !    ------------------------------------
-
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) '              Damping poleward of ', ndmptr,' deg.'
-         IF(lwp) WRITE(numout,*)
-
-         ! ... Distance to coast (zdct)
-
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) ' dtacof : distance to coast file'
-         CALL iom_open ( 'dist.coast.trc.nc', icot )
-         IF( icot > 0 ) THEN
-            CALL iom_get ( icot, jpdom_data, 'Tcoast', zdct )
-            CALL iom_close (icot)
-         ELSE
-            !   ... Compute and save the distance-to-coast array (output in zdct)
-            CALL cofdis( zdct )
-         ENDIF
-
-
-         ! ... Compute arrays resto 
-         !      zinfl : distance of influence for damping term
-         !      zlat0 : latitude strip where resto decreases
-         !      zlat1 : resto = 0 between -zlat1 and zlat1
-         !      zlat2 : resto increases from 0 to 1 between |zlat1| and |zlat2|
-         !          and resto = 1 between |zlat2| and 90 deg.
-         zinfl = 1000.e3
-         zlat0 = 10
-         zlat1 = ndmptr
-         zlat2 = zlat1 + zlat0
-
-         DO jn = 1, jptra
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zlat = ABS( gphit(ji,jj) )
-                  IF ( zlat1 <= zlat .AND. zlat <= zlat2 ) THEN
-                     restotr(ji,jj,1,jn) = 0.5 * ( 1. - COS(rpi*(zlat-zlat1)/zlat0 ) )
-                  ELSEIF ( zlat > zlat2 ) THEN
-                     restotr(ji,jj,1,jn) = 1.
-                  ENDIF
-               END DO
-            END DO
-         END DO
-
-         !   ... North Indian ocean (20N/30N x 45E/100E) : resto=0
-         IF ( ndmptr == 20 ) THEN
-            DO jn = 1, jptra
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     zlat = gphit(ji,jj)
-                     zlon = MOD( glamt(ji,jj), 360. )
-                     IF ( zlat1 < zlat .AND. zlat < zlat2 .AND.   &
-                        45.  < zlon .AND. zlon < 100. ) THEN
-                        restotr(ji,jj,1,jn) = 0.
-                     ENDIF
-                  END DO
-               END DO
-            END DO
-         ENDIF
-
-         zsdmp = 1./(sdmptr * rday)
-         zbdmp = 1./(bdmptr * rday)
-         DO jn = 1, jptra
-            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
-                     restotr(ji,jj,jk,jn) = restotr(ji,jj,1,jn)*0.5   &
-                        &                 * ( 1. - COS( rpi*zdct(ji,jj,jk)/zinfl) )
-
-                     !   ... Vertical variation from zsdmp (sea surface) to zbdmp (bottom)
-                     restotr(ji,jj,jk,jn) = restotr(ji,jj,jk,jn)   &
-                        &                 * ( zbdmp + (zsdmp-zbdmp)*EXP(-fsdept(ji,jj,jk)/hdmptr) )
-                  END DO
-               END DO
-            END DO
-         END DO
-
-      ENDIF
-
-
-      IF( cp_cfg == "orca" .AND. ( ndmptr > 0 .OR. ndmptr == -1 ) ) THEN
-
-         !                                         ! =========================
-         !                                         !  Med and Red Sea damping
-         !                                         ! =========================
-         IF(lwp)WRITE(numout,*)
-         IF(lwp)WRITE(numout,*) '              ORCA configuration: Damping in Med and Red Seas'
-
-
-         zmrs(:,:) = 0.e0                             ! damping term on the Med or Red Sea
-
-         SELECT CASE ( jp_cfg )
-            !                                           ! =======================
-         CASE ( 4 )                                     !  ORCA_R4 configuration 
-            !                                           ! =======================
-
-            ! Mediterranean Sea
-            ij0 =  50   ;   ij1 =  56
-            ii0 =  81   ;   ii1 =  91   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0
-            ij0 =  50   ;   ij1 =  55
-            ii0 =  75   ;   ii1 =  80   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0
-            ij0 =  52   ;   ij1 =  53
-            ii0 =  70   ;   ii1 =  74   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0
-            ! 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*( 1.- COS( rpi*(jk-1)/16. ) ) / rday
-            END DO
-            DO jk = 18, jpkm1
-               zhfac (jk) = 1./rday
-            END DO
-
-            !                                        ! =======================
-         CASE ( 2 )                                  !  ORCA_R2 configuration 
-            !                                        ! =======================
-
-            ! Mediterranean Sea
-            ij0 =  96   ;   ij1 = 110
-            ii0 = 157   ;   ii1 = 181   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0
-            ij0 = 100   ;   ij1 = 110
-            ii0 = 144   ;   ii1 = 156   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0
-            ij0 = 100   ;   ij1 = 103
-            ii0 = 139   ;   ii1 = 143   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0
-            ! Decrease before Gibraltar Strait
-            ij0 = 101   ;   ij1 = 102
-            ii0 = 139   ;   ii1 = 141   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.e0
-            ii0 = 142   ;   ii1 = 142   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0 / 90.e0
-            ii0 = 143   ;   ii1 = 143   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40e0
-            ii0 = 144   ;   ii1 = 144   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.75e0
-            ! Red Sea
-            ij0 =  87   ;   ij1 =  96
-            ii0 = 147   ;   ii1 = 163   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0
-            ! Decrease before Bab el Mandeb Strait
-            ij0 =  91   ;   ij1 =  91
-            ii0 = 153   ;   ii1 = 160   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.80e0
-            ij0 =  90   ;   ij1 =  90
-            ii0 = 153   ;   ii1 = 160   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40e0
-            ij0 =  89   ;   ij1 =  89
-            ii0 = 158   ;   ii1 = 160   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0 / 90.e0
-            ij0 =  88   ;   ij1 =  88
-            ii0 = 160   ;   ii1 = 163   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.e0
-            ! 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*( 1.- COS( rpi*(jk-1)/16. ) ) / rday
-            END DO
-            DO jk = 18, jpkm1
-               zhfac (jk) = 1./rday
-            END DO
-
-            !                                        ! =======================
-         CASE ( 05 )                                 !  ORCA_R05 configuration
-            !                                        ! =======================
-
-            ! Mediterranean Sea
-            ii0 = 568   ;   ii1 = 574 
-            ij0 = 324   ;   ij1 = 333   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0
-            ii0 = 575   ;   ii1 = 658
-            ij0 = 314   ;   ij1 = 366   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0
-            ! Black Sea (remaining part
-            ii0 = 641   ;   ii1 = 651
-            ij0 = 367   ;   ij1 = 372   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0
-            ! Decrease before Gibraltar Strait
-            ii0 = 324   ;   ii1 = 333
-            ij0 = 565   ;   ij1 = 565   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0 / 90.e0
-            ij0 = 566   ;   ij1 = 566   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40
-            ij0 = 567   ;   ij1 = 567   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.75
-            ! Red Sea
-            ii0 = 641   ;   ii1 = 665
-            ij0 = 270   ;   ij1 = 310   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0
-            ! Decrease before Bab el Mandeb Strait
-            ii0 = 666   ;   ii1 = 675
-            ij0 = 270   ;   ij1 = 290   
-            DO ji = mi0(ii0), mi1(ii1)
-               zmrs( ji , mj0(ij0):mj1(ij1) ) = 0.1 * ABS( FLOAT(ji - mi1(ii1)) )
-            END DO
-            zsdmp = 1./(sdmptr * rday)
-            zbdmp = 1./(bdmptr * rday)
-            DO jk = 1, jpk
-               zhfac (jk) = ( zbdmp + (zsdmp-zbdmp) * EXP(-fsdept(1,1,jk)/hdmptr) )
-            END DO
-
-            !                                       ! ========================
-         CASE ( 025 )                               !  ORCA_R025 configuration 
-
-            CALL ctl_stop( ' Not yet implemented in ORCA_R025' ) 
-
-         END SELECT
-
-         DO jn = 1, jptra
-            DO jk = 1, jpkm1
-               restotr(:,:,jk,jn) = zmrs(:,:) * zhfac(jk) + ( 1. - zmrs(:,:) ) * restotr(:,:,jk,jn)
-            END DO
-
-            ! Mask resto array and set to 0 first and last levels
-            restotr(:,:, : ,jn) = restotr(:,:,:,jn) * tmask(:,:,:)
-            restotr(:,:, 1 ,jn) = 0.e0
-            restotr(:,:,jpk,jn) = 0.e0
-         END DO
-
-      ELSE
-         !    ------------
-         !     No damping
-         !    ------------
-         CALL ctl_stop( 'Choose a correct value of ndmp or DO NOT defined key_tradmp' )
-
-      ENDIF
-
-        !    ----------------------------
-         !     Create Print damping array
-         !    ----------------------------
-         
-         ! ndmpftr   : = 1 create a damping.coeff NetCDF file
-
-      IF( ndmpftr == 1 ) THEN
-         DO jn = 1, jptra
-            IF(lwp) WRITE(numout,*) '  create damping.coeff.nc file  ',jn
-            itime   = 0
-            clname3 = 'damping.coeff'//ctrcnm(jn)
-            CALL ymds2ju( 0     , 1     , 1      , 0.e0 , zdate0 )
-            CALL restini( 'NONE', jpi   , jpj    , glamt, gphit,    &
-           &              jpk   , gdept , clname3, itime, zdate0,   &
-           &              rdt   , idmp  , domain_id=nidom)
-            CALL restput( idmp, 'Resto', jpi, jpj, jpk, 0 , restotr(:,:,:,jn)  )
-            CALL restclo( idmp )
-         END DO
-      ENDIF
-
-
-   END SUBROUTINE trccof
-
-
-   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 'trc.dist.coast.nc' 
-      !!        
-      !! History :
-      !!   7.0  !  01-02  (M. Imbard)  Original code
-      !!   8.1  !  01-02  (G. Madec, E. Durand)
-      !!   8.5  !  02-08  (G. Madec, E. Durand)  Free form, F90
-      !!----------------------------------------------------------------------
-      !! * Modules used
-      USE ioipsl
-
-      !! * Arguments
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) ::   &
-         pdct                     ! distance to the coastline
-
-      !! * local declarations
-      INTEGER :: ji, jj, jk, jl      ! dummy loop indices
-      INTEGER :: iju, ijt            ! temporary integers
-      INTEGER :: icoast, itime
-      INTEGER ::   &
-         icot         ! logical unit for file distance to the coast
-      LOGICAL, DIMENSION(jpi,jpj) ::   &
-         llcotu, llcotv, llcotf   ! ???
-      CHARACTER (len=32) ::   clname
-      REAL(wp) ::   zdate0
-      REAL(wp), DIMENSION(jpi,jpj) ::   &
-         zxt, zyt, zzt,                 &  ! cartesian coordinates for T-points
-         zmask                             
-      REAL(wp), DIMENSION(3*jpi*jpj) ::   &
-         zxc, zyc, zzc, zdis      ! temporary workspace
-      !!----------------------------------------------------------------------
-
-      ! 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.e0
-      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. ) 
-               llcotv(ji,jj) = ( tmask(ji,jj  ,jk) + tmask(ji  ,jj+1,jk) == 1. ) 
-               llcotf(ji,jj) = ( zmask(ji,jj) > 0. ) .AND. ( zmask(ji,jj) < 4. )
-            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,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,jpjm1) = llcotu(iju,jpjm1)
-            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( nperio == 5 .OR. nperio == 6 ) THEN
-            DO ji = 1, jpim1
-               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,jpjm1) = llcotf(iju,jpjm1)
-            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,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. ) THEN
-                  pdct(ji,jj,jk) = 0.
-               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 = 'trc.dist.coast'
-      itime = 0
-      CALL ymds2ju( 0     , 1     , 1     , 0.e0 , zdate0 )
-      CALL restini( 'NONE', jpi   , jpj   , glamt, gphit ,   &
-                    jpk   , gdept , clname, itime, zdate0,   &
-                    rdt   , icot , domain_id=nidom         )
-      CALL restput( icot, 'Tcoast', jpi, jpj, jpk, 0, pdct )
-      CALL restclo( icot )
-
-   END SUBROUTINE cofdis
-
 #else
    !!----------------------------------------------------------------------
@@ -837,5 +205,4 @@
    END SUBROUTINE trc_dmp
 #endif
-
    !!======================================================================
 END MODULE trcdmp
Index: trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90	(revision 2528)
@@ -0,0 +1,224 @@
+MODULE trcldf
+   !!======================================================================
+   !!                       ***  MODULE  trcldf  ***
+   !! Ocean Passive tracers : lateral diffusive trends 
+   !!=====================================================================
+   !! History :  9.0  ! 2005-11 (G. Madec)  Original code
+   !!       NEMO 3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA 
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   trc_ldf     : update the tracer trend with the lateral diffusion
+   !!       ldf_ctl : initialization, namelist read, and parameters control
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! ocean dynamics and active tracers
+   USE trc             ! ocean passive tracers variables
+   USE trcnam_trp      ! passive tracers transport namelist variables
+   USE ldftra_oce      ! lateral diffusion coefficient on tracers
+   USE ldfslp          ! ???
+   USE traldf_bilapg   ! lateral mixing            (tra_ldf_bilapg routine)
+   USE traldf_bilap    ! lateral mixing            (tra_ldf_bilap routine)
+   USE traldf_iso      ! lateral mixing            (tra_ldf_iso routine)
+   USE traldf_lap      ! lateral mixing            (tra_ldf_lap routine)
+   USE trdmod_oce
+   USE trdtra
+   USE prtctl_trc      ! Print control
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! distribued memory computing library
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_ldf    ! called by step.F90 
+   !                                                 !!: ** lateral mixing namelist (nam_trcldf) **
+   INTEGER ::   nldf = 0   ! type of lateral diffusion used defined from ln_trcldf_... namlist logicals)
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_ldf( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_ldf  ***
+      !! 
+      !! ** Purpose :   compute the lateral ocean tracer physics.
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      !!
+      INTEGER            :: jn
+      CHARACTER (len=22) :: charout
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   ztrtrd
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 )   CALL ldf_ctl          ! initialisation & control of options
+
+      IF( l_trdtrc )  THEN 
+         ALLOCATE( ztrtrd(jpi,jpj,jpk,jptra) )  ! temporary save of trends
+         ztrtrd(:,:,:,:)  = tra(:,:,:,:)
+      ENDIF
+
+      SELECT CASE ( nldf )                       ! compute lateral mixing trend and add it to the general trend
+      CASE ( 0 )   ;   CALL tra_ldf_lap   ( kt, 'TRC', gtru, gtrv, trb, tra, jptra            )  ! iso-level laplacian
+      CASE ( 1 )   ;   CALL tra_ldf_iso   ( kt, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 )  ! rotated laplacian 
+      CASE ( 2 )   ;   CALL tra_ldf_bilap ( kt, 'TRC', gtru, gtrv, trb, tra, jptra            )  ! iso-level bilaplacian
+      CASE ( 3 )   ;   CALL tra_ldf_bilapg( kt, 'TRC',             trb, tra, jptra            )  ! s-coord. horizontal bilaplacian
+         !
+      CASE ( -1 )                                     ! esopa: test all possibility with control print
+         CALL tra_ldf_lap   ( kt, 'TRC', gtru, gtrv, trb, tra, jptra            )
+         WRITE(charout, FMT="('ldf0 ')") ;  CALL prt_ctl_trc_info(charout)
+                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+         CALL tra_ldf_iso   ( kt, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 )
+         WRITE(charout, FMT="('ldf1 ')") ;  CALL prt_ctl_trc_info(charout)
+                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+         CALL tra_ldf_bilap ( kt, 'TRC', gtru, gtrv, trb, tra, jptra            )
+         WRITE(charout, FMT="('ldf2 ')") ;  CALL prt_ctl_trc_info(charout)
+                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+         CALL tra_ldf_bilapg( kt, 'TRC',             trb, tra, jptra            )
+         WRITE(charout, FMT="('ldf3 ')") ;  CALL prt_ctl_trc_info(charout)
+                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+      END SELECT
+      !
+      IF( l_trdtrc )   THEN                      ! save the horizontal diffusive trends for further diagnostics
+        DO jn = 1, jptra
+           ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn)
+           CALL trd_tra( kt, 'TRC', jn, jptra_trd_ldf, ztrtrd(:,:,:,jn) )
+        END DO
+        DEALLOCATE( ztrtrd ) 
+      ENDIF
+      !                                          ! print mean trends (used for debugging)
+      IF( ln_ctl )   THEN
+         WRITE(charout, FMT="('ldf ')") ;  CALL prt_ctl_trc_info(charout)
+                                           CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+      ENDIF
+      !
+   END SUBROUTINE trc_ldf
+
+
+   SUBROUTINE ldf_ctl
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_ctl  ***
+      !! 
+      !! ** Purpose :   Choice of the operator for the lateral tracer diffusion
+      !!
+      !! ** Method  :   set nldf from the namtra_ldf logicals
+      !!      nldf == -2   No lateral diffusion  
+      !!      nldf == -1   ESOPA test: ALL operators are used
+      !!      nldf ==  0   laplacian operator
+      !!      nldf ==  1   Rotated laplacian operator
+      !!      nldf ==  2   bilaplacian operator
+      !!      nldf ==  3   Rotated bilaplacian
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio, ierr         ! temporary integers 
+      !!----------------------------------------------------------------------
+
+      !  Define the lateral mixing oparator for tracers
+      ! ===============================================
+    
+      !                               ! control the input
+      ioptio = 0
+      IF( ln_trcldf_lap   )   ioptio = ioptio + 1
+      IF( ln_trcldf_bilap )   ioptio = ioptio + 1
+      IF( ioptio >  1 )   CALL ctl_stop( '          use ONE or NONE of the 2 lap/bilap operator type on tracer' )
+      IF( ioptio == 0 )   nldf = -2   ! No lateral diffusion
+      ioptio = 0
+      IF( ln_trcldf_level )   ioptio = ioptio + 1
+      IF( ln_trcldf_hor   )   ioptio = ioptio + 1
+      IF( ln_trcldf_iso   )   ioptio = ioptio + 1
+      IF( ioptio /= 1 )   CALL ctl_stop( '          use only ONE direction (level/hor/iso)' )
+
+      ! defined the type of lateral diffusion from ln_trcldf_... logicals
+      ! CAUTION : nldf = 1 is used in trazdf_imp, change it carefully
+      ierr = 0
+      IF( ln_trcldf_lap ) THEN       ! laplacian operator
+         IF ( ln_zco ) THEN                ! z-coordinate
+            IF ( ln_trcldf_level )   nldf = 0      ! iso-level  (no rotation)
+            IF ( ln_trcldf_hor   )   nldf = 0      ! horizontal (no rotation)
+            IF ( ln_trcldf_iso   )   nldf = 1      ! isoneutral (   rotation)
+         ENDIF
+         IF ( ln_zps ) THEN             ! z-coordinate
+            IF ( ln_trcldf_level )   ierr = 1      ! iso-level not allowed
+            IF ( ln_trcldf_hor   )   nldf = 0      ! horizontal (no rotation)
+            IF ( ln_trcldf_iso   )   nldf = 1      ! isoneutral (   rotation)
+         ENDIF
+         IF ( ln_sco ) THEN             ! z-coordinate
+            IF ( ln_trcldf_level )   nldf = 0      ! iso-level  (no rotation)
+            IF ( ln_trcldf_hor   )   nldf = 1      ! horizontal (   rotation)
+            IF ( ln_trcldf_iso   )   nldf = 1      ! isoneutral (   rotation)
+         ENDIF
+      ENDIF
+
+      IF( ln_trcldf_bilap ) THEN      ! bilaplacian operator
+         IF ( ln_zco ) THEN                ! z-coordinate
+            IF ( ln_trcldf_level )   nldf = 2      ! iso-level  (no rotation)
+            IF ( ln_trcldf_hor   )   nldf = 2      ! horizontal (no rotation)
+            IF ( ln_trcldf_iso   )   ierr = 2      ! isoneutral (   rotation)
+         ENDIF
+         IF ( ln_zps ) THEN             ! z-coordinate
+            IF ( ln_trcldf_level )   ierr = 1      ! iso-level not allowed 
+            IF ( ln_trcldf_hor   )   nldf = 2      ! horizontal (no rotation)
+            IF ( ln_trcldf_iso   )   ierr = 2      ! isoneutral (   rotation)
+         ENDIF
+         IF ( ln_sco ) THEN             ! z-coordinate
+            IF ( ln_trcldf_level )   nldf = 2      ! iso-level  (no rotation)
+            IF ( ln_trcldf_hor   )   nldf = 3      ! horizontal (   rotation)
+            IF ( ln_trcldf_iso   )   ierr = 2      ! isoneutral (   rotation)
+         ENDIF
+      ENDIF
+
+      IF( ierr == 1 )   CALL ctl_stop( ' iso-level in z-coordinate - partial step, not allowed' )
+      IF( ierr == 2 )   CALL ctl_stop( ' isoneutral bilaplacian operator does not exist' )
+      IF( lk_traldf_eiv .AND. .NOT.ln_trcldf_iso )   &
+           CALL ctl_stop( '          eddy induced velocity on tracers',   &
+           &              ' the eddy induced velocity on tracers requires isopycnal laplacian diffusion' )
+      IF( nldf == 1 .OR. nldf == 3 ) THEN      ! rotation
+         IF( .NOT.lk_ldfslp )   CALL ctl_stop( '          the rotation of the diffusive tensor require key_ldfslp' )
+#if defined key_offline
+         l_traldf_rot = .TRUE.                 ! needed for trazdf_imp
+#endif
+      ENDIF
+
+      IF( lk_esopa ) THEN
+         IF(lwp) WRITE(numout,*) '          esopa control: use all lateral physics options'
+         nldf = -1
+      ENDIF
+
+      IF( .NOT. ln_trcldf_diff ) THEN
+         IF(lwp) WRITE(numout,*) '          No lateral diffusion on passive tracers'
+         nldf = -2
+      ENDIF
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         IF( nldf == -2 )   WRITE(numout,*) '          NO lateral diffusion'
+         IF( nldf == -1 )   WRITE(numout,*) '          ESOPA test All scheme used'
+         IF( nldf ==  0 )   WRITE(numout,*) '          laplacian operator'
+         IF( nldf ==  1 )   WRITE(numout,*) '          Rotated laplacian operator'
+         IF( nldf ==  2 )   WRITE(numout,*) '          bilaplacian operator'
+         IF( nldf ==  3 )   WRITE(numout,*) '          Rotated bilaplacian'
+      ENDIF
+
+      !
+   END SUBROUTINE ldf_ctl
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_ldf( kt )
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'trc_ldf: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_ldf
+#endif
+   !!======================================================================
+END MODULE trcldf
Index: trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf_bilap.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf_bilap.F90	(revision 2527)
+++ 	(revision )
@@ -1,234 +1,0 @@
-MODULE trcldf_bilap
-   !!======================================================================
-   !!                   ***  MODULE  trcldf_bilap  ***
-   !! Ocean passive tracers:  horiz. component of the lateral tracer mixing trend
-   !!======================================================================
-   !! History :       !  91-11  (G. Madec)  Original code
-   !!                 !  93-03  (M. Guyon)  symetrical conditions
-   !!                 !  95-11  (G. Madec)  suppress volumetric scale factors
-   !!                 !  96-01  (G. Madec)  statement function for e3
-   !!                 !  96-01  (M. Imbard)  mpp exchange
-   !!                 !  97-07  (G. Madec)  optimization, and ahtt
-   !!                 !  00-05  (MA Foujols) add lbc for tracer trends
-   !!                 !  00-10  (MA Foujols E. Kestenare) use passive tracer coefficient
-   !!            8.5  !  02-08  (G. Madec)  F90: Free form and module
-   !!            9.0  !  04-03  (C. Ethe )  F90: Free form and module
-   !!                 !  07-02  (C. Deltel)  Diagnose ML trends for passive tracers
-   !!----------------------------------------------------------------------
-#if defined key_top
-   !!----------------------------------------------------------------------
-   !!   trc_ldf_bilap : update the tracer trend with the horizontal diffusion
-   !!                   using a iso-level biharmonic operator
-   !!----------------------------------------------------------------------
-   USE oce_trc         ! ocean dynamics and active tracers variables
-   USE trp_trc         ! ocean passive tracers variables
-   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE prtctl_trc      ! Print control for debbuging
-   USE trdmld_trc
-   USE trdmld_trc_oce     
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC trc_ldf_bilap   ! routine called by step.F90
-
-   !! * Substitutions
-#  include "top_substitute.h90"
-   !!----------------------------------------------------------------------
-   !!   TOP 1.0 , LOCEAN-IPSL (2005) 
-   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcldf_bilap.F90,v 1.10 2006/09/12 11:10:14 opalod Exp $ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-
-CONTAINS
-   
-   SUBROUTINE trc_ldf_bilap( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE trc_ldf_bilap  ***
-      !!
-      !! ** Purpose :   Compute the before horizontal tracer tra diffusive 
-      !!      trend and add it to the general trend of tracer equation.
-      !!
-      !! ** Method  :   4th order diffusive operator along model level surfaces 
-      !!      evaluated using before fields (forward time scheme). The hor.
-      !!      diffusive trends of passive tracer is given by:
-      !!       * s-coordinate, the vertical scale 
-      !!      factors e3. are inside the derivatives:
-      !!      Laplacian of trb:
-      !!         zlt   = 1/(e1t*e2t*e3t) {  di-1[ e2u*e3u/e1u di(trb) ]
-      !!                                  + dj-1[ e1v*e3v/e2v dj(trb) ]  }
-      !!      Multiply by the eddy diffusivity coef. and insure lateral bc:
-      !!        zlt   = ahtt * zlt
-      !!        call to lbc_lnk
-      !!      Bilaplacian (laplacian of zlt):
-      !!         difft = 1/(e1t*e2t*e3t) {  di-1[ e2u*e3u/e1u di(zlt) ]
-      !!                                  + dj-1[ e1v*e3v/e2v dj(zlt) ]  }
-      !!       * z-coordinate (default key), e3t=e3u=e3v, the trend becomes:
-      !!      Laplacian of trb:
-      !!         zlt   = 1/(e1t*e2t) {  di-1[ e2u/e1u di(trb) ]
-      !!                              + dj-1[ e1v/e2v dj(trb) ] }
-      !!      Multiply by the eddy diffusivity coef. and insure lateral bc:
-      !!        zlt   = ahtt * zlt
-      !!        call to lbc_lnk
-      !!      Bilaplacian (laplacian of zlt):
-      !!         difft = 1/(e1t*e2t) {  di-1[ e2u/e1u di(zlt) ]
-      !!                              + dj-1[ e1v/e2v dj(zlt) ]  }
-      !!
-      !!      Add this trend to the general trend tra :
-      !!         tra = tra + difft 
-      !!
-      !! ** Action : - Update tra arrays with the before iso-level
-      !!               biharmonic mixing trend.
-      !!             - Save the trends ('key_trdmld_trc')
-      !!----------------------------------------------------------------------
-      USE oce_trc,   ztrtrd => ua        ! use ua as workspace
-      !!
-      INTEGER, INTENT( in ) ::   kt                             ! ocean time-step index
-      INTEGER ::   ji, jj, jk, jn                               ! dummy loop indices
-      INTEGER ::   iku, ikv                                     ! temporary integers
-      REAL(wp) ::   ztra                                        ! temporary scalars
-      REAL(wp), DIMENSION(jpi,jpj) ::   zeeu, zeev, zbtr, zlt   ! workspace
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztu, ztv            ! workspace
-      CHARACTER (len=22) :: charout
-      !!----------------------------------------------------------------------
-
-      IF( kt == nittrc000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'trc_ldf_bilap : iso-level biharmonic operator'
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~'
-      ENDIF
-      !                                                          ! ===========
-      DO jn = 1, jptra                                           ! tracer loop
-         !                                                       ! ===========
-         IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)   ! save trends
-
-                                                          ! ===============
-         DO jk = 1, jpkm1                                 ! Horizontal slab
-            !                                             ! ===============
-
-            ! 0. Initialization of metric arrays (for z- or s-coordinates)
-            ! ----------------------------------
-
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-#if ! defined key_zco 
-                  ! s-coordinates, vertical scale factor are used
-                  zbtr(ji,jj) = 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )
-                  zeeu(ji,jj) = e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj) * umask(ji,jj,jk)
-                  zeev(ji,jj) = e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj) * vmask(ji,jj,jk)
-#else
-                  ! z-coordinates, no vertical scale factors
-                  zbtr(ji,jj) = 1. / ( e1t(ji,jj)*e2t(ji,jj) )
-                  zeeu(ji,jj) = e2u(ji,jj) / e1u(ji,jj) * umask(ji,jj,jk)
-                  zeev(ji,jj) = e1v(ji,jj) / e2v(ji,jj) * vmask(ji,jj,jk)
-#endif
-               END DO
-            END DO
-
-
-            ! 1. Laplacian
-            ! ------------
-
-            ! First derivative (gradient)
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  ztu(ji,jj,jk) = zeeu(ji,jj) * ( trb(ji+1,jj  ,jk,jn) - trb(ji,jj,jk,jn) )
-                  ztv(ji,jj,jk) = zeev(ji,jj) * ( trb(ji  ,jj+1,jk,jn) - trb(ji,jj,jk,jn) )
-               END DO
-            END DO
-
-            IF( ln_zps ) THEN
-               DO jj = 1, jpj-1
-                  DO ji = 1, jpi-1
-                     ! last level
-                     iku = MIN ( mbathy(ji,jj), mbathy(ji+1,jj  ) ) - 1
-                     ikv = MIN ( mbathy(ji,jj), mbathy(ji  ,jj+1) ) - 1
-                     IF( iku == jk ) THEN
-                        ztu(ji,jj,jk) = zeeu(ji,jj) * gtru(ji,jj,jn)
-                     ENDIF
-                     IF( ikv == jk ) THEN
-                        ztv(ji,jj,jk) = zeev(ji,jj) * gtrv(ji,jj,jn)
-                     ENDIF
-                  END DO
-               END DO
-            ENDIF
-
-            ! Second derivative (divergence)
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zlt(ji,jj) = zbtr(ji,jj) * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  )
-               END DO
-            END DO
-
-            ! Multiply by the eddy diffusivity coefficient
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zlt(ji,jj) = fsahtrt(ji,jj,jk) * zlt(ji,jj)
-               END DO
-            END DO
-
-            ! Lateral boundary conditions on the laplacian zlt   (unchanged sgn)
-            CALL lbc_lnk( zlt, 'T', 1. )  
-
-            ! 2. Bilaplacian
-            ! --------------
-
-            ! third derivative (gradient)
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  ztu(ji,jj,jk) = zeeu(ji,jj) * ( zlt(ji+1,jj  ) - zlt(ji,jj) )
-                  ztv(ji,jj,jk) = zeev(ji,jj) * ( zlt(ji  ,jj+1) - zlt(ji,jj) )
-               END DO
-            END DO
-
-            ! fourth derivative (divergence) and add to the general tracer trend
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ! horizontal diffusive trends
-                  ztra = zbtr(ji,jj) * (  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
-                  tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
-#if defined key_trc_diatrd
-                  ! save the horizontal diffusive trends
-                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),4) = (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk) ) * zbtr(ji,jj)
-                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),5) = (  ztv(ji,jj,jk) - ztv(ji-1,jj,jk) ) * zbtr(ji,jj)
-#endif
-
-               END DO
-            END DO
-            !                                             ! ===============
-         END DO                                           ! Horizontal slab
-         !                                                ! ===============
-#if defined key_trc_diatrd
-         ! Lateral boundary conditions on the laplacian zlt   (unchanged sgn)
-         IF (luttrd(jn)) CALL lbc_lnk( trtrd(:,:,:,ikeep(jn),5), 'T', 1. )
-#endif
-
-         IF( l_trdtrc ) THEN
-            ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:)
-            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd, jn, jptrc_trd_ldf, kt )    ! trends diags
-         END IF
-         !                                                       ! ===========
-      END DO                                                     ! tracer loop                
-      !                                                          ! ===========
-
-      IF( ln_ctl ) THEN    ! print mean trends (used for debugging)
-         WRITE(charout, FMT="('ldf - bilap')")
-         CALL prt_ctl_trc_info( charout )
-         CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd' )
-      ENDIF
-
-   END SUBROUTINE trc_ldf_bilap
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option                                         Empty module
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE trc_ldf_bilap( kt )  
-      INTEGER, INTENT(in) :: kt
-      WRITE(*,*) 'trc_ldf_bilap: You should not have seen this print! error?', kt
-   END SUBROUTINE trc_ldf_bilap
-#endif
-   !!==============================================================================
-END MODULE trcldf_bilap
Index: trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf_bilapg.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf_bilapg.F90	(revision 2527)
+++ 	(revision )
@@ -1,362 +1,0 @@
-MODULE trcldf_bilapg
-   !!======================================================================
-   !!                       ***  MODULE  trcldf_bilapg  ***
-   !! Ocean passive tracers:  horizontal component of the lateral tracer mixing trend
-   !!======================================================================
-   !! History :  8.0  !  97-07  (G. Madec)  Original code
-   !!            8.5  !  02-08  (G. Madec)  F90: Free form and module
-   !!            9.0  !  04-03  (C. Ethe)  adapted for passive tracers
-   !!                 !  07-02  (C. Deltel)  Diagnose ML trends for passive tracers
-   !!----------------------------------------------------------------------
-#if key_top && defined key_ldfslp
-   !!----------------------------------------------------------------------
-   !!   'key_ldfslp'                  rotation of the lateral mixing tensor
-   !!----------------------------------------------------------------------
-   !!   trc_ldf_bilapg : update the tracer trend with the horizontal diffusion
-   !!                    using an horizontal biharmonic operator in s-coordinate 
-   !!   ldfght         :  ???
-   !!----------------------------------------------------------------------
-   USE oce_trc             ! ocean dynamics and tracers variables
-   USE trc                 ! ocean passive tracers variables
-   USE lbclnk              ! ocean lateral boundary condition (or mpp link)
-   USE prtctl_trc          ! Print control for debbuging
-   USE trp_trc
-   USE trdmld_trc
-   USE trdmld_trc_oce     
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC trc_ldf_bilapg    ! routine called by step.F90
-
-   !! * Substitutions
-#  include "top_substitute.h90"
-   !!----------------------------------------------------------------------
-   !!   TOP 1.0 , LOCEAN-IPSL (2005) 
-   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcldf_bilapg.F90,v 1.9 2006/04/10 15:38:54 opalod Exp $ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-   
-CONTAINS
-
-   SUBROUTINE trc_ldf_bilapg( kt )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE trc_ldf_bilapg  ***
-      !!                    
-      !! ** Purpose :   Compute the before horizontal passive tracer diffusive 
-      !!      trend and add it to the general trend of tracer equation.
-      !!
-      !! ** Method  :   The lateral diffusive trends is provided by a 4th order
-      !!      operator rotated along geopotential surfaces. It is computed
-      !!      using before fields (forward in time) and geopotential slopes
-      !!      computed in routine inildf.
-      !!         -1- compute the geopotential harmonic operator applied to
-      !!      trb and multiply it by the eddy diffusivity coefficient
-      !!      (done by a call to ldfght routine, result in wk1 array).
-      !!      Applied the domain lateral boundary conditions by call to lbc_lnk
-      !!         -2- compute the geopotential harmonic operator applied to
-      !!      wk1 by a second call to ldfght routine (result in wk3 array).
-      !!         -3- Add this trend to the general trend (ta,sa):
-      !!            tra = tra + wk3
-      !!
-      !! ** Action : - Update tra arrays with the before geopotential 
-      !!               biharmonic mixing trend.
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt                         ! ocean time-step index
-      INTEGER ::   ji, jj, jk, jn                           ! dummy loop indices
-      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra) ::   wk1, wk2  ! work array used for rotated biharmonic
-      !                                                     ! operator on tracers and/or momentum
-      CHARACTER (len=22) ::   charout
-      !!----------------------------------------------------------------------
-
-      IF( kt == nittrc000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'trc_ldf_bilapg : horizontal biharmonic operator in s-coordinate'
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~'
-      ENDIF
-
-      ! 1. Laplacian of passive tracers trb * aht
-      ! ----------------------------- 
-      ! rotated harmonic operator applied to trb 
-      ! and multiply by aht (output in wk1 )
-
-      CALL ldfght ( trb, wk1, 1 )
-
-      DO jn = 1, jptra
-      ! Lateral boundary conditions on wk1   (unchanged sign)
-         CALL lbc_lnk( wk1(:,:,:,jn) , 'T', 1. )
-      END DO
-
-      ! 2. Bilaplacian of trb
-      ! -------------------------
-      ! rotated harmonic operator applied to wk1 (output in wk2 )
-
-      CALL ldfght ( wk1, wk2, 2 )
-      !                                                          ! ===========
-      DO jn = 1, jptra                                           ! tracer loop
-         !                                                       ! ===========
-
-         ! 3. Update the tracer trends                    (j-slab :   2, jpj-1)
-         ! ---------------------------
-         !                                                ! ===============
-         DO jj = 2, jpjm1                                 !  Vertical slab
-            !                                             ! ===============
-            DO jk = 1, jpkm1
-               DO ji = 2, jpim1
-                  ! add it to the general tracer trends
-                  tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + wk2(ji,jj,jk,jn)
-#if defined key_trc_diatrd
-                  ! save the horizontal diffusive trends
-                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),3) = wk2(ji,jj,jk,jn)
-#endif
-               END DO
-            END DO
-            !                                             ! ===============
-         END DO                                           !   End of slab
-         !                                                ! ===============
-         IF( l_trdtrc .AND. luttrd(jn) ) CALL trd_mod_trc( wk2(:,:,:,jn), jn, jptrc_trd_ldf, kt )
-
-         !                                                       ! ===========
-      END DO                                                     ! tracer loop
-      !                                                          ! ===========
-
-
-      IF( ln_ctl ) THEN    ! print mean trends (used for debugging)
-         WRITE(charout, FMT="('ldf - bilapg')")
-         CALL prt_ctl_trc_info( charout )
-         CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd' )
-      ENDIF
-
-   END SUBROUTINE trc_ldf_bilapg
-
-
-   SUBROUTINE ldfght ( pt, plt, kaht )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE ldfght  ***
-      !!          
-      !! ** Purpose :   Apply a geopotential harmonic operator to pt and 
-      !!      multiply it by the eddy diffusivity coefficient (if kaht=1).
-      !!      Routine only used in s-coordinates (l_sco=T) with bilaplacian
-      !!      operator (ln_traldf_bilap=T) acting along geopotential surfaces
-      !!      (ln_traldf_hor).
-      !!
-      !! ** Method  :   The harmonic operator rotated along geopotential 
-      !!      surfaces is applied to pt using the slopes of geopotential
-      !!      surfaces computed in inildf routine. The result is provided in
-      !!      plt arrays. It is computed in 2 steps:
-      !!
-      !!      First step: horizontal part of the operator. It is computed on
-      !!      ==========  pt as follows (idem on ps)
-      !!      horizontal fluxes :
-      !!         zftu = e2u*e3u/e1u di[ pt ] - e2u*uslp dk[ mi(mk(pt)) ]
-      !!         zftv = e1v*e3v/e2v dj[ pt ] - e1v*vslp dk[ mj(mk(pt)) ]
-      !!      take the horizontal divergence of the fluxes (no divided by
-      !!      the volume element :
-      !!         plt  = di-1[ zftu ] +  dj-1[ zftv ]
-      !!
-      !!      Second step: vertical part of the operator. It is computed on
-      !!      ===========  pt as follows (idem on ps)
-      !!      vertical fluxes :
-      !!         zftw = e1t*e2t/e3w * (wslpi^2+wslpj^2)  dk-1[ pt ]
-      !!              -     e2t     *       wslpi        di[ mi(mk(pt)) ]
-      !!              -     e1t     *       wslpj        dj[ mj(mk(pt)) ]
-      !!      take the vertical divergence of the fluxes add it to the hori-
-      !!      zontal component, divide the result by the volume element and
-      !!      if kaht=1, multiply by the eddy diffusivity coefficient:
-      !!         plt  = aht / (e1t*e2t*e3t) { plt + dk[ zftw ] }
-      !!      else:
-      !!         plt  =  1  / (e1t*e2t*e3t) { plt + dk[ zftw ] }
-      !!
-      !! * Action :
-      !!      'key_trdtra' defined: the trend is saved for diagnostics.
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra), INTENT( in  ) ::   &
-         pt               ! tracer fields before for 1st call
-      !                   ! and laplacian of these fields for 2nd call.
-      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra), INTENT( out ) ::   &
-         plt              ! partial harmonic operator applied to
-      !                   ! pt components except
-      !                   ! second order vertical derivative term)
-      INTEGER, INTENT( in ) ::   &
-         kaht             ! =1 multiply the laplacian by the eddy diffusivity coeff.
-      !                   ! =2 no multiplication
-
-      INTEGER ::   ji, jj, jk,jn             ! dummy loop indices
-      REAL(wp) ::   &
-         zabe1, zabe2, zmku, zmkv,     &  ! temporary scalars
-         zbtr, ztah, ztav, &
-         zcof0, zcof1, zcof2,          &
-         zcof3, zcof4
-
-      REAL(wp), DIMENSION(jpi,jpj) ::   &
-         zftu, zftv ,                   &  ! workspace
-         zdkt, zdk1t
-
-      REAL(wp), DIMENSION(jpi,jpk) ::   &
-         zftw,                          &  ! workspace
-         zdit, zdjt, zdj1t
-      !!----------------------------------------------------------------------
-
-      DO jn = 1, jptra
-         !                               ! ********** !   ! ===============
-         DO jk = 1, jpkm1                ! First step !   ! Horizontal slab
-            !                            ! ********** !   ! ===============
-
-            ! I.1 Vertical gradient of pt and ps at level jk and jk+1
-            ! -------------------------------------------------------
-            !     surface boundary condition: zdkt(jk=1)=zdkt(jk=2)
-
-            zdk1t(:,:) = ( pt(:,:,jk,jn) - pt(:,:,jk+1,jn) ) * tmask(:,:,jk+1)
-
-            IF( jk == 1 ) THEN
-               zdkt(:,:) = zdk1t(:,:)
-            ELSE
-               zdkt(:,:) = ( pt(:,:,jk-1,jn) - pt(:,:,jk,jn) ) * tmask(:,:,jk)
-            ENDIF
-
-
-            ! I.2 Horizontal fluxes
-            ! ---------------------
-
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1
-                  zabe1 = e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj)
-                  zabe2 = e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj)
-
-                  zmku=1./MAX( tmask(ji+1,jj,jk  )+tmask(ji,jj,jk+1)   &
-                              +tmask(ji+1,jj,jk+1)+tmask(ji,jj,jk  ),1. )
-                  zmkv=1./MAX( tmask(ji,jj+1,jk  )+tmask(ji,jj,jk+1)   &
-                              +tmask(ji,jj+1,jk+1)+tmask(ji,jj,jk  ),1. )
-
-                  zcof1= -e2u(ji,jj) * uslp(ji,jj,jk) * zmku
-                  zcof2= -e1v(ji,jj) * vslp(ji,jj,jk) * zmkv
-
-                  zftu(ji,jj)= umask(ji,jj,jk) *   &
-                     (  zabe1 *( pt(ji+1,jj,jk,jn) - pt(ji,jj,jk,jn) )   &
-                      + zcof1 *( zdkt (ji+1,jj) + zdk1t(ji,jj)           &
-                                +zdk1t(ji+1,jj) + zdkt (ji,jj) )  )
-
-                  zftv(ji,jj)= vmask(ji,jj,jk) *   &
-                     (  zabe2 *( pt(ji,jj+1,jk,jn) - pt(ji,jj,jk,jn) )   &
-                      + zcof2 *( zdkt (ji,jj+1) + zdk1t(ji,jj)           &
-                                +zdk1t(ji,jj+1) + zdkt (ji,jj) )  )
-               END DO
-            END DO
-
-
-            ! I.3 Second derivative (divergence) (not divided by the volume)
-            ! ---------------------
-
-            DO jj = 2 , jpjm1
-               DO ji = 2 , jpim1
-                  ztah = zftu(ji,jj) - zftu(ji-1,jj) + zftv(ji,jj) - zftv(ji,jj-1)
-                  plt(ji,jj,jk,jn) = ztah
-               END DO
-            END DO
-            !                                             ! ===============
-         END DO                                           !   End of slab
-         !                                                ! ===============
-
-
-         !                             ! ************ !   ! ===============
-         DO jj = 2, jpjm1              !  Second step !   ! Horizontal slab
-            !                          ! ************ !   ! ===============
-
-            ! II.1 horizontal tracer gradient
-            ! -------------------------------
-
-            DO jk = 1, jpk
-               DO ji = 1, jpim1
-                  zdit (ji,jk) = ( pt(ji+1,jj  ,jk,jn) - pt(ji,jj  ,jk,jn) ) * umask(ji,jj  ,jk)
-                  zdjt (ji,jk) = ( pt(ji  ,jj+1,jk,jn) - pt(ji,jj  ,jk,jn) ) * vmask(ji,jj  ,jk)
-                  zdj1t(ji,jk) = ( pt(ji  ,jj  ,jk,jn) - pt(ji,jj-1,jk,jn) ) * vmask(ji,jj-1,jk)
-               END DO
-            END DO
-
-
-            ! II.2 Vertical fluxes
-            ! --------------------
-
-            ! Surface and bottom vertical fluxes set to zero
-            zftw(:, 1 ) = 0.e0
-            zftw(:,jpk) = 0.e0
-
-            ! interior (2=<jk=<jpk-1)
-            DO jk = 2, jpkm1
-               DO ji = 2, jpim1
-                  zcof0 = e1t(ji,jj) * e2t(ji,jj) / fse3w(ji,jj,jk)   &
-                     * (  wslpi(ji,jj,jk) * wslpi(ji,jj,jk)        &
-                        + wslpj(ji,jj,jk) * wslpj(ji,jj,jk)  )
-
-                  zmku =1./MAX(  umask(ji  ,jj,jk-1)+umask(ji-1,jj,jk)   &
-                                +umask(ji-1,jj,jk-1)+umask(ji  ,jj,jk), 1. )
-
-                  zmkv =1./MAX(  vmask(ji,jj  ,jk-1)+vmask(ji,jj-1,jk)   &
-                                +vmask(ji,jj-1,jk-1)+vmask(ji,jj  ,jk), 1. )
-
-                  zcof3 = - e2t(ji,jj) * wslpi (ji,jj,jk) * zmku
-                  zcof4 = - e1t(ji,jj) * wslpj (ji,jj,jk) * zmkv
-
-                  zftw(ji,jk) = tmask(ji,jj,jk) *   &
-                     (  zcof0 * ( pt  (ji,jj,jk-1,jn) - pt  (ji,jj,jk,jn) )   &
-                      + zcof3 * ( zdit (ji  ,jk-1) + zdit (ji-1,jk)           &
-                                 +zdit (ji-1,jk-1) + zdit (ji  ,jk) )         &
-                      + zcof4 * ( zdjt (ji  ,jk-1) + zdj1t(ji  ,jk)           &
-                                 +zdj1t(ji  ,jk-1) + zdjt (ji  ,jk) )  )
-               END DO
-            END DO
-
-
-            ! II.3 Divergence of vertical fluxes added to the horizontal divergence
-            ! ---------------------------------------------------------------------
-
-            IF( kaht == 1 ) THEN
-               ! multiply the laplacian by the eddy diffusivity coefficient
-               DO jk = 1, jpkm1
-                  DO ji = 2, jpim1
-                     ! eddy coef. divided by the volume element
-                     zbtr = fsahtrt(ji,jj,jk) / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )
-                     ! vertical divergence
-                     ztav = zftw(ji,jk) - zftw(ji,jk+1)
-                     ! harmonic operator applied to (pt,ps) and multiply by aht
-                     plt(ji,jj,jk,jn) = ( plt(ji,jj,jk,jn) + ztav ) * zbtr
-                  END DO
-               END DO
-            ELSEIF( kaht == 2 ) THEN
-               ! second call, no multiplication
-               DO jk = 1, jpkm1
-                  DO ji = 2, jpim1
-                     ! inverse of the volume element
-                     zbtr = 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )
-                     ! vertical divergence
-                     ztav = zftw(ji,jk) - zftw(ji,jk+1)
-                     ! harmonic operator applied to (pt,ps) 
-                     plt(ji,jj,jk,jn) = ( plt(ji,jj,jk,jn) + ztav ) * zbtr
-                  END DO
-               END DO
-            ELSE
-               IF(lwp) WRITE(numout,*) ' ldfght: kaht= 1 or 2, here =', kaht
-               IF(lwp) WRITE(numout,*) '         We stop'
-               STOP 'ldfght'
-            ENDIF
-            !                                             ! ===============
-         END DO                                           !   End of slab
-         !                                                ! ===============
-
-      END DO
-
-   END SUBROUTINE ldfght
-
-#else  
-   !!----------------------------------------------------------------------
-   !!   Dummy module :             NO rotation of the lateral mixing tensor
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE trc_ldf_bilapg( kt )               ! Dummy routine
-      INTEGER, INTENT(in) :: kt
-      WRITE(*,*) 'trc_ldf_bilapg: You should not have seen this print! error?', kt
-   END SUBROUTINE trc_ldf_bilapg
-#endif
-
-   !!==============================================================================
-END MODULE trcldf_bilapg
Index: trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf_iso.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf_iso.F90	(revision 2527)
+++ 	(revision )
@@ -1,312 +1,0 @@
-MODULE trcldf_iso
-   !!==============================================================================
-   !!                    ***  MODULE  trcldf_iso  ***
-   !!======================================================================
-   !! Ocean passive tracers:  horizontal component of the lateral tracer mixing trend
-   !! History :
-   !!        !  94-08  (G. Madec, M. Imbard)
-   !!        !  97-05  (G. Madec)  split into traldf and trazdf
-   !!        !  98-03  (L. Bopp, MA Foujols) passive tracer generalisation
-   !!        !  00-10  (MA Foujols E Kestenare) USE passive tracer coefficient
-   !!   8.5  !  02-08  (G. Madec)  Free form, F90
-   !!   9.0  !  04-03  (C. Ethe)  Free form, F90
-   !!        !  06-08  (C. Deltel) Diagnose ML trends for passive tracers
-   !!----------------------------------------------------------------------
-#if key_top && defined key_ldfslp 
-   !!----------------------------------------------------------------------
-   !!   'key_ldfslp'                  rotation of the lateral mixing tensor
-   !!----------------------------------------------------------------------
-   !!   trc_ldf_iso : update the tracer trend with the horizontal component
-   !!                 of iso neutral laplacian operator or horizontal 
-   !!                 laplacian operator in s-coordinate
-   !!----------------------------------------------------------------------
-   USE oce_trc      ! ocean dynamics and tracers variables
-   USE trp_trc      ! ocean passive tracers variables
-   USE prtctl_trc   ! Print control for debbuging
-   USE trdmld_trc
-   USE trdmld_trc_oce     
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC trc_ldf_iso  ! routine called by step.F90
-
-   !! * Substitutions
-#  include "top_substitute.h90"
-   !!----------------------------------------------------------------------
-   !!   TOP 1.0 , LOCEAN-IPSL (2005) 
-   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcldf_iso.F90,v 1.9 2006/04/10 15:38:54 opalod Exp $ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE trc_ldf_iso( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE trc_ldf_iso  ***
-      !! 
-      !! ** Purpose :   Compute the before horizontal tracer  diffusive 
-      !!      trend and add it to the general trend of tracer equation.
-      !!
-      !! ** Method  :   The horizontal component of the lateral diffusive trends 
-      !!      is provided by a 2nd order operator rotated along neural or geopo-
-      !!      tential surfaces to which an eddy induced advection can be added
-      !!      It is computed using before fields (forward in time) and isopyc-
-      !!      nal or geopotential slopes computed in routine ldfslp.
-      !!
-      !!      horizontal fluxes associated with the rotated lateral mixing:
-      !!         zftu = (aht+ahtb0) e2u*e3u/e1u di[ tb ]
-      !!               - aht       e2u*uslp    dk[ mi(mk(tb)) ]
-      !!         zftv = (aht+ahtb0) e1v*e3v/e2v dj[ tb ]
-      !!               - aht       e2u*vslp    dk[ mj(mk(tb)) ]
-      !!      add horizontal Eddy Induced advective fluxes (lk_traldf_eiv=T):
-      !!         zftu = zftu - dk-1[ aht e2u mi(wslpi) ] mi( tb ) 
-      !!         zftv = zftv - dk-1[ aht e1v mj(wslpj) ] mj( tb ) 
-      !!      take the horizontal divergence of the fluxes:
-      !!         difft = 1/(e1t*e2t*e3t) {  di-1[ zftu ] +  dj-1[ zftv ]  }
-      !!      Add this trend to the general trend tra :
-      !!         tra = tra + difft
-      !!
-      !! ** Action  : - Update tra arrays with the before isopycnal or
-      !!                geopotential s-coord harmonic mixing trend.
-      !!              - Save the trends ('key_trdmld_trc')
-      !!----------------------------------------------------------------------
-      USE oce_trc       , zftu => ua,  &  ! use ua as workspace
-         &                zftv => va      ! use va as workspace
-      !!
-      INTEGER, INTENT( in ) ::   kt                             ! ocean time-step index
-      !!                                                 
-      INTEGER ::   ji, jj, jk, jn                               ! dummy loop indices
-      REAL(wp) ::   zabe1, zabe2, zcof1, zcof2                  ! temporary scalars
-      REAL(wp) ::   zmsku, zmskv, zbtr, ztra
-#if defined key_trcldf_eiv
-      REAL(wp) ::   zcg1, zcg2, zuwk, zvwk, zuwk1, zvwk1
-      REAL(wp) ::   z_hdivn_x, z_hdivn_y
-#endif
-      REAL(wp), DIMENSION(jpi,jpj) ::   zdkt, zdk1t             ! workspace
-#if defined key_trcldf_eiv
-      REAL(wp), DIMENSION(jpi,jpj) ::   zftug, zftvg
-#endif
-      CHARACTER (len=22) :: charout
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd       ! trends arrays
-#   if defined key_trcldf_eiv
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd_xei
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd_yei
-#endif
-      !!----------------------------------------------------------------------
-
-      IF( kt == nittrc000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'trc_ldf_iso : iso neutral lateral diffusion or'
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   horizontal laplacian diffusion in s-coordinate'
-#if defined key_trcldf_eiv && defined key_diaeiv
-         u_trc_eiv(:,:,:) = 0.e0
-         v_trc_eiv(:,:,:) = 0.e0
-#endif
-      ENDIF
-
-      IF( l_trdtrc ) THEN
-         ALLOCATE( ztrtrd(jpi,jpj,jpk) )
-#   if defined key_trcldf_eiv
-         ALLOCATE( ztrtrd_xei(jpi,jpj,jpk) )
-         ALLOCATE( ztrtrd_yei(jpi,jpj,jpk) )
-#   endif
-      ENDIF
-
-      !                                                          ! ===========
-      DO jn = 1, jptra                                           ! tracer loop
-         !                                                       ! ===========
-
-         IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)
-
-         !                                                ! ===============
-         DO jk = 1, jpkm1                                 ! Horizontal slab
-            !                                             ! ===============
-            ! 1. Vertical tracer gradient at level jk and jk+1
-            ! ------------------------------------------------
-            ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2)
-
-            zdk1t(:,:) = ( trb(:,:,jk,jn) - trb(:,:,jk+1,jn) ) * tmask(:,:,jk+1)
-
-            IF( jk == 1 ) THEN
-               zdkt(:,:) = zdk1t(:,:)
-            ELSE
-               zdkt(:,:) = ( trb(:,:,jk-1,jn) - trb(:,:,jk,jn) ) * tmask(:,:,jk)
-            ENDIF
-
-
-            ! 2. Horizontal fluxes
-            ! --------------------
-
-            DO jj = 1 , jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zabe1 = ( fsahtru(ji,jj,jk) + ahtrb0 ) * e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj)
-                  zabe2 = ( fsahtrv(ji,jj,jk) + ahtrb0 ) * e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj)
-
-                  zmsku = 1. / MAX(   tmask(ji+1,jj,jk  ) + tmask(ji,jj,jk+1)   &
-                     + tmask(ji+1,jj,jk+1) + tmask(ji,jj,jk  ), 1. )
-
-                  zmskv = 1. / MAX(   tmask(ji,jj+1,jk  ) + tmask(ji,jj,jk+1)   &
-                     + tmask(ji,jj+1,jk+1) + tmask(ji,jj,jk  ), 1. )
-
-                  zcof1 = -fsahtru(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku
-                  zcof2 = -fsahtrv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv
-
-                  zftu(ji,jj,jk) = umask(ji,jj,jk) * (   zabe1 * (   trb(ji+1,jj,jk,jn) - trb(ji,jj,jk,jn)  )   &
-                     &                              + zcof1 * (   zdkt (ji+1,jj) + zdk1t(ji,jj)      &
-                     &                                          + zdk1t(ji+1,jj) + zdkt (ji,jj)  )  )
-
-                  zftv(ji,jj,jk) = vmask(ji,jj,jk) * (   zabe2 * (   trb(ji,jj+1,jk,jn) - trb(ji,jj,jk,jn)  )   &
-                     &                              + zcof2 * (   zdkt (ji,jj+1) + zdk1t(ji,jj)      &
-                     &                                          + zdk1t(ji,jj+1) + zdkt (ji,jj)  )  )
-
-               END DO
-            END DO
-
-#   if defined key_trcldf_eiv
-            !                              ! ---------------------------------------!
-            !                              ! Eddy induced vertical advective fluxes !
-            !                              ! ---------------------------------------!
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zuwk = ( wslpi(ji,jj,jk  ) + wslpi(ji+1,jj,jk  ) ) * fsaeitru(ji,jj,jk  ) * umask(ji,jj,jk  )
-                  zuwk1= ( wslpi(ji,jj,jk+1) + wslpi(ji+1,jj,jk+1) ) * fsaeitru(ji,jj,jk+1) * umask(ji,jj,jk+1)
-                  zvwk = ( wslpj(ji,jj,jk  ) + wslpj(ji,jj+1,jk  ) ) * fsaeitrv(ji,jj,jk  ) * vmask(ji,jj,jk  )
-                  zvwk1= ( wslpj(ji,jj,jk+1) + wslpj(ji,jj+1,jk+1) ) * fsaeitrv(ji,jj,jk+1) * vmask(ji,jj,jk+1)
-
-                  zcg1= -0.25 * e2u(ji,jj) * umask(ji,jj,jk) * ( zuwk-zuwk1 )
-                  zcg2= -0.25 * e1v(ji,jj) * vmask(ji,jj,jk) * ( zvwk-zvwk1 )
-
-                  zftug(ji,jj) = zcg1 * ( trb(ji+1,jj,jk,jn) + trb(ji,jj,jk,jn) )
-                  zftvg(ji,jj) = zcg2 * ( trb(ji,jj+1,jk,jn) + trb(ji,jj,jk,jn) )
-
-                  zftu(ji,jj,jk) = zftu(ji,jj,jk) + zftug(ji,jj)
-                  zftv(ji,jj,jk) = zftv(ji,jj,jk) + zftvg(ji,jj)
-
-#   if defined key_diaeiv
-                  u_trc_eiv(ji,jj,jk) = -2. * zcg1 / ( e2u(ji,jj) * fse3u(ji,jj,jk) )
-                  v_trc_eiv(ji,jj,jk) = -2. * zcg2 / ( e1v(ji,jj) * fse3v(ji,jj,jk) )
-#   endif
-               END DO
-            END DO
-#   endif
-
-            ! 3. Second derivative (divergence) and add to the general trend
-            ! --------------------------------------------------------------
-
-            DO jj = 2 , jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr= 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )
-                  ztra = zbtr * (  zftu(ji,jj,jk) - zftu(ji-1,jj  ,jk)   &
-                       &         + zftv(ji,jj,jk) - zftv(ji  ,jj-1,jk)  )
-                  tra (ji,jj,jk,jn) = tra (ji,jj,jk,jn) + ztra
-#if defined key_trc_diatrd
-                  IF (luttrd(jn)) trtrd (ji,jj,jk,ikeep(jn),4) = ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk  ) ) * zbtr
-                  IF (luttrd(jn)) trtrd (ji,jj,jk,ikeep(jn),5) = ( zftv(ji,jj,jk) - zftv(ji,jj-1,jk  ) ) * zbtr
-#endif
-
-               END DO
-            END DO
-            !                                          ! ===============
-         END DO                                        !   End of slab  
-         !                                             ! ===============
-
-         ! 4. Save the trends for diagnostic
-         ! ---------------------------------
-
-         IF( l_trdtrc ) THEN
-#   if defined key_trcldf_eiv
-
-            ! 4.1) Compute the eiv ZONAL & MERIDIONAL advective trends
-                                                          ! ===============
-            DO jk = 1, jpkm1                              ! Horizontal slab
-                                                          ! ===============
-               DO jj = 1, jpjm1
-                  DO ji = 1, fs_jpim1   ! vector opt.
-                     zuwk = ( wslpi(ji,jj,jk  ) + wslpi(ji+1,jj,jk  ) ) * fsaeitru(ji,jj,jk  ) * umask(ji,jj,jk  )
-                     zuwk1= ( wslpi(ji,jj,jk+1) + wslpi(ji+1,jj,jk+1) ) * fsaeitru(ji,jj,jk+1) * umask(ji,jj,jk+1)
-                     zvwk = ( wslpj(ji,jj,jk  ) + wslpj(ji,jj+1,jk  ) ) * fsaeitrv(ji,jj,jk  ) * vmask(ji,jj,jk  )
-                     zvwk1= ( wslpj(ji,jj,jk+1) + wslpj(ji,jj+1,jk+1) ) * fsaeitrv(ji,jj,jk+1) * vmask(ji,jj,jk+1)
-                     
-                     zcg1= -0.25 * e2u(ji,jj) * umask(ji,jj,jk) * ( zuwk-zuwk1 )
-                     zcg2= -0.25 * e1v(ji,jj) * vmask(ji,jj,jk) * ( zvwk-zvwk1 )
-                     
-                     zftug(ji,jj) = zcg1 * ( trb(ji+1,jj,jk,jn) + trb(ji,jj,jk,jn) )
-                     zftvg(ji,jj) = zcg2 * ( trb(ji,jj+1,jk,jn) + trb(ji,jj,jk,jn) )
-                  END DO
-               END DO
-               
-               DO jj = 2 , jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     zbtr= 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )
-                     
-                     !-- Compute zonal & meridional divergences of the eiv field :
-                     !     d_x[u_trc_eiv] = 1/(e1t*e2t*e3t) ( di[e2u*e3u u_trc_eiv] )
-                     !     d_y[v_trc_eiv] = 1/(e1t*e2t*e3t) ( dj[e1v*e3v v_trc_eiv] )
-                     !   N.B.  This is only possible if key_diaeiv is switched on.
-#       if defined key_diaeiv
-                     z_hdivn_x = (  e2u(ji  ,jj) * fse3u(ji  ,jj,jk) * u_trc_eiv(ji  ,jj  ,jk)  &
-                          &       - e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * u_trc_eiv(ji-1,jj  ,jk) ) * zbtr
-                     z_hdivn_y = (  e1v(ji,  jj) * fse3v(ji,jj  ,jk) * v_trc_eiv(ji,  jj  ,jk)  &
-                          &       - e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * v_trc_eiv(ji  ,jj-1,jk) ) * zbtr
-#       else
-                     z_hdivn_x = 0.e0   ;   z_hdivn_y = 0.e0 
-#       endif
-                     !-- Compute the zonal advective trends associated with eiv
-                     ztrtrd_xei(ji,jj,jk) =  zbtr * ( zftug(ji,jj) - zftug(ji-1,jj  ) )          &
-                          &                 - trn(ji,jj,jk,jn) * z_hdivn_x
-                     
-                     !-- Compute the merid. advective trends associated with eiv
-                     ztrtrd_yei(ji,jj,jk) =  zbtr * ( zftvg(ji,jj) - zftvg(ji  ,jj-1) )          &
-                          &                 - trn(ji,jj,jk,jn) * z_hdivn_y
-                  END DO
-               END DO
-                                                          ! ===============
-            END DO                                        !   End of slab  
-                                                          ! ===============
-            ! 4.2) Deduce the trend
-            ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:) - ztrtrd_xei(:,:,:) - ztrtrd_yei(:,:,:)
-#   else
-            ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:)
-#   endif
-            
-            ! 4.3) save the trends for diagnostic
-            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd    , jn, jptrc_trd_ldf, kt ) 
-#   if defined key_trcldf_eiv
-            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd_xei, jn, jptrc_trd_xei, kt )
-            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd_yei, jn, jptrc_trd_yei, kt )
-#   endif
-         ENDIF
-         !                                                    ! ===========
-      END DO                                                  ! tracer loop
-      !                                                       ! ===========
-
-      IF( l_trdtrc ) THEN
-         DEALLOCATE( ztrtrd )
-#   if defined key_trcldf_eiv
-         DEALLOCATE( ztrtrd_xei )
-         DEALLOCATE( ztrtrd_yei )
-#   endif
-      ENDIF
-
-      IF( ln_ctl ) THEN        ! print mean trends (used for debugging)
-         WRITE(charout, FMT="('ldf - iso')")
-         CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
-      ENDIF
-
-   END SUBROUTINE trc_ldf_iso
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Dummy module :             No rotation of the lateral mixing tensor
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE trc_ldf_iso( kt )               ! Empty routine
-      INTEGER, INTENT(in) :: kt
-      WRITE(*,*) 'trc_ldf_iso: You should not have seen this print! error?', kt
-   END SUBROUTINE trc_ldf_iso
-#endif
-
-   !!==============================================================================
-END MODULE trcldf_iso
Index: trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf_iso_zps.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf_iso_zps.F90	(revision 2527)
+++ 	(revision )
@@ -1,352 +1,0 @@
-MODULE trcldf_iso_zps
-   !!======================================================================
-   !!                   ***  MODULE  trcldf_iso_zps  ***
-   !! Ocean passive tracers:  horizontal component of the lateral tracer mixing trend
-   !!======================================================================
-   !! History :       !  94-08  (G. Madec, M. Imbard)
-   !!                 !  97-05  (G. Madec)  split into traldf and trazdf
-   !!            8.5  !  02-08  (G. Madec)  Free form, F90
-   !!            9.0  !  04-03  (C. Ethe)  adapted for passive tracers
-   !!                 !  07-02  (C. Deltel)  Diagnose ML trends for passive tracers
-   !!----------------------------------------------------------------------
-#if key_top &&  defined key_ldfslp 
-   !!----------------------------------------------------------------------
-   !!   'key_ldfslp'               slope of the lateral diffusive direction
-   !!----------------------------------------------------------------------
-   !!   trc_ldf_iso_zps : update the tracer trend with the horizontal 
-   !!                     component of a iso-neutral laplacian operator
-   !!----------------------------------------------------------------------
-   USE oce_trc             ! ocean dynamics and active tracers variables
-   USE trp_trc                 ! ocean passive tracers variables
-   USE prtctl_trc          ! Print control for debbuging
-   USE trdmld_trc
-   USE trdmld_trc_oce     
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC trc_ldf_iso_zps  ! routine called by step.F90
-
-   !! * Substitutions
-#  include "top_substitute.h90"
-   !!----------------------------------------------------------------------
-   !!   TOP 1.0 , LOCEAN-IPSL (2005) 
-   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcldf_iso_zps.F90,v 1.10 2006/09/12 11:10:14 opalod Exp $ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE trc_ldf_iso_zps( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE trc_ldf_iso_zps  ***
-      !!
-      !! ** Purpose :   Compute the before horizontal tracer  diffusive 
-      !!      trend and add it to the general trend of tracer equation.
-      !!
-      !! ** Method  :   The horizontal component of the lateral diffusive trends 
-      !!      is provided by a 2nd order operator rotated along neural or geopo-
-      !!      tential surfaces to which an eddy induced advection can be added
-      !!      It is computed using before fields (forward in time) and isopyc-
-      !!      nal or geopotential slopes computed in routine ldfslp.
-      !!
-      !!      horizontal fluxes associated with the rotated lateral mixing:
-      !!         zftu = (aht+ahtb0) e2u*e3u/e1u di[ tb ]
-      !!               - aht       e2u*uslp    dk[ mi(mk(trb)) ]
-      !!         zftv = (aht+ahtb0) e1v*e3v/e2v dj[ tb ]
-      !!               - aht       e2u*vslp    dk[ mj(mk(trb)) ]
-      !!      add horizontal Eddy Induced advective fluxes (lk_traldf_eiv=T):
-      !!         zftu = zftu - dk-1[ aht e2u mi(wslpi) ] mi( trb ) 
-      !!         zftv = zftv - dk-1[ aht e1v mj(wslpj) ] mj( trb ) 
-      !!      take the horizontal divergence of the fluxes:
-      !!         difft = 1/(e1t*e2t*e3t) {  di-1[ zftu ] +  dj-1[ zftv ]  }
-      !!      Add this trend to the general trend tra :
-      !!         tra = tra + difft
-      !!
-      !!      'key_trdtra' defined: the trend is saved for diagnostics.
-      !!
-      !!      macro-tasked on horizontal slab (jk-loop).
-      !!
-      !! ** Action :
-      !!         Update tra arrays with the before along level biharmonic
-      !!      mixing trend.
-      !!         Save the trends if 'key_trdmld_trc' defined
-      !!----------------------------------------------------------------------
-      USE oce_trc       , zftu => ua,  &  ! use ua as workspace
-         &                zftv => va      ! use va as workspace
-      !!
-      INTEGER, INTENT( in ) ::   kt       ! ocean time-step index
-      INTEGER ::   ji, jj, jk,jn          ! dummy loop indices
-      INTEGER ::   iku, ikv               ! temporary integer
-      REAL(wp) ::   &
-         zabe1, zabe2, zcof1, zcof2,   &  ! temporary scalars
-         zmsku, zmskv, zbtr, ztra
-
-      REAL(wp), DIMENSION(jpi,jpj) ::   &
-         zdkt , zdk1t                     ! temporary workspace
-
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
-         zgtbu, zgtbv               ! temporary workspace
-
-#if defined key_trcldf_eiv
-      REAL(wp), DIMENSION(jpi,jpj) ::   &
-         zftug, zftvg                     ! temporary workspace
-      REAL(wp) ::   &
-         z_hdivn_x, z_hdivn_y, zcg1, zcg2,  &
-         zuwk, zvwk, zuwk1, zvwk1
-#endif
-      CHARACTER (len=22) :: charout
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd_xei
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd_yei
-      !!----------------------------------------------------------------------
-
-      IF( kt == nittrc000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'trc_ldf_iso_zps : iso neutral laplacian diffusion in '
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~   z-coordinates with partial steps'
-#if defined key_trcldf_eiv && defined key_diaeiv
-         u_trc_eiv(:,:,:) = 0.e0
-         v_trc_eiv(:,:,:) = 0.e0
-#endif
-      ENDIF
-
-      IF( l_trdtrc ) THEN
-         ALLOCATE( ztrtrd(jpi,jpj,jpk) )
-#   if defined key_trcldf_eiv
-         ALLOCATE( ztrtrd_xei(jpi,jpj,jpk) )
-         ALLOCATE( ztrtrd_yei(jpi,jpj,jpk) )
-#   endif
-      ENDIF
-
-      !                                                          ! ===========
-      DO jn = 1, jptra                                           ! tracer loop
-         !                                                       ! ===========
-         IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)   ! save trends
-      
-         zgtbu(:,:,:) = 0.     ;     zgtbv(:,:,:) = 0.
-         ! Horizontal passive tracer gradient 
-         DO jk = 1, jpk
-            DO jj = 1, jpj-1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zgtbu(ji,jj,jk) = tmask(ji,jj,jk) * ( trb(ji+1,jj  ,jk,jn) - trb(ji,jj,jk,jn) )
-                  zgtbv(ji,jj,jk) = tmask(ji,jj,jk) * ( trb(ji  ,jj+1,jk,jn) - trb(ji,jj,jk,jn) )
-               END DO
-            END DO
-         END DO
-         ! partial steps correction at the last level 
-         DO jj = 1, jpj-1
-            DO ji = 1, jpi-1
-               ! last level
-               iku = MIN( mbathy(ji,jj), mbathy(ji+1,jj  ) ) - 1
-               ikv = MIN( mbathy(ji,jj), mbathy(ji  ,jj+1) ) - 1
-               zgtbu(ji,jj,iku) = gtru(ji,jj,jn)               
-               zgtbv(ji,jj,ikv) = gtrv(ji,jj,jn)               
-            END DO
-         END DO
-
-         !                                                ! ===============
-         DO jk = 1, jpkm1                                 ! Horizontal slab
-            !                                             ! ===============
-            ! 1. Vertical tracer gradient at level jk and jk+1
-            ! ------------------------------------------------
-            ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2)
-
-            zdk1t(:,:) = ( trb(:,:,jk,jn) - trb(:,:,jk+1,jn) ) * tmask(:,:,jk+1)
-
-            IF( jk == 1 ) THEN
-               zdkt(:,:) = zdk1t(:,:)
-            ELSE
-               zdkt(:,:) = ( trb(:,:,jk-1,jn) - trb(:,:,jk,jn) ) * tmask(:,:,jk)
-            ENDIF
-
-            ! 2. Horizontal fluxes
-            ! --------------------
-
-            DO jj = 1 , jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zabe1 = ( fsahtru(ji,jj,jk) + ahtrb0 ) * e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj)
-                  zabe2 = ( fsahtrv(ji,jj,jk) + ahtrb0 ) * e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj)
-
-                  zmsku = 1. / MAX(  tmask(ji+1,jj,jk  ) + tmask(ji,jj,jk+1)   &
-                       &           + tmask(ji+1,jj,jk+1) + tmask(ji,jj,jk  ), 1. )
-
-                  zmskv = 1. / MAX(  tmask(ji,jj+1,jk  ) + tmask(ji,jj,jk+1)   &
-                       &           + tmask(ji,jj+1,jk+1) + tmask(ji,jj,jk  ), 1. )
-
-                  zcof1 = -fsahtru(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku
-                  zcof2 = -fsahtrv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv
-
-                  zftu(ji,jj,jk) = umask(ji,jj,jk) * (  zabe1 * zgtbu(ji,jj,jk)   &
-                       &                              + zcof1 * (  zdkt (ji+1,jj) + zdk1t(ji,jj)      &
-                       &                                         + zdk1t(ji+1,jj) + zdkt (ji,jj)  )  )
-                  zftv(ji,jj,jk) = vmask(ji,jj,jk) * (  zabe2 * zgtbv(ji,jj,jk)   &
-                       &                              + zcof2 * (  zdkt (ji,jj+1) + zdk1t(ji,jj)      &
-                       &                                         + zdk1t(ji,jj+1) + zdkt (ji,jj)  )  )
-               END DO
-            END DO
-
-# if defined key_trcldf_eiv
-
-            ! ... Eddy induced horizontal advective fluxes
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  zuwk = ( wslpi(ji,jj,jk  ) + wslpi(ji+1,jj  ,jk  ) ) * fsaeitru(ji,jj,jk  ) * umask(ji,jj,jk  )
-                  zuwk1= ( wslpi(ji,jj,jk+1) + wslpi(ji+1,jj  ,jk+1) ) * fsaeitru(ji,jj,jk+1) * umask(ji,jj,jk+1)
-                  zvwk = ( wslpj(ji,jj,jk  ) + wslpj(ji  ,jj+1,jk  ) ) * fsaeitrv(ji,jj,jk  ) * vmask(ji,jj,jk  )
-                  zvwk1= ( wslpj(ji,jj,jk+1) + wslpj(ji  ,jj+1,jk+1) ) * fsaeitrv(ji,jj,jk+1) * vmask(ji,jj,jk+1)
-
-                  zcg1= -0.25 * e2u(ji,jj) * umask(ji,jj,jk) * ( zuwk-zuwk1 )
-                  zcg2= -0.25 * e1v(ji,jj) * vmask(ji,jj,jk) * ( zvwk-zvwk1 )
-
-                  zftug(ji,jj) = zcg1 * ( trb(ji+1,jj,jk,jn) + trb(ji,jj,jk,jn) )
-                  zftvg(ji,jj) = zcg2 * ( trb(ji,jj+1,jk,jn) + trb(ji,jj,jk,jn) )
-
-                  zftu(ji,jj,jk) = zftu(ji,jj,jk) + zftug(ji,jj)
-                  zftv(ji,jj,jk) = zftv(ji,jj,jk) + zftvg(ji,jj)
-
-#   if defined key_diaeiv
-                  u_trc_eiv(ji,jj,jk) = -2. * zcg1 / ( e2u(ji,jj) * fse3u(ji,jj,jk) )
-                  v_trc_eiv(ji,jj,jk) = -2. * zcg2 / ( e1v(ji,jj) * fse3v(ji,jj,jk) )
-#   endif
-               END DO
-            END DO
-# endif
-
-            ! 3. Second derivative (divergence) and add to the general trend
-            ! --------------------------------------------------------------
-
-            DO jj = 2 , jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  ztra = zbtr * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  )
-                  tra(ji,jj,jk,jn) = tra (ji,jj,jk,jn) + ztra
-               END DO
-            END DO
-
-#if defined key_trc_diatrd
-            DO jj = 2 , jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-                  IF( luttrd(jn) ) THEN 
-                     trtrd (ji,jj,jk,ikeep(jn),4) = zbtr * ( zftu(ji,jj,jk) - zftu(ji-1,  jj,jk) )
-                     trtrd (ji,jj,jk,ikeep(jn),5) = zbtr * ( zftv(ji,jj,jk) - zftv(ji  ,jj-1,jk) )
-                  ENDIF
-#   if defined key_trcldf_eiv
-                  IF( luttrd(jn) ) THEN 
-                     trtrd (ji,jj,jk,ikeep(jn),4) = trtrd(ji,jj,jk,ikeep(jn),4)    &
-                     &                            - zbtr * ( zftug(ji,jj) - zftug(ji-1,jj  ) ) 
-                     trtrd (ji,jj,jk,ikeep(jn),5) = trtrd(ji,jj,jk,ikeep(jn),5)    &
-                     &                            - zbtr * ( zftvg(ji,jj) - zftvg(ji  ,jj-1) )
-                  ENDIF
-#   endif
-               END DO
-            END DO
-#endif
-
-            !                                          ! ===============
-         END DO                                        !   End of slab  
-         !                                             ! ===============
-
-         ! 4. Save the horizontal diffusive and advective (eiv) trends for diagnostics
-         ! ---------------------------------------------------------------------------
-         IF( l_trdtrc ) THEN
-
-            ! 4.1) Compute the eiv ZONAL & MERIDIONAL advective trends
-
-#   if defined key_trcldf_eiv
-            !                                                ! ===============
-            DO jk = 1, jpkm1                                 ! Horizontal slab
-               !                                             ! ===============
-
-               DO jj = 1, jpjm1
-                  DO ji = 1, fs_jpim1   ! vector opt.
-                     zuwk = ( wslpi(ji,jj,jk  ) + wslpi(ji+1,jj  ,jk  ) ) * fsaeitru(ji,jj,jk  ) * umask(ji,jj,jk  )
-                     zuwk1= ( wslpi(ji,jj,jk+1) + wslpi(ji+1,jj  ,jk+1) ) * fsaeitru(ji,jj,jk+1) * umask(ji,jj,jk+1)
-                     zvwk = ( wslpj(ji,jj,jk  ) + wslpj(ji  ,jj+1,jk  ) ) * fsaeitrv(ji,jj,jk  ) * vmask(ji,jj,jk  )
-                     zvwk1= ( wslpj(ji,jj,jk+1) + wslpj(ji  ,jj+1,jk+1) ) * fsaeitrv(ji,jj,jk+1) * vmask(ji,jj,jk+1)
-                     
-                     zcg1= -0.25 * e2u(ji,jj) * umask(ji,jj,jk) * ( zuwk-zuwk1 )
-                     zcg2= -0.25 * e1v(ji,jj) * vmask(ji,jj,jk) * ( zvwk-zvwk1 )
-                     
-                     zftug(ji,jj) = zcg1 * ( trb(ji+1,jj,jk,jn) + trb(ji,jj,jk,jn) )
-                     zftvg(ji,jj) = zcg2 * ( trb(ji,jj+1,jk,jn) + trb(ji,jj,jk,jn) )
-                  END DO
-               END DO
-
-               DO jj = 2 , jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                  
-                     zbtr = 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )
-
-                     !-- Compute zonal & meridional divergences of the eiv field :
-                     !     d_x[u_trc_eiv] = 1/(e1t*e2t*e3t) ( di[e2u*e3u u_trc_eiv] )
-                     !     d_y[v_trc_eiv] = 1/(e1t*e2t*e3t) ( dj[e1v*e3v v_trc_eiv] )
-                     !   N.B.  This is only possible if key_diaeiv is switched on.
-#       if defined key_diaeiv
-                     z_hdivn_x = (  e2u(ji  ,jj) * fse3u(ji  ,jj,jk) * u_trc_eiv(ji  ,jj  ,jk)  &
-                          &       - e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * u_trc_eiv(ji-1,jj  ,jk) ) * zbtr
-                     z_hdivn_y = (  e1v(ji,  jj) * fse3v(ji,jj  ,jk) * v_trc_eiv(ji,  jj  ,jk)  &
-                          &       - e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * v_trc_eiv(ji  ,jj-1,jk) ) * zbtr
-#       else
-                     z_hdivn_x = 0.e0   ;   z_hdivn_y = 0.e0 
-#       endif
-                     !-- Compute the zonal advective trends associated with eiv
-                     ztrtrd_xei(ji,jj,jk) = zbtr * ( zftug(ji,jj) - zftug(ji-1,jj  ) )          &
-                          &                 - trn(ji,jj,jk,jn) * z_hdivn_x
-                     
-                     !-- Compute the merid. advective trends associated with eiv
-                     ztrtrd_yei(ji,jj,jk) = zbtr * ( zftvg(ji,jj) - zftvg(ji  ,jj-1) )          &
-                          &                 - trn(ji,jj,jk,jn) * z_hdivn_y
-
-                  END DO
-               END DO
-               !                                             ! ===============
-            END DO                                           !   End of slab  
-            !                                                ! ===============
-#   else
-            ztrtrd_xei(:,:,:) = 0.e0
-            ztrtrd_yei(:,:,:) = 0.e0
-#   endif
-            ! 4.2) Substract the eddy induced velocity
-            ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:) - ztrtrd_xei(:,:,:) - ztrtrd_yei(:,:,:)
-
-            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd    , jn, jptrc_trd_ldf, kt )
-#   if defined key_trcldf_eiv
-            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd_xei, jn, jptrc_trd_xei, kt )
-            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd_yei, jn, jptrc_trd_yei, kt )
-#   endif
-
-         ENDIF
-         !                                                       ! ===========
-      END DO                                                     ! tracer loop
-      !                                                          ! ===========
-      IF( l_trdtrc ) THEN
-         DEALLOCATE( ztrtrd )
-#   if defined key_trcldf_eiv
-         DEALLOCATE( ztrtrd_xei )
-         DEALLOCATE( ztrtrd_yei )
-#   endif
-      ENDIF
-
-      IF( ln_ctl ) THEN    ! print mean trends (used for debugging)
-         WRITE(charout, FMT="('ldf - iso/zps')")
-         CALL prt_ctl_trc_info( charout )
-         CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd' )
-      ENDIF
-
-   END SUBROUTINE trc_ldf_iso_zps
-
-#else
-   !!----------------------------------------------------------------------
-   !!   default option :   Dummy code   NO rotation of the diffusive tensor
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE trc_ldf_iso_zps( kt )               ! Empty routine
-      INTEGER, INTENT(in) :: kt
-      WRITE(*,*) 'trc_ldf_iso_zps: You should not have seen this print! error?', kt
-   END SUBROUTINE trc_ldf_iso_zps
-#endif
-
-   !!==============================================================================
-END MODULE trcldf_iso_zps
Index: trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf_lap.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf_lap.F90	(revision 2527)
+++ 	(revision )
@@ -1,181 +1,0 @@
-MODULE trcldf_lap
-   !!======================================================================
-   !!                       ***  MODULE  trcldf_lap  ***
-   !! Ocean passive tracers:  horizontal component of the lateral tracer mixing trend
-   !!======================================================================
-   !! History :  1.0  !  87-06  (P. Andrich, D. L Hostis)  Original code
-   !!                 !  91-11  (G. Madec)
-   !!                 !  95-02  (M. Levy)    passive tracers
-   !!                 !  95-11  (G. Madec)  suppress volumetric scale factors
-   !!                 !  96-01  (G. Madec)  statement function for e3
-   !!            8.5  !  02-06  (G. Madec)  F90: Free form and module
-   !!            9.0  !  04-03  (C. Ethe)   passive tracer
-   !!                 !  07-02  (C. Deltel)  Diagnose ML trends for passive tracers
-   !!----------------------------------------------------------------------
-#if defined key_top
-   !!----------------------------------------------------------------------
-   !!   trc_ldf_lap  : update the tracer trend with the horizontal diffusion
-   !!                 using a iso-level harmonic (laplacien) operator.
-   !!----------------------------------------------------------------------
-   USE oce_trc             ! ocean dynamics and active tracers variables
-   USE trp_trc                 ! ocean passive tracers variables
-   USE prtctl_trc          ! Print control for debbuging
-   USE trdmld_trc
-   USE trdmld_trc_oce     
-
-   IMPLICIT NONE
-   PRIVATE
-
-   !! * Routine accessibility
-   PUBLIC trc_ldf_lap  ! routine called by step.F90
-
-   !! * Substitutions
-#  include "top_substitute.h90"
-   !!----------------------------------------------------------------------
-   !!   TOP 1.0 , LOCEAN-IPSL (2005) 
-   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcldf_lap.F90,v 1.10 2006/09/12 11:10:14 opalod Exp $ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-   
-CONTAINS
-
-   SUBROUTINE trc_ldf_lap( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE trc_ldf_lap  ***
-      !!                   
-      !! ** Purpose :   Compute the before horizontal tracer diffusive 
-      !!      trend and add it to the general trend of tracer equation.
-      !!
-      !! ** Method  :   Second order diffusive operator evaluated using before
-      !!      fields (forward time scheme). The horizontal diffusive trends of 
-      !!      the passive tracer is given by:
-      !!       * s-coordinate, the vertical scale 
-      !!      factors e3. are inside the derivatives:
-      !!          difft = 1/(e1t*e2t*e3t) {  di-1[ aht e2u*e3u/e1u di(trb) ]
-      !!                                   + dj-1[ aht e1v*e3v/e2v dj(trb) ] }
-      !!       * z-coordinate (default key), e3t=e3u=e3v, the trend becomes:
-      !!          difft = 1/(e1t*e2t) {  di-1[ aht e2u/e1u di(trb) ]
-      !!                               + dj-1[ aht e1v/e2v dj(trb) ] }
-      !!      Add this trend to the general tracer trend tra :
-      !!          tra = tra + difft
-      !!
-      !! ** Action  : - Update tra arrays with the before iso-level 
-      !!                harmonic mixing trend.
-      !!              - Save the trends ('key_trdmld_trc')
-      !!----------------------------------------------------------------------
-      USE oce_trc          , ztu => ua,  &  ! use ua as workspace
-         &                   ztv => va      ! use va as workspace
-
-      INTEGER, INTENT( in ) ::   kt       ! ocean time-step index
-
-      !! * Local save
-      REAL(wp), DIMENSION(jpi,jpj), SAVE ::   &
-         ze1ur, ze2vr, zbtr2              ! scale factor coefficients
-      
-      INTEGER ::   ji, jj, jk, jn         ! dummy loop indices
-      REAL(wp) ::   &
-         zabe1, zabe2, zbtr               ! temporary scalars
-
-      REAL(wp) ::   &
-         ztrax, ztray               ! workspace
-      CHARACTER (len=22) :: charout
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd
-      !!----------------------------------------------------------------------
-      
-      IF( kt == nittrc000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'trc_ldf_lap : iso-level laplacian diffusion'
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ '
-         ze1ur(:,:) = e2u(:,:) / e1u(:,:)
-         ze2vr(:,:) = e1v(:,:) / e2v(:,:)
-         zbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) )
-      ENDIF
-
-      IF( l_trdtrc ) THEN
-!         STOP 'trcldf_lap: this was never validated, please comment this line to proceed...'
-      ENDIF
-
-      IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk) )
-
-      !                                                          ! ===========
-      DO jn = 1, jptra                                           ! tracer loop
-         !                                                       ! ===========
-         IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)
-         
-         !                                                  ! =============
-         DO jk = 1, jpkm1                                   ! Vertical slab
-            !                                               ! =============
-            ! 1. First derivative (gradient)
-            ! ------------------------------
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  IF ( ln_sco ) THEN
-                     zabe1 = fsahtru(ji,jj,jk) * umask(ji,jj,jk) * ze1ur(ji,jj) * fse3u(ji,jj,jk)
-                     zabe2 = fsahtrv(ji,jj,jk) * vmask(ji,jj,jk) * ze2vr(ji,jj) * fse3v(ji,jj,jk)
-                  ELSE
-                     zabe1 = fsahtru(ji,jj,jk) * umask(ji,jj,jk) * ze1ur(ji,jj)
-                     zabe2 = fsahtrv(ji,jj,jk) * vmask(ji,jj,jk) * ze2vr(ji,jj)
-                  ENDIF
-                  ztu(ji,jj,jk) = zabe1 * ( trb(ji+1,jj  ,jk,jn) - trb(ji,jj,jk,jn) )
-                  ztv(ji,jj,jk) = zabe2 * ( trb(ji  ,jj+1,jk,jn) - trb(ji,jj,jk,jn) )
-               END DO
-            END DO
-
-
-            ! 2. Second derivative (divergence)
-            ! ---------------------------------
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  IF ( ln_sco ) THEN
-                     zbtr = zbtr2(ji,jj) / fse3t(ji,jj,jk)
-                  ELSE
-                     zbtr = zbtr2(ji,jj)
-                  ENDIF
-                  ! horizontal diffusive trends
-                  ztrax = zbtr * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) )
-                  ztray = zbtr * ( ztv(ji,jj,jk) - ztv(ji,jj-1,jk) )
-
-                  ! add it to the general tracer trends
-                  tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztrax + ztray
-#if defined key_trc_diatrd
-                  ! save the horizontal diffusive trends
-                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),4) = ztrax
-                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),5) = ztray
-#endif
-
-               END DO
-            END DO
-            !                                               ! =============
-         END DO                                             !  End of slab  
-         !                                                  ! =============
-         IF( l_trdtrc ) THEN
-            ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:)
-            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd, jn, jptrc_trd_ldf, kt )   ! trends diags
-         END IF
-         !                                                       ! ===========
-      END DO                                                     ! tracer loop
-      !                                                          ! ===========
-
-      IF( l_trdtrc ) DEALLOCATE( ztrtrd )
-
-      IF( ln_ctl ) THEN    ! print mean trends (used for debugging)
-         WRITE(charout, FMT="('ldf - lap')")
-         CALL prt_ctl_trc_info( charout )
-         CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
-      ENDIF
-
-   END SUBROUTINE trc_ldf_lap
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option                                         Empty module
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE trc_ldf_lap( kt )  
-      INTEGER, INTENT(in) :: kt
-      WRITE(*,*) 'trc_ldf_lap: You should not have seen this print! error?', kt
-   END SUBROUTINE trc_ldf_lap
-#endif
-
-   !!==============================================================================
-END MODULE trcldf_lap
Index: trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcnam_trp.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcnam_trp.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcnam_trp.F90	(revision 2528)
@@ -0,0 +1,177 @@
+MODULE trcnam_trp
+   !!======================================================================
+   !!                       ***  MODULE  trcnam_trp  ***
+   !! TOP :   namelist read options for transport
+   !!======================================================================
+   !! History :   1.0  !  2004-03  (C. Ethe)  Original code
+   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_nam_trp  : read the passive tracer namelist for transport
+   !!----------------------------------------------------------------------
+   USE trc                 ! ocean passive tracers variables
+   USE in_out_manager      ! ocean dynamics and active tracers variables
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_nam_trp    ! routine called by step module
+ 
+   !                                                 !!: ** Advection (nam_trcadv) **
+   LOGICAL , PUBLIC ::   ln_trcadv_cen2   = .FALSE.   ! 2nd order centered scheme flag
+   LOGICAL , PUBLIC ::   ln_trcadv_tvd    = .TRUE.    ! TVD scheme flag
+   LOGICAL , PUBLIC ::   ln_trcadv_muscl  = .FALSE.   ! MUSCL scheme flag
+   LOGICAL , PUBLIC ::   ln_trcadv_muscl2 = .FALSE.   ! MUSCL2 scheme flag
+   LOGICAL , PUBLIC ::   ln_trcadv_ubs    = .FALSE.   ! UBS scheme flag
+   LOGICAL , PUBLIC ::   ln_trcadv_qck    = .FALSE.   ! QUICKEST scheme flag
+
+   !                                                 !!: ** lateral mixing namelist (nam_trcldf) **
+   LOGICAL , PUBLIC ::   ln_trcldf_diff  = .FALSE.    !: flag of perform or not the lateral diff.
+   LOGICAL , PUBLIC ::   ln_trcldf_lap   = .TRUE.     !: laplacian operator
+   LOGICAL , PUBLIC ::   ln_trcldf_bilap = .FALSE.    !: bilaplacian operator
+   LOGICAL , PUBLIC ::   ln_trcldf_level = .FALSE.    !: iso-level direction
+   LOGICAL , PUBLIC ::   ln_trcldf_hor   = .FALSE.    !: horizontal (geopotential) direction
+   LOGICAL , PUBLIC ::   ln_trcldf_iso   = .TRUE.     !: iso-neutral direction
+   REAL(wp), PUBLIC ::   rn_ahtrb_0                   !: background diffusivity coefficient for passive tracer (m2/s)
+
+   !                                                 !!: ** Treatment of Negative concentrations ( nam_trcrad )
+   LOGICAL , PUBLIC ::   ln_trcrad       = .TRUE.     !: flag to artificially correct negative concentrations
+
+   !                                                 !!: ** Vertical diffusion (nam_trczdf) **
+   LOGICAL , PUBLIC ::   ln_trczdf_exp = .FALSE.      !: explicit vertical diffusion scheme flag
+   INTEGER , PUBLIC ::   nn_trczdf_exp = 3             !: number of sub-time step (explicit time stepping)
+
+
+#if defined key_trcdmp
+   !                                                 !!: ** newtonian damping namelist (nam_trcdmp) **
+   INTEGER , PUBLIC ::   nn_hdmp_tr      =   -1       ! = 0/-1/'latitude' for damping over passive tracer
+   INTEGER , PUBLIC ::   nn_zdmp_tr      =    0       ! = 0/1/2 flag for damping in the mixed layer
+   REAL(wp), PUBLIC ::   rn_surf_tr      =   50.      ! surface time scale for internal damping        [days]
+   REAL(wp), PUBLIC ::   rn_bot_tr       =  360.      ! bottom time scale for internal damping         [days]
+   REAL(wp), PUBLIC ::   rn_dep_tr       =  800.      ! depth of transition between rn_surf and rn_bot [meters]
+   INTEGER , PUBLIC ::   nn_file_tr      =    2       ! = 1 create a damping.coeff NetCDF file 
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_nam_trp
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_nam_trp  ***
+      !!                
+      !! ** Purpose :   Read Namelist for tracer transport option
+      !!----------------------------------------------------------------------
+      NAMELIST/namtrc_adv/ ln_trcadv_cen2 , ln_trcadv_tvd   ,    &
+         &                 ln_trcadv_muscl, ln_trcadv_muscl2,    &
+         &                 ln_trcadv_ubs  , ln_trcadv_qck
+
+      NAMELIST/namtrc_ldf/ ln_trcldf_diff , ln_trcldf_lap  ,     &
+         &                 ln_trcldf_bilap, ln_trcldf_level,     &
+         &                 ln_trcldf_hor  , ln_trcldf_iso  , rn_ahtrb_0
+      NAMELIST/namtrc_zdf/ ln_trczdf_exp  , nn_trczdf_exp
+      NAMELIST/namtrc_rad/ ln_trcrad
+#if defined key_trcdmp
+      NAMELIST/namtrc_dmp/ nn_hdmp_tr, nn_zdmp_tr, rn_surf_tr, &
+        &                  rn_bot_tr , rn_dep_tr , nn_file_tr
+#endif
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_nam_trp: read namelist for tracer transport'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~'
+
+      REWIND ( numnat )               ! Read Namelist namtrc_adv : tracer advection scheme
+      READ   ( numnat, namtrc_adv )
+
+      IF(lwp) THEN                    ! Namelist print
+         WRITE(numout,*)
+         WRITE(numout,*) 'trc_adv_ctl : choice/control of the tracer advection scheme'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namtrc_adv : chose a advection scheme for tracers'
+         WRITE(numout,*) '      2nd order advection scheme     ln_trcadv_cen2   = ', ln_trcadv_cen2
+         WRITE(numout,*) '      TVD advection scheme           ln_trcadv_tvd    = ', ln_trcadv_tvd
+         WRITE(numout,*) '      MUSCL  advection scheme        ln_trcadv_muscl  = ', ln_trcadv_muscl
+         WRITE(numout,*) '      MUSCL2 advection scheme        ln_trcadv_muscl2 = ', ln_trcadv_muscl2
+         WRITE(numout,*) '      UBS    advection scheme        ln_trcadv_ubs    = ', ln_trcadv_ubs
+         WRITE(numout,*) '      QUICKEST advection scheme      ln_trcadv_qck    = ', ln_trcadv_qck
+      ENDIF
+      !
+      REWIND( numnat )                ! Namelist namtrc_ldf
+      READ  ( numnat, namtrc_ldf )
+
+      IF(lwp) THEN                    ! Namelist print
+         WRITE(numout,*)
+         WRITE(numout,*) 'trc:ldf_ctl : lateral tracer diffusive operator'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namtrc_ldf : set lateral mixing parameters (type, direction, coefficients)'
+         WRITE(numout,*) '      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
+         WRITE(numout,*) '      iso-level                                          ln_trcldf_level = ', ln_trcldf_level
+         WRITE(numout,*) '      horizontal (geopotential)                          ln_trcldf_hor   = ', ln_trcldf_hor
+         WRITE(numout,*) '      iso-neutral                                        ln_trcldf_iso   = ', ln_trcldf_iso
+         WRITE(numout,*) '      background hor. diffusivity                             rn_ahtrb_0 = ', rn_ahtrb_0
+      ENDIF
+
+      !                                ! Vertical mixing
+      REWIND( numnat )                 !   ! Read namtopzdf namelist
+      READ  ( numnat, namtrc_zdf )
+
+      IF(lwp) THEN                     !   ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) '   Namelist namtrc_zdf : set vertical diffusion parameters'
+         WRITE(numout,*) '      time splitting / backward scheme ln_trczdf_exp = ', ln_trczdf_exp
+         WRITE(numout,*) '      number of time step              nn_trczdf_exp = ', nn_trczdf_exp
+      ENDIF
+
+      !
+      REWIND( numnat )                 !   Read Namelist namtoprad
+      READ  ( numnat, namtrc_rad )
+
+      IF(lwp) THEN                     !   ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) '   Namelist namtrc_rad : treatment of negative concentrations'
+         WRITE(numout,*) '      correct artificially negative concen. or not ln_trcrad = ', ln_trcrad
+      ENDIF
+
+
+# if defined key_trcdmp
+      REWIND ( numnat )                  ! Read Namelist namtra_dmp : temperature and salinity damping term
+      READ   ( numnat, namtrc_dmp )
+      IF( lzoom )   nn_zdmp_trc = 0           ! restoring to climatology at closed north or south boundaries
+
+      IF(lwp) THEN                       ! Namelist print
+         WRITE(numout,*)
+         WRITE(numout,*) 'trc_dmp : Passive tracers newtonian damping'
+         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,*) '   Namelist namtrc_dmp : set damping parameter'
+         WRITE(numout,*) '      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
+      ENDIF
+#endif
+      !
+   END SUBROUTINE trc_nam_trp
+   
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :                                         No TOP model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_nam_trp              ! Empty routine
+   END SUBROUTINE trc_nam_trp
+#endif
+
+  !!======================================================================
+END MODULE trcnam_trp
Index: trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90	(revision 2528)
@@ -5,14 +5,19 @@
    !!======================================================================
    !!======================================================================
-   !! History :  7.0  !  91-11  (G. Madec)  Original code
-   !!                 !  93-03  (M. Guyon)  symetrical conditions
-   !!                 !  95-02  (M. Levy)   passive tracers
-   !!                 !  96-02  (G. Madec & M. Imbard)  opa release 8.0
-   !!            8.0  !  96-04  (A. Weaver)  Euler forward step
-   !!            8.2  !  99-02  (G. Madec, N. Grima)  semi-implicit pressure grad.
-   !!            8.5  !  02-08  (G. Madec)  F90: Free form and module
-   !!                 !  02-11  (C. Talandier, A-M Treguier) Open boundaries
-   !!            9.0  !  04-03  (C. Ethe) passive tracers
-   !!                 !  07-02  (C. Deltel) Diagnose ML trends for passive tracers
+   !! History :  7.0  !  1991-11  (G. Madec)  Original code
+   !!                 !  1993-03  (M. Guyon)  symetrical conditions
+   !!                 !  1995-02  (M. Levy)   passive tracers
+   !!                 !  1996-02  (G. Madec & M. Imbard)  opa release 8.0
+   !!            8.0  !  1996-04  (A. Weaver)  Euler forward step
+   !!            8.2  !  1999-02  (G. Madec, N. Grima)  semi-implicit pressure grad.
+   !!  NEMO      1.0  !  2002-08  (G. Madec)  F90: Free form and module
+   !!                 !  2002-08  (G. Madec)  F90: Free form and module
+   !!                 !  2002-11  (C. Talandier, A-M Treguier) Open boundaries
+   !!                 !  2004-03  (C. Ethe) passive tracers
+   !!                 !  2007-02  (C. Deltel) Diagnose ML trends for passive tracers
+   !!            2.0  !  2006-02  (L. Debreu, C. Mazauric) Agrif implementation
+   !!            3.0  !  2008-06  (G. Madec)  time stepping always done in trazdf
+   !!            3.1  !  2009-02  (G. Madec, R. Benshila)  re-introduce the vvl option
+   !!            3.3  !  2010-06  (C. Ethe, G. Madec) Merge TRA-TRC
    !!----------------------------------------------------------------------
 #if defined key_top
@@ -24,12 +29,14 @@
    !! * Modules used
    USE oce_trc         ! ocean dynamics and tracers variables
-   USE trp_trc             ! ocean passive tracers variables
+   USE trc             ! ocean passive tracers variables
    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
-   USE trctrp_lec      ! pasive tracers transport
    USE prtctl_trc      ! Print control for debbuging
-   USE trdmld_trc
-   USE trdmld_trc_oce
+   USE trdmod_oce
+   USE trdtra
+   USE tranxt
+# if defined key_agrif
    USE agrif_top_update
    USE agrif_top_interp
+# endif
 
    IMPLICIT NONE
@@ -38,8 +45,10 @@
    !! * Routine accessibility
    PUBLIC trc_nxt          ! routine called by step.F90
+
+  REAL(wp), DIMENSION(jpk) ::   r2dt
    !!----------------------------------------------------------------------
-   !!   TOP 1.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -70,112 +79,78 @@
       !! ** Action  : - update trb, trn
       !!----------------------------------------------------------------------
-      USE oce, ONLY :   ztrtrd => ua    ! use ua as 3D workspace 
       !! * Arguments
       INTEGER, INTENT( in ) ::   kt     ! ocean time-step index
       !! * Local declarations
-      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      INTEGER  ::   jk, jn   ! dummy loop indices
       REAL(wp) ::   zfact            ! temporary scalar
       CHARACTER (len=22) :: charout
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  ztrdt 
       !!----------------------------------------------------------------------
 
-      IF( kt == nittrc000 .AND. lwp ) THEN
+      IF( kt == nit000 .AND. lwp ) THEN
          WRITE(numout,*)
          WRITE(numout,*) 'trc_nxt : time stepping on passive tracers'
       ENDIF
 
+      ! Update after tracer on domain lateral boundaries
       DO jn = 1, jptra
+         CALL lbc_lnk( tra(:,:,:,jn), 'T', 1. )   
+      END DO
 
-         ! 0. Lateral boundary conditions on tra (T-point, unchanged sign)
-         ! ---------------------------------============
-         CALL lbc_lnk( tra(:,:,:,jn), 'T', 1. )   
-         
-         !                                                ! ===============
-         DO jk = 1, jpk                                   ! Horizontal slab
-            !                                             ! ===============
-            ! 1. Leap-frog scheme (only in explicit case, otherwise the 
-            ! -------------------  time stepping is already done in trczdf)
-            IF( l_trczdf_exp .AND. ( ln_trcadv_cen2 .OR. ln_trcadv_tvd) ) THEN
-               zfact = 2. * rdttra(jk) * FLOAT(ndttrc) 
-               IF( neuler == 0 .AND. kt == nittrc000 ) zfact = rdttra(jk) * FLOAT(ndttrc) 
-               tra(:,:,jk,jn) = ( trb(:,:,jk,jn) + zfact * tra(:,:,jk,jn) ) * tmask(:,:,jk)
-            ENDIF
-
-         END DO
 
 #if defined key_obc
-        CALL ctl_stop( '          Passive tracers and Open Boundary condition can not be used together ' &
-           &           '          Check in trc_nxt routine' )
+!!      CALL obc_trc( kt )               ! OBC open boundaries
+#endif
+#if defined key_bdy
+!!      CALL bdy_trc( kt )               ! BDY open boundaries
+#endif
+#if defined key_agrif
+      CALL Agrif_trc                   ! AGRIF zoom boundaries
 #endif
 
+
+      ! set time step size (Euler/Leapfrog)
+      IF( neuler == 0 .AND. kt ==  nit000) THEN  ;  r2dt(:) =     rdttrc(:)   ! at nit000             (Euler)
+      ELSEIF( kt <= nit000 + 1 )           THEN  ;  r2dt(:) = 2.* rdttrc(:)   ! at nit000 or nit000+1 (Leapfrog)
+      ENDIF
+
+      ! trends computation initialisation
+      IF( l_trdtrc )  THEN
+         ALLOCATE( ztrdt(jpi,jpj,jpk,jptra) )  !* store now fields before applying the Asselin filter
+         ztrdt(:,:,:,:)  = trn(:,:,:,:)
+      ENDIF
+      ! Leap-Frog + Asselin filter time stepping
+      IF( neuler == 0 .AND. kt == nit000 ) THEN        ! Euler time-stepping at first time-step
+         !                                             ! (only swap)
+         DO jn = 1, jptra
+            DO jk = 1, jpkm1
+               trn(:,:,jk,jn) = tra(:,:,jk,jn)
+            END DO
+         END DO
+         !                                              
+      ELSE
+         ! Leap-Frog + Asselin filter time stepping
+         IF( lk_vvl ) THEN   ;   CALL tra_nxt_vvl( kt, 'TRC', trb, trn, tra, jptra )      ! variable volume level (vvl) 
+         ELSE                ;   CALL tra_nxt_fix( kt, 'TRC', trb, trn, tra, jptra )      ! fixed    volume level 
+         ENDIF
+      ENDIF
+
 #if defined key_agrif
-         !                                             ! ===============
-      END DO                                           !   End of slab
-      !                                                ! ===============
-      ! Interp tracers on boundaries (coarse => fine)
-      CALL Agrif_trc
-      !                                                ! ===============
-      DO jn = 1, jptra                                 ! Horizontal slab
-         !                                             ! ===============
-#endif
+      ! Update tracer at AGRIF zoom boundaries
+      IF( .NOT.Agrif_Root() )    CALL Agrif_Update_Trc( kt )      ! children only
+#endif      
 
-         DO jk = 1, jpk  
-
-            ! 2. Time filter and swap of arrays
-            ! ---------------------------------
-            IF ( ln_trcadv_cen2 .OR. ln_trcadv_tvd  ) THEN
-
-               IF( neuler == 0 .AND. kt == nittrc000 ) THEN
-                  DO jj = 1, jpj
-                     DO ji = 1, jpi
-                        trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn)
-                        trn(ji,jj,jk,jn) = tra(ji,jj,jk,jn)
-                        tra(ji,jj,jk,jn) = 0.
-                     END DO
-                  END DO
-                  IF( l_trdtrc )   ztrtrd(:,:,:) = 0.e0           !    no trend
-               ELSE
-                  IF( l_trdtrc ) THEN                             !    Asselin trend
-                     DO jj = 1, jpj
-                        DO ji = 1, jpi
-                           ztrtrd(ji,jj,jk) = atfp * ( trb(ji,jj,jk,jn) - 2*trn(ji,jj,jk,jn) + tra(ji,jj,jk,jn) )
-                        END DO
-                     END DO
-                  ENDIF
-
-                  DO jj = 1, jpj
-                     DO ji = 1, jpi
-                        trb(ji,jj,jk,jn) = atfp  * ( trb(ji,jj,jk,jn) + tra(ji,jj,jk,jn) ) + atfp1 * trn(ji,jj,jk,jn)
-                        trn(ji,jj,jk,jn) = tra(ji,jj,jk,jn)
-                        tra(ji,jj,jk,jn) = 0.
-                     END DO
-                  END DO
-               ENDIF
-            ELSE                                                  ! >> EULER-FORWARD schemes (SMOLAR, MUSCL)
-               IF( l_trdtrc ) ztrtrd(:,:,:) = 0.e0                !    no trend
-
-               DO jj = 1, jpj
-                  DO ji = 1, jpi
-                     trb(ji,jj,jk,jn) = tra(ji,jj,jk,jn)
-                     trn(ji,jj,jk,jn) = tra(ji,jj,jk,jn)
-                     tra(ji,jj,jk,jn) = 0.
-                  END DO
-               END DO
-
-            ENDIF
-            !                                             ! ===============
-         END DO                                           !   End of slab
-         !                                                ! ===============
-
-         IF( l_trdtrc ) THEN                                      ! trends
-            DO jk = 1, jpk
-               zfact = 2. * rdttra(jk) * FLOAT(ndttrc)
-               ztrtrd(:,:,jk) = ztrtrd(:,:,jk) / zfact            ! n.b. ztrtrd=0 in Euler-forward case
+      ! trends computation
+      IF( l_trdtrc ) THEN                                      ! trends
+         DO jn = 1, jptra
+            DO jk = 1, jpkm1
+               zfact = 1.e0 / r2dt(jk)  
+               ztrdt(:,:,jk,jn) = ( trb(:,:,jk,jn) - ztrdt(:,:,jk,jn) ) * zfact 
+               CALL trd_tra( kt, 'TRC', jn, jptra_trd_atf, ztrdt )
             END DO
-            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd, jn, jptrc_trd_atf, kt )
-         ENDIF
-         !                                                        ! ===========
-      END DO                                                      ! tracer loop
-      !                                                           ! ===========
-
+         END DO
+         DEALLOCATE( ztrdt )
+      END IF
+      !
       IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
          WRITE(charout, FMT="('nxt')")
@@ -183,10 +158,5 @@
          CALL prt_ctl_trc(tab4d=trn, mask=tmask, clinfo=ctrcnm)
       ENDIF
-
-#if defined key_agrif
-      IF (.NOT.Agrif_Root())    CALL Agrif_Update_Trc( kt )
-#endif      
-
-
+      !
    END SUBROUTINE trc_nxt
 
Index: trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90	(revision 2528)
@@ -14,7 +14,7 @@
    !!----------------------------------------------------------------------
    USE oce_trc             ! ocean dynamics and tracers variables
-   USE trp_trc             ! ocean passive tracers variables
-   USE trdmld_trc
-   USE trdmld_trc_oce
+   USE trc                 ! ocean passive tracers variables
+   USE trdmod_oce
+   USE trdtra
    USE lib_mpp
    USE prtctl_trc          ! Print control for debbuging
@@ -28,7 +28,7 @@
 #  include "top_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
    
@@ -54,5 +54,5 @@
       !!----------------------------------------------------------------------
 
-      IF( kt == nittrc000 ) THEN
+      IF( kt == nit000 ) THEN
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) 'trc_rad : Correct artificial negative concentrations '
@@ -139,5 +139,5 @@
                   DO ji = 1, jpi
                      zvolk  = cvol(ji,jj,jk)
-# if defined key_off_degrad
+# if defined key_degrad
                      zvolk  = zvolk * facvol(ji,jj,jk)
 # endif
@@ -180,6 +180,6 @@
                ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt
                ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt 
-               IF (luttrd(jn)) CALL trd_mod_trc( ztrtrdb, jn, jptrc_trd_radb, kt )       ! Asselin-like trend handling
-               IF (luttrd(jn)) CALL trd_mod_trc( ztrtrdn, jn, jptrc_trd_radn, kt )       ! standard     trend handling
+               CALL trd_tra( kt, 'TRC', jn, jptra_trd_radb, ztrtrdb )       ! Asselin-like trend handling
+               CALL trd_tra( kt, 'TRC', jn, jptra_trd_radn, ztrtrdn )       ! standard     trend handling
               !
             ENDIF
@@ -208,9 +208,9 @@
             IF( l_trdtrc ) THEN
                !
-               zs2rdt = 1. / ( 2. * rdt * FLOAT(ndttrc) )
+               zs2rdt = 1. / ( 2. * rdt * FLOAT(nn_dttrc) )
                ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt
                ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt 
-               IF (luttrd(jn)) CALL trd_mod_trc( ztrtrdb, jn, jptrc_trd_radb, kt )       ! Asselin-like trend handling
-               IF (luttrd(jn)) CALL trd_mod_trc( ztrtrdn, jn, jptrc_trd_radn, kt )       ! standard     trend handling
+               CALL trd_tra( kt, 'TRC', jn, jptra_trd_radb, ztrtrdb )       ! Asselin-like trend handling
+               CALL trd_tra( kt, 'TRC', jn, jptra_trd_radn, ztrtrdn )       ! standard     trend handling
               !
             ENDIF
Index: trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90	(revision 2528)
@@ -4,9 +4,9 @@
    !! Ocean passive tracers:  surface boundary condition
    !!======================================================================
-   !! History :  8.2  !  98-10  (G. Madec, G. Roullet, M. Imbard)  Original code
-   !!            8.2  !  01-02  (D. Ludicone)  sea ice and free surface
-   !!            8.5  !  02-06  (G. Madec)  F90: Free form and module
-   !!            9.0  !  04-03  (C. Ethe)  adapted for passive tracers
-   !!                 !  06-08  (C. Deltel) Diagnose ML trends for passive tracers
+   !! History :  8.2  !  1998-10  (G. Madec, G. Roullet, M. Imbard)  Original code
+   !!            8.2  !  2001-02  (D. Ludicone)  sea ice and free surface
+   !!            8.5  !  2002-06  (G. Madec)  F90: Free form and module
+   !!            9.0  !  2004-03  (C. Ethe)  adapted for passive tracers
+   !!                 !  2006-08  (C. Deltel) Diagnose ML trends for passive tracers
    !!==============================================================================
 #if defined key_top
@@ -18,8 +18,8 @@
    !! * Modules used
    USE oce_trc             ! ocean dynamics and active tracers variables
-   USE trp_trc                 ! ocean  passive tracers variables
+   USE trc                 ! ocean  passive tracers variables
    USE prtctl_trc          ! Print control for debbuging
-   USE trdmld_trc
-   USE trdmld_trc_oce
+   USE trdmod_oce
+   USE trdtra
 
    IMPLICIT NONE
@@ -32,7 +32,7 @@
 #  include "top_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   TOP 1.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -65,10 +65,11 @@
       !! * Local declarations
       INTEGER  ::   ji, jj, jn           ! dummy loop indices
-      REAL(wp) ::   ztra, zsrau, zse3t   ! temporary scalars
+      REAL(wp) ::   zsrau, zse3t   ! temporary scalars
+      REAL(wp), DIMENSION(jpi,jpj) ::   zemps  ! surface freshwater flux
       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd
       CHARACTER (len=22) :: charout
       !!----------------------------------------------------------------------
 
-      IF( kt == nittrc000 ) THEN
+      IF( kt == nit000 ) THEN
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) 'trc_sbc : Passive tracers surface boundary condition'
@@ -76,26 +77,30 @@
       ENDIF
 
+
       IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk) )
+
+      IF( lk_offline ) THEN          ! emps in dynamical files contains emps - rnf
+         zemps(:,:) = emps(:,:)  
+      ELSE                           ! Concentration dilution effect on tracer due to evaporation, precipitation, and river runoff
+         IF( lk_vvl ) THEN                      ! volume variable
+            zemps(:,:) = emps(:,:) - emp(:,:)   
+!!ch         zemps(:,:) = 0.
+         ELSE                                   ! linear free surface
+            IF( ln_rnf ) THEN  ;  zemps(:,:) = emps(:,:) - rnf(:,:)   !  E-P-R
+            ELSE               ;  zemps(:,:) = emps(:,:)
+            ENDIF 
+         ENDIF 
+      ENDIF 
 
       ! 0. initialization
       zsrau = 1. / rau0
-      IF( .NOT. ln_sco )  zse3t = 1. / fse3t(1,1,1)
-
       DO jn = 1, jptra
-         ! 1. Concentration dillution effect on tra
+         !
          IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)  ! save trends
-
+         !                                             ! add the trend to the general tracer trend
          DO jj = 2, jpj
             DO ji = fs_2, fs_jpim1   ! vector opt.
-               IF( ln_sco ) zse3t = 1. / fse3t(ji,jj,1)
-               ! concent./dilut. effect
-               ztra = emps(ji,jj) * zsrau * trn(ji,jj,1,jn) * zse3t * tmask(ji,jj,1)
-               ! add the trend to the general tracer trend
-               tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + ztra
-#if defined key_trc_diatrd
-               IF( luttrd(jn) ) &
-               &    trtrd(ji,jj,1,ikeep(jn),jpdiatrc) = trtrd(ji,jj,1,ikeep(jn),jpdiatrc) + ztra
-#endif
-
+               zse3t = 1. / fse3t(ji,jj,1)
+               tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + zemps(ji,jj) *  zsrau * trn(ji,jj,1,jn) * zse3t
             END DO
          END DO
@@ -103,18 +108,14 @@
          IF( l_trdtrc ) THEN
             ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:)
-            IF (luttrd(jn)) CALL trd_mod_trc(ztrtrd, jn, jptrc_trd_sbc, kt)
+            CALL trd_tra( kt, 'TRC', jn, jptra_trd_nsr, ztrtrd )
          END IF
-
          !                                                       ! ===========
       END DO                                                     ! tracer loop
       !                                                          ! ===========
-
       IF( l_trdtrc ) DEALLOCATE( ztrtrd )
 
-
-      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
-         WRITE(charout, FMT="('sbc')")
-         CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+      IF( ln_ctl )   THEN
+         WRITE(charout, FMT="('sbc ')") ;  CALL prt_ctl_trc_info(charout)
+                                           CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
       ENDIF
 
Index: trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90	(revision 2528)
@@ -5,4 +5,5 @@
    !!======================================================================
    !! History :   1.0  !  2004-03 (C. Ethe) Original code
+   !!             3.3  !  2010-07 (C. Ethe) Merge TRA-TRC
    !!----------------------------------------------------------------------
 #if defined key_top
@@ -13,33 +14,17 @@
    !!----------------------------------------------------------------------
    USE oce_trc         ! ocean dynamics and active tracers variables
-   USE trp_trc         ! ocean passive tracers variables 
-   USE trctrp_lec      ! passive tracers transport parameters
-   USE prtctl_trc      ! Print control for debbuging
-
+   USE trc             ! ocean passive tracers variables 
+   USE trcnam_trp      ! passive tracers transport namelist variables
+   USE trabbl          ! bottom boundary layer               (trc_bbl routine)
    USE trcbbl          ! bottom boundary layer               (trc_bbl routine)
+   USE zdfkpp          ! KPP non-local tracer fluxes         (trc_kpp routine)
    USE trcdmp          ! internal damping                    (trc_dmp routine)
-
-   USE trcldf_bilapg   ! lateral mixing               (trc_ldf_bilapg routine)
-   USE trcldf_bilap    ! lateral mixing                (trc_ldf_bilap routine)
-   USE trcldf_iso      ! lateral mixing                  (trc_ldf_iso routine)
-   USE trcldf_iso_zps  ! lateral mixing              (trc_ldf_iso_zps routine)
-   USE trcldf_lap      ! lateral mixing                  (trc_ldf_lap routine)
- 
+   USE trcldf          ! lateral mixing                      (trc_ldf routine)
+   USE trcadv          ! advection                           (trc_adv routine)
+   USE trczdf          ! vertical diffusion                  (trc_zdf routine)
    USE trcnxt          ! time-stepping                       (trc_nxt routine)
    USE trcrad          ! positivity                          (trc_rad routine)
-
-   USE trcadv_cen2     ! 2nd order centered advection   (trc_adv_cen2 routine)
-   USE trcadv_muscl    ! MUSCL advection               (trc_adv_muscl routine)
-   USE trcadv_muscl2   ! MUSCL2 advection             (trc_adv_muscl2 routine)
-   USE trcadv_tvd      ! TVD advection                   (trc_adv_tvd routine)
-   USE trcadv_smolar   ! SMOLAR advection             (trc_adv_smolar routine)
-
-   USE trczdf_exp      ! vertical diffusion              (trc_zdf_exp routine)
-   USE trczdf_imp      ! vertical diffusion              (trc_zdf_exp routine)
-   USE trczdf_iso      ! vertical diffusion              (trc_zdf_exp routine)
-   USE trczdf_iso_vopt ! vertical diffusion              (trc_zdf_exp routine)
    USE trcsbc          ! surface boundary condition          (trc_sbc routine)
-
-   USE zpshde_trc      ! partial step: hor. derivative   (zps_hde_trc routine)
+   USE zpshde          ! partial step: hor. derivative       (zps_hde routine)
 
 #if defined key_agrif
@@ -55,12 +40,12 @@
 #  include "top_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
 CONTAINS
 
-   SUBROUTINE trc_trp( kt )
+   SUBROUTINE trc_trp( kstp )
       !!----------------------------------------------------------------------
       !!                     ***  ROUTINE trc_trp  ***
@@ -71,60 +56,33 @@
       !!              - Update the passive tracers
       !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::  kt  ! ocean time-step index
-      !!
-      CHARACTER (len=25) :: charout
+      INTEGER, INTENT( in ) ::  kstp  ! ocean time-step index
       !! ---------------------------------------------------------------------
-
-                               CALL trc_sbc( kt )            ! surface boundary condition
-# if defined key_trcbbc
-!!gm bug : this should be control during the initialisation phase, not here!
-       CALL ctl_stop( '  Bottom heat flux not yet implemented with passive tracer         ' &
-           &          '  Check in trc_trp routine ' )
-# endif 
-      !                                                      ! bottom boundary condition
-      IF( lk_trcbbl_dif    )   CALL trc_bbl_dif( kt )            ! diffusive bottom boundary layer scheme
-      IF( lk_trcbbl_adv    )   CALL trc_bbl_adv( kt )            ! advective (and/or diffusive) bottom boundary layer scheme
-
-      IF( lk_trcdmp        )   CALL trc_dmp( kt )            ! internal damping trends
-
-      !                                                      ! horizontal & vertical advection
-      IF( ln_trcadv_cen2   )   CALL trc_adv_cen2  ( kt )         ! 2nd order centered scheme
-      IF( ln_trcadv_muscl  )   CALL trc_adv_muscl ( kt )         ! MUSCL scheme
-      IF( ln_trcadv_muscl2 )   CALL trc_adv_muscl2( kt )         ! MUSCL2 scheme
-      IF( ln_trcadv_tvd    )   CALL trc_adv_tvd   ( kt )         ! TVD scheme
-      IF( ln_trcadv_smolar )   CALL trc_adv_smolar( kt )         ! SMOLARKIEWICZ scheme
-
- 
-      IF( n_cla == 1   ) THEN
-!!gm bug : this should be control during the initialisation phase, not here!
-         WRITE(ctmp1,*) ' Cross Land Advection not yet implemented with passive tracer n_cla = ',n_cla
-         CALL ctl_stop( ctmp1 )
-      ENDIF
-
-      !                                                      ! lateral mixing 
-      IF( l_trcldf_bilapg  )   CALL trc_ldf_bilapg ( kt )        ! s-coord. horizontal bilaplacian
-      IF( l_trcldf_bilap   )   CALL trc_ldf_bilap  ( kt )        ! iso-level bilaplacian 
-      IF( l_trcldf_iso     )   CALL trc_ldf_iso    ( kt )        ! iso-neutral laplacian 
-      IF( l_trcldf_iso_zps )   CALL trc_ldf_iso_zps( kt )        ! partial step iso-neutral laplacian
-      IF( l_trcldf_lap     )   CALL trc_ldf_lap    ( kt )        ! iso-level laplacian
-
+      IF( .NOT. lk_c1d ) THEN
+         !
+                                CALL trc_sbc( kstp )            ! surface boundary condition
+         IF( lk_trabbl )        CALL trc_bbl( kstp )            ! advective (and/or diffusive) bottom boundary layer scheme
+         IF( lk_trcdmp )        CALL trc_dmp( kstp )            ! internal damping trends
+                                CALL trc_adv( kstp )            ! horizontal & vertical advection 
+                                CALL trc_ldf( kstp )            ! lateral mixing
+         IF( .NOT. lk_offline .AND. lk_zdfkpp )    &
+            &                   CALL trc_kpp( kstp )            ! KPP non-local tracer fluxes
 #if defined key_agrif
-      IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_trc               ! tracers sponge
+         IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_trc           ! tracers sponge
 #endif
- 
-      !                                                      ! vertical diffusion
-      IF( l_trczdf_exp     )   CALL trc_zdf_exp     ( kt )       ! explicit time stepping (time splitting scheme)
-      IF( l_trczdf_imp     )   CALL trc_zdf_imp     ( kt )       ! implicit time stepping (euler backward)
-      IF( l_trczdf_iso     )   CALL trc_zdf_iso     ( kt )       ! isopycnal
-      IF( l_trczdf_iso_vo  )   CALL trc_zdf_iso_vopt( kt )       ! vector opt. isopycnal
-
-                               CALL trc_nxt( kt )            ! tracer fields at next time step
-     
-      IF( ln_trcrad )          CALL trc_rad( kt )            ! Correct artificial negative concentrations
-      !                                                      ! especially useful when isopycnal mixing is used
-      !                                                      
-
-      IF( ln_zps .AND. .NOT. lk_trc_c1d )   &              ! Partial steps: now horizontal gradient of passive
-         &                     CALL zps_hde_trc( kt, trb, gtru, gtrv )       ! tracers at the bottom ocean level
+                                CALL trc_zdf( kstp )            ! vertical mixing and after tracer fields
+                                CALL trc_nxt( kstp )            ! tracer fields at next time step     
+         IF( ln_trcrad )        CALL trc_rad( kstp )            ! Correct artificial negative concentrations
+         IF( ln_zps    )        CALL zps_hde( kstp, jptra, trn, gtru, gtrv )  ! Partial steps: now horizontal gradient of passive
+                                                                ! tracers at the bottom ocean level
+         !
+      ELSE                                               ! 1D vertical configuration
+                                CALL trc_sbc( kstp )            ! surface boundary condition
+         IF( .NOT. lk_offline .AND. lk_zdfkpp )    &
+            &                   CALL trc_kpp( kstp )            ! KPP non-local tracer fluxes
+                                CALL trc_zdf( kstp )            ! vertical mixing and after tracer fields
+                                CALL trc_nxt( kstp )            ! tracer fields at next time step     
+          IF( ln_trcrad )       CALL trc_rad( kstp )            ! Correct artificial negative concentrations
+         !
+      END IF
       !
    END SUBROUTINE trc_trp
Index: trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp_ctl.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp_ctl.F90	(revision 2527)
+++ 	(revision )
@@ -1,330 +1,0 @@
-MODULE trctrp_ctl
-   !!======================================================================
-   !!                       ***  MODULE  trctrp_ctl  ***
-   !! TOP :   transport option control
-   !!======================================================================
-   !! History :   1.0  !  2004-03 (C. Ethe) Original code
-   !!----------------------------------------------------------------------
-#if defined key_top
-   !!----------------------------------------------------------------------
-   !!   'key_top'                                                TOP models
-   !!----------------------------------------------------------------------
-   !!   trc_trp_ctl  : control the different options of transport
-   !!   trc_adv_ctl  : control the different options of the advection
-   !!   trc_ldf_ctl  : control the different options of the lateral diffusion
-   !!   trc_zdf_ctl  : control the different options of the vertical diffusion
-   !!   trc_dmp_ctl  : control the different options of the internal damping
-   !!----------------------------------------------------------------------
-   USE oce_trc       ! ocean dynamics and active tracers variables
-   USE trp_trc           ! ocean passive tracers variables
-   USE trctrp_lec    ! passive tracers transport
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   trc_trp_ctl   ! called by ???
-
-#if defined key_trcldf_eiv
-      LOGICAL, PARAMETER ::   lk_trcldf_eiv   = .TRUE.   !: eddy induced velocity flag
-#else   
-      LOGICAL, PARAMETER ::   lk_trcldf_eiv   = .FALSE.  !: eddy induced velocity flag
-#endif
-   !!----------------------------------------------------------------------
-   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE trc_trp_ctl
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE trc_trp_ctl  ***
-      !!                
-      !! ** Purpose :   Control the consistency between cpp options for 
-      !!                tracer transport
-      !!----------------------------------------------------------------------
-      !!----------------------------------------------------------------------
-
-      CALL trc_adv_ctl      ! Control of Advection scheme options
-
-      CALL trc_ldf_ctl      ! Control of Lateral diffusion scheme options
-
-      CALL trc_zdf_ctl      ! Control of Vertival diffusion scheme options
-
-      !                     ! Control of Newtonian damping  options
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) ' *** Tracer damping option'
-      ENDIF
-#if defined key_trcdmp
-      IF(lwp) WRITE(numout,*) '     key_trcdmp is defined:   Check trcdmp ROUTINE '
-      CALL trc_dmp_ctl
-#else
-      IF(lwp) WRITE(numout,*) '     No tracer damping'
-#endif
-      !
-   END SUBROUTINE trc_trp_ctl
-
-
-   SUBROUTINE trc_adv_ctl
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE trc_adv_ctl  ***
-      !!                
-      !! ** Purpose :   Control the consistency between cpp options for 
-      !!              tracer advection schemes
-      !!----------------------------------------------------------------------
-      INTEGER ::   ioptio
-      !!----------------------------------------------------------------------
-
-      ! Control of Advection scheme options
-      ! -----------------------------------
-     IF( lk_trc_c1d ) THEN
-         ln_trcadv_cen2   = .FALSE.    ;  ln_trcadv_tvd    = .FALSE. ; ln_trcadv_muscl  = .FALSE.
-         ln_trcadv_muscl2 = .FALSE.    ;  ln_trcadv_smolar = .FALSE.
-         IF(lwp) WRITE(numout,*) ' *** 1D configuration : No advection on passive tracers '
-         IF(lwp) WRITE(numout,*) 
-      ELSE
-         ioptio = 0
-         IF( ln_trcadv_cen2   )   ioptio = ioptio + 1
-         IF( ln_trcadv_tvd    )   ioptio = ioptio + 1
-         IF( ln_trcadv_muscl  )   ioptio = ioptio + 1
-         IF( ln_trcadv_muscl2 )   ioptio = ioptio + 1
-         IF( ln_trcadv_smolar )   ioptio = ioptio + 1
-         
-         IF( lk_esopa ) THEN
-            IF(lwp) WRITE(numout,*) ' esopa control : the use of all scheme is forced'
-            ln_trcadv_cen2   = .TRUE.
-            ln_trcadv_tvd    = .TRUE.
-            ln_trcadv_muscl  = .TRUE.
-            ln_trcadv_muscl2 = .TRUE.
-            ln_trcadv_smolar = .TRUE.
-         ELSEIF( ioptio > 1 .OR. ioptio == 0 ) THEN
-            CALL ctl_stop( '  Choose one advection scheme in namelist nam_trcadv' )
-         ENDIF
-         
-         IF( n_cla == 1 .AND. .NOT. ln_trcadv_cen2 ) &
-            &    CALL ctl_stop( '    cross-land advection only with 2nd order advection scheme ' )
-      ENDIF
-      !
-   END SUBROUTINE trc_adv_ctl
-
-
-   SUBROUTINE trc_ldf_ctl
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE trc_ldf_ctl  ***
-      !! 
-      !! ** Purpose :   Control the consistency between cpp options for 
-      !!      tracer lateral diffusion 
-      !!----------------------------------------------------------------------
-      INTEGER ::   ioptio               ! ???
-      LOGICAL ::   ll_print = .FALSE.   ! =T print eddy coef. in numout      
-      !!----------------------------------------------------------------------
-
-      ! Parameter control
-
-      IF( .NOT. ln_trcldf_diff .OR. lk_trc_c1d ) THEN
-         l_trcldf_lap = .FALSE.   ;   l_trcldf_bilap   = .FALSE.   ;   l_trcldf_bilapg  = .FALSE.
-         l_trcldf_iso = .FALSE.   ;   l_trcldf_iso_zps = .FALSE.
-         l_trczdf_iso = .FALSE.   ;   l_trczdf_iso_vo  = .FALSE.
-         IF(lwp ) WRITE(numout,*) '*** No lateral diffusion on passive tracers '
-         IF(lwp ) WRITE(numout,*) 
-      ELSE
-         ! control the input
-         ioptio = 0
-         IF( ln_trcldf_lap   )   ioptio = ioptio + 1
-         IF( ln_trcldf_bilap )   ioptio = ioptio + 1
-         IF( ioptio /= 1 )   CALL ctl_stop( '    use ONE of the 2 lap/bilap operator type on tracer' )
-         
-         ioptio = 0
-         IF( ln_trcldf_level )   ioptio = ioptio + 1
-         IF( ln_trcldf_hor   )   ioptio = ioptio + 1
-         IF( ln_trcldf_iso   )   ioptio = ioptio + 1
-         IF( ioptio /= 1 )   CALL ctl_stop( '   use only ONE direction (level/hor/iso)' )
-         
-         ! ... Choice of the lateral scheme used
-         IF( lk_trcldf_eiv ) THEN
-            IF(lwp) WRITE(numout,*) '          eddy induced velocity on tracers'
-            IF( .NOT.ln_trcldf_iso .OR. ln_trcldf_bilap ) &
-               &      CALL ctl_stop( ' the eddy induced velocity on tracers ',&
-               &                     'requires isopycnal laplacian diffusion' )
-         ENDIF
-         
-         IF( ln_sco ) THEN          ! s-coordinates: rotation required for horizontal or isopycnal mixing
-            IF( ( ln_trcldf_iso .OR. ln_trcldf_hor ) .AND. .NOT.lk_ldfslp ) &
-               &      CALL ctl_stop( '  the rotation of the diffusive tensor require key_ldfslp' )
-         ELSE                       ! z-coordinates with/without partial step:
-            ln_trcldf_level = ln_trcldf_level .OR. ln_trcldf_hor      ! level diffusion = horizontal diffusion
-            ln_trcldf_hor   = .FALSE.
-            IF(lwp) WRITE(numout,*) '          horizontal mixing in z-coord or partial steps: force ln_trcldf_level = T'
-            IF(lwp) WRITE(numout,*) '                                                  and    force ln_trcldf_hor   = F'
-            IF( ln_trcldf_iso .AND. .NOT.lk_ldfslp ) &            ! rotation required for isopycnal mixing
-               &      CALL ctl_stop( ' the rotation of the diffusive tensor require key_ldfslp' )
-         ENDIF
-         
-         l_trcldf_lap     =  ln_trcldf_lap   .AND. ln_trcldf_level     ! iso-level   laplacian operator
-         l_trcldf_bilap   =  ln_trcldf_bilap .AND. ln_trcldf_level     ! iso-level bilaplacian operator
-         l_trcldf_bilapg  =  ln_trcldf_bilap .AND. ln_trcldf_hor       ! geopotential bilap. (s-coord)
-         l_trcldf_iso     =  ln_trcldf_lap   .AND.                  &  ! laplacian operator
-            &              ( ln_trcldf_iso   .OR.  ln_trcldf_hor )  &  ! iso-neutral (z-coord) or horizontal (s-coord)
-            &                                     .AND. .NOT.ln_zps
-         l_trcldf_iso_zps =  ln_trcldf_lap   .AND.                  &  ! laplacian operator
-            &              ( ln_trcldf_iso   .OR.  ln_trcldf_hor )  &  ! iso-neutral (partial steps)
-            &                                .AND. ln_zps              ! or geopotential in mixed partial steps/s-coord
-         l_trczdf_iso    = .FALSE.
-         l_trczdf_iso_vo = .FALSE.
-         IF( l_trcldf_iso     )   l_trczdf_iso = .TRUE.
-         IF( l_trcldf_iso_zps )   l_trczdf_iso = .TRUE.
-#if defined key_vectopt_memory
-         IF( l_trczdf_iso ) THEN
-            l_trczdf_iso    = .FALSE.
-            l_trczdf_iso_vo = .TRUE.
-         ENDIF
-#endif
-         
-         ioptio = 0
-         IF( l_trcldf_lap     )   ioptio = ioptio + 1
-         IF( l_trcldf_bilap   )   ioptio = ioptio + 1
-         IF( l_trcldf_bilapg  )   ioptio = ioptio + 1
-         IF( l_trcldf_iso     )   ioptio = ioptio + 1
-         IF( l_trcldf_iso_zps )   ioptio = ioptio + 1
-         IF( ioptio /= 1 ) &
-            &   CALL ctl_stop( '  this combination of operator and direction has not been implemented' )
-         
-         IF( lk_esopa ) THEN
-            l_trcldf_lap = .TRUE.   ;   l_trcldf_bilap   = .TRUE.   ;   l_trcldf_bilapg  = .TRUE.
-            l_trcldf_iso = .TRUE.   ;   l_trcldf_iso_zps = .TRUE.
-            l_trczdf_iso = .TRUE.   ;   l_trczdf_iso_vo  = .TRUE.
-            IF(lwp ) WRITE(numout,*) '          esopa test: use all lateral physics options'
-         ENDIF
-         
-         ! ... Space variation of eddy coefficients
-         ioptio = 0
-#if defined key_traldf_c3d || defined key_off_degrad
-         IF(lwp) WRITE(numout,*) 'tracer mixing coef. = F( latitude, longitude, depth)'
-         ioptio = ioptio + 1
-#endif
-#if defined key_traldf_c2d && ! defined key_off_degrad
-         IF(lwp) WRITE(numout,*) 'tracer mixing coef. = F( latitude, longitude)'
-         ioptio = ioptio + 1
-#endif
-#if defined key_traldf_c1d && ! defined key_off_degrad
-         IF(lwp) WRITE(numout,*) 'tracer mixing coef. = F( depth )'
-         ioptio = ioptio + 1
-         IF( ln_sco ) &
-            &  CALL ctl_stop( '    key_traldf_c1d cannot be used in s-coordinate ' )
-#endif
-         IF( ioptio == 0 ) THEN
-            IF(lwp) WRITE(numout,*) ' tracer mixing coef. = constant (default option)'
-         ELSEIF( ioptio > 1 ) THEN
-            CALL ctl_stop( '  use only one of the following keys:',   &
-               &                 ' key_traldf_c3d, key_traldf_c2d, key_traldf_c1d' )
-         ENDIF
-         
-         IF( l_trcldf_bilap .OR. l_trcldf_bilapg ) THEN
-            IF(lwp) WRITE(numout,*) '  biharmonic tracer diffusion'
-            IF( ahtrc0 > 0 .AND. .NOT. lk_esopa ) &
-               &  CALL ctl_stop( '  The horizontal diffusivity coef. aht0 must be negative' )
-         ELSE
-            IF(lwp) WRITE(numout,*) ' harmonic tracer diffusion (default)'
-            IF( ahtrc0 < 0 .AND. .NOT. lk_esopa ) &
-               &  CALL ctl_stop( ' The horizontal diffusivity coef. aht0 must be positive' )
-         ENDIF
-      ENDIF
-      !
-   END SUBROUTINE trc_ldf_ctl
-
-
-   SUBROUTINE trc_zdf_ctl
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE trc_zdf_ctl  ***
-      !! 
-      !! ** Purpose :   Control the consistency between cpp options for 
-      !!              tracer vertical diffusion
-      !!----------------------------------------------------------------------
-      !!----------------------------------------------------------------------
-
-      ! Parameter & key controls
-      ! ------------------------
-      ! ... vertical mixing
-      ! time stepping scheme (N.B. TKE && KPP scheme => force the use of implicit scheme)
-#if defined key_zdftke || defined key_zdftke_old || defined key_zdfkpp
-      l_trczdf_exp = .FALSE.          ! use implicit scheme
-      l_trczdf_imp = .TRUE. 
-#else
-      IF( ln_trczdf_exp  ) THEN  
-         l_trczdf_exp = .TRUE.           ! use explicit scheme
-         l_trczdf_imp = .FALSE.
-      ELSE
-         l_trczdf_exp = .FALSE.          ! use implicit scheme
-         l_trczdf_imp = .TRUE. 
-      ENDIF
-#endif
-
-      IF( l_trczdf_iso .OR. l_trczdf_iso_vo ) THEN  
-         l_trczdf_exp = .FALSE.          ! iso-neutral diffusion : 
-         l_trczdf_imp = .FALSE.          ! implicit scheme included in iso-neutral routine
-      ENDIF
-
-#if defined key_esopa
-      l_trczdf_exp = .TRUE.           ! esopa: use all options
-      l_trczdf_imp = .TRUE.
-#endif
-      !
-   END SUBROUTINE trc_zdf_ctl
-
-
-   SUBROUTINE trc_dmp_ctl
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE trc_dmp_ctl  ***
-      !! 
-      !! ** Purpose :    Control the consistency between cpp options for 
-      !!              tracer newtonian damping 
-      !!----------------------------------------------------------------------
-#if defined key_trcdmp
-
-      SELECT CASE ( ndmptr )
-      !
-      CASE ( -1 )               ! ORCA: damping in Red & Med Seas only
-         IF(lwp) WRITE(numout,*) '          tracer damping in the Med & Red seas only'
-         !
-      CASE ( 1:90 )             ! Damping poleward of 'ndmptr' degrees
-         IF(lwp) WRITE(numout,*) '          tracer damping poleward of', ndmptr, ' degrees'
-         !
-      CASE DEFAULT
-         WRITE(ctmp1,*) '          bad flag value for nmldmp = ', ndmptr
-         CALL ctl_stop(ctmp1)
-         !
-      END SELECT
-
-      SELECT CASE ( nmldmptr )
-      !
-      CASE ( 0 )                ! newtonian damping throughout the water column
-         IF(lwp) WRITE(numout,*) '          tracer damping throughout the water column'
-         !
-      CASE ( 1 )                ! no damping in the turbocline (avt > 5 cm2/s)
-         IF(lwp) WRITE(numout,*) '          no tracer damping in the turbocline'
-         !
-      CASE ( 2 )                ! no damping in the mixed layer 
-         IF(lwp) WRITE(numout,*) '          no tracer damping in the mixed layer'
-         !
-      CASE DEFAULT
-         WRITE(ctmp1,*) '          bad flag value for nmldmp = ', nmldmptr
-         CALL ctl_stop(ctmp1)
-         !
-      END SELECT
-#endif
-      !
-   END SUBROUTINE trc_dmp_ctl
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Dummy module :                                        No TOP models
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE trc_trp_ctl             ! Empty routine
-   END SUBROUTINE trc_trp_ctl
-#endif
-   
-  !!======================================================================
-END MODULE trctrp_ctl
Index: trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp_lec.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp_lec.F90	(revision 2527)
+++ 	(revision )
@@ -1,216 +1,0 @@
-MODULE trctrp_lec
-   !!======================================================================
-   !!                       ***  MODULE  trctrp_lec  ***
-   !! TOP :   namelist read options for transport
-   !!======================================================================
-   !! History :   1.0  !  2004-03  (C. Ethe)  Original code
-   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture
-   !!----------------------------------------------------------------------
-#if defined key_top
-   !!----------------------------------------------------------------------
-   !!   'key_top'                                                TOP models
-   !!----------------------------------------------------------------------
-   !!   trc_trp_lec  : read the passive tracer namelist for transport
-   !!----------------------------------------------------------------------
-   USE oce_trc             ! ocean dynamics and active tracers variables
-   USE trp_trc                 ! ocean passive tracers variables
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   trc_trp_lec    ! routine called by step module
- 
-   !                                                  !!: ** Advection (nam_traadv) **
-   LOGICAL , PUBLIC ::   ln_trcadv_cen2   = .FALSE.   !: 2nd order centered scheme flag
-   LOGICAL , PUBLIC ::   ln_trcadv_tvd    = .FALSE.   !: TVD scheme flag
-   LOGICAL , PUBLIC ::   ln_trcadv_muscl  = .FALSE.   !: MUSCL scheme flag
-   LOGICAL , PUBLIC ::   ln_trcadv_muscl2 = .FALSE.   !: MUSCL2 scheme flag
-   LOGICAL , PUBLIC ::   ln_trcadv_smolar = .TRUE.    !: Smolarkiewicz scheme flag
-
-   !                                                 !!: **  bottom boundary layer (nambbl) **
-   REAL(wp), PUBLIC ::   atrcbbl = 1.e+3              ! lateral coeff. for bottom boundary layer scheme (m2/s)
-
-   !                                                 !!: ** lateral mixing namelist (nam_trcldf) **
-   LOGICAL , PUBLIC ::   ln_trcldf_diff  = .FALSE.    !: flag of perform or not the lateral diff.
-   LOGICAL , PUBLIC ::   ln_trcldf_lap   = .TRUE.     !: laplacian operator
-   LOGICAL , PUBLIC ::   ln_trcldf_bilap = .FALSE.    !: bilaplacian operator
-   LOGICAL , PUBLIC ::   ln_trcldf_level = .FALSE.    !: iso-level direction
-   LOGICAL , PUBLIC ::   ln_trcldf_hor   = .FALSE.    !: horizontal (geopotential) direction
-   LOGICAL , PUBLIC ::   ln_trcldf_iso   = .TRUE.     !: iso-neutral direction
-
-   !                                                 !!: ** Treatment of Negative concentrations ( nam_trcrad )
-   LOGICAL , PUBLIC ::   ln_trcrad       = .TRUE.     !: flag to artificially correct negative concentrations
-
-   !                                                 !!: flag of the lateral diff. scheme used
-   LOGICAL , PUBLIC ::   l_trcldf_lap                 !: iso-level laplacian operator
-   LOGICAL , PUBLIC ::   l_trcldf_bilap               !: iso-level bilaplacian operator
-   LOGICAL , PUBLIC ::   l_trcldf_bilapg              !: geopotential bilap. (s-coord)
-   LOGICAL , PUBLIC ::   l_trcldf_iso                 !: iso-neutral laplacian or horizontal lapacian (s-coord)
-   LOGICAL , PUBLIC ::   l_trczdf_iso                 !: idem for the vertical component
-   LOGICAL , PUBLIC ::   l_trczdf_iso_vo              !: idem with vectopt_memory
-   LOGICAL , PUBLIC ::   l_trcldf_iso_zps             !: iso-neutral laplacian (partial steps)
-
-   !                                                 !!: ** Vertical diffusion (nam_trczdf) **
-   LOGICAL , PUBLIC ::   ln_trczdf_exp = .FALSE.      !: explicit vertical diffusion scheme flag
-
-   !                                                 !!: ** vertical diffusion (namzdf) **
-   INTEGER , PUBLIC ::   n_trczdf_exp = 3             !: number of sub-time step (explicit time stepping)
-
-   LOGICAL , PUBLIC ::   l_trczdf_exp     = .FALSE.   !: explicit vertical diffusion
-   LOGICAL , PUBLIC ::   l_trczdf_imp     = .FALSE.   !: implicit vertical diffusion
-
-#if defined key_trcdmp
-   !                                                 !!: ** newtonian damping namelist (nam_trcdmp) **
-   INTEGER  , PUBLIC ::   ndmptr   =   -1             !: = 0/-1/'latitude' for damping over tracers
-   INTEGER  , PUBLIC ::   ndmpftr  =    2             !: = 1 create a damping.coeff NetCDF file 
-   INTEGER  , PUBLIC ::   nmldmptr =    0             !: = 0/1/2 flag for damping in the mixed layer
-
-   !                                                 !!: ** newtonian damping (namdmp) **
-   REAL(wp) , PUBLIC ::   sdmptr   =   50.            !: surface time scale for internal damping (days)
-   REAL(wp) , PUBLIC ::   bdmptr   =  360.            !: bottom time scale for internal damping (days)
-   REAL(wp) , PUBLIC ::   hdmptr   =  800.            !: depth of transition between sdmp and bdmp (meters)
-#endif
-   !                                                 !!: ** SMOLAR advection scheme
-   REAL(wp) , PUBLIC ::  rsc       = 1.               !: tuning coefficient for anti-diffusion
-   INTEGER  , PUBLIC ::  ncortrc   = 1                !: number of corrective phases
-   LOGICAL  , PUBLIC ::  crosster  = .FALSE.          !: computes crossterms (T) or not (F)
-   !!----------------------------------------------------------------------
-   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE trc_trp_lec
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE trc_trp_lec  ***
-      !!                
-      !! ** Purpose :   Read Namelist for tracer transport option
-      !!----------------------------------------------------------------------
-      NAMELIST/namtopadv/ ln_trcadv_cen2 , ln_trcadv_tvd,   &
-         &                ln_trcadv_muscl, ln_trcadv_muscl2, ln_trcadv_smolar, &
-         &                rsc, ncortrc, crosster
-#if  defined key_trcbbl_dif   ||   defined key_trcbbl_adv 
-      NAMELIST/namtopbbl/ atrcbbl
-#endif
-      NAMELIST/namtopldf/  ln_trcldf_diff  , ln_trcldf_lap  , ln_trcldf_bilap, &
-         &                 ln_trcldf_level, ln_trcldf_hor, ln_trcldf_iso,   &
-         &                 ahtrc0, ahtrb0, aeivtr0, trcrat
-      NAMELIST/namtopzdf/ ln_trczdf_exp, n_trczdf_exp
-      NAMELIST/namtoprad/ ln_trcrad
-#if defined key_trcdmp
-      NAMELIST/namtopdmp/ ndmptr, ndmpftr, nmldmptr, sdmptr, bdmptr, hdmptr
-#endif
-      !!----------------------------------------------------------------------
-
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) ' trc_trp_lec: read namelist for tracer transport'
-      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~'
-
-      !                                ! tracer advection scheme
-      REWIND( numnat )                 !   ! Read Namelist namtopadv
-      READ  ( numnat, namtopadv )
-
-      IF(lwp) THEN                     !   ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) '   Namelist namtopadv : chose a advection scheme for tracers'
-         WRITE(numout,*) '      2nd order advection scheme               ln_trcadv_cen2   = ', ln_trcadv_cen2
-         WRITE(numout,*) '      TVD advection scheme                     ln_trcadv_tvd    = ', ln_trcadv_tvd
-         WRITE(numout,*) '      MUSCL  advection scheme                  ln_trcadv_muscl  = ', ln_trcadv_muscl
-         WRITE(numout,*) '      MUSCL2 advection scheme                  ln_trcadv_muscl2 = ', ln_trcadv_muscl2
-         WRITE(numout,*) '      SMOLARKIEWICZ advection scheme           ln_trcadv_smolar = ', ln_trcadv_smolar
-         IF( ln_trcadv_smolar ) THEN
-            WRITE(numout,*) '      SMOLARKIEWICZ : tuning coefficient                rsc      = ', rsc
-            WRITE(numout,*) '      SMOLARKIEWICZ : number of corrective phase        ncortrc  = ', ncortrc
-            WRITE(numout,*) '      SMOLARKIEWICZ : computes or not crossterms        crosster = ', crosster
-         ENDIF
-      ENDIF
-
-#if  defined key_trcbbl_dif
-      !                                ! Bottom boundary layer 
-      REWIND( numnat )                 !   ! Read Namelist namtopbbl
-      READ  ( numnat, namtopbbl )
-
-      IF(lwp) THEN                     !   ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) '   Namelist namtopbbl : set Diffusive Bottom Boundary Layer parameters'
-         WRITE(numout,*) '      bottom boundary layer coef.    atrcbbl = ', atrcbbl
-# if defined key_trcbbl_adv
-         WRITE(numout,*) '   * Advective Bottom Boundary Layer'
-# endif
-      ENDIF
-#endif
-
-      !                                ! Lateral physics on tracers   
-      REWIND( numnat )                 !   ! Read Namelist namtopldf
-      READ  ( numnat, namtopldf )
-
-      IF(lwp) THEN                     !   ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) '   Namelist namtopldf : 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
-         WRITE(numout,*) '      iso-level                                      ln_trcldf_level = ', ln_trcldf_level
-         WRITE(numout,*) '      horizontal (geopotential)                      ln_trcldf_hor   = ', ln_trcldf_hor
-         WRITE(numout,*) '      iso-neutral                                    ln_trcldf_iso   = ', ln_trcldf_iso
-         WRITE(numout,*) '      lateral eddy diffusivity                              ahtrc0   = ', ahtrc0
-         WRITE(numout,*) '      background hor. diffusivity                            ahtrb0  = ', ahtrb0
-         WRITE(numout,*) '      eddy induced velocity coef.                           aeivtr0  = ', aeivtr0
-         WRITE(numout,*) '      ratio between passive and active tracer diffusion coef  trcrat = ', trcrat
-      ENDIF
-
-      !                                ! Vertical mixing
-      REWIND( numnat )                 !   ! Read namtopzdf namelist
-      READ  ( numnat, namtopzdf )
-
-      IF(lwp) THEN                     !   ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) '   Namelist namtopzdf : set vertical diffusion parameters'
-         WRITE(numout,*) '      time splitting / backward scheme ln_trczdf_exp = ', ln_trczdf_exp
-         WRITE(numout,*) '      number of time step               n_trczdf_exp = ', n_trczdf_exp
-      ENDIF
-
-      !
-      REWIND( numnat )                 !   Read Namelist namtoprad
-      READ  ( numnat, namtoprad )
-
-      IF(lwp) THEN                     !   ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) '   Namelist namtoprad : treatment of negative concentrations'
-         WRITE(numout,*) '      correct artificially negative concen. or not ln_trcrad = ', ln_trcrad
-      ENDIF
-
-
-# if defined key_trcdmp
-      !                                ! passive tracres damping term
-      REWIND( numnat )                 !   ! Read Namelist namtdp
-      READ  ( numnat, namtopdmp )
-      IF( lzoom )   nmldmptr = 0           ! restoring to climatology at closed north or south boundaries
-
-      IF(lwp) THEN                     !   ! Control print
-         WRITE(numout,*)
-         WRITE(numout,*) '   Namelist namtopdmp : set damping parameter'
-         WRITE(numout,*) '      tracers damping option         ndmptr   = ', ndmptr
-         WRITE(numout,*) '      create a damping.coeff file    ndmpftr  = ', ndmpftr
-         WRITE(numout,*) '      mixed layer damping option     nmldmptr = ', nmldmptr, '(zoom: forced to 0)'
-         WRITE(numout,*) '      surface time scale (days)      sdmptr   = ', sdmptr
-         WRITE(numout,*) '      bottom time scale (days)       bdmptr   = ', bdmptr
-         WRITE(numout,*) '      depth of transition (meters)   hdmptr   = ', hdmptr
-      ENDIF
-#endif
-      !
-   END SUBROUTINE trc_trp_lec
-   
-#else
-   !!----------------------------------------------------------------------
-   !!   Dummy module :                                         No TOP model
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE trc_trp_lec              ! Empty routine
-   END SUBROUTINE trc_trp_lec
-#endif
-
-  !!======================================================================
-END MODULE trctrp_lec
Index: trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90	(revision 2528)
@@ -0,0 +1,171 @@
+MODULE trczdf
+   !!==============================================================================
+   !!                 ***  MODULE  trczdf  ***
+   !! Ocean Passive tracers : vertical diffusive trends 
+   !!=====================================================================
+   !! History :  9.0  ! 2005-11 (G. Madec)  Original code
+   !!       NEMO 3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA 
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   trc_ldf     : update the tracer trend with the lateral diffusion
+   !!       ldf_ctl : initialization, namelist read, and parameters control
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! ocean dynamics and active tracers
+   USE trc             ! ocean passive tracers variables
+   USE trcnam_trp      ! passive tracers transport namelist variables
+   USE trazdf_exp      ! vertical diffusion: explicit (tra_zdf_exp     routine)
+   USE trazdf_imp      ! vertical diffusion: implicit (tra_zdf_imp     routine)
+   USE prtctl_trc      ! Print control
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE trdmod_oce
+   USE trdtra
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_zdf    ! called by step.F90 
+
+   INTEGER ::   nzdf = 0               ! type vertical diffusion algorithm used
+      !                                ! defined from ln_zdf...  namlist logicals)
+   REAL(wp), DIMENSION(jpk) ::  r2dt   ! vertical profile time-step, = 2 rdttra
+      !                                ! except at nit000 (=rdttra) if neuler=0
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "zdfddm_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+   
+   SUBROUTINE trc_zdf( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_zdf  ***
+      !!
+      !! ** Purpose :   compute the vertical ocean tracer physics.
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::  kt      ! ocean time-step index
+      !
+      INTEGER               ::  jk, jn
+      CHARACTER (len=22)    :: charout
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   ztrtrd   ! 4D workspace
+      !!---------------------------------------------------------------------
+
+      IF( kt == nit000 )   CALL zdf_ctl          ! initialisation & control of options
+
+#if ! defined key_pisces
+      IF( neuler == 0 .AND. kt == nit000 ) THEN     ! at nit000
+         r2dt(:) =  rdttrc(:)           ! = rdttrc (restarting with Euler time stepping)
+      ELSEIF( kt <= nit000 + nn_dttrc ) THEN          ! at nit000 or nit000+1
+         r2dt(:) = 2. * rdttrc(:)       ! = 2 rdttrc (leapfrog)
+      ENDIF
+#else
+      r2dt(:) =  rdttrc(:)              ! = rdttrc (for PISCES use Euler time stepping)
+#endif
+
+      IF( l_trdtrc )  THEN
+         ALLOCATE( ztrtrd(jpi,jpj,jpk,jptra) )   ! temporary save of trends
+         ztrtrd(:,:,:,:)  = tra(:,:,:,:)
+      ENDIF
+
+      SELECT CASE ( nzdf )                       ! compute lateral mixing trend and add it to the general trend
+      CASE ( -1 )                                       ! esopa: test all possibility with control print
+         CALL tra_zdf_exp( kt, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra ) 
+         WRITE(charout, FMT="('zdf1 ')") ;  CALL prt_ctl_trc_info(charout)
+                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+         CALL tra_zdf_imp( kt, 'TRC', r2dt,                trb, tra, jptra ) 
+         WRITE(charout, FMT="('zdf2 ')") ;  CALL prt_ctl_trc_info(charout)
+                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+      CASE ( 0 ) ;  CALL tra_zdf_exp( kt, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra )    !   explicit scheme 
+      CASE ( 1 ) ;  CALL tra_zdf_imp( kt, 'TRC', r2dt,                trb, tra, jptra )    !   implicit scheme          
+
+      END SELECT
+
+      IF( l_trdtra )   THEN                      ! save the vertical diffusive trends for further diagnostics
+         DO jn = 1, jptra
+            DO jk = 1, jpkm1
+               ztrtrd(:,:,jk,jn) = ( ( tra(:,:,jk,jn) - trb(:,:,jk,jn) ) / r2dt(jk) ) - ztrtrd(:,:,jk,jn)
+            END DO
+            CALL trd_tra( kt, 'TRC', jn, jptra_trd_zdf, ztrtrd(:,:,:,jn) )
+         END DO
+         DEALLOCATE( ztrtrd )
+      ENDIF
+
+      !                                          ! print mean trends (used for debugging)
+      IF( ln_ctl )   THEN
+         WRITE(charout, FMT="('zdf ')") ;  CALL prt_ctl_trc_info(charout)
+                                           CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+      END IF
+      !
+   END SUBROUTINE trc_zdf
+
+
+   SUBROUTINE zdf_ctl
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE zdf_ctl  ***
+      !!
+      !! ** Purpose :   Choose the vertical mixing scheme
+      !!
+      !! ** Method  :   Set nzdf from ln_zdfexp
+      !!      nzdf = 0   explicit (time-splitting) scheme (ln_trczdf_exp=T)
+      !!           = 1   implicit (euler backward) scheme (ln_trczdf_exp=F)
+      !!      NB: The implicit scheme is required when using : 
+      !!             - rotated lateral mixing operator
+      !!             - TKE, GLS or KPP vertical mixing scheme
+      !!----------------------------------------------------------------------
+
+      !  Define the vertical tracer physics scheme
+      ! ==========================================
+
+      ! Choice from ln_zdfexp already read in namelist in zdfini module
+      IF( ln_trczdf_exp ) THEN           ! use explicit scheme
+         nzdf = 0
+      ELSE                               ! use implicit scheme
+         nzdf = 1
+      ENDIF
+
+      ! Force implicit schemes
+      IF( ln_trcldf_iso                               )   nzdf = 1      ! iso-neutral lateral physics
+      IF( ln_trcldf_hor .AND. ln_sco                  )   nzdf = 1      ! horizontal lateral physics in s-coordinate
+#if defined key_zdftke || defined key_zdfgls || defined key_zdfkpp
+                                                          nzdf = 1      ! TKE, GLS or KPP physics       
+#endif
+      IF( ln_trczdf_exp .AND. nzdf == 1 )   THEN
+         CALL ctl_stop( 'trc_zdf : If using the rotated lateral mixing operator or TKE, GLS or KPP vertical scheme ', &
+            &           '          the implicit scheme is required, set ln_trczdf_exp = .false.' )
+      ENDIF
+
+      ! Test: esopa
+      IF( lk_esopa )    nzdf = -1                      ! All schemes used
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'trc:zdf_ctl : vertical passive tracer physics scheme'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         IF( nzdf == -1 )   WRITE(numout,*) '              ESOPA test All scheme used'
+         IF( nzdf ==  0 )   WRITE(numout,*) '              Explicit time-splitting scheme'
+         IF( nzdf ==  1 )   WRITE(numout,*) '              Implicit (euler backward) scheme'
+      ENDIF
+
+   END SUBROUTINE zdf_ctl
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_zdf( kt )
+      INTEGER, INTENT(in) :: kt  
+      WRITE(*,*) 'trc_zdf: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_zdf
+#endif
+   !!==============================================================================
+END MODULE trczdf
Index: trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf_exp.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf_exp.F90	(revision 2527)
+++ 	(revision )
@@ -1,203 +1,0 @@
-MODULE trczdf_exp
-   !!==============================================================================
-   !!                    ***  MODULE  trczdf_exp  ***
-   !! Ocean passive tracers:  vertical component of the tracer mixing trend using
-   !!                        an explicit time-stepping (time spllitting scheme)
-   !!======================================================================
-   !! History :  6.0  !  90-10  (B. Blanke)  Original code
-   !!            7.0  !  91-11  (G. Madec)
-   !!                 !  92-06  (M. Imbard)  correction on tracer trend loops
-   !!                 !  96-01  (G. Madec)  statement function for e3
-   !!                 !  97-05  (G. Madec)  vertical component of isopycnal
-   !!                 !  97-07  (G. Madec)  geopotential diffusion in s-coord
-   !!                 !  98-03  (L. Bopp MA Foujols) passive tracer generalisation
-   !!                 !  00-05  (MA Foujols) add lbc for tracer trends
-   !!                 !  00-06  (O Aumont)  correct isopycnal scheme suppress
-   !!                 !                     avt multiple correction
-   !!                 !  00-08  (G. Madec)  double diffusive mixing
-   !!            8.5  !  02-08  (G. Madec)  F90: Free form and module
-   !!            9.0  !  04-03  (C. Ethe )  adapted for passive tracers
-   !!                 !  07-02  (C. Deltel)  Diagnose ML trends for passive tracers
-   !!----------------------------------------------------------------------
-#if defined key_top
-   !!----------------------------------------------------------------------
-   !!   'key_top'                                                TOP models
-   !!----------------------------------------------------------------------
-   !!   trc_zdf_exp  : update the tracer trend with the vertical diffusion
-   !!                  using an explicit time stepping
-   !!----------------------------------------------------------------------
-   !! * Modules used
-   USE oce_trc          ! ocean dynamics and active tracers variables
-   USE trp_trc              ! ocean passive tracers variables
-   USE trctrp_lec       ! passive tracers transport
-   USE prtctl_trc          ! Print control for debbuging
-   USE trdmld_trc
-   USE trdmld_trc_oce
-
-   IMPLICIT NONE
-   PRIVATE
-
-   !! * Routine accessibility
-   PUBLIC trc_zdf_exp          ! routine called by step.F90
-
-   !! * Module variable
-   REAL(wp), DIMENSION(jpk) ::   &
-      rdttrc                     ! vertical profile of 2 x tracer time-step
-
-   !! * Substitutions
-#  include "top_substitute.h90"
-   !!----------------------------------------------------------------------
-   !!   TOP 1.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE trc_zdf_exp( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE trc_zdf_exp  ***
-      !!                   
-      !! ** Purpose :   Compute the trend due to the vertical tracer mixing 
-      !!      using an explicit time stepping and add it to the general trend 
-      !!      of the tracer equations.
-      !!
-      !! ** Method  :   The vertical diffusion of tracers  is given by:
-      !!         difft = dz( avt dz(trb) ) = 1/e3t dk+1( avt/e3w dk(trb) )
-      !!      It is evaluated with an Euler scheme, using a time splitting
-      !!      technique.
-      !!      Surface and bottom boundary conditions: no diffusive flux on
-      !!      both tracers (bottom, applied through the masked field avt).
-      !!      Add this trend to the general trend tra :
-      !!          tra = tra + dz( avt dz(t) ) if lk_zdfddm= T)
-      !!
-      !! ** Action : - Update tra with the before vertical diffusion trend
-      !!             - Save the trends ('key_trdmld_trc')
-      !!
-      !!---------------------------------------------------------------------
-      USE oce, ONLY :   ztrtrd => ua    ! use ua as 3D workspace
-      !! * Arguments
-      INTEGER, INTENT( in ) ::   kt           ! ocean time-step index
-      
-      !! * Local declarations
-      INTEGER ::   ji, jj, jk, jl, jn             ! dummy loop indices
-      REAL(wp) ::   &
-         zlavmr,                 &  ! ???
-         zave3r, ze3tr,          &  ! ???
-         ztra                  !
-      REAL(wp), DIMENSION(jpi,jpk) ::   &
-         zwx, zwy
-      CHARACTER (len=22) :: charout
-      !!---------------------------------------------------------------------
-
-      IF( kt == nittrc000 ) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'trc_zdf_exp : vertical tracer mixing'
-         WRITE(numout,*) '~~~~~~~~~~~~~~~'
-      ENDIF
-
-      IF( l_trdtrc ) THEN
-         STOP 'trczdf_exp: this was never validated, please comment this line to proceed...'
-      ENDIF
-
-      ! 0. Local constant initialization
-      ! --------------------------------
-      IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd ) THEN
-         ! time step = 2 rdttra with Arakawa or TVD advection scheme
-         IF( neuler == 0 .AND. kt == nittrc000 ) THEN
-            rdttrc(:) =  rdttra(:) * FLOAT(ndttrc)             ! restarting with Euler time stepping
-         ELSEIF( kt <= nittrc000 + ndttrc ) THEN
-            rdttrc(:) = 2. * rdttra(:) * FLOAT(ndttrc)         ! leapfrog
-         ENDIF
-      ELSE
-         rdttrc(:) =  rdttra(:) * FLOAT(ndttrc)      
-      ENDIF
-
-
-      zlavmr = 1. / FLOAT( n_trczdf_exp )
-
-      DO jn = 1, jptra
-         !
-         IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)   ! save trends
-         !                                                ! ===============
-         DO jj = 2, jpjm1                                 !  Vertical slab
-            !                                             ! ===============
-            ! 1. Initializations
-            ! ------------------
-
-            ! Surface & bottom boundary conditions: no flux
-            DO ji = 2, jpim1
-               zwy(ji, 1 ) = 0.e0
-               zwy(ji,jpk) = 0.e0
-            END DO
-
-            ! zwx and zwz arrays set to before tracer values
-            DO jk = 1, jpk
-               DO ji = 2, jpim1
-                  zwx(ji,jk) = trb(ji,jj,jk,jn)
-               END DO
-            END DO
-
-
-            ! 2. Time splitting loop
-            ! ----------------------
-
-            DO jl = 1, n_trczdf_exp
-
-               ! first vertical derivative
-               ! double diffusion: fstravs(ji,jj,jk) = avt(ji,jj,jk) /= avs (key_trc_zdfddm) 
-               !                   fstravs(ji,jj,jk) = avs(ji,jj,jk) = avt
-               DO jk = 2, jpk
-                  DO ji = 2, jpim1
-                     zave3r = 1.e0 / fse3w(ji,jj,jk) 
-                     zwy(ji,jk) = fstravs(ji,jj,jk) * ( zwx(ji,jk-1) - zwx(ji,jk) ) * zave3r
-                  END DO
-               END DO
-
-
-               ! trend estimation at kt+l*2*rdt/n_zdfexp
-               DO jk = 1, jpkm1
-                  DO ji = 2, jpim1
-                     ze3tr = zlavmr / fse3t(ji,jj,jk)
-                     ! 2nd vertical derivative
-                     ztra = ( zwy(ji,jk) - zwy(ji,jk+1) ) * ze3tr
-                     ! update the tracer trends
-                     tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
-                     ! update tracer fields at kt+l*2*rdt/n_trczdf_exp
-                     zwx(ji,jk) = zwx(ji,jk) + rdttrc(jk) * ztra * tmask(ji,jj,jk)
-                  END DO
-               END DO
-            END DO
-            !                                             ! ===============
-         END DO                                           !   End of slab
-         !                                                ! ===============
-         IF( l_trdtrc ) THEN
-            ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:)
-            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd, jn, jptrc_trd_zdf, kt )
-         END IF
-
-         !                                                    ! ===========
-      END DO                                                  ! tracer loop
-      !                                                       ! ===========
-
-      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
-         WRITE(charout, FMT="('zdf - exp')")
-         CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
-      ENDIF
-
-   END SUBROUTINE trc_zdf_exp
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Dummy module :                      NO passive tracer
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE trc_zdf_exp (kt )              ! Empty routine
-      INTEGER, INTENT(in) :: kt
-      WRITE(*,*) 'trc_zdf_exp: You should not have seen this print! error?', kt
-   END SUBROUTINE trc_zdf_exp
-#endif
-   
-   !!==============================================================================
-END MODULE trczdf_exp
Index: trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf_imp.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf_imp.F90	(revision 2527)
+++ 	(revision )
@@ -1,297 +1,0 @@
-MODULE trczdf_imp
-   !!==============================================================================
-   !!                    ***  MODULE  trczdf_imp  ***
-   !! Ocean passive tracers:  vertical component of the tracer mixing trend
-   !!==============================================================================
-   !! History :  6.0  !  90-10  (B. Blanke)  Original code
-   !!            7.0  !  91-11  (G. Madec)
-   !!                 !  92-06  (M. Imbard)  correction on tracer trend loops
-   !!                 !  96-01  (G. Madec)  statement function for e3
-   !!                 !  97-05  (G. Madec)  vertical component of isopycnal
-   !!                 !  97-07  (G. Madec)  geopotential diffusion in s-coord
-   !!                 !  98-03  (L. Bopp MA Foujols) passive tracer generalisation
-   !!                 !  00-05  (MA Foujols) add lbc for tracer trends
-   !!                 !  00-06  (O Aumont)  correct isopycnal scheme suppress
-   !!                 !                     avt multiple correction
-   !!                 !  00-08  (G. Madec)  double diffusive mixing
-   !!            8.5  !  02-08  (G. Madec)  F90: Free form and module
-   !!            9.0  !  04-03  (C. Ethe )  adapted for passive tracers
-   !!                 !  07-02  (C. Deltel)  Diagnose ML trends for passive tracers
-   !!----------------------------------------------------------------------
-#if defined key_top
-   !!----------------------------------------------------------------------
-   !!   'key_top'                                                TOP models
-   !!----------------------------------------------------------------------
-   !!   trc_zdf_imp  : update the tracer trend with the vertical diffusion
-   !!                  using an implicit time-stepping.
-   !!----------------------------------------------------------------------
-   !! * Modules used
-   USE oce_trc             ! ocean dynamics and active tracers variables
-   USE trp_trc                 ! ocean passive tracers variables
-   USE trctrp_lec          ! passive tracers transport
-   USE prtctl_trc
-   USE trdmld_trc
-   USE trdmld_trc_oce
-
-   IMPLICIT NONE
-   PRIVATE
-
-   !! * Routine accessibility
-   PUBLIC trc_zdf_imp          ! routine called by step.F90
-
-   !! * Module variable
-   REAL(wp), DIMENSION(jpk) ::   &
-      rdttrc                     ! vertical profile of 2 x tracer time-step
-
-   !! * Substitutions
-#  include "top_substitute.h90"
-   !!----------------------------------------------------------------------
-   !!   TOP 1.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE trc_zdf_imp( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE trc_zdf_imp  ***
-      !!
-      !! ** Purpose :   Compute the trend due to the vertical tracer mixing 
-      !!      using an implicit time stepping and add it to the general trend
-      !!      of the tracer equations.
-      !!
-      !! ** Method  :   The vertical diffusion of tracers tra is given by:
-      !!          difft = dz( avt dz(t) ) = 1/e3t dk+1( avt/e3w dk(tra) )
-      !!      It is thus evaluated using a backward time scheme
-      !!      Surface and bottom boundary conditions: no diffusive flux on
-      !!      both tracers (bottom, applied through the masked field avt).
-      !!      Add this trend to the general trend tra :
-      !!          tra = tra + dz( avt dz(t) )
-      !!         (tra = tra + dz( avs dz(t) ) if lk_zdfddmtrc=T)
-      !!
-      !! ** Action  : - Update tra with the before vertical diffusion trend
-      !!              - save the trends 
-      !!
-      !!---------------------------------------------------------------------
-      !!
-      !! * Arguments
-      USE oce, ONLY :   ztrtrd => ua    ! use ua as 3D workspace 
-
-      INTEGER, INTENT( in ) ::   kt           ! ocean time-step index
-      INTEGER ::   ikst, ikenm2, ikstp1
-      !! * Local declarations
-      INTEGER ::   ji, jj, jk, jn             ! dummy loop indices
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
-         zwd, zws, zwi,          &  ! ???
-         zwx, zwy, zwt              ! ???
-#if defined key_trc_diatrd
-      REAL(wp) ::  ztra      ! temporary scalars
-#endif
-      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra) ::   &
-         ztrd
-      CHARACTER (len=22) :: charout
-      !!---------------------------------------------------------------------
-
-      IF( kt == nittrc000 ) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'trc_zdf_implicit : vertical tracer mixing'
-         WRITE(numout,*) '~~~~~~~~~~~~~~~'
-      ENDIF
-
-      ! 0. Local constant initialization
-      ! --------------------------------
-      IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd ) THEN
-         ! time step = 2 rdttra with Arakawa or TVD advection scheme
-         IF( neuler == 0 .AND. kt == nittrc000 ) THEN
-            rdttrc(:) =  rdttra(:) * FLOAT(ndttrc)             ! restarting with Euler time stepping
-         ELSEIF( kt <= nittrc000 + ndttrc ) THEN
-            rdttrc(:) = 2. * rdttra(:) * FLOAT(ndttrc)         ! leapfrog
-         ENDIF
-      ELSE
-         rdttrc(:) =  rdttra(:) * FLOAT(ndttrc)      
-      ENDIF
-
-      ! Initialisation
-      zwd( 1 ,:,:) = 0.e0     ;     zwd(jpi,:,:) = 0.e0
-      zws( 1 ,:,:) = 0.e0     ;     zws(jpi,:,:) = 0.e0
-      zwi( 1 ,:,:) = 0.e0     ;     zwi(jpi,:,:) = 0.e0
-      !                                          
-      ! 0. Matrix construction 
-      ! ----------------------
-
-      ! Diagonal, inferior, superior
-      ! (including the bottom boundary condition via avs masked
-      DO jk = 1, jpkm1                    
-         DO jj = 2, jpjm1                                    
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zwi(ji,jj,jk) = - rdttrc(jk) * fstravs(ji,jj,jk  ) /( fse3t(ji,jj,jk) * fse3w(ji,jj,jk  ) )
-               zws(ji,jj,jk) = - rdttrc(jk) * fstravs(ji,jj,jk+1) /( fse3t(ji,jj,jk) * fse3w(ji,jj,jk+1) )
-               zwd(ji,jj,jk) = 1. - zwi(ji,jj,jk) - zws(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-
-      ! Surface boudary conditions
-      DO jj = 2, jpjm1        
-         DO ji = fs_2, fs_jpim1
-            zwi(ji,jj,1) = 0.e0
-            zwd(ji,jj,1) = 1. - zws(ji,jj,1) 
-         END DO
-      END DO
-
-      !                                                       ! ===========
-      DO jn = 1, jptra                                        ! tracer loop
-         !                                                    ! ===========
-         IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)         ! ??? validation needed
-
-	 zwt( 1 ,:,:) = 0.e0     ;     zwt(jpi,:,:) = 0.e0     
-         zwt(  :,:,1) = 0.e0     ;     zwt(  :,:,jpk) = 0.e0
-         
-         ! Second member construction
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1     
-               DO ji = fs_2, fs_jpim1
-                  zwy(ji,jj,jk) = trb(ji,jj,jk,jn) + rdttrc(jk) * tra(ji,jj,jk,jn)
-               END DO
-            END DO
-         END DO
-         
-         
-         ! Matrix inversion from the first level
-         !----------------------------------------------------------------------
-         !   solve m.x = y  where m is a tri diagonal matrix ( jpk*jpk )
-         !
-         !        ( zwd1 zws1   0    0    0  )( zwx1 ) ( zwy1 )
-         !        ( zwi2 zwd2 zws2   0    0  )( zwx2 ) ( zwy2 )
-         !        (  0   zwi3 zwd3 zws3   0  )( zwx3 )=( zwy3 )
-         !        (        ...               )( ...  ) ( ...  )
-         !        (  0    0    0   zwik zwdk )( zwxk ) ( zwyk )
-         !
-         !   m is decomposed in the product of an upper and lower triangular matrix
-         !   The 3 diagonal terms are in 2d arrays: zwd, zws, zwi
-         !   The second member is in 2d array zwy
-         !   The solution is in 2d array zwx
-         !   The 3d arry zwt is a work space array
-         !   zwy is used and then used as a work space array : its value is modified!
-         !
-         !   N.B. the starting vertical index (ikst) is equal to 1 except for
-         !   the resolution of tke matrix where surface tke value is prescribed
-         !   so that ikstrt=2.
-        ikst = 1
-        ikstp1 = ikst + 1
-        ikenm2 = jpk - 2
-        
-        DO jj = 2, jpjm1
-           DO ji = fs_2, fs_jpim1
-              zwt(ji,jj,ikst) = zwd(ji,jj,ikst)
-           END DO
-        END DO
-        
-        DO jk = ikstp1, 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
-           END DO
-        END DO
-        
-        DO jk = ikstp1, jpkm1
-           DO jj = 2, jpjm1
-              DO ji = fs_2, fs_jpim1
-                 zwy(ji,jj,jk) = zwy(ji,jj,jk) - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * zwy(ji,jj,jk-1)
-              END DO
-           END DO
-        END DO
-        
-        DO jj = 2, jpjm1
-           DO ji = fs_2, fs_jpim1
-              zwx(ji,jj,jpkm1) = zwy(ji,jj,jpkm1) / zwt(ji,jj,jpkm1)
-           END DO
-        END DO
-        
-        DO jk = ikenm2, ikst, -1
-           DO jj = 2, jpjm1
-              DO ji = fs_2, fs_jpim1
-                 zwx(ji,jj,jk) = ( zwy(ji,jj,jk) - zws(ji,jj,jk) * zwx(ji,jj,jk+1) ) / zwt(ji,jj,jk)
-              END DO
-           END DO
-        END DO
-
-#if defined key_trc_diatrd
-         ! Compute and save the vertical diffusive of tracers trends
-#  if defined key_trcldf_iso
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ztra = ( zwx(ji,jj,jk) - trb(ji,jj,jk,jn) ) / rdttrc(jk)
-                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),6) = ztra - tra(ji,jj,jk,jn) + trtrd(ji,jj,jk,ikeep(jn),6)
-               END DO
-            END DO
-         END DO
-#  else
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ztra = ( zwx(ji,jj,jk) - trb(ji,jj,jk,jn) ) / rdttrc(jk)
-                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),6) = ztra - tra(ji,jj,jk,jn)
-               END DO
-            END DO
-         END DO
-#  endif
-#endif
-
-         ! Save the masked passive tracer after in tra
-         ! (c a u t i o n:  tracer not its trend, Leap-frog scheme done
-         !                  it will not be done in tranxt)
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-                  tra(ji,jj,jk,jn) = zwx(ji,jj,jk) * tmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-
-         IF( l_trdtrc ) THEN                            ! trends
-            DO jk = 1, jpkm1
-               ztrtrd(:,:,jk) = ( ( tra(:,:,jk,jn) - trb(:,:,jk,jn) ) / rdttrc(jk) ) - ztrtrd(:,:,jk)
-            END DO
-            IF (luttrd(jn)) CALL trd_mod_trc(ztrtrd, jn, jptrc_trd_zdf, kt)
-         END IF
-
-         IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
-            ztrd(:,:,:,:) = 0.
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1
-                     ztrd(ji,jj,jk,jn) = ( zwx(ji,jj,jk) - trb(ji,jj,jk,jn) ) / rdttrc(jk)
-                  END DO
-               END DO
-            END DO
-         ENDIF
-
-         !                                                    ! ===========
-      END DO                                                  ! tracer loop
-      !                                                       ! ===========
-
-      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
-         WRITE(charout, FMT="('zdf - imp')")
-         CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=ztrd, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
-      ENDIF
-
-   END SUBROUTINE trc_zdf_imp
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Dummy module :                      NO passive tracer
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE trc_zdf_imp (kt )              ! Empty routine
-      INTEGER, INTENT(in) :: kt
-      WRITE(*,*) 'trc_zdf_imp: You should not have seen this print! error?', kt
-   END SUBROUTINE trc_zdf_imp
-#endif
-   
-!!==============================================================================
-END MODULE trczdf_imp
Index: trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf_iso.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf_iso.F90	(revision 2527)
+++ 	(revision )
@@ -1,527 +1,0 @@
-MODULE trczdf_iso
-   !!==============================================================================
-   !!                    ***  MODULE  trczdf_iso  ***
-   !! Ocean passive tracers:  vertical component of the tracer mixing trend
-   !!==============================================================================
-   !! History :  7.0  !  91-11  (G. Madec)  Original code
-   !!                 !  92-06  (M. Imbard)  correction on tracer trend loops
-   !!                 !  96-01  (G. Madec)  statement function for e3
-   !!                 !  97-05  (G. Madec)  vertical component of isopycnal
-   !!                 !  97-07  (G. Madec)  geopotential diffusion in s-coord
-   !!                 !  98-03  (L. Bopp MA Foujols) passive tracer generalisation
-   !!                 !  00-05  (MA Foujols) add lbc for tracer trends
-   !!                 !  00-06  (O Aumont)  correct isopycnal scheme suppress
-   !!                 !                     avt multiple correction
-   !!                 !  00-08  (G. Madec)  double diffusive mixing
-   !!            8.5  !  02-08  (G. Madec)  F90: Free form and module
-   !!            9.0  !  04-03  (C. Ethe )  adapted for passive tracers
-   !!----------------------------------------------------------------------
-#if defined key_top  &&  ( defined key_ldfslp   ||   defined key_esopa )
-   !!----------------------------------------------------------------------
-   !!   'key_top'       and                                      TOP models
-   !!   'key_ldfslp'                  rotation of the lateral mixing tensor
-   !!----------------------------------------------------------------------
-   !!   trc_zdf_iso  : update the tracer trend with the vertical part of 
-   !!                  the isopycnal or geopotential s-coord. operator and
-   !!                  the vertical diffusion
-   !!----------------------------------------------------------------------
-   !! * Modules used
-   USE oce_trc          ! ocean dynamics and tracers variables
-   USE trp_trc              ! ocean passive tracers variables 
-   USE lbclnk           ! ocean lateral boundary conditions (or mpp link)
-   USE trctrp_lec       ! passive tracers transport
-   USE trdmld_trc
-   USE trdmld_trc_oce
-   USE prtctl_trc          ! Print control for debbuging
-
-   IMPLICIT NONE
-   PRIVATE
-
-   !! * Accessibility
-   PUBLIC trc_zdf_iso    ! routine called by step.F90
-
-   !! * Module variable
-   REAL(wp), DIMENSION(jpk) ::   &
-      rdttrc                     ! vertical profile of 2 x tracer time-step
-
-   !! * Substitutions
-#  include "top_substitute.h90"
-   !!----------------------------------------------------------------------
-   !!   TOP 1.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE trc_zdf_iso( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE trc_zdf_iso  ***
-      !!
-      !! ** Purpose :
-      !!     Compute the trend due to the vertical tracer diffusion inclu-
-      !!     ding the vertical component of lateral mixing (only for second
-      !!     order operator, for fourth order it is already computed and
-      !!     add to the general trend in trcldf.F) and add it to the general
-      !!     trend of the tracer equations.
-      !!
-      !! ** Method :
-      !!         The vertical component of the lateral diffusive trends is
-      !!      provided by a 2nd order operator rotated along neural or geopo-
-      !!      tential surfaces to which an eddy induced advection can be added
-      !!      It is computed using before fields (forward in time) and isopyc-
-      !!      nal or geopotential slopes computed in routine ldfslp.
-      !!
-      !!      First part: vertical trends associated with the lateral mixing
-      !!      ==========  (excluding the vertical flux proportional to dk[t] )
-      !!      vertical fluxes associated with the rotated lateral mixing:
-      !!         zftw =-aht {  e2t*wslpi di[ mi(mk(trb)) ]
-      !!                     + e1t*wslpj dj[ mj(mk(trb)) ]  }
-      !!      save avt coef. resulting from vertical physics alone in zavt:
-      !!         zavt = avt
-      !!      update and save in zavt the vertical eddy viscosity coefficient:
-      !!         avt = avt + wslpi^2+wslj^2
-      !!      add vertical Eddy Induced advective fluxes ('lk_trcldf_eiv=T):
-      !!         zftw = zftw + { di[aht e2u mi(wslpi)]
-      !!                    +dj[aht e1v mj(wslpj)] } mk(trb)
-      !!      take the horizontal divergence of the fluxes:
-      !!         difft = 1/(e1t*e2t*e3t) dk[ zftw ] 
-      !!      Add this trend to the general trend tra :
-      !!         tra = tra + difft
-      !!
-      !!      Second part: vertical trend associated with the vertical physics
-      !!      ===========  (including the vertical flux proportional to dk[t]
-      !!                  associated with the lateral mixing, through the
-      !!                  update of avt)
-      !!      The vertical diffusion of tracers tra  is given by:
-      !!             difft = dz( avt dz(t) ) = 1/e3t dk+1( avt/e3w dk(t) )
-      !!      It is computed using a backward time scheme, t=ta.
-      !!      Surface and bottom boundary conditions: no diffusive flux on
-      !!      both tracers (bottom, applied through the masked field avt).
-      !!      Add this trend to the general trend tra  :
-      !!         tra = tra + dz( avt dz(t) )
-      !!         (tra = tra + dz( avs dz(t) ) if lk_trc_zdfddm=T )
-      !!
-      !!      Third part: recover avt resulting from the vertical physics
-      !!      ==========  alone, for further diagnostics (for example to
-      !!                  compute the turbocline depth in diamld).
-      !!         avt = zavt
-      !!         (avs = zavs if lk_trc_zdfddm=T )
-      !!
-      !!      'key_trdmld_trc' defined: trend saved for futher diagnostics.
-      !!
-      !!      macro-tasked on vertical slab (jj-loop)
-      !!
-      !! ** Action :
-      !!         Update tra arrays with the before vertical diffusion trend
-      !!         Save in trtrd arrays the trends if 'key_trdmld_trc' defined
-      !!---------------------------------------------------------------------
-      !! * Modules used
-      USE oce , ONLY :    zavs => va, ztrtrd => ua
-
-      !! * Arguments
-      INTEGER, INTENT( in ) ::   kt           ! ocean time-step index
-
-      !! * Local declarations
-      INTEGER ::   ji, jj, jk, jn                 ! dummy loop indices
-      INTEGER ::   ikst, ikenm2, ikstp1       ! temporary integers
-      INTEGER ::   iku, ikv, ikv1             ! temporary integers
-
-      REAL(wp) ::   &
-         ztavg,                 &  ! ???
-         zcoef0, zcoef3,        &  ! ???
-         zcoef4, zavi,          &  ! ???
-         zbtr, zmku, zmkv,      &  !
-         ztav
-      REAL(wp), DIMENSION(jpi,jpk) ::   &
-         zwd, zws, zwi,         &  ! ???
-         zwx, zwy, zwz, zwt        ! ???
-      REAL(wp), DIMENSION(jpi,jpk) ::   &
-         ztfw, zdit, zdjt, zdj1t
-#if defined key_trcldf_eiv   ||   defined key_esopa
-      REAL(wp), DIMENSION(jpi,jpk) ::   &
-         ztfwg
-
-      REAL(wp) ::         &
-         zcoeg3,          &
-         zuwk, zvwk,      &
-         zuwki, zvwki, z_hdivn_z
-#endif
-      CHARACTER (len=22) :: charout
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  ztrtrd_tmp
-      !!---------------------------------------------------------------------
-
-      IF( kt == nittrc000 ) THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'trc_zdf_iso : vertical mixing (including isopycnal component)'
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
-#if defined key_trcldf_eiv && defined key_diaeiv
-         w_trc_eiv(:,:,:) = 0.e0
-#endif
-      ENDIF
-
-
-      ! 0.0  Local constant initialization
-      ! --------------------------------
-      IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd ) THEN
-         ! time step = 2 rdttra with Arakawa or TVD advection scheme
-         IF( neuler == 0 .AND. kt == nittrc000 ) THEN
-            rdttrc(:) =  rdttra(:) * FLOAT(ndttrc)             ! restarting with Euler time stepping
-         ELSEIF( kt <= nittrc000 + ndttrc ) THEN
-            rdttrc(:) = 2. * rdttra(:) * FLOAT(ndttrc)         ! leapfrog
-         ENDIF
-      ELSE
-         rdttrc(:) =  rdttra(:) * FLOAT(ndttrc)      
-      ENDIF
-
-
-
-      ! 0.1 Save avs in zavs to recover avs in output files
-      !---------------------------------------------------
-      zavs(:,:,:) = fstravs(:,:,:)
-
-
-      ! 0.2 Update and save of avt (and avs if double diffusive mixing)
-      ! ---------------------------
-
-     DO jj = 2, jpjm1                                 !  Vertical slab
-        !                                             ! ===============
-         DO jk = 2, jpkm1
-            DO ji = 2, jpim1
-               zavi = fsahtw(ji,jj,jk)*( wslpi(ji,jj,jk)*wslpi(ji,jj,jk)   &
-                  &                     +wslpj(ji,jj,jk)*wslpj(ji,jj,jk) )
-               ! add isopycnal vertical coeff. to avs
-               fstravs(ji,jj,jk) = fstravs(ji,jj,jk) + zavi
-            END DO
-         END DO
-       !
-     END DO
-
-
-
-     DO jn = 1, jptra
-
-         IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)          ! save trends
-
-         ztavg = 0.e0
-
-         !                                                ! ===============
-         DO jj = 2, jpjm1                                 !  Vertical slab
-            !                                             ! ===============
-
-            ! I. vertical trends associated with the lateral mixing
-            ! =====================================================
-            !  (excluding the vertical flux proportional to dk[t]
-
-
-            ! I.1 horizontal tracer gradient
-            ! ------------------------------
-
-            DO jk = 1, jpkm1
-               DO ji = 1, jpim1
-                  ! i-gradient of passive tracer at jj
-                  zdit (ji,jk) = ( trb(ji+1,jj,jk,jn)-trb(ji,jj,jk,jn) ) * umask(ji,jj,jk)
-                  ! j-gradient of passive tracer at jj
-                  zdjt (ji,jk) = ( trb(ji,jj+1,jk,jn)-trb(ji,jj,jk,jn) ) * vmask(ji,jj,jk)
-                  ! j-gradient of passive tracer at jj+1
-                  zdj1t(ji,jk) = ( trb(ji,jj,jk,jn)-trb(ji,jj-1,jk,jn) ) * vmask(ji,jj-1,jk)
-               END DO
-            END DO
-
-            IF( ln_zps ) THEN
-               ! partial steps correction at the bottom ocean level 
-               DO ji = 1, jpim1
-                  ! last ocean level
-                  iku  = MIN( mbathy(ji,jj), mbathy(ji+1,jj  ) ) - 1
-                  ikv  = MIN( mbathy(ji,jj), mbathy(ji  ,jj+1) ) - 1
-                  ikv1 = MIN( mbathy(ji,jj), mbathy(ji  ,jj-1) ) - 1
-                  ! i-gradient of of passive tracer at jj
-                  zdit (ji,iku) = gtru(ji,jj,jn)
-                  ! j-gradient of of passive tracer at jj
-                  zdjt (ji,ikv) = gtrv(ji,jj,jn) 
-                  ! j-gradient of of passive tracer at jj+1
-                  zdj1t(ji,ikv1)= gtrv(ji,jj-1,jn)
-               END DO
-            ENDIF
-
-            ! I.2 Vertical fluxes
-            ! -------------------
-
-            ! Surface and bottom vertical fluxes set to zero
-            ztfw(:, 1 ) = 0.e0
-            ztfw(:,jpk) = 0.e0
-
-#if defined key_trcldf_eiv
-            ztfwg(:, 1 ) = 0.e0
-            ztfwg(:,jpk) = 0.e0
-#endif
-
-            ! interior (2=<jk=<jpk-1)
-            DO jk = 2, jpkm1
-               DO ji = 2, jpim1
-                  zcoef0 = - fsahtw(ji,jj,jk) * tmask(ji,jj,jk)
-
-                  zmku = 1./MAX( umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)   &
-                     &          +umask(ji-1,jj,jk-1) + umask(ji  ,jj,jk), 1. )
-
-                  zmkv = 1./MAX( vmask(ji,jj  ,jk-1) + vmask(ji,jj-1,jk)   &
-                     &          +vmask(ji,jj-1,jk-1) + vmask(ji,jj  ,jk), 1. )
-
-                  zcoef3 = zcoef0 * e2t(ji,jj) * zmku * wslpi (ji,jj,jk)
-                  zcoef4 = zcoef0 * e1t(ji,jj) * zmkv * wslpj (ji,jj,jk)
-
-                  ztfw(ji,jk) = zcoef3 * ( zdit (ji  ,jk-1) + zdit (ji-1,jk)     &
-                     &                    +zdit (ji-1,jk-1) + zdit (ji  ,jk) )   &
-                     &        + zcoef4 * ( zdjt (ji  ,jk-1) + zdj1t(ji  ,jk)     &
-                     &                    +zdj1t(ji  ,jk-1) + zdjt (ji  ,jk) )
-
-               END DO
-            END DO
-
-
-#if defined key_trcldf_eiv
-            !                              ! ---------------------------------------!
-            !                              ! Eddy induced vertical advective fluxes !
-            !                              ! ---------------------------------------!
-#if defined key_traldf_c2d || defined key_traldf_c3d || defined key_off_degrad
-            DO jk = 2, jpkm1
-               DO ji = 2, jpim1
-                  zuwki = ( wslpi(ji,jj,jk) + wslpi(ji-1,jj,jk) )   &
-                     &  * fsaeitru(ji-1,jj,jk) * e2u(ji-1,jj)*umask(ji-1,jj,jk)
-                  zuwk  = ( wslpi(ji,jj,jk) + wslpi(ji+1,jj,jk) )   &
-                     &  * fsaeitru(ji  ,jj,jk) * e2u(ji  ,jj)*umask(ji  ,jj,jk)
-                  zvwki = ( wslpj(ji,jj,jk) + wslpj(ji,jj-1,jk) )   &
-                     &  * fsaeitrv(ji,jj-1,jk) * e1v(ji,jj-1)*vmask(ji,jj-1,jk)
-                  zvwk  = ( wslpj(ji,jj,jk) + wslpj(ji,jj+1,jk) )   &
-                     &  * fsaeitrv(ji,jj  ,jk) * e1v(ji  ,jj)*vmask(ji  ,jj,jk)
-
-                  zcoeg3 = + 0.25 * tmask(ji,jj,jk) * ( zuwk - zuwki + zvwk - zvwki )
-
-                  ztfwg(ji,jk) = + zcoeg3 * ( trb(ji,jj,jk,jn) + trb(ji,jj,jk-1,jn) ) 
-                  ztfw(ji,jk) = ztfw(ji,jk) + ztfwg(ji,jk)
-
-# if defined key_diaeiv
-                  w_trc_eiv(ji,jj,jk) = -2. *  zcoeg3 / ( e1t(ji,jj)*e2t(ji,jj) )
-# endif
-               END DO
-            END DO
-
-#else
-            DO jk = 2, jpkm1
-               DO ji = 2, jpim1
-                  zuwki = ( wslpi(ji,jj,jk) + wslpi(ji-1,jj,jk) )   &
-                     &  * e2u(ji-1,jj)*umask(ji-1,jj,jk)
-                  zuwk  = ( wslpi(ji,jj,jk) + wslpi(ji+1,jj,jk) )   &
-                     &  * e2u(ji  ,jj)*umask(ji  ,jj,jk)
-                  zvwki = ( wslpj(ji,jj,jk) + wslpj(ji,jj-1,jk) )   &
-                     &  * e1v(ji,jj-1)*vmask(ji,jj-1,jk)
-                  zvwk  = ( wslpj(ji,jj,jk) + wslpj(ji,jj+1,jk) )   &
-                     &  * e1v(ji  ,jj)*vmask(ji  ,jj,jk)
-
-                  zcoeg3 = + 0.25 * tmask(ji,jj,jk) * fsaeitrw(ji,jj,jk)   &
-                     &            * ( zuwk - zuwki + zvwk - zvwki )
-
-                  ztfwg(ji,jk) = + zcoeg3 * ( trb(ji,jj,jk,jn) + trb(ji,jj,jk-1,jn) )
-                  ztfw(ji,jk) = ztfw(ji,jk) + ztfwg(ji,jk)
-
-# if defined key_diaeiv
-                  w_trc_eiv(ji,jj,jk) = -2. *  zcoeg3 / ( e1t(ji,jj)*e2t(ji,jj) )
-# endif
-               END DO
-            END DO
-#endif
-
-#endif
-
-
-            ! I.5 Divergence of vertical fluxes added to the general tracer trend
-            ! -------------------------------------------------------------------
-
-            DO jk = 1, jpkm1
-               DO ji = 2, jpim1
-                  zbtr =  1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )
-                  ztav = (  ztfw(ji,jk) - ztfw(ji,jk+1)  ) * zbtr
-                  tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztav
-#if defined key_trc_diatrd
-#   if defined key_trcldf_eiv
-                  ztavg = ( ztfwg(ji,jk) - ztfwg(ji,jk+1) ) * zbtr
-                  !  WARNING trtrd(ji,jj,jk,6) used for vertical gent velocity trend
-                  !                           not for damping !!!
-                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),6) = ztavg
-#   endif
-                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),6) = ztav - ztavg
-#endif
-
-               END DO
-            END DO
-            !                                             ! ===============
-         END DO                                           !   End of slab
-         !                                                ! ===============
-         ! II. Save the trends for diagnostics
-         ! ===================================
-         IF( l_trdtrc ) THEN
-#   if defined key_trcldf_eiv
-
-            ! II.1) Compute the eiv VERTICAL trend
-            DO jj = 2, jpjm1
-               DO jk = 1, jpkm1
-                  DO ji = 2, jpim1
-
-                     !-- Compute the eiv vertical divergence : 1/e3t ( dk[w_eiv] )
-                     !   N.B. This is only possible if key_diaeiv is switched on.
-                     !     Else, the vertical eiv is not diagnosed,
-                     !     so we can only store the flux form trend d_z ( T * w_eiv )
-                     !     instead of w_eiv * d_z( T ). Then, ONLY THE SUM of zonal,
-                     !     meridional, and vertical trends are valid.
-#       if defined key_diaeiv
-                     z_hdivn_z = ( 1. / fse3t(ji,jj,jk) ) * ( w_trc_eiv(ji,jj,jk) - w_trc_eiv(ji,jj,jk+1) )
-#       else
-                     z_hdivn_z = 0.e0
-#       endif
-                     !-- Compute the vertical advective trend associated with eiv
-                     zbtr =  1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )
-                     ztrtrd_tmp(ji,jj,jk) = (  ztfwg(ji,jk) - ztfwg(ji,jk+1)  ) * zbtr   &
-                          &                 - trn(ji,jj,jk,jn) * z_hdivn_z
-                  END DO
-               END DO
-            END DO
-
-            ! II.2) Save the vertical eiv trend
-            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd_tmp, jn, jptrc_trd_zei, kt )
-
-#   endif
-
-            !-- Remove vert. eiv from the current up-to-date trend
-            !   N.B. ztrtrd_tmp is recycled for this purpose
-            ztrtrd_tmp(:,:,:) = ( tra(:,:,:,jn) - ztrtrd(:,:,:) ) - ztrtrd_tmp(:,:,:)
-
-            ! Save the new trends
-            ztrtrd(:,:,:) = tra(:,:,:,jn)
-         END IF
-
-
-      END DO
-
-      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
-         WRITE(charout, FMT="('zdf - 1')")
-         CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
-      ENDIF
-
-      DO jn = 1, jptra
-         !                                                ! ===============
-         DO jj = 2, jpjm1                                 !  Vertical slab
-            !                                             ! ===============
-
-            ! II. Vertical trend associated with the vertical physics
-            ! =======================================================
-            !     (including the vertical flux proportional to dk[t] associated
-            !      with the lateral mixing, through the avt update)
-            !     dk[ avt dk[ (t,s) ] ] diffusive trends
-
-
-            ! Diagonal, inferior, superior
-            ! (including the bottom boundary condition via avs masked)
-            DO jk = 1, jpkm1
-               DO ji = 2, jpim1
-                  zwi(ji,jk) = - rdttrc(jk) * fstravs(ji,jj,jk  )   &
-                     /( fse3t(ji,jj,jk) * fse3w(ji,jj,jk  ) )
-                  zws(ji,jk) = - rdttrc(jk) * fstravs(ji,jj,jk+1)   &
-                     /( fse3t(ji,jj,jk) * fse3w(ji,jj,jk+1) )
-                  zwd(ji,jk) = 1. - zwi(ji,jk) - zws(ji,jk)
-               END DO
-            END DO
-
-            ! Surface boudary conditions
-            DO ji = 2, jpim1
-               zwi(ji,1) = 0.e0
-               zwd(ji,1) = 1. - zws(ji,1)
-            END DO
-
-            ! Second member construction
-            DO jk = 1, jpkm1
-               DO ji = 2, jpim1
-                  zwy(ji,jk) = trb(ji,jj,jk,jn) + rdttrc(jk) * tra(ji,jj,jk,jn)
-               END DO
-            END DO
-
-            ! Matrix inversion from the first level
-            ikst = 1
-#   include "zdf.matrixsolver.h90"
-#if defined key_trc_diatrd
-            ! Compute and save the vertical diffusive of tracers trends
-#  if defined key_trcldf_iso
-            DO jk = 1, jpkm1
-               DO ji = 2, jpim1
-                  ztav = ( zwx(ji,jk) - trb(ji,jj,jk,jn) ) / rdttrc(jk)
-                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),6) = ztav - tra(ji,jj,jk,jn) + trtrd(ji,jj,jk,ikeep(jn),6)
-               END DO
-            END DO
-#  else
-            DO jk = 1, jpkm1
-               DO ji = 2, jpim1
-                  ztav = ( zwx(ji,jk) - trb(ji,jj,jk,jn) ) / rdttrc(jk)
-                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),6) = ztav - tra(ji,jj,jk,jn)
-               END DO
-            END DO
-#  endif
-#endif
-            ! Compute and save the vertical diffusive of tracers trends
-            ! Save the masked passive tracer after in tra
-            ! (c a u t i o n:  tracer not its trend, Leap-frog scheme done
-            !                  it will not be done in tranxt)
-            DO jk = 1, jpkm1
-               DO ji = 2, jpim1
-                  tra(ji,jj,jk,jn) = zwx(ji,jk)  * tmask(ji,jj,jk)
-               END DO
-            END DO
-            !                                             ! ===============
-         END DO                                           !   End of slab
-         !                                                ! ===============
-
-         ! IV. Save the trends for diagnostics
-         ! ===================================
-         IF( l_trdtrc ) THEN
-            ! deduce the full vertical diff. trend (except for vertical eiv advection)
-#if defined key_trcldf_iso
-            DO jk = 1, jpkm1
-               ztrtrd(:,:,jk) = ( (tra(:,:,jk,jn) - trb(:,:,jk,jn))/rdttrc(jk) ) - ztrtrd(:,:,jk) + ztrtrd_tmp(:,:,jk)
-            END DO
-#else
-            DO jk = 1, jpkm1
-               ztrtrd(:,:,jk) = ( (tra(:,:,jk,jn) - trb(:,:,jk,jn))/rdttrc(jk) ) - ztrtrd(:,:,jk)
-            END DO
-#endif
-            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd, jn, jptrc_trd_zdf, kt )
-
-         END IF
-
-      END DO
-
-
-
-      ! III. recover the avt (avs) resulting from vertical physics only
-      !---------------------------------------------------------------
-      fstravs(:,:,:) = zavs(:,:,:)
-
-      
-      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
-         WRITE(charout, FMT="('zdf - 2')")
-         CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
-      ENDIF
-
-   END SUBROUTINE trc_zdf_iso
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Dummy module               NO rotation of the lateral mixing tensor
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE trc_zdf_iso( kt )              ! empty routine
-      WRITE(*,*) 'trc_zdf_iso: You should not have seen this print! error?', kt
-   END SUBROUTINE trc_zdf_iso
-#endif
-
-   !!==============================================================================
-END MODULE trczdf_iso
Index: trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf_iso_vopt.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf_iso_vopt.F90	(revision 2527)
+++ 	(revision )
@@ -1,638 +1,0 @@
-MODULE trczdf_iso_vopt
-   !!======================================================================
-   !!                 ***  MODULE  trczdf_iso_vopt  ***
-   !! Ocean passive tracers:  vertical component of the tracer mixing trend
-   !!======================================================================
-   !! History :  6.0  !  90-10 (B. Blanke)  Original code
-   !!            7.0  !  91-11 (G. Madec)
-   !!                 !  92-06 (M. Imbard) correction on tracer trend loops
-   !!                 !  96-01 (G. Madec) statement function for e3
-   !!                 !  97-05 (G. Madec) vertical component of isopycnal
-   !!                 !  97-07 (G. Madec) geopotential diffusion in s-coord
-   !!                 !  98-03  (L. Bopp MA Foujols) passive tracer generalisation
-   !!                 !  00-05  (MA Foujols) add lbc for tracer trends
-   !!                 !  00-06  (O Aumont)  correct isopycnal scheme suppress
-   !!                 !                     avt multiple correction
-   !!                 !  00-08  (G. Madec)  double diffusive mixing
-   !!            8.5  !  02-08  (G. Madec)  F90: Free form and module
-   !!            9.0  !  04-03  (C. Ethe )  adapted for passive tracers
-   !!                 !  06-08  (C. Deltel) Diagnose ML trends for passive tracer
-   !!----------------------------------------------------------------------
-#if defined key_top && ( defined key_ldfslp   ||   defined key_esopa )
-   !!----------------------------------------------------------------------
-   !!   'key_ldfslp'                  rotation of the lateral mixing tensor
-   !!----------------------------------------------------------------------
-   !!   trc_zdf_iso_vopt : Update the tracer trend with the vertical part of 
-   !!                  the isopycnal or geopotential s-coord. operator and
-   !!                  the vertical diffusion. vector optimization, use
-   !!                  k-j-i loops.
-   !!   trc_zdf_iso  :
-   !!   trc_zdf_zdf  :
-   !!----------------------------------------------------------------------
-   USE oce_trc               ! ocean dynamics and tracers variables
-   USE trp_trc                   ! ocean passive tracers variables 
-   USE lbclnk                ! ocean lateral boundary conditions (or mpp link)
-   USE trctrp_lec
-   USE prtctl_trc            ! Print control for debbuging
-   USE trdmld_trc
-   USE trdmld_trc_oce     
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC trc_zdf_iso_vopt   !  routine called by step.F90
-
-   REAL(wp), DIMENSION(jpk) ::   rdttrc                    ! vertical profile of 2 x time-step
-   REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   ztrcavg  ! workspace arrays
-
-   !! * Substitutions
-#  include "top_substitute.h90"
-   !!----------------------------------------------------------------------
-   !!   TOP 1.0 , LOCEAN-IPSL (2005) 
-   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trczdf_iso_vopt.F90,v 1.11 2007/02/21 12:55:33 opalod Exp $ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-   
-   SUBROUTINE trc_zdf_iso_vopt( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE trc_zdf_iso_vopt  ***
-      !!
-      !! ** Purpose :
-      !! ** Method  :
-      !! ** Action  :
-      !!---------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
-      CHARACTER (len=22) :: charout
-      !!---------------------------------------------------------------------
-
-      IF( kt == nittrc000 ) THEN
-         IF(lwp)WRITE(numout,*)
-         IF(lwp)WRITE(numout,*) 'trc_zdf_iso_vopt : vertical mixing computation'
-         IF(lwp)WRITE(numout,*) '~~~~~~~~~~~~~~~~   is  iso-neutral diffusion : implicit vertical time stepping'
-#if defined key_trcldf_eiv && defined key_diaeiv 
-         w_trc_eiv(:,:,:) = 0.e0
-#endif
-      ENDIF
-
-      IF( l_trdtrc ) THEN
-         ALLOCATE( ztrcavg(jpi,jpj,jpk,jptra) )
-         ztrcavg(:,:,:,:) = 0.e0          ! initialisation step
-      ENDIF
-
-      ! I. vertical extra-diagonal part of the rotated tensor
-      ! -----------------------------------------------------
-
-      CALL trc_zdf_iso( kt )
-
-      IF( ln_ctl ) THEN    ! print mean trends (used for debugging)
-         WRITE(charout, FMT="('zdf - 1')")
-         CALL prt_ctl_trc_info( charout )
-         CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
-      ENDIF
-
-      ! II. vertical diffusion (including the vertical diagonal part of the rotated tensor)
-      ! ----------------------
-
-      CALL trc_zdf_zdf( kt )
-
-      IF( ln_ctl ) THEN    ! print mean trends (used for debugging)
-         WRITE(charout, FMT="('zdf - 2')")
-         CALL prt_ctl_trc_info( charout )
-         CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
-      ENDIF
-
-      IF( l_trdtrc ) DEALLOCATE( ztrcavg )
-
-   END SUBROUTINE trc_zdf_iso_vopt
-
-
-   SUBROUTINE trc_zdf_zdf( kt )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE trc_zdf_zdf  ***
-      !!                    
-      !! ** Purpose :   Compute the trend due to the vertical tracer diffusion
-      !!     including the vertical component of lateral mixing (only for 2nd
-      !!     order operator, for fourth order it is already computed and add
-      !!     to the general trend in traldf.F) and add it to the general trend
-      !!     of the tracer equations.
-      !!
-      !! ** Method  :   The vertical component of the lateral diffusive trends
-      !!      is provided by a 2nd order operator rotated along neural or geo-
-      !!      potential surfaces to which an eddy induced advection can be 
-      !!      added. It is computed using before fields (forward in time) and 
-      !!      isopycnal or geopotential slopes computed in routine ldfslp.
-      !!
-      !!      Second part: vertical trend associated with the vertical physics
-      !!      ===========  (including the vertical flux proportional to dk[t]
-      !!                  associated with the lateral mixing, through the
-      !!                  update of avt)
-      !!      The vertical diffusion of tracers  is given by:
-      !!             difft = dz( avt dz(t) ) = 1/e3t dk+1( avt/e3w dk(t) )
-      !!      It is computed using a backward time scheme (t=tra).
-      !!      Surface and bottom boundary conditions: no diffusive flux on
-      !!      both tracers (bottom, applied through the masked field avt).
-      !!      Add this trend to the general trend tra :
-      !!         tra = tra + dz( avt dz(t) )
-      !!         (tra = tra + dz( avs dz(t) ) if lk_trc_zdfddm=T )
-      !!
-      !!      Third part: recover avt resulting from the vertical physics
-      !!      ==========  alone, for further diagnostics (for example to
-      !!                  compute the turbocline depth in diamld).
-      !!         avt = zavt
-      !!         (avs = zavs if lk_trc_zdfddm=T )
-      !!
-      !!      'key_trdtra' defined: trend saved for futher diagnostics.
-      !!
-      !!      macro-tasked on vertical slab (jj-loop)
-      !!
-      !! ** Action  : - Update tra with before vertical diffusion trend
-      !!              - Save the trend in trtrd  ('key_trdmld_trc')
-      !!---------------------------------------------------------------------
-      USE oce, ONLY :       zwd   => ua,  &  ! ua, va used as
-                            zws   => va      ! workspace
-      INTEGER, INTENT( in ) ::   kt          ! ocean time-step index
-      INTEGER  ::   ji, jj, jk, jn            ! dummy loop indices
-      REAL(wp) ::   zavi, zrhs               ! temporary scalars
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
-         zwi, zwt, zavsi                     ! temporary workspace arrays
-#  if defined key_trc_diatrd
-      REAL(wp) ::   ztra
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztrd
-#  endif
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd
-      !!---------------------------------------------------------------------
-
-
-      ! I. Local constant initialization
-      ! --------------------------------
-      ! ... time step = 2 rdttra ex
-      IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd ) THEN
-         ! time step = 2 rdttra with Arakawa or TVD advection scheme
-         IF( neuler == 0 .AND. kt == nittrc000 ) THEN
-            rdttrc(:) =  rdttra(:) * FLOAT(ndttrc)             ! restarting with Euler time stepping
-         ELSEIF( kt <= nittrc000 + ndttrc ) THEN
-            rdttrc(:) = 2. * rdttra(:) * FLOAT(ndttrc)         ! leapfrog
-         ENDIF
-      ELSE
-         rdttrc(:) =  rdttra(:) * FLOAT(ndttrc)      
-      ENDIF
-
-         
-      zwd  ( 1, :, : ) = 0.e0    ;     zwd  ( jpi, :,   : ) = 0.e0
-      zws  ( 1, :, : ) = 0.e0    ;     zws  ( jpi, :,   : ) = 0.e0
-      zwi  ( 1, :, : ) = 0.e0    ;     zwi  ( jpi, :,   : ) = 0.e0
-      zwt  ( 1, :, : ) = 0.e0    ;     zwt  ( jpi, :,   : ) = 0.e0
-      zwt  ( :, :, 1 ) = 0.e0    ;     zwt  (   :, :, jpk ) = 0.e0
-      zavsi( 1, :, : ) = 0.e0    ;     zavsi( jpi, :,   : ) = 0.e0 
-      zavsi( :, :, 1 ) = 0.e0    ;     zavsi(   :, :, jpk ) = 0.e0
-
-
-      ! II. Vertical trend associated with the vertical physics
-      !=======================================================
-      !     (including the vertical flux proportional to dk[t] associated
-      !      with the lateral mixing, through the avt update)
-      !     dk[ avt dk[ (t,s) ] ] diffusive trends
-
-      ! II.0 Matrix construction
-      ! ------------------------        
-      ! update and save of avt (and avs if double diffusive mixing)
-      DO jk = 2, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zavi = fsahtw(ji,jj,jk) * (                 &   ! vertical mixing coef. due to lateral mixing
-                  &                           wslpi(ji,jj,jk) * wslpi(ji,jj,jk)      &
-                  &                         + wslpj(ji,jj,jk) * wslpj(ji,jj,jk)  )
-               zavsi(ji,jj,jk) = fstravs(ji,jj,jk) + zavi        ! dd mixing: zavsi = total vertical mixing coef. on tracer
-            END DO
-         END DO
-      END DO
-
-      ! II.1 Vertical diffusion on tracer
-      ! ---------------------------------
-      ! Rebuild the Matrix as avt /= avs
-
-      ! Diagonal, inferior, superior  (including the bottom boundary condition via avs masked)
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zwi(ji,jj,jk) = - rdttrc(jk) * zavsi(ji,jj,jk  ) / ( fse3t(ji,jj,jk) * fse3w(ji,jj,jk  ) )
-               zws(ji,jj,jk) = - rdttrc(jk) * zavsi(ji,jj,jk+1) / ( fse3t(ji,jj,jk) * fse3w(ji,jj,jk+1) )
-               zwd(ji,jj,jk) = 1. - zwi(ji,jj,jk) - zws(ji,jj,jk)
-            END DO
-         END DO
-      END DO
-
-      ! Surface boudary conditions
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1   ! vector opt.
-            zwi(ji,jj,1) = 0.e0
-            zwd(ji,jj,1) = 1. - zws(ji,jj,1)
-         END DO
-      END DO
-
-      !! Matrix inversion from the first level
-      !!----------------------------------------------------------------------
-      !   solve m.x = y  where m is a tri diagonal matrix ( jpk*jpk )
-      !
-      !        ( zwd1 zws1   0    0    0  )( zwx1 ) ( zwy1 )
-      !        ( zwi2 zwd2 zws2   0    0  )( zwx2 ) ( zwy2 )
-      !        (  0   zwi3 zwd3 zws3   0  )( zwx3 )=( zwy3 )
-      !        (        ...               )( ...  ) ( ...  )
-      !        (  0    0    0   zwik zwdk )( zwxk ) ( zwyk )
-      !
-      !   m is decomposed in the product of an upper and lower triangular
-      !   matrix
-      !   The 3 diagonal terms are in 2d arrays: zwd, zws, zwi
-      !   The second member is in 2d array zwy
-      !   The solution is in 2d array zwx
-      !   The 3d arry zwt is a work space array
-      !   zwy is used and then used as a work space array : its value is modified!
-
-      ! first recurrence:   Tk = Dk - Ik Sk-1 / Tk-1   (increasing k)
-      DO jj = 2, jpjm1
-         DO ji = fs_2, fs_jpim1
-            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
-         END DO
-      END DO
-
-      IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk) )
-
-      !                                                          ! ===========
-      DO jn = 1, jptra                                           ! tracer loop
-         !                                                       ! ===========
-         
-         IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)          ! save trends
-
-#  if defined key_trc_diatrd
-         ! save the tra trend
-         ztrd(:,:,:) = tra(:,:,:,jn)
-#  endif
-
-         ! second recurrence:    Zk = Yk - Ik / Tk-1  Zk-1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               tra(ji,jj,1,jn) = trb(ji,jj,1,jn) + rdttrc(1) * tra(ji,jj,1,jn)
-            END DO
-         END DO
-         DO jk = 2, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-                  zrhs = trb(ji,jj,jk,jn) + rdttrc(jk) * tra(ji,jj,jk,jn)   ! zrhs=right hand side
-                  tra(ji,jj,jk,jn) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * tra(ji,jj,jk-1,jn)
-               END DO
-            END DO
-         END DO
-
-         ! third recurrence: Xk = (Zk - Sk Xk+1 ) / Tk
-         ! Save the masked passive tracer after in tra
-         ! (c a u t i o n: passive tracer not its trend, Leap-frog scheme done it will not be done in tranxt)
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1
-               tra(ji,jj,jpkm1,jn) = tra(ji,jj,jpkm1,jn) / zwt(ji,jj,jpkm1) * tmask(ji,jj,jpkm1)
-            END DO
-         END DO
-         DO jk = jpk-2, 1, -1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1
-                  tra(ji,jj,jk,jn) = ( tra(ji,jj,jk,jn) - zws(ji,jj,jk) * tra(ji,jj,jk+1,jn) ) / zwt(ji,jj,jk) * tmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-
-#if defined key_trc_diatrd
-         ! Compute and save the vertical diffusive passive tracer trends
-#  if defined key_trcldf_iso
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ztra = ( tra(ji,jj,jk,jn) - trb(ji,jj,jk,jn) ) / rdttrc(jk)
-                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),6) = ztra - ztrd(ji,jj,jk) + trtrd(ji,jj,jk,ikeep(jn),6)
-               END DO
-            END DO
-         END DO
-#  else
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  ztra = ( tra(ji,jj,jk,jn) - trb(ji,jj,jk,jn) ) / rdttrc(jk)
-                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),6) = ztra - ztrd(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-#  endif
-#endif
-
-
-         ! III. Save vertical trend assoc. with the vertical physics for diagnostics
-         ! =========================================================================
-         IF( l_trdtrc )   THEN
-
-            ! III.1) Deduce the full vertical diff. trend (except for vertical eiv advection)
-            ! N.B. tavg & savg contain the contribution from the extra diagonal part
-            !   of the rotated tensor (from trc_zdf_iso).
-            IF( ln_trcldf_iso ) THEN
-               DO jk = 1, jpkm1
-                  ztrtrd(:,:,jk) = ( (tra(:,:,jk,jn) - trb(:,:,jk,jn))/rdttrc(jk) ) - ztrtrd(:,:,jk)  &
-                       &           + ztrcavg(:,:,jk,jn) 
-               END DO
-            ELSE
-               DO jk = 1, jpkm1
-                  ztrtrd(:,:,jk) = ( (tra(:,:,jk,jn) - trb(:,:,jk,jn))/rdttrc(jk) ) - ztrtrd(:,:,jk)
-               END DO
-            ENDIF
-            
-            ! III.2) save the trends for diagnostic
-            ! N.B. However the purely vertical diffusion "K_z" (included here) will be deduced
-            !   and removed from this trend before storage. It is stored separately, so as to
-            !   clearly distinguish both contributions (see trd_mld)
-            IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd, jn, jptrc_trd_zdf, kt )
-
-         END IF
-         !                                                    ! ===========
-      END DO                                                  ! tracer loop
-      !                                                       ! ===========
-      
-      IF( l_trdtrc ) DEALLOCATE( ztrtrd )
-
-   END SUBROUTINE trc_zdf_zdf
-
-
-   SUBROUTINE trc_zdf_iso ( kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE trc_zdf_iso  ***
-      !!
-      !! ** Purpose :
-      !!     Compute the trend due to the vertical tracer diffusion inclu-
-      !!     ding the vertical component of lateral mixing (only for second
-      !!     order operator, for fourth order it is already computed and
-      !!     add to the general trend in traldf.F) and add it to the general
-      !!     trend of the tracer equations.
-      !!
-      !! ** Method :
-      !!         The vertical component of the lateral diffusive trends is
-      !!      provided by a 2nd order operator rotated along neural or geopo-
-      !!      tential surfaces to which an eddy induced advection can be added
-      !!      It is computed using before fields (forward in time) and isopyc-
-      !!      nal or geopotential slopes computed in routine ldfslp.
-      !!
-      !!      First part: vertical trends associated with the lateral mixing
-      !!      ==========  (excluding the vertical flux proportional to dk[t] )
-      !!      vertical fluxes associated with the rotated lateral mixing:
-      !!         zftw =-aht {  e2t*wslpi di[ mi(mk(trb)) ]
-      !!                     + e1t*wslpj dj[ mj(mk(trb)) ]  }
-      !!      save avt coef. resulting from vertical physics alone in zavt:
-      !!         zavt = avt
-      !!      update and save in zavt the vertical eddy viscosity coefficient:
-      !!         avt = avt + wslpi^2+wslj^2
-      !!      add vertical Eddy Induced advective fluxes (lk_traldf_eiv=T):
-      !!         zftw = zftw + { di[aht e2u mi(wslpi)]
-      !!                    +dj[aht e1v mj(wslpj)] } mk(trb)
-      !!      take the horizontal divergence of the fluxes:
-      !!         difft = 1/(e1t*e2t*e3t) dk[ zftw ] 
-      !!      Add this trend to the general trend tra :
-      !!         tra = tra + difft
-      !!
-      !! ** Action :
-      !!         Update tra arrays with the before vertical diffusion trend
-      !!         Save in trtrd arrays the trends if 'key_trdmld_trc' defined
-      !!---------------------------------------------------------------------
-      USE oce, ONLY :   zwx => ua,  &  ! use ua, va as
-                        zwy => va      ! workspace arrays
-      INTEGER, INTENT(in) :: kt
-
-      INTEGER ::   ji, jj, jk, jn                ! dummy loop indices
-      INTEGER ::   iku, ikv                      
-      REAL(wp) ::   ztavg                        ! temporary scalars
-      REAL(wp) ::   zcoef0, zcoef3               !    "         "
-      REAL(wp) ::   zcoef4                       !    "         "
-      REAL(wp) ::   zbtr, zmku, zmkv             !    "         "
-#if defined key_trcldf_eiv                       
-      REAL(wp) ::   zcoeg3, z_hdivn_z            !    "         "
-      REAL(wp) ::   zuwki, zvwki                 !    "         "
-      REAL(wp) ::   zuwk, zvwk                   !    "         "
-#endif
-      REAL(wp) ::   ztav
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwz  ! temporary workspace arrays
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwt
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztfw
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd
-      !!---------------------------------------------------------------------
-
-
-      IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk) )
-
-      !                                                          ! ===========
-      DO jn = 1, jptra                                           ! tracer loop
-         !                                                       ! ===========
-
-         ! 0. Local constant initialization
-         ! --------------------------------
-         zwx (1,:,:) = 0.e0    ;     zwx (jpi,:,:) = 0.e0
-         zwy (1,:,:) = 0.e0    ;     zwy (jpi,:,:) = 0.e0
-         zwz (1,:,:) = 0.e0    ;     zwz (jpi,:,:) = 0.e0
-         zwt (1,:,:) = 0.e0    ;     zwt (jpi,:,:) = 0.e0
-         ztfw(1,:,:) = 0.e0    ;     ztfw(jpi,:,:) = 0.e0
-
-         IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)          ! save trends
-
-         ztavg = 0.e0
-
-         ! I. Vertical trends associated with lateral mixing
-         ! -------------------------------------------------
-         !    (excluding the vertical flux proportional to dk[t] )
-
-         ! I.1 horizontal tracer gradient
-         ! ------------------------------
-
-         DO jk = 1, jpkm1
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  ! i-gradient of passive tracer at ji
-                  zwx (ji,jj,jk) = ( trb(ji+1,jj,jk,jn)-trb(ji,jj,jk,jn) ) * umask(ji,jj,jk)
-                  ! j-gradient of passive tracer at jj
-                  zwy (ji,jj,jk) = ( trb(ji,jj+1,jk,jn)-trb(ji,jj,jk,jn) ) * vmask(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-         IF( ln_zps ) THEN
-            ! partial steps correction at the bottom ocean level 
-            DO jj = 1, jpjm1
-               DO ji = 1, fs_jpim1   ! vector opt.
-                  ! last ocean level
-                  iku  = MIN( mbathy(ji,jj), mbathy(ji+1,jj  ) ) - 1
-                  ikv  = MIN( mbathy(ji,jj), mbathy(ji  ,jj+1) ) - 1
-                  ! i-gradient of passive tracer
-                  zwx (ji,jj,iku) = gtru(ji,jj,jn)
-                  ! j-gradient of passive tracer
-                  zwy (ji,jj,ikv) = gtrv(ji,jj,jn)  
-               END DO
-            END DO
-         ENDIF
-
-         ! I.2 Vertical fluxes
-         ! -------------------
-
-         ! Surface and bottom vertical fluxes set to zero
-         ztfw(:,:, 1 ) = 0.e0
-         ztfw(:,:,jpk) = 0.e0
-
-         ! interior (2=<jk=<jpk-1)
-         DO jk = 2, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zcoef0 = - fsahtw(ji,jj,jk) * tmask(ji,jj,jk)
-
-                  zmku = 1./MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)      &
-                     &           + umask(ji-1,jj,jk-1) + umask(ji  ,jj,jk), 1.  )
-
-                  zmkv = 1./MAX(   vmask(ji,jj  ,jk-1) + vmask(ji,jj-1,jk)      &
-                     &           + vmask(ji,jj-1,jk-1) + vmask(ji,jj  ,jk), 1.  )
-
-                  zcoef3 = zcoef0 * e2t(ji,jj) * zmku * wslpi (ji,jj,jk)
-                  zcoef4 = zcoef0 * e1t(ji,jj) * zmkv * wslpj (ji,jj,jk)
-
-                  ztfw(ji,jj,jk) = zcoef3 * (   zwx(ji  ,jj  ,jk-1) + zwx(ji-1,jj  ,jk)      &
-                     &                        + zwx(ji-1,jj  ,jk-1) + zwx(ji  ,jj  ,jk)  )   &
-                     &           + zcoef4 * (   zwy(ji  ,jj  ,jk-1) + zwy(ji  ,jj-1,jk)      &
-                     &                        + zwy(ji  ,jj-1,jk-1) + zwy(ji  ,jj  ,jk)  )
-               END DO
-            END DO
-         END DO
-
-#if defined key_trcldf_eiv
-         !                              ! ---------------------------------------!
-         !                              ! Eddy induced vertical advective fluxes !
-         !                              ! ---------------------------------------!
-         zwx(:,:, 1 ) = 0.e0
-         zwx(:,:,jpk) = 0.e0
-
-         DO jk = 2, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-#   if defined key_traldf_c2d || defined key_traldf_c3d  || defined key_off_degrad
-                  zuwki = ( wslpi(ji,jj,jk) + wslpi(ji-1,jj,jk) )   &
-                     &  * fsaeitru(ji-1,jj,jk) * e2u(ji-1,jj) * umask(ji-1,jj,jk)
-                  zuwk  = ( wslpi(ji,jj,jk) + wslpi(ji+1,jj,jk) )   &
-                     &  * fsaeitru(ji  ,jj,jk) * e2u(ji  ,jj) * umask(ji  ,jj,jk)
-                  zvwki = ( wslpj(ji,jj,jk) + wslpj(ji,jj-1,jk) )   &
-                     &  * fsaeitrv(ji,jj-1,jk) * e1v(ji,jj-1) * vmask(ji,jj-1,jk)
-                  zvwk  = ( wslpj(ji,jj,jk) + wslpj(ji,jj+1,jk) )   &
-                     &  * fsaeitrv(ji,jj  ,jk) * e1v(ji  ,jj) * vmask(ji  ,jj,jk)
-
-                  zcoeg3 = + 0.25 * tmask(ji,jj,jk) * ( zuwk - zuwki + zvwk - zvwki )
-#   else
-                  zuwki = ( wslpi(ji,jj,jk) + wslpi(ji-1,jj,jk) )   &
-                     &  * e2u(ji-1,jj) * umask(ji-1,jj,jk)
-                  zuwk  = ( wslpi(ji,jj,jk) + wslpi(ji+1,jj,jk) )   &
-                     &  * e2u(ji  ,jj) * umask(ji  ,jj,jk)
-                  zvwki = ( wslpj(ji,jj,jk) + wslpj(ji,jj-1,jk) )   &
-                     &  * e1v(ji,jj-1) * vmask(ji,jj-1,jk)
-                  zvwk  = ( wslpj(ji,jj,jk) + wslpj(ji,jj+1,jk) )   &
-                     &  * e1v(ji  ,jj) * vmask(ji  ,jj,jk)
-
-                  zcoeg3 = + 0.25 * tmask(ji,jj,jk) * fsaeiw(ji,jj,jk)   &
-                     &            * ( zuwk - zuwki + zvwk - zvwki )
-#   endif
-                  zwx(ji,jj,jk) = + zcoeg3 * ( trb(ji,jj,jk,jn) + trb(ji,jj,jk-1,jn) )
-
-                  ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + zwx(ji,jj,jk)
-#   if defined key_diaeiv
-                  w_trc_eiv(ji,jj,jk) = -2. * zcoeg3 / ( e1t(ji,jj)*e2t(ji,jj) )
-#   endif
-               END DO
-            END DO
-         END DO
-#endif
-
-         ! I.3 Divergence of vertical fluxes added to the general tracer trend
-         ! -------------------------------------------------------------------
-
-         DO jk = 1, jpkm1
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zbtr =  1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )
-                  ztav = (  ztfw(ji,jj,jk) - ztfw(ji,jj,jk+1)  ) * zbtr
-                  tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztav
-#if defined key_trc_diatrd
-#   if defined key_trcldf_eiv
-                  ztavg = ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) * zbtr
-                  !  WARNING trtrd(ji,jj,jk,7) used for vertical gent velocity trend  not for damping !!!
-                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),7) = ztavg
-#   endif
-                  IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),6) = ztav - ztavg
-#endif
-
-               END DO
-            END DO
-         END DO
-
-         ! II. Save the trends for diagnostics
-         ! -----------------------------------
-         IF( l_trdtrc )   THEN
-#if defined key_trcldf_eiv
-
-            ! II.1) Compute the eiv VERTICAL trend
-            DO jk = 1, jpkm1
-               DO jj = 2, jpjm1
-                  DO ji = fs_2, fs_jpim1   ! vector opt.
-                     
-                     !-- Compute the eiv vertical divergence : 1/e3t ( dk[w_eiv] )
-                     !   N.B. This is only possible if key_diaeiv is switched on.
-                     !     Else, the vertical eiv is not diagnosed,
-                     !     so we can only store the flux form trend d_z ( T * w_eiv )
-                     !     instead of w_eiv * d_z( T ). Then, ONLY THE SUM of zonal,
-                     !     meridional, and vertical trends are valid.
-#   if defined key_diaeiv
-                     z_hdivn_z = ( 1. / fse3t(ji,jj,jk) ) * ( w_trc_eiv(ji,jj,jk) - w_trc_eiv(ji,jj,jk+1) )
-#   else
-                     z_hdivn_z = 0.e0
-#   endif
-                     zbtr =  1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )
-                     ztrcavg(ji,jj,jk,jn) = ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) * zbtr &
-                           &                - trn(ji,jj,jk,jn) * z_hdivn_z
-                  END DO
-               END DO
-            END DO
-
-            ! II.2) save the trends for diagnostic
-            !       N.B. The other part of the computed trend is stored below for later
-            !         output (see trc_zdf_zdf)  
-            IF (luttrd(jn)) CALL trd_mod_trc( ztrcavg(:,:,:,jn), jn, jptrc_trd_zei, kt )
-
-#endif
-            !-- Retain only the vertical diff. trends due to the extra diagonal
-            !   part of the rotated tensor (i.e. remove vert. eiv from the trend)
-            !   N.B. ztrcavg is recycled for this purpose
-            ztrcavg(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:) - ztrcavg(:,:,:,jn)
-
-          END IF
-
-         !                                                       ! ===========
-      END DO                                                     ! tracer loop
-      !                                                          ! ===========
-
-      IF( l_trdtrc ) DEALLOCATE( ztrtrd )
-
-   END SUBROUTINE trc_zdf_iso
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Dummy module :             NO rotation of the lateral mixing tensor
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE trc_zdf_iso_vopt( kt )              ! empty routine
-      WRITE(*,*) 'trc_zdf_iso_vopt: You should not have seen this print! error?', kt
-   END SUBROUTINE trc_zdf_iso_vopt
-#endif
-
-   !!==============================================================================
-END MODULE trczdf_iso_vopt
Index: trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trdmld_trc.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trdmld_trc.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trdmld_trc.F90	(revision 2528)
@@ -16,8 +16,13 @@
    !!   trd_mld_trc_init : initialization step
    !!----------------------------------------------------------------------
-   USE trp_trc           ! tracer definitions (trn, trb, tra, etc.)
-   USE oce_trc           ! needed for namelist logicals, and euphotic layer arrays
-   USE trctrp_lec
-   USE trdmld_trc_oce    ! definition of main arrays used for trends computations
+   USE trc               ! tracer definitions (trn, trb, tra, etc.)
+   USE dom_oce           ! domain definition
+   USE zdfmxl  , ONLY : nmln !: number of level in the mixed layer
+   USE zdf_oce , ONLY : avt  !: vert. diffusivity coef. at w-point for temp  
+# if defined key_zdfddm   
+   USE zdfddm  , ONLY : avs  !: salinity vertical diffusivity coeff. at w-point
+# endif
+   USE trcnam_trp      ! passive tracers transport namelist variables
+   USE trdmod_trc_oce    ! definition of main arrays used for trends computations
    USE in_out_manager    ! I/O manager
    USE dianam            ! build the name of file (routine)
@@ -29,17 +34,13 @@
    USE sms_pisces        
    USE sms_lobster
-   USE trc
 
    IMPLICIT NONE
    PRIVATE
 
-   INTERFACE trd_mod_trc
-      MODULE PROCEDURE trd_mod_trc_trp, trd_mod_trc_bio
-   END INTERFACE
-
-   PUBLIC trd_mod_trc                                             ! routine called by step.F90
    PUBLIC trd_mld_trc
    PUBLIC trd_mld_bio
    PUBLIC trd_mld_trc_init
+   PUBLIC trd_mld_trc_zint
+   PUBLIC trd_mld_bio_zint
 
    CHARACTER (LEN=40) ::  clhstnam                                ! name of the trends NetCDF file
@@ -60,78 +61,10 @@
 #  include "top_substitute.h90"
    !!----------------------------------------------------------------------
-   !!   TOP 1.0 , LOCEAN-IPSL (2007) 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Header:  $ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
 CONTAINS
-
-   SUBROUTINE trd_mod_trc_trp( ptrtrd, kjn, ktrd, kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE trd_mod_trc  ***
-      !!----------------------------------------------------------------------
-#if defined key_trcbbl_adv
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zun, zvn                   ! temporary arrays
-#else
-      USE oce_trc,   zun => un                                            ! When no bbl, zun == un
-      USE oce_trc,   zvn => vn                                            ! When no bbl, zvn == vn
-#endif
-      INTEGER, INTENT( in )  ::   kt                                  ! time step
-      INTEGER, INTENT( in )  ::   kjn                                 ! tracer index
-      INTEGER, INTENT( in )  ::   ktrd                                ! tracer trend index
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout )  ::   ptrtrd  ! Temperature or U trend
-      !!----------------------------------------------------------------------
-
-      IF( kt == nittrc000 ) THEN
-!         IF(lwp)WRITE(numout,*)
-!         IF(lwp)WRITE(numout,*) 'trd_mod_trc:'
-!         IF(lwp)WRITE(numout,*) '~~~~~~~~~~~~'
-      ENDIF
-
-      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
-      ! Mixed layer trends for passive tracers
-      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-
-      SELECT CASE ( ktrd )
-         CASE ( jptrc_trd_xad     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_xad    , '3D', kjn )
-         CASE ( jptrc_trd_yad     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_yad    , '3D', kjn )
-         CASE ( jptrc_trd_zad     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_zad    , '3D', kjn )
-         CASE ( jptrc_trd_ldf     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_ldf    , '3D', kjn )
-         CASE ( jptrc_trd_xei     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_xei    , '3D', kjn )
-         CASE ( jptrc_trd_yei     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_yei    , '3D', kjn )
-         CASE ( jptrc_trd_bbl     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_bbl    , '3D', kjn )
-         CASE ( jptrc_trd_zdf     )
-            IF( ln_trcldf_iso ) THEN
-               CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_ldf, '3D', kjn )
-            ELSE
-               CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_zdf, '3D', kjn )
-            ENDIF
-         CASE ( jptrc_trd_zei     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_zei    , '3D', kjn )
-         CASE ( jptrc_trd_dmp     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_dmp    , '3D', kjn )
-         CASE ( jptrc_trd_sbc     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_sbc    , '2D', kjn )
-         CASE ( jptrc_trd_sms     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_sms    , '3D', kjn )
-         CASE ( jptrc_trd_bbc     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_bbc    , '3D', kjn )
-         CASE ( jptrc_trd_radb    )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_radb   , '3D', kjn )
-         CASE ( jptrc_trd_radn    )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_radn   , '3D', kjn )
-         CASE ( jptrc_trd_atf     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_atf    , '3D', kjn )
-      END SELECT
-
-
-   END SUBROUTINE trd_mod_trc_trp
-
-   SUBROUTINE trd_mod_trc_bio( ptrbio, ktrd, kt )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE trd_mod_bio  ***
-      !!----------------------------------------------------------------------
-
-      INTEGER, INTENT( in )  ::   kt                                  ! time step
-      INTEGER, INTENT( in )  ::   ktrd                                ! bio trend index
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout )  ::   ptrbio  ! Bio trend
-      !!----------------------------------------------------------------------
-
-      CALL trd_mld_bio_zint( ptrbio, ktrd ) ! Verticaly integrated biological trends
-
-   END SUBROUTINE trd_mod_trc_bio
-
 
    SUBROUTINE trd_mld_trc_zint( ptrc_trdmld, ktrd, ctype, kjn )
@@ -170,5 +103,5 @@
           
          ! ... Set nmld(ji,jj) = index of first T point below control surf. or outside mixed-layer
-         SELECT CASE ( nctls_trc )                                ! choice of the control surface
+         SELECT CASE ( nn_ctls_trc )                                ! choice of the control surface
             CASE ( -2  )   ;   STOP 'trdmld_trc : not ready '     !     -> isopycnal surface (see ???)
 #if defined key_pisces || defined key_lobster
@@ -177,6 +110,6 @@
             CASE (  0  )   ;   nmld_trc(:,:) = nmln(:,:)          !     -> ML with density criterion (see zdfmxl)
             CASE (  1  )   ;   nmld_trc(:,:) = nbol_trc(:,:)          !     -> read index from file
-            CASE (  2: )   ;   nctls_trc = MIN( nctls_trc, jpktrd_trc - 1 )
-                               nmld_trc(:,:) = nctls_trc + 1      !     -> model level
+            CASE (  2: )   ;   nn_ctls_trc = MIN( nn_ctls_trc, jpktrd_trc - 1 )
+                               nmld_trc(:,:) = nn_ctls_trc + 1      !     -> model level
          END SELECT
 
@@ -281,11 +214,11 @@
          tmltrd_bio(:,:,:) = 0.e0    ! <<< reset trend arrays to zero
          ! ... Set nmld(ji,jj) = index of first T point below control surf. or outside mixed-layer
-         SELECT CASE ( nctls_trc )                                    ! choice of the control surface
+         SELECT CASE ( nn_ctls_trc )                                    ! choice of the control surface
             CASE ( -2  )   ;   STOP 'trdmld_trc : not ready '     !     -> isopycnal surface (see ???)
             CASE ( -1  )   ;   nmld_trc(:,:) = neln(:,:)          !     -> euphotic layer with light criterion
             CASE (  0  )   ;   nmld_trc(:,:) = nmln(:,:)          !     -> ML with density criterion (see zdfmxl)
             CASE (  1  )   ;   nmld_trc(:,:) = nbol_trc(:,:)          !     -> read index from file
-            CASE (  2: )   ;   nctls_trc = MIN( nctls_trc, jpktrd_trc - 1 )
-                               nmld_trc(:,:) = nctls_trc + 1          !     -> model level
+            CASE (  2: )   ;   nn_ctls_trc = MIN( nn_ctls_trc, jpktrd_trc - 1 )
+                               nmld_trc(:,:) = nn_ctls_trc + 1          !     -> model level
          END SELECT
 
@@ -380,5 +313,5 @@
       !!        of time-averaged mixed-layer fields, this residual WILL NOT BE ZERO
       !!        over the first two analysis windows (except if restart).
-      !!        N.B. For ORCA2_LIM, use e.g. ntrc_trc=5, ucf_trc=1., nctls_trc=8
+      !!        N.B. For ORCA2_LIM, use e.g. ntrc_trc=5, rn_ucf_trc=1., nctls_trc=8
       !!             for checking residuals.
       !!             On a NEC-SX5 computer, this typically leads to:
@@ -421,5 +354,4 @@
       REAL(wp), DIMENSION(jpi,jpj,jpltrd_trc,jptra) ::  ztmltrd2  ! -+
       !!
-      REAL(wp), DIMENSION(jpi,jpj) ::   z2d                       ! temporary array, used for eiv arrays
       CHARACTER (LEN= 5) ::   clvar
 #if defined key_dimgout
@@ -429,12 +361,5 @@
       !!----------------------------------------------------------------------
 
-      IF( llwarn ) THEN                                           ! warnings
-         IF(      ( nittrc000 /= nit000   ) &
-              .OR.( ndttrc    /= 1        )    ) THEN
-
-            WRITE(numout,*) 'Be careful, trends diags never validated'
-            STOP 'Uncomment this line to proceed'
-         ENDIF
-      ENDIF
+      IF( nn_dttrc  /= 1  ) CALL ctl_stop( " Be careful, trends diags never validated " )
 
       ! ======================================================================
@@ -450,7 +375,7 @@
             DO ji = 1,jpi
                ik = nmld_trc(ji,jj)
-               zavt = avt(ji,jj,ik)
+               zavt = fsavs(ji,jj,ik)
                DO jn = 1, jptra
-                  IF( luttrd(jn) )    &
+                  IF( ln_trdtrc(jn) )    &
                   tmltrd_trc(ji,jj,jpmld_trc_zdf,jn) = - zavt / fse3w(ji,jj,ik) * tmask(ji,jj,ik)  &
                        &                    * ( trn(ji,jj,ik-1,jn) - trn(ji,jj,ik,jn) )            &
@@ -462,5 +387,5 @@
          DO jn = 1, jptra
          ! ... Remove this K_z trend from the iso-neutral diffusion term (if any)
-            IF( luttrd(jn) ) &
+            IF( ln_trdtrc(jn) ) &
                  tmltrd_trc(:,:,jpmld_trc_ldf,jn) = tmltrd_trc(:,:,jpmld_trc_ldf,jn) - tmltrd_trc(:,:,jpmld_trc_zdf,jn)
    
@@ -473,5 +398,5 @@
       ! therefore we do not call lbc_lnk in GYRE config. (closed basin, no cyclic B.C.)
       DO jn = 1, jptra
-         IF( luttrd(jn) ) THEN
+         IF( ln_trdtrc(jn) ) THEN
             DO jl = 1, jpltrd_trc
                CALL lbc_lnk( tmltrd_trc(:,:,jl,jn), 'T', 1. )        ! lateral boundary conditions
@@ -490,7 +415,7 @@
       ! II.1 Set before values of vertically averages passive tracers
       ! -------------------------------------------------------------
-      IF( kt > nittrc000 ) THEN
+      IF( kt > nit000 ) THEN
          DO jn = 1, jptra
-            IF( luttrd(jn) ) THEN
+            IF( ln_trdtrc(jn) ) THEN
                tmlb_trc   (:,:,jn) = tml_trc   (:,:,jn)
                tmlatfn_trc(:,:,jn) = tmltrd_trc(:,:,jpmld_trc_atf,jn)
@@ -505,5 +430,5 @@
       DO jk = 1, jpktrd_trc ! - 1 ???
          DO jn = 1, jptra
-            IF( luttrd(jn) ) &
+            IF( ln_trdtrc(jn) ) &
                tml_trc(:,:,jn) = tml_trc(:,:,jn) + wkx_trc(:,:,jk) * trn(:,:,jk,jn)
          END DO
@@ -515,5 +440,5 @@
          !
          DO jn = 1, jptra
-            IF( luttrd(jn) ) THEN
+            IF( ln_trdtrc(jn) ) THEN
                tmlbb_trc  (:,:,jn) = tmlb_trc   (:,:,jn)   ;   tmlbn_trc  (:,:,jn) = tml_trc    (:,:,jn)
                tmlatfb_trc(:,:,jn) = tmlatfn_trc(:,:,jn)   ;   tmlradb_trc(:,:,jn) = tmlradn_trc(:,:,jn)
@@ -544,5 +469,5 @@
          ! ... Cumulate over BOTH physical contributions AND over time steps
          DO jn = 1, jptra
-            IF( luttrd(jn) ) THEN
+            IF( ln_trdtrc(jn) ) THEN
                DO jl = 1, jpltrd_trc
                   tmltrdm_trc(:,:,jn) = tmltrdm_trc(:,:,jn) + tmltrd_trc(:,:,jl,jn)
@@ -552,5 +477,5 @@
 
          DO jn = 1, jptra
-            IF( luttrd(jn) ) THEN
+            IF( ln_trdtrc(jn) ) THEN
                ! ... Special handling of the Asselin trend 
                tmlatfm_trc(:,:,jn) = tmlatfm_trc(:,:,jn) + tmlatfn_trc(:,:,jn)
@@ -573,10 +498,10 @@
 
       ! Convert to appropriate physical units
-      tmltrd_trc(:,:,:,:) = tmltrd_trc(:,:,:,:) * ucf_trc
-
-      itmod = kt - nittrc000 + 1
+      tmltrd_trc(:,:,:,:) = tmltrd_trc(:,:,:,:) * rn_ucf_trc
+
+      itmod = kt - nit000 + 1
       it    = kt
 
-      MODULO_NTRD : IF( MOD( itmod, ntrd_trc ) == 0 ) THEN           ! nitend MUST be multiple of ntrd_trc
+      MODULO_NTRD : IF( MOD( itmod, nn_trd_trc ) == 0 ) THEN           ! nitend MUST be multiple of nn_trd_trc
          !
          ztmltot (:,:,:) = 0.e0                                   ! reset arrays to zero
@@ -591,7 +516,7 @@
 
          DO jn = 1, jptra
-            IF( luttrd(jn) ) THEN
+            IF( ln_trdtrc(jn) ) THEN
                !-- Compute total trends    (use rdttrc instead of rdt ???)
-               IF ( ln_trcadv_smolar .OR. ln_trcadv_muscl .OR. ln_trcadv_muscl2 ) THEN  ! EULER-FORWARD schemes
+               IF ( ln_trcadv_muscl .OR. ln_trcadv_muscl2 ) THEN  ! EULER-FORWARD schemes
                   ztmltot(:,:,jn) =  ( tml_trc(:,:,jn) - tmlbn_trc(:,:,jn) )/rdt
                ELSE                                                                     ! LEAP-FROG schemes
@@ -629,5 +554,5 @@
                !-- Compute passive tracer total trends
          DO jn = 1, jptra
-            IF( luttrd(jn) ) THEN
+            IF( ln_trdtrc(jn) ) THEN
                tml_sum_trc(:,:,jn) = tmlbn_trc(:,:,jn) + 2 * ( tml_sum_trc(:,:,jn) - tml_trc(:,:,jn) ) + tml_trc(:,:,jn)
                ztmltot2   (:,:,jn) = ( tml_sum_trc(:,:,jn) - tml_sumb_trc(:,:,jn) ) /  ( 2.*rdt )    ! now tracer unit is /sec
@@ -637,5 +562,5 @@
          !-- Compute passive tracer residuals
          DO jn = 1, jptra
-            IF( luttrd(jn) ) THEN
+            IF( ln_trdtrc(jn) ) THEN
                !
                DO jl = 1, jpltrd_trc
@@ -680,5 +605,5 @@
             DO jn = 1, jptra
 
-               IF( luttrd(jn) ) THEN
+               IF( ln_trdtrc(jn) ) THEN
                   WRITE(numout, *)
                   WRITE(numout, *) '>>>>>>>>>>>>>>>>>>  TRC TRACER jn =', jn, ' <<<<<<<<<<<<<<<<<<'
@@ -777,5 +702,5 @@
          rmld_sum_trc(:,:)     = rmld_sum_trc(:,:)     /      (2*zfn)  ! similar to tml_sum and sml_sum
          DO jn = 1, jptra
-            IF( luttrd(jn) ) THEN        
+            IF( ln_trdtrc(jn) ) THEN        
                ! For passive tracer instantaneous diagnostics
                tmlbb_trc  (:,:,jn) = tmlb_trc   (:,:,jn)   ;   tmlbn_trc  (:,:,jn) = tml_trc    (:,:,jn)
@@ -791,14 +716,14 @@
                ! III.4 Convert to appropriate physical units
                ! -------------------------------------------
-               ztmltot     (:,:,jn)   = ztmltot     (:,:,jn)   * ucf_trc/zfn   ! instant diags
-               ztmlres     (:,:,jn)   = ztmlres     (:,:,jn)   * ucf_trc/zfn
-               ztmlatf     (:,:,jn)   = ztmlatf     (:,:,jn)   * ucf_trc/zfn
-               ztmlrad     (:,:,jn)   = ztmlrad     (:,:,jn)   * ucf_trc/zfn
+               ztmltot     (:,:,jn)   = ztmltot     (:,:,jn)   * rn_ucf_trc/zfn   ! instant diags
+               ztmlres     (:,:,jn)   = ztmlres     (:,:,jn)   * rn_ucf_trc/zfn
+               ztmlatf     (:,:,jn)   = ztmlatf     (:,:,jn)   * rn_ucf_trc/zfn
+               ztmlrad     (:,:,jn)   = ztmlrad     (:,:,jn)   * rn_ucf_trc/zfn
                tml_sum_trc (:,:,jn)   = tml_sum_trc (:,:,jn)   /      (2*zfn)  ! mean diags
-               ztmltot2    (:,:,jn)   = ztmltot2    (:,:,jn)   * ucf_trc/zfn2
-               ztmltrd2    (:,:,:,jn) = ztmltrd2    (:,:,:,jn) * ucf_trc/zfn2
-               ztmlatf2    (:,:,jn)   = ztmlatf2    (:,:,jn)   * ucf_trc/zfn2
-               ztmlrad2    (:,:,jn)   = ztmlrad2    (:,:,jn)   * ucf_trc/zfn2
-               ztmlres2    (:,:,jn)   = ztmlres2    (:,:,jn)   * ucf_trc/zfn2
+               ztmltot2    (:,:,jn)   = ztmltot2    (:,:,jn)   * rn_ucf_trc/zfn2
+               ztmltrd2    (:,:,:,jn) = ztmltrd2    (:,:,:,jn) * rn_ucf_trc/zfn2
+               ztmlatf2    (:,:,jn)   = ztmlatf2    (:,:,jn)   * rn_ucf_trc/zfn2
+               ztmlrad2    (:,:,jn)   = ztmlrad2    (:,:,jn)   * rn_ucf_trc/zfn2
+               ztmlres2    (:,:,jn)   = ztmlres2    (:,:,jn)   * rn_ucf_trc/zfn2
             ENDIF
          END DO
@@ -820,5 +745,5 @@
       ! ----------------------------------
 
-      IF( lwp .AND. MOD( itmod , ntrd_trc ) == 0 ) THEN
+      IF( lwp .AND. MOD( itmod , nn_trd_trc ) == 0 ) THEN
          WRITE(numout,*) ' '
          WRITE(numout,*) 'trd_mld_trc : write passive tracer trends in the NetCDF file :'
@@ -834,16 +759,5 @@
          DO jn = 1, jptra
             !
-            IF( luttrd(jn) ) THEN
-               !-- Specific treatment for EIV trends
-               !   WARNING : When eiv is switched on but key_diaeiv is not, we do NOT diagnose
-               !   u_eiv, v_eiv, and w_eiv : the exact eiv advective trends thus cannot be computed,
-               !   only their sum makes sense => mask directional contrib. to avoid confusion
-               z2d(:,:) = tmltrd_trc(:,:,jpmld_trc_xei,jn) + tmltrd_trc(:,:,jpmld_trc_yei,jn) &
-                    &   + tmltrd_trc(:,:,jpmld_trc_zei,jn)
-#if ( defined key_trcldf_eiv && defined key_diaeiv )
-               tmltrd_trc(:,:,jpmld_trc_xei,jn) = -999.
-               tmltrd_trc(:,:,jpmld_trc_yei,jn) = -999.
-               tmltrd_trc(:,:,jpmld_trc_zei,jn) = -999.
-#endif   
+            IF( ln_trdtrc(jn) ) THEN
                CALL histwrite( nidtrd(jn), "mxl_depth", it, rmld_trc(:,:), ndimtrd1, ndextrd1 )
                !-- Output the fields
@@ -864,7 +778,4 @@
                     &          it, ztmlatf(:,:,jn), ndimtrd1, ndextrd1 )
                      
-               CALL histwrite( nidtrd(jn), trim(clvar//ctrd_trc( jpltrd_trc+1,2)),     &  ! now total EIV : jpltrd_trc + 1
-                    &          it, z2d(:,:), ndimtrd1, ndextrd1 )                     
-            !
             ENDIF
          END DO
@@ -872,5 +783,5 @@
          IF( kt == nitend ) THEN 
             DO jn = 1, jptra
-               IF( luttrd(jn) )  CALL histclo( nidtrd(jn) )
+               IF( ln_trdtrc(jn) )  CALL histclo( nidtrd(jn) )
             END DO
          ENDIF
@@ -881,15 +792,5 @@
          DO jn = 1, jptra
             !
-            IF( luttrd(jn) ) THEN
-               !-- Specific treatment for EIV trends
-               !   WARNING : see above
-               z2d(:,:) = ztmltrd2(:,:,jpmld_trc_xei,jn) + ztmltrd2(:,:,jpmld_trc_yei,jn) &
-                   &   + ztmltrd2(:,:,jpmld_trc_zei,jn)
-
-#if ( defined key_trcldf_eiv && defined key_diaeiv )
-               ztmltrd2(:,:,jpmld_trc_xei,jn) = -999.
-               ztmltrd2(:,:,jpmld_trc_yei,jn) = -999.
-               ztmltrd2(:,:,jpmld_trc_zei,jn) = -999.
-#endif
+            IF( ln_trdtrc(jn) ) THEN
                CALL histwrite( nidtrd(jn), "mxl_depth", it, rmld_sum_trc(:,:), ndimtrd1, ndextrd1 ) 
                !-- Output the fields
@@ -911,7 +812,4 @@
                  &          it, ztmlatf2(:,:,jn), ndimtrd1, ndextrd1 )
 
-               CALL histwrite( nidtrd(jn), trim(clvar//ctrd_trc( jpltrd_trc+1,2)),    &  ! now total EIV : jpltrd_trc + 1
-                 &          it, z2d(:,:), ndimtrd1, ndextrd1 )
-
             ENDIF 
             !
@@ -919,5 +817,5 @@
          IF( kt == nitend ) THEN 
             DO jn = 1, jptra
-               IF( luttrd(jn) )  CALL histclo( nidtrd(jn) )
+               IF( ln_trdtrc(jn) )  CALL histclo( nidtrd(jn) )
             END DO
          ENDIF
@@ -931,5 +829,5 @@
 # endif /* key_dimgout */
 
-      IF( MOD( itmod, ntrd_trc ) == 0 ) THEN
+      IF( MOD( itmod, nn_trd_trc ) == 0 ) THEN
          !
          ! Reset cumulative arrays to zero
@@ -1010,12 +908,5 @@
       !!----------------------------------------------------------------------
       ! ... Warnings
-      IF( llwarn ) THEN
-         IF(      ( nittrc000 /= nit000   ) &
-              .OR.( ndttrc    /= 1        )    ) THEN
-
-            WRITE(numout,*) 'Be careful, trends diags never validated'
-            STOP 'Uncomment this line to proceed'
-         END IF
-      END IF
+      IF( nn_dttrc  /= 1  ) CALL ctl_stop( " Be careful, trends diags never validated " )
 
       ! ======================================================================
@@ -1058,7 +949,7 @@
 
       ! Convert to appropriate physical units
-      tmltrd_bio(:,:,:) = tmltrd_bio(:,:,:) * ucf_trc
-
-      MODULO_NTRD : IF( MOD( kt, ntrd_trc ) == 0 ) THEN      ! nitend MUST be multiple of ntrd
+      tmltrd_bio(:,:,:) = tmltrd_bio(:,:,:) * rn_ucf_trc
+
+      MODULO_NTRD : IF( MOD( kt, nn_trd_trc ) == 0 ) THEN      ! nitend MUST be multiple of ntrd
          !
          zfn  = float(nmoymltrdbio)    ;    zfn2 = zfn * zfn
@@ -1114,5 +1005,5 @@
          ! III.4 Convert to appropriate physical units
          ! -------------------------------------------
-         ztmltrdbio2    (:,:,:) = ztmltrdbio2    (:,:,:) * ucf_trc/zfn2
+         ztmltrdbio2    (:,:,:) = ztmltrdbio2    (:,:,:) * rn_ucf_trc/zfn2
 
       END IF MODULO_NTRD
@@ -1133,8 +1024,8 @@
 
       ! define time axis
-      itmod = kt - nittrc000 + 1
+      itmod = kt - nit000 + 1
       it    = kt
 
-      IF( lwp .AND. MOD( itmod , ntrd_trc ) == 0 ) THEN
+      IF( lwp .AND. MOD( itmod , nn_trd_trc ) == 0 ) THEN
          WRITE(numout,*) ' '
          WRITE(numout,*) 'trd_mld_bio : write ML bio trends in the NetCDF file :'
@@ -1176,5 +1067,5 @@
 # endif /* key_dimgout */
 
-      IF( MOD( itmod, ntrd_trc ) == 0 ) THEN
+      IF( MOD( itmod, nn_trd_trc ) == 0 ) THEN
          !
          ! III.5 Reset cumulative arrays to zero
@@ -1216,12 +1107,9 @@
       INTEGER :: ilseq, jl, jn
       REAL(wp) ::   zjulian, zsto, zout
-      CHARACTER (LEN=40) ::   clop, cleiv
+      CHARACTER (LEN=40) ::   clop
       CHARACTER (LEN=15) ::   csuff
       CHARACTER (LEN=12) ::   clmxl
       CHARACTER (LEN=16) ::   cltrcu
       CHARACTER (LEN= 5) ::   clvar
-
-      NAMELIST/namtoptrd/ ntrd_trc, nctls_trc, ucf_trc, &
-                          ln_trdmld_trc_restart, ln_trdmld_trc_instant, luttrd
 
       !!----------------------------------------------------------------------
@@ -1241,24 +1129,10 @@
       ! I.1 Check consistency of user defined preferences
       ! -------------------------------------------------
-#if defined key_trcldf_eiv
-      IF( lk_trdmld_trc .AND. ln_trcldf_iso ) THEN
-         WRITE(numout,cform_war)
-         WRITE(numout,*) '                You asked for ML diagnostics with iso-neutral diffusion   '
-         WRITE(numout,*) '                and eiv physics.                                          '
-         WRITE(numout,*) '                Yet, key_diaeiv is NOT switched on, so the eddy induced   '
-         WRITE(numout,*) '                velocity is not diagnosed.                                '
-         WRITE(numout,*) '                Therefore, we cannot deduce the eiv advective trends.     '
-         WRITE(numout,*) '                Only THE SUM of the i,j,k directional contributions then  '
-         WRITE(numout,*) '                makes sense => To avoid any confusion, we choosed to mask '
-         WRITE(numout,*) '                these i,j,k directional contributions (with -999.)        '
-         nwarn = nwarn + 1
-      ENDIF
-#  endif
-
-      IF( ( lk_trdmld_trc ) .AND. ( MOD( nitend, ntrd_trc ) /= 0 ) ) THEN
+
+      IF( ( lk_trdmld_trc ) .AND. ( MOD( nitend, nn_trd_trc ) /= 0 ) ) THEN
          WRITE(numout,cform_err)
          WRITE(numout,*) '                Your nitend parameter, nitend = ', nitend
          WRITE(numout,*) '                is no multiple of the trends diagnostics frequency        '
-         WRITE(numout,*) '                          you defined, ntrd_trc   = ', ntrd_trc
+         WRITE(numout,*) '                          you defined, nn_trd_trc   = ', nn_trd_trc
          WRITE(numout,*) '                This will not allow you to restart from this simulation.  '
          WRITE(numout,*) '                You should reconsider this choice.                        ' 
@@ -1269,29 +1143,8 @@
       ENDIF
 
-      IF( ( lk_trdmld_trc ) .AND. ( n_cla == 1 ) ) THEN
-         WRITE(numout,cform_war)
-         WRITE(numout,*) '                You set n_cla = 1. Note that the Mixed-Layer diagnostics  '
-         WRITE(numout,*) '                are not exact along the corresponding straits.            '
-         nwarn = nwarn + 1
-      ENDIF
-
-
       ! * Debugging information *
       IF( lldebug ) THEN
          WRITE(numout,*) '               ln_trcadv_muscl = '      , ln_trcadv_muscl
-         WRITE(numout,*) '               ln_trcadv_smolar = '     , ln_trcadv_smolar
          WRITE(numout,*) '               ln_trdmld_trc_instant = ', ln_trdmld_trc_instant
-      ENDIF
-
-      IF( ln_trcadv_smolar .AND. .NOT. ln_trdmld_trc_instant ) THEN
-         WRITE(numout,cform_err)
-         WRITE(numout,*) '                Currently, you can NOT use simultaneously tracer Smolark. '
-         WRITE(numout,*) '                advection and window averaged diagnostics of ML trends.   '
-         WRITE(numout,*) '                WHY? Everything in trdmld_trc is coded for leap-frog, and '
-         WRITE(numout,*) '                Smolarkiewicz scheme is Euler forward.                    '
-         WRITE(numout,*) '                In particuliar, entrainment trend would be FALSE. However '
-         WRITE(numout,*) '                this residual is correct for instantaneous ML diagnostics.'
-         WRITE(numout,*) 
-         nstop = nstop + 1
       ENDIF
 
@@ -1364,5 +1217,5 @@
       ! I.3 Read control surface from file ctlsurf_idx
       ! ----------------------------------------------
-      IF( nctls_trc == 1 ) THEN
+      IF( nn_ctls_trc == 1 ) THEN
          CALL ctl_opn( inum, 'ctlsurf_idx', 'OLD', 'UNFORMATTED', 'SEQUENTIAL', -1, numout, lwp )
          READ ( inum ) nbol_trc
@@ -1378,10 +1231,10 @@
 #else
       ! clmxl = legend root for netCDF output
-      IF( nctls_trc == 0 ) THEN                                   ! control surface = mixed-layer with density criterion
+      IF( nn_ctls_trc == 0 ) THEN                                   ! control surface = mixed-layer with density criterion
          clmxl = 'Mixed Layer '
-      ELSE IF( nctls_trc == 1 ) THEN                              ! control surface = read index from file 
+      ELSE IF( nn_ctls_trc == 1 ) THEN                              ! control surface = read index from file 
          clmxl = '      Bowl '
-      ELSE IF( nctls_trc >= 2 ) THEN                              ! control surface = model level
-         WRITE(clmxl,'(A10,I2,1X)') 'Levels 1 -', nctls_trc
+      ELSE IF( nn_ctls_trc >= 2 ) THEN                              ! control surface = model level
+         WRITE(clmxl,'(A10,I2,1X)') 'Levels 1 -', nn_ctls_trc
       ENDIF
 
@@ -1395,5 +1248,5 @@
          STOP 'trd_mld_trc : this was never checked. Comment this line to proceed...'
       ENDIF
-      zsto = ntrd_trc * rdt
+      zsto = nn_trd_trc * rdt
       clop = "inst("//TRIM(clop)//")"
 #  else
@@ -1401,9 +1254,9 @@
          zsto = rdt                                               ! inst. diags : we use IOIPSL time averaging
       ELSE
-         zsto = ntrd_trc * rdt                                    ! mean  diags : we DO NOT use any IOIPSL time averaging
+         zsto = nn_trd_trc * rdt                                    ! mean  diags : we DO NOT use any IOIPSL time averaging
       ENDIF
       clop = "ave("//TRIM(clop)//")"
 #  endif
-      zout = ntrd_trc * rdt
+      zout = nn_trd_trc * rdt
 
       IF(lwp) WRITE (numout,*) '                netCDF initialization'
@@ -1424,9 +1277,4 @@
       !       ==> choose them according to trdmld_trc_oce.F90 <==
 
-#if defined key_diaeiv
-      cleiv = " (*** only total EIV is meaningful ***)"           ! eiv advec. trends require u_eiv, v_eiv
-#else
-      cleiv = " "
-#endif
       ctrd_trc(jpmld_trc_xad    ,1) = " Zonal advection"                 ;   ctrd_trc(jpmld_trc_xad    ,2) = "_xad"
       ctrd_trc(jpmld_trc_yad    ,1) = " Meridional advection"            ;   ctrd_trc(jpmld_trc_yad    ,2) = "_yad"
@@ -1434,8 +1282,4 @@
       ctrd_trc(jpmld_trc_ldf    ,1) = " Lateral diffusion"               ;   ctrd_trc(jpmld_trc_ldf    ,2) = "_ldf"
       ctrd_trc(jpmld_trc_zdf    ,1) = " Vertical diff. (Kz)"             ;   ctrd_trc(jpmld_trc_zdf    ,2) = "_zdf"
-      ctrd_trc(jpmld_trc_xei    ,1) = " Zonal EIV advection"//cleiv      ;   ctrd_trc(jpmld_trc_xei    ,2) = "_xei"
-      ctrd_trc(jpmld_trc_yei    ,1) = " Merid. EIV advection"//cleiv     ;   ctrd_trc(jpmld_trc_yei    ,2) = "_yei"
-      ctrd_trc(jpmld_trc_zei    ,1) = " Vertical EIV advection"//cleiv   ;   ctrd_trc(jpmld_trc_zei    ,2) = "_zei"
-      ctrd_trc(jpmld_trc_bbc    ,1) = " Geothermal flux"                 ;   ctrd_trc(jpmld_trc_bbc    ,2) = "_bbc"
       ctrd_trc(jpmld_trc_bbl    ,1) = " Adv/diff. Bottom boundary layer" ;   ctrd_trc(jpmld_trc_bbl    ,2) = "_bbl"
       ctrd_trc(jpmld_trc_dmp    ,1) = " Tracer damping"                  ;   ctrd_trc(jpmld_trc_dmp    ,2) = "_dmp"
@@ -1445,13 +1289,12 @@
       ctrd_trc(jpmld_trc_radn   ,1) = " Correct negative concentrations" ;   ctrd_trc(jpmld_trc_radn   ,2) = "_radn"
       ctrd_trc(jpmld_trc_atf    ,1) = " Asselin time filter"             ;   ctrd_trc(jpmld_trc_atf    ,2) = "_atf"
-      ctrd_trc(jpltrd_trc+1     ,1) = " Total EIV"//cleiv                ;   ctrd_trc(jpltrd_trc+1     ,2) = "_tei"
 
       DO jn = 1, jptra      
       !-- Create a NetCDF file and enter the define mode 
-         IF( luttrd(jn) ) THEN
+         IF( ln_trdtrc(jn) ) THEN
             csuff="ML_"//ctrcnm(jn)
-            CALL dia_nam( clhstnam, ntrd_trc, csuff )
+            CALL dia_nam( clhstnam, nn_trd_trc, csuff )
             CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,                                            &
-               &        1, jpi, 1, jpj, nittrc000-ndttrc, zjulian, rdt, nh_t(jn), nidtrd(jn), domain_id=nidom )
+               &        1, jpi, 1, jpj, nit000, zjulian, rdt, nh_t(jn), nidtrd(jn), domain_id=nidom, snc4chunks=snc4set )
       
             !-- Define the ML depth variable
@@ -1464,13 +1307,13 @@
 #if defined key_lobster
           !-- Create a NetCDF file and enter the define mode
-          CALL dia_nam( clhstnam, ntrd_trc, 'trdbio' )
+          CALL dia_nam( clhstnam, nn_trd_trc, 'trdbio' )
           CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,                                            &
-             &             1, jpi, 1, jpj, nittrc000-ndttrc, zjulian, rdt, nh_tb, nidtrdbio, domain_id=nidom )
+             &             1, jpi, 1, jpj, nit000, zjulian, rdt, nh_tb, nidtrdbio, domain_id=nidom, snc4chunks=snc4set )
 #endif
 
       !-- Define physical units
-      IF( ucf_trc == 1. ) THEN
+      IF( rn_ucf_trc == 1. ) THEN
          cltrcu = "(mmole-N/m3)/sec"                              ! all passive tracers have the same unit 
-      ELSEIF ( ucf_trc == 3600.*24.) THEN                         ! ??? trop long : seulement (mmole-N/m3)
+      ELSEIF ( rn_ucf_trc == 3600.*24.) THEN                         ! ??? trop long : seulement (mmole-N/m3)
          cltrcu = "(mmole-N/m3)/day"                              ! ??? apparait dans les sorties netcdf 
       ELSE
@@ -1485,5 +1328,5 @@
       DO jn = 1, jptra
          !
-         IF( luttrd(jn) ) THEN
+         IF( ln_trdtrc(jn) ) THEN
             clvar = trim(ctrcnm(jn))//"ml"                           ! e.g. detml, zooml, no3ml, etc.
             CALL histdef(nidtrd(jn), clvar,           clmxl//" "//trim(ctrcnm(jn))//" Mixed Layer ",                         &
@@ -1504,7 +1347,4 @@
             CALL histdef(nidtrd(jn), trim(clvar//ctrd_trc(jpmld_trc_atf,2)), clmxl//" "//clvar//ctrd_trc(jpmld_trc_atf,1),   & 
               &       cltrcu, jpi, jpj, nh_t(jn), 1  , 1, 1  , -99 , 32, clop, zout, zout ) ! IOIPSL: NO time mean
-         
-            CALL histdef(nidtrd(jn), trim(clvar//ctrd_trc(jpltrd_trc+1,2)),  clmxl//" "//clvar//ctrd_trc(jpltrd_trc+1 ,1),   & 
-              &       cltrcu, jpi, jpj, nh_t(jn), 1  , 1, 1  , -99 , 32, clop, zsto, zout ) ! Total EIV 
          !
          ENDIF
@@ -1520,10 +1360,10 @@
       !-- Leave IOIPSL/NetCDF define mode
       DO jn = 1, jptra
-         IF( luttrd(jn) )  CALL histend( nidtrd(jn) )
+         IF( ln_trdtrc(jn) )  CALL histend( nidtrd(jn), snc4set )
       END DO
 
 #if defined key_lobster
       !-- Leave IOIPSL/NetCDF define mode
-      CALL histend( nidtrdbio )
+      CALL histend( nidtrdbio, snc4set )
 
       IF(lwp) WRITE(numout,*)
@@ -1539,8 +1379,4 @@
    !!----------------------------------------------------------------------
 
-   INTERFACE trd_mod_trc
-      MODULE PROCEDURE trd_mod_trc_trp, trd_mod_trc_bio
-   END INTERFACE
-
 CONTAINS
 
@@ -1554,24 +1390,4 @@
       WRITE(*,*) 'trd_mld_bio: You should not have seen this print! error?', kt
    END SUBROUTINE trd_mld_bio
-
-   SUBROUTINE trd_mod_trc_bio( ptrbio, ktrd, kt )
-      INTEGER               , INTENT( in )     ::   kt      ! time step
-      INTEGER               , INTENT( in )     ::   ktrd    ! bio trend index
-      REAL, DIMENSION(:,:,:), INTENT( inout )  ::   ptrbio  ! Bio trend
-      WRITE(*,*) 'trd_mod_trc_bio : You should not have seen this print! error?', ptrbio(1,1,1)
-      WRITE(*,*) '  "      "      : You should not have seen this print! error?', ktrd
-      WRITE(*,*) '  "      "      : You should not have seen this print! error?', kt
-   END SUBROUTINE trd_mod_trc_bio
-
-   SUBROUTINE trd_mod_trc_trp( ptrtrd, kjn, ktrd, kt )
-      INTEGER               , INTENT( in )     ::   kt      ! time step
-      INTEGER               , INTENT( in )     ::   kjn     ! tracer index
-      INTEGER               , INTENT( in )     ::   ktrd    ! tracer trend index
-      REAL, DIMENSION(:,:,:), INTENT( inout )  ::   ptrtrd  ! Temperature or U trend
-      WRITE(*,*) 'trd_mod_trc_trp : You should not have seen this print! error?', ptrtrd(1,1,1)
-      WRITE(*,*) '  "      "      : You should not have seen this print! error?', kjn
-      WRITE(*,*) '  "      "      : You should not have seen this print! error?', ktrd
-      WRITE(*,*) '  "      "      : You should not have seen this print! error?', kt
-   END SUBROUTINE trd_mod_trc_trp
 
    SUBROUTINE trd_mld_trc_zint( ptrc_trdmld, ktrd, ctype, kjn )
Index: trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trdmld_trc_oce.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trdmld_trc_oce.F90	(revision 2527)
+++ 	(revision )
@@ -1,150 +1,0 @@
-MODULE trdmld_trc_oce
-   !!======================================================================
-   !!                   ***  MODULE trdmld_trc_oce  ***
-   !! Ocean trends :   set tracer and momentum trend variables
-   !!======================================================================
-   !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/TRD/trdmld_oce.F90,v 1.2 2005/03/27 18:35:23 opalod Exp $ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-#if defined key_top
-   !!----------------------------------------------------------------------
-   !!   'key_top'                                                TOP models
-   !!----------------------------------------------------------------------
-
-   USE par_oce                        ! ocean parameters
-   USE par_trc                        ! passive tracers parameters
-
-   IMPLICIT NONE
-   PUBLIC
-
-   !!* Namelist namtoptrd:  diagnostics on passive tracers trends
-   INTEGER  ::    ntrd_trc                !: time step frequency dynamics and tracers trends
-   INTEGER  ::    nctls_trc               !: control surface type for trends vertical integration
-   REAL(wp) ::    ucf_trc                 !: unit conversion factor (for netCDF trends outputs)
-   LOGICAL  ::    ln_trdmld_trc_instant   !: flag to diagnose inst./mean ML trc trends
-   LOGICAL  ::    ln_trdmld_trc_restart   !: flag to restart mixed-layer trc diagnostics
-   CHARACTER(len=50) ::  cn_trdrst_trc_in  !: suffix of pass. tracer restart name (input)
-   CHARACTER(len=50) ::  cn_trdrst_trc_out !: suffix of pass. tracer restart name (output)
-   LOGICAL, DIMENSION (jptra) ::   luttrd   !: large trends diagnostic to write or not (namelist)
-
-   !!* Passive tracers trends indexes
-   INTEGER, PARAMETER ::   jptrc_trd_xad     =  1   !: x- horizontal advection
-   INTEGER, PARAMETER ::   jptrc_trd_yad     =  2   !: y- horizontal advection
-   INTEGER, PARAMETER ::   jptrc_trd_zad     =  3   !: z- vertical   advection
-   INTEGER, PARAMETER ::   jptrc_trd_ldf     =  4   !: lateral       diffusion
-   INTEGER, PARAMETER ::   jptrc_trd_zdf     =  5   !: vertical diffusion (Kz)
-   INTEGER, PARAMETER ::   jptrc_trd_xei     =  6   !: x- horiz. EIV advection
-   INTEGER, PARAMETER ::   jptrc_trd_yei     =  7   !: y- horiz. EIV advection
-   INTEGER, PARAMETER ::   jptrc_trd_zei     =  8   !: z- vert.  EIV advection
-   INTEGER, PARAMETER ::   jptrc_trd_bbc     =  9   !: Bottom Boundary Condition (geoth. flux)
-   INTEGER, PARAMETER ::   jptrc_trd_bbl     = 10   !: Bottom Boundary Layer (diffusive/convective)
-   INTEGER, PARAMETER ::   jptrc_trd_dmp     = 11   !: damping
-   INTEGER, PARAMETER ::   jptrc_trd_sbc     = 12   !: surface boundary condition
-   INTEGER, PARAMETER ::   jptrc_trd_sms     = 13   !: sources m. sinks
-   INTEGER, PARAMETER ::   jptrc_trd_radn    = 14   !: corr. trn<0 in trcrad
-   INTEGER, PARAMETER ::   jptrc_trd_radb    = 15   !: corr. trb<0 in trcrad (like atf)
-   INTEGER, PARAMETER ::   jptrc_trd_atf     = 16   !: Asselin correction
-
-#if defined key_trdmld_trc
-   !!----------------------------------------------------------------------
-   !!   'key_trdmld_trc'                     mixed layer trends diagnostics
-   !!----------------------------------------------------------------------
-
-   LOGICAL, PARAMETER ::   lk_trdmld_trc = .TRUE.    !: ML trend flag
-   LOGICAL, PARAMETER ::   l_trdtrc = .TRUE.         !: passive tracers trend flag
-
-   INTEGER, PARAMETER ::            & !: mixed layer trends indices
-        jpmld_trc_xad     =  1,     & !:     zonal      \
-        jpmld_trc_yad     =  2,     & !:     meridonal   > advection
-        jpmld_trc_zad     =  3,     & !:     vertical   /
-        jpmld_trc_ldf     =  4,     & !:     lateral diffusion (geopot. or iso-neutral)
-        jpmld_trc_zdf     =  5,     & !:     vertical diffusion (TKE)
-        jpmld_trc_xei     =  6,     & !:     zonal      \
-        jpmld_trc_yei     =  7,     & !:     meridional  > eddy induced advection
-        jpmld_trc_zei     =  8,     & !:     vertical   / 
-        jpmld_trc_bbc     =  9,     & !:     geothermal flux
-        jpmld_trc_bbl     = 10,     & !:     bottom boundary layer (advective/diffusive)
-        jpmld_trc_dmp     = 11,     & !:     internal restoring trend
-        jpmld_trc_sbc     = 12,     & !:     forcing 
-        jpmld_trc_sms     = 13,     & !:     sources minus sinks trend
-  !     jpmld_trc_xxx     = xx,     & !:     add here any additional trend    (** AND UPDATE JPLTRD_TRC BELOW **)
-        jpmld_trc_radn    = 14,     & !:     corr. trn<0 in trcrad
-        jpmld_trc_radb    = 15,     & !:     corr. trb<0 in trcrad (like atf) (** MUST BE BEFORE THE LAST ONE **)
-        jpmld_trc_atf     = 16        !:     asselin trend                    (** MUST BE    THE      LAST ONE**)
-
-   !! Trends diagnostics parameters
-   !!---------------------------------------------------------------------
-   INTEGER, PARAMETER ::            &
-      jpltrd_trc = 16,                  & !: number of mixed-layer trends arrays
-      jpktrd_trc = jpk                    !: max level for mixed-layer trends diag.
-
-   !! Arrays used for diagnosing mixed-layer trends 
-   !!---------------------------------------------------------------------
-   CHARACTER(LEN=80) :: clname_trc, ctrd_trc(jpltrd_trc+1,2)
-
-   INTEGER, DIMENSION(jpi,jpj) ::   &
-      nmld_trc       , &                            !: mixed layer depth indexes 
-      nbol_trc                                   !: mixed-layer depth indexes when read from file
-
-   REAL(wp), DIMENSION(jpi,jpj,jpk) ::  wkx_trc  !:
-
-   REAL(wp), DIMENSION(jpi,jpj) ::  rmld_trc     !: ML depth (m) corresponding to nmld_trc
-   REAL(wp), DIMENSION(jpi,jpj) ::  rmld_sum_trc !: needed to compute the leap-frog time mean of ML depth
-   REAL(wp), DIMENSION(jpi,jpj) ::  rmldbn_trc   !: idem
-
-   REAL(wp), DIMENSION(jpi,jpj,jptra) ::  &
-      tml_trc    ,                        &      !: \ "now" mixed layer temperature/salinity
-      tmlb_trc   ,                        &      !: /  and associated "before" fields
-      tmlbb_trc  ,                        &      !: \  idem, but valid at the 1rst time step of the
-      tmlbn_trc  ,                        &      !: /  current analysis window
-      tml_sum_trc,                        &      !: mixed layer T, summed over the current analysis period
-      tml_sumb_trc,                       &      !: idem, but from the previous analysis period
-      tmltrd_atf_sumb_trc,                &      !: Asselin trends, summed over the previous analysis period
-      tmltrd_rad_sumb_trc                        !: trends due to trb correction in trcrad.F90, summed over the
-                                                 !:     previous analysis period
-                                                 
-   REAL(wp), DIMENSION(jpi,jpj,jptra) ::  &      
-      tmlatfb_trc, tmlatfn_trc ,          &      !: "before" Asselin contrib. at beginning of the averaging
-                                                 !:     period (i.e. last contrib. from previous such period)
-                                                 !:     and "now" Asselin contrib. to the ML trc. trends
-      tmlatfm_trc,                        &      !: accumulator for Asselin trends (needed for storage only)
-      tmlradb_trc, tmlradn_trc ,          &      !: similar to Asselin above, but for the trend due to trb
-                                                 !:     correction in trcrad.F90
-      tmlradm_trc                                !: accumulator for the previous trcrad trend
-
-   REAL(wp), DIMENSION(jpi,jpj,jpltrd_trc,jptra) ::  &
-      tmltrd_trc,                         &      !: \ physical contributions to the total trend (for T/S),
-                                                 !: / cumulated over the current analysis window
-      tmltrd_sum_trc,                     &      !: sum of these trends over the analysis period
-      tmltrd_csum_ln_trc,                 &      !: now cumulated sum of trends over the "lower triangle"
-      tmltrd_csum_ub_trc                         !: before (prev. analysis period) cumulated sum over the
-                                                 !: upper triangle
-   REAL(wp), DIMENSION(jpi,jpj,jptra) ::  &
-      tmltrdm_trc                                !: total cumulative trends over the analysis window
-
-#else
-   LOGICAL, PARAMETER ::   lk_trdmld_trc = .FALSE.   !: ML trend flag
-   LOGICAL, PARAMETER ::   l_trdtrc = .FALSE.             !: passive tracers trend flag
-#endif
-
-#if defined key_lobster
-   CHARACTER(LEN=80) :: clname_bio, ctrd_bio(jpdiabio,2)
-   REAL(wp), DIMENSION(jpi,jpj,jpdiabio) ::  &
-      tmltrd_bio,                         &      !: \ biological contributions to the total trend ,
-                                                 !: / cumulated over the current analysis window
-      tmltrd_sum_bio,                     &      !: sum of these trends over the analysis period
-      tmltrd_csum_ln_bio,                 &      !: now cumulated sum of trends over the "lower triangle"
-      tmltrd_csum_ub_bio                         !: before (prev. analysis period) cumulated sum over the
-                                                 !: upper triangle
-#endif
-
-#else
-   !!----------------------------------------------------------------------
-   !!  Empty module :                                     No passive tracer
-   !!----------------------------------------------------------------------
-#endif
-
-
-END MODULE trdmld_trc_oce
Index: trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trdmld_trc_rst.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trdmld_trc_rst.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trdmld_trc_rst.F90	(revision 2528)
@@ -9,9 +9,8 @@
 #if defined key_top && defined key_trdmld_trc
    !!----------------------------------------------------------------------
-   USE oce_trc
    USE in_out_manager  ! I/O manager
    USE iom             ! I/O module
-   USE trc             ! for ndttrc ctrcnm
-   USE trdmld_trc_oce  ! for lk_trdmld_trc
+   USE trc             ! for nn_dttrc ctrcnm
+   USE trdmod_trc_oce  ! for lk_trdmld_trc
 
    IMPLICIT NONE
@@ -23,7 +22,7 @@
    INTEGER ::   nummldw_trc               ! logical unit for mld restart
    !!---------------------------------------------------------------------------------
-   !! OPA 9.0 , LOCEAN-IPSL (2006) 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/TRD/trdmld_rst.F90,v 1.6 2006/11/14 09:46:13 opalod Exp $ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!---------------------------------------------------------------------------------
   
@@ -45,5 +44,5 @@
       !!--------------------------------------------------------------------------------
 
-      IF( kt == nitrst - ndttrc .OR. nitend - nit000 + 1 < 2 * ndttrc ) THEN ! idem trcrst.F90
+      IF( kt == nitrst - nn_dttrc .OR. nitend - nit000 + 1 < 2 * nn_dttrc ) THEN ! idem trcrst.F90
          IF( nitrst > 1.0e9 ) THEN
             WRITE(clkt,*) nitrst
Index: trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trdmod_trc.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trdmod_trc.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trdmod_trc.F90	(revision 2528)
@@ -0,0 +1,149 @@
+MODULE trdmod_trc
+   !!======================================================================
+   !!                       ***  MODULE  trdmod_trc  ***
+   !! Ocean diagnostics:  mixed layer passive tracer trends 
+   !!======================================================================
+   !! History :  3.0  !  2010-07  (C. Ethe)  Original code (from trdmod.F90)
+   !!----------------------------------------------------------------------
+#if   defined key_top && ( defined key_trdmld_trc   ||   defined key_trdtrc )
+   !!----------------------------------------------------------------------
+   !!   'key_trdmld_trc'                  mixed layer trend diagnostics
+   !!   'key_trdtrc'                      3D trend diagnostics
+   !!----------------------------------------------------------------------
+   !!   trd_mod_trc      : passive tracer trends 
+   !!----------------------------------------------------------------------
+   USE trc               ! tracer definitions (trn, trb, tra, etc.)
+   USE trcnam_trp
+   USE trdmod_oce
+   USE trdmod_trc_oce    ! definition of main arrays used for trends computations
+   USE trdmld_trc        ! Mixed layer trends diag.
+   USE iom               ! I/O library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   INTERFACE trd_mod_trc
+      MODULE PROCEDURE trd_mod_trc_trp, trd_mod_trc_bio
+   END INTERFACE
+
+   PUBLIC trd_mod_trc
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Header:  $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trd_mod_trc_trp( ptrtrd, kjn, ktrd, kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_mod_trc  ***
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in )  ::   kt                                  ! time step
+      INTEGER, INTENT( in )  ::   kjn                                 ! tracer index
+      INTEGER, INTENT( in )  ::   ktrd                                ! tracer trend index
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout )  ::   ptrtrd  ! Temperature or U trend
+      CHARACTER (len=20) :: cltra
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+!         IF(lwp)WRITE(numout,*)
+!         IF(lwp)WRITE(numout,*) 'trd_mod_trc:'
+!         IF(lwp)WRITE(numout,*) '~~~~~~~~~~~~'
+      ENDIF
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Mixed layer trends for passive tracers
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      IF( lk_trdmld_trc .AND. ln_trdtrc( kjn ) ) THEN
+         !
+         SELECT CASE ( ktrd )
+         CASE ( jptra_trd_xad     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_xad, '3D', kjn )
+         CASE ( jptra_trd_yad     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_yad, '3D', kjn )
+         CASE ( jptra_trd_zad     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_zad, '3D', kjn )
+         CASE ( jptra_trd_ldf     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_ldf, '3D', kjn )
+         CASE ( jptra_trd_bbl     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_bbl, '3D', kjn )
+         CASE ( jptra_trd_zdf     )
+            IF( ln_trcldf_iso ) THEN
+               CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_ldf, '3D', kjn )
+            ELSE
+               CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_zdf, '3D', kjn )
+            ENDIF
+         CASE ( jptra_trd_dmp     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_dmp , '3D', kjn )
+         CASE ( jptra_trd_nsr     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_sbc , '2D', kjn )
+         CASE ( jptra_trd_sms     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_sms , '3D', kjn )
+         CASE ( jptra_trd_radb    )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_radb, '3D', kjn )
+         CASE ( jptra_trd_radn    )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_radn, '3D', kjn )
+         CASE ( jptra_trd_atf     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_atf , '3D', kjn )
+         END SELECT
+         !
+      END IF
+
+      IF( lk_trdtrc .AND. ln_trdtrc( kjn ) ) THEN
+         !
+         SELECT CASE( ktrd )
+         CASE( jptra_trd_xad )       ;    WRITE (cltra,'("XAD_",16a)')   ctrcnm(kjn)
+         CASE( jptra_trd_yad )       ;    WRITE (cltra,'("YAD_",16a)')   ctrcnm(kjn)
+         CASE( jptra_trd_zad )       ;    WRITE (cltra,'("ZAD_",16a)')   ctrcnm(kjn)
+         CASE( jptra_trd_ldf )       ;    WRITE (cltra,'("LDF_",16a)')   ctrcnm(kjn)
+         CASE( jptra_trd_bbl )       ;    WRITE (cltra,'("BBL_",16a)')   ctrcnm(kjn)
+         CASE( jptra_trd_zdf )       ;    WRITE (cltra,'("ZDF_",16a)')   ctrcnm(kjn)
+         CASE( jptra_trd_dmp )       ;    WRITE (cltra,'("DMP_",16a)')   ctrcnm(kjn)
+         CASE( jptra_trd_nsr )       ;    WRITE (cltra,'("FOR_",16a)')   ctrcnm(kjn)
+         END SELECT
+                                          CALL iom_put( cltra,  ptrtrd(:,:,:) )
+         !
+      END IF
+
+   END SUBROUTINE trd_mod_trc_trp
+
+   SUBROUTINE trd_mod_trc_bio( ptrbio, ktrd, kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_mod_bio  ***
+      !!----------------------------------------------------------------------
+
+      INTEGER, INTENT( in )  ::   kt                                  ! time step
+      INTEGER, INTENT( in )  ::   ktrd                                ! bio trend index
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout )  ::   ptrbio  ! Bio trend
+      !!----------------------------------------------------------------------
+
+      CALL trd_mld_bio_zint( ptrbio, ktrd ) ! Verticaly integrated biological trends
+
+   END SUBROUTINE trd_mod_trc_bio
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :                                       Empty module
+   !!----------------------------------------------------------------------
+
+   INTERFACE trd_mod_trc
+      MODULE PROCEDURE trd_mod_trc_trp, trd_mod_trc_bio
+   END INTERFACE
+
+CONTAINS
+
+   SUBROUTINE trd_mod_trc_trp( ptrtrd, kjn, ktrd, kt )
+      INTEGER               , INTENT( in )     ::   kt      ! time step
+      INTEGER               , INTENT( in )     ::   kjn     ! tracer index
+      INTEGER               , INTENT( in )     ::   ktrd    ! tracer trend index
+      REAL, DIMENSION(:,:,:), INTENT( inout )  ::   ptrtrd  ! Temperature or U trend
+      WRITE(*,*) 'trd_mod_trc_trp : You should not have seen this print! error?', ptrtrd(1,1,1)
+      WRITE(*,*) '  "      "      : You should not have seen this print! error?', kjn
+      WRITE(*,*) '  "      "      : You should not have seen this print! error?', ktrd
+      WRITE(*,*) '  "      "      : You should not have seen this print! error?', kt
+   END SUBROUTINE trd_mod_trc_trp
+
+   SUBROUTINE trd_mod_trc_bio( ptrbio, ktrd, kt )
+      INTEGER               , INTENT( in )     ::   kt      ! time step
+      INTEGER               , INTENT( in )     ::   ktrd    ! tracer trend index
+      REAL, DIMENSION(:,:,:), INTENT( inout )  ::   ptrbio  ! Temperature or U trend
+      WRITE(*,*) 'trd_mod_trc_trp : You should not have seen this print! error?', ptrbio(1,1,1)
+      WRITE(*,*) '  "      "      : You should not have seen this print! error?', ktrd
+      WRITE(*,*) '  "      "      : You should not have seen this print! error?', kt
+   END SUBROUTINE trd_mod_trc_bio
+
+#endif
+   !!======================================================================
+END MODULE trdmod_trc
Index: trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trdmod_trc_oce.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trdmod_trc_oce.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trdmod_trc_oce.F90	(revision 2528)
@@ -0,0 +1,132 @@
+MODULE trdmod_trc_oce
+   !!======================================================================
+   !!                   ***  MODULE trdmod_trc_oce  ***
+   !! Ocean trends :   set tracer and momentum trend variables
+   !!======================================================================
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/TRD/trdmld_oce.F90,v 1.2 2005/03/27 18:35:23 opalod Exp $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+
+   USE par_oce                        ! ocean parameters
+   USE par_trc                        ! passive tracers parameters
+
+   IMPLICIT NONE
+   PUBLIC
+
+   !!* Namelist namtoptrd:  diagnostics on passive tracers trends
+   INTEGER  ::    nn_trd_trc                 !: time step frequency dynamics and tracers trends
+   INTEGER  ::    nn_ctls_trc                !: control surface type for trends vertical integration
+   REAL(wp) ::    rn_ucf_trc                  !: unit conversion factor (for netCDF trends outputs)
+   LOGICAL  ::    ln_trdmld_trc_instant    !: flag to diagnose inst./mean ML trc trends
+   LOGICAL  ::    ln_trdmld_trc_restart    !: flag to restart mixed-layer trc diagnostics
+   CHARACTER(len=50) ::  cn_trdrst_trc_in  !: suffix of pass. tracer restart name (input)
+   CHARACTER(len=50) ::  cn_trdrst_trc_out !: suffix of pass. tracer restart name (output)
+   LOGICAL, DIMENSION (jptra) ::   ln_trdtrc  !: large trends diagnostic to write or not (namelist)
+
+# if defined key_trdtrc && defined key_iomput
+   LOGICAL, PARAMETER ::   lk_trdtrc = .TRUE. 
+#else
+   LOGICAL, PARAMETER ::   lk_trdtrc = .FALSE.   !: ML trend flag
+#endif
+
+#if defined key_trdmld_trc
+   !!----------------------------------------------------------------------
+   !!   'key_trdmld_trc'                     mixed layer trends diagnostics
+   !!----------------------------------------------------------------------
+
+   LOGICAL, PARAMETER ::   lk_trdmld_trc = .TRUE.    !: ML trend flag
+
+   INTEGER, PARAMETER ::            & !: mixed layer trends indices
+        jpmld_trc_xad     =  1,     & !:     zonal      \
+        jpmld_trc_yad     =  2,     & !:     meridonal   > advection
+        jpmld_trc_zad     =  3,     & !:     vertical   /
+        jpmld_trc_ldf     =  4,     & !:     lateral diffusion (geopot. or iso-neutral)
+        jpmld_trc_zdf     =  5,     & !:     vertical diffusion (TKE)
+        jpmld_trc_bbl     =  6,     & !:     bottom boundary layer (advective/diffusive)
+        jpmld_trc_dmp     =  7,     & !:     internal restoring trend
+        jpmld_trc_sbc     =  8,     & !:     forcing 
+        jpmld_trc_sms     =  9,     & !:     sources minus sinks trend
+  !     jpmld_trc_xxx     = xx,     & !:     add here any additional trend    (** AND UPDATE JPLTRD_TRC BELOW **)
+        jpmld_trc_radn    = 10,     & !:     corr. trn<0 in trcrad
+        jpmld_trc_radb    = 11,     & !:     corr. trb<0 in trcrad (like atf) (** MUST BE BEFORE THE LAST ONE **)
+        jpmld_trc_atf     = 12        !:     asselin trend                    (** MUST BE    THE      LAST ONE**)
+
+   !! Trends diagnostics parameters
+   !!---------------------------------------------------------------------
+   INTEGER, PARAMETER ::            &
+      jpltrd_trc = 12,                  & !: number of mixed-layer trends arrays
+      jpktrd_trc = jpk                    !: max level for mixed-layer trends diag.
+
+   !! Arrays used for diagnosing mixed-layer trends 
+   !!---------------------------------------------------------------------
+   CHARACTER(LEN=80) :: clname_trc, ctrd_trc(jpltrd_trc+1,2)
+
+   INTEGER, DIMENSION(jpi,jpj) ::   &
+      nmld_trc       , &                            !: mixed layer depth indexes 
+      nbol_trc                                   !: mixed-layer depth indexes when read from file
+
+   REAL(wp), DIMENSION(jpi,jpj,jpk) ::  wkx_trc  !:
+
+   REAL(wp), DIMENSION(jpi,jpj) ::  rmld_trc     !: ML depth (m) corresponding to nmld_trc
+   REAL(wp), DIMENSION(jpi,jpj) ::  rmld_sum_trc !: needed to compute the leap-frog time mean of ML depth
+   REAL(wp), DIMENSION(jpi,jpj) ::  rmldbn_trc   !: idem
+
+   REAL(wp), DIMENSION(jpi,jpj,jptra) ::  &
+      tml_trc    ,                        &      !: \ "now" mixed layer temperature/salinity
+      tmlb_trc   ,                        &      !: /  and associated "before" fields
+      tmlbb_trc  ,                        &      !: \  idem, but valid at the 1rst time step of the
+      tmlbn_trc  ,                        &      !: /  current analysis window
+      tml_sum_trc,                        &      !: mixed layer T, summed over the current analysis period
+      tml_sumb_trc,                       &      !: idem, but from the previous analysis period
+      tmltrd_atf_sumb_trc,                &      !: Asselin trends, summed over the previous analysis period
+      tmltrd_rad_sumb_trc                        !: trends due to trb correction in trcrad.F90, summed over the
+                                                 !:     previous analysis period
+                                                 
+   REAL(wp), DIMENSION(jpi,jpj,jptra) ::  &      
+      tmlatfb_trc, tmlatfn_trc ,          &      !: "before" Asselin contrib. at beginning of the averaging
+                                                 !:     period (i.e. last contrib. from previous such period)
+                                                 !:     and "now" Asselin contrib. to the ML trc. trends
+      tmlatfm_trc,                        &      !: accumulator for Asselin trends (needed for storage only)
+      tmlradb_trc, tmlradn_trc ,          &      !: similar to Asselin above, but for the trend due to trb
+                                                 !:     correction in trcrad.F90
+      tmlradm_trc                                !: accumulator for the previous trcrad trend
+
+   REAL(wp), DIMENSION(jpi,jpj,jpltrd_trc,jptra) ::  &
+      tmltrd_trc,                         &      !: \ physical contributions to the total trend (for T/S),
+                                                 !: / cumulated over the current analysis window
+      tmltrd_sum_trc,                     &      !: sum of these trends over the analysis period
+      tmltrd_csum_ln_trc,                 &      !: now cumulated sum of trends over the "lower triangle"
+      tmltrd_csum_ub_trc                         !: before (prev. analysis period) cumulated sum over the
+                                                 !: upper triangle
+   REAL(wp), DIMENSION(jpi,jpj,jptra) ::  &
+      tmltrdm_trc                                !: total cumulative trends over the analysis window
+
+#else
+   LOGICAL, PARAMETER ::   lk_trdmld_trc = .FALSE.   !: ML trend flag
+#endif
+
+#if defined key_lobster
+   CHARACTER(LEN=80) :: clname_bio, ctrd_bio(jpdiabio,2)
+   REAL(wp), DIMENSION(jpi,jpj,jpdiabio) ::  &
+      tmltrd_bio,                         &      !: \ biological contributions to the total trend ,
+                                                 !: / cumulated over the current analysis window
+      tmltrd_sum_bio,                     &      !: sum of these trends over the analysis period
+      tmltrd_csum_ln_bio,                 &      !: now cumulated sum of trends over the "lower triangle"
+      tmltrd_csum_ub_bio                         !: before (prev. analysis period) cumulated sum over the
+                                                 !: upper triangle
+#endif
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Empty module :                                     No passive tracer
+   !!----------------------------------------------------------------------
+#endif
+
+
+END MODULE trdmod_trc_oce
Index: trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trp_trc.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trp_trc.F90	(revision 2527)
+++ 	(revision )
@@ -1,76 +1,0 @@
-MODULE trp_trc
-   !!======================================================================
-   !!                         ***  MODULE trp_trc  ***
-   !! TOP :   TOP parameters used in TRP
-   !!======================================================================
-   !! History :   1.0  !  2004-03 (C. Ethe) original code
-   !!----------------------------------------------------------------------
-   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-#if defined key_top
-   !!----------------------------------------------------------------------
-   !!   'key_top'                                                TOP models
-   !!----------------------------------------------------------------------
-   USE par_oce
-   USE par_trc
-
-   !! passive tracers fields 
-   USE trc, ONLY :   trai      =>   trai     !: initial total tracer
-   USE trc, ONLY :   trb       =>   trb      !: tracer field (before)
-   USE trc, ONLY :   tra       =>   tra      !: tracer field (now)
-   USE trc, ONLY :   trn       =>   trn      !: tracer field (after)
-
-   !! Ocean volume
-   USE trc, ONLY :   cvol      =>   cvol     !: masked grid volume
-
-   !! time step
-   USE trc, ONLY :   ndttrc    =>   ndttrc   !: frequency of step on passive tracers (NAMELIST)
-   USE trc, ONLY :   ctrcnm    =>   ctrcnm   !: 
-   USE trc, ONLY :   numnat    =>   numnat   !: namelist
-   USE trc, ONLY :   nittrc000 =>   nittrc000
-   USE trc, ONLY :   lrst_trc  =>   lrst_trc  !: logical to control the trc restart write
-
-   !! isopycnal scheme for passive tracers
-   !! ------------------------------------  
-   REAL(wp), PUBLIC ::   ahtrb0     !: background diffusivity coefficient for passive tracer (m2/s)
-   REAL(wp), PUBLIC ::   trcrat     !: ratio between passive and active tracer coeff for diffusion
-   REAL(wp), PUBLIC ::   ahtrc0     !: horizontal eddy diffusivity for passive tracers (m2/s)
-   REAL(wp), PUBLIC ::   aeivtr0    !: eddy induced velocity coefficient (m2/s)
-
-   !! interpolated gradient
-   !!--------------------------------------------------  
-   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jptra) ::   gtru   !: horizontal gradient at u-points at bottom ocean level
-   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jptra) ::   gtrv   !: horizontal gradient at v-points at bottom ocean level
-
-   
-# if defined key_trcldf_eiv && defined key_diaeiv
-   !! The three component of the eddy induced velocity
-   !! --------------------------------------------------
-   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk) ::   u_trc_eiv   !: u-eiv (m/s)
-   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk) ::   v_trc_eiv   !: v-eiv (m/s)
-   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk) ::   w_trc_eiv   !: w-eiv (m/s)
-# endif
-
-# if defined key_trc_diatrd
-
-   !!  non conservative trends (biological, ...)
-   !! --------------------------------------------------
-   !!  Advection-diffusion trends
-   REAL(wp), PUBLIC, DIMENSION(:,:,:,:,:), ALLOCATABLE ::   trtrd   !: trends of the tracer equations
-
-   INTEGER, PUBLIC, DIMENSION(jptra) :: ikeep ! indice of tracer for which dyn trends are stored
-   INTEGER, PUBLIC                   :: nkeep ! number of tracers for which dyn trends are stored
-   !                                          ! (used to allocate trtrd buffer)
-
-   INTEGER , PUBLIC ::   nwritetrd   !: frequency of additional arrays outputs(namelist)
-# endif
-#else
-   !!----------------------------------------------------------------------
-   !!  Empty module :                                     No passive tracer
-   !!----------------------------------------------------------------------
-#endif
-
-   !!======================================================================
-END MODULE trp_trc
Index: trunk/NEMOGCM/NEMO/TOP_SRC/TRP/zpshde_trc.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/TRP/zpshde_trc.F90	(revision 2527)
+++ 	(revision )
@@ -1,201 +1,0 @@
-MODULE zpshde_trc
-   !!==============================================================================
-   !!                       ***  MODULE zpshde_trc   ***
-   !! Ocean passive tracers: 
-   !!==============================================================================
-#if defined key_top
-   !!----------------------------------------------------------------------
-   !!   'key_top'                                                TOP models
-   !!----------------------------------------------------------------------
-   !!                  z-coordinate with partial steps
-   !!----------------------------------------------------------------------
-   !!   zps_hde_trc  :  Horizontal DErivative of passive tracers at the last
-   !!                   ocean level (Z-coord. with Partial Steps)
-   !!----------------------------------------------------------------------
-   !! * Modules used
-   USE oce_trc         ! ocean dynamics and tracers variables
-   USE trp_trc             ! ocean passive tracers variables
-   USE lbclnk          ! lateral boundary conditions (or mpp link)
-
-   IMPLICIT NONE
-   PRIVATE
-
-   !! * Routine accessibility
-   PUBLIC zps_hde_trc          ! routine called by step.F90
-
-   !! * module variables
-   INTEGER, DIMENSION(jpi,jpj) ::   &
-      mbatu, mbatv      ! bottom ocean level index at U- and V-points
-
-   !! * Substitutions
-#  include "top_substitute.h90"
-   !!----------------------------------------------------------------------
-   !!   TOP 1.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE zps_hde_trc ( kt, ptra, pgtru, pgtrv )
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE zps_hde_trc  ***
-      !!                    
-      !! ** Purpose :   Compute the horizontal derivative of passive tracers
-      !!      TRA 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 TRA points 
-      !!      are not at the same depth as in z-coord. To have horizontal
-      !!      gradients again, we interpolate TRA at the good depth : 
-      !!      Linear interpolation of TRA  
-      !!         Computation of di(trb) and dj(trb) by vertical interpolation:
-      !!          di(tra) = tra~ - tra(i,j,k) or tra(i+1,j,k) - tra~
-      !!          dj(tra) = tra~ - tra(i,j,k) or tra(i,j+1,k) - tra~
-      !!         This formulation computes the two cases:
-      !!                 CASE 1                   CASE 2  
-      !!         k-1  ___ ___________   k-1   ___ ___________
-      !!                  TRAi  TRA~             TRA~  TRAi+1
-      !!                  _____                        _____
-      !!         k        |   |TRAi+1   k         TRAi |   |
-      !!                  |   |____                ____|   |
-      !!              ___ |   |   |           ___  |   |   |
-      !!                  
-      !!      case 1->   e3w(i+1) >= e3w(i) ( and e3w(j+1) >= e3w(j) ) then
-      !!      tra~ = tra(i+1,j  ,k) + (e3w(i+1) - e3w(i)) * dk(TRAi+1)/e3w(i+1)
-      !!    ( tra~ = tra(i  ,j+1,k) + (e3w(j+1) - e3w(j)) * dk(TRAj+1)/e3w(j+1))
-      !!          or
-      !!      case 2->   e3w(i+1) <= e3w(i) ( and e3w(j+1) <= e3w(j) ) then
-      !!       tra~ = tra(i,j,k) + (e3w(i) - e3w(i+1)) * dk(TRAi)/e3w(i )
-      !!     ( tra~ = tra(i,j,k) + (e3w(j) - e3w(j+1)) * dk(TRAj)/e3w(j ) )
-      !!      
-      !!
-      !! ** Action  : - pgtru : horizontal gradient of TRA at U-points 
-      !!              - pgtrv : horizontal gradient of TRA at V-points 
-      !!
-      !! History :
-      !!   8.5  !  02-04  (A. Bozec)  Original code
-      !!   8.5  !  02-08  (G. Madec E. Durand)  Optimization and Free form
-      !!   9.0  !  04-03  (C. Ethe)  adapted for passive tracers
-      !!----------------------------------------------------------------------
-      !! * Arguments
-      INTEGER, INTENT( in ) ::   kt ! ocean time-step index
-      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra), INTENT( in ) ::   &
-         ptra                       ! 4D tracers fields
-      REAL(wp), DIMENSION(jpi,jpj,jptra), INTENT( out ) ::   &
-         pgtru,                 &  ! horizontal grad. of TRA u- and v-points 
-         pgtrv                     ! of the partial step level
-
-      !! * Local declarations
-      INTEGER ::   ji, jj,jn,     &  ! Dummy loop indices
-                   iku,ikv          ! partial step level at u- and v-points
-      REAL(wp), DIMENSION(jpi,jpj) ::   &
-         zti, ztj                   ! tempory arrays
-
-      REAL(wp), DIMENSION(jpi,jpj,jptra) ::   &
-         ztrai, ztraj               ! interpolated value of TRA
-
-      REAL(wp) ::   &
-         ze3wu, ze3wv,           &  ! temporary scalars
-         zmaxu1, zmaxu2,         &  !    "         "
-         zmaxv1, zmaxv2             !    "         "
-      !!----------------------------------------------------------------------
-
-      ! Initialization (first time-step only): compute mbatu and mbatv
-      IF( kt == nittrc000 ) THEN
-         mbatu(:,:) = 0
-         mbatv(:,:) = 0
-         DO jj = 1, jpjm1
-            DO ji = 1, fs_jpim1   ! vector opt.
-               mbatu(ji,jj) = MAX( MIN( mbathy(ji,jj), mbathy(ji+1,jj  ) ) - 1, 2 )
-               mbatv(ji,jj) = MAX( MIN( mbathy(ji,jj), mbathy(ji  ,jj+1) ) - 1, 2 )
-            END DO
-         END DO
-         zti(:,:) = FLOAT( mbatu(:,:) )
-         ztj(:,:) = FLOAT( mbatv(:,:) )
-         ! lateral boundary conditions: T-point, sign unchanged
-         CALL lbc_lnk( zti , 'U', 1. )
-         CALL lbc_lnk( ztj , 'V', 1. )
-         mbatu(:,:) = MAX( INT( zti(:,:) ), 2 )
-         mbatv(:,:) = MAX( INT( ztj(:,:) ), 2 )
-      ENDIF
-      
-
-      DO jn = 1, jptra
-         ! Interpolation of passive tracers at the last ocean level
-# if defined key_vectopt_loop
-         jj = 1
-         DO ji = 1, jpij-jpi   ! vector opt. (forced unrolled)
-# else
-         DO jj = 1, jpjm1
-            DO ji = 1, jpim1
-# endif
-               ! last level
-               iku = mbatu(ji,jj)
-               ikv = mbatv(ji,jj)
-
-               ze3wu  = fse3w(ji+1,jj  ,iku) - fse3w(ji,jj,iku)
-               ze3wv  = fse3w(ji  ,jj+1,ikv) - fse3w(ji,jj,ikv)
-               zmaxu1 =  ze3wu / fse3w(ji+1,jj  ,iku)
-               zmaxu2 = -ze3wu / fse3w(ji  ,jj  ,iku)
-               zmaxv1 =  ze3wv / fse3w(ji  ,jj+1,ikv)
-               zmaxv2 = -ze3wv / fse3w(ji  ,jj  ,ikv)
-
-               ! i- direction
-
-               IF( ze3wu >= 0. ) THEN      ! case 1
-                  ! interpolated values of passive tracers
-                  ztrai(ji,jj,jn) = ptra(ji+1,jj,iku,jn) + zmaxu1 * ( ptra(ji+1,jj,iku-1,jn) - ptra(ji+1,jj,iku,jn) )
-                  ! gradient of passive tracers
-                  pgtru(ji,jj,jn) = umask(ji,jj,1) * ( ztrai(ji,jj,jn) - ptra(ji,jj,iku,jn) )
-               ELSE                        ! case 2
-                  ! interpolated values of passive tracers
-                  ztrai(ji,jj,jn) = ptra(ji,jj,iku,jn) + zmaxu2 * ( ptra(ji,jj,iku-1,jn) - ptra(ji,jj,iku,jn) )
-                  ! gradient of passive tracers
-                  pgtru(ji,jj,jn) = umask(ji,jj,1) * ( ptra(ji+1,jj,iku,jn) - ztrai (ji,jj,jn) )
-               ENDIF
-
-               ! j- direction
-
-               IF( ze3wv >= 0. ) THEN      ! case 1
-                  ! interpolated values of passive tracers
-                  ztraj(ji,jj,jn) = ptra(ji,jj+1,ikv,jn) + zmaxv1 * ( ptra(ji,jj+1,ikv-1,jn) - ptra(ji,jj+1,ikv,jn) )
-                  ! gradient of passive tracers
-                  pgtrv(ji,jj,jn) = vmask(ji,jj,1) * ( ztraj(ji,jj,jn) - ptra(ji,jj,ikv,jn) )
-               ELSE                        ! case 2
-                  ! interpolated values of passive tracers
-                  ztraj(ji,jj,jn) = ptra(ji,jj,ikv,jn) + zmaxv2 * ( ptra(ji,jj,ikv-1,jn) - ptra(ji,jj,ikv,jn) )
-                  ! gradient of passive tracers
-                  pgtrv(ji,jj,jn) = vmask(ji,jj,1) * ( ptra(ji,jj+1,ikv,jn) - ztraj(ji,jj,jn) )
-               ENDIF
-# if ! defined key_vectopt_loop
-            END DO
-# endif
-         END DO
-
-         ! Lateral boundary conditions on each gradient
-         CALL lbc_lnk( pgtru(:,:,jn) , 'U', -1. ) 
-         CALL lbc_lnk( pgtrv(:,:,jn) , 'V', -1. )
-
-      END DO
-
-   END SUBROUTINE zps_hde_trc
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option                                         Empty module
-   !!----------------------------------------------------------------------
-   USE par_kind
-CONTAINS
-   SUBROUTINE zps_hde_trc ( kt, ptra, pgtru, pgtrv ) ! Empty routine
-      INTEGER, INTENT( in) :: kt
-      REAL(wp), DIMENSION(:,:,:,:) :: ptra
-      REAL(wp) :: pgtru, pgtrv
-      WRITE(*,*) 'zps_hde_trc: You should not have seen this print! error?',   &
-         kt, ptra, pgtru, pgtrv
-   END SUBROUTINE zps_hde_trc
-#endif
-
-   !!======================================================================
-END MODULE zpshde_trc
Index: trunk/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90	(revision 2528)
@@ -6,8 +6,4 @@
    !! History :   1.0  !  2004-03  (C. Ethe)  original code
    !!             2.0  !  2007-12 (C. Ethe, G. Madec)  rewritting
-   !!----------------------------------------------------------------------
-   !! NEMO/TOP 2.0,  LOCEAN-IPSL (2007)
-   !! $Id$
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 #if defined key_top
@@ -32,9 +28,15 @@
    USE par_oce , ONLY :   jpkdta   =>   jpkdta     !: number of levels            > or = jpk
    USE par_oce , ONLY :   lk_esopa =>   lk_esopa   !: flag to activate the all option
+   USE par_oce , ONLY :   jp_tem   =>   jp_tem     !: indice for temperature
+   USE par_oce , ONLY :   jp_sal   =>   jp_sal     !: indice for salinity
 
    !* IO manager *
-   USE in_out_manager      ! use all the variables
+   USE in_out_manager    
+                          
    !* physical constants *
-   USE phycst              ! use all the variables
+   USE phycst            
+
+   !* 1D configuration
+   USE c1d                                         
 
    !* model domain *
@@ -111,17 +113,29 @@
    USE dom_oce , ONLY :   ln_sco     =>  ln_sco      !: s-coordinate flag
    USE dom_oce , ONLY :   ln_zco     =>  ln_zco      !: z-coordinate flag
-   USE dom_oce , ONLY :   lk_zco     =>  lk_zco      !: z-coordinate flag (1D or 3D arrays)
-   USE dom_oce , ONLY :   hbatt      =>   hbatt      !: ocean depth at the vertical of  t-point (m)
-   USE dom_oce , ONLY :   hbatu      =>   hbatu      !: ocean depth at the vertical of  u-point (m)
-   USE dom_oce , ONLY :   hbatv      =>   hbatv      !: ocean depth at the vertical of w-point (m)
-   USE dom_oce , ONLY :   gsigt      =>   gsigt      !: model level depth coefficient at T-levels
-   USE dom_oce , ONLY :   gsigw      =>   gsigw      !: model level depth coefficient at W-levels
-   USE dom_oce , ONLY :   gsi3w      =>   gsi3w      !: model level depth coef at w-levels (defined as the sum of e3w)
-   USE dom_oce , ONLY :   esigt      =>   esigt      !: vertical scale factor coef. at t-levels
-   USE dom_oce , ONLY :   esigw      =>   esigw      !: vertical scale factor coef. at w-levels
-   USE dom_oce , ONLY :   lk_vvl     => lk_vvl       !: variable grid flag
-
+   USE dom_oce , ONLY :   hbatt      =>  hbatt       !: ocean depth at the vertical of  t-point (m)
+   USE dom_oce , ONLY :   hbatu      =>  hbatu       !: ocean depth at the vertical of  u-point (m)
+   USE dom_oce , ONLY :   hbatv      =>  hbatv       !: ocean depth at the vertical of w-point (m)
+   USE dom_oce , ONLY :   gsigt      =>  gsigt       !: model level depth coefficient at T-levels
+   USE dom_oce , ONLY :   gsigw      =>  gsigw       !: model level depth coefficient at W-levels
+   USE dom_oce , ONLY :   gsi3w      =>  gsi3w       !: model level depth coef at w-levels (defined as the sum of e3w)
+   USE dom_oce , ONLY :   esigt      =>  esigt       !: vertical scale factor coef. at t-levels
+   USE dom_oce , ONLY :   esigw      =>  esigw       !: vertical scale factor coef. at w-levels
+   USE dom_oce , ONLY :   lk_vvl     =>  lk_vvl      !: variable grid flag
+# if defined key_vvl
+   USE dom_oce , ONLY :   gdep3w_1   =>  gdep3w_1    !: ???
+   USE dom_oce , ONLY :   gdept_1    =>  gdept_1     !: depth of t-points (m)
+   USE dom_oce , ONLY :   gdepw_1    =>  gdepw_1     !: depth of t-points (m)
+   USE dom_oce , ONLY :   e3t_1      =>  e3t_1       !: vertical scale factors at t-
+   USE dom_oce , ONLY :   e3u_1      =>  e3u_1       !: vertical scale factors at u-
+   USE dom_oce , ONLY :   e3v_1      =>  e3v_1       !: vertical scale factors v-
+   USE dom_oce , ONLY :   e3w_1      =>  e3w_1       !: w-points (m)
+   USE dom_oce , ONLY :   e3f_1      =>  e3f_1       !: f-points (m)
+   USE dom_oce , ONLY :   e3uw_1     =>  e3uw_1      !: uw-points (m)
+   USE dom_oce , ONLY :   e3vw_1     =>  e3vw_1      !: vw-points (m)
+# endif
    !* masks, bathymetry *
-   USE dom_oce , ONLY :   mbathy     =>   mbathy     !: number of ocean level (=0,  & 1, ... , jpk-1) 
+   USE dom_oce , ONLY :   mbkt       =>   mbkt       !: vertical index of the bottom last T- ocean level
+   USE dom_oce , ONLY :   mbku       =>   mbku       !: vertical index of the bottom last U- ocean level
+   USE dom_oce , ONLY :   mbkv       =>   mbkv       !: vertical index of the bottom last V- ocean level
    USE dom_oce , ONLY :   tmask_i    =>   tmask_i    !: Interior mask at t-points
    USE dom_oce , ONLY :   tmask      =>   tmask      !: land/ocean mask at t-points
@@ -129,7 +143,4 @@
    USE dom_oce , ONLY :   vmask      =>   vmask      !: land/ocean mask at v-points 
    USE dom_oce , ONLY :   fmask      =>   fmask      !: land/ocean mask at f-points 
-# if defined key_off_degrad
-   USE dom_oce , ONLY :   facvol     =>   facvol     !: volume factor for degradation
-# endif
 
    !* time domain *
@@ -166,18 +177,24 @@
    USE oce , ONLY :   tn      =>    tn      !: pot. temperature (celsius)
    USE oce , ONLY :   sn      =>    sn      !: salinity (psu)
+   USE oce , ONLY :   tsn     =>    tsn     !: 4D array contaning ( tn, sn )
+   USE oce , ONLY :   tsb     =>    tsb     !: 4D array contaning ( tb, sb )
+   USE oce , ONLY :   tsa     =>    tsa     !: 4D array contaning ( ta, sa )
    USE oce , ONLY :   rhop    =>    rhop    !: potential volumic mass (kg m-3) 
    USE oce , ONLY :   rhd     =>    rhd     !: in situ density anomalie rhd=(rho-rau0)/rau0 (no units)
    USE oce , ONLY :   hdivn   =>    hdivn   !: horizontal divergence (1/s)
-#if defined key_off_tra
-   USE oce , ONLY :   gtu     =>    gtu     !: t-, s- and rd horizontal gradient at u- and
-   USE oce , ONLY :   gsu     =>    gsu     !: v-points at bottom ocean level
+   USE oce , ONLY :   l_traldf_rot => l_traldf_rot  !: rotated laplacian operator for lateral diffusion
+#if defined key_offline
+   USE oce , ONLY :   gtsu    =>    gtsu    !: t-, s- and rd horizontal gradient at u- and
+   USE oce , ONLY :   gtsv    =>    gtsv    !:
    USE oce , ONLY :   gru     =>    gru     !:
-   USE oce , ONLY :   gtv     =>    gtv     !:
-   USE oce , ONLY :   gsv     =>    gsv     !:
    USE oce , ONLY :   grv     =>    grv     !: 
+# if defined key_degrad
+   USE dommsk , ONLY :   facvol     =>   facvol     !: volume factor for degradation
+# endif
+
 #endif
-   USE lib_mpp , ONLY :   lk_mpp    =>  lk_mpp       !: Mpp flag
-
-   USE dom_oce , ONLY :   n_cla     =>   n_cla         !: flag (0/1) for cross land advection 
+   USE lib_mpp , ONLY :   lk_mpp    =>  lk_mpp        !: Mpp flag
+
+   USE dom_oce , ONLY :   nn_cla    =>  nn_cla        !: flag (0/1) for cross land advection 
 
    !* surface fluxes *
@@ -186,23 +203,17 @@
    USE sbc_oce , ONLY :   wndm       =>    wndm       !: 10m wind speed 
    USE sbc_oce , ONLY :   qsr        =>    qsr        !: penetrative solar radiation (w m-2)  
-   USE sbc_oce , ONLY :   emp        =>    emp        !: evaporation minus precipitation (kg m-2 s-2) 
-   USE sbc_oce , ONLY :   emps       =>    emps       !: evaporation minus precipitation (kg m-2 s-2)
+   USE sbc_oce , ONLY :   emp        =>    emp        !: freshwater budget: volume flux               [Kg/m2/s]
+   USE sbc_oce , ONLY :   emps       =>    emps       !: freshwater budget: concentration/dillution   [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_rnf     =>    ln_rnf     !: runoffs / runoff mouths
    USE sbc_oce , ONLY :   fr_i       =>    fr_i       !: ice fraction (between 0 to 1)
    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
-   USE traqsr  , ONLY :   rn_si2     =>    rn_si2     !: deepest depth of extinction (blue &  0.01 mg.m-3)     (RGB)
    USE traqsr  , ONLY :   ln_qsr_bio =>    ln_qsr_bio !: flag to use or not the biological fluxes for light
    USE sbcrnf  , ONLY :   rnfmsk     =>    rnfmsk     !: mixed adv scheme in runoffs vicinity (hori.) 
    USE sbcrnf  , ONLY :   rnfmsk_z   =>    rnfmsk_z   !: mixed adv scheme in runoffs vicinity (vert.)
 
-   !* bottom boundary layer *
-# if   defined key_trabbl_dif   ||   defined key_trabbl_adv
-# if ! defined key_off_tra 
-   USE trabbl , ONLY :   atrbbl   =>   rn_ahtbbl     !: lateral coeff. for bottom boundary layer scheme (m2/s)
-# else 
-   USE trabbl, ONLY :   bblx   => bblx         !: ???
-   USE trabbl, ONLY :   bbly   => bbly         !: ???
-#  endif
-# endif
+   USE trc_oce
 
    !* lateral diffusivity (tracers) *
@@ -221,5 +232,5 @@
    USE zdf_oce , ONLY :   avt        =>   avt         !: vert. diffusivity coef. at w-point for temp  
 # if defined key_zdfddm
-   USE zdfddm  , ONLY :   avs        =>    avs        !: salinity vertical diffusivity coeff. at w-point
+   USE zdfddm  , ONLY :   avs        =>   avs        !: salinity vertical diffusivity coeff. at w-point
 # endif
 
@@ -245,4 +256,8 @@
 #endif
 
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!======================================================================
 END MODULE oce_trc
Index: trunk/NEMOGCM/NEMO/TOP_SRC/par_trc.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/par_trc.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/par_trc.F90	(revision 2528)
@@ -9,8 +9,4 @@
    !!             1.0  !  2004-03  (C. Ethe) Free form and module
    !!             2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture
-   !!----------------------------------------------------------------------
-   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
    USE par_kind          ! kind parameters
@@ -39,37 +35,11 @@
    LOGICAL, PUBLIC, PARAMETER ::   lk_trc_c1d   = .FALSE.  !: 1D pass. tracer configuration flag
 # endif
-   ! Passive tracers : size for TRP trends diagnotics (used if 'key_trc_diatrd' defined)
-# if defined key_trc_diatrd
-   ! Passive tracers : size for TRP trends diagnotics (used if 'key_trc_diatrd' defined)
-   INTEGER, PUBLIC,  PARAMETER ::   jptrc_xad     =  1   !: x- horizontal advection
-   INTEGER, PUBLIC,  PARAMETER ::   jptrc_yad     =  2   !: y- horizontal advection
-   INTEGER, PUBLIC,  PARAMETER ::   jptrc_zad     =  3   !: z- vertical   advection
-   INTEGER, PUBLIC,  PARAMETER ::   jptrc_xdf     =  4   !: lateral       diffusion
-   INTEGER, PUBLIC,  PARAMETER ::   jptrc_ydf     =  5   !: lateral       diffusion
-   INTEGER, PUBLIC,  PARAMETER ::   jptrc_zdf     =  6   !: vertical diffusion (Kz)
-   INTEGER, PUBLIC,  PARAMETER ::   jptrc_sbc     =  7   !: surface boundary condition
-#if ! defined key_trcldf_eiv && ! defined key_trcdmp
-   INTEGER, PUBLIC,  PARAMETER ::   jpdiatrc      =  7  !: trends: 3*(advection + diffusion       ) + sbc
-#endif
-#if defined key_trcldf_eiv && defined key_trcdmp
-   INTEGER, PUBLIC,  PARAMETER ::   jptrc_xei     =  8   !: x- horiz. EIV advection
-   INTEGER, PUBLIC,  PARAMETER ::   jptrc_yei     =  9   !: y- horiz. EIV advection
-   INTEGER, PUBLIC,  PARAMETER ::   jptrc_zei     = 10   !: z- vert.  EIV advection
-   INTEGER, PUBLIC,  PARAMETER ::   jptrc_dmp     = 11   !: damping
-   INTEGER, PUBLIC,  PARAMETER ::   jpdiatrc      = 11   !: trends: 3*(advection + diffusion + eiv ) + sbc + damping
-#endif
-#if defined key_trcldf_eiv && ! defined key_trcdmp
-   INTEGER, PUBLIC,  PARAMETER ::   jptrc_xei     =  8   !: x- horiz. EIV advection
-   INTEGER, PUBLIC,  PARAMETER ::   jptrc_yei     =  9   !: y- horiz. EIV advection
-   INTEGER, PUBLIC,  PARAMETER ::   jptrc_zei     = 10   !: z- vert.  EIV advection
-   INTEGER, PUBLIC,  PARAMETER ::   jpdiatrc      = 10   !: trends: 3*(advection + diffusion + eiv ) + sbc 
-#endif
-#if ! defined key_trcldf_eiv && defined key_trcdmp
-   INTEGER, PUBLIC,  PARAMETER ::   jptrc_dmp     =  8   !: damping
-   INTEGER, PUBLIC,  PARAMETER ::   jpdiatrc      =  8   !: trends: 3*(advection + diffusion       ) + sbc + damping
-#endif
-#endif
 
    REAL(wp), PUBLIC  :: rtrn  = 1.e-15      !: truncation value     
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!======================================================================
 END MODULE par_trc
Index: trunk/NEMOGCM/NEMO/TOP_SRC/prtctl_trc.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/prtctl_trc.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/prtctl_trc.F90	(revision 2528)
@@ -35,10 +35,4 @@
    PUBLIC prt_ctl_trc_info    !
    PUBLIC prt_ctl_trc_init    ! called by opa.F90
-
-   !!----------------------------------------------------------------------
-   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
 
 CONTAINS
@@ -466,5 +460,9 @@
    !!----------------------------------------------------------------------
 #endif
-    
-   !!======================================================================
+ 
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================   
 END MODULE prtctl_trc
Index: trunk/NEMOGCM/NEMO/TOP_SRC/top_substitute.h90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/top_substitute.h90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/top_substitute.h90	(revision 2528)
@@ -2,79 +2,16 @@
    !!                    ***  top_substitute.h90   ***
    !!----------------------------------------------------------------------
-   !! ** purpose : Statement function file: to be include in all routines
-   !!              concerning passive tracer model 
+   !! ** purpose : Statement function file: to be include in all passive tracer modules
    !!----------------------------------------------------------------------
    !! History :   1.0  !  2004-03 (C. Ethe) Original code
    !!             2.0  !  2007-12 (C. Ethe, G. Madec) new architecture
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+#  include "domzgr_substitute.h90"
+#  include "ldfeiv_substitute.h90"
+#  include "ldftra_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
-    ! Lateral eddy diffusivity coefficient for passive tracer:
-    ! ========================================================
-#if defined key_traldf_c3d || defined key_off_degrad
-!   'key_traldf_c3d' :                 aht: 3D coefficient
-#       define fsahtrt(i,j,k)  trcrat * ahtt(i,j,k)
-#       define fsahtru(i,j,k)  trcrat * ahtu(i,j,k)
-#       define fsahtrv(i,j,k)  trcrat * ahtv(i,j,k)
-#       define fsahtrw(i,j,k)  trcrat * ahtw(i,j,k)
-#elif defined key_traldf_c2d
-!   'key_traldf_c2d' :                 aht: 2D coefficient
-#       define fsahtrt(i,j,k)  trcrat * ahtt(i,j)
-#       define fsahtru(i,j,k)  trcrat * ahtu(i,j)
-#       define fsahtrv(i,j,k)  trcrat * ahtv(i,j)
-#       define fsahtrw(i,j,k)  trcrat * ahtw(i,j)
-#elif defined key_traldf_c1d
-!   'key_traldf_c1d' :                 aht: 1D coefficient
-#       define fsahtrt(i,j,k)  trcrat * ahtt(k)
-#       define fsahtru(i,j,k)  trcrat * ahtu(k)
-#       define fsahtrv(i,j,k)  trcrat * ahtv(k)
-#       define fsahtrw(i,j,k)  trcrat * ahtw(k)
-#else
-!   Default option :             aht: Constant coefficient
-#       define fsahtrt(i,j,k)  ahtrc0
-#       define fsahtru(i,j,k)  ahtrc0
-#       define fsahtrv(i,j,k)  ahtrc0
-#       define fsahtrw(i,j,k)  ahtrc0
-#endif
-
-    ! Eddy induced velocity  coefficient for passive tracer:
-    ! ========================================================
-#if defined key_traldf_c3d || defined key_off_degrad
-!   'key_traldf_c3d' :                 eiv: 3D coefficient
-#       define fsaeitru(i,j,k)  trcrat * aeiu(i,j,k)
-#       define fsaeitrv(i,j,k)  trcrat * aeiv(i,j,k)
-#       define fsaeitrw(i,j,k)  trcrat * aeiw(i,j,k)
-#elif defined key_traldf_c2d
-!   'key_traldf_c2d' :                 eiv: 2D coefficient
-#       define fsaeitru(i,j,k)  trcrat * aeiu(i,j)
-#       define fsaeitrv(i,j,k)  trcrat * aeiv(i,j)
-#       define fsaeitrw(i,j,k)  trcrat * aeiw(i,j)
-#elif defined key_traldf_c1d
-!   'key_traldf_c1d' :                 eiv: 1D coefficient
-#       define fsaeitru(i,j,k)  trcrat * aeiu(k)
-#       define fsaeitrv(i,j,k)  trcrat * aeiv(k)
-#       define fsaeitrw(i,j,k)  trcrat * aeiw(k)
-#else
-!   Default option :             eiv: Constant coefficient
-#       define fsaeitru(i,j,k)  aeiv0
-#       define fsaeitrv(i,j,k)  aeiv0
-#       define fsaeitrw(i,j,k)  aeiv0
-#endif
-    ! mixing for passive tracer:
-    ! ========================================================
-#if defined key_trc_zdfddm
-!   'key_trc_zdfddm' :    avs 
-#       define fstravs(i,j,k)   avs(i,j,k)
-#else
-!   Defautl option :   avs = avt
-#       define fstravs(i,j,k)   avt(i,j,k)
-#endif
-
-! ========================================================
-#include "domzgr_substitute.h90"
-#include "ldfeiv_substitute.h90"
-#include "ldftra_substitute.h90"
-#include "vectopt_loop_substitute.h90"
Index: trunk/NEMOGCM/NEMO/TOP_SRC/trc.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/trc.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/trc.F90	(revision 2528)
@@ -4,12 +4,8 @@
    !! Passive tracers   :  module for tracers defined
    !!======================================================================
-   !! History :    -   !  1996-01  (M. Levy)  Original code
+   !! History :   OPA  !  1996-01  (M. Levy)  Original code
    !!              -   !  1999-07  (M. Levy)  for LOBSTER1 or NPZD model
    !!              -   !  2000-04  (O. Aumont, M.A. Foujols)  HAMOCC3 and P3ZD
-   !!             1.0  !  2004-03  (C. Ethe)  Free form and module
-   !!----------------------------------------------------------------------
-   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!   NEMO      1.0  !  2004-03  (C. Ethe)  Free form and module
    !!----------------------------------------------------------------------
 #if defined key_top
@@ -34,12 +30,11 @@
    INTEGER, PUBLIC                   ::   numnat   !: the number of the passive tracer NAMELIST
    LOGICAL, PUBLIC, DIMENSION(jptra) ::   lutini   !:  initialisation from FILE or not (NAMELIST)
-   LOGICAL, PUBLIC, DIMENSION(jptra) ::   lutsav   !:  logical for saving tracer or not
-   INTEGER, PUBLIC, DIMENSION(jptra) ::   nutini   !: FORTRAN LOGICAL UNIT for initialisation file
+   LOGICAL, PUBLIC, DIMENSION(jptra) ::   lutsav   !:  save the tracer or not
 
    !! passive tracers fields (before,now,after)
    !! --------------------------------------------------
-   REAL(wp), PUBLIC ::   trai                         !: initial total tracer
-   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk) :: cvol  !: masked grid volume 
-   REAL(wp), PUBLIC ::   areatot                      !: total volume 
+   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk) :: cvol   !: volume correction -degrad option- 
+   REAL(wp), PUBLIC ::   trai                          !: initial total tracer
+   REAL(wp), PUBLIC ::   areatot                       !: total volume 
 
    REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk,jptra) ::   trn   !: traceur concentration for actual time step
@@ -47,47 +42,52 @@
    REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk,jptra) ::   trb   !: traceur concentration for before time step
 
+   !! interpolated gradient
+   !!--------------------------------------------------  
+   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jptra) ::   gtru   !: horizontal gradient at u-points at bottom ocean level
+   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jptra) ::   gtrv   !: horizontal gradient at v-points at bottom ocean level
    
    !! passive tracers restart (input and output)
    !! ------------------------------------------  
-   INTEGER , PUBLIC  ::  ndttrc     !: frequency of step on passive tracers
-   INTEGER , PUBLIC  ::  nittrc000  !: first time step of passive tracers model
-   LOGICAL , PUBLIC  ::  ln_rsttr     !: boolean term for restart i/o for passive tracers (namelist)
-   LOGICAL , PUBLIC  ::  lrst_trc   !: logical to control the trc restart write
-   INTEGER , PUBLIC  ::  nutwrs     !: output FILE for passive tracers restart
-   INTEGER , PUBLIC  ::  nutrst     !: logical unit for restart FILE for passive tracers
-   INTEGER , PUBLIC  ::  nrsttr     !: control of the time step ( 0 or 1 ) for pass. tr.
-   CHARACTER(len=50) ::  cn_trcrst_in  !: suffix of pass. tracer restart name (input)
-   CHARACTER(len=50) ::  cn_trcrst_out !: suffix of pass. tracer restart name (output)
+   LOGICAL , PUBLIC          ::  ln_rsttr      !: boolean term for restart i/o for passive tracers (namelist)
+   LOGICAL , PUBLIC          ::  lrst_trc      !: logical to control the trc restart write
+   INTEGER , PUBLIC          ::  nn_dttrc      !: frequency of step on passive tracers
+   INTEGER , PUBLIC          ::  nutwrs        !: output FILE for passive tracers restart
+   INTEGER , PUBLIC          ::  nutrst        !: logical unit for restart FILE for passive tracers
+   INTEGER , PUBLIC          ::  nn_rsttr      !: control of the time step ( 0 or 1 ) for pass. tr.
+   CHARACTER(len=50), PUBLIC ::  cn_trcrst_in  !: suffix of pass. tracer restart name (input)
+   CHARACTER(len=50), PUBLIC ::  cn_trcrst_out !: suffix of pass. tracer restart name (output)
    
    !! information for outputs
    !! --------------------------------------------------
-   INTEGER , PUBLIC ::   nwritetrc   !: time step frequency for concentration outputs (namelist)
+   INTEGER , PUBLIC ::   nn_writetrc   !: time step frequency for concentration outputs (namelist)
+   REAL(wp), PUBLIC, DIMENSION(jpk) ::   rdttrc        !: vertical profile of passive tracer time step
    
-# if defined key_trc_diaadd && ! defined key_iomput
+# if defined key_diatrc && ! defined key_iomput
    !! additional 2D/3D outputs namelist
    !! --------------------------------------------------
-   CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia2d) ::   ctrc2d   !: 2d output field name
-   CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia2d) ::   ctrc2u   !: 2d output field unit   
-   CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia3d) ::   ctrc3d   !: 3d output field name
-   CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia3d) ::   ctrc3u   !: 3d output field unit
-   CHARACTER(len=80), PUBLIC, DIMENSION (jpdia2d) ::   ctrc2l   !: 2d output field long name
-   CHARACTER(len=80), PUBLIC, DIMENSION (jpdia3d) ::   ctrc3l   !: 3d output field long name
+   INTEGER , PUBLIC                               ::   nwritedia   !: frequency of additional arrays outputs(namelist)
+   CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia2d) ::   ctrc2d      !: 2d output field name
+   CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia2d) ::   ctrc2u      !: 2d output field unit   
+   CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia3d) ::   ctrc3d      !: 3d output field name
+   CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia3d) ::   ctrc3u      !: 3d output field unit
+   CHARACTER(len=80), PUBLIC, DIMENSION (jpdia2d) ::   ctrc2l      !: 2d output field long name
+   CHARACTER(len=80), PUBLIC, DIMENSION (jpdia3d) ::   ctrc3l      !: 3d output field long name
 
-   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,    jpdia2d) ::   trc2d   !:  additional 2d outputs  
-   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk,jpdia3d) ::   trc3d   !:  additional 3d outputs  
+   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,    jpdia2d) ::   trc2d    !:  additional 2d outputs  
+   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk,jpdia3d) ::   trc3d    !:  additional 3d outputs  
    
-   INTEGER , PUBLIC ::   nwritedia     !: frequency of additional arrays outputs(namelist)
 # endif
 
-#if defined key_trc_diabio || defined key_trdmld_trc
-   CHARACTER(len=8),  DIMENSION(jpdiabio) ::   ctrbio   !: biological trends name      (NAMELIST)
-   CHARACTER(len=20), DIMENSION(jpdiabio) ::   ctrbiu   !: biological trends unit      (NAMELIST)
-   CHARACTER(len=80), DIMENSION(jpdiabio) ::   ctrbil   !: biological trends long name (NAMELIST)
-   INTEGER ::   nwritebio   !: time step frequency for biological outputs (NAMELIST)
+#if defined key_diabio || defined key_trdmld_trc
+   !                                                              !!*  namtop_XXX namelist *
+   INTEGER , PUBLIC                               ::   nwritebio   !: time step frequency for biological outputs 
+   CHARACTER(len=8 ), PUBLIC, DIMENSION(jpdiabio) ::   ctrbio      !: biological trends name      
+   CHARACTER(len=20), PUBLIC, DIMENSION(jpdiabio) ::   ctrbiu      !: biological trends unit   
+   CHARACTER(len=80), PUBLIC, DIMENSION(jpdiabio) ::   ctrbil      !: biological trends long name
 #endif
-# if defined key_trc_diabio
+# if defined key_diabio
    !! Biological trends
    !! -----------------
-   REAL(wp), DIMENSION(jpi,jpj,jpk,jpdiabio) :: trbio   !: biological trends
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk,jpdiabio) :: trbio   !: biological trends
 # endif
 
@@ -105,4 +105,8 @@
 #endif
 
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!======================================================================
 END MODULE trc
Index: trunk/NEMOGCM/NEMO/TOP_SRC/trcctl.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/trcctl.F90	(revision 2527)
+++ 	(revision )
@@ -1,120 +1,0 @@
-MODULE trcctl
-   !!======================================================================
-   !!                         ***  MODULE trcctl  ***
-   !! TOP :   control the cpp options, files and namelist values of a run
-   !!======================================================================
-   !! History :   1.0  !  2005-03 (O. Aumont, A. El Moussaoui) original code
-   !!----------------------------------------------------------------------
-#if defined key_top
-   !!----------------------------------------------------------------------
-   !!   'key_top'                                                TOP models
-   !!----------------------------------------------------------------------
-   !!   trc_ctl    : control the cpp options, files and namelist values
-   !!----------------------------------------------------------------------
-   USE oce_trc
-   USE trc
-   USE trctrp_ctl
-   USE trcctl_lobster
-   USE trcctl_pisces
-   USE trcctl_cfc
-   USE trcctl_c14b
-   USE trcctl_my_trc
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC trc_ctl      ! called by ???
-
-   !!----------------------------------------------------------------------
-   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE trc_ctl
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE trc_ctl  ***
-      !!
-      !! ** Purpose :   control the cpp options, namelist and files 
-      !!              we use IF/ENDIF inside #IF defined option-cpp
-      !!              FILE name must not exceed 21 characters
-      !!----------------------------------------------------------------------
-      INTEGER ::   istop, jn
-      !!----------------------------------------------------------------------
-
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) ' trc_ctl :   passive tracer option'
-      IF(lwp) WRITE(numout,*) ' ~~~~~~~'
-
-      istop = 0      ! initialise to zero
-
-      ! restart for passive tracer (input)
-      IF( ln_rsttr ) THEN
-         IF(lwp) WRITE(numout,*) '       READ a restart FILE for passive tracer'
-         IF(lwp) WRITE(numout,*) ' '
-      ELSE
-         IF(lwp) WRITE(numout,*) '       no restart FILE'
-         IF(lwp) WRITE(numout,*)
-         DO jn = 1, jptra
-            IF( lutini(jn) ) THEN      ! OPEN input FILE only IF lutini(jn) is true
-               IF(lwp) WRITE(numout,*)  &
-                  '       READ an initial FILE  for passive tracer number :', jn, ' traceur : ', ctrcnm(jn) 
-            END IF
-         END DO
-      ENDIF
-
-      ! transport scheme option
-      CALL trc_trp_ctl
-
-      ! SMS model
-      IF(lwp) WRITE(numout,*) '  '
-      IF(lwp) WRITE(numout,*) '       Source/Sink model option'
-      IF(lwp) WRITE(numout,*) '  '
-
-      IF( lk_lobster ) THEN   ;   CALL trc_ctl_lobster      ! LOBSTER bio-model
-      ELSE                    ;   IF(lwp) WRITE(numout,*) '          LOBSTER not used'
-      ENDIF
-
-      IF( lk_pisces  ) THEN   ;   CALL trc_ctl_pisces      ! PISCES  bio-model
-      ELSE                    ;   IF(lwp) WRITE(numout,*) '          PISCES not used'
-      ENDIF
-
-      IF( lk_cfc     ) THEN   ;   CALL trc_ctl_cfc         ! CFC     tracers
-      ELSE                    ;   IF(lwp) WRITE(numout,*) '          CFC not used'
-      ENDIF
-
-      IF( lk_c14b    ) THEN   ;   CALL trc_ctl_c14b        ! C14 bomb   tracers
-      ELSE                    ;   IF(lwp) WRITE(numout,*) '          C14b not used'
-      ENDIF
-
-
-      IF( lk_my_trc  ) THEN   ;   CALL trc_ctl_my_trc      ! MY_TRC  tracers
-      ELSE                    ;   IF(lwp) WRITE(numout,*) '          MY_TRC not used'
-      ENDIF
-
-
-      ! E r r o r  control
-      ! ------------------
-      IF( istop > 0  ) THEN
-         IF(lwp)WRITE(numout,*)
-         IF(lwp)WRITE(numout,*) istop,' E R R O R found : we stop'
-         IF(lwp)WRITE(numout,*) '  **************************'
-         IF(lwp)WRITE(numout,*)
-         STOP 'trcctl'
-      ENDIF
-      !
-   END SUBROUTINE trc_ctl
-
-#else
-   !!----------------------------------------------------------------------
-   !!  Empty module :                                     No passive tracer
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE trc_ctl                      ! Dummy routine
-   END SUBROUTINE trc_ctl
-#endif
-
-   !!======================================================================
-END MODULE trcctl
Index: trunk/NEMOGCM/NEMO/TOP_SRC/trcdia.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/trcdia.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/trcdia.F90	(revision 2528)
@@ -4,9 +4,9 @@
    !! TOP :   Output of passive tracers
    !!======================================================================
-   !! History :    -   !  1995-01 (M. Levy)  Original code
+   !! History :   OPA  !  1995-01 (M. Levy)  Original code
    !!              -   !  1998-01 (C. Levy) NETCDF format using ioipsl interface
    !!              -   !  1999-01 (M.A. Foujols) adapted for passive tracer
    !!              -   !  1999-09 (M.A. Foujols) split into three parts
-   !!             1.0  !  2005-03 (O. Aumont, A. El Moussaoui) F90
+   !!   NEMO      1.0  !  2005-03 (O. Aumont, A. El Moussaoui) F90
    !!                  !  2008-05 (C. Ethe re-organization)
    !!----------------------------------------------------------------------
@@ -17,5 +17,4 @@
    !! trc_dia     : main routine of output passive tracer
    !! trcdit_wr   : outputs of concentration fields
-   !! trcdid_wr   : outputs of dvection-diffusion trends
    !! trcdii_wr   : outputs of additional 2D/3D diagnostics
    !! trcdib_wr   : outputs of biological fields
@@ -24,7 +23,5 @@
    USE oce_trc
    USE trc
-   USE trp_trc
    USE par_trc
-   USE trdmld_trc_oce, ONLY : luttrd
    USE dianam    ! build name of file (routine)
    USE in_out_manager  ! I/O manager
@@ -35,5 +32,5 @@
    PRIVATE
 
-   PUBLIC trc_dia      
+   PUBLIC   trc_dia   ! called by XXX module 
 
    INTEGER  ::   nit5      !: id for tracer output file
@@ -45,15 +42,10 @@
    INTEGER , DIMENSION (jpij*jpk) ::   ndext50   !: integer arrays for ocean 3D index
    INTEGER , DIMENSION (jpij)     ::   ndext51   !: integer arrays for ocean surface index
-# if defined key_trc_diaadd
+# if defined key_diatrc
    INTEGER  ::   nitd      !: id for additional array output file
    INTEGER  ::   ndepitd   !: id for depth mesh
    INTEGER  ::   nhoritd   !: id for horizontal mesh
 # endif
-# if defined key_trc_diatrd
-   INTEGER , DIMENSION (jptra) ::   nit6      !: id for additional array output file
-   INTEGER , DIMENSION (jptra) ::   ndepit6   !: id for depth mesh
-   INTEGER , DIMENSION (jptra) ::   nhorit6   !: id for horizontal mesh
-# endif
-# if defined key_trc_diabio
+# if defined key_diabio
    INTEGER  ::   nitb        !:         id.         for additional array output file
    INTEGER  ::   ndepitb   !:  id for depth mesh
@@ -64,9 +56,8 @@
 #  include "top_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
@@ -80,12 +71,11 @@
       INTEGER               :: kindic
       !!---------------------------------------------------------------------
-      
+      !
       CALL trcdit_wr( kt, kindic )      ! outputs for tracer concentration
-      CALL trcdid_wr( kt, kindic )      ! outputs for dynamical trends
       CALL trcdii_wr( kt, kindic )      ! outputs for additional arrays
       CALL trcdib_wr( kt, kindic )      ! outputs for biological trends
-
       !
    END SUBROUTINE trc_dia
+
 
    SUBROUTINE trcdit_wr( kt, kindic )
@@ -111,11 +101,9 @@
       LOGICAL ::   ll_print = .FALSE.
       CHARACTER (len=40) :: clhstnam, clop
-#if defined key_off_tra
       INTEGER ::   inum = 11             ! temporary logical unit
-#endif
       CHARACTER (len=20) :: cltra, cltrau
       CHARACTER (len=80) :: cltral
       REAL(wp) :: zsto, zout, zdt
-      INTEGER  :: iimi, iima, ijmi, ijma, ipk, it, itmod
+      INTEGER  :: iimi, iima, ijmi, ijma, ipk, it, itmod, iiter
       !!----------------------------------------------------------------------
 
@@ -133,5 +121,5 @@
       ENDIF
 # if defined key_diainstant
-      zsto = nwritetrc * rdt
+      zsto = nn_writetrc * rdt
       clop = "inst("//TRIM(clop)//")"
 # else
@@ -139,5 +127,5 @@
       clop = "ave("//TRIM(clop)//")"
 # endif
-      zout = nwritetrc * zdt
+      zout = nn_writetrc * zdt
 
       ! Define indices of the horizontal output zoom and vertical limit storage
@@ -147,6 +135,7 @@
 
       ! define time axis
-      itmod = kt - nittrc000 + 1
+      itmod = kt - nit000 + 1
       it    = kt
+      iiter = ( nit000 - 1 ) / nn_dttrc
 
       ! Define NETCDF files and fields at beginning of first time step
@@ -155,5 +144,5 @@
       IF(ll_print)WRITE(numout,*)'trcdit_wr kt=',kt,' kindic ',kindic
       
-      IF( kt == nittrc000 ) THEN
+      IF( kt == nit000 ) THEN
 
          ! Compute julian date from starting date of the run
@@ -161,5 +150,5 @@
          zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment
          IF(lwp)WRITE(numout,*)' '  
-         IF(lwp)WRITE(numout,*)' Date 0 used :', nittrc000                         &
+         IF(lwp)WRITE(numout,*)' Date 0 used :', nit000                         &
             &                 ,' YEAR ', nyear, ' MONTH ', nmonth, ' DAY ', nday   &
             &                 ,'Julian day : ', zjulian  
@@ -168,16 +157,13 @@
             &                    ' limit storage in depth = ', ipk
 
-#if defined key_off_tra
-        ! WRITE root name in date.file for use by postpro
-         IF(lwp) THEN
-            CALL dia_nam( clhstnam, nwritetrc,' ' )
+         IF( lk_offline .AND. lwp ) THEN
+            CALL dia_nam( clhstnam, nn_writetrc,' ' )
             CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, narea )
             WRITE(inum,*) clhstnam
             CLOSE(inum)
          ENDIF
-#endif
 
          ! Define the NETCDF files for passive tracer concentration
-         CALL dia_nam( clhstnam, nwritetrc, 'ptrc_T' )
+         CALL dia_nam( clhstnam, nn_writetrc, 'ptrc_T' )
          IF(lwp)WRITE(numout,*)" Name of NETCDF file ", clhstnam
 
@@ -185,5 +171,5 @@
          CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,     &
             &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,         & 
-            &          nittrc000-ndttrc, zjulian, zdt, nhorit5, nit5 , domain_id=nidom)
+            &          iiter, zjulian, zdt, nhorit5, nit5 , domain_id=nidom, snc4chunks=snc4set)
 
          ! Vertical grid for tracer : gdept
@@ -206,5 +192,5 @@
 
          ! end netcdf files header
-         CALL histend( nit5 )
+         CALL histend( nit5, snc4set )
          IF(lwp) WRITE(numout,*)
          IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization in trcdit_wr'
@@ -216,5 +202,5 @@
       ! ---------------------------------------
 
-      IF( lwp .AND. MOD( itmod, nwritetrc ) == 0 ) THEN
+      IF( lwp .AND. MOD( itmod, nn_writetrc ) == 0 ) THEN
          WRITE(numout,*) 'trcdit_wr : write NetCDF passive tracer concentrations at ', kt, 'time-step'
          WRITE(numout,*) '~~~~~~~~~ '
@@ -233,235 +219,5 @@
    END SUBROUTINE trcdit_wr
 
-# if defined key_trc_diatrd
-
-   SUBROUTINE trcdid_wr( kt, kindic )
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE trcdid_wr  ***
-      !!
-      !! ** Purpose :   output of passive tracer : advection-diffusion trends
-      !!
-      !! ** Method  :   At the beginning of the first time step (nit000), define all
-      !!             the NETCDF files and fields for concentration of passive tracer
-      !!
-      !!        At each time step call histdef to compute the mean if necessary
-      !!        Each nwritetrd time step, output the instantaneous or mean fields
-      !!
-      !!        IF kindic <0, output of fields before the model interruption.
-      !!        IF kindic =0, time step loop
-      !!        IF kindic >0, output of fields before the time step loop
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt          ! ocean time-step
-      INTEGER, INTENT( in ) ::   kindic      ! indicator of abnormal termination
-      !!
-      LOGICAL ::   ll_print = .FALSE.
-      CHARACTER (len=40) ::   clhstnam, clop
-      CHARACTER (len=20) ::   cltra, cltrau
-      CHARACTER (len=80) ::   cltral
-      CHARACTER (len=10) ::   csuff
-      INTEGER  ::   jn, jl, ikn
-      INTEGER  ::   iimi, iima, ijmi, ijma, ipk, it, itmod
-      REAL(wp) ::   zsto, zout, zdt
-      !!----------------------------------------------------------------------
-
-      ! 0. Initialisation
-      ! -----------------
-      
-
-      ! local variable for debugging
-      ll_print = .FALSE.
-      ll_print = ll_print .AND. lwp
-      !
-      ! Define frequency of output and means
-      zdt = rdt
-      IF( ln_mskland )   THEN   ;   clop = "only(x)"   ! put 1.e+20 on land (very expensive!!)
-      ELSE                      ;   clop = "x"         ! no use of the mask value (require less cpu time)
-      ENDIF
-#  if defined key_diainstant
-      zsto = nwritetrd * rdt
-      clop = "inst("//TRIM(clop)//")"
-#  else
-      zsto = zdt
-      clop = "ave("//TRIM(clop)//")"
-#  endif
-      zout = nwritetrd * zdt
-
-      ! Define indices of the horizontal output zoom and vertical limit storage
-      iimi = 1      ;      iima = jpi
-      ijmi = 1      ;      ijma = jpj
-      ipk = jpk
-
-      ! define time axis
-      itmod = kt - nittrc000 + 1
-      it    = kt
-
-      ! Define the NETCDF files (one per tracer)
-      IF( ll_print ) WRITE(numout,*) 'trcdid kt=', kt, ' kindic ', kindic
-      
-      
-      IF( kt == nittrc000 ) THEN
-
-         DO jn = 1, jptra
-            !
-            IF( luttrd(jn) ) THEN      ! Define the file for dynamical trends - one per each tracer IF required
-
-               IF(lwp)WRITE(numout,*) ' indexes of zoom = ', iimi, iima, ijmi, ijma,  &
-                   &                   ' limit storage in depth = ', ipk
-               csuff='DY_'//ctrcnm(jn)
-               CALL dia_nam( clhstnam, nwritetrd, csuff )
-               IF(lwp)WRITE(numout,*)   " Name of NETCDF file for dynamical trends",   &
-                  &                     " of tracer number : ",clhstnam
-
-               CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,       &
-                  &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,   &
-                  &          nittrc000-ndttrc, zjulian, zdt, nhorit6(jn),  &
-                  &          nit6(jn) , domain_id=nidom )
-
-               ! Vertical grid for tracer trend - one per each tracer IF needed
-               CALL histvert( nit6(jn), 'deptht', 'Vertical T levels', 'm', ipk, gdept_0, ndepit6(jn) ) 
-             END IF
-          END DO
-
-          ! Declare all the output fields as NETCDF variables
-          DO jn = 1, jptra
-            IF( luttrd(jn) ) THEN
-                DO jl = 1, jpdiatrc
-                  IF( jl == jptrc_xad ) THEN
-                      ! short and long title for x advection for tracer
-                      WRITE (cltra,'("XAD_",16a)') ctrcnm(jn)
-                      WRITE (cltral,'("X advective trend for ",58a)') ctrcnl(jn)(1:58)
-                  END IF
-                  IF( jl == jptrc_yad ) THEN
-                      ! short and long title for y advection for tracer
-                      WRITE (cltra,'("YAD_",16a)') ctrcnm(jn)
-                      WRITE (cltral,'("Y advective trend for ",58a)') ctrcnl(jn)(1:58)
-                  END IF
-                  IF( jl == jptrc_zad ) THEN
-                      ! short and long title for Z advection for tracer
-                      WRITE (cltra,'("ZAD_",16a)') ctrcnm(jn)
-                      WRITE (cltral,'("Z advective trend for ",58a)') ctrcnl(jn)(1:58)
-                  END IF
-                  IF( jl == jptrc_xdf ) THEN
-                      ! short and long title for X diffusion for tracer
-                      WRITE (cltra,'("XDF_",16a)') ctrcnm(jn)
-                      WRITE (cltral,'("X diffusion trend for ",58a)') ctrcnl(jn)(1:58)
-                  END IF
-                  IF( jl == jptrc_ydf ) THEN
-                      ! short and long title for Y diffusion for tracer
-                      WRITE (cltra,'("YDF_",16a)') ctrcnm(jn)
-                      WRITE (cltral,'("Y diffusion trend for ",58a)') ctrcnl(jn)(1:58)
-                  END IF
-                  IF( jl == jptrc_zdf ) THEN
-                      ! short and long title for Z diffusion for tracer
-                      WRITE (cltra,'("ZDF_",16a)') ctrcnm(jn)
-                      WRITE (cltral,'("Z diffusion trend for ",58a)') ctrcnl(jn)(1:58)
-                  END IF
-# if defined key_trcldf_eiv
-                  IF( jl == jptrc_xei ) THEN
-                      ! short and long title for x gent velocity for tracer
-                      WRITE (cltra,'("XGV_",16a)') ctrcnm(jn)
-                      WRITE (cltral,'("X gent velocity trend for ",53a)') ctrcnl(jn)(1:53)
-                  END IF
-                  IF( jl == jptrc_yei ) THEN
-                      ! short and long title for y gent velocity for tracer
-                      WRITE (cltra,'("YGV_",16a)') ctrcnm(jn)
-                      WRITE (cltral,'("Y gent velocity trend for ",53a)') ctrcnl(jn)(1:53)
-                  END IF
-                  IF( jl == jptrc_zei ) THEN
-                      ! short and long title for Z gent velocity for tracer
-                      WRITE (cltra,'("ZGV_",16a)') ctrcnm(jn)
-                      WRITE (cltral,'("Z gent velocity trend for ",53a)') ctrcnl(jn)(1:53)
-                  END IF
-# endif
-# if defined key_trcdmp
-                  IF( jl == jptrc_dmp ) THEN
-                      ! last trends for tracer damping : short and long title
-                      WRITE (cltra,'("TDM_",16a)') ctrcnm(jn)
-                      WRITE (cltral,'("Tracer damping trend for ",55a)') ctrcnl(jn)(1:55)
-                  END IF
-# endif
-                  IF( jl == jptrc_sbc ) THEN
-                      ! last trends for tracer damping : short and long title
-                      WRITE (cltra,'("SBC_",16a)') ctrcnm(jn)
-                      WRITE (cltral,'("Surface boundary flux ",58a)') ctrcnl(jn)(1:55)
-                  END IF
-                      WRITE (cltral,'("Surface boundary flux ",58a)') ctrcnl(jn)(1:55)
-                  END IF
-                  CALL FLUSH( numout )
-                  cltrau = ctrcun(jn)      ! UNIT for tracer /trends
-                  CALL histdef( nit6(jn), cltra, cltral, cltrau, jpi,jpj,  &
-                     &          nhorit6(jn), ipk, 1, ipk,  ndepit6(jn), 32, clop ,  &
-                     &          zsto,zout )
-               END DO
-            END IF
-         END DO
-         ! CLOSE netcdf Files
-          DO jn = 1, jptra
-             IF( luttrd(jn) )   CALL histend( nit6(jn) )
-          END DO
-
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization in trcdid'
-         IF(ll_print) CALL FLUSH(numout )
-         !
-      ENDIF
-
-      ! SOME diagnostics to DO first time
-
-      ! Start writing data
-      ! ---------------------
-
-      ! trends for tracer concentrations
-
-      IF( lwp .AND. MOD( itmod, nwritetrd ) == 0 ) THEN
-         WRITE(numout,*) 'trcdid_wr : write NetCDF dynamical trends at ', kt, 'time-step'
-         WRITE(numout,*) '~~~~~~ '
-      ENDIF
-
-      DO jn = 1, jptra
-         IF( luttrd(jn) ) THEN
-            ikn = ikeep(jn) 
-            DO jl = 1, jpdiatrc
-               ! short titles
-               IF( jl == jptrc_xad)   WRITE (cltra,'("XAD_",16a)') ctrcnm(jn)
-               IF( jl == jptrc_yad)   WRITE (cltra,'("YAD_",16a)') ctrcnm(jn)
-               IF( jl == jptrc_zad)   WRITE (cltra,'("ZAD_",16a)') ctrcnm(jn)
-               IF( jl == jptrc_xdf)   WRITE (cltra,'("XDF_",16a)') ctrcnm(jn)
-               IF( jl == jptrc_ydf)   WRITE (cltra,'("YDF_",16a)') ctrcnm(jn)
-               IF( jl == jptrc_zdf)   WRITE (cltra,'("ZDF_",16a)') ctrcnm(jn)
-# if defined key_trcldf_eiv
-               IF( jl == jptrc_xei)   WRITE (cltra,'("XGV_",16a)') ctrcnm(jn)
-               IF( jl == jptrc_yei)   WRITE (cltra,'("YGV_",16a)') ctrcnm(jn)
-               IF( jl == jptrc_zei)   WRITE (cltra,'("ZGV_",16a)') ctrcnm(jn)
-# endif
-# if defined key_trcdmp
-               IF( jl == jptrc_dmp )  WRITE (cltra,'("TDM_",16a)') ctrcnm(jn)
-# endif
-               IF( jl == jptrc_sbc )  WRITE (cltra,'("SBC_",16a)') ctrcnm(jn)
-               !
-               CALL histwrite(nit6(jn), cltra, it, trtrd(:,:,:,ikn,jl),ndimt50, ndext50)
-            END DO
-         END IF
-      END DO
-
-      ! Closing all files
-      ! -----------------
-      IF( kt == nitend .OR. kindic < 0 ) THEN
-         DO jn = 1, jptra
-            IF( luttrd(jn) )   CALL histclo( nit6(jn) )
-         END DO
-      ENDIF
-      !
-
-   END SUBROUTINE trcdid_wr
-
-# else
-
-   SUBROUTINE trcdid_wr( kt, kindic )                      ! Dummy routine
-      INTEGER, INTENT ( in ) ::   kt, kindic
-   END SUBROUTINE trcdid_wr
-
-# endif
-
-#if defined key_trc_diaadd
+#if defined key_diatrc
 
    SUBROUTINE trcdii_wr( kt, kindic )
@@ -489,5 +245,5 @@
       CHARACTER (len=80) ::   cltral
       INTEGER  ::   jl
-      INTEGER  ::   iimi, iima, ijmi, ijma, ipk, it, itmod
+      INTEGER  ::   iimi, iima, ijmi, ijma, ipk, it, itmod, iiter
       REAL(wp) ::   zsto, zout, zdt
       !!----------------------------------------------------------------------
@@ -506,5 +262,5 @@
       ENDIF
 #  if defined key_diainstant
-      zsto = nwritedia * zdt
+      zsto = nn_writedia * zdt
       clop = "inst("//TRIM(clop)//")"
 #  else
@@ -512,5 +268,5 @@
       clop = "ave("//TRIM(clop)//")"
 #  endif
-      zout = nwritedia * zdt
+      zout = nn_writedia * zdt
 
       ! Define indices of the horizontal output zoom and vertical limit storage
@@ -520,6 +276,7 @@
 
       ! define time axis
-      itmod = kt - nittrc000 + 1
+      itmod = kt - nit000 + 1
       it    = kt
+      iiter = ( nit000 - 1 ) / nn_dttrc
 
       ! 1. Define NETCDF files and fields at beginning of first time step
@@ -528,5 +285,5 @@
       IF( ll_print ) WRITE(numout,*) 'trcdii_wr kt=', kt, ' kindic ', kindic
 
-      IF( kt == nittrc000 ) THEN
+      IF( kt == nit000 ) THEN
 
          ! Define the NETCDF files for additional arrays : 2D or 3D
@@ -534,5 +291,5 @@
          ! Define the T grid file for tracer auxiliary files
 
-         CALL dia_nam( clhstnam, nwritedia, 'diad_T' )
+         CALL dia_nam( clhstnam, nn_writedia, 'diad_T' )
          IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam
 
@@ -541,5 +298,5 @@
          CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,             &
             &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,         &
-            &          nittrc000-ndttrc, zjulian, zdt, nhoritd, nitd , domain_id=nidom )
+            &          iiter, zjulian, zdt, nhoritd, nitd , domain_id=nidom, snc4chunks=snc4set )
 
          ! Vertical grid for 2d and 3d arrays
@@ -570,5 +327,5 @@
 
          ! CLOSE netcdf Files
-         CALL histend( nitd )
+         CALL histend( nitd, snc4set )
 
          IF(lwp) WRITE(numout,*)
@@ -581,5 +338,5 @@
       ! ---------------------
 
-      IF( lwp .AND. MOD( itmod, nwritedia ) == 0 ) THEN
+      IF( lwp .AND. MOD( itmod, nn_writedia ) == 0 ) THEN
          WRITE(numout,*) 'trcdii_wr : write NetCDF additional arrays at ', kt, 'time-step'
          WRITE(numout,*) '~~~~~~ '
@@ -606,12 +363,10 @@
 
 # else
-
    SUBROUTINE trcdii_wr( kt, kindic )                      ! Dummy routine
       INTEGER, INTENT ( in ) :: kt, kindic
    END SUBROUTINE trcdii_wr
-
 # endif
 
-# if defined key_trc_diabio
+# if defined key_diabio
 
    SUBROUTINE trcdib_wr( kt, kindic )
@@ -631,5 +386,4 @@
       !!        IF kindic >0, output of fields before the time step loop
       !!----------------------------------------------------------------------
-      !!
       INTEGER, INTENT( in ) ::   kt          ! ocean time-step
       INTEGER, INTENT( in ) ::   kindic      ! indicator of abnormal termination
@@ -640,5 +394,5 @@
       CHARACTER (len=80) ::   cltral
       INTEGER  ::   ji, jj, jk, jl
-      INTEGER  ::   iimi, iima, ijmi, ijma, ipk, it, itmod
+      INTEGER  ::   iimi, iima, ijmi, ijma, ipk, it, itmod, iiter
       REAL(wp) ::   zsto, zout, zdt
       !!----------------------------------------------------------------------
@@ -658,5 +412,5 @@
       ENDIF
 #        if defined key_diainstant
-      zsto = nwritebio * zdt
+      zsto = nn_writebio * zdt
       clop = "inst("//TRIM(clop)//")"
 #        else
@@ -664,5 +418,5 @@
       clop = "ave("//TRIM(clop)//")"
 #        endif
-      zout = nwritebio * zdt
+      zout = nn_writebio * zdt
 
       ! Define indices of the horizontal output zoom and vertical limit storage
@@ -672,6 +426,7 @@
 
       ! define time axis
-      itmod = kt - nittrc000 + 1
+      itmod = kt - nit000 + 1
       it    = kt
+      iiter = ( nit000 - 1 ) / nn_dttrc
 
       ! Define NETCDF files and fields at beginning of first time step
@@ -680,14 +435,14 @@
       IF(ll_print) WRITE(numout,*)'trcdib_wr kt=',kt,' kindic ',kindic
 
-      IF( kt == nittrc000 ) THEN
+      IF( kt == nit000 ) THEN
 
          ! Define the NETCDF files for biological trends
 
-         CALL dia_nam(clhstnam,nwritebio,'biolog')
+         CALL dia_nam(clhstnam,nn_writebio,'biolog')
          IF(lwp)WRITE(numout,*) " Name of NETCDF file for biological trends ", clhstnam
          ! Horizontal grid : glamt and gphit
          CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,      &
             &    iimi, iima-iimi+1, ijmi, ijma-ijmi+1,          &
-            &    nittrc000-ndttrc, zjulian, zdt, nhoritb, nitb , domain_id=nidom )
+            &    iiter, zjulian, zdt, nhoritb, nitb , domain_id=nidom, snc4chunks=snc4set )
          ! Vertical grid for biological trends
          CALL histvert(nitb, 'deptht', 'Vertical T levels', 'm', ipk, gdept_0, ndepitb)
@@ -704,5 +459,5 @@
 
          ! CLOSE netcdf Files
-          CALL histend( nitb )
+          CALL histend( nitb, snc4set )
 
          IF(lwp) WRITE(numout,*)
@@ -716,5 +471,5 @@
 
       ! biological trends
-      IF( lwp .AND. MOD( itmod, nwritebio ) == 0 ) THEN
+      IF( lwp .AND. MOD( itmod, nn_writebio ) == 0 ) THEN
          WRITE(numout,*) 'trcdit_wr : write NetCDF biological trends at ', kt, 'time-step'
          WRITE(numout,*) '~~~~~~ '
@@ -749,5 +504,4 @@
       INTEGER, INTENT(in) :: kt
    END SUBROUTINE trc_dia   
-
 #endif
 
Index: trunk/NEMOGCM/NEMO/TOP_SRC/trcdta.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/trcdta.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/trcdta.F90	(revision 2528)
@@ -36,15 +36,10 @@
 #  include "top_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
-   !!----------------------------------------------------------------------
-   !!   Default case                                            NetCDF file
-   !!----------------------------------------------------------------------
-   
    SUBROUTINE trc_dta( kt )
       !!----------------------------------------------------------------------
@@ -63,9 +58,10 @@
       !!
       CHARACTER (len=39) ::   clname(jptra)
-      INTEGER, PARAMETER ::   &
-         jpmonth = 12    ! number of months
+      INTEGER, PARAMETER ::   jpmonth = 12    ! number of months
       INTEGER ::   ji, jj, jn, jl 
       INTEGER ::   imois, iman, i15, ik  ! temporary integers 
       REAL(wp) ::   zxy, zl
+!!gm HERE the daymod should be used instead of computation of month and co !!
+!!gm      better in case of real calandar and leap-years !
       !!----------------------------------------------------------------------
 
@@ -74,5 +70,5 @@
          IF( lutini(jn) ) THEN 
 
-            IF ( kt == nittrc000 ) THEN
+            IF ( kt == nit000 ) THEN
                !! 3D tracer data
                IF(lwp)WRITE(numout,*)
@@ -92,5 +88,5 @@
             ! --------------------
 
-            IF ( kt == nittrc000 .AND. nlectr(jn) == 0 ) THEN
+            IF ( kt == nit000 .AND. nlectr(jn) == 0 ) THEN
                ntrc1(jn) = 0
                IF(lwp) WRITE(numout,*) ' trc_dta : Levitus tracer data monthly fields'
@@ -107,5 +103,5 @@
 # if defined key_pisces
             ! Read montly file
-            IF( ( kt == nittrc000 .AND. nlectr(jn) == 0)  .OR. imois /= ntrc1(jn) ) THEN
+            IF( ( kt == nit000 .AND. nlectr(jn) == 0)  .OR. imois /= ntrc1(jn) ) THEN
                nlectr(jn) = 1
 
@@ -142,5 +138,5 @@
                      DO jj = 1, jpj                ! interpolation of temperature at the last level
                         DO ji = 1, jpi
-                           ik = mbathy(ji,jj) - 1
+                           ik = mbkt(ji,jj)
                            IF( ik > 2 ) THEN
                               zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) )
@@ -189,5 +185,5 @@
 # else
             ! Read init file only
-            IF( kt == nittrc000  ) THEN
+            IF( kt == nit000  ) THEN
                ntrc1(jn) = 1
                CALL iom_get ( numtr(jn), jpdom_data, ctrcnm(jn), trdta(:,:,:,jn), ntrc1(jn) )
@@ -196,5 +192,4 @@
             ENDIF 
 # endif
-
          ENDIF
 
Index: trunk/NEMOGCM/NEMO/TOP_SRC/trcini.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/trcini.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/trcini.F90	(revision 2528)
@@ -14,12 +14,10 @@
    !!----------------------------------------------------------------------
    !!----------------------------------------------------------------------
-   !!   trc_ini :   Initialization for passive tracer
+   !!   trc_init :   Initialization for passive tracer
    !!----------------------------------------------------------------------
    USE oce_trc
    USE trc
-   USE trp_trc
    USE trcrst
-   USE trcctl
-   USE trclec
+   USE trcnam          ! Namelist read
    USE trcini_cfc      ! CFC      initialisation
    USE trcini_lobster  ! LOBSTER  initialisation
@@ -28,30 +26,26 @@
    USE trcini_my_trc   ! MY_TRC   initialisation
    USE trcdta   
-#if defined key_off_tra 
+#if defined key_offline
    USE daymod
 #endif
-   USE zpshde_trc      ! partial step: hor. derivative 
+   USE zpshde          ! partial step: hor. derivative   (zps_hde routine)
    USE in_out_manager  ! I/O manager
    USE prtctl_trc      ! Print control passive tracers (prt_ctl_trc_init routine)
    USE lib_mpp         ! distributed memory computing library
+   USE lib_fortran     ! 
    
    IMPLICIT NONE
    PRIVATE
    
-   PUBLIC   trc_ini   ! called by opa
+   PUBLIC   trc_init   ! called by opa
 
     !! * Substitutions
 #  include "domzgr_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
   
 CONTAINS
    
-   SUBROUTINE trc_ini
+   SUBROUTINE trc_init
       !!---------------------------------------------------------------------
-      !!                     ***  ROUTINE trc_ini  ***
+      !!                     ***  ROUTINE trc_init  ***
       !!
       !! ** Purpose :   Initialization of the passive tracer fields 
@@ -69,23 +63,38 @@
 
       IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'trc_ini : initial set up of the passive tracers'
+      IF(lwp) WRITE(numout,*) 'trc_init : initial set up of the passive tracers'
       IF(lwp) WRITE(numout,*) '~~~~~~~'
 
       !                 ! masked grid volume
       DO jk = 1, jpk
-         cvol(:,:,jk) = e1t(:,:) * e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:)
+         cvol(:,:,jk) = e1t(:,:) * e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk) 
       END DO
 
       ! total volume of the ocean
-#if ! defined key_off_degrad
-      areatot = SUM( cvol(:,:,:) )
+#if ! defined key_degrad
+      areatot = glob_sum( cvol(:,:,:) )
 #else
-      areatot = SUM( cvol(:,:,:) * facvol(:,:,:) ) ! degrad option: reduction by facvol
+      areatot = glob_sum( cvol(:,:,:) * facvol(:,:,:) )  ! degrad option: reduction by facvol
 #endif
-      IF( lk_mpp )   CALL mpp_sum( areatot )     ! sum over the global domain  
 
-                                  CALL trc_lec      ! READ passive tracers namelists
+                                  CALL trc_nam      ! read passive tracers namelists
 
-                                  CALL trc_ctl      ! control consistency between parameters, cpp key
+      ! restart for passive tracer (input)
+      IF( ln_rsttr ) THEN
+         IF(lwp) WRITE(numout,*) '       read a restart file for passive tracer : ', cn_trcrst_in
+         IF(lwp) WRITE(numout,*) ' '
+      ELSE
+         IF(lwp) WRITE(numout,*)
+         DO jn = 1, jptra
+            IF( lwp .AND. lutini(jn) )  &                  ! open input FILE only IF lutini(jn) is true
+            &  WRITE(numout,*) '        read an initial file  for passive tracer number :', jn, ' traceur : ', ctrcnm(jn) 
+         END DO
+      ENDIF
+
+      IF( ln_dm2dc .AND. ( lk_pisces .OR. lk_lobster ) )    &
+         &       CALL ctl_stop( ' The diurnal cycle is not compatible with PISCES or LOBSTER  ' )
+
+      IF( nn_cla == 1 )   &
+         &       CALL ctl_stop( ' Cross Land Advection not yet implemented with passive tracer ; nn_cla must be 0' )
 
       IF( lk_lobster ) THEN   ;   CALL trc_ini_lobster      ! LOBSTER bio-model
@@ -109,26 +118,28 @@
       ENDIF
 
-      IF( .NOT. ln_rsttr ) THEN 
-#if defined key_off_tra
-         CALL day_init      ! calendar
-#endif
-# if defined key_dtatrc
-         ! Initialization of tracer from a file that may also be used for damping
-         CALL trc_dta( nittrc000 )
-         DO jn = 1, jptra
-            IF( lutini(jn) )   trn(:,:,:,jn) = trdta(:,:,:,jn) * tmask(:,:,:)   ! initialisation from file if required
-         END DO
-# endif
-         trb(:,:,:,:) = trn(:,:,:,:)
+      IF( ln_rsttr ) THEN
+        !
+        IF( lk_offline )  neuler = 1   ! Set time-step indicator at nit000 (leap-frog)
+        CALL trc_rst_read              ! restart from a file
+        !
       ELSE
-         !
-         CALL trc_rst_read      ! restart from a file
-         !
+        IF( lk_offline )  THEN
+           neuler = 0                  ! Set time-step indicator at nit000 (euler)
+           CALL day_init               ! set calendar
+        ENDIF
+        IF( lk_dtatrc )  THEN
+           CALL trc_dta( nit000 )      ! Initialization of tracer from a file that may also be used for damping
+           DO jn = 1, jptra
+              IF( lutini(jn) )   trn(:,:,:,jn) = trdta(:,:,:,jn) * tmask(:,:,:)   ! initialisation from file if required
+           END DO
+        ENDIF 
+        trb(:,:,:,:) = trn(:,:,:,:)
+        ! 
       ENDIF
-
+ 
       tra(:,:,:,:) = 0.
       
-      IF( ln_zps .AND. .NOT. lk_trc_c1d )   &              ! Partial steps: before horizontal gradient of passive
-      &                     CALL zps_hde_trc( nittrc000, trb, gtru, gtrv )       ! tracers at the bottom ocean level
+      IF( ln_zps .AND. .NOT. lk_c1d )   &              ! Partial steps: before horizontal gradient of passive
+      &                     CALL zps_hde( nit000, jptra, trn, gtru, gtrv )       ! tracers at the bottom ocean level
 
 
@@ -136,12 +147,10 @@
       trai = 0.e0
       DO jn = 1, jptra
-#if ! defined key_off_degrad
-         trai = trai + SUM( trn(:,:,:,jn) * cvol(:,:,:) )
+#if ! defined key_degrad
+         trai = trai + glob_sum( trn(:,:,:,jn) * cvol(:,:,:) )
 #else
-         trai = trai + SUM( trn(:,:,:,jn) * cvol(:,:,:) * facvol(:,:,:) ) ! degrad option: reduction by facvol
+         trai = trai + glob_sum( trn(:,:,:,jn) * cvol(:,:,:) * facvol(:,:,:) ) ! degrad option: reduction by facvol
 #endif
       END DO      
-      IF( lk_mpp )   CALL mpp_sum( trai )     ! sum over the global domain  
-
 
       !                 ! control print
@@ -162,5 +171,5 @@
       ENDIF
 
-   END SUBROUTINE trc_ini
+   END SUBROUTINE trc_init
 
 #else
@@ -169,8 +178,12 @@
    !!----------------------------------------------------------------------
 CONTAINS
-   SUBROUTINE trc_ini                      ! Dummy routine   
-   END SUBROUTINE trc_ini
+   SUBROUTINE trc_init                      ! Dummy routine   
+   END SUBROUTINE trc_init
 #endif
 
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!======================================================================
 END MODULE trcini
Index: trunk/NEMOGCM/NEMO/TOP_SRC/trclec.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/trclec.F90	(revision 2527)
+++ 	(revision )
@@ -1,238 +1,0 @@
-MODULE trclec
-   !!======================================================================
-   !!                       ***  MODULE trclec  ***
-   !! TOP :   Read and print options for the passive tracer run (namelist)
-   !!======================================================================
-   !! History :    -   !  1996-11  (M.A. Foujols, M. Levy)  original code
-   !!              -   !  1998-04  (M.A Foujols, L. Bopp) ahtrb0 for isopycnal mixing
-   !!              -   !  1999-10  (M.A. Foujols, M. Levy) separation of sms
-   !!              -   !  2000-07  (A. Estublier) add TVD and MUSCL : Tests on ndttrc
-   !!              -   !  2000-11  (M.A Foujols, E Kestenare) trcrat, ahtrc0 and aeivtr0
-   !!              -   !  2001-01 (E Kestenare) suppress ndttrc=1 for CEN2 and TVD schemes
-   !!             1.0  !  2005-03 (O. Aumont, A. El Moussaoui) F90
-   !!----------------------------------------------------------------------
-#if defined key_top
-   !!----------------------------------------------------------------------
-   !!   'key_top'                                                TOP models
-   !!----------------------------------------------------------------------
-   !!   trc_lec    :  Read and print options for the passive tracer run (namelist)
-   !!----------------------------------------------------------------------
-   USE oce_trc
-   USE trc
-   USE trp_trc
-   USE trctrp_lec
-   USE trclsm_lobster    ! LOBSTER namelist
-   USE trclsm_pisces     ! PISCES namelist
-   USE trclsm_cfc        ! CFC SMS namelist
-   USE trclsm_c14b       ! C14 SMS namelist
-   USE trclsm_my_trc     ! MY_TRC SMS namelist
-   USE in_out_manager    ! I/O manager
-   USE trdmld_trc_oce
-
-   IMPLICIT NONE
-   PRIVATE 
-
-   PUBLIC trc_lec      ! called in ???
-
-   !! * Substitutions
-#  include "top_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE trc_lec
-      !!---------------------------------------------------------------------
-      !!                     ***  ROUTINE trc_lec  ***
-      !!
-      !! ** Purpose :   READ and PRINT options for the passive tracer run (namelist) 
-      !!
-      !! ** Method  : - read passive tracer namelist 
-      !!              - read namelist of each defined SMS model
-      !!                ( (LOBSTER, PISCES, CFC, MY_TRC )
-      !!---------------------------------------------------------------------
-      INTEGER ::  jn
-
-      ! Definition of a tracer as a structure
-      TYPE PTRACER
-         CHARACTER(len = 20)  :: sname  !: short name
-         CHARACTER(len = 80 ) :: lname  !: long name
-         CHARACTER(len = 20 ) :: unit   !: unit
-         LOGICAL              :: lini   !: read in a file or not
-         LOGICAL              :: lsav   !: ouput the tracer or not 
-      END TYPE PTRACER
-
-      TYPE(PTRACER) , DIMENSION(jptra) :: tracer
-
-      !!
-      NAMELIST/namtoptrc/ ndttrc, nwritetrc, ln_rsttr, nrsttr, &
-                          cn_trcrst_in, cn_trcrst_out, tracer
-#if defined key_trdmld_trc || defined key_trc_diatrd
-      NAMELIST/namtoptrd/ ntrd_trc, nctls_trc, ucf_trc, &
-                         ln_trdmld_trc_restart, ln_trdmld_trc_instant, &
-                         cn_trdrst_trc_in, cn_trdrst_trc_out, luttrd
-#endif
-
-      !!---------------------------------------------------------------------
-
-      IF(lwp) WRITE(numout,*) 'trc_lec : read the passive tracer namelists'
-      IF(lwp) WRITE(numout,*) '~~~~~~~'
-
-      CALL ctl_opn( numnat, 'namelist_top', 'OLD', 'FORMATTED', 'SEQUENTIAL', 1, numout, .FALSE. )
-
-      ! Namelist nattrc (files)
-      ! ----------------------------------------------
-      ndttrc    = 1                 ! default values
-      nwritetrc = 10      
-      ln_rsttr    = .FALSE.
-      nrsttr    =  0
-      cn_trcrst_in  = 'restart_trc'
-      cn_trcrst_out = 'restart_trc'
-      DO jn = 1, jptra
-         WRITE(ctrcnm(jn),'("TR_",I1)'           ) jn
-         WRITE(ctrcnl(jn),'("TRACER NUMBER ",I1)') jn
-         ctrcun(jn) = 'mmole/m3'
-         lutini(jn) = .FALSE. 
-         lutsav(jn) = .TRUE.
-      END DO
-
-      REWIND( numnat )               ! read nattrc
-      READ  ( numnat, namtoptrc )
-
-      !!Chris  computes the first time step of tracer model
-      nittrc000 = nit000 + ndttrc - 1
-
-      DO jn = 1, jptra
-         ctrcnm(jn) = tracer(jn)%sname
-         ctrcnl(jn) = tracer(jn)%lname
-         ctrcun(jn) = tracer(jn)%unit
-         lutini(jn) = tracer(jn)%lini
-         lutsav(jn) = tracer(jn)%lsav
-      END DO
-
-
-      IF(lwp) THEN                   ! control print
-         WRITE(numout,*)
-         WRITE(numout,*) ' Namelist : namtoptrc'
-         WRITE(numout,*) '    time step freq. for pass. trac. ndttrc             = ', ndttrc
-         WRITE(numout,*) '    1st time step for pass. trac. nittrc000            = ', nittrc000
-         WRITE(numout,*) '    frequency of outputs for passive tracers nwritetrc = ', nwritetrc  
-         WRITE(numout,*) '    restart LOGICAL for passive tr. ln_rsttr           = ', ln_rsttr
-         WRITE(numout,*) '    control of time step for p. tr. nrsttr             = ', nrsttr
-         WRITE(numout,*) ' '
-         DO jn = 1, jptra
-            WRITE(numout,*) '   tracer nb             : ', jn 
-            WRITE(numout,*) '   short name            : ', TRIM(ctrcnm(jn))
-            WRITE(numout,*) '   long name             : ', TRIM(ctrcnl(jn))
-            WRITE(numout,*) '   unit                  : ', TRIM(ctrcun(jn))
-            WRITE(numout,*) '   initial value in FILE : ', lutini(jn) 
-            WRITE(numout,*) '   output of tracer      : ', lutsav(jn)
-            WRITE(numout,*) ' '
-         END DO
-      ENDIF
-
-#if defined key_trdmld_trc || defined key_trc_diatrd
-
-      ! Namelist natrtd (transport trends)
-      ! ----------------------------------------------
-      ntrd_trc  = 20
-      nctls_trc =  6
-      ucf_trc   =  1.
-      ln_trdmld_trc_instant = .TRUE.
-      ln_trdmld_trc_restart =.FALSE.
-      cn_trdrst_trc_in  = "restart_mld_trc"
-      cn_trdrst_trc_out = "restart_mld_trc"
-      DO jn = 1, jptra
-         luttrd(jn) = .FALSE.
-      END DO
-
-      REWIND( numnat )               !  namelist namtoptrd : passive tracer trends diagnostic
-      READ  ( numnat, namtoptrd )
-
-#if defined key_trc_diatrd
-      nkeep    = 0
-      ikeep(:) = 0
-      DO jn = 1, jptra
-         IF( luttrd(jn) ) THEN 
-             nkeep     = nkeep + 1
-             ikeep(jn) = nkeep
-         END IF 
-      END DO
-      IF( nkeep > 0 ) THEN  
-        IF(.NOT. ALLOCATED( trtrd ) )   ALLOCATE( trtrd(jpi,jpj,jpk,nkeep,jpdiatrc) ) 
-        trtrd(:,:,:,:,:) = 0.e0
-      ENDIF 
-
-      nwritetrd = ntrd_trc
-#endif
-
-     IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) ' trd_mld_trc_init : read namelist namtoptrd                        '
-         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~                                               '
-         WRITE(numout,*) '   * frequency of trends diagnostics   ntrd_trc               = ', ntrd_trc
-         WRITE(numout,*) '   * control surface type              nctls_trc              = ', nctls_trc
-         WRITE(numout,*) '   * restart for ML diagnostics        ln_trdmld_trc_restart  = ', ln_trdmld_trc_restart
-         WRITE(numout,*) '   * flag to diagnose trends of                                 '
-         WRITE(numout,*) '     instantantaneous or mean ML T/S   ln_trdmld_trc_instant  = ', ln_trdmld_trc_instant
-         WRITE(numout,*) '   * unit conversion factor            ucf_trc                = ', ucf_trc
-#if defined key_trdmld_trc
-         DO jn = 1, jptra
-            WRITE(numout,*) '    keep dynamical trends for tracer number :', jn, luttrd(jn)
-         END DO
-#else
-         DO jn = 1, jptra
-            WRITE(numout,*) '    keep dynamical trends for tracer number :', jn, luttrd(jn), ikeep(jn)
-         END DO
-
-         WRITE(numout,*)
-         WRITE(numout,*) '    total = ', nkeep, ' tracers dyn trends saved'
-         WRITE(numout,*) '    size of trtrd = ', jpi*jpj*jpk*nkeep*jpdiatrc
-#endif
-      ENDIF
-
-#endif
-
-
-      ! namelist of transport
-      ! ---------------------
-      CALL trc_trp_lec
-
-      ! namelist of SMS
-      ! ---------------      
-      IF( lk_lobster ) THEN   ;   CALL trc_lsm_lobster      ! LOBSTER bio-model
-      ELSE                    ;   IF(lwp) WRITE(numout,*) '          LOBSTER not used'
-      ENDIF
-
-      IF( lk_pisces  ) THEN   ;   CALL trc_lsm_pisces      ! PISCES  bio-model
-      ELSE                    ;   IF(lwp) WRITE(numout,*) '          PISCES not used'
-      ENDIF
-
-      IF( lk_cfc     ) THEN   ;   CALL trc_lsm_cfc         ! CFC     tracers
-      ELSE                    ;   IF(lwp) WRITE(numout,*) '          CFC not used'
-      ENDIF
-
-      IF( lk_c14b     ) THEN   ;   CALL trc_lsm_c14b         ! C14 bomb     tracers
-      ELSE                    ;   IF(lwp) WRITE(numout,*) '          C14 not used'
-      ENDIF
-
-      IF( lk_my_trc  ) THEN   ;   CALL trc_lsm_my_trc      ! MY_TRC  tracers
-      ELSE                    ;   IF(lwp) WRITE(numout,*) '          MY_TRC not used'
-      ENDIF
-      !
-   END SUBROUTINE trc_lec
-
-#else
-   !!----------------------------------------------------------------------
-   !!  Dummy module :                                     No passive tracer
-   !!----------------------------------------------------------------------
-CONTAINS
-   SUBROUTINE trc_lec                      ! Empty routine   
-   END SUBROUTINE trc_lec
-#endif
-
-   !!======================================================================
-END MODULE  trclec
Index: trunk/NEMOGCM/NEMO/TOP_SRC/trcnam.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/trcnam.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/trcnam.F90	(revision 2528)
@@ -0,0 +1,209 @@
+MODULE trcnam
+   !!======================================================================
+   !!                       ***  MODULE trcnam  ***
+   !! TOP :   Read and print options for the passive tracer run (namelist)
+   !!======================================================================
+   !! History :    -   !  1996-11  (M.A. Foujols, M. Levy)  original code
+   !!              -   !  1998-04  (M.A Foujols, L. Bopp) ahtrb0 for isopycnal mixing
+   !!              -   !  1999-10  (M.A. Foujols, M. Levy) separation of sms
+   !!              -   !  2000-07  (A. Estublier) add TVD and MUSCL : Tests on ndttrc
+   !!              -   !  2000-11  (M.A Foujols, E Kestenare) trcrat, ahtrc0 and aeivtr0
+   !!              -   !  2001-01 (E Kestenare) suppress ndttrc=1 for CEN2 and TVD schemes
+   !!             1.0  !  2005-03 (O. Aumont, A. El Moussaoui) F90
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_nam    :  Read and print options for the passive tracer run (namelist)
+   !!----------------------------------------------------------------------
+   USE oce_trc
+   USE trc
+   USE trcnam_trp        ! Transport namelist
+   USE trcnam_lobster    ! LOBSTER namelist
+   USE trcnam_pisces     ! PISCES namelist
+   USE trcnam_cfc        ! CFC SMS namelist
+   USE trcnam_c14b       ! C14 SMS namelist
+   USE trcnam_my_trc     ! MY_TRC SMS namelist
+   USE in_out_manager    ! I/O manager
+   USE trdmod_trc_oce
+
+   IMPLICIT NONE
+   PRIVATE 
+
+   PUBLIC trc_nam      ! called in trcini
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_nam
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_nam  ***
+      !!
+      !! ** Purpose :   READ and PRINT options for the passive tracer run (namelist) 
+      !!
+      !! ** Method  : - read passive tracer namelist 
+      !!              - read namelist of each defined SMS model
+      !!                ( (LOBSTER, PISCES, CFC, MY_TRC )
+      !!---------------------------------------------------------------------
+      INTEGER ::  jn
+
+      ! Definition of a tracer as a structure
+      TYPE PTRACER
+         CHARACTER(len = 20)  :: clsname  !: short name
+         CHARACTER(len = 80 ) :: cllname  !: long name
+         CHARACTER(len = 20 ) :: clunit   !: unit
+         LOGICAL              :: llinit   !: read in a file or not
+         LOGICAL              :: llsave   !: save the tracer or not
+      END TYPE PTRACER
+
+      TYPE(PTRACER) , DIMENSION(jptra) :: sn_tracer
+
+      !!
+      NAMELIST/namtrc/    nn_dttrc, nn_writetrc, ln_rsttr, nn_rsttr, &
+                          cn_trcrst_in, cn_trcrst_out, sn_tracer
+#if defined key_trdmld_trc  || defined key_trdtrc
+      NAMELIST/namtrc_trd/ nn_trd_trc, nn_ctls_trc, rn_ucf_trc, &
+                         ln_trdmld_trc_restart, ln_trdmld_trc_instant, &
+                         cn_trdrst_trc_in, cn_trdrst_trc_out, ln_trdtrc
+#endif
+
+      !!---------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*) 'trc_nam : read the passive tracer namelists'
+      IF(lwp) WRITE(numout,*) '~~~~~~~'
+
+      CALL ctl_opn( numnat, 'namelist_top', 'OLD', 'FORMATTED', 'SEQUENTIAL', 1, numout, .FALSE. )
+
+      ! Namelist nattrc (files)
+      ! ----------------------------------------------
+      nn_dttrc    = 1                 ! default values
+      nn_writetrc = 10      
+      ln_rsttr    = .FALSE.
+      nn_rsttr    =  0
+      cn_trcrst_in  = 'restart_trc'
+      cn_trcrst_out = 'restart_trc'
+      DO jn = 1, jptra
+         WRITE(ctrcnm(jn),'("TR_",I1)'           ) jn
+         WRITE(ctrcnl(jn),'("TRACER NUMBER ",I1)') jn
+         ctrcun(jn) = 'mmole/m3'
+         lutini(jn) = .FALSE. 
+         lutsav(jn) = .TRUE. 
+      END DO
+
+      REWIND( numnat )               ! read nattrc
+      READ  ( numnat, namtrc )
+
+      DO jn = 1, jptra
+         ctrcnm(jn) = sn_tracer(jn)%clsname
+         ctrcnl(jn) = sn_tracer(jn)%cllname
+         ctrcun(jn) = sn_tracer(jn)%clunit
+         lutini(jn) = sn_tracer(jn)%llinit
+         lutsav(jn) = sn_tracer(jn)%llsave
+      END DO
+
+
+      IF(lwp) THEN                   ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) ' Namelist : namtrc'
+         WRITE(numout,*) '    time step freq. for pass. trac. nn_dttrc             = ', nn_dttrc
+         WRITE(numout,*) '    frequency of outputs for passive tracers nn_writetrc = ', nn_writetrc  
+         WRITE(numout,*) '    restart LOGICAL for passive tr. ln_rsttr             = ', ln_rsttr
+         WRITE(numout,*) '    control of time step for p. tr. nn_rsttr             = ', nn_rsttr
+         WRITE(numout,*) ' '
+         DO jn = 1, jptra
+            WRITE(numout,*) '   tracer nb             : ', jn 
+            WRITE(numout,*) '   short name            : ', TRIM(ctrcnm(jn))
+            WRITE(numout,*) '   long name             : ', TRIM(ctrcnl(jn))
+            WRITE(numout,*) '   unit                  : ', TRIM(ctrcun(jn))
+            WRITE(numout,*) '   initial value in FILE : ', lutini(jn) 
+            WRITE(numout,*) ' '
+         END DO
+      ENDIF
+
+      rdttrc(:) = rdttra(:) * FLOAT( nn_dttrc )   ! vertical profile of passive tracer time-step
+  
+      IF(lwp) WRITE(numout,*) 
+      IF(lwp) WRITE(numout,*) '    Passive Tracer  time step    rdttrc  = ', rdttrc(1)
+      IF(lwp) WRITE(numout,*) 
+
+#if defined key_trdmld_trc || defined key_trdtrc
+      nn_trd_trc  = 20
+      nn_ctls_trc =  9
+      rn_ucf_trc   =  1.
+      ln_trdmld_trc_instant = .TRUE.
+      ln_trdmld_trc_restart =.FALSE.
+      cn_trdrst_trc_in  = "restart_mld_trc"
+      cn_trdrst_trc_out = "restart_mld_trc"
+      ln_trdtrc(:) = .FALSE.
+
+      REWIND( numnat )               !  namelist namtoptrd : passive tracer trends diagnostic
+      READ  ( numnat, namtrc_trd )
+
+     IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) ' trd_mld_trc_init : read namelist namtrc_trd                    '
+         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~                                               '
+         WRITE(numout,*) '   * frequency of trends diagnostics   nn_trd_trc             = ', nn_trd_trc
+         WRITE(numout,*) '   * control surface type              nn_ctls_trc            = ', nn_ctls_trc
+         WRITE(numout,*) '   * restart for ML diagnostics        ln_trdmld_trc_restart  = ', ln_trdmld_trc_restart
+         WRITE(numout,*) '   * flag to diagnose trends of                                 '
+         WRITE(numout,*) '     instantantaneous or mean ML T/S   ln_trdmld_trc_instant  = ', ln_trdmld_trc_instant
+         WRITE(numout,*) '   * unit conversion factor            rn_ucf_trc             = ', rn_ucf_trc
+         DO jn = 1, jptra
+            IF( ln_trdtrc(jn) ) WRITE(numout,*) '    compute ML trends for tracer number :', jn
+         END DO
+      ENDIF
+#endif
+
+      ! namelist of transport
+      ! ---------------------
+      CALL trc_nam_trp
+
+
+      ! namelist of SMS
+      ! ---------------      
+      IF( lk_lobster ) THEN   ;   CALL trc_nam_lobster      ! LOBSTER bio-model
+      ELSE                    ;   IF(lwp) WRITE(numout,*) '          LOBSTER not used'
+      ENDIF
+
+      IF( lk_pisces  ) THEN   ;   CALL trc_nam_pisces      ! PISCES  bio-model
+      ELSE                    ;   IF(lwp) WRITE(numout,*) '          PISCES not used'
+      ENDIF
+
+      IF( lk_cfc     ) THEN   ;   CALL trc_nam_cfc         ! CFC     tracers
+      ELSE                    ;   IF(lwp) WRITE(numout,*) '          CFC not used'
+      ENDIF
+
+      IF( lk_c14b     ) THEN   ;   CALL trc_nam_c14b         ! C14 bomb     tracers
+      ELSE                    ;   IF(lwp) WRITE(numout,*) '          C14 not used'
+      ENDIF
+
+      IF( lk_my_trc  ) THEN   ;   CALL trc_nam_my_trc      ! MY_TRC  tracers
+      ELSE                    ;   IF(lwp) WRITE(numout,*) '          MY_TRC not used'
+      ENDIF
+      !
+   END SUBROUTINE trc_nam
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                     No passive tracer
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_nam                      ! Empty routine   
+   END SUBROUTINE trc_nam
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE  trcnam
Index: trunk/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/trcrst.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/trcrst.F90	(revision 2528)
@@ -25,6 +25,7 @@
    USE oce_trc
    USE trc
-   USE trctrp_lec
+   USE trcnam_trp
    USE lib_mpp
+   USE lib_fortran
    USE iom
    USE trcrst_cfc      ! CFC      
@@ -33,7 +34,5 @@
    USE trcrst_c14b     ! C14 bomb restart
    USE trcrst_my_trc   ! MY_TRC   restart
-#if defined key_off_tra
-    USE daymod
-#endif
+   USE daymod
    IMPLICIT NONE
    PRIVATE
@@ -47,9 +46,4 @@
    !! * Substitutions
 #  include "top_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
    
 CONTAINS
@@ -67,22 +61,23 @@
       !!----------------------------------------------------------------------
       !
-# if ! defined key_off_tra
-      IF( kt == nit000 ) lrst_trc = .FALSE. 
-# else
-      IF( kt == nit000 ) THEN
-        lrst_trc = .FALSE. 
-        nitrst = nitend  
-      ENDIF
-
-      IF( 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
-         IF( nitrst > nitend )   nitrst = nitend   ! make sure we write a restart at the end of the run
-      ENDIF
-# endif
-     ! to get better performances with NetCDF format:
-     ! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 2*ndttrc + 1)
-     ! except if we write tracer restart files every tracer time step or if a tracer restart file was writen at nitend - 2*ndttrc + 1
-     IF( kt == nitrst - 2*ndttrc + 1 .OR. nstock == ndttrc .OR. ( kt == nitend - ndttrc + 1 .AND. .NOT. lrst_trc ) ) THEN
+      IF( lk_offline ) THEN
+         IF( kt == nit000 ) THEN
+            lrst_trc = .FALSE.
+            nitrst = nitend
+         ENDIF
+
+         IF( 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
+            IF( nitrst > nitend )   nitrst = nitend   ! make sure we write a restart at the end of the run
+         ENDIF
+      ELSE
+         IF( kt == nit000 ) lrst_trc = .FALSE.
+      ENDIF
+
+      ! to get better performances with NetCDF format:
+      ! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 2*nn_dttrc + 1)
+      ! except if we write tracer restart files every tracer time step or if a tracer restart file was writen at nitend - 2*nn_dttrc + 1
+      IF( kt == nitrst - 2*nn_dttrc + 1 .OR. nstock == nn_dttrc .OR. ( kt == nitend - nn_dttrc + 1 .AND. .NOT. lrst_trc ) ) THEN
          ! beware of the format used to write kt (default is i8.8, that should be large enough)
          IF( nitrst > 1.0e9 ) THEN   ;   WRITE(clkt,*       ) nitrst
@@ -106,6 +101,4 @@
       !!----------------------------------------------------------------------
       INTEGER  ::  jn     
-      INTEGER  ::  iarak0 
-      REAL(wp) ::  zarak0
       INTEGER  ::  jlibalt = jprstlib
       LOGICAL  ::  llok
@@ -128,17 +121,5 @@
       ! Time domain : restart
       ! ---------------------
-      CALL trc_rst_cal( nittrc000, 'READ' )   ! calendar
-
-      IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd ) THEN   ;   iarak0 = 1
-      ELSE                                           ;   iarak0 = 0
-      ENDIF
-      CALL iom_get( numrtr, 'arak0', zarak0 )
-
-      IF( iarak0 /= NINT( zarak0 ) )   &                           ! Control of the scheme
-         & CALL ctl_stop( ' ===>>>> : problem with advection scheme', &
-         & ' it must be the same type for both restart and previous run', &
-         & ' centered or euler '  )
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) '    arakawa option      : ', NINT( zarak0 )
+      CALL trc_rst_cal( nit000, 'READ' )   ! calendar
 
       ! READ prognostic variables and computes diagnostic variable
@@ -175,10 +156,5 @@
 
       CALL trc_rst_cal( kt, 'WRITE' )   ! calendar
-
-      IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd ) THEN   ;   zarak0 = 1.
-      ELSE                                           ;   zarak0 = 0.
-      ENDIF
-      CALL iom_rstput( kt, nitrst, numrtw, 'arak0', zarak0 )
-
+      CALL iom_rstput( kt, nitrst, numrtw, 'rdttrc1', rdttrc(1) )   ! surface passive tracer time step
       ! prognostic variables 
       ! -------------------- 
@@ -222,6 +198,6 @@
       !!
       !!   According to namelist parameter nrstdt,
-      !!       nrsttr = 0  no control on the date (nittrc000 is  arbitrary).
-      !!       nrsttr = 1  we verify that nit000 is equal to the last
+      !!       nn_rsttr = 0  no control on the date (nit000 is  arbitrary).
+      !!       nn_rsttr = 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
@@ -230,5 +206,5 @@
       !!       This is valid is the time step has remained constant.
       !!
-      !!       nrsttr = 2  the duration of the experiment in days (adatrj)
+      !!       nn_rsttr = 2  the duration of the experiment in days (adatrj)
       !!                    has been stored in the restart file.
       !!----------------------------------------------------------------------
@@ -236,8 +212,6 @@
       CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
       !
-      REAL(wp) ::  zkt
-#if defined key_off_tra
+      REAL(wp) ::  zkt, zrdttrc1
       REAL(wp) ::  zndastp
-#endif
 
       ! Time domain : restart
@@ -250,38 +224,43 @@
             WRITE(numout,*) '   previous time-step                               : ', NINT( zkt )
             WRITE(numout,*) ' *** restart option'
-            SELECT CASE ( nrsttr )
-            CASE ( 0 )   ;   WRITE(numout,*) ' nrsttr = 0 : no control of nittrc000'
-            CASE ( 1 )   ;   WRITE(numout,*) ' nrsttr = 1 : no control the date at nit000 (use ndate0 read in the namelist)'
-            CASE ( 2 )   ;   WRITE(numout,*) ' nrsttr = 2 : calendar parameters read in restart'
+            SELECT CASE ( nn_rsttr )
+            CASE ( 0 )   ;   WRITE(numout,*) ' nn_rsttr = 0 : no control of nit000'
+            CASE ( 1 )   ;   WRITE(numout,*) ' nn_rsttr = 1 : no control the date at nit000 (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 ) /= 1 .AND.  nrsttr /= 0 )                                  &
+         IF( nit000  - NINT( zkt ) /= 1 .AND.  nn_rsttr /= 0 )                                  &
             &   CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart',                 &
-            &                  ' verify the restart file or rerun with nrsttr = 0 (namelist)' )
-#if defined key_off_tra
-         ! define ndastp and adatrj
-         IF ( nrsttr == 2 ) THEN
-            CALL iom_get( numrtr, 'ndastp', zndastp ) 
-            ndastp = NINT( zndastp )
-            CALL iom_get( numrtr, 'adatrj', adatrj  )
-         ELSE
-            ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam
-            adatrj = ( REAL( nittrc000-1, wp ) * rdttra(1) ) / rday
-            ! note this is wrong if time step has changed during run
+            &                  ' 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 /= rdttrc(1) )   neuler = 0
+            ENDIF
+            !                          ! define ndastp and adatrj
+            IF ( nn_rsttr == 2 ) THEN
+               CALL iom_get( numrtr, 'ndastp', zndastp ) 
+               ndastp = NINT( zndastp )
+               CALL iom_get( numrtr, 'adatrj', adatrj  )
+            ELSE
+               ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam
+               adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday
+               ! note this is wrong if time step has changed during run
+            ENDIF
+            !
+            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
+            !
+            CALL day_init          ! compute calendar
+            !
          ENDIF
          !
-         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
-         !
-         CALL day_init          ! compute calendar
-         !
-#endif
-
       ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
          !
@@ -291,5 +270,4 @@
             IF(lwp) WRITE(numout,*) '~~~~~~~'
          ENDIF
-         ! calendar control
          CALL iom_rstput( kt, nitrst, numrtw, 'kt'     , REAL( kt    , wp) )   ! time-step
          CALL iom_rstput( kt, nitrst, numrtw, 'ndastp' , REAL( ndastp, wp) )   ! date
@@ -308,7 +286,7 @@
       !!----------------------------------------------------------------------
 
-      INTEGER  :: ji, jj, jk, jn
+      INTEGER  :: jn
       REAL(wp) :: zdiag_var, zdiag_varmin, zdiag_varmax, zdiag_tot
-      REAL(wp) :: zder, zvol
+      REAL(wp) :: zder
       !!----------------------------------------------------------------------
 
@@ -322,19 +300,9 @@
       zdiag_tot = 0.e0
       DO jn = 1, jptra
-         zdiag_var    = 0.e0
-         zdiag_varmin = 0.e0
-         zdiag_varmax = 0.e0
-         DO jk = 1, jpk
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  zvol = cvol(ji,jj,jk)
-#  if defined key_off_degrad
-                  zvol = zvol * facvol(ji,jj,jk)
+#  if defined key_degrad
+         zdiag_var = glob_sum( trn(:,:,:,jn) * cvol(:,:,:) * facvol(:,:,:) )
+#  else
+         zdiag_var = glob_sum( trn(:,:,:,jn) * cvol(:,:,:)  )
 #  endif
-                  zdiag_var = zdiag_var + trn(ji,jj,jk,jn) * zvol
-               END DO
-            END DO
-         END DO
-         
          zdiag_varmin = MINVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) )
          zdiag_varmax = MAXVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) )
@@ -342,5 +310,4 @@
             CALL mpp_min( zdiag_varmin )      ! min over the global domain
             CALL mpp_max( zdiag_varmax )      ! max over the global domain
-            CALL mpp_sum( zdiag_var    )      ! sum over the global domain
          END IF
          zdiag_tot = zdiag_tot + zdiag_var
@@ -369,4 +336,8 @@
 #endif
 
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!======================================================================
 END MODULE trcrst
Index: trunk/NEMOGCM/NEMO/TOP_SRC/trcsms.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/trcsms.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/trcsms.F90	(revision 2528)
@@ -28,7 +28,7 @@
 
    !!----------------------------------------------------------------------
-   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
 
@@ -48,5 +48,5 @@
       !!---------------------------------------------------------------------
 
-      IF ( MOD(kt,ndttrc) /= 0) RETURN      ! this ROUTINE is called only every ndttrc time step
+      IF ( MOD( kt, nn_dttrc) /= 0 ) RETURN      ! this ROUTINE is called only every ndttrc time step
 
       IF( lk_lobster )   CALL trc_sms_lobster( kt )    ! main program of LOBSTER
Index: trunk/NEMOGCM/NEMO/TOP_SRC/trcstp.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/trcstp.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/trcstp.F90	(revision 2528)
@@ -4,11 +4,12 @@
    !! Time-stepping    : time loop of opa for passive tracer
    !!======================================================================
+   !! History :  1.0  !  2004-03  (C. Ethe)  Original
+   !!----------------------------------------------------------------------
 #if defined key_top
    !!----------------------------------------------------------------------
    !!   trc_stp      : passive tracer system time-stepping
    !!----------------------------------------------------------------------
-   !! * Modules used
    USE oce_trc          ! ocean dynamics and active tracers variables
-   USE trp_trc
+   USE trc
    USE trctrp           ! passive tracers transport
    USE trcsms           ! passive tracers sources and sinks
@@ -17,5 +18,5 @@
    USE trcwri
    USE trcrst
-   USE trdmld_trc_oce
+   USE trdmod_trc_oce
    USE trdmld_trc
    USE iom
@@ -25,12 +26,11 @@
    PRIVATE
 
-   !! * Routine accessibility
-   PUBLIC trc_stp           ! called by step
+   PUBLIC   trc_stp    ! called by step
+   
    !!----------------------------------------------------------------------
-   !!   TOP 1.0 , LOCEAN-IPSL (2005) 
-   !! $Id: trcstp.F90 1285 2009-02-03 13:38:51Z cetlod $ 
-   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
@@ -44,33 +44,31 @@
       !!              Compute the passive tracers trends 
       !!              Update the passive tracers
-      !!
-      !! History :
-      !!   9.0  !  04-03  (C. Ethe)  Original
       !!-------------------------------------------------------------------
-      !! * Arguments
       INTEGER, INTENT( in ) ::  kt  ! ocean time-step index
       CHARACTER (len=25)    ::  charout
+      !!-------------------------------------------------------------------
 
-      ! this ROUTINE is called only every ndttrc time step
-      IF( MOD( kt , ndttrc ) /= 0 ) RETURN
-
-      IF(ln_ctl) THEN
-         WRITE(charout,FMT="('kt =', I4,'  d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear
-         CALL prt_ctl_trc_info(charout)
+      IF( MOD( kt - 1 , nn_dttrc ) == 0 ) THEN      ! only every nn_dttrc time step
+         !
+         IF(ln_ctl) THEN
+            WRITE(charout,FMT="('kt =', I4,'  d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear
+            CALL prt_ctl_trc_info(charout)
+         ENDIF
+         !
+         tra(:,:,:,:) = 0.e0
+         !
+         IF( kt == nit000 .AND. lk_trdmld_trc  )  &
+            &                      CALL trd_mld_trc_init        ! trends: Mixed-layer
+                                   CALL trc_rst_opn( kt )       ! Open tracer restart file 
+         IF( lk_iomput ) THEN  ;   CALL trc_wri( kt )           ! output of passive tracers
+         ELSE                  ;   CALL trc_dia( kt )
+         ENDIF
+                                   CALL trc_sms( kt )           ! tracers: sink and source
+                                   CALL trc_trp( kt )           ! transport of passive tracers
+         IF( kt == nit000 )     CALL iom_close( numrtr )     ! close input  passive tracers restart file
+         IF( lrst_trc )            CALL trc_rst_wri( kt )       ! write tracer restart file
+         IF( lk_trdmld_trc  )      CALL trd_mld_trc( kt )       ! trends: Mixed-layer
+         !
       ENDIF
-
-      IF( kt == nittrc000 .AND. lk_trdmld_trc  )  &
-         &                   CALL trd_mld_trc_init        ! trends: Mixed-layer
-                             CALL trc_rst_opn( kt )       ! Open tracer restart file 
-                             CALL trc_sms( kt )           ! tracers: sink and source
-                             CALL trc_trp( kt )           ! transport of passive tracers
-      IF( kt == nittrc000 )  CALL iom_close( numrtr )     ! close input  passive tracers restart file
-      IF( lrst_trc )         CALL trc_rst_wri( kt )       ! write tracer restart file
-      IF( lk_iomput ) THEN
-                             CALL trc_wri( kt )           ! output of passive tracers
-      ELSE
-                             CALL trc_dia( kt )   ! diagnostics
-      ENDIF
-      IF( lk_trdmld_trc  )   CALL trd_mld_trc( kt )     ! trends: Mixed-layer
 
    END SUBROUTINE trc_stp
@@ -82,5 +80,4 @@
 CONTAINS
    SUBROUTINE trc_stp( kt )        ! Empty routine
-      INTEGER, INTENT(in) :: kt
       WRITE(*,*) 'trc_stp: You should not have seen this print! error?', kt
    END SUBROUTINE trc_stp
Index: trunk/NEMOGCM/NEMO/TOP_SRC/trcwri.F90
===================================================================
--- trunk/NEMOGCM/NEMO/TOP_SRC/trcwri.F90	(revision 2527)
+++ trunk/NEMOGCM/NEMO/TOP_SRC/trcwri.F90	(revision 2528)
@@ -5,5 +5,4 @@
    !!====================================================================================
    !! History :   1.0  !  2009-05 (C. Ethe)  Original code
-   !!                  !  2010-03 (C. Ethe, R. Seferian ) Add the tracer transport trends
    !!----------------------------------------------------------------------
 #if defined key_top &&  defined key_iomput
@@ -12,16 +11,10 @@
    !!----------------------------------------------------------------------
    !! trc_wri_trc   :  outputs of concentration fields
-   !! trc_wri_trd   :  outputs of transport trends
    !!----------------------------------------------------------------------
    USE dom_oce         ! ocean space and time domain variables
    USE oce_trc
-   USE trp_trc
    USE trc
-   USE trdmld_trc_oce, ONLY : luttrd
    USE iom
-#if defined key_off_tra
-   USE oce_trc
    USE dianam
-#endif
 
    IMPLICIT NONE
@@ -32,9 +25,4 @@
    !! * Substitutions
 #  include "top_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) 
-   !! $Id: trcdia.F90 1450 2009-05-15 14:12:12Z cetlod $ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
 
 CONTAINS
@@ -50,7 +38,6 @@
 
       !
-      CALL iom_setkt  ( kt + ndttrc - 1 )       ! set the passive tracer time step
+      CALL iom_setkt  ( kt + nn_dttrc - 1 )       ! set the passive tracer time step
       CALL trc_wri_trc( kt              )       ! outputs for tracer concentration
-      CALL trc_wri_trd( kt              )       ! outputs for dynamical trends
       CALL iom_setkt  ( kt              )       ! set the model time step
       !
@@ -65,22 +52,15 @@
       INTEGER, INTENT( in ) :: kt       ! ocean time-step
       INTEGER               :: jn
-      CHARACTER (len=20)    :: cltra, cltras
-#if defined key_off_tra
+      CHARACTER (len=20)    :: cltra
       CHARACTER (len=40) :: clhstnam
       INTEGER ::   inum = 11            ! temporary logical unit
-#endif
       !!---------------------------------------------------------------------
  
-#if defined key_off_tra
-      IF( kt == nittrc000 ) THEN
-        ! WRITE root name in date.file for use by postpro
-         IF(lwp) THEN
-            CALL dia_nam( clhstnam, nwritetrc,' ' )
-            CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
-            WRITE(inum,*) clhstnam
-            CLOSE(inum)
-         ENDIF
+      IF( lk_offline .AND. kt == nit000 .AND. lwp ) THEN    ! WRITE root name in date.file for use by postpro
+         CALL dia_nam( clhstnam, nn_writetrc,' ' )
+         CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
+         WRITE(inum,*) clhstnam
+         CLOSE(inum)
       ENDIF
-#endif
       ! write the tracer concentrations in the file
       ! ---------------------------------------
@@ -92,51 +72,4 @@
    END SUBROUTINE trc_wri_trc
 
-# if defined key_trc_diatrd
-
-   SUBROUTINE trc_wri_trd( kt )
-      !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE trc_wri_trd  ***
-      !!
-      !! ** Purpose :   output of passive tracer : advection-diffusion trends
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt          ! ocean time-step
-      !!
-      CHARACTER (len=3) ::   cltra
-      INTEGER  ::   jn, jl, ikn
-      !!----------------------------------------------------------------------
-
-      DO jn = 1, jptra
-         IF( luttrd(jn) ) THEN
-            ikn = ikeep(jn)
-            DO jl = 1, jpdiatrc
-               IF( jl == jptrc_xad ) WRITE (cltra,"(3a)") 'XAD' ! x advection for tracer
-               IF( jl == jptrc_yad ) WRITE (cltra,"(3a)") 'YAD'  ! y advection for tracer
-               IF( jl == jptrc_zad ) WRITE (cltra,"(3a)") 'ZAD'  ! z advection for tracer
-               IF( jl == jptrc_xdf ) WRITE (cltra,"(3a)") 'XDF'  ! x diffusion for tracer
-               IF( jl == jptrc_ydf ) WRITE (cltra,"(3a)") 'YDF'  ! y diffusion for tracer
-               IF( jl == jptrc_zdf ) WRITE (cltra,"(3a)") 'ZDF'  ! z diffusion for tracer
-# if defined key_trcldf_eiv
-               IF( jl == jptrc_xei ) WRITE (cltra,"(3a)") 'XGV'  ! x gent velocity for tracer
-               IF( jl == jptrc_yei ) WRITE (cltra,"(3a)") 'YGV'  ! y gent velocity for tracer
-               IF( jl == jptrc_zei ) WRITE (cltra,"(3a)") 'ZGV'  ! z gent velocity for tracer
-# endif
-# if defined key_trcdmp
-               IF( jl == jptrc_dmp ) WRITE (cltra,"(3a)") 'DMP'  ! damping
-# endif
-               IF( jl == jptrc_sbc ) WRITE (cltra,"(3a)") 'SBC'  ! surface boundary conditions
-               ! write the trends
-               CALL iom_put( cltra, trtrd(:,:,:,ikn,jl) )
-            END DO
-         END IF
-      END DO
-      !
-   END SUBROUTINE trc_wri_trd
-
-# else
-   SUBROUTINE trc_wri_trd( kt )                      ! Dummy routine
-      INTEGER, INTENT ( in ) ::   kt
-   END SUBROUTINE trc_wri_trd
-#endif
 #else
    !!----------------------------------------------------------------------
@@ -150,4 +83,8 @@
 #endif
 
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!======================================================================
 END MODULE trcwri
Index: trunk/NEMOGCM/SETTE/README
===================================================================
--- trunk/NEMOGCM/SETTE/README	(revision 2528)
+++ trunk/NEMOGCM/SETTE/README	(revision 2528)
@@ -0,0 +1,40 @@
+usage of SETTE package:
+
+principal script is sette.sh (usage: ./sette.sh)
+
+USER MODIFICATIONS
+ in sette.sh script :
+               SETTE_DIR : base directory for SETTE
+               makenemo -m : machine (compilator); see ./makenemo -m help
+                        -n : config name (in examples config_name_nproci_nprocj), see ./makenemo -n help
+                        -r : reference configuration (if you don't give it you have to choise directories to install)
+                        add_key : to add list of keys (for example to test reproductibility: add_key mpp_rep)
+                        del_key : to del list of keys
+               and for more details and options of makenemo see ./makenemo -h
+	       set_namelist : to set namelist values 
+			(example : to set 75 time steps for one test : namelist nn_itend 75)
+			(  	 : to change cn_icerst_in name : namelist_ice cn_icerst_in  \"test_00101231_restart_icemod.nc\")
+			(  	 : to activate control print : namelist ln_ctl \".false.\" )
+               fcm_job.sh needs input: input_CONFIG_NAME and TOTAL NUMBER OF PROCS used
+			(for example if you compile ORCA2_LIM with nproci=2 and nprocj=2 ===> ./fcm_job input_ORCA2_LIM.cfg 4)
+ in param.cfg :
+               EXE_DIR     : directory in which execute jobs (by default CONFIG_DIR)
+               FORCING_DIR : directory where to get input tar file
+               INPUT_DIR   : directory in which store input files
+               TMPDIR      : temporary directory NEEDED ONLY FOR IBM machines (put EXP00 directory)
+               OUTPUT_DIR  : directory in which store output files
+ in fcm_job.sh :
+               IMPORTANT : control that name of tar file in FORCING directory
+               is the same of that in input_REF_CONFIG.cfg, if not change one.
+               change in "RUN OPA" part the command line (some examples are already written)
+
+
+NOTE:
+in case of error you can remove you NEW_CONF directory and all files doing :
+./makenemo -n MY_CONFIG clean_config
+
+if you want recompile nemo but before you want to clean compiled code do :
+./makenemo clean
+
+and if you have already compiled you can re-run all sette.sh and compilation part will be by-passed.
+
Index: trunk/NEMOGCM/SETTE/all_functions.sh
===================================================================
--- trunk/NEMOGCM/SETTE/all_functions.sh	(revision 2528)
+++ trunk/NEMOGCM/SETTE/all_functions.sh	(revision 2528)
@@ -0,0 +1,87 @@
+#!/bin/bash
+######################################################
+# Author : Simona Flavoni for NEMO
+# Contact : sflod@locean-ipsl.upmc.fr
+#
+# Some scripts called by sette.sh
+# all_functions.sh   : all functions used by sette.sh  
+######################################################
+#set -x
+set -o posix
+#set -u
+#set -e
+#+
+#
+# ================
+# all_functions.sh
+# ================
+#
+# ----------------------------------------------
+# Set of functions used by sette.sh (NEMO tests) 
+# ----------------------------------------------
+#
+# SYNOPSIS
+# ========
+#
+# ::
+#
+#  $ ./set_namelist.sh INPUT_NAMELIST VARIABLE VALUE 
+#
+#
+# DESCRIPTION
+# ===========
+#
+# function superegrep
+# input variable value
+#
+# function set_namelist
+# input namelist_name variable value
+# output namelist
+#
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./set_namelist.sh namelist          nn_itend        75
+#  $ ./set_namelist.sh namelist_ice_lim2 cn_icerst_in  \"00101231_restart_icemod\"
+#
+#
+# TODO
+# ====
+#
+# option debug
+#
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id$
+#
+#   * creation
+#-
+#
+
+
+# function to find namelists parameters
+supergrep () {
+            grep "^ *$1 *=" $2 | sed -e "s% *\!.*%%"
+    }
+
+usage=" Usage : set_namelist input_namelist variable_name value"
+usage=" if value is a string ths is neede syntax : ./set_namelist namelist_name var_name \"new_value\" "
+
+# function to set namelists parameters
+set_namelist () {
+	minargcount=3
+		if [ ${#} -lt ${minargcount} ]
+		then
+		echo "not enought arguments"
+		echo "${usage}"
+		exit 1
+		fi
+	unset minargcount
+	VAR_NAME=$( supergrep $2 ${INPUT_DIR}/$1 )
+     	sed -e "s/${VAR_NAME}/$2=$3/"  ${INPUT_DIR}/$1 > ${INPUT_DIR}/$1.tmp
+     	mv ${INPUT_DIR}/$1.tmp ${INPUT_DIR}/$1
+}
Index: trunk/NEMOGCM/SETTE/fcm_job.sh
===================================================================
--- trunk/NEMOGCM/SETTE/fcm_job.sh	(revision 2528)
+++ trunk/NEMOGCM/SETTE/fcm_job.sh	(revision 2528)
@@ -0,0 +1,120 @@
+#!/bin/bash
+######################################################
+# Author : Simona Flavoni for NEMO
+# Contact : sflod@locean-ipsl.upmc.fr
+#
+# Some scripts called by sette.sh 
+# fcm_job.sh   : simple job to run NEMO with fcm 
+######################################################
+#set -x
+set -o posix
+#set -u
+#set -e
+#+
+#
+# ================
+# fcm_job.sh
+# ================
+#
+# --------------------------
+# Simple job for NEMO tests 
+# --------------------------
+#
+# SYNOPSIS
+# ========
+#
+# ::
+#
+#  $ ./fcm_job.sh INPUT_FILE_CONFIG_NAME NUMBER_PROC
+#
+#
+# DESCRIPTION
+# ===========
+#
+#
+# Simple job for SET TESTS for NEMO (SETTE)
+#
+#
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./fcm_job.sh INPUT_FILE_CONFIG_NAME       NUMBER_PROC
+#
+#  run a job of config GYRE with 1 processor
+#  $ ./fcm_job.sh input_GYRE.cfg                     1
+#
+#  run a job of config ORCA2_LIM_PISCES with 8 processors
+#  $ ./fcm_job.sh input_ORCA2_LIM_PISCES.cfg         8
+#
+#
+# TODO
+# ====
+#
+# option debug
+#
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id$
+#
+#
+#
+#   * creation
+#
+#-
+#
+# SET INPUT
+# get the input tarfile if needed
+tar_file=$(sed -ne "1,1p" $1)
+if [ "$(cat $1 | grep -c ".tar" )" -ne 0 ] ; then
+	cp ${FORCING_DIR}/${tar_file} ${INPUT_DIR}/.
+	cd ${INPUT_DIR} ; tar xvf ${INPUT_DIR}/*.tar ; gunzip *gz
+fi 
+
+if [ -f ${INPUT_DIR}/namelist_ice_lim2 ] ; then 
+   cp ${INPUT_DIR}/namelist_ice_lim2 ${INPUT_DIR}/namelist_ice
+elif  [ -f ${INPUT_DIR}/namelist_ice_lim3 ] ; then 
+   cp ${INPUT_DIR}/namelist_ice_lim3 ${INPUT_DIR}/namelist_ice
+fi
+
+
+if [ "$(cat ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm | grep -c "agrif" )" -ne 0 ] ; then
+	#- Namelist for ocean and ice (agrif fine grid)
+	cp ${INPUT_DIR}/1_namelist_ice_lim2 ${INPUT_DIR}/1_namelist_ice 
+fi
+################################################################
+
+################################################################
+# RUN OPA
+cd ${INPUT_DIR}
+NB_PROC=$2
+ if [ ${NB_PROC} == 1 ] ; then
+	./opa
+else
+# example for brodie (NEC SX8) machine
+	mpirun -np ${NB_PROC} opa
+# example for dedale machine
+#	mpirun --mca btl self,tcp -np ${NB_PROC} opa
+# example for vargas (IBM Power6) machine
+#	mpiexec -n ${NB_PROC} opa
+fi
+################################################################
+
+################################################################
+## -- Save output files
+
+#- Save ocean output files
+[ ! -d ${OUTPUT_DIR} ] && mkdir ${OUTPUT_DIR}
+[ -f *ocean.output ] && mv *ocean.output ${OUTPUT_DIR}/.
+[ -f *solver.stat ] && mv *solver.stat ${OUTPUT_DIR}/.
+[ -n "$(ls *_grid_*)" ] && mv *_grid_*.nc ${OUTPUT_DIR}/.
+[ -f restart* ] && cp restart* ${OUTPUT_DIR}/.
+[ -f ice_evolu ] && mv ice_evolu ${OUTPUT_DIR}/.
+[ -n "$(ls *icemod*)" ] && mv *icemod* ${OUTPUT_DIR}/.
+#- Save ftrace file
+[ -f ftrace.out* ] && cp ftrace.out* ${OUTPUT_DIR}/.
+################################################################
+
Index: trunk/NEMOGCM/SETTE/input_GYRE.cfg
===================================================================
--- trunk/NEMOGCM/SETTE/input_GYRE.cfg	(revision 2528)
+++ trunk/NEMOGCM/SETTE/input_GYRE.cfg	(revision 2528)
@@ -0,0 +1,1 @@
+
Index: trunk/NEMOGCM/SETTE/input_ORCA2_LIM.cfg
===================================================================
--- trunk/NEMOGCM/SETTE/input_ORCA2_LIM.cfg	(revision 2528)
+++ trunk/NEMOGCM/SETTE/input_ORCA2_LIM.cfg	(revision 2528)
@@ -0,0 +1,1 @@
+ORCA2_LIM_nemo_v3.3.beta.tar
Index: trunk/NEMOGCM/SETTE/input_ORCA2_LIM_PISCES.cfg
===================================================================
--- trunk/NEMOGCM/SETTE/input_ORCA2_LIM_PISCES.cfg	(revision 2528)
+++ trunk/NEMOGCM/SETTE/input_ORCA2_LIM_PISCES.cfg	(revision 2528)
@@ -0,0 +1,1 @@
+ORCA2_LIM_nemo_v3.3.beta.tar
Index: trunk/NEMOGCM/SETTE/param.cfg
===================================================================
--- trunk/NEMOGCM/SETTE/param.cfg	(revision 2528)
+++ trunk/NEMOGCM/SETTE/param.cfg	(revision 2528)
@@ -0,0 +1,9 @@
+EXE_DIR=${CONFIG_DIR}     
+#- input files storing 
+FORCING_DIR=~/FORCING
+#- input files storing 
+INPUT_DIR=${CONFIG_DIR}/${NEW_CONF}/EXP00
+#- only for IBM
+#- TMPDIR=${CONFIG_DIR}/${NEW_CONF}/EXP00
+#- output files storing 
+OUTPUT_DIR=${CONFIG_DIR}/${NEW_CONF}/EXP00/VALIDATION
Index: trunk/NEMOGCM/SETTE/sette.sh
===================================================================
--- trunk/NEMOGCM/SETTE/sette.sh	(revision 2528)
+++ trunk/NEMOGCM/SETTE/sette.sh	(revision 2528)
@@ -0,0 +1,76 @@
+#!/bin/sh
+#############################################################
+# Author : Simona Flavoni for NEMO
+# Contact : sflod@locean-ipsl.upmc.fr
+#
+# sette.sh   : principal script of SET TEsts for NEMO (SETTE)
+#############################################################
+#set -x
+set -o posix
+#set -u
+#set -e
+#+
+#
+# ================
+# sette.sh
+# ================
+#
+# ----------------------------------------------
+# Set of tests for NEMO
+# ----------------------------------------------
+#
+# SYNOPSIS
+# ========
+#
+# ::
+#
+#  $ ./sette.sh
+#
+# DESCRIPTION
+# ===========
+#
+#
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./sette.sh 
+#
+#
+# TODO
+# ====
+#
+# option debug
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id$
+#
+#   * creation
+#
+#-
+#
+SETTE_DIR=/PATH/OF/SETTE
+
+cd ${SETTE_DIR}
+. ../CONFIG/makenemo -m ifort_linux -n GYRE_1_1 -r GYRE
+cd ${SETTE_DIR}
+. param.cfg
+. all_functions.sh
+set_namelist namelist nn_it000 1
+set_namelist namelist nn_itend 75
+cd ${SETTE_DIR}
+. ./fcm_job.sh input_GYRE.cfg 1
+
+cd ${SETTE_DIR}
+. ../CONFIG/makenemo -n ORCA2_LIM_1_2 add_key "key_mpp_mpi key_nproci=1 key_nprocj=2"
+cd ${SETTE_DIR}
+. param.cfg
+. all_functions.sh
+set_namelist namelist nn_it000 1
+set_namelist namelist nn_itend 75
+cd ${SETTE_DIR}
+. ./fcm_job.sh input_ORCA2_LIM.cfg 2
+
Index: trunk/NEMOGCM/TOOLS/COMPILE/Fadd_keys.sh
===================================================================
--- trunk/NEMOGCM/TOOLS/COMPILE/Fadd_keys.sh	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/COMPILE/Fadd_keys.sh	(revision 2528)
@@ -0,0 +1,83 @@
+#!/bin/bash
+######################################################
+# Author : Simona Flavoni for NEMO
+# Contact : sflod@locean-ipsl.upmc.fr
+#
+# Some functions called from makenemo
+# Fadd_keys   : add keys in cpp.fcm file  
+######################################################
+#set -x
+set -o posix
+#set -u
+#set -e
+#+
+#
+# ============
+# Fadd_keys.sh
+# ============
+#
+# --------------------
+# Add compilation keys
+# --------------------
+#
+# SYNOPSIS
+# ========
+#
+# ::
+#
+#  $ Fadd_keys.sh CONFIG_NAME add_key "LIST_KEYS"
+#
+#
+# DESCRIPTION
+# ===========
+#
+#
+# Script to add a set off key when compiling a configuration.
+# The list off key to be added has to be enclosed with " ". 
+# A 'sed' is performed to modify the CONFIG_NAME/cpp.fcm file to    
+# add the new key(s). 
+#
+#
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./Fadd_keys.sh ORCA2_LIM add_key "key_mpp_mpi key_nproci=1 key_nprocj=10"
+#
+#
+# TODO
+# ====
+#
+# option debug
+#
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id: Fadd_keys.sh 2158 2010-10-20 17:30:03Z sflod $
+#
+#
+#
+#   * creation
+#
+#-
+ echo "Adding keys in : ${NEW_CONF}" 
+ for i in ${list_add_key} ; do
+	if [ "$(echo ${i} | grep -c key_proc )" -ne 0 ] ; then
+		sed -e "s/key_proc[ij]=.* //"  ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm >  ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm.tmp
+       	 	mv ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm.tmp   ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm
+		echo " "
+		sed -e "s/$/ ${i}/"  ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm >  ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm.tmp
+       	 	mv ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm.tmp   ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm
+	elif [ "$(cat ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm | grep -c "$i" )" -ne 0 ] ; then
+ 	echo "key $i already present in cpp_${NEW_CONF}.fcm" 
+	else
+	sed -e "s/$/ ${i}/"  ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm >  ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm.tmp
+ 	mv ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm.tmp   ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm
+ 	echo "added key $i in ${NEW_CONF}" 
+	fi
+ done
+ 
+ unset -v list_add_key
+
Index: trunk/NEMOGCM/TOOLS/COMPILE/Fcheck_archfile.sh
===================================================================
--- trunk/NEMOGCM/TOOLS/COMPILE/Fcheck_archfile.sh	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/COMPILE/Fcheck_archfile.sh	(revision 2528)
@@ -0,0 +1,72 @@
+#!/bin/bash
+#set -x
+set -o posix
+#set -u
+#set -e
+#+
+#
+# ==================
+# Fcheck_archfile.sh
+# ==================
+#
+# --------------------------
+# Check the compilation file
+# --------------------------
+#
+# SYNOPSIS
+# ========
+#
+# ::
+#
+#  $ Fcheck_archfile.sh
+#
+#
+# DESCRIPTION
+# ===========
+#
+#
+# Check the choice of the compiler.
+# Three cases :  
+#
+# - There was a previous choice
+# - A new one has be specified, we use this one
+# - No information, exit
+#
+# We use TOOLS/COMPILE/arch.fcm to see if something was chosen. 
+#
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./Fcheck_archfile.sh ARCHFILE COMPILER
+#
+#
+# TODO
+# ====
+#
+# option debug
+#
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id$
+#
+#
+#
+#   * creation
+#
+#-
+
+if [ ${#2} -eq 0 ]; then
+   if [ ! -f ${COMPIL_DIR}/$1 ]; then
+   echo "Warning !!!"
+   echo "NO compiler chosen"
+   echo "Try makenemo -h for help"
+   echo "EXITING..."
+   exit 1 
+   fi
+else
+   ln -sf ${MAIN_DIR}/ARCH/arch-${2}.fcm ${COMPIL_DIR}/$1
+fi
Index: trunk/NEMOGCM/TOOLS/COMPILE/Fcheck_config.sh
===================================================================
--- trunk/NEMOGCM/TOOLS/COMPILE/Fcheck_config.sh	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/COMPILE/Fcheck_config.sh	(revision 2528)
@@ -0,0 +1,87 @@
+#!/bin/bash
+######################################################
+# Author : Rachid Benshila for NEMO
+# Contact : rblod@locean-ipsl.upmc.fr
+#
+# Some functions called from makenemo
+# Fcheck_config   : config checking 
+######################################################
+#set -x
+set -o posix
+#set -u
+#set -e
+#+
+#
+# ================
+# Fcheck_config.sh
+# ================
+#
+# --------------------------
+# Check the configuration
+# --------------------------
+#
+# SYNOPSIS
+# ========
+#
+# ::
+#
+#  $ Fcheck_config.sh FILENAME CONFNAME
+#
+#
+# DESCRIPTION
+# ===========
+#
+#
+# Check the choice of the configuration:
+#
+# - Two cases
+# - One is explicitely set
+# - Nothing set, use the previous in use 
+#
+# We use TOOLS/COMPILE/cfg.txt to check if the onfiguration exists.
+#
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./Fcheck_config.sh
+#
+#
+# TODO
+# ====
+#
+# option debug
+#
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id$
+#
+#
+#
+#   * creation
+#
+#-
+
+declare -a ZTAB
+if [ ${#2} -eq 0 ]; then
+   tail -1  ${COMPIL_DIR}/$1	> ${COMPIL_DIR}/cfg.tmp
+   read -a ZTAB < ${COMPIL_DIR}/cfg.tmp
+   NEW_CONF=${ZTAB[0]} ; TAB=( ${ZTAB[@]:1} )
+   \rm ${COMPIL_DIR}/cfg.tmp
+   echo "Warning !!!"
+   echo "No configuration specified"
+   echo "Use makenemo -n MYCONFIG"
+   echo "or  makenemo -h for help"
+   echo "Using defaut configuration : ${NEW_CONF}"
+fi
+if [ "$1" == cfg.txt ]; then
+   cat ${COMPIL_DIR}/$1 | grep "${NEW_CONF} " > ${COMPIL_DIR}/cfg.tmp
+   read -a ZTAB < ${COMPIL_DIR}/cfg.tmp
+   NEW_CONF=${ZTAB[0]} ; TAB=( ${ZTAB[@]:1} )
+   \rm ${COMPIL_DIR}/cfg.tmp
+fi
+
+unset -v ZTAB
Index: trunk/NEMOGCM/TOOLS/COMPILE/Fcheck_script.sh
===================================================================
--- trunk/NEMOGCM/TOOLS/COMPILE/Fcheck_script.sh	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/COMPILE/Fcheck_script.sh	(revision 2528)
@@ -0,0 +1,63 @@
+#!/bin/bash
+#set -x
+set -o posix
+#set -u
+#set -e
+#+
+#
+# ================
+# Fcheck_script.sh
+# ================
+#
+# --------------------------
+# Check
+# --------------------------
+#
+# SYNOPSIS
+# ========
+#
+# ::
+#
+#  $ Fcheck_script.sh
+#
+#
+# DESCRIPTION
+# ===========
+#
+#
+# Check if utilities are in the path, typically fcm.
+#
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./Fcheck_script.sh fcm
+#
+#
+# TODO
+# ====
+#
+# option debug
+#
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id$
+#
+#
+#
+#   * creation
+#
+#-
+
+myscript=`which $1`
+if [ ${#myscript} -eq 0 ]; then
+echo "WARNING !!!"
+echo "$1 has to be installed first"
+echo "Exiting......................"
+exit 1
+fi
+
+unset -v myscript
Index: trunk/NEMOGCM/TOOLS/COMPILE/Fclean_config.sh
===================================================================
--- trunk/NEMOGCM/TOOLS/COMPILE/Fclean_config.sh	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/COMPILE/Fclean_config.sh	(revision 2528)
@@ -0,0 +1,86 @@
+#!/bin/bash
+######################################################
+# Author : Simona Flavoni for NEMO
+# Contact : sflod@locean-ipsl.upmc.fr
+#
+# Some functions called from makenemo
+# Fclean_config   : config removing 
+######################################################
+#set -x
+set -o posix
+#set -u
+#set -e
+#+
+#
+# ================
+# Fclean_config.sh
+# ================
+#
+# ------------------------
+# Remove the configuration
+# ------------------------
+#
+# SYNOPSIS
+# ========
+#
+# ::
+#
+#  $ Fclean_config.sh CONFNAME
+#
+#
+# DESCRIPTION
+# ===========
+#
+#
+# Remove the configuration:
+#
+# - remove CONFIG_NAME/WORK
+# - remove CONFIG_NAME/BLD
+# - remove CONFIG_NAME from TOOLS/TOOLS/COMPILE/cfg.txt 
+# 
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./Fclean_config.sh ORCA2_LIM
+#
+#
+# TODO
+# ====
+#
+# option debug
+#
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id: Fclean_config.sh 2158 2010-10-20 17:30:03Z sflod $
+#
+#
+#
+#   * creation
+#
+#-
+ NEW_CONF=${x_n}
+ echo "Are you sure that you want to remove this directory ? [y/n] "
+ read answer
+ answer=`echo $answer | sed 's/^[y].*$/y/'`
+ if [  -z "$answer" -o "x$answer" = "xy" ]; then
+ 	# testing if configuration exists
+ 	if [ "$(cat ${COMPIL_DIR}/cfg.txt | grep "${NEW_CONF} ")"  == "" ] ; then
+		echo "The configuration ${NEW_CONF} does not exist in file cfg.txt"     
+		echo "No removing configuration"
+		echo " "
+        else
+		rm -rf ${CONFIG_DIR}/${NEW_CONF}
+		sed -e "/${NEW_CONF} /d"  ${COMPIL_DIR}/cfg.txt >  ${COMPIL_DIR}/cfg.tmp
+		mv  ${COMPIL_DIR}/cfg.tmp  ${COMPIL_DIR}/cfg.txt
+		echo "${NEW_CONF} configuration REMOVED" 
+        fi
+ else
+	echo " "
+	echo "nothing to remove"
+ fi
+
+ unset -v answer
Index: trunk/NEMOGCM/TOOLS/COMPILE/Fclean_var.sh
===================================================================
--- trunk/NEMOGCM/TOOLS/COMPILE/Fclean_var.sh	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/COMPILE/Fclean_var.sh	(revision 2528)
@@ -0,0 +1,68 @@
+#!/bin/bash
+#set -x
+set -o posix
+#set -u
+#set -e
+#+
+#
+# =============
+# Fclean_var.sh
+# =============
+#
+# ----------------------------
+# Clean environement variables
+# ----------------------------
+#
+# SYNOPSIS
+# ========
+#
+# ::
+#
+#  $ Fclean_var.sh
+#
+#
+# DESCRIPTION
+# ===========
+#
+#
+# Clean environement variables
+#
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./Fclean_var.sh
+#
+#
+# TODO
+# ====
+#
+# option debug
+#
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id$
+#
+#
+#
+#   * creation
+#
+#-
+#- Unset variables
+
+unset -v NSTOP
+unset -v TAB
+unset -v NEW_CONF
+unset -v REF_CONF
+unset -v CMP_NAM
+unset -v NBR_PRC
+unset -v NEM_SUBDIR
+unset -v MAIN_DIR
+unset -v CONFIG_DIR
+unset -v TOOLS_DIR
+unset -v COMPIL_DIR
+unset -v NEMO_DIR
+unset -v USEBLD
Index: trunk/NEMOGCM/TOOLS/COMPILE/Fcopy_dir.sh
===================================================================
--- trunk/NEMOGCM/TOOLS/COMPILE/Fcopy_dir.sh	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/COMPILE/Fcopy_dir.sh	(revision 2528)
@@ -0,0 +1,62 @@
+#!/bin/bash
+#set -x
+set -o posix
+#set -u
+#set -e
+#+
+#
+# ============
+# Fcopy_dir.sh
+# ============
+#
+# --------------------------
+# Copy a reference directory
+# --------------------------
+#
+# SYNOPSIS
+# ========
+#
+# ::
+#
+#  $ Fcopy_dir.sh
+#
+#
+# DESCRIPTION
+# ===========
+#
+#
+# When a refenrence configuration is set, 
+# Copy NEMO sub-directories needed (OPA_SRC, TOP_SRC ...)
+#
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./Fcopy_dir.sh ORCA2_LIM
+#
+#
+# TODO
+# ====
+#
+# option debug
+#
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id$
+#
+#
+#
+#   * creation
+#
+#-
+
+declare -a ZTAB
+grep "$1 " ${COMPIL_DIR}/cfg.txt > ${COMPIL_DIR}/cfg.tmp
+read -a ZTAB < ${COMPIL_DIR}/cfg.tmp
+TAB=( ${ZTAB[@]:1} )
+\rm ${COMPIL_DIR}/cfg.tmp
+
+unset -v ZTAB
Index: trunk/NEMOGCM/TOOLS/COMPILE/Fdel_keys.sh
===================================================================
--- trunk/NEMOGCM/TOOLS/COMPILE/Fdel_keys.sh	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/COMPILE/Fdel_keys.sh	(revision 2528)
@@ -0,0 +1,67 @@
+#!/bin/bash
+######################################################
+# Author : Simona Flavoni for NEMO
+# Contact : sflod@locean-ipsl.upmc.fr
+#
+# Some functions called from makenemo
+# Fdel_keys   : del keys in cpp.fcm file  
+######################################################
+#set -x
+set -o posix
+#set -u
+#set -e
+#+
+#
+# ================
+# Fdel_keys.sh
+# ================
+#
+# --------------------------
+# Add compilation keys
+# --------------------------
+#
+# SYNOPSIS
+# ========
+#
+# ::
+#
+#  $ Fdel_keys.sh CONFIG_NAME del_key "LIST_KEYS"
+#
+#
+# DESCRIPTION
+# ===========
+#
+#
+# Add cpp keys when compiling a configuration, key list has to be enclosed with " ".
+# We perform a 'sed' on the CONFIG_NAME/CPP.fcm file, contianing the list of keys. 
+#
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./Fdel_keys.sh CONFIG_NAME del_key "key_agrif"
+#
+#
+# TODO
+# ====
+#
+# option debug
+#
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id: Fdel_keys.sh 2158 2010-10-20 17:30:03Z sflod $
+#
+#
+#
+#   * creation
+#
+#-
+ echo "Removing keys in : ${NEW_CONF}" 
+ sed -e "s/${list_del_key}//"  ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm >  ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm.tmp
+ mv ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm.tmp   ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm
+ echo "removed keys ${list_del_key} in ${NEW_CONF}" 
+
+ unset -v list_del_key
Index: trunk/NEMOGCM/TOOLS/COMPILE/Fgo_to_TOOLS.sh
===================================================================
--- trunk/NEMOGCM/TOOLS/COMPILE/Fgo_to_TOOLS.sh	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/COMPILE/Fgo_to_TOOLS.sh	(revision 2528)
@@ -0,0 +1,55 @@
+#!/bin/bash
+#set -x
+set -o posix
+#set -u
+#set -e
+#+
+#
+# ===============
+# Fgo_to_tools.sh
+# ===============
+#
+# --------------------------
+# Go to the TOOLS directory
+# --------------------------
+#
+# SYNOPSIS
+# ========
+#
+# ::
+#
+#  $ Fgo_to_tools.sh
+#
+#
+# DESCRIPTION
+# ===========
+#
+#
+# Go to the TOOLS directory
+#
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./Fgo_to_tools.sh
+#
+#
+# TODO
+# ====
+#
+# option debug
+#
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id$
+#
+#
+#
+#   * creation
+#
+#-
+
+cd ${MAIN_DIR}/TOOLS
Index: trunk/NEMOGCM/TOOLS/COMPILE/Flist_archfile.sh
===================================================================
--- trunk/NEMOGCM/TOOLS/COMPILE/Flist_archfile.sh	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/COMPILE/Flist_archfile.sh	(revision 2528)
@@ -0,0 +1,63 @@
+#!/bin/bash
+#set -x
+set -o posix
+#set -u
+#set -e
+#+
+#
+# ==================
+# Flist_archfile.sh
+# ==================
+#
+# --------------------------
+# Check the compilation file
+# --------------------------
+#
+# SYNOPSIS
+# ========
+#
+# ::
+#
+#  $ Flist_archfile.sh
+#
+#
+# DESCRIPTION
+# ===========
+#
+#
+# List arch file available.
+# The first line of each file in NEMO/ARCH directory is echoed.  
+#
+#
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./Flist_archfile.sh 
+#
+#
+# TODO
+# ====
+#
+# option debug
+#
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id$
+#
+#
+#
+#   * creation
+#
+#-
+echo "Available compilers for -m option :"
+for file in `ls ${MAIN_DIR}/ARCH`
+do
+zvar1=${file#arch-}
+zvar2=$(head -1 ${MAIN_DIR}/ARCH/$file)
+#echo "${zvar1%.fcm} : ${zvar2#\#}"
+printf "%-20s %s %-s\n" "${zvar1%.fcm}" : "${zvar2#\#}"
+done
Index: trunk/NEMOGCM/TOOLS/COMPILE/Fmake_WORK.sh
===================================================================
--- trunk/NEMOGCM/TOOLS/COMPILE/Fmake_WORK.sh	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/COMPILE/Fmake_WORK.sh	(revision 2528)
@@ -0,0 +1,104 @@
+#!/bin/bash
+######################################################
+# Author : Rachid Benshila for NEMO
+# Contact : rblod@locean-ipsl.upmc.fr
+#
+# Some functions called from makenemo
+# Fmake_WORK      : create links in the WORK
+######################################################
+#set -x
+set -o posix
+#set -u
+#set -e
+#+
+#
+# =============
+# Fmake_WORK.sh
+# =============
+#
+# -----------------------
+# Make the WORK directory
+# -----------------------
+#
+# SYNOPSIS
+# ========
+#
+# ::
+#
+#  $ Fmake_WORK.sh
+#
+#
+# DESCRIPTION
+# ===========
+#
+#
+# Make the WORK directory:
+#
+# - Create lin in NEW_CONF/WORK
+# - Use specified sub-directories previously
+# - OPA has to be done first !!!
+#
+#
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./Fmake_WORK.sh ORCA2_LIM OPA_SRC LIM_SRC_2
+#
+#
+# TODO
+# ====
+#
+# option debug
+#
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id$
+#
+#
+#
+#   * creation
+#
+#-
+declare ZCONF=$1 ; shift 
+ZTAB=( $@ )
+declare i=0 ; declare NDIR=${#ZTAB[@]}
+
+echo "Creating ${ZCONF}/WORK = ${ZTAB[*]} for ${ZCONF}"
+echo ""
+
+[ ! -d ${ZCONF}/MY_SRC ] && \mkdir ${ZCONF}/MY_SRC
+[   -d ${ZCONF}/WORK   ] || \mkdir ${ZCONF}/WORK
+
+\rm -f ../${1}/WORK/*
+
+while [ $i -lt $NDIR ]
+do
+   [ "${ZTAB[i]}" = "OPA_SRC" ] && ln -sf ${NEMO_DIR}/OPA_SRC/*.[Ffh]90 ${ZCONF}/WORK
+   [ "${ZTAB[i]}" = "OPA_SRC" ] && ln -sf ${NEMO_DIR}/OPA_SRC/*/*.[Ffh]90 ${ZCONF}/WORK && break
+   let i=$i+1
+done
+
+i=0
+while [ $i -lt $NDIR ]
+do
+   if [ "${ZTAB[i]}" != "OPA_SRC" ]; then
+      ln -sf ${NEMO_DIR}/${ZTAB[i]}/*.[Ffh]90 ${ZCONF}/WORK
+      ln -sf ${NEMO_DIR}/${ZTAB[i]}/*/*.[Ffh]90 ${ZCONF}/WORK 2>/dev/null
+   fi
+   let i=$i+1
+done
+
+for i in `(cd ${ZCONF}/MY_SRC ; ls *.[Ffh]90 2>/dev/null ) `
+   do
+      [ -f ${ZCONF}/MY_SRC/$i ] &&  ln -sf $PWD/${ZCONF}/MY_SRC/${i} ${ZCONF}/WORK/.
+   done
+
+unset -v  ZCONF
+unset -v ZTAB
+unset -v  i
+unset -v NDIR
+
Index: trunk/NEMOGCM/TOOLS/COMPILE/Fmake_bld.sh
===================================================================
--- trunk/NEMOGCM/TOOLS/COMPILE/Fmake_bld.sh	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/COMPILE/Fmake_bld.sh	(revision 2528)
@@ -0,0 +1,64 @@
+#!/bin/bash
+#set -x
+set -o posix
+#set -u
+#set -e
+#+
+#
+# ============
+# Fmake_bld.sh
+# ============
+#
+# --------------------
+# Make build directory
+# --------------------
+#
+# SYNOPSIS
+# ========
+#
+# ::
+#
+#  $ Fmake_bld.sh
+#
+#
+# DESCRIPTION
+# ===========
+#
+#
+# Under CONFIG_NAME :
+# - Make the build directory 
+# - Create repositories needed :
+# - BLD for compilation 
+#
+# A tmpdir can be specified for memory issues.
+#
+#
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./Fmake_bld.sh NEMOGCM/CONFIG GYRE  /usr/tmp
+#
+#
+# TODO
+# ====
+#
+# option debug
+#
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id$
+#
+#
+#
+#   * creation
+#
+#-
+[ ! -d ${3}/${2} ] && \mkdir   ${3}/${2}
+[ ! -d ${3}/${2}/BLD ] && \mkdir  ${3}/${2}/BLD
+[ ! -d ${1}/${2}/BLD ]   && ln -sf ${3}/${2}/BLD ${1}/${2}/BLD
+[ -f ${1}/${NEW_CONF}/cpp_${NEW_CONF}.fcm ] && ln -sf ${1}/${NEW_CONF}/cpp_${NEW_CONF}.fcm ${COMPIL_DIR}/cpp.fcm
+rm -f  ${1}/${NEW_CONF}/BLD/fcm.bld.lock
Index: trunk/NEMOGCM/TOOLS/COMPILE/Fmake_config.sh
===================================================================
--- trunk/NEMOGCM/TOOLS/COMPILE/Fmake_config.sh	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/COMPILE/Fmake_config.sh	(revision 2528)
@@ -0,0 +1,67 @@
+#!/bin/bash
+#set -x
+set -o posix
+#set -u
+#set -e
+#+
+#
+# ===============
+# Fmake_config.sh
+# ===============
+#
+# ---------------
+# Make the config 
+# ---------------
+#
+# SYNOPSIS
+# ========
+#
+# ::
+#
+#  $ Fmake_config.sh
+#
+#
+# DESCRIPTION
+# ===========
+#
+#
+# - Make the config directory 
+# - Create repositories needed :
+#  
+#  - EXP00 for namelist
+#  - MY_SRC for user sources
+#  - BLD for compilation 
+#
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./Fmake_config.sh CONFIG_NAME REF_CONFIG_NAME 
+#
+#
+# TODO
+# ====
+#
+# option debug
+#
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id$
+#
+#
+#
+#   * creation
+#
+#-
+\mkdir  ${1}
+\mkdir  ${1}/EXP00
+\mkdir  ${1}/MY_SRC
+\cp -R  ${2}/cpp_${2}.fcm ${1}/cpp_${1}.fcm
+\cp -R  ${2}/EXP00/*namelist* ${1}/EXP00/.
+[ -f ${2}/EXP00/AGRIF_FixedGrids.in ] &&  \cp -R  ${2}/EXP00/AGRIF_FixedGrids.in ${1}/EXP00/.
+[ -f ${2}/EXP00/iodef.xml ] &&  \cp -R  ${2}/EXP00/iodef.xml ${1}/EXP00/.
+[ -f ${2}/EXP00/xmlio_server.def ] &&  \cp -R  ${2}/EXP00/xmlio_server.def ${1}/EXP00/.
+[ -d    ${2}/MY_SRC ] && \cp  ${2}/MY_SRC/* ${1}/MY_SRC/. 2> /dev/null
Index: trunk/NEMOGCM/TOOLS/COMPILE/Fprep_agrif.sh
===================================================================
--- trunk/NEMOGCM/TOOLS/COMPILE/Fprep_agrif.sh	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/COMPILE/Fprep_agrif.sh	(revision 2528)
@@ -0,0 +1,71 @@
+#!/bin/bash
+#set -x
+set -o posix
+#set -u
+#set -e
+#+
+#
+# ==============
+# Fprep_agrif.sh
+# ==============
+#
+# ---------------------
+# Preparation for AGRIF
+# ---------------------
+#
+# SYNOPSIS
+# ========
+#
+# ::
+#
+#  $ Fprep_agrif.sh
+#
+#
+# DESCRIPTION
+# ===========
+#
+#
+# Prepare directories for AGRIF and copy files needed
+#
+# Compile the conv
+#
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./Fprep_agrif.sh CONFIG_NAME
+#
+#
+# TODO
+# ====
+#
+# option debug
+#
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id$
+#
+#
+#
+#   * creation
+#
+#-
+
+#- AGRIF conv
+if [ "$AGRIFUSE" == 1 ]; then
+
+#- CONV
+#fcm build ${TOOLS_DIR}/conv.cfg || exit 1
+gmake -C ${MAIN_DIR}/EXTERNAL/AGRIF/LIB
+
+#- AGRIF sources
+[ ! -d $2/$1/OPAFILES ] && mkdir  $2/$1/OPAFILES
+[ ! -d $2/$1/OPAFILES/AGRIF_INC ] && mkdir  $2/$1/OPAFILES/AGRIF_INC
+[ ! -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/
+
+fi
Index: trunk/NEMOGCM/TOOLS/COMPILE/Fread_dir.sh
===================================================================
--- trunk/NEMOGCM/TOOLS/COMPILE/Fread_dir.sh	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/COMPILE/Fread_dir.sh	(revision 2528)
@@ -0,0 +1,83 @@
+#!/bin/bash
+#set -x
+set -o posix
+#set -u
+#set -e
+#+
+#
+# ============
+# Fread_dir.sh
+# ============
+#
+# ---------------------
+# Read user directories
+# ---------------------
+#
+# SYNOPSIS
+# ========
+#
+# ::
+#
+#  $ Fread_dir.sh
+#
+#
+# DESCRIPTION
+# ===========
+#
+#
+# Read directoires needed from standard input
+#
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./Fread_dir.sh Directory_NAME YES/NO
+#
+#
+# TODO
+# ====
+#
+# option debug
+#
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id$
+#
+#
+#
+#   * creation
+#
+#-
+
+if [ "$2" == "YES" ]; then
+   echo -n " $1 [Y/n] "
+   read answer
+   answer=`echo $answer | sed 's/^[yY].*$/y/'`
+   if [  -z "$answer" -o "x$answer" = "xy" ]; then
+      TAB[$ind]="$1"
+      let ind=ind+1
+      echo " $1 selected "
+      echo "  "
+   else
+      echo " $1 Not selected "
+      echo "  "
+   fi
+   unset -v answer
+else
+   echo -n " $1 [y/N] "
+   read answer
+   answer=`echo $answer | sed 's/^[nN].*$/N/'`
+   if [ "x$answer" = "xy" ]; then
+      TAB[$ind]="$1"
+      let ind =ind+1
+      echo " $1 selected "
+      echo "  "
+   else
+      echo " $1 Not selected "
+      echo "  "
+   fi
+   unset -v answer
+fi
Index: trunk/NEMOGCM/TOOLS/COMPILE/README
===================================================================
--- trunk/NEMOGCM/TOOLS/COMPILE/README	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/COMPILE/README	(revision 2528)
@@ -0,0 +1,7 @@
+CSHRC :
+setenv PATH ~/NEMOGCM/TOOLS:$PATH
+setenv NEMO_TDIR /users/rblod/tmp
+
+BASH :
+export PATH=$PATH:~/NEMOGCM/TOOLS'
+export NEMO_TDIR=/users/rblod/tmp
Index: trunk/NEMOGCM/TOOLS/COMPILE/agrifpp.sh
===================================================================
--- trunk/NEMOGCM/TOOLS/COMPILE/agrifpp.sh	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/COMPILE/agrifpp.sh	(revision 2528)
@@ -0,0 +1,89 @@
+#!/bin/bash
+#set -x
+set -o posix
+#set -u
+#set -e
+#+
+#
+# ==========
+# agrifpp.sh
+# ==========
+#
+# ----------------------------
+# Preform AGrif pre-processing
+# ----------------------------
+#
+# SYNOPSIS
+# ========
+#
+# ::
+#
+#  $ agrifpp.sh
+#
+#
+# DESCRIPTION
+# ===========
+#
+#
+# Look after key agrif, if yes the conv is used, otherwise standard pre-processing is performed.
+#
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./agrifpp.sh 1 -Dkey
+# 
+#  or
+#
+#  $ ./agrifpp.sh -Dkey
+#
+# TODO
+# ====
+#
+# option debug
+#
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id: agrifpp.sh 2143 2010-10-04 12:49:55Z rblod $
+#
+#
+#
+#   * creation
+#
+#-
+
+if [ "$1" == "1" ]; then
+   shift
+   MYFILE=`echo $* |awk -F" " '{print $NF}' `  
+   FPP_OPT=` echo $* |awk '{  for (i=1 ; i<NF ; i++ )  { printf " %s",  $i } }'`
+
+
+   if [ "${MYFILE}" != "par_oce.F90" -a  ! -f ${NEMO_TDIR}/${NEW_CONF}}/OPAFILES/param_done ]; then
+      cpp ${FPP_OPT} ${CONFIG_DIR}/${NEW_CONF}/WORK/par_oce.F90 > ${NEMO_TDIR}/${NEW_CONF}/OPAFILES/par_oce.F90
+      (cd ${NEMO_TDIR}/${NEW_CONF}/OPAFILES ; ${NEMO_TDIR}/${NEW_CONF}/OPAFILES/conv agrif_opa.in -rm -comdirin ./ -comdirout AGRIF_MODELFILES/ -convfile par_oce.F90 > /dev/null )
+      cpp ${FPP_OPT}  -I${NEMO_TDIR}/${NEW_CONF}/OPAFILES/AGRIF_INC  ${NEMO_TDIR}/${NEW_CONF}/OPAFILES/AGRIF_MODELFILES/par_oce.F90 > ${NEMO_TDIR}/${NEW_CONF}/OPAFILES/par_oce.F90
+      touch ${NEMO_TDIR}/${NEW_CONF}/OPAFILES/param_done
+   elif  [ "${MYFILE}" == "par_oce.F90" -a -f ${NEMO_TDIR}/${NEW_CONF}/OPAFILES/param_done ] ; then
+      cd  ${NEMO_TDIR}/${NEW_CONF}/OPAFILES
+      cpp ${FPP_OPT} -I${NEMO_TDIR}/${NEW_CONF}/OPAFILES/AGRIF_INC ${MYFILE}
+      exit
+   fi
+
+   if [ "${MYFILE}" == agrif2model.F90 ]; then
+      cpp  -I${NEMO_TDIR}/${NEW_CONF}/OPAFILES/AGRIF_INC $@
+      exit
+   fi 
+
+   cpp  -I${NEMO_TDIR}/${NEW_CONF}/OPAFILES/AGRIF_INC $@ > ${NEMO_TDIR}/${NEW_CONF}/OPAFILES/${MYFILE}
+   ( cd ${NEMO_TDIR}/${NEW_CONF}/OPAFILES ; ${NEMO_TDIR}/${NEW_CONF}/OPAFILES/conv agrif_opa.in -rm -comdirin ./ -comdirout AGRIF_MODELFILES/ -convfile ${MYFILE} > /dev/null )
+   cd  ${NEMO_TDIR}/${NEW_CONF}
+   sed 's/[ 	]*$//' OPAFILES/AGRIF_MODELFILES/${MYFILE}> OPAFILES/${MYFILE}
+   cpp ${FPP_OPT} -IOPAFILES/AGRIF_INC OPAFILES/${MYFILE} 
+else
+   shift
+   cpp $@
+fi
+
Index: trunk/NEMOGCM/TOOLS/COMPILE/bld.cfg
===================================================================
--- trunk/NEMOGCM/TOOLS/COMPILE/bld.cfg	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/COMPILE/bld.cfg	(revision 2528)
@@ -0,0 +1,90 @@
+# ----------------------- FCM extract configuration file -----------------------
+cfg::type                           bld
+cfg::version                        1.0
+
+
+# ------------------------------------------------------------------------------
+# Build information
+# ------------------------------------------------------------------------------
+
+inc $COMPIL_DIR/arch_nemo.fcm
+inc $COMPIL_DIR/cpp.fcm
+
+search_src           1
+
+src::xmlf90::cml          $MAIN_DIR/EXTERNAL/XMLF90/src/cml
+src::xmlf90::dom          $MAIN_DIR/EXTERNAL/XMLF90/src/dom
+src::xmlf90::sax          $MAIN_DIR/EXTERNAL/XMLF90/src/sax
+src::xmlf90::strings      $MAIN_DIR/EXTERNAL/XMLF90/src/strings
+src::xmlf90::wxml         $MAIN_DIR/EXTERNAL/XMLF90/src/wxml
+src::xmlf90::xpath        $MAIN_DIR/EXTERNAL/XMLF90/src/xpath
+src::xmlio                $MAIN_DIR/EXTERNAL/XMLIO_SERVER/src/XMLIO
+src::ioserver             $MAIN_DIR/EXTERNAL/XMLIO_SERVER/src/IOSERVER
+src::ioipsl               $MAIN_DIR/EXTERNAL/IOIPSL/src
+src::agrif                $MAIN_DIR/EXTERNAL/AGRIF/AGRIF_FILES
+src::nemo                 $CONFIG_DIR/$NEW_CONF/WORK
+
+#bld::lib::xmlf90           xmlf90
+#bld::lib::xmlio            xmlio
+#bld::lib::ioserver         ioserver
+#bld::lib::ioipsl           ioipsl
+#bld::lib::agrif            agrif
+#bld::lib::nemo             nemo
+#bld::target libxmlf90.a libioserver.a libxmlio.a libioipsl.a libagrif.a libnemo.a server.exe nemo.exe
+bld::target  server.exe nemo.exe
+bld::exe_dep
+
+
+dir::root            $NEMO_TDIR/$NEW_CONF/BLD
+
+
+bld::tool::fc        %FC 
+bld::tool::fflags    %FCFLAGS %USER_INC
+bld::tool::fflags::agrif   %FFLAGS %USER_INC
+bld::tool::ld        %LD
+bld::tool::ldflags   %LDFLAGS %USER_LIB
+bld::tool::ar        %AR
+bld::tool::arflags   %ARFLAGS
+bld::tool::make      %MK
+
+# Pre-process code before analysing dependencies
+bld::pp::xmlio    1
+bld::pp::ioserver 1
+bld::pp::ioipsl   1
+bld::pp::nemo     1
+bld::pp::agrif    1
+bld::tool::fpp       $COMPIL_DIR/agrifpp.sh
+bld::tool::fppflags::nemo ${AGRIFUSE} %FPPFLAGS
+bld::tool::fppflags::xmlio    0 %FPPFLAGS
+bld::tool::fppflags::ioserver 0 %FPPFLAGS
+bld::tool::fppflags::ioipsl   0 %FPPFLAGS
+bld::tool::fppflags::agrif    0 %FPPFLAGS
+
+# Ignore the following dependencies
+bld::excl_dep        inc::netcdf.inc
+bld::excl_dep        inc::VT.inc
+bld::excl_dep        use::netcdf
+bld::excl_dep        h::netcdf.inc
+bld::excl_dep        h::mpif.h
+bld::excl_dep        inc::mpif.h
+bld::excl_dep        inc::mpe_logf.h
+bld::excl_dep        use::mpi
+bld::excl_dep        use::mod_prism_proto
+bld::excl_dep        use::mod_prism_def_partition_proto
+bld::excl_dep        use::mod_prism_get_comm
+bld::excl_dep        use::mod_prism_get_proto
+bld::excl_dep        use::mod_prism_put_proto
+bld::excl_dep        use::mod_comprism_proto
+bld::excl_dep        use::mkl_dfti
+# Don't generate interface files
+bld::tool::geninterface none
+
+# Allow ".h90" as an extension for CPP include files
+bld::infile_ext::h90  CPP::INCLUDE
+
+# extension for module output
+bld::outfile_ext::mod .mod
+
+# rename executable to nemo.exe
+bld::exe_name::model  nemo.exe
+
Index: trunk/NEMOGCM/TOOLS/COMPILE/bld_tools.cfg
===================================================================
--- trunk/NEMOGCM/TOOLS/COMPILE/bld_tools.cfg	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/COMPILE/bld_tools.cfg	(revision 2528)
@@ -0,0 +1,44 @@
+# ----------------------- FCM extract configuration file -----------------------
+cfg::type                           bld
+cfg::version                        1.0
+
+
+# ------------------------------------------------------------------------------
+# Build information
+# ------------------------------------------------------------------------------
+
+inc $COMPIL_DIR/arch_tools.fcm
+
+search_src           1
+
+src::nemo                 $TOOLS_DIR/$NEW_CONF/src
+
+dir::root            $NEMO_TDIR/$NEW_CONF/BLD
+
+bld::tool::fc        %FC 
+bld::tool::fflags    %FCFLAGS %USER_INC
+bld::tool::ld        %LD
+bld::tool::ldflags   %LDFLAGS %USER_LIB
+bld::tool::ar        %AR
+bld::tool::arflags   %ARFLAGS
+bld::tool::make      %MK
+
+# Ignore the following dependencies
+bld::excl_dep        inc::netcdf.inc
+bld::excl_dep        use::netcdf
+bld::excl_dep        h::netcdf.inc
+bld::excl_dep        h::mpif.h
+bld::excl_dep        inc::mpif.h
+bld::excl_dep        use::mpi
+
+# Don't generate interface files
+bld::tool::geninterface none
+
+# Allow ".h90" as an extension for CPP include files
+bld::infile_ext::h90  CPP::INCLUDE
+
+# extension for module output
+bld::outfile_ext::mod .mod
+
+# rename executable to nemo.exe
+bld::exe_name::model  nemo.exe
Index: trunk/NEMOGCM/TOOLS/COMPILE/bldxio.cfg
===================================================================
--- trunk/NEMOGCM/TOOLS/COMPILE/bldxio.cfg	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/COMPILE/bldxio.cfg	(revision 2528)
@@ -0,0 +1,71 @@
+# ----------------------- FCM extract configuration file -----------------------
+cfg::type                           bld
+cfg::version                        1.0
+
+
+# ------------------------------------------------------------------------------
+# Build information
+# ------------------------------------------------------------------------------
+
+inc $COMPIL_DIR/arch_nemo.fcm
+inc $COMPIL_DIR/cpp.fcm
+
+search_src           1
+
+src::ioipsl               $MAIN_DIR/EXTERNAL/IOIPSL/src
+src::agrif                $MAIN_DIR/EXTERNAL/AGRIF/AGRIF_FILES
+src::nemo                 $CONFIG_DIR/$NEW_CONF/WORK
+
+bld::target  nemo.exe
+bld::exe_dep
+
+
+dir::root            $NEMO_TDIR/$NEW_CONF/BLD
+
+
+bld::tool::fc        %FC 
+bld::tool::fflags    %FCFLAGS %USER_INC
+bld::tool::fflags::agrif   %FFLAGS %USER_INC
+bld::tool::ld        %LD
+bld::tool::ldflags   %LDFLAGS %USER_LIB
+bld::tool::ar        %AR
+bld::tool::arflags   %ARFLAGS
+bld::tool::make      %MK
+
+# Pre-process code before analysing dependencies
+bld::pp::ioipsl   1
+bld::pp::nemo     1
+bld::pp::agrif    1
+bld::tool::fpp       $COMPIL_DIR/agrifpp.sh
+bld::tool::fppflags::nemo ${AGRIFUSE} %FPPFLAGS
+bld::tool::fppflags::ioipsl   0 %FPPFLAGS
+bld::tool::fppflags::agrif    0 %FPPFLAGS
+
+# Ignore the following dependencies
+bld::excl_dep        inc::netcdf.inc
+bld::excl_dep        inc::VT.inc
+bld::excl_dep        use::netcdf
+bld::excl_dep        h::netcdf.inc
+bld::excl_dep        h::mpif.h
+bld::excl_dep        inc::mpif.h
+bld::excl_dep        inc::mpe_logf.h
+bld::excl_dep        use::mpi
+bld::excl_dep        use::mod_prism_proto
+bld::excl_dep        use::mod_prism_def_partition_proto
+bld::excl_dep        use::mod_prism_get_comm
+bld::excl_dep        use::mod_prism_get_proto
+bld::excl_dep        use::mod_prism_put_proto
+bld::excl_dep        use::mod_comprism_proto
+bld::excl_dep        use::mkl_dfti
+# Don't generate interface files
+bld::tool::geninterface none
+
+# Allow ".h90" as an extension for CPP include files
+bld::infile_ext::h90  CPP::INCLUDE
+
+# extension for module output
+bld::outfile_ext::mod .mod
+
+# rename executable to nemo.exe
+bld::exe_name::model  nemo.exe
+
Index: trunk/NEMOGCM/TOOLS/COMPILE/cfg.txt
===================================================================
--- trunk/NEMOGCM/TOOLS/COMPILE/cfg.txt	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/COMPILE/cfg.txt	(revision 2528)
@@ -0,0 +1,7 @@
+GYRE OPA_SRC
+ORCA2_LIM_PISCES OPA_SRC LIM_SRC_2 NST_SRC TOP_SRC
+GYRE_LOBSTER OPA_SRC TOP_SRC
+ORCA2_OFF_PISCES OPA_SRC OFF_SRC TOP_SRC
+POMME OPA_SRC NST_SRC
+ORCA2_LIM3 OPA_SRC LIM_SRC_3
+ORCA2_LIM OPA_SRC LIM_SRC_2 NST_SRC
Index: trunk/NEMOGCM/TOOLS/COMPILE/conv.cfg
===================================================================
--- trunk/NEMOGCM/TOOLS/COMPILE/conv.cfg	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/COMPILE/conv.cfg	(revision 2528)
@@ -0,0 +1,33 @@
+# ----------------------- FCM extract configuration file -----------------------
+# template to compile agrif conv, currently not used
+cfg::type                           bld
+cfg::version                        1.0
+
+
+# ------------------------------------------------------------------------------
+# Build information
+# ------------------------------------------------------------------------------
+inc $COMPIL_DIR/arch.fcm
+
+bld::tool::make      %MK
+
+src::convsrc   $MAIN_DIR/EXTERNAL/AGRIF/LIB
+
+ #----------------------------------------------------------------------------
+# Build options (code-specific, machine-independent)
+# ----------------------------------------------------------------------------
+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::exe_name::main conv
+bld::target                              libconvsrc.a  fortran.o main.o  conv
+bld::exe_dep::conv      
+
+
+
Index: trunk/NEMOGCM/TOOLS/COMPILE/tools.txt
===================================================================
--- trunk/NEMOGCM/TOOLS/COMPILE/tools.txt	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/COMPILE/tools.txt	(revision 2528)
@@ -0,0 +1,1 @@
+REBUILD 
Index: trunk/NEMOGCM/TOOLS/GRIDGEN/namelist_R05
===================================================================
--- trunk/NEMOGCM/TOOLS/GRIDGEN/namelist_R05	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/GRIDGEN/namelist_R05	(revision 2528)
@@ -0,0 +1,19 @@
+&input_output
+    ln_iom_activated = true 
+/
+
+&coarse_grid_files    
+    cn_parent_coordinate_file = 'coordinates_ORCA_R05.nc'
+    cn_position_pivot = 'F-grid'
+/    
+
+&nesting    
+    nn_imin = 0
+    nn_imax = 1
+    nn_jmin = 1
+    nn_jmax = 1
+    nn_rhox  = 2
+    nn_rhoy = 2
+/
+
+
Index: trunk/NEMOGCM/TOOLS/GRIDGEN/namelist_R2
===================================================================
--- trunk/NEMOGCM/TOOLS/GRIDGEN/namelist_R2	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/GRIDGEN/namelist_R2	(revision 2528)
@@ -0,0 +1,19 @@
+&input_output
+    ln_iom_activated = true 
+/
+
+&coarse_grid_files    
+    cn_parent_coordinate_file = 'coordinates_ORCA_R2.nc'
+    cn_position_pivot = 'T-grid'
+/    
+
+&nesting    
+    nn_imin = 49
+    nn_imax = 52
+    nn_jmin = 147
+    nn_jmax = 147
+    nn_rhox  = 3
+    nn_rhoy = 3
+/
+
+
Index: trunk/NEMOGCM/TOOLS/GRIDGEN/src/cfg_tools.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/GRIDGEN/src/cfg_tools.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/GRIDGEN/src/cfg_tools.f90	(revision 2528)
@@ -0,0 +1,633 @@
+MODULE cfg_tools
+!!-----------------------------------------------------------
+!!
+!!  to make that we use a 4th order polynomial interpolation
+!!
+!!	         Created by Brice Lemaire on 12/2009.
+!!
+!!-----------------------------------------------------------
+  USE readwrite
+  USE projection
+  !
+  IMPLICIT NONE
+  PUBLIC
+  !
+  !
+  !
+  CONTAINS
+  !********************************************************
+  !               SUBROUTINE interp_grid   				*
+  !									        			*
+  !	 calculate polynomial interpolation at 4th order	*
+  !												        *
+  !		   CALLED from create_coordinates.f90	        *
+  !********************************************************   
+  SUBROUTINE interp_grid
+    !
+	REAL*8, DIMENSION(:,:),ALLOCATABLE :: dlcoef      !Array to store the coefficients of Lagrange 	 
+	INTEGER :: ji, jj, jk, jproj
+	INTEGER :: istat, ip
+	LOGICAL :: llnorth_pole = .FALSE.
+	!
+	WRITE(*,*) ''
+	WRITE(*,*) '### SUBROUTINE interp_grid ###'
+	WRITE(*,*) ''
+	!
+	jproj = 0
+	!
+	! Calculate coefficients for interpolation along longitude
+	!
+	ALLOCATE(dlcoef(nn_rhox-1,4))
+	istat = pol_coef(dlcoef,nn_rhox)
+	IF (istat/=1) THEN    
+      WRITE(*,*) "ERROR WITH LAGRANGIAN COEFFICIENTS"
+      STOP
+    ENDIF
+	!
+	WRITE(*,*) 'Interpolation along longitude'
+    !
+	DO jj = nn_rhoy,nygmix,nn_rhoy     
+	  DO ji = nn_rhox,nxgmix,nn_rhox
+        !
+		DO jk = 1,nn_rhox-1
+		  !
+		  ! First, we check the +-180 discontinuity.
+		  ! In this case, we increase the negative values of 360.
+		  IF(ABS(smixgrd%glam(ji,jj)-smixgrd%glam(ji+1*nn_rhox,jj)).GT.180.0.AND.smixgrd%glam(ji,jj).LT.0.) THEN
+	        smixgrd%glam(ji,jj) = smixgrd%glam(ji,jj) + 360.
+		  ENDIF
+		  !
+		  IF(ABS(smixgrd%glam(ji,jj)-smixgrd%glam(ji+1*nn_rhox,jj)).GT.180.0.AND.smixgrd%glam(ji+1*nn_rhox,jj).LT.0.) THEN
+	        smixgrd%glam(ji+1*nn_rhox,jj) = smixgrd%glam(ji+1*nn_rhox,jj) + 360.
+		  ENDIF
+		  !
+		  IF(ABS(smixgrd%glam(ji+1*nn_rhox,jj)-smixgrd%glam(ji+2*nn_rhox,jj)).GT.180.0.AND.smixgrd%glam(ji+1*nn_rhox,jj).LT.0.) THEN
+            smixgrd%glam(ji+1*nn_rhox,jj) = smixgrd%glam(ji+1*nn_rhox,jj) + 360.
+		  ENDIF
+		  !
+		  IF(ABS(smixgrd%glam(ji+1*nn_rhox,jj)-smixgrd%glam(ji+2*nn_rhox,jj)).GT.180.0.AND.smixgrd%glam(ji+2*nn_rhox,jj).LT.0.) THEN
+            smixgrd%glam(ji+2*nn_rhox,jj) = smixgrd%glam(ji+2*nn_rhox,jj) + 360.
+		  ENDIF
+		  !
+		  IF(ABS(smixgrd%glam(ji+2*nn_rhox,jj)-smixgrd%glam(ji+3*nn_rhox,jj)).GT.180.0.AND.smixgrd%glam(ji+2*nn_rhox,jj).LT.0.) THEN
+            smixgrd%glam(ji+2*nn_rhox,jj) = smixgrd%glam(ji+2*nn_rhox,jj) + 360.
+		  ENDIF
+		  !
+		  IF(ABS(smixgrd%glam(ji+2*nn_rhox,jj)-smixgrd%glam(ji+3*nn_rhox,jj)).GT.180.0.AND.smixgrd%glam(ji+3*nn_rhox,jj).LT.0.) THEN
+            smixgrd%glam(ji+3*nn_rhox,jj) = smixgrd%glam(ji+3*nn_rhox,jj) + 360.
+		  ENDIF		  
+		  !
+		  ! If we are along north boundary,	
+		  ! the variation of longitude looks like a heaviside fonction at the geographical north pole.
+		  ! Thus, we can't make an interpolation.	  
+		  IF(ABS(smixgrd%glam(ji,jj) - smixgrd%glam(ji+3*nn_rhox,jj)).EQ.180.0)THEN
+			 llnorth_pole = .TRUE.
+		  ENDIF
+		  !  
+		  ! Nearby the geographical north pole,
+		  ! the variation of the longitudes is too important.
+		  ! We need to make a polar stereographic projection before interpolation.
+		  !IF(.NOT.llnorth_pole.AND.ABS(smixgrd%glam(ji,jj)-smixgrd%glam(ji+3*nn_rhox,jj)).GE.80.0) THEN
+		  IF(.NOT.llnorth_pole.AND.smixgrd%gphi(ji,jj).GE.88.) THEN
+			CALL stereo_projection(ji,jj,jk,llnorth_pole,1)
+			jproj = 1
+		  ENDIF
+		  !															
+		  smixgrd%glam(ji+nn_rhox+jk,jj) =   dlcoef(jk,1) * smixgrd%glam(ji,jj)            &
+										   + dlcoef(jk,2) * smixgrd%glam(ji+1*nn_rhox,jj)   &
+										   + dlcoef(jk,3) * smixgrd%glam(ji+2*nn_rhox,jj)   &
+										   + dlcoef(jk,4) * smixgrd%glam(ji+3*nn_rhox,jj)
+		  !
+		  smixgrd%gphi(ji+nn_rhox+jk,jj) =   dlcoef(jk,1) * smixgrd%gphi(ji,jj)            &
+										   + dlcoef(jk,2) * smixgrd%gphi(ji+1*nn_rhox,jj)   &
+										   + dlcoef(jk,3) * smixgrd%gphi(ji+2*nn_rhox,jj)   &
+										   + dlcoef(jk,4) * smixgrd%gphi(ji+3*nn_rhox,jj)
+		  !
+		  smixgrd%e1(ji+nn_rhox+jk,jj) =     dlcoef(jk,1) * smixgrd%e1(ji,jj)            &
+										   + dlcoef(jk,2) * smixgrd%e1(ji+1*nn_rhox,jj)   &
+										   + dlcoef(jk,3) * smixgrd%e1(ji+2*nn_rhox,jj)   &
+										   + dlcoef(jk,4) * smixgrd%e1(ji+3*nn_rhox,jj)
+		  !
+		  smixgrd%e2(ji+nn_rhox+jk,jj) =     dlcoef(jk,1) * smixgrd%e2(ji,jj)            &
+										   + dlcoef(jk,2) * smixgrd%e2(ji+1*nn_rhox,jj)   &
+										   + dlcoef(jk,3) * smixgrd%e2(ji+2*nn_rhox,jj)   &
+										   + dlcoef(jk,4) * smixgrd%e2(ji+3*nn_rhox,jj)
+		  !
+		  smixgrd%nav_lon(ji+nn_rhox+jk,jj) = smixgrd%glam(ji+nn_rhox+jk,jj)
+		  smixgrd%nav_lat(ji+nn_rhox+jk,jj) = smixgrd%gphi(ji+nn_rhox+jk,jj)
+		  !		
+		  ! We make the polar stereographic projection reverse if needs.  
+		  IF(jproj.EQ.1)THEN
+			CALL stereo_projection_inv(ji,jj,jk,llnorth_pole,1)
+		  ENDIF
+          !
+		  ! We replace the strong values along the north boundary.
+  		  IF(llnorth_pole)THEN
+			IF(smixgrd%glam(ji+1*nn_rhox,jj).EQ.smixgrd%glam(ji+2*nn_rhox,jj))THEN
+			  smixgrd%glam(ji+nn_rhox+jk,jj) = smixgrd%glam(ji+1*nn_rhox,jj)		  
+	    	ELSEIF(ABS(smixgrd%glam(ji+1*nn_rhox,jj) - smixgrd%glam(ji+2*nn_rhox,jj)).EQ.180.0)THEN
+			  IF(smixgrd%gphi(ji+1*nn_rhox,jj).LT.smixgrd%gphi(ji+2*nn_rhox,jj))THEN
+				smixgrd%glam(ji+nn_rhox+jk,jj) = smixgrd%glam(ji+1*nn_rhox,jj)
+			  ELSEIF(smixgrd%gphi(ji+1*nn_rhox,jj).GT.smixgrd%gphi(ji+2*nn_rhox,jj))THEN
+				smixgrd%glam(ji+nn_rhox+jk,jj) = smixgrd%glam(ji+2*nn_rhox,jj)
+			  ENDIF
+			ENDIF
+		  ENDIF
+		  !
+		  ip = 0
+		  jproj = 0
+		  llnorth_pole = .FALSE.
+		  !
+		END DO
+	  END DO
+	END DO
+	!
+  	WHERE(smixgrd%glam.GT.180)
+	  smixgrd%glam = smixgrd%glam - 360.0
+	ENDWHERE
+	!
+	DEALLOCATE(dlcoef)
+	!
+	! Calculate coefficients for interpolation along latitude
+	!
+	ALLOCATE(dlcoef(nn_rhoy-1,4))
+	istat = pol_coef(dlcoef,nn_rhoy)
+	IF (istat/=1) THEN    
+      WRITE(*,*) "ERROR WITH LAGRANGIAN COEFFICIENTS"
+      STOP
+    ENDIF
+	!
+	WRITE(*,*) 'Interpolation along latitude'
+	!
+print*, nequator
+	DO ji = 1,nxgmix,1    
+      !
+	  DO jj = nn_rhoy,nygmix,nn_rhoy
+	  	!
+		DO jk = 1,nn_rhoy-1
+		  !
+		  IF(ABS(smixgrd%glam(ji,jj)-smixgrd%glam(ji,jj+1*nn_rhoy)).GT.180.0.AND.smixgrd%glam(ji,jj).LT.0.) THEN
+	        smixgrd%glam(ji,jj) = smixgrd%glam(ji,jj) + 360.
+		  ENDIF
+		  !
+		  IF(ABS(smixgrd%glam(ji,jj)-smixgrd%glam(ji,jj+1*nn_rhoy)).GT.180.0.AND.smixgrd%glam(ji,jj+1*nn_rhoy).LT.0.) THEN
+	        smixgrd%glam(ji,jj+1*nn_rhoy) = smixgrd%glam(ji,jj+1*nn_rhoy) + 360.
+		  ENDIF
+		  !
+		  IF(ABS(smixgrd%glam(ji,jj+1*nn_rhoy)-smixgrd%glam(ji,jj+2*nn_rhoy)).GT.180.0.AND.smixgrd%glam(ji,jj+1*nn_rhoy).LT.0.) THEN
+            smixgrd%glam(ji,jj+1*nn_rhoy) = smixgrd%glam(ji,jj+1*nn_rhoy) + 360.
+		  ENDIF
+		  !
+		  IF(ABS(smixgrd%glam(ji,jj+1*nn_rhoy)-smixgrd%glam(ji,jj+2*nn_rhoy)).GT.180.0.AND.smixgrd%glam(ji,jj+2*nn_rhoy).LT.0.) THEN
+            smixgrd%glam(ji,jj+2*nn_rhoy) = smixgrd%glam(ji,jj+2*nn_rhoy) + 360.
+		  ENDIF
+		  !
+		  IF(ABS(smixgrd%glam(ji,jj+2*nn_rhoy)-smixgrd%glam(ji,jj+3*nn_rhoy)).GT.180.0.AND.smixgrd%glam(ji,jj+2*nn_rhoy).LT.0.) THEN
+            smixgrd%glam(ji,jj+2*nn_rhoy) = smixgrd%glam(ji,jj+2*nn_rhoy) + 360.
+		  ENDIF
+		  !
+		  IF(ABS(smixgrd%glam(ji,jj+2*nn_rhoy)-smixgrd%glam(ji,jj+3*nn_rhoy)).GT.180.0.AND.smixgrd%glam(ji,jj+3*nn_rhoy).LT.0.) THEN
+            smixgrd%glam(ji,jj+3*nn_rhoy) = smixgrd%glam(ji,jj+3*nn_rhoy) + 360.
+		  ENDIF	
+		  !
+		  !IF(.NOT.llnorth_pole.AND.ABS(smixgrd%glam(ji,jj)-smixgrd%glam(ji,jj+3*nn_rhoy)).GE.60.0) THEN
+		  IF(.NOT.llnorth_pole.AND.smixgrd%gphi(ji,jj).GE.88.) THEN
+			CALL stereo_projection(ji,jj,jk,llnorth_pole,2)
+			jproj = 1
+		  ENDIF	
+		  !	
+		  smixgrd%glam(ji,jj+nn_rhoy+jk) =  dlcoef(jk,1) * smixgrd%glam(ji,jj)           &
+								          + dlcoef(jk,2) * smixgrd%glam(ji,jj+nn_rhoy)   &
+								          + dlcoef(jk,3) * smixgrd%glam(ji,jj+2*nn_rhoy) &
+								          + dlcoef(jk,4) * smixgrd%glam(ji,jj+3*nn_rhoy)
+		  !
+		  smixgrd%gphi(ji,jj+nn_rhoy+jk) =  dlcoef(jk,1) * smixgrd%gphi(ji,jj)           &
+								          + dlcoef(jk,2) * smixgrd%gphi(ji,jj+nn_rhoy)   &
+									      + dlcoef(jk,3) * smixgrd%gphi(ji,jj+2*nn_rhoy) &
+								          + dlcoef(jk,4) * smixgrd%gphi(ji,jj+3*nn_rhoy)
+		  !
+		  smixgrd%e1(ji,jj+nn_rhoy+jk) =    dlcoef(jk,1) * smixgrd%e1(ji,jj)           &
+								          + dlcoef(jk,2) * smixgrd%e1(ji,jj+nn_rhoy)   &
+								          + dlcoef(jk,3) * smixgrd%e1(ji,jj+2*nn_rhoy) &
+								          + dlcoef(jk,4) * smixgrd%e1(ji,jj+3*nn_rhoy)
+		  !
+		  smixgrd%e2(ji,jj+nn_rhoy+jk) =    dlcoef(jk,1) * smixgrd%e2(ji,jj)           &
+								          + dlcoef(jk,2) * smixgrd%e2(ji,jj+nn_rhoy)   &
+								          + dlcoef(jk,3) * smixgrd%e2(ji,jj+2*nn_rhoy) &
+								          + dlcoef(jk,4) * smixgrd%e2(ji,jj+3*nn_rhoy)
+		  !
+		  smixgrd%nav_lon(ji,jj+nn_rhoy+jk) = smixgrd%glam(ji,jj+nn_rhoy+jk)
+		  smixgrd%nav_lat(ji,jj+nn_rhoy+jk) = smixgrd%gphi(ji,jj+nn_rhoy+jk)
+		  !
+		  IF(jproj.EQ.1)THEN
+			CALL stereo_projection_inv(ji,jj,jk,llnorth_pole,2)
+		  ENDIF	
+		  !	 
+		  jproj = 0
+		  llnorth_pole = .FALSE.		  
+		  !
+	    END DO
+		!							   
+		IF(jj+3*nn_rhoy.EQ.nygmix) EXIT
+		!
+	  END DO
+      !
+	END DO	
+	!
+	WHERE(smixgrd%glam.GT.180.)
+	  smixgrd%glam = smixgrd%glam - 360.0
+	ENDWHERE
+	!	
+	WRITE(*,*) ''
+	WRITE(*,*) '### END SUBROUTINE interp_grid ###'
+	WRITE(*,*) ''
+	!
+  END SUBROUTINE
+  !
+  !
+  !
+  !********************************************************
+  !                  FUNCTION pol_coef   			    *
+  !									        			*
+  !	      calculate the coefficients of Lagrange   		*
+  !			 for the polynomial interpolation	        *
+  !												        *
+  !            CALLED from SUBROUTINE interp            *
+  !********************************************************
+  REAL FUNCTION pol_coef(kvect,kxy)
+    !
+	REAL*8, DIMENSION(:,:),ALLOCATABLE :: kvect
+	REAL*8, DIMENSION(3) :: dlv		
+	INTEGER :: ji, jm, jk
+	REAL*8 :: dlx0              !position relative du point  calculer 
+	INTEGER :: jx_k, jx_i       !position relative des points utiliss pour l'interpolation
+	REAL*8 :: dleps 
+	INTEGER :: kxy, irho
+	!
+	!on parle de position relative puisque nous utilisons les positions
+	!indiciaires, lesquelles sont rptes dans toute la grille.
+	!Il n'est donc ncessaire de calculer qu'une fois les 4 coefficients 
+	!qui seront utiliss dans toute la grille en fonction de nn_rho
+	!
+	WRITE(*,*) ''
+	WRITE(*,*) '*** FUNCTION pol_coef ***'
+	WRITE(*,*) ''
+	!
+	jm=1
+	dleps = 1.-1e-8
+	!
+	irho = kxy 
+	!
+	DO jk = 1,irho-1 
+	  dlx0 = irho+1+jk
+	  ji=1
+	  DO jx_i = 1,4+3*(irho-1),irho
+		jm=1
+		DO jx_k=1,4+3*(irho-1),irho
+		  IF(jx_k == jx_i) THEN
+			CYCLE
+		  ELSE	
+			dlv(jm) = (dlx0-jx_k) / (jx_i-jx_k)
+			jm = jm + 1
+		  END IF
+		END DO
+		kvect(jk,ji) = product(dlv)
+		ji = ji + 1
+	  END DO
+	END DO
+	!
+	IF(SUM(kvect).LT.dleps .OR. SUM(kvect).GT.dleps) THEN
+	  WRITE(*,*) ''
+	  WRITE(*,*) '*** CHECK LAGRANGE COEFFICIENTS: ***'
+	  WRITE(*,*) ''
+	  !	  
+	  DO ji=1,irho-1
+		WRITE(*,*)'point #',ji
+		WRITE(*,*) 'dlcoef(:)= ', kvect(ji,:)
+		WRITE(*,*) 'SUM(dlcoef(:)) =', SUM(kvect(ji,:))
+		WRITE(*,*)''
+	  END DO
+	  pol_coef = 1
+	ELSE
+	  !
+	  pol_coef = 0
+    ENDIF
+	!
+  END FUNCTION pol_coef
+  !
+  !
+  !
+  !********************************************************
+  !                SUBROUTINE child_grid     		    *
+  !									        			*
+  !	      create the child grids from mixed grid	    *
+  !												        *
+  !		   CALLED from create_coordinates.f90	        *
+  !********************************************************
+  SUBROUTINE child_grid	 
+    !
+	INTEGER :: ji, jj
+	INTEGER :: ip, iq
+	REAL*8, DIMENSION(2) :: dlgrdt, dlgrdu, dlgrdv, dlgrdf
+	REAL*8 :: dleps
+	!
+	WRITE(*,*) ''
+	WRITE(*,*) '### SUBROUTINE child_grid ###'
+	WRITE(*,*) ''
+	!	
+	IF(.NOT.nglobal.AND.(nn_rhox.GT.1.OR.nn_rhoy.GT.1)) THEN
+	  iq=1
+	  DO jj = (2*nn_rhoy)+1-nequator,(nygmix-(2*nn_rhoy-1)-nequator),2
+	    ip=1
+	    DO ji = (2*nn_rhox)+1,(nxgmix-(2*nn_rhox-1)),2
+		  !
+		  sfingrd%nav_lon(ip,iq) = smixgrd%nav_lon(ji,jj)
+		  sfingrd%nav_lat(ip,iq) = smixgrd%nav_lat(ji,jj)
+		  !
+		  sfingrd%glamt(ip,iq) = smixgrd%glam(ji,jj)
+		  sfingrd%glamu(ip,iq) = smixgrd%glam(ji+1,jj)
+		  sfingrd%glamv(ip,iq) = smixgrd%glam(ji,jj+1)
+		  sfingrd%glamf(ip,iq) = smixgrd%glam(ji+1,jj+1)
+		  !
+		  sfingrd%gphit(ip,iq) = smixgrd%gphi(ji,jj)
+		  sfingrd%gphiu(ip,iq) = smixgrd%gphi(ji+1,jj)
+		  sfingrd%gphiv(ip,iq) = smixgrd%gphi(ji,jj+1)
+		  sfingrd%gphif(ip,iq) = smixgrd%gphi(ji+1,jj+1)
+		  !
+		  sfingrd%e1t(ip,iq) = smixgrd%e1(ji,jj)
+		  sfingrd%e1u(ip,iq) = smixgrd%e1(ji+1,jj)
+		  sfingrd%e1v(ip,iq) = smixgrd%e1(ji,jj+1)
+		  sfingrd%e1f(ip,iq) = smixgrd%e1(ji+1,jj+1)
+		  !
+		  sfingrd%e2t(ip,iq) = smixgrd%e2(ji,jj)
+		  sfingrd%e2u(ip,iq) = smixgrd%e2(ji+1,jj)
+		  sfingrd%e2v(ip,iq) = smixgrd%e2(ji,jj+1)
+		  sfingrd%e2f(ip,iq) = smixgrd%e2(ji+1,jj+1)
+		  !		
+		  ip=ip+1
+		ENDDO
+		iq=iq+1
+	  ENDDO
+      !
+	ELSEIF(nglobal.AND.(nn_rhox.GT.1.OR.nn_rhoy.GT.1))THEN
+	  iq=1
+      DO jj = (2*nn_rhoy)+1-nequator,nygmix,2  
+	    ip=1
+		DO ji = (2*nn_rhox)-1,nxgmix,2
+		  !
+		  sfingrd%nav_lon(ip,iq) = smixgrd%nav_lon(ji,jj)
+		  sfingrd%nav_lat(ip,iq) = smixgrd%nav_lat(ji,jj)
+		  !
+		  sfingrd%glamt(ip,iq) = smixgrd%glam(ji,jj)
+		  sfingrd%glamu(ip,iq) = smixgrd%glam(ji+1,jj)
+		  sfingrd%glamv(ip,iq) = smixgrd%glam(ji,jj+1)
+		  sfingrd%glamf(ip,iq) = smixgrd%glam(ji+1,jj+1)
+		  !
+		  sfingrd%gphit(ip,iq) = smixgrd%gphi(ji,jj)
+		  sfingrd%gphiu(ip,iq) = smixgrd%gphi(ji+1,jj)
+		  sfingrd%gphiv(ip,iq) = smixgrd%gphi(ji,jj+1)
+		  sfingrd%gphif(ip,iq) = smixgrd%gphi(ji+1,jj+1)
+		  !
+		  sfingrd%e1t(ip,iq) = smixgrd%e1(ji,jj)
+		  sfingrd%e1u(ip,iq) = smixgrd%e1(ji+1,jj)
+		  sfingrd%e1v(ip,iq) = smixgrd%e1(ji,jj+1)
+		  sfingrd%e1f(ip,iq) = smixgrd%e1(ji+1,jj+1)
+		  !
+		  sfingrd%e2t(ip,iq) = smixgrd%e2(ji,jj)
+		  sfingrd%e2u(ip,iq) = smixgrd%e2(ji+1,jj)
+		  sfingrd%e2v(ip,iq) = smixgrd%e2(ji,jj+1)
+		  sfingrd%e2f(ip,iq) = smixgrd%e2(ji+1,jj+1)
+		  !	
+		  IF(ip.EQ.nxfine) EXIT
+		  !
+		  ip=ip+1
+		  !
+		ENDDO
+		!
+		IF(iq.EQ.nyfine) EXIT
+		!
+		iq=iq+1		
+		!
+	  ENDDO
+	  !
+	ELSE                                                 !No interpolation
+	  iq=1
+	  DO jj = 1,nygmix-1,2    
+	    ip=1
+	    DO ji = 1,nxgmix-1,2
+		  !
+		  sfingrd%nav_lon(ip,iq) = smixgrd%nav_lon(ji,jj)
+		  sfingrd%nav_lat(ip,iq) = smixgrd%nav_lat(ji,jj)
+		  !
+		  sfingrd%glamt(ip,iq) = smixgrd%glam(ji,jj)
+		  sfingrd%glamu(ip,iq) = smixgrd%glam(ji+1,jj)
+		  sfingrd%glamv(ip,iq) = smixgrd%glam(ji,jj+1)
+		  sfingrd%glamf(ip,iq) = smixgrd%glam(ji+1,jj+1)
+		  !
+		  sfingrd%gphit(ip,iq) = smixgrd%gphi(ji,jj)
+		  sfingrd%gphiu(ip,iq) = smixgrd%gphi(ji+1,jj)
+		  sfingrd%gphiv(ip,iq) = smixgrd%gphi(ji,jj+1)
+		  sfingrd%gphif(ip,iq) = smixgrd%gphi(ji+1,jj+1)
+		  !
+		  sfingrd%e1t(ip,iq) = smixgrd%e1(ji,jj)
+		  sfingrd%e1u(ip,iq) = smixgrd%e1(ji+1,jj)
+		  sfingrd%e1v(ip,iq) = smixgrd%e1(ji,jj+1)
+		  sfingrd%e1f(ip,iq) = smixgrd%e1(ji+1,jj+1)
+		  !
+		  sfingrd%e2t(ip,iq) = smixgrd%e2(ji,jj)
+		  sfingrd%e2u(ip,iq) = smixgrd%e2(ji+1,jj)
+		  sfingrd%e2v(ip,iq) = smixgrd%e2(ji,jj+1)
+		  sfingrd%e2f(ip,iq) = smixgrd%e2(ji+1,jj+1)
+		  !		
+		  ip=ip+1
+		END DO
+		iq=iq+1
+	  END DO
+    !
+	ENDIF
+	!
+	! With a global domain, we check the overlap bands for have
+	! * Grid(1,:) = Grid(n-1,:)
+	! * Grid(2,:) = Grid(n,:)
+	! because after interpolation the first column have no values  
+	IF(nglobal.AND.nn_rhox.GT.1)THEN
+	  !
+	  sfingrd%nav_lon(1,:) = sfingrd%nav_lon(nxfine-1,:)
+	  sfingrd%nav_lat(1,:) = sfingrd%nav_lat(nxfine-1,:)
+	  !
+	  sfingrd%glamt(1,:) = sfingrd%glamt(nxfine-1,:)
+	  sfingrd%glamu(1,:) = sfingrd%glamu(nxfine-1,:)
+	  sfingrd%glamv(1,:) = sfingrd%glamv(nxfine-1,:)
+	  sfingrd%glamf(1,:) = sfingrd%glamf(nxfine-1,:)
+	  !
+	  sfingrd%gphit(1,:) = sfingrd%gphit(nxfine-1,:)
+	  sfingrd%gphiu(1,:) = sfingrd%gphiu(nxfine-1,:)
+	  sfingrd%gphiv(1,:) = sfingrd%gphiv(nxfine-1,:)
+	  sfingrd%gphif(1,:) = sfingrd%gphif(nxfine-1,:)
+	  !
+	  sfingrd%e1t(1,:) = sfingrd%e1t(nxfine-1,:)
+	  sfingrd%e1u(1,:) = sfingrd%e1u(nxfine-1,:)
+	  sfingrd%e1v(1,:) = sfingrd%e1v(nxfine-1,:)
+	  sfingrd%e1f(1,:) = sfingrd%e1f(nxfine-1,:)
+	  !
+	  sfingrd%e2t(1,:) = sfingrd%e2t(nxfine-1,:)
+	  sfingrd%e2u(1,:) = sfingrd%e2u(nxfine-1,:)
+	  sfingrd%e2v(1,:) = sfingrd%e2v(nxfine-1,:)
+	  sfingrd%e2f(1,:) = sfingrd%e2f(nxfine-1,:)
+	  !
+	  WRITE(*,*) ''
+	  WRITE(*,*) 'WE CHECK THE OVERLAP BANDS FOR EACH FINE GRID (T,U,V & F):'
+	  WRITE(*,*) ' ==> SUM{ grd(1,:) + grd(2,:) } - SUM{ grd(n-1) + grd(n,:) } = 0'
+	  !
+	  dleps = 1e-2
+	  !
+	  WRITE(*,*) '* grid T:'
+	  dlgrdt(1) = SUM(sfingrd%glamt(1,:)) + SUM(sfingrd%glamt(2,:))
+	  dlgrdt(1) = dlgrdt(1) + SUM(sfingrd%gphit(1,:)) + SUM(sfingrd%gphit(2,:))  
+	  dlgrdt(1) = dlgrdt(1) + SUM(sfingrd%e1t(1,:)) + SUM(sfingrd%e1t(2,:))  
+	  dlgrdt(1) = dlgrdt(1) + SUM(sfingrd%e2t(1,:)) + SUM(sfingrd%e2t(2,:)) 
+	  !
+	  dlgrdt(2) = SUM(sfingrd%glamt(nxfine-1,:)) + SUM(sfingrd%glamt(nxfine,:))
+	  dlgrdt(2) = dlgrdt(2) + SUM(sfingrd%gphit(nxfine-1,:)) + SUM(sfingrd%gphit(nxfine,:))  
+	  dlgrdt(2) = dlgrdt(2) + SUM(sfingrd%e1t(nxfine-1,:)) + SUM(sfingrd%e1t(nxfine,:))  
+	  dlgrdt(2) = dlgrdt(2) + SUM(sfingrd%e2t(nxfine-1,:)) + SUM(sfingrd%e2t(nxfine,:))	
+	  !  
+	  IF((dlgrdt(1)-dlgrdt(2)).GT.dleps.OR.(dlgrdt(1)+dlgrdt(2)).LT.dleps) THEN				
+	    WRITE(*,*) '   ERROR'
+		print*,(dlgrdt(1)-dlgrdt(2)), (dlgrdt(1)+dlgrdt(2))
+	  ELSE
+	    WRITE(*,*) 'OVERLAP BANDS OK'
+	  ENDIF
+	  !
+	  WRITE(*,*) '* grid U:'
+	  dlgrdu(1) = SUM(sfingrd%glamu(1,:)) + SUM(sfingrd%glamu(2,:))
+	  dlgrdu(1) = dlgrdu(1) + SUM(sfingrd%gphiu(1,:)) + SUM(sfingrd%gphiu(2,:))  
+	  dlgrdu(1) = dlgrdu(1) + SUM(sfingrd%e1u(1,:)) + SUM(sfingrd%e1u(2,:))  
+	  dlgrdu(1) = dlgrdu(1) + SUM(sfingrd%e2u(1,:)) + SUM(sfingrd%e2u(2,:)) 
+	  !
+	  dlgrdu(2) = SUM(sfingrd%glamu(nxfine-1,:)) + SUM(sfingrd%glamu(nxfine,:))
+	  dlgrdu(2) = dlgrdu(2) + SUM(sfingrd%gphiu(nxfine-1,:)) + SUM(sfingrd%gphiu(nxfine,:))  
+	  dlgrdu(2) = dlgrdu(2) + SUM(sfingrd%e1u(nxfine-1,:)) + SUM(sfingrd%e1u(nxfine,:))  
+	  dlgrdu(2) = dlgrdu(2) + SUM(sfingrd%e2u(nxfine-1,:)) + SUM(sfingrd%e2u(nxfine,:))	
+	  !  
+	  IF((dlgrdu(1)-dlgrdu(2)).GT.dleps.OR.(dlgrdu(1)+dlgrdu(2)).LT.dleps) THEN				
+	    WRITE(*,*) '   ERROR'
+		print*,(dlgrdu(1)-dlgrdu(2)),  (dlgrdu(1)+dlgrdu(2))
+	  ELSE
+	    WRITE(*,*) 'OVERLAP BANDS OK'
+	  ENDIF
+	  !	  
+	  WRITE(*,*) '* grid V:'
+	  dlgrdv(1) = SUM(sfingrd%glamv(1,:)) + SUM(sfingrd%glamv(2,:))
+	  dlgrdv(1) = dlgrdv(1) + SUM(sfingrd%gphiv(1,:)) + SUM(sfingrd%gphiv(2,:))  
+	  dlgrdv(1) = dlgrdv(1) + SUM(sfingrd%e1v(1,:)) + SUM(sfingrd%e1v(2,:))  
+	  dlgrdv(1) = dlgrdv(1) + SUM(sfingrd%e2v(1,:)) + SUM(sfingrd%e2v(2,:)) 
+	  !
+	  dlgrdv(2) = SUM(sfingrd%glamv(nxfine-1,:)) + SUM(sfingrd%glamv(nxfine,:))
+	  dlgrdv(2) = dlgrdv(2) + SUM(sfingrd%gphiv(nxfine-1,:)) + SUM(sfingrd%gphiv(nxfine,:))  
+	  dlgrdv(2) = dlgrdv(2) + SUM(sfingrd%e1v(nxfine-1,:)) + SUM(sfingrd%e1v(nxfine,:))  
+	  dlgrdv(2) = dlgrdv(2) + SUM(sfingrd%e2v(nxfine-1,:)) + SUM(sfingrd%e2v(nxfine,:))	
+	  !  
+	  IF((dlgrdv(1)-dlgrdv(2)).GT.dleps.OR.(dlgrdv(1)+dlgrdv(2)).LT.dleps) THEN				
+	    WRITE(*,*) '   ERROR'
+		print*,(dlgrdv(1)-dlgrdv(2)), (dlgrdv(1)+dlgrdv(2))
+	  ELSE
+	    WRITE(*,*) 'OVERLAP BANDS OK'
+	  ENDIF
+	  !	
+	  WRITE(*,*) '* grid F:'
+	  dlgrdf(1) = SUM(sfingrd%glamf(1,:)) + SUM(sfingrd%glamf(2,:))
+	  dlgrdf(1) = dlgrdf(1) + SUM(sfingrd%gphif(1,:)) + SUM(sfingrd%gphif(2,:))  
+	  dlgrdf(1) = dlgrdf(1) + SUM(sfingrd%e1f(1,:)) + SUM(sfingrd%e1f(2,:))  
+	  dlgrdf(1) = dlgrdf(1) + SUM(sfingrd%e2f(1,:)) + SUM(sfingrd%e2f(2,:)) 
+	  !
+	  dlgrdf(2) = SUM(sfingrd%glamf(nxfine-1,:)) + SUM(sfingrd%glamf(nxfine,:))
+	  dlgrdf(2) = dlgrdf(2) + SUM(sfingrd%gphif(nxfine-1,:)) + SUM(sfingrd%gphif(nxfine,:))  
+	  dlgrdf(2) = dlgrdf(2) + SUM(sfingrd%e1f(nxfine-1,:)) + SUM(sfingrd%e1f(nxfine,:))  
+	  dlgrdf(2) = dlgrdf(2) + SUM(sfingrd%e2f(nxfine-1,:)) + SUM(sfingrd%e2f(nxfine,:))	
+	  !  
+	  IF((dlgrdf(1)-dlgrdf(2)).GT.dleps.OR.(dlgrdf(1)+dlgrdf(2)).LT.dleps) THEN				
+	    WRITE(*,*) '   ERROR'
+		print*, (dlgrdf(1)-dlgrdf(2)),  (dlgrdf(1)+dlgrdf(2))
+	  ELSE
+	    WRITE(*,*) 'OVERLAP BANDS OK'
+	  ENDIF
+	  !
+	  WRITE(*,*) ''
+	  WRITE(*,*) ' grid T'
+	  WRITE(*,*)  'i=    ','      1            ','         2            ','          3   '
+	  WRITE(*,*)  sfingrd%glamt(1:3,1)
+	  WRITE(*,*)  sfingrd%gphit(1:3,1)
+	  WRITE(*,*)  'i=    ','     n-2           ','        n-1           ','          n   '
+	  WRITE(*,*)  sfingrd%glamt(nxfine-2:nxfine,1)
+	  WRITE(*,*)  sfingrd%gphit(nxfine-2:nxfine,1)
+	  WRITE(*,*) ''
+	  WRITE(*,*) ' grid U'
+	  WRITE(*,*)  'i=    ','      1            ','         2            ','          3   '
+	  WRITE(*,*)  sfingrd%glamu(1:3,1)
+	  WRITE(*,*)  sfingrd%gphiu(1:3,1)
+	  WRITE(*,*)  'i=    ','     n-2           ','        n-1           ','          n   '
+	  WRITE(*,*)  sfingrd%glamu(nxfine-2:nxfine,1)
+	  WRITE(*,*)  sfingrd%gphiu(nxfine-2:nxfine,1)
+	  WRITE(*,*) ''
+	  WRITE(*,*) ' grid V'
+	  WRITE(*,*)  'i=    ','      1            ','         2            ','          3   '
+	  WRITE(*,*)  sfingrd%glamv(1:3,1)
+	  WRITE(*,*)  sfingrd%gphiv(1:3,1)
+	  WRITE(*,*)  'i=    ','     n-2           ','        n-1           ','          n   '
+	  WRITE(*,*)  sfingrd%glamv(nxfine-2:nxfine,1)
+	  WRITE(*,*)  sfingrd%gphiv(nxfine-2:nxfine,1)
+	  WRITE(*,*) ''	
+	  WRITE(*,*) ' grid F'
+	  WRITE(*,*)  'i=    ','      1            ','         2            ','          3   '
+	  WRITE(*,*)  sfingrd%glamf(1:3,1)
+	  WRITE(*,*)  sfingrd%gphif(1:3,1)
+	  WRITE(*,*)  'i=    ','     n-2           ','        n-1           ','          n   '
+	  WRITE(*,*)  sfingrd%glamf(nxfine-2:nxfine,1)
+	  WRITE(*,*)  sfingrd%gphif(nxfine-2:nxfine,1)
+	  WRITE(*,*) ''
+	ENDIF
+	!
+	IF(nglobal.AND.nequator.EQ.1) THEN
+      ! *** GRID U
+	  jj = 1
+	  DO ji = nxfine/2 + nn_rhox,nxfine,2
+	    sfingrd%glamu(ji,nyfine-1) = sfingrd%glamu(nxfine/2+1 - jj,nyfine-1)
+	    sfingrd%gphiu(ji,nyfine-1) = sfingrd%gphiu(nxfine/2+1 - jj,nyfine-1)
+	    jj = jj+2
+	  ENDDO
+	  !
+	  jj = 0
+	  DO ji = 2,nxfine
+	    sfingrd%glamu(ji,nyfine) = sfingrd%glamu(nxfine - jj,nyfine-2)
+	    sfingrd%gphiu(ji,nyfine) = sfingrd%gphiu(nxfine - jj,nyfine-2)
+	    jj = jj+1
+	  ENDDO
+	  !	
+	  ! *** GRID T 
+	  jj = 0
+	  DO ji = nxfine/2 + nn_rhox,nxfine
+	    sfingrd%glamt(ji,nyfine-1) = sfingrd%glamt(nxfine/2+1 - jj,nyfine-1)
+	    sfingrd%gphit(ji,nyfine-1) = sfingrd%gphit(nxfine/2+1 - jj,nyfine-1)
+	    jj = jj+1
+	  ENDDO
+	  !
+	  jj = 0
+	  DO ji = 3,nxfine
+	    sfingrd%glamt(ji,nyfine) = sfingrd%glamt(nxfine - jj,nyfine-2)
+	    sfingrd%gphit(ji,nyfine) = sfingrd%gphit(nxfine - jj,nyfine-2)
+	    jj = jj+1
+	  ENDDO
+    ENDIF			  
+	!
+	WRITE(*,*) ''
+	WRITE(*,*) '### END SUBROUTINE child_grid ###'
+	WRITE(*,*) ''
+	!
+  END SUBROUTINE child_grid
+  !
+  !
+  !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!             
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+END MODULE cfg_tools
Index: trunk/NEMOGCM/TOOLS/GRIDGEN/src/create_coordinates.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/GRIDGEN/src/create_coordinates.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/GRIDGEN/src/create_coordinates.f90	(revision 2528)
@@ -0,0 +1,250 @@
+PROGRAM create_coordinates
+!!-----------------------------------------------------------
+!!
+!!	  to create regional coordinates file (e.g. 1_coordinates.nc)
+!!    for fine grid from coarse grid (e.g. coordinates.nc)
+!!
+!!   to make it we use a 4th order polynomial interpolation
+!!
+!!	        Created by Brice Lemaire on 12/2009.
+!!
+!!-----------------------------------------------------------
+  USE netcdf
+  USE cfg_tools
+  USE mixed_grid
+  USE domain
+  !------------
+  IMPLICIT NONE
+  !
+  INTEGER :: narg,iargc
+  INTEGER :: nstat, imodulo
+  INTEGER :: nik, njk, npk
+  INTEGER :: ival
+  CHARACTER(len=80) :: cnmlname, cfingrdname
+  !
+  !
+  !
+  !*************************************  
+  ! Read input file (namelist file)
+  !         using types.f90
+  !*************************************
+  narg = iargc()
+  !
+  IF (narg == 0) THEN
+    cnmlname = 'namelist.input'
+  ELSE
+	CALL getarg(1,cnmlname)
+  ENDIF
+  !
+  CALL read_namelist(cnmlname)  
+  !
+  nstat = read_coordinates(TRIM(cn_parent_coordinate_file),scoagrd)    
+  IF (nstat/=1) THEN    
+   WRITE(*,*) 'unable to open netcdf file : ',cn_parent_coordinate_file
+   STOP
+  ENDIF
+  !
+  nsizex = SIZE(scoagrd%glamt,1)
+  nsizey = SIZE(scoagrd%glamt,2)
+  !
+  WRITE(*,*) ''
+  WRITE(*,*) 'Size of input matrix: '
+  WRITE(*,*) '(',nsizex,';', nsizey,')' 
+  WRITE(*,*) ''
+  !
+  WRITE(*,*) 'Domain: '
+  WRITE(*,*) ''
+  WRITE(*,*) '           ', '    min(1,1:nsizey)       ', '      max(nsizex,1:nsizey)            '
+  WRITE(*,*) 'longitude: ', MINVAL(scoagrd%glamt(1,1:nsizey)), ' --> ', MAXVAL(scoagrd%glamf(nsizex,1:nsizey)) 
+  WRITE(*,*) 'latitude:  ', MINVAL(scoagrd%gphit(1:nsizex,1)), ' --> ', MAXVAL(scoagrd%gphif(1:nsizex,nsizey)) 
+  WRITE(*,*) ''
+  !
+  !*************************************  
+  ! Check the values read in the namelist
+  !*************************************
+  IF(nn_imin.LE.0.OR.nn_imin.GT.nsizex)THEN
+    WRITE(*,*) 'Wrong values in namelist:'
+	WRITE(*,*) 'nn_imin must be greater than 0 and less than', nsizex
+	STOP
+  ENDIF
+  !
+  IF(nn_imax.LE.0.OR.nn_imax.GT.nsizex)THEN
+    WRITE(*,*) 'Wrong values in namelist:'
+	WRITE(*,*) 'nn_imax must be greater than 0 and less than', nsizex
+	STOP
+  ENDIF
+  !
+  IF(nn_jmin.LE.0.OR.nn_jmin.GT.nsizey)THEN
+    WRITE(*,*) 'Wrong values in namelist:'
+	WRITE(*,*) 'nn_jmin must be greater than 0 and less than', nsizey
+	STOP
+  ENDIF
+  !
+  IF(nn_jmax.LE.0.OR.nn_jmax.GT.nsizey)THEN
+    WRITE(*,*) 'Wrong values in namelist:'
+	WRITE(*,*) 'nn_jmax must be greater than 0 and less than', nsizey
+	STOP
+  ENDIF
+  !
+  !*************************************  
+  ! Define the sub-domain chosen by user
+  !*************************************
+  WRITE(*,*) 'Domain defined by user: '
+  WRITE(*,*) ''
+  WRITE(*,*) '           ', '          min           ', '               max            '
+  WRITE(*,*) 'longitude: ', MINVAL(scoagrd%glamt(nn_imin,nn_jmin:nn_jmax)), ' --> ', MAXVAL(scoagrd%glamf(nn_imax,nn_jmin:nn_jmax)) 
+  WRITE(*,*) 'latitude:  ', MINVAL(scoagrd%gphit(nn_imin:nn_imax,nn_jmin)), ' --> ', MAXVAL(scoagrd%gphif(nn_imin:nn_imax,nn_jmax)) 
+  WRITE(*,*) ''
+  !
+  IF(nn_imin.EQ.nn_imax.AND.nn_jmin.EQ.nn_jmax) THEN
+    nglobal = .TRUE.
+	WRITE(*,*) 'Size of domain: GLOBAL'
+  ELSE
+    nglobal = .FALSE.
+	WRITE(*,*) 'Size of domain: REGIONAL'
+  ENDIF
+  !
+  IF(cn_position_pivot.EQ.'F-grid') THEN       !case of ORCA05 & ORCA025 grids
+   npivot = 0
+  ELSEIF(cn_position_pivot.EQ.'T-grid') THEN   !case of ORCA2 grid
+   npivot = 1
+  ENDIF
+  !
+  nmid = nsizex/2 + npivot
+  !
+  !
+  !
+  !*************************************
+  ! Redefine for particular cases
+  !*************************************
+  IF(((nn_imax - nn_imin).EQ.-1).OR.((nn_imax - nn_imin).EQ.-2)) THEN
+    nn_imax = nn_imin
+  ELSEIF(ABS(nn_imin - nn_imax).GE.nsizex-1) THEN
+    nn_imax = nn_imin
+  ELSEIF((nn_imin.EQ.1).AND.(nn_imax.EQ.nsizex)) THEN
+    nn_imax = nn_imin
+  ELSEIF(nn_imin.EQ.1.AND.nn_imax.GT.nn_imin) THEN
+    nn_imin = nsizey-2
+  ELSEIF(nn_imax.EQ.nsizex) THEN
+    nn_imax = 3
+  ELSEIF(nn_imin.EQ.nsizex) THEN
+    nn_imin = nsizex-1
+  ELSEIF(nn_imax.EQ.1.AND.nn_imax.NE.nn_imin) THEN
+    nn_imax = 2
+  ENDIF
+  !
+  !
+  !
+  !*************************************
+  ! We want to fix equator along T and U-points
+  !*************************************
+  imodulo =  MOD(nn_rhoy,2)    
+  !
+  IF(.NOT.nglobal.AND.(scoagrd%gphit(nn_imin,nn_jmin)*scoagrd%gphit(nn_imin,nn_jmax)).LT.0.AND.imodulo.EQ.0) THEN 
+    nequator = 1
+  ELSEIF(nglobal.AND.imodulo.EQ.0) THEN
+    nequator = 1
+  ELSE
+    nequator = 0
+  ENDIF	  
+  !
+  !
+  !
+  !*************************************
+  ! CREATE MIXED GRID
+  !*************************************
+  CALL define_domain
+  !
+  CALL define_mixed_grid 
+  !
+  !
+  !
+  !*************************************
+  !!! CALCULATE FINE GRID DIMENSIONS
+  !************************************* 
+  IF(.NOT.nglobal) THEN
+	IF(nn_rhox.EQ.1) THEN 
+	  nxfine = nxcoag
+	ELSE
+	  nxfine = (nxcoag-2)*nn_rhox + 1
+	ENDIF  
+	!
+	 IF(nn_rhoy.EQ.1) THEN 
+	  nyfine = nycoag
+	ELSE
+	  nyfine = (nycoag-2)*nn_rhoy + 1
+	ENDIF  
+	!
+  ELSEIF(nglobal) THEN
+    IF(nn_rhox.GT.1) THEN
+	  nxfine = (nxgmix - 4*(nn_rhox-1))/2
+	ELSEIF(nn_rhox.EQ.1) THEN
+	  nxfine = nsizex
+	ENDIF
+	!
+	IF(nn_rhoy.GT.1) THEN
+	  nyfine = (nygmix - (2*nn_rhoy))/2 - nn_rhoy + nequator
+	ELSEIF(nn_rhoy.EQ.1) THEN
+	  nyfine = nsizey
+	ENDIF
+	!
+  ENDIF
+  !
+  WRITE(*,*) ''
+  WRITE(*,*) '*** SIZE OF FINE GRID ***'
+  WRITE(*,*) nxfine, ' x ', nyfine
+  WRITE(*,*) ''
+  !
+  !
+  !
+  !*************************************
+  ! Interpolation inside the mixed grid
+  !        from cfg_tools.f90
+  !*************************************
+  IF(nn_rhox.GT.1.OR.nn_rhoy.GT.1) THEN
+	CALL interp_grid    
+  ENDIF
+  !  
+  !
+  ! 
+  !*************************************  
+  ! Define name of child coordinate file  
+  !  coordinates.nc -> 1_coordinates.nc
+  !*************************************
+  CALL set_child_name(cn_parent_coordinate_file,cfingrdname)      
+  !
+  !
+  !
+  !*************************************
+  ! Allocation of child grid elements
+  !          from types.f90
+  !*************************************
+  CALL grid_allocate(sfingrd,nxfine,nyfine)                         
+  !
+  !
+  !
+  !*************************************
+  ! Break the mixed grid smixgrd into 4 grids 
+  !        from cfg_tools.f90
+  !*************************************
+  CALL child_grid                                
+  !     
+  !
+  !
+  !*************************************
+  ! Read parent coordinate file
+  !      from readwrite.f90
+  !*************************************
+  nstat = write_coordinates(cfingrdname,sfingrd,nxfine,nyfine)      
+  IF (nstat/=1) THEN    
+   WRITE(*,*)"unable to write netcdf file : ",cfingrdname
+   STOP
+  ENDIF
+  !	
+  CALL grid_deallocate(scoagrd)
+  CALL grid_deallocate(sfingrd)
+  CALL mixed_grid_deallocate(smixgrd)
+  !
+  !
+  !
+END PROGRAM create_coordinates
Index: trunk/NEMOGCM/TOOLS/GRIDGEN/src/domain.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/GRIDGEN/src/domain.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/GRIDGEN/src/domain.f90	(revision 2528)
@@ -0,0 +1,172 @@
+MODULE domain
+!!-----------------------------------------------------------
+!!
+!!         module to define domain to extract 
+!!                 from initial grid
+!!
+!!	       Created by Brice Lemaire on 01/2010.
+!!
+!!-----------------------------------------------------------
+  USE readwrite
+  USE mixed_grid
+  !
+  IMPLICIT NONE
+  PUBLIC
+  !
+  CONTAINS
+  !********************************************************
+  !              SUBROUTINE  define_domain              *
+  !												        *
+  !      to define the domain of the coarse grid        *
+  !			        which will be used 					*
+  !                                                     *
+  !          CALLED from create_coordinates             *
+  !******************************************************** 
+  SUBROUTINE define_domain
+  !
+  WRITE(*,*) ''
+  WRITE(*,*) ' ### SUBROUTINE define_domain ### '
+  WRITE(*,*) ''
+  !
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  ! *** without northern boundary ***
+  IF((nn_jmax.LT.(nsizey-1)).AND.(nn_jmax.GT.nn_jmin)) THEN             
+    !
+    WRITE(*,*) ' ****************************** ' 
+    WRITE(*,*) ' *** WITHOUT NORTH BOUNDARY *** '
+    WRITE(*,*) ' ****************************** ' 
+    !     
+	! *** with left/right boundary *** 
+	IF(nn_imin.GT.nn_imax) THEN                                        
+	  nxcoag = (nsizex - (nn_imin-1) + 1) + ((nn_imax+1) - 2) 
+	! *** all around the earth ***  
+	ELSEIF(nn_imin.EQ.nn_imax) THEN                       
+	  nxcoag = nsizex
+	ELSE
+	  nxcoag = (nn_imax+1) - (nn_imin-1) + 1                 	
+	ENDIF
+	!  
+	!(+/-1) we need ghost cells to make interpolation
+	nycoag = (nn_jmax+1) - (nn_jmin-1) + 1                
+	!
+  ENDIF
+  !
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !  
+  ! *** along northern boundary ***
+  IF((nn_jmax.LE.nn_jmin).OR.(nn_jmax.GE.nsizey-1)) THEN             
+    !
+    WRITE(*,*) ' **************************** ' 
+    WRITE(*,*) ' *** ALONG NORTH BOUNDARY *** '
+    WRITE(*,*) ' **************************** ' 
+	!
+	! *** with left/right boundary ***
+	IF(nn_imin.GT.nn_imax) THEN                       
+	  !
+	  WRITE(*,*) '' 
+	  WRITE(*,*) ' ** asian bipole ** '
+	  WRITE(*,*) '' 
+	  !	  
+	  nval1 = nsizex - nn_imin + 1
+	  nval2 = nn_imax  
+	  nn_jmin = nn_jmax
+	  !
+	  ! *** to respect symmetry around asian bipole ***
+	  IF((nval1.LT.nval2).AND.(nval2.LT.nmid)) THEN       
+        !
+		nn_imin = nsizex - nval2 + 1	
+		nxcoag = nval2
+		nycoag = (nsizey+1 - (nn_jmin-1))  + (nsizey+1 - (nn_jmax-1)) - 2		  
+	    ! 
+	    ELSEIF((nval1.GE.nval2).AND.(nval1.LT.nmid)) THEN
+	    !
+	    nn_imax = nval1
+		nxcoag = nval1 
+		nycoag = (nsizey+1 - (nn_jmin-1))  + (nsizey+1 - (nn_jmax-1)) - 2		  
+		!
+		! *** all around the earth ***
+	    ELSE                                         
+	    !
+	    nn_imax = nn_imin	
+		!		
+      ENDIF
+	ENDIF
+	!
+	IF(nn_imin.LT.nn_imax) THEN                           
+	  !
+	  ! *** without bipole ***
+	  IF(((nn_imin.LT.nmid).AND.(nn_imax.LT.nmid)).OR.((nn_imin.GT.nmid).AND.(nn_imax.GT.nmid))) THEN  
+	    !
+	    WRITE(*,*) '' 
+	    WRITE(*,*) ' ** without bipole ** '
+	    WRITE(*,*) '' 
+	    !	 	    
+	    nxcoag = (nn_imax+1) - (nn_imin-1) + 1 
+	    nycoag = (nsizey+1 - (nn_jmin-1))  + (nsizey+1 - (nn_jmax-1)) - 2 -0   
+	    !
+		! *** including canada bipole ***
+	    ELSEIF((nn_imin.LE.nmid).AND.(nn_imax.GE.nmid)) THEN    
+		!
+		WRITE(*,*) '' 
+		WRITE(*,*) ' ** canadian bipole ** '
+		WRITE(*,*) '' 
+		!	 		
+		nn_jmin = nn_jmax
+		nval1 = nmid - nn_imin 
+		nval2 = nn_imax - (nmid-1) 
+		!
+		! *** to respect around canada bipole ***
+		IF(nval1.LT.nval2) THEN    
+		  !
+		  nn_imin = nmid - nval2	
+		  nxcoag = (nval2+1)  
+	      nycoag = (nsizey+1 - (nn_jmin-1))  + (nsizey+1 - (nn_jmax-1)) - 2	- (2*npivot)	  
+		  ! 
+		  ELSEIF(nval1.GE.nval2) THEN
+		  !
+		  nn_imax = nmid + nval1
+		  nxcoag = (nval1+1)  
+	      nycoag = (nsizey+1 - (nn_jmin-1))  + (nsizey+1 - (nn_jmax-1)) - 2	- (2*npivot)	  
+		  !
+		ENDIF    
+	  ENDIF	
+    ENDIF
+  ENDIF
+    !
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    !
+	IF(nglobal) THEN                                  !Global
+	  !                                                Don't change the global shape of the matrix
+	  WRITE(*,*) '' 
+	  WRITE(*,*) ' ** global ** '
+	  WRITE(*,*) '' 
+	  !	  
+	  nn_imin = 1
+	  nn_imax = nsizex
+	  nn_jmin = 1
+	  nn_jmax = nsizey
+	  nxcoag = nsizex
+	  nycoag = nsizey
+	  !
+	ELSEIF(nn_imin.EQ.nn_imax) THEN      !Semi-global (e.g northern hemisphere)  
+	  !                                   Change the global shape -> suppression of the northern boundary and bipoles 
+	  WRITE(*,*) '' 
+	  WRITE(*,*) ' ** all around the earth (2 bipoles) ** '
+	  WRITE(*,*) '' 
+	  !	 	
+	  nn_imin = 2 
+	  nn_imax = nmid
+	  nn_jmin = nn_jmax
+	  nxcoag = (nn_imax+1) - (nn_imin-1) + 1 
+	  nycoag = (nsizey+1 - (nn_jmin-1))  + (nsizey+1 - (nn_jmax-1)) - 2	
+	  !
+	ENDIF
+  !  
+  WRITE(*,*) ''
+  WRITE(*,*) ' ### END SUBROUTINE define_domain ### '
+  WRITE(*,*) ''
+  !
+  END SUBROUTINE
+  !
+END MODULE
Index: trunk/NEMOGCM/TOOLS/GRIDGEN/src/io_netcdf.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/GRIDGEN/src/io_netcdf.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/GRIDGEN/src/io_netcdf.f90	(revision 2528)
@@ -0,0 +1,1688 @@
+!************************************************************************
+!                  Fortran 95 OPA Nesting tools			    			*
+!					                                    				*
+!     Copyright (C) 2005 Florian Lemari�(Florian.Lemarie@imag.fr)	    *
+!									                                    *
+!************************************************************************
+!
+!********************************************************************************
+!		                                        								*
+!                              module io_netcdf		    						*
+!						                                        				*
+!                  NetCDF Fortran 90 read/write interface	    				*
+!                  using input/output functions provided						*
+!                                 by unidata									*
+!						                                        				*
+!http://my.unidata.ucar.edu/content/software/netcdf/docs/netcdf-f90/index.html	*
+!									                                        	*
+!********************************************************************************
+!
+!
+!
+MODULE io_netcdf
+  !      
+  USE netcdf
+  USE types
+  !      
+  INTERFACE Read_Ncdf_var
+     MODULE PROCEDURE Read_Ncdf_var1d_Real,       &
+                      Read_Ncdf_var2d_Real,       &
+                      Read_Ncdf_var2d_Real_bis,   &
+                      Read_Ncdf_var3d_Real,       &
+                      Read_Ncdf_var4d_Real,       &
+                      Read_Ncdf_var3d_Real_t,     &
+                      Read_Ncdf_var4d_Real_t,     &
+                      Read_Ncdf_var4d_Real_nt,    &
+                      Read_Ncdf_var1d_Int,        &
+                      Read_Ncdf_var2d_Int,        &
+                      Read_Ncdf_var3d_Int,        &
+                      Read_Ncdf_var4d_Int,        &
+                      Read_Ncdf_var0d_Int,        &
+                      Read_Ncdf_var0d_Real
+  END INTERFACE
+  !
+  INTERFACE Write_Ncdf_var
+     MODULE PROCEDURE Write_Ncdf_var1d_Real,      &
+					  Write_Ncdf_var2d_Real,      &
+					  Write_Ncdf_var3d_Real,      &
+					  Write_Ncdf_var4d_Real,      &
+					  Write_Ncdf_var3d_Real_t,    &
+					  Write_Ncdf_var4d_Real_t,    &
+					  Write_Ncdf_var4d_Real_nt,   &                           
+					  Write_Ncdf_var2d_Real_bis,  &			   
+					  Write_Ncdf_var1d_Int,       &
+					  Write_Ncdf_var2d_Int,       &
+					  Write_Ncdf_var3d_Int,       &
+					  Write_Ncdf_var4d_Int,       &
+					  Write_Ncdf_var0d_Real
+  END INTERFACE
+  ! 
+  INTERFACE Copy_Ncdf_att
+     MODULE PROCEDURE Copy_Ncdf_att_latlon,Copy_Ncdf_att_var
+  END INTERFACE
+  !
+CONTAINS
+  !
+  !****************************************************************
+  !                 subroutine Read_Ncdf_dim					*
+  !				                                				*
+  !     subroutine to retrieve value of a given dimension 		*
+  !	                                							*
+  !     dimname : name of dimension to retrieve		        	*
+  !     file    : netcdf file name				                *
+  !     dimval  : value of the required dimension   			*
+  !								                                *
+  !****************************************************************
+  !
+  SUBROUTINE Read_Ncdf_dim(dimname,file,dimval)   
+    !      
+    IMPLICIT NONE
+    !           
+    CHARACTER(*),INTENT(in) :: dimname,file    
+    INTEGER    :: dimval
+    INTEGER ncid,status,dimid
+    !     
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname,dimid)
+    status = nf90_inquire_dimension(ncid,dimid,len=dimval)						                
+    status = nf90_close(ncid)
+    !      
+  END SUBROUTINE Read_Ncdf_dim
+  !
+  !   
+  !
+  !****************************************************************
+  !                subroutine Write_Ncdf_dim					*
+  !		                                 						*
+  !      subroutine to write a dimension in a given file 		*
+  !		                                						*
+  !     dimname : name of dimension to initialize    			*
+  !     file    : netcdf file name				                *
+  !     dimval  : value of the dimension to write	     		*
+  !								                                *
+  !****************************************************************
+  SUBROUTINE Write_Ncdf_dim(dimname,file,dimval)   
+    !      
+    IMPLICIT NONE
+    !           
+    CHARACTER(*),INTENT(in) :: dimname,file    
+    INTEGER    :: dimval
+    !      
+    ! local variables
+    !
+    INTEGER ncid,status,dimid
+    !     
+    status = nf90_open(file,NF90_WRITE,ncid)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_redef(ncid)
+    IF(dimval.EQ.0) THEN
+       status = nf90_def_dim(ncid,dimname,nf90_unlimited,dimid)       
+    ELSE
+       status = nf90_def_dim(ncid,dimname,dimval,dimid)  
+    END IF
+    !
+    status = nf90_enddef(ncid)
+    !      
+    status = nf90_close(ncid)
+    !      
+  END SUBROUTINE Write_Ncdf_dim
+  !
+  !
+  !
+  !****************************************************************
+  !                 subroutine Read_Ncdf_var					   *
+  !		                                						   *
+  !     subroutine to retrieve values of a given variable 		   *
+  !				                                				   *
+  !     varname : name of variable to retrieve	        		   *
+  !     file    : netcdf file name			                	   *
+  !     tabvar  : array containing values of the required variable *
+  !								                                   *
+  !****************************************************************   
+  SUBROUTINE Read_Ncdf_var1d_Real(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    REAL*8, DIMENSION(:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER, DIMENSION(1) :: dimID
+    INTEGER :: dim1
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimID)
+    status=nf90_inquire_dimension(ncid,dimID(1),len=dim1)
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1))  
+    ELSE
+       IF( ANY(SHAPE(tabvar)/=(/dim1/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1))      
+       ENDIF
+    ENDIF
+    !        
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE Read_Ncdf_var1d_Real
+  !           
+  !            
+  !           
+  !**************************************************************
+  !         subroutine Read_Ncdf_var2d_real
+  !**************************************************************          
+  SUBROUTINE Read_Ncdf_var2d_Real(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    REAL*8, DIMENSION(:,:), POINTER :: tabvar
+    !local variables
+    INTEGER, DIMENSION(10) :: dimIDS
+    INTEGER :: dim1,dim2
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2))  
+    ELSE
+       IF( ANY(SHAPE(tabvar)/=(/dim1,dim2/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1,dim2))      
+       ENDIF
+    ENDIF
+    !       
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE Read_Ncdf_var2d_Real
+  !           
+  !
+  !           
+  !**************************************************************
+  !   subroutine Read_Ncdf_var2d_real_bis
+  !**************************************************************          
+  SUBROUTINE Read_Ncdf_var2d_Real_bis(varname,file,tabvar,strt,cnt)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    REAL*8, DIMENSION(:,:), POINTER :: tabvar
+    !local variables
+    INTEGER, DIMENSION(10) :: dimIDS
+    INTEGER, DIMENSION(2) :: strt,cnt
+    INTEGER :: dim1,dim2
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    dim1 = cnt(1) 
+    dim2 = cnt(2)
+    !      
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2))  
+    ELSE
+       IF( ANY(SHAPE(tabvar)/=(/dim1,dim2/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1,dim2))      
+       ENDIF
+    ENDIF
+    !       
+    status=nf90_get_var(ncid,varid,tabvar,start = strt,count = cnt)     
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE Read_Ncdf_var2d_Real_bis
+  !
+  !
+  !           
+  !**************************************************************
+  !   subroutine Read_Ncdf_var3d_real
+  !**************************************************************          
+  SUBROUTINE Read_Ncdf_var3d_Real(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    REAL*8, DIMENSION(:,:,:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER, DIMENSION(10) :: dimIDS
+    INTEGER :: dim1,dim2,dim3
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)  
+    status=nf90_inquire_dimension(ncid,dimIDS(3),len=dim3)
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2,dim3))  
+    ELSE
+       IF( ANY(SHAPE(tabvar) /= (/dim1,dim2,dim3/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1,dim2,dim3))      
+       ENDIF
+    ENDIF
+    !      
+    status=nf90_get_var(ncid,varid,tabvar) 
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to retrieve netcdf variable : ",TRIM(varname)
+       STOP
+    ENDIF
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE Read_Ncdf_var3d_Real
+  !           
+  !
+  !           
+  !**************************************************************
+  !         subroutine Read_Ncdf_var4d_real
+  !**************************************************************          
+  SUBROUTINE Read_Ncdf_var4d_Real(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    REAL*8, DIMENSION(:,:,:,:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER, DIMENSION(10) :: dimIDS
+    INTEGER :: dim1,dim2,dim3,dim4
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)  
+    status=nf90_inquire_dimension(ncid,dimIDS(3),len=dim3)   
+    status=nf90_inquire_dimension(ncid,dimIDS(4),len=dim4)       
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2,dim3,dim4))  
+    ELSE
+       IF( ANY(SHAPE(tabvar) /= (/dim1,dim2,dim3,dim4/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1,dim2,dim3,dim4))      
+       ENDIF
+    ENDIF
+    !  
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE Read_Ncdf_var4d_Real
+
+  SUBROUTINE Read_Ncdf_var0d_Real(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    REAL*8 :: tabvar
+    !
+    !local variables
+    !
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    !
+    !  
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE Read_Ncdf_var0d_Real
+
+  SUBROUTINE Read_Ncdf_var0d_Int(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    INTEGER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    !
+    !  
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE Read_Ncdf_var0d_Int
+  !           
+  !             
+  !           
+  !**************************************************************
+  !   subroutine Read_Ncdf_var1d_int
+  !**************************************************************          
+  SUBROUTINE Read_Ncdf_var1d_Int(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    INTEGER, DIMENSION(:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER,DIMENSION(10) :: dimID
+    INTEGER :: dim1
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimID)
+    status=nf90_inquire_dimension(ncid,dimID(1),len=dim1)          
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1))  
+    ELSE
+       IF( ANY(SHAPE(tabvar) /= (/dim1/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1))      
+       ENDIF
+    ENDIF
+    !  
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    !      
+  END SUBROUTINE Read_Ncdf_var1d_Int
+  !           
+  !         
+  !           
+  !**************************************************************
+  !   subroutine Read_Ncdf_var2d_int
+  !**************************************************************          
+  SUBROUTINE Read_Ncdf_var2d_Int(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    INTEGER, DIMENSION(:,:), POINTER :: tabvar
+    !local variables
+    INTEGER, DIMENSION(10) :: dimIDS
+    INTEGER :: dim1,dim2
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)      
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2))  
+    ELSE
+       IF( ANY(SHAPE(tabvar) /= (/dim1,dim2/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1,dim2))      
+       ENDIF
+    ENDIF
+    !  
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    !      
+  END SUBROUTINE Read_Ncdf_var2d_Int
+  !           
+  !
+  !           
+  !**************************************************************
+  !   subroutine Read_Ncdf_var3d_Int
+  !**************************************************************          
+  SUBROUTINE Read_Ncdf_var3d_Int(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    INTEGER, DIMENSION(:,:,:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER, DIMENSION(10) :: dimIDS
+    INTEGER :: dim1,dim2,dim3
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)  
+    status=nf90_inquire_dimension(ncid,dimIDS(3),len=dim3)          
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2,dim3))  
+    ELSE
+       IF( ANY(SHAPE(tabvar) /= (/dim1,dim2,dim3/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1,dim2,dim3))      
+       ENDIF
+    ENDIF
+    ! 
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    !      
+  END SUBROUTINE Read_Ncdf_var3d_Int
+  !           
+  !
+  !
+  !**************************************************************
+  !   subroutine Read_Ncdf_var4d_int
+  !**************************************************************          
+  SUBROUTINE Read_Ncdf_var4d_Int(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    INTEGER, DIMENSION(:,:,:,:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER, DIMENSION(10) :: dimIDS
+    INTEGER :: dim1,dim2,dim3,dim4
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)  
+    status=nf90_inquire_dimension(ncid,dimIDS(3),len=dim3)   
+    status=nf90_inquire_dimension(ncid,dimIDS(4),len=dim4)       
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2,dim3,dim4))  
+    ELSE
+       IF( ANY(SHAPE(tabvar) /= (/dim1,dim2,dim3,dim4/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1,dim2,dim3,dim4))      
+       ENDIF
+    ENDIF
+    !  
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE Read_Ncdf_var4d_Int
+  !           
+  !  
+  !
+  !****************************************************************
+  !                subroutine Write_Ncdf_var					*
+  !			                                 					*
+  !       subroutine to write a variable in a given file 		*
+  !	                                							*
+  !     varname : name of variable to store		            	*     
+  !     dimname : name of dimensions of the given variable	    *
+  !     file    : netcdf file name				                *
+  !     tabvar  : values of the variable to write		     	*
+  !								                                *
+  !****************************************************************
+  !    
+  !      
+  !**************************************************************
+  !      subroutine Write_Ncdf_var1d_real
+  !**************************************************************    
+  SUBROUTINE Write_Ncdf_var1d_Real(varname,dimname,file,tabvar,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,dimname,typevar
+    REAL*8, DIMENSION(:), POINTER :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname, dimid)
+    status = nf90_inq_varid(ncid,varname,varid)
+    status = nf90_redef(ncid)
+    SELECT CASE(TRIM(typevar))
+    CASE('double')
+       status = nf90_def_var(ncid,varname,nf90_double,(/dimid/),varid)
+    CASE('float')
+       status = nf90_def_var(ncid,varname,nf90_float,(/dimid/),varid)      
+    END SELECT
+    status = nf90_enddef(ncid)
+    status = nf90_put_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE Write_Ncdf_var1d_Real
+  !      
+  !
+  !   
+  !**************************************************************
+  !   subroutine Write_Ncdf_var2d_real
+  !**************************************************************    
+  SUBROUTINE Write_Ncdf_var2d_Real_bis(varname,dimname,file,tabvar,nbdim,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    INTEGER,INTENT(in) :: nbdim
+    CHARACTER(*), DIMENSION(4) :: dimname
+    REAL*8, DIMENSION(:,:) :: tabvar
+    REAL*8, DIMENSION(:,:,:),POINTER :: tabtemp3d
+    REAL*8, DIMENSION(:,:,:,:),POINTER :: tabtemp4d
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2,dimid3,dimid4
+    INTEGER :: status,ncid,ncid2
+    INTEGER :: varid,varid2             
+    ! 
+    IF(nbdim==4) THEN      
+       ALLOCATE(tabtemp4d(SIZE(tabvar,1),SIZE(tabvar,2),1,1))
+       tabtemp4d(:,:,1,1) = tabvar(:,:)
+    ELSE IF(nbdim==3) THEN
+       ALLOCATE(tabtemp3d(SIZE(tabvar,1),SIZE(tabvar,2),1))
+       tabtemp3d(:,:,1) = tabvar(:,:)
+    END IF
+    !      
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+    status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+    status = nf90_inq_dimid(ncid,dimname(3), dimid3)
+    !      
+    IF(nbdim==4) status = nf90_inq_dimid(ncid,dimname(4), dimid4)
+    !      
+    status = nf90_inq_varid(ncid,varname,varid)
+    status = nf90_redef(ncid)
+    IF(nbdim==4 .AND. typevar == 'double') THEN
+       status = nf90_def_var(ncid,varname,nf90_double,     &
+            (/dimid1,dimid2,dimid3,dimid4/),varid)
+       !                              
+    ELSE IF(nbdim==4 .AND. typevar == 'float') THEN
+       status = nf90_def_var(ncid,varname,nf90_float,     &
+            (/dimid1,dimid2,dimid3,dimid4/),varid)                        
+       !          
+    ELSE IF(nbdim==3 .AND. typevar == 'float') THEN
+       status = nf90_def_var(ncid,varname,nf90_float,     &
+            (/dimid1,dimid2,dimid3/),varid)
+       !
+    ELSE IF(nbdim==3 .AND. typevar == 'double') THEN
+       status = nf90_def_var(ncid,varname,nf90_double,     &
+            (/dimid1,dimid2,dimid3/),varid)
+       !     			      			      
+    ENDIF
+    !      			      
+    status = nf90_enddef(ncid)
+    IF(nbdim==4) status = nf90_put_var(ncid,varid,tabtemp4d)
+    IF(nbdim==3) status = nf90_put_var(ncid,varid,tabtemp3d)
+    !      
+    IF(ASSOCIATED( tabtemp3d ) ) DEALLOCATE( tabtemp3d )   
+    IF(ASSOCIATED( tabtemp4d ) ) DEALLOCATE( tabtemp4d )     
+    !
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE Write_Ncdf_var2d_Real_bis
+  !      
+  !
+  !      
+  !**************************************************************
+  !   subroutine Write_Ncdf_var2d_real
+  !**************************************************************    
+  SUBROUTINE Write_Ncdf_var2d_Real(varname,dimname,file,tabvar,typevar)
+    !      
+	IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    CHARACTER(*), DIMENSION(2) :: dimname
+    REAL*8, DIMENSION(:,:), POINTER :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+    status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+    status = nf90_inq_varid(ncid,varname,varid)
+    status = nf90_redef(ncid)
+
+    SELECT CASE(TRIM(typevar))
+    CASE('double')
+       status = nf90_def_var(ncid,varname,nf90_double,     &
+            (/dimid1,dimid2/),varid)
+    CASE('float')
+       status = nf90_def_var(ncid,varname,nf90_float,     &
+            (/dimid1,dimid2/),varid)     
+    END SELECT
+    !
+    status = nf90_enddef(ncid)
+    status = nf90_put_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE Write_Ncdf_var2d_Real
+  !      
+  !
+  !      
+  !**************************************************************
+  !   subroutine Write_Ncdf_var3d_real
+  !**************************************************************
+  SUBROUTINE Write_Ncdf_var3d_Real(varname,dimname,file,tabvar,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    CHARACTER(*),DIMENSION(3),INTENT(in) :: dimname
+    REAL*8, DIMENSION(:,:,:), POINTER :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2,dimid3
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+    status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+    status = nf90_inq_dimid(ncid,dimname(3), dimid3)
+    status = nf90_inq_varid(ncid,varname,varid)
+    status = nf90_redef(ncid)
+    !
+    SELECT CASE(TRIM(typevar))
+    CASE('double')
+       status = nf90_def_var(ncid,varname,nf90_double,     &
+            (/dimid1,dimid2,dimid3/),varid)
+    CASE('float')
+       status = nf90_def_var(ncid,varname,nf90_float,     &
+            (/dimid1,dimid2,dimid3/),varid)    
+    END SELECT
+    !
+    status = nf90_enddef(ncid)
+    status = nf90_put_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE Write_Ncdf_var3d_Real
+  !      
+  !
+  !
+  !**************************************************************
+  !   subroutine Write_Ncdf_var4d_real
+  !**************************************************************
+  SUBROUTINE Write_Ncdf_var4d_Real(varname,dimname,file,tabvar,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    CHARACTER(*),DIMENSION(4),INTENT(in) :: dimname
+    REAL*8, DIMENSION(:,:,:,:), POINTER :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2,dimid3,dimid4
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !
+    status = nf90_inq_varid(ncid,varname,varid)
+    !      
+    IF(status/=nf90_noerr) THEN
+       !     
+       status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+       status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+       status = nf90_inq_dimid(ncid,dimname(3), dimid3)
+       status = nf90_inq_dimid(ncid,dimname(4), dimid4)
+       status = nf90_redef(ncid)
+       !      
+       SELECT CASE(TRIM(typevar))
+       CASE('double')
+          status = nf90_def_var(ncid,varname,nf90_double,     &
+               (/dimid1,dimid2,dimid3,dimid4/),varid)
+       CASE('float')
+          status = nf90_def_var(ncid,varname,nf90_float,     &
+               (/dimid1,dimid2,dimid3,dimid4/),varid)   
+       END SELECT
+       !
+       status = nf90_enddef(ncid)
+    ENDIF
+    !         
+    status = nf90_put_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE Write_Ncdf_var4d_Real
+  !      
+  !
+  !  
+  !**************************************************************
+  !   subroutine Write_Ncdf_var1d_Int
+  !**************************************************************    
+  SUBROUTINE Write_Ncdf_var1d_Int(varname,dimname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,dimname
+    INTEGER, DIMENSION(:), POINTER :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname, dimid)
+    status = nf90_inq_varid(ncid,varname,varid)
+    status = nf90_redef(ncid)
+    status = nf90_def_var(ncid,varname,nf90_int,(/dimid/),varid)
+    status = nf90_enddef(ncid)
+    status = nf90_put_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE Write_Ncdf_var1d_Int
+  !      
+  ! 
+  !      
+  !**************************************************************
+  !   subroutine Write_Ncdf_var2d_Int
+  !**************************************************************    
+  SUBROUTINE Write_Ncdf_var2d_Int(varname,dimname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    CHARACTER(*), DIMENSION(2) :: dimname
+    INTEGER, DIMENSION(:,:), POINTER :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+    status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+    status = nf90_inq_varid(ncid,varname,varid)
+    status = nf90_redef(ncid)
+    status = nf90_def_var(ncid,varname,nf90_int,     &
+         (/dimid1,dimid2/),varid)
+    status = nf90_enddef(ncid)
+    status = nf90_put_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE Write_Ncdf_var2d_Int
+  !      
+  !
+  !      
+  !**************************************************************
+  !   subroutine Write_Ncdf_var3d_Int
+  !**************************************************************
+  SUBROUTINE Write_Ncdf_var3d_Int(varname,dimname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    CHARACTER(*),DIMENSION(3),INTENT(in) :: dimname
+    INTEGER, DIMENSION(:,:,:), POINTER :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2,dimid3
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+    status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+    status = nf90_inq_dimid(ncid,dimname(3), dimid3)
+    status = nf90_inq_varid(ncid,varname,varid)
+    status = nf90_redef(ncid)
+    status = nf90_def_var(ncid,varname,nf90_int,     &
+         (/dimid1,dimid2,dimid3/),varid)
+    status = nf90_enddef(ncid)
+    status = nf90_put_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE Write_Ncdf_var3d_Int
+  !      
+  !
+  !
+  !**************************************************************
+  !   subroutine Write_Ncdf_var4d_Int
+  !**************************************************************
+  SUBROUTINE Write_Ncdf_var4d_Int(varname,dimname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    CHARACTER(*),DIMENSION(4),INTENT(in) :: dimname
+    INTEGER, DIMENSION(:,:,:,:), POINTER :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2,dimid3,dimid4
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+    status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+    status = nf90_inq_dimid(ncid,dimname(3), dimid3)
+    status = nf90_inq_dimid(ncid,dimname(4), dimid4)
+    status = nf90_inq_varid(ncid,varname,varid)
+    status = nf90_redef(ncid)
+    status = nf90_def_var(ncid,varname,nf90_int,     &
+         (/dimid1,dimid2,dimid3,dimid4/),varid)
+    status = nf90_enddef(ncid)
+    status = nf90_put_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE Write_Ncdf_var4d_Int
+  !      
+  !
+  !
+  !****************************************************************
+  !               subroutine Read_Ncdf_var_t					*
+  !						                                		*
+  !  subroutine to read a variable in a given file for time t	*
+  !						                                		*
+  !     varname : name of variable to read		            	*     
+  !     file    : netcdf file name				                *
+  !     tabvar  : values of the read variable	         		*
+  !     time    : time corresponding to the values to read	    *	
+  !								                                *
+  !****************************************************************
+  !
+  !
+  !**************************************************************
+  !          subroutine Read_Ncdf_var3d_real_t
+  !**************************************************************          
+  SUBROUTINE Read_Ncdf_var3d_Real_t(varname,file,tabvar,time)
+    !      
+    USE types     
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    INTEGER,INTENT(in) :: time
+    REAL*8, DIMENSION(:,:,:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER, DIMENSION(3) :: dimIDS
+    INTEGER :: dim1,dim2
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    !        
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)
+    !
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2,1))  
+    ELSE
+       IF( ANY(SHAPE(tabvar) /= (/dim1,dim2,1/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1,dim2,1))      
+       ENDIF
+    ENDIF
+
+    status=nf90_get_var(ncid,varid,tabvar,start=(/1,1,time/))
+
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to retrieve netcdf variable : ",TRIM(varname)
+       STOP
+    ENDIF
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE Read_Ncdf_var3d_Real_t
+  !           
+  !
+  !
+  !****************************************************************
+  !              subroutine Write_Ncdf_var_t					*
+  !		                                						*
+  ! subroutine to write a variable in a given file for time t	*
+  !		                                						*
+  !     varname : name of variable to store		            	*     
+  !     dimname : name of dimensions of the given variable   	*
+  !     file    : netcdf file name				                *
+  !     tabvar  : values of the variable to write		    	*
+  !     time    : time corresponding to the values to store	    *	
+  !								                                *
+  !****************************************************************
+  !
+  !      
+  !**************************************************************
+  !          subroutine Write_Ncdf_var3d_real_t
+  !**************************************************************
+  SUBROUTINE Write_Ncdf_var3d_Real_t(varname,dimname,file,tabvar,time,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    CHARACTER(*),DIMENSION(3),INTENT(in) :: dimname
+    INTEGER :: time
+    REAL*8, DIMENSION(:,:,:), POINTER :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2,dimid3
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    IF(time==1) THEN
+       !      
+       status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+       status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+       status = nf90_inq_dimid(ncid,dimname(3), dimid3)
+       status = nf90_redef(ncid)
+
+       !      
+       SELECT CASE(TRIM(typevar))
+       CASE('double')
+          status = nf90_def_var(ncid,varname,nf90_double,     &
+               (/dimid1,dimid2,dimid3/),varid) 
+       CASE('float')
+          status = nf90_def_var(ncid,varname,nf90_float,     &
+               (/dimid1,dimid2,dimid3/),varid)    
+       END SELECT
+       !
+       status = nf90_enddef(ncid)
+
+    ELSE
+       status = nf90_inq_varid(ncid, varname, varid)
+    ENDIF
+    !      
+    status = nf90_put_var(ncid,varid,tabvar,start=(/1,1,time/))
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to store variable ",varname, &
+	    " in file ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE Write_Ncdf_var3d_Real_t
+  !      
+  !
+  !
+  !****************************************************************
+  !               subroutine Read_Ncdf_var_t					*
+  !			                                					*
+  !  subroutine to read a variable in a given file for time t	*
+  !					    	at level n	                        *
+  !     varname : name of variable to read           			*     
+  !     file    : netcdf file name			                	*
+  !     tabvar  : values of the read variable	        		*
+  !     time    : time corresponding to the values to read   	*	
+  !     level   : level corresponding to the values to read	    *
+  !								                                *
+  !****************************************************************
+  !
+  !
+  !**************************************************************
+  !   subroutine Read_Ncdf_var4d_real_nt
+  !**************************************************************          
+  SUBROUTINE Read_Ncdf_var4d_Real_nt(varname,file,tabvar,time,level)
+    !      
+    USE types     
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    INTEGER,INTENT(in) :: time,level
+    REAL*8, DIMENSION(:,:,:,:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER, DIMENSION(4) :: dimIDS
+    INTEGER :: dim1,dim2
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    !        
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)
+    !
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2,1,1))  
+    ELSE
+       IF ((SIZE(tabvar,1) /= dim1) .OR. (SIZE(tabvar,2) /= dim2)) THEN
+          DEALLOCATE(tabvar)
+          ALLOCATE(tabvar(dim1,dim2,1,1))
+       ENDIF
+    ENDIF
+    !
+    status=nf90_get_var(ncid,varid,tabvar,start=(/1,1,level,time/),count=(/dim1,dim2,1,1/))
+    !                                             
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to retrieve netcdf variable : ",TRIM(varname)
+       STOP
+    ENDIF
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE Read_Ncdf_var4d_Real_nt
+  !           
+  !
+  !
+  !**************************************************************
+  !   subroutine Read_Ncdf_var4d_real_t
+  !**************************************************************          
+  SUBROUTINE Read_Ncdf_var4d_Real_t(varname,file,tabvar,time)
+    !      
+    USE types     
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    INTEGER,INTENT(in) :: time
+    REAL*8, DIMENSION(:,:,:,:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER, DIMENSION(4) :: dimIDS
+    INTEGER :: dim1,dim2,dim3
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    !        
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)
+    status=nf90_inquire_dimension(ncid,dimIDS(3),len=dim3)
+    !
+    IF(.NOT. ASSOCIATED(tabvar)) ALLOCATE(tabvar(dim1,dim2,dim3,1))  
+    status=nf90_get_var(ncid,varid,tabvar,start=(/1,1,1,time/))
+
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to retrieve netcdf variable : ",TRIM(varname)
+       STOP
+    ENDIF
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE Read_Ncdf_var4d_Real_t
+  !           
+  !
+  !
+  !****************************************************************
+  !               subroutine Write_Ncdf_var_t					*
+  !				                                 				*
+  !  subroutine to write a variable in a given file for time t	*
+  !						    at level n	                        *
+  !                                                             *
+  !     varname : name of variable to store		            	*     
+  !     dimname : name of dimensions of the given variable   	*
+  !     file    : netcdf file name				                *
+  !     tabvar  : values of the variable to write			    *
+  !     time    : time corresponding to the values to store	    *	
+  !     level   : level corresponding to the values to store	*
+  !								                                *
+  !****************************************************************
+  !
+  !      
+  !**************************************************************
+  !   subroutine Write_Ncdf_var4d_real_t
+  !**************************************************************
+  SUBROUTINE Write_Ncdf_var4d_Real_t(varname,dimname,file,tabvar,time,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    CHARACTER(*),DIMENSION(4),INTENT(in) :: dimname
+    INTEGER :: time,level
+    REAL*8, DIMENSION(:,:,:,:), POINTER :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2,dimid3,dimid4
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !      
+    IF(time==1) THEN
+       !      
+       status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+       status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+       status = nf90_inq_dimid(ncid,dimname(3), dimid3)
+       status = nf90_inq_dimid(ncid,dimname(4), dimid4)
+       status = nf90_redef(ncid)
+       !      
+       SELECT CASE(TRIM(typevar))
+       CASE('double')
+          status = nf90_def_var(ncid,TRIM(varname),nf90_double,     &
+               (/dimid1,dimid2,dimid3,dimid4/),varid)  
+       CASE('float')
+          status = nf90_def_var(ncid,TRIM(varname),nf90_float,     &
+               (/dimid1,dimid2,dimid3,dimid4/),varid)    
+       END SELECT
+       !
+       status = nf90_enddef(ncid)
+
+    ELSE
+       status = nf90_inq_varid(ncid, varname, varid)
+    ENDIF
+    !    
+    status = nf90_put_var(ncid,varid,tabvar,start=(/1,1,1,time/))
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to store variable ",varname, &
+	    " in file ",file
+       STOP
+    ENDIF
+    !    
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE Write_Ncdf_var4d_Real_t
+  !      
+  !
+  !      
+  !**************************************************************
+  !   subroutine Write_Ncdf_var4d_real_nt
+  !**************************************************************
+  SUBROUTINE Write_Ncdf_var4d_Real_nt(varname,dimname,file,tabvar,time,level,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    CHARACTER(*),DIMENSION(4),INTENT(in) :: dimname
+    INTEGER :: time,level
+    REAL*8, DIMENSION(:,:,:,:), POINTER :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2,dimid3,dimid4
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !      
+    IF(time==1.AND.level==1) THEN
+       !      
+       status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+       status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+       status = nf90_inq_dimid(ncid,dimname(3), dimid3)
+       status = nf90_inq_dimid(ncid,dimname(4), dimid4)
+       status = nf90_redef(ncid)
+       !      
+       SELECT CASE(TRIM(typevar))
+       CASE('double')
+          status = nf90_def_var(ncid,TRIM(varname),nf90_double,     &
+               (/dimid1,dimid2,dimid3,dimid4/),varid)  
+       CASE('float')
+          status = nf90_def_var(ncid,TRIM(varname),nf90_float,     &
+               (/dimid1,dimid2,dimid3,dimid4/),varid)    
+       END SELECT
+       !
+       status = nf90_enddef(ncid)
+
+    ELSE
+       status = nf90_inq_varid(ncid, varname, varid)
+    ENDIF
+    !    
+    status = nf90_put_var(ncid,varid,tabvar,start=(/1,1,level,time/))
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to store variable ",varname, &
+	    " in file ",file
+       STOP
+    ENDIF
+    !    
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE Write_Ncdf_var4d_Real_nt
+
+  SUBROUTINE Write_Ncdf_var0d_Real(varname,file,tabvar,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    INTEGER :: time,level
+    REAL*8 :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !      
+
+    status = nf90_redef(ncid)
+    !      
+    SELECT CASE(TRIM(typevar))
+    CASE('double')
+       status = nf90_def_var(ncid,TRIM(varname),nf90_double,     &
+            varid=varid)  
+    CASE('float')
+       status = nf90_def_var(ncid,TRIM(varname),nf90_float,     &
+            varid=varid)    
+    END SELECT
+    !
+    status = nf90_enddef(ncid)
+
+    !    
+    status = nf90_put_var(ncid,varid,tabvar)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to store variable ",varname, &
+	    " in file ",file
+       STOP
+    ENDIF
+    !    
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE Write_Ncdf_var0d_Real
+  !      
+  !
+  !****************************************************************
+  !                 subroutine Read_Ncdf_VarName				*
+  !			                                 					*
+  !           subroutine to retrieve of all variables 			*
+  !                  included in a given file					*
+  !					                                			*
+  !     filename    : netcdf file name	             			*
+  !     tabvarname  : array containing various variables names	*
+  !								                                *
+  !****************************************************************
+  !
+  !**************************************************************
+  !   subroutine Read_Ncdf_VarName
+  !**************************************************************          
+  SUBROUTINE Read_Ncdf_VarName(filename,tabvarname)
+    !      
+    CHARACTER(*),INTENT(in) :: filename
+    CHARACTER*20,DIMENSION(:),POINTER :: tabvarname
+    INTEGER :: nDimensions,nVariables
+    INTEGER :: nAttributes,unlimitedDimId,i
+    INTEGER :: ncid,status,dimid
+    !     
+    status = nf90_open(filename,NF90_NOWRITE,ncid)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",filename
+       STOP
+    ENDIF
+    !      
+    status = nf90_inquire(ncid,nDimensions,nVariables,nAttributes, &                                                      
+         unlimitedDimId) 
+    !
+    ALLOCATE(tabvarname(nVariables))
+    !
+    DO i=1,nVariables
+       status = nf90_inquire_variable(ncid,i,tabvarname(i))
+    END DO
+    !
+  END SUBROUTINE Read_Ncdf_Varname
+  !
+  !
+  !
+  !**************************************************************
+  !   subroutine Copy_Ncdf_att
+  !**************************************************************          
+  SUBROUTINE Copy_Ncdf_att_var(varname,filein,fileout)
+    !      
+    CHARACTER(*),INTENT(in) :: filein,fileout
+    CHARACTER(*),INTENT(in) :: varname
+    INTEGER :: ncid_in,ncid_out,status,varid_in,varid_out
+    !     
+    status = nf90_open(filein,NF90_NOWRITE,ncid_in)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open input netcdf file : ",filein
+       STOP
+    ENDIF
+    !     							     	   
+    status = nf90_open(fileout,NF90_WRITE,ncid_out)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open output netcdf file : ",fileout
+       STOP
+    ENDIF
+    !  
+    status = nf90_inq_varid(ncid_in,varname,varid_in)
+    status = nf90_inq_varid(ncid_out,varname,varid_out)
+    !
+    status = nf90_redef(ncid_out)
+    !      
+    status = nf90_copy_att(ncid_in,varid_in,'units',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'valid_min',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'valid_max',ncid_out,varid_out) 
+    status = nf90_copy_att(ncid_in,varid_in,'long_name',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'calendar',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'title',ncid_out,varid_out)     
+    status = nf90_copy_att(ncid_in,varid_in,'time_origin',ncid_out,varid_out) 
+    status = nf90_copy_att(ncid_in,varid_in,'positive',ncid_out,varid_out)                 
+    status = nf90_copy_att(ncid_in,varid_in,'tstep_sec',ncid_out,varid_out)          
+    status = nf90_copy_att(ncid_in,varid_in,'nav_model',ncid_out,varid_out)   
+    status = nf90_copy_att(ncid_in,varid_in,'Minvalue=',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'Maxvalue=',ncid_out,varid_out)  
+    status = nf90_copy_att(ncid_in,varid_in,'short_name',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'online_operation',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'axis',ncid_out,varid_out)            
+    status = nf90_copy_att(ncid_in,varid_in,'interval_operation',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'interval_write',ncid_out,varid_out) 
+    status = nf90_copy_att(ncid_in,varid_in,'associate',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'actual_range',ncid_out,varid_out) 
+    status = nf90_copy_att(ncid_in,varid_in,'longitude',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'latitude',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'scale_factor',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'add_offset',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'missing_value',ncid_out,varid_out) 
+    !      
+    status = nf90_enddef(ncid_out)  
+    !
+    status = nf90_close(ncid_in)
+    status = nf90_close(ncid_out)
+    ! 
+  END SUBROUTINE Copy_Ncdf_att_var
+  !
+  !
+  !         
+  !**************************************************************
+  !       subroutine Copy_Ncdf_att
+  !**************************************************************          
+  SUBROUTINE Copy_Ncdf_att_latlon(varname,filein,fileout,min,max)
+    !      
+    CHARACTER(*),INTENT(in) :: filein,fileout
+    CHARACTER(*),INTENT(in) :: varname
+    REAL*8 :: min,max
+    INTEGER :: ncid_in,ncid_out,status,varid_in,varid_out
+    !     
+    status = nf90_open(filein,NF90_NOWRITE,ncid_in)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",filein
+       STOP
+    ENDIF
+    !     							     	   
+    status = nf90_open(fileout,NF90_WRITE,ncid_out)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",fileout
+       STOP
+    ENDIF
+    !  
+    status = nf90_inq_varid(ncid_in,varname,varid_in)
+    status = nf90_inq_varid(ncid_out,varname,varid_out)
+    !
+    status = nf90_redef(ncid_out)
+    !      
+    SELECT CASE (varname)
+       !      
+    CASE('nav_lon')     
+       status = nf90_copy_att(ncid_in,varid_in,'units',ncid_out,varid_out) 
+       status = nf90_put_att(ncid_out,varid_out,'valid_min',REAL(min,4))
+       status = nf90_put_att(ncid_out,varid_out,'valid_max',REAL(max,4))
+       status = nf90_copy_att(ncid_in,varid_in,'long_name',ncid_out,varid_out)
+       status = nf90_copy_att(ncid_in,varid_in,'nav_model',ncid_out,varid_out)
+       status = nf90_copy_att(ncid_in,varid_in,'title',ncid_out,varid_out)
+       !
+    CASE('nav_lat')
+       status = nf90_copy_att(ncid_in,varid_in,'units',ncid_out,varid_out) 
+       status = nf90_put_att(ncid_out,varid_out,'valid_min',REAL(min,4))
+       status = nf90_put_att(ncid_out,varid_out,'valid_max',REAL(max,4))
+       status = nf90_copy_att(ncid_in,varid_in,'long_name',ncid_out,varid_out)
+       status = nf90_copy_att(ncid_in,varid_in,'nav_model',ncid_out,varid_out)
+       status = nf90_copy_att(ncid_in,varid_in,'title',ncid_out,varid_out) 
+       !
+    END SELECT
+    !      
+    status = nf90_enddef(ncid_out)  
+    !
+    status = nf90_close(ncid_in)
+    status = nf90_close(ncid_out)
+  END SUBROUTINE Copy_Ncdf_att_latlon
+  !
+  !
+  !
+  !**************************************************************
+  !   function Get_NbDims
+  !**************************************************************          
+  INTEGER FUNCTION Get_NbDims( varname , filename )
+    !
+    CHARACTER(*),INTENT(in) :: varname,filename
+    INTEGER :: status,ncid,varid    
+    !      
+    status = nf90_open(TRIM(filename),NF90_NOWRITE,ncid)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",TRIM(filename)
+       STOP
+    ENDIF
+    status = nf90_inq_varid(ncid,TRIM(varname),varid)     
+    status = nf90_inquire_variable(ncid, varid , ndims = Get_NbDims)
+    !
+    RETURN
+    !
+  END FUNCTION Get_NbDims
+  !
+  !
+  !
+  !**************************************************************
+  !   function Get_NbDims
+  !**************************************************************          
+  LOGICAL FUNCTION Dims_Existence( dimname , filename )
+    !
+    CHARACTER(*),INTENT(in) :: dimname,filename
+    INTEGER :: status,ncid,dimid    
+    !      
+    status = nf90_open(TRIM(filename),NF90_NOWRITE,ncid)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",TRIM(filename)
+       STOP
+    ENDIF
+    status = nf90_inq_dimid(ncid,dimname,dimid)
+    !      
+    IF (status/=nf90_noerr) THEN
+       Dims_Existence = .FALSE.
+    ELSE
+       Dims_Existence = .TRUE.
+    ENDIF
+    !
+    RETURN
+    !
+  END FUNCTION Dims_Existence
+  !
+END MODULE io_netcdf
Index: trunk/NEMOGCM/TOOLS/GRIDGEN/src/mixed_grid.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/GRIDGEN/src/mixed_grid.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/GRIDGEN/src/mixed_grid.f90	(revision 2528)
@@ -0,0 +1,267 @@
+MODULE mixed_grid
+!!-----------------------------------------------------------
+!!
+!!       tools box to create a mixed grid storing 
+!!           the known values of grids U,V,T,F
+!!
+!!	        Created by Brice Lemaire on 01/2010.
+!!
+!!-----------------------------------------------------------
+  USE readwrite
+  !
+  IMPLICIT NONE
+  PUBLIC
+  !
+  CONTAINS
+  !********************************************************
+  !            SUBROUTINE define_mixed_grid             *
+  !												        *
+  !         to define the size of the mixed grid        *
+  !														*
+  !            CALL from create_coordinates             *
+  !********************************************************
+  SUBROUTINE define_mixed_grid
+    !
+    INTEGER :: ixgmix, iygmix
+    INTEGER :: ii, ij
+    ! 
+	WRITE(*,*) ''
+	WRITE(*,*) ' ### SUBROUTINE define_mixed_grid ### '
+	WRITE(*,*) ''
+	!
+	WRITE(*,*) ' *** CHECKING SIZE OF COARSE DOMAIN *** '
+	WRITE(*,*) nxcoag, 'x', nycoag
+	WRITE(*,*) ''
+	!
+    !*************************************
+	!!!Calculate size of mixed grid (ixgmix x iygmix)
+    !*************************************
+	IF(.NOT.nglobal) THEN
+	  ixgmix = (nxcoag) * 2                              !known points (T,U,V,F) along x
+	  ixgmix = ixgmix + (nn_rhox-1)*(ixgmix)!-1)           !points to interpolate    ''
+	  ! 
+	  iygmix = (nycoag) * 2                              !known points (T,U,V,F) along y
+	  iygmix = iygmix + (nn_rhoy-1)*(iygmix)!-1)           !points to interpolate    ''
+	ELSEIF(nglobal) THEN
+	  ixgmix = (nxcoag) * 2                             
+	  ixgmix = ixgmix + (nn_rhox-1)*(ixgmix)              
+	  ! 
+	  iygmix = (nycoag) * 2                            
+	  iygmix = iygmix + (nn_rhoy-1)*(iygmix)     
+	ENDIF
+	!
+	nxgmix = ixgmix
+	nygmix = iygmix
+	!
+	WRITE(*,*) ''
+	WRITE(*,*) '*** SIZE OF MIXED GRID ***'
+	WRITE(*,*) nxgmix, ' x ', nygmix
+	WRITE(*,*) ''
+    !
+    CALL mixed_grid_allocate(smixgrd,ixgmix,iygmix)     !using type.f90
+    !
+	IF(nglobal)THEN
+	  ii = 1
+      ij = 1
+    ELSE
+	  ii = nn_imin-1
+	  ij = nn_jmin-1
+	ENDIF
+	!
+    CALL write_mixed_grid(ixgmix,iygmix,ii,ij)   
+    !
+	WRITE(*,*) ''
+	WRITE(*,*) ' ### END SUBROUTINE define_mixed_grid ### '
+	WRITE(*,*) ''  
+	!
+  END SUBROUTINE
+  !
+  !
+  !
+  !********************************************************
+  !           SUBROUTINE write_mixed_grid   			  *
+  !									        			  *
+  !  to write the known values into the mixed grid		  *
+  !	These known values are spaced every (nn_rho-1) points *
+  !	    for allowing to compute the interpolation         *
+  !               inside this same grid	     			  *
+  !														  *
+  !******************************************************** 
+  SUBROUTINE write_mixed_grid(ki_end,kj_end,ki_min,kj_min)
+    !
+	INTEGER, INTENT(IN) :: ki_end, kj_end
+	INTEGER, INTENT(INOUT) :: ki_min, kj_min
+	INTEGER :: ji_start, jj_start
+	INTEGER :: ji,jj
+	INTEGER :: isym_x, isym_y
+	INTEGER :: itmp1, itmp2, itmp3, itmp4, itmp5, itmp6, itmp7
+    INTEGER :: icorrxt, icorrxu, icorrxv, icorrxf      !correction factor for i-indexation
+    INTEGER :: icorryt, icorryu, icorryv, icorryf      !correction factor for j-indexation
+	LOGICAL :: llp = .TRUE.
+	LOGICAL :: llq = .TRUE.
+	!
+	WRITE(*,*) ''
+	WRITE(*,*) ' ### SUBROUTINE write_mixed_grid ### '
+	WRITE(*,*) '' 
+	!
+	ji_start = 1
+	jj_start = 1   
+    !
+	isym_y = 1
+	!
+	! correction factor for symmetry along north boundary
+	icorrxt = 0
+	icorrxu = 0
+	icorrxv = 0
+	icorrxf = 0
+    !
+	icorryt = 0
+	icorryu = 0
+	icorryv = 0
+	icorryf = 0
+	!
+	DO jj=nn_rhoy,kj_end,2*nn_rhoy
+      !
+	  DO ji=nn_rhox,ki_end,2*nn_rhox
+        !
+		smixgrd%nav_lon(ji,jj)              =  scoagrd%nav_lon(ki_min + icorrxt, kj_min + icorryt)
+		smixgrd%nav_lat(ji,jj)              =  scoagrd%nav_lat(ki_min + icorrxt, kj_min + icorryt)	    
+		!
+		smixgrd%glam(ji,jj)                 =  scoagrd%glamt(ki_min + icorrxt, kj_min + icorryt)
+		smixgrd%glam(ji+nn_rhox,jj)         =  scoagrd%glamu(ki_min + icorrxu, kj_min + icorryu)
+		smixgrd%glam(ji,jj+nn_rhoy)         =  scoagrd%glamv(ki_min + icorrxv, kj_min + icorryv)
+		smixgrd%glam(ji+nn_rhox,jj+nn_rhoy) =  scoagrd%glamf(ki_min + icorrxf, kj_min + icorryf)		    
+		!
+		smixgrd%gphi(ji,jj)                 =  scoagrd%gphit(ki_min + icorrxt, kj_min + icorryt)
+		smixgrd%gphi(ji+nn_rhox,jj)         =  scoagrd%gphiu(ki_min + icorrxu, kj_min + icorryu)		 
+		smixgrd%gphi(ji,jj+nn_rhoy)         =  scoagrd%gphiv(ki_min + icorrxv, kj_min + icorryv)
+		smixgrd%gphi(ji+nn_rhox,jj+nn_rhoy) =  scoagrd%gphif(ki_min + icorrxf, kj_min + icorryf)
+		!
+		smixgrd%e1(ji,jj)                   =  scoagrd%e1t(ki_min + icorrxt, kj_min + icorryt)
+		smixgrd%e1(ji+nn_rhox,jj)           =  scoagrd%e1u(ki_min + icorrxu, kj_min + icorryu)		 
+		smixgrd%e1(ji,jj+nn_rhoy)           =  scoagrd%e1v(ki_min + icorrxv, kj_min + icorryv)
+		smixgrd%e1(ji+nn_rhox,jj+nn_rhoy)   =  scoagrd%e1f(ki_min + icorrxf, kj_min + icorryf)	
+		!	
+		smixgrd%e2(ji,jj)                   =  scoagrd%e2t(ki_min + icorrxt, kj_min + icorryt)
+		smixgrd%e2(ji+nn_rhox,jj)           =  scoagrd%e2u(ki_min + icorrxu, kj_min + icorryu)		 
+		smixgrd%e2(ji,jj+nn_rhoy)           =  scoagrd%e2v(ki_min + icorrxv, kj_min + icorryv)
+		smixgrd%e2(ji+nn_rhox,jj+nn_rhoy)   =  scoagrd%e2f(ki_min + icorrxf, kj_min + icorryf)
+        !
+		IF(.NOT.nglobal)THEN
+		  IF(ki_min.EQ.nsizex.AND.nn_imin.NE.2) THEN          ! across right/left boundary BUT not all around the earth
+			ki_min = 3
+		  ELSEIF(isym_y.EQ.1) THEN                            ! normal case
+			ki_min = ki_min + 1                                
+		  ELSEIF(isym_y.EQ.-1) THEN                           ! symetry along north boundary
+			ki_min = ki_min - 1              
+		  ENDIF
+		ELSE
+		  ki_min = ki_min + 1
+		ENDIF
+        !
+	  ENDDO
+      !	 
+	  !
+	  ! when we reach north boundary
+	  IF(.NOT.nglobal)THEN
+		IF(kj_min.EQ.nsizey-npivot-1.AND.llp) THEN           ! npivot => pivot located on T-point or F-point
+		  llp = .FALSE.
+		  kj_min = nsizey 
+		  isym_y = -1
+		  IF(nn_imin.LT.nmid.AND.nn_imax.LT.nmid) THEN       ! no bipole (from Asia to Canada)                               
+			itmp1 = nsizex - nn_imin + 2 + npivot              
+			isym_x = 1
+		  ELSEIF(nn_imin.GT.nmid.AND.nn_imax.GT.nmid) THEN   ! no bipole (from Canada to Asia)
+			itmp2 = nsizex - nn_imin + 2 + npivot               		  
+			isym_x = 2
+		  ELSEIF(nn_imin.LT.nmid.AND.nn_imax.GT.nmid) THEN   ! canadian bipole
+			IF(nval1.LT.nval2) THEN
+			  itmp3 = nmid + nval2 
+			  isym_x = 3
+			ELSEIF(nval1.GE.nval2) THEN                      ! canadian bipole
+			  itmp4 = nmid + nval1 + 2 - npivot
+			  isym_x = 4
+			ENDIF
+		  ELSEIF(ki_min.EQ.nsizex.AND.nval1.GT.nval2) THEN   ! asian bipole
+			  itmp5 = nval1 + 1 + npivot
+			  isym_x = 5
+		  ELSEIF(ki_min.EQ.nsizex.AND.nval1.LT.nval2) THEN   ! asian bipole
+			  itmp6 = nval2 + 1
+			  isym_x = 6		
+		  ELSEIF(ki_min.GE.nmid) THEN                        ! all around the earth (2 bipoles)
+			  itmp7 = nsizex 
+			  isym_x = 7
+		  ENDIF
+		ENDIF
+	    !
+	    !
+	    !
+	    IF(isym_y.EQ.1) THEN
+          kj_min = kj_min + 1                   ! cas normal
+          ki_min = nn_imin - 1   
+	    ELSEIF(isym_y.EQ.-1) THEN                             
+		  kj_min = kj_min - 1  
+		  !
+		  icorrxt = 0   
+		  icorrxu = -1  
+		  icorrxv = 0   
+		  icorrxf = -1  
+		  !
+		  icorryt = 0   
+		  icorryu = 0    
+		  icorryv = -1  
+		  icorryf = -1  
+		  !      		
+		  IF(isym_x.EQ.1) THEN                  ! no bipole
+			ki_min = itmp1
+			IF(llq)THEN
+			  icorrxt = 0   
+			  icorrxu = -1 + npivot
+			  icorrxv = 0   
+			  !
+			  icorryt = 0   
+			  icorryu = 0    
+			  icorryv = -1 + npivot 
+			  !  
+			  llq = .FALSE.
+			ENDIF		
+          ELSEIF(isym_x.EQ.2) THEN              ! no bipole
+		    ki_min = itmp2 
+	      ELSEIF(isym_x.EQ.3) THEN              ! canadian bipole
+		    ki_min = itmp3	
+	      ELSEIF(isym_x.EQ.4) THEN              ! canadian bipole
+		    ki_min = itmp4 
+		    IF(llq)THEN
+			  icorrxt = 0   
+			  icorrxu = -1 + npivot
+			  icorrxv = 0   
+			  !
+			  icorryt = 0   
+			  icorryu = 0    
+			  icorryv = -1 + npivot 
+			  !  
+			  llq = .FALSE.
+		    ENDIF	
+		  ELSEIF(isym_x.EQ.5) THEN              ! asian bipole
+		    ki_min = itmp5		    
+	      ELSEIF(isym_x.EQ.6) THEN              ! asian bipole
+		    ki_min = itmp6      
+		  ELSEIF(isym_x.EQ.7) THEN              ! all around the earth (2 bipoles)
+		    ki_min = itmp7	
+		  ENDIF
+		  !
+	    ENDIF
+		!
+	  ELSEIF(nglobal) THEN
+        kj_min = kj_min + 1                    
+	    ki_min = 1 	  
+	  ENDIF
+	ENDDO
+	!
+	WRITE(*,*) ''
+	WRITE(*,*) ' ### END SUBROUTINE write_mixed_grid ### '
+	WRITE(*,*) ''   
+	! 
+  END SUBROUTINE
+  !
+END MODULE
Index: trunk/NEMOGCM/TOOLS/GRIDGEN/src/projection.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/GRIDGEN/src/projection.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/GRIDGEN/src/projection.f90	(revision 2528)
@@ -0,0 +1,240 @@
+MODULE projection
+!!-----------------------------------------------------------
+!!
+!!          to make a polar stereographic projection 
+!!              in the area of the north pole
+!!
+!!	         Created by Brice Lemaire on 05/2010.
+!!
+!!-----------------------------------------------------------
+  USE readwrite
+  !
+  IMPLICIT NONE
+  PUBLIC
+  !
+  REAL*8,DIMENSION(4) :: dmixlam, dmixphi
+  REAL*8 :: dray = 6357          !rayon polaire de la Terre (km)    
+  REAL*8 :: PI = ACOS(-1.0)
+  REAL*8 :: dlong0 = 0.          !longitude du centre de projection (origine)
+  REAL*8 :: dlat0 = 90.          !latitude       ''    
+  INTEGER :: idisc = 0           !to check the +/- 180 discontinuity
+  INTEGER :: m
+  !
+  CONTAINS  
+  !********************************************************
+  !            SUBROUTINE stereo_projection      	    *
+  !									        			*
+  !												        *
+  !		          CALLED by cfg_tools.F90	            *
+  !********************************************************
+  SUBROUTINE stereo_projection(kji,kjj,kjk,knorth_pole,kway)
+    !
+    INTEGER,INTENT(IN) :: kji,kjj,kjk
+	LOGICAL,INTENT(IN) :: knorth_pole
+	INTEGER,INTENT(IN) :: kway
+	INTEGER :: klon, klat
+	REAL*8,DIMENSION(4) :: dlx, dly
+	REAL*8,DIMENSION(4) :: dllam, dlphi, dlk
+	REAL*8 :: dl_lat0, dl_long0
+	!
+    dl_lat0 = dlat0 * PI/180.
+    dl_long0 = dlong0 * PI/180.
+    !
+	!Either we interpolate along longitude or along latitude
+	IF(kway.EQ.1)THEN
+	  klon = 1
+	  klat = 0
+	ELSEIF(kway.EQ.2) THEN
+	  klon = 0
+	  klat = 1
+	ENDIF
+	!
+	! Check the discontinuity +/- 180
+	IF(kway.EQ.1)THEN
+	  IF(smixgrd%glam(kji,kjj).LT.180..AND.smixgrd%glam(kji+3*nn_rhox,kjj).GT.180.) THEN
+	    IF(smixgrd%glam(kji+2*nn_rhox,kjj).LT.180.) THEN
+	      idisc = 1
+	    ELSEIF(smixgrd%glam(kji+1*nn_rhox,kjj).GT.180.) THEN 
+	      idisc = 2
+        ELSEIF(smixgrd%glam(kji+2*nn_rhox,kjj).GT.180.AND.smixgrd%glam(kji+1*nn_rhox,kjj).LT.180.)THEN
+	      idisc = 3
+	    ENDIF
+	  ELSE
+	  idisc = 0
+	  ENDIF
+	ENDIF
+	!
+	dllam(1) = smixgrd%glam(kji,kjj) * PI/180.
+	dlphi(1) = smixgrd%gphi(kji,kjj) * PI/180.
+	dlk(1)   = (2*dray) / (1 + (SIN(dl_lat0)*SIN(dlphi(1))) + (COS(dl_lat0)*COS(dlphi(1))*COS(dllam(1) - dl_long0)))
+	!
+	dllam(2) = smixgrd%glam(kji+1*nn_rhox*klon,kjj+1*nn_rhoy*klat) * PI/180.
+	dlphi(2) = smixgrd%gphi(kji+1*nn_rhox*klon,kjj+1*nn_rhoy*klat) * PI/180.
+	dlk(2)   = (2*dray) / (1 + (SIN(dl_lat0)*SIN(dlphi(2))) + (COS(dl_lat0)*COS(dlphi(2))*COS(dllam(2) - dl_long0)))
+	!
+	dllam(3) = smixgrd%glam(kji+2*nn_rhox*klon,kjj+2*nn_rhoy*klat) * PI/180.
+	dlphi(3) = smixgrd%gphi(kji+2*nn_rhox*klon,kjj+2*nn_rhoy*klat) * PI/180.
+	dlk(3)   = (2*dray) / (1 + (SIN(dl_lat0)*SIN(dlphi(3))) + (COS(dl_lat0)*COS(dlphi(3))*COS(dllam(3) - dl_long0)))
+	!
+	dllam(4) = smixgrd%glam(kji+3*nn_rhox*klon,kjj+3*nn_rhoy*klat) * PI/180.
+	dlphi(4) = smixgrd%gphi(kji+3*nn_rhox*klon,kjj+3*nn_rhoy*klat) * PI/180.
+	dlk(4)   = (2*dray) / (1 + (SIN(dl_lat0)*SIN(dlphi(4))) + (COS(dl_lat0)*COS(dlphi(4))*COS(dllam(4) - dl_long0)))
+	!	
+	dlx(1) = dlk(1) * COS(dlphi(1)) * SIN(dllam(1) - dl_long0)
+	dly(1) = dlk(1) * ((COS(dl_lat0) * SIN(dlphi(1))) - (SIN(dl_lat0) * COS(dlphi(1)) * COS(dllam(1) - dl_long0)))
+    !
+	dlx(2) = dlk(2) * COS(dlphi(2)) * SIN(dllam(2) - dl_long0)
+	dly(2) = dlk(2) * ((COS(dl_lat0) * SIN(dlphi(2))) - (SIN(dl_lat0) * COS(dlphi(2)) * COS(dllam(2) - dl_long0)))
+    !
+	dlx(3) = dlk(3) * COS(dlphi(3)) * SIN(dllam(3) - dl_long0)
+	dly(3) = dlk(3) * ((COS(dl_lat0) * SIN(dlphi(3))) - (SIN(dl_lat0) * COS(dlphi(3)) * COS(dllam(3) - dl_long0)))
+    !
+	dlx(4) = dlk(4) * COS(dlphi(4)) * SIN(dllam(4) - dl_long0)
+	dly(4) = dlk(4) * ((COS(dl_lat0) * SIN(dlphi(4))) - (SIN(dl_lat0) * COS(dlphi(4)) * COS(dllam(4) - dl_long0)))
+    ! 
+	dmixlam(1) = smixgrd%glam(kji,kjj)         
+	dmixlam(2) = smixgrd%glam(kji+1*nn_rhox*klon,kjj+1*nn_rhoy*klat) 
+    dmixlam(3) = smixgrd%glam(kji+2*nn_rhox*klon,kjj+2*nn_rhoy*klat) 
+    dmixlam(4) = smixgrd%glam(kji+3*nn_rhox*klon,kjj+3*nn_rhoy*klat)
+	!
+	dmixphi(1) = smixgrd%gphi(kji,kjj)       
+	dmixphi(2) = smixgrd%gphi(kji+1*nn_rhox*klon,kjj+1*nn_rhoy*klat) 
+    dmixphi(3) = smixgrd%gphi(kji+2*nn_rhox*klon,kjj+2*nn_rhoy*klat) 
+    dmixphi(4) = smixgrd%gphi(kji+3*nn_rhox*klon,kjj+3*nn_rhoy*klat)
+	!
+	smixgrd%glam(kji,kjj)                               = dlx(1)
+	smixgrd%glam(kji+1*nn_rhox*klon,kjj+1*nn_rhoy*klat) = dlx(2)
+	smixgrd%glam(kji+2*nn_rhox*klon,kjj+2*nn_rhoy*klat) = dlx(3)
+	smixgrd%glam(kji+3*nn_rhox*klon,kjj+3*nn_rhoy*klat) = dlx(4)
+	!
+	smixgrd%gphi(kji,kjj)                               = dly(1)
+	smixgrd%gphi(kji+1*nn_rhox*klon,kjj+1*nn_rhoy*klat) = dly(2)
+    smixgrd%gphi(kji+2*nn_rhox*klon,kjj+2*nn_rhoy*klat) = dly(3)
+    smixgrd%gphi(kji+3*nn_rhox*klon,kjj+3*nn_rhoy*klat) = dly(4)
+	!
+  END SUBROUTINE stereo_projection
+  ! 
+  !
+  !
+  !********************************************************
+  !          SUBROUTINE stereo_projection_inv    	    *
+  !									        			*
+  !												        *
+  !		            CALLED from here	                *
+  !********************************************************
+  SUBROUTINE stereo_projection_inv(kji,kjj,kjk,knorth_pole,kway)
+    !
+    INTEGER,INTENT(IN) :: kji,kjj,kjk
+	LOGICAL,INTENT(IN) :: knorth_pole
+	INTEGER,INTENT(IN) :: kway
+	INTEGER :: klon, klat
+	REAL*8,DIMENSION(5) :: dlx, dly
+	REAL*8,DIMENSION(5)  :: dllam, dlphi
+    REAL*8,DIMENSION(5)  :: dlro, dlc
+	REAL*8 :: dl_long0, dl_lat0
+	!	
+    dl_lat0 = dlat0 * PI/180.
+    dl_long0 = dlong0 * PI/180.
+    !
+ 	IF(kway.EQ.1)THEN
+	  klon = 1
+	  klat = 0
+	ELSEIF(kway.EQ.2) THEN
+	  klon = 0
+	  klat = 1
+	ENDIF
+	!
+	!
+	dlx(1) = smixgrd%glam(kji,kjj)
+	dlx(2) = smixgrd%glam(kji+1*nn_rhox*klon,kjj+1*nn_rhoy*klat)
+	dlx(3) = smixgrd%glam(kji+2*nn_rhox*klon,kjj+2*nn_rhoy*klat)
+	dlx(4) = smixgrd%glam(kji+3*nn_rhox*klon,kjj+3*nn_rhoy*klat)	
+	dlx(5) = smixgrd%glam(kji+(nn_rhox+kjk)*klon,kjj+(nn_rhoy+kjk)*klat) 
+	!
+	dly(1) = smixgrd%gphi(kji,kjj)
+	dly(2) = smixgrd%gphi(kji+1*nn_rhox*klon,kjj+1*nn_rhoy*klat)
+	dly(3) = smixgrd%gphi(kji+2*nn_rhox*klon,kjj+2*nn_rhoy*klat)
+	dly(4) = smixgrd%gphi(kji+3*nn_rhox*klon,kjj+3*nn_rhoy*klat)	
+	dly(5) = smixgrd%gphi(kji+(nn_rhox+kjk)*klon,kjj+(nn_rhoy+kjk)*klat) 	
+	!
+	dlro(1) = SQRT(dlx(1)*dlx(1) + dly(1)*dly(1))
+	dlro(2) = SQRT(dlx(2)*dlx(2) + dly(2)*dly(2))
+	dlro(3) = SQRT(dlx(3)*dlx(3) + dly(3)*dly(3))
+	dlro(4) = SQRT(dlx(4)*dlx(4) + dly(4)*dly(4))
+	dlro(5) = SQRT(dlx(5)*dlx(5) + dly(5)*dly(5))
+	!
+	dlc(1) = 2*ATAN(dlro(1)/(2*dray))
+	dlc(2) = 2*ATAN(dlro(2)/(2*dray))
+	dlc(3) = 2*ATAN(dlro(3)/(2*dray))
+	dlc(4) = 2*ATAN(dlro(4)/(2*dray))
+	dlc(5) = 2*ATAN(dlro(5)/(2*dray))
+	!
+	dlphi(1) =  ASIN(COS(dlc(1))*SIN(dl_lat0) + (dly(1)*SIN(dlc(1))*COS(dl_lat0) / dlro(1)))
+	dlphi(2) =  ASIN(COS(dlc(2))*SIN(dl_lat0) + (dly(2)*SIN(dlc(2))*COS(dl_lat0) / dlro(2)))
+	dlphi(3) =  ASIN(COS(dlc(3))*SIN(dl_lat0) + (dly(3)*SIN(dlc(3))*COS(dl_lat0) / dlro(3)))
+	dlphi(4) =  ASIN(COS(dlc(4))*SIN(dl_lat0) + (dly(4)*SIN(dlc(4))*COS(dl_lat0) / dlro(4)))
+	dlphi(5) =  ASIN(COS(dlc(5))*SIN(dl_lat0) + (dly(5)*SIN(dlc(5))*COS(dl_lat0) / dlro(5)))
+    !	
+	dlphi(:) = dlphi(:) * 180./PI
+    !
+	dllam(1) = dl_long0 + ATAN(dlx(1)*SIN(dlc(1) / ((dlro(1)*COS(dl_lat0)*COS(dlc(1)))-(dly(1)*SIN(dl_lat0)*SIN(dlc(1))))))
+	dllam(2) = dl_long0 + ATAN(dlx(2)*SIN(dlc(2) / ((dlro(2)*COS(dl_lat0)*COS(dlc(2)))-(dly(2)*SIN(dl_lat0)*SIN(dlc(2))))))
+	dllam(3) = dl_long0 + ATAN(dlx(3)*SIN(dlc(3) / ((dlro(3)*COS(dl_lat0)*COS(dlc(3)))-(dly(3)*SIN(dl_lat0)*SIN(dlc(3))))))
+	dllam(4) = dl_long0 + ATAN(dlx(4)*SIN(dlc(4) / ((dlro(4)*COS(dl_lat0)*COS(dlc(4)))-(dly(4)*SIN(dl_lat0)*SIN(dlc(4))))))
+	dllam(5) = dl_long0 + ATAN(dlx(5)*SIN(dlc(5) / ((dlro(5)*COS(dl_lat0)*COS(dlc(5)))-(dly(5)*SIN(dl_lat0)*SIN(dlc(5))))))
+    !
+	dllam(1) = dllam(1) * 180./PI
+	dllam(2) = dllam(2) * 180./PI 
+	dllam(3) = dllam(3) * 180./PI 
+	dllam(4) = dllam(4) * 180./PI 
+    !
+	dllam(5) = dllam(5) * 180./PI 
+	!
+	IF(kway.EQ.1)THEN		
+	  IF(idisc.EQ.1) THEN
+		dllam(5) = dllam(5) + 180.
+	  ELSEIF(idisc.EQ.2) THEN
+		dllam(5) = dllam(5) - 180.
+	  ELSEIF(idisc.EQ.3) THEN
+		 dllam(5) = dllam(5) - 180.
+	  ELSE
+		dllam(5) = dllam(5)  
+	  ENDIF
+	  !
+	ELSEIF(kway.EQ.2)THEN
+	  IF(smixgrd%glam(kji,kjj+1*nn_rhoy).GT.0.AND.smixgrd%glam(kji,kjj+2*nn_rhoy).GT.0)THEN
+	    IF(dllam(5).LT.0.)THEN
+	      dllam(5) = dllam(5) + 180
+		ENDIF
+	  ELSEIF(smixgrd%glam(kji,kjj+1*nn_rhoy).LT.0.AND.smixgrd%glam(kji,kjj+2*nn_rhoy).LT.0)THEN
+	    IF(dllam(5).GT.0.)THEN
+		  dllam(5) = dllam(5) - 180
+	    ENDIF
+	  ELSEIF(smixgrd%glam(kji,kjj+1*nn_rhoy)*smixgrd%glam(kji,kjj+2*nn_rhoy).LT.0)THEN
+	    IF(dllam(5).LT.0.)THEN
+	      dllam(5) = dllam(5) + 180
+	    ELSEIF(dllam(5).GT.0.)THEN
+	      dllam(5) = dllam(5) - 180
+	    ENDIF
+	  ENDIF
+	ENDIF
+	!
+	smixgrd%glam(kji,kjj)                                       = dmixlam(1)
+	smixgrd%glam(kji+1*nn_rhox*klon,kjj+1*nn_rhoy*klat)         = dmixlam(2)
+    smixgrd%glam(kji+2*nn_rhox*klon,kjj+2*nn_rhoy*klat)         = dmixlam(3)
+    smixgrd%glam(kji+3*nn_rhox*klon,kjj+3*nn_rhoy*klat)         = dmixlam(4)
+	!
+    smixgrd%glam(kji+(nn_rhox+kjk)*klon,kjj+(nn_rhoy+kjk)*klat) = dllam(5)
+	!
+	smixgrd%gphi(kji,kjj)                                       = dmixphi(1)
+	smixgrd%gphi(kji+1*nn_rhox*klon,kjj+1*nn_rhoy*klat)         = dmixphi(2)
+    smixgrd%gphi(kji+2*nn_rhox*klon,kjj+2*nn_rhoy*klat)         = dmixphi(3)
+    smixgrd%gphi(kji+3*nn_rhox*klon,kjj+3*nn_rhoy*klat)         = dmixphi(4)
+	!
+    smixgrd%gphi(kji+(nn_rhox+kjk)*klon,kjj+(nn_rhoy+kjk)*klat) = dlphi(5)
+	!
+  END SUBROUTINE stereo_projection_inv
+  !
+  !
+  !
+END MODULE projection
Index: trunk/NEMOGCM/TOOLS/GRIDGEN/src/readwrite.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/GRIDGEN/src/readwrite.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/GRIDGEN/src/readwrite.f90	(revision 2528)
@@ -0,0 +1,182 @@
+MODULE readwrite
+  !
+  USE types
+  !
+  IMPLICIT NONE
+  !
+CONTAINS
+  !       
+  !*****************************************************
+  !   function Read_Coordinates(name,Grid)
+  !*****************************************************
+  INTEGER FUNCTION read_coordinates(name,Grid)
+    !
+    USE io_netcdf
+    !         
+    CHARACTER(*) name
+    TYPE(coordinates) :: Grid
+    !      
+    CALL Read_Ncdf_var('glamt',name,Grid%glamt)
+    CALL Read_Ncdf_var('glamu',name,Grid%glamu)
+    CALL Read_Ncdf_var('glamv',name,Grid%glamv)
+    CALL Read_Ncdf_var('glamf',name,Grid%glamf)
+    CALL Read_Ncdf_var('gphit',name,Grid%gphit)
+    CALL Read_Ncdf_var('gphiu',name,Grid%gphiu)
+    CALL Read_Ncdf_var('gphiv',name,Grid%gphiv)
+    CALL Read_Ncdf_var('gphif',name,Grid%gphif)
+    CALL Read_Ncdf_var('e1t',name,Grid%e1t)
+    CALL Read_Ncdf_var('e1u',name,Grid%e1u)
+    CALL Read_Ncdf_var('e1v',name,Grid%e1v)
+    CALL Read_Ncdf_var('e1f',name,Grid%e1f)
+    CALL Read_Ncdf_var('e2t',name,Grid%e2t)
+    CALL Read_Ncdf_var('e2u',name,Grid%e2u)
+    CALL Read_Ncdf_var('e2v',name,Grid%e2v)
+    CALL Read_Ncdf_var('e2f',name,Grid%e2f)
+    CALL Read_Ncdf_var('nav_lon',name,Grid%nav_lon)
+    CALL Read_Ncdf_var('nav_lat',name,Grid%nav_lat)       
+    !            
+    WRITE(*,*) ' '
+    WRITE(*,*) '*** Reading coordinates file: ',name
+    WRITE(*,*) ' '
+    !      
+    read_coordinates = 1
+    !      
+  END FUNCTION read_coordinates
+  !
+  !
+  !
+  !*****************************************************
+  !   function Write_Coordinates(name,Grid)
+  !*****************************************************
+  INTEGER FUNCTION write_coordinates(name,Grid,kxfine,kyfine)
+    !
+    USE io_netcdf
+	!
+    CHARACTER(*) name
+    TYPE(coordinates) :: Grid
+    INTEGER :: status,ncid,z
+    REAL*8,DIMENSION(:),POINTER :: tabtemp
+    INTEGER,DIMENSION(:),POINTER :: tabint
+    CHARACTER(len=20),DIMENSION(4) :: dimnames
+	INTEGER :: kxfine, kyfine
+    !
+    status = nf90_create(name,NF90_WRITE,ncid)
+    status = nf90_close(ncid)
+    !           
+	CALL Write_Ncdf_dim('x',name,nxfine)
+    CALL Write_Ncdf_dim('y',name,nyfine)
+    IF(.NOT. ln_iom_activated) CALL Write_Ncdf_dim('z',name,1)
+    CALL Write_Ncdf_dim('time',name,0)
+    !      
+    dimnames(1)='x'
+    dimnames(2)='y'
+    CALL Write_Ncdf_var('nav_lon',dimnames(1:2),name,Grid%nav_lon,'float')      
+    CALL Write_Ncdf_var('nav_lat',dimnames(1:2),name,Grid%nav_lat,'float')
+    !
+    IF(.NOT. ln_iom_activated) THEN
+       ! copy nav_lev variable -> IOIPSL
+       CALL Read_Ncdf_dim('z',cn_parent_coordinate_file,z)
+       ALLOCATE(tabtemp(z))
+       CALL Read_Ncdf_var('nav_lev',TRIM(cn_parent_coordinate_file),tabtemp)
+       CALL Write_Ncdf_var('nav_lev','z',name,tabtemp,'float')           
+       DEALLOCATE(tabtemp)
+    ENDIF
+    !
+    CALL Read_Ncdf_var('time',TRIM(cn_parent_coordinate_file),tabtemp)
+    CALL Write_Ncdf_var('time','time',name,tabtemp,'float')           
+    DEALLOCATE(tabtemp)      
+    CALL Read_Ncdf_var('time_steps',TRIM(cn_parent_coordinate_file),tabint)
+    CALL Write_Ncdf_var('time_steps','time',name,tabint) 
+    !      
+    dimnames(1)='x'
+    dimnames(2)='y'
+    IF(ln_iom_activated) THEN
+       dimnames(3)='time'
+    ELSE
+       dimnames(3)='z'
+       dimnames(4)='time'
+    ENDIF
+
+    CALL Write_Ncdf_var('glamt',dimnames,name,Grid%glamt,3,'double')
+    CALL Write_Ncdf_var('glamu',dimnames,name,Grid%glamu,3,'double')
+    CALL Write_Ncdf_var('glamv',dimnames,name,Grid%glamv,3,'double')
+    CALL Write_Ncdf_var('glamf',dimnames,name,Grid%glamf,3,'double')
+    CALL Write_Ncdf_var('gphit',dimnames,name,Grid%gphit,3,'double')
+    CALL Write_Ncdf_var('gphiu',dimnames,name,Grid%gphiu,3,'double')
+    CALL Write_Ncdf_var('gphiv',dimnames,name,Grid%gphiv,3,'double')
+    CALL Write_Ncdf_var('gphif',dimnames,name,Grid%gphif,3,'double')      
+    CALL Write_Ncdf_var('e1t',dimnames,name,Grid%e1t,3,'double')      
+    CALL Write_Ncdf_var('e1u',dimnames,name,Grid%e1u,3,'double')     
+    CALL Write_Ncdf_var('e1v',dimnames,name,Grid%e1v,3,'double')      
+    CALL Write_Ncdf_var('e1f',dimnames,name,Grid%e1f,3,'double')
+    CALL Write_Ncdf_var('e2t',dimnames,name,Grid%e2t,3,'double')
+    CALL Write_Ncdf_var('e2u',dimnames,name,Grid%e2u,3,'double')
+    CALL Write_Ncdf_var('e2v',dimnames,name,Grid%e2v,3,'double')
+    CALL Write_Ncdf_var('e2f',dimnames,name,Grid%e2f,3,'double')
+    !      
+    CALL Copy_Ncdf_att('nav_lon',TRIM(cn_parent_coordinate_file),name,&
+         MINVAL(Grid%nav_lon),MAXVAL(Grid%nav_lon))
+    CALL Copy_Ncdf_att('nav_lat',TRIM(cn_parent_coordinate_file),name,&
+         MINVAL(Grid%nav_lat),MAXVAL(Grid%nav_lat))
+    CALL Copy_Ncdf_att('nav_lev',TRIM(cn_parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('time',TRIM(cn_parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('time_steps',TRIM(cn_parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('glamt',TRIM(cn_parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('glamu',TRIM(cn_parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('glamv',TRIM(cn_parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('glamf',TRIM(cn_parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('gphit',TRIM(cn_parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('gphiu',TRIM(cn_parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('gphiv',TRIM(cn_parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('gphif',TRIM(cn_parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('e1t',TRIM(cn_parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('e1u',TRIM(cn_parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('e1v',TRIM(cn_parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('e1f',TRIM(cn_parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('e2t',TRIM(cn_parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('e2u',TRIM(cn_parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('e2v',TRIM(cn_parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('e2f',TRIM(cn_parent_coordinate_file),name)            
+    !
+    WRITE(*,*) ' '
+    WRITE(*,*) 'Writing coordinates file: ',name
+    IF(.NOT. ln_iom_activated) WRITE(*,*) 'IOISPL format'
+    IF(ln_iom_activated) WRITE(*,*) 'IOM format'      
+    WRITE(*,*) ' '
+    !
+    write_coordinates = 1
+    !      
+  END FUNCTION write_coordinates
+  !
+  !
+  !
+  !*****************************************************
+  !   function set_child_name(Parentname,Childname)
+  !*****************************************************
+  SUBROUTINE set_child_name(Parentname,Childname)
+    !
+    CHARACTER(*),INTENT(in) :: Parentname
+    CHARACTER(*),INTENT(out) :: Childname
+    CHARACTER(2) :: prefix
+    INTEGER :: pos
+    !   
+    pos  = INDEX(TRIM(Parentname),'/',back=.TRUE.)
+    !
+    prefix=Parentname(pos+1:pos+2)
+    IF (prefix == '1_') THEN
+       Childname = '2_'//Parentname(pos+3:LEN(Parentname)) 
+    ELSEIF (prefix == '2_') THEN
+       Childname = '3_'//Parentname(pos+3:LEN(Parentname)) 
+    ELSEIF (prefix == '3_') THEN
+       Childname = '4_'//Parentname(pos+3:LEN(Parentname)) 
+    ELSEIF (prefix == '4_') THEN
+       Childname = '5_'//Parentname(pos+3:LEN(Parentname)) 
+    ELSE
+       Childname = '1_'//Parentname(pos+1:LEN(Parentname)) 
+    ENDIF
+    !   
+  END SUBROUTINE set_child_name
+  !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!             
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+END MODULE readwrite
Index: trunk/NEMOGCM/TOOLS/GRIDGEN/src/types.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/GRIDGEN/src/types.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/GRIDGEN/src/types.f90	(revision 2528)
@@ -0,0 +1,210 @@
+MODULE types
+  !
+  PUBLIC
+  !   
+  !*****************************
+  ! Coordinates type definition 
+  !*****************************
+  TYPE coordinates
+     REAL*8, DIMENSION(:,:), POINTER  :: nav_lon,nav_lat              => NULL()
+     REAL*8, DIMENSION(:,:), POINTER  :: glamv, glamu, glamt, glamf   => NULL()
+     REAL*8, DIMENSION(:,:), POINTER  :: gphit, gphiu, gphiv, gphif   => NULL()
+     REAL*8, DIMENSION(:,:), POINTER  :: e1t, e1u, e1v, e1f           => NULL()
+     REAL*8, DIMENSION(:,:), POINTER  :: e2t, e2u, e2v, e2f           => NULL()
+     INTEGER, DIMENSION(:) , POINTER  :: time_steps                   => NULL()
+  END TYPE coordinates
+  !
+  !
+  !
+  TYPE mixed_coordinates
+     REAL*8, DIMENSION(:,:), POINTER  :: nav_lon,nav_lat              => NULL()
+     REAL*8, DIMENSION(:,:), POINTER  :: glam                         => NULL()
+     REAL*8, DIMENSION(:,:), POINTER  :: gphi                         => NULL()
+     REAL*8, DIMENSION(:,:), POINTER  :: e1                           => NULL()
+     REAL*8, DIMENSION(:,:), POINTER  :: e2                           => NULL()
+     INTEGER, DIMENSION(:) , POINTER  :: time_steps                   => NULL()
+  END TYPE mixed_coordinates
+  !
+  !**************************************************************
+  ! Declaration of global variables
+  !**************************************************************
+  !size of input ORCA grid
+  INTEGER :: nsizex, nsizey    
+  INTEGER :: nmid            
+  !
+  !kind of input grid
+  INTEGER :: npivot 
+  !
+  INTEGER :: nequator
+  !
+  LOGICAL :: nglobal
+  !
+  INTEGER :: nresx, nresy
+  !
+  !distance between middle of input grid and the border of sub-domain 
+  INTEGER :: nval1, nval2
+  !
+  INTEGER :: nxcoag, nycoag     !size of the sub-domain inside input ORCA grid 
+  INTEGER :: nxgmix, nygmix     !size of the mixed grid 
+  INTEGER :: nxfine, nyfine     !size of fine grid 
+  !
+  TYPE(coordinates), SAVE :: scoagrd         !coarse grid
+  TYPE(coordinates), SAVE :: sfingrd         !fine grid
+  TYPE(mixed_coordinates), SAVE :: smixgrd   !mixed grid to store all components (T,U,V,F) 
+  !                                           of the coarse grid in the same one
+  !
+  !
+  !
+  !**************************************************************
+  ! Declaration of various input file variables (namelist.input) 
+  !**************************************************************
+  INTEGER nn_imin,nn_jmin,nn_imax,nn_jmax,nn_rhox,nn_rhoy
+  LOGICAL ln_iom_activated
+  CHARACTER*100 cn_parent_coordinate_file, cn_position_pivot
+  !      
+  NAMELIST /input_output/ln_iom_activated
+  NAMELIST /coarse_grid_files/cn_parent_coordinate_file,cn_position_pivot
+  NAMELIST /nesting/nn_imin,nn_jmin,nn_imax,nn_jmax,nn_rhox,nn_rhoy      
+  !
+  !
+  !
+CONTAINS
+  !********************************************************
+  !             subroutine grid_allocate				*
+  !					                            		*
+  !         allocation of grid type elements 			*
+  !             according to nx and ny	     			*
+  !							                            *
+  !********************************************************
+  SUBROUTINE grid_allocate(Grid,nx,ny)
+    !
+    TYPE(coordinates) :: Grid
+    INTEGER :: nx,ny
+    !
+    ALLOCATE(Grid%nav_lon(nx,ny),Grid%nav_lat(nx,ny))
+    ALLOCATE(Grid%glamt(nx,ny),Grid%glamu(nx,ny),Grid%glamv(nx,ny),Grid%glamf(nx,ny))
+    ALLOCATE(Grid%gphit(nx,ny),Grid%gphiu(nx,ny),Grid%gphiv(nx,ny),Grid%gphif(nx,ny))
+    ALLOCATE(Grid%e1t(nx,ny),Grid%e1u(nx,ny),Grid%e1v(nx,ny),Grid%e1f(nx,ny))
+    ALLOCATE(Grid%e2t(nx,ny),Grid%e2u(nx,ny),Grid%e2v(nx,ny),Grid%e2f(nx,ny))
+	!
+  END SUBROUTINE grid_allocate
+  !
+  !
+  !
+  SUBROUTINE grid_deallocate(Grid)
+    !
+    TYPE(coordinates) :: Grid
+    !
+    DEALLOCATE(Grid%nav_lon,Grid%nav_lat)
+    DEALLOCATE(Grid%glamt,Grid%glamu,Grid%glamv,Grid%glamf)
+    DEALLOCATE(Grid%gphit,Grid%gphiu,Grid%gphiv,Grid%gphif)
+    DEALLOCATE(Grid%e1t,Grid%e1u,Grid%e1v,Grid%e1f)
+    DEALLOCATE(Grid%e2t,Grid%e2u,Grid%e2v,Grid%e2f)
+	!
+  END SUBROUTINE grid_deallocate
+  !
+  !
+  !
+  !********************************************************
+  !           subroutine mixed_grid_allocate			*
+  !							                            *
+  !          allocation of grid type elements 			*
+  !               according to nx and ny				*
+  !						                            	*
+  !********************************************************
+  SUBROUTINE mixed_grid_allocate(Grid,nx,ny)
+    !
+    TYPE(mixed_coordinates) :: Grid
+    INTEGER :: nx,ny
+    !
+    ALLOCATE(Grid%nav_lon(nx,ny),Grid%nav_lat(nx,ny))
+    ALLOCATE(Grid%glam(nx,ny))
+    ALLOCATE(Grid%gphi(nx,ny))
+    ALLOCATE(Grid%e1(nx,ny))
+    ALLOCATE(Grid%e2(nx,ny))
+	!
+  END SUBROUTINE mixed_grid_allocate
+  !
+  !
+  !
+  SUBROUTINE mixed_grid_deallocate(Grid)
+    !
+    TYPE(mixed_coordinates) :: Grid
+    !
+    DEALLOCATE(Grid%nav_lon,Grid%nav_lat)
+    DEALLOCATE(Grid%glam)
+    DEALLOCATE(Grid%gphi)
+    DEALLOCATE(Grid%e1)
+    DEALLOCATE(Grid%e2)
+	!
+  END SUBROUTINE mixed_grid_deallocate
+  !
+  !
+  !
+  !********************************************************
+  !             subroutine read_namelist				*
+  !				                     					*
+  !   read variables contained in namelist.input file   *
+  !                filled in by user 					*
+  !								                    	*
+  !********************************************************
+  SUBROUTINE read_namelist(namelistname)
+    !
+    IMPLICIT NONE
+    CHARACTER(len=80) :: namelistname
+    CHARACTER*255 :: output
+    LOGICAL :: is_it_there
+    INTEGER unit_nml
+    !
+    unit_nml = Get_Unit()
+    !      
+    INQUIRE ( FILE = namelistname , EXIST = is_it_there )      
+    !
+    IF ( is_it_there ) THEN 
+       !
+       OPEN ( FILE   =  namelistname, &
+              UNIT   =  unit_nml,	  &
+              STATUS = 'OLD',		  &
+              FORM   = 'FORMATTED',	  &
+              ACTION = 'READ',		  &
+              ACCESS = 'SEQUENTIAL'     )	  
+       !
+       REWIND(unit_nml)
+       READ (unit_nml , NML = coarse_grid_files)
+       READ (unit_nml , NML = nesting) 
+       CLOSE(unit_nml)
+	   !
+    ELSE
+       !
+       PRINT *,'namelist file ''',TRIM(namelistname),''' not found'
+       STOP	 
+       !
+    END IF
+    !
+  END SUBROUTINE read_namelist
+  !
+  !
+  !
+  !*************************************************
+  !              function Get_Unit                             
+  !*************************************************
+  INTEGER FUNCTION Get_Unit()
+    !
+    INTEGER n
+    LOGICAL op
+    INTEGER :: nunit
+    INTEGER :: iii,out,iiimax 
+    ! 
+    DO n = 7,1000
+       ! 
+       INQUIRE(Unit=n,Opened=op)
+       !
+       IF (.NOT.op) EXIT
+       !      
+    ENDDO
+    !
+    Get_Unit=n
+    !
+  END FUNCTION Get_Unit
+  !
+END MODULE types
Index: trunk/NEMOGCM/TOOLS/MISCELLANEOUS/chk_iomput.sh
===================================================================
--- trunk/NEMOGCM/TOOLS/MISCELLANEOUS/chk_iomput.sh	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/MISCELLANEOUS/chk_iomput.sh	(revision 2528)
@@ -0,0 +1,130 @@
+#!/bin/bash
+#------------------------------------------------
+#$Id$
+#------------------------------------------------
+#
+set -u
+#
+# if not argument -> get the help
+[ $# -eq 0 ] && ./$0 --help && exit
+#
+inxml=0
+insrc=0
+while [ $# -gt 0 ]   # Until you run out of parameters . . . 
+do    
+    case "$1" in 
+	-h|--help)
+	    echo
+	    echo 'Description:'
+	    echo '      check that an xml file is coherant with the source code:'
+	    echo '         - all variable ids defined by "call iom_put" must have their counterpart'
+	    echo '           in the variable definition in xml file'
+	    echo '         - list variable ids defined in xml file without any corresponding call'
+	    echo '           to iom_put. This can be done but it is useless as iom will only ouput zeros'
+	    echo '         - all variable ids used in the files definition in xml file must have'
+	    echo '           their counterpart in the variable definition in xml file'
+	    echo 'Usage:'
+	    echo '      chk_iomput.sh [OPTION]'
+	    echo '  or  chk_iomput.sh [OPTION] xmlfile DIRECTORIES'
+	    echo '         with:'
+	    echo '           xmlfile:  the xml file to test'
+	    echo '           DIRECTORIES: a list of directories containing the source code'
+	    echo 'Options'
+	    echo ' -h, --help           to get this help'
+	    echo ' --inxml              only print all variable definitions found in the xml file'
+	    echo ' --insrc              only print all variable definitions found in the source code'
+	    echo 'Examples'
+	    echo '      chk_iomput.sh'
+	    echo '      chk_iomput.sh --help'
+	    echo '      chk_iomput.sh ../../CONFIG/ORCA2_LIM/EXP00/iodef.xml "../../NEMO/OPA_SRC/ ../../NEMO/LIM_SRC_2/"'
+	    echo
+	    exit ;;
+        --inxml) inxml=1 ;;
+        --insrc) insrc=1 ;;
+	-*) echo ; echo "illegal option" ; ./$0 --help && exit ;;
+	*) [ $# -ne 2 ] && echo && echo "wrong number of arguments" && ./$0 --help && exit
+	    xmlfile=${1}
+	    srcdir=${2}
+	   shift
+    esac
+    shift       # Check next set of parameters. 
+done 
+#
+[ ! -f "$xmlfile" ] && echo "$xmlfile not found, we stop..." && exit
+for i in $srcdir 
+do
+    [ ! -d $i ] && echo "$i is not a directory, we stop..." && exit
+done
+#
+#------------------------------------------------
+#
+[ $inxml -eq 1 ] && grep "< *field * id *=" $xmlfile
+[ $insrc -eq 1 ] && find $srcdir -name "*.[Ffh]90" -exec grep -iH "^[^\!]*call  *iom_put *(" {} \;
+[ $(( $insrc + $inxml )) -ge 1 ] && exit
+#
+#------------------------------------------------
+#
+# list of file containing "CALL iom_put" in $srcdir
+#
+srclist=$( find $srcdir -name "*.[Ffh]90" -exec grep -il "^[^\!]*call  *iom_put *(" {} \; )
+#
+# list of variables used in "CALL iom_put"
+#
+varlistsrc=$( find $srcdir -name "*.[Ffh]90" -exec grep -i  "^[^\!]*call  *iom_put *(" {} \; | sed -e "s/.*iom_put *( *[\"\']\([^\"\']*\)[\"\'] *,.*/\1/" | sort -d )
+#
+# list of variables defined in the xml file
+#
+varlistxml=$( grep "< *field * id *=" $xmlfile  | sed -e "s/^.*< *field * id *= *[\"\']\([^\"\']*\)[\"\'].*/\1/" | sort -d )
+#
+# list of variables to be outputed in the xml file
+#
+varlistout=$( grep "< *field * ref *=" $xmlfile  | sed -e "s/^.*< *field * ref *= *[\"\']\([^\"\']*\)[\"\'].*/\1/" | sort -d )
+#
+echo "--------------------------------------------------"
+echo  check if all iom_put found in $srcdir
+echo  have a corresponding variable definition in $xmlfile
+echo "--------------------------------------------------"
+for var in $varlistsrc
+do
+    tst=$( echo " "$varlistxml" " | grep -c " $var " )
+    if [ $tst -ne 1 ] 
+    then
+	echo "problem with $var: $tst lines corresponding to its definition in $xmlfile, but defined in the code in"
+	for f in $srclist
+	do
+	    grep -iH "^[^\!]*call  *iom_put *( *[\"\']${var}[\"\'] *," $f
+	done
+	echo
+    fi
+done
+#
+echo "--------------------------------------------------"
+echo  check if all variables defined in $xmlfile
+echo  have a corresponding \"call iom_put\" in sources found in $srcdir
+echo "--------------------------------------------------"
+#
+for var in $varlistxml
+do
+    found=$( echo " "$varlistsrc" " | grep -c " $var " )
+    if [ $found -eq 0 ] 
+    then
+	echo \"call iom_put\" not found for variable $var
+	grep "< *field * id *= *[\"\']${var}[\"\']" $xmlfile
+	echo
+    fi
+done
+#
+echo "--------------------------------------------------"
+echo  ${xmlfile}: check if all variables to be outputed in files are really defined...
+echo "--------------------------------------------------"
+#
+# list of variables defined in the xml file
+for var in $varlistout
+do
+    found=$( echo " "$varlistxml" " | grep -c " $var " )
+    [ $found -eq 0 ] && echo variable to be outputed but not defined: $var 
+done
+
+
+
+exit
Index: trunk/NEMOGCM/TOOLS/MPP_PREP/namelist
===================================================================
--- trunk/NEMOGCM/TOOLS/MPP_PREP/namelist	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/MPP_PREP/namelist	(revision 2528)
@@ -0,0 +1,75 @@
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!  MPP_OPTIMIZ_ZOOM namelist
+! ---------------------------
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!
+!'''''''''''''''''''''''''''''''''''''''''
+!       namspace  spatial indexes
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+! NAMELIST /namspace/ jpiglo,jpjglo,jpidta,jpjdta,nizoom,njzoom
+! jpiglo = overall size of the zoomed region (i-direction)
+! jpjglo = overall size of the zoomed region (j-direction)
+! jpidta = overall size of the domain (i-direction)
+! jpjdta = overall size of the domain (j-direction)
+! nizoom = i -index of point (1,1) of the zoomed region/ jpidta
+! njzoom = j -index of point (1,1) of the zoomed region/ jpjdta
+!
+&NAMSPACE
+    jpk=31
+    jpiglo =  182
+    jpjglo =  149
+    jpidta =  182
+    jpjdta =  149
+    nizoom = 1
+    njzoom = 1
+/
+!'''''''''''''''''''''''''''''''''''''
+!      namproc
+!''''''''''''''''''''''''''''''''''''
+!   jprocx = maximum number of proc
+!   jpmem = 0 : dont care about the use of memory
+!           1 : try to optimize the use of memory
+!
+&NAMPROC
+     jprocx= 80
+     jpmem = 0
+/
+!''''''''''''''''''''''''''''''''''''''
+!      namparam
+!''''''''''''''''''''''''''''''''''''''
+!  ppmcal = memoire en octet d'un processeur
+!  ppmin = ??
+!  ppmax = ??
+!
+&NAMPARAM
+   ppmcal = 225000000.
+   ppmin = 0.4
+   ppmax = 0.9
+/
+!
+!'''''''''''''''''''''''''''''''''''''''
+!      namfile  of filename
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+! NAMELIST /namfile/ cbathy
+! cbathy = name of the  bathymetric file(nc)
+! ln_zps = false if bathy file is level
+!          true  if bathy file is meter
+!
+&NAMFILE
+     cbathy='bathymetry_depth_ORCA_R2_V3.nc'
+     ln_zps=.true.
+/
+!
+!''''''''''''''''''''''''''''''''''''''
+!      namkeep  jpni jpnj  kept
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+! NAMELIST /namkeep/ jpni,jpnj,covdta
+!   jpni = number of procs. in the i-direction
+!   jpnj = number of procs. in the j-direction
+!   covdta = Root for the overdata file name .
+!           Complete name will be {covdta}.{jpni}x{jpnj}_{jpnij}
+&NAMKEEP
+    jpni = 7
+    jpnj =11 
+    covdta = 'ORCA2-zahir'
+/
Index: trunk/NEMOGCM/TOOLS/MPP_PREP/src/mpp_optimiz_zoom_nc.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/MPP_PREP/src/mpp_optimiz_zoom_nc.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/MPP_PREP/src/mpp_optimiz_zoom_nc.f90	(revision 2528)
@@ -0,0 +1,372 @@
+PROGRAM mpp_optimiz_nc
+ !!---------------------------------------------------------------------
+ !!
+ !!                       PROGRAM MPP_OPTIMIZ_NC
+ !!                     ***********************
+ !!
+ !!  PURPOSE :
+ !!  ---------
+ !!              This program is build to optimize the domain beakdown into
+ !!              subdomain for mpp computing.
+ !!              Once the grid size, and the land/sea mask is known, it looks
+ !!              for all the possibilities within a range of setting parameters
+ !!              and determine the optimal.
+ !!
+ !!              Optimization is done with respect to the maximum number of
+ !!              sea processors and to the maximum numbers of procs (jprocx)
+ !!                     
+ !!              Optional optimization can be performed takink into account
+ !!              the maximum available processor memory ppmcal. This is
+ !!              activated if jpmen =1
+ !!
+ !! history:
+ !! --------
+ !!       original  : 95-12 (Imbard M) for OPA8.1, CLIPPER
+ !!       f90       : 03-06 (Molines JM), namelist as input
+ !!                 : 05-05 (Molines JM), bathy in ncdf
+ !!----------------------------------------------------------------------
+ !! * modules used
+  USE netcdf
+
+  IMPLICIT NONE
+
+  INTEGER ::  jprocx=250   !: maximum number of proc. (Read from namelist)
+  INTEGER ::  jpmem=0      !: memory constraint (1) or no constraint (0)
+     !                     !  (use 1 with caution as the memory size of 
+     !                     !   the code lays on OPA 8.1 estimates ...)
+     !
+  INTEGER          ::  &
+       jpk    = 46  ,    & !: vertical levels (namelist)
+       jpiglo = 1442,    & !: I-size of the model (namelist)
+       jpjglo = 1021,    & !: J-size of the model (namelist)
+       jpidta = 1442,    & !: I-size of the data file (namelist)
+       jpjdta = 1021,   &  !: J-size of the data files (namelist)
+       nizoom = 1 ,     &  !: I zoom indicator (namelist)
+       njzoom = 1 ,     &  !: J zoom indicatori (namelist)
+       numnam = 4          !: logical unit for the namelist
+  NAMELIST /namspace/ jpk,jpiglo,jpjglo,jpidta,jpjdta,nizoom,njzoom
+  NAMELIST /namproc/ jprocx, jpmem
+
+  INTEGER ::  jpnix ,jpnjx  
+  !
+  INTEGER,PARAMETER :: jpreci=1 ,jprecj=1
+  !
+  ! Following variables are used only if jpmem=1
+  REAL(KIND=4) ::  ppmpt ,   &
+       ppmcal = 225000000., &  !: maximum memory of one processor for a given machine (in 8 byte words)
+       ppmin  = 0.4,         & !: minimum ratio to fill the memory
+       ppmax  = 0.9            !: maximum ration to fill the memory
+  ! Aleph
+  !     PARAMETER(ppmcal= 16000000.)
+  !Brodie
+  !     PARAMETER(ppmcal=250000000.)
+  ! Uqbar
+  !     PARAMETER(ppmcal=3750000000.)
+  ! Zahir
+  !     PARAMETER(ppmcal=225000000.)
+
+  CHARACTER(LEN=80) :: cbathy, &       !: File name of the netcdf bathymetry (namelist)
+      &                clvar           !: Variable name in netcdf for the bathy to be read
+  LOGICAL ::  ln_zps=.false.           !: Logical flag for partial cells.
+  NAMELIST /namfile/ cbathy, ln_zps
+  NAMELIST /namparam/ ppmcal, ppmin, ppmax
+  !
+  INTEGER :: iumout = 1
+  INTEGER :: ji,jj,jn,jni,jnj,jni2,jnj2
+  INTEGER :: iumbat,ifreq,il1,il2
+  INTEGER :: ii,iim,ij,ijm,imoy,iost,iresti,irestj,isurf,ivide
+  INTEGER :: iilb,ijlb,ireci,irecj,in
+  INTEGER :: ipi,ipj
+  INTEGER :: inf10,inf30,inf50,iptx,isw
+  INTEGER :: iii,iij,iiii,iijj,iimoy,iinf10,iinf30,iinf50
+  !
+  INTEGER,DIMENSION(:,:),ALLOCATABLE     ::  ibathy    ! jpidta -jpjdta
+  INTEGER,DIMENSION(:,:),ALLOCATABLE     ::  ippdi, ippdj ,iidom, ijdom
+  !
+  REAL(KIND=4)                           ::  zmin,zmax,zper,zmem
+  REAL(KIND=4)                           ::  zzmin,zzmax,zperx
+  REAL(KIND=4),DIMENSION(:,:),ALLOCATABLE  ::  zmask ,&  ! jpiglo -jpjglo
+      &                                        zdta      ! jpidta -jpjdta
+
+ ! CDF stuff
+  INTEGER :: ncid, ivarid, istatus
+  LOGICAL ::  llbon=.false.
+  !
+  ! 0. Initialisation
+  ! -----------------
+  OPEN(numnam,FILE='namelist')
+  REWIND(numnam)
+  READ(numnam,namspace)
+
+  REWIND(numnam)
+  READ(numnam,namfile)
+
+  REWIND(numnam)
+  READ(numnam,namparam)
+
+  REWIND(numnam)
+  READ(numnam,namproc)
+
+  ! estimated  code size expressed in number of 3D arrays (valid for OPA8.1)
+  ppmpt = 55.+73./jpk
+  jpnix = jprocx ; jpnjx=jprocx
+
+  ALLOCATE ( ibathy(jpidta,jpjdta), zmask(jpiglo,jpjglo),zdta(jpidta,jpjdta) )
+  ALLOCATE (ippdi(jpnix,jpnjx), ippdj(jpnix,jpnjx) )
+  ALLOCATE (iidom(jpnix,jpnjx), ijdom(jpnix,jpnjx) )
+
+  OPEN(iumout,FILE='processor.layout')
+  WRITE(iumout,*)
+  WRITE(iumout,*) ' optimisation de la partition'
+  WRITE(iumout,*) ' ----------------------------'
+  WRITE(iumout,*)
+  !
+  ! * Read cdf bathy file
+  !
+         IF ( ln_zps ) THEN        ! partial steps
+            clvar = 'Bathymetry'
+         ELSE 
+            clvar = 'Bathy_level'  ! full steps
+         ENDIF
+
+         INQUIRE( FILE=cbathy, EXIST=llbon )
+      IF( llbon ) THEN
+            istatus=NF90_OPEN(cbathy,NF90_NOWRITE,ncid)
+            istatus=NF90_INQ_VARID(ncid,clvar,ivarid)
+            istatus=NF90_GET_VAR(ncid,ivarid,zdta)
+            istatus=NF90_CLOSE(ncid)
+      ELSE
+          PRINT *,' File missing : ', trim(cbathy)
+          STOP
+      ENDIF
+  ibathy(:,:)=zdta(:,:)
+
+  !
+  ! Building the mask
+  DO jj=1,jpjglo
+     DO ji=1,jpiglo
+        zmask(ji,jj) = float(ibathy(ji+nizoom - 1,jj+njzoom -1))
+     END DO
+  END DO
+
+  DO jj=1,jpjglo
+     DO ji=1,jpiglo
+        zmask(ji,jj)=  min(REAL(1.,kind=4),max(REAL(0.,kind=4),zmask(ji,jj)))  ! Old vector coding rule ...
+     END DO
+  END DO
+  !
+  !  Main loop on processors
+  ! ------------------------
+  iii=1 ; iij=1
+  iiii=jpiglo ; iijj=jpjglo
+  iptx=0
+  iimoy=0
+  zzmin=0. ; zzmax=0.
+  iinf10=0 ; iinf30=0 ; iinf50=0
+  zperx=1.
+  in=0
+  DO jni=1,jpnix
+     DO jnj=1,jpnjx
+        !
+        ! Limitation ob the maxumun number of PE's
+        IF(jni*jnj >  jprocx) goto 1000
+        !
+        ! Partition
+        ipi=(jpiglo-2*jpreci + (jni-1))/jni + 2*jpreci
+        ipj=(jpjglo-2*jprecj + (jnj-1))/jnj + 2*jprecj
+        !
+        ! Memory optimization ?
+        isw=0
+        zmem=ppmpt*ipi*ipj*jpk
+        IF(zmem > ppmcal) go to 1000
+        IF(jpmem == 1) THEN
+           IF(zmem.GT.ppmax*ppmcal.OR.zmem.LT.ppmin*ppmcal) isw=1
+        ENDIF
+        IF(isw.EQ.1) go to 1000
+        in=in+1
+        !
+        WRITE(iumout,*) '--> nombre de processeurs ',jni*jnj
+        WRITE(iumout,*) ' '
+        WRITE(iumout,*) " jpni=",jni ," jpnj=",jnj
+        WRITE(iumout,*) " jpi= ",ipi ," jpj= ",ipj
+        zper=(jni*jnj*ipi*ipj)/float(jpiglo*jpjglo)
+        WRITE(iumout,*) " rapport jpnij*domain/global domain ",zper
+        !
+        ! Coin en bas a gauche de chaque processeur
+        !
+        iilb=1
+        ijlb=1
+        ireci=2*jpreci
+        irecj=2*jprecj
+        iresti = MOD ( jpiglo - ireci , jni )
+        irestj = MOD ( jpjglo - irecj , jnj )
+        !
+        IF (iresti.EQ.0) iresti = jni
+        DO jj=1,jnj
+           DO ji=1,iresti
+              ippdi(ji,jj) = ipi
+           END DO
+           DO ji=iresti+1,jni
+              ippdi(ji,jj) = ipi -1
+           END DO
+        END DO
+        IF (irestj.EQ.0) irestj = jnj
+        DO ji=1,jni
+           DO jj=1,irestj
+              ippdj(ji,jj) = ipj
+           END DO
+           DO jj=irestj+1,jnj
+              ippdj(ji,jj) = ipj -1
+           END DO
+        END DO
+        DO jj=1,jnj
+           DO ji=1,jni
+              iidom(ji,jj)=iilb
+              ijdom(ji,jj)=ijlb
+           END DO
+        END DO
+        WRITE(iumout,*) " iresti=",iresti," irestj=",irestj
+        !
+        !  2. Boucle sur les processeurs
+        ! ------------------------------
+        !
+        ivide=0
+        imoy=0
+        zmin=1.e+20
+        zmax=-1.e+20
+        inf10=0
+        inf30=0
+        inf50=0
+        !
+        DO jni2=1,jni
+           DO jnj2=1,jnj
+
+              IF(jni.GT.1)THEN
+                 DO jj=1,jnj
+                    DO ji=2,jni
+                       iidom(ji,jj)=iidom(ji-1,jj)+ippdi(ji-1,jj)-ireci
+                    END DO
+                 END DO
+                 iilb=iidom(jni2,jnj2)
+              ENDIF
+              IF(jnj.GT.1)THEN
+                 DO jj=2,jnj
+                    DO ji=1,jni
+                       ijdom(ji,jj)=ijdom(ji,jj-1)+ippdj(ji,jj-1)-irecj
+                    END DO
+                 END DO
+                 ijlb=ijdom(jni2,jnj2)
+              ENDIF
+              isurf=0
+              DO jj=1+jprecj,ippdj(jni2,jnj2)-jprecj
+                 DO  ji=1+jpreci,ippdi(jni2,jnj2)-jpreci
+                    IF(zmask(ji+iilb-1,jj+ijlb-1).EQ.1.) isurf=isurf+1
+                 END DO
+              END DO
+              IF(isurf.EQ.0) THEN
+                 ivide=ivide+1
+              ELSE
+                 imoy=imoy+isurf
+              ENDIF
+              zper=float(isurf)/float(ipi*ipj)
+              IF(zmin.GT.zper.AND.isurf.NE.0) zmin=zper
+              IF(zmax.LT.zper.AND.isurf.NE.0) zmax=zper
+              IF(zper.LT.0.1.AND.isurf.NE.0) inf10=inf10+1
+              IF(zper.LT.0.3.AND.isurf.NE.0) inf30=inf30+1
+              IF(zper.LT.0.5.AND.isurf.NE.0) inf50=inf50+1
+              !
+              !
+              ! 3. Fin de boucle sur les processeurs, impression
+              ! ------------------------------------------------
+              !
+           END DO
+        END DO
+        WRITE(iumout,*) ' nombre de processeurs       ',jni*jnj
+        WRITE(iumout,*) ' nombre de processeurs mer   ',jni*jnj-ivide
+        WRITE(iumout,*) ' nombre de processeurs terre ',ivide
+        WRITE(iumout,*) ' moyenne de recouvrement     ',float(imoy)/float(jni*jnj-ivide)/float(ipi*ipj)
+        WRITE(iumout,*) ' minimum de recouvrement     ',zmin
+        WRITE(iumout,*) ' maximum de recouvrement     ',zmax
+        WRITE(iumout,*) ' nb de p recouvrement < 10 % ',inf10
+        WRITE(iumout,*) ' nb de p      10 < nb < 30 % ',inf30-inf10
+        WRITE(iumout,*) ' nb de p      30 < nb < 50 % ',inf50-inf10 -inf30
+        WRITE(iumout,*) ' nombre de points integres   ', (jni*jnj-ivide)*ipi*ipj
+        WRITE(iumout,*) ' nbr de pts supplementaires  ', (jni*jnj-ivide)*ipi*ipj-jpiglo*jpjglo
+        zper=float((jni*jnj-ivide))*float(ipi*ipj)/float(jpiglo*jpjglo)
+        WRITE(iumout,*) ' % sup                       ',zper
+        WRITE(iumout,*)
+        ! 
+        ! 
+        ! 4. Recherche de l optimum
+        ! -------------------------
+        !
+        IF(ivide.GT.iptx) THEN
+           iii=jni
+           iij=jnj
+           iiii=ipi
+           iijj=ipj
+           iptx=ivide
+           iimoy=imoy
+           zzmin=zmin
+           zzmax=zmax
+           iinf10=inf10
+           iinf30=inf30
+           iinf50=inf50
+           zperx=zper
+        ELSE IF(ivide.EQ.iptx.AND.zperx.LT.zper) THEN
+           iii=jni
+           iij=jnj
+           iiii=ipi
+           iijj=ipj
+           iimoy=imoy
+           zzmin=zmin
+           zzmax=zmax
+           iinf10=inf10
+           iinf30=inf30
+           iinf50=inf50
+           zperx=zper
+        ENDIF
+        !
+        ! 5. Fin de boucle sur le nombre de processeurs
+        ! ---------------------------------------------
+        !
+      1000 continue
+     END DO
+  END DO
+  !
+  !
+  ! 6. Affichage resultat
+  ! ---------------------
+  !
+  IF(in.EQ.0) THEN
+     WRITE(iumout,*) ' le choix n'' a pas pu etre fait '
+     WRITE(iumout,*)
+     WRITE(iumout,*) 'le nombre de processeurs maximum est insuffisant'
+     STOP 
+  ENDIF
+  WRITE(iumout,*) ' choix optimum'
+  WRITE(iumout,*) ' ============='
+  WRITE(iumout,*) 
+  WRITE(iumout,*) '--> nombre de processeurs ',iii*iij
+  WRITE(iumout,*) ' '
+  WRITE(iumout,*) " jpni=",iii ," jpnj=",iij
+  WRITE(iumout,*) " jpi= ",iiii ," jpj= ",iijj
+  WRITE(iumout,*) 
+  WRITE(iumout,*) ' nombre de processeurs mer   ',iii*iij-iptx
+  WRITE(iumout,*) ' nombre de processeurs terre ',iptx
+  WRITE(iumout,*) ' moyenne de recouvrement     ',float(iimoy)/float(iii*iij-iptx)/float(iiii*iijj)
+  WRITE(iumout,*) ' minimum de recouvrement     ',zzmin
+  WRITE(iumout,*) ' maximum de recouvrement     ',zzmax
+  WRITE(iumout,*) ' nb de p recouvrement < 10 % ',iinf10
+  WRITE(iumout,*) ' nb de p      10 < nb < 30 % ',iinf30-iinf10
+  WRITE(iumout,*) ' nb de p      30 < nb < 50 % ',iinf50-iinf10 -iinf30
+  WRITE(iumout,*) ' nombre de points integres   ', (iii*iij-iptx)*iiii*iijj
+  WRITE(iumout,*) ' nbr de pts supplementaires  ', (iii*iij-iptx)*iiii*iijj-jpiglo*jpjglo
+  WRITE(iumout,*) ' % sup                       ',zperx
+  WRITE(iumout,*)
+  CLOSE(iumout)
+  !
+  !
+  !
+  STOP
+END PROGRAM mpp_optimiz_nc
Index: trunk/NEMOGCM/TOOLS/MPP_PREP/src/mppopt_showproc_nc.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/MPP_PREP/src/mppopt_showproc_nc.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/MPP_PREP/src/mppopt_showproc_nc.f90	(revision 2528)
@@ -0,0 +1,450 @@
+PROGRAM mppopt_showproc_nc
+ !!---------------------------------------------------------------------
+ !!
+ !!                       PROGRAM MPP_showproc_nc
+ !!                     ***********************
+ !!
+ !!  PURPOSE :
+ !!  ---------
+ !!              Build a ascii file (suitable for the overlay function of
+ !!              chart) holding the chosen domain decomposition, formely
+ !!              determined by mpp_opatimize_nc.
+ !!              It takes the same namelist than  mpp_optimize_nc, with
+ !!              the jpni, jpnj given in the namelist (NAMKEEP)
+ !!              
+ !!
+ !!              The output file is called from a root name in the namelist
+ !!              (covdta) with the jpni, jpnj, and jpnij added to the name.
+ !!   MODIFICATIONS:
+ !!   --------------
+ !!       original  : 95-12 (Imbard M)
+ !!       modif pour chart : 98-12 ( J.M. Molines)
+ !!             26/05/2005 : English documentation (partial ..) JMM
+ !!----------------------------------------------------------------------
+  !
+  USE netcdf
+  IMPLICIT NONE
+  !
+  INTEGER ::  jprocx=250
+  !
+  INTEGER :: jpmem=0
+  !
+  ! les dimensions du modele
+  !
+  INTEGER :: jpk,jpiglo,jpjglo, jpidta, jpjdta
+  NAMELIST /namspace/ jpk,jpiglo,jpjglo, jpidta, jpjdta,nizoom,njzoom
+  NAMELIST /namproc/ jprocx, jpmem
+
+  INTEGER :: jpni,jpnj, jpnij
+  CHARACTER(LEN=80) :: covdta, cdum
+  NAMELIST /namkeep/ jpni,jpnj,covdta
+
+  CHARACTER(LEN=80) ::  cbathy
+  LOGICAL :: ln_zps=.false.
+  NAMELIST /namfile / cbathy, ln_zps
+  !!
+  ! quelques parametres
+  !
+  INTEGER ::  jpnix,jpnjx
+  !
+  INTEGER,PARAMETER ::  jpreci=1,jprecj=1
+  !
+  ! les dimensions de la memoire du modele et du calculateur (T3E)
+  !
+  REAL(KIND=4) ::  ppmpt ,   &
+       ppmcal = 1000000000., &
+       ppmin  = 0.4,         &
+       ppmax  = 1.0
+  ! Aleph
+  !     PARAMETER(ppmcal=16000000.)
+  !Brodie
+  !     PARAMETER(ppmcal=250000000.)
+  ! Uqbar
+  !     PARAMETER(ppmcal=3750000000.)
+  ! Zahir
+  !     PARAMETER(ppmcal=1000000000.)
+  NAMELIST /namparam/ ppmcal, ppmin, ppmax
+
+
+  !
+  INTEGER,PARAMETER ::  iumout=8, numnam=4, iumbat=11
+  INTEGER           :: ji,jj,jn,jni,jnj,jni2,jnj2
+  INTEGER           ::  ifreq,il1,il2
+  INTEGER           :: ii,iim,ij,ijm,imoy,iost,iresti,irestj,isurf,ivide
+  INTEGER           :: iilb,ijlb,ireci,irecj,in
+  INTEGER           :: ipi,ipj
+  INTEGER           :: inf10,inf30,inf50,iptx,isw
+  INTEGER           :: iii,iij,iiii,iijj,iimoy,iinf10,iinf30,iinf50
+  !
+  INTEGER,DIMENSION(:,:),ALLOCATABLE     ::  ibathy    ! jpidta -jpjdta
+  INTEGER,DIMENSION(:,:),ALLOCATABLE     ::  ippdi, ippdj ,iidom, ijdom
+  INTEGER,DIMENSION(:)  ,ALLOCATABLE     :: nlei, nldi,nlej,nldj,ICOUNT
+  INTEGER,DIMENSION(:)  ,ALLOCATABLE     :: nleiv, nldiv,nlejv,nldjv
+  INTEGER           :: jjc, nizoom, njzoom
+  !
+  REAL(KIND=4) :: zmin,zmax,zper,zmem
+  REAL(KIND=4) :: zzmin,zzmax,zperx
+  REAL(KIND=4),DIMENSION(:,:),ALLOCATABLE  ::  zmask, zdta, &   ! jpiglo -jpjglo
+                   zlamt, zphit
+  REAL(KIND=4),DIMENSION(:),ALLOCATABLE  ::  zdept   ! jpk
+  LOGICAL :: llbon, lwp=.true.
+  CHARACTER(LEN=80) ::  clvar
+  INTEGER :: numout=6, itime, ipk, istep,  inum
+  REAL(KIND=4) :: zdt, zdate0
+  ! CDF stuff
+  INTEGER :: ncid, ivarid, istatus
+
+  !
+  !
+  !
+  ! 0. Initialisation
+  ! -----------------
+  !
+  OPEN(numnam,FILE='namelist')
+
+  REWIND(numnam)
+  READ(numnam,namspace)
+  ALLOCATE ( ibathy(jpidta,jpjdta), zmask(jpiglo,jpjglo) ,zdta(jpidta,jpjdta))
+  ALLOCATE ( zlamt(jpidta,jpjdta), zphit(jpidta,jpjdta))
+
+  REWIND(numnam)
+  READ(numnam,namparam)
+
+  REWIND(numnam)
+  READ(numnam,namproc)
+
+  ppmpt = 55.+73./jpk
+  jpnix = jprocx ; jpnjx=jprocx
+
+  ALLOCATE (ippdi(jpnix,jpnjx), ippdj(jpnix,jpnjx) )
+  ALLOCATE (iidom(jpnix,jpnjx), ijdom(jpnix,jpnjx) )
+  ALLOCATE (nlei(jprocx), nldi(jprocx) )
+  ALLOCATE (nlej(jprocx), nldj(jprocx) )
+! empty processors
+  ALLOCATE (nleiv(jprocx), nldiv(jprocx) )
+  ALLOCATE (nlejv(jprocx), nldjv(jprocx) )
+  ALLOCATE (ICOUNT(jprocx), zdept(jpk) )
+
+  REWIND(numnam)
+  READ(numnam,namfile) 
+
+  REWIND(numnam)
+  READ(numnam,namkeep)
+
+  WRITE(iumout,*)
+  WRITE(iumout,*) ' optimisation de la partition'
+  WRITE(iumout,*) ' ----------------------------'
+  WRITE(iumout,*)
+
+  !
+  ! Lecture de la bathymetrie
+  !
+      ! open the file
+         IF ( ln_zps ) THEN
+            clvar = 'Bathymetry'
+
+         ELSE
+            clvar = 'Bathy_level'
+         ENDIF
+
+         INQUIRE( FILE=cbathy, EXIST=llbon )
+      IF( llbon ) THEN
+            istatus=NF90_OPEN(cbathy,NF90_NOWRITE,ncid)
+            istatus=NF90_INQ_VARID(ncid,clvar,ivarid)
+            istatus=NF90_GET_VAR(ncid,ivarid,zdta)
+            istatus=NF90_CLOSE(ncid)
+      ELSE
+          WRITE(numout,*)'    mppini_2 : unable to read the file', cbathy
+      ENDIF
+
+      ! land/sea mask over the global/zoom domain
+
+!     imask(:,:)=1
+!     WHERE ( zdta(jpizoom:jpiglo+jpizoom-1, jpjzoom:jpjglo+jpjzoom-1) == 0.e0 ) imask = 0
+      ibathy(:,:)=zdta(:,:)
+
+  DO jj=1,jpjglo
+     DO ji=1,jpiglo
+        zmask(ji,jj) = float(ibathy(ji+nizoom -1,jj+njzoom -1))
+     END DO
+  END DO
+  DO jj=1,jpjglo
+     DO ji=1,jpiglo
+        zmask(ji,jj)= min(REAL(1.,kind=4),max(REAL(0.,kind=4),zmask(ji,jj)))
+     END DO
+  END DO
+  print *,'Nombre de pts mer :', sum(zmask)
+  !
+  !
+  !  1. Boucle sur le nombre de processeurs
+  ! ---------------------------------------
+  !
+  iii=1
+  iij=1
+  iiii=jpiglo
+  iijj=jpjglo
+  iptx=0
+  iimoy=0
+  zzmin=0.
+  zzmax=0.
+  iinf10=0
+  iinf30=0
+  iinf50=0
+  zperx=1.
+  in=0
+! Next loop corresponds to just 1 case, which is the one kept from mpp_optimize.
+  DO jni=jpni,jpni
+     DO jnj=jpnj,jpnj
+        !
+        ! Limitation nombre de pe
+        !
+        IF(jni*jnj.GT.jprocx) go to 1000
+        !
+        ! Partition
+        !
+        ipi=(jpiglo-2*jpreci + (jni-1))/jni + 2*jpreci
+        ipj=(jpjglo-2*jprecj + (jnj-1))/jnj + 2*jprecj
+        !
+        ! Optimisation memoire ?
+        !
+        isw=0
+        zmem=ppmpt*ipi*ipj*jpk + jpiglo*jpjglo
+        IF(zmem.GT.ppmcal) go to 1000
+        IF(jpmem.EQ.1) THEN
+           IF(zmem.GT.ppmax*ppmcal.OR.zmem.LT.ppmin*ppmcal) isw=1
+        ENDIF
+        IF(isw.EQ.1) go to 1000
+        in=in+1
+        !
+        WRITE(iumout,*) '--> nombre de processeurs ',jni*jnj
+        WRITE(iumout,*) ' '
+        WRITE(iumout,*) " jpni=",jni ," jpnj=",jnj
+        WRITE(iumout,*) " jpi= ",ipi ," jpj= ",ipj
+        zper=(jni*jnj*ipi*ipj)/float(jpiglo*jpjglo)
+        WRITE(iumout,*) " rapport jpnij*domain/global domain ",zper
+        !
+        ! Coin en bas a gauche de chaque processeur
+        !
+        iilb=1
+        ijlb=1
+        ireci=2*jpreci
+        irecj=2*jprecj
+        iresti = MOD ( jpiglo - ireci , jni )
+        irestj = MOD ( jpjglo - irecj , jnj )
+        !
+        IF (iresti.EQ.0) iresti = jni
+        DO jj=1,jnj
+           DO ji=1,iresti
+              ippdi(ji,jj) = ipi
+           END DO
+           DO ji=iresti+1,jni
+              ippdi(ji,jj) = ipi -1
+           END DO
+        END DO
+        IF (irestj.EQ.0) irestj = jnj
+        DO ji=1,jni
+           DO jj=1,irestj
+              ippdj(ji,jj) = ipj
+           END DO
+           DO jj=irestj+1,jnj
+              ippdj(ji,jj) = ipj -1
+           END DO
+        END DO
+        DO jj=1,jnj
+           DO ji=1,jni
+              iidom(ji,jj)=iilb
+              ijdom(ji,jj)=ijlb
+           END DO
+        END DO
+        !
+        !  2. Boucle sur les processeurs
+        ! ------------------------------
+        !
+        ivide=0
+        imoy=0
+        zmin=1.e+20
+        zmax=-1.e+20
+        inf10=0
+        inf30=0
+        inf50=0
+        jjc=0
+        !
+        DO jni2=1,jni
+           DO jnj2=1,jnj
+
+              IF(jni.GT.1)THEN
+                 DO jj=1,jnj
+                    DO ji=2,jni
+                       iidom(ji,jj)=iidom(ji-1,jj)+ippdi(ji-1,jj)-ireci
+                    END DO
+                 END DO
+                 iilb=iidom(jni2,jnj2)
+              ENDIF
+              IF(jnj.GT.1)THEN
+                 DO jj=2,jnj
+                    DO ji=1,jni
+                       ijdom(ji,jj)=ijdom(ji,jj-1)+ippdj(ji,jj-1)-irecj
+                    END DO
+                 END DO
+                 ijlb=ijdom(jni2,jnj2)
+              ENDIF
+              isurf=0
+
+              DO jj=1+jprecj,ippdj(jni2,jnj2)-jprecj
+                 DO  ji=1+jpreci,ippdi(jni2,jnj2)-jpreci
+                    IF(zmask(ji+iilb-1,jj+ijlb-1).EQ.1.) isurf=isurf+1
+                 END DO
+              END DO
+              IF(isurf.EQ.0) THEN
+                 ivide=ivide+1
+                 nldiv(ivide)=jpreci+iilb
+                 nleiv(ivide)=iilb+ippdi(jni2,jnj2)-1-jpreci
+                 nldjv(ivide)=jprecj+ijlb
+                 nlejv(ivide)=ijlb+ippdj(jni2,jnj2)-1-jprecj
+              ELSE
+                 imoy=imoy+isurf
+                 jjc=jjc+1
+                 icount(jjc)=isurf 
+                 nldi(jjc)=jpreci+iilb
+                 nlei(jjc)=iilb+ippdi(jni2,jnj2)-1-jpreci
+                 nldj(jjc)=jprecj+ijlb
+                 nlej(jjc)=ijlb+ippdj(jni2,jnj2)-1-jprecj
+              ENDIF
+              zper=float(isurf)/float(ipi*ipj)
+              IF(zmin.GT.zper.AND.isurf.NE.0) zmin=zper
+              IF(zmax.LT.zper.AND.isurf.NE.0) zmax=zper
+              IF(zper.LT.0.1.AND.isurf.NE.0) inf10=inf10+1
+              IF(zper.LT.0.3.AND.isurf.NE.0) inf30=inf30+1
+              IF(zper.LT.0.5.AND.isurf.NE.0) inf50=inf50+1
+              !
+              !
+              ! 3. Fin de boucle sur les processeurs, impression
+              ! ------------------------------------------------
+              !
+           END DO
+        END DO
+        WRITE(iumout,*) ' nombre de processeurs       ',jni*jnj
+        WRITE(iumout,*) ' nombre de processeurs mer   ',jni*jnj-ivide
+        WRITE(iumout,*) ' nombre de processeurs terre ',ivide
+        WRITE(iumout,*) ' moyenne de recouvrement     ',float(imoy)/float(jni*jnj-ivide)/float(ipi*ipj)
+        WRITE(iumout,*) ' minimum de recouvrement     ',zmin
+        WRITE(iumout,*) ' maximum de recouvrement     ',zmax
+        WRITE(iumout,*) ' nb de p recouvrement < 10 % ',inf10
+        WRITE(iumout,*) ' nb de p      10 < nb < 30 % ',inf30-inf10
+        WRITE(iumout,*) ' nb de p      30 < nb < 50 % ',inf50-inf10-inf30
+        WRITE(iumout,*) ' nombre de points integres   ',(jni*jnj-ivide)*ipi*ipj
+        WRITE(iumout,*) ' nbr de pts supplementaires  ',(jni*jnj-ivide)*ipi*ipj-jpiglo*jpjglo
+        zper=float((jni*jnj-ivide))*float(ipi*ipj)/float(jpiglo*jpjglo)
+        WRITE(iumout,*) ' % sup                       ',zper
+        WRITE(iumout,*)
+        WRITE(iumout,*) ' PROCESSORS WITH LESS THAN 100 WATER POINTS'
+
+        WRITE(cdum,'(a,1h-,i3.3,1hx,i3.3,1h_,i3.3)') TRIM(covdta),jpni,jpnj,jni*jnj -ivide
+        OPEN (10,file=cdum)
+        WRITE(10,'(a,i5)')'#',jni*jnj -ivide
+        DO jjc=1,jni*jnj-ivide
+           WRITE(10,'(a,i5)')'#',jjc
+           WRITE(10,'(2i5)')nldi(jjc)-1+nizoom-1,nldj(jjc)-1+njzoom -1
+           WRITE(10,'(2i5)')nlei(jjc)+1+nizoom-1,nldj(jjc)-1+njzoom -1
+           WRITE(10,'(2i5)')nlei(jjc)+1+nizoom-1,nlej(jjc)+1+njzoom -1
+           WRITE(10,'(2i5)')nldi(jjc)-1+nizoom-1,nlej(jjc)+1+njzoom -1
+           WRITE(10,'(2i5)')nldi(jjc)-1+nizoom-1,nldj(jjc)-1+njzoom -1
+           WRITE(10,'(2i5)') 9999,9999 
+           IF (icount(jjc).LT.100) THEN
+              WRITE(iumout,*)' proc ji=',jjc,' water points:', icount(jjc)
+              WRITE(iumout,*) ' ji from ',nldi(jjc), ' to :',nlei(jjc)
+              WRITE(iumout,*) ' jj /  mask value for all ji'
+              DO jj=nldj(jjc),nlej(jjc)
+                 WRITE(iumout,900) jj,(INT(zmask(ji,jj)),ji=nldi(jjc),nlei(jjc))
+              ENDDO
+900           FORMAT(1x,i4,1x,9(10i1,1x))
+           ENDIF
+        ENDDO
+        WRITE(10,'(a,i5)')'# vides:',ivide
+        DO jjc=1,ivide
+           WRITE(10,'(a,i5)')'# vide ',jjc
+           WRITE(10,'(2i5)')nldiv(jjc)-1+nizoom-1,nldjv(jjc)-1+njzoom -1
+           WRITE(10,'(2i5)')nleiv(jjc)+1+nizoom-1,nldjv(jjc)-1+njzoom -1
+           WRITE(10,'(2i5)')nleiv(jjc)+1+nizoom-1,nlejv(jjc)+1+njzoom -1
+           WRITE(10,'(2i5)')nldiv(jjc)-1+nizoom-1,nlejv(jjc)+1+njzoom -1
+           WRITE(10,'(2i5)')nldiv(jjc)-1+nizoom-1,nldjv(jjc)-1+njzoom -1
+           WRITE(10,'(2i5)')nleiv(jjc)+1+nizoom-1,nlejv(jjc)+1+njzoom -1
+           WRITE(10,'(2i5)')nldiv(jjc)-1+nizoom-1,nlejv(jjc)+1+njzoom -1
+           WRITE(10,'(2i5)')nleiv(jjc)+1+nizoom-1,nldjv(jjc)-1+njzoom -1
+           WRITE(10,'(2i5)') 9999,9999
+        END DO
+
+        ! 
+        ! 
+        ! 4. Recherche de l optimum
+        ! -------------------------
+        !
+        IF(ivide.GT.iptx) THEN
+           iii=jni
+           iij=jnj
+           iiii=ipi
+           iijj=ipj
+           iptx=ivide
+           iimoy=imoy
+           zzmin=zmin
+           zzmax=zmax
+           iinf10=inf10
+           iinf30=inf30
+           iinf50=inf50
+           zperx=zper
+        ELSE IF(ivide.EQ.iptx.AND.zperx.LT.zper) THEN
+           iii=jni
+           iij=jnj
+           iiii=ipi
+           iijj=ipj
+           iimoy=imoy
+           zzmin=zmin
+           zzmax=zmax
+           iinf10=inf10
+           iinf30=inf30
+           iinf50=inf50
+           zperx=zper
+        ENDIF
+        !
+        ! 5. Fin de boucle sur le nombre de processeurs
+        ! ---------------------------------------------
+        !
+1000    CONTINUE
+     END DO
+  END DO
+  !
+  !
+  ! 6. Affichage resultat
+  ! ---------------------
+  !
+  IF(in.EQ.0) THEN
+     WRITE(iumout,*) ' le choix n a pas pu etre fait '
+     WRITE(iumout,*)
+     WRITE(iumout,*) 'le nombre de processeurs maximum est insuffisant'
+     STOP 
+  ENDIF
+  WRITE(iumout,*) ' choix optimum'
+  WRITE(iumout,*) ' ============='
+  WRITE(iumout,*) 
+  WRITE(iumout,*) '--> nombre de processeurs ',iii*iij
+  WRITE(iumout,*) ' '
+  WRITE(iumout,*) " jpni=",iii ," jpnj=",iij
+  WRITE(iumout,*) " jpi= ",iiii ," jpj= ",iijj
+  WRITE(iumout,*) 
+  WRITE(iumout,*) ' nombre de processeurs mer   ',iii*iij-iptx
+  WRITE(iumout,*) ' nombre de processeurs terre ',iptx
+  WRITE(iumout,*) ' moyenne de recouvrement     ',float(iimoy)/float(iii*iij-iptx)/float(iiii*iijj)
+  WRITE(iumout,*) ' minimum de recouvrement     ',zzmin
+  WRITE(iumout,*) ' maximum de recouvrement     ',zzmax
+  WRITE(iumout,*) ' nb de p recouvrement < 10 % ',iinf10
+  WRITE(iumout,*) ' nb de p      10 < nb < 30 % ',iinf30-iinf10
+  WRITE(iumout,*) ' nb de p      30 < nb < 50 % ',iinf50-iinf10-iinf30
+  WRITE(iumout,*) ' nombre de points integres   ',(iii*iij-iptx)*iiii*iijj
+  WRITE(iumout,*) ' nbr de pts supplementaires  ',(iii*iij-iptx)*iiii*iijj-jpiglo*jpjglo
+  WRITE(iumout,*) ' % sup                       ',zperx
+  WRITE(iumout,*)
+  !
+  !
+  !
+  STOP
+END PROGRAM mppopt_showproc_nc
Index: trunk/NEMOGCM/TOOLS/NESTING/agulhas
===================================================================
--- trunk/NEMOGCM/TOOLS/NESTING/agulhas	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/NESTING/agulhas	(revision 2528)
@@ -0,0 +1,95 @@
+&input_output
+    iom_activated = true 
+/
+
+&coarse_grid_files    
+    parent_coordinate_file = 'coordinates.nc'
+    parent_meshmask_file   = 'meshmask.nc'  
+/    
+    
+&bathymetry    
+    new_topo = true
+    elevation_database = 'bathymetry_meter_ORCA_R05.nc'
+    elevation_name = 'topo'
+    smoothing = true
+    smoothing_factor = 0.6
+    nb_connection_pts = 3    
+    removeclosedseas = true
+    type_bathy_interp = 0 
+/   
+
+&nesting    
+    imin = 125
+    imax = 170
+    jmin = 36
+    jmax = 63
+    rho  = 4									
+    rhot = 2
+    bathy_update = true
+    updated_parent_file = 'bathy_updated.nc'				
+/
+
+&vertical_grid    
+    ppkth = 21.4333619793800
+    ppacr = 3
+    ppdzmin = 0
+    pphmax  = 0
+    psur = -4762.96143546300
+    pa0  = 255.58049070440
+    pa1  = 245.58132232490
+    N  = 31
+/    
+    
+&partial_cells    	
+    partial_steps = true
+    parent_bathy_meter = 'bathy_meter.nc'
+    parent_batmet_name = 'Bathymetry'
+    e3zps_min = 25.
+    e3zps_rat = 0.2
+/
+
+&nemo_coarse_grid    
+    jpizoom = 1			
+    jpjzoom = 1			
+/
+&forcing_files		   
+    U_FILES = 'taux_1m.nc'
+!'dyna_grid_U.nc'                              ! needed for Offline
+    V_FILES =  'tauy_1m.nc'
+!'dyna_grid_V.nc'                              ! needed for Offline
+    FLX_FILES = 
+    'data_1m_salinity_nomask.nc',
+    'data_1m_potential_temperature_nomask.nc',
+    'flx.nc',
+    'geothermal_heating.nc'
+!    'river.orca.nc ',                         ! needed for Pisces
+!    'ndeposition.orca.nc',                    ! needed for Pisces 
+!    'dust.orca.nc',                           ! needed for Pisces 
+!    'bathy.orca.nc'                           ! needed for Pisces
+!'dyna_grid_T.nc',                             ! needed for Offline
+!'dyna_grid_W.nc'                              ! needed for Offline 
+/
+
+&interp
+    VAR_INTERP =
+    'votemper/bicubic',
+    'vosaline/bicubic'
+!    'dust/bilinear',
+!    'riverdic/bilinear',
+!    'riverpoc/bilinear',
+!    'riverdoc/bilinear',
+!    'nedep/bilinear',
+!    'bathy/bilinear'
+/
+
+&restart
+    restart_file = 'restart.nc'   
+    shlat = 0
+    dimg = false
+    dimg_output_file = 'test_dimg'
+    adatrj = 360.25 
+    interp_type = 'bilinear'
+/ 
+&restart_trc
+    restart_trc_file = 'restart_trc.nc'   
+/ 
Index: trunk/NEMOGCM/TOOLS/NESTING/src/agrif_connect_topo.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/NESTING/src/agrif_connect_topo.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/NESTING/src/agrif_connect_topo.f90	(revision 2528)
@@ -0,0 +1,792 @@
+!************************************************************************
+! Fortran 95 OPA Nesting tools						*
+!									*
+!     Copyright (C) 2005 Florian Lemarié (Florian.Lemarie@imag.fr)	*
+!                        Laurent Debreu (Laurent.Debreu@imag.fr)	*
+!************************************************************************
+!
+!Smoothing procedures : Pierrick Penven 2004
+!
+MODULE agrif_connect_topo
+  !
+  USE agrif_types
+  !
+  IMPLICIT NONE           
+  !
+CONTAINS
+  !
+  !
+  !************************************************************************
+  ! 									*
+  ! MODULE  CONNECT_TOPO							*
+  !									*
+  ! module containing subroutine used for : 				*
+  !   - Parent-Child bathymetry connection				*
+  !   - Bathymetry smoothing						*
+  !   - Meters to levels conversion					*
+  !   - Parent Bathymetry update 						*
+  !									*
+  !************************************************************************
+  !
+  !****************************************************************
+  !   subroutine init_constant_bathy				*
+  !								*
+  !								*
+  ! - input :							*
+  !     coarse_bathy : coarse grid bathymetry 			*
+  ! - ouput :							*
+  !    bathy_fin_constant : coarse bathymetry on fine grid	*
+  !								*
+  !****************************************************************
+  !
+  SUBROUTINE init_constant_bathy(coarse_bathy,bathy_fin_constant)
+    !       
+    IMPLICIT NONE 
+    !      
+    INTEGER :: i,j,ii,jj,ji
+    INTEGER :: jpt,ipt,diff,indx,indy,bornex,borney,bornex2,borney2
+    INTEGER :: jdeb,ideb,ifin,jfin
+    REAL*8, DIMENSION(:,:)  :: coarse_bathy
+    REAL*8, DIMENSION(:,:),POINTER :: bathy_fin_constant
+    TYPE(Coordinates) :: Grid     
+    !
+    !
+    diff = 0
+    IF(MOD(rho,2) .EQ. 0) diff = 1
+    !
+    indx = 2 + CEILING(irafx/2.0) + diff      
+    indy = 2 + CEILING(irafy/2.0) + diff
+    bornex = nbghostcellsfine + CEILING(irafx/2.0) + diff - irafx
+    borney = nbghostcellsfine + CEILING(irafy/2.0) + diff - irafy
+    bornex2 = nxfin - (nbghostcellsfine-1) + irafx - CEILING(irafx/2.0) 
+    borney2 = nyfin - (nbghostcellsfine-1) + irafy - CEILING(irafy/2.0) 
+    !    
+    ALLOCATE(bathy_fin_constant(bornex-FLOOR(irafx/2.0):bornex2+FLOOR(irafx/2.0), &
+         borney-FLOOR(irafy/2.0):borney2+FLOOR(irafy/2.0)))
+    !
+    DO j = borney,borney2,irafy
+
+       jpt = jmin + 3 - 1 + (j-indy)/irafy
+       IF(j<=1) jpt = jmin + 1
+
+       DO i = bornex,bornex2,irafx
+
+          ipt = imin + 3 - 1 + (i-indx)/irafx
+          IF(i<=1) ipt = imin + 1
+          !       
+          DO jj = j-FLOOR(irafy/2.0),j+FLOOR(irafy/2.0)-diff
+             DO ii = i-FLOOR(irafx/2.0),i+FLOOR(irafx/2.0)-diff
+
+                bathy_fin_constant(ii,jj) = coarse_bathy(ipt,jpt)
+
+             END DO
+          END DO
+
+       END DO
+    END DO
+    !
+    !
+  END SUBROUTINE init_constant_bathy
+  !
+  !****************************************************************
+  !   subroutine meter_to_levels					*
+  !								*
+  ! subroutine to convert bathymetry in meters to bathymetry	*
+  ! in vertical levels						*
+  !								*
+  ! - input/output :						*
+  !     Grid : grid where conversion is required			*
+  !								*
+  !various input parameters come from namelist.input files	*
+  !****************************************************************
+  !
+  SUBROUTINE meter_to_levels(Grid)
+    !
+    IMPLICIT NONE
+    !
+    REAL*8 :: za1,za0,zsur,zacr,zkth,zmin,zmax
+    TYPE(Coordinates) :: Grid
+    INTEGER :: i,j
+    INTEGER, DIMENSION(1) :: k
+    INTEGER :: k1,ji,jj,jpi,jpj
+    REAL*8, POINTER, DIMENSION(:) :: gdepw,gdept,e3w,e3t
+    !       
+    WRITE(*,*) 'convert bathymetry from etopo to vertical levels'
+    !
+    jpi = SIZE(Grid%bathy_meter,1)
+    jpj = SIZE(Grid%bathy_meter,2)
+    !                     
+    IF ( ( pa0 == 0 .OR. pa1 == 0 .OR. psur == 0 ) &
+         .AND. ppdzmin.NE.0 .AND. pphmax.NE.0 ) THEN 
+       !    
+       za1=( ppdzmin - pphmax / (N-1) )          &
+            / ( TANH((1-ppkth)/ppacr) - ppacr/(N-1) &
+            *  (  LOG( COSH( (N - ppkth) / ppacr) )      &
+            - LOG( COSH( ( 1  - ppkth) / ppacr) )  )  )
+
+       za0  = ppdzmin - za1 * TANH( (1-ppkth) / ppacr )
+       zsur = - za0 - za1 * ppacr * LOG( COSH( (1-ppkth) / ppacr )  )
+       !
+    ELSE IF ( (ppdzmin == 0 .OR. pphmax == 0) .AND. psur.NE.0 .AND. &
+         pa0.NE.0 .AND. pa1.NE.0 ) THEN
+       !       
+       zsur = psur
+       za0  = pa0
+       za1  = pa1
+       !
+    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 
+
+    !
+    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
+    !
+    gdepw(1) = 0.0
+    zmax = gdepw(N) + e3t(N)
+    zmin = gdepw(4)
+    !
+    IF ( .NOT. ASSOCIATED(Grid%bathy_level)) &
+         ALLOCATE(Grid%bathy_level(jpi,jpj))    
+    !
+    Grid%bathy_level = N-1
+    !
+    DO jj = 1, jpj
+       DO ji= 1, jpi
+          IF( Grid%bathy_meter(ji,jj) <= 0. )   &
+               Grid%bathy_level(ji,jj) = INT( Grid%bathy_meter(ji,jj) )
+       END DO
+    END DO
+    !
+    DO jj = 1, jpj
+       DO ji= 1, jpi
+          IF( Grid%bathy_meter(ji,jj) <= 0. ) THEN
+             Grid%bathy_meter(ji,jj) = 0.e0
+          ELSE
+             Grid%bathy_meter(ji,jj) = MAX( Grid%bathy_meter(ji,jj), zmin )
+             Grid%bathy_meter(ji,jj) = MIN( Grid%bathy_meter(ji,jj), zmax )
+          ENDIF
+       END DO
+    END DO
+    !
+    !
+    !
+    DO j = 1,jpj
+       DO i = 1,jpi
+          !
+          IF (Grid%bathy_meter(i,j) .EQ. 0.0 ) THEN
+             Grid%bathy_level(i,j)=0.
+          ELSE
+             !	
+             k1=4
+             DO WHILE (k1 .LT. (N-1))
+                IF ((Grid%bathy_meter(i,j).GE.gdepw(k1)) &
+                     .AND.(Grid%bathy_meter(i,j).LE.gdepw(k1+1))) EXIT
+                k1=k1+1
+             END DO
+             Grid%bathy_level(i,j)=k1
+             !
+          ENDIF
+          !
+       END DO
+    END DO
+    !
+  END SUBROUTINE meter_to_levels
+  !
+  !!
+  !****************************************************************
+  !   subroutine levels_to_meter					*
+  !								*
+  ! subroutine to convert bathymetry in meters to bathymetry	*
+  ! in vertical levels						*
+  !								*
+  ! - input/output :						*
+  !     Grid : grid where conversion is required			*
+  !								*
+  !various input parameters come from namelist.input files	*
+  !****************************************************************
+  !
+  SUBROUTINE levels_to_meter(Grid)
+    !
+    IMPLICIT NONE
+    !
+    REAL*8 :: za1,za0,zsur,zacr,zkth,zmin,zmax
+    TYPE(Coordinates) :: Grid
+    INTEGER :: i,j
+    INTEGER, DIMENSION(1) :: k
+    INTEGER :: k1,ji,jj,jpi,jpj
+    REAL*8, POINTER, DIMENSION(:) :: gdepw,gdept,e3w,e3t
+    !       
+    WRITE(*,*) 'convert bathymetry in meters for smoothing'
+    !
+    jpi = SIZE(Grid%bathy_level,1)
+    jpj = SIZE(Grid%bathy_level,2)
+    !              
+    !             
+    IF ( ( pa0 == 0 .OR. pa1 == 0 .OR. psur == 0 ) &
+         .AND. ppdzmin.NE.0 .AND. pphmax.NE.0 ) THEN 
+       !    
+       za1=( ppdzmin - pphmax / (N-1) )          &
+            / ( TANH((1-ppkth)/ppacr) - ppacr/(N-1) &
+            *  (  LOG( COSH( (N - ppkth) / ppacr) )      &
+            - LOG( COSH( ( 1  - ppkth) / ppacr) )  )  )
+
+       za0  = ppdzmin - za1 * TANH( (1-ppkth) / ppacr )
+       zsur = - za0 - za1 * ppacr * LOG( COSH( (1-ppkth) / ppacr )  )
+       !
+    ELSE IF ( (ppdzmin == 0 .OR. pphmax == 0) .AND. psur.NE.0 .AND. &
+         pa0.NE.0 .AND. pa1.NE.0 ) THEN
+       !       
+       zsur = psur
+       za0  = pa0
+       za1  = pa1
+       !
+    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 
+
+    !
+    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
+    !
+    gdepw(1) = 0.0  
+    !
+    IF(.NOT. ASSOCIATED(Grid%bathy_meter)) THEN
+       ALLOCATE(Grid%bathy_meter(jpi,jpj))  
+    ELSE
+       IF( ANY(SHAPE(Grid%bathy_meter)/=(/jpi,jpj/)) ) THEN	   
+          DEALLOCATE(Grid%bathy_meter)   
+          ALLOCATE(Grid%bathy_meter(jpi,jpj))     
+       ENDIF
+    ENDIF
+    !      
+    DO jj = 1, jpj
+       DO ji= 1, jpi
+          !
+          Grid%bathy_meter(ji,jj) = gdepw( INT( Grid%bathy_level(ji,jj) ) + 1 )
+          !
+       END DO
+    END DO
+    !
+  END SUBROUTINE levels_to_meter
+  !
+
+  !****************************************************************
+  !   subroutine smooth_topo					*
+  !								*
+  ! subroutine to smooth a given bathymetry (in meters)		*
+  !  hanning filter is used (smoothing criterion : rfactor)	*
+  !								*
+  ! - input/output :						*
+  !     h : bathymetry						*
+  !								*
+  !various input parameters are stored in namelist.input files	*
+  !****************************************************************
+  !
+  SUBROUTINE smooth_topo(h,nbiter)
+    !
+    IMPLICIT NONE
+    ! 
+    REAL*8, DIMENSION(:,:) :: h
+    REAL*8 :: hmin,cff,nu,r
+    REAL*8, DIMENSION(:,:), ALLOCATABLE :: rx,ry,cx,cy,f_x,f_y
+    INTEGER :: Mm,Mmm,Lm,Lmm,M,L,nbiter,i,j
+    REAL*8,DIMENSION(:,:),ALLOCATABLE :: maskedtopo
+    !
+    M = SIZE(h,1)
+    L = SIZE(h,2)     
+    !       
+    ALLOCATE(cx(M,L),cy(M,L))
+    ALLOCATE(rx(M,L),ry(M,L))
+    ALLOCATE(f_x(M,L),f_y(M,L))
+    ALLOCATE(maskedtopo(M,L))
+    !
+    WRITE(*,*) ''
+    WRITE(*,*) 'smooth the topography (Hanning filter)'
+    WRITE(*,*) 'slope parameter = ',smoothing_factor
+    !
+    hmin = 1.1
+    WHERE(h <= hmin)
+       h = hmin
+    END WHERE
+    !       
+    WHERE (h == hmin)
+       maskedtopo = 0.
+    ELSEWHERE
+       maskedtopo = 1.
+    END WHERE
+    !
+    Mm = M-1
+    Mmm = Mm - 1
+    Lm = L-1
+    Lmm = Lm - 1
+    cff = 0.8
+    nu = 3.0/16.0
+    rx=0.
+    ry=0.      
+    CALL rfact(h,rx,ry,maskedtopo)    
+    r = MAX(MAXVAL(rx),MAXVAL(ry))
+    h = LOG(h)         
+    nbiter = 0
+    !       
+    DO WHILE (r.GT.smoothing_factor .AND. nbiter < 500  )         
+       !       
+       nbiter=nbiter+1       
+       WHERE(rx > cff*smoothing_factor)
+          cx = 1
+       ELSEWHERE
+          cx = 0
+       END WHERE
+       CALL hanningx(cx,maskedtopo)      
+       WHERE(ry > cff*smoothing_factor)
+          cy = 1
+       ELSEWHERE
+          cy = 0
+       END WHERE
+       CALL hanningy(cy,maskedtopo)      
+       CALL FX(h,f_x,cx,maskedtopo)
+       CALL FY(h,f_y,cy,maskedtopo)       
+       h(2:Mm,2:Lm) = h(2:Mm,2:Lm) + maskedtopo(2:Mm,2:Lm)*nu *                 &
+            ((f_x(2:Mm,3:L)-f_x(2:Mm,2:Lm)) + &     
+            (f_y(3:M,2:Lm)-f_y(2:Mm,2:Lm)))       
+       CALL rfact(EXP(h),rx,ry,maskedtopo)
+       r = MAX(MAXVAL(rx(2:Mm,2:L)),MAXVAL(ry(2:M,2:Lm)))
+       !
+    END DO
+    !       
+    WRITE(*,*) 'iterations = ',nbiter
+    WRITE(*,*) ''
+    h = EXP(h)               
+    WHERE( ABS(h-hmin) <= 0.001 )
+       h = 0.
+    END WHERE
+    DEALLOCATE(rx,ry,cx,cy,f_x,f_y,maskedtopo)
+    !
+  END SUBROUTINE smooth_topo
+  !       
+  !************************************************************************
+  ! subroutine hanning(bathy_meter)
+  !************************************************************************
+  !
+  SUBROUTINE hanning(h,maskedtopo)
+    !
+    IMPLICIT NONE
+    !
+    REAL*8, DIMENSION(:,:) :: h,maskedtopo
+    !
+    INTEGER :: Mm,Mmm,Lm,Lmm,M,L
+    !      
+    M = SIZE(h,1)
+    L = SIZE(h,2)
+    Mm = M-1
+    Mmm = Mm - 1
+    Lm = L-1
+    Lmm = Lm - 1
+    !      
+    h(2:Mm,2:Lm) = maskedtopo(2:Mm,2:Lm)*0.125*(   h(1:Mmm,2:Lm) + &
+         h(3:M,2:Lm)   + &
+         h(2:Mm,1:Lmm) + &
+         h(2:Mm,3:L)   + &
+         4*h(2:Mm,2:Lm))+(1.-maskedtopo(2:Mm,2:Lm))*h(2:Mm,2:Lm)
+    !
+  END SUBROUTINE hanning
+  !      
+  !************************************************************************
+  ! subroutine hanningx(bathy_meter)
+  !************************************************************************
+  !
+  SUBROUTINE hanningx(h,maskedtopo)
+    !
+    IMPLICIT NONE
+    !
+    REAL*8, DIMENSION(:,:) :: h,maskedtopo
+    REAL*8, DIMENSION(:,:), ALLOCATABLE ::  htemp 
+    !
+    INTEGER :: Mm,Mmm,Lm,Lmm,M,L
+    INTEGER :: i,j
+    !      
+    M = SIZE(h,1)
+    L = SIZE(h,2)
+    Mm = M-1
+    Mmm = Mm - 1
+    Lm = L-1
+    Lmm = Lm - 1
+
+    ALLOCATE(htemp(M,L))
+    !      
+    htemp = h      
+    DO j=3,Lm
+       DO i=2,Mm
+          IF ((maskedtopo(i,j)*maskedtopo(i,j-1)) .NE.0.) THEN
+             h(i,j)=0.125*(htemp(i-1,j)+htemp(i+1,j) &
+                  +htemp(i,j+1)+htemp(i,j-1)+4.*htemp(i,j))
+          ENDIF
+       ENDDO
+    ENDDO
+    j=2
+    DO i=2,Mm
+       IF ((maskedtopo(i,j)*maskedtopo(i,j-1)) .NE.0.) THEN
+          h(i,j)=0.25*(htemp(i+1,j)+htemp(i-1,j)+2.*htemp(i,j))
+       ENDIF
+    ENDDO
+    j=L
+    DO i=2,Mm
+       IF ((maskedtopo(i,j)*maskedtopo(i,j-1)) .NE.0.) THEN
+          h(i,j)=0.25*(htemp(i+1,j)+htemp(i-1,j)+2.*htemp(i,j))
+       ENDIF
+    ENDDO
+    DEALLOCATE(htemp)
+    !
+  END SUBROUTINE hanningx
+
+  !************************************************************************
+  ! subroutine hanning(bathy_meter)
+  !************************************************************************
+  !
+  SUBROUTINE hanningy(h,maskedtopo)
+    !
+    IMPLICIT NONE
+    !
+    REAL*8, DIMENSION(:,:) :: h,maskedtopo
+    REAL*8, DIMENSION(:,:), ALLOCATABLE ::  htemp 
+    !
+    INTEGER :: Mm,Mmm,Lm,Lmm,M,L
+    INTEGER :: i,j
+    !      
+    M = SIZE(h,1)
+    L = SIZE(h,2)
+    Mm = M-1
+    Mmm = Mm - 1
+    Lm = L-1
+    Lmm = Lm - 1      
+    ALLOCATE(htemp(M,L))
+    !      
+    htemp = h
+
+    DO j=2,Lm
+       DO i=3,Mm
+          IF ((maskedtopo(i,j)*maskedtopo(i-1,j)) .NE.0.) THEN
+             h(i,j)=0.125*(htemp(i-1,j)+htemp(i+1,j) &
+                  +htemp(i,j+1)+htemp(i,j-1)+4.*htemp(i,j))
+          ENDIF
+       ENDDO
+    ENDDO
+
+    i=2
+    DO j=2,Lm
+       IF ((maskedtopo(i,j)*maskedtopo(i-1,j)) .NE.0.) THEN
+          h(i,j)=0.25*(htemp(i,j+1)+htemp(i,j-1)+2.*htemp(i,j))
+       ENDIF
+    ENDDO
+
+    i=M
+    DO j=2,Lm
+       IF ((maskedtopo(i,j)*maskedtopo(i-1,j)) .NE.0.) THEN
+          h(i,j)=0.25*(htemp(i,j+1)+htemp(i,j-1)+2.*htemp(i,j))
+       ENDIF
+    ENDDO
+
+    DEALLOCATE(htemp)
+    !
+  END SUBROUTINE hanningy
+
+  !      
+  !************************************************************************
+  ! subroutine FX(bathy_meter,fx)
+  !************************************************************************
+  !
+  SUBROUTINE FX(h,f,c,maskedtopo)
+    !
+    IMPLICIT NONE
+    !
+    REAL*8, DIMENSION(:,:)  :: h,c
+    REAL*8, DIMENSION(:,:)  :: f,maskedtopo
+    REAL*8, DIMENSION(SIZE(h,1),SIZE(h,2))  :: floc
+    !
+    INTEGER :: Mm,Mmm,Lm,Lmm,M,L,i,j
+    !
+    f = 0.0     
+    M = SIZE(h,1)
+    L = SIZE(h,2)
+    Mm = M-1
+    Mmm = Mm - 1
+    Lm = L-1
+    Lmm = Lm - 1
+    floc = 0.  
+
+    DO j=2,L
+       DO i=1,M
+
+          IF ((maskedtopo(i,j)*maskedtopo(i,j-1)).EQ.0.) THEN
+             floc(i,j)=0.
+          ELSEIF ((i.EQ.1).OR.(i.EQ.M)) THEN     
+             floc(i,j)=(7./12.)*(h(i,j)-h(i,j-1))              
+          ELSEIF ((maskedtopo(i-1,j)*maskedtopo(i-1,j-1)).EQ.0.) THEN
+             floc(i,j)=(7./12.)*(h(i,j)-h(i,j-1))    
+          ELSEIF ((maskedtopo(i+1,j)*maskedtopo(i+1,j-1)).EQ.0.) THEN
+             floc(i,j)=(7./12.)*(h(i,j)-h(i,j-1))       
+          ELSE               
+             floc(i,j)=(5./12.)*(h(i,j)-h(i,j-1)) &
+                  +(1./12.)*(h(i-1,j)-h(i-1,j-1)+h(i+1,j)-h(i+1,j-1))
+          ENDIF
+       ENDDO
+    ENDDO
+    !      
+    DO j = 1,L
+       DO i = 1,M
+          f(i,j) = c(i,j)*floc(i,j) 
+       END DO
+    END DO
+    !           	       
+    !
+  END SUBROUTINE FX
+  !
+  !
+  !      
+  !************************************************************************
+  ! subroutine FY(bathy_meter,fy)
+  !************************************************************************
+  !
+  SUBROUTINE FY(h,f,c,maskedtopo)
+    !
+    IMPLICIT NONE
+    !
+    REAL*8, DIMENSION(:,:) :: h,c
+    REAL*8, DIMENSION(:,:) :: f,maskedtopo
+    REAL*8, DIMENSION(SIZE(h,1),SIZE(h,2))  :: floc
+    INTEGER :: Mm,Mmm,Lm,Lmm,M,L,i,j
+    f=0.0 
+    !            
+    M = SIZE(h,1)
+    L = SIZE(h,2)
+    Mm = M-1
+    Mmm = Mm - 1
+    Lm = L-1
+    Lmm = Lm - 1
+    !
+    floc = 0.
+
+    DO j=1,L
+       DO i=2,M
+          IF ((maskedtopo(i,j)*maskedtopo(i-1,j)).EQ.0.) THEN
+             floc(i,j) = 0.
+          ELSEIF ((j.EQ.1).OR.(j.EQ.L)) THEN
+             floc(i,j)=(7./12.)*(h(i,j)-h(i-1,j))
+          ELSEIF ((maskedtopo(i,j-1)*maskedtopo(i-1,j-1)).EQ.0.) THEN
+             floc(i,j)=(7./12.)*(h(i,j)-h(i-1,j))
+          ELSEIF ((maskedtopo(i,j+1)*maskedtopo(i-1,j+1)).EQ.0.) THEN
+             floc(i,j)=(7./12.)*(h(i,j)-h(i-1,j))
+          ELSE      
+             floc(i,j)=(5./12.)*(h(i,j)-h(i-1,j)) &
+                  +(1./12.)*(h(i,j-1)-h(i-1,j-1)+h(i,j+1)-h(i-1,j+1))
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    DO j = 1,L
+       DO i = 1,M
+          f(i,j) = c(i,j)*floc(i,j) 
+       END DO
+    END DO
+    !      
+  END SUBROUTINE FY
+  !
+  !
+  !****************************************************************
+  !   subroutine rfact						*
+  !								*
+  ! subroutine to check if smoothing criterion 			*
+  !                     is verified everywhere			*
+  !								*
+  ! - input :							*
+  !     h : bathymetry						*
+  ! - ouput :							*
+  !    rx,ry : delta(theta)/theta in x and y directions		*
+  !****************************************************************
+  !
+  SUBROUTINE rfact(h,rx,ry,maskedtopo)
+    !
+    IMPLICIT NONE
+    !
+    REAL*8, DIMENSION(:,:)  :: h
+    REAL*8, DIMENSION(:,:)  :: rx,ry
+    REAL*8, DIMENSION(:,:)  :: maskedtopo
+    INTEGER M,L,i,j,Mm,Mmm,Lm,Lmm
+    !
+    M = SIZE(h,1)
+    L = SIZE(h,2)
+    Mm = M-1
+    Mmm = Mm - 1
+    Lm = L-1
+    Lmm = Lm - 1
+    !
+    rx=0.
+    ry=0.
+    !      
+    DO j=2,L
+       DO i=1,M	     
+          rx(i,j) = ABS(h(i,j)-h(i,j-1))/(h(i,j)+h(i,j-1))
+          IF ((maskedtopo(i,j)*maskedtopo(i,j-1)) .EQ.0.) THEN
+             rx(i,j)=0.
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    DO j=1,L
+       DO i=2,M
+          ry(i,j) = ABS(h(i,j)-h(i-1,j))/(h(i,j)+h(i-1,j))
+          IF ((maskedtopo(i,j)*maskedtopo(i-1,j)) .EQ.0.) THEN
+             ry(i,j)=0.
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+  END SUBROUTINE rfact
+  !
+  !
+  !****************************************************************
+  !   subroutine Update_Parent_Bathy				*
+  !								*
+  ! (if desired) subroutine to update parent grid bathymetry	*
+  ! 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								*
+  !								*
+  ! - input :							*
+  !     G0,G1 : both grids involved				*
+  ! - ouput :							*
+  !    G0 parent grid containing updated bathymetry		*
+  !****************************************************************
+  !
+  !
+  SUBROUTINE Update_Parent_Bathy( G0,G1 )
+    !
+    IMPLICIT NONE
+
+    TYPE(coordinates) :: G0,G1
+    INTEGER :: ji,jj,jk,ipt,jpt,diff,indx,indy,bornex,borney,bornex2,borney2
+    !
+    INTEGER :: ideb,jdeb,ifin,jfin
+    REAL*8 :: za1,za0,zsur,zacr,zkth,zmin
+    INTEGER :: i,j
+    INTEGER :: k1
+    INTEGER :: compt
+    REAL*8, POINTER, DIMENSION(:) :: gdepw,gdept,e3w,e3t
+    !                     
+    IF ( ( pa0 == 0 .OR. pa1 == 0 .OR. psur == 0 ) &
+         .AND. ppdzmin.NE.0 .AND. pphmax.NE.0 ) THEN 
+       !    
+       za1=( ppdzmin - pphmax / (N-1) )          &
+            / ( TANH((1-ppkth)/ppacr) - ppacr/(N-1) &
+            *  (  LOG( COSH( (N - ppkth) / ppacr) )      &
+            - LOG( COSH( ( 1  - ppkth) / ppacr) )  )  )
+
+       za0  = ppdzmin - za1 * TANH( (1-ppkth) / ppacr )
+       zsur = - za0 - za1 * ppacr * LOG( COSH( (1-ppkth) / ppacr )  )
+       !
+    ELSE IF ( (ppdzmin == 0 .OR. pphmax == 0) .AND. psur.NE.0 .AND. &
+         pa0.NE.0 .AND. pa1.NE.0 ) THEN
+       !       
+       zsur = psur
+       za0  = pa0
+       za1  = pa1
+       !
+    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 
+
+    !
+    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)
+    !      
+    diff = 0
+    IF(MOD(rho,2) .EQ. 0) diff = 1
+
+    ideb = 3 + (irafx - 1)/2
+    jdeb = 3 + (irafy - 1)/2
+
+    jfin = nyfin - 2 - (irafy)/2
+    ifin = nxfin - 2 - (irafx)/2
+    !
+    WRITE(*,*) '---------------------------------'
+    WRITE(*,*) 'Parent grid bathymetry update ...'
+    compt = 0
+    !
+    DO jj = jdeb,jfin,irafy
+       jpt = jmin + 3 - 1 + (jj - jdeb) / irafy
+       DO ji = ideb,ifin,irafx
+          ipt = imin + 3 - 1 + (ji - ideb) / irafx
+          !
+          IF( G0%Bathy_meter(ipt,jpt) .LE. 0. .AND.                      &
+               MAXVAL(G1%Bathy_meter(ji-irafx/2+diff:ji+irafx/2, &
+               jj-irafy/2+diff:jj+irafy/2)).GT. 0.  ) THEN
+             G0%Bathy_meter(ipt,jpt) = zmin
+             !
+             compt = compt + 1
+             !
+          ENDIF
+          !
+       ENDDO
+    ENDDO
+    !
+    WRITE(*,*) ' Number of coarse grid points updated = ',compt
+    WRITE(*,*) '---------------------------------'
+    !      
+  END SUBROUTINE Update_Parent_Bathy
+
+END MODULE agrif_connect_topo
Index: trunk/NEMOGCM/TOOLS/NESTING/src/agrif_create_bathy.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/NESTING/src/agrif_create_bathy.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/NESTING/src/agrif_create_bathy.f90	(revision 2528)
@@ -0,0 +1,706 @@
+!************************************************************************
+! Fortran 95 OPA Nesting tools						*
+!									*
+!     Copyright (C) 2005 Florian Lemarié (Florian.Lemarie@imag.fr)	*
+!                        Laurent Debreu (Laurent.Debreu@imag.fr)	*
+!************************************************************************
+!
+PROGRAM create_bathy
+  !
+  USE NETCDF
+  USE bilinear_interp
+  USE agrif_readwrite
+  USE agrif_partial_steps
+  USE agrif_connect_topo
+  !
+  IMPLICIT NONE
+  !
+  !************************************************************************
+  ! 									*
+  ! PROGRAM  CREATE_BATHY						*
+  !									*
+  ! program to implement bathymetry interpolation to generate 		*
+  ! child grid bathymetry file						*
+  !									*
+  ! various options :							*
+  !									*
+  ! 1- Interpolation directly from parent bathymetry file (z-coord)	*
+  ! 2- Use new topo file in meters (for example etopo)  		*
+  !									*
+  ! vertical coordinates permitted : z-coord and partial steps		*
+  ! sigma coordinates is not yet implemented				*
+  !									*
+  !Interpolation is carried out using bilinear interpolation		*
+  !routine from SCRIP package or median average				*		
+  !									*
+  !http://climate.lanl.gov/Software/SCRIP/				*
+  !************************************************************************
+  !
+  ! variables declaration
+  !      
+  CHARACTER(len=80) :: namelistname
+  CHARACTER*100 :: Childmeter_file,Childlevel_file,Child_coordinates,child_ps     
+  LOGICAL,DIMENSION(:,:),POINTER :: masksrc => NULL()  
+  LOGICAL :: identical_grids     
+  INTEGER,DIMENSION(:,:),ALLOCATABLE ::mask_oce,trouble_points
+  INTEGER :: i,j,num_links,nb,nbadd,status,narg,iargc     
+  INTEGER,DIMENSION(:),POINTER :: src_add,dst_add => NULL() 
+  INTEGER :: numlatfine,numlonfine,numlat,numlon,pos,pos2
+  REAL*8,DIMENSION(:,:),POINTER :: matrix,interpdata => NULL()     
+  REAL*8, DIMENSION(:,:),POINTER :: bathy_fin_constant => NULL()  
+  REAL*8,DIMENSION(:,:),ALLOCATABLE :: bathy_test,vardep,glamhr,gphihr
+  REAL*8,DIMENSION(:),ALLOCATABLE :: vardep1d
+  REAL*8, DIMENSION(:,:),POINTER :: gdepw_ps_interp => NULL() 
+  REAL*8, DIMENSION(:,:),POINTER :: save_gdepw,rx,ry,maskedtopo
+  REAL*8  :: Cell_lonmin,Cell_lonmax,Cell_latmin,Cell_latmax,wghts
+  LOGICAL :: Pacifique
+  INTEGER :: boundary,xpos,ypos,iimin,iimax,jjmax,jjmin
+  INTEGER :: nbloops,nxhr,nyhr,ji,jj,nbiter,nbloopmax
+  INTEGER :: ipt,jpt,iloc,jloc
+  INTEGER, DIMENSION(2) :: i_min,i_max,j_min,j_max
+
+  TYPE(Coordinates) :: G0,G1 
+  !      
+  narg = iargc()      
+  IF (narg == 0) THEN
+     namelistname = 'namelist.input'
+  ELSE
+     CALL getarg(1,namelistname)
+  ENDIF
+  !
+  ! read input file (namelist.input)
+  !
+  CALL read_namelist(namelistname)
+  !      
+  ! define names of child grid files
+  !
+  CALL set_child_name(parent_coordinate_file,Child_coordinates) 
+  IF( TRIM(parent_meshmask_file) .NE. '/NULL' ) &
+       CALL set_child_name(parent_meshmask_file,Childlevel_file)            
+  !
+  !
+  !
+  !
+  !
+  !------------------------------------------------------------------
+  ! ****First option : no new topo file / no partial steps
+  ! interpolate levels directly from parent file
+  !------------------------------------------------------------------
+  !
+  !
+  !
+  !
+  !
+  !
+  IF(.NOT.new_topo .AND. .NOT.partial_steps) THEN      
+     !      
+     WRITE(*,*) 'First option'
+     !read coarse grid bathymetry and coordinates file
+     !           
+     WRITE(*,*) 'No new topo file ...'
+     status = Read_Coordinates(TRIM(parent_coordinate_file),G0)    
+     status = Read_bathy_level(TRIM(parent_meshmask_file),G0)
+     !           
+     IF( imax > SIZE(G0%glamt,1) .OR. jmax > SIZE(G0%glamt,2) .OR. &
+          imax <= imin .OR. jmax <= jmin ) THEN                   
+        WRITE(*,*) 'ERROR ***** bad child grid definition ...'
+        WRITE(*,*) 'please check imin,jmin,imax,jmax,jpizoom,jpjzoom values'       
+        WRITE(*,*) ' '
+        STOP
+     ENDIF
+     !
+     !read fine grid coordinates file
+     !      
+     status = Read_Coordinates(TRIM(Child_coordinates),G1,pacifique)
+     !  
+     IF( SIZE(G1%nav_lon,1) .NE. nxfin .OR. SIZE(G1%nav_lon,2) .NE. nyfin ) THEN
+        !
+        WRITE(*,*) 'ERROR ***** bad child coordinates file ...'
+        WRITE(*,*) ' '
+        WRITE(*,*) 'please check that child coordinates file '
+        WRITE(*,*) 'has been created with the same namelist '
+        WRITE(*,*) ' '
+        STOP
+        !
+     ENDIF
+     !
+     numlat =  SIZE(G0%nav_lat,2)
+     numlon =  SIZE(G0%nav_lat,1)    
+     numlatfine =  SIZE(G1%nav_lat,2)
+     numlonfine =  SIZE(G1%nav_lat,1)  
+     !           
+     ALLOCATE(masksrc(numlon,numlat))
+     !
+     ! create logical array masksrc
+     !
+     WHERE(G0%bathy_level.LE.0) 
+        masksrc = .FALSE.
+     ELSEWHERE
+        masksrc = .TRUE.
+     END WHERE
+
+     IF ( Pacifique ) THEN
+        WHERE(G0%nav_lon < 0.001) 
+           G0%nav_lon = G0%nav_lon + 360.
+        END WHERE
+     ENDIF
+
+
+     !-----------------          
+     ! compute remapping matrix thanks to SCRIP package
+     !
+     ! remapping process
+     !              
+     ALLOCATE(G1%bathy_meter(nxfin,nyfin))
+     CALL levels_to_meter(G0)
+     !             
+     !             Call levels_to_meter(G1)
+     !             
+     CALL get_remap_matrix(G0%nav_lat,G1%nav_lat,   &
+          G0%nav_lon,G1%nav_lon,   &
+          masksrc,matrix,src_add,dst_add)
+     CALL make_remap(G0%bathy_meter,G1%bathy_meter,nxfin,nyfin, &
+          matrix,src_add,dst_add)  
+     !                                  
+     !            
+     DEALLOCATE(masksrc)
+     !-----------------                                      
+     !      
+     ! 
+     ! compute constant bathymetry for Parent-Child bathymetry connection
+     !              
+     CALL init_constant_bathy(G0%bathy_meter,bathy_fin_constant)
+     !
+     boundary = connectionsize*irafx + nbghostcellsfine 
+     !
+     ! connection carried out by copying parent grid values for the fine points
+     ! corresponding to 3 coarse grid cells at the boundaries
+     !                 
+     G1%bathy_meter(1:boundary,:) = bathy_fin_constant(1:boundary,:)
+     G1%bathy_meter(:,1:boundary) = bathy_fin_constant(:,1:boundary)
+     G1%bathy_meter(nxfin-boundary+1:nxfin,:) = bathy_fin_constant(nxfin-boundary+1:nxfin,:)
+     G1%bathy_meter(:,nyfin-boundary+1:nyfin) = bathy_fin_constant(:,nyfin-boundary+1:nyfin)
+     !                  
+     CALL smooth_topo(G1%bathy_meter(boundary:nxfin-boundary+1,boundary:nyfin-boundary+1),nbiter)
+     !             
+     CALL meter_to_levels(G1)
+     !             
+     DEALLOCATE(bathy_fin_constant)
+     !
+     !
+     !------------------------------------------------------------------
+     ! ****Second option : new topo file or/and partial steps     
+     !------------------------------------------------------------------ 
+     !
+     !
+     !
+     !
+     !
+     !
+     !
+     !
+  ELSE
+     !
+     WRITE(*,*) 'Second option : partial steps'
+     ! read fine and coarse grids coordinates file
+     !	    
+     status = Read_Coordinates(TRIM(parent_coordinate_file),G0)
+     status = Read_Coordinates(TRIM(Child_coordinates),G1,Pacifique)
+     !                        
+     IF( imax > SIZE(G0%nav_lon,1) .OR. jmax > SIZE(G0%nav_lon,2) .OR. &
+          imax <= imin .OR. jmax <= jmin ) THEN                    
+        WRITE(*,*) 'ERROR ***** bad child grid definition ...'
+        WRITE(*,*) 'please check imin,jmin,imax,jmax,jpizoom,jpjzoom values'       
+        WRITE(*,*) ' '
+        STOP
+     ENDIF
+     !
+
+     !  
+     IF( SIZE(G1%nav_lon,1) .NE. nxfin .OR. SIZE(G1%nav_lon,2) .NE. nyfin ) THEN
+        !
+        WRITE(*,*) 'ERROR ***** bad child coordinates file ...'
+        WRITE(*,*) ' '
+        WRITE(*,*) 'please check that child coordinates file '
+        WRITE(*,*) 'has been created with the same namelist '
+        WRITE(*,*) ' '
+        STOP
+        !
+     ENDIF
+     !      
+     ! read coarse grid bathymetry file
+     !---
+     IF( new_topo ) THEN
+        WRITE(*,*) 'use new topo file : ',TRIM(elevation_database)
+        DEALLOCATE( G0%nav_lon, G0%nav_lat )
+        status = Read_bathy_meter(TRIM(elevation_database),G0,G1,Pacifique)
+     ELSE
+        WRITE(*,*) 'no new topo file'
+        status = Read_Bathymeter(TRIM(parent_bathy_meter),G0)
+        IF(Pacifique) THEN
+           WHERE(G0%nav_lon < 0.001) 
+              G0%nav_lon = G0%nav_lon + 360.
+           END WHERE
+        ENDIF
+     ENDIF
+     !---            
+     numlatfine =  SIZE(G1%nav_lat,2)
+     numlonfine =  SIZE(G1%nav_lat,1) 
+     !  
+     !               
+     ALLOCATE(G1%bathy_meter(nxfin,nyfin))
+     G1%bathy_meter(:,:)=0.                       
+
+     WRITE(*,*) 'Interpolation of high resolution bathymetry on child grid'
+
+     IF( type_bathy_interp == 0 ) THEN
+        WRITE(*,*) 'Arithmetic average ...'
+     ELSE IF( type_bathy_interp == 1 ) THEN
+        WRITE(*,*) 'Median average ...'
+     ELSE IF( type_bathy_interp == 2 ) THEN     
+        WRITE(*,*) 'Bilinear interpolation ...'
+     ELSE     
+        WRITE(*,*) 'bad value for type_bathy_interp variable ( must be 0,1 or 2 )'
+        STOP 
+     ENDIF
+     !
+     !************************************
+     !MEDIAN AVERAGE or ARITHMETIC AVERAGE
+     !************************************
+     !
+     IF( type_bathy_interp == 0 .OR. type_bathy_interp == 1 ) THEN 
+        !
+        ALLOCATE(trouble_points(nxfin,nyfin))
+        trouble_points = 0
+        !
+        !  POINT DETECTION
+        !
+        !                       
+        DO jj = 2,numlatfine
+           DO ji = 2,numlonfine
+              !	    
+              ! FINE GRID CELLS DEFINITION               
+              !
+              Cell_lonmin = MIN(G1%glamf(ji-1,jj-1),G1%glamf(ji,jj-1),G1%glamf(ji,jj),G1%glamf(ji-1,jj))
+              Cell_lonmax = MAX(G1%glamf(ji-1,jj-1),G1%glamf(ji,jj-1),G1%glamf(ji,jj),G1%glamf(ji-1,jj))
+              Cell_latmin = MIN(G1%gphif(ji-1,jj-1),G1%gphif(ji,jj-1),G1%gphif(ji,jj),G1%gphif(ji-1,jj))
+              Cell_latmax = MAX(G1%gphif(ji-1,jj-1),G1%gphif(ji,jj-1),G1%gphif(ji,jj),G1%gphif(ji-1,jj))	                   
+              !               
+              ! SEARCH FOR ALL POINTS CONTAINED IN THIS CELL
+              !
+              iimin = 1
+              DO WHILE( G0%nav_lon(iimin,1) < Cell_lonmin ) 
+                 iimin = iimin + 1
+              ENDDO
+              !               
+              jjmin = 1
+              DO WHILE( G0%nav_lat(iimin,jjmin) < Cell_latmin ) 
+                 jjmin = jjmin + 1
+              ENDDO
+              !                
+              iimax = iimin 
+              DO WHILE( G0%nav_lon(iimax,1) <= Cell_lonmax ) 
+                 iimax = iimax + 1
+              ENDDO
+              !                               
+              jjmax = jjmin 
+              DO WHILE( G0%nav_lat(iimax,jjmax) <= Cell_latmax ) 
+                 jjmax = jjmax + 1
+              ENDDO
+              !
+              iimax = iimax-1
+              jjmax = jjmax-1
+              !               
+              iimin = MAX( iimin,1 )
+              jjmin = MAX( jjmin,1 )
+              iimax = MIN( iimax,SIZE(G0%bathy_meter,1))
+              jjmax = MIN( jjmax,SIZE(G0%bathy_meter,2))
+
+              nxhr = iimax - iimin + 1
+              nyhr = jjmax - jjmin + 1                    
+
+              IF( nxhr == 0 .OR. nyhr == 0 ) THEN
+                 trouble_points(ji,jj) = 1
+              ELSE
+
+                 ALLOCATE( vardep(nxhr,nyhr) )
+                 ALLOCATE( mask_oce(nxhr,nyhr) )
+                 mask_oce = 0	       
+
+                 vardep(:,:) = G0%bathy_meter(iimin:iimax,jjmin:jjmax)
+
+                 WHERE( vardep(:,:) .GT. 0. )  mask_oce = 1
+
+                 IF( SUM(mask_oce) == 0 ) THEN
+                    G1%bathy_meter(ji,jj) = 0.
+                 ELSE
+                    IF( type_bathy_interp == 0 ) THEN
+                       ! Arithmetic average                   
+                       G1%bathy_meter(ji,jj) = SUM (vardep(:,:)*mask_oce(:,:))/SUM(mask_oce)
+                    ELSE
+                       ! Median average		    
+                       !
+                       vardep(:,:) = vardep(:,:)*mask_oce(:,:) - 100000*(1-mask_oce(:,:))
+                       ALLOCATE(vardep1d(nxhr*nyhr))
+                       vardep1d = RESHAPE(vardep,(/ nxhr*nyhr /) )
+                       CALL ssort(vardep1d,nxhr*nyhr)
+                       !
+                       ! Calculate median
+                       !
+                       IF (MOD(SUM(mask_oce),2) .NE. 0) THEN
+                          G1%bathy_meter(ji,jj) = vardep1d( SUM(mask_oce)/2 + 1)
+                       ELSE
+                          G1%bathy_meter(ji,jj) = ( vardep1d(SUM(mask_oce)/2) + vardep1d(SUM(mask_oce)/2+1) )/2.0
+                       END IF
+                       DEALLOCATE(vardep1d)		   
+                    ENDIF
+                 ENDIF
+                 DEALLOCATE (mask_oce,vardep)
+
+              ENDIF
+           ENDDO
+        ENDDO
+
+        IF( SUM( trouble_points ) > 0 ) THEN
+           PRINT*,'too much empty cells, proceed to bilinear interpolation !!'
+           type_bathy_interp = 2
+        ENDIF
+
+     ENDIF
+
+     !
+     ! create logical array masksrc
+     !
+     IF( type_bathy_interp == 2) THEN 
+        !
+
+        !            
+        identical_grids = .FALSE.
+
+        IF( SIZE(G0%nav_lat,1) == SIZE(G1%nav_lat,1)  .AND.   &
+             SIZE(G0%nav_lat,2) == SIZE(G1%nav_lat,2)  .AND.   &
+             SIZE(G0%nav_lon,1) == SIZE(G1%nav_lon,1)  .AND.   &
+             SIZE(G0%nav_lon,2) == SIZE(G1%nav_lon,2)   ) THEN
+           IF( MAXVAL( ABS(G0%nav_lat(:,:)- G1%nav_lat(:,:)) ) < 0.0001 .AND.   &
+                MAXVAL( ABS(G0%nav_lon(:,:)- G1%nav_lon(:,:)) ) < 0.0001 ) THEN
+              G1%bathy_meter = G0%bathy_meter 
+              PRINT*,'same grid between ',elevation_database,' and child domain'    
+              identical_grids = .TRUE.                          
+           ENDIF
+        ENDIF
+
+
+        IF( .NOT. identical_grids ) THEN 
+
+           ALLOCATE(masksrc(SIZE(G0%bathy_meter,1),SIZE(G0%bathy_meter,2)))
+           ALLOCATE(bathy_test(nxfin,nyfin))
+           !
+           !                    Where(G0%bathy_meter.le.0.00001) 
+           !	                masksrc = .false.
+           !	            ElseWhere
+           !
+           masksrc = .TRUE.
+           !
+           !	            End where                       
+           !            
+           ! compute remapping matrix thanks to SCRIP package            
+           !                                  
+           CALL get_remap_matrix(G0%nav_lat,G1%nav_lat,   &
+                G0%nav_lon,G1%nav_lon,   &
+                masksrc,matrix,src_add,dst_add)
+           CALL make_remap(G0%bathy_meter,bathy_test,nxfin,nyfin, &
+                matrix,src_add,dst_add)  
+           !                                  
+           G1%bathy_meter = bathy_test               
+           !            
+           DEALLOCATE(masksrc)
+           DEALLOCATE(bathy_test) 
+
+        ENDIF
+        !            
+     ENDIF
+     !
+     !
+     !
+     !------------------------------------------------------------------------------------------
+     ! ! ****Third  option : Partial Steps
+     ! The code includes the 
+     ! option to include partial cells at the bottom 
+     ! in order to better resolve topographic variations
+     !------------------------------------------------------------------------------------------
+     !
+     ! At this step bathymetry in meters has already been interpolated on fine grid
+     !
+     ! 	                
+     IF( partial_steps ) THEN                
+        !                  
+        status = Read_Bathymeter(TRIM(parent_bathy_meter),G0)
+        DEALLOCATE(G0%nav_lat,G0%nav_lon)
+        status = Read_coordinates(TRIM(parent_coordinate_file),G0)
+        !------------------------                  
+
+        IF (.NOT.ASSOCIATED(G0%gdepw_ps)) &
+             ALLOCATE(G0%gdepw_ps(SIZE(G0%bathy_meter,1),SIZE(G0%bathy_meter,2)))
+        IF (.NOT.ASSOCIATED(G1%gdepw_ps)) &
+             ALLOCATE(G1%gdepw_ps(SIZE(G1%bathy_meter,1),SIZE(G1%bathy_meter,2)))                  
+        IF (.NOT.ASSOCIATED(gdepw_ps_interp)) &
+             ALLOCATE(gdepw_ps_interp(SIZE(G1%bathy_meter,1),SIZE(G1%bathy_meter,2)))
+        !
+        !                       
+        WRITE(*,*) 'Coarse grid : '
+        CALL get_partial_steps(G0) 
+        WRITE(*,*) ' '
+        WRITE(*,*) 'Fine grid : '
+        CALL get_partial_steps(G1)                 ! compute gdepw_ps for G1
+        CALL bathymetry_control(G0%Bathy_level)    !    
+        CALL Check_interp(G0,gdepw_ps_interp)      ! interpolation in connection zone (3 coarse grid cells)
+        !
+        boundary = connectionsize*irafx + nbghostcellsfine                     
+        G1%gdepw_ps(1:boundary,:) = gdepw_ps_interp(1:boundary,:)
+        G1%gdepw_ps(:,1:boundary) = gdepw_ps_interp(:,1:boundary)
+        G1%gdepw_ps(nxfin-boundary+1:nxfin,:) = gdepw_ps_interp(nxfin-boundary+1:nxfin,:)
+        G1%gdepw_ps(:,nyfin-boundary+1:nyfin) = gdepw_ps_interp(:,nyfin-boundary+1:nyfin)
+
+
+        !                   
+
+        IF(.NOT. smoothing) WRITE(*,*) 'No smoothing process only connection is carried out'
+        WRITE(*,*) ' linear connection on ',nb_connection_pts,'coarse grid points'
+
+        connectionsize = 3 + nb_connection_pts 
+        !            
+        gdepw_ps_interp = 0.
+        CALL Check_interp(G0,gdepw_ps_interp)      ! interpolation in connection zone (3 coarse grid cells)
+        !
+        !
+        !
+        !
+        !                    LINEAR CONNECTION
+        !
+        !
+        !
+        !
+        !
+        wghts = 1.
+        DO ji = boundary + 1 , boundary + nb_connection_pts * irafx
+           G1%gdepw_ps(ji,boundary+1:nyfin-boundary) =                                          &
+                (1.-wghts) * G1%gdepw_ps(ji,boundary+1:nyfin-boundary) +                          &
+                wghts * gdepw_ps_interp(ji,boundary+1:nyfin-boundary)
+           wghts = wghts - (1. / (nb_connection_pts*irafx - 1. ) ) 
+        ENDDO
+
+        wghts = 1.
+        DO ji = nxfin - boundary , nxfin - boundary - nb_connection_pts * irafx + 1 ,-1 
+           G1%gdepw_ps(ji,boundary+1:nyfin-boundary) =                                            &
+                (1. - wghts) * G1%gdepw_ps(ji,boundary+1:nyfin-boundary) +                          &
+                wghts * gdepw_ps_interp(ji,boundary+1:nyfin-boundary)
+           wghts = wghts - (1. / ( (nb_connection_pts*irafx) - 1. ) )                      
+        ENDDO
+        !                     
+        wghts = 1.
+        DO jj = boundary + 1 , boundary + nb_connection_pts * irafy
+           G1%gdepw_ps(boundary + nb_connection_pts * irafx + 1: &
+                nxfin - boundary - nb_connection_pts * irafx ,jj) =          &
+                (1. - wghts) * G1%gdepw_ps(boundary + nb_connection_pts * irafx + 1:  &
+                nxfin - boundary - nb_connection_pts * irafx,jj) +                          &
+                wghts * gdepw_ps_interp(boundary + nb_connection_pts * irafx + 1:   &
+                nxfin - boundary - nb_connection_pts * irafx,jj)
+           wghts = wghts - (1. / (nb_connection_pts*irafx - 1. ) )                      
+        ENDDO
+        !                    
+        wghts = 1.
+        DO jj = nyfin - boundary , nyfin - boundary - nb_connection_pts * irafy+ 1 , -1
+           G1%gdepw_ps(boundary + nb_connection_pts * irafx + 1: &
+                nxfin - boundary - nb_connection_pts * irafx ,jj) =                      &
+                (1. - wghts) * G1%gdepw_ps(boundary + nb_connection_pts * irafx + 1: &
+                nxfin - boundary - nb_connection_pts * irafx,jj) +                          &
+                wghts * gdepw_ps_interp(boundary + nb_connection_pts * irafx + 1: &
+                nxfin - boundary - nb_connection_pts * irafx,jj)
+           wghts = wghts - (1. / (nb_connection_pts*irafx - 1. ) )   
+        ENDDO
+
+        G1%bathy_meter = G1%gdepw_ps
+        !                     
+        connectionsize = 3
+        ! 
+        IF(smoothing) THEN 
+
+           !
+           ! Smoothing to connect the connection zone (3 + nb_connection_pts coarse grid cells) and the interior domain
+           !
+           boundary = (connectionsize+nb_connection_pts)*irafx + nbghostcellsfine 
+           CALL smooth_topo(G1%gdepw_ps(boundary:nxfin-boundary+1,boundary:nyfin-boundary+1),nbiter)
+           G1%bathy_meter = G1%gdepw_ps                         
+        ENDIF
+
+
+        !
+        !  
+        ! Remove closed seas
+        !                            
+        IF (removeclosedseas) THEN
+           ALLOCATE(bathy_test(nxfin,nyfin))
+           bathy_test=0.
+           WHERE (G1%bathy_meter(1,:).GT.0.)
+              bathy_test(1,:)=1
+           END WHERE
+           WHERE (G1%bathy_meter(nxfin,:).GT.0.)
+              bathy_test(nxfin,:)=1
+           END WHERE
+           WHERE (G1%bathy_meter(:,1).GT.0.)
+              bathy_test(:,1)=1
+           END WHERE
+           WHERE (G1%bathy_meter(:,nyfin).GT.0.)
+              bathy_test(:,nyfin)=1
+           END WHERE
+           nbadd = 1
+           DO WHILE (nbadd.NE.0)
+              nbadd = 0
+              DO j=2,nyfin-1
+                 DO i=2,nxfin-1
+                    IF (G1%bathy_meter(i,j).GT.0.) THEN
+                       IF (MAX(bathy_test(i,j+1),bathy_test(i,j-1), &
+                            bathy_test(i-1,j),bathy_test(i+1,j)).EQ.1) THEN
+                          IF (bathy_test(i,j).NE.1.) nbadd = nbadd + 1
+                          bathy_test(i,j)=1.
+                       ENDIF
+
+                    ENDIF
+                 ENDDO
+              ENDDO
+           ENDDO
+           WHERE (bathy_test.EQ.0.)
+              G1%bathy_meter = 0.
+           END WHERE
+           DEALLOCATE(bathy_test)
+        ENDIF
+        !
+        IF(bathy_update) CALL Update_Parent_Bathy( G0,G1 )                  
+        !
+        CALL set_child_name(parent_bathy_meter,child_ps)
+        status = Write_Bathy_meter(TRIM(child_ps),G1)        
+
+        IF(bathy_update) status = Write_Bathy_meter(TRIM(updated_parent_file),G0)
+
+        CALL get_partial_steps(G1)
+        !
+        G1%bathy_level=NINT(G1%bathy_level)
+        !
+        IF( TRIM(parent_meshmask_file) .NE. '/NULL' ) &
+             status = Write_Bathy_level(TRIM(Childlevel_file),G1)
+        !
+        WRITE(*,*) '****** Bathymetry successfully created for partial cells ******'
+        WRITE(*,*) ' '
+        !
+        STOP         
+     ENDIF
+     !            
+     !--------------------------------end if partial steps------------------------------------
+     !
+     !
+     status = Read_bathy_level(TRIM(parent_meshmask_file),G0)
+     !            
+     CALL levels_to_meter(G0)
+     ! 
+     ! compute constant bathymetry for Parent-Child bathymetry connection
+     !              
+     WHERE( G0%bathy_meter < 0.000001 ) G0%bathy_meter = 0.
+
+     CALL init_constant_bathy(G0%bathy_meter,bathy_fin_constant)
+     !
+     boundary = connectionsize*irafx + nbghostcellsfine   
+     !             
+     G1%bathy_meter(1:boundary,:) = bathy_fin_constant(1:boundary,:)
+     G1%bathy_meter(:,1:boundary) = bathy_fin_constant(:,1:boundary)
+     G1%bathy_meter(nxfin-boundary+1:nxfin,:) = bathy_fin_constant(nxfin-boundary+1:nxfin,:)
+     G1%bathy_meter(:,nyfin-boundary+1:nyfin) = bathy_fin_constant(:,nyfin-boundary+1:nyfin)
+     !
+     ! bathymetry smoothing
+     !                  
+     CALL smooth_topo(G1%bathy_meter(boundary:nxfin-boundary+1,boundary:nyfin-boundary+1),nbiter)
+     !
+     ! convert bathymetry from meters to levels
+     !
+     CALL meter_to_levels(G1) 
+     !           
+     DEALLOCATE(G1%bathy_meter)           
+     !	     	     
+  ENDIF
+  !
+  !
+  ! make connection thanks to constant and interpolated bathymetry
+  !
+  !      
+  G1%bathy_level=NINT(G1%bathy_level)
+  !	    
+  DO j=1,nyfin
+     DO i=1,nxfin
+        IF (g1%bathy_level(i,j).LT.0.) THEN
+           PRINT *,'error in ',i,j,g1%bathy_level(i,j)
+        ENDIF
+     ENDDO
+  ENDDO
+  !	    
+  WHERE ((G1%bathy_level.LT.3.).AND.(G1%bathy_level.GT.0.))
+     G1%bathy_level=3
+  END WHERE
+  !
+  ! possibility to remove closed seas
+  !      
+  IF (removeclosedseas) THEN
+     ALLOCATE(bathy_test(nxfin,nyfin))
+
+     bathy_test=0.
+     WHERE (G1%bathy_level(1,:).GT.0.)
+        bathy_test(1,:)=1
+     END WHERE
+
+     WHERE (G1%bathy_level(nxfin,:).GT.0.)
+        bathy_test(nxfin,:)=1
+     END WHERE
+
+     WHERE (G1%bathy_level(:,1).GT.0.)
+        bathy_test(:,1)=1
+     END WHERE
+
+     WHERE (G1%bathy_level(:,nyfin).GT.0.)
+        bathy_test(:,nyfin)=1
+     END WHERE
+
+     nbadd = 1
+
+     DO WHILE (nbadd.NE.0)
+        nbadd = 0
+        DO j=2,nyfin-1
+           DO i=2,nxfin-1
+              IF (G1%bathy_level(i,j).GT.0.) THEN
+                 IF (MAX(bathy_test(i,j+1),bathy_test(i,j-1),bathy_test(i-1,j),bathy_test(i+1,j)).EQ.1) THEN
+                    IF (bathy_test(i,j).NE.1.) nbadd = nbadd + 1
+                    bathy_test(i,j)=1.
+                 ENDIF
+
+              ENDIF
+           ENDDO
+        ENDDO
+
+     ENDDO
+
+     WHERE (bathy_test.EQ.0.)
+        G1%bathy_level = 0.
+     END WHERE
+     DEALLOCATE(bathy_test)           
+  ENDIF
+
+
+  !
+  ! store interpolation result in output file
+  !
+  status = Write_Bathy_level(TRIM(Childlevel_file),G1)
+
+  WRITE(*,*) '****** Bathymetry successfully created for full cells ******'
+  WRITE(*,*) ' '
+
+  STOP
+END PROGRAM create_bathy
+
+
Index: trunk/NEMOGCM/TOOLS/NESTING/src/agrif_create_coordinates.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/NESTING/src/agrif_create_coordinates.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/NESTING/src/agrif_create_coordinates.f90	(revision 2528)
@@ -0,0 +1,236 @@
+PROGRAM create_coordinate
+  !
+  USE NETCDF
+  USE agrif_readwrite
+  USE agrif_interpolation
+  !	     
+  !****************************************************************      
+  !								*
+  !************************************************************************
+  ! Fortran 95 OPA Nesting tools						*
+  !									*
+  !     Copyright (C) 2005 Florian Lemarié (Florian.Lemarie@imag.fr)	*
+  !									*
+  !************************************************************************
+  !
+  ! PROGRAM CREATE_COORDINATE 					*
+  !								*
+  ! program to create coordinates file for child grid		*
+  ! (child grid defined by imin,imax,jmin,jmax,rho)		*
+  !								*
+  !****************************************************************
+  !
+  ! variables declaration
+  !
+  REAL*8 :: rpi,ra,rad
+  CHARACTER*100 :: Child_filename 
+  INTEGER :: i
+  TYPE(Coordinates) :: G0,G1
+  INTEGER :: narg,iargc
+  CHARACTER(len=80) :: namelistname
+
+  narg = iargc()
+
+  IF (narg == 0) THEN
+     namelistname = 'namelist.input'
+  ELSE
+     CALL getarg(1,namelistname)
+  ENDIF
+  !
+  ! read input file (namelist.input)
+  !
+  CALL read_namelist(namelistname)
+  !
+
+  !      
+  ! read parent coodinates file
+  !
+  status = Read_Coordinates(TRIM(parent_coordinate_file),G0)
+  ! 
+  ! define name of child coordinate file
+  !     
+  CALL set_child_name(parent_coordinate_file,Child_filename) 
+  !
+  IF( imax > SIZE(G0%glamt,1) .OR. jmax > SIZE(G0%glamt,2) .OR. imax <= imin .OR. jmax <= jmin ) THEN                    
+     WRITE(*,*) 'ERROR ***** bad child grid definition ...'
+     WRITE(*,*) 'please check imin,jmin,imax,jmax,jpizoom,jpjzoom values'       
+     WRITE(*,*) ' '
+     STOP
+  ENDIF
+  !                      
+  WRITE(*,*) ' '
+  WRITE(*,*)'Size of the High resolution grid: ',nxfin,' x ',nyfin
+  WRITE(*,*) ' '
+  !
+  ! allocation of child grid elements
+  !
+  CALL agrif_grid_allocate(G1,nxfin,nyfin)
+  !
+  !
+  !  check potential longitude problems 
+  !      
+  IF( G0%glamt(imin,jmin) > G0%glamt(imax,jmax) ) THEN           
+     WRITE(*,*) '    '
+     WHERE ( G0%glamt < 0 )
+        G0%glamt = G0%glamt + 360.
+     END WHERE
+     WHERE ( G0%glamf < 0 )
+        G0%glamf = G0%glamf + 360.
+     END WHERE
+  ENDIF
+
+  !      
+  ! interpolation from parent grid to child grid for
+  ! T points (cell center)
+  ! F points (lower left corner)
+  ! U points (cell left side)
+  ! V points (cell top side)
+  !    glam = longitude
+  !    gphi = latitude
+  !
+
+  !      
+  CALL agrif_interp(G0%glamt,G1%glamt,'T')            
+  CALL agrif_interp(G0%glamf,G1%glamf,'F')       
+  G1%glamu = G1%glamf
+  G1%glamv = G1%glamt    
+  !
+  CALL agrif_interp(G0%gphit,G1%gphit,'T')
+  CALL agrif_interp(G0%gphif,G1%gphif,'F')
+  G1%gphiu = G1%gphit
+  G1%gphiv = G1%gphif
+  !
+  !
+  rpi = 4.*ATAN(1.)
+  rad = rpi/180.
+  ra  = 6371229.
+  !
+  ! Compute scale factors e1 e2
+  !
+  DO j=1,nyfin
+     DO i=2,nxfin
+        G1%e1t(i,j) = ra * rad * SQRT( (COS(rad*G1%gphit(i,j))*(G1%glamu(i,j)-G1%glamu(i-1,j)))**2 &
+             + (G1%gphiu(i,j)-G1%gphiu(i-1,j))**2)
+        G1%e1v(i,j) = ra * rad * SQRT( (COS(rad*G1%gphiv(i,j))*(G1%glamf(i,j)-G1%glamf(i-1,j)))**2 &
+             + (G1%gphif(i,j)-G1%gphif(i-1,j))**2)                                                             
+     END DO
+  END DO
+  !      
+  G1%e1t(1,:)=G1%e1t(2,:)
+  G1%e1v(1,:)=G1%e1v(2,:)
+  !
+  DO j=1,nyfin
+     DO i=1,nxfin-1
+        G1%e1u(i,j) = ra * rad * SQRT( (COS(rad*G1%gphiu(i,j))*(G1%glamt(i+1,j)-G1%glamt(i,j)))**2 &
+             + (G1%gphit(i+1,j)-G1%gphit(i,j))**2)
+        G1%e1f(i,j) = ra * rad * SQRT( (COS(rad*G1%gphif(i,j))*(G1%glamv(i+1,j)-G1%glamv(i,j)))**2 &
+             + (G1%gphiv(i+1,j)-G1%gphiv(i,j))**2)                                                            
+     END DO
+  END DO
+  !
+  G1%e1u(nxfin,:)=G1%e1u(nxfin-1,:)
+  G1%e1f(nxfin,:)=G1%e1f(nxfin-1,:)
+  !
+  DO j=2,nyfin
+     DO i=1,nxfin                                     
+        G1%e2t(i,j) = ra * rad * SQRT( (COS(rad*G1%gphit(i,j))*(G1%glamv(i,j)-G1%glamv(i,j-1)))**2 &
+             + (G1%gphiv(i,j)-G1%gphiv(i,j-1))**2)
+        G1%e2u(i,j) = ra * rad * SQRT( (COS(rad*G1%gphiu(i,j))*(G1%glamf(i,j)-G1%glamf(i,j-1)))**2 &
+             + (G1%gphif(i,j)-G1%gphif(i,j-1))**2)                                                               
+     END DO
+  END DO
+  !
+  G1%e2t(:,1)=G1%e2t(:,2)
+  G1%e2u(:,1)=G1%e2u(:,2)
+  !
+  DO j=1,nyfin-1
+     DO i=1,nxfin
+        G1%e2v(i,j) = ra * rad * SQRT( (COS(rad*G1%gphiv(i,j))*(G1%glamt(i,j+1)-G1%glamt(i,j)))**2 &
+             + (G1%gphit(i,j+1)-G1%gphit(i,j))**2)
+        G1%e2f(i,j) = ra * rad * SQRT( (COS(rad*G1%gphif(i,j))*(G1%glamu(i,j+1)-G1%glamu(i,j)))**2 &
+             + (G1%gphiu(i,j+1)-G1%gphiu(i,j))**2)
+     END DO
+  END DO
+  !
+  G1%e2v(:,nyfin)=G1%e2v(:,nyfin-1)
+  G1%e2f(:,nyfin)=G1%e2f(:,nyfin-1)
+
+
+  CALL agrif_interp(G0%e1t,G1%e1t,'T')
+  G1%e1t = G1%e1t / REAL(irafx)
+  CALL agrif_interp(G0%e2t,G1%e2t,'T')
+  G1%e2t = G1%e2t / REAL(irafy)
+
+  CALL agrif_interp(G0%e1u,G1%e1u,'U')
+  G1%e1u = G1%e1u / REAL(irafx)
+  CALL agrif_interp(G0%e2u,G1%e2u,'U')
+  G1%e2u = G1%e2u / REAL(irafy)  
+
+  CALL agrif_interp(G0%e1v,G1%e1v,'V')
+  G1%e1v = G1%e1v / REAL(irafx)
+  CALL agrif_interp(G0%e2v,G1%e2v,'V')
+  G1%e2v = G1%e2v / REAL(irafy) 
+
+  CALL agrif_interp(G0%e1f,G1%e1f,'F')
+  G1%e1f = G1%e1f / REAL(irafx)
+  CALL agrif_interp(G0%e2f,G1%e2f,'F')
+  G1%e2f = G1%e2f / REAL(irafy)               
+
+  !
+  WHERE ( G1%glamt > 180 )
+     G1%glamt = G1%glamt - 360.
+  END WHERE
+  WHERE ( G1%glamf > 180 )
+     G1%glamf = G1%glamf - 360.
+  END WHERE
+  WHERE ( G1%glamu > 180 )
+     G1%glamu = G1%glamu - 360.
+  END WHERE
+  WHERE ( G1%glamv > 180 )
+     G1%glamv = G1%glamv - 360.
+  END WHERE
+  !
+  !
+  G1%nav_lon=G1%glamt
+  G1%nav_lat=G1%gphit 
+  !              
+  !
+  ! Write interpolation result in child coodinates file
+  !      
+  status = Write_Coordinates(TRIM(Child_filename),G1)
+
+  !
+  WRITE(*,*) 'Child domain position : '
+  WRITE(*,*) 'latmin =',G1%gphit(3,3)
+  WRITE(*,*) 'latmax =',G1%gphit(nxfin-2,nyfin-2)
+  WRITE(*,*) 'lonmin =',G1%glamt(3,3)
+  WRITE(*,*) 'lonmax =',G1%glamt(nxfin-2,nyfin-2)
+  STOP
+END PROGRAM create_coordinate
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: trunk/NEMOGCM/TOOLS/NESTING/src/agrif_create_data.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/NESTING/src/agrif_create_data.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/NESTING/src/agrif_create_data.f90	(revision 2528)
@@ -0,0 +1,79 @@
+PROGRAM create_data
+  !
+  USE io_netcdf
+  USE bilinear_interp
+  USE agrif_readwrite
+  USE agrif_interpolation      
+  !
+  IMPLICIT NONE
+  !
+  !************************************************************************
+  ! 									*
+  ! PROGRAM  CREATE_DATA							*
+  !									*
+  ! program to implement data interpolation to generate	 		*
+  ! child grid forcing files						*
+  !									*									*
+  !Interpolation is carried out using bilinear interpolation		*
+  !routine from SCRIP package						*		
+  !									*
+  !http://climate.lanl.gov/Software/SCRIP/				*									*
+  !************************************************************************
+  !
+  INTEGER :: narg,iargc,i
+  CHARACTER(len=80) :: namelistname
+
+  narg = iargc()
+
+  IF (narg == 0) THEN
+     namelistname = 'namelist.input'
+  ELSE
+     CALL getarg(1,namelistname)
+  ENDIF
+
+  ! read input file (namelist.input)
+  !
+  CALL read_namelist(namelistname)
+
+  i = 1
+  !
+  ! Interpolate U grid  data
+  !
+  DO WHILE( TRIM(U_Files(i)) .NE. '/NULL' )
+     PRINT *,'Grid U forcing files = ',u_files(i)
+     !        
+     CALL Interp_Extrap_var(U_FILES(i), 'U') 
+     i = i+1                
+     !             
+  END DO
+
+  i = 1
+  !
+  ! Interpolate V grid  data
+  !
+  DO WHILE( TRIM(V_Files(i)) .NE. '/NULL' )
+     PRINT *,'Grid V forcing files = ',v_files(i)
+     !        
+     CALL Interp_Extrap_var(V_FILES(i), 'V') 
+     i = i+1                
+     !             
+  END DO
+
+  i = 1
+  !
+  ! Interpolate flux data
+  !
+  DO WHILE( TRIM(Flx_Files(i)) .NE. '/NULL' )
+     PRINT *,'flxfiles = ',flx_files(i)
+     !        
+     CALL Interp_Extrap_var(FLX_FILES(i), 'T') 
+     i = i+1                
+     !             
+  END DO
+  !
+  WRITE(*,*) ' '
+  WRITE(*,*) '******* forcing files successfully created *******' 
+  WRITE(*,*) ' '  
+  !
+  STOP
+END PROGRAM create_data
Index: trunk/NEMOGCM/TOOLS/NESTING/src/agrif_create_restart.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/NESTING/src/agrif_create_restart.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/NESTING/src/agrif_create_restart.f90	(revision 2528)
@@ -0,0 +1,982 @@
+!
+!************************************************************************
+! Fortran 95 OPA Nesting tools						*
+!									*
+!     Copyright (C) 2005 Florian Lemari�(Florian.Lemarie@imag.fr)	*
+!									*
+!************************************************************************
+!
+PROGRAM create_rstrt
+  !
+  USE NETCDF
+  USE bilinear_interp
+  USE bicubic_interp
+  USE agrif_readwrite
+  USE io_netcdf 
+  USE agrif_extrapolation
+  USE agrif_interpolation
+  USE agrif_partial_steps        
+  !
+  IMPLICIT NONE
+  !
+  !************************************************************************
+  ! 									*
+  ! PROGRAM  CREATE_RSTRT							*
+  !									*
+  ! program to interpolate parent grid restart file to child grid		*
+  !									*
+  !									*
+  !Interpolation is carried out using bilinear interpolation		*
+  !routine from SCRIP package						*		
+  !									*
+  !http://climate.lanl.gov/Software/SCRIP/				*
+  !************************************************************************
+  !
+  ! variables declaration
+  !      
+  CHARACTER*20,DIMENSION(:),POINTER :: Ncdf_varname => NULL()
+  CHARACTER*20 :: vert_coord_name
+  CHARACTER*1 :: posvar
+  CHARACTER*100 :: Child_file,Childcoordinates,varname,Childbathy,Childbathymeter   
+  REAL*8, POINTER, DIMENSION(:,:) :: lonChild,latChild => NULL()
+  REAL*8, POINTER, DIMENSION(:,:) :: lonParent,latParent => NULL()
+  REAL*8, POINTER, DIMENSION(:,:,:) :: tabvar3d,tabinterp3d,mask => NULL()
+  REAL*8, POINTER, DIMENSION(:,:,:) :: fmask,fse3u,fse3v,fse3t => NULL()
+  REAL*8, POINTER, DIMENSION(:,:,:,:) :: un,ub,vn,vb,tn,tb => NULL()
+  REAL*8, POINTER, DIMENSION(:,:,:,:) :: sshn,sshb,sb,sn,gcx,gcxb => NULL()      
+  REAL*8, POINTER, DIMENSION(:,:,:,:) :: tabinterp4d,tabvar1,tabvar2,tabvar3 => NULL()
+  REAL*8, POINTER, DIMENSION(:,:,:,:) :: rotn,rotb,hdivn,hdivb => NULL()
+  REAL*8, POINTER, DIMENSION(:) :: timedepth_temp => NULL()
+  REAL*8, POINTER, DIMENSION(:) :: tabtemp1D,nav_lev => NULL()
+  INTEGER, POINTER, DIMENSION(:) :: tabtemp1DInt => NULL()
+  REAL*8, POINTER, DIMENSION(:,:) :: tabtemp2D,zwf => NULL()
+  REAL*8, POINTER, DIMENSION(:,:) :: e1f,e2f,e1v,e2v,e1u,e2u,e1t,e2t => NULL()
+  REAL*8, POINTER, DIMENSION(:,:,:,:) :: tabtemp4D => NULL()
+  INTEGER,DIMENSION(:),POINTER :: src_add,dst_add  => NULL()
+  REAL*8,DIMENSION(:,:),POINTER :: matrix,bathy_G0 => NULL()
+  LOGICAL,DIMENSION(:,:,:),POINTER :: Tmask => NULL()
+  LOGICAL,DIMENSION(:,:),POINTER :: masksrc => NULL()
+  LOGICAL, DIMENSION(:,:,:), POINTER :: detected_pts
+  LOGICAL :: Interpolation,Extrapolation,Pacifique,op
+  REAL*8 :: za1,za0,zsur,zacr,zkth,zdepth,zdepwp,zmin,zmax,zdiff,ze3tp,ze3wp       
+  INTEGER :: narg,iargc,ncid,x,y,t,z,z_a,x_a,y_a,z_b,nbvert_lev,m
+  REAL*8 :: now_wght,before_wght
+  INTEGER :: i,j,k,status,ji,jj
+  CHARACTER(len=20),DIMENSION(4) :: dimnames
+  CHARACTER(len=80) :: namelistname
+  TYPE(Coordinates) :: G0,G1
+  INTEGER :: jpi,jpj,jpk,jpni,jpnj,jpnij,jpiglo,jpjglo,nlcit,nlcjt,nldit
+  INTEGER :: nldjt,nleit,nlejt,nimppt,njmppt
+  REAL*8 :: tabtemp0dreal
+  INTEGER :: tabtemp0dint
+  CHARACTER(len=20) :: timedimname
+
+  !      
+  ! Variables for dimg
+  ! 
+  INTEGER :: ino0, it0, ipcg0, isor0, itke0,nfice,nfbulk
+  INTEGER :: irecl8, irec,ndastp,narea,nsolv
+  INTEGER :: jk,kt            ! dummy loop indices
+  INTEGER :: inum             ! temporary logical unit
+  INTEGER :: ios1 , ios2      ! flag for ice and bulk in the current run
+  INTEGER :: ios3             ! flag for free surface.  0 = none 1 = yes.  0 = none 1 = yes
+  INTEGER :: ios4             ! flag for coupled (1) or not (0)    
+  !       
+  narg = iargc()
+  IF (narg == 0) THEN
+     namelistname = 'namelist.input'
+  ELSE
+     CALL getarg(1,namelistname)
+  ENDIF
+  !
+  ! read input file
+  !
+  CALL read_namelist(namelistname)
+  !      
+  IF(TRIM(restart_file) == '/NULL') THEN
+     WRITE(*,*) 'no restart file specified in ',TRIM(namelistname)
+     STOP
+  END IF
+
+  IF (iom_activated) THEN
+     timedimname = 't'
+  ELSE
+     timedimname='time'
+  ENDIF
+
+  !
+  WRITE(*,*) ''
+  WRITE(*,*) 'Interpolation of restart file : ',TRIM(restart_file)
+  WRITE(*,*) ''
+  !
+  CALL Read_Ncdf_VarName(restart_file,Ncdf_varname)
+  !       
+  CALL set_child_name(parent_coordinate_file,Childcoordinates)   
+  CALL set_child_name(parent_meshmask_file,Childbathy) 
+  CALL set_child_name(parent_bathy_meter,Childbathymeter)   
+  !
+  ! create this file
+  !
+  IF( .NOT. dimg ) THEN           
+     CALL set_child_name(restart_file,Child_file)
+     status = nf90_create(Child_file,NF90_WRITE,ncid)
+     status = nf90_close(ncid)
+     WRITE(*,*) 'Child grid restart file name = ',TRIM(Child_file)      
+     WRITE(*,*) ''
+  ENDIF
+
+  ! 
+  ! read dimensions in parent restart file
+  !
+  CALL Read_Ncdf_dim('x',restart_file,x)
+  CALL Read_Ncdf_dim('y',restart_file,y) 
+  CALL Read_Ncdf_dim('z',restart_file,z)
+  CALL Read_Ncdf_dim('x_a',restart_file,x_a)
+  CALL Read_Ncdf_dim('y_a',restart_file,y_a)
+  CALL Read_Ncdf_dim('z_a',restart_file,z_a)
+  CALL Read_Ncdf_dim('z_b',restart_file,z_b)
+
+  IF( z .NE. N ) THEN
+     WRITE(*,*) '***'
+     WRITE(*,*) 'Number of vertical levels doesn t match between namelist and restart file'
+     WRITE(*,*) 'Please check the values in namelist file'
+     STOP
+  ENDIF
+  !
+  ! mask initialization for extrapolation and interpolation
+  ! 
+  WRITE(*,*) 'mask initialisation on coarse and fine grids'
+  !           
+  status = Read_Local_Coordinates(parent_coordinate_file,G0,(/jpizoom,jpjzoom/),(/x,y/))
+  status = Read_Coordinates(Childcoordinates,G1,Pacifique)
+  !
+  !longitude modification if child domain covers Pacific ocean area
+  !      
+  IF( Pacifique ) THEN
+     !
+     WHERE( G0%nav_lon < 0 )
+        G0%nav_lon = G0%nav_lon + 360.
+     END WHERE
+     !              
+     WHERE( G1%nav_lon < 0 )
+        G1%nav_lon = G1%nav_lon + 360.
+     END WHERE
+     !
+  ENDIF
+  !
+  CALL Init_mask(parent_meshmask_file,G0,x,y)
+  CALL Init_mask(childbathy,G1,1,1)
+
+  G0%tmask = 1.    
+
+  DO k=1,z
+     ALLOCATE(tabvar1(x,y,1,1))
+     CALL Read_Ncdf_var('sn',TRIM(restart_file),tabvar1,1,k)
+     WHERE( tabvar1(:,:,1,1) == 0. ) 
+        G0%tmask(:,:,k) = 0.
+     END WHERE
+     DEALLOCATE(tabvar1)
+  END DO
+  !
+  G0%umask(1:x-1,:,:) = G0%tmask(1:x-1,:,:)*G0%tmask(2:x,:,:)
+  G0%vmask(:,1:y-1,:) = G0%tmask(:,1:y-1,:)*G0%tmask(:,2:y,:)
+  !
+  G0%umask(x,:,:) = G0%tmask(x,:,:)
+  G0%vmask(:,y,:) = G0%tmask(:,y,:)
+  !      
+  G0%fmask(1:x-1,1:y-1,:) = G0%tmask(1:x-1,1:y-1,:)*G0%tmask(2:x,1:y-1,:)* &
+       G0%tmask(1:x-1,2:y,:)*G0%tmask(2:x,2:y,:) 
+  !
+  G0%fmask(x,:,:) = G0%tmask(x,:,:)
+  G0%fmask(:,y,:) = G0%tmask(:,y,:)
+  !
+  !   *****   ***  **   ** ******
+  !   *    *   *   * * * * *
+  !   *    *   *   *  *  * *  ***
+  !   *    *   *   *     * *    *
+  !   *****   ***  *     * ******
+  !
+  IF(dimg) THEN
+     !        
+     WRITE(*,*) 'create dimg restart file'
+     DO m = 7,1000 
+        INQUIRE(Unit=inum,Opened=op)
+        IF( .NOT. op ) THEN
+           inum = m
+           EXIT
+        ENDIF
+     ENDDO
+     !
+     inum = 11
+     irecl8 = nxfin * nyfin * 8
+     OPEN(inum,FILE=TRIM(dimg_output_file),FORM='UNFORMATTED',  &
+          ACCESS='DIRECT',RECL=irecl8)
+     !       
+     CALL Read_Ncdf_var('info',TRIM(restart_file),tabtemp4D)    
+     !        
+     ino0 = NINT(tabtemp4D(1,1,1,1))
+     it0 = NINT(tabtemp4D(1,1,2,1))*rhot
+     WRITE(*,*) 'restart file created for kt = ',it0
+     ipcg0 = NINT(tabtemp4D(1,1,3,1))
+     isor0 = NINT(tabtemp4D(1,1,4,1))
+     itke0 = 0
+     IF(tabtemp4D(1,1,5,1)==1.) itke0 = 1 
+     ndastp = NINT(tabtemp4D(1,1,6,1))
+     ! number of elapsed days since the begining of the run              
+     !
+     DEALLOCATE(tabtemp4D)
+     !
+     IF (isor0 + 1 == 3) THEN 
+        isor0 = 2
+        ipcg0 = 2
+     ENDIF
+     !        
+     CALL Read_Ncdf_var('nfice',TRIM(restart_file),tabtemp4D)     
+     nfice = NINT(tabtemp4D(1,1,1,1))
+     DEALLOCATE(tabtemp4D)
+     !
+     CALL Read_Ncdf_var('nfbulk',TRIM(restart_file),tabtemp4D)     
+     nfbulk = NINT(tabtemp4D(1,1,1,1))
+     DEALLOCATE(tabtemp4D)
+     !
+     nfice = 5
+     nfbulk = 5
+     !
+     ios1 = 0
+     ios2 = 0
+     ios3 = 1          ! flag for free surface.  0 = none 1 = yes.  0
+     ios4 = 0
+     narea = 1
+     jpi = nxfin
+     jpj = nyfin
+     jpk = z
+     jpni = 1
+     jpnj = 1
+     jpnij = 1
+     narea = 1
+     jpiglo = nxfin
+     jpjglo = nyfin
+     nlcit = nxfin
+     nlcjt = nyfin
+     nldit = 1
+     nldjt = 1
+     nleit = nxfin
+     nlejt = nyfin
+     nimppt = 1
+     njmppt = 1
+     !
+     PRINT*,'jpi = ',jpi
+     PRINT*,'jpj = ',jpj
+     PRINT*,'jpk = ',jpk
+     PRINT*,'nfice = ',nfice
+     PRINT*,'nfbulk = ',nfbulk
+     PRINT*,'ndastp = ',ndastp
+     !
+     WRITE(inum,REC=1) irecl8, ino0, it0, isor0, ipcg0, itke0, &
+          nfice, nfbulk , ios1, ios2, ios3, ios4, &
+          ndastp, adatrj, jpi, jpj, jpk,  &
+          jpni, jpnj, jpnij, narea, jpiglo, jpjglo, &
+          nlcit, nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt
+     !          
+     irec = 2
+     !
+     !   *****    *****    ******
+     !   *        *    *   *   
+     !   *        *    *   *** 
+     !   *        *    *   *   
+     !   *****    *****    *  
+     !
+  ELSE
+
+
+     !
+     ! write dimensions in output file
+     !          
+     CALL Write_Ncdf_dim('x',Child_file,nxfin)
+     CALL Write_Ncdf_dim('y',Child_file,nyfin)
+     CALL Write_Ncdf_dim('z',Child_file,z)
+     CALL Write_Ncdf_dim(TRIM(timedimname),Child_file,0) 
+     IF (.NOT.iom_activated) THEN
+        CALL Write_Ncdf_dim('x_a',Child_file,x_a)
+        CALL Write_Ncdf_dim('y_a',Child_file,y_a)
+        CALL Write_Ncdf_dim('z_a',Child_file,z_a)
+        CALL Write_Ncdf_dim('z_b',Child_file,z_b)
+     ENDIF
+     !
+     !
+  ENDIF
+
+
+
+
+
+
+  !
+  !
+  !
+  DO i = 1,SIZE(Ncdf_varname)      
+     !      
+     ! loop on variables names
+     !      
+     SELECT CASE (TRIM(Ncdf_varname(i)))
+        !
+        !copy nav_lon from child coordinates to output file      
+        !
+     CASE('nav_lon')
+        IF(.NOT. dimg ) THEN
+           WRITE(*,*) 'copy nav_lon'
+           CALL Read_Ncdf_var('nav_lon',TRIM(Childcoordinates),tabtemp2D) 
+           CALL Write_Ncdf_var('nav_lon',(/'x','y'/),Child_file,tabtemp2D,'float')
+           CALL Copy_Ncdf_att('nav_lon',TRIM(restart_file),Child_file, &
+                MINVAL(tabtemp2D),MAXVAL(tabtemp2D))
+           DEALLOCATE(tabtemp2D)
+           Interpolation = .FALSE.
+        ENDIF
+        !	     
+        !copy nav_lat from child coordinates to output file
+        !
+     CASE('nav_lat')             
+        IF(.NOT. dimg ) THEN
+           WRITE(*,*) 'copy nav_lat'
+           CALL Read_Ncdf_var('nav_lat',TRIM(Childcoordinates),tabtemp2D) 
+           CALL Write_Ncdf_var('nav_lat',(/'x','y'/),Child_file,tabtemp2D,'float')
+           CALL Copy_Ncdf_att('nav_lat',TRIM(restart_file),Child_file, &
+                MINVAL(tabtemp2D),MAXVAL(tabtemp2D)) 
+           DEALLOCATE(tabtemp2D)
+           Interpolation = .FALSE.
+        ENDIF
+        !
+        !copy nav_lev from restart_file to output file
+        !
+     CASE('nav_lev')
+
+        WRITE(*,*) 'copy nav_lev'
+        CALL Read_Ncdf_var('nav_lev',TRIM(restart_file),nav_lev) 
+        IF(.NOT. dimg ) THEN
+           CALL Write_Ncdf_var('nav_lev','z',Child_file,nav_lev,'float')
+           CALL Copy_Ncdf_att('nav_lev',TRIM(restart_file),Child_file)      
+        ENDIF
+        Interpolation = .FALSE.
+        !
+        !copy time from restart_file to output file                       
+        !
+     CASE('time')
+        IF(.NOT. dimg ) THEN
+           WRITE(*,*) 'copy time'
+           CALL Read_Ncdf_var('time',TRIM(restart_file),tabtemp1D) 
+           CALL Write_Ncdf_var('time',TRIM(timedimname),Child_file,tabtemp1D,'float')
+           CALL Copy_Ncdf_att('time',TRIM(restart_file),Child_file) 
+           DEALLOCATE(tabtemp1D)
+           Interpolation = .FALSE.
+        ENDIF
+        !copy time from restart_file to output file                       
+        !
+     CASE('time_counter')
+        IF(.NOT. dimg ) THEN
+           WRITE(*,*) 'copy time_counter'
+           CALL Read_Ncdf_var('time_counter',TRIM(restart_file),tabtemp1D) 
+           tabtemp1D = tabtemp1D * rhot
+           CALL Write_Ncdf_var('time_counter',TRIM(timedimname),Child_file,tabtemp1D,'double')
+           CALL Copy_Ncdf_att('time_counter',TRIM(restart_file),Child_file) 
+           DEALLOCATE(tabtemp1D)
+           Interpolation = .FALSE.
+        ENDIF
+        !
+        !copy time_steps from restart_file to output file             
+        !
+     CASE('time_steps')
+        IF(.NOT. dimg ) THEN
+           WRITE(*,*) 'copy time_steps'
+           CALL Read_Ncdf_var('time_steps',TRIM(restart_file),tabtemp1DInt) 
+           CALL Write_Ncdf_var('time_steps',TRIM(timedimname),Child_file,tabtemp1DInt)
+           CALL Copy_Ncdf_att('time_steps',TRIM(restart_file),Child_file) 
+           DEALLOCATE(tabtemp1DInt)
+           Interpolation = .FALSE.    
+        ENDIF
+        !
+        !copy info from restart_file to output file
+        !
+     CASE('info') 
+        IF(.NOT. dimg ) THEN
+           WRITE(*,*) 'copy info'        
+           CALL Read_Ncdf_var('info',TRIM(restart_file),tabtemp4D) 
+           dimnames(1)='x_a'
+           dimnames(2)='y_a'
+           dimnames(3)='z_a'
+           dimnames(4)=TRIM(timedimname)            
+           CALL Write_Ncdf_var('info',dimnames,Child_file,tabtemp4D,'double')
+           CALL Copy_Ncdf_att('info',TRIM(restart_file),Child_file) 
+           DEALLOCATE(tabtemp4D)
+           Interpolation = .FALSE. 
+        ENDIF
+        !
+     CASE('nfice','nfbulk','kt','ndastp','adatrj','rdt','rdttra1') 
+        IF(.NOT. dimg ) THEN
+           WRITE(*,*) 'copy ',TRIM(Ncdf_varname(i))
+           IF (iom_activated) THEN
+              CALL Read_Ncdf_var(TRIM(Ncdf_varname(i)),TRIM(restart_file),tabtemp0dreal)  
+              SELECT CASE (TRIM(Ncdf_varname(i)))
+              CASE('rdt','rdttra1')
+                 tabtemp0dreal = tabtemp0dreal/rhot
+              CASE('kt')
+                 tabtemp0dreal = tabtemp0dreal * rhot
+              END SELECT
+              CALL Write_Ncdf_var(TRIM(Ncdf_varname(i)),Child_file,tabtemp0dreal,'double')
+           ELSE
+              CALL Read_Ncdf_var(TRIM(Ncdf_varname(i)),TRIM(restart_file),tabtemp4D) 
+              dimnames(1)='x_a'
+              dimnames(2)='y_a'
+              dimnames(3)='z_b'
+              dimnames(4)=TRIM(timedimname)            
+              CALL Write_Ncdf_var(TRIM(Ncdf_varname(i)),dimnames,Child_file,tabtemp4D,'double')
+	      DEALLOCATE(tabtemp4D)
+           ENDIF
+           CALL Copy_Ncdf_att(TRIM(Ncdf_varname(i)),TRIM(restart_file),Child_file) 
+           Interpolation = .FALSE.
+        ENDIF
+        !
+        ! Variable interpolation according to their position on grid
+        !                                   
+     CASE('un','ub')  
+        varname = Ncdf_varname(i)
+
+        IF(TRIM(varname)=='un') irec = 6 * z + 2
+        IF(TRIM(varname)=='ub') irec = 2
+
+        WRITE(*,*) TRIM(varname),'interpolation ...'    
+        vert_coord_name = 'z'             
+        posvar='U'
+        Interpolation = .TRUE.  
+        !
+     CASE('u_io')  
+        varname = Ncdf_varname(i)  
+        WRITE(*,*) TRIM(varname),'interpolation ...'    
+        vert_coord_name = 'z_b'             
+        posvar='U'
+        Interpolation = .TRUE. 
+        !                          
+     CASE('vn','vb')
+        varname = Ncdf_varname(i)
+
+        IF(TRIM(varname)=='vn') irec = 7 * z + 2
+        IF(TRIM(varname)=='vb') irec = 2 + z
+
+        WRITE(*,*) TRIM(varname),'interpolation ...'      
+        vert_coord_name = 'z'
+        posvar='V'
+        Interpolation = .TRUE.     
+        !              
+     CASE('v_io')
+        varname = Ncdf_varname(i)
+        WRITE(*,*) TRIM(varname),'interpolation ...'      
+        vert_coord_name = 'z_b'
+        posvar='V'
+        Interpolation = .TRUE.
+        !             
+     CASE('gcx','gcxb','sshb','sshn','sst_io','sss_io','gsst')
+        varname = Ncdf_varname(i)    
+
+        IF(TRIM(varname)=='gcx') irec = 12 * z + 2
+        IF(TRIM(varname)=='gcxb')  irec = 12 * z + 3
+        IF(TRIM(varname)=='sshb') irec = 12 * z + 4
+        IF(TRIM(varname)=='sshn') irec = 12 * z + 5
+
+        WRITE(*,*) TRIM(varname),'interpolation ...' 
+        vert_coord_name = 'z_b'             
+        posvar='T'
+        Interpolation = .TRUE.     
+
+        !  
+     CASE ('tb','sb','sn','tn')
+        varname = Ncdf_varname(i) 
+
+        IF(TRIM(varname)=='sn') irec = 9 * z + 2
+        IF(TRIM(varname)=='tn') irec = 8 * z + 2
+        IF(TRIM(varname)=='sb') irec = 3 * z + 2
+        IF(TRIM(varname)=='tb') irec = 2 * z + 2
+
+        WRITE(*,*) TRIM(varname),'interpolation ...'     
+        vert_coord_name = 'z'
+        posvar='T'
+        Interpolation = .TRUE.            
+
+     CASE('en')
+        varname = Ncdf_varname(i) 
+        irec = 12 * z + 6
+        WRITE(*,*) TRIM(varname),'interpolation ...'     
+        vert_coord_name = 'z'
+        posvar='T'
+        Interpolation = .TRUE.             
+
+     CASE ('rotb','rotn','hdivb','hdivn')
+        Interpolation = .FALSE.
+        !
+     END SELECT
+     !      
+     IF( Interpolation ) THEN
+        !		  
+        IF( vert_coord_name == 'z') THEN
+           nbvert_lev = z 
+        ELSE IF( vert_coord_name == 'z_b') THEN
+           IF (iom_activated) THEN
+              nbvert_lev=1
+           ELSE
+              nbvert_lev = z_b
+           ENDIF
+        END IF
+        !                  
+
+        !
+        t = 1
+
+        ALLOCATE(detected_pts(SIZE(G0%tmask,1),SIZE(G0%tmask,2),nbvert_lev))                             
+        ALLOCATE(tabvar1(x,y,1,2))
+        ALLOCATE(tabvar2(x,y,1,1))
+        ALLOCATE(tabvar3(x,y,1,1))
+        ALLOCATE(masksrc(x,y))
+        ALLOCATE(tabinterp4d(nxfin,nyfin,1,1)) 
+
+        !	    
+        DO n = 1,nbvert_lev
+           !
+           WRITE(*,*) 'interpolate/extrapolate ', &
+                TRIM(varname),' for vertical level = ',n   
+           !                           
+           !                                                       
+           !                            If(n==1) then
+           !                                      Call Read_Ncdf_var(varname,TRIM(restart_file),tabvar1,t,n)    
+           !                            else if (n==2) then
+           !                                      Call Read_Ncdf_var(varname,TRIM(restart_file),tabvar2,t,n-1)
+           !                                      Call Read_Ncdf_var(varname,TRIM(restart_file),tabvar1,t,n)            
+           !                            else 
+           !                                      Call Read_Ncdf_var(varname,TRIM(restart_file),tabvar3,t,n-2)
+           !                                      Call Read_Ncdf_var(varname,TRIM(restart_file),tabvar2,t,n-1)
+           !                                      Call Read_Ncdf_var(varname,TRIM(restart_file),tabvar1,t,n)
+           !                            endif                                                        	                  
+           !
+           CALL Read_Ncdf_var(varname,TRIM(restart_file),tabvar1,t,n)
+           IF(n==1) THEN
+              !                            
+           ELSE IF (n==2) THEN
+              tabvar2(:,:,:,1) = tabvar1(:,:,:,2)
+           ELSE
+              tabvar3(:,:,:,1) = tabvar2(:,:,:,1)
+              tabvar2(:,:,:,1) = tabvar1(:,:,:,2)
+
+           ENDIF
+           !                            
+           SELECT CASE(posvar)
+              ! 
+           CASE('T')
+              !
+              IF(MAXVAL(G1%tmask(:,:,n)) == 0.) THEN		      
+                 tabinterp4d = 0.0
+                 WRITE(*,*) 'only land points on level ',n                     
+              ELSE		       		      
+
+                 CALL extrap_detect(G0,G1,detected_pts(:,:,n),n)                                            
+
+                 CALL correct_field(detected_pts(:,:,n),tabvar1,tabvar2,&
+                      tabvar3,G0,nav_lev,masksrc,n)                                 
+
+                 SELECT CASE(TRIM(interp_type))
+                 CASE('bilinear')                                                       
+                    CALL get_remap_matrix(G0%nav_lat,G1%nav_lat, &
+                         G0%nav_lon,G1%nav_lon,masksrc,matrix,src_add,dst_add)
+                    CALL make_remap(tabvar1(:,:,1,1),tabinterp4d(:,:,1,1),nxfin,nyfin, &
+                         matrix,src_add,dst_add)     
+                 CASE('bicubic')                                   
+                    CALL get_remap_bicub(G0%nav_lat,G1%nav_lat, &
+                         G0%nav_lon,G1%nav_lon,masksrc,matrix,src_add,dst_add)
+                    CALL make_bicubic_remap(tabvar1(:,:,1,1),masksrc,tabinterp4d(:,:,1,1),&
+                         nxfin,nyfin,matrix,src_add,dst_add) 
+                 END SELECT
+                 !                      
+                 CALL Correctforconservation(tabvar1(:,:,1,1),tabinterp4d(:,:,1,1), &
+                      G0%e1t,G0%e2t,G1%e1t,G1%e2t,nxfin,nyfin,posvar,imin-jpizoom+1,jmin-jpjzoom+1)
+
+
+              ENDIF
+
+              tabinterp4d(:,:,1,1) =  tabinterp4d(:,:,1,1) * G1%tmask(:,:,n)
+              !
+           CASE('U')
+              !
+              IF(MAXVAL(G1%umask(:,:,n)) == 0) THEN
+                 tabinterp4d = 0.0
+                 WRITE(*,*) 'only land points on level ',n  
+              ELSE		
+                 !
+                 CALL extrap_detect(G0,G1,detected_pts(:,:,n),n,'U')  
+                 CALL correct_field(detected_pts(:,:,n),tabvar1,tabvar2,&
+                      tabvar3,G0,nav_lev,masksrc,n,'U')
+                 !                                                           
+                 SELECT CASE(TRIM(interp_type))
+                 CASE('bilinear')                                                       
+                    CALL get_remap_matrix(G0%gphiu,G1%gphiu,   &
+                         G0%glamu,G1%glamu,masksrc,matrix,src_add,dst_add)
+                    CALL make_remap(tabvar1(:,:,1,1),tabinterp4d(:,:,1,1),nxfin,nyfin, &
+                         matrix,src_add,dst_add)     
+                 CASE('bicubic')                                   
+                    CALL get_remap_bicub(G0%gphiu,G1%gphiu,   &
+                         G0%glamu,G1%glamu,masksrc,matrix,src_add,dst_add)
+                    CALL make_bicubic_remap(tabvar1(:,:,1,1),masksrc,tabinterp4d(:,:,1,1),&
+                         nxfin,nyfin,matrix,src_add,dst_add)                        
+                 END SELECT
+                 !                      
+                 CALL Correctforconservation(tabvar1(:,:,1,1),tabinterp4d(:,:,1,1), &
+                      G0%e1u,G0%e2u,G1%e1u,G1%e2u,nxfin,nyfin,posvar,imin-jpizoom+1,jmin-jpjzoom+1)
+
+              ENDIF
+
+              tabinterp4d(:,:,1,1) =  tabinterp4d(:,:,1,1) * G1%umask(:,:,n)
+              !
+           CASE('V')
+              !		
+              IF(MAXVAL(G1%vmask(:,:,n)) == 0) THEN
+                 tabinterp4d = 0.0
+                 WRITE(*,*) 'only land points on level ',n 
+              ELSE		
+                 !
+
+                 CALL extrap_detect(G0,G1,detected_pts(:,:,n),n,'V')
+
+                 CALL correct_field(detected_pts(:,:,n),tabvar1,tabvar2,&
+                      tabvar3,G0,nav_lev,masksrc,n,'V')
+                 !                                                           
+                 SELECT CASE(TRIM(interp_type))
+                 CASE('bilinear')                                                       
+                    CALL get_remap_matrix(G0%gphiv,G1%gphiv,   &
+                         G0%glamv,G1%glamv,masksrc,matrix,src_add,dst_add)
+                    CALL make_remap(tabvar1(:,:,1,1),tabinterp4d(:,:,1,1),nxfin,nyfin, &
+                         matrix,src_add,dst_add)     
+                 CASE('bicubic')                                   
+                    CALL get_remap_bicub(G0%gphiv,G1%gphiv,   &
+                         G0%glamv,G1%glamv,masksrc,matrix,src_add,dst_add)
+                    CALL make_bicubic_remap(tabvar1(:,:,1,1),masksrc,tabinterp4d(:,:,1,1),&
+                         nxfin,nyfin,matrix,src_add,dst_add)                        
+                 END SELECT
+                 !                      
+                 CALL Correctforconservation(tabvar1(:,:,1,1),tabinterp4d(:,:,1,1), &
+                      G0%e1v,G0%e2v,G1%e1v,G1%e2v,nxfin,nyfin,posvar,imin-jpizoom+1,jmin-jpjzoom+1)
+
+              ENDIF
+
+              tabinterp4d(:,:,1,1) =  tabinterp4d(:,:,1,1) * G1%vmask(:,:,n)
+              !
+           END SELECT
+           !
+           IF(dimg) THEN
+              !
+              WRITE(inum,REC=irec) tabinterp4d(:,:,1,1)
+              irec = irec + 1
+              !
+           ELSE
+              !
+              dimnames(1)='x'
+              dimnames(2)='y'
+              IF ((iom_activated).AND.(vert_coord_name == 'z_b')) THEN
+                 dimnames(3)=TRIM(timedimname)
+              ELSE
+                 dimnames(3)=vert_coord_name
+                 dimnames(4)=TRIM(timedimname)
+              ENDIF
+              !             
+              IF(TRIM(varname)=='gcx' .OR. TRIM(varname)=='gcxb') THEN 
+                 PRINT*,TRIM(varname),MAXVAL(tabinterp4d),MINVAL(tabinterp4d)
+              ENDIF
+              IF ((iom_activated).AND.(vert_coord_name == 'z_b')) THEN
+                 ALLOCATE(tabvar3d(SIZE(tabinterp4d,1),SIZE(tabinterp4d,2),SIZE(tabinterp4d,3)))
+                 tabvar3d=tabinterp4d(:,:,:,1)
+                 CALL Write_Ncdf_var(TRIM(varname),dimnames, &
+                      Child_file,tabvar3d,t,'double')
+                 DEALLOCATE(tabvar3d)
+              ELSE
+                 CALL Write_Ncdf_var(TRIM(varname),dimnames, &
+                      Child_file,tabinterp4d,t,n,'double')
+              ENDIF
+              !
+              CALL Copy_Ncdf_att(TRIM(varname),TRIM(restart_file),Child_file)
+              !
+           ENDIF
+           !
+           IF(ASSOCIATED(matrix)) DEALLOCATE(matrix,src_add,dst_add)   
+           !
+        END DO
+        ! 
+        DEALLOCATE(detected_pts)
+        DEALLOCATE(tabinterp4d)
+        DEALLOCATE(tabvar1,tabvar2,tabvar3)
+        DEALLOCATE(masksrc)  
+        !                     
+     ENDIF
+
+  END DO
+  !
+  !
+  !
+  !
+  !
+  !
+  !
+  !
+  !
+  ALLOCATE(rotn(nxfin,nyfin,z,1),rotb(nxfin,nyfin,z,1))
+  ALLOCATE(hdivn(nxfin,nyfin,z,1),hdivb(nxfin,nyfin,z,1))
+  !                          
+  !
+  IF(dimg) THEN         
+     ALLOCATE(un(nxfin,nyfin,z,1),ub(nxfin,nyfin,z,1))
+     ALLOCATE(vn(nxfin,nyfin,z,1),vb(nxfin,nyfin,z,1))
+     irec = 6 * z + 2
+     CALL read_dimg_var(inum,irec,un,z)  
+     irec = 2
+     CALL read_dimg_var(inum,irec,ub,z)
+     irec = 7 * z + 2
+     CALL read_dimg_var(inum,irec,vn,z)
+     irec = 2 + z
+     CALL read_dimg_var(inum,irec,vb,z)                      
+  ELSE
+     CALL Read_Ncdf_var('un',Child_file,un)      
+     CALL Read_Ncdf_var('vn',Child_file,vn)
+     !	 	 
+     CALL Read_Ncdf_var('ub',Child_file,ub)
+     CALL Read_Ncdf_var('vb',Child_file,vb)
+  ENDIF
+  !
+
+  IF(rhot == 1) THEN
+     WRITE(*,*) ''	 
+     WRITE(*,*) 'no time interpolation (time refinement ratio = 1)'
+  ELSE   
+     WRITE(*,*) ''
+     WRITE(*,*) 'time interpolation'
+     now_wght = (rhot-1.)/rhot
+     before_wght = 1./rhot
+     !    
+     ub = now_wght*un + before_wght*ub
+     vb = now_wght*vn + before_wght*vb
+     !-----------------------	       	       
+     IF(dimg) THEN
+        ALLOCATE(tn(nxfin,nyfin,z,1),tb(nxfin,nyfin,z,1))
+        irec = 8 * z + 2
+        CALL read_dimg_var(inum,irec,tn,z)
+        irec = 2 * z + 2
+        CALL read_dimg_var(inum,irec,tb,z)               
+     ELSE
+        CALL Read_Ncdf_var('tb',Child_file,tb)
+        CALL Read_Ncdf_var('tn',Child_file,tn)
+     ENDIF
+     !----------------------               
+     tb = now_wght*tn + before_wght*tb
+
+     IF(dimg) THEN
+        irec = 2 * z + 2
+        CALL write_dimg_var(inum,irec,tb,z)                
+     ELSE
+        dimnames(1)='x'
+        dimnames(2)='y'
+        dimnames(3)='z'
+        dimnames(4)=TRIM(timedimname)
+        CALL Write_Ncdf_var('tb',dimnames,Child_file,tb,'double')
+     ENDIF
+     !
+     DEALLOCATE(tn,tb)
+     !----------------------	       
+     IF(dimg) THEN
+        ALLOCATE(sn(nxfin,nyfin,z,1),sb(nxfin,nyfin,z,1))
+        irec = 9 * z + 2
+        CALL read_dimg_var(inum,irec,sn,z)
+        irec = 3 * z + 2
+        CALL read_dimg_var(inum,irec,sb,z)              
+     ELSE	       
+        CALL Read_Ncdf_var('sb',Child_file,sb)
+        CALL Read_Ncdf_var('sn',Child_file,sn)            
+     ENDIF
+     !----------------------               
+     sb = now_wght*sn + before_wght*sb
+
+     IF(dimg) THEN
+        irec = 3 * z + 2
+        CALL write_dimg_var(inum,irec,sb,z)                
+     ELSE               
+        dimnames(1)='x'
+        dimnames(2)='y'
+        dimnames(3)='z'
+        dimnames(4)=TRIM(timedimname)
+        CALL Write_Ncdf_var('sb',dimnames,Child_file,sb,'double')
+     ENDIF
+     !----------------------                             
+     DEALLOCATE(sn,sb)
+     !	       
+     IF(dimg) THEN
+        ALLOCATE(gcx(nxfin,nyfin,1,1),gcxb(nxfin,nyfin,1,1))
+        irec = 12 * z + 2
+        CALL read_dimg_var(inum,irec,gcx,1)
+        irec = 12 * z + 3
+        CALL read_dimg_var(inum,irec,gcxb,1) 
+     ELSE  
+        CALL Read_Ncdf_var('gcx',Child_file,gcx)
+        CALL Read_Ncdf_var('gcxb',Child_file,gcxb)
+     ENDIF
+     !----------------------               
+     gcxb = now_wght*gcx + before_wght*gcxb
+
+     IF(dimg) THEN
+        irec = 12 * z + 3
+        CALL write_dimg_var(inum,irec,gcxb,1)                
+     ELSE               
+        dimnames(1)='x'
+        dimnames(2)='y'
+        dimnames(3)='z_b'
+        dimnames(4)=TRIM(timedimname)
+        CALL Write_Ncdf_var('gcxb',dimnames,Child_file,gcxb,'double')
+     ENDIF
+     !-----------------------               
+     PRINT*,' gcx = ',MAXVAL(gcx),MINVAL(gcx)
+     PRINT*,' gcxb = ',MAXVAL(gcxb),MINVAL(gcxb)
+
+     DEALLOCATE(gcx,gcxb)
+     !
+     IF(dimg) THEN
+        ALLOCATE(sshn(nxfin,nyfin,1,1),sshb(nxfin,nyfin,1,1))
+        irec = 12 * z + 5
+        CALL read_dimg_var(inum,irec,sshn,1)
+        irec = 12 * z + 4
+        CALL read_dimg_var(inum,irec,sshb,1) 
+     ELSE 	       
+        CALL Read_Ncdf_var('sshb',Child_file,sshb)
+        CALL Read_Ncdf_var('sshn',Child_file,sshn)
+     ENDIF
+     !----------------------               
+     sshb = now_wght*sshn + before_wght*sshb
+
+     IF(dimg) THEN
+        irec = 12 * z + 4
+        CALL write_dimg_var(inum,irec,sshb,1)                
+     ELSE  	       
+        dimnames(1)='x'
+        dimnames(2)='y'
+        dimnames(3)='z_b'
+        dimnames(4)=TRIM(timedimname)
+        CALL Write_Ncdf_var('sshb',dimnames,Child_file,sshb,'double')
+     ENDIF
+     !               
+     DEALLOCATE(sshb,sshn) 
+
+     !    
+  ENDIF
+  !
+  WRITE(*,*) 'Compute hdivn,rotn with new interpolated fields ...'
+  !
+  !fmask:land/ocean mask at f-point (=0. or 1.)=shlat along lateral boundaries
+  !
+  ALLOCATE(fse3u(nxfin,nyfin,z),fse3v(nxfin,nyfin,z),fse3t(nxfin,nyfin,z)) 
+  !      
+  IF(partial_steps) THEN
+     status = Read_Bathymeter(TRIM(Childbathymeter),G1)
+     CALL get_scale_factors( G1,fse3t,fse3u,fse3v )
+  ELSE       
+     fse3t(:,:,:) = 1.0
+     fse3u(:,:,:) = 1.0
+     fse3v(:,:,:) = 1.0
+  ENDIF
+  !
+  !
+  DO k = 1,z  
+     !	 
+     DO j = 2,nyfin-1
+        DO i = 2, nxfin-1
+           !
+           hdivn(i,j,k,1) = (G1%e2u(i,j)*fse3u(i,j,k)*un(i,j,k,1)-G1%e2u(i-1,j)*fse3u(i-1,j,k)*un(i-1,j,k,1)      &
+                +    G1%e1v(i,j)*fse3v(i,j,k)*vn(i,j,k,1)-G1%e1v(i,j-1)*fse3v(i,j-1,k)*vn(i,j-1,k,1))   & 
+                / ( G1%e1t(i,j) * G1%e2t(i,j) * fse3t(i,j,k) )
+           !
+           hdivb(i,j,k,1) = (G1%e2u(i,j)*fse3u(i,j,k)*ub(i,j,k,1)-G1%e2u(i-1,j)*fse3u(i-1,j,k)*ub(i-1,j,k,1)      &
+                +    G1%e1v(i,j)*fse3v(i,j,k)*vb(i,j,k,1)-G1%e1v(i,j-1)*fse3v(i,j-1,k)*vb(i,j-1,k,1))   & 
+                / ( G1%e1t(i,j) * G1%e2t(i,j) * fse3t(i,j,k) )
+           !			 
+        END DO
+     END DO
+     !
+     !
+     hdivn(1:2,:,k,1) = 0.
+     hdivn(:,1:2,k,1) = 0.
+     hdivn(nxfin-1:nxfin,:,k,1) = 0.
+     hdivn(:,nyfin-1:nyfin,k,1) = 0.
+     hdivb(1:2,:,k,1) = 0.
+     hdivb(:,1:2,k,1) = 0.
+     hdivb(nxfin-1:nxfin,:,k,1) = 0.
+     hdivb(:,nyfin-1:nyfin,k,1) = 0.         
+     !	 
+     DO j = 1, nyfin-1
+        DO i = 1, nxfin-1
+           !
+           rotn(i,j,k,1) = (G1%e2v(i+1,j)*vn(i+1,j,k,1)-G1%e2v(i,j)*vn(i,j,k,1)    &
+                - G1%e1u(i,j+1)*un(i,j+1,k,1)+G1%e1u(i,j)*un(i,j,k,1)) &
+                * G1%fmask(i,j,k) / ( G1%e1f(i,j) * G1%e2f(i,j))
+           !
+           rotb(i,j,k,1) = (G1%e2v(i+1,j)*vb(i+1,j,k,1)-G1%e2v(i,j)*vb(i,j,k,1)    &
+                - G1%e1u(i,j+1)*ub(i,j+1,k,1)+G1%e1u(i,j)*ub(i,j,k,1)) &
+                * G1%fmask(i,j,k) / ( G1%e1f(i,j) * G1%e2f(i,j))
+           !			    
+        END DO
+     END DO
+     !
+  END DO
+  !
+  PRINT*,' hdivn = ',MAXVAL(hdivn(2:nxfin-1,2:nyfin-1,:,1)),MINVAL(hdivn(2:nxfin-1,2:nyfin-1,:,1))
+  PRINT*,' hdivb = ',MAXVAL(hdivb(2:nxfin-1,2:nyfin-1,:,1)),MINVAL(hdivb(2:nxfin-1,2:nyfin-1,:,1))
+  PRINT*,' rotn  = ',MAXVAL(rotn(2:nxfin-1,2:nyfin-1,:,1)),MINVAL(rotn(2:nxfin-1,2:nyfin-1,:,1))
+  PRINT*,' rotb  = ',MAXVAL(rotb(2:nxfin-1,2:nyfin-1,:,1)),MINVAL(rotb(2:nxfin-1,2:nyfin-1,:,1))
+  !
+  IF(dimg) THEN
+     !
+     irec = 10 * z + 2
+     DO k=1,z
+        WRITE(inum,REC=irec) rotn(:,:,k,1)
+        irec = irec+1
+     ENDDO
+     !          
+     irec = 4 * z + 2
+     DO k=1,z
+        WRITE(inum,REC=irec) rotb(:,:,k,1)
+        irec = irec+1
+     ENDDO
+     !          
+     irec = 11 * z + 2
+     DO k=1,z
+        WRITE(inum,REC=irec) hdivn(:,:,k,1)
+        irec = irec+1
+     ENDDO
+     !          
+     irec = 5 * z + 2
+     DO k=1,z
+        WRITE(inum,REC=irec) hdivb(:,:,k,1)
+        irec = irec+1
+     ENDDO
+     !          
+     CLOSE(inum)
+  ELSE
+     dimnames(1)='x'
+     dimnames(2)='y'
+     dimnames(3)='z'
+     dimnames(4)=TRIM(timedimname)
+     CALL Write_Ncdf_var('rotn',dimnames,Child_file,rotn,'double')
+     CALL Copy_Ncdf_att('rotn',TRIM(restart_file),Child_file)
+     CALL Write_Ncdf_var('hdivn',dimnames,Child_file,hdivn,'double')
+     CALL Copy_Ncdf_att('hdivn',TRIM(restart_file),Child_file)
+     CALL Write_Ncdf_var('rotb',dimnames,Child_file,rotb,'double')
+     CALL Copy_Ncdf_att('rotb',TRIM(restart_file),Child_file)
+     CALL Write_Ncdf_var('hdivb',dimnames,Child_file,hdivb,'double')
+     CALL Copy_Ncdf_att('hdivb',TRIM(restart_file),Child_file)
+  ENDIF
+  !
+  WRITE(*,*) ' '
+  WRITE(*,*) '******* restart file successfully created *******' 
+  WRITE(*,*) ' '
+  !
+  STOP 
+END PROGRAM create_rstrt
+
+
Index: trunk/NEMOGCM/TOOLS/NESTING/src/agrif_create_restart_trc.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/NESTING/src/agrif_create_restart_trc.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/NESTING/src/agrif_create_restart_trc.f90	(revision 2528)
@@ -0,0 +1,420 @@
+!
+!************************************************************************
+! Fortran 95 OPA Nesting tools						*
+!									*
+!     Copyright (C) 2005 Florian Lemari�(Florian.Lemarie@imag.fr)	*
+!									*
+!************************************************************************
+!
+PROGRAM create_rstrt_trc
+  !
+  USE NETCDF
+  USE bilinear_interp
+  USE bicubic_interp
+  USE agrif_readwrite
+  USE io_netcdf 
+  USE agrif_extrapolation
+  USE agrif_interpolation
+  USE agrif_partial_steps        
+  !
+  IMPLICIT NONE
+  !
+  !************************************************************************
+  ! 									*
+  ! PROGRAM  CREATE_RSTRT_TRC     					*
+  !									*
+  ! program to interpolate parent grid restart file to child grid		*
+  !									*
+  !									*
+  !Interpolation is carried out using bilinear interpolation		*
+  !routine from SCRIP package						*		
+  !									*
+  !http://climate.lanl.gov/Software/SCRIP/				*
+  !************************************************************************
+  !
+  ! variables declaration
+  !      
+  CHARACTER*20,DIMENSION(:),POINTER :: Ncdf_varname => NULL()
+  CHARACTER*20 :: vert_coord_name
+  CHARACTER*1 :: posvar
+  CHARACTER*3 :: prefix
+  CHARACTER*20:: suffix 
+  CHARACTER*100 :: Child_file,Childcoordinates,varname,varname2,Childbathy,Childbathymeter   
+  REAL*8, POINTER, DIMENSION(:,:,:) :: fse3u, fse3v,fse3t => NULL()
+  REAL*8, POINTER, DIMENSION(:,:) :: lonChild,latChild => NULL()
+  REAL*8, POINTER, DIMENSION(:,:) :: lonParent,latParent => NULL()
+  REAL*8, POINTER, DIMENSION(:,:,:) :: cvol => NULL()
+  REAL*8, POINTER, DIMENSION(:,:,:) :: tabvar3d,tabinterp3d,mask => NULL()
+  REAL*8, POINTER, DIMENSION(:,:,:,:) :: trb,trn => NULL()
+  REAL*8, POINTER, DIMENSION(:,:,:,:) :: tabinterp4d,tabvar1,tabvar2,tabvar3 => NULL()
+  REAL*8, POINTER, DIMENSION(:) :: timedepth_temp => NULL()
+  REAL*8, POINTER, DIMENSION(:) :: tabtemp1D,nav_lev => NULL()
+  INTEGER, POINTER, DIMENSION(:) :: tabtemp1DInt => NULL()
+  REAL*8, POINTER, DIMENSION(:,:) :: tabtemp2D,zwf => NULL()
+  REAL*8, POINTER, DIMENSION(:,:) :: e1f,e2f,e1v,e2v,e1u,e2u,e1t,e2t => NULL()
+  REAL*8, POINTER, DIMENSION(:,:,:,:) :: tabtemp4D => NULL()
+  INTEGER,DIMENSION(:),POINTER :: src_add,dst_add  => NULL()
+  REAL*8,DIMENSION(:,:),POINTER :: matrix,bathy_G0 => NULL()
+  LOGICAL,DIMENSION(:,:,:),POINTER :: Tmask => NULL()
+  LOGICAL,DIMENSION(:,:),POINTER :: masksrc => NULL()
+  LOGICAL, DIMENSION(:,:,:), POINTER :: detected_pts
+  LOGICAL :: Interpolation,Extrapolation,Pacifique,op
+  REAL*8 :: za1,za0,zsur,zacr,zkth,zdepth,zdepwp,zmin,zmax,zdiff,ze3tp,ze3wp,ztrcor,zvolk
+  INTEGER :: narg,iargc,ncid,x,y,t,z,nbvert_lev,m
+  REAL*8 :: now_wght,before_wght, ztrmas,zcoef
+  INTEGER :: i,j,k,ji,jj,jk,status,varid,numdims
+  CHARACTER(len=20),DIMENSION(4) :: dimnames
+  CHARACTER(len=80) :: namelistname
+  TYPE(Coordinates) :: G0,G1
+  INTEGER :: jpi,jpj,jpk,jpni,jpnj,jpnij,jpiglo,jpjglo,nlcit,nlcjt,nldit
+  INTEGER :: nldjt,nleit,nlejt,nimppt,njmppt
+  REAL*8 :: tabtemp0dreal
+  INTEGER :: tabtemp0dint
+  CHARACTER(len=20) :: timedimname
+
+  !       
+  narg = iargc()
+  IF (narg == 0) THEN
+     namelistname = 'namelist.input'
+  ELSE
+     CALL getarg(1,namelistname)
+  ENDIF
+  !
+  ! read input file
+  !
+  CALL read_namelist(namelistname)
+  !      
+  IF(TRIM(restart_trc_file) == '/NULL') THEN
+     WRITE(*,*) 'no tracers restart file specified in ',TRIM(namelistname)
+     STOP
+  ENDIF
+
+  timedimname = 't'
+
+  !
+  WRITE(*,*) ''
+  WRITE(*,*) 'Interpolation of restart file : ',TRIM(restart_trc_file)
+  WRITE(*,*) ''
+  !
+  CALL Read_Ncdf_VarName(restart_trc_file,Ncdf_varname)
+  !       
+  CALL set_child_name(parent_coordinate_file,Childcoordinates)   
+  CALL set_child_name(parent_meshmask_file,Childbathy) 
+  CALL set_child_name(parent_bathy_meter,Childbathymeter)   
+  !
+  ! create this file
+  !
+  CALL set_child_name(restart_trc_file,Child_file)
+  status = nf90_create(Child_file,NF90_WRITE,ncid)
+  status = nf90_close(ncid)
+  WRITE(*,*) 'Child grid restart file name = ',TRIM(Child_file)      
+  WRITE(*,*) ''
+  ! 
+  ! read dimensions in parent restart file
+  !
+  CALL Read_Ncdf_dim('x',restart_trc_file,x)
+  CALL Read_Ncdf_dim('y',restart_trc_file,y) 
+  CALL Read_Ncdf_dim('z',restart_trc_file,z)
+
+  IF( z .NE. N ) THEN
+     WRITE(*,*) '***'
+     WRITE(*,*) 'Number of vertical levels doesn t match between namelist and restart file'
+     WRITE(*,*) 'Please check the values in namelist file'
+     STOP
+  ENDIF
+  !
+  ! mask initialization for extrapolation and interpolation
+  ! 
+  WRITE(*,*) 'mask initialisation on coarse and fine grids'
+  !           
+  status = Read_Local_Coordinates(parent_coordinate_file,G0,(/jpizoom,jpjzoom/),(/x,y/))
+  status = Read_Coordinates(Childcoordinates,G1,Pacifique)
+  !
+  !longitude modification if child domain covers Pacific ocean area
+  !      
+  IF( Pacifique ) THEN
+     WHERE( G0%nav_lon < 0 )
+        G0%nav_lon = G0%nav_lon + 360.
+     END WHERE
+     WHERE( G1%nav_lon < 0 )
+        G1%nav_lon = G1%nav_lon + 360.
+     END WHERE
+  ENDIF
+  !
+  CALL Init_tmask(parent_meshmask_file,G0,x,y)
+  CALL Init_tmask(childbathy,G1,nxfin,nyfin)
+  
+  ALLOCATE(fse3u(nxfin,nyfin,z),fse3v(nxfin,nyfin,z),fse3t(nxfin,nyfin,z),cvol(nxfin,nyfin,z))
+    !      
+    status = Read_Bathymeter(TRIM(Childbathymeter),G1)
+    CALL get_scale_factors( G1,fse3t,fse3u,fse3v )
+                          
+  DO jk =1,z
+  cvol(:,:,jk) = G1%e1t(:,:)*G1%e2t(:,:)*fse3t(:,:,jk)*G1%tmask(:,:,jk)
+  END DO 
+!  CALL Init_mask(childbathy,G1,1,1)
+
+  G0%tmask = 1.    
+
+
+  status = nf90_open(TRIM(restart_trc_file), NF90_NOWRITE, ncid) ! Open dataset
+  DO k=1,z
+     ALLOCATE(tabvar1(x,y,1,1))
+     !
+     status = nf90_inq_varid(ncid, "TRNDIC", VarId) !PISCES
+     IF (status == nf90_noerr) THEN
+        CALL Read_Ncdf_var('TRNDIC',TRIM(restart_trc_file),tabvar1,1,k)
+     ELSE
+        status = nf90_inq_varid(ncid, "TRNNO3"  , VarId) ! LOBSTER
+        IF (status == nf90_noerr) THEN
+           CALL Read_Ncdf_var('TRNNO3',TRIM(restart_trc_file),tabvar1,1,k)
+        ELSE
+           status = nf90_inq_varid(ncid, "TRNCFC11", VarId) ! CFC
+           IF (status == nf90_noerr) THEN
+              CALL Read_Ncdf_var('TRNCFC11',TRIM(restart_trc_file),tabvar1,1,k)
+           ELSE
+              status = nf90_inq_varid(ncid, "TRNCLR  ", VarId) ! My TRC
+              IF (status == nf90_noerr) THEN
+                 CALL Read_Ncdf_var('TRNCLR',TRIM(restart_trc_file),tabvar1,1,k)
+              ELSE
+                 WRITE(*,*) 'No suitable tracer found to build the mask '
+              ENDIF
+           ENDIF
+        ENDIF
+     ENDIF
+     WHERE( tabvar1(:,:,1,1) == 0. ) 
+        G0%tmask(:,:,k) = 0.
+     END WHERE
+     DEALLOCATE(tabvar1)
+  END DO
+
+  !
+  ! write dimensions in output file
+  !          
+  CALL Write_Ncdf_dim('x',Child_file,nxfin)
+  CALL Write_Ncdf_dim('y',Child_file,nyfin)
+  CALL Write_Ncdf_dim('z',Child_file,z)
+  CALL Write_Ncdf_dim(TRIM(timedimname),Child_file,0) 
+  !
+  !
+  VARIABLE :  DO i = 1,SIZE(Ncdf_varname)      
+     !      
+     ! loop on variables names
+     !      
+     SELECT CASE (TRIM(Ncdf_varname(i)))
+        !
+        !copy nav_lon from child coordinates to output file      
+        !
+     CASE('nav_lon')
+        WRITE(*,*) 'copy nav_lon'
+        CALL Read_Ncdf_var('nav_lon',TRIM(Childcoordinates),tabtemp2D) 
+        CALL Write_Ncdf_var('nav_lon',(/'x','y'/),Child_file,tabtemp2D,'float')
+        CALL Copy_Ncdf_att('nav_lon',TRIM(restart_trc_file),Child_file, &
+             MINVAL(tabtemp2D),MAXVAL(tabtemp2D))
+        DEALLOCATE(tabtemp2D)
+        Interpolation = .FALSE.
+        !	     
+        !copy nav_lat from child coordinates to output file
+        !
+     CASE('nav_lat')             
+        WRITE(*,*) 'copy nav_lat'
+        CALL Read_Ncdf_var('nav_lat',TRIM(Childcoordinates),tabtemp2D) 
+        CALL Write_Ncdf_var('nav_lat',(/'x','y'/),Child_file,tabtemp2D,'float')
+        CALL Copy_Ncdf_att('nav_lat',TRIM(restart_trc_file),Child_file, &
+             MINVAL(tabtemp2D),MAXVAL(tabtemp2D)) 
+        DEALLOCATE(tabtemp2D)
+        Interpolation = .FALSE.
+        !
+        !copy nav_lev from restart_file to output file
+        !
+     CASE('nav_lev')
+
+        WRITE(*,*) 'copy nav_lev'
+        CALL Read_Ncdf_var('nav_lev',TRIM(restart_trc_file),nav_lev) 
+        CALL Write_Ncdf_var('nav_lev','z',Child_file,nav_lev,'float')
+        CALL Copy_Ncdf_att('nav_lev',TRIM(restart_trc_file),Child_file)      
+        Interpolation = .FALSE.
+        !
+        !copy time from restart_file to output file                       
+        !
+     CASE('time_counter')
+        WRITE(*,*) 'copy time_counter'
+        CALL Read_Ncdf_var('time_counter',TRIM(restart_trc_file),tabtemp1D) 
+        tabtemp1D = tabtemp1D * rhot
+        CALL Write_Ncdf_var('time_counter',TRIM(timedimname),Child_file,tabtemp1D,'double')
+        CALL Copy_Ncdf_att('time_counter',TRIM(restart_trc_file),Child_file) 
+        DEALLOCATE(tabtemp1D)
+        Interpolation = .FALSE.
+        !
+        !copy info from restart_file to output file
+        !
+     CASE('arak0') 
+        WRITE(*,*) 'copy trp info'        
+        CALL Read_Ncdf_var('arak0',TRIM(restart_trc_file),tabtemp0dreal) 
+        CALL Write_Ncdf_var('arak0',Child_file,tabtemp0dreal,'double')
+        CALL Copy_Ncdf_att('arak0',TRIM(restart_trc_file),Child_file) 
+        Interpolation = .FALSE. 
+        !
+     CASE('kt') 
+        WRITE(*,*) 'copy kt'
+        CALL Read_Ncdf_var('kt',TRIM(restart_trc_file),tabtemp0dreal)  
+        tabtemp0dreal = tabtemp0dreal * rhot
+        CALL Write_Ncdf_var('kt',Child_file,tabtemp0dreal,'double')
+        CALL Copy_Ncdf_att('kt',TRIM(restart_trc_file),Child_file) 
+        Interpolation = .FALSE.
+        !
+     CASE DEFAULT
+        varname = Ncdf_varname(i) 
+        WRITE(*,*) TRIM(varname),' interpolation ...'     
+        vert_coord_name = 'z'
+        posvar='T'
+        Interpolation = .TRUE.            
+        !      
+     END SELECT
+     IF( Interpolation ) THEN
+        !		  
+        nbvert_lev = z 
+        !                  
+        t = 1
+
+        ALLOCATE(detected_pts(SIZE(G0%tmask,1),SIZE(G0%tmask,2),nbvert_lev))                             
+        ALLOCATE(tabvar1(x,y,1,2))
+        ALLOCATE(tabvar2(x,y,1,1))
+        ALLOCATE(tabvar3(x,y,1,1))
+        ALLOCATE(masksrc(x,y))
+        ALLOCATE(tabinterp4d(nxfin,nyfin,1,1)) 
+
+        !	    
+        DO n = 1,nbvert_lev
+           !
+           WRITE(*,*) 'interpolate/extrapolate ', &
+                TRIM(varname),' for vertical level = ',n   
+           !
+           CALL Read_Ncdf_var(varname,TRIM(restart_trc_file),tabvar1,t,n)
+           IF(n==1) THEN
+              !                            
+           ELSE IF (n==2) THEN
+              tabvar2(:,:,:,1) = tabvar1(:,:,:,2)
+           ELSE
+              tabvar3(:,:,:,1) = tabvar2(:,:,:,1)
+              tabvar2(:,:,:,1) = tabvar1(:,:,:,2)
+           ENDIF
+           ! 
+           !
+           IF(MAXVAL(G1%tmask(:,:,n)) == 0.) THEN
+              tabinterp4d = 0.0
+              WRITE(*,*) 'only land points on level ',n                     
+           ELSE
+              CALL extrap_detect(G0,G1,detected_pts(:,:,n),n)                                            
+
+              CALL correct_field(detected_pts(:,:,n),tabvar1,tabvar2,&
+                   tabvar3,G0,nav_lev,masksrc,n)                                 
+
+              SELECT CASE(TRIM(interp_type))
+              CASE('bilinear')                                                       
+                 CALL get_remap_matrix(G0%nav_lat,G1%nav_lat, &
+                      G0%nav_lon,G1%nav_lon,masksrc,matrix,src_add,dst_add)
+                 CALL make_remap(tabvar1(:,:,1,1),tabinterp4d(:,:,1,1),nxfin,nyfin, &
+                      matrix,src_add,dst_add)     
+              CASE('bicubic')                                   
+                 CALL get_remap_bicub(G0%nav_lat,G1%nav_lat, &
+                      G0%nav_lon,G1%nav_lon,masksrc,matrix,src_add,dst_add)
+                 CALL make_bicubic_remap(tabvar1(:,:,1,1),masksrc,tabinterp4d(:,:,1,1),&
+                      nxfin,nyfin,matrix,src_add,dst_add) 
+              END SELECT
+              !                      
+              CALL Correctforconservation(tabvar1(:,:,1,1),tabinterp4d(:,:,1,1), &
+                   G0%e1t,G0%e2t,G1%e1t,G1%e2t,nxfin,nyfin,posvar,imin-jpizoom+1,jmin-jpjzoom+1)
+           ENDIF
+
+           tabinterp4d(:,:,1,1) =  tabinterp4d(:,:,1,1) * G1%tmask(:,:,n)
+           ztrmas = 0.0
+           ztrcor = 0.0
+           DO jj=1, nyfin
+           DO ji=1, nxfin
+              zvolk = cvol(ji,jj,n)
+              ztrcor = ztrcor + MIN( 0., tabinterp4d(ji,jj,1,1) ) * zvolk
+              tabinterp4d(ji,jj,1,1) = MAX( 0., tabinterp4d(ji,jj,1,1)) 
+              ztrmas  = ztrmas + tabinterp4d(ji,jj,1,1)  * zvolk
+           END DO
+           END DO
+           IF( ztrcor .LT. 0. ) THEN
+               WRITE(*,*) 'Correcting negative concentration'    
+               zcoef = 1. + ztrcor / ztrmas
+               tabinterp4d(:,:,1,1) =  tabinterp4d(:,:,1,1) *zcoef * G1%tmask(:,:,n)               
+           ENDIF        
+           IF(MINVAL(tabinterp4d(:,:,1,1)) .LT.0. ) STOP
+
+           !
+
+           status = nf90_inq_varid(ncid,TRIM(varname) , VarId)
+           status = nf90_inquire_variable(ncid, VarId, ndims=numdims)
+           IF( numdims == 3) THEN
+              dimnames(1)='x'
+              dimnames(2)='y'
+              dimnames(3)=TRIM(timedimname)
+              ALLOCATE(tabvar3d(SIZE(tabinterp4d,1),SIZE(tabinterp4d,2),SIZE(tabinterp4d,3)))
+              tabvar3d=tabinterp4d(:,:,:,1)
+              CALL Write_Ncdf_var(TRIM(varname),dimnames, &
+                   Child_file,tabvar3d,t,'double')
+              DEALLOCATE(tabvar3d)
+           ELSE       
+              dimnames(1)='x'
+              dimnames(2)='y'
+              dimnames(3)=vert_coord_name
+              dimnames(4)=TRIM(timedimname)
+              CALL Write_Ncdf_var(TRIM(varname),dimnames, &
+                   Child_file,tabinterp4d,t,n,'double')
+           ENDIF
+           !
+           CALL Copy_Ncdf_att(TRIM(varname),TRIM(restart_trc_file),Child_file)
+           !
+           IF(ASSOCIATED(matrix)) DEALLOCATE(matrix,src_add,dst_add)   
+           !
+           IF( numdims == 3) CYCLE VARIABLE
+           !
+        END DO
+        ! 
+        DEALLOCATE(detected_pts)
+        DEALLOCATE(tabinterp4d)
+        DEALLOCATE(tabvar1,tabvar2,tabvar3)
+        DEALLOCATE(masksrc)  
+        !                     
+     ENDIF
+
+     prefix = varname(1:3)
+     suffix = varname(4:LEN_TRIM(varname))   
+
+     IF(rhot == 1 .OR. prefix/= 'TRB') THEN
+        WRITE(*,*) ''	 
+        WRITE(*,*) 'no time interpolation for', varname
+     ELSE   
+        WRITE(*,*) ''
+        WRITE(*,*) 'time interpolation for', varname
+        ALLOCATE(trn(nxfin,nyfin,z,1),trb(nxfin,nyfin,z,1))
+        varname2 = 'TRN'//TRIM(suffix)
+        now_wght = (rhot-1.)/rhot
+        before_wght = 1./rhot
+        !    
+        CALL Read_Ncdf_var(TRIM(varname),Child_file,trb)
+        CALL Read_Ncdf_var(TRIM(varname2),Child_file,trn)            
+        trb = now_wght*trn + before_wght*trb
+
+        dimnames(1)='x'
+        dimnames(2)='y'
+        dimnames(3)='z'
+        dimnames(4)=TRIM(timedimname)
+        CALL Write_Ncdf_var(TRIM(varname),dimnames,Child_file,trb,'double')
+        !    
+     ENDIF
+
+  END DO VARIABLE
+  !
+  WRITE(*,*) ' '
+  WRITE(*,*) '******* restart file successfully created *******' 
+  WRITE(*,*) ' '
+  !
+  STOP 
+END PROGRAM create_rstrt_trc
+
+
Index: trunk/NEMOGCM/TOOLS/NESTING/src/agrif_extrapolation.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/NESTING/src/agrif_extrapolation.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/NESTING/src/agrif_extrapolation.f90	(revision 2528)
@@ -0,0 +1,631 @@
+!************************************************************************
+! Fortran 95 OPA Nesting tools						*
+!									*
+!     Copyright (C) 2005 Florian Lemarié (Florian.Lemarie@imag.fr)	*
+!									*
+!************************************************************************
+!
+MODULE agrif_extrapolation
+  !
+  USE agrif_types
+  USE agrif_readwrite 
+  USE io_netcdf  
+  USE agrif_gridsearch  
+  
+  IMPLICIT NONE 
+
+CONTAINS
+  !
+  !************************************************************************
+  ! 									*
+  ! MODULE  AGRIF_EXTRAPOLATION						*
+  !									*
+  !************************************************************************   
+  !      
+  !****************************************************************
+  !     subroutine extrap_detect					*
+  !								*
+  !     detection on each level of points 			*
+  !     where extrapolation is required 				*
+  !								*
+  !****************************************************************          
+  !      
+  !
+  SUBROUTINE extrap_detect(G0,G1,detected,n,posvar) 
+    !      
+    LOGICAL, DIMENSION(:,:) :: detected
+    TYPE(Coordinates) :: G0,G1       
+    CHARACTER(*), OPTIONAL :: posvar
+    INTEGER :: i,j,k,ic,jc,compt,dst_add,n
+    INTEGER, DIMENSION(1) :: i_min,j_min     
+    !                                
+    IF( PRESENT(posvar) .AND. posvar == 'U' ) THEN      
+       CALL get_detected_pts(G0%gphiu,G1%gphiu,G0%glamu,G1%glamu,   &
+            G0%umask(:,:,n),G1%umask(:,:,n),detected(:,:))       
+    ELSE IF( PRESENT(posvar) .AND. posvar == 'V' ) THEN
+       !      
+       CALL get_detected_pts(G0%gphiv,G1%gphiv,G0%glamv,G1%glamv,   &
+            G0%vmask(:,:,n),G1%vmask(:,:,n),detected(:,:))                                  
+    ELSE
+       CALL get_detected_pts(G0%nav_lat,G1%nav_lat,G0%nav_lon,G1%nav_lon,   &
+            G0%tmask(:,:,n),G1%tmask(:,:,n),detected(:,:))        
+    ENDIF
+    !      
+  END SUBROUTINE extrap_detect
+  !      
+  !   
+  !****************************************************************
+  !     end subroutine extrap_detect				*
+  !**************************************************************** 
+  !      
+  !      
+  !****************************************************************
+  !    subroutine correct_field					*
+  ! correct field on detected points				*
+  !								*
+  !****************************************************************          
+  ! 
+  SUBROUTINE correct_field(detected_pts,tabin,tabinkm1,tabinkm2,G0,nav_lev,newmask,k,posvar)
+    !
+    LOGICAL, DIMENSION(:,:) :: detected_pts
+    LOGICAL, DIMENSION(:,:) :: newmask
+    CHARACTER(*),OPTIONAL :: posvar
+    INTEGER :: k
+    !
+    INTEGER :: i,j,ii,jj,nx,ny,n,lbi,ubi,lbj,ubj,kpos,ipos,jpos,r
+    !
+    REAL*8, DIMENSION(:,:,:,:) ::  tabin
+    REAL*8, DIMENSION(:,:,:,:) ::  tabinkm1
+    REAL*8, DIMENSION(:,:,:,:) ::  tabinkm2
+    REAL*8, DIMENSION(:) :: nav_lev
+    REAL*8, DIMENSION(:,:,:), ALLOCATABLE :: mask
+    REAL*8, DIMENSION(:,:), ALLOCATABLE :: lon,lat 
+    REAL*8 :: deriv,deriv_min
+    LOGICAL :: found
+    !      
+    TYPE(Coordinates) :: G0  
+    !
+    ! copy coarse grid mask in newmask 
+    !            
+    IF ( PRESENT(posvar) .AND. posvar == 'U' ) THEN
+       WHERE(G0%umask(:,:,k) == 1. )
+          newmask(:,:) = .TRUE.
+       ELSEWHERE
+          newmask(:,:) = .FALSE.
+       END WHERE
+       ALLOCATE(mask(SIZE(G0%umask,1),SIZE(G0%umask,2),SIZE(G0%umask,3)))
+       ALLOCATE(lat(SIZE(G0%umask,1),SIZE(G0%umask,2)))
+       ALLOCATE(lon(SIZE(G0%umask,1),SIZE(G0%umask,2)))
+       mask = G0%umask
+       lat = G0%gphiu 
+       lon = G0%glamu     
+    ELSE IF ( PRESENT(posvar) .AND. posvar == 'V' ) THEN
+       WHERE(G0%vmask(:,:,k) == 1. )
+          newmask(:,:) = .TRUE.
+       ELSEWHERE
+          newmask(:,:) = .FALSE.
+       END WHERE
+       ALLOCATE(mask(SIZE(G0%vmask,1),SIZE(G0%vmask,2),SIZE(G0%vmask,3)))
+       ALLOCATE(lat(SIZE(G0%vmask,1),SIZE(G0%vmask,2)))
+       ALLOCATE(lon(SIZE(G0%vmask,1),SIZE(G0%vmask,2)))
+       mask = G0%vmask        
+       lat = G0%gphiv 
+       lon = G0%glamv
+    ELSE      
+       WHERE(G0%tmask(:,:,k) == 1. )
+          newmask(:,:) = .TRUE.
+       ELSEWHERE
+          newmask(:,:) = .FALSE.
+       END WHERE
+       ALLOCATE(mask(SIZE(G0%tmask,1),SIZE(G0%tmask,2),SIZE(G0%tmask,3)))
+       ALLOCATE(lat(SIZE(G0%tmask,1),SIZE(G0%tmask,2)))
+       ALLOCATE(lon(SIZE(G0%tmask,1),SIZE(G0%tmask,2)))
+       mask = G0%tmask
+       lon = G0%nav_lon
+       lat = G0%nav_lat
+    ENDIF
+    !
+    ! dimensions initialisation
+    !
+    nx = SIZE(tabin,1)
+    ny = SIZE(tabin,2)    
+    ! 
+    !       
+    DO j = 1,ny   
+       !
+       DO i = 1,nx         
+          !
+          IF( detected_pts(i,j) ) THEN       
+             !
+             r = 0
+             found = .FALSE.
+             deriv_min = 2000000.
+             ipos=0
+             jpos=0
+             !
+             DO WHILE(.NOT. found)
+                !
+                r = r + 1      
+                !       
+                IF(i-r < 1 ) THEN
+                   lbi = 1
+                   ubi = MIN(i+r,nx)
+                ELSE IF(i+r > nx) THEN
+                   lbi = MAX(i-r,1)
+                   ubi = nx
+                ELSE
+                   lbi = i-r
+                   ubi = i+r
+                ENDIF
+                !
+                IF(j-r < 1) THEN
+                   lbj = 1
+                   ubj = MIN(j+r,ny)
+                ELSE IF(j+r > ny) THEN
+                   lbj = MAX(j-r,1)
+                   ubj = ny
+                ELSE
+                   lbj = j-r
+                   ubj = j+r
+                ENDIF
+                !
+                DO jj = lbj,ubj,ubj-lbj
+                   DO ii = lbi,ubi,ubi-lbi
+                      !
+                      deriv = search_pts_h(ii,jj,k,i,j,k,tabin(:,:,1,1),mask,lon,lat)  
+                      !
+                      IF( ABS(deriv) < deriv_min ) THEN                                                    
+                         deriv_min = ABS(deriv)
+                         ipos = ii
+                         jpos = jj
+                         kpos = k
+                      ENDIF
+                      !                           
+                      deriv = search_pts_v(ii,jj,k-1,i,j,k,tabinkm1,tabinkm2,mask,nav_lev,lon,lat)
+                      !
+                      IF( ABS(deriv) < deriv_min ) THEN                                                    
+                         deriv_min = ABS(deriv)
+                         ipos = ii
+                         jpos = jj
+                         kpos = k-1
+                      ENDIF
+                      !                                       
+                   END DO
+                END DO
+                !
+                !                                  
+                IF( deriv_min < 2000000.  ) THEN 
+                   !                
+                   IF(kpos == k)   tabin(i,j,1,1) = tabin(ipos,jpos,1,1)
+                   IF(kpos == k-1) tabin(i,j,1,1) = tabinkm1(ipos,jpos,1,1)   
+                   found = .TRUE.
+                   newmask(i,j) = .TRUE.
+                ELSE IF ((lbi == 1).AND.(ubi == nx).AND.(lbj == 1).AND.(ubj == ny)) THEN
+                   found = .TRUE.
+                   newmask(i,j) = .FALSE.
+                   !
+                ENDIF
+                !
+             END DO !do while
+             !
+          ENDIF
+          !
+       END DO
+       !
+    END DO
+    !
+    DEALLOCATE(mask,lon,lat)
+    !
+  END SUBROUTINE correct_field
+  !      
+  !**************************************************************
+  !    end subroutine correct_field
+  !**************************************************************          
+  !  
+  SUBROUTINE correct_field_2d(detected_pts,tabin,G0,newmask,posvar)
+    !
+    LOGICAL, DIMENSION(:,:) :: detected_pts
+    LOGICAL, DIMENSION(:,:) :: newmask
+    CHARACTER(*), OPTIONAL :: posvar
+    LOGICAL :: found
+    INTEGER :: k
+    !
+    INTEGER :: i,j,ii,jj,nx,ny,n,lbi,ubi,lbj,ubj,ipos,jpos,r
+    !
+    REAL*8, DIMENSION(:,:,:), ALLOCATABLE :: mask
+    REAL*8, DIMENSION(:,:), ALLOCATABLE :: lon,lat 
+    REAL*8, DIMENSION(:,:,:) ::  tabin
+    REAL*8 :: deriv,deriv_min
+    !      
+    TYPE(Coordinates) :: G0  
+    !
+    ! copy coarse grid mask in newmask 
+    !            
+    mask = G0%tmask
+    lon = G0%nav_lon
+    lat = G0%nav_lat      
+    IF ( PRESENT(posvar) .AND. posvar == 'U' ) THEN
+       WHERE(G0%umask(:,:,1) == 1. )
+          newmask(:,:) = .TRUE.
+       ELSEWHERE
+          newmask(:,:) = .FALSE.
+       END WHERE
+       ALLOCATE(mask(SIZE(G0%umask,1),SIZE(G0%umask,2),SIZE(G0%umask,3)))
+       ALLOCATE(lat(SIZE(G0%umask,1),SIZE(G0%umask,2)))
+       ALLOCATE(lon(SIZE(G0%umask,1),SIZE(G0%umask,2)))
+       mask = G0%umask
+       lat = G0%gphiu 
+       lon = G0%glamu     
+    ELSE IF ( PRESENT(posvar) .AND. posvar == 'V' ) THEN
+       WHERE(G0%vmask(:,:,1) == 1. )
+          newmask(:,:) = .TRUE.
+       ELSEWHERE
+          newmask(:,:) = .FALSE.
+       END WHERE
+       ALLOCATE(mask(SIZE(G0%vmask,1),SIZE(G0%vmask,2),SIZE(G0%vmask,3)))
+       ALLOCATE(lat(SIZE(G0%vmask,1),SIZE(G0%vmask,2)))
+       ALLOCATE(lon(SIZE(G0%vmask,1),SIZE(G0%vmask,2)))
+       mask = G0%vmask        
+       lat = G0%gphiv 
+       lon = G0%glamv
+    ELSE      
+       WHERE(G0%tmask(:,:,1) == 1. )
+          newmask(:,:) = .TRUE.
+       ELSEWHERE
+          newmask(:,:) = .FALSE.
+       END WHERE
+       ALLOCATE(mask(SIZE(G0%tmask,1),SIZE(G0%tmask,2),SIZE(G0%tmask,3)))
+       ALLOCATE(lat(SIZE(G0%tmask,1),SIZE(G0%tmask,2)))
+       ALLOCATE(lon(SIZE(G0%tmask,1),SIZE(G0%tmask,2)))
+       mask = G0%tmask
+       lon = G0%nav_lon
+       lat = G0%nav_lat
+    ENDIF
+
+    !
+    ! dimensions initialisation
+    !
+    nx = SIZE(tabin,1)
+    ny = SIZE(tabin,2)    
+    !       
+    DO i = 1,nx         
+       !
+       DO j = 1,ny   
+          !                    
+          !                      
+          IF( detected_pts(i,j) ) THEN       
+             ! 
+             r = 0 
+             found = .FALSE.
+             deriv_min = 2000000.
+             ipos=0
+             jpos=0
+             !
+             DO WHILE (.NOT. found )
+
+                !
+                r = r + 1 
+                !
+                IF(i-r < 1 ) THEN
+                   lbi = 1
+                   ubi = MIN(i+r,nx)
+                ELSE IF(i+r > nx) THEN
+                   lbi = MAX(i-r,1)
+                   ubi = nx
+                ELSE
+                   lbi = i-r
+                   ubi = i+r
+                ENDIF
+                !
+                IF(j-r < 1) THEN
+                   lbj = 1
+                   ubj = MIN(j+r,ny)
+                ELSE IF(j+r > ny) THEN
+                   lbj = MAX(j-r,1)
+                   ubj = ny
+                ELSE
+                   lbj = j-r
+                   ubj = j+r
+                ENDIF
+                !                                 
+                DO ii = lbi,ubi
+                   DO jj = lbj,ubj
+                      !
+                      deriv = search_pts_h(ii,jj,1,i,j,1,tabin(:,:,1),mask,lon,lat)  
+                      !
+                      IF( ABS(deriv) < deriv_min ) THEN                                                    
+                         deriv_min = ABS(deriv)
+                         ipos = ii
+                         jpos = jj
+                      ENDIF
+                      !                                       
+                   END DO
+                END DO
+                !
+                !                                    
+                IF( deriv_min < 2000000.  ) THEN 
+                   !
+                   found = .TRUE.                                              
+                   tabin(i,j,1) = tabin(ipos,jpos,1) 
+                   newmask(i,j) = .TRUE.
+                   !
+                ENDIF
+                !
+             END DO !do while
+             !
+          ENDIF
+          !
+       END DO
+       !
+    END DO
+    !
+    DEALLOCATE(mask,lon,lat)
+    !
+  END SUBROUTINE correct_field_2d
+  !      
+  !**************************************************************
+  !    function get_dist
+  !**************************************************************          
+  ! 
+
+  !
+  REAL*8 FUNCTION  get_dist(plat1,plon1,plat2,plon2)
+    !
+    REAL*8 :: plat1,plon1,plat2,plon2
+    REAL*8 :: dist,ra,rad,rpi,lat,lon
+    !      
+    rpi = 3.141592653589793
+    rad = rpi/180.
+    ra  = 6371229.   
+    !      
+    lat = plat2-plat1
+    lon = plon2-plon1
+    !
+    dist = ra * rad * SQRT( (COS(rad*(plat1+plat2)/2.)*lon)**2 + lat**2 )          
+    get_dist = dist
+    RETURN
+    !
+  END FUNCTION get_dist
+
+  !
+  !      
+  !**************************************************************
+  !    end function get_dist
+  !**************************************************************
+  !
+  !      
+  !**************************************************************
+  !    subroutine check_extrap
+  !**************************************************************          
+  ! 
+
+  !
+  SUBROUTINE check_extrap(Grid,tabin,k)
+    !
+    REAL*8, DIMENSION(:,:,:,:) ::  tabin
+    TYPE(Coordinates) :: Grid 
+    INTEGER :: i,j,k  
+    !  
+    DO i = 2,SIZE(tabin,1)-1
+       DO j=2,SIZE(tabin,2)-1
+          !                     
+          IF( Grid%tmask(i,j,k) == 1. .AND. tabin(i,j,1,1)==0.) THEN
+             !      
+             WRITE(*,*) 'no masked point with value zero (',i,',',j,',',k,')'
+             !                    
+          ENDIF
+
+       END DO
+    END DO
+    !
+  END SUBROUTINE check_extrap
+
+  !
+  !      
+  !**************************************************************
+  !    end subroutine check_extrap
+  !**************************************************************  
+  !
+  !**************************************************************
+  !    subroutine search_pts_h
+  !************************************************************** 
+  !
+  REAL*8 FUNCTION search_pts_h(i,j,k,ipt,jpt,kpt,tabvar,mask,lon,lat)
+    !
+    REAL*8 :: hx,hy,fx,fy
+    REAL*8 :: h_x,h_y
+    REAL*8, DIMENSION(:,:) :: tabvar
+    INTEGER :: i,j,k,ipt,jpt,kpt,nx,ny
+    LOGICAL :: foundx,foundy
+    REAL*8, DIMENSION(:,:,:) :: mask
+    REAL*8, DIMENSION(:,:) :: lon,lat
+    !
+    !
+    foundx = .TRUE.
+    foundy = .TRUE.
+    !      
+    nx = SIZE(tabvar,1)
+    ny = SIZE(tabvar,2)
+    !
+    IF( i==ipt .AND. j==jpt ) THEN    
+       search_pts_h = 2000000.
+       RETURN
+    ENDIF
+    !      
+    IF( mask(i,j,k) == 0. ) THEN    
+       search_pts_h = 2000000.
+       RETURN
+    ENDIF
+    !
+    ! x direction
+    !
+    IF(i+1<=nx .AND. i-1>=1) THEN
+       IF(mask(i+1,j,k)==1. .AND. mask(i-1,j,k)==1.) THEN     
+          hx = get_dist(lat(i+1,j),lon(i+1,j),&
+               lat(i-1,j),lon(i-1,j))
+          fx = (tabvar(i+1,j) - tabvar(i-1,j))/hx
+       ELSE IF(mask(i+1,j,k)==1. .AND. mask(i-1,j,k)==0. .AND. mask(i,j,k)==1.) THEN
+          hx = get_dist(lat(i+1,j),lon(i+1,j),&
+               lat(i,j),lon(i,j))
+          fx = (tabvar(i+1,j) - tabvar(i,j))/hx
+       ELSE IF(mask(i+1,j,k)==0. .AND. mask(i-1,j,k)==1. .AND. mask(i,j,k)==1.) THEN
+          hx = get_dist(lat(i,j),lon(i,j),&
+               lat(i-1,j),lon(i-1,j))
+          fx = (tabvar(i,j) - tabvar(i-1,j))/hx
+       ELSE
+          foundx = .FALSE.                 
+       ENDIF
+       !           
+    ELSE IF(i+1<=nx .AND. i>=1) THEN    
+       !
+       IF(mask(i+1,j,k)==1. .AND. mask(i,j,k)==1.) THEN     
+          hx = get_dist(lat(i+1,j),lon(i+1,j),&
+               lat(i,j),lon(i,j))
+          fx = (tabvar(i+1,j) - tabvar(i,j))/hx
+       ELSE
+          foundx = .FALSE.             
+       ENDIF
+       !   
+    ELSE IF(i<=nx .AND. i-1>=1) THEN    
+       !
+       IF(mask(i,j,k)==1. .AND. mask(i-1,j,k)==1.) THEN     
+          hx = get_dist(lat(i,j),lon(i,j),&
+               lat(i-1,j),lon(i-1,j))
+          fx = (tabvar(i,j) - tabvar(i-1,j))/hx
+       ELSE
+          foundx = .FALSE.            
+       ENDIF
+       !
+    ELSE
+        foundy = .FALSE.             
+    ENDIF
+
+    !
+    ! y direction
+    !
+    IF(j+1<=ny .AND. j-1>=1) THEN      
+       IF( mask(i,j+1,k)==1. .AND. mask(i,j-1,k)==1. ) THEN      
+          hy = get_dist(lat(i,j+1),lon(i,j+1),&
+               lat(i,j-1),lon(i,j-1))                      
+          fy = (tabvar(i,j+1) - tabvar(i,j-1))/hy
+       ELSE IF( mask(i,j+1,k)==1. .AND. mask(i,j-1,k)==0. .AND. mask(i,j,k)==1.) THEN      
+          hy = get_dist(lat(i,j+1),lon(i,j+1),&
+               lat(i,j),lon(i,j))                      
+          fy = (tabvar(i,j+1) - tabvar(i,j))/hy      
+       ELSE IF( mask(i,j+1,k)==0. .AND. mask(i,j-1,k)==1. .AND. mask(i,j,k)==1.) THEN     
+          hy = get_dist(lat(i,j),lon(i,j),&
+               lat(i,j-1),lon(i,j-1))                      
+          fy = (tabvar(i,j) - tabvar(i,j-1))/hy      
+       ELSE
+          foundy = .FALSE.                    
+       ENDIF
+       !           
+    ELSE IF(j+1<=ny .AND. j>=1) THEN    
+       !
+       IF(mask(i,j+1,k)==1. .AND. mask(i,j,k)==1.) THEN     
+          hy = get_dist(lat(i,j+1),lon(i,j+1),&
+               lat(i,j),lon(i,j))
+          fy = (tabvar(i,j+1) - tabvar(i,j))/hy
+       ELSE
+          foundy = .FALSE.            
+       ENDIF
+       !   
+    ELSE IF(j<=ny .AND. j-1>=1) THEN    
+       !
+       IF(mask(i,j,k)==1. .AND. mask(i,j-1,k)==1.) THEN     
+          hy = get_dist(lat(i,j),lon(i,j),&
+               lat(i,j-1),lon(i,j-1))
+          fy = (tabvar(i,j) - tabvar(i,j-1))/hy
+       ELSE
+          foundy = .FALSE.             
+       ENDIF
+       !
+    ELSE
+        foundy = .FALSE.             
+    ENDIF
+    !                   
+    h_x = get_dist(lat(ipt,jpt),lon(ipt,jpt),lat(ipt,jpt),lon(i,j))
+    h_y = get_dist(lat(ipt,jpt),lon(ipt,jpt),lat(i,j),lon(ipt,jpt))
+    !
+    IF(.NOT.foundx .AND. .NOT.foundy)THEN      
+       search_pts_h = 2000000.
+    ELSE IF( foundx .AND. foundy) THEN        
+       search_pts_h = h_x * fx + h_y * fy
+    ELSE IF( .NOT.foundx .AND. foundy .AND. h_y.NE.0.) THEN        
+       search_pts_h = h_y * fy
+    ELSE IF( foundx .AND. .NOT.foundy .AND. h_x.NE.0.) THEN        
+       search_pts_h = h_x * fx
+    ELSE    
+       search_pts_h = 2000000.             
+    ENDIF
+
+    !      
+    RETURN          
+    !
+  END FUNCTION search_pts_h
+  !
+  !**************************************************************
+  !    end subroutine search_pts_h
+  !************************************************************** 
+  !
+  !**************************************************************
+  !    subroutine search_pts_v
+  !************************************************************** 
+  !
+  REAL*8 FUNCTION search_pts_v(i,j,k,ipt,jpt,kpt,tabvarkm1,tabvarkm2,mask,depth,lon,lat)
+    !
+    REAL*8 :: hz,fz,dz,fh
+    REAL*8, DIMENSION(:) :: depth 
+    REAL*8, DIMENSION(:,:,:,:) :: tabvarkm1,tabvarkm2
+    INTEGER :: i,j,k,ipt,jpt,kpt,nx,ny
+    LOGICAL :: foundz
+    REAL*8, DIMENSION(:,:,:) :: mask
+    REAL*8, DIMENSION(:,:) :: lon,lat
+    !          
+    IF( k <= 2 .OR. mask(i,j,k) == 0.   ) THEN
+       !
+       search_pts_v = 2000000.
+       RETURN
+       !
+    ELSE IF( i==ipt .AND. j==jpt .AND. mask(i,j,k-1) == 1. .AND. mask(i,j,k-2) == 1. ) THEN
+       !
+       dz = depth(k) - depth(k-1)
+       hz = depth(kpt) - depth(k)     
+       search_pts_v = ((tabvarkm2(i,j,1,1) - tabvarkm1(i,j,1,1))/dz)*hz
+       RETURN
+       ! 
+    ELSE
+       !
+       IF( mask(i,j,k) == 1. .AND. mask(i,j,k-1) == 1. ) THEN
+          !                         
+          dz = depth(k) - depth(k-1)
+          fz = (tabvarkm2(i,j,1,1) - tabvarkm1(i,j,1,1))/dz
+          hz = depth(kpt) - depth(k)
+          !
+       ELSE
+          foundz = .FALSE.
+       ENDIF
+       !             
+       fh = search_pts_h(i,j,k,ipt,jpt,k,tabvarkm1(:,:,1,1),mask,lon,lat)
+       !
+       IF(foundz) THEN
+          search_pts_v = hz * fz + fh
+          RETURN
+       ELSE       
+          search_pts_v = 2000000.  
+          RETURN 
+       ENDIF
+       !
+    ENDIF
+    WRITE(*,*) 'cas 2', search_pts_v
+    !     
+    RETURN          
+    !
+  END FUNCTION search_pts_v
+  !
+  !**************************************************************
+  !    end subroutine search_pts_v
+  !************************************************************** 
+  !
+  !
+END MODULE agrif_extrapolation
Index: trunk/NEMOGCM/TOOLS/NESTING/src/agrif_gridsearch.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/NESTING/src/agrif_gridsearch.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/NESTING/src/agrif_gridsearch.f90	(revision 2528)
@@ -0,0 +1,760 @@
+!
+MODULE agrif_gridsearch
+  !
+  USE agrif_modutil
+  !
+  !************************************************************************
+  ! 									*
+  ! MODULE  AGRIF_GRIDSEARCH						*
+  ! 									*
+  !************************************************************************
+  !     
+  !-----------------------------------------------------------------------
+  IMPLICIT NONE
+
+  !-----------------------------------------------------------------------
+  !     variables that describe each grid
+  !-----------------------------------------------------------------------
+  !
+  !      integer :: grid1_size,grid2_size,grid1_rank, grid2_rank      
+  !      integer, dimension(:), pointer :: grid1_dims, grid2_dims  
+  !      logical, dimension(:), pointer :: grid1_mask,grid2_mask        
+  !      real*8,dimension(:),pointer :: grid1_center_lat,grid1_center_lon,grid2_center_lat,grid2_center_lon
+  !
+  !      real*8,dimension(:,:), pointer :: grid1_bound_box,grid2_bound_box   
+  !      integer, parameter :: num_srch_bins = 90  
+  !      integer,dimension(:,:),pointer :: bin_addr1,bin_addr2 
+  !      real*8, dimension(:,:),pointer :: bin_lats,bin_lons 
+  REAL*8, PARAMETER :: zero   = 0.0,  &
+       one    = 1.0,  &
+       two    = 2.0,  &
+       three  = 3.0,  &
+       four   = 4.0,  &
+       five   = 5.0,  & 
+       half   = 0.5,  &
+       quart  = 0.25, &
+       bignum = 1.e+20, &
+       tiny   = 1.e-14, &
+       pi     = 3.14159265359, &
+       pi2    = two*pi, &
+       pih    = half*pi        
+  !      
+  REAL*8, PARAMETER :: deg2rad = pi/180.
+  ! 
+  !
+CONTAINS 
+  !     
+  !
+  SUBROUTINE get_detected_pts(grid1_lat,grid2_lat,grid1_lon,grid2_lon,maskC,maskF,detected_pts)
+    !
+    !-----------------------------------------------------------------------
+    !this routine makes any necessary changes (e.g. for 0,2pi longitude range)
+    !-----------------------------------------------------------------------
+    !
+    REAL*8,DIMENSION(:,:),POINTER :: grid1_lat,grid2_lat,grid1_lon,grid2_lon
+    LOGICAL, POINTER, DIMENSION(:,:) :: masksrc,maskdst 
+    LOGICAL, DIMENSION(:,:) :: detected_pts 
+    REAL*8,DIMENSION(:,:) :: maskF,maskC
+    LOGICAL,POINTER,DIMENSION(:) :: detected_pts_1D     
+    REAL*8 :: plat,plon
+    INTEGER :: lastsrc_add
+    INTEGER, DIMENSION(4) :: src_add 
+    REAL*8,DIMENSION(4) :: src_lats,src_lons      
+    INTEGER :: grid1_size,grid2_size,grid1_rank, grid2_rank      
+    INTEGER, DIMENSION(:), POINTER :: grid1_dims, grid2_dims  
+    LOGICAL, DIMENSION(:), POINTER :: grid1_mask,grid2_mask        
+    REAL*8,DIMENSION(:),POINTER :: grid1_center_lat,grid1_center_lon,grid2_center_lat,grid2_center_lon
+
+    REAL*8,DIMENSION(:,:), POINTER :: grid1_bound_box,grid2_bound_box   
+    !      integer, parameter :: num_srch_bins = 90  
+    INTEGER,DIMENSION(:,:),POINTER :: bin_addr1,bin_addr2 
+    REAL*8, DIMENSION(:,:),POINTER :: bin_lats,bin_lons 
+
+    REAL*8, PARAMETER :: zero   = 0.0,  &
+         one    = 1.0,  &
+         two    = 2.0,  &
+         three  = 3.0,  &
+         four   = 4.0,  &
+         five   = 5.0,  & 
+         half   = 0.5,  &
+         quart  = 0.25, &
+         bignum = 1.e+20, &
+         tiny   = 1.e-14, &
+         pi     = 3.14159265359, &
+         pi2    = two*pi, &
+         pih    = half*pi        
+
+    REAL*8, PARAMETER :: deg2rad = pi/180.
+    !
+    !-----------------------------------------------------------------------
+    ! local variables
+    !-----------------------------------------------------------------------
+    !
+    INTEGER :: n,nele,i,j,ip1,jp1,n_add,e_add,ne_add,nx,ny
+    INTEGER :: xpos,ypos,dst_add
+    !          
+    ! integer mask
+    ! 
+    INTEGER, DIMENSION(:), POINTER :: imask 
+    !
+    ! lat/lon intervals for search bins
+    !
+    REAL*8 :: dlat,dlon           
+    !      
+    ! temps for computing bounding boxes
+    !
+    REAL*8, DIMENSION(4) :: tmp_lats, tmp_lons  
+    !
+    !      write(*,*)'proceed to Bilinear interpolation ...'
+    !
+    ALLOCATE(grid1_dims(2),grid2_dims(2))
+    !      
+    grid1_dims(1) = SIZE(grid1_lat,2)
+    grid1_dims(2) = SIZE(grid1_lat,1)
+    grid2_dims(1) = SIZE(grid2_lat,2)
+    grid2_dims(2) = SIZE(grid2_lat,1)
+    grid1_size = SIZE(grid1_lat,2) * SIZE(grid1_lat,1)
+    grid2_size = SIZE(grid2_lat,2) * SIZE(grid2_lat,1)  
+    !      
+    !-----------------------------------------------------------------------
+    !     allocate grid coordinates/masks and read data
+    !-----------------------------------------------------------------------
+    !     
+    ALLOCATE( grid1_bound_box (4,grid1_size),grid2_bound_box (4,grid2_size))
+
+    ALLOCATE(detected_pts_1D(grid1_size))
+    ALLOCATE(masksrc(SIZE(maskC,1),SIZE(maskC,2)))
+    ALLOCATE(maskdst(SIZE(maskF,1),SIZE(maskF,2)))
+    !      
+    WHERE(maskC == 1.)
+       masksrc= .TRUE.
+    ELSEWHERE
+       masksrc= .FALSE.
+    END WHERE
+    !      
+    WHERE(maskF == 1.)
+       maskdst= .TRUE.
+    ELSEWHERE
+       maskdst= .FALSE.
+    END WHERE
+    !                 
+    !      
+    !
+    ! 2D array -> 1D array
+    !
+    ALLOCATE(grid1_center_lat(SIZE(grid1_lat,1)*SIZE(grid1_lat,2)))
+    CALL tab2Dto1D(grid1_lat,grid1_center_lat)
+
+    ALLOCATE(grid1_center_lon(SIZE(grid1_lon,1)*SIZE(grid1_lon,2)))
+    CALL tab2Dto1D(grid1_lon,grid1_center_lon)
+
+    ALLOCATE(grid2_center_lat(SIZE(grid2_lat,1)*SIZE(grid2_lat,2)))
+    CALL tab2Dto1D(grid2_lat,grid2_center_lat)
+
+    ALLOCATE(grid2_center_lon(SIZE(grid2_lon,1)*SIZE(grid2_lon,2)))      
+    CALL tab2Dto1D(grid2_lon,grid2_center_lon) 
+
+    ALLOCATE(grid1_mask(SIZE(grid1_lat,1)*SIZE(grid1_lat,2)))
+    CALL logtab2Dto1D(masksrc,grid1_mask)
+
+    ALLOCATE(grid2_mask(SIZE(grid2_lat,1)*SIZE(grid2_lat,2)))      
+    CALL logtab2Dto1D(maskdst,grid2_mask)
+    !                      
+    !
+    ! degrees to radian
+    !
+    grid1_center_lat = grid1_center_lat*deg2rad
+    grid1_center_lon = grid1_center_lon*deg2rad
+    grid2_center_lat = grid2_center_lat*deg2rad
+    grid2_center_lon = grid2_center_lon*deg2rad
+
+    !-----------------------------------------------------------------------
+    !     convert longitudes to 0,2pi interval
+    !-----------------------------------------------------------------------
+
+    WHERE (grid1_center_lon .GT. pi2)  grid1_center_lon =       &
+         grid1_center_lon - pi2
+    WHERE (grid1_center_lon .LT. zero) grid1_center_lon =       &
+         grid1_center_lon + pi2
+    WHERE (grid2_center_lon .GT. pi2)  grid2_center_lon =       &
+         grid2_center_lon - pi2
+    WHERE (grid2_center_lon .LT. zero) grid2_center_lon =       &
+         grid2_center_lon + pi2
+
+    !-----------------------------------------------------------------------
+    !
+    !     make sure input latitude range is within the machine values
+    !     for +/- pi/2 
+    !
+    !-----------------------------------------------------------------------
+
+    WHERE (grid1_center_lat >  pih) grid1_center_lat =  pih
+    WHERE (grid1_center_lat < -pih) grid1_center_lat = -pih
+    WHERE (grid2_center_lat >  pih) grid2_center_lat =  pih
+    WHERE (grid2_center_lat < -pih) grid2_center_lat = -pih
+
+    !-----------------------------------------------------------------------
+    !
+    !     compute bounding boxes for restricting future grid searches
+    !
+    !-----------------------------------------------------------------------
+    !
+    nx = grid1_dims(1)
+    ny = grid1_dims(2)
+
+    DO n=1,grid1_size
+
+       !*** find N,S and NE points to this grid point
+
+       j = (n - 1)/nx +1
+       i = n - (j-1)*nx
+
+       IF (i < nx) THEN
+          ip1 = i + 1
+       ELSE
+          !*** assume cyclic
+          ip1 = 1
+          !*** but if it is not, correct
+          e_add = (j - 1)*nx + ip1
+          IF (ABS(grid1_center_lat(e_add) -     &
+               grid1_center_lat(n   )) > pih) THEN
+             ip1 = i
+          ENDIF
+          ip1=nx
+       ENDIF
+
+       IF (j < ny) THEN
+          jp1 = j+1
+       ELSE
+          !*** assume cyclic
+          jp1 = 1
+          !*** but if it is not, correct
+          n_add = (jp1 - 1)*nx + i
+          IF (ABS(grid1_center_lat(n_add) -             &
+               grid1_center_lat(n   )) > pih) THEN
+             jp1 = j
+          ENDIF
+          jp1=ny
+       ENDIF
+
+       n_add = (jp1 - 1)*nx + i
+       e_add = (j - 1)*nx + ip1
+       ne_add = (jp1 - 1)*nx + ip1
+
+       !*** find N,S and NE lat/lon coords and check bounding box
+
+       tmp_lats(1) = grid1_center_lat(n)
+       tmp_lats(2) = grid1_center_lat(e_add)
+       tmp_lats(3) = grid1_center_lat(ne_add)
+       tmp_lats(4) = grid1_center_lat(n_add)
+
+       tmp_lons(1) = grid1_center_lon(n)
+       tmp_lons(2) = grid1_center_lon(e_add)
+       tmp_lons(3) = grid1_center_lon(ne_add)
+       tmp_lons(4) = grid1_center_lon(n_add)
+
+       grid1_bound_box(1,n) = MINVAL(tmp_lats)
+       grid1_bound_box(2,n) = MAXVAL(tmp_lats)
+
+       grid1_bound_box(3,n) = MINVAL(tmp_lons)
+       grid1_bound_box(4,n) = MAXVAL(tmp_lons)
+    END DO
+
+    nx = grid2_dims(1)
+    ny = grid2_dims(2)
+
+    DO n=1,grid2_size
+
+       !*** find N,S and NE points to this grid point
+
+       j = (n - 1)/nx +1
+       i = n - (j-1)*nx
+
+       IF (i < nx) THEN
+          ip1 = i + 1
+       ELSE
+          !*** assume cyclic
+          ip1 = 1
+          !*** but if it is not, correct
+          e_add = (j - 1)*nx + ip1
+          IF (ABS(grid2_center_lat(e_add) -  &
+               grid2_center_lat(n   )) > pih) THEN
+             ip1 = i
+          ENDIF
+       ENDIF
+
+       IF (j < ny) THEN
+          jp1 = j+1
+       ELSE
+          !*** assume cyclic
+          jp1 = 1
+          !*** but if it is not, correct
+          n_add = (jp1 - 1)*nx + i
+          IF (ABS(grid2_center_lat(n_add) -  &
+               grid2_center_lat(n   )) > pih) THEN
+             jp1 = j
+          ENDIF
+       ENDIF
+
+       n_add = (jp1 - 1)*nx + i
+       e_add = (j - 1)*nx + ip1
+       ne_add = (jp1 - 1)*nx + ip1
+
+       !*** find N,S and NE lat/lon coords and check bounding box
+
+       tmp_lats(1) = grid2_center_lat(n)
+       tmp_lats(2) = grid2_center_lat(e_add)
+       tmp_lats(3) = grid2_center_lat(ne_add)
+       tmp_lats(4) = grid2_center_lat(n_add)
+
+       tmp_lons(1) = grid2_center_lon(n)
+       tmp_lons(2) = grid2_center_lon(e_add)
+       tmp_lons(3) = grid2_center_lon(ne_add)
+       tmp_lons(4) = grid2_center_lon(n_add)
+
+       grid2_bound_box(1,n) = MINVAL(tmp_lats)
+       grid2_bound_box(2,n) = MAXVAL(tmp_lats)
+       grid2_bound_box(3,n) = MINVAL(tmp_lons)
+       grid2_bound_box(4,n) = MAXVAL(tmp_lons)
+    END DO
+    !
+    !
+    !
+    WHERE (ABS(grid1_bound_box(4,:) - grid1_bound_box(3,:)) > pi)
+       grid1_bound_box(3,:) = zero
+       grid1_bound_box(4,:) = pi2
+    END WHERE
+
+    WHERE (ABS(grid2_bound_box(4,:) - grid2_bound_box(3,:)) > pi)
+       grid2_bound_box(3,:) = zero
+       grid2_bound_box(4,:) = pi2
+    END WHERE
+
+    !***
+    !*** try to check for cells that overlap poles
+    !***
+
+    WHERE (grid1_center_lat > grid1_bound_box(2,:)) &
+         grid1_bound_box(2,:) = pih
+
+    WHERE (grid1_center_lat < grid1_bound_box(1,:)) &
+         grid1_bound_box(1,:) = -pih
+
+    WHERE (grid2_center_lat > grid2_bound_box(2,:)) &
+         grid2_bound_box(2,:) = pih
+
+    WHERE (grid2_center_lat < grid2_bound_box(1,:)) &
+         grid2_bound_box(1,:) = -pih
+
+    !-----------------------------------------------------------------------
+    !     set up and assign address ranges to search bins in order to 
+    !     further restrict later searches
+    !-----------------------------------------------------------------------
+
+    ALLOCATE(bin_addr1(2,90))
+    ALLOCATE(bin_addr2(2,90))
+    ALLOCATE(bin_lats (2,90))
+    ALLOCATE(bin_lons (2,90))
+
+    dlat = pi/90
+
+    DO n=1,90
+       bin_lats(1,n) = (n-1)*dlat - pih
+       bin_lats(2,n) =     n*dlat - pih
+       bin_lons(1,n) = zero
+       bin_lons(2,n) = pi2
+       bin_addr1(1,n) = grid1_size + 1
+       bin_addr1(2,n) = 0
+       bin_addr2(1,n) = grid2_size + 1
+       bin_addr2(2,n) = 0
+    END DO
+
+    DO nele=1,grid1_size
+       DO n=1,90
+          IF (grid1_bound_box(1,nele) <= bin_lats(2,n) .AND.   &
+               grid1_bound_box(2,nele) >= bin_lats(1,n)) THEN
+             bin_addr1(1,n) = MIN(nele,bin_addr1(1,n))
+             bin_addr1(2,n) = MAX(nele,bin_addr1(2,n))
+          ENDIF
+       END DO
+    END DO
+
+    DO nele=1,grid2_size
+       DO n=1,90
+          IF (grid2_bound_box(1,nele) <= bin_lats(2,n) .AND.    &
+               grid2_bound_box(2,nele) >= bin_lats(1,n)) THEN
+             bin_addr2(1,n) = MIN(nele,bin_addr2(1,n))
+             bin_addr2(2,n) = MAX(nele,bin_addr2(2,n))
+          ENDIF
+       END DO
+    END DO
+    !	
+    !	Call init_remap_vars 
+    !
+
+    lastsrc_add=1
+    detected_pts_1D = .FALSE.
+    !
+    DO dst_add = 1, grid2_size
+       !        
+       plat = grid2_center_lat(dst_add)
+       plon = grid2_center_lon(dst_add)
+       !***
+       !*** find nearest square of grid points on source grid
+       !***
+       CALL grid_search_bilin(bin_lons,bin_lats,src_add, src_lats, src_lons,          &
+            plat, plon, grid1_dims,               &
+            grid1_center_lat, grid1_center_lon,   & 
+            grid1_bound_box, bin_addr1, bin_addr2,lastsrc_add)
+       !
+       IF (src_add(1) > 0) THEN
+          !
+          IF(grid2_mask(dst_add)) THEN                  !mask true on destination grid	    
+             DO n=1,4
+                IF(.NOT. grid1_mask(src_add(n))) THEN
+                   detected_pts_1D(src_add(n)) = .TRUE.
+                ENDIF
+             END DO
+          ENDIF
+       ENDIF
+    END DO
+    !
+    !
+    CALL logtab1Dto2D(detected_pts_1D,detected_pts,SIZE(detected_pts,2),SIZE(detected_pts,1))	
+    !
+    DEALLOCATE(detected_pts_1D,grid1_bound_box,grid2_bound_box)
+    DEALLOCATE(grid1_center_lon,grid1_center_lat,grid2_center_lon,grid2_center_lat)
+    DEALLOCATE(grid1_mask,grid2_mask,masksrc,maskdst)
+    DEALLOCATE(bin_addr1,bin_addr2,bin_lats,bin_lons)
+    DEALLOCATE(grid1_dims,grid2_dims)
+    !	
+    !-----------------------------------------------------------------------
+
+  END SUBROUTINE get_detected_pts
+
+  !**********************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !************************************************************************
+  !   SUBROUTINE GRID_SEARCH_BILIN
+  !************************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  SUBROUTINE grid_search_bilin(bin_lons,bin_lats,src_add, src_lats, src_lons,   &
+       plat, plon, src_grid_dims,      &
+       src_center_lat, src_center_lon, & 
+       src_grid_bound_box,             &
+       src_bin_add, dst_bin_add,lastsrc_add)
+
+    !-----------------------------------------------------------------------
+    !
+    !     this routine finds the location of the search point plat, plon
+    !     in the source grid and returns the corners needed for a bilinear
+    !     interpolation.
+    !
+    !-----------------------------------------------------------------------
+
+    !-----------------------------------------------------------------------
+    !     output variables
+    !-----------------------------------------------------------------------
+    !
+    ! address of each corner point enclosing P
+    !
+    INTEGER,DIMENSION(4) :: src_add  
+    REAL*8,DIMENSION(4) :: src_lats,src_lons  
+    !      
+    !-----------------------------------------------------------------------
+    !     input variables
+    !-----------------------------------------------------------------------
+    ! 
+    ! latitude, longitude of the search point
+    !
+    REAL*8, DIMENSION(:,:) :: bin_lats,bin_lons 
+    REAL*8, INTENT(in) :: plat,plon   
+    !
+    ! size of each src grid dimension
+    !
+    INTEGER, DIMENSION(2), INTENT(in) :: src_grid_dims  
+    !
+    ! latitude, longitude of each src grid center
+    !
+    REAL*8, DIMENSION(:), INTENT(in) :: src_center_lat,src_center_lon  
+    !
+    ! bound box for source grid
+    !
+    REAL*8, DIMENSION(:,:), INTENT(in) :: src_grid_bound_box 
+    !
+    ! latitude bins for restricting searches
+    !
+    INTEGER, DIMENSION(:,:), INTENT(in) ::src_bin_add,dst_bin_add 
+
+    INTEGER,OPTIONAL :: lastsrc_add
+    INTEGER :: loopsrc,l1,l2
+    !      
+    !-----------------------------------------------------------------------
+    !     local variables
+    !-----------------------------------------------------------------------
+    !
+    INTEGER :: n,next_n,srch_add,nx, ny,min_add, max_add,  &
+         i, j, jp1, ip1, n_add, e_add, ne_add
+
+
+    REAL*8 ::  vec1_lat, vec1_lon,vec2_lat, vec2_lon, cross_product,  &
+         cross_product_last,coslat_dst, sinlat_dst, coslon_dst, &
+         sinlon_dst,dist_min, distance 
+
+    !-----------------------------------------------------------------------
+    !     restrict search first using bins
+    !-----------------------------------------------------------------------
+
+    src_add = 0
+
+    min_add = SIZE(src_center_lat)
+    max_add = 1
+    DO n=1,90
+       IF (plat >= bin_lats(1,n) .AND. plat <= bin_lats(2,n) .AND. &
+            plon >= bin_lons(1,n) .AND. plon <= bin_lons(2,n)) THEN
+          min_add = MIN(min_add, src_bin_add(1,n))
+          max_add = MAX(max_add, src_bin_add(2,n))
+       ENDIF
+    END DO
+
+    !-----------------------------------------------------------------------
+    !     now perform a more detailed search 
+    !-----------------------------------------------------------------------
+
+    nx = src_grid_dims(1)
+    ny = src_grid_dims(2)
+
+    loopsrc=0
+    DO WHILE (loopsrc <= max_add)
+
+
+       l1=MAX(min_add,lastsrc_add-loopsrc)
+       l2=MIN(max_add,lastsrc_add+loopsrc)      
+
+       loopsrc = loopsrc+1
+
+       srch_loop: DO srch_add = l1,l2,MAX(l2-l1,1)
+
+          !*** first check bounding box
+
+          IF (plat <= src_grid_bound_box(2,srch_add) .AND. & 
+               plat >= src_grid_bound_box(1,srch_add) .AND.  &
+               plon <= src_grid_bound_box(4,srch_add) .AND.  &
+               plon >= src_grid_bound_box(3,srch_add)) THEN
+             !***
+             !*** we are within bounding box so get really serious
+             !***
+             !*** determine neighbor addresses
+             !
+             j = (srch_add - 1)/nx +1
+             i = srch_add - (j-1)*nx
+             !
+             IF (i < nx) THEN
+                ip1 = i + 1
+             ELSE
+                ip1 = 1
+             ENDIF
+             !
+             IF (j < ny) THEN
+                jp1 = j+1
+             ELSE
+                jp1 = 1
+             ENDIF
+             !
+             n_add = (jp1 - 1)*nx + i
+             e_add = (j - 1)*nx + ip1
+             ne_add = (jp1 - 1)*nx + ip1
+             !
+             src_lats(1) = src_center_lat(srch_add)
+             src_lats(2) = src_center_lat(e_add)
+             src_lats(3) = src_center_lat(ne_add)
+             src_lats(4) = src_center_lat(n_add)
+             !
+             src_lons(1) = src_center_lon(srch_add)
+             src_lons(2) = src_center_lon(e_add)
+             src_lons(3) = src_center_lon(ne_add)
+             src_lons(4) = src_center_lon(n_add)
+             !
+             !***
+             !*** for consistency, we must make sure all lons are in
+             !*** same 2pi interval
+             !***
+             !
+             vec1_lon = src_lons(1) - plon
+             IF (vec1_lon >  pi) THEN
+                src_lons(1) = src_lons(1) - pi2
+             ELSE IF (vec1_lon < -pi) THEN
+                src_lons(1) = src_lons(1) + pi2
+             ENDIF
+             DO n=2,4
+                vec1_lon = src_lons(n) - src_lons(1)
+                IF (vec1_lon >  pi) THEN
+                   src_lons(n) = src_lons(n) - pi2
+                ELSE IF (vec1_lon < -pi) THEN
+                   src_lons(n) = src_lons(n) + pi2
+                ENDIF
+             END DO
+             !
+             corner_loop: DO n=1,4
+                next_n = MOD(n,4) + 1
+                !***
+                !*** here we take the cross product of the vector making 
+                !*** up each box side with the vector formed by the vertex
+                !*** and search point.  if all the cross products are 
+                !*** positive, the point is contained in the box.
+                !***
+                vec1_lat = src_lats(next_n) - src_lats(n)
+                vec1_lon = src_lons(next_n) - src_lons(n)
+                vec2_lat = plat - src_lats(n)
+                vec2_lon = plon - src_lons(n)
+                !***
+                !*** check for 0,2pi crossings
+                !***
+                IF (vec1_lon >  three*pih) THEN
+                   vec1_lon = vec1_lon - pi2
+                ELSE IF (vec1_lon < -three*pih) THEN
+                   vec1_lon = vec1_lon + pi2
+                ENDIF
+                IF (vec2_lon >  three*pih) THEN
+                   vec2_lon = vec2_lon - pi2
+                ELSE IF (vec2_lon < -three*pih) THEN
+                   vec2_lon = vec2_lon + pi2
+                ENDIF
+                !
+                cross_product = vec1_lon*vec2_lat - vec2_lon*vec1_lat
+                !
+                !***
+                !*** if cross product is less than zero, this cell
+                !*** doesn't work
+                !***
+                IF (n == 1) cross_product_last = cross_product
+                IF (cross_product*cross_product_last < zero) &
+                     EXIT corner_loop
+                cross_product_last = cross_product
+                !
+             END DO corner_loop
+             !***
+             !*** if cross products all same sign, we found the location
+             !***
+             IF (n > 4) THEN
+                src_add(1) = srch_add
+                src_add(2) = e_add
+                src_add(3) = ne_add
+                src_add(4) = n_add
+                !
+                lastsrc_add = srch_add
+                RETURN
+             ENDIF
+             !***
+             !*** otherwise move on to next cell
+             !***
+          ENDIF !bounding box check
+       END DO srch_loop
+
+
+    ENDDO
+
+
+    !***
+    !*** if no cell found, point is likely either in a box that
+    !*** straddles either pole or is outside the grid.  fall back
+    !*** to a distance-weighted average of the four closest
+    !*** points.  go ahead and compute weights here, but store
+    !*** in src_lats and return -add to prevent the parent
+    !*** routine from computing bilinear weights
+    !***
+    !print *,'Could not find location for ',plat,plon
+    !print *,'Using nearest-neighbor average for this point'
+    !
+    coslat_dst = COS(plat)
+    sinlat_dst = SIN(plat)
+    coslon_dst = COS(plon)
+    sinlon_dst = SIN(plon)
+    !
+    dist_min = bignum
+    src_lats = bignum
+    DO srch_add = min_add,max_add
+       distance = ACOS(coslat_dst*COS(src_center_lat(srch_add))*   &
+            (coslon_dst*COS(src_center_lon(srch_add)) +   &
+            sinlon_dst*SIN(src_center_lon(srch_add)))+   &
+            sinlat_dst*SIN(src_center_lat(srch_add)))
+
+       IF (distance < dist_min) THEN
+          sort_loop: DO n=1,4
+             IF (distance < src_lats(n)) THEN
+                DO i=4,n+1,-1
+                   src_add (i) = src_add (i-1)
+                   src_lats(i) = src_lats(i-1)
+                END DO
+                src_add (n) = -srch_add
+                src_lats(n) = distance
+                dist_min = src_lats(4)
+                EXIT sort_loop
+             ENDIF
+          END DO sort_loop
+       ENDIF
+    END DO
+    !
+    src_lons = one/(src_lats + tiny)
+    distance = SUM(src_lons)
+    src_lats = src_lons/distance
+
+    !-----------------------------------------------------------------------
+
+  END SUBROUTINE grid_search_bilin
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !************************************************************************
+  !   SUBROUTINE INIT_REMAP_VARS
+  !************************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  !      subroutine init_remap_vars
+  !
+  !-----------------------------------------------------------------------
+  !
+  !     this routine initializes some variables and provides an initial
+  !     allocation of arrays (fairly large so frequent resizing 
+  !     unnecessary).
+  !
+  !-----------------------------------------------------------------------
+  !
+  !-----------------------------------------------------------------------
+  !     determine the number of weights
+  !-----------------------------------------------------------------------
+  !        num_wts = 1     ! bilinear interpolation
+  !-----------------------------------------------------------------------
+  !     initialize num_links and set max_links to four times the largest 
+  !     of the destination grid sizes initially (can be changed later).
+  !     set a default resize increment to increase the size of link
+  !     arrays if the number of links exceeds the initial size  
+  !!-----------------------------------------------------------------------
+  !      
+  !      num_links_map1 = 0
+  !      max_links_map1 = 4*grid2_size
+  !      if (num_maps > 1) then
+  !        num_links_map2 = 0
+  !        max_links_map1 = max(4*grid1_size,4*grid2_size)
+  !        max_links_map2 = max_links_map1
+  !      endif
+  !
+  !      resize_increment = 0.1*max(grid1_size,grid2_size)
+  !
+  !-----------------------------------------------------------------------
+  !     allocate address and weight arrays for mapping 1  
+  !-----------------------------------------------------------------------
+  !
+  !      allocate (grid1_add_map1(max_links_map1),    &
+  !                grid2_add_map1(max_links_map1),    &
+  !                wts_map1(num_wts, max_links_map1))
+  !		
+  !	grid1_add_map1 = 0.	
+  !	grid2_add_map1 = 0.
+  !	wts_map1 = 0.!
+  !
+  !!-----------------------------------------------------------------------
+  !
+  !      end subroutine init_remap_vars
+
+END MODULE agrif_gridsearch
Index: trunk/NEMOGCM/TOOLS/NESTING/src/agrif_interpolation.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/NESTING/src/agrif_interpolation.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/NESTING/src/agrif_interpolation.f90	(revision 2528)
@@ -0,0 +1,990 @@
+!************************************************************************
+! Fortran 95 OPA Nesting tools						*
+!									*
+!     Copyright (C) 2005 Florian Lemarié (Florian.Lemarie@imag.fr)	*
+!									*
+!************************************************************************
+!
+MODULE agrif_interpolation
+  !
+  USE agrif_types
+  USE io_netcdf
+  USE bicubic_interp
+  USE bilinear_interp
+  USE agrif_extrapolation
+  USE agrif_readwrite 
+  !
+  !
+  !************************************************************************
+  ! 									*
+  ! MODULE  AGRIF_INTERPOLATION						*
+  !									*
+  ! module containing subroutine used for : 				*
+  !   - Forcing data interpolation					*
+  !   - Parent to Child coordinates interpolation			*
+  !									*
+  !************************************************************************
+  !          
+  ! 
+CONTAINS
+  !  
+  !
+  !****************************************************************
+  !   subroutine agrif_interp					*
+  !								*
+  ! subroutine to interpolate coordinates		 	*
+  !								*
+  ! - input :							*
+  !     tabin : coarse grid coordinate variable 		*
+  !   typevar : position of interpolated variable on cells	*
+  !								*
+  ! - ouput :							*
+  !    tabout : coordinate variable interpolated on fine grid	*
+  !								*
+  !****************************************************************
+  !     
+  SUBROUTINE agrif_interp(tabin,tabout,typevar)
+    !      
+    REAL*8,DIMENSION(:,:) :: tabin,tabout
+    CHARACTER(*) :: typevar
+    REAL*8 :: cff1
+    INTEGER :: ii,jj
+    REAL*8,DIMENSION(:,:),ALLOCATABLE :: tabouttemp
+    !
+    ! 
+    !
+    CALL agrif_base_interp2(tabin,tabout,imin,jmin,typevar)
+
+    !
+  END SUBROUTINE agrif_interp
+  !
+  !********************************************************
+  !   subroutine agrif_base_interp2			*
+  !********************************************************
+  !      
+  SUBROUTINE agrif_base_interp2(tabin,tabout,i_min,j_min,typevar)
+    !
+    IMPLICIT NONE
+    REAL*8,DIMENSION(:,:) :: tabin,tabout
+    REAL*8 :: cff1
+    INTEGER :: i_min,j_min
+    INTEGER :: ii,jj,i,j
+    CHARACTER(*) :: typevar   
+    REAL*8,DIMENSION(:),ALLOCATABLE :: xc,yc,xf,yf
+    REAL*8,DIMENSION(:,:),ALLOCATABLE :: tabtemp
+    REAL*8 :: dxc,dyc,dxf,dyf
+    REAL*8 :: decalxc,decalyc,decalxf,decalyf
+
+    INTEGER :: ptx,pty
+    REAL*8 :: val(4),xval(4)
+
+    INTEGER :: nxc,nyc,nxf,nyf
+    REAL :: xmin,ymin,x,y
+    INTEGER :: ic,jc,itemp,jtemp
+
+    nxc = SIZE(tabin,1)
+    nyc = SIZE(tabin,2)
+
+    nxf = SIZE(tabout,1)
+    nyf = SIZE(tabout,2)      
+    !
+
+    ALLOCATE(xc(nxc))
+    ALLOCATE(yc(nyc))
+    ALLOCATE(xf(nxf))
+    ALLOCATE(yf(nyf))
+
+    ALLOCATE(tabtemp(nxc,nyf))
+
+    dxc = 1.
+    dyc = 1.
+    dxf = 1./REAL(irafx)
+    dyf = 1./REAL(irafy)
+
+    IF (typevar .EQ. 'F') THEN
+       ptx = 2
+       pty = 2
+       decalxc = 0.
+       decalyc = 0.
+       decalxf = 0.
+       decalyf = 0.
+    ELSEIF (typevar .EQ. 'T') THEN
+       ptx = 3
+       pty = 3
+       decalxc = dxc/2.
+       decalyc = dyc/2.
+       decalxf = dxf/2.
+       decalyf = dyf/2.
+    ELSEIF (typevar .EQ. 'U') THEN
+       ptx = 2
+       pty = 3
+       decalxc = 0.
+       decalyc = dyc/2.
+       decalxf = 0.
+       decalyf = dyf/2.
+    ELSEIF (typevar .EQ. 'V') THEN
+       ptx = 3
+       pty = 2
+       decalxc = dxc/2.
+       decalyc = 0.
+       decalxf = dxf/2.
+       decalyf = 0.
+    ENDIF
+
+    DO i=1,nxc
+       xc(i) = 0. + (i-ptx) * dxc + decalxc
+    ENDDO
+
+    DO j=1,nyc
+       yc(j) = 0. + (j-pty) * dyc + decalyc
+    ENDDO
+
+
+    xmin = (i_min - 1) * dxc
+    ymin = (j_min - 1) * dyc
+
+    DO i=1,nxf
+       xf(i) = xmin + (i-ptx) * dxf + decalxf
+    ENDDO
+
+    DO j=1,nyf
+       yf(j) = ymin + (j-pty) * dyf + decalyf
+    ENDDO
+
+
+    DO j = 1,nyf
+       DO i = 1,nxc
+	  x = xc(i)
+	  y = yf(j)
+
+	  ic = ptx + NINT((x-0.-decalxc)/dxc)
+	  jc = pty + agrif_int((y-0.-decalyc)/dyc)
+
+	  jc = jc - 1
+
+	  CALL polint(yc(jc:jc+3),tabin(ic,jc:jc+3),4,y,tabtemp(i,j))
+       ENDDO
+    ENDDO
+
+    DO j = 1,nyf
+       DO i = 1,nxf
+	  x = xf(i)
+	  y = yf(j)
+
+	  itemp = ptx + agrif_int((x-0.-decalxc)/dxc)
+	  jtemp = pty + NINT((y-ymin-decalyf)/dyf)
+
+	  itemp = itemp - 1
+
+	  val = tabtemp(itemp:itemp+3,jtemp)
+	  xval = xc(itemp:itemp+3)
+	  CALL polint(xval,val,4,x,tabout(i,j))
+
+       ENDDO
+    ENDDO
+
+    DEALLOCATE(xc,yc,xf,yf,tabtemp)
+
+
+  END SUBROUTINE agrif_base_interp2
+  !
+  !********************************************************
+  !   subroutine polint					*
+  !********************************************************
+  !       
+  SUBROUTINE polint(xin,valin,n,x,val)
+    IMPLICIT NONE
+    INTEGER n
+    REAL*8 xin(n), valin(n)
+    REAL*8 x,val
+
+    INTEGER ns,i,m
+    REAL *8 dif,dift
+    REAL*8 c(n),d(n),ho,hp,w,den,dy
+
+    ns = 1
+    dif = ABS(x-xin(1))
+
+    DO i=1,n
+       dift = ABS(x-xin(i))
+       IF (dift < dif) THEN
+	  ns = i
+	  dif = dift
+       ENDIF
+       c(i) = valin(i)
+       d(i) = valin(i)
+    ENDDO
+
+    val = valin(ns)
+    ns = ns - 1
+
+    DO m=1,n-1
+       DO i=1,n-m
+	  ho = xin(i)-x
+	  hp = xin(i+m)-x
+	  w=c(i+1)-d(i)
+	  den = w/(ho-hp)
+          d(i) = hp * den
+	  c(i) = ho * den
+       ENDDO
+       IF (2*ns < (n-m)) THEN
+          dy = c(ns+1)
+       ELSE
+          dy = d(ns)
+          ns = ns - 1
+       ENDIF
+       val = val + dy
+    ENDDO
+  END SUBROUTINE polint
+  !
+  !********************************************************
+  !   subroutine polcoe					*
+  !********************************************************
+  !      
+  SUBROUTINE polcoe(xin,valin,n,cof)
+    IMPLICIT NONE
+    INTEGER n
+    REAL*8 xin(n),valin(n),cof(n)
+
+
+    INTEGER i,j,k
+    REAL*8 b,ff,phi,s(n)
+
+    s = 0.
+    cof = 0.
+
+    s(n)=-xin(1)
+    DO i=2,n
+       DO j=n+1-i,n-1
+          s(j) =s(j) -xin(i)*s(j+1)
+       ENDDO
+       s(n)=s(n)-xin(i)
+    ENDDO
+
+    DO j=1,n
+       phi=n
+       DO k=n-1,1,-1
+          phi = k*s(k+1)+xin(j)*phi
+       ENDDO
+       ff=valin(j)/phi
+       b=1.
+       DO k=n,1,-1
+	  cof(k)=cof(k)+b*ff
+	  b=s(k)+xin(j)*b
+       ENDDO
+    ENDDO
+
+    RETURN
+  END SUBROUTINE polcoe
+  !
+
+  !****************************************************************
+  !   subroutine Correctforconservation				*
+  !								*
+  ! Conservation on domain boundaries ( over 2 coarse grid cells)	*
+  !								*
+  !****************************************************************          
+  !
+  !
+  SUBROUTINE Correctforconservation(tabcoarse,tabfine,e1parent,e2parent,e1,e2,nxfin,nyfin,posvar,i_min,j_min)
+    IMPLICIT NONE
+    INTEGER :: nxfin,nyfin
+    REAL*8,DIMENSION(:,:) :: tabcoarse,tabfine,e1parent,e2parent,e1,e2
+    CHARACTER*1  :: posvar
+    INTEGER :: i_min,j_min,diff
+    INTEGER ji,jj,ipt,jpt,i,j
+    INTEGER ind1,ind2,ind3,ind4,ind5,ind6
+    REAL*8 cff1,cff2,cff3      
+    !
+    diff = 0      
+    IF ( MOD(irafx,2) .EQ. 0 ) diff = 1
+    !       
+    ind1 = 2 + CEILING(irafx/2.0) + diff
+    ind2 = nxfin-(2-1)-CEILING(irafx/2.0)
+    ind3 = 2 + CEILING(irafy/2.0) + diff
+    ind4 = nyfin-(2-1)-CEILING(irafy/2.0)
+    ind5 = nxfin - 1 - irafx - CEILING(irafx/2.0) 
+    ind6 = nyfin - 1 - irafy - CEILING(irafy/2.0) 
+    !       
+    IF (posvar.EQ.'T') THEN
+       !       
+       PRINT *,'correction'
+       !
+       DO ji=ind1,ind1+irafx,irafx
+          !       
+          ipt=i_min+(3-1)+(ji-ind1)/irafx
+          !            
+          DO jj=ind3,ind4,irafy
+             !            
+             jpt=j_min+(3-1)+(jj-ind3)/irafy
+
+             cff1=SUM(e1(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff)* &
+                  e2(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff))
+
+             cff2=SUM(e1(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff)*   &
+                  e2(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff)*   &
+                  tabfine(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff))
+
+             cff3=e1parent(ipt,jpt)*e2parent(ipt,jpt)*tabcoarse(ipt,jpt)                        
+
+             tabfine(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff)=  &
+                  tabfine(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff)+(cff3-cff2)/cff1
+
+          END DO
+
+       ENDDO
+       !****      
+       DO ji=ind5,ind5+irafx,irafx
+          !       
+          ipt=i_min+(3-1)+(ji-ind1)/irafx
+
+          DO jj=ind3,ind4,irafy
+             jpt=j_min+(3-1)+(jj-ind3)/irafy
+
+             cff1=SUM(e1(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff)* &
+                  e2(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff))
+
+             cff2=SUM(e1(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff)*   &
+                  e2(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff)*   &
+                  tabfine(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff))
+
+             cff3=e1parent(ipt,jpt)*e2parent(ipt,jpt)*tabcoarse(ipt,jpt)                        
+
+             tabfine(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff)=  &
+                  tabfine(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff)+(cff3-cff2)/cff1
+
+          END DO
+       ENDDO
+
+       DO jj=ind3,ind3+irafy,irafy
+          !       
+          jpt=j_min+(3-1)+(jj-ind3)/irafy
+          !
+          DO ji=ind1,ind2,irafx
+             !          
+             ipt=i_min+(3-1)+(ji-ind1)/irafx
+
+             cff1=SUM(e1(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff)* &
+                  e2(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff))
+
+             cff2=SUM(e1(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff)*   &
+                  e2(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff)*   &
+                  tabfine(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff))
+
+             cff3=e1parent(ipt,jpt)*e2parent(ipt,jpt)*tabcoarse(ipt,jpt)                        
+
+             tabfine(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff)=  &
+                  tabfine(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff)+(cff3-cff2)/cff1
+
+          END DO
+       ENDDO
+       !****      
+       DO jj=ind6,ind6+irafy,irafy
+          !
+          jpt=j_min+(3-1)+(jj-ind3)/irafy
+          !
+          DO ji=ind1,ind2,irafx          
+             ipt=i_min+(3-1)+(ji-ind1)/irafx	
+
+             cff1=SUM(e1(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff)* &
+                  e2(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff))
+
+             cff2=SUM(e1(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff)*   &
+                  e2(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff)*   &
+                  tabfine(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff))
+
+             cff3=e1parent(ipt,jpt)*e2parent(ipt,jpt)*tabcoarse(ipt,jpt)                        
+
+             tabfine(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff)=  &
+                  tabfine(ji-FLOOR(irafx/2.0):ji+FLOOR(irafx/2.0)-diff,jj-FLOOR(irafy/2.0):jj+FLOOR(irafy/2.0)-diff)+(cff3-cff2)/cff1
+
+          END DO
+       ENDDO
+       !                                     
+       !       
+    ENDIF
+    RETURN
+  END SUBROUTINE Correctforconservation
+
+  !
+  !****************************************************************
+  !   subroutine Interp_Extrap_var				*
+  !								*
+  ! Interpolation and Extrapolation for temperature and salinity	*
+  !								*
+  ! -input : 							*
+  !       filename : file containing variable to interpolate	*
+  !								*
+  !****************************************************************          
+  !
+  SUBROUTINE Interp_Extrap_var(filename, cd_type)      
+    !
+    IMPLICIT NONE
+    !
+    ! variables declaration
+    !      
+    CHARACTER(len=80),INTENT(in) :: filename
+    CHARACTER(len=1 ), OPTIONAL, INTENT(in) :: cd_type
+
+    CHARACTER*100 :: interp_type
+    CHARACTER*100 :: Child_file,Childcoordinates
+    CHARACTER*100 :: varname,childbathy
+    CHARACTER*1  :: posvar
+    CHARACTER*20,DIMENSION(:),POINTER :: Ncdf_varname
+    CHARACTER(len=20),DIMENSION(4) :: dimnames
+    !
+    REAL*8, POINTER, DIMENSION(:,:) :: lonParent,latParent => NULL()
+    REAL*8, POINTER, DIMENSION(:,:) :: lonChild,latChild,latlon_temp => NULL()
+    REAL*8, POINTER, DIMENSION(:,:,:,:) :: tabinterp4d,tabvar1,tabvar2,tabvar3 => NULL()
+    REAL*8, POINTER, DIMENSION(:,:,:) :: tabinterp3d,tabvar3d => NULL()
+    REAL*8, POINTER, DIMENSION(:) :: timedepth_temp,depth => NULL()
+    REAL*8,DIMENSION(:,:),POINTER :: matrix => NULL()
+    INTEGER,DIMENSION(:),POINTER :: src_add,dst_add  => NULL()
+    INTEGER, POINTER, DIMENSION(:) :: tabtemp1DInt => NULL()
+    REAL*8, POINTER, DIMENSION(:) :: nav_lev => NULL()
+    !      
+    LOGICAL, DIMENSION(:,:,:), POINTER :: detected_pts => NULL()  
+    REAL*8,DIMENSION(:,:,:),POINTER :: mask => NULL()
+    LOGICAL,DIMENSION(:,:),POINTER :: masksrc => NULL()
+    LOGICAL :: Interpolation,conservation,Pacifique,Extrapolation,land_level
+    !      
+    INTEGER :: deptht,time,i,status,ncid,t,ii,j,nb,numlon,numlat
+
+    !        
+    TYPE(Coordinates) :: G0,G1      
+    !
+    !*****************
+    !If coarse grid is masked possibility to activate an extrapolation process
+    !
+    Extrapolation = .FALSE.
+    PRINT*,'DEBUT INTERP_EXTRAP_VAR'
+    !
+    !*****************
+    !
+    ! check grid position
+    !
+    IF( PRESENT(cd_type) ) THEN
+       posvar = cd_type
+    ELSE
+       posvar = 'T'
+    ENDIF     
+
+    !
+    ! read dimensions in netcdf file
+    !
+    CALL Read_Ncdf_dim('x',filename,numlon)
+    CALL Read_Ncdf_dim('y',filename,numlat)
+    CALL Read_Ncdf_dim('time_counter',filename,time)
+    IF ( Dims_Existence( 'deptht' , filename ) ) THEN
+       CALL Read_Ncdf_dim('deptht',filename,deptht)
+    ELSE IF ( Dims_Existence( 'depthu' , filename ) ) THEN
+       CALL Read_Ncdf_dim('depthu',filename,deptht)
+    ELSE IF ( Dims_Existence( 'depthv' , filename ) ) THEN
+       CALL Read_Ncdf_dim('depthv',filename,deptht)
+    ELSE IF ( Dims_Existence( 'depthw' , filename ) ) THEN
+       CALL Read_Ncdf_dim('depthw',filename,deptht)
+    ELSE IF ( Dims_Existence( 'z' , filename ) ) THEN
+       CALL Read_Ncdf_dim('z',filename,deptht)
+    ELSE
+       deptht = N
+    ENDIF
+
+    !
+    ! retrieve netcdf variable name
+    !
+    CALL Read_Ncdf_VarName(filename,Ncdf_varname)
+    !
+    ! define name of child grid file
+    !
+    CALL set_child_name(filename,Child_file) 
+    CALL set_child_name(parent_coordinate_file,Childcoordinates)
+    CALL set_child_name(parent_meshmask_file,childbathy)
+    WRITE(*,*) 'Child grid file name = ',TRIM(Child_file)
+    !
+    ! create this file
+    !
+    status = nf90_create(Child_file,NF90_WRITE,ncid)
+    status = nf90_close(ncid)
+    !
+    ! read coordinates of both domains
+    !           
+    status = Read_Coordinates(parent_coordinate_file,G0)
+    status = Read_Coordinates(Childcoordinates,G1,Pacifique)
+    !
+    ! check consistency of informations read in namelist 
+    !      
+    IF( imax > SIZE(G0%glamt,1) .OR. jmax > SIZE(G0%glamt,2) .OR. &
+         imax <= imin .OR. jmax <= jmin ) THEN                    
+       WRITE(*,*) 'ERROR ***** bad child grid definition ...'
+       WRITE(*,*) 'please check imin,jmin,imax,jmax,jpizoom,jpjzoom values'       
+       WRITE(*,*) ' '
+       STOP
+    ENDIF
+    !
+    IF( SIZE(G1%nav_lon,1) .NE. nxfin .OR. SIZE(G1%nav_lon,2) .NE. nyfin ) THEN
+       WRITE(*,*) 'ERROR ***** bad child coordinates or bathy file ...'
+       WRITE(*,*) ' '
+       WRITE(*,*) 'please check that child coordinates file and child bathymetry file'
+       WRITE(*,*) 'has been created with the current namelist '
+       WRITE(*,*) ' '
+       STOP
+    ENDIF
+    !      
+
+    !
+    ! Initialization of T-mask thanks to bathymetry 
+    !
+    IF( Extrapolation ) THEN
+
+       WRITE(*,*) 'mask initialisation on coarse and fine grids'
+       ! 
+       ALLOCATE(mask(numlon,numlat,N))
+       CALL Init_mask(childbathy,G1,1,1)
+       CALL Init_mask(parent_meshmask_file,G0,1,1)
+       !
+    ENDIF
+
+    !      
+    ! select coordinates to use according to variable position
+    !
+    ALLOCATE(lonParent(numlon,numlat),latParent(numlon,numlat))
+    ALLOCATE(lonChild(nxfin,nyfin),latChild(nxfin,nyfin))
+
+    SELECT CASE(posvar)
+    CASE('T')
+       lonParent = G0%glamt
+       latParent = G0%gphit
+       lonChild  = G1%glamt
+       latChild  = G1%gphit
+       mask      = G1%tmask
+    CASE('U')
+       lonParent = G0%glamu
+       latParent = G0%gphiu
+       lonChild  = G1%glamu
+       latChild  = G1%gphiu
+       mask      = G1%umask
+    CASE('V')
+       lonParent = G0%glamv
+       latParent = G0%gphiv
+       lonChild  = G1%glamv
+       latChild  = G1%gphiv
+       mask      = G1%vmask
+    END SELECT
+
+    DEALLOCATE(G0%glamu,G0%glamv,G0%gphiu,G0%gphiv)
+    DEALLOCATE(G1%glamu,G1%glamv,G1%gphiu,G1%gphiv) 
+    DEALLOCATE(G1%glamt,G1%gphit,G0%glamt,G0%gphit)
+
+    !
+    !longitude modification if child domain covers Pacific ocean area
+    ! 
+    IF( lonChild(1,1) > lonChild(nxfin,nyfin) ) THEN
+       Pacifique = .TRUE.
+       WHERE( lonChild < 0 )
+          lonChild = lonChild + 360.
+       END WHERE
+       WHERE( lonParent < 0 )
+          lonParent = lonParent + 360.
+       END WHERE
+    ENDIF
+
+    !    
+    !
+    ! dimensions initialization      
+    !
+    CALL Write_Ncdf_dim('x',Child_file,nxfin)
+    CALL Write_Ncdf_dim('y',Child_file,nyfin)
+    IF ( Dims_Existence( 'deptht' , filename ) ) CALL Write_Ncdf_dim('deptht',Child_file,deptht)
+    IF ( Dims_Existence( 'depthu' , filename ) ) CALL Write_Ncdf_dim('depthu',Child_file,deptht)
+    IF ( Dims_Existence( 'depthv' , filename ) ) CALL Write_Ncdf_dim('depthv',Child_file,deptht)
+    IF ( Dims_Existence( 'depthw' , filename ) ) CALL Write_Ncdf_dim('depthw',Child_file,deptht)
+    IF ( Dims_Existence( 'z' , filename ) ) CALL Write_Ncdf_dim('z',Child_file,deptht)
+    CALL Write_Ncdf_dim('time_counter',Child_file,0)
+
+    IF( deptht .NE. 1 .AND. deptht .NE. N ) THEN
+       WRITE(*,*) '***'
+       WRITE(*,*) 'Number of vertical levels doesn t match between namelist'
+       WRITE(*,*) 'and forcing file ',TRIM(filename)
+       WRITE(*,*) 'Please check the values in namelist file'
+       WRITE(*,*) 'N = ',N
+       WRITE(*,*) 'deptht = ',deptht
+       STOP     
+    ENDIF
+    !
+    !
+    DO i = 1,SIZE(Ncdf_varname)
+       !      
+       !
+       ! ******************************LOOP ON VARIABLE NAMES*******************************************
+       !
+       !      
+       SELECT CASE (TRIM(Ncdf_varname(i)))
+          !
+          !copy nav_lon from child coordinates to output file      
+       CASE('nav_lon')   
+          ALLOCATE(latlon_temp(nxfin,nyfin))
+          CALL Read_Ncdf_var('nav_lon',TRIM(Childcoordinates),latlon_temp) 
+          CALL Write_Ncdf_var('nav_lon',(/'x','y'/),Child_file,latlon_temp,'float')
+          CALL Copy_Ncdf_att('nav_lon',TRIM(filename),Child_file, &
+               MINVAL(latlon_temp),MAXVAL(latlon_temp))
+          DEALLOCATE(latlon_temp)
+          varname = TRIM(Ncdf_varname(i))
+          Interpolation = .FALSE.
+          !	     
+          !copy nav_lat from child coordinates to output file
+       CASE('nav_lat')             
+          ALLOCATE(latlon_temp(nxfin,nyfin))
+          CALL Read_Ncdf_var('nav_lat',TRIM(Childcoordinates),latlon_temp) 
+          CALL Write_Ncdf_var('nav_lat',(/'x','y'/),Child_file,latlon_temp,'float')
+          CALL Copy_Ncdf_att('nav_lat',TRIM(filename),Child_file, &
+               MINVAL(latlon_temp),MAXVAL(latlon_temp)) 
+          DEALLOCATE(latlon_temp)
+          varname = TRIM(Ncdf_varname(i))
+          Interpolation = .FALSE.
+          !
+          !copy nav_lev from restart_file to output file
+          !
+       CASE('nav_lev')
+
+          WRITE(*,*) 'copy nav_lev'
+          CALL Read_Ncdf_var('nav_lev',filename,nav_lev) 
+          IF(.NOT. dimg ) THEN
+             CALL Write_Ncdf_var('nav_lev','z',Child_file,nav_lev,'float')
+             CALL Copy_Ncdf_att('nav_lev',filename,Child_file)      
+          ENDIF
+          DEALLOCATE(nav_lev)
+          Interpolation = .FALSE.
+          !	    	
+          !copy time_counter from input file to output file
+       CASE('time_counter')
+          ALLOCATE(timedepth_temp(time))
+          CALL Read_Ncdf_var('time_counter',filename,timedepth_temp) 
+          CALL Write_Ncdf_var('time_counter','time_counter',  &
+               Child_file,timedepth_temp,'float')
+          CALL Copy_Ncdf_att('time_counter',TRIM(filename),Child_file)
+          DEALLOCATE(timedepth_temp)
+          varname = TRIM(Ncdf_varname(i))
+          Interpolation = .FALSE.
+          !
+          !copy deptht from input file to output file
+       CASE('deptht')
+          ALLOCATE(depth(deptht))
+          CALL Read_Ncdf_var('deptht',filename,depth) 
+          CALL Write_Ncdf_var('deptht','deptht',Child_file,depth,'float')
+          CALL Copy_Ncdf_att('deptht',TRIM(filename),Child_file)
+          varname = TRIM(Ncdf_varname(i))
+          Interpolation = .FALSE.     
+          !
+          !copy depthu from input file to output file
+       CASE('depthu')
+          ALLOCATE(depth(deptht))
+          CALL Read_Ncdf_var('depthu',filename,depth) 
+          CALL Write_Ncdf_var('depthu','depthu',Child_file,depth,'float')
+          CALL Copy_Ncdf_att('depthu',TRIM(filename),Child_file)
+          varname = TRIM(Ncdf_varname(i))
+          Interpolation = .FALSE.     
+          !
+          !copy depthv from input file to output file
+       CASE('depthv')
+          ALLOCATE(depth(deptht))
+          CALL Read_Ncdf_var('depthv',filename,depth) 
+          CALL Write_Ncdf_var('depthv','depthv',Child_file,depth,'float')
+          CALL Copy_Ncdf_att('depthv',TRIM(filename),Child_file)
+          varname = TRIM(Ncdf_varname(i))
+          Interpolation = .FALSE.     
+          !
+          !copy depthv from input file to output file
+       CASE('depthw')
+          ALLOCATE(depth(deptht))
+          CALL Read_Ncdf_var('depthw',filename,depth) 
+          CALL Write_Ncdf_var('depthw','depthw',Child_file,depth,'float')
+          CALL Copy_Ncdf_att('depthw',TRIM(filename),Child_file)
+          varname = TRIM(Ncdf_varname(i))
+          Interpolation = .FALSE.     
+          !
+          !copy time_steps from input file in case of restget use in NEMO in/out routines
+       CASE('time_steps')
+          !         print *,'avant time step'
+
+          CALL Read_Ncdf_var('time_steps',filename,tabtemp1DInt) 
+          !		   print *,'timedeph = ',tabtemp1DInt
+          CALL Write_Ncdf_var('time_steps','time_counter',Child_file,tabtemp1DInt)
+          CALL Copy_Ncdf_att('time_steps',filename,Child_file) 
+          DEALLOCATE(tabtemp1DInt)
+          Interpolation = .FALSE.  
+          !  
+          !store tmask in output file
+       CASE('tmask')
+          dimnames(1)='x'
+          dimnames(2)='y'
+          dimnames(3)='deptht' 
+          IF (.NOT.ASSOCIATED(G1%tmask)) THEN
+             ALLOCATE(G1%tmask(nxfin,nyfin,deptht))
+             G1%tmask = 1
+          ENDIF
+          CALL Write_Ncdf_var('tmask',dimnames(1:3),Child_file,G1%tmask,'float')
+          varname = TRIM(Ncdf_varname(i))
+          Interpolation = .FALSE.     
+          !      
+       CASE default
+          varname = Ncdf_varname(i)
+          conservation = .FALSE.
+          CALL get_interptype( varname,interp_type,conservation )
+          WRITE(*,*) '**********************************************'
+          WRITE(*,*) 'varname      = ',TRIM(varname), 'at ', posvar, ' point'
+          WRITE(*,*) 'interp_type  = ',TRIM(interp_type)
+          WRITE(*,*) 'conservation = ',conservation
+          WRITE(*,*) '***********************************************'
+          Interpolation = .TRUE.
+          !	         
+       END SELECT
+
+       ! //////////////// INTERPOLATION FOR 3D VARIABLES /////////////////////////////////////
+       ! 
+       IF( Interpolation .AND. Get_NbDims(TRIM(varname),TRIM(filename)) == 3 ) THEN
+          !      
+          ALLOCATE(detected_pts(numlon,numlat,N))
+          ALLOCATE(masksrc(numlon,numlat))                                           
+          !
+          ! ******************************LOOP ON TIME*******************************************
+          !loop on time
+          DO t = 1,time
+             !                   
+             IF(extrapolation) THEN
+                WRITE(*,*) 'interpolation/extrapolation ',TRIM(varname),' for time t = ',t
+             ELSE
+                WRITE(*,*) 'interpolation ',TRIM(varname),' for time t = ',t
+             ENDIF
+             !                            
+             ALLOCATE(tabvar3d(numlon,numlat,1))      
+             ALLOCATE(tabinterp3d(nxfin,nyfin,1))
+             !                    
+             CALL Read_Ncdf_var(varname,filename,tabvar3d,t)                                              
+             !
+             ! search points where extrapolation is required
+             ! 
+             IF(Extrapolation) THEN
+                 WHERE( tabvar3d .GE. 1.e+20 ) tabvar3d = 0.
+                IF (t .EQ. 1. ) CALL extrap_detect(G0,G1,detected_pts(:,:,1),1)
+                CALL correct_field_2d(detected_pts(:,:,1),tabvar3d,G0,masksrc,'posvar')
+             ELSE
+                masksrc = .TRUE.
+             ENDIF
+
+             IF (t.EQ.1 ) THEN 
+
+                SELECT CASE(TRIM(interp_type))
+                CASE('bilinear')
+                   CALL get_remap_matrix(latParent,latChild,   &
+                        lonParent,lonChild,                    &
+                        masksrc,matrix,src_add,dst_add)
+
+                CASE('bicubic')
+                   CALL get_remap_bicub(latParent,latChild,   &
+                        lonParent,lonChild,   &
+                        masksrc,matrix,src_add,dst_add)
+
+                END SELECT
+                !                                                        
+             ENDIF
+             !      
+             SELECT CASE(TRIM(interp_type))
+             CASE('bilinear')                                                       
+                CALL make_remap(tabvar3d(:,:,1),tabinterp3d(:,:,1),nxfin,nyfin, &
+                     matrix,src_add,dst_add)     
+             CASE('bicubic')                                   
+                CALL make_bicubic_remap(tabvar3d(:,:,1),masksrc,tabinterp3d(:,:,1),nxfin,nyfin, &
+                     matrix,src_add,dst_add)                        
+             END SELECT
+             !                     
+             IF( conservation ) CALL Correctforconservation(tabvar3d(:,:,1),tabinterp3d(:,:,1), &
+                  G0%e1t,G0%e2t,G1%e1t,G1%e2t,nxfin,nyfin,posvar,imin,jmin)  
+             !      
+             IF(Extrapolation) tabinterp3d(:,:,1) = tabinterp3d(:,:,1) * mask(:,:,1)     
+             !                     
+             dimnames(1)='x'
+             dimnames(2)='y'
+             dimnames(3)='time_counter'
+             !                                     
+             CALL Write_Ncdf_var(TRIM(varname),dimnames(1:3),&
+                  Child_file,tabinterp3d,t,'float')
+             !      
+             DEALLOCATE(tabinterp3d)
+             DEALLOCATE(tabvar3d)                     
+             !end loop on time
+          END DO
+          !                   
+          DEALLOCATE(detected_pts)
+          IF(ASSOCIATED(matrix)) DEALLOCATE(matrix,dst_add,src_add)
+          DEALLOCATE( masksrc)
+
+          CALL Copy_Ncdf_att(TRIM(varname),TRIM(filename),Child_file)                        
+          !
+       ELSE IF( Interpolation .AND. Get_NbDims(TRIM(varname),TRIM(filename)) == 4 ) THEN
+          !
+          !
+          ! //////////////// INTERPOLATION FOR 4D VARIABLES /////////////////////////////////////
+          ! 
+          dimnames(1)='x'
+          dimnames(2)='y'
+          IF ( Dims_Existence( 'deptht' , filename ) ) dimnames(3)='deptht'  
+          IF ( Dims_Existence( 'depthu' , filename ) ) dimnames(3)='depthu'
+          IF ( Dims_Existence( 'depthv' , filename ) ) dimnames(3)='depthv'
+          IF ( Dims_Existence( 'depthw' , filename ) ) dimnames(3)='depthw'
+          IF ( Dims_Existence( 'z' , filename ) ) dimnames(3)='z'
+          dimnames(4)='time_counter'  
+          !
+          ! loop on vertical levels
+          ! 
+          DO nb = 1,deptht
+             !        
+             ALLOCATE(masksrc(numlon,numlat))
+             ALLOCATE(detected_pts(numlon,numlat,N))          
+             !
+             ! point detection et level n                                     
+             !
+             land_level = .FALSE.
+             IF( Extrapolation ) THEN
+                IF(MAXVAL(mask(:,:,nb))==0.) land_level = .TRUE.
+             ENDIF
+
+
+             IF ( land_level ) THEN
+                !
+                WRITE(*,*) 'only land points on level ',nb
+                ALLOCATE(tabinterp4d(nxfin,nyfin,1,1)) 
+                tabinterp4d = 0.e0
+                !                              
+                DO ii = 1,time
+                   CALL Write_Ncdf_var(TRIM(varname),dimnames, &
+                        Child_file,tabinterp4d,ii,nb,'float')
+                END DO
+                DEALLOCATE(tabinterp4d)
+                !
+             ELSE
+                !                       
+                ! loop on time                       
+                !
+                DO t = 1,time
+                   !                   
+                   ALLOCATE(tabvar1(numlon,numlat,1,1))    ! level k
+                   IF(Extrapolation) ALLOCATE(tabvar2(numlon,numlat,1,1))    ! level k-1
+                   IF(Extrapolation) ALLOCATE(tabvar3(numlon,numlat,1,1))    ! level k-2                       
+                   ALLOCATE(tabinterp4d(nxfin,nyfin,1,1)) 
+                   !
+                   IF(Extrapolation) THEN                                  
+                      IF(nb==1) THEN
+                         CALL Read_Ncdf_var(varname,filename,tabvar1,t,nb)    
+                         WHERE( tabvar1 .GE. 1.e+20 ) tabvar1 = 0.
+                      ELSE IF (nb==2) THEN
+                         CALL Read_Ncdf_var(varname,filename,tabvar2,t,nb-1)
+                         CALL Read_Ncdf_var(varname,filename,tabvar1,t,nb)            
+                         WHERE( tabvar1 .GE. 1.e+20 ) tabvar1 = 0.
+                         WHERE( tabvar2 .GE. 1.e+20 ) tabvar2 = 0.
+                      ELSE 
+                         CALL Read_Ncdf_var(varname,filename,tabvar3,t,nb-2)
+                         CALL Read_Ncdf_var(varname,filename,tabvar2,t,nb-1)
+                         CALL Read_Ncdf_var(varname,filename,tabvar1,t,nb)
+                         WHERE( tabvar1 .GE. 1.e+20 ) tabvar1 = 0.
+                         WHERE( tabvar2 .GE. 1.e+20 ) tabvar2 = 0.
+                         WHERE( tabvar3 .GE. 1.e+20 ) tabvar3 = 0.
+                      ENDIF
+                      !                              
+                      IF (t.EQ.1 ) CALL extrap_detect(G0,G1,detected_pts(:,:,nb),nb)
+
+                      CALL correct_field(detected_pts(:,:,nb),tabvar1,tabvar2,&
+                           tabvar3,G0,depth,masksrc,nb,'posvar')                       
+                      DEALLOCATE(tabvar2,tabvar3)
+
+                   ELSE 
+                      CALL Read_Ncdf_var(varname,filename,tabvar1,t,nb)
+                      IF(MAXVAL(tabvar1(:,:,1,1))==0.) land_level = .TRUE.
+                      masksrc = .TRUE. 
+                   ENDIF
+
+                   IF( Extrapolation ) THEN
+                      WRITE(*,*) 'interpolation/extrapolation ',TRIM(varname),' for time t = ',t,'vertical level = ',nb   
+                   ELSE
+                      WRITE(*,*) 'interpolation ',TRIM(varname),' for time t = ',t,'vertical level = ',nb
+                   ENDIF
+
+                   !                          
+
+                   IF (t.EQ.1 ) THEN 
+
+                      SELECT CASE(TRIM(interp_type))
+                      CASE('bilinear')
+                         CALL get_remap_matrix(latParent,latChild,   &
+                              lonParent,lonChild,   &
+                              masksrc,matrix,src_add,dst_add)
+
+                      CASE('bicubic')
+                         CALL get_remap_bicub(latParent,latChild,   &
+                              lonParent,lonChild,   &
+                              masksrc,matrix,src_add,dst_add)
+                         !                             
+                      END SELECT
+                      !                                                        
+                   ENDIF
+                   !      
+                   SELECT CASE(TRIM(interp_type))
+                      !                             
+                   CASE('bilinear')                                                       
+                      CALL make_remap(tabvar1(:,:,1,1),tabinterp4d(:,:,1,1),nxfin,nyfin, &
+                           matrix,src_add,dst_add)     
+                   CASE('bicubic')                                   
+                      CALL make_bicubic_remap(tabvar1(:,:,1,1),masksrc,tabinterp4d(:,:,1,1),nxfin,nyfin, &
+                           matrix,src_add,dst_add)                        
+                   END SELECT
+                   !                     
+                   IF( conservation ) CALL Correctforconservation(tabvar1(:,:,1,1),tabinterp4d(:,:,1,1), &
+                        G0%e1t,G0%e2t,G1%e1t,G1%e2t,nxfin,nyfin,posvar,imin,jmin)  
+
+                   !
+                   IF(Extrapolation) CALL check_extrap(G1,tabinterp4d,nb)
+                   !      
+                   IF(Extrapolation) tabinterp4d(:,:,1,1) = tabinterp4d(:,:,1,1) * mask(:,:,nb)     
+                   !                     
+                   CALL Write_Ncdf_var(TRIM(varname),dimnames, &
+                        Child_file,tabinterp4d,t,nb,'float')
+                   !      
+                   DEALLOCATE(tabinterp4d)
+                   DEALLOCATE(tabvar1)                     
+                   !
+                   ! end loop on time
+                   !
+
+                END DO
+
+             ENDIF
+
+             !
+             IF(ASSOCIATED(matrix)) DEALLOCATE(matrix,dst_add,src_add)
+             DEALLOCATE( masksrc )
+             DEALLOCATE(detected_pts)       
+             !
+             ! end loop on vertical levels
+             !      
+          END DO
+          !   
+          CALL Copy_Ncdf_att(TRIM(varname),TRIM(filename),Child_file)
+          !
+          ! fin du if interpolation ...
+          !
+       ENDIF
+       ! 
+    END DO
+
+    PRINT *,'FIN DE INTERPEXTRAPVAR'
+    !    
+    IF(Extrapolation) DEALLOCATE(G1%tmask,G0%tmask)
+    DEALLOCATE(G0%e1t,G0%e2t,G1%e1t,G1%e2t)
+    IF(ASSOCIATED(depth)) DEALLOCATE(depth)   
+    !
+  END SUBROUTINE Interp_Extrap_var
+  !
+  !**************************************************************
+  !   end subroutine Interp_var
+  !**************************************************************          
+  ! 
+END MODULE agrif_interpolation
Index: trunk/NEMOGCM/TOOLS/NESTING/src/agrif_modutil.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/NESTING/src/agrif_modutil.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/NESTING/src/agrif_modutil.f90	(revision 2528)
@@ -0,0 +1,439 @@
+!
+MODULE agrif_modutil
+  !
+CONTAINS
+  !
+  !************************************************************************
+  ! 									*
+  ! MODULE  AGRIF_MODUTIL							*
+  !									*
+  ! module containing subroutine used for : 				*
+  !   - unrolling 2D arrays to 1D arrays (required for SCRIP package use)	*
+  !   - convert 1D arrays to 2D arrays (required for SCRIP package use)	*
+  !   - remapping process (use SCRIP remapping matrix)			*
+  !									*
+  !************************************************************************
+  ! 
+  !***********************************************************    
+  SUBROUTINE ssort (x, nb)
+    !***********************************************************
+    !
+    IMPLICIT NONE
+
+    INTEGER :: nb
+    REAL*8, DIMENSION(:) :: x
+    REAL*8 :: temp
+    INTEGER ji,jj,jmax,itemp
+    !      
+    jmax=nb-1
+    !
+    !
+    DO ji=1,nb-1
+       temp=HUGE(1)
+
+       DO jj=1,jmax
+
+          IF(X(jj).LE.X(jj+1)) THEN 
+             temp=X(jj)
+             X(jj)=X(jj+1)
+             X(jj+1)=temp
+          ENDIF
+
+       ENDDO
+
+       IF(temp.EQ.HUGE(1)) RETURN
+       jmax=jmax-1
+    ENDDO
+
+    RETURN
+  END SUBROUTINE ssort
+  !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !************************************************************************
+  !   SUBROUTINE 1Dto2D
+  !************************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE tab1Dto2D(tab1D,tab2D,nx,ny)
+    !
+    IMPLICIT NONE   
+    !
+    REAL*8,DIMENSION(:) :: tab1D
+    REAL*8,DIMENSION(:,:) :: tab2D
+    !          
+    INTEGER :: xpos,ypos
+    INTEGER :: nx,ny   
+    INTEGER :: i      
+    !      
+    xpos=0
+    ypos=1
+    !      
+    DO i=1,nx*ny
+       xpos=xpos+1
+       IF(xpos.GT.nx) THEN
+          xpos=1
+          ypos=ypos+1
+       ENDIF
+       tab2D(ypos,xpos)=tab1D(i)
+    END DO
+    !
+  END SUBROUTINE tab1Dto2D
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !************************************************************************
+  !   SUBROUTINE tab2Dto1D
+  !************************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE tab2Dto1D(tab2D,tab1D)
+    !
+    IMPLICIT NONE 
+    !       
+    REAL*8,DIMENSION(:,:) :: tab2D
+    REAL*8,DIMENSION(:) :: tab1D
+    !          
+    INTEGER :: xpos,ypos
+    INTEGER :: nx,ny
+    INTEGER :: i
+    !
+    nx = SIZE(tab2D,2)
+    ny = SIZE(tab2D,1)
+    !      
+    xpos = 0
+    ypos = 1
+    DO i = 1,nx*ny
+       xpos = xpos + 1
+       IF(xpos.GT.nx) THEN
+          xpos = 1
+          ypos = ypos + 1
+       END IF
+       tab1D(i) = tab2D(ypos,xpos)
+    END DO
+    !
+  END SUBROUTINE tab2Dto1D
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !************************************************************************
+  !   SUBROUTINE tab2Dto1D logical
+  !************************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE logtab2Dto1D(tab2D,tab1D)
+    !
+    IMPLICIT NONE 
+    !       
+    LOGICAL,DIMENSION(:,:) :: tab2D
+    LOGICAL,DIMENSION(:) :: tab1D
+    !          
+    INTEGER :: xpos,ypos
+    INTEGER :: nx,ny
+    INTEGER :: i
+    !
+    nx = SIZE(tab2D,2)
+    ny = SIZE(tab2D,1)
+    !      
+    xpos = 0
+    ypos = 1
+    DO i = 1,nx*ny
+       xpos = xpos + 1
+       IF(xpos.GT.nx) THEN
+          xpos = 1
+          ypos = ypos + 1
+       END IF
+       tab1D(i) = tab2D(ypos,xpos)
+    END DO
+    !
+  END SUBROUTINE logtab2Dto1D
+  !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !************************************************************************
+  !   SUBROUTINE 1Dto2D
+  !************************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE logtab1Dto2D(tab1D,tab2D,nx,ny)
+    !
+    IMPLICIT NONE   
+    !
+    LOGICAL,DIMENSION(:) :: tab1D
+    LOGICAL,DIMENSION(:,:) :: tab2D
+    !          
+    INTEGER :: xpos,ypos
+    INTEGER :: nx,ny   
+    INTEGER :: i      
+    !      
+    xpos=0
+    ypos=1
+    !      
+    DO i=1,nx*ny
+       xpos=xpos+1
+       IF(xpos.GT.nx) THEN
+          xpos=1
+          ypos=ypos+1
+       ENDIF
+       tab2D(ypos,xpos)=tab1D(i)
+    END DO
+    !
+  END SUBROUTINE logtab1Dto2D
+
+  !**************************************************************
+  !   subroutine make_remap
+  !**************************************************************            
+  !
+  SUBROUTINE make_remap(tabin,tabout,nxfin,nyfin,matrix,src_add,dst_add) 
+    !      
+    IMPLICIT NONE
+    !      
+    REAL*8, DIMENSION(:,:)  :: tabin 
+    REAL*8, DIMENSION(:,:) :: tabout 
+    REAL*8, POINTER, DIMENSION(:,:) :: tabtemp    
+    INTEGER,DIMENSION(:) :: src_add,dst_add
+    INTEGER :: nxfin,nyfin      
+    REAL*8, POINTER, DIMENSION(:) :: var1D,var_interp1D
+    REAL*8,DIMENSION(:,:) :: matrix 
+    INTEGER :: num_links,i
+    ! 
+    ALLOCATE(var1D(SIZE(tabin,1)*SIZE(tabin,2)))     
+    CALL tab2Dto1D(tabin,var1D)
+    !      
+    ALLOCATE(var_interp1D(nxfin*nyfin))
+    var_interp1D = 0.0
+    num_links = SIZE(dst_add)
+    !
+    DO i = 1,num_links
+       var_interp1D(dst_add(i)) = var_interp1D(dst_add(i)) &
+            + matrix(1,i)*var1D(src_add(i))
+    END DO
+    !
+    ALLOCATE(tabtemp(SIZE(tabout,1),SIZE(tabout,2)))
+    !
+    CALL tab1Dto2D(var_interp1D,tabtemp,nyfin,nxfin)
+    !
+    tabout = tabtemp
+    !
+    DEALLOCATE(var_interp1D,var1D,tabtemp)  
+    ! 
+  END SUBROUTINE make_remap
+  !          
+  !
+  !**************************************************************
+  !   end subroutine make_remap
+  !**************************************************************          
+  !
+  !
+  !**************************************************************
+  !   subroutine make_bicubic_remap
+  !**************************************************************            
+  !
+  SUBROUTINE make_bicubic_remap(tabin,masksrc,tabout,nxfin,nyfin,matrix,src_add,dst_add) 
+    !      
+    IMPLICIT NONE
+    !      
+    REAL*8, DIMENSION(:,:)  :: tabin
+    LOGICAL, DIMENSION(:,:)  :: masksrc
+    LOGICAL, POINTER, DIMENSION(:)  :: grid1_mask
+    REAL*8, DIMENSION(:,:) :: tabout     
+    INTEGER,DIMENSION(:) :: src_add,dst_add
+    INTEGER :: nxfin,nyfin      
+    REAL*8, POINTER, DIMENSION(:) :: var1D,var_interp1D,gradi,gradj,gradij,deriv1,deriv2
+    REAL*8,DIMENSION(:,:) :: matrix 
+    INTEGER :: num_links,i,j,nx,ny,n,ip1,im1,jp1,jm1
+    INTEGER :: in,is,ie,iw,ine,inw,ise,isw
+    REAL*8 :: delew,delns
+    !
+    nx = SIZE(tabin,1)
+    ny = SIZE(tabin,2)
+    ALLOCATE(gradi(nx*ny),gradj(nx*ny),gradij(nx*ny),deriv1(nx*ny),deriv2(nx*ny))
+    ALLOCATE(var1D(nx*ny),grid1_mask(nx*ny))
+    !           
+    CALL tab2Dto1D(tabin,var1D)
+    CALL logtab2Dto1D(masksrc,grid1_mask)     
+    !
+    gradi  = 0.0
+    gradj  = 0.0
+    gradij = 0.0
+    !
+    DO n = 1,nx*ny
+
+       IF( grid1_mask(n) ) THEN                        
+          !                     
+          delew = 0.5      
+          delns = 0.5
+
+          j = (n-1)/ny + 1
+          i = n - (j-1)*ny
+          !
+          ip1 = i+1
+          im1 = i-1
+          jp1 = j+1
+          jm1 = j-1      
+          !
+          IF (ip1 > ny) ip1 = ip1 - ny
+
+          IF (im1 < 1 ) im1 = ny
+
+          IF (jp1 > nx) THEN
+             jp1 = j
+             delns = 1.
+          ENDIF
+
+          IF (jm1 < 1 ) THEN
+             jm1 = j
+             delns = 1.
+          ENDIF
+          !
+          in  = (jp1-1)*ny + i
+          is  = (jm1-1)*ny + i
+          ie  = (j  -1)*ny + ip1
+          iw  = (j  -1)*ny + im1
+          !
+          ine = (jp1-1)*ny + ip1
+          inw = (jp1-1)*ny + im1
+          ise = (jm1-1)*ny + ip1
+          isw = (jm1-1)*ny + im1
+          !
+          !*** compute i-gradient
+
+          IF (.NOT. grid1_mask(ie)) THEN
+             ie = n
+             delew = 1.
+          ENDIF
+          !            
+          IF (.NOT. grid1_mask(iw)) THEN
+             iw = n
+             delew = 1.
+          ENDIF
+          !
+          gradi(n) = delew*(var1D(ie) - var1D(iw))
+          !
+          !*** compute j-gradient
+
+          IF (.NOT. grid1_mask(in)) THEN
+             in = n
+             delns = 1.
+          ENDIF
+          !                      
+          IF (.NOT. grid1_mask(is)) THEN
+             is = n
+             delns = 1.
+          ENDIF
+          !
+          gradj(n) = delns*(var1D(in) - var1D(is))                    
+          !
+          !*** compute ij-gradient
+
+          delew = 0.5
+
+          IF (jp1 == j .OR. jm1 == j) THEN
+             delns = 1.
+          ELSE 
+             delns = 0.5
+          ENDIF
+          !
+          IF (.NOT. grid1_mask(ine)) THEN
+             IF (in /= n) THEN
+                ine = in
+                delew = 1.
+             ELSE IF (ie /= n) THEN
+                ine = ie
+                inw = iw
+                IF (inw == n) delew = 1.
+                delns = 1.
+             ELSE
+                ine = n
+                inw = iw
+                delew = 1
+                delns = 1
+             ENDIF
+          ENDIF
+          !
+          IF (.NOT. grid1_mask(inw)) THEN
+             IF (in /= n) THEN
+                inw = in
+                delew = 1.
+             ELSE IF (iw /= n) THEN
+                inw = iw
+                ine = ie
+                IF (ie == n) delew = 1.
+                delns = 1.
+             ELSE
+                inw = n
+                ine = ie
+                delew = 1.
+                delns = 1.
+             ENDIF
+          ENDIF
+          !
+          deriv1(n) = delew*(var1D(ine)-var1D(inw))                    
+          !
+          IF (.NOT. grid1_mask(ise)) THEN
+             IF (is /= n) THEN
+                ise = is
+                delew = 1.
+             ELSE IF (ie /= n) THEN
+                ise = ie
+                isw = iw
+                IF (isw == n) delew = 1.
+                delns = 1.
+             ELSE
+                ise = n
+                isw = iw
+                delew = 1.
+                delns = 1.
+             ENDIF
+          ENDIF
+          !
+          IF (.NOT. grid1_mask(isw)) THEN
+             IF (is /= n) THEN
+                isw = is
+                delew = 1.
+             ELSE IF (iw /= n) THEN
+                isw = iw
+                ise = ie
+                IF (ie == n) delew = 1.
+                delns = 1.
+             ELSE
+                isw = n
+                ise = ie
+                delew = 1.
+                delns = 1.
+             ENDIF
+          ENDIF
+
+          deriv2(n) = delew*(var1D(ise) - var1D(isw))
+          gradij(n) = delns*(deriv1(n) - deriv2(n))
+       ENDIF
+    END DO
+    !
+    DEALLOCATE(deriv1,deriv2,grid1_mask)
+
+    !       
+    ALLOCATE(var_interp1D(nxfin*nyfin))
+    var_interp1D = 0.0
+    num_links = SIZE(dst_add)
+    !      
+    DO i = 1,num_links
+       !        
+       var_interp1D(dst_add(i)) = var_interp1D(dst_add(i))        +      &
+            matrix(1,i)*var1D(src_add(i))   +      &
+            matrix(2,i)*gradi(src_add(i))   +      &
+            matrix(3,i)*gradj(src_add(i))   +      & 
+            matrix(4,i)*gradij(src_add(i))
+    END DO
+    !
+    DEALLOCATE(gradi,gradj,gradij,var1D)
+    !
+    CALL tab1Dto2D(var_interp1D,tabout,nyfin,nxfin)
+    !      
+    DEALLOCATE(var_interp1D)       
+    ! 
+  END SUBROUTINE make_bicubic_remap
+  !          
+  !
+  !**************************************************************
+  !   end subroutine make_bicubic_remap
+  !**************************************************************          
+  !
+  !
+END MODULE agrif_modutil
Index: trunk/NEMOGCM/TOOLS/NESTING/src/agrif_partial_steps.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/NESTING/src/agrif_partial_steps.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/NESTING/src/agrif_partial_steps.f90	(revision 2528)
@@ -0,0 +1,763 @@
+!************************************************************************
+! Fortran 95 OPA Nesting tools                                    	*
+!                                                      			*
+!     Copyright (C) 2005 Florian Lemarié (Florian.Lemarie@imag.fr)      *
+!                        Laurent Debreu (Laurent.Debreu@imag.fr)      	*
+!************************************************************************
+!
+MODULE agrif_partial_steps
+  !
+  USE agrif_types
+CONTAINS
+
+
+
+
+
+  !
+  !************************************************************************
+  !                                                       		*
+  ! MODULE  AGRIF_PARTIAL_STEPS                                    	*
+  !									*
+  !************************************************************************
+
+
+  !************************************************************************
+  !									*
+  ! Subroutine get_partial_steps						*
+  !									*
+  ! subroutine to compute gdepw_ps on the input grid (based on NEMO code) *
+  !                                                      			*
+  !************************************************************************
+  !       
+  SUBROUTINE get_partial_steps(Grid)
+    !
+    IMPLICIT NONE
+    !       
+    TYPE(Coordinates) :: Grid                     
+    REAL*8 :: za1,za0,zsur,zacr,zkth,zdepth,zdepwp,zmin,zmax,zdiff,ze3tp,ze3wp
+    INTEGER :: i,j,jk,jj,ji,jpj,jpi,ik,ii,ipt,jpt
+    INTEGER, DIMENSION(1) :: k
+    INTEGER :: k1
+    REAL*8, POINTER, DIMENSION(:) :: gdepw,gdept,e3w,e3t
+    REAL*8, POINTER, DIMENSION(:,:)   :: hdepw,e3tp,e3wp
+    REAL*8, POINTER, DIMENSION(:,:,:) :: gdept_ps,gdepw_ps
+    REAL*8 e3t_ps
+
+    !
+    WRITE(*,*) 'convert bathymetry from etopo for partial step z-coordinate case'
+    WRITE(*,*) 'minimum thickness of partial step   e3zps_min = ', e3zps_min, ' (m)'
+    WRITE(*,*) '       step  level                  e3zps_rat = ', e3zps_rat       
+    !       
+    jpi = SIZE(Grid%bathy_meter,1)
+    jpj = SIZE(Grid%bathy_meter,2)       
+    !       
+    ALLOCATE(gdepw(N),gdept(N),e3w(N),e3t(N))
+    ALLOCATE(gdepw_ps(jpi,jpj,N))                  
+    IF (.NOT.ASSOCIATED(Grid%bathy_level)) ALLOCATE(Grid%bathy_level(jpi,jpj))
+    !       
+    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) &
+            *  (  LOG( COSH( (N - ppkth) / ppacr) )      &
+            - LOG( COSH( ( 1  - ppkth) / ppacr) )  )  )
+
+       za0  = ppdzmin - za1 * TANH( (1-ppkth) / ppacr )
+       zsur = - za0 - za1 * ppacr * LOG( COSH( (1-ppkth) / ppacr )  )
+       !
+    ELSE IF ( (ppdzmin == 0 .OR. pphmax == 0) .AND. psur.NE.0 .AND. &
+         pa0.NE.0 .AND. pa1.NE.0 ) THEN
+       !       
+       WRITE(*,*) 'psur,pa0,pa1 given by namelist'
+       zsur = psur
+       za0  = pa0
+       za1  = pa1
+       !
+    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       
+    !
+    DO i = 1,N
+       ! 
+       gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 
+       gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr)))
+       e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr))
+       e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))
+       !
+    END DO
+    !
+
+    gdepw(1) = 0.0  
+    !
+    ! Initialization of constant
+    !
+    zmax = gdepw(N) + e3t(N)
+    zmin = gdepw(4)
+    !
+    ! Initialize bathy_level to the maximum ocean level available
+    !
+    Grid%bathy_level = N-1
+    !
+    ! storage of land and island's number (zera and negative values) in mbathy
+    !
+    DO jj = 1, jpj
+       DO ji= 1, jpi
+          IF( Grid%bathy_meter(ji,jj) <= 0. )   &
+               Grid%bathy_level(ji,jj) = INT( Grid%bathy_meter(ji,jj) )
+       END DO
+    END DO
+    !
+    ! the last ocean level thickness cannot exceed e3t(jpkm1)+e3t(jpk)
+    !
+    DO jj = 1, jpj
+       DO ji= 1, jpi
+          IF( Grid%bathy_meter(ji,jj) <= 0. ) THEN
+             Grid%bathy_meter(ji,jj) = 0.e0
+          ELSE
+             Grid%bathy_meter(ji,jj) = MAX( Grid%bathy_meter(ji,jj), zmin )
+             Grid%bathy_meter(ji,jj) = MIN( Grid%bathy_meter(ji,jj), zmax )
+          ENDIF
+       END DO
+    END DO
+    !
+    ! Compute bathy_level 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 (where
+    ! e3t is the reference level thickness   
+    !     
+    DO jk = N-1, 1, -1
+       zdepth = gdepw(jk) + MIN( e3zps_min, e3t(jk)*e3zps_rat )
+       DO jj = 1, jpj
+          DO ji = 1, jpi
+             IF( 0. < Grid%bathy_meter(ji,jj) .AND. Grid%bathy_meter(ji,jj) <= zdepth ) &
+                  Grid%bathy_level(ji,jj) = jk-1
+          END DO
+       END DO
+    END DO
+
+
+    CALL bathymetry_control(grid%bathy_level)
+    !
+    ! initialization to the reference z-coordinate
+    ! 
+    WRITE(*,*) ' initialization to the reference z-coordinate '
+    !     
+    DO jk = 1, N
+       !        Write(*,*) 'k = ',jk
+       gdepw_ps(1:jpi,1:jpj,jk) = gdepw(jk)
+    END DO
+    !      
+    Grid%gdepw_ps(:,:) = gdepw_ps(:,:,3)           
+    !
+    DO jj = 1, jpj
+       DO ji = 1, jpi
+          ik = Grid%bathy_level(ji,jj)
+          ! ocean point only
+          IF( ik > 0 ) THEN
+             ! max ocean level case
+             IF( ik == N-1 ) THEN
+                zdepwp = Grid%bathy_meter(ji,jj)
+                ze3tp  = Grid%bathy_meter(ji,jj) - gdepw(ik)
+                ze3wp = 0.5 * e3w(ik) * ( 1. + ( ze3tp/e3t(ik) ) )
+                gdepw_ps(ji,jj,ik+1) = zdepwp
+                ! standard case
+             ELSE
+                !
+                IF( Grid%bathy_meter(ji,jj) <= gdepw(ik+1) ) THEN
+                   gdepw_ps(ji,jj,ik+1) = Grid%bathy_meter(ji,jj)
+                ELSE
+                   !
+                   gdepw_ps(ji,jj,ik+1) = gdepw(ik+1)
+                ENDIF
+                !
+             ENDIF
+             !           
+          ENDIF
+       END DO
+    END DO
+    !
+    DO jj = 1, jpj
+       DO ji = 1, jpi
+          ik = Grid%bathy_level(ji,jj)
+          ! ocean point only
+          IF( ik > 0 ) THEN
+             ! bathymetry output
+             !
+             Grid%gdepw_ps(ji,jj) = gdepw_ps(ji,jj,ik+1)
+             !
+             !AJOUT-----------------------------------------------------------------------
+             !
+          ELSE
+             !           
+             Grid%gdepw_ps(ji,jj) = 0
+             !
+             !AJOUT------------------------------------------------------------------------
+             !           
+          ENDIF
+          !                     
+       END DO
+    END DO
+    !     
+    !
+    DEALLOCATE(gdepw,gdept,e3w,e3t)
+    DEALLOCATE(gdepw_ps)                  
+  END SUBROUTINE get_partial_steps
+  !
+  !
+  !*************************************************************************
+  !									*
+  ! Subroutine check interp						*
+  !									*
+  ! subroutine to compute gdepw_ps on the input grid (based on NEMO code) *
+  !                                                      			*
+  !************************************************************************
+  !
+  !
+  SUBROUTINE check_interp( ParentGrid , gdepwChild )
+    !
+    IMPLICIT NONE
+    !                   
+    TYPE(Coordinates) :: ParentGrid
+    REAL*8,DIMENSION(:,:) :: gdepwChild 
+    INTEGER :: i,j,ji,ij,ii,jj,jpt,ipt
+    REAL,DIMENSION(N) :: gdepw,e3t
+    REAL :: za0,za1,zsur,zacr,zkth,zmin,zmax,zdepth
+    INTEGER :: kbathy,jk,diff
+    INTEGER :: bornex,borney,bornex2,borney2
+    !       
+    IF ( ( pa0 == 0 .OR. pa1 == 0 .OR. psur == 0 ) &
+         .AND. ppdzmin.NE.0 .AND. pphmax.NE.0 ) THEN 
+       !    
+       za1=( ppdzmin - pphmax / (N-1) )          &
+            / ( TANH((1-ppkth)/ppacr) - ppacr/(N-1) &
+            *  (  LOG( COSH( (N - ppkth) / ppacr) )      &
+            - LOG( COSH( ( 1  - ppkth) / ppacr) )  )  )
+
+       za0  = ppdzmin - za1 * TANH( (1-ppkth) / ppacr )
+       zsur = - za0 - za1 * ppacr * LOG( COSH( (1-ppkth) / ppacr )  )
+       !
+    ELSE IF ( (ppdzmin == 0 .OR. pphmax == 0) .AND. psur.NE.0 .AND. &
+         pa0.NE.0 .AND. pa1.NE.0 ) THEN
+       !       
+       zsur = psur
+       za0  = pa0
+       za1  = pa1
+       !
+    ELSE
+       !       
+       WRITE(*,*) 'ERROR ***** bad vertical grid parameters ...' 
+       WRITE(*,*) ' '
+       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
+    !
+    gdepw(1) = 0.0
+    !
+    !
+    diff = 0      
+    IF ( MOD(irafx,2) .EQ. 0 ) diff = 1
+    !       
+    bornex = nbghostcellsfine + CEILING(irafx/2.0) + diff - irafx
+    borney = nbghostcellsfine + CEILING(irafy/2.0) + diff - irafy
+    bornex2 = nxfin - (nbghostcellsfine-1) - irafx - CEILING(irafx/2.0) 
+    borney2 = nyfin - (nbghostcellsfine-1) - irafy - CEILING(irafy/2.0)                      
+    !
+    !
+    ! west boundary
+    !
+
+    CALL correct_level( gdepwchild,ParentGrid,gdepw,e3t,1,3+connectionsize*irafx-1, &
+         1,nyfin)
+
+    !
+    ! east boundary
+    !
+
+    CALL correct_level( gdepwchild,ParentGrid,gdepw,e3t,nxfin-2-(connectionsize*irafx-1),nxfin, &
+         1,nyfin)
+
+    !
+    ! north boundary
+    !
+
+    CALL correct_level( gdepwchild,ParentGrid,gdepw,e3t,1,nxfin, &
+         nyfin-2-(connectionsize*irafy-1),nyfin )
+
+    !
+    ! south boundary
+    !
+    CALL correct_level( gdepwchild,ParentGrid,gdepw,e3t,1,nxfin, &
+         1,3+connectionsize*irafy-1 )
+
+    !       
+    !
+    !
+  END SUBROUTINE check_interp
+  !
+  SUBROUTINE correct_level( gdepwchild,ParentGrid,gdepw,e3t,minboundx,maxboundx,minboundy,maxboundy )
+    !
+    IMPLICIT NONE
+    TYPE(Coordinates) :: ParentGrid
+    REAL*8,DIMENSION(:,:) :: gdepwChild
+    REAL*8,DIMENSION(N) :: gdepw,e3t
+    INTEGER :: minboundx,maxboundx,minboundy,maxboundy
+    INTEGER :: kbathy,jk,indx,indy,diff
+    REAL :: xdiff
+    INTEGER :: i,j,ji,ij,ii,jj,jpt,ipt
+    REAL*8 :: slopex, slopey,val,tmp1,tmp2,tmp3,tmp4
+    INTEGER :: parentbathy
+    REAL :: mindepth, maxdepth
+    REAL :: xmin,ymin,dxfin,dyfin,dsparent
+    INTEGER ipbegin,ipend,jpbegin,jpend
+    INTEGER ibegin,iend,jbegin,jend
+    REAL x,y,zmin,zmax
+    INTEGER ptx,pty
+    REAL,DIMENSION(:,:),ALLOCATABLE :: gdepwtemp
+    INTEGER,DIMENSION(:,:),ALLOCATABLE :: parentbathytab
+    !
+    !
+    ! Initialization of constant
+    !
+    zmax = gdepw(N) + e3t(N)
+    zmin = gdepw(4) 
+    !
+    ! check that interpolated value stays at the same level         
+    ! 
+    !
+    diff = 0      
+    IF ( MOD(irafx,2) .EQ. 0 ) diff = 1
+
+    xdiff = REAL(diff)/2.
+
+    dxfin = 1./irafx
+    dyfin = 1./irafy
+
+    ptx = 3
+    pty = 3
+
+    xmin = (imin-1) * 1
+    ymin = (jmin-1) * 1
+
+
+    ! compute x and y the locations of the indices minbounx and minboundy 
+
+    x = xmin + (minboundx-ptx)*dxfin  + dxfin/2.
+    y = ymin + (minboundy-pty)*dyfin  + dyfin/2.
+
+    ! compute the indices of the nearest coarse grid points      
+    ipbegin = ptx + agrif_int((x-0.-1./2.) / 1.) - 1
+    jpbegin = pty + agrif_int((y-0.-1./2.) / 1.) - 1
+
+    ! compute indices of the fine grid points nearest to the preceeding coarse grid points       
+    ! (inferior values)
+
+    x = (ipbegin - ptx) + 1./2.
+    y = (jpbegin - pty) + 1./2.
+
+    ibegin = ptx + agrif_int((x-xmin-dxfin/2.)/dxfin) 
+    jbegin = pty + agrif_int((y-ymin-dyfin/2.)/dyfin) 
+
+    ! compute x and y the locations of the indices maxbounx and maxboundy        
+    x = xmin + (maxboundx-ptx)*dxfin + dxfin/2.
+    y = ymin + (maxboundy-pty)*dyfin + dyfin/2.
+
+    ! compute the indices of the nearest coarse grid points         
+    ipend = ptx + CEILING((x-0.-1./2) / 1.) + 1
+    jpend = pty + CEILING((y-0.-1./2) / 1.) + 1
+
+    ! compute indices of the fine grid points nearest to the preceeding coarse grid points       
+    ! (inferior values)
+
+    x = (ipend - ptx) + 1./2.
+    y = (jpend - pty) + 1./2.
+    iend = ptx + agrif_int((x-xmin-dxfin/2.)/dxfin) 
+    jend = pty + agrif_int((y-ymin-dyfin/2.)/dyfin)               
+
+
+    ALLOCATE(gdepwtemp(ibegin-irafx:iend+irafx,jbegin-irafy:jend+irafy))
+    ALLOCATE(parentbathytab(ibegin-irafx:iend+irafx,jbegin-irafy:jend+irafy))
+
+
+    jpt=jpbegin
+    DO j=jbegin,jend,irafy
+
+       ipt=ipbegin
+
+
+       DO i=ibegin,iend,irafx
+
+
+          !            
+          parentbathy = ParentGrid%bathy_level(ipt,jpt)
+          IF (parentbathy == 0) THEN
+             mindepth = 0.
+             maxdepth = 0.
+          ELSE
+             mindepth = MAX(gdepw(parentbathy) + MIN( e3zps_min, e3t(parentbathy)*e3zps_rat ),zmin)
+             !                  maxdepth = min(gdepw(parentbathy + 1),zmax)
+             IF (parentbathy < (N-1)) THEN
+                maxdepth = gdepw(parentbathy + 1)
+             ELSE
+                maxdepth = HUGE(1.)
+             ENDIF
+          ENDIF
+
+          slopex = vanleer(parentgrid%gdepw_ps(ipt-1:ipt+1,jpt))/REAL(irafx)
+
+
+          tmp1 = (maxdepth - parentgrid%gdepw_ps(ipt,jpt)) / REAL(irafx)
+          tmp2 = (parentgrid%gdepw_ps(ipt,jpt) - mindepth) / REAL(irafx)
+
+          IF (ABS(slopex) > tmp1) THEN
+             IF (slopex > 0) THEN
+                slopex = tmp1
+             ELSE
+                slopex = -tmp1
+             ENDIF
+          ENDIF
+
+          IF (ABS(slopex) > tmp2) THEN
+             IF (slopex > 0) THEN
+                slopex = tmp2
+             ELSE
+                slopex = -tmp2
+             ENDIF
+          ENDIF
+          !                  
+          ! interpolation on fine grid points (connection zone)
+          !
+          DO ii = i-FLOOR(irafx/2.0)+diff,i+FLOOR(irafx/2.0)
+             x = ii-i - xdiff/2.
+             val = parentgrid%gdepw_ps(ipt,jpt)+slopex * x
+             gdepwtemp(ii,j) = val
+             IF (gdepwtemp(ii,j) < mindepth) THEN
+                gdepwtemp(ii,j) = mindepth
+             ENDIF
+             IF (gdepwtemp(ii,j) > maxdepth) THEN
+                gdepwtemp(ii,j) = maxdepth
+             ENDIF
+             parentbathytab(ii,j) = parentbathy
+          ENDDO
+          ipt =ipt + 1
+       ENDDO
+
+       jpt = jpt + 1                
+    ENDDO
+
+    DO j=jbegin+irafy,jend-irafy,irafy
+
+       DO i=ibegin,iend
+
+          parentbathy = parentbathytab(i,j)
+          IF (parentbathy == 0) THEN
+             mindepth = 0.
+             maxdepth = 0.
+          ELSE
+             mindepth = MAX(gdepw(parentbathy) + MIN( e3zps_min, e3t(parentbathy)*e3zps_rat ),zmin)
+             !                  maxdepth = min(gdepw(parentbathy + 1),zmax)
+             IF (parentbathy < (N-1)) THEN
+                maxdepth = gdepw(parentbathy + 1)
+             ELSE
+                maxdepth = HUGE(1.)
+             ENDIF
+          ENDIF
+
+          slopey = vanleer(gdepwtemp(i,j-irafy:j+irafy:irafy))/REAL(irafy)
+
+          tmp1 = (maxdepth - gdepwtemp(i,j)) / REAL(irafy)
+          tmp2 = (gdepwtemp(i,j) - mindepth) / REAL(irafy)
+
+          IF (ABS(slopey) > tmp1) THEN
+             IF (slopey > 0) THEN
+                slopey = tmp1
+             ELSE
+                slopey = -tmp1
+             ENDIF
+          ENDIF
+          IF (ABS(slopey) > tmp2) THEN
+             IF (slopey > 0) THEN
+                slopey = tmp2
+             ELSE
+                slopey = -tmp2
+             ENDIF
+          ENDIF
+
+
+          DO jj = j-FLOOR(irafy/2.0)+diff,j+FLOOR(irafy/2.0)
+             y = jj-j - xdiff/2.
+             val = gdepwtemp(i,j) + slopey*y
+             gdepwtemp(i,jj) = val     
+          ENDDO
+       ENDDO
+    ENDDO
+
+
+    gdepwchild(minboundx:maxboundx,minboundy:maxboundy) = gdepwtemp(minboundx:maxboundx,minboundy:maxboundy)
+    DEALLOCATE(gdepwtemp,parentbathytab)
+
+  END SUBROUTINE correct_level
+  !
+  !
+  !***************************************************
+  ! function van leer to compute the corresponding 
+  ! Van Leer slopes
+  !***************************************************
+  !      
+  REAL FUNCTION vanleer(tab)
+    REAL, DIMENSION(3) :: tab
+    REAL res,res1
+    REAL p1,p2,p3
+
+    p1=(tab(3)-tab(1))/2.
+    p2=(tab(2)-tab(1))
+    p3=(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
+  !
+  !
+  !********************************************************************************
+  !   subroutine bathymetry_control                        			*
+  !                                                				*
+  !  - Purpose :   check the bathymetry in levels                  		*
+  !										*
+  !  - Method  :   The array mbathy is checked to verified its consistency	*
+  !      with the model options. in particular:					*
+  !            mbathy must have at least 1 land grid-points (mbathy<=0)		*
+  !                  along closed boundary.					*
+  !            mbathy must be cyclic IF jperio=1.					*
+  !            mbathy must be lower or equal to jpk-1.				*
+  !            isolated ocean grid points are suppressed from mbathy		*
+  !                  since they are only connected to remaining			*
+  !                  ocean through vertical diffusion.				*
+  !										*
+  !										*
+  !********************************************************************************
+
+  SUBROUTINE bathymetry_control(mbathy)
+
+    INTEGER ::   i, j, jl           
+    INTEGER ::   icompt, ibtest, ikmax          
+    REAL*8, DIMENSION(:,:) :: mbathy     
+
+    ! ================
+    ! Bathymetry check
+    ! ================
+
+    ! Suppress isolated ocean grid points
+
+    WRITE(*,*)'                   suppress isolated ocean grid points'
+    WRITE(*,*)'                   -----------------------------------'
+
+    icompt = 0
+
+    DO jl = 1, 2
+       !
+       DO j = 2, SIZE(mbathy,2)-1
+          DO i = 2, SIZE(mbathy,1)-1
+
+             ibtest = MAX( mbathy(i-1,j), mbathy(i+1,j),mbathy(i,j-1),mbathy(i,j+1) )
+             !               
+             IF( ibtest < mbathy(i,j) ) THEN
+                !                  
+                WRITE(*,*) 'grid-point(i,j)= ',i,j,'is changed from',mbathy(i,j),' to ', ibtest
+                mbathy(i,j) = ibtest
+                icompt = icompt + 1
+                !
+             ENDIF
+             !           
+          END DO
+       END DO
+       !
+    END DO
+    !      
+    IF( icompt == 0 ) THEN
+       WRITE(*,*)'     no isolated ocean grid points'
+    ELSE
+       WRITE(*,*)'    ',icompt,' ocean grid points suppressed'
+    ENDIF
+    !
+
+    ! Number of ocean level inferior or equal to jpkm1
+
+    ikmax = 0
+    DO j = 1, SIZE(mbathy,2)
+       DO ji = 1, SIZE(mbathy,1)
+          ikmax = MAX( ikmax, NINT(mbathy(i,j)) )
+       END DO
+    END DO
+    !
+    IF( ikmax > N-1 ) THEN
+       WRITE(*,*) ' maximum number of ocean level = ', ikmax,' >  jpk-1'
+       WRITE(*,*) ' change jpk to ',ikmax+1,' to use the exact ead bathymetry'
+    ELSE IF( ikmax < N-1 ) THEN
+       WRITE(*,*) ' maximum number of ocean level = ', ikmax,' < jpk-1' 
+       WRITE(*,*) ' you can decrease jpk to ', ikmax+1
+    ENDIF
+
+  END SUBROUTINE bathymetry_control
+  !
+  !
+  !**********************************************************************************
+  !
+  !subroutine get_scale_factors
+  !
+  !**********************************************************************************
+  !
+  SUBROUTINE get_scale_factors(Grid,fse3t,fse3u,fse3v)
+    !
+    IMPLICIT NONE
+    !       
+    TYPE(Coordinates) :: Grid 
+    REAL*8, DIMENSION(:,:,:) :: fse3u,fse3t,fse3v
+    !                                  
+    REAL*8 :: za1,za0,zsur,zacr,zkth,zdepth,zdepwp,zmin,zmax,zdiff,ze3tp,ze3wp
+    INTEGER :: i,j,jk,jj,ji,jpj,jpi,ik,ii,ipt,jpt,jpk
+    INTEGER, DIMENSION(1) :: k
+    INTEGER :: k1
+    REAL*8, POINTER, DIMENSION(:) :: gdepw,gdept,e3w,e3t
+    REAL*8, POINTER, DIMENSION(:,:)   :: hdepw,e3tp,e3wp
+    REAL*8, POINTER, DIMENSION(:,:,:) :: gdept_ps,gdepw_ps   
+    !       
+    jpi = SIZE(fse3t,1)
+    jpj = SIZE(fse3t,2) 
+    jpk = SIZE(fse3t,3)      
+    !       
+    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 
+       !    
+       WRITE(*,*) 'psur,pa0,pa1 computed'
+       za1=( ppdzmin - pphmax / (jpk-1) )          &
+            / ( TANH((1-ppkth)/ppacr) - ppacr/(jpk-1) &
+            *  (  LOG( COSH( (jpk - ppkth) / ppacr) )      &
+            - LOG( COSH( ( 1  - ppkth) / ppacr) )  )  ) 
+       !
+       za0  = ppdzmin - za1 * TANH( (1-ppkth) / ppacr )
+       zsur = - za0 - za1 * ppacr * LOG( COSH( (1-ppkth) / ppacr )  )
+       !
+    ELSE IF ( (ppdzmin == 0 .OR. pphmax == 0) .AND. psur.NE.0 .AND. &
+         pa0.NE.0 .AND. pa1.NE.0 ) THEN
+       !       
+       zsur = psur
+       za0  = pa0
+       za1  = pa1   
+       !       
+    ENDIF
+
+    zacr = ppacr
+    zkth = ppkth       
+    !         
+    !                
+    DO i = 1,jpk
+       ! 
+       gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 
+       e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))
+       !       
+       fse3t(:,:,i) = e3t(i)
+       gdepw_ps(:,:,i) = gdepw(i)
+       !
+    END DO
+    !                                 
+    gdepw(1) = 0.0 
+    gdepw_ps(:,:,1) = 0.0 
+    !
+    zmax = gdepw(jpk) + e3t(jpk)
+    zmin = gdepw(4)
+    !
+    DO jj = 1, jpj
+       DO ji= 1, jpi
+          IF( Grid%bathy_meter(ji,jj) <= 0. ) THEN
+             Grid%bathy_meter(ji,jj) = 0.e0
+          ELSE
+             Grid%bathy_meter(ji,jj) = MAX( Grid%bathy_meter(ji,jj), zmin )
+             Grid%bathy_meter(ji,jj) = MIN( Grid%bathy_meter(ji,jj), zmax )
+          ENDIF
+       END DO
+    END DO
+    !
+    DO jj = 1, jpj
+       DO ji = 1, jpi
+          ik = Grid%bathy_level(ji,jj) 
+          IF( ik > 0 ) THEN
+             ! max ocean level case
+             IF( ik == jpk-1 ) THEN
+                zdepwp = Grid%bathy_meter(ji,jj)
+                ze3tp  = Grid%bathy_meter(ji,jj) - gdepw(ik)
+                fse3t(ji,jj,ik  ) = ze3tp
+                fse3t(ji,jj,ik+1) = ze3tp
+                gdepw_ps(ji,jj,ik+1) = zdepwp
+             ELSE
+                IF( Grid%bathy_meter(ji,jj) <= gdepw(ik+1) ) THEN
+                   gdepw_ps(ji,jj,ik+1) = Grid%bathy_meter(ji,jj)
+                ELSE
+                   gdepw_ps(ji,jj,ik+1) = gdepw(ik+1)
+                ENDIF
+                fse3t(ji,jj,ik) = e3t(ik) * ( gdepw_ps(ji,jj,ik+1) - gdepw(ik))   & 
+                     /( gdepw(ik+1) - gdepw(ik)) 
+                fse3t(ji,jj,ik+1) = fse3t(ji,jj,ik)
+
+             ENDIF
+          ENDIF
+       END DO
+    END DO
+    !
+    DO i = 1, jpk
+       fse3u (:,:,i)  = e3t(i)
+       fse3v (:,:,i)  = e3t(i)
+    END DO
+    !
+    DO jk = 1,jpk
+       DO jj = 1, jpj-1
+          DO ji = 1, jpi-1
+             fse3u (ji,jj,jk) = MIN( fse3t(ji,jj,jk), fse3t(ji+1,jj,jk))
+             fse3v (ji,jj,jk) = MIN( fse3t(ji,jj,jk), fse3t(ji,jj+1,jk))      
+          ENDDO
+       ENDDO
+    ENDDO
+    !           
+    DEALLOCATE(gdepw,e3t)
+    DEALLOCATE(gdepw_ps)
+    DEALLOCATE(Grid%bathy_meter,Grid%bathy_level) 
+    !
+  END SUBROUTINE get_scale_factors
+  !       
+END MODULE agrif_partial_steps
+
+
Index: trunk/NEMOGCM/TOOLS/NESTING/src/agrif_readwrite.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/NESTING/src/agrif_readwrite.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/NESTING/src/agrif_readwrite.f90	(revision 2528)
@@ -0,0 +1,794 @@
+!************************************************************************
+! Fortran 95 OPA Nesting tools						*
+!									*
+!     Copyright (C) 2005 Florian Lemarié (Florian.Lemarie@imag.fr)	*
+!									*
+!************************************************************************
+!
+MODULE agrif_readwrite
+  !
+  USE agrif_types
+  !
+  IMPLICIT NONE
+  !
+CONTAINS
+  !
+  !************************************************************************
+  ! 									*
+  ! MODULE  AGRIF_READWRITE						*
+  !									*
+  ! module containing subroutine used for : 				*
+  !   - Coordinates files reading/writing				*
+  !   - Bathymetry files reading/writing (meter and levels)		*
+  !   - Naming of child grid files					*
+  !									*
+  !************************************************************************
+  !       
+  !*****************************************************
+  !   function Read_Coordinates(name,Grid)
+  !*****************************************************
+
+  INTEGER FUNCTION Read_Coordinates(name,Grid,Pacifique)
+    !
+    USE io_netcdf
+    !    
+    !  file name to open
+    ! 
+    CHARACTER(*) name
+    LOGICAL,OPTIONAL :: Pacifique
+    ! 
+    TYPE(Coordinates) :: Grid
+    !      
+    CALL Read_Ncdf_var('glamt',name,Grid%glamt)
+    CALL Read_Ncdf_var('glamu',name,Grid%glamu)
+    CALL Read_Ncdf_var('glamv',name,Grid%glamv)
+    CALL Read_Ncdf_var('glamf',name,Grid%glamf)
+    CALL Read_Ncdf_var('gphit',name,Grid%gphit)
+    CALL Read_Ncdf_var('gphiu',name,Grid%gphiu)
+    CALL Read_Ncdf_var('gphiv',name,Grid%gphiv)
+    CALL Read_Ncdf_var('gphif',name,Grid%gphif)
+    CALL Read_Ncdf_var('e1t',name,Grid%e1t)
+    CALL Read_Ncdf_var('e1u',name,Grid%e1u)
+    CALL Read_Ncdf_var('e1v',name,Grid%e1v)
+    CALL Read_Ncdf_var('e1f',name,Grid%e1f)
+    CALL Read_Ncdf_var('e2t',name,Grid%e2t)
+    CALL Read_Ncdf_var('e2u',name,Grid%e2u)
+    CALL Read_Ncdf_var('e2v',name,Grid%e2v)
+    CALL Read_Ncdf_var('e2f',name,Grid%e2f)
+    CALL Read_Ncdf_var('nav_lon',name,Grid%nav_lon)
+    CALL Read_Ncdf_var('nav_lat',name,Grid%nav_lat)       
+    ! 
+    IF( PRESENT(Pacifique) )THEN
+       IF ( Grid%glamt(1,1) > Grid%glamt(nxfin,nyfin) ) THEN           
+       Pacifique = .TRUE.
+       WHERE ( Grid%glamt < 0 )
+          Grid%glamt = Grid%glamt + 360.
+       END WHERE
+       WHERE ( Grid%glamf < 0 )
+          Grid%glamf = Grid%glamf + 360.
+       END WHERE
+       WHERE ( Grid%glamu < 0 )
+          Grid%glamu = Grid%glamu + 360.
+       END WHERE
+       WHERE ( Grid%glamv < 0 )
+          Grid%glamv = Grid%glamv + 360.
+       END WHERE
+       WHERE ( Grid%nav_lon < 0 )
+          Grid%nav_lon = Grid%nav_lon + 360.
+       END WHERE
+       ENDIF
+    ENDIF
+    !            
+    WRITE(*,*) ' '
+    WRITE(*,*) 'Reading coordinates file: ',name
+    WRITE(*,*) ' '
+    !      
+    Read_Coordinates = 1
+    !      
+  END FUNCTION Read_Coordinates
+
+  !*****************************************************
+  !   function Read_Coordinates(name,Grid)
+  !*****************************************************
+
+  INTEGER FUNCTION Read_Local_Coordinates(name,Grid,strt,cnt)
+    !
+    USE io_netcdf
+    !    
+    !  file name to open
+    ! 
+    CHARACTER(*) name
+    INTEGER, DIMENSION(2) :: strt,cnt
+    ! 
+    TYPE(Coordinates) :: Grid
+    !      
+    CALL Read_Ncdf_var('glamt',name,Grid%glamt,strt,cnt)
+    CALL Read_Ncdf_var('glamu',name,Grid%glamu,strt,cnt)
+    CALL Read_Ncdf_var('glamv',name,Grid%glamv,strt,cnt)
+    CALL Read_Ncdf_var('glamf',name,Grid%glamf,strt,cnt)
+    CALL Read_Ncdf_var('gphit',name,Grid%gphit,strt,cnt)
+    CALL Read_Ncdf_var('gphiu',name,Grid%gphiu,strt,cnt)
+    CALL Read_Ncdf_var('gphiv',name,Grid%gphiv,strt,cnt)
+    CALL Read_Ncdf_var('gphif',name,Grid%gphif,strt,cnt)
+    CALL Read_Ncdf_var('e1t',name,Grid%e1t,strt,cnt)
+    CALL Read_Ncdf_var('e1u',name,Grid%e1u,strt,cnt)
+    CALL Read_Ncdf_var('e1v',name,Grid%e1v,strt,cnt)
+    CALL Read_Ncdf_var('e1f',name,Grid%e1f,strt,cnt)
+    CALL Read_Ncdf_var('e2t',name,Grid%e2t,strt,cnt)
+    CALL Read_Ncdf_var('e2u',name,Grid%e2u,strt,cnt)
+    CALL Read_Ncdf_var('e2v',name,Grid%e2v,strt,cnt)
+    CALL Read_Ncdf_var('e2f',name,Grid%e2f,strt,cnt)
+    CALL Read_Ncdf_var('nav_lon',name,Grid%nav_lon,strt,cnt)
+    CALL Read_Ncdf_var('nav_lat',name,Grid%nav_lat,strt,cnt)       
+    !
+    WRITE(*,*) ' '
+    WRITE(*,*) 'Reading coordinates file: ',name
+    WRITE(*,*) ' '
+    !      
+    Read_Local_Coordinates = 1
+    !      
+  END FUNCTION Read_Local_Coordinates
+
+  !*****************************************************
+  !   function Write_Coordinates(name,Grid)
+  !*****************************************************
+
+  INTEGER FUNCTION Write_Coordinates(name,Grid)
+    !
+    USE io_netcdf
+    CHARACTER(*) name
+    TYPE(Coordinates) :: Grid
+    INTEGER :: status,ncid
+    CHARACTER(len=1),DIMENSION(2) :: dimnames
+    !
+    status = nf90_create(name,NF90_WRITE,ncid)
+    status = nf90_close(ncid)
+    !           
+    dimnames = (/ 'x','y' /)
+    CALL Write_Ncdf_dim(dimnames(1),name,nxfin)
+    CALL Write_Ncdf_dim(dimnames(2),name,nyfin)
+    !      
+    CALL Write_Ncdf_var('nav_lon',dimnames,name,Grid%nav_lon,'float')      
+    CALL Write_Ncdf_var('nav_lat',dimnames,name,Grid%nav_lat,'float')
+    !
+    CALL Write_Ncdf_var('glamt',dimnames,name,Grid%glamt,'double')
+    CALL Write_Ncdf_var('glamu',dimnames,name,Grid%glamu,'double')
+    CALL Write_Ncdf_var('glamv',dimnames,name,Grid%glamv,'double')
+    CALL Write_Ncdf_var('glamf',dimnames,name,Grid%glamf,'double')
+    CALL Write_Ncdf_var('gphit',dimnames,name,Grid%gphit,'double')
+    CALL Write_Ncdf_var('gphiu',dimnames,name,Grid%gphiu,'double')
+    CALL Write_Ncdf_var('gphiv',dimnames,name,Grid%gphiv,'double')
+    CALL Write_Ncdf_var('gphif',dimnames,name,Grid%gphif,'double')      
+    CALL Write_Ncdf_var('e1t',dimnames,name,Grid%e1t,'double')      
+    CALL Write_Ncdf_var('e1u',dimnames,name,Grid%e1u,'double')     
+    CALL Write_Ncdf_var('e1v',dimnames,name,Grid%e1v,'double')      
+    CALL Write_Ncdf_var('e1f',dimnames,name,Grid%e1f,'double')
+    CALL Write_Ncdf_var('e2t',dimnames,name,Grid%e2t,'double')
+    CALL Write_Ncdf_var('e2u',dimnames,name,Grid%e2u,'double')
+    CALL Write_Ncdf_var('e2v',dimnames,name,Grid%e2v,'double')
+    CALL Write_Ncdf_var('e2f',dimnames,name,Grid%e2f,'double')
+    !      
+    CALL Copy_Ncdf_att('nav_lon',TRIM(parent_coordinate_file),name,MINVAL(Grid%nav_lon),MAXVAL(Grid%nav_lon))
+    CALL Copy_Ncdf_att('nav_lat',TRIM(parent_coordinate_file),name,MINVAL(Grid%nav_lat),MAXVAL(Grid%nav_lat))
+    CALL Copy_Ncdf_att('glamt',TRIM(parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('glamu',TRIM(parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('glamv',TRIM(parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('glamf',TRIM(parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('gphit',TRIM(parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('gphiu',TRIM(parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('gphiv',TRIM(parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('gphif',TRIM(parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('e1t',TRIM(parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('e1u',TRIM(parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('e1v',TRIM(parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('e1f',TRIM(parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('e2t',TRIM(parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('e2u',TRIM(parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('e2v',TRIM(parent_coordinate_file),name)
+    CALL Copy_Ncdf_att('e2f',TRIM(parent_coordinate_file),name)            
+    !
+    WRITE(*,*) ' '
+    WRITE(*,*) 'Writing coordinates file: ',name
+    WRITE(*,*) ' '
+    !
+    Write_Coordinates = 1
+    !      
+  END FUNCTION Write_Coordinates
+  !
+  !
+  !
+  !*****************************************************
+  !   function Read_Bathy_level(name,Grid)
+  !*****************************************************
+  !
+  INTEGER FUNCTION Read_Bathy_level(name,Grid)
+    !
+    USE io_netcdf
+    !      
+    CHARACTER(*) name
+    TYPE(Coordinates) :: Grid
+    !
+    CALL Read_Ncdf_var('mbathy',name,Grid%Bathy_level)    
+    !
+    WRITE(*,*) ' '
+    WRITE(*,*) 'Reading bathymetry file: ',name
+    WRITE(*,*) ' '      
+    !
+    Read_Bathy_level = 1
+    !      
+  END FUNCTION Read_Bathy_level
+  !
+  !*****************************************************
+  !   function Write_Bathy_level(name,Grid)
+  !*****************************************************
+  !
+  INTEGER FUNCTION Write_Bathy_level(name,Grid)
+    !
+    USE io_netcdf
+    !      
+    CHARACTER(*) name
+    TYPE(Coordinates) :: Grid
+    INTEGER :: status,ncid
+    CHARACTER(len=1),DIMENSION(2) :: dimnames
+    !
+    status = nf90_create(name,NF90_WRITE,ncid)
+    status = nf90_close(ncid)          
+    !
+    dimnames = (/ 'x','y' /)
+    CALL Write_Ncdf_dim(dimnames(1),name,nxfin)
+    CALL Write_Ncdf_dim(dimnames(2),name,nyfin)
+    !      
+    CALL Write_Ncdf_var('nav_lon',dimnames,name,Grid%nav_lon    ,'float')
+    CALL Write_Ncdf_var('nav_lat',dimnames,name,Grid%nav_lat    ,'float')
+    CALL Write_Ncdf_var('mbathy' ,dimnames,name,Grid%bathy_level,'float')
+    !
+    CALL Copy_Ncdf_att('nav_lon',TRIM(parent_meshmask_file),name,MINVAL(Grid%nav_lon),MAXVAL(Grid%nav_lon))
+    CALL Copy_Ncdf_att('nav_lat',TRIM(parent_meshmask_file),name,MINVAL(Grid%nav_lat),MAXVAL(Grid%nav_lat))
+    CALL Copy_Ncdf_att('mbathy' ,TRIM(parent_meshmask_file),name)       
+    !
+    WRITE(*,*) ' '
+    WRITE(*,*) 'Writing bathymetry file: ',name
+    WRITE(*,*) ' '
+    !
+    Write_Bathy_level = 1
+    !
+  END FUNCTION Write_Bathy_level
+  !
+  !*****************************************************
+  !   function Read_Bathy_meter(name,CoarseGrid,ChildGrid)
+  !*****************************************************
+  !
+  INTEGER FUNCTION Read_Bathy_meter(name,CoarseGrid,ChildGrid,Pacifique)
+    !
+    USE io_netcdf
+    CHARACTER(*) name
+    INTEGER :: i,j,tabdim1,tabdim2
+    INTEGER, DIMENSION(1) :: i_min,i_max,j_min,j_max
+    REAL*8,POINTER,DIMENSION(:) :: topo_lon,topo_lat
+    INTEGER :: status,ncid,varid 
+    LOGICAL,OPTIONAL :: Pacifique
+    TYPE(Coordinates) :: CoarseGrid,ChildGrid
+    !
+    IF( Dims_Existence('lon',name) .AND. Dims_Existence('lat',name) ) THEN
+       WRITE(*,*) '****'
+       WRITE(*,*) ' etopo format for external high resolution database  '
+       WRITE(*,*) '****'
+       CALL Read_Ncdf_var('lon',name,topo_lon)
+       CALL Read_Ncdf_var('lat',name,topo_lat)
+    ELSE IF( Dims_Existence('x',name) .AND. Dims_Existence('y',name) ) THEN
+       WRITE(*,*) '****'
+       WRITE(*,*) ' OPA format for external high resolution database  '
+       WRITE(*,*) '****'
+       CALL Read_Ncdf_var('nav_lon',name,CoarseGrid%nav_lon)
+       CALL Read_Ncdf_var('nav_lat',name,CoarseGrid%nav_lat)
+       CALL Read_Ncdf_var(parent_batmet_name,name,CoarseGrid%Bathy_meter)
+       !            
+       IF ( PRESENT(Pacifique) ) THEN
+          IF(Pacifique) THEN
+             WHERE(CoarseGrid%nav_lon < 0.001) 
+                CoarseGrid%nav_lon = CoarseGrid%nav_lon + 360.
+             END WHERE
+          ENDIF
+       ENDIF
+       !      
+       Read_Bathy_meter = 1
+       RETURN      
+    ELSE
+       WRITE(*,*) '****'
+       WRITE(*,*) '*** ERROR Bad format for external high resolution database'
+       WRITE(*,*) '****'
+       STOP  
+    ENDIF
+    !
+    IF( MAXVAL(ChildGrid%glamt) > 180 ) THEN                 
+       !          
+       WHERE( topo_lon < 0 )
+          topo_lon = topo_lon + 360.
+       END WHERE
+       !          
+       i_min = MAXLOC(topo_lon,mask = topo_lon < MINVAL(ChildGrid%nav_lon))
+       i_max = MINLOC(topo_lon,mask = topo_lon > MAXVAL(ChildGrid%nav_lon))                    
+       j_min = MAXLOC(topo_lat,mask = topo_lat < MINVAL(ChildGrid%nav_lat))
+       j_max = MINLOC(topo_lat,mask = topo_lat > MAXVAL(ChildGrid%nav_lat))
+       !          
+       tabdim1 = ( SIZE(topo_lon) - i_min(1) + 1 ) + i_max(1)                    
+       !          
+       IF(j_min(1)-2 >= 1 .AND. j_max(1)+3 <= SIZE(topo_lat,1) ) THEN
+          j_min(1) = j_min(1)-2
+          j_max(1) = j_max(1)+3
+       ENDIF
+       tabdim2 = j_max(1) - j_min(1) + 1
+       !
+       ALLOCATE(CoarseGrid%nav_lon(tabdim1,tabdim2))
+       ALLOCATE(CoarseGrid%nav_lat(tabdim1,tabdim2))
+       ALLOCATE(CoarseGrid%Bathy_meter(tabdim1,tabdim2))          
+       !
+       DO i = 1,tabdim1
+          CoarseGrid%nav_lat(i,:) = topo_lat(j_min(1):j_max(1))
+       END DO
+       !
+       DO j = 1, tabdim2
+          !                     
+          CoarseGrid%nav_lon(1:SIZE(topo_lon)-i_min(1)+1      ,j) = topo_lon(i_min(1):SIZE(topo_lon))
+          CoarseGrid%nav_lon(2+SIZE(topo_lon)-i_min(1):tabdim1,j) = topo_lon(1:i_max(1))
+          !    
+       END DO
+       status = nf90_open(name,NF90_NOWRITE,ncid)
+       status = nf90_inq_varid(ncid,elevation_name,varid)
+       !          
+       status=nf90_get_var(ncid,varid,CoarseGrid%Bathy_meter(1:SIZE(topo_lon)-i_min(1)+1,:), &
+            start=(/i_min(1),j_min(1)/),count=(/SIZE(topo_lon)-i_min(1),tabdim2/))
+
+       status=nf90_get_var(ncid,varid,CoarseGrid%Bathy_meter(2+SIZE(topo_lon)-i_min(1):tabdim1,:), &
+            start=(/1,j_min(1)/),count=(/i_max(1),tabdim2/))                
+       !
+    ELSE
+       !
+       i_min = MAXLOC(topo_lon,mask = topo_lon < MINVAL(ChildGrid%nav_lon))
+       i_max = MINLOC(topo_lon,mask = topo_lon > MAXVAL(ChildGrid%nav_lon))
+       j_min = MAXLOC(topo_lat,mask = topo_lat < MINVAL(ChildGrid%nav_lat))
+       j_max = MINLOC(topo_lat,mask = topo_lat > MAXVAL(ChildGrid%nav_lat))
+       !      
+       IF(i_min(1)-2 >= 1 .AND. i_max(1)+3 <= SIZE(topo_lon,1) ) THEN
+          i_min(1) = i_min(1)-2
+          i_max(1) = i_max(1)+3
+       ENDIF
+       tabdim1 = i_max(1) - i_min(1) + 1
+       !
+       IF(j_min(1)-2 >= 1 .AND. j_max(1)+3 <= SIZE(topo_lat,1) ) THEN
+          j_min(1) = j_min(1)-2
+          j_max(1) = j_max(1)+3
+       ENDIF
+       tabdim2 = j_max(1) - j_min(1) + 1
+       !
+       WRITE(*,*) ' '
+       WRITE(*,*) 'Reading bathymetry file: ',name
+       WRITE(*,*) ' '
+       !
+       ALLOCATE(CoarseGrid%nav_lon(tabdim1,tabdim2))
+       ALLOCATE(CoarseGrid%nav_lat(tabdim1,tabdim2))
+       ALLOCATE(CoarseGrid%Bathy_meter(tabdim1,tabdim2))
+       !
+       DO j = 1,tabdim2
+          CoarseGrid%nav_lon(:,j) = topo_lon(i_min(1):i_max(1))
+       END DO
+       !      
+       DO i = 1,tabdim1
+          CoarseGrid%nav_lat(i,:) = topo_lat(j_min(1):j_max(1)) 
+       END DO
+       !
+       status = nf90_open(name,NF90_NOWRITE,ncid)
+       status = nf90_inq_varid(ncid,elevation_name,varid)
+       status = nf90_get_var(ncid,varid,CoarseGrid%Bathy_meter, &
+          &                  start=(/i_min(1),j_min(1)/),count=(/tabdim1,tabdim2/))
+       !
+    ENDIF
+    !
+    status = nf90_close(ncid)     
+    !
+    WHERE(CoarseGrid%Bathy_meter.GE.0)
+       CoarseGrid%Bathy_meter = 0.0
+    END WHERE
+    !      
+    CoarseGrid%Bathy_meter(:,:) = -1.0 * CoarseGrid%Bathy_meter(:,:)
+    !      
+    Read_Bathy_meter = 1
+    RETURN
+    !      
+  END FUNCTION Read_Bathy_meter
+  ! 
+  !
+  !*****************************************************
+  !   function Read_Bathy_meter(name,CoarseGrid,ChildGrid)
+  !*****************************************************
+  !
+  INTEGER FUNCTION Read_Bathymeter(name,Grid)
+    !
+    !
+    USE io_netcdf
+    !      
+    CHARACTER(*) name
+    TYPE(Coordinates) :: Grid
+    !
+    CALL Read_Ncdf_var(parent_batmet_name,name,Grid%Bathy_meter)    
+    !
+    WRITE(*,*) ' '
+    WRITE(*,*) 'Reading bathymetry file: ',name
+    WRITE(*,*) ' '      
+    !
+    Read_Bathymeter = 1
+    !      
+  END FUNCTION Read_Bathymeter
+  !     
+  !*****************************************************
+  !   function Write_Bathy_meter(name,Grid)
+  !*****************************************************
+  !
+  INTEGER FUNCTION Write_Bathy_meter(name,Grid)
+    !
+    USE io_netcdf
+    !
+    CHARACTER(*) name
+    TYPE(Coordinates) :: Grid
+    INTEGER :: status,ncid
+    CHARACTER(len=1),DIMENSION(2) :: dimnames
+    INTEGER :: nx,ny
+    !
+    status = nf90_create(name,NF90_WRITE,ncid)
+    status = nf90_close(ncid)     
+    !
+    nx = SIZE(Grid%bathy_meter,1)
+    ny = SIZE(Grid%bathy_meter,2)
+    dimnames = (/ 'x','y' /)
+
+    CALL Write_Ncdf_dim(dimnames(1),name,nx)
+    CALL Write_Ncdf_dim(dimnames(2),name,ny)
+    !     
+    CALL Write_Ncdf_var('nav_lon'         ,dimnames,name,Grid%nav_lon    ,'float')
+    CALL Write_Ncdf_var('nav_lat'         ,dimnames,name,Grid%nav_lat    ,'float')
+    CALL Write_Ncdf_var(parent_batmet_name,dimnames,name,Grid%bathy_meter,'float')
+    !
+    CALL Copy_Ncdf_att('nav_lon'         ,TRIM(parent_bathy_meter),name,MINVAL(Grid%nav_lon),MAXVAL(Grid%nav_lon))
+    CALL Copy_Ncdf_att('nav_lat'         ,TRIM(parent_bathy_meter),name,MINVAL(Grid%nav_lat),MAXVAL(Grid%nav_lat))  
+    CALL Copy_Ncdf_att(parent_batmet_name,TRIM(parent_bathy_meter),name)
+    !
+    WRITE(*,*) ' '
+    WRITE(*,*) 'Writing bathymetry file: ',name
+    WRITE(*,*) ' '
+    !
+    Write_Bathy_meter = 1
+    !      
+  END FUNCTION Write_Bathy_meter
+  !
+  !*****************************************************
+  !   function set_child_name(Parentname,Childname)
+  !*****************************************************
+  !
+  SUBROUTINE set_child_name(Parentname,Childname)
+    !
+    CHARACTER(*),INTENT(in) :: Parentname
+    CHARACTER(*),INTENT(out) :: Childname
+    CHARACTER(2) :: prefix
+    INTEGER :: pos
+    !   
+    pos  = INDEX(TRIM(Parentname),'/',back=.TRUE.)
+    !
+    prefix=Parentname(pos+1:pos+2)
+    IF (prefix == '1_') THEN
+       Childname = '2_'//Parentname(pos+3:LEN(Parentname)) 
+    ELSEIF (prefix == '2_') THEN
+       Childname = '3_'//Parentname(pos+3:LEN(Parentname)) 
+    ELSEIF (prefix == '3_') THEN
+       Childname = '4_'//Parentname(pos+3:LEN(Parentname)) 
+    ELSEIF (prefix == '4_') THEN
+       Childname = '5_'//Parentname(pos+3:LEN(Parentname)) 
+    ELSE
+       Childname = '1_'//Parentname(pos+1:LEN(Parentname)) 
+    ENDIF
+    !   
+  END SUBROUTINE set_child_name
+  !
+  !*****************************************************
+  !   function set_child_name(Parentname,Childname)
+  !*****************************************************
+  !
+  !*****************************************************
+  !   subroutine get_interptype(varname,interp_type,conservation)
+  !*****************************************************
+  !
+  SUBROUTINE get_interptype( varname,interp_type,conservation )
+    !
+    LOGICAL,OPTIONAL :: conservation
+    CHARACTER(*) :: interp_type,varname
+    INTEGER :: pos,pos1,pos2,pos3,i,k 
+    LOGICAL :: find        
+    i=1
+    DO WHILE ( TRIM(VAR_INTERP(i)) .NE. 'NULL' )     
+       pos = INDEX( TRIM(VAR_INTERP(i)) , TRIM(varname) )
+       IF ( pos .NE. 0 ) THEN      
+          pos1 = INDEX( TRIM(VAR_INTERP(i)) , 'bicubic' )
+          pos2 = INDEX( TRIM(VAR_INTERP(i)) , 'bilinear' )
+          pos3 = INDEX( TRIM(VAR_INTERP(i)) , 'conservative' )
+          ! initialize interp_type
+          IF( pos1 .NE. 0 ) interp_type = 'bicubic'
+          IF( pos2 .NE. 0 ) interp_type = 'bilinear'
+          IF( pos1 .EQ. 0 .AND. pos2 .EQ. 0) interp_type = 'bicubic'
+          ! initialize conservation                                           
+          IF( pos3 .NE. 0 .AND. PRESENT(conservation) ) THEN
+             conservation = .TRUE.
+             RETURN
+          ELSE 
+             conservation = .FALSE.
+          ENDIF
+          find = .FALSE.
+          IF( PRESENT(conservation) ) THEN
+             k=0
+             conservation = .FALSE.         
+             DO WHILE( k < SIZE(flxtab) .AND. .NOT.find ) 
+                k = k+1
+                IF( TRIM(varname) .EQ. TRIM(flxtab(k)) ) THEN       
+                   conservation = .TRUE.
+                   find = .TRUE.
+                ENDIF
+             END DO
+          ENDIF
+          RETURN
+       ENDIF
+       i = i+1
+    END DO
+    !default values interp_type = bicubic // conservation = false      
+    interp_type = 'bicubic'      
+    IF( PRESENT(conservation) ) conservation = .FALSE.
+
+    RETURN
+    !   
+  END SUBROUTINE get_interptype
+  !      
+  !*****************************************************              
+  !   end subroutine get_interptype
+  !*****************************************************
+  !           
+  !*****************************************************
+  !   subroutine Init_mask(name,Grid)
+  !*****************************************************
+  !
+  SUBROUTINE Init_mask(name,Grid,jpiglo,jpjglo)
+    !
+    USE io_netcdf
+    !      
+    CHARACTER(*) name
+    INTEGER :: nx,ny,k,i,j,jpiglo,jpjglo
+    TYPE(Coordinates) :: Grid
+    REAL*8, POINTER, DIMENSION(:,:) ::zwf => NULL()
+    !
+    IF(jpiglo == 1 .AND. jpjglo == 1) THEN
+       CALL Read_Ncdf_var('Bathy_level',name,Grid%Bathy_level)
+    ELSE
+       CALL Read_Ncdf_var('Bathy_level',name,Grid%Bathy_level,(/jpizoom,jpjzoom/),(/jpiglo,jpjglo/) )
+    ENDIF
+
+
+    !
+    WRITE(*,*) 'Init masks in T,U,V,F points'    
+    !
+    nx = SIZE(Grid%Bathy_level,1)
+    ny = SIZE(Grid%Bathy_level,2)
+    !
+    !      
+    ALLOCATE(Grid%tmask(nx,ny,N), &
+         Grid%umask(nx,ny,N), &
+         Grid%vmask(nx,ny,N), &
+         Grid%fmask(nx,ny,N))
+    !
+    DO k = 1,N
+       !      
+       WHERE(Grid%Bathy_level(:,:) <= k-1 )    
+          Grid%tmask(:,:,k) = 0
+       ELSEWHERE
+          Grid%tmask(:,:,k) = 1
+       END WHERE
+       !
+    END DO
+    !
+    Grid%umask(1:nx-1,:,:) = Grid%tmask(1:nx-1,:,:)*Grid%tmask(2:nx,:,:)
+    Grid%vmask(:,1:ny-1,:) = Grid%tmask(:,1:ny-1,:)*Grid%tmask(:,2:ny,:)
+    !
+    Grid%umask(nx,:,:) = Grid%tmask(nx,:,:)
+    Grid%vmask(:,ny,:) = Grid%tmask(:,ny,:)
+    !      
+    Grid%fmask(1:nx-1,1:ny-1,:) = Grid%tmask(1:nx-1,1:ny-1,:)*Grid%tmask(2:nx,1:ny-1,:)* &
+         Grid%tmask(1:nx-1,2:ny,:)*Grid%tmask(2:nx,2:ny,:) 
+    !
+    Grid%fmask(nx,:,:) = Grid%tmask(nx,:,:)
+    Grid%fmask(:,ny,:) = Grid%tmask(:,ny,:)
+    !
+    ALLOCATE(zwf(nx,ny))
+    !     
+    DO k = 1,N
+       !
+       zwf(:,:) = Grid%fmask(:,:,k)
+       !         
+       DO j = 2, ny-1
+          DO i = 2,nx-1            
+             IF( Grid%fmask(i,j,k) == 0. ) THEN               
+                Grid%fmask(i,j,k) = shlat * MIN(1.,MAX( zwf(i+1,j),zwf(i,j+1),zwf(i-1,j),zwf(i,j-1)))
+             END IF
+          END DO
+       END DO
+       !
+       DO j = 2, ny-1
+          IF( Grid%fmask(1,j,k) == 0. ) THEN
+             Grid%fmask(1,j,k) = shlat * MIN(1.,MAX(zwf(2,j),zwf(1,j+1),zwf(1,j-1)))
+          ENDIF
+
+          IF( Grid%fmask(nx,j,k) == 0. ) THEN
+             Grid%fmask(nx,j,k) = shlat * MIN(1.,MAX(zwf(nx,j+1),zwf(nx-1,j),zwf(nx,j-1)))
+          ENDIF
+       END DO
+       !         
+       DO i = 2, nx-1         
+          IF( Grid%fmask(i,1,k) == 0. ) THEN
+             Grid%fmask(i, 1 ,k) = shlat*MIN( 1.,MAX(zwf(i+1,1),zwf(i,2),zwf(i-1,1)))
+          ENDIF
+          !            
+          IF( Grid%fmask(i,ny,k) == 0. ) THEN
+             Grid%fmask(i,ny,k) = shlat * MIN(1.,MAX(zwf(i+1,ny),zwf(i-1,ny),zwf(i,ny-1)))
+          ENDIF
+       END DO
+       !!
+    END DO
+    !!      
+  END SUBROUTINE Init_mask
+  !
+  !*****************************************************
+  !   end subroutine Init_mask
+  !*****************************************************
+  ! 
+  !*****************************************************
+  !   subroutine Init_Tmask(name,Grid)
+  !*****************************************************
+  !
+  SUBROUTINE Init_Tmask(name,Grid,jpiglo,jpjglo)
+    !
+    USE io_netcdf
+    !      
+    CHARACTER(*) name
+    INTEGER :: nx,ny,k,i,j,jpiglo,jpjglo
+    TYPE(Coordinates) :: Grid
+    REAL*8, POINTER, DIMENSION(:,:) ::zwf => NULL()
+    !
+    IF(jpiglo == 1 .AND. jpjglo == 1) THEN
+       CALL Read_Ncdf_var('Bathy_level',name,Grid%Bathy_level)
+    ELSE
+       CALL Read_Ncdf_var('Bathy_level',name,Grid%Bathy_level,(/jpizoom,jpjzoom/),(/jpiglo,jpjglo/) )
+    ENDIF
+    !
+    nx = SIZE(Grid%Bathy_level,1)
+    ny = SIZE(Grid%Bathy_level,2) 
+    !
+    WRITE(*,*) 'Init masks in T points'    
+    !     
+    ALLOCATE(Grid%tmask(nx,ny,N))
+    !
+    DO k = 1,N
+       !      
+       WHERE(Grid%Bathy_level(:,:) <= k-1 )    
+          Grid%tmask(:,:,k) = 0.
+       ELSEWHERE
+          Grid%tmask(:,:,k) = 1.
+       END WHERE
+       !
+    END DO
+    !      
+  END SUBROUTINE Init_Tmask
+  !
+  !*****************************************************
+  !   subroutine get_mask(name,Grid)
+  !*****************************************************
+  !
+  SUBROUTINE get_mask(level,posvar,mask,filename)
+    !
+    USE io_netcdf
+    !      
+    CHARACTER(*) filename
+    CHARACTER(*) posvar
+    INTEGER :: level, nx, ny
+    LOGICAL,DIMENSION(:,:),POINTER :: mask
+    INTEGER,DIMENSION(:,:),POINTER :: maskT,maskU,maskV
+    !      
+    TYPE(Coordinates) :: Grid
+    !
+    CALL Read_Ncdf_var('Bathy_level',filename,Grid%Bathy_level)
+    ! 
+    nx = SIZE(Grid%Bathy_level,1)
+    ny = SIZE(Grid%Bathy_level,2)
+    ALLOCATE(maskT(nx,ny),mask(nx,ny))
+    mask = .TRUE.
+    !
+    WHERE(Grid%Bathy_level(:,:) <= level-1 )    
+       maskT(:,:) = 0
+    ELSEWHERE
+       maskT(:,:) = 1
+    END WHERE
+    !
+    SELECT CASE(posvar)
+       !
+    CASE('T')
+       !
+       WHERE(maskT > 0)
+          mask = .TRUE.
+       ELSEWHERE
+          mask = .FALSE.
+       END WHERE
+       DEALLOCATE(maskT)
+       !
+    CASE('U')
+       !
+       ALLOCATE(maskU(nx,ny))
+       maskU(1:nx-1,:) = maskT(1:nx-1,:)*maskT(2:nx,:)
+       maskU(nx,:) = maskT(nx,:)
+       WHERE(maskU > 0)
+          mask = .TRUE.
+       ELSEWHERE
+          mask = .FALSE.
+       END WHERE
+       DEALLOCATE(maskU,maskT)
+       !
+    CASE('V')
+       !
+       ALLOCATE(maskV(nx,ny))
+       maskV(:,1:ny-1) = maskT(:,1:ny-1)*maskT(:,2:ny)
+       maskV(:,ny) = maskT(:,ny)
+       WHERE(maskT > 0)
+          mask = .TRUE.
+       ELSEWHERE
+          mask = .FALSE.
+       END WHERE
+       DEALLOCATE(maskV,maskT)
+       !
+    END SELECT
+    !      
+  END SUBROUTINE get_mask
+  !
+  !*****************************************************
+  !   end subroutine get_mask
+  !*****************************************************
+  !       
+  !
+  !*****************************************************
+  !   subroutine read_dimg_var(unit,irec,field)
+  !*****************************************************
+  !
+  SUBROUTINE read_dimg_var(unit,irec,field,jpk)
+    !      
+    INTEGER :: unit,irec,jpk
+    REAL*8,DIMENSION(:,:,:,:),POINTER :: field
+    INTEGER :: k
+    !      
+    DO k = 1,jpk
+       READ(unit,REC=irec) field(:,:,k,1)
+       irec = irec + 1
+    ENDDO
+    !
+  END SUBROUTINE read_dimg_var
+  ! 
+  !
+  !*****************************************************
+  !   subroutine read_dimg_var(unit,irec,field)
+  !*****************************************************
+  !
+  SUBROUTINE write_dimg_var(unit,irec,field,jpk)
+    !      
+    INTEGER :: unit,irec,jpk
+    REAL*8,DIMENSION(:,:,:,:),POINTER :: field
+    INTEGER :: k
+    !      
+    DO k = 1,jpk
+       WRITE(unit,REC=irec) field(:,:,k,1)
+       irec = irec + 1
+    ENDDO
+    !
+  END SUBROUTINE write_dimg_var
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!             
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+END MODULE agrif_readwrite
Index: trunk/NEMOGCM/TOOLS/NESTING/src/agrif_types.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/NESTING/src/agrif_types.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/NESTING/src/agrif_types.f90	(revision 2528)
@@ -0,0 +1,229 @@
+!************************************************************************
+! Fortran 95 OPA Nesting tools						*
+!									*
+!     Copyright (C) 2005 Florian Lemarié (Florian.Lemarie@imag.fr)	*
+!									*
+!************************************************************************
+!      
+MODULE agrif_types
+  !
+  PUBLIC
+  !   
+  !*****************************
+  ! Coordinates type definition 
+  !*****************************
+  TYPE Coordinates
+     !
+     REAL*8, DIMENSION(:,:), POINTER :: nav_lon,nav_lat => NULL()
+     REAL*8, DIMENSION(:,:), POINTER :: glamv, glamu, glamt, glamf => NULL()
+     REAL*8, DIMENSION(:,:), POINTER :: gphit, gphiu, gphiv, gphif => NULL()
+     REAL*8, DIMENSION(:,:), POINTER :: e1t, e1u, e1v, e1f => NULL()
+     REAL*8, DIMENSION(:,:), POINTER :: e2t, e2u, e2v, e2f => NULL()
+     REAL*8, DIMENSION(:,:), POINTER :: bathy_level => NULL()
+     REAL*8, DIMENSION(:,:), POINTER :: bathy_meter => NULL()
+     REAL*8, DIMENSION(:,:,:),POINTER :: fmask,umask,vmask,tmask => NULL()
+     REAL*8, DIMENSION(:,:,:),POINTER :: e3t_ps,e3w_ps,gdept_ps,gdepwps => NULL()
+     REAL*8, DIMENSION(:,:),POINTER :: gdepw_ps => NULL()
+     REAL*8, DIMENSION(:), POINTER :: gdeptht => NULL()
+     INTEGER, DIMENSION(:) , POINTER :: time_steps => NULL()
+     !     
+  END TYPE Coordinates
+  !
+  !
+  !
+  CHARACTER*8,DIMENSION(10) :: flxtab = (/'socliot1','socliot2','socliopl',&
+       'socliocl','socliohu','socliowi','soshfldo','sohefldo','sowaflup','sofbt   '/)
+  !
+  !
+  !**************************************************************
+  ! Declaration of various input file variables (namelist.input) 
+  !**************************************************************
+  !
+  INTEGER irafx,irafy
+  INTEGER nxfin,nyfin
+  INTEGER, PARAMETER :: nbghostcellsfine = 2
+  INTEGER, PARAMETER :: nbghostcellscoarse = 1
+  !      
+  INTEGER imin,jmin,imax,jmax,rho,rhot
+  INTEGER shlat
+  INTEGER N,type_bathy_interp
+  ! 
+  INTEGER jpizoom,jpjzoom,nb_connection_pts
+  !      
+  REAL*8 ppacr,ppdzmin,pphmax,ppkth,smoothing_factor,e3zps_min,e3zps_rat
+  REAL*8 psur,pa0,pa1,adatrj
+  !       
+  LOGICAL partial_steps,smoothing,bathy_update
+  LOGICAL new_topo,removeclosedseas,dimg,iom_activated
+  !       
+  CHARACTER*100 parent_meshmask_file,elevation_database,parent_bathy_meter
+  CHARACTER*100 elevation_name,parent_batmet_name
+  CHARACTER*100 parent_coordinate_file,restart_file,updated_parent_file,restart_trc_file
+  CHARACTER*100 dimg_output_file,interp_type
+  !      
+  CHARACTER(len=80),DIMENSION(20) :: flx_Files, u_files, v_files
+  CHARACTER(len=255),DIMENSION(20) :: VAR_INTERP
+  !
+  NAMELIST /input_output/iom_activated
+  !
+  NAMELIST /coarse_grid_files/parent_coordinate_file,parent_meshmask_file
+  !      
+  NAMELIST /bathymetry/new_topo,elevation_database,elevation_name,smoothing,smoothing_factor, &
+       nb_connection_pts,removeclosedseas,type_bathy_interp      
+  !      
+  NAMELIST /nesting/imin,imax,jmin,jmax,rho,rhot,bathy_update,updated_parent_file      
+  !
+  NAMELIST /vertical_grid/ppkth,ppacr,ppdzmin,pphmax,psur,pa0,pa1,N
+  ! 
+  NAMELIST /partial_cells/partial_steps,parent_bathy_meter,parent_batmet_name,e3zps_min,e3zps_rat      
+  !
+  NAMELIST /nemo_coarse_grid/ jpizoom,jpjzoom 
+  !          
+  NAMELIST /forcing_files/ flx_files, u_files, v_files 
+  !           
+  NAMELIST /interp/ VAR_INTERP
+  !      
+  NAMELIST /restart/ restart_file,shlat,dimg,dimg_output_file,adatrj,interp_type 
+
+  NAMELIST /restart_trc/ restart_trc_file,interp_type 
+
+  INTEGER :: connectionsize = 3
+  !
+CONTAINS
+  !
+  !********************************************************
+  !subroutine agrif_grid_allocate				*
+  !							*
+  !allocation of grid type elements 			*
+  !      according to nx and ny				*
+  !							*
+  !							*
+  !********************************************************
+  !       
+  SUBROUTINE agrif_grid_allocate(Grid,nx,ny)
+    !
+    TYPE(Coordinates) :: Grid
+    INTEGER :: nx,ny
+    !
+    ALLOCATE(Grid%nav_lon(nx,ny),Grid%nav_lat(nx,ny))
+    !
+    ALLOCATE(Grid%glamt(nx,ny),Grid%glamu(nx,ny),Grid%glamv(nx,ny),Grid%glamf(nx,ny))
+    ALLOCATE(Grid%gphit(nx,ny),Grid%gphiu(nx,ny),Grid%gphiv(nx,ny),Grid%gphif(nx,ny))
+    !
+    ALLOCATE(Grid%e1t(nx,ny),Grid%e1u(nx,ny),Grid%e1v(nx,ny),Grid%e1f(nx,ny))
+    ALLOCATE(Grid%e2t(nx,ny),Grid%e2u(nx,ny),Grid%e2v(nx,ny),Grid%e2f(nx,ny))
+    !
+    ALLOCATE(Grid%bathy_level(nx,ny))
+    !
+  END SUBROUTINE agrif_grid_allocate
+  !
+  !
+  !************************************************************************
+  !									*
+  !   subroutine read_namelist						*
+  !									*
+  !   read variables contained in namelist.input file   			*
+  !   filled in by user 							*
+  !									*
+  !************************************************************************
+  !
+  SUBROUTINE read_namelist(namelistname)
+    !
+    IMPLICIT NONE
+    CHARACTER(len=80) :: namelistname
+    CHARACTER*255 :: output
+    LOGICAL :: is_it_there
+    INTEGER unit_nml
+    !      
+    FLX_FILES = '/NULL'
+    U_FILES = '/NULL'
+    V_FILES = '/NULL'
+    VAR_INTERP = 'NULL'
+    unit_nml = Agrif_Get_Unit()
+    !      
+    INQUIRE ( FILE = namelistname , EXIST = is_it_there )      
+    !
+    IF ( is_it_there ) THEN 
+       !
+       OPEN ( FILE   = namelistname , &
+            UNIT   =  unit_nml        , &
+            STATUS = 'OLD'            , &
+            FORM   = 'FORMATTED'      , &
+            ACTION = 'READ'           , &
+            ACCESS = 'SEQUENTIAL'     )	  
+       !
+       REWIND(unit_nml)
+       READ (unit_nml , NML = input_output)
+       READ (unit_nml , NML = coarse_grid_files)
+       READ (unit_nml , NML = bathymetry)	  
+       READ (unit_nml , NML = nesting) 
+       READ (unit_nml , NML = vertical_grid)
+       READ (unit_nml , NML = partial_cells)                    
+       READ (unit_nml , NML = nemo_coarse_grid ) 
+       READ (unit_nml , NML = forcing_files )  
+       READ (unit_nml , NML = interp )   
+       READ (unit_nml , NML = restart )
+       READ (unit_nml , NML = restart_trc )
+       CLOSE(unit_nml)
+       !	
+       irafx = rho
+       irafy = rho
+       imin = imin + jpizoom - 1
+       imax = imax + jpizoom - 1
+       jmin = jmin + jpjzoom - 1
+       jmax = jmax + jpjzoom - 1
+       !
+       nxfin = (imax-imin)*irafx+nbghostcellsfine*2
+       nyfin = (jmax-jmin)*irafy+nbghostcellsfine*2
+       !
+    ELSE
+       !
+       PRINT *,'namelist file ''',TRIM(namelistname),''' not found'
+       STOP	 
+       !
+    END IF
+    !
+    !
+  END SUBROUTINE read_namelist
+
+  INTEGER FUNCTION agrif_int(x)
+
+    REAL :: x
+    INTEGER ::i
+
+    i = FLOOR(x) + 1
+
+    IF( ABS(x - i).LE.0.0001 )THEN
+       agrif_int = i
+    ELSE
+       agrif_int = i-1
+    ENDIF
+
+  END FUNCTION agrif_int
+  !
+  !*************************************************
+  !   function Agrif_Get_Unit                             
+  !*************************************************
+  !
+
+  INTEGER FUNCTION Agrif_Get_Unit()
+    !
+    INTEGER n
+    LOGICAL op
+    INTEGER :: nunit
+    INTEGER :: iii,out,iiimax 
+    ! 
+    DO n = 7,1000
+       ! 
+       INQUIRE(Unit=n,Opened=op)
+       !
+       IF (.NOT.op) EXIT
+       !      
+    ENDDO
+    !
+    Agrif_Get_Unit=n
+    !
+    !
+  END FUNCTION Agrif_Get_Unit
+  !
+END MODULE agrif_types
Index: trunk/NEMOGCM/TOOLS/NESTING/src/bicubic_interp.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/NESTING/src/bicubic_interp.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/NESTING/src/bicubic_interp.f90	(revision 2528)
@@ -0,0 +1,1091 @@
+!
+MODULE bicubic_interp
+  !
+  USE agrif_modutil
+  !
+  !************************************************************************
+  ! 									*
+  ! MODULE  BICUBIC INTERP						*
+  ! 									*
+  ! bicubic interpolation routines from SCRIP package			*		
+  !									*
+  !http://climate.lanl.gov/Software/SCRIP/				*
+  !									*
+  !Bicubic remapping							*
+  !									*
+  !************************************************************************
+  !                 
+  IMPLICIT NONE
+  !
+  INTEGER :: grid1_size,grid2_size,grid1_rank, grid2_rank      
+  INTEGER, DIMENSION(:), POINTER :: grid1_dims, grid2_dims  
+  LOGICAL, DIMENSION(:), POINTER :: grid1_mask,grid2_mask        
+  REAL*8,DIMENSION(:),POINTER :: &
+       grid1_center_lat,  &
+       grid1_center_lon,  & 
+       grid2_center_lat,  &
+       grid2_center_lon,  &
+       grid1_frac,        & 
+       grid2_frac           
+  REAL*8,DIMENSION(:,:), POINTER :: grid1_bound_box,grid2_bound_box   
+  INTEGER, PARAMETER :: num_srch_bins = 90  
+  INTEGER,DIMENSION(:,:),POINTER :: bin_addr1,bin_addr2 
+  REAL*8, DIMENSION(:,:),POINTER :: bin_lats,bin_lons       
+  REAL*8, PARAMETER :: zero   = 0.0,  &
+       one    = 1.0,  &
+       two    = 2.0,  &
+       three  = 3.0,  &
+       four   = 4.0,  &
+       five   = 5.0,  & 
+       half   = 0.5,  &
+       quart  = 0.25, &
+       bignum = 1.e+20, &
+       tiny   = 1.e-14, &
+       pi     = 3.14159265359, &
+       pi2    = two*pi, &
+       pih    = half*pi        
+
+  REAL*8, PARAMETER :: deg2rad = pi/180.   
+  INTEGER , PARAMETER :: max_iter = 100   
+  REAL*8, PARAMETER :: converge = 1.e-10 
+  INTEGER, PARAMETER :: norm_opt_none    = 1 &
+       ,norm_opt_dstarea = 2 &
+       ,norm_opt_frcarea = 3
+  !
+  INTEGER, PARAMETER :: map_type_conserv  = 1 &
+       ,map_type_bilinear = 2 &
+       ,map_type_bicubic  = 3 &
+       ,map_type_distwgt  = 4
+  !
+  INTEGER :: max_links_map1  &  ! current size of link arrays
+       ,num_links_map1  &  ! actual number of links for remapping
+       ,max_links_map2  &  ! current size of link arrays
+       ,num_links_map2  &  ! actual number of links for remapping
+       ,num_maps        &  ! num of remappings for this grid pair
+       ,num_wts         &  ! num of weights used in remapping
+       ,map_type        &  ! identifier for remapping method
+       ,norm_opt        &  ! option for normalization (conserv only)
+       ,resize_increment ! default amount to increase array size
+
+  INTEGER , DIMENSION(:), POINTER :: &
+       bicubic_grid1_add_map1, &  ! grid1 address for each link in mapping 1
+       bicubic_grid2_add_map1, &  ! grid2 address for each link in mapping 1
+       grid1_add_map2, &  ! grid1 address for each link in mapping 2
+       grid2_add_map2   ! grid2 address for each link in mapping 2
+
+  REAL*8, DIMENSION(:,:), POINTER ::   &
+       bicubic_wts_map1, &   ! map weights for each link (num_wts,max_links)
+       wts_map2 => NULL()    ! map weights for each link (num_wts,max_links)
+
+
+
+
+
+
+CONTAINS
+
+
+
+
+
+
+
+  !***********************************************************************
+  SUBROUTINE get_remap_bicub(grid1_lat,grid2_lat,grid1_lon,grid2_lon,mask, &
+       remap_matrix,source_add,destination_add)
+
+    !-----------------------------------------------------------------------
+    !
+    !     this routine computes the weights for a bicubic interpolation.
+    !
+    !-----------------------------------------------------------------------
+    REAL*8,DIMENSION(:,:),POINTER :: grid1_lat,grid2_lat,grid1_lon,grid2_lon
+    LOGICAL,DIMENSION(:,:) :: mask
+    !      
+    INTEGER,DIMENSION(:),POINTER :: source_add,destination_add
+    REAL*8,DIMENSION(:,:),POINTER :: remap_matrix 
+    !-----------------------------------------------------------------------
+    !
+    !     local variables
+    !
+    !-----------------------------------------------------------------------
+
+    INTEGER :: n,icount,dst_add,iter,nx,ny,i,j,ip1,e_add,jp1,n_add,ne_add,nele
+    REAL*8, DIMENSION(4) :: tmp_lats, tmp_lons
+    INTEGER, DIMENSION(4) :: src_add
+
+    REAL*8, DIMENSION(4)  :: src_lats,src_lons
+    INTEGER lastsrc_add
+    REAL*8, DIMENSION(4,4)  :: wgts
+    REAL*8 :: dlat,dlon
+    REAL*8 :: plat, plon,iguess, jguess,thguess, phguess,deli, delj, &
+         dth1, dth2, dth3,dph1, dph2, dph3,dthp, dphp,          &
+         mat1, mat2, mat3, mat4,determinant,sum_wgts,           &
+         w1,w2,w3,w4,w5,w6,w7,w8,w9,w10,w11,w12,w13,w14,w15,w16
+
+
+    !-----------------------------------------------------------------------
+    !
+    !     compute mappings from grid1 to grid2
+    !
+    !-----------------------------------------------------------------------
+    !
+    ALLOCATE(grid1_dims(2),grid2_dims(2))
+    grid1_dims(1) = SIZE(grid1_lat,2)
+    grid1_dims(2) = SIZE(grid1_lat,1)
+    grid2_dims(1) = SIZE(grid2_lat,2)
+    grid2_dims(2) = SIZE(grid2_lat,1)
+    grid1_size = SIZE(grid1_lat,2) * SIZE(grid1_lat,1)
+    grid2_size = SIZE(grid2_lat,2) * SIZE(grid2_lat,1) 
+    !      
+    ALLOCATE( grid2_mask(grid2_size),         &
+         grid1_bound_box (4,grid1_size), &
+         grid2_bound_box (4,grid2_size), &
+         grid1_frac      (grid1_size),   &
+         grid2_frac      (grid2_size))
+
+    grid1_frac = zero
+    grid2_frac = zero
+
+    !
+    ! 2D array -> 1D array
+    !
+    ALLOCATE(grid1_center_lat(SIZE(grid1_lat,1)*SIZE(grid1_lat,2)))
+    CALL tab2Dto1D(grid1_lat,grid1_center_lat)
+
+    ALLOCATE(grid1_center_lon(SIZE(grid1_lon,1)*SIZE(grid1_lon,2)))
+    CALL tab2Dto1D(grid1_lon,grid1_center_lon)
+
+    ALLOCATE(grid2_center_lat(SIZE(grid2_lat,1)*SIZE(grid2_lat,2)))
+    CALL tab2Dto1D(grid2_lat,grid2_center_lat)
+
+    ALLOCATE(grid2_center_lon(SIZE(grid2_lon,1)*SIZE(grid2_lon,2)))      
+    CALL tab2Dto1D(grid2_lon,grid2_center_lon) 
+
+    ALLOCATE(grid1_mask(SIZE(grid1_lat,1)*SIZE(grid1_lat,2)))
+    CALL logtab2Dto1D(mask,grid1_mask)
+    !      
+    !      Write(*,*) ,'grid1_mask = ',grid1_mask 
+    !              
+    !
+    ! degrees to radian
+    !
+    grid1_center_lat = grid1_center_lat*deg2rad
+    grid1_center_lon = grid1_center_lon*deg2rad
+    grid2_center_lat = grid2_center_lat*deg2rad
+    grid2_center_lon = grid2_center_lon*deg2rad
+
+    !-----------------------------------------------------------------------
+    !     convert longitudes to 0,2pi interval
+    !-----------------------------------------------------------------------
+
+    WHERE (grid1_center_lon .GT. pi2)  grid1_center_lon =       &
+         grid1_center_lon - pi2
+    WHERE (grid1_center_lon .LT. zero) grid1_center_lon =       &
+         grid1_center_lon + pi2
+    WHERE (grid2_center_lon .GT. pi2)  grid2_center_lon =       &
+         grid2_center_lon - pi2
+    WHERE (grid2_center_lon .LT. zero) grid2_center_lon =       &
+         grid2_center_lon + pi2
+
+    !-----------------------------------------------------------------------
+    !
+    !     make sure input latitude range is within the machine values
+    !     for +/- pi/2 
+    !
+    !-----------------------------------------------------------------------
+
+    WHERE (grid1_center_lat >  pih) grid1_center_lat =  pih
+    WHERE (grid1_center_lat < -pih) grid1_center_lat = -pih
+    WHERE (grid2_center_lat >  pih) grid2_center_lat =  pih
+    WHERE (grid2_center_lat < -pih) grid2_center_lat = -pih
+    !
+
+    !
+    !-----------------------------------------------------------------------
+    !
+    !     compute bounding boxes for restricting future grid searches
+    !
+    !-----------------------------------------------------------------------
+    !
+    nx = grid1_dims(1)
+    ny = grid1_dims(2)
+
+    DO n=1,grid1_size
+
+       !*** find N,S and NE points to this grid point
+
+       j = (n - 1)/nx +1
+       i = n - (j-1)*nx
+
+       IF (i < nx) THEN
+          ip1 = i + 1
+       ELSE
+          !*** assume cyclic
+          ip1 = 1
+          !*** but if it is not, correct
+          e_add = (j - 1)*nx + ip1
+          IF (ABS(grid1_center_lat(e_add) -     &
+               grid1_center_lat(n   )) > pih) THEN
+             ip1 = i
+          ENDIF
+          ip1=nx
+       ENDIF
+
+       IF (j < ny) THEN
+          jp1 = j+1
+       ELSE
+          !*** assume cyclic
+          jp1 = 1
+          !*** but if it is not, correct
+          n_add = (jp1 - 1)*nx + i
+          IF (ABS(grid1_center_lat(n_add) -             &
+               grid1_center_lat(n   )) > pih) THEN
+             jp1 = j
+          ENDIF
+          jp1=ny
+       ENDIF
+
+       n_add = (jp1 - 1)*nx + i
+       e_add = (j - 1)*nx + ip1
+       ne_add = (jp1 - 1)*nx + ip1
+
+       !*** find N,S and NE lat/lon coords and check bounding box
+
+       tmp_lats(1) = grid1_center_lat(n)
+       tmp_lats(2) = grid1_center_lat(e_add)
+       tmp_lats(3) = grid1_center_lat(ne_add)
+       tmp_lats(4) = grid1_center_lat(n_add)
+
+       tmp_lons(1) = grid1_center_lon(n)
+       tmp_lons(2) = grid1_center_lon(e_add)
+       tmp_lons(3) = grid1_center_lon(ne_add)
+       tmp_lons(4) = grid1_center_lon(n_add)
+
+       grid1_bound_box(1,n) = MINVAL(tmp_lats)
+       grid1_bound_box(2,n) = MAXVAL(tmp_lats)
+
+       grid1_bound_box(3,n) = MINVAL(tmp_lons)
+       grid1_bound_box(4,n) = MAXVAL(tmp_lons)
+    END DO
+
+    nx = grid2_dims(1)
+    ny = grid2_dims(2)
+
+    DO n=1,grid2_size
+
+       !*** find N,S and NE points to this grid point
+
+       j = (n - 1)/nx +1
+       i = n - (j-1)*nx
+
+       IF (i < nx) THEN
+          ip1 = i + 1
+       ELSE
+          !*** assume cyclic
+          ip1 = 1
+          !*** but if it is not, correct
+          e_add = (j - 1)*nx + ip1
+          IF (ABS(grid2_center_lat(e_add) -  &
+               grid2_center_lat(n   )) > pih) THEN
+             ip1 = i
+          ENDIF
+       ENDIF
+
+       IF (j < ny) THEN
+          jp1 = j+1
+       ELSE
+          !*** assume cyclic
+          jp1 = 1
+          !*** but if it is not, correct
+          n_add = (jp1 - 1)*nx + i
+          IF (ABS(grid2_center_lat(n_add) -  &
+               grid2_center_lat(n   )) > pih) THEN
+             jp1 = j
+          ENDIF
+       ENDIF
+
+       n_add = (jp1 - 1)*nx + i
+       e_add = (j - 1)*nx + ip1
+       ne_add = (jp1 - 1)*nx + ip1
+
+       !*** find N,S and NE lat/lon coords and check bounding box
+
+       tmp_lats(1) = grid2_center_lat(n)
+       tmp_lats(2) = grid2_center_lat(e_add)
+       tmp_lats(3) = grid2_center_lat(ne_add)
+       tmp_lats(4) = grid2_center_lat(n_add)
+
+       tmp_lons(1) = grid2_center_lon(n)
+       tmp_lons(2) = grid2_center_lon(e_add)
+       tmp_lons(3) = grid2_center_lon(ne_add)
+       tmp_lons(4) = grid2_center_lon(n_add)
+
+       grid2_bound_box(1,n) = MINVAL(tmp_lats)
+       grid2_bound_box(2,n) = MAXVAL(tmp_lats)
+       grid2_bound_box(3,n) = MINVAL(tmp_lons)
+       grid2_bound_box(4,n) = MAXVAL(tmp_lons)
+    END DO
+    !
+    !
+    !
+    WHERE (ABS(grid1_bound_box(4,:) - grid1_bound_box(3,:)) > pi)
+       grid1_bound_box(3,:) = zero
+       grid1_bound_box(4,:) = pi2
+    END WHERE
+
+    WHERE (ABS(grid2_bound_box(4,:) - grid2_bound_box(3,:)) > pi)
+       grid2_bound_box(3,:) = zero
+       grid2_bound_box(4,:) = pi2
+    END WHERE
+
+    !***
+    !*** try to check for cells that overlap poles
+    !***
+
+    WHERE (grid1_center_lat > grid1_bound_box(2,:)) &
+         grid1_bound_box(2,:) = pih
+
+    WHERE (grid1_center_lat < grid1_bound_box(1,:)) &
+         grid1_bound_box(1,:) = -pih
+
+    WHERE (grid2_center_lat > grid2_bound_box(2,:)) &
+         grid2_bound_box(2,:) = pih
+
+    WHERE (grid2_center_lat < grid2_bound_box(1,:)) &
+         grid2_bound_box(1,:) = -pih
+
+    !-----------------------------------------------------------------------
+    !     set up and assign address ranges to search bins in order to 
+    !     further restrict later searches
+    !-----------------------------------------------------------------------
+
+    ALLOCATE(bin_addr1(2,num_srch_bins))
+    ALLOCATE(bin_addr2(2,num_srch_bins))
+    ALLOCATE(bin_lats (2,num_srch_bins))
+    ALLOCATE(bin_lons (2,num_srch_bins))
+
+    dlat = pi/num_srch_bins
+
+    DO n=1,num_srch_bins
+       bin_lats(1,n) = (n-1)*dlat - pih
+       bin_lats(2,n) =     n*dlat - pih
+       bin_lons(1,n) = zero
+       bin_lons(2,n) = pi2
+       bin_addr1(1,n) = grid1_size + 1
+       bin_addr1(2,n) = 0
+       bin_addr2(1,n) = grid2_size + 1
+       bin_addr2(2,n) = 0
+    END DO
+
+    DO nele=1,grid1_size
+       DO n=1,num_srch_bins
+          IF (grid1_bound_box(1,nele) <= bin_lats(2,n) .AND.   &
+               grid1_bound_box(2,nele) >= bin_lats(1,n)) THEN
+             bin_addr1(1,n) = MIN(nele,bin_addr1(1,n))
+             bin_addr1(2,n) = MAX(nele,bin_addr1(2,n))
+          ENDIF
+       END DO
+    END DO
+
+    DO nele=1,grid2_size
+       DO n=1,num_srch_bins
+          IF (grid2_bound_box(1,nele) <= bin_lats(2,n) .AND.    &
+               grid2_bound_box(2,nele) >= bin_lats(1,n)) THEN
+             bin_addr2(1,n) = MIN(nele,bin_addr2(1,n))
+             bin_addr2(2,n) = MAX(nele,bin_addr2(2,n))
+          ENDIF
+       END DO
+    END DO
+
+    CALL init_remap_vars    
+    !
+    !***
+    !*** loop over destination grid 
+    !***
+    !      
+    grid2_mask = .TRUE.
+    !
+    lastsrc_add=1
+    !         
+    WRITE(*,*) 'Bicubic remapping weights computation'
+    !      
+    DO dst_add = 1, grid2_size
+
+       plat = grid2_center_lat(dst_add)
+       plon = grid2_center_lon(dst_add)         
+       !           
+       !           
+       CALL grid_search_bicub(src_add, src_lats, src_lons,     &
+            plat, plon, grid1_dims,              &
+            grid1_center_lat, grid1_center_lon,  &
+            grid1_bound_box, bin_addr1, bin_addr2,lastsrc_add)
+       !        
+       !           
+       IF (src_add(1) > 0) THEN
+          DO n=1,4
+             IF (.NOT. grid1_mask(src_add(n))) src_add(1) = 0
+          END DO
+       ENDIF
+
+       !-----------------------------------------------------------------------
+       !
+       !       if point found, find local i,j coordinates for weights
+       !
+       !-----------------------------------------------------------------------
+
+       IF (src_add(1) > 0) THEN
+
+          grid2_frac(dst_add) = one
+          !
+          dth1 = src_lats(2) - src_lats(1)
+          dth2 = src_lats(4) - src_lats(1)
+          dth3 = src_lats(3) - src_lats(2) - dth2
+
+          dph1 = src_lons(2) - src_lons(1)
+          dph2 = src_lons(4) - src_lons(1)
+          dph3 = src_lons(3) - src_lons(2)
+
+          IF (dph1 >  three*pih) dph1 = dph1 - pi2
+          IF (dph2 >  three*pih) dph2 = dph2 - pi2
+          IF (dph3 >  three*pih) dph3 = dph3 - pi2
+          IF (dph1 < -three*pih) dph1 = dph1 + pi2
+          IF (dph2 < -three*pih) dph2 = dph2 + pi2
+          IF (dph3 < -three*pih) dph3 = dph3 + pi2
+
+          dph3 = dph3 - dph2
+          iguess = half
+          jguess = half
+
+          DO iter=1,max_iter
+
+             dthp = plat-src_lats(1)-dth1*iguess- &
+                  dth2*jguess-dth3*iguess*jguess
+             dphp = plon - src_lons(1)
+
+             IF (dphp >  three*pih) dphp = dphp - pi2
+             IF (dphp < -three*pih) dphp = dphp + pi2
+
+             dphp = dphp - dph1*iguess - dph2*jguess - & 
+                  dph3*iguess*jguess
+             !
+             mat1 = dth1 + dth3*jguess
+             mat2 = dth2 + dth3*iguess
+             mat3 = dph1 + dph3*jguess
+             mat4 = dph2 + dph3*iguess
+             !
+             determinant = mat1*mat4 - mat2*mat3
+             !
+             deli = (dthp*mat4 - mat2*dphp)/determinant
+             delj = (mat1*dphp - dthp*mat3)/determinant
+             !
+             IF (ABS(deli) < converge .AND.            & 
+                  ABS(delj) < converge) EXIT
+             !
+             iguess = iguess + deli
+             jguess = jguess + delj
+
+          END DO
+
+          IF (iter <= max_iter) THEN
+             !
+             wgts(1,1) = (one - jguess**2*(three-two*jguess))*   &
+                  (one - iguess**2*(three-two*iguess))
+
+             wgts(1,2) = (one - jguess**2*(three-two*jguess))*   &
+                  iguess**2*(three-two*iguess)
+
+             wgts(1,3) = jguess**2*(three-two*jguess)*           &
+                  iguess**2*(three-two*iguess)
+
+             wgts(1,4) = jguess**2*(three-two*jguess)*           &
+                  (one - iguess**2*(three-two*iguess))
+
+             wgts(2,1) = (one - jguess**2*(three-two*jguess))*   &
+                  iguess*(iguess-one)**2
+
+             wgts(2,2) = (one - jguess**2*(three-two*jguess))*   &
+                  iguess**2*(iguess-one)
+
+             wgts(2,3) = jguess**2*(three-two*jguess)*           &
+                  iguess**2*(iguess-one)
+
+             wgts(2,4) =  jguess**2*(three-two*jguess)*          &
+                  iguess*(iguess-one)**2
+
+             wgts(3,1) =  jguess*(jguess-one)**2*                &
+                  (one - iguess**2*(three-two*iguess))
+
+             wgts(3,2) =  jguess*(jguess-one)**2*                &
+                  iguess**2*(three-two*iguess)                            
+
+             wgts(3,3) =  jguess**2*(jguess-one)*                &
+                  iguess**2*(three-two*iguess)
+
+             wgts(3,4) =  jguess**2*(jguess-one)*                &
+                  (one - iguess**2*(three-two*iguess))
+
+             wgts(4,1) =  iguess*(iguess-one)**2*                &
+                  jguess*(jguess-one)**2
+
+             wgts(4,2) =  iguess**2*(iguess-one)*                &
+                  jguess*(jguess-one)**2
+
+             wgts(4,3) =  iguess**2*(iguess-one)*                &
+                  jguess**2*(jguess-one)
+
+             wgts(4,4) =  iguess*(iguess-one)**2*                &
+                  jguess**2*(jguess-one)
+
+             CALL store_link_bicub(dst_add, src_add, wgts)
+
+          ELSE
+             STOP 'Iteration for i,j exceed max iteration count'
+          ENDIF
+          !
+       ELSE IF (src_add(1) < 0) THEN
+
+          src_add = ABS(src_add)
+          !
+          icount = 0
+          !          
+          DO n=1,4
+             IF (grid1_mask(src_add(n))) THEN
+                icount = icount + 1
+             ELSE
+                src_lats(n) = zero
+             ENDIF
+          END DO
+
+          IF (icount > 0) THEN
+
+             sum_wgts = SUM(src_lats)
+             wgts(1,1) = src_lats(1)/sum_wgts
+             wgts(1,2) = src_lats(2)/sum_wgts
+             wgts(1,3) = src_lats(3)/sum_wgts
+             wgts(1,4) = src_lats(4)/sum_wgts
+             wgts(2:4,:) = zero
+
+             CALL store_link_bicub(dst_add, src_add, wgts)
+
+          ENDIF
+
+       ENDIF
+       !
+    END DO
+    !              
+    ALLOCATE(remap_matrix(SIZE(bicubic_wts_map1,1),SIZE(bicubic_wts_map1,2)), &
+         source_add(num_links_map1),       &
+         destination_add(num_links_map1))
+
+    DO j = 1,SIZE(bicubic_wts_map1,2)
+       DO i = 1,SIZE(bicubic_wts_map1,1)
+
+          remap_matrix(i,j) = bicubic_wts_map1(i,j)
+
+       END DO
+    END DO
+    !        
+    source_add(:) = bicubic_grid1_add_map1(1:num_links_map1)
+    destination_add(:) = bicubic_grid2_add_map1(1:num_links_map1)
+    !                
+    !
+    WHERE(destination_add == 0)
+       destination_add = 1
+    END WHERE
+
+    WHERE(source_add == 0)
+       source_add = 1
+    END WHERE
+    !               
+    DEALLOCATE(grid1_bound_box,grid2_bound_box,grid1_center_lat,grid1_center_lon)
+    DEALLOCATE(grid2_center_lat,grid2_center_lon,bicubic_grid1_add_map1,bicubic_wts_map1)
+    DEALLOCATE(grid1_frac,grid2_frac,grid1_dims,grid2_dims,grid2_mask)
+    DEALLOCATE(bin_addr1,bin_addr2,bin_lats,bin_lons)
+    DEALLOCATE(grid1_mask,bicubic_grid2_add_map1)	
+    !
+    !-----------------------------------------------------------------------
+
+  END SUBROUTINE get_remap_bicub
+
+  !
+  !***********************************************************************
+
+  !***********************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !************************************************************************
+  !   SUBROUTINE GRID_SEARCH_BILIN
+  !************************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  SUBROUTINE grid_search_bicub(src_add, src_lats, src_lons,   &
+       plat, plon, src_grid_dims,      &
+       src_center_lat, src_center_lon, & 
+       src_grid_bound_box,             &
+       src_bin_add, dst_bin_add,lastsrc_add)
+
+    !-----------------------------------------------------------------------
+    !
+    !     this routine finds the location of the search point plat, plon
+    !     in the source grid and returns the corners needed for a bilinear
+    !     interpolation.
+    !
+    !-----------------------------------------------------------------------
+
+    !-----------------------------------------------------------------------
+    !     output variables
+    !-----------------------------------------------------------------------
+    !
+    ! address of each corner point enclosing P
+    !
+    INTEGER,DIMENSION(4) :: src_add  
+    REAL*8,DIMENSION(4) :: src_lats,src_lons  
+    !      
+    !-----------------------------------------------------------------------
+    !     input variables
+    !-----------------------------------------------------------------------
+    ! 
+    ! latitude, longitude of the search point
+    !
+    REAL*8, INTENT(in) :: plat,plon   
+    !
+    ! size of each src grid dimension
+    !
+    INTEGER, DIMENSION(2), INTENT(in) :: src_grid_dims  
+    !
+    ! latitude, longitude of each src grid center
+    !
+    REAL*8, DIMENSION(:), INTENT(in) :: src_center_lat,src_center_lon  
+    !
+    ! bound box for source grid
+    !
+    REAL*8, DIMENSION(:,:), INTENT(in) :: src_grid_bound_box 
+    !
+    ! latitude bins for restricting searches
+    !
+    INTEGER, DIMENSION(:,:), INTENT(in) ::src_bin_add,dst_bin_add 
+
+    INTEGER,OPTIONAL :: lastsrc_add
+    INTEGER :: loopsrc,l1,l2
+    !      
+    !-----------------------------------------------------------------------
+    !     local variables
+    !-----------------------------------------------------------------------
+    !
+    INTEGER :: n,next_n,srch_add,nx, ny,min_add, max_add,  &
+         i, j, jp1, ip1, n_add, e_add, ne_add
+
+
+    REAL*8 ::  vec1_lat, vec1_lon,vec2_lat, vec2_lon, cross_product,  &
+         cross_product_last,coslat_dst, sinlat_dst, coslon_dst, &
+         sinlon_dst,dist_min, distance 
+
+    !-----------------------------------------------------------------------
+    !     restrict search first using bins
+    !-----------------------------------------------------------------------
+
+    src_add = 0
+    min_add = SIZE(src_center_lat)
+    max_add = 1
+    DO n=1,num_srch_bins
+       IF (plat >= bin_lats(1,n) .AND. plat <= bin_lats(2,n) .AND. &
+            plon >= bin_lons(1,n) .AND. plon <= bin_lons(2,n)) THEN
+          min_add = MIN(min_add, src_bin_add(1,n))
+          max_add = MAX(max_add, src_bin_add(2,n))
+       ENDIF
+    END DO
+
+    !-----------------------------------------------------------------------
+    !     now perform a more detailed search 
+    !-----------------------------------------------------------------------
+
+    nx = src_grid_dims(1)
+    ny = src_grid_dims(2)
+
+    loopsrc=0
+    DO WHILE (loopsrc <= max_add)
+
+
+       l1=MAX(min_add,lastsrc_add-loopsrc)
+       l2=MIN(max_add,lastsrc_add+loopsrc)      
+
+       loopsrc = loopsrc+1
+
+       srch_loop: DO srch_add = l1,l2,MAX(l2-l1,1)
+
+          !*** first check bounding box
+
+          IF (plat <= src_grid_bound_box(2,srch_add) .AND. & 
+               plat >= src_grid_bound_box(1,srch_add) .AND.  &
+               plon <= src_grid_bound_box(4,srch_add) .AND.  &
+               plon >= src_grid_bound_box(3,srch_add)) THEN
+
+
+             !***
+             !*** we are within bounding box so get really serious
+             !***
+             !*** determine neighbor addresses
+             !
+             j = (srch_add - 1)/nx +1
+             i = srch_add - (j-1)*nx
+             !
+             IF (i < nx) THEN
+                ip1 = i + 1
+             ELSE
+                ip1 = 1
+             ENDIF
+             !
+             IF (j < ny) THEN
+                jp1 = j+1
+             ELSE
+                jp1 = 1
+             ENDIF
+             !
+             n_add = (jp1 - 1)*nx + i
+             e_add = (j - 1)*nx + ip1
+             ne_add = (jp1 - 1)*nx + ip1
+             !
+             src_lats(1) = src_center_lat(srch_add)
+             src_lats(2) = src_center_lat(e_add)
+             src_lats(3) = src_center_lat(ne_add)
+             src_lats(4) = src_center_lat(n_add)
+             !
+             src_lons(1) = src_center_lon(srch_add)
+             src_lons(2) = src_center_lon(e_add)
+             src_lons(3) = src_center_lon(ne_add)
+             src_lons(4) = src_center_lon(n_add)
+             !
+             !***
+             !*** for consistency, we must make sure all lons are in
+             !*** same 2pi interval
+             !***
+             !
+             vec1_lon = src_lons(1) - plon
+             IF (vec1_lon >  pi) THEN
+                src_lons(1) = src_lons(1) - pi2
+             ELSE IF (vec1_lon < -pi) THEN
+                src_lons(1) = src_lons(1) + pi2
+             ENDIF
+             DO n=2,4
+                vec1_lon = src_lons(n) - src_lons(1)
+                IF (vec1_lon >  pi) THEN
+                   src_lons(n) = src_lons(n) - pi2
+                ELSE IF (vec1_lon < -pi) THEN
+                   src_lons(n) = src_lons(n) + pi2
+                ENDIF
+             END DO
+             !
+             corner_loop: DO n=1,4
+                next_n = MOD(n,4) + 1
+                !***
+                !*** here we take the cross product of the vector making 
+                !*** up each box side with the vector formed by the vertex
+                !*** and search point.  if all the cross products are 
+                !*** positive, the point is contained in the box.
+                !***
+                vec1_lat = src_lats(next_n) - src_lats(n)
+                vec1_lon = src_lons(next_n) - src_lons(n)
+                vec2_lat = plat - src_lats(n)
+                vec2_lon = plon - src_lons(n)
+                !***
+                !*** check for 0,2pi crossings
+                !***
+                IF (vec1_lon >  three*pih) THEN
+                   vec1_lon = vec1_lon - pi2
+                ELSE IF (vec1_lon < -three*pih) THEN
+                   vec1_lon = vec1_lon + pi2
+                ENDIF
+                IF (vec2_lon >  three*pih) THEN
+                   vec2_lon = vec2_lon - pi2
+                ELSE IF (vec2_lon < -three*pih) THEN
+                   vec2_lon = vec2_lon + pi2
+                ENDIF
+                !
+                cross_product = vec1_lon*vec2_lat - vec2_lon*vec1_lat
+                !
+                !***
+                !*** if cross product is less than zero, this cell
+                !*** doesn't work
+                !***
+                IF (n == 1) cross_product_last = cross_product
+                IF (cross_product*cross_product_last < zero) &
+                     EXIT corner_loop
+                cross_product_last = cross_product
+                !
+             END DO corner_loop
+             !***
+             !*** if cross products all same sign, we found the location
+             !***
+             IF (n > 4) THEN
+                src_add(1) = srch_add
+                src_add(2) = e_add
+                src_add(3) = ne_add
+                src_add(4) = n_add
+                !
+                lastsrc_add = srch_add
+                RETURN
+             ENDIF
+             !***
+             !*** otherwise move on to next cell
+             !***
+          ENDIF !bounding box check
+       END DO srch_loop
+
+
+    ENDDO
+
+    !***
+    !*** if no cell found, point is likely either in a box that
+    !*** straddles either pole or is outside the grid.  fall back
+    !*** to a distance-weighted average of the four closest
+    !*** points.  go ahead and compute weights here, but store
+    !*** in src_lats and return -add to prevent the parent
+    !*** routine from computing bilinear weights
+    !***
+    !print *,'Could not find location for ',plat,plon
+    !print *,'Using nearest-neighbor average for this point'
+    !
+    coslat_dst = COS(plat)
+    sinlat_dst = SIN(plat)
+    coslon_dst = COS(plon)
+    sinlon_dst = SIN(plon)
+    !
+    dist_min = bignum
+    src_lats = bignum
+    DO srch_add = min_add,max_add
+       distance = ACOS(coslat_dst*COS(src_center_lat(srch_add))*   &
+            (coslon_dst*COS(src_center_lon(srch_add)) +   &
+            sinlon_dst*SIN(src_center_lon(srch_add)))+   &
+            sinlat_dst*SIN(src_center_lat(srch_add)))
+
+       IF (distance < dist_min) THEN
+          sort_loop: DO n=1,4
+             IF (distance < src_lats(n)) THEN
+                DO i=4,n+1,-1
+                   src_add (i) = src_add (i-1)
+                   src_lats(i) = src_lats(i-1)
+                END DO
+                src_add (n) = -srch_add
+                src_lats(n) = distance
+                dist_min = src_lats(4)
+                EXIT sort_loop
+             ENDIF
+          END DO sort_loop
+       ENDIF
+    END DO
+    !
+    src_lons = one/(src_lats + tiny)
+    distance = SUM(src_lons)
+    src_lats = src_lons/distance
+
+    !-----------------------------------------------------------------------
+
+  END SUBROUTINE grid_search_bicub
+
+
+
+
+
+
+
+
+
+
+
+
+
+  !-----------------------------------------------------------------------
+
+  SUBROUTINE store_link_bicub(dst_add, src_add, weights)
+
+    !-----------------------------------------------------------------------
+    !
+    !     this routine stores the address and weight for four links 
+    !     associated with one destination point in the appropriate address 
+    !     and weight arrays and resizes those arrays if necessary.
+    !
+    !-----------------------------------------------------------------------
+
+    !-----------------------------------------------------------------------
+    !
+    !     input variables
+    !
+    !-----------------------------------------------------------------------
+
+    INTEGER :: dst_add
+    INTEGER, DIMENSION(4) :: src_add
+    REAL*8, DIMENSION(4,4) :: weights 
+
+    !-----------------------------------------------------------------------
+    !
+    !     local variables
+    !
+    !-----------------------------------------------------------------------
+
+    INTEGER :: n,num_links_old
+
+    !-----------------------------------------------------------------------
+    !
+    !     increment number of links and check to see if remap arrays need
+    !     to be increased to accomodate the new link.  then store the
+    !     link.
+    !
+    !-----------------------------------------------------------------------
+
+
+    num_links_old  = num_links_map1
+    num_links_map1 = num_links_old + 4
+
+    IF (num_links_map1 > max_links_map1)    & 
+         CALL resize_remap_vars(resize_increment)
+
+    DO n=1,4
+       bicubic_grid1_add_map1(num_links_old+n) = src_add(n)
+       bicubic_grid2_add_map1(num_links_old+n) = dst_add
+       bicubic_wts_map1    (:,num_links_old+n) = weights(:,n)
+    END DO
+
+
+
+
+
+    !-----------------------------------------------------------------------
+
+  END SUBROUTINE store_link_bicub
+
+  !***********************************************************************
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+  !
+  !************************************************************************
+  !   SUBROUTINE INIT_REMAP_VAR
+  !************************************************************************
+  !
+  SUBROUTINE init_remap_vars
+    !
+    num_wts = 4
+    !
+    num_links_map1 = 0
+    max_links_map1 = 4*grid2_size
+    IF (num_maps > 1) THEN
+       num_links_map2 = 0
+       max_links_map1 = MAX(4*grid1_size,4*grid2_size)
+       max_links_map2 = max_links_map1
+    ENDIF
+
+    resize_increment = 0.1*MAX(grid1_size,grid2_size)
+    !
+    !-----------------------------------------------------------------------
+    !
+    !     allocate address and weight arrays for mapping 1
+    !   
+    !-----------------------------------------------------------------------
+    !
+    ALLOCATE (bicubic_grid1_add_map1(max_links_map1),  &
+         bicubic_grid2_add_map1(max_links_map1),  &
+         bicubic_wts_map1(num_wts, max_links_map1))
+
+    !-----------------------------------------------------------------------
+    !
+    !     allocate address and weight arrays for mapping 2 if necessary 
+    !   
+    !-----------------------------------------------------------------------
+
+    IF (num_maps > 1) THEN
+       ALLOCATE (grid1_add_map2(max_links_map2),    &
+            grid2_add_map2(max_links_map2),    &
+            wts_map2(num_wts, max_links_map2))
+    ENDIF
+
+    !-----------------------------------------------------------------------
+
+  END SUBROUTINE init_remap_vars
+
+  !***********************************************************************
+  !************************************************************************
+  !   SUBROUTINE RESIZE_REMAP_VAR
+  !************************************************************************
+
+  SUBROUTINE resize_remap_vars(increment)
+
+    !-----------------------------------------------------------------------
+    !     this routine resizes remapping arrays by increasing(decreasing)
+    !     the max_links by increment
+    !-----------------------------------------------------------------------
+
+    !-----------------------------------------------------------------------
+    !     input variables
+    !-----------------------------------------------------------------------
+
+    INTEGER :: increment
+
+    !-----------------------------------------------------------------------
+    !     local variables
+    !-----------------------------------------------------------------------
+
+    INTEGER ::    &
+         ierr,    &  ! error flag
+         mxlinks   ! size of link arrays
+
+    INTEGER, DIMENSION(:), POINTER ::    &
+         add1_tmp,   & ! temp array for resizing address arrays
+         add2_tmp  ! temp array for resizing address arrays
+    !
+    ! temp array for resizing weight arrays
+    !
+    REAL*8, DIMENSION(:,:), POINTER :: wts_tmp   
+    !
+    !-----------------------------------------------------------------------
+    !***
+    !*** allocate temporaries to hold original values
+    !***
+    mxlinks = SIZE(bicubic_grid1_add_map1)
+    ALLOCATE (add1_tmp(mxlinks), add2_tmp(mxlinks), &
+         wts_tmp(num_wts,mxlinks))
+
+    add1_tmp = bicubic_grid1_add_map1
+    add2_tmp = bicubic_grid2_add_map1
+    wts_tmp  = bicubic_wts_map1
+
+    !***
+    !*** deallocate originals and increment max_links then
+    !*** reallocate arrays at new size
+    !***
+
+    DEALLOCATE (bicubic_grid1_add_map1, bicubic_grid2_add_map1, bicubic_wts_map1)
+    max_links_map1 = mxlinks + increment
+    ALLOCATE (bicubic_grid1_add_map1(max_links_map1),    &
+         bicubic_grid2_add_map1(max_links_map1),    &
+         bicubic_wts_map1(num_wts,max_links_map1))
+    !***
+    !*** restore original values from temp arrays and
+    !*** deallocate temps
+    !***
+    mxlinks = MIN(mxlinks, max_links_map1)
+    bicubic_grid1_add_map1(1:mxlinks) = add1_tmp (1:mxlinks)
+    bicubic_grid2_add_map1(1:mxlinks) = add2_tmp (1:mxlinks)
+    bicubic_wts_map1    (:,1:mxlinks) = wts_tmp(:,1:mxlinks)
+    DEALLOCATE(add1_tmp, add2_tmp, wts_tmp)
+
+    !-----------------------------------------------------------------------
+    !
+  END SUBROUTINE resize_remap_vars
+  !
+  !************************************************************************
+  !
+
+END MODULE bicubic_interp
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: trunk/NEMOGCM/TOOLS/NESTING/src/bilinear_interp.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/NESTING/src/bilinear_interp.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/NESTING/src/bilinear_interp.f90	(revision 2528)
@@ -0,0 +1,1207 @@
+!
+MODULE bilinear_interp
+  !
+  USE agrif_modutil
+  !
+  !************************************************************************
+  ! 									*
+  ! MODULE  BILINEAR INTERP						*
+  ! 									*
+  ! bilinear interpolation routines from SCRIP package			*		
+  !									*
+  !http://climate.lanl.gov/Software/SCRIP/				*
+  !									*
+  !Bilinear remapping							*
+  !									*
+  !************************************************************************
+  !     
+  !-----------------------------------------------------------------------
+  IMPLICIT NONE
+
+  !-----------------------------------------------------------------------
+  !     variables that describe each grid
+  !-----------------------------------------------------------------------
+  !
+  INTEGER :: grid1_size,grid2_size,grid1_rank, grid2_rank
+  !      
+  INTEGER, DIMENSION(:), POINTER :: grid1_dims, grid2_dims  
+  !  
+
+  !-----------------------------------------------------------------------
+  !     grid coordinates and masks
+  !-----------------------------------------------------------------------
+  !
+  LOGICAL, DIMENSION(:), POINTER :: grid1_mask,grid2_mask        
+  ! each grid center in radians
+  REAL*8,DIMENSION(:),POINTER :: &
+       grid1_center_lat,  &
+       grid1_center_lon,  & 
+       grid2_center_lat,  &
+       grid2_center_lon,  &
+       grid1_frac,        & ! fractional area of grid cells
+       grid2_frac           ! participating in remapping
+  !
+  ! lat/lon bounding box for use in restricting grid searches
+  !
+  REAL*8,DIMENSION(:,:), POINTER :: grid1_bound_box,grid2_bound_box   
+  !
+  !-----------------------------------------------------------------------
+  !     bins for restricting searches
+  !-----------------------------------------------------------------------
+  !
+  ! num of bins for restricted srch
+  INTEGER, PARAMETER :: num_srch_bins = 90  
+  !
+  ! min,max adds for grid cells in this lat bin
+  !
+  INTEGER,DIMENSION(:,:),POINTER :: bin_addr1,bin_addr2 
+  !
+  ! min,max longitude for each search bin
+  !
+  REAL*8, DIMENSION(:,:),POINTER :: bin_lats,bin_lons 
+
+  REAL*8, PARAMETER :: zero   = 0.0,  &
+       one    = 1.0,  &
+       two    = 2.0,  &
+       three  = 3.0,  &
+       four   = 4.0,  &
+       five   = 5.0,  & 
+       half   = 0.5,  &
+       quart  = 0.25, &
+       bignum = 1.e+20, &
+       tiny   = 1.e-14, &
+       pi     = 3.14159265359, &
+       pi2    = two*pi, &
+       pih    = half*pi        
+
+  REAL*8, PARAMETER :: deg2rad = pi/180.
+  ! 
+  ! max iteration count for i,j iteration 
+  !    
+  INTEGER , PARAMETER :: max_iter = 100   
+  !
+  ! convergence criterion
+  !
+  REAL*8, PARAMETER :: converge = 1.e-10
+
+
+  !  
+  INTEGER, PARAMETER :: norm_opt_none    = 1 &
+       ,norm_opt_dstarea = 2 &
+       ,norm_opt_frcarea = 3
+  !
+  INTEGER, PARAMETER :: map_type_conserv  = 1 &
+       ,map_type_bilinear = 2 &
+       ,map_type_bicubic  = 3 &
+       ,map_type_distwgt  = 4
+  !
+  INTEGER :: max_links_map1  &  ! current size of link arrays
+       ,num_links_map1  &  ! actual number of links for remapping
+       ,max_links_map2  &  ! current size of link arrays
+       ,num_links_map2  &  ! actual number of links for remapping
+       ,num_maps        &  ! num of remappings for this grid pair
+       ,num_wts         &  ! num of weights used in remapping
+       ,map_type        &  ! identifier for remapping method
+       ,norm_opt        &  ! option for normalization (conserv only)
+       ,resize_increment ! default amount to increase array size
+
+  INTEGER , DIMENSION(:), POINTER :: &
+       grid1_add_map1, &  ! grid1 address for each link in mapping 1
+       grid2_add_map1, &  ! grid2 address for each link in mapping 1
+       grid1_add_map2, &  ! grid1 address for each link in mapping 2
+       grid2_add_map2    ! grid2 address for each link in mapping 2
+
+  REAL*8, DIMENSION(:,:), POINTER ::   &
+       wts_map1, &   ! map weights for each link (num_wts,max_links)
+       wts_map2     ! map weights for each link (num_wts,max_links)
+  !
+CONTAINS 
+  !     
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !************************************************************************
+  !   SUBROUTINE GRID_INIT
+  !************************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  SUBROUTINE get_remap_matrix(grid1_lat,grid2_lat,grid1_lon,grid2_lon,mask, &
+       remap_matrix,source_add,destination_add)
+    !
+    !-----------------------------------------------------------------------
+    !this routine makes any necessary changes (e.g. for 0,2pi longitude range)
+    !-----------------------------------------------------------------------
+    !
+    REAL*8,DIMENSION(:,:),POINTER :: grid1_lat,grid2_lat,grid1_lon,grid2_lon
+    LOGICAL,DIMENSION(:,:) :: mask
+    !      
+    INTEGER,DIMENSION(:),POINTER :: source_add,destination_add  
+    REAL*8,DIMENSION(:,:),POINTER :: remap_matrix       
+    !
+    !-----------------------------------------------------------------------
+    ! local variables
+    !-----------------------------------------------------------------------
+    !
+    INTEGER :: n,nele,i,j,ip1,jp1,n_add,e_add,ne_add,nx,ny
+    INTEGER :: xpos,ypos
+    !          
+    ! integer mask
+    ! 
+    INTEGER, DIMENSION(:), POINTER :: imask 
+    !
+    ! lat/lon intervals for search bins
+    !
+    REAL*8 :: dlat,dlon           
+    !      
+    ! temps for computing bounding boxes
+    !
+    REAL*8, DIMENSION(4) :: tmp_lats, tmp_lons  
+    !
+    !      write(*,*)'proceed to Bilinear interpolation ...'
+    !
+    IF(ASSOCIATED(wts_map1)) DEALLOCATE(wts_map1)
+    IF(ASSOCIATED(grid1_add_map1)) DEALLOCATE(grid1_add_map1)
+    IF(ASSOCIATED(grid2_add_map1)) DEALLOCATE(grid2_add_map1)
+
+
+    !
+    ALLOCATE(grid1_dims(2),grid2_dims(2))
+    !      
+    grid1_dims(1) = SIZE(grid1_lat,2)
+    grid1_dims(2) = SIZE(grid1_lat,1)
+    grid2_dims(1) = SIZE(grid2_lat,2)
+    grid2_dims(2) = SIZE(grid2_lat,1)
+    grid1_size = SIZE(grid1_lat,2) * SIZE(grid1_lat,1)
+    grid2_size = SIZE(grid2_lat,2) * SIZE(grid2_lat,1)  
+    !      
+    !-----------------------------------------------------------------------
+    !     allocate grid coordinates/masks and read data
+    !-----------------------------------------------------------------------
+    !     
+    ALLOCATE( grid2_mask(grid2_size),         &
+         grid1_bound_box (4,grid1_size), &
+         grid2_bound_box (4,grid2_size), &
+         grid1_frac      (grid1_size),   &
+         grid2_frac      (grid2_size))
+    ALLOCATE(imask(grid1_size))
+    !                 
+    !      
+    grid1_frac = zero
+    grid2_frac = zero
+
+    !
+    ! 2D array -> 1D array
+    !
+    ALLOCATE(grid1_center_lat(SIZE(grid1_lat,1)*SIZE(grid1_lat,2)))
+    CALL tab2Dto1D(grid1_lat,grid1_center_lat)
+
+    ALLOCATE(grid1_center_lon(SIZE(grid1_lon,1)*SIZE(grid1_lon,2)))
+    CALL tab2Dto1D(grid1_lon,grid1_center_lon)
+
+    ALLOCATE(grid2_center_lat(SIZE(grid2_lat,1)*SIZE(grid2_lat,2)))
+    CALL tab2Dto1D(grid2_lat,grid2_center_lat)
+
+    ALLOCATE(grid2_center_lon(SIZE(grid2_lon,1)*SIZE(grid2_lon,2)))      
+    CALL tab2Dto1D(grid2_lon,grid2_center_lon) 
+
+    ALLOCATE(grid1_mask(SIZE(grid1_lat,1)*SIZE(grid1_lat,2)))
+    CALL logtab2Dto1D(mask,grid1_mask)
+    !      
+    !      Write(*,*) ,'grid1_mask = ',grid1_mask                 
+    !
+    ! degrees to radian
+    !
+    grid1_center_lat = grid1_center_lat*deg2rad
+    grid1_center_lon = grid1_center_lon*deg2rad
+    grid2_center_lat = grid2_center_lat*deg2rad
+    grid2_center_lon = grid2_center_lon*deg2rad
+
+    !-----------------------------------------------------------------------
+    !     convert longitudes to 0,2pi interval
+    !-----------------------------------------------------------------------
+
+    WHERE (grid1_center_lon .GT. pi2)  grid1_center_lon =       &
+         grid1_center_lon - pi2
+    WHERE (grid1_center_lon .LT. zero) grid1_center_lon =       &
+         grid1_center_lon + pi2
+    WHERE (grid2_center_lon .GT. pi2)  grid2_center_lon =       &
+         grid2_center_lon - pi2
+    WHERE (grid2_center_lon .LT. zero) grid2_center_lon =       &
+         grid2_center_lon + pi2
+
+    !-----------------------------------------------------------------------
+    !
+    !     make sure input latitude range is within the machine values
+    !     for +/- pi/2 
+    !
+    !-----------------------------------------------------------------------
+
+    WHERE (grid1_center_lat >  pih) grid1_center_lat =  pih
+    WHERE (grid1_center_lat < -pih) grid1_center_lat = -pih
+    WHERE (grid2_center_lat >  pih) grid2_center_lat =  pih
+    WHERE (grid2_center_lat < -pih) grid2_center_lat = -pih
+
+    !-----------------------------------------------------------------------
+    !
+    !     compute bounding boxes for restricting future grid searches
+    !
+    !-----------------------------------------------------------------------
+    !
+    nx = grid1_dims(1)
+    ny = grid1_dims(2)
+
+    DO n=1,grid1_size
+
+       !*** find N,S and NE points to this grid point
+
+       j = (n - 1)/nx +1
+       i = n - (j-1)*nx
+
+       IF (i < nx) THEN
+          ip1 = i + 1
+       ELSE
+          !*** assume cyclic
+          ip1 = 1
+          !*** but if it is not, correct
+          e_add = (j - 1)*nx + ip1
+          IF (ABS(grid1_center_lat(e_add) -     &
+               grid1_center_lat(n   )) > pih) THEN
+             ip1 = i
+          ENDIF
+          ip1=nx
+       ENDIF
+
+       IF (j < ny) THEN
+          jp1 = j+1
+       ELSE
+          !*** assume cyclic
+          jp1 = 1
+          !*** but if it is not, correct
+          n_add = (jp1 - 1)*nx + i
+          IF (ABS(grid1_center_lat(n_add) -             &
+               grid1_center_lat(n   )) > pih) THEN
+             jp1 = j
+          ENDIF
+          jp1=ny
+       ENDIF
+
+       n_add = (jp1 - 1)*nx + i
+       e_add = (j - 1)*nx + ip1
+       ne_add = (jp1 - 1)*nx + ip1
+
+       !*** find N,S and NE lat/lon coords and check bounding box
+
+       tmp_lats(1) = grid1_center_lat(n)
+       tmp_lats(2) = grid1_center_lat(e_add)
+       tmp_lats(3) = grid1_center_lat(ne_add)
+       tmp_lats(4) = grid1_center_lat(n_add)
+
+       tmp_lons(1) = grid1_center_lon(n)
+       tmp_lons(2) = grid1_center_lon(e_add)
+       tmp_lons(3) = grid1_center_lon(ne_add)
+       tmp_lons(4) = grid1_center_lon(n_add)
+
+       grid1_bound_box(1,n) = MINVAL(tmp_lats)
+       grid1_bound_box(2,n) = MAXVAL(tmp_lats)
+
+       grid1_bound_box(3,n) = MINVAL(tmp_lons)
+       grid1_bound_box(4,n) = MAXVAL(tmp_lons)
+    END DO
+
+    nx = grid2_dims(1)
+    ny = grid2_dims(2)
+
+    DO n=1,grid2_size
+
+       !*** find N,S and NE points to this grid point
+
+       j = (n - 1)/nx +1
+       i = n - (j-1)*nx
+
+       IF (i < nx) THEN
+          ip1 = i + 1
+       ELSE
+          !*** assume cyclic
+          ip1 = 1
+          !*** but if it is not, correct
+          e_add = (j - 1)*nx + ip1
+          IF (ABS(grid2_center_lat(e_add) -  &
+               grid2_center_lat(n   )) > pih) THEN
+             ip1 = i
+          ENDIF
+       ENDIF
+
+       IF (j < ny) THEN
+          jp1 = j+1
+       ELSE
+          !*** assume cyclic
+          jp1 = 1
+          !*** but if it is not, correct
+          n_add = (jp1 - 1)*nx + i
+          IF (ABS(grid2_center_lat(n_add) -  &
+               grid2_center_lat(n   )) > pih) THEN
+             jp1 = j
+          ENDIF
+       ENDIF
+
+       n_add = (jp1 - 1)*nx + i
+       e_add = (j - 1)*nx + ip1
+       ne_add = (jp1 - 1)*nx + ip1
+
+       !*** find N,S and NE lat/lon coords and check bounding box
+
+       tmp_lats(1) = grid2_center_lat(n)
+       tmp_lats(2) = grid2_center_lat(e_add)
+       tmp_lats(3) = grid2_center_lat(ne_add)
+       tmp_lats(4) = grid2_center_lat(n_add)
+
+       tmp_lons(1) = grid2_center_lon(n)
+       tmp_lons(2) = grid2_center_lon(e_add)
+       tmp_lons(3) = grid2_center_lon(ne_add)
+       tmp_lons(4) = grid2_center_lon(n_add)
+
+       grid2_bound_box(1,n) = MINVAL(tmp_lats)
+       grid2_bound_box(2,n) = MAXVAL(tmp_lats)
+       grid2_bound_box(3,n) = MINVAL(tmp_lons)
+       grid2_bound_box(4,n) = MAXVAL(tmp_lons)
+    END DO
+    !
+    !
+    !
+    WHERE (ABS(grid1_bound_box(4,:) - grid1_bound_box(3,:)) > pi)
+       grid1_bound_box(3,:) = zero
+       grid1_bound_box(4,:) = pi2
+    END WHERE
+
+    WHERE (ABS(grid2_bound_box(4,:) - grid2_bound_box(3,:)) > pi)
+       grid2_bound_box(3,:) = zero
+       grid2_bound_box(4,:) = pi2
+    END WHERE
+
+    !***
+    !*** try to check for cells that overlap poles
+    !***
+
+    WHERE (grid1_center_lat > grid1_bound_box(2,:)) &
+         grid1_bound_box(2,:) = pih
+
+    WHERE (grid1_center_lat < grid1_bound_box(1,:)) &
+         grid1_bound_box(1,:) = -pih
+
+    WHERE (grid2_center_lat > grid2_bound_box(2,:)) &
+         grid2_bound_box(2,:) = pih
+
+    WHERE (grid2_center_lat < grid2_bound_box(1,:)) &
+         grid2_bound_box(1,:) = -pih
+
+    !-----------------------------------------------------------------------
+    !     set up and assign address ranges to search bins in order to 
+    !     further restrict later searches
+    !-----------------------------------------------------------------------
+
+    ALLOCATE(bin_addr1(2,num_srch_bins))
+    ALLOCATE(bin_addr2(2,num_srch_bins))
+    ALLOCATE(bin_lats (2,num_srch_bins))
+    ALLOCATE(bin_lons (2,num_srch_bins))
+
+    dlat = pi/num_srch_bins
+
+    DO n=1,num_srch_bins
+       bin_lats(1,n) = (n-1)*dlat - pih
+       bin_lats(2,n) =     n*dlat - pih
+       bin_lons(1,n) = zero
+       bin_lons(2,n) = pi2
+       bin_addr1(1,n) = grid1_size + 1
+       bin_addr1(2,n) = 0
+       bin_addr2(1,n) = grid2_size + 1
+       bin_addr2(2,n) = 0
+    END DO
+
+    DO nele=1,grid1_size
+       DO n=1,num_srch_bins
+          IF (grid1_bound_box(1,nele) <= bin_lats(2,n) .AND.   &
+               grid1_bound_box(2,nele) >= bin_lats(1,n)) THEN
+             bin_addr1(1,n) = MIN(nele,bin_addr1(1,n))
+             bin_addr1(2,n) = MAX(nele,bin_addr1(2,n))
+          ENDIF
+       END DO
+    END DO
+
+    DO nele=1,grid2_size
+       DO n=1,num_srch_bins
+          IF (grid2_bound_box(1,nele) <= bin_lats(2,n) .AND.    &
+               grid2_bound_box(2,nele) >= bin_lats(1,n)) THEN
+             bin_addr2(1,n) = MIN(nele,bin_addr2(1,n))
+             bin_addr2(2,n) = MAX(nele,bin_addr2(2,n))
+          ENDIF
+       END DO
+    END DO
+    !	
+    CALL init_remap_vars 
+    CALL remap_bilin
+
+    ALLOCATE(remap_matrix(SIZE(wts_map1,1),SIZE(wts_map1,2)), &
+         source_add(SIZE(grid1_add_map1)),       &
+         destination_add(SIZE(grid2_add_map1)))
+
+    DO j = 1,SIZE(wts_map1,2)
+       DO i = 1,SIZE(wts_map1,1)
+
+          remap_matrix(i,j) = wts_map1(i,j)
+
+       END DO
+    END DO
+
+
+    source_add(:) = grid1_add_map1(:)
+    destination_add(:) = grid2_add_map1(:)               
+    !
+    WHERE(destination_add == 0)
+       destination_add = 1
+    END WHERE
+
+    WHERE(source_add == 0)
+       source_add = 1
+    END WHERE
+    !               
+    DEALLOCATE(grid1_bound_box,grid2_bound_box,grid1_center_lat,grid1_center_lon)
+    DEALLOCATE(grid2_center_lat,grid2_center_lon,grid2_add_map1,grid1_add_map1,wts_map1)
+    DEALLOCATE(grid1_frac,grid2_frac,grid1_dims,grid2_dims,grid2_mask,imask)
+    DEALLOCATE(bin_addr1,bin_addr2,bin_lats,bin_lons)
+    DEALLOCATE(grid1_mask)	
+    !	
+    !-----------------------------------------------------------------------
+
+  END SUBROUTINE get_remap_matrix
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+  !***********************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !************************************************************************
+  !   SUBROUTINE REMAP_BILINEAR
+  !************************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE remap_bilin
+
+    !-----------------------------------------------------------------------
+    !     this routine computes the weights for a bilinear interpolation.
+    !-----------------------------------------------------------------------
+
+    !-----------------------------------------------------------------------
+    !     local variables
+    !-----------------------------------------------------------------------
+
+    INTEGER :: n,icount,dst_add,iter,nmap,nbmasked    
+    !        
+    ! address for the four source points
+    !
+    INTEGER, DIMENSION(4) :: src_add,involved_pts
+    INTEGER, DIMENSION(1) :: minlon
+    INTEGER, DIMENSION(1) :: minlat
+    REAL*8, DIMENSION(4) :: distx,disty
+    REAL*8 :: normalize
+    !               
+    ! latitudes longitudes of four bilinear corners
+    !
+    REAL*8, DIMENSION(4) :: src_lats,src_lons
+    !
+    ! bilinear weights for four corners
+    !      
+    REAL*8, DIMENSION(4) :: wgts            
+    !
+    REAL*8 :: &
+         plat, plon,       &  ! lat/lon coords of destination point
+         iguess, jguess,   &  ! current guess for bilinear coordinate
+         thguess, phguess, &  ! current guess for lat/lon coordinate
+         deli, delj,       &  ! corrections to i,j
+         dth1, dth2, dth3, &  ! some latitude  differences
+         dph1, dph2, dph3, &  ! some longitude differences
+         dthp, dphp,       &  ! difference between point and sw corner
+         mat1, mat2, mat3, mat4, &  ! matrix elements
+         determinant, &     ! matrix determinant
+         sum_wgts          ! sum of weights for normalization
+
+    INTEGER lastsrc_add     
+    !      
+    grid2_mask = .TRUE.     
+    !      
+    !      
+    nmap = 1
+    !
+    !***
+    !*** loop over destination grid 
+    !***
+    !      print*,'grid2_size =',grid2_size
+    !      
+    lastsrc_add=1
+    !
+    grid_loop1: DO dst_add = 1, grid2_size
+
+       IF (.NOT. grid2_mask(dst_add)) CYCLE grid_loop1
+       !        
+       plat = grid2_center_lat(dst_add)
+       plon = grid2_center_lon(dst_add)
+       !***
+       !*** find nearest square of grid points on source grid
+       !***
+       CALL grid_search_bilin(src_add, src_lats, src_lons,          &
+            plat, plon, grid1_dims,               &
+            grid1_center_lat, grid1_center_lon,   & 
+            grid1_bound_box, bin_addr1, bin_addr2,lastsrc_add)		       
+       !***
+       !*** check to see if points are land points
+       !*** 
+       !   
+       IF (src_add(1) > 0) THEN
+          !	    
+          DO n=1,4
+             !           if(.not. grid1_mask(src_add(n))) nbmasked = nbmasked + 1
+             IF(.NOT. grid1_mask(src_add(n))) src_add(1) = 0
+          END DO
+          !
+       ENDIF
+       !
+       !
+
+       !***
+       !*** if point found, find local i,j coordinates for weights
+       !***
+       IF (src_add(1) > 0) THEN
+          grid2_frac(dst_add) = one
+          !***
+          !*** iterate to find i,j for bilinear approximation
+          !***
+          dth1 = src_lats(2) - src_lats(1)
+          dth2 = src_lats(4) - src_lats(1)
+          dth3 = src_lats(3) - src_lats(2) - dth2
+
+          dph1 = src_lons(2) - src_lons(1)
+          dph2 = src_lons(4) - src_lons(1)
+          dph3 = src_lons(3) - src_lons(2)
+
+          IF (dph1 >  three*pih) dph1 = dph1 - pi2
+          IF (dph2 >  three*pih) dph2 = dph2 - pi2
+          IF (dph3 >  three*pih) dph3 = dph3 - pi2
+          IF (dph1 < -three*pih) dph1 = dph1 + pi2
+          IF (dph2 < -three*pih) dph2 = dph2 + pi2
+          IF (dph3 < -three*pih) dph3 = dph3 + pi2
+
+          dph3 = dph3 - dph2
+
+          iguess = half
+          jguess = half
+
+          iter_loop1: DO iter=1,max_iter
+
+             dthp = plat - src_lats(1) - dth1*iguess -        &
+                  dth2*jguess - dth3*iguess*jguess
+             dphp = plon - src_lons(1)
+
+             IF (dphp >  three*pih) dphp = dphp - pi2
+             IF (dphp < -three*pih) dphp = dphp + pi2
+
+             dphp = dphp - dph1*iguess - dph2*jguess -        &
+                  dph3*iguess*jguess
+
+             mat1 = dth1 + dth3*jguess
+             mat2 = dth2 + dth3*iguess
+             mat3 = dph1 + dph3*jguess
+             mat4 = dph2 + dph3*iguess
+
+             determinant = mat1*mat4 - mat2*mat3
+
+             deli = (dthp*mat4 - mat2*dphp)/determinant
+             delj = (mat1*dphp - dthp*mat3)/determinant
+
+             IF (ABS(deli) < converge .AND.                   &
+                  ABS(delj) < converge) EXIT iter_loop1
+
+             iguess = iguess + deli
+             jguess = jguess + delj
+
+          END DO iter_loop1
+
+          IF (iter <= max_iter) THEN
+
+             !***
+             !*** successfully found i,j - compute weights
+             !***
+
+             wgts(1) = (one-iguess)*(one-jguess)
+             wgts(2) = iguess*(one-jguess)
+             wgts(3) = iguess*jguess
+             wgts(4) = (one-iguess)*jguess
+             !	    	        
+             !
+             CALL store_link_bilin(dst_add, src_add, wgts, nmap)
+
+          ELSE
+             PRINT *,'Point coords: ',plat,plon
+             PRINT *,'Dest grid lats: ',src_lats
+             PRINT *,'Dest grid lons: ',src_lons
+             PRINT *,'Dest grid addresses: ',src_add
+             PRINT *,'Current i,j : ',iguess, jguess
+             STOP 'Iteration for i,j exceed max iteration count'
+          ENDIF
+          !
+          !***
+          !*** search for bilinear failed - use a distance-weighted
+          !*** average instead (this is typically near the pole)
+          !***
+       ELSE IF (src_add(1) < 0) THEN
+
+          src_add = ABS(src_add)
+          icount = 0
+          DO n=1,4
+             !           
+             IF (grid1_mask(src_add(n))) THEN
+                icount = icount + 1
+             ELSE
+                src_lats(n) = zero
+             ENDIF
+             !	    
+          END DO
+
+          IF (icount > 0) THEN
+             !	  
+             !*** renormalize weights
+             !
+             sum_wgts = SUM(src_lats)
+             wgts(1) = src_lats(1)/sum_wgts
+             wgts(2) = src_lats(2)/sum_wgts
+             wgts(3) = src_lats(3)/sum_wgts
+             wgts(4) = src_lats(4)/sum_wgts
+             !
+             grid2_frac(dst_add) = one
+             CALL store_link_bilin(dst_add, src_add, wgts, nmap)
+          ENDIF
+
+          !
+       ENDIF
+    END DO grid_loop1
+    !      
+    !      Call sort_add(grid2_add_map1, grid1_add_map1, wts_map1)	
+    !               
+    !
+    !-----------------------------------------------------------------------
+
+  END SUBROUTINE remap_bilin
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+  !***********************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !************************************************************************
+  !   SUBROUTINE GRID_SEARCH_BILIN
+  !************************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  SUBROUTINE grid_search_bilin(src_add, src_lats, src_lons,   &
+       plat, plon, src_grid_dims,      &
+       src_center_lat, src_center_lon, & 
+       src_grid_bound_box,             &
+       src_bin_add, dst_bin_add,lastsrc_add)
+
+    !-----------------------------------------------------------------------
+    !
+    !     this routine finds the location of the search point plat, plon
+    !     in the source grid and returns the corners needed for a bilinear
+    !     interpolation.
+    !
+    !-----------------------------------------------------------------------
+
+    !-----------------------------------------------------------------------
+    !     output variables
+    !-----------------------------------------------------------------------
+    !
+    ! address of each corner point enclosing P
+    !
+    INTEGER,DIMENSION(4) :: src_add  
+    REAL*8,DIMENSION(4) :: src_lats,src_lons  
+    !      
+    !-----------------------------------------------------------------------
+    !     input variables
+    !-----------------------------------------------------------------------
+    ! 
+    ! latitude, longitude of the search point
+    !
+    REAL*8, INTENT(in) :: plat,plon   
+    !
+    ! size of each src grid dimension
+    !
+    INTEGER, DIMENSION(2), INTENT(in) :: src_grid_dims  
+    !
+    ! latitude, longitude of each src grid center
+    !
+    REAL*8, DIMENSION(:), INTENT(in) :: src_center_lat,src_center_lon  
+    !
+    ! bound box for source grid
+    !
+    REAL*8, DIMENSION(:,:), INTENT(in) :: src_grid_bound_box 
+    !
+    ! latitude bins for restricting searches
+    !
+    INTEGER, DIMENSION(:,:), INTENT(in) ::src_bin_add,dst_bin_add 
+
+    INTEGER,OPTIONAL :: lastsrc_add
+    INTEGER :: loopsrc,l1,l2
+    !      
+    !-----------------------------------------------------------------------
+    !     local variables
+    !-----------------------------------------------------------------------
+    !
+    INTEGER :: n,next_n,srch_add,nx, ny,min_add, max_add,  &
+         i, j, jp1, ip1, n_add, e_add, ne_add
+
+
+    REAL*8 ::  vec1_lat, vec1_lon,vec2_lat, vec2_lon, cross_product,  &
+         cross_product_last,coslat_dst, sinlat_dst, coslon_dst, &
+         sinlon_dst,dist_min, distance 
+
+    !-----------------------------------------------------------------------
+    !     restrict search first using bins
+    !-----------------------------------------------------------------------
+
+    src_add = 0
+
+    min_add = SIZE(src_center_lat)
+    max_add = 1
+    DO n=1,num_srch_bins
+       IF (plat >= bin_lats(1,n) .AND. plat <= bin_lats(2,n) .AND. &
+            plon >= bin_lons(1,n) .AND. plon <= bin_lons(2,n)) THEN
+          min_add = MIN(min_add, src_bin_add(1,n))
+          max_add = MAX(max_add, src_bin_add(2,n))
+       ENDIF
+    END DO
+
+    !-----------------------------------------------------------------------
+    !     now perform a more detailed search 
+    !-----------------------------------------------------------------------
+
+    nx = src_grid_dims(1)
+    ny = src_grid_dims(2)
+
+    loopsrc=0
+    DO WHILE (loopsrc <= max_add)
+
+
+       l1=MAX(min_add,lastsrc_add-loopsrc)
+       l2=MIN(max_add,lastsrc_add+loopsrc)      
+
+       loopsrc = loopsrc+1
+
+       srch_loop: DO srch_add = l1,l2,MAX(l2-l1,1)
+
+          !*** first check bounding box
+
+          IF (plat <= src_grid_bound_box(2,srch_add) .AND. & 
+               plat >= src_grid_bound_box(1,srch_add) .AND.  &
+               plon <= src_grid_bound_box(4,srch_add) .AND.  &
+               plon >= src_grid_bound_box(3,srch_add)) THEN
+             !***
+             !*** we are within bounding box so get really serious
+             !***
+             !*** determine neighbor addresses
+             !
+             j = (srch_add - 1)/nx +1
+             i = srch_add - (j-1)*nx
+             !
+             IF (i < nx) THEN
+                ip1 = i + 1
+             ELSE
+                ip1 = 1
+             ENDIF
+             !
+             IF (j < ny) THEN
+                jp1 = j+1
+             ELSE
+                jp1 = 1
+             ENDIF
+             !
+             n_add = (jp1 - 1)*nx + i
+             e_add = (j - 1)*nx + ip1
+             ne_add = (jp1 - 1)*nx + ip1
+             !
+             src_lats(1) = src_center_lat(srch_add)
+             src_lats(2) = src_center_lat(e_add)
+             src_lats(3) = src_center_lat(ne_add)
+             src_lats(4) = src_center_lat(n_add)
+             !
+             src_lons(1) = src_center_lon(srch_add)
+             src_lons(2) = src_center_lon(e_add)
+             src_lons(3) = src_center_lon(ne_add)
+             src_lons(4) = src_center_lon(n_add)
+             !
+             !***
+             !*** for consistency, we must make sure all lons are in
+             !*** same 2pi interval
+             !***
+             !
+             vec1_lon = src_lons(1) - plon
+             IF (vec1_lon >  pi) THEN
+                src_lons(1) = src_lons(1) - pi2
+             ELSE IF (vec1_lon < -pi) THEN
+                src_lons(1) = src_lons(1) + pi2
+             ENDIF
+             DO n=2,4
+                vec1_lon = src_lons(n) - src_lons(1)
+                IF (vec1_lon >  pi) THEN
+                   src_lons(n) = src_lons(n) - pi2
+                ELSE IF (vec1_lon < -pi) THEN
+                   src_lons(n) = src_lons(n) + pi2
+                ENDIF
+             END DO
+             !
+             corner_loop: DO n=1,4
+                next_n = MOD(n,4) + 1
+                !***
+                !*** here we take the cross product of the vector making 
+                !*** up each box side with the vector formed by the vertex
+                !*** and search point.  if all the cross products are 
+                !*** positive, the point is contained in the box.
+                !***
+                vec1_lat = src_lats(next_n) - src_lats(n)
+                vec1_lon = src_lons(next_n) - src_lons(n)
+                vec2_lat = plat - src_lats(n)
+                vec2_lon = plon - src_lons(n)
+                !***
+                !*** check for 0,2pi crossings
+                !***
+                IF (vec1_lon >  three*pih) THEN
+                   vec1_lon = vec1_lon - pi2
+                ELSE IF (vec1_lon < -three*pih) THEN
+                   vec1_lon = vec1_lon + pi2
+                ENDIF
+                IF (vec2_lon >  three*pih) THEN
+                   vec2_lon = vec2_lon - pi2
+                ELSE IF (vec2_lon < -three*pih) THEN
+                   vec2_lon = vec2_lon + pi2
+                ENDIF
+                !
+                cross_product = vec1_lon*vec2_lat - vec2_lon*vec1_lat
+                !
+                !***
+                !*** if cross product is less than zero, this cell
+                !*** doesn't work
+                !***
+                IF (n == 1) cross_product_last = cross_product
+                IF (cross_product*cross_product_last < zero) &
+                     EXIT corner_loop
+                cross_product_last = cross_product
+                !
+             END DO corner_loop
+             !***
+             !*** if cross products all same sign, we found the location
+             !***
+             IF (n > 4) THEN
+                src_add(1) = srch_add
+                src_add(2) = e_add
+                src_add(3) = ne_add
+                src_add(4) = n_add
+                !
+                lastsrc_add = srch_add
+                RETURN
+             ENDIF
+             !***
+             !*** otherwise move on to next cell
+             !***
+          ENDIF !bounding box check
+       END DO srch_loop
+
+
+    ENDDO
+
+
+    !***
+    !*** if no cell found, point is likely either in a box that
+    !*** straddles either pole or is outside the grid.  fall back
+    !*** to a distance-weighted average of the four closest
+    !*** points.  go ahead and compute weights here, but store
+    !*** in src_lats and return -add to prevent the parent
+    !*** routine from computing bilinear weights
+    !***
+    !print *,'Could not find location for ',plat,plon
+    !print *,'Using nearest-neighbor average for this point'
+    !
+    coslat_dst = COS(plat)
+    sinlat_dst = SIN(plat)
+    coslon_dst = COS(plon)
+    sinlon_dst = SIN(plon)
+    !
+    dist_min = bignum
+    src_lats = bignum
+    DO srch_add = min_add,max_add
+       distance = ACOS(coslat_dst*COS(src_center_lat(srch_add))*   &
+            (coslon_dst*COS(src_center_lon(srch_add)) +   &
+            sinlon_dst*SIN(src_center_lon(srch_add)))+   &
+            sinlat_dst*SIN(src_center_lat(srch_add)))
+
+       IF (distance < dist_min) THEN
+          sort_loop: DO n=1,4
+             IF (distance < src_lats(n)) THEN
+                DO i=4,n+1,-1
+                   src_add (i) = src_add (i-1)
+                   src_lats(i) = src_lats(i-1)
+                END DO
+                src_add (n) = -srch_add
+                src_lats(n) = distance
+                dist_min = src_lats(4)
+                EXIT sort_loop
+             ENDIF
+          END DO sort_loop
+       ENDIF
+    END DO
+    !
+    src_lons = one/(src_lats + tiny)
+    distance = SUM(src_lons)
+    src_lats = src_lons/distance
+
+    !-----------------------------------------------------------------------
+
+  END SUBROUTINE grid_search_bilin
+
+
+  !***********************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !************************************************************************
+  !   SUBROUTINE STORE_LINK_BILIN
+  !************************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE store_link_bilin(dst_add, src_add, weights, nmap)
+
+    !-----------------------------------------------------------------------
+    !     this routine stores the address and weight for four links 
+    !     associated with one destination point in the appropriate address 
+    !     and weight arrays and resizes those arrays if necessary.
+    !-----------------------------------------------------------------------
+
+    !-----------------------------------------------------------------------
+    !     input variables
+    !-----------------------------------------------------------------------
+    !
+    INTEGER :: dst_add,nmap
+    !
+    INTEGER, DIMENSION(4) :: src_add
+    !
+    REAL*8, DIMENSION(4) :: weights 
+
+    !-----------------------------------------------------------------------
+    !
+    !     local variables
+    !
+    !-----------------------------------------------------------------------
+
+    INTEGER :: n,num_links_old   
+
+    !-----------------------------------------------------------------------
+    !     increment number of links and check to see if remap arrays need
+    !     to be increased to accomodate the new link.  then store the
+    !     link.
+    !-----------------------------------------------------------------------
+
+    num_links_old  = num_links_map1
+    num_links_map1 = num_links_old + 4
+
+    IF (num_links_map1 > max_links_map1) &
+         CALL resize_remap_vars(1,resize_increment)
+
+    DO n=1,4
+       grid1_add_map1(num_links_old+n) = src_add(n)
+       grid2_add_map1(num_links_old+n) = dst_add
+       wts_map1    (1,num_links_old+n) = weights(n)
+    END DO
+
+    !-----------------------------------------------------------------------
+
+  END SUBROUTINE store_link_bilin
+
+
+
+
+
+
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !************************************************************************
+  !   SUBROUTINE INIT_REMAP_VARS
+  !************************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !
+  SUBROUTINE init_remap_vars
+
+    !-----------------------------------------------------------------------
+    !
+    !     this routine initializes some variables and provides an initial
+    !     allocation of arrays (fairly large so frequent resizing 
+    !     unnecessary).
+    !
+    !-----------------------------------------------------------------------
+
+    !-----------------------------------------------------------------------
+    !     determine the number of weights
+    !-----------------------------------------------------------------------
+    num_wts = 1     ! bilinear interpolation
+    !-----------------------------------------------------------------------
+    !     initialize num_links and set max_links to four times the largest 
+    !     of the destination grid sizes initially (can be changed later).
+    !     set a default resize increment to increase the size of link
+    !     arrays if the number of links exceeds the initial size  
+    !-----------------------------------------------------------------------
+
+    num_links_map1 = 0
+    max_links_map1 = 4*grid2_size
+    IF (num_maps > 1) THEN
+       num_links_map2 = 0
+       max_links_map1 = MAX(4*grid1_size,4*grid2_size)
+       max_links_map2 = max_links_map1
+    ENDIF
+
+    resize_increment = 0.1*MAX(grid1_size,grid2_size)
+
+    !-----------------------------------------------------------------------
+    !     allocate address and weight arrays for mapping 1  
+    !-----------------------------------------------------------------------
+
+    ALLOCATE (grid1_add_map1(max_links_map1),    &
+         grid2_add_map1(max_links_map1),    &
+         wts_map1(num_wts, max_links_map1))
+
+    grid1_add_map1 = 0.	
+    grid2_add_map1 = 0.
+    wts_map1 = 0.
+
+    !-----------------------------------------------------------------------
+
+  END SUBROUTINE init_remap_vars
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+  !***********************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !************************************************************************
+  !   SUBROUTINE RESIZE_REMAP_VAR
+  !************************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE resize_remap_vars(nmap, increment)
+
+    !-----------------------------------------------------------------------
+    !     this routine resizes remapping arrays by increasing(decreasing)
+    !     the max_links by increment
+    !-----------------------------------------------------------------------
+
+    !-----------------------------------------------------------------------
+    !     input variables
+    !-----------------------------------------------------------------------
+
+    INTEGER ::     &
+         nmap,      &     ! identifies which mapping array to resize
+         increment       ! the number of links to add(subtract) to arrays
+
+    !-----------------------------------------------------------------------
+    !     local variables
+    !-----------------------------------------------------------------------
+
+    INTEGER ::    &
+         ierr,    &  ! error flag
+         mxlinks   ! size of link arrays
+
+    INTEGER, DIMENSION(:), POINTER ::    &
+         add1_tmp,   & ! temp array for resizing address arrays
+         add2_tmp  ! temp array for resizing address arrays
+    !
+    ! temp array for resizing weight arrays
+    !
+    REAL*8, DIMENSION(:,:), POINTER :: wts_tmp   
+    !
+    !-----------------------------------------------------------------------
+    !***
+    !*** allocate temporaries to hold original values
+    !***
+    mxlinks = SIZE(grid1_add_map1)
+    ALLOCATE (add1_tmp(mxlinks), add2_tmp(mxlinks), &
+         wts_tmp(num_wts,mxlinks))
+
+    add1_tmp = grid1_add_map1
+    add2_tmp = grid2_add_map1
+    wts_tmp  = wts_map1
+
+    !***
+    !*** deallocate originals and increment max_links then
+    !*** reallocate arrays at new size
+    !***
+
+    DEALLOCATE (grid1_add_map1, grid2_add_map1, wts_map1)
+    max_links_map1 = mxlinks + increment
+    ALLOCATE (grid1_add_map1(max_links_map1),    &
+         grid2_add_map1(max_links_map1),    &
+         wts_map1(num_wts,max_links_map1))
+    !***
+    !*** restore original values from temp arrays and
+    !*** deallocate temps
+    !***
+    mxlinks = MIN(mxlinks, max_links_map1)
+    grid1_add_map1(1:mxlinks) = add1_tmp (1:mxlinks)
+    grid2_add_map1(1:mxlinks) = add2_tmp (1:mxlinks)
+    wts_map1    (:,1:mxlinks) = wts_tmp(:,1:mxlinks)
+    DEALLOCATE(add1_tmp, add2_tmp, wts_tmp)
+
+    !-----------------------------------------------------------------------
+    !
+  END SUBROUTINE resize_remap_vars
+  !
+  !************************************************************************
+  !
+END MODULE bilinear_interp
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
Index: trunk/NEMOGCM/TOOLS/NESTING/src/io_netcdf.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/NESTING/src/io_netcdf.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/NESTING/src/io_netcdf.f90	(revision 2528)
@@ -0,0 +1,1815 @@
+!************************************************************************
+! Fortran 95 OPA Nesting tools						*
+!									*
+!     Copyright (C) 2005 Florian Lemari�(Florian.Lemarie@imag.fr)	*
+!									*
+!************************************************************************
+!
+!********************************************************************************
+!										*
+! module io_netcdf								*
+!										*
+! NetCDF Fortran 90 read/write interface					*
+! using input/output functions provided						*
+! by unidata									*
+!										*
+!http://my.unidata.ucar.edu/content/software/netcdf/docs/netcdf-f90/index.html	*
+!										*
+!********************************************************************************
+!
+!
+!
+MODULE io_netcdf
+  !      
+  USE netcdf
+  USE agrif_types
+  !      
+  INTERFACE Read_Ncdf_var
+     MODULE PROCEDURE Read_Ncdf_var1d_Real,   &
+          Read_Ncdf_var2d_Real,   &
+          Read_Ncdf_var2d_Real_bis,   &
+          Read_Ncdf_var3d_Real,   &
+          Read_Ncdf_var4d_Real,   &
+          Read_Ncdf_var3d_Real_t, &
+          Read_Ncdf_var4d_Real_t, &
+          Read_Ncdf_var4d_Real_nt, &
+          Read_Ncdf_var1d_Int,    &
+          Read_Ncdf_var2d_Int,    &
+          Read_Ncdf_var3d_Int,    &
+          Read_Ncdf_var4d_Int,    &
+          Read_Ncdf_var0d_Int,    &
+          Read_Ncdf_var0d_Real
+  END INTERFACE
+  !
+  INTERFACE Write_Ncdf_var
+     MODULE PROCEDURE Write_Ncdf_var1d_Real,   &
+          Write_Ncdf_var2d_Real,   &
+          Write_Ncdf_var3d_Real,   &
+          Write_Ncdf_var4d_Real,   &
+          Write_Ncdf_var3d_Real_t, &
+          Write_Ncdf_var4d_Real_t, &
+          Write_Ncdf_var4d_Real_nt, &                           
+          Write_Ncdf_var2d_Real_bis,&			   
+          Write_Ncdf_var1d_Int,    &
+          Write_Ncdf_var2d_Int,    &
+          Write_Ncdf_var3d_Int,    &
+          Write_Ncdf_var4d_Int,    &
+          Write_Ncdf_var0d_Real
+  END INTERFACE
+  ! 
+  INTERFACE Copy_Ncdf_att
+     MODULE PROCEDURE Copy_Ncdf_att_latlon,Copy_Ncdf_att_var
+  END INTERFACE
+  !
+CONTAINS
+  !
+  !****************************************************************
+  !   subroutine Read_Ncdf_dim					*
+  !								*
+  ! subroutine to retrieve value of a given dimension 		*
+  !								*
+  !     dimname : name of dimension to retrieve			*
+  !     file    : netcdf file name				*
+  !     dimval  : value of the required dimension			*
+  !								*
+  !****************************************************************
+  !
+  SUBROUTINE Read_Ncdf_dim(dimname,file,dimval)   
+    !      
+    IMPLICIT NONE
+    !           
+    CHARACTER(*),INTENT(in) :: dimname,file    
+    INTEGER    :: dimval
+    !            
+    ! local variables
+    !
+    INTEGER ncid,status,dimid
+    !     
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname,dimid)
+    status = nf90_inquire_dimension(ncid,dimid,len=dimval)						                
+    !      
+    status = nf90_close(ncid)
+    !      
+  END SUBROUTINE Read_Ncdf_dim
+  !
+  !**************************************************************
+  ! end subroutine Read_Ncdf_dim
+  !**************************************************************      
+  !
+  !****************************************************************
+  !   subroutine Write_Ncdf_dim					*
+  !								*
+  ! subroutine to write a dimension in a given file 		*
+  !								*
+  !     dimname : name of dimension to initialize			*
+  !     file    : netcdf file name				*
+  !     dimval  : value of the dimension to write			*
+  !								*
+  !****************************************************************
+  !
+  SUBROUTINE Write_Ncdf_dim(dimname,file,dimval)   
+    !      
+    IMPLICIT NONE
+    !           
+    CHARACTER(*),INTENT(in) :: dimname,file    
+    INTEGER    :: dimval
+    !      
+    ! local variables
+    !
+    INTEGER ncid,status,dimid
+    !     
+    status = nf90_open(file,NF90_WRITE,ncid)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_redef(ncid)
+    IF(dimval.EQ.0) THEN
+       status = nf90_def_dim(ncid,dimname,nf90_unlimited,dimid)       
+    ELSE
+       status = nf90_def_dim(ncid,dimname,dimval,dimid)  
+    END IF
+
+    status = nf90_enddef(ncid)
+    !      
+
+    status = nf90_close(ncid)
+    !      
+  END SUBROUTINE Write_Ncdf_dim
+  !
+  !**************************************************************
+  ! end subroutine Write_Ncdf_dim
+  !**************************************************************            
+  ! 
+  !****************************************************************
+  !   subroutine Read_Ncdf_var					*
+  !								*
+  ! subroutine to retrieve values of a given variable 		*
+  !								*
+  !     varname : name of variable to retrieve			*
+  !     file    : netcdf file name				*
+  !     tabvar  : array containing values of the required variable*
+  !								*
+  !****************************************************************
+  !          
+  !**************************************************************
+  !   subroutine Read_Ncdf_var1d_real
+  !**************************************************************          
+  !      
+  SUBROUTINE Read_Ncdf_var1d_Real(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    REAL*8, DIMENSION(:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER, DIMENSION(1) :: dimID
+    INTEGER :: dim1
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimID)
+    status=nf90_inquire_dimension(ncid,dimID(1),len=dim1)
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1))  
+    ELSE
+       IF( ANY(SHAPE(tabvar)/=(/dim1/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1))      
+       ENDIF
+    ENDIF
+    !        
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE Read_Ncdf_var1d_Real
+  !           
+  !**************************************************************
+  ! end subroutine Read_Ncdf_var1d_real
+  !**************************************************************          
+  !            
+  !           
+  !**************************************************************
+  !   subroutine Read_Ncdf_var2d_real
+  !**************************************************************          
+  !      
+  SUBROUTINE Read_Ncdf_var2d_Real(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    REAL*8, DIMENSION(:,:), POINTER :: tabvar
+    !local variables
+    INTEGER, DIMENSION(10) :: dimIDS
+    INTEGER :: dim1,dim2
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2))  
+    ELSE
+       IF( ANY(SHAPE(tabvar)/=(/dim1,dim2/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1,dim2))      
+       ENDIF
+    ENDIF
+    !       
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE Read_Ncdf_var2d_Real
+  !           
+  !**************************************************************
+  ! end subroutine Read_Ncdf_var2d_real
+  !**************************************************************          
+  !    
+
+  !           
+  !**************************************************************
+  !   subroutine Read_Ncdf_var2d_real_bis
+  !**************************************************************          
+  !      
+  SUBROUTINE Read_Ncdf_var2d_Real_bis(varname,file,tabvar,strt,cnt)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    REAL*8, DIMENSION(:,:), POINTER :: tabvar
+    !local variables
+    INTEGER, DIMENSION(10) :: dimIDS
+    INTEGER, DIMENSION(2) :: strt,cnt
+    INTEGER :: dim1,dim2
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    dim1 = cnt(1) 
+    dim2 = cnt(2)
+    !      
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2))  
+    ELSE
+       IF( ANY(SHAPE(tabvar)/=(/dim1,dim2/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1,dim2))      
+       ENDIF
+    ENDIF
+    !       
+    status=nf90_get_var(ncid,varid,tabvar,start = strt,count = cnt)     
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE Read_Ncdf_var2d_Real_bis
+  !           
+  !**************************************************************
+  ! end subroutine Read_Ncdf_var2d_real_bis
+  !**************************************************************          
+  !  
+
+
+  !           
+  !**************************************************************
+  !   subroutine Read_Ncdf_var3d_real
+  !**************************************************************          
+  !      
+  SUBROUTINE Read_Ncdf_var3d_Real(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    REAL*8, DIMENSION(:,:,:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER, DIMENSION(10) :: dimIDS
+    INTEGER :: dim1,dim2,dim3
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)  
+    status=nf90_inquire_dimension(ncid,dimIDS(3),len=dim3)
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2,dim3))  
+    ELSE
+       IF( ANY(SHAPE(tabvar) /= (/dim1,dim2,dim3/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1,dim2,dim3))      
+       ENDIF
+    ENDIF
+    !      
+    status=nf90_get_var(ncid,varid,tabvar) 
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to retrieve netcdf variable : ",TRIM(varname)
+       STOP
+    ENDIF
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE Read_Ncdf_var3d_Real
+  !           
+  !**************************************************************
+  ! end subroutine Read_Ncdf_var3d_real
+  !**************************************************************          
+  ! 
+  !           
+  !**************************************************************
+  !   subroutine Read_Ncdf_var4d_real
+  !**************************************************************          
+  !      
+  SUBROUTINE Read_Ncdf_var4d_Real(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    REAL*8, DIMENSION(:,:,:,:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER, DIMENSION(10) :: dimIDS
+    INTEGER :: dim1,dim2,dim3,dim4
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)  
+    status=nf90_inquire_dimension(ncid,dimIDS(3),len=dim3)   
+    status=nf90_inquire_dimension(ncid,dimIDS(4),len=dim4)       
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2,dim3,dim4))  
+    ELSE
+       IF( ANY(SHAPE(tabvar) /= (/dim1,dim2,dim3,dim4/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1,dim2,dim3,dim4))      
+       ENDIF
+    ENDIF
+    !  
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE Read_Ncdf_var4d_Real
+
+  SUBROUTINE Read_Ncdf_var0d_Real(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    REAL*8 :: tabvar
+    !
+    !local variables
+    !
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    !
+    !  
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE Read_Ncdf_var0d_Real
+
+  SUBROUTINE Read_Ncdf_var0d_Int(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    INTEGER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    !
+    !  
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE Read_Ncdf_var0d_Int
+  !           
+  !**************************************************************
+  ! end subroutine Read_Ncdf_var4d_real
+  !**************************************************************          
+  !             
+  !           
+  !**************************************************************
+  !   subroutine Read_Ncdf_var1d_int
+  !**************************************************************          
+  !      
+  SUBROUTINE Read_Ncdf_var1d_Int(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    INTEGER, DIMENSION(:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER,DIMENSION(10) :: dimID
+    INTEGER :: dim1
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimID)
+    status=nf90_inquire_dimension(ncid,dimID(1),len=dim1)          
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1))  
+    ELSE
+       IF( ANY(SHAPE(tabvar) /= (/dim1/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1))      
+       ENDIF
+    ENDIF
+    !  
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    !      
+  END SUBROUTINE Read_Ncdf_var1d_Int
+  !           
+  !**************************************************************
+  ! end subroutine Read_Ncdf_var1d_int
+  !**************************************************************          
+  !            
+  !           
+  !**************************************************************
+  !   subroutine Read_Ncdf_var2d_int
+  !**************************************************************          
+  !      
+  SUBROUTINE Read_Ncdf_var2d_Int(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    INTEGER, DIMENSION(:,:), POINTER :: tabvar
+    !local variables
+    INTEGER, DIMENSION(10) :: dimIDS
+    INTEGER :: dim1,dim2
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)      
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2))  
+    ELSE
+       IF( ANY(SHAPE(tabvar) /= (/dim1,dim2/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1,dim2))      
+       ENDIF
+    ENDIF
+    !  
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    !      
+  END SUBROUTINE Read_Ncdf_var2d_Int
+  !           
+  !**************************************************************
+  ! end subroutine Read_Ncdf_var2d_Int
+  !**************************************************************          
+  !    
+
+  !           
+  !**************************************************************
+  !   subroutine Read_Ncdf_var3d_Int
+  !**************************************************************          
+  !      
+  SUBROUTINE Read_Ncdf_var3d_Int(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    INTEGER, DIMENSION(:,:,:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER, DIMENSION(10) :: dimIDS
+    INTEGER :: dim1,dim2,dim3
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)  
+    status=nf90_inquire_dimension(ncid,dimIDS(3),len=dim3)          
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2,dim3))  
+    ELSE
+       IF( ANY(SHAPE(tabvar) /= (/dim1,dim2,dim3/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1,dim2,dim3))      
+       ENDIF
+    ENDIF
+    ! 
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    !      
+  END SUBROUTINE Read_Ncdf_var3d_Int
+  !           
+  !**************************************************************
+  ! end subroutine Read_Ncdf_var3d_int
+  !**************************************************************  
+  !
+  !
+  !
+  !**************************************************************
+  !   subroutine Read_Ncdf_var4d_int
+  !**************************************************************          
+  !      
+  SUBROUTINE Read_Ncdf_var4d_Int(varname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    INTEGER, DIMENSION(:,:,:,:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER, DIMENSION(10) :: dimIDS
+    INTEGER :: dim1,dim2,dim3,dim4
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)  
+    status=nf90_inquire_dimension(ncid,dimIDS(3),len=dim3)   
+    status=nf90_inquire_dimension(ncid,dimIDS(4),len=dim4)       
+    !                
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2,dim3,dim4))  
+    ELSE
+       IF( ANY(SHAPE(tabvar) /= (/dim1,dim2,dim3,dim4/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1,dim2,dim3,dim4))      
+       ENDIF
+    ENDIF
+    !  
+    status=nf90_get_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE Read_Ncdf_var4d_Int
+  !           
+  !**************************************************************
+  ! end subroutine Read_Ncdf_var4d_real
+  !**************************************************************         
+  !    
+  !
+  !****************************************************************
+  !   subroutine Write_Ncdf_var					*
+  !								*
+  ! subroutine to write a variable in a given file 		*
+  !								*
+  !     varname : name of variable to store			*     
+  !     dimname : name of dimensions of the given variable	*
+  !     file    : netcdf file name				*
+  !     tabvar  : values of the variable to write			*
+  !								*
+  !****************************************************************
+  !    
+  !      
+  !**************************************************************
+  !   subroutine Write_Ncdf_var1d_real
+  !**************************************************************    
+  !      
+  SUBROUTINE Write_Ncdf_var1d_Real(varname,dimname,file,tabvar,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,dimname,typevar
+    REAL*8, DIMENSION(:), POINTER :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname, dimid)
+    status = nf90_inq_varid(ncid,varname,varid)
+    status = nf90_redef(ncid)
+    SELECT CASE(TRIM(typevar))
+    CASE('double')
+       status = nf90_def_var(ncid,varname,nf90_double,(/dimid/),varid)
+    CASE('float')
+       status = nf90_def_var(ncid,varname,nf90_float,(/dimid/),varid)      
+    END SELECT
+    status = nf90_enddef(ncid)
+    status = nf90_put_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE Write_Ncdf_var1d_Real
+  !      
+  !**************************************************************
+  !   end subroutine Write_Ncdf_var1d_real
+  !**************************************************************
+  !      
+  !**************************************************************
+  !   subroutine Write_Ncdf_var2d_real
+  !**************************************************************    
+  !      
+  SUBROUTINE Write_Ncdf_var2d_Real_bis(varname,dimname,file,tabvar,nbdim,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    INTEGER,INTENT(in) :: nbdim
+    CHARACTER(*), DIMENSION(4) :: dimname
+    REAL*8, DIMENSION(:,:) :: tabvar
+    REAL*8, DIMENSION(:,:,:),POINTER :: tabtemp3d
+    REAL*8, DIMENSION(:,:,:,:),POINTER :: tabtemp4d
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2,dimid3,dimid4
+    INTEGER :: status,ncid,ncid2
+    INTEGER :: varid,varid2             
+    ! 
+    IF(nbdim==4) THEN      
+       ALLOCATE(tabtemp4d(SIZE(tabvar,1),SIZE(tabvar,2),1,1))
+       tabtemp4d(:,:,1,1) = tabvar(:,:)
+    ELSE IF(nbdim==3) THEN
+       ALLOCATE(tabtemp3d(SIZE(tabvar,1),SIZE(tabvar,2),1))
+       tabtemp3d(:,:,1) = tabvar(:,:)
+    END IF
+    !      
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+    status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+    status = nf90_inq_dimid(ncid,dimname(3), dimid3)
+    !      
+    IF(nbdim==4) status = nf90_inq_dimid(ncid,dimname(4), dimid4)
+    !      
+    status = nf90_inq_varid(ncid,varname,varid)
+    status = nf90_redef(ncid)
+    IF(nbdim==4 .AND. typevar == 'double') THEN
+       status = nf90_def_var(ncid,varname,nf90_double,     &
+            (/dimid1,dimid2,dimid3,dimid4/),varid)
+       !                              
+    ELSE IF(nbdim==4 .AND. typevar == 'float') THEN
+       status = nf90_def_var(ncid,varname,nf90_float,     &
+            (/dimid1,dimid2,dimid3,dimid4/),varid)                        
+       !          
+    ELSE IF(nbdim==3 .AND. typevar == 'float') THEN
+       status = nf90_def_var(ncid,varname,nf90_float,     &
+            (/dimid1,dimid2,dimid3/),varid)
+       !
+    ELSE IF(nbdim==3 .AND. typevar == 'double') THEN
+       status = nf90_def_var(ncid,varname,nf90_double,     &
+            (/dimid1,dimid2,dimid3/),varid)
+       !     			      			      
+    ENDIF
+    !      			      
+    status = nf90_enddef(ncid)
+    IF(nbdim==4) status = nf90_put_var(ncid,varid,tabtemp4d)
+    IF(nbdim==3) status = nf90_put_var(ncid,varid,tabtemp3d)
+    !      
+    IF(ASSOCIATED( tabtemp3d ) ) DEALLOCATE( tabtemp3d )   
+    IF(ASSOCIATED( tabtemp4d ) ) DEALLOCATE( tabtemp4d )     
+    !
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE Write_Ncdf_var2d_Real_bis
+  !      
+  !**************************************************************
+  !   end subroutine Write_Ncdf_var2d_real
+  !**************************************************************  
+  !   
+  !      
+  !**************************************************************
+  !   subroutine Write_Ncdf_var2d_real
+  !**************************************************************    
+  !      
+  SUBROUTINE Write_Ncdf_var2d_Real(varname,dimname,file,tabvar,typevar)
+    !      
+    !      implicit none
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    CHARACTER(*), DIMENSION(2) :: dimname
+    REAL*8, DIMENSION(:,:), POINTER :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+    status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+    status = nf90_inq_varid(ncid,varname,varid)
+    status = nf90_redef(ncid)
+
+    SELECT CASE(TRIM(typevar))
+    CASE('double')
+       status = nf90_def_var(ncid,varname,nf90_double,     &
+            (/dimid1,dimid2/),varid)
+    CASE('float')
+       status = nf90_def_var(ncid,varname,nf90_float,     &
+            (/dimid1,dimid2/),varid)     
+    END SELECT
+    !
+    status = nf90_enddef(ncid)
+    status = nf90_put_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE Write_Ncdf_var2d_Real
+  !      
+  !**************************************************************
+  !   end subroutine Write_Ncdf_var2d_real
+  !**************************************************************  
+  !
+  !      
+  !**************************************************************
+  !   subroutine Write_Ncdf_var3d_real
+  !**************************************************************
+  !      
+  SUBROUTINE Write_Ncdf_var3d_Real(varname,dimname,file,tabvar,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    CHARACTER(*),DIMENSION(3),INTENT(in) :: dimname
+    REAL*8, DIMENSION(:,:,:), POINTER :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2,dimid3
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+    status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+    status = nf90_inq_dimid(ncid,dimname(3), dimid3)
+    status = nf90_inq_varid(ncid,varname,varid)
+    status = nf90_redef(ncid)
+
+    SELECT CASE(TRIM(typevar))
+    CASE('double')
+       status = nf90_def_var(ncid,varname,nf90_double,     &
+            (/dimid1,dimid2,dimid3/),varid)
+    CASE('float')
+       status = nf90_def_var(ncid,varname,nf90_float,     &
+            (/dimid1,dimid2,dimid3/),varid)    
+    END SELECT
+    !
+    status = nf90_enddef(ncid)
+    status = nf90_put_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE Write_Ncdf_var3d_Real
+  !      
+  !**************************************************************
+  !   end subroutine Write_Ncdf_var3d_real
+  !**************************************************************
+  ! 
+  !
+  !**************************************************************
+  !   subroutine Write_Ncdf_var4d_real
+  !**************************************************************
+  !      
+  SUBROUTINE Write_Ncdf_var4d_Real(varname,dimname,file,tabvar,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    CHARACTER(*),DIMENSION(4),INTENT(in) :: dimname
+    REAL*8, DIMENSION(:,:,:,:), POINTER :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2,dimid3,dimid4
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !
+    status = nf90_inq_varid(ncid,varname,varid)
+    !      
+    IF(status/=nf90_noerr) THEN
+       !     
+       status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+       status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+       status = nf90_inq_dimid(ncid,dimname(3), dimid3)
+       status = nf90_inq_dimid(ncid,dimname(4), dimid4)
+       status = nf90_redef(ncid)
+       !      
+       SELECT CASE(TRIM(typevar))
+       CASE('double')
+          status = nf90_def_var(ncid,varname,nf90_double,     &
+               (/dimid1,dimid2,dimid3,dimid4/),varid)
+       CASE('float')
+          status = nf90_def_var(ncid,varname,nf90_float,     &
+               (/dimid1,dimid2,dimid3,dimid4/),varid)   
+       END SELECT
+       !
+       status = nf90_enddef(ncid)
+    ENDIF
+    !         
+    status = nf90_put_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE Write_Ncdf_var4d_Real
+  !      
+  !**************************************************************
+  !   end subroutine Write_Ncdf_var4d_real
+  !**************************************************************
+  !
+  !
+  !  
+  !**************************************************************
+  !   subroutine Write_Ncdf_var1d_Int
+  !**************************************************************    
+  !      
+  SUBROUTINE Write_Ncdf_var1d_Int(varname,dimname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,dimname
+    INTEGER, DIMENSION(:), POINTER :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    !           print *,'ici tabvar = ',tabvar,varname,dimname
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname, dimid)
+    status = nf90_inq_varid(ncid,varname,varid)
+    status = nf90_redef(ncid)
+    status = nf90_def_var(ncid,varname,nf90_int,(/dimid/),varid)
+    status = nf90_enddef(ncid)
+    status = nf90_put_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE Write_Ncdf_var1d_Int
+  !      
+  !**************************************************************
+  !   end subroutine Write_Ncdf_var1d_Int
+  !**************************************************************
+  !  
+  !      
+  !**************************************************************
+  !   subroutine Write_Ncdf_var2d_Int
+  !**************************************************************    
+  !      
+  SUBROUTINE Write_Ncdf_var2d_Int(varname,dimname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    CHARACTER(*), DIMENSION(2) :: dimname
+    INTEGER, DIMENSION(:,:), POINTER :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+    status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+    status = nf90_inq_varid(ncid,varname,varid)
+    status = nf90_redef(ncid)
+    status = nf90_def_var(ncid,varname,nf90_int,     &
+         (/dimid1,dimid2/),varid)
+    status = nf90_enddef(ncid)
+    status = nf90_put_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE Write_Ncdf_var2d_Int
+  !      
+  !**************************************************************
+  !   end subroutine Write_Ncdf_var2d_Int
+  !**************************************************************  
+  ! 
+  !      
+  !**************************************************************
+  !   subroutine Write_Ncdf_var3d_Int
+  !**************************************************************
+  !      
+  SUBROUTINE Write_Ncdf_var3d_Int(varname,dimname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    CHARACTER(*),DIMENSION(3),INTENT(in) :: dimname
+    INTEGER, DIMENSION(:,:,:), POINTER :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2,dimid3
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+    status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+    status = nf90_inq_dimid(ncid,dimname(3), dimid3)
+    status = nf90_inq_varid(ncid,varname,varid)
+    status = nf90_redef(ncid)
+    status = nf90_def_var(ncid,varname,nf90_int,     &
+         (/dimid1,dimid2,dimid3/),varid)
+    status = nf90_enddef(ncid)
+    status = nf90_put_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE Write_Ncdf_var3d_Int
+  !      
+  !**************************************************************
+  !   end subroutine Write_Ncdf_var3d_Int
+  !**************************************************************
+  ! 
+  !
+  !**************************************************************
+  !   subroutine Write_Ncdf_var4d_Int
+  !**************************************************************
+  !      
+  SUBROUTINE Write_Ncdf_var4d_Int(varname,dimname,file,tabvar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    CHARACTER(*),DIMENSION(4),INTENT(in) :: dimname
+    INTEGER, DIMENSION(:,:,:,:), POINTER :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2,dimid3,dimid4
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+    status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+    status = nf90_inq_dimid(ncid,dimname(3), dimid3)
+    status = nf90_inq_dimid(ncid,dimname(4), dimid4)
+    status = nf90_inq_varid(ncid,varname,varid)
+    status = nf90_redef(ncid)
+    status = nf90_def_var(ncid,varname,nf90_int,     &
+         (/dimid1,dimid2,dimid3,dimid4/),varid)
+    status = nf90_enddef(ncid)
+    status = nf90_put_var(ncid,varid,tabvar)     
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE Write_Ncdf_var4d_Int
+  !      
+  !**************************************************************
+  !   end subroutine Write_Ncdf_var4d_Int
+  !************************************************************** 
+  !
+  !
+  !****************************************************************
+  !   subroutine Read_Ncdf_var_t					*
+  !								*
+  ! subroutine to read a variable in a given file for time t	*
+  !								*
+  !     varname : name of variable to read			*     
+  !     file    : netcdf file name				*
+  !     tabvar  : values of the read variable			*
+  !     time    : time corresponding to the values to read	*	
+  !								*
+  !****************************************************************
+  !
+  !
+  !**************************************************************
+  !   subroutine Read_Ncdf_var3d_real_t
+  !**************************************************************          
+  !      
+  SUBROUTINE Read_Ncdf_var3d_Real_t(varname,file,tabvar,time)
+    !      
+    USE agrif_types     
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    INTEGER,INTENT(in) :: time
+    REAL*8, DIMENSION(:,:,:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER, DIMENSION(3) :: dimIDS
+    INTEGER :: dim1,dim2
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    !        
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)
+    !
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2,1))  
+    ELSE
+       IF( ANY(SHAPE(tabvar) /= (/dim1,dim2,1/)) ) THEN	   
+          DEALLOCATE(tabvar)   
+          ALLOCATE(tabvar(dim1,dim2,1))      
+       ENDIF
+    ENDIF
+
+    status=nf90_get_var(ncid,varid,tabvar,start=(/1,1,time/))
+
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to retrieve netcdf variable : ",TRIM(varname)
+       STOP
+    ENDIF
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE Read_Ncdf_var3d_Real_t
+  !           
+  !**************************************************************
+  ! end subroutine Read_Ncdf_var3d_real_t
+  !**************************************************************          
+  !
+  !
+  !
+  !****************************************************************
+  !   subroutine Write_Ncdf_var_t					*
+  !								*
+  ! subroutine to write a variable in a given file for time t	*
+  !								*
+  !     varname : name of variable to store			*     
+  !     dimname : name of dimensions of the given variable	*
+  !     file    : netcdf file name				*
+  !     tabvar  : values of the variable to write			*
+  !     time    : time corresponding to the values to store	*	
+  !								*
+  !****************************************************************
+  !
+  !      
+  !**************************************************************
+  !   subroutine Write_Ncdf_var3d_real_t
+  !**************************************************************
+  !      
+  SUBROUTINE Write_Ncdf_var3d_Real_t(varname,dimname,file,tabvar,time,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    CHARACTER(*),DIMENSION(3),INTENT(in) :: dimname
+    INTEGER :: time
+    REAL*8, DIMENSION(:,:,:), POINTER :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2,dimid3
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    IF(time==1) THEN
+       !      
+       status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+       status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+       status = nf90_inq_dimid(ncid,dimname(3), dimid3)
+       status = nf90_redef(ncid)
+
+       !      
+       SELECT CASE(TRIM(typevar))
+       CASE('double')
+          status = nf90_def_var(ncid,varname,nf90_double,     &
+               (/dimid1,dimid2,dimid3/),varid) 
+       CASE('float')
+          status = nf90_def_var(ncid,varname,nf90_float,     &
+               (/dimid1,dimid2,dimid3/),varid)    
+       END SELECT
+       !
+       status = nf90_enddef(ncid)
+
+    ELSE
+       status = nf90_inq_varid(ncid, varname, varid)
+    ENDIF
+    !      
+    status = nf90_put_var(ncid,varid,tabvar,start=(/1,1,time/))
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to store variable ",varname, &
+	    " in file ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE Write_Ncdf_var3d_Real_t
+  !      
+  !**************************************************************
+  !   end subroutine Write_Ncdf_var3d_real_t
+  !**************************************************************
+  !
+  !
+  !****************************************************************
+  !   subroutine Read_Ncdf_var_t					*
+  !								*
+  ! subroutine to read a variable in a given file for time t	*
+  !						at level n	*
+  !     varname : name of variable to read			*     
+  !     file    : netcdf file name				*
+  !     tabvar  : values of the read variable			*
+  !     time    : time corresponding to the values to read	*	
+  !     level   : level corresponding to the values to read	*
+  !								*
+  !****************************************************************
+  !
+  !
+  !**************************************************************
+  !   subroutine Read_Ncdf_var4d_real_nt
+  !**************************************************************          
+  !      
+  SUBROUTINE Read_Ncdf_var4d_Real_nt(varname,file,tabvar,time,level)
+    !      
+    USE agrif_types     
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    INTEGER,INTENT(in) :: time,level
+    REAL*8, DIMENSION(:,:,:,:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER, DIMENSION(4) :: dimIDS
+    INTEGER :: dim1,dim2
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    !        
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)
+    !
+    IF(.NOT. ASSOCIATED(tabvar)) THEN
+       ALLOCATE(tabvar(dim1,dim2,1,1))  
+    ELSE
+       IF ((SIZE(tabvar,1) /= dim1) .OR. (SIZE(tabvar,2) /= dim2)) THEN
+          DEALLOCATE(tabvar)
+          ALLOCATE(tabvar(dim1,dim2,1,1))
+       ENDIF
+    ENDIF
+    !
+    status=nf90_get_var(ncid,varid,tabvar,start=(/1,1,level,time/),count=(/dim1,dim2,1,1/))
+    !                                             
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to retrieve netcdf variable : ",TRIM(varname)
+       STOP
+    ENDIF
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE Read_Ncdf_var4d_Real_nt
+  !           
+  !**************************************************************
+  ! end subroutine Read_Ncdf_var4d_real_nt
+  !**************************************************************          
+  !
+  !
+  !**************************************************************
+  !   subroutine Read_Ncdf_var4d_real_t
+  !**************************************************************          
+  !      
+  SUBROUTINE Read_Ncdf_var4d_Real_t(varname,file,tabvar,time)
+    !      
+    USE agrif_types     
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file
+    INTEGER,INTENT(in) :: time
+    REAL*8, DIMENSION(:,:,:,:), POINTER :: tabvar
+    !
+    !local variables
+    !
+    INTEGER, DIMENSION(4) :: dimIDS
+    INTEGER :: dim1,dim2,dim3
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_NOWRITE,ncid)
+    !      
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !     
+    status = nf90_inq_varid(ncid,varname,varid)
+    !        
+    status=nf90_inquire_variable(ncid,varid,dimids=dimIDS)
+    status=nf90_inquire_dimension(ncid,dimIDS(1),len=dim1)
+    status=nf90_inquire_dimension(ncid,dimIDS(2),len=dim2)
+    status=nf90_inquire_dimension(ncid,dimIDS(3),len=dim3)
+    !
+    IF(.NOT. ASSOCIATED(tabvar)) ALLOCATE(tabvar(dim1,dim2,dim3,1))  
+    status=nf90_get_var(ncid,varid,tabvar,start=(/1,1,1,time/))
+
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to retrieve netcdf variable : ",TRIM(varname)
+       STOP
+    ENDIF
+    !     
+    status = nf90_close(ncid)
+    !     
+  END SUBROUTINE Read_Ncdf_var4d_Real_t
+  !           
+  !**************************************************************
+  ! end subroutine Read_Ncdf_var4d_real_t
+  !**************************************************************          
+  !
+  !
+  !****************************************************************
+  !   subroutine Write_Ncdf_var_t					*
+  !								*
+  ! subroutine to write a variable in a given file for time t	*
+  !						at level n	*
+  !     varname : name of variable to store			*     
+  !     dimname : name of dimensions of the given variable	*
+  !     file    : netcdf file name				*
+  !     tabvar  : values of the variable to write			*
+  !     time    : time corresponding to the values to store	*	
+  !     level   : level corresponding to the values to store	*
+  !								*
+  !****************************************************************
+  !
+  !      
+  !**************************************************************
+  !   subroutine Write_Ncdf_var4d_real_t
+  !**************************************************************
+  !      
+  SUBROUTINE Write_Ncdf_var4d_Real_t(varname,dimname,file,tabvar,time,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    CHARACTER(*),DIMENSION(4),INTENT(in) :: dimname
+    INTEGER :: time,level
+    REAL*8, DIMENSION(:,:,:,:), POINTER :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2,dimid3,dimid4
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !      
+    IF(time==1) THEN
+       !      
+       status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+       status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+       status = nf90_inq_dimid(ncid,dimname(3), dimid3)
+       status = nf90_inq_dimid(ncid,dimname(4), dimid4)
+       status = nf90_redef(ncid)
+       !      
+       SELECT CASE(TRIM(typevar))
+       CASE('double')
+          status = nf90_def_var(ncid,TRIM(varname),nf90_double,     &
+               (/dimid1,dimid2,dimid3,dimid4/),varid)  
+       CASE('float')
+          status = nf90_def_var(ncid,TRIM(varname),nf90_float,     &
+               (/dimid1,dimid2,dimid3,dimid4/),varid)    
+       END SELECT
+       !
+       status = nf90_enddef(ncid)
+
+    ELSE
+       status = nf90_inq_varid(ncid, varname, varid)
+    ENDIF
+    !    
+    status = nf90_put_var(ncid,varid,tabvar,start=(/1,1,1,time/))
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to store variable ",varname, &
+	    " in file ",file
+       STOP
+    ENDIF
+    !    
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE Write_Ncdf_var4d_Real_t
+  !      
+  !**************************************************************
+  !   end subroutine Write_Ncdf_var4d_real_t
+  !**************************************************************
+  !
+  !      
+  !**************************************************************
+  !   subroutine Write_Ncdf_var4d_real_nt
+  !**************************************************************
+  !      
+  SUBROUTINE Write_Ncdf_var4d_Real_nt(varname,dimname,file,tabvar,time,level,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    CHARACTER(*),DIMENSION(4),INTENT(in) :: dimname
+    INTEGER :: time,level
+    REAL*8, DIMENSION(:,:,:,:), POINTER :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: dimid1,dimid2,dimid3,dimid4
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !      
+    IF(time==1.AND.level==1) THEN
+       !      
+       status = nf90_inq_dimid(ncid,dimname(1), dimid1)
+       status = nf90_inq_dimid(ncid,dimname(2), dimid2)
+       status = nf90_inq_dimid(ncid,dimname(3), dimid3)
+       status = nf90_inq_dimid(ncid,dimname(4), dimid4)
+       status = nf90_redef(ncid)
+       !      
+       SELECT CASE(TRIM(typevar))
+       CASE('double')
+          status = nf90_def_var(ncid,TRIM(varname),nf90_double,     &
+               (/dimid1,dimid2,dimid3,dimid4/),varid)  
+       CASE('float')
+          status = nf90_def_var(ncid,TRIM(varname),nf90_float,     &
+               (/dimid1,dimid2,dimid3,dimid4/),varid)    
+       END SELECT
+       !
+       status = nf90_enddef(ncid)
+
+    ELSE
+       status = nf90_inq_varid(ncid, varname, varid)
+    ENDIF
+    !    
+    status = nf90_put_var(ncid,varid,tabvar,start=(/1,1,level,time/))
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to store variable ",varname, &
+	    " in file ",file
+       STOP
+    ENDIF
+    !    
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE Write_Ncdf_var4d_Real_nt
+
+  SUBROUTINE Write_Ncdf_var0d_Real(varname,file,tabvar,typevar)
+    !      
+    IMPLICIT NONE
+    !       
+    CHARACTER(*),INTENT(in) :: varname,file,typevar
+    INTEGER :: time,level
+    REAL*8 :: tabvar
+    !
+    ! local variables
+    !
+    INTEGER :: status,ncid
+    INTEGER :: varid             
+    !
+    status = nf90_open(file,NF90_WRITE,ncid)       
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",file
+       STOP
+    ENDIF
+    !      
+
+    status = nf90_redef(ncid)
+    !      
+    SELECT CASE(TRIM(typevar))
+    CASE('double')
+       status = nf90_def_var(ncid,TRIM(varname),nf90_double,     &
+            varid=varid)  
+    CASE('float')
+       status = nf90_def_var(ncid,TRIM(varname),nf90_float,     &
+            varid=varid)    
+    END SELECT
+    !
+    status = nf90_enddef(ncid)
+
+    !    
+    status = nf90_put_var(ncid,varid,tabvar)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to store variable ",varname, &
+	    " in file ",file
+       STOP
+    ENDIF
+    !    
+    status = nf90_close(ncid)
+    ! 
+  END SUBROUTINE Write_Ncdf_var0d_Real
+  !      
+  !**************************************************************
+  !   end subroutine Write_Ncdf_var4d_real_nt
+  !**************************************************************
+  !
+  !****************************************************************
+  !   subroutine Read_Ncdf_VarName				*
+  !								*
+  ! subroutine to retrieve of all variables 			*
+  ! included in a given file					*
+  !								*
+  !     filename    : netcdf file name				*
+  !     tabvarname  : array containing various variables names	*
+  !								*
+  !****************************************************************
+  !
+  !**************************************************************
+  !   subroutine Read_Ncdf_VarName
+  !**************************************************************          
+  !
+  SUBROUTINE Read_Ncdf_VarName(filename,tabvarname)
+    !      
+    CHARACTER(*),INTENT(in) :: filename
+    CHARACTER*20,DIMENSION(:),POINTER :: tabvarname
+    INTEGER :: nDimensions,nVariables
+    INTEGER :: nAttributes,unlimitedDimId,i
+    INTEGER :: ncid,status,dimid
+    !     
+    status = nf90_open(filename,NF90_NOWRITE,ncid)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",filename
+       STOP
+    ENDIF
+    !      
+    status = nf90_inquire(ncid,nDimensions,nVariables,nAttributes, &                                                      
+         unlimitedDimId) 
+    !
+    ALLOCATE(tabvarname(nVariables))
+    !
+    DO i=1,nVariables
+       status = nf90_inquire_variable(ncid,i,tabvarname(i))
+    END DO
+
+  END SUBROUTINE Read_Ncdf_Varname
+  !
+  !**************************************************************
+  !   end subroutine Read_Ncdf_VarName
+  !**************************************************************          
+  !
+  !**************************************************************
+  !   subroutine Copy_Ncdf_att
+  !**************************************************************          
+  !
+  SUBROUTINE Copy_Ncdf_att_var(varname,filein,fileout)
+    !      
+    CHARACTER(*),INTENT(in) :: filein,fileout
+    CHARACTER(*),INTENT(in) :: varname
+    INTEGER :: ncid_in,ncid_out,status,varid_in,varid_out
+    !     
+    !      print *,'filein = ',filein,fileout
+    status = nf90_open(filein,NF90_NOWRITE,ncid_in)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open input netcdf file : ",filein
+       STOP
+    ENDIF
+    !     							     	   
+    status = nf90_open(fileout,NF90_WRITE,ncid_out)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open output netcdf file : ",fileout
+       STOP
+    ENDIF
+    !  
+    !      print *,'ici1'
+    status = nf90_inq_varid(ncid_in,varname,varid_in)
+    status = nf90_inq_varid(ncid_out,varname,varid_out)
+    !
+    status = nf90_redef(ncid_out)
+    !      
+    status = nf90_copy_att(ncid_in,varid_in,'units',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'valid_min',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'valid_max',ncid_out,varid_out) 
+    status = nf90_copy_att(ncid_in,varid_in,'long_name',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'calendar',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'title',ncid_out,varid_out)     
+    status = nf90_copy_att(ncid_in,varid_in,'time_origin',ncid_out,varid_out) 
+    status = nf90_copy_att(ncid_in,varid_in,'positive',ncid_out,varid_out)                 
+    status = nf90_copy_att(ncid_in,varid_in,'tstep_sec',ncid_out,varid_out)          
+    status = nf90_copy_att(ncid_in,varid_in,'nav_model',ncid_out,varid_out)   
+    status = nf90_copy_att(ncid_in,varid_in,'Minvalue=',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'Maxvalue=',ncid_out,varid_out)  
+    status = nf90_copy_att(ncid_in,varid_in,'short_name',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'online_operation',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'axis',ncid_out,varid_out)            
+    status = nf90_copy_att(ncid_in,varid_in,'interval_operation',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'interval_write',ncid_out,varid_out) 
+    status = nf90_copy_att(ncid_in,varid_in,'associate',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'actual_range',ncid_out,varid_out) 
+    status = nf90_copy_att(ncid_in,varid_in,'longitude',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'latitude',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'scale_factor',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'add_offset',ncid_out,varid_out)
+    status = nf90_copy_att(ncid_in,varid_in,'missing_value',ncid_out,varid_out) 
+    !      
+    status = nf90_enddef(ncid_out)  
+    !
+    status = nf90_close(ncid_in)
+    status = nf90_close(ncid_out)
+    !      print *,'ici2'
+    ! 
+  END SUBROUTINE Copy_Ncdf_att_var
+  !
+  !**************************************************************
+  !   end subroutine Copy_Ncdf_att
+  !**************************************************************         
+  !**************************************************************
+  !   subroutine Copy_Ncdf_att
+  !**************************************************************          
+  !
+  SUBROUTINE Copy_Ncdf_att_latlon(varname,filein,fileout,min,max)
+    !      
+    CHARACTER(*),INTENT(in) :: filein,fileout
+    CHARACTER(*),INTENT(in) :: varname
+    REAL*8 :: min,max
+    INTEGER :: ncid_in,ncid_out,status,varid_in,varid_out
+    !     
+    status = nf90_open(filein,NF90_NOWRITE,ncid_in)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",filein
+       STOP
+    ENDIF
+    !     							     	   
+    status = nf90_open(fileout,NF90_WRITE,ncid_out)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",fileout
+       STOP
+    ENDIF
+    !  
+    status = nf90_inq_varid(ncid_in,varname,varid_in)
+    status = nf90_inq_varid(ncid_out,varname,varid_out)
+    !
+    status = nf90_redef(ncid_out)
+    !      
+    SELECT CASE (varname)
+       !      
+    CASE('nav_lon')     
+       status = nf90_copy_att(ncid_in,varid_in,'units',ncid_out,varid_out) 
+       status = nf90_put_att(ncid_out,varid_out,'valid_min',REAL(min,4))
+       status = nf90_put_att(ncid_out,varid_out,'valid_max',REAL(max,4))
+       status = nf90_copy_att(ncid_in,varid_in,'long_name',ncid_out,varid_out)
+       status = nf90_copy_att(ncid_in,varid_in,'nav_model',ncid_out,varid_out)
+       status = nf90_copy_att(ncid_in,varid_in,'title',ncid_out,varid_out)
+       !
+    CASE('nav_lat')
+       status = nf90_copy_att(ncid_in,varid_in,'units',ncid_out,varid_out) 
+       status = nf90_put_att(ncid_out,varid_out,'valid_min',REAL(min,4))
+       status = nf90_put_att(ncid_out,varid_out,'valid_max',REAL(max,4))
+       status = nf90_copy_att(ncid_in,varid_in,'long_name',ncid_out,varid_out)
+       status = nf90_copy_att(ncid_in,varid_in,'nav_model',ncid_out,varid_out)
+       status = nf90_copy_att(ncid_in,varid_in,'title',ncid_out,varid_out) 
+       !
+    END SELECT
+    !      
+    status = nf90_enddef(ncid_out)  
+    !
+    status = nf90_close(ncid_in)
+    status = nf90_close(ncid_out)
+  END SUBROUTINE Copy_Ncdf_att_latlon
+  !*************************************************************
+  !**************************************************************
+  !**************************************************************
+  !   function Get_NbDims
+  !**************************************************************          
+  !
+  INTEGER FUNCTION Get_NbDims( varname , filename )
+    !
+    CHARACTER(*),INTENT(in) :: varname,filename
+    INTEGER :: status,ncid,varid    
+    !      
+    status = nf90_open(TRIM(filename),NF90_NOWRITE,ncid)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",TRIM(filename)
+       STOP
+    ENDIF
+    status = nf90_inq_varid(ncid,TRIM(varname),varid)     
+    status = nf90_inquire_variable(ncid, varid , ndims = Get_NbDims)
+    !
+    RETURN
+    !
+  END FUNCTION Get_NbDims
+  !
+  !*************************************************************
+  !**************************************************************
+  !   function Get_NbDims
+  !**************************************************************          
+  !
+  LOGICAL FUNCTION Dims_Existence( dimname , filename )
+    !
+    CHARACTER(*),INTENT(in) :: dimname,filename
+    INTEGER :: status,ncid,dimid    
+    !      
+    status = nf90_open(TRIM(filename),NF90_NOWRITE,ncid)
+    IF (status/=nf90_noerr) THEN    
+       WRITE(*,*)"unable to open netcdf file : ",TRIM(filename)
+       STOP
+    ENDIF
+    status = nf90_inq_dimid(ncid,dimname,dimid)
+    !      
+    IF (status/=nf90_noerr) THEN
+       Dims_Existence = .FALSE.
+    ELSE
+       Dims_Existence = .TRUE.
+    ENDIF
+    !
+    RETURN
+    !
+  END FUNCTION Dims_Existence
+  !
+  !*************************************************************
+  !**************************************************************
+END MODULE io_netcdf
Index: trunk/NEMOGCM/TOOLS/REBUILD/rebuild
===================================================================
--- trunk/NEMOGCM/TOOLS/REBUILD/rebuild	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/REBUILD/rebuild	(revision 2528)
@@ -0,0 +1,1 @@
+link ../../EXTERNAL/IOIPSL/tools/rebuild
Index: trunk/NEMOGCM/TOOLS/REBUILD/src/calendar.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/REBUILD/src/calendar.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/REBUILD/src/calendar.f90	(revision 2528)
@@ -0,0 +1,1 @@
+link ../../../EXTERNAL/IOIPSL/src/calendar.f90
Index: trunk/NEMOGCM/TOOLS/REBUILD/src/defprec.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/REBUILD/src/defprec.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/REBUILD/src/defprec.f90	(revision 2528)
@@ -0,0 +1,1 @@
+link ../../../EXTERNAL/IOIPSL/src/defprec.f90
Index: trunk/NEMOGCM/TOOLS/REBUILD/src/errioipsl.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/REBUILD/src/errioipsl.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/REBUILD/src/errioipsl.f90	(revision 2528)
@@ -0,0 +1,1 @@
+link ../../../EXTERNAL/IOIPSL/src/errioipsl.f90
Index: trunk/NEMOGCM/TOOLS/REBUILD/src/flincom.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/REBUILD/src/flincom.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/REBUILD/src/flincom.f90	(revision 2528)
@@ -0,0 +1,1 @@
+link ../../../EXTERNAL/IOIPSL/src/flincom.f90
Index: trunk/NEMOGCM/TOOLS/REBUILD/src/flio_rbld.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/REBUILD/src/flio_rbld.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/REBUILD/src/flio_rbld.f90	(revision 2528)
@@ -0,0 +1,1 @@
+link ../../../EXTERNAL/IOIPSL/tools/flio_rbld.f90
Index: trunk/NEMOGCM/TOOLS/REBUILD/src/fliocom.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/REBUILD/src/fliocom.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/REBUILD/src/fliocom.f90	(revision 2528)
@@ -0,0 +1,1 @@
+link ../../../EXTERNAL/IOIPSL/src/fliocom.f90
Index: trunk/NEMOGCM/TOOLS/REBUILD/src/getincom.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/REBUILD/src/getincom.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/REBUILD/src/getincom.f90	(revision 2528)
@@ -0,0 +1,1 @@
+link ../../../EXTERNAL/IOIPSL/src/getincom.f90
Index: trunk/NEMOGCM/TOOLS/REBUILD/src/histcom.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/REBUILD/src/histcom.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/REBUILD/src/histcom.f90	(revision 2528)
@@ -0,0 +1,1 @@
+link ../../../EXTERNAL/IOIPSL/src/histcom.f90
Index: trunk/NEMOGCM/TOOLS/REBUILD/src/ioipsl.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/REBUILD/src/ioipsl.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/REBUILD/src/ioipsl.f90	(revision 2528)
@@ -0,0 +1,1 @@
+link ../../../EXTERNAL/IOIPSL/src/ioipsl.f90
Index: trunk/NEMOGCM/TOOLS/REBUILD/src/mathelp.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/REBUILD/src/mathelp.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/REBUILD/src/mathelp.f90	(revision 2528)
@@ -0,0 +1,1 @@
+link ../../../EXTERNAL/IOIPSL/src/mathelp.f90
Index: trunk/NEMOGCM/TOOLS/REBUILD/src/nc4interface.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/REBUILD/src/nc4interface.F90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/REBUILD/src/nc4interface.F90	(revision 2528)
@@ -0,0 +1,1 @@
+link ../../../EXTERNAL/IOIPSL/src/nc4interface.F90
Index: trunk/NEMOGCM/TOOLS/REBUILD/src/ncunderflow.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/REBUILD/src/ncunderflow.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/REBUILD/src/ncunderflow.f90	(revision 2528)
@@ -0,0 +1,1 @@
+link ../../../EXTERNAL/IOIPSL/tools/ncunderflow.f90
Index: trunk/NEMOGCM/TOOLS/REBUILD/src/restcom.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/REBUILD/src/restcom.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/REBUILD/src/restcom.f90	(revision 2528)
@@ -0,0 +1,1 @@
+link ../../../EXTERNAL/IOIPSL/src/restcom.f90
Index: trunk/NEMOGCM/TOOLS/REBUILD/src/stringop.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/REBUILD/src/stringop.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/REBUILD/src/stringop.f90	(revision 2528)
@@ -0,0 +1,1 @@
+link ../../../EXTERNAL/IOIPSL/src/stringop.f90
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/README
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/README	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/README	(revision 2528)
@@ -0,0 +1,304 @@
+nocsSCRIP v1.1 03/11/2010
+-------------------------
+
+Author: NOCS NEMO Team
+Contacts: Steven Alderson (sga@noc.soton.ac.uk)
+          Andrew Coward   (acc@noc.soton.ac.uk)
+
+Disclaimer
+
+This directory contains software for generating and manipulating interpolation
+weights for use with the Interpolation On the Fly (IOF) option in NEMO
+v3 onwards.  The utilities rely heavily on the Spherical Coordinate Remapping
+and Interpolation Package (SCRIP) which is freely available from Los Alamos
+(see copyright file). We make no claim to authorship of those parts of the
+SCRIP package we have used and included with this distribution.
+
+Unless otherwise indicated, all other software has been authored by an
+employee or employees of the National Oceanography Centre, Southampton, UK
+(NOCS).  NOCS operates as a collaboration between the Natural Environment
+Research Council (NERC) and the University of Southampton.  The public may
+copy and use this software without charge, provided that this Notice and any
+statement of authorship are reproduced on all copies.  Neither NERC nor the
+University makes any warranty, express or implied, or assumes any liability
+or responsibility for the use of this software.
+
+Introduction
+
+The IOF option enables forced ocean runs without the need to provide surface
+boundary data on the nemo grid. Atmospheric data are kept on their original
+grid(s) which typically have a coarser resolution than the ocean grid. IOF
+supports multiple source (atmospheric) grids and two interpolation methods
+(bilinear and bicubic).  Different combinations of source grid and method can
+be selected for each variable.  IOF is also compatible with AGRIF; allowing
+AGRIF nests to be used without the need to provide separate forcing data
+(only a separate set of weights fields).  Operational details are provided
+in the SBC chapter of the NEMO reference manual.
+
+Please note that the methods described here assume that the forcing datasets
+are unmasked. Where the original sources are masked it is the users'
+responsibility to ensure that an unmasked set is produced on the source
+grid with appropriate oceanic values in previously masked locations. This
+is particularly important for atmospheric variables which experience step
+changes at the land-sea boundary. For these, care must be taken to avoid
+contaminating oceanic values.
+
+The software is divided into several sub-directories:
+
+                         ./
+                          |
+     +-------------+--------------+
+  SCRIP1.4      nocsutil         bin
+
+SCRIP1.4 contains the unmodified copy (apart from compression of two sample netcdf
+files) of SCRIP version 1.4 from Los Alamos. 
+(http://climate.lanl.gov/Software/SCRIP).
+
+The bin directory contains python script freeform.py.
+This is run to reformat the code for use within the NEMO 3.3 FCm framework.
+It creates and populates a directory called 'src' with copied and modified versions
+of the SCRIP library routines.  Changes are described in the src/CHANGES file.
+This script has already been run and only needs to be re-executed if SCRIP is updated.
+
+The nocscrip directory contains the code for the three programs used to 
+generate a weights file. These are:
+
+scripgrid.exe (scripgrid.F90) which creates two grid description files suitable for
+input to the scrip package. 
+
+scrip.exe (scrip.F90) which takes these descriptions and generates the required
+weights in the standard SCRIP format. This program is a version of the SCRIP
+program: scrip.f which has been modified to accept the name of its namelist
+file on the command line.
+
+scripshape.exe (scripshape.F90) which takes the output from scrip and rearranges
+the fields into a series of 2D fields more suited for input into NEMO using
+the iom_get routine.
+
+All three FORTRAN90 programs read domain information from their respective
+netCDF input files and dynamically allocate internal storage. They are
+thus independent of the target configuration and have been successfully
+tested with both ORCA2 and ORCA025 grids. Their suitably for use with larger
+grids has not been tested but should only be subject to limitations of
+the operating system and the memory available to the processing element.
+
+A separate tar file is available containing test data.
+This comprises an ORCA2 coordinates file and sample DFS4.1 input field that
+can be used for testing. Reference weights files generated using the two
+example namelists provided are located in its refout subdirectory.
+
+Installation is by use of the makenemo script.
+
+Example Use
+-----------
+
+  cd data
+  ../scripgrid.exe  namelist_reshape_bilin    (creates remap_data_grid.nc 
+                                                and remap_nemo_grid.nc)
+  ../scrip.exe      namelist_reshape_bilin    (creates data_nemo_bilin.nc)
+
+  ../scripshape.exe namelist_reshape_bilin    (creates reshape_orca2_bilinear.nc)
+  
+[Note that because the gfortran compiler does not understand the iargc function 
+and getarg subroutine calls, command line namelist names can only be supplied if
+symbol ARGC is defined during compilation (eg add '#define ARGC' to the top of 
+the relevant program).  If not, the program asks for the name instead during execution.]
+
+Only the final output file is required for use with NEMO but the intermediate
+files can be checked against the examples in the test data (available separately).
+
+For bicubic mapping only scrip and scripshape need to be rerun (because the grid_inputs namelist
+entries are identical in the two namelist files, see Controls section below):
+ 
+  ../scrip.exe namelist_reshape_bicubic       (creates data_nemo_bicubic.nc)
+
+  ../scripshape.exe namelist_reshape_bicubic  (creates reshape_orca2_bicubic.nc)
+
+Controls
+--------
+
+The SCRIP derived utilities use SCRIP-style namelists to control their
+operation.  In the example above the same named file is used for both but within that
+file are two separate namelists:
+
+&grid_inputs
+    input_file = './snow_1m_TRP_1958.nc'
+    nemo_file = 'coordinates.nc'
+    datagrid_file = 'remap_data_grid.nc'
+    nemogrid_file = 'remap_nemo_grid.nc'
+    method = 'regular'
+    input_lon = 'lon'
+    input_lat = 'lat'
+    nemo_lon = 'glamt'
+    nemo_lat = 'gphit'
+    nemo_mask = 'none'
+    nemo_mask_value = 10
+    input_mask = 'none'
+    input_mask_value = 10
+/
+
+which is used by scripgrid, and:
+
+&remap_inputs
+    num_maps = 1
+    grid1_file = 'remap_data_grid.nc'
+    grid2_file = 'remap_nemo_grid.nc'
+    interp_file1 = 'data_nemo_bilin.nc'
+    interp_file2 = 'nemo_data_bilin.nc'
+    map1_name = 'data to nemo bilin Mapping'
+    map2_name = 'nemo to data bilin Mapping'
+    map_method = 'bilinear'
+    normalize_opt = 'frac'
+    output_opt = 'scrip'
+    restrict_type = 'latitude'
+    num_srch_bins = 90
+    luse_grid1_area = .false.
+    luse_grid2_area = .false.
+/
+
+which is used by scrip.
+
+scripshape also reads information from a namelist:
+
+&shape_inputs
+    interp_file = 'data_nemo_bilin.nc'
+    output_file = 'weights_bilin.nc'
+    ew_wrap     = 0
+/
+
+scripgrid.exe
+-------------
+
+scripgrid accesses the named files and coordinate data in order to produce
+the grid centre and corner locations required by scrip. In the example given,
+a file called 'coordinates.nc' must exist in the current directory. This is
+recognised by scripgrid as a nemo coordinates file and the correct corner
+locations appropriate to the named grid centres are obtained (i.e. since
+glamt is named, glamf and gphif will be used to provide corner coordinates).
+"input_file" file must contain at least one variable on a grid whose axes are
+described by the netcdf coordinate variables named in input_lon and input_lat.
+The program produces two grid description files, one corresponding to each
+input file, for use by the scrip program to calculate weights required to
+go from one to the other and back again.
+
+This step is independent of the mapping method (e.g. bilinear or bicubic)
+and so only one set of remap_data_grid.nc and remap_nemo_grid.nc files needs
+to be produced for each pair of source and destination grids.
+
+scrip.exe
+---------
+
+scrip takes the output files from scripgrid and creates a file of weights
+to use to interpolate between the two grids described. The example given
+only requests 1 map (from data to nemo); setting num_maps=2 will provide
+the reverse weights if required.
+ 
+ - num_maps is either 1 or 2 depending on whether the reverse 
+    transformation is required 
+
+ - grid1_file, grid2_file: two remap grid files are required 
+    as output by scripgrid
+
+ - interp_file1, interp_file2: one or two interp_file names are 
+    then supplied; these hold the weights to convert one grid to another
+
+ - map1_name, map2_name: the map_name variables are just descriptive
+
+ - map_method: can be 'bilinear' or 'bicubic'
+
+ - normalize_opt: should usually be 'frac' or else the user needs to do  
+    this scaling manually (this seems to the case for fractional ice cover)
+
+ - output_opt may be supplied and set to either 'scrip' or 'ncar-csm'
+
+ - restrict_type: should be 'latitude' or 'latlon' in which case 
+    num_srch_bins only are used in one or two directions
+
+ - use_grid_area fields override the scrip calculation of area in 
+    case the model gets slightly different answers, but the area needs 
+    to be supplied in the input files
+
+A conservative mapping scheme exists but is not yet working with NEMO grids.
+See the scrip package documentation for more details of these parameters.
+(http://climate.lanl.gov/Software/SCRIP/SCRIPusers.pdf)
+
+scripshape.exe
+--------------
+
+scripshape takes the output from scrip (e.g. data_nemo_bilin.nc ) and
+rearranges the source and destination indices and associated weights into
+sets of 2D fields each spanning the nemo grid. Each set is associated with
+each node involved in the interpolation scheme.  Thus for a bilinear mapping
+the weights file required by the IOF option includes the following fields:
+
+  double src01(lat, lon) ;   double dst01(lat, lon) ;   double wgt01(lat, lon) ;
+  double src02(lat, lon) ;   double dst02(lat, lon) ;   double wgt02(lat, lon) ;
+  double src03(lat, lon) ;   double dst03(lat, lon) ;   double wgt03(lat, lon) ;
+  double src04(lat, lon) ;   double dst04(lat, lon) ;   double wgt04(lat, lon) ;
+
+For a bicubic mapping the required fields are:
+
+  double src01(lat, lon) ;   double dst01(lat, lon) ;   double wgt01(lat, lon) ;
+  double src02(lat, lon) ;   double dst02(lat, lon) ;   double wgt02(lat, lon) ;
+  double src03(lat, lon) ;   double dst03(lat, lon) ;   double wgt03(lat, lon) ;
+  double src04(lat, lon) ;   double dst04(lat, lon) ;   double wgt04(lat, lon) ;
+  double src05(lat, lon) ;   double dst05(lat, lon) ;   double wgt05(lat, lon) ;
+  double src06(lat, lon) ;   double dst06(lat, lon) ;   double wgt06(lat, lon) ;
+  double src07(lat, lon) ;   double dst07(lat, lon) ;   double wgt07(lat, lon) ;
+  double src08(lat, lon) ;   double dst08(lat, lon) ;   double wgt08(lat, lon) ;
+  double src09(lat, lon) ;   double dst09(lat, lon) ;   double wgt09(lat, lon) ;
+  double src10(lat, lon) ;   double dst10(lat, lon) ;   double wgt10(lat, lon) ;
+  double src11(lat, lon) ;   double dst11(lat, lon) ;   double wgt11(lat, lon) ;
+  double src12(lat, lon) ;   double dst12(lat, lon) ;   double wgt12(lat, lon) ;
+  double src13(lat, lon) ;   double dst13(lat, lon) ;   double wgt13(lat, lon) ;
+  double src14(lat, lon) ;   double dst14(lat, lon) ;   double wgt14(lat, lon) ;
+  double src15(lat, lon) ;   double dst15(lat, lon) ;   double wgt15(lat, lon) ;
+  double src16(lat, lon) ;   double dst16(lat, lon) ;   double wgt16(lat, lon) ;
+
+This program also adds an attribute to the weights file for use by the fld_interp
+routine in fldread.F90.  This tells the model about the east-west cyclicity of the source grid.
+The value needs to be supplied in the scripshape namelist via the variable ew_wrap.
+It should have one of the values -1, 0, 1 or 2.  -1 means that the input grid is not
+cyclic; 0 means that it is cyclic but with no overlapping columns; and a value greater
+than zero represents the number of columns that overlap.  In fact it only has an effect 
+when using bicubic interpolation in which the model needs to know which additional columns
+have to be read in to correctly calculate gradient values.
+The weights file produced by scripshape is ready for use in NEMO. This file
+needs to by placed in the nemo working directory and needs to be named in the
+appropriate SBC namelist entry (e.g. namsbc_clio, namsbc_flux or namsbc_core).
+
+scripinterp.exe
+---------------
+
+Take data on an input grid and interpolate to the nemo grid using the weights
+calculated by the scrip program.
+Method
+Two namelists are used for configuration, eg
+
+&interp_inputs
+    input_file = "../data/wsx_av.nc"
+    interp_file = "data_nemo_bilin.nc"
+    input_name = "wsx"
+    input_start = 1,1,1,1
+    input_stride = 1,1,1,1
+    input_stop = 0,0,0,1
+    input_vars = 'time'
+/
+
+&interp_outputs
+    output_file = "taux_1m.nc"
+    output_mode = "create"
+    output_dims = 'x', 'y', 'time_counter'
+    output_scaling = "sozotaux|1.0", "time_counter|86400.0"
+    output_name = 'sozotaux'
+    output_lon = 'x'
+    output_lat = 'y'
+    output_vars = 'time_counter'
+    output_attributes = 'time_counter|units|seconds since 1995-00-00 00:00:00',
+                        'time_counter|calendar|noleap',
+                        'sozotaux|units|N/m2'
+/
+
+This program just multiplies by weights and sums over each contributing point,
+and then formats the output correctly for the model.
+
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/.log.dti
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/.log.dti	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/.log.dti	(revision 2528)
@@ -0,0 +1,16 @@
+96/10/22 13:08:53 opened .log.dti
+96/10/22 13:08:53 debug explicitly set to 0
+96/10/22 13:08:58 opened .log.dti
+96/10/22 13:08:58 debug explicitly set to 0
+96/10/22 13:09:56 opened .log.dti
+96/10/22 13:09:56 debug explicitly set to 0
+96/11/18 11:29:28 opened .log.dti
+96/11/18 11:29:28 debug explicitly set to 0
+96/11/18 11:29:31 opened .log.dti
+96/11/18 11:29:31 debug explicitly set to 0
+96/11/18 11:31:34 opened .log.dti
+96/11/18 11:31:34 debug explicitly set to 0
+96/11/20 09:09:51 opened .log.dti
+96/11/20 09:09:51 debug explicitly set to 0
+96/11/20 09:09:55 opened .log.dti
+96/11/20 09:09:55 debug explicitly set to 0
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/bugs
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/bugs	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/bugs	(revision 2528)
@@ -0,0 +1,58 @@
+************************************************************************
+
+Bug or issue                                          Reported   Fixed
+----------------------------------------------------  --------  --------
+
+Outstanding:
+
+Need parallel implementation of SCRIP                 07/01/00
+Latitude bins not very robust for sparse grids        10/27/98
+Deal with extrapolation for bilinear, bicubic         12/02/98
+Remove cyclic bndy assumptions from bilin, bicubic    12/02/98
+Problem with coordinate transform when both grids 
+  contain pole point as cell edge (note that in
+  such a case, turning off the coordinate transform
+  by setting thresholds >pi, <-pi may fix this)       12/03/98
+Bug in test configuration when SH transformation on   12/03/98
+
+Fixed in release 1.4:
+
+Conversion from polar projection back to lat/lon
+  space extremely sensitive near pole                 07/01/01  08/20/01
+Bilinear/cubic fails when cells overlap longitude cut 08/13/01  08/20/01
+Bilinear/cubic iteration converges to bad solution
+  for skewed cells                                    08/21/01  08/21/01
+Nearest-neighbor backup to bilinear/cubic fails       08/13/01  08/20/01
+Added feature to use input areas for normalization    06/20/00  07/01/00
+Added error checks on weights for conservative maps   06/20/00  07/01/00
+
+Fixed in release 1.3:
+
+Added new binning options to restrict searches        ...do not know...
+Optimized code for resizing arrays                    .................
+
+Fixed in release 1.2:
+
+Changed namelist input for map type to character      05/31/99  06/04/99
+Added new output option for CSM coupler               05/31/99  06/04/99
+Added additional normalization options for conserv    05/31/99  06/04/99
+Improper handling of grid pairs which share corners   01/29/99  02/04/99
+Uninitialized variables and subscripts out of range   01/22/99  01/25/99
+
+Fixed in release 1.1:
+
+Conservative remap assumed num_maps = 2               12/16/98  12/17/98
+Change units of grid quantities back to input units   12/04/98  12/17/98
+Add option for unnormalized conservative weights      12/04/98  12/17/98
+Update user's guide for recent changes                12/02/98  12/17/98
+Add different test fields                             11/18/98  12/02/98
+Add support for multiple remap test                   11/18/98  12/02/98
+Add bicubic module                                    11/18/98  12/17/98
+
+Fixed in release 1.02:
+
+Problems setting up latitude bins for polar cells     10/22/98  10/27/98
+Input latitudes out of range (due to machine pi/2)    10/27/98  10/27/98
+Bad coordinate transformation in south pole           10/22/98  11/02/98
+
+************************************************************************
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/doc/SCRIPusers.tex
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/doc/SCRIPusers.tex	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/doc/SCRIPusers.tex	(revision 2528)
@@ -0,0 +1,1113 @@
+\documentclass[12pt]{report}
+
+\title{A User's Guide for SCRIP: A {\em S}pherical {\em C}oordinate
+       {\em R}empping and {\em I}nterpolation {\em P}ackage }
+
+\author{Philip W. Jones}
+
+\begin{document}
+
+%\maketitle
+
+\begin{titlepage}
+
+\vspace{1in}
+
+\begin{center}
+{\Large{A User's Guide for SCRIP: A {\em S}pherical {\em C}oordinate
+       {\em R}emapping and {\em I}nterpolation {\em P}ackage }}
+\end{center}
+
+\vspace{1in}
+
+\begin{center}
+Version 1.4
+\end{center}
+
+\vspace{1in}
+
+\begin{center}
+Philip W. Jones \\
+Theoretical Division \\
+Los Alamos National Laboratory
+\end{center}
+
+\newpage
+
+\begin{center}
+{\bf COPYRIGHT NOTICE}
+\end{center}
+
+Copyright \copyright 1997, 1998 the Regents of the University of
+California.
+
+\vspace{0.5in}
+
+This software and ancillary information (herein called SOFTWARE) called
+SCRIP is made available under the terms described here.  The SOFTWARE
+has been approved for release with associated LA-CC Number 98-45.
+
+Unless otherwise indicated, this SOFTWARE has been authored by an
+employee or employees of the University of California, operator
+of Los Alamos National Laboratory under Contract No. W-7405-ENG-36
+with the United States Department of Energy.  The United States
+Government has rights to use, reproduce, and distribute this
+SOFTWARE.  The public may copy, distribute, prepare derivative
+works and publicly display this SOFTWARE without charge, provided
+that this Notice and any statement of authorship are reproduced
+on all copies.  Neither the Government nor the University makes
+any warranty, express or implied, or assumes any liability or
+responsibility for the use of this SOFTWARE.
+
+If SOFTWARE is modified to produce derivative works, such modified
+SOFTWARE should be clearly marked, so as not to confuse it with the
+version available from Los Alamos National Laboratory.
+
+
+\end{titlepage}
+
+\tableofcontents
+
+\chapter{Introduction}
+
+SCRIP is a software package used to generate interpolation weights
+for remapping fields from one grid to another in spherical geometry.
+The package currently supports four types of remappings.  The
+first is a conservative remapping scheme that
+is ideally suited to a coupled model context where the area-integrated
+field (e.g. water or heat flux) must be conserved.  The second
+type of mapping is a basic bilinear interpolation which has
+been slightly generalized to perform a local bilinear interpolation.
+A third method is a bicubic interpolation similar to the
+bilinear method.
+The last type of remapping is a distance-weighted average of
+nearest-neighbor points.  The bilinear and bicubic schemes can
+only be used with logically-rectangular grids; the other two methods
+can be used for any grid in spherical coordinates.
+
+SCRIP is available via the web at \newline
+http://climate.acl.lanl.gov/software/SCRIP/ \newline
+NOTE: This location has changed since the 1.2 release.
+
+The next chapter describes how to compile and run SCRIP, while
+the following sections describe the remapping methods in more
+detail.
+
+\chapter{Compiling and Running}
+
+The distribution file is a gzipped tarfile, so you must
+uncompress the file using ``gunzip'' and then extract SCRIP
+from the tar file using ``tar -xvf scrip1.4.tar''.  The extraction
+process will create a directory called SCRIP with two
+subdirectories named ``source'' and ``grids''.  The source
+directory contains all the source files and the makefile
+for building the package.  The grids directory contains
+some sample grid files and routines for creating or
+converting other grid files to the proper format.
+
+\section{Compiling}
+
+In order to compile SCRIP, you need access to a
+Fortran 90 compiler and a netCDF library (version 3 or
+later).  In the source directory, you must edit the
+makefile to insert the appropriate compiler and compiler
+options for whatever machine you happen to work on.  The
+makefile currently only has SGI compiler options.  In
+addition, you must edit the paths in the makefile to
+find the proper netCDF library - if netCDF is in your
+default path, you may delete the path altogether.
+
+Once the makefile has been edited to reflect your
+local environment, type ``make'' and let it
+build.  By default, the makefile builds two executables
+in the main SCRIP directory;
+the first executable is called scrip and computes
+all the necessary weights for a remapping.  The second
+executable is a simple test code scrip\_test which will
+test the weights output by scrip.
+
+\subsection{Compile-time Parameters}
+
+There are a few compile-time parameters that can
+be changed before compiling (see Table~\ref{tab:params}).
+For the most part, the
+defaults are adequate, but you may wish to change
+these at some point.  The use of these parameters
+will become clear in the chapters describing the
+remapping algorithms.
+
+\begin{table}
+\caption{Compile-time parameters \label{tab:params}}
+
+\begin{tabular}{|l|l|c|l|} \hline
+     Routine       &    Parameter     &  Default & Description  \\
+                   &      Name        &   Value  &              \\ \hline
+remap\_conserv.f   &  north\_thresh   &   1.42   &  threshold latitude (in  \\
+                   &                  &          &  radians) above which a  \\
+                   &                  &          &  coordinate transformation \\
+                   &                  &          &  is used to perform       \\
+                   &                  &          &  intersection calculation \\ \hline
+remap\_conserv.f   &  south\_thresh   &  -2.00   &  same for south pole \\ \hline
+remap\_conserv.f   &  max\_subseg     &  10000   &  maximum number of sub-  \\
+                   &                  &          &  segments allowed (to    \\
+                   &                  &          &  prevent infinite loop)  \\
+\hline
+remap\_bilinear.f  &  max\_iter       &   100    &  max number of iterations \\
+                   &                  &          &  to determine local i,j   \\ \hline
+remap\_bilinear.f  &  converge        & $1\times 10^{-10}$
+                                                 &  convergence criterion   \\
+                   &                  &          &  for bilinear iteration  \\
+\hline
+remap\_bicubic.f   &  max\_iter       &   100    &  max number of iterations \\
+                   &                  &          &  to determine local i,j   \\ \hline
+remap\_bicubic.f   &  converge        & $1\times 10^{-10}$
+                                                 &  convergence criterion   \\
+                   &                  &          &  for bicubic iteration  \\
+\hline
+remap\_distwgt.f   &  num\_neighbors  &    4     &  number of nearest       \\
+                   &                  &          &  neighbors to use for    \\
+                   &                  &          &  distance-weighted average\\
+\hline
+iounits.f          &  stdin           &    5     &  I/O unit reserved for \\
+                   &                  &          &  standard input \\ \hline
+iounits.f          &  stdout          &    6     &  I/O unit reserved for \\
+                   &                  &          &  standard output \\ \hline
+iounits.f          &  stderr          &    6     &  I/O unit reserved for \\
+                   &                  &          &  standard error output \\
+\hline
+timers.f           &  max\_timers     &   99     &  max number of CPU timers \\
+\hline
+\end{tabular}
+\end{table}
+
+\section{Running}
+
+Once the code is compiled, a few input files are needed.
+The first is a namelist input file and the other two
+required files are grid description files.
+
+\subsection{Namelist Input}
+
+The namelist input file must be called scrip\_in
+and contain a namelist as shown in Fig.~\ref{fig:nml}.
+
+\begin{figure}
+\caption{Required input namelist. \label{fig:nml}}
+\begin{verbatim}
+&remap_inputs
+    num_maps = 2
+    grid1_file = 'grid_1_file_name'
+    grid2_file = 'grid_2_file_name'
+    interp_file1 = 'map_1_output_file_name'
+    interp_file2 = 'map_2_output_file_name'
+    map1_name = 'name_for_mapping_1'
+    map2_name = 'name_for_mapping_2'
+    map_method = 'conservative'
+    normalize_opt = 'frac'
+    output_opt = 'scrip'
+    restrict_type = 'latitude'
+    num_srch_bins = 90
+    luse_grid1_area = .false.
+    luse_grid2_area = .false.
+/
+\end{verbatim}
+\end{figure}
+
+The num\_maps variable determines the number of mappings
+to be computed.  If you'd like mappings only from a source
+grid (grid 1) to a destination grid (grid 2), then
+num\_maps should be set to one.  If you'd also like weights
+for a remapping in the opposite direction (grid 2 to grid 1),
+then num\_maps should be set to two.
+
+The map\_method variable determines the method to be used
+for the mapping.  A conservative remapping is map\_method
+`conservative'; a bilinear mapping is map\_method `bilinear';
+a distance-weighted average is map\_method `distwgt'; a
+bicubic mapping is map\_method `bicubic'.
+
+The restrict\_type variable and num\_srch\_bins determines
+how the software restricts the range of grid points to search
+to avoid a full $N^2$ search.  There are currently two options
+for restrict\_type: `latitude' and `latlon'.  The first was used in
+all previous versions of SCRIP and restricts the search by
+dividing the grid points into num\_srch\_bins latitude bins.
+The `latlon' choice divides the spherical domain into
+latitude-longitude boxes and thus provides a way to
+restrict the longitude range as well.  Note that for the latlon
+option, the domain is divided by num\_srch\_bins in
+{\em each} direction so that the total number of bins is the
+square of num\_srch\_bins.  Generally, the larger the number
+of bins, the more the search can be restricted.  However if
+the number of bins is too large, more time will be taken
+restricting the search than the search itself.  For coarse
+grids, choosing the latitude option with 90 bins (one degree
+bins) is sufficient.
+
+The normalize\_opt variable is used to choose the normalization
+of the remappings for the conservative remapping method.
+By default, normalize\_opt is set to be `fracarea' and will
+include the destination area fraction in the output weights;
+other options are `none' and `destarea' (see chapter on the
+conservative remapping method). The latter two are useful when
+dealing with masks that are dynamic (e.g. variable ice fraction).
+Keep in mind that in such a case, the
+area fractions must be computed explicitly by the remapping
+routine at the time the remappings are actually computed
+(see the example in Fig.~\ref{fig:rmpfort}).
+
+The grid{\em x}\_file are names (with relative paths) of
+the grid input files.  The first grid file (grid1\_file)
+{\em must} be the source grid if num\_maps=1.  If this
+mapping uses the conservative remapping method, the first
+grid file must also be the grid with the master mask
+(e.g. a land mask) -- grid fractions on the second grid
+will be determined by this mask.
+
+Names of the output files for the remapping weights are
+determined by the interp\_file{\em x} filenames (again
+with paths).  Map 1 refers to a mapping from grid 1 to
+grid 2; map 2 is in the opposite direction.
+
+A descriptive name for the remappings are determined by
+the map{\em x}\_name variables.  These should be
+descriptive enough to know exactly which grids and
+methods were used.
+
+The output\_opt variable determines the format of the
+netCDF output file.  The two currently-supported options
+are `scrip' and `ncar-csm'.  The latter is to generate
+files for use in the NCAR CSM Flux Coupler for coupled
+climate modeling.  The primary difference between the
+formats is the choice of variable names.
+
+The two logical flags luse\_grid{\em x}\_area are
+for using an input area to normalize the conservative
+weights.  If these are set to true, the input grid
+files must contain the grid areas.  This option is
+provided primarily for making the weights consistent
+with internal model-computed areas (which may differ
+somewhat from the SCRIP-computed areas).
+
+\subsection{Grid Input Files}
+
+The grid input files are in netCDF format as shown
+by the sample ncdump grid output in Fig.~\ref{fig:ncgrid}.
+If you're unfamiliar with ncdump output, it's important to
+not that ncdump shows the array dimensions in C ordering.
+In Fortran, the order is reversed (e.g. arrays are
+dimensioned (grid\_corners,grid\_size).
+In the grids subdirectory of the distribution there
+are some fortran source codes for creating these
+grid files for some special cases.  See the README
+file in that subdirectory for details.
+
+\begin{figure}
+\caption{A sample input grid file. \label{fig:ncgrid}}
+\begin{verbatim}
+netcdf remap_grid_T42 {
+dimensions:
+        grid_size = 8192 ;
+        grid_corners = 4 ;
+        grid_rank = 2 ;
+
+variables:
+        long grid_dims(grid_rank) ;
+        double grid_center_lat(grid_size) ;
+                grid_center_lat:units = "radians" ;
+        double grid_center_lon(grid_size) ;
+                grid_center_lon:units = "radians" ;
+        long grid_imask(grid_size) ;
+                grid_imask:units = "unitless" ;
+        double grid_corner_lat(grid_size, grid_corners) ;
+                grid_corner_lat:units = "radians" ;
+        double grid_corner_lon(grid_size, grid_corners) ;
+                grid_corner_lon:units = "radians" ;
+
+// global attributes:
+                :title = "T42 Gaussian Grid" ;
+}
+\end{verbatim}
+\end{figure}
+
+The name of the grid is given as the title and will be used
+to specify the grid name throughout the remapping process.
+
+The grid\_size dimension is the total size of the grid; grid\_rank
+refers to the number of dimensions the grid array would have
+when used in a model code.  The number of corners (vertices) in
+each grid cell is given by grid\_corners.  Note that if your
+grid has a variable number of corners on grid cells, then you
+should set grid\_corners to be the highest value and use
+redundant points on cells with fewer corners.
+
+The integer array grid\_dims gives the length of each
+grid axis when used in a model code.  Because the remapping
+routines read the grid properties as a linear list of
+grid cells, the grid\_dims array is necessary for
+reconstructing the grid, particularly for a bilinear mapping
+where a logically rectangular structure is needed.
+
+The integer array grid\_imask is used to mask out grid cells
+which should not participate in the remapping.  The array
+should by zero for any points (e.g. land points) that do
+not participate in the remapping and one for all other points.
+
+Coordinate arrays provide the latitudes and longitudes of
+cell centers and cell corners.  Although the above reports
+the units as ``radians'', the code happily accepts ``degrees''
+as well.  The grid corner coordinates {\em must} be
+written in an order which traces the outside of a grid
+cell in a counterclockwise sense.  That is, when moving
+from corner 1 to corner 2 to corner 3, etc., the grid
+cell interior must always be to the left.
+
+\subsection{Output Files}
+
+The remapping output files are also in netCDF format
+and contain some grid information from each grid
+as well as the remapping addresses and weights.  An example
+ncdump of the output files is shown in Fig.~\ref{fig:ncrmp}.
+
+\begin{figure}
+\caption{A sample output file for mapping data in scrip format.
+\label{fig:ncrmp}}
+\begin{verbatim}
+netcdf rmp_POP43_to_T42_cnsrv {
+dimensions:
+        src_grid_size = 24576 ; dst_grid_size = 8192 ;
+        src_grid_corners = 4  ; dst_grid_corners = 4 ;
+        src_grid_rank = 2     ; dst_grid_rank = 2 ;
+        num_links = 42461 ; num_wgts = 3 ;
+variables:
+        long src_grid_dims(src_grid_rank) ;
+        long dst_grid_dims(dst_grid_rank) ;
+        double src_grid_center_lat(src_grid_size) ;
+        double dst_grid_center_lat(dst_grid_size) ;
+        double src_grid_center_lon(src_grid_size) ;
+        double dst_grid_center_lon(dst_grid_size) ;
+        long src_grid_imask(src_grid_size) ;
+        long dst_grid_imask(dst_grid_size) ;
+        double src_grid_corner_lat(src_grid_size, src_grid_corners) ;
+        double src_grid_corner_lon(src_grid_size, src_grid_corners) ;
+        double dst_grid_corner_lat(dst_grid_size, dst_grid_corners) ;
+        double dst_grid_corner_lon(dst_grid_size, dst_grid_corners) ;
+        double src_grid_area(src_grid_size) ;
+                src_grid_area:units = "square radians" ;
+        double dst_grid_area(dst_grid_size) ;
+                dst_grid_area:units = "square radians" ;
+        double src_grid_frac(src_grid_size) ;
+        double dst_grid_frac(dst_grid_size) ;
+        long src_address(num_links) ;
+        long dst_address(num_links) ;
+        double remap_matrix(num_links, num_wgts) ;
+// global attributes:
+         :title = "POP 4/3 to T42 Conservative Mapping" ;
+         :normalization = "fracarea" ;
+         :map_method = "Conservative remapping" ;
+         :history = "Created: 07-19-1999" ;
+         :conventions = "SCRIP" ;
+         :source_grid = "POP 4/3 Displaced-Pole T grid" ;
+         :dest_grid = "T42 Gaussian Grid" ;
+}
+\end{verbatim}
+\end{figure}
+
+The grid information is simply echoing the input grid file
+information and adding grid\_area and grid\_frac arrays.
+The grid\_area array currently is {\em only} computed by
+the conservative remapping option; the others will write
+arrays full of zeros for this field.  The grid\_frac array
+for the conservative remapping returns the area fraction
+of the grid cell which participates in the remapping based
+on the source grid mask.  For the other two remapping options,
+the grid\_frac array is one where the grid point participates
+in the remapping and zero otherwise, based again on the
+source grid mask (and {\em not} on the grid\_imask for that
+grid).
+
+The remapping data itself is written as if for a sparse matrix
+multiplication.  Again, the Fortran array must be dimensioned
+(num\_wgts,num\_links) rather than the C order shown in the
+ncdump.  The dimension num\_wgts refers to the number
+of weights for a given remapping and is one for bilinear and
+distance-weighted remappings.  For the conservative
+remapping, num\_wgts is 3 as it contains two additional
+weights for a second-order remapping.  The bicubic remappings
+require four weights as for gradients in each direction plus
+a term for the cross gradient.  The dimension num\_links
+is the number of unique address pairs in the remapping and is
+therefore the number of entries in a sparse matrix for the
+remapping.  The integer address arrays contain the source
+and destination address for each ``link''.  So, a Fortran code
+to complete the conservative remappings might look like that
+shown in Fig.~\ref{fig:rmpfort}.
+
+\begin{figure}
+\caption{Sample Fortran code for performing a first-order
+         conservative remap. \label{fig:rmpfort}}
+\begin{verbatim}
+
+dst_array = 0.0
+
+select case (normalize_opt)
+case ('fracarea')
+
+  do n=1,num_links
+    dst_array(dst_address(n)) = dst_array(dst_address(n)) +
+              remap_matrix(1,n)*src_array(src_address(n))
+  end do
+
+case ('destarea')
+
+  do n=1,num_links
+    dst_array(dst_address(n)) = dst_array(dst_address(n)) +
+             (remap_matrix(1,n)*src_array(src_address(n)))/
+             (dst_frac(dst_address(n)))
+  end do
+
+case ('none')
+
+  do n=1,num_links
+    dst_array(dst_address(n)) = dst_array(dst_address(n)) +
+             (remap_matrix(1,n)*src_array(src_address(n)))/
+       (dst_area(dst_address(n))*dst_frac(dst_address(n)))
+  end do
+
+end select
+
+\end{verbatim}
+\end{figure}
+
+The address arrays are sorted by destination address and are
+linear addresses that assume standard
+Fortran ordering. They can therefore be converted to logical
+address space if necessary.  For example, a point on a
+two-dimensional grid with logical coordinates $(i,j)$ will
+have a linear address $n$ given by
+$n=(j-1)*{\rm grid\_dims(1)} + i.$  Alternatively, if the
+code is run on a serial machine, the multi-dimensional arrays
+can be passed into linear dummy arrays and the addresses can
+be used directly.  Such a storage/sequence association may
+not be valid in a distributed-memory context however.
+The scrip\_test code shows an example of how the remappings
+can be implemented.
+
+\section{Testing}
+
+In order to test the weights computed by the SCRIP package,
+a simple test code is provided.  This code reads in the
+weights and remaps analytic fields.  Three choices for the
+analytic field are provided.  The first is a cosine bell
+function $f=2+\cos(\pi r/L)$, where $r$ is the distance from
+the center of the hill and $L$ is a length scale.  Such a
+function is useful for determining the effects of repeated
+applications.  The other two fields are representative of
+spherical harmonic wavefunctions.  A relatively smooth function
+$f=2+\cos^2\theta\cos(2\phi)$ is similar to a spherical
+harmonic with $\ell=2$ and $m=2$, where $\ell$ is the
+spherical harmonic order and $m$ is the azimuthal wave number.
+The function
+$f=2+\sin^{16}(2\theta)\cos(16\phi)$ is similar to a
+spherical harmonic with $\ell=32$ and $m=16$ and is useful
+for testing a field with relatively high spatial
+frequency and rapidly changing gradients.  The choice of
+which field is remapped in determined by the input namelist
+scrip\_test\_in.
+
+For
+conservative remappings, the test code tests three different
+remappings: the first is a first-order remapping, the second
+is a second-order remapping using only latitude gradients,
+and the third is a full second-order remapping.  The second
+is performed in order to determine which weights are
+causing problems when errors occur.  The code
+prints out three diagnostics to standard output and writes
+many quantities to a netCDF output file.
+
+First, it prints out the minimum and maximum of the source
+and destination (remapped) fields.  This is a test for
+monotonicity (although only the first-order conservative
+remapping is monotone by default).
+
+Second, the test code prints out the maximum and average
+relative error $\epsilon =
+|(F_{dst} - F_{analytic})/F_{analytic}|$, where
+$F_{analytic}$ is the source function evaluated at the
+destination grid points and $F_{dst}$ is the destination
+(remapped) field.  The errors here can sometimes be misleading.
+For example, if a conservative remapping is performed from
+a fine grid to a coarse grid, the destination array will
+contain the field averaged over many source cells, while
+$F_{analytic}$ is the analytic field evaluated at the cell
+center point.  Another instance which leads to relatively
+large errors is near mask boundaries where the remapped
+field is correctly returning values indicative of the edge
+of a grid cell, while $F_{analytic}$ is again computing
+cell-center values. To avoid the latter problem, the error is
+only computed where the destination grid fraction
+is greater than $0.999$.
+
+Lastly, the test code prints out the area-integrated
+field on the source and destination grids in order to
+test conservation.  This diagnostic returns zeros for
+all but conservative remappings.  For a first-order
+conservative remapping, these numbers should agree
+to machine accuracy.  For a second-order conservative
+remapping, they will be very close, but may not exactly
+agree due to mask boundary effects where it is not
+possible to perform the exact area integral.
+
+The netCDF output file from the test code contains
+the source and destination arrays as well as the
+error arrays so the error can be examined at every
+grid point to pinpoint problems.  The arrays in
+the netCDF file are written out in arrays with
+rank grid\_rank (e.g. two-dimensional grids are
+written as proper 2-d arrays rather than vectors
+of values).  These arrays can then be viewed using
+any visualization package.
+
+\chapter{Conservative Remapping}
+
+The SCRIP package implements a conservative remapping
+scheme described in detail in a separate paper
+(Jones, P.W. 1999 {\em Monthly Weather Review}, 
+{\bf 127}, 2204-2210).
+A brief outline will be given here to aid the
+user in understanding what this portion of the
+package does.
+
+To compute a flux on a new (destination) grid which
+results in the same energy or water exchange as a flux $f$ on an
+old (source) grid, the destination flux $F$ at a destination grid
+cell $k$ must satisfy
+\begin{equation}\label{eq:local}
+\overline{F}_k = {1\over{A_k}}\int\int_{A_k} fdA,
+\end{equation}
+where $\overline{F}$ is the area-averaged flux and $A_k$ is
+the area of cell $k$.
+Because the integral in (\ref{eq:local}) is over the area of
+the destination grid cell, only those cells on the source grid
+that are covered at least partly by the destination grid cell
+contribute to the value of the flux on the destination grid.
+If cell $k$ overlaps $N$ cells on the source grid, the
+remapping can be written as
+\begin{equation}\label{eq:rmpsum}
+\overline{F}_k =
+{1\over{A_k}} \sum_{n=1}^N \int\int_{A_{nk}} f_ndA,
+\end{equation}
+where $A_{nk}$ is the
+area of the source grid cell $n$ covered by the destination grid
+cell $k$, and $f_n$ is the local value of the flux in the source
+grid cell (see Figure~\ref{fig:grids}).  Note that (\ref{eq:rmpsum})
+is normalized by the destination area $A_k$ corresponding to
+the normalize\_opt value of `destarea'.  The sum of the weights
+for a destination cell $k$ in this case would be between 0 and 1
+and would be the area fraction if $f_n$ were identically 1
+everywhere on the source grid.  The normalization option
+`fracarea' would actually divide by the area of the source
+grid overlapped by cell $k$:
+\begin{equation}
+\sum_{n=1}^N \int\int_{A_{nk}}dA.
+\end{equation}
+For this normalization option, remapping a function $f$ which
+is 1 everywhere on the source grid would result in a function
+$F$ that is exactly one wherever the destination grid overlaps
+a non-masked source grid cell and zero otherwise.  A normalization
+option of `none' would result in the actual angular area
+participating in the remapping.
+
+Assuming $f_n$ is constant across a source grid cell,
+(\ref{eq:rmpsum})
+would lead to the first-order area-weighted schemes used in
+current coupled models.  A more accurate form of the remapping
+is obtained by using
+\begin{equation}\label{eq:gradient}
+f_n = \overline{f}_n +
+                   \nabla_n f\cdot({\vec{r}} - \vec{r}_n),
+\end{equation}
+where $\nabla_n f$ is the gradient of the flux in cell $n$ and
+$\vec{r}_n$ is the centroid of cell $n$ defined by
+\begin{equation}\label{eq:centroid}
+\vec{r}_n = {1\over{A_n}}\int\int_{A_n}\vec{r}dA.
+\end{equation}
+Such a distribution satisfies the conservation constraint and
+is equivalent to the first terms of a Taylor series expansion
+of $f$ around $\vec{r}_n$.  The remapping is thus
+second-order accurate if $\nabla_n f$ is at least a
+first-order approximation to the gradient.
+
+The remapping can now be expanded in spherical coordinates as
+\begin{equation}\label{eq:remap}
+\overline{F}_k = \sum_{n=1}^{N} \left[\overline{f}_n w_{1nk} +
+\left({{\partial f}\over{\partial \theta}}\right)_n w_{2nk} +
+\left({1\over{\cos\theta}}{{\partial f}\over{\partial \phi}}\right)_n w_{3nk}
+\right],
+\end{equation}
+where $\theta$ is latitude, $\phi$ is longitude and the
+three remapping weights are
+\begin{equation}\label{eq:weights1}
+w_{1nk} = {1\over{A_k}}\int\int_{A_{nk}}dA, \\
+\end{equation}
+\begin{eqnarray}\label{eq:weights2}
+w_{2nk} & = & {1\over{A_k}}\int\int_{A_{nk}}(\theta-\theta_n)dA \nonumber \\
+        & = & {1\over{A_k}}\int\int_{A_{nk}}\theta dA -
+              {{w_{1nk}}\over{A_n}}\int\int_{A_n}\theta dA,
+\end{eqnarray}
+and
+\begin{eqnarray}\label{eq:weights3}
+w_{3nk} & = & {1\over{A_k}}\int\int_{A_{nk}}\cos\theta(\phi-\phi_n)dA \nonumber \\
+        & = & {1\over{A_k}}\int\int_{A_{nk}}\phi\cos\theta dA -
+              {{w_{1nk}}\over{A_n}}\int\int_{A_n}\phi\cos\theta dA .
+\end{eqnarray}
+Again, if the gradient is zero, ({\ref{eq:remap}})
+reduces to a first-order area-weighted remapping.
+
+The area integrals in
+equations~(\ref{eq:weights1})--(\ref{eq:weights3})
+are computed by converting the area integrals into line
+integrals using the divergence theorem.
+Computing line integrals around the overlap regions
+is much simpler; one simply integrates first around every
+grid cell on the source grid, keeping track of intersections
+with destination grid lines, and then one integrates around every
+grid cell on the destination grid in a similar manner.  After
+the sweep of each grid, all overlap regions have been
+integrated.
+
+Choosing appropriate functions for the divergence, the integrals
+in equations~(\ref{eq:weights1})--(\ref{eq:weights3}) become
+\begin{equation}
+\int\int_{A_{nk}}dA = \oint_{C_{nk}} -\sin\theta d\phi,
+\end{equation}
+\begin{equation}
+\int\int_{A_{nk}}\theta dA =
+ \oint_{C_{nk}} [-\cos\theta-\theta\sin\theta]d\phi,
+\end{equation}
+\begin{equation}
+\int\int_{A_{nk}}\phi\cos\theta dA =
+\oint_{C_{nk}} -{\phi\over 2}[\sin\theta\cos\theta + \theta]d\phi,
+\end{equation}
+where $C_{nk}$ is the counterclockwise path around the region
+$A_{nk}$.  Computing these three line integrals during the
+sweeps of each grid provides all the information necessary
+for computing the remapping weights.
+
+\begin{figure}
+  \caption{An example of a triangular destination grid
+           cell $k$ overlapping
+           a quadrilateral source grid.  The region $A_{kn}$
+           is where cell $k$ overlaps the quadrilateral cell $n$.
+           Vectors
+           used by search and intersection routines are
+           also labelled. \label{fig:grids}}
+
+\begin{picture}(400,400)
+
+\put(100,0){\line(2,1){300}}
+\put(50,100){\line(2,1){300}}
+\put(0,200){\line(2,1){300}}
+%\put(0,150){\line(2,1){400}}
+
+\put(  0,200){\line(1,-2){100}}
+\put(100,250){\line(1,-2){100}}
+\put(200,300){\line(1,-2){100}}
+\put(300,350){\line(1,-2){100}}
+
+
+\put( 50,125){\line(1,0){200}}
+\put(250,125){\line(1,4){40}}
+{\thicklines
+\put(290,285){\vector(-3,-2){240}}
+\put(200,300){\vector(1,-2){50}}
+%\put(200,300){\vector(6,-1){90}}
+\put(200,300){\vector(4,-1){90}}
+}
+
+\put(250,295){$\vec{r}_{1b}$}
+\put(195,270){$\vec{r}_{12}$}
+\put(175,225){$\vec{r}_{be}$}
+
+\put(170,310){$(\theta_1,\phi_1)$}
+\put(255,200){$(\theta_2,\phi_2)$}
+\put(300,285){$(\theta_b,\phi_b)$}
+\put( 10,125){$(\theta_e,\phi_e)$}
+
+\put(200,300){\circle*{4}}
+\put(250,200){\circle*{4}}
+\put(290,285){\circle*{4}}
+\put( 50,125){\circle*{4}}
+
+\put(225,225){Cell $k$}
+\put(250,100){Cell $n$}
+\put(200,150){$A_{kn}$}
+
+\end{picture}
+\end{figure}
+
+\section{Search algorithms}\label{sec:search}
+
+As mentioned in the previous section, the algorithm for
+computing the remapping weights is relatively simple.  The
+process amounts to finding the location of the endpoint
+of a segment and then finding the next intersection with
+the other grid.  The line integrals are then computed and
+summed according to which grid cells are associated with
+that particular subsegment.
+The most time-consuming portion of the algorithm
+is finding which cell on one grid
+contains an endpoint from the other grid.  Optimal
+search algorithms can be written when the grid is
+well structured and regular.  However, if one requires
+a search algorithm that will work for any general
+grid, a hierarchy of search algorithms appears to
+work best.  In SCRIP, each grid cell address is
+assigned to one or more latitude bins.  When the
+search begins, only those cells belonging to the
+same latitude bin as the search point are used.
+The second stage checks the bounding box of each
+grid cell in the latitude bin.  The bounding box
+is formed by the cells minimum and maximum latitude
+and longitude.  This process further restricts
+the search to a small number of cells.
+
+Once the search has been restricted, a robust algorithm
+that works for most cases is a cross-product test.
+In this test, a cross product is computed between
+the vector corresponding to a cell side ($\vec{r}_{12}$ in
+Figure~\ref{fig:grids}) and a vector extending from the
+beginning of the cell side to the search point ($\vec{r}_{1b}$).
+If
+\begin{equation}\label{eq:cross}
+\vec{r}_{12} \times \vec{r}_{1b} > 0,
+\end{equation}
+the point lies to the left of the cell side.  If
+(\ref{eq:cross}) holds for every cell side, the
+point is enclosed by the cell.
+This test is not completely robust and will fail for
+grid cells that are non-convex.
+
+\section{Intersections}\label{sec:intersect}
+
+Once the location of an initial endpoint is found,
+it is necessary to check to see if the segment intersects
+with the cell side.  If the segment is parametrized as
+\begin{eqnarray}
+\theta &=& \theta_b + s_1 (\theta_e - \theta_b) \nonumber \\
+\phi   &=& \phi_b + s_1 (\phi_e - \phi_b)
+\end{eqnarray}
+and the cell side as
+\begin{eqnarray}
+\theta &=& \theta_1 + s_2 (\theta_2 - \theta_1) \nonumber \\
+\phi   &=& \phi_1 + s_2 (\phi_2 - \phi_1),
+\end{eqnarray}
+where $\theta_1, \phi_1, \theta_2, \phi_2, \theta_b,$ and
+$\theta_e$ are endpoints as shown in Figure~\ref{fig:grids},
+the intersection of the two lines occurs when $\theta$
+and $\phi$ are equal.  The linear system
+\begin{equation}
+\left[ \begin{array}{cc}
+(\theta_e - \theta_b) & (\theta_1 - \theta_2) \\
+(\phi_e - \phi_b) & (\phi_1 - \phi_2) \\
+\end{array} \right]
+\left[ \begin{array}{c} s_1 \\ s_2 \\ \end{array} \right] =
+\left[ \begin{array}{c}
+(\theta_1 - \theta_b) \\ (\phi_1 - \phi_b)  \\
+\end{array} \right]
+\end{equation}
+is then solved
+to determine $s_1$ and $s_2$ at the intersection point.
+If $s_1$ and $s_2$ are between zero and one, an
+intersection occurs with that cell side.
+
+It is important also to compute identical intersections
+during the sweeps of each grid.  To ensure that this
+will occur, the entire line segment is used to
+compute intersections rather than using a previous or
+next intersection as an endpoint.
+
+\section{Coincidences}
+
+Often, pairs of grids will share common lines (e.g. the
+Equator).  When this is the case, the method described
+above will double-count the contribution of these line
+segments.  Coincidences can be detected when computing
+cross products for the search algorithm described above.
+If the cross product is zero
+in this case, the endpoint lies on the cell side.  A
+second cross product between the line segment and the
+cell side can then be computed.  If the second cross
+product is also zero, the lines are coincident.
+Once a coincidence has been detected, the contribution
+of the coincident segment can be computed during the
+first sweep and ignored during the second sweep.
+
+\section{Spherical coordinates}\label{sec-sphere}
+
+Some aspects of the spherical coordinate system introduce
+additional problems for the method described above.
+Longitude is multiple valued on one line on the sphere,
+and this branch cut may be chosen differently by different
+grids.  Care must be taken when calculating intersections
+and line integrals to ensure that the proper
+longitude values are used.  A simple method is to always
+check to make sure the longitude is in the same interval
+as the source grid cell center.
+
+Another problem with computing weights in spherical
+coordinates is the treatment of the pole.  First, note
+that although the pole is physically a point, it is a
+line in latitude-longitude space and has a nonzero
+contribution to the weight integrals.  If a grid does
+not contain the pole explicitly as a grid vertex, the
+pole contribution must be added to the appropriate cells.
+The pole contribution can be computed analytically.
+
+The pole also creates problems for the search and
+intersection algorithms described above.  For example,
+a grid cell that overlaps the pole can result in a
+nonconvex cell in latitude-longitude coordinates.
+The cross-product test described above
+will fail in this case.  In addition, segments near
+the pole typically exhibit large changes in longitude
+even for very short segments.  In such a case, the
+linear parametrizations used above
+result in inaccuracies for determining the correct
+intersections.
+
+To avoid these problems, a coordinate transformation
+can be used poleward of a given threshold latitude
+(typically within one degree of the pole).  A possible
+transformation is the Lambert equivalent azimuthal projection
+\begin{eqnarray}
+X &=& 2\sin\left({\pi \over 4} - {\theta \over 2}\right)\cos\phi \nonumber \\
+Y &=& 2\sin\left({\pi \over 4} - {\theta \over 2}\right)\sin\phi
+\end{eqnarray}
+for the North Pole.  The transformation for the South
+Pole is similar.  This transformation is only used to
+compute intersections; line integrals are still computed
+in latitude-longitude coordinates.  Because intersections
+computed in the transformed coordinates can be different
+from those computed in latitude-longitude coordinates,
+line segments which cross the latitude threshold must be
+treated carefully.  To compute the intersections
+consistently for such a segment, intersections with the
+threshold latitude are detected and used as a normal
+grid intersection to provide a clean break between the
+two coordinate systems.
+
+\section{Conclusion}
+
+The implementation in the SCRIP code follows closely
+the description above.  The user should be able to
+follow and understand the process based on this
+description.
+
+\chapter{Bilinear Remapping}
+
+Standard bilinear interpolation schemes can be found
+in many textbooks.  Here we present a more general
+scheme which uses a local bilinear approximation
+to interpolate to a point in a quadrilateral grid.
+Consider the grid points shown in Fig.~\ref{fig:quad}
+labelled with logically-rectangular indices (e.g. $(i,j)$).
+
+\begin{figure}
+\caption{A general quadrilateral grid. \label{fig:quad}}
+\begin{picture}(400,400)
+
+\put(40,40){\line(2,1){200}}
+\put(240,140){\line(1,2){100}}
+\put(40,40){\line(1,2){100}}
+\put(140,240){\line(2,1){200}}
+
+\put(40,40){\circle*{4}}
+\put(240,140){\circle*{4}}
+\put(140,240){\circle*{4}}
+\put(340,340){\circle*{4}}
+\put(210,200){\circle*{4}}
+
+\put(30 , 20){1 $(i,j)$}
+\put(250,130){2 $(i+1,j)$}
+\put( 80,240){$(i,j+1)$ 4}
+\put(350,340){3 $(i+1,j+1)$}
+\put(200,200){$P$}
+
+\end{picture}
+\end{figure}
+
+Let the latitude-longitude coordinates of point
+1 be $(\theta(i,j),\phi(i,j))$, the coordinates of
+point 2 be $(\theta(i+1,j),\phi(i+1,j))$, etc.
+Now let $\alpha$ and $\beta$ be continuous local
+coordinates such that the coordinates $(\alpha,\beta)$
+of point 1 are $(0,0)$, point 2 are $(1,0)$, point
+3 are $(1,1)$ and point 4 are $(0,1)$.  If point $P$
+lies inside the cell formed by the four points above,
+the function $f$ at point $P$ can be approximated by
+\begin{eqnarray}\label{eq:bilinear}
+f_P & = & (1-\alpha)(1-\beta)f(i,j) + \alpha(1-\beta)f(i+1,j) + \nonumber \\
+    &   & \alpha\beta f(i+1,j+1) + (1-\alpha)\beta f(i,j+1)  \\
+    & = & w_1 f(i,j) + w_2 f(i+1,j) + w_3 f(i+1,j+1) + w_4 f(i,j+1). \nonumber
+\end{eqnarray}
+The remapping weights must therefore be computed by
+finding $\alpha$ and $\beta$ at point $P$.
+
+The latitude-longitude coordinates $(\theta,\phi)$ of
+point $P$ are known and can also be approximated by
+\begin{eqnarray}\label{eq:thetaphi}
+\theta & = & (1-\alpha)(1-\beta)\theta_1 + \alpha(1-\beta)\theta_2 + \nonumber
+          \alpha\beta \theta_3 + (1-\alpha)\beta \theta_4 \\
+\phi   & = & (1-\alpha)(1-\beta)\phi_1   + \alpha(1-\beta)\phi_2 +
+          \alpha\beta \phi_3 + (1-\alpha)\beta \phi_4.
+\end{eqnarray}
+Because (\ref{eq:thetaphi}) is nonlinear in $\alpha$ and $\beta$,
+we must linearize and iterate toward a solution.  Differentiating
+(\ref{eq:thetaphi}) results in
+\begin{equation}
+\left[\begin{array}{c} \delta\theta \\ \delta\phi \end{array}\right]
+= A
+\left[\begin{array}{c} \delta\alpha \\ \delta\beta \end{array}\right],
+\end{equation}
+where
+\begin{equation}
+A = \left[\begin{array}{cc}
+(\theta_2-\theta_1) + (\theta_1-\theta_4+\theta_3-\theta_2)\beta &
+(\theta_4-\theta_1) + (\theta_1-\theta_4+\theta_3-\theta_2)\alpha \\
+(\phi_2-\phi_1) + (\phi_1-\phi_4+\phi_3-\phi_2)\beta &
+(\phi_4-\phi_1) + (\phi_1-\phi_4+\phi_3-\phi_2)\alpha
+\end{array}\right].
+\end{equation}
+Inverting this system,
+\begin{equation}\label{eq:dalpha}
+\delta\alpha = \left|\begin{array}{cc}
+\delta\theta &
+(\theta_4-\theta_1) + (\theta_1-\theta_4+\theta_3-\theta_2)\alpha \\
+\delta\phi &
+(\phi_4-\phi_1) + (\phi_1-\phi_4+\phi_3-\phi_2)\alpha
+\end{array}\right| \div \det(A),
+\end{equation}
+and
+\begin{equation}\label{eq:dbeta}
+\delta\beta
+= \left|\begin{array}{cc}
+(\theta_2-\theta_1) + (\theta_1-\theta_4+\theta_3-\theta_2)\beta &
+\delta\theta \\
+(\phi_2-\phi_1) + (\phi_1-\phi_4+\phi_3-\phi_2)\beta &
+\delta\phi
+\end{array}\right| \div \det(A).
+\end{equation}
+Starting with an initial guess for $\alpha$ and $\beta$
+(say $\alpha=\beta=0$), equations~(\ref{eq:dalpha}) and
+(\ref{eq:dbeta}) can be iterated until
+$\delta\alpha$ and $\delta\beta$ are suitably small.  The
+weights can then be computed from (\ref{eq:bilinear}).  Note
+that for simple latitude-longitude grids, this iteration
+will converge in the first iteration.
+
+In order to compute the weights using this general bilinear
+iteration, it must be determined in which box the point $P$
+resides.  For this, the search algorithms outlined in the
+previous chapter are used with the exception that instead
+of using cell corners, the relevant box is formed by
+neighbor cell centers as shown in Fig.~\ref{fig:quad}.
+
+\chapter{Bicubic Remapping}
+
+The bicubic remapping exactly follows the bilinear remapping
+except that four weights for each corner point are required.
+Thus, num\_wts is set to four for this option.
+The bicubic remapping is
+\begin{eqnarray}\label{eq:bicubic}
+f_P & = & 
+    (1 - \beta^2(3-2\beta))(1 - \alpha^2(3-2\alpha))f(i  ,j  ) + \nonumber \\
+& & (1 - \beta^2(3-2\beta))     \alpha^2(3-2\alpha) f(i+1,j  ) + \nonumber \\
+& &      \beta^2(3-2\beta)      \alpha^2(3-2\alpha) f(i+1,j+1) + \nonumber \\
+& &      \beta^2(3-2\beta) (1 - \alpha^2(3-2\alpha))f(i  ,j+1) + \nonumber \\
+& & (1 - \beta^2(3-2\beta))\alpha  (\alpha-1)^2
+                        {{\partial f}\over{\partial i}}(i  ,j  ) + \nonumber \\
+& & (1 - \beta^2(3-2\beta))\alpha^2(\alpha-1)
+                        {{\partial f}\over{\partial i}}(i+1,j  ) + \nonumber \\
+& &      \beta^2(3-2\beta) \alpha^2(\alpha-1)
+                        {{\partial f}\over{\partial i}}(i+1,j+1) + \nonumber \\
+& &      \beta^2(3-2\beta) \alpha  (\alpha-1)^2
+                        {{\partial f}\over{\partial i}}(i  ,j+1) + \nonumber \\
+& & \beta  (\beta-1)^2(1 - \alpha^2(3-2\alpha))
+                        {{\partial f}\over{\partial j}}(i  ,j  ) + \nonumber \\
+& & \beta  (\beta-1)^2     \alpha^2(3-2\alpha)
+                        {{\partial f}\over{\partial j}}(i+1,j  ) + \nonumber \\
+& & \beta^2(\beta-1)       \alpha^2(3-2\alpha)
+                        {{\partial f}\over{\partial j}}(i+1,j+1) + \nonumber \\
+& & \beta^2(\beta-1)  (1 - \alpha^2(3-2\alpha))
+                        {{\partial f}\over{\partial j}}(i  ,j+1) + \nonumber \\
+& & \alpha  (\alpha-1)^2\beta  (\beta-1)^2
+           {{\partial^2 f}\over{\partial i \partial j}}(i  ,j  ) + \nonumber \\
+& & \alpha^2(\alpha-1)  \beta  (\beta-1)^2
+           {{\partial^2 f}\over{\partial i \partial j}}(i+1,j  ) + \nonumber \\
+& & \alpha^2(\alpha-1)  \beta^2(\beta-1)
+           {{\partial^2 f}\over{\partial i \partial j}}(i+1,j+1) + \nonumber \\
+& & \alpha  (\alpha-1)^2\beta^2(\beta-1)
+           {{\partial^2 f}\over{\partial i \partial j}}(i  ,j+1)
+\end{eqnarray}
+where $\alpha$ and $\beta$ are identical to those found in
+the bilinear case and are found using an identical algorithm.
+Note that unlike the conservative remappings, the gradients
+here are gradients with respect to the {\em logical} variable
+and not latitude or longitude.  Lastly, the four weights
+corresponding to each address pair correspond to the
+weight multiplying the field value at the point, the weight
+multiplying the gradient with respect to $i$, the weight
+multiplying the gradient with respect to $j$, and the weight
+multiplying the cross gradient in that order.
+
+\chapter{Distance-weighted Average Remapping}
+
+This scheme for remapping is probably the simplest
+in this package.  The code simply searches for the
+num\_neighbors nearest neighbors and computes the
+weights using
+\begin{equation}\label{eq:distwgt}
+w = {{1/(d+\epsilon)} \over
+     {\sum_n^{\rm num\_neighbors} [1/(d_n+\epsilon)]}},
+\end{equation}
+where $\epsilon$ is a small number to prevent
+dividing by zero, the sum is for normalization and
+$d$ is the distance from the destination grid point
+to the source grid point.  The distance is the angular
+distance
+\begin{equation}\label{eq:distance}
+d = \cos^{-1}\left(\cos\theta_d\cos\theta_s
+                  (\cos\phi_d\cos\phi_s + \sin\phi_d\sin\phi_s) +
+                   \sin\theta_d\sin\theta_s\right),
+\end{equation}
+where $\theta$ is latitude, $\phi$ is longitude and the
+subscripts $d,s$ denote destination and source grids,
+respectively.
+
+When finding nearest neighbors, the distance is not
+computed between the destination grid point and every
+source grid point.  Instead, the search is narrowed by
+sorting the two grids into latitude bins.  Only those
+source grid cells lying in the same latitude bin as
+the destination grid cell are checked to find the
+nearest neighbors.
+
+\chapter{Bugs}
+
+A file called `bugs' is included in the distribution
+which lists current outstanding bugs as well as a
+version history.  Any further bugs, comments, or suggestions
+should be sent to me at pwjones@lanl.gov.
+
+The code does not have very useful error messages to
+help diagnose problems so feel free to pester me with
+any problems you encounter.
+
+The package has also not been extensively tested on
+a variety of machines.  It works fine on SGI machines
+and IBM machines, but has not been run on other machines.
+It is pretty vanilla Fortran, so should be ok on
+machines with standard-compliant F90 compilers.
+
+\end{document}
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/README
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/README	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/README	(revision 2528)
@@ -0,0 +1,17 @@
+
+      This directory contains some grid files in netCDF format
+      for use in the SCRIP remapping package.
+
+      In addition, there are several source codes for creating
+      netCDF files for use in SCRIP:
+
+      convertPOPT.f  - converts input grid files for the POP 
+                       ocean model to SCRIP netCDF format
+
+      convertgauss.f - creates a SCRIP netCDF grid file for
+                       a Gaussian lat/lon grid that a global
+                       spectral model would use
+
+      convert_old.f  - converts old grid files from a previous
+                       version of the SCRIP routines
+
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/convertPOPT.f
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/convertPOPT.f	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/convertPOPT.f	(revision 2528)
@@ -0,0 +1,447 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This file converts a POP grid.dat file to a remapping grid file
+!     in netCDF format.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: convertPOPT.f,v 1.4 2001/08/21 21:22:56 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!***********************************************************************
+
+      program convertPOPT
+
+!-----------------------------------------------------------------------
+!
+!     This file converts a POP grid.dat file to a remapping grid file.
+!
+!-----------------------------------------------------------------------
+
+      use kinds_mod
+      use constants
+      use iounits
+      use netcdf_mod
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     variables that describe the grid
+!       4/3       nx = 192, ny = 128
+!       2/3 (mod) nx = 384, ny = 288
+!       x3p Greenland DP nx = 100, ny = 116
+!       x2p Greenland DP nx = 160, ny = 192
+!       x1p Greenland DP nx = 320, ny = 384
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), parameter ::
+     &             nx = 320, ny = 384,
+     &             grid_size = nx*ny,
+     &             grid_rank = 2,
+     &             grid_corners = 4
+
+      integer (kind=int_kind), dimension(2) ::
+     &             grid_dims   ! size of each dimension
+
+      character(char_len), parameter :: 
+     &    grid_name = 'Greenland DP x1p',
+     &    grid_file_in  = '/scratch/pwjones/grid.320x384.da',
+     &    grid_topo_in  = '/scratch/pwjones/kmt.320x384.da',
+     &    grid_file_out = '/scratch/pwjones/Greenland_DP_x1p.nc'
+
+      real (kind=dbl_kind), parameter ::
+     &  radius    = 6370.0e5_dbl_kind       ! radius of Earth (cm)
+     &, area_norm = one/(radius*radius)
+
+!-----------------------------------------------------------------------
+!
+!     grid coordinates and masks
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(grid_size) ::
+     &             grid_imask
+
+      real (kind=dbl_kind), dimension(grid_size) ::
+     &             grid_area      ,  ! area as computed in POP
+     &             grid_center_lat,  ! lat/lon coordinates for
+     &             grid_center_lon   ! each grid center in radians
+
+      real (kind=dbl_kind), dimension(grid_corners,grid_size) ::
+     &             grid_corner_lat,  ! lat/lon coordinates for
+     &             grid_corner_lon   ! each grid corner in radians
+
+      real (kind=dbl_kind), dimension(nx,ny) ::
+     &             HTN, HTE          ! T-cell grid lengths
+
+!-----------------------------------------------------------------------
+!
+!     other local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: i, j, n, iunit, ocn_add, im1, jm1
+
+      integer (kind=int_kind) ::
+     &        ncstat,            ! general netCDF status variable
+     &        nc_grid_id,        ! netCDF grid dataset id
+     &        nc_gridsize_id,    ! netCDF grid size dim id
+     &        nc_gridcorn_id,    ! netCDF grid corner dim id
+     &        nc_gridrank_id,    ! netCDF grid rank dim id
+     &        nc_griddims_id,    ! netCDF grid dimensions id
+     &        nc_grdcntrlat_id,  ! netCDF grid center lat id
+     &        nc_grdcntrlon_id,  ! netCDF grid center lon id
+     &        nc_grdimask_id,    ! netCDF grid mask id
+     &        nc_gridarea_id,    ! netCDF grid area id
+     &        nc_grdcrnrlat_id,  ! netCDF grid corner lat id
+     &        nc_grdcrnrlon_id   ! netCDF grid corner lon id
+
+      integer (kind=int_kind), dimension(2) ::
+     &        nc_dims2_id        ! netCDF dim id array for 2-d arrays
+
+      real (kind=dbl_kind) :: tmplon, dxt, dyt
+
+!-----------------------------------------------------------------------
+!
+!     read in grid info
+!     lat/lon info is on velocity points which correspond
+!     to the NE corner (in logical space) of the grid cell.
+!
+!-----------------------------------------------------------------------
+
+      call get_unit(iunit)
+      open(unit=iunit, file=grid_topo_in, status='old', 
+     &     form='unformatted', access='direct', recl=grid_size*4)
+      read (unit=iunit,rec=1) grid_imask
+      call release_unit(iunit)
+
+      call get_unit(iunit)
+      open(unit=iunit, file=grid_file_in, status='old', 
+     &     form='unformatted', access='direct', recl=grid_size*8)
+      read (unit=iunit, rec=1) grid_corner_lat(3,:)
+      read (unit=iunit, rec=2) grid_corner_lon(3,:)
+      read (unit=iunit, rec=3) HTN
+      read (unit=iunit, rec=4) HTE
+      call release_unit(iunit)
+
+      grid_dims(1) = nx
+      grid_dims(2) = ny
+
+!-----------------------------------------------------------------------
+!
+!     convert KMT field to integer grid mask
+!
+!-----------------------------------------------------------------------
+
+      grid_imask = min(grid_imask, 1)
+
+!-----------------------------------------------------------------------
+!
+!     compute remaining corners
+!
+!-----------------------------------------------------------------------
+
+      do j=1,ny
+        do i=1,nx
+          ocn_add = (j-1)*nx + i
+          if (i .ne. 1) then
+            im1 = ocn_add - 1
+          else
+            im1 = ocn_add + nx - 1
+          endif
+
+          grid_corner_lat(4,ocn_add) = grid_corner_lat(3,im1)
+          grid_corner_lon(4,ocn_add) = grid_corner_lon(3,im1)
+        end do
+      end do
+
+      do j=2,ny
+        do i=1,nx
+          ocn_add = (j-1)*nx + i
+          jm1 = (j-2)*nx + i
+
+          grid_corner_lat(2,ocn_add) = grid_corner_lat(3,jm1)
+          grid_corner_lat(1,ocn_add) = grid_corner_lat(4,jm1)
+
+          grid_corner_lon(2,ocn_add) = grid_corner_lon(3,jm1)
+          grid_corner_lon(1,ocn_add) = grid_corner_lon(4,jm1)
+        end do
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     mock up the lower row boundaries
+!
+!-----------------------------------------------------------------------
+
+      do i=1,nx
+        grid_corner_lat(1,i) = -pih + tiny
+        grid_corner_lat(2,i) = -pih + tiny
+
+        grid_corner_lon(1,i) = grid_corner_lon(4,i)
+        grid_corner_lon(2,i) = grid_corner_lon(3,i)
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     correct for 0,2pi longitude crossings
+!
+!-----------------------------------------------------------------------
+
+      do ocn_add=1,grid_size
+        if (grid_corner_lon(1,ocn_add) > pi2) 
+     &      grid_corner_lon(1,ocn_add) = 
+     &      grid_corner_lon(1,ocn_add) - pi2
+        if (grid_corner_lon(1,ocn_add) < 0.0) 
+     &      grid_corner_lon(1,ocn_add) = 
+     &      grid_corner_lon(1,ocn_add) + pi2
+        do n=2,grid_corners
+          tmplon = grid_corner_lon(n  ,ocn_add) - 
+     &             grid_corner_lon(n-1,ocn_add) 
+          if (tmplon < -three*pih) grid_corner_lon(n,ocn_add) = 
+     &                             grid_corner_lon(n,ocn_add) + pi2
+          if (tmplon >  three*pih) grid_corner_lon(n,ocn_add) = 
+     &                             grid_corner_lon(n,ocn_add) - pi2
+        end do
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     compute ocean cell centers by averaging corner values
+!
+!-----------------------------------------------------------------------
+
+      do ocn_add=1,grid_size
+        grid_center_lat(ocn_add) = grid_corner_lat(1,ocn_add)
+        grid_center_lon(ocn_add) = grid_corner_lon(1,ocn_add)
+        do n=2,grid_corners
+          grid_center_lat(ocn_add) = grid_center_lat(ocn_add) + 
+     &                               grid_corner_lat(n,ocn_add)
+          grid_center_lon(ocn_add) = grid_center_lon(ocn_add) + 
+     &                               grid_corner_lon(n,ocn_add)
+        end do
+        grid_center_lat(ocn_add) = grid_center_lat(ocn_add)/
+     &                                  float(grid_corners)
+        grid_center_lon(ocn_add) = grid_center_lon(ocn_add)/
+     &                                  float(grid_corners)
+        if (grid_center_lon(ocn_add) > pi2) 
+     &      grid_center_lon(ocn_add) = grid_center_lon(ocn_add) - pi2
+        if (grid_center_lon(ocn_add) < 0.0) 
+     &      grid_center_lon(ocn_add) = grid_center_lon(ocn_add) + pi2
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     compute cell areas in same way as POP
+!
+!-----------------------------------------------------------------------
+
+      n = 0
+      do j=1,ny
+        if (j > 1) then
+          jm1 = j-1
+        else
+          jm1 = 1
+        endif
+        do i=1,nx
+          if (i > 1) then
+            im1 = i-1
+          else
+            im1 = nx
+          endif
+
+          n = n+1
+
+          dxt = half*(HTN(i,j) + HTN(i,jm1))
+          dyt = half*(HTE(i,j) + HTE(im1,j))
+          if (dxt == zero) dxt=one
+          if (dyt == zero) dyt=one
+
+          grid_area(n) = dxt*dyt*area_norm
+        end do
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     set up attributes for netCDF file
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** create netCDF dataset for this grid
+      !***
+
+      ncstat = nf_create (grid_file_out, NF_CLOBBER,
+     &                    nc_grid_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, NF_GLOBAL, 'title',
+     &                          len_trim(grid_name), grid_name)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid size dimension
+      !***
+
+      ncstat = nf_def_dim (nc_grid_id, 'grid_size', grid_size, 
+     &                     nc_gridsize_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid rank dimension
+      !***
+
+      ncstat = nf_def_dim (nc_grid_id, 'grid_rank', grid_rank, 
+     &                     nc_gridrank_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner dimension
+      !***
+
+      ncstat = nf_def_dim (nc_grid_id, 'grid_corners', grid_corners, 
+     &                     nc_gridcorn_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid dim size array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_dims', NF_INT,
+     &                     1, nc_gridrank_id, nc_griddims_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid center latitude array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_center_lat', NF_DOUBLE,
+     &                     1, nc_gridsize_id, nc_grdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcntrlat_id, 'units',
+     &                          7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid center longitude array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_center_lon', NF_DOUBLE,
+     &                     1, nc_gridsize_id, nc_grdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcntrlon_id, 'units',
+     &                          7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid area array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_area', NF_DOUBLE,
+     &                     1, nc_gridsize_id, nc_gridarea_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid mask
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_imask', NF_INT,
+     &                     1, nc_gridsize_id, nc_grdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdimask_id, 'units',
+     &                          8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner latitude array
+      !***
+
+      nc_dims2_id(1) = nc_gridcorn_id
+      nc_dims2_id(2) = nc_gridsize_id
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_corner_lat', NF_DOUBLE,
+     &                     2, nc_dims2_id, nc_grdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcrnrlat_id, 'units',
+     &                          7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner longitude array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_corner_lon', NF_DOUBLE,
+     &                     2, nc_dims2_id, nc_grdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcrnrlon_id, 'units',
+     &                          7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** end definition stage
+      !***
+
+      ncstat = nf_enddef(nc_grid_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     write grid data
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_put_var_int(nc_grid_id, nc_griddims_id, grid_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcntrlat_id, 
+     &                           grid_center_lat)
+      ncstat = nf_put_var_int(nc_grid_id, nc_grdimask_id, grid_imask)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_gridarea_id, 
+     &                           grid_area)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcntrlat_id, 
+     &                           grid_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcntrlon_id, 
+     &                           grid_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcrnrlat_id, 
+     &                           grid_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcrnrlon_id, 
+     &                           grid_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_close(nc_grid_id)
+
+!***********************************************************************
+
+      end program convertPOPT
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/convert_old.f
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/convert_old.f	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/convert_old.f	(revision 2528)
@@ -0,0 +1,287 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This file converts a POP grid.dat file to a remapping grid file
+!     in netCDF format.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: convert_old.f,v 1.2 2000/04/19 22:05:57 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!***********************************************************************
+
+      program convertPOPT
+
+!-----------------------------------------------------------------------
+!
+!     This file converts a POP grid.dat file to a remapping grid file.
+!
+!-----------------------------------------------------------------------
+
+      use kinds_mod
+      use constants
+      use iounits
+      use netcdf_mod
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     variables that describe the grid
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) ::
+     &             grid_size, grid_rank, grid_corners
+
+      integer (kind=int_kind), dimension(2) ::
+     &             grid_dims   ! size of each dimension
+
+      character(char_len) :: 
+     &             grid_name
+
+      character(char_len), parameter :: 
+     &             grid_file_in  = 'remap_grid_WWice.dat',
+     &             grid_file_out = 'remap_grid_WWice.nc'
+
+!-----------------------------------------------------------------------
+!
+!     grid coordinates and masks
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(:), allocatable ::
+     &             grid_imask
+
+      real (kind=dbl_kind), dimension(:), allocatable ::
+     &             grid_center_lat,  ! lat/lon coordinates for
+     &             grid_center_lon   ! each grid center in radians
+
+      real (kind=dbl_kind), dimension(:,:), allocatable ::
+     &             grid_corner_lat,  ! lat/lon coordinates for
+     &             grid_corner_lon   ! each grid corner in radians
+
+!-----------------------------------------------------------------------
+!
+!     other local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: i, j, n, iunit, ocn_add, im1, jm1
+
+      integer (kind=int_kind) ::
+     &        ncstat,            ! general netCDF status variable
+     &        nc_grid_id,        ! netCDF grid dataset id
+     &        nc_gridsize_id,    ! netCDF grid size dim id
+     &        nc_gridcorn_id,    ! netCDF grid corner dim id
+     &        nc_gridrank_id,    ! netCDF grid rank dim id
+     &        nc_griddims_id,    ! netCDF grid dimensions id
+     &        nc_grdcntrlat_id,  ! netCDF grid center lat id
+     &        nc_grdcntrlon_id,  ! netCDF grid center lon id
+     &        nc_grdimask_id,    ! netCDF grid mask id
+     &        nc_grdcrnrlat_id,  ! netCDF grid corner lat id
+     &        nc_grdcrnrlon_id   ! netCDF grid corner lon id
+
+      integer (kind=int_kind), dimension(2) ::
+     &        nc_dims2_id        ! netCDF dim id array for 2-d arrays
+
+      real (kind=dbl_kind) :: tmplon
+
+!-----------------------------------------------------------------------
+!
+!     read in grid info
+!     lat/lon info is on velocity points which correspond
+!     to the NE corner (in logical space) of the grid cell.
+!
+!-----------------------------------------------------------------------
+
+      call get_unit(iunit)
+      open(unit=iunit, file=grid_file_in, status='old', 
+     &     form='unformatted')
+
+      read(iunit) grid_name
+      read(iunit) grid_size, grid_corners, grid_rank, grid_dims
+
+      allocate( grid_center_lat(grid_size),
+     &		grid_center_lon(grid_size),
+     &		grid_imask     (grid_size),
+     &		grid_corner_lat(grid_corners, grid_size),
+     &		grid_corner_lon(grid_corners, grid_size) )
+
+      read(iunit) grid_center_lat
+      read(iunit) grid_center_lon
+      read(iunit) grid_corner_lat
+      read(iunit) grid_corner_lon
+      read(iunit) grid_imask
+      call release_unit(iunit)
+
+!-----------------------------------------------------------------------
+!
+!     set up attributes for netCDF file
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** create netCDF dataset for this grid
+      !***
+
+      ncstat = nf_create (grid_file_out, NF_CLOBBER,
+     &                    nc_grid_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, NF_GLOBAL, 'title',
+     &                          len_trim(grid_name), grid_name)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid size dimension
+      !***
+
+      ncstat = nf_def_dim (nc_grid_id, 'grid_size', grid_size, 
+     &                     nc_gridsize_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid rank dimension
+      !***
+
+      ncstat = nf_def_dim (nc_grid_id, 'grid_rank', grid_rank, 
+     &                     nc_gridrank_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner dimension
+      !***
+
+      ncstat = nf_def_dim (nc_grid_id, 'grid_corners', grid_corners, 
+     &                     nc_gridcorn_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid dim size array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_dims', NF_INT,
+     &                     1, nc_gridrank_id, nc_griddims_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid center latitude array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_center_lat', NF_DOUBLE,
+     &                     1, nc_gridsize_id, nc_grdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcntrlat_id, 'units',
+     &                          7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid center longitude array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_center_lon', NF_DOUBLE,
+     &                     1, nc_gridsize_id, nc_grdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcntrlon_id, 'units',
+     &                          7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid mask
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_imask', NF_INT,
+     &                     1, nc_gridsize_id, nc_grdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdimask_id, 'units',
+     &                          8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner latitude array
+      !***
+
+      nc_dims2_id(1) = nc_gridcorn_id
+      nc_dims2_id(2) = nc_gridsize_id
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_corner_lat', NF_DOUBLE,
+     &                     2, nc_dims2_id, nc_grdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcrnrlat_id, 'units',
+     &                          7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner longitude array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_corner_lon', NF_DOUBLE,
+     &                     2, nc_dims2_id, nc_grdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcrnrlon_id, 'units',
+     &                          7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** end definition stage
+      !***
+
+      ncstat = nf_enddef(nc_grid_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     write grid data
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_put_var_int(nc_grid_id, nc_griddims_id, grid_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcntrlat_id, 
+     &                           grid_center_lat)
+      ncstat = nf_put_var_int(nc_grid_id, nc_grdimask_id, grid_imask)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcntrlat_id, 
+     &                           grid_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcntrlon_id, 
+     &                           grid_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcrnrlat_id, 
+     &                           grid_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcrnrlon_id, 
+     &                           grid_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_close(nc_grid_id)
+
+!***********************************************************************
+
+      end program convertPOPT
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/convertgauss.f
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/convertgauss.f	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/convertgauss.f	(revision 2528)
@@ -0,0 +1,506 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This program creates a remapping grid file for Gaussian lat/lon
+!     grids (for spectral transform codes).
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: convertgauss.f,v 1.3 2000/04/19 22:05:57 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!***********************************************************************
+
+      program convert_gauss
+
+!-----------------------------------------------------------------------
+!
+!     This file creates a remapping grid file for a Gaussian grid
+!
+!-----------------------------------------------------------------------
+
+      use kinds_mod
+      use constants
+      use iounits
+      use netcdf_mod
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     variables that describe the grid
+!
+!     T42: nx=128 ny=64
+!     T62: nx=192 ny=94
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), parameter ::
+     &             nx = 192, ny = 94,
+     &             grid_size = nx*ny,
+     &             grid_rank = 2,
+     &             grid_corners = 4
+
+      character(char_len), parameter :: 
+     &             grid_name = 'T62 Gaussian Grid',
+     &             grid_file_out = 'remap_grid_T62.nc'
+
+      integer (kind=int_kind), dimension(grid_rank) ::
+     &             grid_dims
+
+!-----------------------------------------------------------------------
+!
+!     grid coordinates and masks
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(grid_size) ::
+     &             grid_imask
+
+      real (kind=dbl_kind), dimension(grid_size) ::
+     &             grid_center_lat,  ! lat/lon coordinates for
+     &             grid_center_lon   ! each grid center in degrees
+
+      real (kind=dbl_kind), dimension(grid_corners,grid_size) ::
+     &             grid_corner_lat,  ! lat/lon coordinates for
+     &             grid_corner_lon   ! each grid corner in degrees
+
+!-----------------------------------------------------------------------
+!
+!     other local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: i, j, iunit, atm_add
+
+      integer (kind=int_kind) ::
+     &        ncstat,            ! general netCDF status variable
+     &        nc_grid_id,        ! netCDF grid dataset id
+     &        nc_gridsize_id,    ! netCDF grid size dim id
+     &        nc_gridcorn_id,    ! netCDF grid corner dim id
+     &        nc_gridrank_id,    ! netCDF grid rank dim id
+     &        nc_griddims_id,    ! netCDF grid dimension size id
+     &        nc_grdcntrlat_id,  ! netCDF grid center lat id
+     &        nc_grdcntrlon_id,  ! netCDF grid center lon id
+     &        nc_grdimask_id,    ! netCDF grid mask id
+     &        nc_grdcrnrlat_id,  ! netCDF grid corner lat id
+     &        nc_grdcrnrlon_id   ! netCDF grid corner lon id
+
+      integer (kind=int_kind), dimension(2) ::
+     &        nc_dims2_id        ! netCDF dim id array for 2-d arrays
+
+      real (kind=dbl_kind) :: dlon, minlon, maxlon, centerlon,
+     &                              minlat, maxlat, centerlat
+
+      real (kind=dbl_kind), dimension(ny) :: gauss_root, gauss_wgt
+
+!-----------------------------------------------------------------------
+!
+!     compute longitudes of cell centers and corners.  set up alon
+!     array for search routine.
+!
+!-----------------------------------------------------------------------
+
+      grid_dims(1) = nx
+      grid_dims(2) = ny
+
+      dlon = 360./nx
+
+      do i=1,nx
+
+        centerlon = (i-1)*dlon
+        minlon = centerlon - half*dlon
+        maxlon = centerlon + half*dlon
+
+        do j=1,ny
+          atm_add = (j-1)*nx + i
+
+          grid_center_lon(atm_add  ) = centerlon
+          grid_corner_lon(1,atm_add) = minlon
+          grid_corner_lon(2,atm_add) = maxlon
+          grid_corner_lon(3,atm_add) = maxlon
+          grid_corner_lon(4,atm_add) = minlon
+        end do
+
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     compute Gaussian latitudes and store in gauss_wgt.
+!
+!-----------------------------------------------------------------------
+
+      call gquad(ny, gauss_root, gauss_wgt)
+      do j=1,ny
+        gauss_wgt(j) = pih - gauss_root(ny+1-j)
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     compute latitudes at cell centers and corners.  set up alat 
+!     array for search routine.
+!
+!-----------------------------------------------------------------------
+
+      do j=1,ny
+        centerlat = gauss_wgt(j)
+
+        if (j .eq. 1) then
+          minlat = -pih
+        else
+          minlat = ATAN((COS(gauss_wgt(j-1)) - 
+     &                   COS(gauss_wgt(j  )))/
+     &                  (SIN(gauss_wgt(j  )) - 
+     &                   SIN(gauss_wgt(j-1))))
+        endif
+
+        if (j .eq. ny) then
+          maxlat = pih
+        else
+          maxlat = ATAN((COS(gauss_wgt(j  )) - 
+     &                   COS(gauss_wgt(j+1)))/
+     &                  (SIN(gauss_wgt(j+1)) - 
+     &                   SIN(gauss_wgt(j  ))))
+        endif
+
+        do i=1,nx
+          atm_add = (j-1)*nx + i
+          grid_center_lat(atm_add  ) = centerlat*360./pi2
+          grid_corner_lat(1,atm_add) = minlat*360./pi2
+          grid_corner_lat(2,atm_add) = minlat*360./pi2
+          grid_corner_lat(3,atm_add) = maxlat*360./pi2
+          grid_corner_lat(4,atm_add) = maxlat*360./pi2
+        end do
+
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     define mask
+!
+!-----------------------------------------------------------------------
+
+      grid_imask = 1
+
+!-----------------------------------------------------------------------
+!
+!     set up attributes for netCDF file
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** create netCDF dataset for this grid
+      !***
+
+      ncstat = nf_create (grid_file_out, NF_CLOBBER,
+     &                    nc_grid_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, NF_GLOBAL, 'title',
+     &                          len_trim(grid_name), grid_name)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid size dimension
+      !***
+
+      ncstat = nf_def_dim (nc_grid_id, 'grid_size', grid_size, 
+     &                     nc_gridsize_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner dimension
+      !***
+
+      ncstat = nf_def_dim (nc_grid_id, 'grid_corners', grid_corners, 
+     &                     nc_gridcorn_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid rank dimension
+      !***
+
+      ncstat = nf_def_dim (nc_grid_id, 'grid_rank', grid_rank, 
+     &                     nc_gridrank_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid dimension size array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_dims', NF_INT,
+     &                     1, nc_gridrank_id, nc_griddims_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid center latitude array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_center_lat', NF_DOUBLE,
+     &                     1, nc_gridsize_id, nc_grdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcntrlat_id, 'units',
+     &                          7, 'degrees')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid center longitude array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_center_lon', NF_DOUBLE,
+     &                     1, nc_gridsize_id, nc_grdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcntrlon_id, 'units',
+     &                          7, 'degrees')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid mask
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_imask', NF_INT,
+     &                     1, nc_gridsize_id, nc_grdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdimask_id, 'units',
+     &                          8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner latitude array
+      !***
+
+      nc_dims2_id(1) = nc_gridcorn_id
+      nc_dims2_id(2) = nc_gridsize_id
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_corner_lat', NF_DOUBLE,
+     &                     2, nc_dims2_id, nc_grdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcrnrlat_id, 'units',
+     &                          7, 'degrees')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner longitude array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_corner_lon', NF_DOUBLE,
+     &                     2, nc_dims2_id, nc_grdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcrnrlon_id, 'units',
+     &                          7, 'degrees')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** end definition stage
+      !***
+
+      ncstat = nf_enddef(nc_grid_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     write grid data
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_put_var_int(nc_grid_id, nc_griddims_id, grid_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_grid_id, nc_grdimask_id, grid_imask)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcntrlat_id, 
+     &                           grid_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcntrlon_id, 
+     &                           grid_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcrnrlat_id, 
+     &                           grid_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcrnrlon_id, 
+     &                           grid_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_close(nc_grid_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+
+      end program convert_gauss
+
+!***********************************************************************
+
+      subroutine gquad(l,root,w)
+
+!-----------------------------------------------------------------------
+!
+!     This subroutine finds the l roots (in theta) and gaussian weights 
+!     associated with the legendre polynomial of degree l > 1.
+!
+!-----------------------------------------------------------------------
+
+      use kinds_mod
+      use constants
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     intent(in)
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) :: l
+
+!-----------------------------------------------------------------------
+!
+!     intent(out)
+!
+!-----------------------------------------------------------------------
+
+      real (kind=dbl_kind), dimension(l), intent(out) ::
+     &      root, w
+
+!-----------------------------------------------------------------------
+!
+!     local
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: l1, l2, l22, l3, k, i, j
+
+      real (kind=dbl_kind) :: 
+     &     del,co,p1,p2,p3,t1,t2,slope,s,c,pp1,pp2,p00
+
+!-----------------------------------------------------------------------
+!
+!     Define useful constants.
+!
+!-----------------------------------------------------------------------
+
+      del= pi/float(4*l)
+      l1 = l+1
+      co = float(2*l+3)/float(l1**2)
+      p2 = 1.0
+      t2 = -del
+      l2 = l/2
+      k = 1
+      p00 = one/sqrt(two)
+
+!-----------------------------------------------------------------------
+!
+!     Start search for each root by looking for crossing point.
+!
+!-----------------------------------------------------------------------
+
+      do i=1,l2
+   10    t1 = t2
+         t2 = t1+del
+         p1 = p2
+         s = sin(t2)
+         c = cos(t2)
+         pp1 = 1.0
+         p3 = p00
+         do j=1,l1
+            pp2 = pp1
+            pp1 = p3
+            p3 = 2.0*sqrt((float(j**2)-0.250)/float(j**2))*c*pp1-
+     &           sqrt(float((2*j+1)*(j-1)*(j-1))/
+     &           float((2*j-3)*j*j))*pp2
+         end do
+         p2 = pp1
+         if ((k*p2).gt.0) goto 10
+
+!-----------------------------------------------------------------------
+!
+!        Now converge using Newton-Raphson.
+!
+!-----------------------------------------------------------------------
+
+         k = -k
+   20    continue
+            slope = (t2-t1)/(p2-p1)
+            t1 = t2
+            t2 = t2-slope*p2
+            p1 = p2
+            s = sin(t2)
+            c = cos(t2)
+            pp1 = 1.0
+            p3 = p00
+            do j=1,l1
+               pp2 = pp1
+               pp1 = p3
+               p3 = 2.0*sqrt((float(j**2)-0.250)/float(j**2))*c*pp1-
+     &              sqrt(float((2*j+1)*(j-1)*(j-1))/
+     &              float((2*j-3)*j*j))*pp2
+            end do
+            p2 = pp1
+         if (abs(p2).gt.1.e-10) goto 20
+         root(i) = t2
+         w(i) = co*(sin(t2)/p3)**2
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     If l is odd, take care of odd point.
+!
+!-----------------------------------------------------------------------
+
+      l22 = 2*l2
+      if (l22 .ne. l) then
+         l2 = l2+1
+         t2 = pi/2.0
+         root(l2) = t2
+         s = sin(t2)
+         c = cos(t2)
+         pp1 = 1.0
+         p3 = p00
+         do j=1,l1
+            pp2 = pp1
+            pp1 = p3
+            p3 = 2.0*sqrt((float(j**2)-0.250)/float(j**2))*c*pp1-
+     &           sqrt(float((2*j+1)*(j-1)*(j-1))/
+     &           float((2*j-3)*j*j))*pp2
+         end do
+         p2 = pp1
+         w(l2) = co/p3**2
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     Use symmetry to compute remaining roots and weights.
+!
+!-----------------------------------------------------------------------
+
+      l3 = l2+1
+      do i=l3,l
+         root(i) = pi-root(l-i+1)
+         w(i) = w(l-i+1)
+      end do
+
+!-----------------------------------------------------------------------
+
+      end subroutine gquad
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/create_latlon.f
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/create_latlon.f	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/create_latlon.f	(revision 2528)
@@ -0,0 +1,305 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This program creates a remapping grid file for a lat/lon grid.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: create_latlon.f,v 1.1 2000/04/19 22:05:58 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!***********************************************************************
+
+      program create_latlon
+
+!-----------------------------------------------------------------------
+!
+!     This file creates a remapping grid file for a Gaussian grid
+!
+!-----------------------------------------------------------------------
+
+      use kinds_mod
+      use constants
+      use iounits
+      use netcdf_mod
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     variables that describe the grid
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), parameter ::
+     &             nx = 360, ny = 180,
+     &             grid_size = nx*ny,
+     &             grid_rank = 2,
+     &             grid_corners = 4
+
+      character(char_len), parameter :: 
+     &             grid_name = 'Lat/lon 1 degree Grid',
+     &             grid_file_out = 'll1deg_grid.nc'
+
+      integer (kind=int_kind), dimension(grid_rank) ::
+     &             grid_dims
+
+!-----------------------------------------------------------------------
+!
+!     grid coordinates and masks
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(grid_size) ::
+     &             grid_imask
+
+      real (kind=dbl_kind), dimension(grid_size) ::
+     &             grid_center_lat,  ! lat/lon coordinates for
+     &             grid_center_lon   ! each grid center in degrees
+
+      real (kind=dbl_kind), dimension(grid_corners,grid_size) ::
+     &             grid_corner_lat,  ! lat/lon coordinates for
+     &             grid_corner_lon   ! each grid corner in degrees
+
+!-----------------------------------------------------------------------
+!
+!     other local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: i, j, iunit, atm_add
+
+      integer (kind=int_kind) ::
+     &        ncstat,            ! general netCDF status variable
+     &        nc_grid_id,        ! netCDF grid dataset id
+     &        nc_gridsize_id,    ! netCDF grid size dim id
+     &        nc_gridcorn_id,    ! netCDF grid corner dim id
+     &        nc_gridrank_id,    ! netCDF grid rank dim id
+     &        nc_griddims_id,    ! netCDF grid dimension size id
+     &        nc_grdcntrlat_id,  ! netCDF grid center lat id
+     &        nc_grdcntrlon_id,  ! netCDF grid center lon id
+     &        nc_grdimask_id,    ! netCDF grid mask id
+     &        nc_grdcrnrlat_id,  ! netCDF grid corner lat id
+     &        nc_grdcrnrlon_id   ! netCDF grid corner lon id
+
+      integer (kind=int_kind), dimension(2) ::
+     &        nc_dims2_id        ! netCDF dim id array for 2-d arrays
+
+      real (kind=dbl_kind) :: dlon, minlon, maxlon, centerlon,
+     &                        dlat, minlat, maxlat, centerlat
+
+!-----------------------------------------------------------------------
+!
+!     compute longitudes and latitudes of cell centers and corners.
+!
+!-----------------------------------------------------------------------
+
+      grid_dims(1) = nx
+      grid_dims(2) = ny
+
+      dlon = 360./nx
+      dlat = 180./ny
+
+      do j=1,ny
+
+        minlat = -90._dbl_kind + (j-1)*dlat
+        maxlat = -90._dbl_kind +  j   *dlat
+        centerlat = minlat + half*dlat
+
+        do i=1,nx
+          centerlon = (i-1)*dlon
+          minlon = centerlon - half*dlon
+          maxlon = centerlon + half*dlon
+
+          atm_add = (j-1)*nx + i
+
+          grid_center_lat(atm_add  ) = centerlat
+          grid_corner_lat(1,atm_add) = minlat
+          grid_corner_lat(2,atm_add) = minlat
+          grid_corner_lat(3,atm_add) = maxlat
+          grid_corner_lat(4,atm_add) = maxlat
+
+          grid_center_lon(atm_add  ) = centerlon
+          grid_corner_lon(1,atm_add) = minlon
+          grid_corner_lon(2,atm_add) = maxlon
+          grid_corner_lon(3,atm_add) = maxlon
+          grid_corner_lon(4,atm_add) = minlon
+        end do
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     define mask
+!
+!-----------------------------------------------------------------------
+
+      grid_imask = 1
+
+!-----------------------------------------------------------------------
+!
+!     set up attributes for netCDF file
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** create netCDF dataset for this grid
+      !***
+
+      ncstat = nf_create (grid_file_out, NF_CLOBBER,
+     &                    nc_grid_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, NF_GLOBAL, 'title',
+     &                          len_trim(grid_name), grid_name)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid size dimension
+      !***
+
+      ncstat = nf_def_dim (nc_grid_id, 'grid_size', grid_size, 
+     &                     nc_gridsize_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner dimension
+      !***
+
+      ncstat = nf_def_dim (nc_grid_id, 'grid_corners', grid_corners, 
+     &                     nc_gridcorn_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid rank dimension
+      !***
+
+      ncstat = nf_def_dim (nc_grid_id, 'grid_rank', grid_rank, 
+     &                     nc_gridrank_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid dimension size array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_dims', NF_INT,
+     &                     1, nc_gridrank_id, nc_griddims_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid center latitude array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_center_lat', NF_DOUBLE,
+     &                     1, nc_gridsize_id, nc_grdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcntrlat_id, 'units',
+     &                          7, 'degrees')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid center longitude array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_center_lon', NF_DOUBLE,
+     &                     1, nc_gridsize_id, nc_grdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcntrlon_id, 'units',
+     &                          7, 'degrees')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid mask
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_imask', NF_INT,
+     &                     1, nc_gridsize_id, nc_grdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdimask_id, 'units',
+     &                          8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner latitude array
+      !***
+
+      nc_dims2_id(1) = nc_gridcorn_id
+      nc_dims2_id(2) = nc_gridsize_id
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_corner_lat', NF_DOUBLE,
+     &                     2, nc_dims2_id, nc_grdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcrnrlat_id, 'units',
+     &                          7, 'degrees')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner longitude array
+      !***
+
+      ncstat = nf_def_var (nc_grid_id, 'grid_corner_lon', NF_DOUBLE,
+     &                     2, nc_dims2_id, nc_grdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_grid_id, nc_grdcrnrlon_id, 'units',
+     &                          7, 'degrees')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** end definition stage
+      !***
+
+      ncstat = nf_enddef(nc_grid_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     write grid data
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_put_var_int(nc_grid_id, nc_griddims_id, grid_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_grid_id, nc_grdimask_id, grid_imask)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcntrlat_id, 
+     &                           grid_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcntrlon_id, 
+     &                           grid_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcrnrlat_id, 
+     &                           grid_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_grid_id, nc_grdcrnrlon_id, 
+     &                           grid_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_close(nc_grid_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+
+      end program create_latlon
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/makefile
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/makefile	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/makefile	(revision 2528)
@@ -0,0 +1,59 @@
+#
+# Makefile for interpolation code
+# CVS:$Id: makefile,v 1.3 2000/04/19 22:05:59 pwjones Exp $
+#
+#COMP = xlf
+COMP = f90
+FLAGS = -O3 -64 -r10000 -I/usr/local/include 
+#FLAGS = -g
+LIB  = -lnetcdf 
+INCL = 
+SRCDIR  = ../source
+EXEDIR  = .
+OBJ  = \
+	kinds_mod.o \
+	constants.o \
+	iounits.o \
+	netcdf.o
+
+all: convertPOPT convertgauss create_latlon
+
+convertold: $(OBJ) convert_old.o
+	$(COMP) $(FLAGS) $(OBJ) convert_old.o $(LIB) -o $(EXEDIR)/convertold
+
+convertPOPT: $(OBJ) convertPOPT.o
+	$(COMP) $(FLAGS) $(OBJ) convertPOPT.o $(LIB) -o $(EXEDIR)/convertPOPT
+
+convertgauss: $(OBJ) convertgauss.o
+	$(COMP) $(FLAGS) $(OBJ) convertgauss.o $(LIB) -o $(EXEDIR)/convertgauss
+
+create_latlon: $(OBJ) create_latlon.o
+	$(COMP) $(FLAGS) $(OBJ) create_latlon.o $(LIB) -o $(EXEDIR)/create_latlon
+
+kinds_mod.o: $(SRCDIR)/kinds_mod.f $(INCL)
+	$(COMP) $(FLAGS) -c $(SRCDIR)/kinds_mod.f
+
+constants.o: $(SRCDIR)/constants.f kinds_mod.o $(INCL)
+	$(COMP) $(FLAGS) -c $(SRCDIR)/constants.f
+
+iounits.o: $(SRCDIR)/iounits.f kinds_mod.o constants.o $(INCL)
+	$(COMP) $(FLAGS) -c $(SRCDIR)/iounits.f
+
+netcdf.o: $(SRCDIR)/netcdf.f kinds_mod.o constants.o $(INCL)
+	$(COMP) $(FLAGS) -c $(SRCDIR)/netcdf.f
+
+convert_old.o: convert_old.f kinds_mod.o constants.o iounits.o netcdf.o $(INCL)
+	$(COMP) $(FLAGS) -c convert_old.f
+
+convertPOPT.o: convertPOPT.f kinds_mod.o constants.o iounits.o netcdf.o $(INCL)
+	$(COMP) $(FLAGS) -c convertPOPT.f
+
+convertgauss.o: convertgauss.f kinds_mod.o constants.o iounits.o netcdf.o $(INCL)
+	$(COMP) $(FLAGS) -c convertgauss.f
+
+create_latlon.o: create_latlon.f kinds_mod.o constants.o iounits.o netcdf.o $(INCL)
+	$(COMP) $(FLAGS) -c create_latlon.f
+
+clean: 
+	/bin/rm *.o *.mod
+
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/scrip_in
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/scrip_in	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/scrip_in	(revision 2528)
@@ -0,0 +1,16 @@
+&remap_inputs
+    num_maps = 2
+    grid1_file = 'grids/remap_grid_POP43.nc'
+    grid2_file = 'grids/remap_grid_T42.nc'
+    interp_file1 = 'rmp_POP43_to_T42_conserv.nc'
+    interp_file2 = 'rmp_T42_to_POP43_conserv.nc'
+    map1_name = 'POP43 to T42 Conservative Mapping'
+    map2_name = 'T42 to POP43 Conservative Mapping'
+    map_method = 'conservative'
+    normalize_opt = 'frac'
+    output_opt = 'scrip'
+    restrict_type = 'latitude'
+    num_srch_bins = 90 
+    luse_grid1_area = .false.
+    luse_grid2_area = .false.
+/
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/scrip_test_in
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/scrip_test_in	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/scrip_test_in	(revision 2528)
@@ -0,0 +1,5 @@
+&remap_inputs
+    field_choice = 2
+    interp_file = 'rmp_T42_to_POP43_conserv.nc'
+    output_file = 'out_T42_to_POP43_conserv.nc'
+/
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/constants.f
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/constants.f	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/constants.f	(revision 2528)
@@ -0,0 +1,65 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module defines common constants used in many routines.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: constants.f,v 1.2 2000/04/19 21:56:25 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module constants
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod  ! defines common data types
+
+      implicit none
+
+      save
+
+!-----------------------------------------------------------------------
+
+      real (kind = dbl_kind), parameter :: 
+     &                        zero   = 0.0_dbl_kind,
+     &                        one    = 1.0_dbl_kind,
+     &                        two    = 2.0_dbl_kind,
+     &                        three  = 3.0_dbl_kind,
+     &                        four   = 4.0_dbl_kind,
+     &                        five   = 5.0_dbl_kind,
+     &                        half   = 0.5_dbl_kind,
+     &                        quart  = 0.25_dbl_kind,
+     &                        bignum = 1.e+20_dbl_kind,
+     &                        tiny   = 1.e-14_dbl_kind,
+     &                        pi     = 3.14159265359_dbl_kind,
+     &                        pi2    = two*pi,
+     &                        pih    = half*pi
+
+!-----------------------------------------------------------------------
+
+      end module constants
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/copyright
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/copyright	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/copyright	(revision 2528)
@@ -0,0 +1,26 @@
+!-----------------------------------------------------------------------
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!-----------------------------------------------------------------------
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/grids.f
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/grids.f	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/grids.f	(revision 2528)
@@ -0,0 +1,831 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module reads in and initializes two grids for remapping.
+!     NOTE: grid1 must be the master grid -- the grid that determines
+!           which cells participate (e.g. land mask) and the fractional
+!           area of grid2 cells that participate in the remapping.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: grids.f,v 1.6 2001/08/21 21:06:41 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module grids
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod    ! defines data types
+      use constants    ! common constants
+      use iounits      ! I/O unit manager
+      use netcdf_mod   ! netCDF stuff
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     variables that describe each grid
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), save ::
+     &             grid1_size, grid2_size, ! total points on each grid
+     &             grid1_rank, grid2_rank, ! rank of each grid
+     &             grid1_corners, grid2_corners ! number of corners
+                                                ! for each grid cell
+
+      integer (kind=int_kind), dimension(:), allocatable, save ::
+     &             grid1_dims, grid2_dims  ! size of each grid dimension
+
+      character(char_len), save :: 
+     &             grid1_name, grid2_name  ! name for each grid
+
+      character (char_len), save :: 
+     &             grid1_units, ! units for grid coords (degs/radians)
+     &             grid2_units  ! units for grid coords
+
+      real (kind=dbl_kind), parameter ::
+     &      deg2rad = pi/180.   ! conversion for deg to rads
+
+!-----------------------------------------------------------------------
+!
+!     grid coordinates and masks
+!
+!-----------------------------------------------------------------------
+
+      logical (kind=log_kind), dimension(:), allocatable, save ::
+     &             grid1_mask,        ! flag which cells participate
+     &             grid2_mask         ! flag which cells participate
+
+      real (kind=dbl_kind), dimension(:), allocatable, save ::
+     &             grid1_center_lat,  ! lat/lon coordinates for
+     &             grid1_center_lon,  ! each grid center in radians
+     &             grid2_center_lat, 
+     &             grid2_center_lon,
+     &             grid1_area,        ! tot area of each grid1 cell
+     &             grid2_area,        ! tot area of each grid2 cell
+     &             grid1_area_in,     ! area of grid1 cell from file
+     &             grid2_area_in,     ! area of grid2 cell from file
+     &             grid1_frac,        ! fractional area of grid cells
+     &             grid2_frac         ! participating in remapping
+
+      real (kind=dbl_kind), dimension(:,:), allocatable, save ::
+     &             grid1_corner_lat,  ! lat/lon coordinates for
+     &             grid1_corner_lon,  ! each grid corner in radians
+     &             grid2_corner_lat, 
+     &             grid2_corner_lon
+
+      logical (kind=log_kind), save ::
+     &             luse_grid_centers ! use centers for bounding boxes
+     &,            luse_grid1_area   ! use area from grid file
+     &,            luse_grid2_area   ! use area from grid file
+
+      real (kind=dbl_kind), dimension(:,:), allocatable, save ::
+     &             grid1_bound_box,  ! lat/lon bounding box for use
+     &             grid2_bound_box   ! in restricting grid searches
+
+!-----------------------------------------------------------------------
+!
+!     bins for restricting searches
+!
+!-----------------------------------------------------------------------
+
+      character (char_len), save ::
+     &        restrict_type  ! type of bins to use
+
+      integer (kind=int_kind), save ::
+     &        num_srch_bins  ! num of bins for restricted srch
+
+      integer (kind=int_kind), dimension(:,:), allocatable, save ::
+     &        bin_addr1, ! min,max adds for grid1 cells in this lat bin
+     &        bin_addr2  ! min,max adds for grid2 cells in this lat bin
+
+      real(kind=dbl_kind), dimension(:,:), allocatable, save ::
+     &        bin_lats   ! min,max latitude for each search bin
+     &,       bin_lons   ! min,max longitude for each search bin
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine grid_init(grid1_file, grid2_file)
+
+!-----------------------------------------------------------------------
+!
+!     this routine reads grid info from grid files and makes any
+!     necessary changes (e.g. for 0,2pi longitude range)
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len), intent(in) :: 
+     &             grid1_file, grid2_file  ! grid data files
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: 
+     &  n      ! loop counter
+     &, nele   ! element loop counter
+     &, iunit  ! unit number for opening files
+     &, i,j    ! logical 2d addresses
+     &, ip1,jp1
+     &, n_add, e_add, ne_add
+     &, nx, ny
+
+      integer (kind=int_kind) :: 
+     &         ncstat,           ! netCDF status variable
+     &         nc_grid1_id,       ! netCDF grid file id
+     &         nc_grid2_id,       ! netCDF grid file id
+     &         nc_grid1size_id,   ! netCDF grid size dim id
+     &         nc_grid2size_id,   ! netCDF grid size dim id
+     &         nc_grid1corn_id,   ! netCDF grid corner dim id
+     &         nc_grid2corn_id,   ! netCDF grid corner dim id
+     &         nc_grid1rank_id,   ! netCDF grid rank dim id
+     &         nc_grid2rank_id,   ! netCDF grid rank dim id
+     &         nc_grid1area_id,   ! netCDF grid rank dim id
+     &         nc_grid2area_id,   ! netCDF grid rank dim id
+     &         nc_grid1dims_id,   ! netCDF grid dimension size id
+     &         nc_grid2dims_id,   ! netCDF grid dimension size id
+     &         nc_grd1imask_id,   ! netCDF grid imask var id
+     &         nc_grd2imask_id,   ! netCDF grid imask var id
+     &         nc_grd1crnrlat_id, ! netCDF grid corner lat var id
+     &         nc_grd2crnrlat_id, ! netCDF grid corner lat var id
+     &         nc_grd1crnrlon_id, ! netCDF grid corner lon var id
+     &         nc_grd2crnrlon_id, ! netCDF grid corner lon var id
+     &         nc_grd1cntrlat_id, ! netCDF grid center lat var id
+     &         nc_grd2cntrlat_id, ! netCDF grid center lat var id
+     &         nc_grd1cntrlon_id, ! netCDF grid center lon var id
+     &         nc_grd2cntrlon_id  ! netCDF grid center lon var id
+
+      integer (kind=int_kind), dimension(:), allocatable :: 
+     &                            imask ! integer mask read from file
+
+      real (kind=dbl_kind) :: 
+     &  dlat,dlon           ! lat/lon intervals for search bins
+
+      real (kind=dbl_kind), dimension(4) ::
+     &  tmp_lats, tmp_lons  ! temps for computing bounding boxes
+
+!-----------------------------------------------------------------------
+!
+!     open grid files and read grid size/name data
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_open(grid1_file, NF_NOWRITE, nc_grid1_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_open(grid2_file, NF_NOWRITE, nc_grid2_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_grid1_id, 'grid_size', nc_grid1size_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_grid1_id, nc_grid1size_id, grid1_size)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_grid2_id, 'grid_size', nc_grid2size_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_grid2_id, nc_grid2size_id, grid2_size)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_grid1_id, 'grid_rank', nc_grid1rank_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_grid1_id, nc_grid1rank_id, grid1_rank)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_grid2_id, 'grid_rank', nc_grid2rank_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_grid2_id, nc_grid2rank_id, grid2_rank)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_grid1_id,'grid_corners',nc_grid1corn_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_grid1_id,nc_grid1corn_id,grid1_corners)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_grid2_id,'grid_corners',nc_grid2corn_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_grid2_id,nc_grid2corn_id,grid2_corners)
+      call netcdf_error_handler(ncstat)
+
+      allocate( grid1_dims(grid1_rank),
+     &          grid2_dims(grid2_rank))
+
+      ncstat = nf_get_att_text(nc_grid1_id, nf_global, 'title',
+     &                         grid1_name)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_att_text(nc_grid2_id, nf_global, 'title',
+     &                         grid2_name)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     allocate grid coordinates/masks and read data
+!
+!-----------------------------------------------------------------------
+
+      allocate( grid1_mask      (grid1_size),
+     &          grid2_mask      (grid2_size),
+     &          grid1_center_lat(grid1_size), 
+     &          grid1_center_lon(grid1_size),
+     &          grid2_center_lat(grid2_size), 
+     &          grid2_center_lon(grid2_size),
+     &          grid1_area      (grid1_size),
+     &          grid2_area      (grid2_size),
+     &          grid1_frac      (grid1_size),
+     &          grid2_frac      (grid2_size),
+     &          grid1_corner_lat(grid1_corners, grid1_size),
+     &          grid1_corner_lon(grid1_corners, grid1_size),
+     &          grid2_corner_lat(grid2_corners, grid2_size),
+     &          grid2_corner_lon(grid2_corners, grid2_size),
+     &          grid1_bound_box (4            , grid1_size),
+     &          grid2_bound_box (4            , grid2_size))
+
+      allocate(imask(grid1_size))
+
+      ncstat = nf_inq_varid(nc_grid1_id, 'grid_dims', nc_grid1dims_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid1_id, 'grid_imask', nc_grd1imask_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid1_id, 'grid_center_lat', 
+     &                                   nc_grd1cntrlat_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid1_id, 'grid_center_lon', 
+     &                                   nc_grd1cntrlon_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid1_id, 'grid_corner_lat', 
+     &                                   nc_grd1crnrlat_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid1_id, 'grid_corner_lon', 
+     &                                   nc_grd1crnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_grid1_id, nc_grid1dims_id, grid1_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_grid1_id, nc_grd1imask_id, imask)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid1_id, nc_grd1cntrlat_id, 
+     &                                       grid1_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid1_id, nc_grd1cntrlon_id, 
+     &                                       grid1_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid1_id, nc_grd1crnrlat_id, 
+     &                                       grid1_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid1_id, nc_grd1crnrlon_id, 
+     &                                       grid1_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      if (luse_grid1_area) then
+        allocate (grid1_area_in(grid1_size))
+        ncstat = nf_inq_varid(nc_grid1_id, 'grid_area', nc_grid1area_id)
+        call netcdf_error_handler(ncstat)
+        ncstat = nf_get_var_double(nc_grid1_id, nc_grid1area_id, 
+     &                                          grid1_area_in)
+        call netcdf_error_handler(ncstat)
+      endif
+
+      grid1_area = zero
+      grid1_frac = zero
+
+!-----------------------------------------------------------------------
+!
+!     initialize logical mask and convert lat/lon units if required
+!
+!-----------------------------------------------------------------------
+
+      where (imask == 1)
+        grid1_mask = .true.
+      elsewhere
+        grid1_mask = .false.
+      endwhere
+      deallocate(imask)
+
+      grid1_units = ' '
+      ncstat = nf_get_att_text(nc_grid1_id, nc_grd1cntrlat_id, 'units',
+     &                         grid1_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid1_units(1:7))
+      case ('degrees')
+
+        grid1_center_lat = grid1_center_lat*deg2rad
+        grid1_center_lon = grid1_center_lon*deg2rad
+
+      case ('radians')
+
+        !*** no conversion necessary
+
+      case default
+
+        print *,'unknown units supplied for grid1 center lat/lon: '
+        print *,'proceeding assuming radians'
+
+      end select
+
+      grid1_units = ' '
+      ncstat = nf_get_att_text(nc_grid1_id, nc_grd1crnrlat_id, 'units',
+     &                         grid1_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid1_units(1:7))
+      case ('degrees')
+
+        grid1_corner_lat = grid1_corner_lat*deg2rad
+        grid1_corner_lon = grid1_corner_lon*deg2rad
+
+      case ('radians')
+
+        !*** no conversion necessary
+
+      case default
+
+        print *,'unknown units supplied for grid1 corner lat/lon: '
+        print *,'proceeding assuming radians'
+
+      end select
+
+      ncstat = nf_close(nc_grid1_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     read data for grid 2
+!
+!-----------------------------------------------------------------------
+
+      allocate(imask(grid2_size))
+
+      ncstat = nf_inq_varid(nc_grid2_id, 'grid_dims', nc_grid2dims_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid2_id, 'grid_imask', nc_grd2imask_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid2_id, 'grid_center_lat', 
+     &                                   nc_grd2cntrlat_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid2_id, 'grid_center_lon', 
+     &                                   nc_grd2cntrlon_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid2_id, 'grid_corner_lat', 
+     &                                   nc_grd2crnrlat_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid2_id, 'grid_corner_lon', 
+     &                                   nc_grd2crnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_grid2_id, nc_grid2dims_id, grid2_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_grid2_id, nc_grd2imask_id, imask)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid2_id, nc_grd2cntrlat_id, 
+     &                                       grid2_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid2_id, nc_grd2cntrlon_id, 
+     &                                       grid2_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid2_id, nc_grd2crnrlat_id, 
+     &                                       grid2_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid2_id, nc_grd2crnrlon_id, 
+     &                                       grid2_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      if (luse_grid2_area) then
+        allocate (grid2_area_in(grid2_size))
+        ncstat = nf_inq_varid(nc_grid2_id, 'grid_area', nc_grid2area_id)
+        call netcdf_error_handler(ncstat)
+        ncstat = nf_get_var_double(nc_grid2_id, nc_grid2area_id, 
+     &                                          grid2_area_in)
+        call netcdf_error_handler(ncstat)
+      endif
+
+      grid2_area = zero
+      grid2_frac = zero
+
+!-----------------------------------------------------------------------
+!
+!     initialize logical mask and convert lat/lon units if required
+!
+!-----------------------------------------------------------------------
+
+      where (imask == 1)
+        grid2_mask = .true.
+      elsewhere
+        grid2_mask = .false.
+      endwhere
+      deallocate(imask)
+
+      grid2_units = ' '
+      ncstat = nf_get_att_text(nc_grid2_id, nc_grd2cntrlat_id, 'units',
+     &                         grid2_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid2_units(1:7))
+      case ('degrees')
+
+        grid2_center_lat = grid2_center_lat*deg2rad
+        grid2_center_lon = grid2_center_lon*deg2rad
+
+      case ('radians')
+
+        !*** no conversion necessary
+
+      case default
+
+        print *,'unknown units supplied for grid2 center lat/lon: '
+        print *,'proceeding assuming radians'
+
+      end select
+
+      grid2_units = ' '
+      ncstat = nf_get_att_text(nc_grid2_id, nc_grd2crnrlat_id, 'units',
+     &                         grid2_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid2_units(1:7))
+      case ('degrees')
+
+        grid2_corner_lat = grid2_corner_lat*deg2rad
+        grid2_corner_lon = grid2_corner_lon*deg2rad
+
+      case ('radians')
+
+        !*** no conversion necessary
+
+      case default
+
+        print *,'no units supplied for grid2 corner lat/lon: '
+        print *,'proceeding assuming radians'
+
+      end select
+
+      ncstat = nf_close(nc_grid2_id)
+      call netcdf_error_handler(ncstat)
+
+
+!-----------------------------------------------------------------------
+!
+!     convert longitudes to 0,2pi interval
+!
+!-----------------------------------------------------------------------
+
+      where (grid1_center_lon .gt. pi2)  grid1_center_lon =
+     &                                   grid1_center_lon - pi2
+      where (grid1_center_lon .lt. zero) grid1_center_lon =
+     &                                   grid1_center_lon + pi2
+      where (grid2_center_lon .gt. pi2)  grid2_center_lon =
+     &                                   grid2_center_lon - pi2
+      where (grid2_center_lon .lt. zero) grid2_center_lon =
+     &                                   grid2_center_lon + pi2
+      where (grid1_corner_lon .gt. pi2)  grid1_corner_lon =
+     &                                   grid1_corner_lon - pi2
+      where (grid1_corner_lon .lt. zero) grid1_corner_lon =
+     &                                   grid1_corner_lon + pi2
+      where (grid2_corner_lon .gt. pi2)  grid2_corner_lon =
+     &                                   grid2_corner_lon - pi2
+      where (grid2_corner_lon .lt. zero) grid2_corner_lon =
+     &                                   grid2_corner_lon + pi2
+
+!-----------------------------------------------------------------------
+!
+!     make sure input latitude range is within the machine values
+!     for +/- pi/2 
+!
+!-----------------------------------------------------------------------
+
+      where (grid1_center_lat >  pih) grid1_center_lat =  pih
+      where (grid1_corner_lat >  pih) grid1_corner_lat =  pih
+      where (grid1_center_lat < -pih) grid1_center_lat = -pih
+      where (grid1_corner_lat < -pih) grid1_corner_lat = -pih
+
+      where (grid2_center_lat >  pih) grid2_center_lat =  pih
+      where (grid2_corner_lat >  pih) grid2_corner_lat =  pih
+      where (grid2_center_lat < -pih) grid2_center_lat = -pih
+      where (grid2_corner_lat < -pih) grid2_corner_lat = -pih
+
+!-----------------------------------------------------------------------
+!
+!     compute bounding boxes for restricting future grid searches
+!
+!-----------------------------------------------------------------------
+
+      if (.not. luse_grid_centers) then
+        grid1_bound_box(1,:) = minval(grid1_corner_lat, DIM=1)
+        grid1_bound_box(2,:) = maxval(grid1_corner_lat, DIM=1)
+        grid1_bound_box(3,:) = minval(grid1_corner_lon, DIM=1)
+        grid1_bound_box(4,:) = maxval(grid1_corner_lon, DIM=1)
+
+        grid2_bound_box(1,:) = minval(grid2_corner_lat, DIM=1)
+        grid2_bound_box(2,:) = maxval(grid2_corner_lat, DIM=1)
+        grid2_bound_box(3,:) = minval(grid2_corner_lon, DIM=1)
+        grid2_bound_box(4,:) = maxval(grid2_corner_lon, DIM=1)
+
+      else
+
+        nx = grid1_dims(1)
+        ny = grid1_dims(2)
+
+        do n=1,grid1_size
+
+          !*** find N,S and NE points to this grid point
+
+          j = (n - 1)/nx +1
+          i = n - (j-1)*nx
+
+          if (i < nx) then
+            ip1 = i + 1
+          else
+            !*** assume cyclic
+            ip1 = 1
+            !*** but if it is not, correct
+            e_add = (j - 1)*nx + ip1
+            if (abs(grid1_center_lat(e_add) - 
+     &              grid1_center_lat(n   )) > pih) then
+              ip1 = i
+            endif
+          endif
+
+          if (j < ny) then
+            jp1 = j+1
+          else
+            !*** assume cyclic
+            jp1 = 1
+            !*** but if it is not, correct
+            n_add = (jp1 - 1)*nx + i
+            if (abs(grid1_center_lat(n_add) - 
+     &              grid1_center_lat(n   )) > pih) then
+              jp1 = j
+            endif
+          endif
+
+          n_add = (jp1 - 1)*nx + i
+          e_add = (j - 1)*nx + ip1
+          ne_add = (jp1 - 1)*nx + ip1
+
+          !*** find N,S and NE lat/lon coords and check bounding box
+
+          tmp_lats(1) = grid1_center_lat(n)
+          tmp_lats(2) = grid1_center_lat(e_add)
+          tmp_lats(3) = grid1_center_lat(ne_add)
+          tmp_lats(4) = grid1_center_lat(n_add)
+
+          tmp_lons(1) = grid1_center_lon(n)
+          tmp_lons(2) = grid1_center_lon(e_add)
+          tmp_lons(3) = grid1_center_lon(ne_add)
+          tmp_lons(4) = grid1_center_lon(n_add)
+
+          grid1_bound_box(1,n) = minval(tmp_lats)
+          grid1_bound_box(2,n) = maxval(tmp_lats)
+          grid1_bound_box(3,n) = minval(tmp_lons)
+          grid1_bound_box(4,n) = maxval(tmp_lons)
+        end do
+
+        nx = grid2_dims(1)
+        ny = grid2_dims(2)
+
+        do n=1,grid2_size
+
+          !*** find N,S and NE points to this grid point
+
+          j = (n - 1)/nx +1
+          i = n - (j-1)*nx
+
+          if (i < nx) then
+            ip1 = i + 1
+          else
+            !*** assume cyclic
+            ip1 = 1
+            !*** but if it is not, correct
+            e_add = (j - 1)*nx + ip1
+            if (abs(grid2_center_lat(e_add) - 
+     &              grid2_center_lat(n   )) > pih) then
+              ip1 = i
+            endif
+          endif
+
+          if (j < ny) then
+            jp1 = j+1
+          else
+            !*** assume cyclic
+            jp1 = 1
+            !*** but if it is not, correct
+            n_add = (jp1 - 1)*nx + i
+            if (abs(grid2_center_lat(n_add) - 
+     &              grid2_center_lat(n   )) > pih) then
+              jp1 = j
+            endif
+          endif
+
+          n_add = (jp1 - 1)*nx + i
+          e_add = (j - 1)*nx + ip1
+          ne_add = (jp1 - 1)*nx + ip1
+
+          !*** find N,S and NE lat/lon coords and check bounding box
+
+          tmp_lats(1) = grid2_center_lat(n)
+          tmp_lats(2) = grid2_center_lat(e_add)
+          tmp_lats(3) = grid2_center_lat(ne_add)
+          tmp_lats(4) = grid2_center_lat(n_add)
+
+          tmp_lons(1) = grid2_center_lon(n)
+          tmp_lons(2) = grid2_center_lon(e_add)
+          tmp_lons(3) = grid2_center_lon(ne_add)
+          tmp_lons(4) = grid2_center_lon(n_add)
+
+          grid2_bound_box(1,n) = minval(tmp_lats)
+          grid2_bound_box(2,n) = maxval(tmp_lats)
+          grid2_bound_box(3,n) = minval(tmp_lons)
+          grid2_bound_box(4,n) = maxval(tmp_lons)
+        end do
+
+      endif
+
+      where (abs(grid1_bound_box(4,:) - grid1_bound_box(3,:)) > pi)
+        grid1_bound_box(3,:) = zero
+        grid1_bound_box(4,:) = pi2
+      end where
+
+      where (abs(grid2_bound_box(4,:) - grid2_bound_box(3,:)) > pi)
+        grid2_bound_box(3,:) = zero
+        grid2_bound_box(4,:) = pi2
+      end where
+
+      !***
+      !*** try to check for cells that overlap poles
+      !***
+
+      where (grid1_center_lat > grid1_bound_box(2,:))
+     &  grid1_bound_box(2,:) = pih
+
+      where (grid1_center_lat < grid1_bound_box(1,:))
+     &  grid1_bound_box(1,:) = -pih
+
+      where (grid2_center_lat > grid2_bound_box(2,:))
+     &  grid2_bound_box(2,:) = pih
+
+      where (grid2_center_lat < grid2_bound_box(1,:))
+     &  grid2_bound_box(1,:) = -pih
+
+!-----------------------------------------------------------------------
+!
+!     set up and assign address ranges to search bins in order to 
+!     further restrict later searches
+!
+!-----------------------------------------------------------------------
+
+      select case (restrict_type)
+
+      case ('latitude')
+        write(stdout,*) 'Using latitude bins to restrict search.'
+
+        allocate(bin_addr1(2,num_srch_bins))
+        allocate(bin_addr2(2,num_srch_bins))
+        allocate(bin_lats (2,num_srch_bins))
+        allocate(bin_lons (2,num_srch_bins))
+
+        dlat = pi/num_srch_bins
+
+        do n=1,num_srch_bins
+          bin_lats(1,n) = (n-1)*dlat - pih
+          bin_lats(2,n) =     n*dlat - pih
+          bin_lons(1,n) = zero
+          bin_lons(2,n) = pi2
+          bin_addr1(1,n) = grid1_size + 1
+          bin_addr1(2,n) = 0
+          bin_addr2(1,n) = grid2_size + 1
+          bin_addr2(2,n) = 0
+        end do
+
+        do nele=1,grid1_size
+          do n=1,num_srch_bins
+            if (grid1_bound_box(1,nele) <= bin_lats(2,n) .and.
+     &          grid1_bound_box(2,nele) >= bin_lats(1,n)) then
+              bin_addr1(1,n) = min(nele,bin_addr1(1,n))
+              bin_addr1(2,n) = max(nele,bin_addr1(2,n))
+            endif
+          end do
+        end do
+
+        do nele=1,grid2_size
+          do n=1,num_srch_bins
+            if (grid2_bound_box(1,nele) <= bin_lats(2,n) .and.
+     &          grid2_bound_box(2,nele) >= bin_lats(1,n)) then
+              bin_addr2(1,n) = min(nele,bin_addr2(1,n))
+              bin_addr2(2,n) = max(nele,bin_addr2(2,n))
+            endif
+          end do
+        end do
+
+      case ('latlon')
+        write(stdout,*) 'Using lat/lon boxes to restrict search.'
+
+        dlat = pi /num_srch_bins
+        dlon = pi2/num_srch_bins
+
+        allocate(bin_addr1(2,num_srch_bins*num_srch_bins))
+        allocate(bin_addr2(2,num_srch_bins*num_srch_bins))
+        allocate(bin_lats (2,num_srch_bins*num_srch_bins))
+        allocate(bin_lons (2,num_srch_bins*num_srch_bins))
+
+        n = 0
+        do j=1,num_srch_bins
+        do i=1,num_srch_bins
+          n = n + 1
+
+          bin_lats(1,n) = (j-1)*dlat - pih
+          bin_lats(2,n) =     j*dlat - pih
+          bin_lons(1,n) = (i-1)*dlon
+          bin_lons(2,n) =     i*dlon
+          bin_addr1(1,n) = grid1_size + 1
+          bin_addr1(2,n) = 0
+          bin_addr2(1,n) = grid2_size + 1
+          bin_addr2(2,n) = 0
+        end do
+        end do
+
+        num_srch_bins = num_srch_bins**2
+
+        do nele=1,grid1_size
+          do n=1,num_srch_bins
+            if (grid1_bound_box(1,nele) <= bin_lats(2,n) .and.
+     &          grid1_bound_box(2,nele) >= bin_lats(1,n) .and.
+     &          grid1_bound_box(3,nele) <= bin_lons(2,n) .and.
+     &          grid1_bound_box(4,nele) >= bin_lons(1,n)) then
+              bin_addr1(1,n) = min(nele,bin_addr1(1,n))
+              bin_addr1(2,n) = max(nele,bin_addr1(2,n))
+            endif
+          end do
+        end do
+
+        do nele=1,grid2_size
+          do n=1,num_srch_bins
+            if (grid2_bound_box(1,nele) <= bin_lats(2,n) .and.
+     &          grid2_bound_box(2,nele) >= bin_lats(1,n) .and.
+     &          grid2_bound_box(3,nele) <= bin_lons(2,n) .and.
+     &          grid2_bound_box(4,nele) >= bin_lons(1,n)) then
+              bin_addr2(1,n) = min(nele,bin_addr2(1,n))
+              bin_addr2(2,n) = max(nele,bin_addr2(2,n))
+            endif
+          end do
+        end do
+
+      case default
+        stop 'unknown search restriction method'
+      end select
+
+!-----------------------------------------------------------------------
+
+      end subroutine grid_init
+
+!***********************************************************************
+
+      end module grids
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/iounits.f
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/iounits.f	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/iounits.f	(revision 2528)
@@ -0,0 +1,154 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module is a dynamic I/O unit manager.  It keeps track of
+!     which units are in use and reserves units for stdin, stdout, and
+!     stderr.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: iounits.f,v 1.2 2000/04/19 21:56:25 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module iounits
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod   ! defines data types
+
+      implicit none
+
+!-----------------------------------------------------------------------
+
+      logical (kind=log_kind), dimension(99), save ::
+     &    unit_free   ! flags to determine whether unit is free for use
+
+      integer (kind=int_kind), parameter ::
+     &    stdin  = 5, ! reserves unit for standard input
+     &    stdout = 6, ! reserves unit for standard output
+     &    stderr = 6  ! reserves unit for standard error
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine get_unit(iunit)
+
+!-----------------------------------------------------------------------
+!
+!     This routine returns the next available I/O unit number.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     output variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(out) ::
+     &     iunit   ! next free I/O unit
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n
+
+      logical (kind=log_kind), save :: first_call = .true.
+
+!-----------------------------------------------------------------------
+!
+!     if this is the first call, reserve stdout, stdin and stderr
+!
+!-----------------------------------------------------------------------
+
+      if (first_call) then
+        unit_free = .true.
+        unit_free(stdin)  = .false.
+        unit_free(stdout) = .false.
+        unit_free(stderr) = .false.
+        first_call = .false.
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     search for next available unit
+!
+!-----------------------------------------------------------------------
+
+      srch_unit: do n=1,99
+        if (unit_free(n)) then
+          iunit = n
+          unit_free(n) = .false.
+          exit srch_unit
+        endif
+      end do srch_unit
+
+!-----------------------------------------------------------------------
+
+      end subroutine get_unit
+
+!***********************************************************************
+
+      subroutine release_unit(iunit)
+
+!-----------------------------------------------------------------------
+!
+!     This routine releases the specified unit and closes the file.
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::
+     &     iunit   ! I/O unit to release
+
+!-----------------------------------------------------------------------
+!
+!     closes I/O unit and declares it free
+!
+!-----------------------------------------------------------------------
+
+      unit_free(iunit) = .true.
+      close(iunit)
+
+!-----------------------------------------------------------------------
+
+      end subroutine release_unit
+
+!***********************************************************************
+
+      end module iounits
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/kinds_mod.f
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/kinds_mod.f	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/kinds_mod.f	(revision 2528)
@@ -0,0 +1,53 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module defines the F90 kind parameter for common data types.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: kinds_mod.f,v 1.2 2000/04/19 21:56:25 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module kinds_mod
+
+!-----------------------------------------------------------------------
+
+      implicit none
+      save
+
+!-----------------------------------------------------------------------
+
+      integer, parameter :: char_len  = 80,
+     &                      int_kind  = kind(1),
+     &                      log_kind  = kind(.true.),
+     &                      real_kind = selected_real_kind(6),
+     &                      dbl_kind  = selected_real_kind(13)
+
+!-----------------------------------------------------------------------
+
+      end module kinds_mod
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/makefile
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/makefile	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/makefile	(revision 2528)
@@ -0,0 +1,122 @@
+#!/bin/csh
+#
+# Makefile for interpolation code
+#
+# CVS:$Id: makefile,v 1.7 2000/04/19 21:46:44 pwjones Exp $
+#
+#COMPILE = xlf
+COMPILE = f90
+FLAGS = -O3 -r10000 -64 -I/usr/local/include
+#FLAGS = -g -DEBUG:div_check=3:subscript_check=ON:trap_uninitialized=ON:verbose_runtime=ON -r10000 -64 -I/usr/local/include 
+LIB  =  -lnetcdf 
+INCLUDE = 
+SRCDIR  = .
+EXEDIR  = ..
+OBJSET  = \
+	kinds_mod.o \
+	constants.o \
+	iounits.o \
+	netcdf.o \
+	grids.o \
+	remap_vars.o \
+	remap_distwgt.o \
+	remap_conserv.o \
+	remap_bilinear.o \
+	remap_bicubic.o \
+	timers.o \
+	remap_write.o \
+	scrip.o
+
+OBJTEST  = \
+	kinds_mod.o \
+	constants.o \
+	iounits.o \
+	netcdf.o \
+	grids.o \
+	timers.o \
+	remap_vars.o \
+	remap_read.o \
+	remap.o
+
+all: $(EXEDIR)/scrip $(EXEDIR)/scrip_test
+
+$(EXEDIR)/scrip: $(OBJSET)
+	$(COMPILE) $(FLAGS) $(OBJSET) $(LIB) -o $(EXEDIR)/scrip
+
+$(EXEDIR)/scrip_test: $(OBJTEST) scrip_test.o
+	$(COMPILE) $(FLAGS) $(OBJTEST) scrip_test.o $(LIB) \
+	-o $(EXEDIR)/scrip_test
+
+scrip_test_repeat: $(OBJTEST) scrip_test_repeat.o
+	$(COMPILE) $(FLAGS) $(OBJTEST) scrip_test_repeat.o $(LIB) \
+	-o $(EXEDIR)/scrip_test_repeat
+
+kinds_mod.o: $(SRCDIR)/kinds_mod.f $(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/kinds_mod.f
+
+constants.o: $(SRCDIR)/constants.f kinds_mod.o $(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/constants.f
+
+iounits.o: $(SRCDIR)/iounits.f kinds_mod.o $(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/iounits.f
+
+netcdf.o: $(SRCDIR)/netcdf.f kinds_mod.o constants.o $(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/netcdf.f
+
+grids.o: $(SRCDIR)/grids.f kinds_mod.o constants.o iounits.o netcdf.o \
+	$(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/grids.f
+
+remap_vars.o: $(SRCDIR)/remap_vars.f kinds_mod.o constants.o grids.o \
+	$(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/remap_vars.f
+
+remap_conserv.o: $(SRCDIR)/remap_conserv.f kinds_mod.o constants.o \
+		timers.o remap_vars.o grids.o $(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/remap_conserv.f
+
+remap_distwgt.o: $(SRCDIR)/remap_distwgt.f kinds_mod.o constants.o \
+		remap_vars.o grids.o $(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/remap_distwgt.f
+
+remap_bilinear.o: $(SRCDIR)/remap_bilinear.f kinds_mod.o constants.o \
+		remap_vars.o grids.o timers.o $(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/remap_bilinear.f
+
+remap_bicubic.o: $(SRCDIR)/remap_bicubic.f kinds_mod.o constants.o \
+		remap_vars.o grids.o $(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/remap_bicubic.f
+
+timers.o: $(SRCDIR)/timers.f kinds_mod.o constants.o $(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/timers.f
+
+remap_write.o: $(SRCDIR)/remap_write.f kinds_mod.o constants.o \
+		netcdf.o remap_vars.o grids.o $(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/remap_write.f
+
+remap_read.o: $(SRCDIR)/remap_read.f kinds_mod.o constants.o netcdf.o \
+		remap_vars.o grids.o $(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/remap_read.f
+
+remap.o: $(SRCDIR)/remap.f kinds_mod.o constants.o 
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/remap.f
+
+scrip.o: $(SRCDIR)/scrip.f kinds_mod.o constants.o iounits.o timers.o \
+		remap_vars.o grids.o remap_conserv.o remap_distwgt.o \
+		remap_bilinear.o remap_bicubic.o remap_write.o \
+		$(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/scrip.f
+
+scrip_test.o: $(SRCDIR)/scrip_test.f kinds_mod.o constants.o iounits.o \
+		netcdf.o remap_vars.o grids.o remap.o remap_read.o \
+		$(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/scrip_test.f
+
+scrip_test_repeat.o: $(SRCDIR)/scrip_test_repeat.f kinds_mod.o \
+		constants.o netcdf.o \
+		iounits.o remap_vars.o grids.o $(INCLUDE)
+	$(COMPILE) $(FLAGS) -c $(SRCDIR)/scrip_test_repeat.f
+
+clean: 
+	/bin/rm *.o *.mod
+
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/netcdf.f
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/netcdf.f	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/netcdf.f	(revision 2528)
@@ -0,0 +1,79 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module contains the netCDF include file and a netcdf error
+!     handling routine.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: netcdf.f,v 1.2 2000/04/19 21:56:25 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module netcdf_mod
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod
+      use constants
+
+      implicit none
+
+      include 'netcdf.inc'
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine netcdf_error_handler(istat)
+
+!-----------------------------------------------------------------------
+!
+!     This routine provides a simple interface to netCDF error message
+!     routine.
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) :: 
+     &    istat   ! integer status returned by netCDF function call
+
+!-----------------------------------------------------------------------
+
+      if (istat /= NF_NOERR) then
+        print *,'Error in netCDF: ',nf_strerror(istat)
+        stop
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine netcdf_error_handler
+
+!***********************************************************************
+
+      end module netcdf_mod
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap.f
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap.f	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap.f	(revision 2528)
@@ -0,0 +1,165 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this routine performs a remapping based on addresses and weights
+!     computed in a setup phase
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap.f,v 1.5 2000/04/19 21:56:25 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_mod
+
+!-----------------------------------------------------------------------
+!
+!     this module contains the routines for performing the actual
+!     remappings
+!
+!-----------------------------------------------------------------------
+
+      use kinds_mod    ! defines common data types
+      use constants    ! defines common constants
+
+      implicit none
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine remap(dst_array, map_wts, dst_add, src_add, 
+     &                 src_array, src_grad1, src_grad2, src_grad3)
+
+!-----------------------------------------------------------------------
+!
+!     performs the remapping based on weights computed elsewhere
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input arrays
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(:), intent(in) ::
+     &     dst_add,     ! destination address for each link
+     &     src_add      ! source      address for each link
+
+      real (kind=dbl_kind), dimension(:,:), intent(in) ::
+     &     map_wts      ! remapping weights for each link
+
+      real (kind=dbl_kind), dimension(:), intent(in) ::
+     &     src_array    ! array with source field to be remapped
+
+      real (kind=dbl_kind), dimension(:), intent(in), optional ::
+     &     src_grad1    ! gradient arrays on source grid necessary for
+     &,    src_grad2    ! higher-order remappings
+     &,    src_grad3
+
+!-----------------------------------------------------------------------
+!
+!     output variables
+!
+!-----------------------------------------------------------------------
+
+      real (kind=dbl_kind), dimension(:), intent(inout) ::
+     &     dst_array    ! array for remapped field on destination grid
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, iorder
+
+!-----------------------------------------------------------------------
+!
+!     check the order of the interpolation
+!
+!-----------------------------------------------------------------------
+
+      if (present(src_grad1)) then
+        iorder = 2
+      else
+        iorder = 1
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     first order remapping
+!
+!-----------------------------------------------------------------------
+
+      dst_array = zero
+
+      select case (iorder)
+      case(1)
+
+        do n=1,size(dst_add)
+          dst_array(dst_add(n)) = dst_array(dst_add(n)) + 
+     &                            src_array(src_add(n))*map_wts(1,n)
+        end do
+
+!-----------------------------------------------------------------------
+!
+!     second order remapping
+!
+!-----------------------------------------------------------------------
+
+      case(2)
+
+        if (size(map_wts,DIM=1) == 3) then
+          do n=1,size(dst_add)
+            dst_array(dst_add(n)) = dst_array(dst_add(n)) +
+     &                              src_array(src_add(n))*map_wts(1,n) +
+     &                              src_grad1(src_add(n))*map_wts(2,n) +
+     &                              src_grad2(src_add(n))*map_wts(3,n)
+          end do
+        else if (size(map_wts,DIM=1) == 4) then
+          do n=1,size(dst_add)
+            dst_array(dst_add(n)) = dst_array(dst_add(n)) +
+     &                              src_array(src_add(n))*map_wts(1,n) +
+     &                              src_grad1(src_add(n))*map_wts(2,n) +
+     &                              src_grad2(src_add(n))*map_wts(3,n) +
+     &                              src_grad3(src_add(n))*map_wts(4,n)
+          end do
+        endif
+
+      end select
+
+!-----------------------------------------------------------------------
+
+      end subroutine remap
+
+!***********************************************************************
+
+      end module remap_mod
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_bicubic.f
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_bicubic.f	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_bicubic.f	(revision 2528)
@@ -0,0 +1,844 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this module contains necessary routines for performing an 
+!     bicubic interpolation.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_bicubic.f,v 1.5 2001/08/22 18:20:41 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_bicubic
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod     ! defines common data types
+      use constants     ! defines common constants
+      use grids         ! module containing grid info
+      use remap_vars    ! module containing remap info
+
+      implicit none
+
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), parameter ::
+     &    max_iter = 100   ! max iteration count for i,j iteration
+
+      real (kind=dbl_kind), parameter ::
+     &     converge = 1.e-10_dbl_kind  ! convergence criterion
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine remap_bicub
+
+!-----------------------------------------------------------------------
+!
+!     this routine computes the weights for a bicubic interpolation.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n,icount,
+     &     dst_add,        ! destination address
+     &     iter,           ! iteration counter
+     &     nmap            ! index of current map being computed
+
+      integer (kind=int_kind), dimension(4) :: 
+     &     src_add         ! address for the four source points
+
+      real (kind=dbl_kind), dimension(4)  ::
+     &     src_lats,       ! latitudes  of four bilinear corners
+     &     src_lons        ! longitudes of four bilinear corners
+
+      real (kind=dbl_kind), dimension(4,4)  ::
+     &     wgts            ! bicubic weights for four corners
+
+      real (kind=dbl_kind) ::
+     &     plat, plon,       ! lat/lon coords of destination point
+     &     iguess, jguess,   ! current guess for bilinear coordinate
+     &     thguess, phguess, ! current guess for lat/lon coordinate
+     &     deli, delj,       ! corrections to i,j
+     &     dth1, dth2, dth3, ! some latitude  differences
+     &     dph1, dph2, dph3, ! some longitude differences
+     &     dthp, dphp,       ! difference between point and sw corner
+     &     mat1, mat2, mat3, mat4, ! matrix elements
+     &     determinant,      ! matrix determinant
+     &     sum_wgts,         ! sum of weights for normalization
+     &     w1,w2,w3,w4,w5,w6,w7,w8, ! 16 bicubic weight functions
+     &     w9,w10,w11,w12,w13,w14,w15,w16
+
+!-----------------------------------------------------------------------
+!
+!     compute mappings from grid1 to grid2
+!
+!-----------------------------------------------------------------------
+
+      nmap = 1
+      if (grid1_rank /= 2) then
+        stop 'Can not do bicubic interpolation when grid_rank /= 2'
+      endif
+
+      !***
+      !*** loop over destination grid 
+      !***
+
+      grid_loop1: do dst_add = 1, grid2_size
+
+        if (.not. grid2_mask(dst_add)) cycle grid_loop1
+
+        plat = grid2_center_lat(dst_add)
+        plon = grid2_center_lon(dst_add)
+
+!-----------------------------------------------------------------------
+!
+!       find nearest square of grid points on source grid
+!
+!-----------------------------------------------------------------------
+
+        call grid_search_bicub(src_add, src_lats, src_lons, 
+     &                         plat, plon, grid1_dims,
+     &                         grid1_center_lat, grid1_center_lon,
+     &                         grid1_bound_box, bin_addr1, bin_addr2)
+
+        !***
+        !*** check to see if points are land points
+        !***
+
+        if (src_add(1) > 0) then
+          do n=1,4
+            if (.not. grid1_mask(src_add(n))) src_add(1) = 0
+          end do
+        endif
+
+!-----------------------------------------------------------------------
+!
+!       if point found, find local i,j coordinates for weights
+!
+!-----------------------------------------------------------------------
+
+        if (src_add(1) > 0) then
+
+          grid2_frac(dst_add) = one
+
+          !***
+          !*** iterate to find i,j for bicubic approximation
+          !***
+
+          dth1 = src_lats(2) - src_lats(1)
+          dth2 = src_lats(4) - src_lats(1)
+          dth3 = src_lats(3) - src_lats(2) - dth2
+
+          dph1 = src_lons(2) - src_lons(1)
+          dph2 = src_lons(4) - src_lons(1)
+          dph3 = src_lons(3) - src_lons(2)
+
+          if (dph1 >  three*pih) dph1 = dph1 - pi2
+          if (dph2 >  three*pih) dph2 = dph2 - pi2
+          if (dph3 >  three*pih) dph3 = dph3 - pi2
+          if (dph1 < -three*pih) dph1 = dph1 + pi2
+          if (dph2 < -three*pih) dph2 = dph2 + pi2
+          if (dph3 < -three*pih) dph3 = dph3 + pi2
+
+          dph3 = dph3 - dph2
+
+          iguess = half
+          jguess = half
+
+          iter_loop1: do iter=1,max_iter
+
+            dthp = plat - src_lats(1) - dth1*iguess -
+     &                    dth2*jguess - dth3*iguess*jguess
+            dphp = plon - src_lons(1)
+
+            if (dphp >  three*pih) dphp = dphp - pi2
+            if (dphp < -three*pih) dphp = dphp + pi2
+
+            dphp = dphp - dph1*iguess - dph2*jguess - 
+     &                    dph3*iguess*jguess
+
+            mat1 = dth1 + dth3*jguess
+            mat2 = dth2 + dth3*iguess
+            mat3 = dph1 + dph3*jguess
+            mat4 = dph2 + dph3*iguess
+
+            determinant = mat1*mat4 - mat2*mat3
+
+            deli = (dthp*mat4 - mat2*dphp)/determinant
+            delj = (mat1*dphp - dthp*mat3)/determinant
+
+            if (abs(deli) < converge .and. 
+     &          abs(delj) < converge) exit iter_loop1
+
+            iguess = iguess + deli
+            jguess = jguess + delj
+
+          end do iter_loop1
+
+          if (iter <= max_iter) then
+
+!-----------------------------------------------------------------------
+!
+!           successfully found i,j - compute weights
+!
+!-----------------------------------------------------------------------
+
+            wgts(1,1) = (one - jguess**2*(three-two*jguess))*
+     &                  (one - iguess**2*(three-two*iguess))
+            wgts(1,2) = (one - jguess**2*(three-two*jguess))*
+     &                         iguess**2*(three-two*iguess)
+            wgts(1,3) =        jguess**2*(three-two*jguess)*
+     &                         iguess**2*(three-two*iguess)
+            wgts(1,4) =        jguess**2*(three-two*jguess)*
+     &                  (one - iguess**2*(three-two*iguess))
+            wgts(2,1) = (one - jguess**2*(three-two*jguess))*
+     &                         iguess*(iguess-one)**2
+            wgts(2,2) = (one - jguess**2*(three-two*jguess))*
+     &                         iguess**2*(iguess-one)
+            wgts(2,3) =        jguess**2*(three-two*jguess)*
+     &                         iguess**2*(iguess-one)
+            wgts(2,4) =        jguess**2*(three-two*jguess)*
+     &                         iguess*(iguess-one)**2
+            wgts(3,1) =        jguess*(jguess-one)**2*
+     &                  (one - iguess**2*(three-two*iguess))
+            wgts(3,2) =        jguess*(jguess-one)**2*
+     &                         iguess**2*(three-two*iguess)
+            wgts(3,3) =        jguess**2*(jguess-one)*
+     &                         iguess**2*(three-two*iguess)
+            wgts(3,4) =        jguess**2*(jguess-one)*
+     &                  (one - iguess**2*(three-two*iguess))
+            wgts(4,1) =        iguess*(iguess-one)**2*
+     &                         jguess*(jguess-one)**2
+            wgts(4,2) =        iguess**2*(iguess-one)*
+     &                         jguess*(jguess-one)**2
+            wgts(4,3) =        iguess**2*(iguess-one)*
+     &                         jguess**2*(jguess-one)
+            wgts(4,4) =        iguess*(iguess-one)**2*
+     &                         jguess**2*(jguess-one)
+
+            call store_link_bicub(dst_add, src_add, wgts, nmap)
+
+          else
+            stop 'Iteration for i,j exceed max iteration count'
+          endif
+
+!-----------------------------------------------------------------------
+!
+!       search for bilinear failed - use a distance-weighted
+!       average instead (this is typically near the pole)
+!
+!-----------------------------------------------------------------------
+
+        else if (src_add(1) < 0) then
+
+          src_add = abs(src_add)
+
+          icount = 0
+          do n=1,4
+            if (grid1_mask(src_add(n))) then
+              icount = icount + 1
+            else
+              src_lats(n) = zero
+            endif
+          end do
+
+          if (icount > 0) then
+            !*** renormalize weights
+
+            sum_wgts = sum(src_lats)
+            wgts(1,1) = src_lats(1)/sum_wgts
+            wgts(1,2) = src_lats(2)/sum_wgts
+            wgts(1,3) = src_lats(3)/sum_wgts
+            wgts(1,4) = src_lats(4)/sum_wgts
+            wgts(2:4,:) = zero
+
+            grid2_frac(dst_add) = one
+            call store_link_bicub(dst_add, src_add, wgts, nmap)
+          endif
+
+        endif
+      end do grid_loop1
+
+!-----------------------------------------------------------------------
+!
+!     compute mappings from grid2 to grid1 if necessary
+!
+!-----------------------------------------------------------------------
+
+      if (num_maps > 1) then
+
+      nmap = 2
+      if (grid2_rank /= 2) then
+        stop 'Can not do bicubic interpolation when grid_rank /= 2'
+      endif
+
+      !***
+      !*** loop over destination grid 
+      !***
+
+      grid_loop2: do dst_add = 1, grid1_size
+
+        if (.not. grid1_mask(dst_add)) cycle grid_loop2
+
+        plat = grid1_center_lat(dst_add)
+        plon = grid1_center_lon(dst_add)
+
+        !***
+        !*** find nearest square of grid points on source grid
+        !***
+
+        call grid_search_bicub(src_add, src_lats, src_lons, 
+     &                         plat, plon, grid2_dims,
+     &                         grid2_center_lat, grid2_center_lon,
+     &                         grid2_bound_box, bin_addr2, bin_addr1)
+
+        !***
+        !*** check to see if points are land points
+        !***
+
+        if (src_add(1) > 0) then
+          do n=1,4
+            if (.not. grid2_mask(src_add(n))) src_add(1) = 0
+          end do
+        endif
+
+        !***
+        !*** if point found, find i,j coordinates for weights
+        !***
+
+        if (src_add(1) > 0) then
+
+          grid1_frac(dst_add) = one
+
+          !***
+          !*** iterate to find i,j for bilinear approximation
+          !***
+
+          dth1 = src_lats(2) - src_lats(1)
+          dth2 = src_lats(4) - src_lats(1)
+          dth3 = src_lats(3) - src_lats(2) - dth2
+
+          dph1 = src_lons(2) - src_lons(1)
+          dph2 = src_lons(4) - src_lons(1)
+          dph3 = src_lons(3) - src_lons(2)
+
+          if (dph1 >  pi) dph1 = dph1 - pi2
+          if (dph2 >  pi) dph2 = dph2 - pi2
+          if (dph3 >  pi) dph3 = dph3 - pi2
+          if (dph1 < -pi) dph1 = dph1 + pi2
+          if (dph2 < -pi) dph2 = dph2 + pi2
+          if (dph3 < -pi) dph3 = dph3 + pi2
+
+          dph3 = dph3 - dph2
+
+          iguess = zero
+          jguess = zero
+
+          iter_loop2: do iter=1,max_iter
+
+            dthp = plat - src_lats(1) - dth1*iguess -
+     &                    dth2*jguess - dth3*iguess*jguess
+            dphp = plon - src_lons(1)
+
+            if (dphp >  pi) dphp = dphp - pi2
+            if (dphp < -pi) dphp = dphp + pi2
+
+            dphp = dphp - dph1*iguess - dph2*jguess - 
+     &                    dph3*iguess*jguess
+
+            mat1 = dth1 + dth3*jguess
+            mat2 = dth2 + dth3*iguess
+            mat3 = dph1 + dph3*jguess
+            mat4 = dph2 + dph3*iguess
+
+            determinant = mat1*mat4 - mat2*mat3
+
+            deli = (dthp*mat4 - mat2*dphp)/determinant
+            delj = (mat1*dphp - dthp*mat3)/determinant
+
+            if (abs(deli) < converge .and. 
+     &          abs(delj) < converge) exit iter_loop2
+
+            iguess = iguess + deli
+            jguess = jguess + delj
+
+          end do iter_loop2
+
+          if (iter <= max_iter) then
+
+            !***
+            !*** successfully found i,j - compute weights
+            !***
+
+            wgts(1,1) = (one - jguess**2*(three-two*jguess))*
+     &                  (one - iguess**2*(three-two*iguess))
+            wgts(1,2) = (one - jguess**2*(three-two*jguess))*
+     &                         iguess**2*(three-two*iguess)
+            wgts(1,3) =        jguess**2*(three-two*jguess)*
+     &                         iguess**2*(three-two*iguess)
+            wgts(1,4) =        jguess**2*(three-two*jguess)*
+     &                  (one - iguess**2*(three-two*iguess))
+            wgts(2,1) = (one - jguess**2*(three-two*jguess))*
+     &                         iguess*(iguess-one)**2
+            wgts(2,2) = (one - jguess**2*(three-two*jguess))*
+     &                         iguess**2*(iguess-one)
+            wgts(2,3) =        jguess**2*(three-two*jguess)*
+     &                         iguess**2*(iguess-one)
+            wgts(2,4) =        jguess**2*(three-two*jguess)*
+     &                         iguess*(iguess-one)**2
+            wgts(3,1) =        jguess*(jguess-one)**2*
+     &                  (one - iguess**2*(three-two*iguess))
+            wgts(3,2) =        jguess*(jguess-one)**2*
+     &                         iguess**2*(three-two*iguess)
+            wgts(3,3) =        jguess**2*(jguess-one)*
+     &                         iguess**2*(three-two*iguess)
+            wgts(3,4) =        jguess**2*(jguess-one)*
+     &                  (one - iguess**2*(three-two*iguess))
+            wgts(4,1) =        iguess*(iguess-one)**2*
+     &                         jguess*(jguess-one)**2
+            wgts(4,2) =        iguess**2*(iguess-one)*
+     &                         jguess*(jguess-one)**2
+            wgts(4,3) =        iguess**2*(iguess-one)*
+     &                         jguess**2*(jguess-one)
+            wgts(4,4) =        iguess*(iguess-one)**2*
+     &                         jguess**2*(jguess-one)
+
+            call store_link_bicub(dst_add, src_add, wgts, nmap)
+
+          else
+            stop 'Iteration for i,j exceed max iteration count'
+          endif
+
+        !***
+        !*** search for bilinear failed - us a distance-weighted
+        !*** average instead
+        !***
+
+        else if (src_add(1) < 0) then
+
+          src_add = abs(src_add)
+
+          icount = 0
+          do n=1,4
+            if (grid2_mask(src_add(n))) then
+              icount = icount + 1
+            else
+              src_lats(n) = zero
+            endif
+          end do
+
+          if (icount > 0) then
+            !*** renormalize weights
+
+            sum_wgts = sum(src_lats)
+            wgts(1,1) = src_lats(1)/sum_wgts
+            wgts(1,2) = src_lats(2)/sum_wgts
+            wgts(1,3) = src_lats(3)/sum_wgts
+            wgts(1,4) = src_lats(4)/sum_wgts
+            wgts(2:4,:) = zero
+
+            grid1_frac(dst_add) = one
+            call store_link_bicub(dst_add, src_add, wgts, nmap)
+          endif
+
+        endif
+      end do grid_loop2
+
+      endif ! nmap=2
+
+!-----------------------------------------------------------------------
+
+      end subroutine remap_bicub
+
+!***********************************************************************
+
+      subroutine grid_search_bicub(src_add, src_lats, src_lons, 
+     &                             plat, plon, src_grid_dims,
+     &                             src_center_lat, src_center_lon,
+     &                             src_bound_box,
+     &                             src_bin_add, dst_bin_add)
+
+!-----------------------------------------------------------------------
+!
+!     this routine finds the location of the search point plat, plon
+!     in the source grid and returns the corners needed for a bicubic
+!     interpolation.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     output variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(4), intent(out) ::
+     &        src_add  ! address of each corner point enclosing P
+
+      real (kind=dbl_kind), dimension(4), intent(out) ::
+     &        src_lats, ! latitudes  of the four corner points
+     &        src_lons  ! longitudes of the four corner points
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      real (kind=dbl_kind), intent(in) ::
+     &        plat,   ! latitude  of the search point
+     &        plon    ! longitude of the search point
+
+      integer (kind=int_kind), dimension(2), intent(in) ::
+     &        src_grid_dims  ! size of each src grid dimension
+
+      real (kind=dbl_kind), dimension(:), intent(in) ::
+     &        src_center_lat, ! latitude  of each src grid center 
+     &        src_center_lon  ! longitude of each src grid center
+
+      real (kind=dbl_kind), dimension(:,:), intent(in) ::
+     &        src_bound_box   ! bounding box for src grid search
+
+      integer (kind=int_kind), dimension(:,:), intent(in) ::
+     &        src_bin_add,    ! search bins for restricting
+     &        dst_bin_add     ! searches
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, next_n, srch_add,   ! dummy indices
+     &    nx, ny,            ! dimensions of src grid
+     &    min_add, max_add,  ! addresses for restricting search
+     &    i, j, jp1, ip1, n_add, e_add, ne_add  ! addresses
+
+      real (kind=dbl_kind) ::  ! vectors for cross-product check
+     &      vec1_lat, vec1_lon,
+     &      vec2_lat, vec2_lon, cross_product, cross_product_last,
+     &      coslat_dst, sinlat_dst, coslon_dst, sinlon_dst,
+     &      dist_min, distance ! for computing dist-weighted avg
+
+!-----------------------------------------------------------------------
+!
+!     restrict search first using search bins. 
+!
+!-----------------------------------------------------------------------
+
+      src_add = 0
+
+      min_add = size(src_center_lat)
+      max_add = 1
+      do n=1,num_srch_bins
+        if (plat >= bin_lats(1,n) .and. plat <= bin_lats(2,n) .and.
+     &      plon >= bin_lons(1,n) .and. plon <= bin_lons(2,n)) then
+          min_add = min(min_add, src_bin_add(1,n))
+          max_add = max(max_add, src_bin_add(2,n))
+        endif
+      end do
+ 
+!-----------------------------------------------------------------------
+!
+!     now perform a more detailed search 
+!
+!-----------------------------------------------------------------------
+
+      nx = src_grid_dims(1)
+      ny = src_grid_dims(2)
+
+      srch_loop: do srch_add = min_add,max_add
+
+        if (plat <= src_bound_box(2,srch_add) .and. 
+     &      plat >= src_bound_box(1,srch_add) .and.
+     &      plon <= src_bound_box(4,srch_add) .and. 
+     &      plon >= src_bound_box(3,srch_add)) then
+
+          !***
+          !*** we are within bounding box so get really serious
+          !***
+
+          !*** find N,S and NE points to this grid point
+
+          j = (srch_add - 1)/nx +1
+          i = srch_add - (j-1)*nx
+
+          if (i < nx) then
+            ip1 = i + 1
+          else
+            ip1 = 1
+          endif
+
+          if (j < ny) then
+            jp1 = j+1
+          else
+            jp1 = 1
+          endif
+
+          n_add = (jp1 - 1)*nx + i
+          e_add = (j - 1)*nx + ip1
+          ne_add = (jp1 - 1)*nx + ip1
+
+          !***
+          !*** find N,S and NE lat/lon coords and check bounding box
+          !***
+
+          src_lats(1) = src_center_lat(srch_add)
+          src_lats(2) = src_center_lat(e_add)
+          src_lats(3) = src_center_lat(ne_add)
+          src_lats(4) = src_center_lat(n_add)
+
+          src_lons(1) = src_center_lon(srch_add)
+          src_lons(2) = src_center_lon(e_add)
+          src_lons(3) = src_center_lon(ne_add)
+          src_lons(4) = src_center_lon(n_add)
+
+          !***
+          !*** for consistency, we must make sure all lons are in
+          !*** same 2pi interval
+          !***
+
+          vec1_lon = src_lons(1) - plon
+          if (vec1_lon > pi) then
+            src_lons(1) = src_lons(1) - pi2
+          else if (vec1_lon < -pi) then
+            src_lons(1) = src_lons(1) + pi2
+          endif
+          do n=2,4
+            vec1_lon = src_lons(n) - src_lons(1)
+            if (vec1_lon > pi) then
+              src_lons(n) = src_lons(n) - pi2
+            else if (vec1_lon < -pi) then
+              src_lons(n) = src_lons(n) + pi2
+            endif
+          end do
+
+          corner_loop: do n=1,4
+            next_n = MOD(n,4) + 1
+
+            !***
+            !*** here we take the cross product of the vector making 
+            !*** up each box side with the vector formed by the vertex
+            !*** and search point.  if all the cross products are 
+            !*** same sign, the point is contained in the box.
+            !***
+
+            vec1_lat = src_lats(next_n) - src_lats(n)
+            vec1_lon = src_lons(next_n) - src_lons(n)
+            vec2_lat = plat - src_lats(n)
+            vec2_lon = plon - src_lons(n)
+
+            !***
+            !*** check for 0,2pi crossings
+            !***
+
+            if (vec1_lon >  three*pih) then
+              vec1_lon = vec1_lon - pi2
+            else if (vec1_lon < -three*pih) then
+              vec1_lon = vec1_lon + pi2
+            endif
+            if (vec2_lon >  three*pih) then
+              vec2_lon = vec2_lon - pi2
+            else if (vec2_lon < -three*pih) then
+              vec2_lon = vec2_lon + pi2
+            endif
+
+            cross_product = vec1_lon*vec2_lat - vec2_lon*vec1_lat
+
+            !***
+            !*** if cross product is less than zero, this cell
+            !*** doesn't work
+            !***
+
+            if (n==1) cross_product_last = cross_product
+            if (cross_product*cross_product_last < zero) then
+              exit corner_loop
+            else
+              cross_product_last = cross_product
+            endif
+
+          end do corner_loop
+
+          !***
+          !*** if cross products all positive, we found the location
+          !***
+
+          if (n > 4) then
+            src_add(1) = srch_add
+            src_add(2) = e_add
+            src_add(3) = ne_add
+            src_add(4) = n_add
+
+            return
+          endif
+
+          !***
+          !*** otherwise move on to next cell
+          !***
+
+        endif !bounding box check
+      end do srch_loop
+
+      !***
+      !*** if no cell found, point is likely either in a box that
+      !*** straddles either pole or is outside the grid.  fall back
+      !*** to a distance-weighted average of the four closest
+      !*** points.  go ahead and compute weights here, but store
+      !*** in src_lats and return -add to prevent the parent
+      !*** routine from computing bilinear weights
+      !***
+
+      coslat_dst = cos(plat)
+      sinlat_dst = sin(plat)
+      coslon_dst = cos(plon)
+      sinlon_dst = sin(plon)
+
+      dist_min = bignum
+      src_lats = bignum
+      do srch_add = min_add,max_add
+        distance = acos(coslat_dst*cos(src_center_lat(srch_add))*
+     &                 (coslon_dst*cos(src_center_lon(srch_add)) +
+     &                  sinlon_dst*sin(src_center_lon(srch_add)))+
+     &                  sinlat_dst*sin(src_center_lat(srch_add)))
+
+        if (distance < dist_min) then
+          sort_loop: do n=1,4
+            if (distance < src_lats(n)) then
+              do i=4,n+1,-1
+                src_add (i) = src_add (i-1)
+                src_lats(i) = src_lats(i-1)
+              end do
+              src_add (n) = -srch_add
+              src_lats(n) = distance
+              dist_min = src_lats(4)
+              exit sort_loop
+            endif
+          end do sort_loop
+        endif
+      end do
+
+      src_lons = one/(src_lats + tiny)
+      distance = sum(src_lons)
+      src_lats = src_lons/distance
+
+!-----------------------------------------------------------------------
+
+      end subroutine grid_search_bicub 
+
+!***********************************************************************
+
+      subroutine store_link_bicub(dst_add, src_add, weights, nmap)
+
+!-----------------------------------------------------------------------
+!
+!     this routine stores the address and weight for four links 
+!     associated with one destination point in the appropriate address 
+!     and weight arrays and resizes those arrays if necessary.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::
+     &        dst_add,  ! address on destination grid
+     &        nmap      ! identifies which direction for mapping
+
+      integer (kind=int_kind), dimension(4), intent(in) ::
+     &        src_add   ! addresses on source grid
+
+      real (kind=dbl_kind), dimension(4,4), intent(in) ::
+     &        weights ! array of remapping weights for these links
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, ! dummy index
+     &       num_links_old          ! placeholder for old link number
+
+!-----------------------------------------------------------------------
+!
+!     increment number of links and check to see if remap arrays need
+!     to be increased to accomodate the new link.  then store the
+!     link.
+!
+!-----------------------------------------------------------------------
+
+      select case (nmap)
+      case(1)
+
+        num_links_old  = num_links_map1
+        num_links_map1 = num_links_old + 4
+
+        if (num_links_map1 > max_links_map1) 
+     &     call resize_remap_vars(1,resize_increment)
+
+        do n=1,4
+          grid1_add_map1(num_links_old+n) = src_add(n)
+          grid2_add_map1(num_links_old+n) = dst_add
+          wts_map1    (:,num_links_old+n) = weights(:,n)
+        end do
+
+      case(2)
+
+        num_links_old  = num_links_map2
+        num_links_map2 = num_links_old + 4
+
+        if (num_links_map2 > max_links_map2) 
+     &     call resize_remap_vars(2,resize_increment)
+
+        do n=1,4
+          grid1_add_map2(num_links_old+n) = dst_add
+          grid2_add_map2(num_links_old+n) = src_add(n)
+          wts_map2    (:,num_links_old+n) = weights(:,n)
+        end do
+
+      end select
+
+!-----------------------------------------------------------------------
+
+      end subroutine store_link_bicub
+
+!***********************************************************************
+
+      end module remap_bicubic
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_bilinear.f
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_bilinear.f	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_bilinear.f	(revision 2528)
@@ -0,0 +1,781 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this module contains necessary routines for performing an 
+!     bilinear interpolation.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_bilinear.f,v 1.6 2001/08/22 18:20:40 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_bilinear
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod     ! defines common data types
+      use constants     ! defines common constants
+      use grids         ! module containing grid info
+      use remap_vars    ! module containing remap info
+
+      implicit none
+
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), parameter ::
+     &    max_iter = 100   ! max iteration count for i,j iteration
+
+      real (kind=dbl_kind), parameter ::
+     &     converge = 1.e-10_dbl_kind  ! convergence criterion
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine remap_bilin
+
+!-----------------------------------------------------------------------
+!
+!     this routine computes the weights for a bilinear interpolation.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n,icount,
+     &     dst_add,        ! destination address
+     &     iter,           ! iteration counter
+     &     nmap            ! index of current map being computed
+
+      integer (kind=int_kind), dimension(4) :: 
+     &     src_add         ! address for the four source points
+
+      real (kind=dbl_kind), dimension(4)  ::
+     &     src_lats,       ! latitudes  of four bilinear corners
+     &     src_lons,       ! longitudes of four bilinear corners
+     &     wgts            ! bilinear weights for four corners
+
+      real (kind=dbl_kind) ::
+     &     plat, plon,       ! lat/lon coords of destination point
+     &     iguess, jguess,   ! current guess for bilinear coordinate
+     &     thguess, phguess, ! current guess for lat/lon coordinate
+     &     deli, delj,       ! corrections to i,j
+     &     dth1, dth2, dth3, ! some latitude  differences
+     &     dph1, dph2, dph3, ! some longitude differences
+     &     dthp, dphp,       ! difference between point and sw corner
+     &     mat1, mat2, mat3, mat4, ! matrix elements
+     &     determinant,      ! matrix determinant
+     &     sum_wgts          ! sum of weights for normalization
+
+!-----------------------------------------------------------------------
+!
+!     compute mappings from grid1 to grid2
+!
+!-----------------------------------------------------------------------
+
+      nmap = 1
+      if (grid1_rank /= 2) then
+        stop 'Can not do bilinear interpolation when grid_rank /= 2'
+      endif
+
+      !***
+      !*** loop over destination grid 
+      !***
+
+      grid_loop1: do dst_add = 1, grid2_size
+
+        if (.not. grid2_mask(dst_add)) cycle grid_loop1
+
+        plat = grid2_center_lat(dst_add)
+        plon = grid2_center_lon(dst_add)
+
+        !***
+        !*** find nearest square of grid points on source grid
+        !***
+
+        call grid_search_bilin(src_add, src_lats, src_lons, 
+     &                         plat, plon, grid1_dims,
+     &                         grid1_center_lat, grid1_center_lon,
+     &                         grid1_bound_box, bin_addr1, bin_addr2)
+
+        !***
+        !*** check to see if points are land points
+        !***
+
+        if (src_add(1) > 0) then
+          do n=1,4
+            if (.not. grid1_mask(src_add(n))) src_add(1) = 0
+          end do
+        endif
+
+        !***
+        !*** if point found, find local i,j coordinates for weights
+        !***
+
+        if (src_add(1) > 0) then
+
+          grid2_frac(dst_add) = one
+
+          !***
+          !*** iterate to find i,j for bilinear approximation
+          !***
+
+          dth1 = src_lats(2) - src_lats(1)
+          dth2 = src_lats(4) - src_lats(1)
+          dth3 = src_lats(3) - src_lats(2) - dth2
+
+          dph1 = src_lons(2) - src_lons(1)
+          dph2 = src_lons(4) - src_lons(1)
+          dph3 = src_lons(3) - src_lons(2)
+
+          if (dph1 >  three*pih) dph1 = dph1 - pi2
+          if (dph2 >  three*pih) dph2 = dph2 - pi2
+          if (dph3 >  three*pih) dph3 = dph3 - pi2
+          if (dph1 < -three*pih) dph1 = dph1 + pi2
+          if (dph2 < -three*pih) dph2 = dph2 + pi2
+          if (dph3 < -three*pih) dph3 = dph3 + pi2
+
+          dph3 = dph3 - dph2
+
+          iguess = half
+          jguess = half
+
+          iter_loop1: do iter=1,max_iter
+
+            dthp = plat - src_lats(1) - dth1*iguess -
+     &                    dth2*jguess - dth3*iguess*jguess
+            dphp = plon - src_lons(1)
+
+            if (dphp >  three*pih) dphp = dphp - pi2
+            if (dphp < -three*pih) dphp = dphp + pi2
+
+            dphp = dphp - dph1*iguess - dph2*jguess - 
+     &                    dph3*iguess*jguess
+
+            mat1 = dth1 + dth3*jguess
+            mat2 = dth2 + dth3*iguess
+            mat3 = dph1 + dph3*jguess
+            mat4 = dph2 + dph3*iguess
+
+            determinant = mat1*mat4 - mat2*mat3
+
+            deli = (dthp*mat4 - mat2*dphp)/determinant
+            delj = (mat1*dphp - dthp*mat3)/determinant
+
+            if (abs(deli) < converge .and. 
+     &          abs(delj) < converge) exit iter_loop1
+
+            iguess = iguess + deli
+            jguess = jguess + delj
+
+          end do iter_loop1
+
+          if (iter <= max_iter) then
+
+            !***
+            !*** successfully found i,j - compute weights
+            !***
+
+            wgts(1) = (one-iguess)*(one-jguess)
+            wgts(2) = iguess*(one-jguess)
+            wgts(3) = iguess*jguess
+            wgts(4) = (one-iguess)*jguess
+
+            call store_link_bilin(dst_add, src_add, wgts, nmap)
+
+          else
+            print *,'Point coords: ',plat,plon
+            print *,'Dest grid lats: ',src_lats
+            print *,'Dest grid lons: ',src_lons
+            print *,'Dest grid addresses: ',src_add
+            print *,'Current i,j : ',iguess, jguess
+            stop 'Iteration for i,j exceed max iteration count'
+          endif
+
+        !***
+        !*** search for bilinear failed - use a distance-weighted
+        !*** average instead (this is typically near the pole)
+        !***
+
+        else if (src_add(1) < 0) then
+
+          src_add = abs(src_add)
+          icount = 0
+          do n=1,4
+            if (grid1_mask(src_add(n))) then
+              icount = icount + 1
+            else
+              src_lats(n) = zero
+            endif
+          end do
+
+          if (icount > 0) then
+            !*** renormalize weights
+
+            sum_wgts = sum(src_lats)
+            wgts(1) = src_lats(1)/sum_wgts
+            wgts(2) = src_lats(2)/sum_wgts
+            wgts(3) = src_lats(3)/sum_wgts
+            wgts(4) = src_lats(4)/sum_wgts
+
+            grid2_frac(dst_add) = one
+            call store_link_bilin(dst_add, src_add, wgts, nmap)
+          endif
+
+        endif
+      end do grid_loop1
+
+!-----------------------------------------------------------------------
+!
+!     compute mappings from grid2 to grid1 if necessary
+!
+!-----------------------------------------------------------------------
+
+      if (num_maps > 1) then
+
+      nmap = 2
+      if (grid2_rank /= 2) then
+        stop 'Can not do bilinear interpolation when grid_rank /= 2'
+      endif
+
+      !***
+      !*** loop over destination grid 
+      !***
+
+      grid_loop2: do dst_add = 1, grid1_size
+
+        if (.not. grid1_mask(dst_add)) cycle grid_loop2
+
+        plat = grid1_center_lat(dst_add)
+        plon = grid1_center_lon(dst_add)
+
+        !***
+        !*** find nearest square of grid points on source grid
+        !***
+
+        call grid_search_bilin(src_add, src_lats, src_lons, 
+     &                         plat, plon, grid2_dims,
+     &                         grid2_center_lat, grid2_center_lon,
+     &                         grid2_bound_box, bin_addr2, bin_addr1)
+
+        !***
+        !*** check to see if points are land points
+        !***
+
+        if (src_add(1) > 0) then
+          do n=1,4
+            if (.not. grid2_mask(src_add(n))) src_add(1) = 0
+          end do
+        endif
+
+        !***
+        !*** if point found, find i,j coordinates for weights
+        !***
+
+        if (src_add(1) > 0) then
+
+          grid1_frac(dst_add) = one
+
+          !***
+          !*** iterate to find i,j for bilinear approximation
+          !***
+
+          dth1 = src_lats(2) - src_lats(1)
+          dth2 = src_lats(4) - src_lats(1)
+          dth3 = src_lats(3) - src_lats(2) - dth2
+
+          dph1 = src_lons(2) - src_lons(1)
+          dph2 = src_lons(4) - src_lons(1)
+          dph3 = src_lons(3) - src_lons(2)
+
+          if (dph1 >  pi) dph1 = dph1 - pi2
+          if (dph2 >  pi) dph2 = dph2 - pi2
+          if (dph3 >  pi) dph3 = dph3 - pi2
+          if (dph1 < -pi) dph1 = dph1 + pi2
+          if (dph2 < -pi) dph2 = dph2 + pi2
+          if (dph3 < -pi) dph3 = dph3 + pi2
+
+          dph3 = dph3 - dph2
+
+          iguess = zero
+          jguess = zero
+
+          iter_loop2: do iter=1,max_iter
+
+            dthp = plat - src_lats(1) - dth1*iguess -
+     &                    dth2*jguess - dth3*iguess*jguess
+            dphp = plon - src_lons(1)
+
+            if (dphp >  pi) dphp = dphp - pi2
+            if (dphp < -pi) dphp = dphp + pi2
+
+            dphp = dphp - dph1*iguess - dph2*jguess - 
+     &                    dph3*iguess*jguess
+
+            mat1 = dth1 + dth3*jguess
+            mat2 = dth2 + dth3*iguess
+            mat3 = dph1 + dph3*jguess
+            mat4 = dph2 + dph3*iguess
+
+            determinant = mat1*mat4 - mat2*mat3
+
+            deli = (dthp*mat4 - mat2*dphp)/determinant
+            delj = (mat1*dphp - dthp*mat3)/determinant
+
+            if (abs(deli) < converge .and. 
+     &          abs(delj) < converge) exit iter_loop2
+
+            iguess = iguess + deli
+            jguess = jguess + delj
+
+          end do iter_loop2
+
+          if (iter <= max_iter) then
+
+            !***
+            !*** successfully found i,j - compute weights
+            !***
+
+            wgts(1) = (one-iguess)*(one-jguess)
+            wgts(2) = iguess*(one-jguess)
+            wgts(3) = iguess*jguess
+            wgts(4) = (one-iguess)*jguess
+
+            call store_link_bilin(dst_add, src_add, wgts, nmap)
+
+          else
+            print *,'Point coords: ',plat,plon
+            print *,'Dest grid lats: ',src_lats
+            print *,'Dest grid lons: ',src_lons
+            print *,'Dest grid addresses: ',src_add
+            print *,'Current i,j : ',iguess, jguess
+            stop 'Iteration for i,j exceed max iteration count'
+          endif
+
+        !***
+        !*** search for bilinear failed - us a distance-weighted
+        !*** average instead
+        !***
+
+        else if (src_add(1) < 0) then
+
+          src_add = abs(src_add)
+          icount = 0
+          do n=1,4
+            if (grid2_mask(src_add(n))) then
+              icount = icount + 1
+            else
+              src_lats(n) = zero
+            endif
+          end do
+
+          if (icount > 0) then
+            !*** renormalize weights
+
+            sum_wgts = sum(src_lats)
+            wgts(1) = src_lats(1)/sum_wgts
+            wgts(2) = src_lats(2)/sum_wgts
+            wgts(3) = src_lats(3)/sum_wgts
+            wgts(4) = src_lats(4)/sum_wgts
+
+            grid1_frac(dst_add) = one
+            call store_link_bilin(dst_add, src_add, wgts, nmap)
+          endif
+
+        endif
+      end do grid_loop2
+
+      endif ! nmap=2
+
+!-----------------------------------------------------------------------
+
+      end subroutine remap_bilin
+
+!***********************************************************************
+
+      subroutine grid_search_bilin(src_add, src_lats, src_lons, 
+     &                             plat, plon, src_grid_dims,
+     &                             src_center_lat, src_center_lon,
+     &                             src_grid_bound_box,
+     &                             src_bin_add, dst_bin_add)
+
+!-----------------------------------------------------------------------
+!
+!     this routine finds the location of the search point plat, plon
+!     in the source grid and returns the corners needed for a bilinear
+!     interpolation.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     output variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(4), intent(out) ::
+     &        src_add  ! address of each corner point enclosing P
+
+      real (kind=dbl_kind), dimension(4), intent(out) ::
+     &        src_lats, ! latitudes  of the four corner points
+     &        src_lons  ! longitudes of the four corner points
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      real (kind=dbl_kind), intent(in) ::
+     &        plat,   ! latitude  of the search point
+     &        plon    ! longitude of the search point
+
+      integer (kind=int_kind), dimension(2), intent(in) ::
+     &        src_grid_dims  ! size of each src grid dimension
+
+      real (kind=dbl_kind), dimension(:), intent(in) ::
+     &        src_center_lat, ! latitude  of each src grid center 
+     &        src_center_lon  ! longitude of each src grid center
+
+      real (kind=dbl_kind), dimension(:,:), intent(in) ::
+     &        src_grid_bound_box ! bound box for source grid
+
+      integer (kind=int_kind), dimension(:,:), intent(in) ::
+     &        src_bin_add,    ! latitude bins for restricting
+     &        dst_bin_add     ! searches
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, next_n, srch_add,   ! dummy indices
+     &    nx, ny,            ! dimensions of src grid
+     &    min_add, max_add,  ! addresses for restricting search
+     &    i, j, jp1, ip1, n_add, e_add, ne_add  ! addresses
+
+      real (kind=dbl_kind) ::  ! vectors for cross-product check
+     &      vec1_lat, vec1_lon,
+     &      vec2_lat, vec2_lon, cross_product, cross_product_last,
+     &      coslat_dst, sinlat_dst, coslon_dst, sinlon_dst,
+     &      dist_min, distance ! for computing dist-weighted avg
+
+!-----------------------------------------------------------------------
+!
+!     restrict search first using bins
+!
+!-----------------------------------------------------------------------
+
+      src_add = 0
+
+      min_add = size(src_center_lat)
+      max_add = 1
+      do n=1,num_srch_bins
+        if (plat >= bin_lats(1,n) .and. plat <= bin_lats(2,n) .and.
+     &      plon >= bin_lons(1,n) .and. plon <= bin_lons(2,n)) then
+          min_add = min(min_add, src_bin_add(1,n))
+          max_add = max(max_add, src_bin_add(2,n))
+        endif
+      end do
+ 
+!-----------------------------------------------------------------------
+!
+!     now perform a more detailed search 
+!
+!-----------------------------------------------------------------------
+
+      nx = src_grid_dims(1)
+      ny = src_grid_dims(2)
+
+      srch_loop: do srch_add = min_add,max_add
+
+        !*** first check bounding box
+
+        if (plat <= src_grid_bound_box(2,srch_add) .and. 
+     &      plat >= src_grid_bound_box(1,srch_add) .and.
+     &      plon <= src_grid_bound_box(4,srch_add) .and. 
+     &      plon >= src_grid_bound_box(3,srch_add)) then
+
+          !***
+          !*** we are within bounding box so get really serious
+          !***
+
+          !*** determine neighbor addresses
+
+          j = (srch_add - 1)/nx +1
+          i = srch_add - (j-1)*nx
+
+          if (i < nx) then
+            ip1 = i + 1
+          else
+            ip1 = 1
+          endif
+
+          if (j < ny) then
+            jp1 = j+1
+          else
+            jp1 = 1
+          endif
+
+          n_add = (jp1 - 1)*nx + i
+          e_add = (j - 1)*nx + ip1
+          ne_add = (jp1 - 1)*nx + ip1
+
+          src_lats(1) = src_center_lat(srch_add)
+          src_lats(2) = src_center_lat(e_add)
+          src_lats(3) = src_center_lat(ne_add)
+          src_lats(4) = src_center_lat(n_add)
+
+          src_lons(1) = src_center_lon(srch_add)
+          src_lons(2) = src_center_lon(e_add)
+          src_lons(3) = src_center_lon(ne_add)
+          src_lons(4) = src_center_lon(n_add)
+
+          !***
+          !*** for consistency, we must make sure all lons are in
+          !*** same 2pi interval
+          !***
+
+          vec1_lon = src_lons(1) - plon
+          if (vec1_lon >  pi) then
+            src_lons(1) = src_lons(1) - pi2
+          else if (vec1_lon < -pi) then
+            src_lons(1) = src_lons(1) + pi2
+          endif
+          do n=2,4
+            vec1_lon = src_lons(n) - src_lons(1)
+            if (vec1_lon >  pi) then
+              src_lons(n) = src_lons(n) - pi2
+            else if (vec1_lon < -pi) then
+              src_lons(n) = src_lons(n) + pi2
+            endif
+          end do
+
+          corner_loop: do n=1,4
+            next_n = MOD(n,4) + 1
+
+            !***
+            !*** here we take the cross product of the vector making 
+            !*** up each box side with the vector formed by the vertex
+            !*** and search point.  if all the cross products are 
+            !*** positive, the point is contained in the box.
+            !***
+
+            vec1_lat = src_lats(next_n) - src_lats(n)
+            vec1_lon = src_lons(next_n) - src_lons(n)
+            vec2_lat = plat - src_lats(n)
+            vec2_lon = plon - src_lons(n)
+
+            !***
+            !*** check for 0,2pi crossings
+            !***
+
+            if (vec1_lon >  three*pih) then
+              vec1_lon = vec1_lon - pi2
+            else if (vec1_lon < -three*pih) then
+              vec1_lon = vec1_lon + pi2
+            endif
+            if (vec2_lon >  three*pih) then
+              vec2_lon = vec2_lon - pi2
+            else if (vec2_lon < -three*pih) then
+              vec2_lon = vec2_lon + pi2
+            endif
+
+            cross_product = vec1_lon*vec2_lat - vec2_lon*vec1_lat
+
+            !***
+            !*** if cross product is less than zero, this cell
+            !*** doesn't work
+            !***
+
+            if (n == 1) cross_product_last = cross_product
+            if (cross_product*cross_product_last < zero) 
+     &          exit corner_loop
+            cross_product_last = cross_product
+
+          end do corner_loop
+
+          !***
+          !*** if cross products all same sign, we found the location
+          !***
+
+          if (n > 4) then
+            src_add(1) = srch_add
+            src_add(2) = e_add
+            src_add(3) = ne_add
+            src_add(4) = n_add
+
+            return
+          endif
+
+          !***
+          !*** otherwise move on to next cell
+          !***
+
+        endif !bounding box check
+      end do srch_loop
+
+      !***
+      !*** if no cell found, point is likely either in a box that
+      !*** straddles either pole or is outside the grid.  fall back
+      !*** to a distance-weighted average of the four closest
+      !*** points.  go ahead and compute weights here, but store
+      !*** in src_lats and return -add to prevent the parent
+      !*** routine from computing bilinear weights
+      !***
+
+      !print *,'Could not find location for ',plat,plon
+      !print *,'Using nearest-neighbor average for this point'
+
+      coslat_dst = cos(plat)
+      sinlat_dst = sin(plat)
+      coslon_dst = cos(plon)
+      sinlon_dst = sin(plon)
+
+      dist_min = bignum
+      src_lats = bignum
+      do srch_add = min_add,max_add
+        distance = acos(coslat_dst*cos(src_center_lat(srch_add))*
+     &                 (coslon_dst*cos(src_center_lon(srch_add)) +
+     &                  sinlon_dst*sin(src_center_lon(srch_add)))+
+     &                  sinlat_dst*sin(src_center_lat(srch_add)))
+
+        if (distance < dist_min) then
+          sort_loop: do n=1,4
+            if (distance < src_lats(n)) then
+              do i=4,n+1,-1
+                src_add (i) = src_add (i-1)
+                src_lats(i) = src_lats(i-1)
+              end do
+              src_add (n) = -srch_add
+              src_lats(n) = distance
+              dist_min = src_lats(4)
+              exit sort_loop
+            endif
+          end do sort_loop
+        endif
+      end do
+
+      src_lons = one/(src_lats + tiny)
+      distance = sum(src_lons)
+      src_lats = src_lons/distance
+
+!-----------------------------------------------------------------------
+
+      end subroutine grid_search_bilin 
+
+!***********************************************************************
+
+      subroutine store_link_bilin(dst_add, src_add, weights, nmap)
+
+!-----------------------------------------------------------------------
+!
+!     this routine stores the address and weight for four links 
+!     associated with one destination point in the appropriate address 
+!     and weight arrays and resizes those arrays if necessary.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::
+     &        dst_add,  ! address on destination grid
+     &        nmap      ! identifies which direction for mapping
+
+      integer (kind=int_kind), dimension(4), intent(in) ::
+     &        src_add   ! addresses on source grid
+
+      real (kind=dbl_kind), dimension(4), intent(in) ::
+     &        weights ! array of remapping weights for these links
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, ! dummy index
+     &       num_links_old          ! placeholder for old link number
+
+!-----------------------------------------------------------------------
+!
+!     increment number of links and check to see if remap arrays need
+!     to be increased to accomodate the new link.  then store the
+!     link.
+!
+!-----------------------------------------------------------------------
+
+      select case (nmap)
+      case(1)
+
+        num_links_old  = num_links_map1
+        num_links_map1 = num_links_old + 4
+
+        if (num_links_map1 > max_links_map1) 
+     &     call resize_remap_vars(1,resize_increment)
+
+        do n=1,4
+          grid1_add_map1(num_links_old+n) = src_add(n)
+          grid2_add_map1(num_links_old+n) = dst_add
+          wts_map1    (1,num_links_old+n) = weights(n)
+        end do
+
+      case(2)
+
+        num_links_old  = num_links_map2
+        num_links_map2 = num_links_old + 4
+
+        if (num_links_map2 > max_links_map2) 
+     &     call resize_remap_vars(2,resize_increment)
+
+        do n=1,4
+          grid1_add_map2(num_links_old+n) = dst_add
+          grid2_add_map2(num_links_old+n) = src_add(n)
+          wts_map2    (1,num_links_old+n) = weights(n)
+        end do
+
+      end select
+
+!-----------------------------------------------------------------------
+
+      end subroutine store_link_bilin
+
+!***********************************************************************
+
+      end module remap_bilinear
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_conserv.f
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_conserv.f	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_conserv.f	(revision 2528)
@@ -0,0 +1,2197 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this module contains necessary routines for computing addresses
+!     and weights for a conservative interpolation  between any two 
+!     grids on a sphere.  the weights are computed by performing line 
+!     integrals around all overlap regions of the two grids.  see 
+!     Dukowicz and Kodis, SIAM J. Sci. Stat. Comput. 8, 305 (1987) and
+!     Jones, P.W. Monthly Weather Review (submitted).
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_conserv.f,v 1.10 2001/08/21 21:05:13 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_conservative
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod    ! defines common data types
+      use constants    ! defines common constants
+      use timers       ! module for timing
+      use grids        ! module containing grid information
+      use remap_vars   ! module containing remap information
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     module variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), save :: 
+     &        num_srch_cells ! num cells in restricted search arrays
+
+      integer (kind=int_kind), dimension(:), allocatable, save :: 
+     &        srch_add       ! global address of cells in srch arrays
+
+      real (kind=dbl_kind), parameter :: 
+     &     north_thresh = 1.45_dbl_kind, ! threshold for coord transf.
+     &     south_thresh =-2.00_dbl_kind  ! threshold for coord transf.
+
+      real (kind=dbl_kind), dimension(:,:), allocatable, save ::
+     &     srch_corner_lat,  ! lat of each corner of srch cells
+     &     srch_corner_lon   ! lon of each corner of srch cells
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine remap_conserv
+
+!-----------------------------------------------------------------------
+!
+!     this routine traces the perimeters of every grid cell on each
+!     grid checking for intersections with the other grid and computing
+!     line integrals for each subsegment.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), parameter :: 
+     &        max_subseg = 10000 ! max number of subsegments per segment
+                                 ! to prevent infinite loop
+
+      integer (kind=int_kind) :: 
+     &        grid1_add,  ! current linear address for grid1 cell
+     &        grid2_add,  ! current linear address for grid2 cell
+     &        min_add,    ! addresses for restricting search of
+     &        max_add,    !   destination grid
+     &        n, nwgt,    ! generic counters
+     &        corner,     ! corner of cell that segment starts from
+     &        next_corn,  ! corner of cell that segment ends on
+     &        num_subseg  ! number of subsegments 
+
+      logical (kind=log_kind) :: 
+     &        lcoinc,  ! flag for coincident segments
+     &        lrevers, ! flag for reversing direction of segment
+     &        lbegin   ! flag for first integration of a segment
+
+      logical (kind=log_kind), dimension(:), allocatable ::
+     &        srch_mask   ! mask for restricting searches
+
+      real (kind=dbl_kind) ::
+     &     intrsct_lat, intrsct_lon,       ! lat/lon of next intersect
+     &     beglat, endlat, beglon, endlon, ! endpoints of current seg.
+     &     norm_factor                     ! factor for normalizing wts
+
+      real (kind=dbl_kind), dimension(:), allocatable ::
+     &       grid2_centroid_lat, grid2_centroid_lon, ! centroid coords
+     &       grid1_centroid_lat, grid1_centroid_lon  ! on each grid
+
+      real (kind=dbl_kind), dimension(2) :: begseg ! begin lat/lon for
+                                                   ! full segment
+
+      real (kind=dbl_kind), dimension(6) :: weights ! local wgt array
+
+!-----------------------------------------------------------------------
+!
+!     initialize centroid arrays
+!
+!-----------------------------------------------------------------------
+
+      allocate( grid1_centroid_lat(grid1_size),
+     &          grid1_centroid_lon(grid1_size),
+     &          grid2_centroid_lat(grid2_size),
+     &          grid2_centroid_lon(grid2_size))
+
+      grid1_centroid_lat = zero
+      grid1_centroid_lon = zero
+      grid2_centroid_lat = zero
+      grid2_centroid_lon = zero
+
+!-----------------------------------------------------------------------
+!
+!     integrate around each cell on grid1
+!
+!-----------------------------------------------------------------------
+
+      allocate(srch_mask(grid2_size))
+
+      print *,'grid1 sweep '
+      do grid1_add = 1,grid1_size
+
+        !***
+        !*** restrict searches first using search bins
+        !***
+
+        call timer_start(1)
+        min_add = grid2_size
+        max_add = 1
+        do n=1,num_srch_bins
+          if (grid1_add >= bin_addr1(1,n) .and.
+     &        grid1_add <= bin_addr1(2,n)) then
+            min_add = min(min_add, bin_addr2(1,n))
+            max_add = max(max_add, bin_addr2(2,n))
+          endif
+        end do
+
+        !***
+        !*** further restrict searches using bounding boxes
+        !***
+
+        num_srch_cells = 0
+        do grid2_add = min_add,max_add
+          srch_mask(grid2_add) = (grid2_bound_box(1,grid2_add) <= 
+     &                            grid1_bound_box(2,grid1_add)) .and.
+     &                           (grid2_bound_box(2,grid2_add) >= 
+     &                            grid1_bound_box(1,grid1_add)) .and.
+     &                           (grid2_bound_box(3,grid2_add) <= 
+     &                            grid1_bound_box(4,grid1_add)) .and.
+     &                           (grid2_bound_box(4,grid2_add) >= 
+     &                            grid1_bound_box(3,grid1_add))
+
+          if (srch_mask(grid2_add)) num_srch_cells = num_srch_cells+1
+        end do
+
+        !***
+        !*** create search arrays
+        !***
+
+        allocate(srch_add(num_srch_cells),
+     &           srch_corner_lat(grid2_corners,num_srch_cells),
+     &           srch_corner_lon(grid2_corners,num_srch_cells))
+
+        n = 0
+        gather1: do grid2_add = min_add,max_add
+          if (srch_mask(grid2_add)) then
+            n = n+1
+            srch_add(n) = grid2_add
+            srch_corner_lat(:,n) = grid2_corner_lat(:,grid2_add)
+            srch_corner_lon(:,n) = grid2_corner_lon(:,grid2_add)
+          endif
+        end do gather1
+        call timer_stop(1)
+
+        !***
+        !*** integrate around this cell
+        !***
+
+        do corner = 1,grid1_corners
+          next_corn = mod(corner,grid1_corners) + 1
+
+          !***
+          !*** define endpoints of the current segment
+          !***
+
+          beglat = grid1_corner_lat(corner,grid1_add)
+          beglon = grid1_corner_lon(corner,grid1_add)
+          endlat = grid1_corner_lat(next_corn,grid1_add)
+          endlon = grid1_corner_lon(next_corn,grid1_add)
+          lrevers = .false.
+
+          !***
+          !*** to ensure exact path taken during both
+          !*** sweeps, always integrate segments in the same 
+          !*** direction (SW to NE).
+          !***
+
+          if ((endlat < beglat) .or.
+     &        (endlat == beglat .and. endlon < beglon)) then 
+            beglat = grid1_corner_lat(next_corn,grid1_add)
+            beglon = grid1_corner_lon(next_corn,grid1_add)
+            endlat = grid1_corner_lat(corner,grid1_add)
+            endlon = grid1_corner_lon(corner,grid1_add)
+            lrevers = .true.
+          endif
+
+          begseg(1) = beglat
+          begseg(2) = beglon
+          lbegin = .true.
+          num_subseg = 0
+
+          !***
+          !*** if this is a constant-longitude segment, skip the rest 
+          !*** since the line integral contribution will be zero.
+          !***
+
+          if (endlon /= beglon) then
+
+          !***
+          !*** integrate along this segment, detecting intersections 
+          !*** and computing the line integral for each sub-segment
+          !***
+
+          do while (beglat /= endlat .or. beglon /= endlon)
+
+            !***
+            !*** prevent infinite loops if integration gets stuck
+            !*** near cell or threshold boundary
+            !***
+
+            num_subseg = num_subseg + 1
+            if (num_subseg > max_subseg) then
+              stop 'integration stalled: num_subseg exceeded limit'
+            endif
+
+            !***
+            !*** find next intersection of this segment with a grid
+            !*** line on grid 2.
+            !***
+
+            call timer_start(2)
+            call intersection(grid2_add,intrsct_lat,intrsct_lon,lcoinc,
+     &                        beglat, beglon, endlat, endlon, begseg, 
+     &                        lbegin, lrevers)
+            call timer_stop(2)
+            lbegin = .false.
+
+            !***
+            !*** compute line integral for this subsegment.
+            !***
+
+            call timer_start(3)
+            if (grid2_add /= 0) then
+              call line_integral(weights, num_wts,
+     &                         beglon, intrsct_lon, beglat, intrsct_lat,
+     &                         grid1_center_lat(grid1_add), 
+     &                         grid1_center_lon(grid1_add),
+     &                         grid2_center_lat(grid2_add), 
+     &                         grid2_center_lon(grid2_add))
+            else
+              call line_integral(weights, num_wts,
+     &                         beglon, intrsct_lon, beglat, intrsct_lat,
+     &                         grid1_center_lat(grid1_add), 
+     &                         grid1_center_lon(grid1_add),
+     &                         grid1_center_lat(grid1_add), 
+     &                         grid1_center_lon(grid1_add))
+            endif
+            call timer_stop(3)
+
+            !***
+            !*** if integrating in reverse order, change
+            !*** sign of weights
+            !***
+
+            if (lrevers) then
+              weights = -weights
+            endif
+
+            !***
+            !*** store the appropriate addresses and weights. 
+            !*** also add contributions to cell areas and centroids.
+            !***
+
+            !if (grid1_add == 119247) then
+            !  print *,grid1_add,grid2_add,corner,weights(1)
+            !  print *,grid1_corner_lat(:,grid1_add)
+            !  print *,grid1_corner_lon(:,grid1_add)
+            !  print *,grid2_corner_lat(:,grid2_add)
+            !  print *,grid2_corner_lon(:,grid2_add)
+            !  print *,beglat,beglon,intrsct_lat,intrsct_lon
+            !endif
+
+            if (grid2_add /= 0) then
+              if (grid1_mask(grid1_add)) then
+                call timer_start(4)
+                call store_link_cnsrv(grid1_add, grid2_add, weights)
+                call timer_stop(4)
+                grid1_frac(grid1_add) = grid1_frac(grid1_add) + 
+     &                                  weights(1)
+                grid2_frac(grid2_add) = grid2_frac(grid2_add) + 
+     &                                  weights(num_wts+1)
+              endif
+
+            endif
+
+            grid1_area(grid1_add) = grid1_area(grid1_add) + weights(1)
+            grid1_centroid_lat(grid1_add) = 
+     &      grid1_centroid_lat(grid1_add) + weights(2)
+            grid1_centroid_lon(grid1_add) = 
+     &      grid1_centroid_lon(grid1_add) + weights(3)
+
+            !***
+            !*** reset beglat and beglon for next subsegment.
+            !***
+
+            beglat = intrsct_lat
+            beglon = intrsct_lon
+          end do
+
+          endif
+
+          !***
+          !*** end of segment
+          !***
+
+        end do
+
+        !***
+        !*** finished with this cell: deallocate search array and
+        !*** start on next cell
+
+        deallocate(srch_add, srch_corner_lat, srch_corner_lon)
+
+      end do
+
+      deallocate(srch_mask)
+
+!-----------------------------------------------------------------------
+!
+!     integrate around each cell on grid2
+!
+!-----------------------------------------------------------------------
+
+      allocate(srch_mask(grid1_size))
+
+      print *,'grid2 sweep '
+      do grid2_add = 1,grid2_size
+
+        !***
+        !*** restrict searches first using search bins
+        !***
+
+        call timer_start(5)
+        min_add = grid1_size
+        max_add = 1
+        do n=1,num_srch_bins
+          if (grid2_add >= bin_addr2(1,n) .and.
+     &        grid2_add <= bin_addr2(2,n)) then
+            min_add = min(min_add, bin_addr1(1,n))
+            max_add = max(max_add, bin_addr1(2,n))
+          endif
+        end do
+
+        !***
+        !*** further restrict searches using bounding boxes
+        !***
+
+        num_srch_cells = 0
+        do grid1_add = min_add, max_add
+          srch_mask(grid1_add) = (grid1_bound_box(1,grid1_add) <= 
+     &                            grid2_bound_box(2,grid2_add)) .and.
+     &                           (grid1_bound_box(2,grid1_add) >= 
+     &                            grid2_bound_box(1,grid2_add)) .and.
+     &                           (grid1_bound_box(3,grid1_add) <= 
+     &                            grid2_bound_box(4,grid2_add)) .and.
+     &                           (grid1_bound_box(4,grid1_add) >= 
+     &                            grid2_bound_box(3,grid2_add))
+
+          if (srch_mask(grid1_add)) num_srch_cells = num_srch_cells+1
+        end do
+
+        allocate(srch_add(num_srch_cells),
+     &           srch_corner_lat(grid1_corners,num_srch_cells),
+     &           srch_corner_lon(grid1_corners,num_srch_cells))
+
+        n = 0
+        gather2: do grid1_add = min_add,max_add
+          if (srch_mask(grid1_add)) then
+            n = n+1
+            srch_add(n) = grid1_add
+            srch_corner_lat(:,n) = grid1_corner_lat(:,grid1_add)
+            srch_corner_lon(:,n) = grid1_corner_lon(:,grid1_add)
+          endif
+        end do gather2
+        call timer_stop(5)
+
+        !***
+        !*** integrate around this cell
+        !***
+
+        do corner = 1,grid2_corners
+          next_corn = mod(corner,grid2_corners) + 1
+
+          beglat = grid2_corner_lat(corner,grid2_add)
+          beglon = grid2_corner_lon(corner,grid2_add)
+          endlat = grid2_corner_lat(next_corn,grid2_add)
+          endlon = grid2_corner_lon(next_corn,grid2_add)
+          lrevers = .false.
+
+          !***
+          !*** to ensure exact path taken during both
+          !*** sweeps, always integrate in the same direction
+          !***
+
+          if ((endlat < beglat) .or.
+     &        (endlat == beglat .and. endlon < beglon)) then 
+            beglat = grid2_corner_lat(next_corn,grid2_add)
+            beglon = grid2_corner_lon(next_corn,grid2_add)
+            endlat = grid2_corner_lat(corner,grid2_add)
+            endlon = grid2_corner_lon(corner,grid2_add)
+            lrevers = .true.
+          endif
+
+          begseg(1) = beglat
+          begseg(2) = beglon
+          lbegin = .true.
+
+          !***
+          !*** if this is a constant-longitude segment, skip the rest 
+          !*** since the line integral contribution will be zero.
+          !***
+
+          if (endlon /= beglon) then
+          num_subseg = 0
+
+          !***
+          !*** integrate along this segment, detecting intersections 
+          !*** and computing the line integral for each sub-segment
+          !***
+
+          do while (beglat /= endlat .or. beglon /= endlon)
+
+            !***
+            !*** prevent infinite loops if integration gets stuck
+            !*** near cell or threshold boundary
+            !***
+
+            num_subseg = num_subseg + 1
+            if (num_subseg > max_subseg) then
+              stop 'integration stalled: num_subseg exceeded limit'
+            endif
+
+            !***
+            !*** find next intersection of this segment with a line 
+            !*** on grid 2.
+            !***
+
+            call timer_start(6)
+            call intersection(grid1_add,intrsct_lat,intrsct_lon,lcoinc,
+     &                        beglat, beglon, endlat, endlon, begseg,
+     &                        lbegin, lrevers)
+            call timer_stop(6)
+            lbegin = .false.
+
+            !***
+            !*** compute line integral for this subsegment.
+            !***
+
+            call timer_start(7)
+            if (grid1_add /= 0) then
+              call line_integral(weights, num_wts,
+     &                         beglon, intrsct_lon, beglat, intrsct_lat,
+     &                         grid1_center_lat(grid1_add), 
+     &                         grid1_center_lon(grid1_add),
+     &                         grid2_center_lat(grid2_add), 
+     &                         grid2_center_lon(grid2_add))
+            else
+              call line_integral(weights, num_wts,
+     &                         beglon, intrsct_lon, beglat, intrsct_lat,
+     &                         grid2_center_lat(grid2_add), 
+     &                         grid2_center_lon(grid2_add),
+     &                         grid2_center_lat(grid2_add), 
+     &                         grid2_center_lon(grid2_add))
+            endif
+            call timer_stop(7)
+
+            if (lrevers) then
+              weights = -weights
+            endif
+
+            !***
+            !*** store the appropriate addresses and weights. 
+            !*** also add contributions to cell areas and centroids.
+            !*** if there is a coincidence, do not store weights
+            !*** because they have been captured in the previous loop.
+            !*** the grid1 mask is the master mask
+            !***
+
+            !if (grid1_add == 119247) then
+            !  print *,grid1_add,grid2_add,corner,weights(1)
+            !  print *,grid1_corner_lat(:,grid1_add)
+            !  print *,grid1_corner_lon(:,grid1_add)
+            !  print *,grid2_corner_lat(:,grid2_add)
+            !  print *,grid2_corner_lon(:,grid2_add)
+            !  print *,beglat,beglon,intrsct_lat,intrsct_lon
+            !endif
+
+            if (.not. lcoinc .and. grid1_add /= 0) then
+              if (grid1_mask(grid1_add)) then
+                call timer_start(8)
+                call store_link_cnsrv(grid1_add, grid2_add, weights)
+                call timer_stop(8)
+                grid1_frac(grid1_add) = grid1_frac(grid1_add) + 
+     &                                  weights(1)
+                grid2_frac(grid2_add) = grid2_frac(grid2_add) + 
+     &                                  weights(num_wts+1)
+              endif
+
+            endif
+
+            grid2_area(grid2_add) = grid2_area(grid2_add) + 
+     &                                      weights(num_wts+1)
+            grid2_centroid_lat(grid2_add) = 
+     &      grid2_centroid_lat(grid2_add) + weights(num_wts+2)
+            grid2_centroid_lon(grid2_add) = 
+     &      grid2_centroid_lon(grid2_add) + weights(num_wts+3)
+
+            !***
+            !*** reset beglat and beglon for next subsegment.
+            !***
+
+            beglat = intrsct_lat
+            beglon = intrsct_lon
+          end do
+
+          endif
+
+          !***
+          !*** end of segment
+          !***
+
+        end do
+
+        !***
+        !*** finished with this cell: deallocate search array and
+        !*** start on next cell
+
+        deallocate(srch_add, srch_corner_lat, srch_corner_lon)
+
+      end do
+
+      deallocate(srch_mask)
+
+!-----------------------------------------------------------------------
+!
+!     correct for situations where N/S pole not explicitly included in
+!     grid (i.e. as a grid corner point). if pole is missing from only
+!     one grid, need to correct only the area and centroid of that 
+!     grid.  if missing from both, do complete weight calculation.
+!
+!-----------------------------------------------------------------------
+
+      !*** North Pole
+      weights(1) =  pi2
+      weights(2) =  pi*pi
+      weights(3) =  zero
+      weights(4) =  pi2
+      weights(5) =  pi*pi
+      weights(6) =  zero
+
+      grid1_add = 0
+      pole_loop1: do n=1,grid1_size
+        if (grid1_area(n) < -three*pih .and.
+     &      grid1_center_lat(n) > zero) then
+          grid1_add = n
+          exit pole_loop1
+        endif
+      end do pole_loop1
+
+      grid2_add = 0
+      pole_loop2: do n=1,grid2_size
+        if (grid2_area(n) < -three*pih .and.
+     &      grid2_center_lat(n) > zero) then
+          grid2_add = n
+          exit pole_loop2
+        endif
+      end do pole_loop2
+
+      if (grid1_add /=0) then
+        grid1_area(grid1_add) = grid1_area(grid1_add) + weights(1)
+        grid1_centroid_lat(grid1_add) = 
+     &  grid1_centroid_lat(grid1_add) + weights(2)
+        grid1_centroid_lon(grid1_add) =
+     &  grid1_centroid_lon(grid1_add) + weights(3)
+      endif
+
+      if (grid2_add /=0) then
+        grid2_area(grid2_add) = grid2_area(grid2_add) + 
+     &                                  weights(num_wts+1)
+        grid2_centroid_lat(grid2_add) = 
+     &  grid2_centroid_lat(grid2_add) + weights(num_wts+2)
+        grid2_centroid_lon(grid2_add) =
+     &  grid2_centroid_lon(grid2_add) + weights(num_wts+3)
+      endif
+
+      if (grid1_add /= 0 .and. grid2_add /=0) then
+        call store_link_cnsrv(grid1_add, grid2_add, weights)
+
+        grid1_frac(grid1_add) = grid1_frac(grid1_add) + 
+     &                          weights(1)
+        grid2_frac(grid2_add) = grid2_frac(grid2_add) + 
+     &                          weights(num_wts+1)
+      endif
+
+      !*** South Pole
+      weights(1) =  pi2
+      weights(2) = -pi*pi
+      weights(3) =  zero
+      weights(4) =  pi2
+      weights(5) = -pi*pi
+      weights(6) =  zero
+
+      grid1_add = 0
+      pole_loop3: do n=1,grid1_size
+        if (grid1_area(n) < -three*pih .and.
+     &      grid1_center_lat(n) < zero) then
+          grid1_add = n
+          exit pole_loop3
+        endif
+      end do pole_loop3
+
+      grid2_add = 0
+      pole_loop4: do n=1,grid2_size
+        if (grid2_area(n) < -three*pih .and.
+     &      grid2_center_lat(n) < zero) then
+          grid2_add = n
+          exit pole_loop4
+        endif
+      end do pole_loop4
+
+      if (grid1_add /=0) then
+        grid1_area(grid1_add) = grid1_area(grid1_add) + weights(1)
+        grid1_centroid_lat(grid1_add) = 
+     &  grid1_centroid_lat(grid1_add) + weights(2)
+        grid1_centroid_lon(grid1_add) =
+     &  grid1_centroid_lon(grid1_add) + weights(3)
+      endif
+
+      if (grid2_add /=0) then
+        grid2_area(grid2_add) = grid2_area(grid2_add) + 
+     &                                  weights(num_wts+1)
+        grid2_centroid_lat(grid2_add) = 
+     &  grid2_centroid_lat(grid2_add) + weights(num_wts+2)
+        grid2_centroid_lon(grid2_add) =
+     &  grid2_centroid_lon(grid2_add) + weights(num_wts+3)
+      endif
+
+      if (grid1_add /= 0 .and. grid2_add /=0) then
+        call store_link_cnsrv(grid1_add, grid2_add, weights)
+
+        grid1_frac(grid1_add) = grid1_frac(grid1_add) + 
+     &                          weights(1)
+        grid2_frac(grid2_add) = grid2_frac(grid2_add) + 
+     &                          weights(num_wts+1)
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     finish centroid computation
+!
+!-----------------------------------------------------------------------
+
+      where (grid1_area /= zero)
+        grid1_centroid_lat = grid1_centroid_lat/grid1_area
+        grid1_centroid_lon = grid1_centroid_lon/grid1_area
+      end where
+
+      where (grid2_area /= zero)
+        grid2_centroid_lat = grid2_centroid_lat/grid2_area
+        grid2_centroid_lon = grid2_centroid_lon/grid2_area
+      end where
+
+!-----------------------------------------------------------------------
+!
+!     include centroids in weights and normalize using destination
+!     area if requested
+!
+!-----------------------------------------------------------------------
+
+      do n=1,num_links_map1
+        grid1_add = grid1_add_map1(n)
+        grid2_add = grid2_add_map1(n)
+        do nwgt=1,num_wts
+          weights(        nwgt) = wts_map1(nwgt,n)
+          if (num_maps > 1) then
+            weights(num_wts+nwgt) = wts_map2(nwgt,n)
+          endif
+        end do
+
+        select case(norm_opt)
+        case (norm_opt_dstarea)
+          if (grid2_area(grid2_add) /= zero) then
+            if (luse_grid2_area) then
+              norm_factor = one/grid2_area_in(grid2_add)
+            else
+              norm_factor = one/grid2_area(grid2_add)
+            endif
+          else
+            norm_factor = zero
+          endif
+        case (norm_opt_frcarea)
+          if (grid2_frac(grid2_add) /= zero) then
+            if (luse_grid2_area) then
+              norm_factor = grid2_area(grid2_add)/
+     &                     (grid2_frac(grid2_add)*
+     &                      grid2_area_in(grid2_add))
+            else
+              norm_factor = one/grid2_frac(grid2_add)
+            endif
+          else
+            norm_factor = zero
+          endif
+        case (norm_opt_none)
+          norm_factor = one
+        end select
+
+        wts_map1(1,n) =  weights(1)*norm_factor
+        wts_map1(2,n) = (weights(2) - weights(1)*
+     &                              grid1_centroid_lat(grid1_add))*
+     &                              norm_factor
+        wts_map1(3,n) = (weights(3) - weights(1)*
+     &                              grid1_centroid_lon(grid1_add))*
+     &                              norm_factor
+
+        if (num_maps > 1) then
+          select case(norm_opt)
+          case (norm_opt_dstarea)
+            if (grid1_area(grid1_add) /= zero) then
+              if (luse_grid1_area) then
+                norm_factor = one/grid1_area_in(grid1_add)
+              else
+                norm_factor = one/grid1_area(grid1_add)
+              endif
+            else
+              norm_factor = zero
+            endif
+          case (norm_opt_frcarea)
+            if (grid1_frac(grid1_add) /= zero) then
+              if (luse_grid1_area) then
+                norm_factor = grid1_area(grid1_add)/
+     &                       (grid1_frac(grid1_add)*
+     &                        grid1_area_in(grid1_add))
+              else
+                norm_factor = one/grid1_frac(grid1_add)
+              endif
+            else
+              norm_factor = zero
+            endif
+          case (norm_opt_none)
+            norm_factor = one
+          end select
+
+          wts_map2(1,n) =  weights(num_wts+1)*norm_factor
+          wts_map2(2,n) = (weights(num_wts+2) - weights(num_wts+1)*
+     &                                grid2_centroid_lat(grid2_add))*
+     &                                norm_factor
+          wts_map2(3,n) = (weights(num_wts+3) - weights(num_wts+1)*
+     &                                grid2_centroid_lon(grid2_add))*
+     &                                norm_factor
+        endif
+
+      end do
+
+      print *, 'Total number of links = ',num_links_map1
+
+      where (grid1_area /= zero) grid1_frac = grid1_frac/grid1_area
+      where (grid2_area /= zero) grid2_frac = grid2_frac/grid2_area
+
+!-----------------------------------------------------------------------
+!
+!     perform some error checking on final weights
+!
+!-----------------------------------------------------------------------
+
+      grid2_centroid_lat = zero
+      grid2_centroid_lon = zero
+
+      do n=1,grid1_size
+        if (grid1_area(n) < -.01) then
+          print *,'Grid 1 area error: ',n,grid1_area(n)
+        endif
+        if (grid1_centroid_lat(n) < -pih-.01 .or.
+     &      grid1_centroid_lat(n) >  pih+.01) then
+          print *,'Grid 1 centroid lat error: ',n,grid1_centroid_lat(n)
+        endif
+        grid1_centroid_lat(n) = zero
+        grid1_centroid_lon(n) = zero
+      end do
+
+      do n=1,grid2_size
+        if (grid2_area(n) < -.01) then
+          print *,'Grid 2 area error: ',n,grid2_area(n)
+        endif
+        if (grid2_centroid_lat(n) < -pih-.01 .or.
+     &      grid2_centroid_lat(n) >  pih+.01) then
+          print *,'Grid 2 centroid lat error: ',n,grid2_centroid_lat(n)
+        endif
+        grid2_centroid_lat(n) = zero
+        grid2_centroid_lon(n) = zero
+      end do
+
+      do n=1,num_links_map1
+        grid1_add = grid1_add_map1(n)
+        grid2_add = grid2_add_map1(n)
+        
+        if (wts_map1(1,n) < -.01) then
+          print *,'Map 1 weight < 0 ',grid1_add,grid2_add,wts_map1(1,n)
+        endif
+        if (norm_opt /= norm_opt_none .and. wts_map1(1,n) > 1.01) then
+          print *,'Map 1 weight > 1 ',grid1_add,grid2_add,wts_map1(1,n)
+        endif
+        grid2_centroid_lat(grid2_add) = 
+     &  grid2_centroid_lat(grid2_add) + wts_map1(1,n)
+
+        if (num_maps > 1) then
+          if (wts_map2(1,n) < -.01) then
+            print *,'Map 2 weight < 0 ',grid1_add,grid2_add,
+     &                                  wts_map2(1,n)
+          endif
+          if (norm_opt /= norm_opt_none .and. wts_map2(1,n) > 1.01) then
+            print *,'Map 2 weight < 0 ',grid1_add,grid2_add,
+     &                                  wts_map2(1,n)
+          endif
+          grid1_centroid_lat(grid1_add) = 
+     &    grid1_centroid_lat(grid1_add) + wts_map2(1,n)
+        endif
+      end do
+
+      do n=1,grid2_size
+        select case(norm_opt)
+        case (norm_opt_dstarea)
+          norm_factor = grid2_frac(grid2_add)
+        case (norm_opt_frcarea)
+          norm_factor = one
+        case (norm_opt_none)
+          if (luse_grid2_area) then
+            norm_factor = grid2_area_in(grid2_add)
+          else
+            norm_factor = grid2_area(grid2_add)
+          endif
+        end select
+        if (abs(grid2_centroid_lat(grid2_add)-norm_factor) > .01) then
+          print *,'Error: sum of wts for map1 ',grid2_add,
+     &            grid2_centroid_lat(grid2_add),norm_factor
+        endif
+      end do
+
+      if (num_maps > 1) then
+        do n=1,grid1_size
+          select case(norm_opt)
+          case (norm_opt_dstarea)
+            norm_factor = grid1_frac(grid1_add)
+          case (norm_opt_frcarea)
+            norm_factor = one
+          case (norm_opt_none)
+            if (luse_grid1_area) then
+              norm_factor = grid1_area_in(grid1_add)
+            else
+              norm_factor = grid1_area(grid1_add)
+            endif
+          end select
+          if (abs(grid1_centroid_lat(grid1_add)-norm_factor) > .01) then
+            print *,'Error: sum of wts for map2 ',grid1_add,
+     &              grid1_centroid_lat(grid1_add),norm_factor
+          endif
+        end do
+      endif
+!-----------------------------------------------------------------------
+
+      end subroutine remap_conserv
+
+!***********************************************************************
+
+      subroutine intersection(location,intrsct_lat,intrsct_lon,lcoinc,
+     &                        beglat, beglon, endlat, endlon, begseg,
+     &                        lbegin, lrevers)
+
+!-----------------------------------------------------------------------
+!
+!     this routine finds the next intersection of a destination grid 
+!     line with the line segment given by beglon, endlon, etc.
+!     a coincidence flag is returned if the segment is entirely 
+!     coincident with an ocean grid line.  the cells in which to search
+!     for an intersection must have already been restricted in the
+!     calling routine.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     intent(in): 
+!
+!-----------------------------------------------------------------------
+
+      logical (kind=log_kind), intent(in) ::
+     &     lbegin, ! flag for first integration along this segment
+     &     lrevers ! flag whether segment integrated in reverse
+
+      real (kind=dbl_kind), intent(in) :: 
+     &     beglat, beglon,  ! beginning lat/lon endpoints for segment
+     &     endlat, endlon   ! ending    lat/lon endpoints for segment
+
+      real (kind=dbl_kind), dimension(2), intent(inout) :: 
+     &     begseg ! begin lat/lon of full segment
+
+!-----------------------------------------------------------------------
+!
+!     intent(out): 
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(out) ::
+     &        location  ! address in destination array containing this
+                        ! segment
+
+      logical (kind=log_kind), intent(out) ::
+     &        lcoinc    ! flag segments which are entirely coincident
+                        ! with a grid line
+
+      real (kind=dbl_kind), intent(out) ::
+     &     intrsct_lat, intrsct_lon ! lat/lon coords of next intersect.
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, next_n, cell, srch_corners, pole_loc
+
+      integer (kind=int_kind), save :: 
+     &     last_loc  ! save location when crossing threshold
+
+      logical (kind=log_kind) :: 
+     &     loutside  ! flags points outside grid
+
+      logical (kind=log_kind), save :: 
+     &     lthresh = .false.  ! flags segments crossing threshold bndy
+
+      real (kind=dbl_kind) ::
+     &     lon1, lon2,       ! local longitude variables for segment
+     &     lat1, lat2,       ! local latitude  variables for segment
+     &     grdlon1, grdlon2, ! local longitude variables for grid cell
+     &     grdlat1, grdlat2, ! local latitude  variables for grid cell
+     &     vec1_lat, vec1_lon, ! vectors and cross products used
+     &     vec2_lat, vec2_lon, ! during grid search
+     &     cross_product, 
+     &     eps, offset,        ! small offset away from intersect
+     &     s1, s2, determ,     ! variables used for linear solve to
+     &     mat1, mat2, mat3, mat4, rhs1, rhs2  ! find intersection
+
+      real (kind=dbl_kind), save ::
+     &     intrsct_lat_off, intrsct_lon_off ! lat/lon coords offset 
+                                            ! for next search
+
+!-----------------------------------------------------------------------
+!
+!     initialize defaults, flags, etc.
+!
+!-----------------------------------------------------------------------
+
+      location = 0
+      lcoinc = .false.
+      intrsct_lat = endlat
+      intrsct_lon = endlon
+
+      if (num_srch_cells == 0) return
+
+      if (beglat > north_thresh .or. beglat < south_thresh) then
+
+        if (lthresh) location = last_loc
+        call pole_intersection(location,
+     &               intrsct_lat,intrsct_lon,lcoinc,lthresh,
+     &               beglat, beglon, endlat, endlon, begseg, lrevers)
+        if (lthresh) then
+          last_loc = location
+          intrsct_lat_off = intrsct_lat
+          intrsct_lon_off = intrsct_lon
+        endif
+        return
+
+      endif
+
+      loutside = .false.
+      if (lbegin) then
+        lat1 = beglat
+        lon1 = beglon
+      else
+        lat1 = intrsct_lat_off
+        lon1 = intrsct_lon_off
+      endif
+      lat2 = endlat
+      lon2 = endlon
+      if ((lon2-lon1) > three*pih) then
+        lon2 = lon2 - pi2
+      else if ((lon2-lon1) < -three*pih) then
+        lon2 = lon2 + pi2
+      endif
+      s1 = zero
+
+!-----------------------------------------------------------------------
+!
+!     search for location of this segment in ocean grid using cross
+!     product method to determine whether a point is enclosed by a cell
+!
+!-----------------------------------------------------------------------
+
+      call timer_start(12)
+      srch_corners = size(srch_corner_lat,DIM=1)
+      srch_loop: do
+
+        !***
+        !*** if last segment crossed threshold, use that location
+        !***
+
+        if (lthresh) then
+          do cell=1,num_srch_cells
+            if (srch_add(cell) == last_loc) then
+              location = last_loc
+              eps = tiny
+              exit srch_loop
+            endif
+          end do
+        endif
+
+        !***
+        !*** otherwise normal search algorithm
+        !***
+
+        cell_loop: do cell=1,num_srch_cells
+          corner_loop: do n=1,srch_corners
+            next_n = MOD(n,srch_corners) + 1
+
+            !***
+            !*** here we take the cross product of the vector making 
+            !*** up each cell side with the vector formed by the vertex
+            !*** and search point.  if all the cross products are 
+            !*** positive, the point is contained in the cell.
+            !***
+
+            vec1_lat = srch_corner_lat(next_n,cell) - 
+     &                 srch_corner_lat(n     ,cell)
+            vec1_lon = srch_corner_lon(next_n,cell) - 
+     &                 srch_corner_lon(n     ,cell)
+            vec2_lat = lat1 - srch_corner_lat(n,cell)
+            vec2_lon = lon1 - srch_corner_lon(n,cell)
+
+            !***
+            !*** if endpoint coincident with vertex, offset
+            !*** the endpoint
+            !***
+
+            if (vec2_lat == 0 .and. vec2_lon == 0) then
+              lat1 = lat1 + 1.d-10*(lat2-lat1)
+              lon1 = lon1 + 1.d-10*(lon2-lon1)
+              vec2_lat = lat1 - srch_corner_lat(n,cell)
+              vec2_lon = lon1 - srch_corner_lon(n,cell)
+            endif
+
+            !***
+            !*** check for 0,2pi crossings
+            !***
+
+            if (vec1_lon >  pi) then
+              vec1_lon = vec1_lon - pi2
+            else if (vec1_lon < -pi) then
+              vec1_lon = vec1_lon + pi2
+            endif
+            if (vec2_lon >  pi) then
+              vec2_lon = vec2_lon - pi2
+            else if (vec2_lon < -pi) then
+              vec2_lon = vec2_lon + pi2
+            endif
+
+            cross_product = vec1_lon*vec2_lat - vec2_lon*vec1_lat
+
+            !***
+            !*** if the cross product for a side is zero, the point 
+            !***   lies exactly on the side or the side is degenerate
+            !***   (zero length).  if degenerate, set the cross 
+            !***   product to a positive number.  otherwise perform 
+            !***   another cross product between the side and the 
+            !***   segment itself. 
+            !*** if this cross product is also zero, the line is 
+            !***   coincident with the cell boundary - perform the 
+            !***   dot product and only choose the cell if the dot 
+            !***   product is positive (parallel vs anti-parallel).
+            !***
+
+            if (cross_product == zero) then
+              if (vec1_lat /= zero .or. vec1_lon /= zero) then
+                vec2_lat = lat2 - lat1
+                vec2_lon = lon2 - lon1
+
+                if (vec2_lon >  pi) then
+                  vec2_lon = vec2_lon - pi2
+                else if (vec2_lon < -pi) then
+                  vec2_lon = vec2_lon + pi2
+                endif
+
+                cross_product = vec1_lon*vec2_lat - vec2_lon*vec1_lat
+              else
+                cross_product = one
+              endif
+
+              if (cross_product == zero) then
+                lcoinc = .true.
+                cross_product = vec1_lon*vec2_lon + vec1_lat*vec2_lat
+                if (lrevers) cross_product = -cross_product
+              endif
+            endif
+
+            !***
+            !*** if cross product is less than zero, this cell
+            !*** doesn't work
+            !***
+
+            if (cross_product < zero) exit corner_loop
+
+          end do corner_loop
+
+          !***
+          !*** if cross products all positive, we found the location
+          !***
+
+          if (n > srch_corners) then
+            location = srch_add(cell)
+
+            !***
+            !*** if the beginning of this segment was outside the
+            !*** grid, invert the segment so the intersection found
+            !*** will be the first intersection with the grid
+            !***
+
+            if (loutside) then
+              lat2 = beglat
+              lon2 = beglon
+              location = 0
+              eps  = -tiny
+            else
+              eps  = tiny
+            endif
+
+            exit srch_loop
+          endif
+
+          !***
+          !*** otherwise move on to next cell
+          !***
+
+        end do cell_loop
+
+        !***
+        !*** if still no cell found, the point lies outside the grid.
+        !***   take some baby steps along the segment to see if any
+        !***   part of the segment lies inside the grid.  
+        !***
+
+        loutside = .true.
+        s1 = s1 + 0.001_dbl_kind
+        lat1 = beglat + s1*(endlat - beglat)
+        lon1 = beglon + s1*(lon2   - beglon)
+
+        !***
+        !*** reached the end of the segment and still outside the grid
+        !*** return no intersection
+        !***
+
+        if (s1 >= one) return
+
+      end do srch_loop
+      call timer_stop(12)
+
+!-----------------------------------------------------------------------
+!
+!     now that a cell is found, search for the next intersection.
+!     loop over sides of the cell to find intersection with side
+!     must check all sides for coincidences or intersections
+!
+!-----------------------------------------------------------------------
+
+      call timer_start(13)
+      intrsct_loop: do n=1,srch_corners
+        next_n = mod(n,srch_corners) + 1
+
+        grdlon1 = srch_corner_lon(n     ,cell)
+        grdlon2 = srch_corner_lon(next_n,cell)
+        grdlat1 = srch_corner_lat(n     ,cell)
+        grdlat2 = srch_corner_lat(next_n,cell)
+
+        !***
+        !*** set up linear system to solve for intersection
+        !***
+
+        mat1 = lat2 - lat1
+        mat2 = grdlat1 - grdlat2
+        mat3 = lon2 - lon1
+        mat4 = grdlon1 - grdlon2
+        rhs1 = grdlat1 - lat1
+        rhs2 = grdlon1 - lon1
+
+        if (mat3 >  pi) then
+          mat3 = mat3 - pi2
+        else if (mat3 < -pi) then
+          mat3 = mat3 + pi2
+        endif
+        if (mat4 >  pi) then
+          mat4 = mat4 - pi2
+        else if (mat4 < -pi) then
+          mat4 = mat4 + pi2
+        endif
+        if (rhs2 >  pi) then
+          rhs2 = rhs2 - pi2
+        else if (rhs2 < -pi) then
+          rhs2 = rhs2 + pi2
+        endif
+
+        determ = mat1*mat4 - mat2*mat3
+
+        !***
+        !*** if the determinant is zero, the segments are either 
+        !***   parallel or coincident.  coincidences were detected 
+        !***   above so do nothing.
+        !*** if the determinant is non-zero, solve for the linear 
+        !***   parameters s for the intersection point on each line 
+        !***   segment.
+        !*** if 0<s1,s2<1 then the segment intersects with this side.
+        !***   return the point of intersection (adding a small
+        !***   number so the intersection is off the grid line).
+        !***
+
+        if (abs(determ) > 1.e-30) then
+
+          s1 = (rhs1*mat4 - mat2*rhs2)/determ
+          s2 = (mat1*rhs2 - rhs1*mat3)/determ
+
+          if (s2 >= zero .and. s2 <= one .and.
+     &        s1 >  zero. and. s1 <= one) then
+
+            !***
+            !*** recompute intersection based on full segment
+            !*** so intersections are consistent for both sweeps
+            !***
+
+            if (.not. loutside) then
+              mat1 = lat2 - begseg(1)
+              mat3 = lon2 - begseg(2)
+              rhs1 = grdlat1 - begseg(1)
+              rhs2 = grdlon1 - begseg(2)
+            else
+              mat1 = begseg(1) - endlat
+              mat3 = begseg(2) - endlon
+              rhs1 = grdlat1 - endlat
+              rhs2 = grdlon1 - endlon
+            endif
+
+            if (mat3 >  pi) then
+              mat3 = mat3 - pi2
+            else if (mat3 < -pi) then
+              mat3 = mat3 + pi2
+            endif
+            if (rhs2 >  pi) then
+              rhs2 = rhs2 - pi2
+            else if (rhs2 < -pi) then
+              rhs2 = rhs2 + pi2
+            endif
+
+            determ = mat1*mat4 - mat2*mat3
+
+            !***
+            !*** sometimes due to roundoff, the previous 
+            !*** determinant is non-zero, but the lines
+            !*** are actually coincident.  if this is the
+            !*** case, skip the rest.
+            !***
+
+            if (determ /= zero) then
+              s1 = (rhs1*mat4 - mat2*rhs2)/determ
+              s2 = (mat1*rhs2 - rhs1*mat3)/determ
+
+              offset = s1 + eps/determ
+              if (offset > one) offset = one
+
+              if (.not. loutside) then
+                intrsct_lat = begseg(1) + mat1*s1
+                intrsct_lon = begseg(2) + mat3*s1
+                intrsct_lat_off = begseg(1) + mat1*offset
+                intrsct_lon_off = begseg(2) + mat3*offset
+              else
+                intrsct_lat = endlat + mat1*s1
+                intrsct_lon = endlon + mat3*s1
+                intrsct_lat_off = endlat + mat1*offset
+                intrsct_lon_off = endlon + mat3*offset
+              endif
+              exit intrsct_loop
+            endif
+
+          endif
+        endif
+
+        !***
+        !*** no intersection this side, move on to next side
+        !***
+
+      end do intrsct_loop
+      call timer_stop(13)
+
+!-----------------------------------------------------------------------
+!
+!     if the segment crosses a pole threshold, reset the intersection
+!     to be the threshold latitude.  only check if this was not a
+!     threshold segment since sometimes coordinate transform can end
+!     up on other side of threshold again.
+!
+!-----------------------------------------------------------------------
+
+      if (lthresh) then
+        if (intrsct_lat < north_thresh .or. intrsct_lat > south_thresh)
+     &      lthresh = .false.
+      else if (lat1 > zero .and. intrsct_lat > north_thresh) then
+        intrsct_lat = north_thresh + tiny
+        intrsct_lat_off = north_thresh + eps*mat1
+        s1 = (intrsct_lat - begseg(1))/mat1
+        intrsct_lon     = begseg(2) + s1*mat3
+        intrsct_lon_off = begseg(2) + (s1+eps)*mat3
+        last_loc = location
+        lthresh = .true.
+      else if (lat1 < zero .and. intrsct_lat < south_thresh) then
+        intrsct_lat = south_thresh - tiny
+        intrsct_lat_off = south_thresh + eps*mat1
+        s1 = (intrsct_lat - begseg(1))/mat1
+        intrsct_lon     = begseg(2) + s1*mat3
+        intrsct_lon_off = begseg(2) + (s1+eps)*mat3
+        last_loc = location
+        lthresh = .true.
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine intersection
+
+!***********************************************************************
+
+      subroutine pole_intersection(location,
+     &                 intrsct_lat,intrsct_lon,lcoinc,lthresh,
+     &                 beglat, beglon, endlat, endlon, begseg, lrevers)
+
+!-----------------------------------------------------------------------
+!
+!     this routine is identical to the intersection routine except
+!     that a coordinate transformation (using a Lambert azimuthal
+!     equivalent projection) is performed to treat polar cells more
+!     accurately.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     intent(in): 
+!
+!-----------------------------------------------------------------------
+
+      real (kind=dbl_kind), intent(in) :: 
+     &     beglat, beglon,  ! beginning lat/lon endpoints for segment
+     &     endlat, endlon   ! ending    lat/lon endpoints for segment
+
+      real (kind=dbl_kind), dimension(2), intent(inout) :: 
+     &     begseg ! begin lat/lon of full segment
+
+      logical (kind=log_kind), intent(in) ::
+     &        lrevers   ! flag true if segment integrated in reverse
+
+!-----------------------------------------------------------------------
+!
+!     intent(out): 
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(inout) ::
+     &        location  ! address in destination array containing this
+                        ! segment -- also may contain last location on
+                        ! entry
+
+      logical (kind=log_kind), intent(out) ::
+     &        lcoinc    ! flag segment coincident with grid line
+
+      logical (kind=log_kind), intent(inout) ::
+     &        lthresh   ! flag segment crossing threshold boundary
+
+      real (kind=dbl_kind), intent(out) ::
+     &     intrsct_lat, intrsct_lon ! lat/lon coords of next intersect.
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, next_n, cell, srch_corners, pole_loc
+
+      logical (kind=log_kind) :: loutside ! flags points outside grid
+
+      real (kind=dbl_kind) :: pi4, rns, ! north/south conversion
+     &     x1, x2,       ! local x variables for segment
+     &     y1, y2,       ! local y variables for segment
+     &     begx, begy,   ! beginning x,y variables for segment
+     &     endx, endy,   ! beginning x,y variables for segment
+     &     begsegx, begsegy,   ! beginning x,y variables for segment
+     &     grdx1, grdx2, ! local x variables for grid cell
+     &     grdy1, grdy2, ! local y variables for grid cell
+     &     vec1_y, vec1_x, ! vectors and cross products used
+     &     vec2_y, vec2_x, ! during grid search
+     &     cross_product, eps, ! eps=small offset away from intersect
+     &     s1, s2, determ,     ! variables used for linear solve to
+     &     mat1, mat2, mat3, mat4, rhs1, rhs2  ! find intersection
+
+      real (kind=dbl_kind), dimension(:,:), allocatable ::
+     &     srch_corner_x,  ! x of each corner of srch cells
+     &     srch_corner_y   ! y of each corner of srch cells
+
+      !***
+      !*** save last intersection to avoid roundoff during coord
+      !*** transformation
+      !***
+
+      logical (kind=log_kind), save :: luse_last = .false.
+
+      real (kind=dbl_kind), save :: 
+     &     intrsct_x, intrsct_y  ! x,y for intersection
+
+      !***
+      !*** variables necessary if segment manages to hit pole
+      !***
+
+      integer (kind=int_kind), save :: 
+     &     avoid_pole_count = 0  ! count attempts to avoid pole
+
+      real (kind=dbl_kind), save :: 
+     &     avoid_pole_offset = tiny  ! endpoint offset to avoid pole
+
+!-----------------------------------------------------------------------
+!
+!     initialize defaults, flags, etc.
+!
+!-----------------------------------------------------------------------
+
+      if (.not. lthresh) location = 0
+      lcoinc = .false.
+      intrsct_lat = endlat
+      intrsct_lon = endlon
+
+      loutside = .false.
+      s1 = zero
+
+!-----------------------------------------------------------------------
+!
+!     convert coordinates
+!
+!-----------------------------------------------------------------------
+
+      allocate(srch_corner_x(size(srch_corner_lat,DIM=1),
+     &                       size(srch_corner_lat,DIM=2)),
+     &         srch_corner_y(size(srch_corner_lat,DIM=1),
+     &                       size(srch_corner_lat,DIM=2)))
+
+      if (beglat > zero) then
+        pi4 = quart*pi
+        rns = one
+      else
+        pi4 = -quart*pi
+        rns = -one
+      endif
+
+      if (luse_last) then
+        x1 = intrsct_x
+        y1 = intrsct_y
+      else
+        x1 = rns*two*sin(pi4 - half*beglat)*cos(beglon)
+        y1 =     two*sin(pi4 - half*beglat)*sin(beglon)
+        luse_last = .true.
+      endif
+      x2 = rns*two*sin(pi4 - half*endlat)*cos(endlon)
+      y2 =     two*sin(pi4 - half*endlat)*sin(endlon)
+      srch_corner_x = rns*two*sin(pi4 - half*srch_corner_lat)*
+     &                        cos(srch_corner_lon)
+      srch_corner_y =     two*sin(pi4 - half*srch_corner_lat)*
+     &                        sin(srch_corner_lon)
+
+      begx = x1
+      begy = y1
+      endx = x2
+      endy = y2
+      begsegx = rns*two*sin(pi4 - half*begseg(1))*cos(begseg(2))
+      begsegy =     two*sin(pi4 - half*begseg(1))*sin(begseg(2))
+      intrsct_x = endx
+      intrsct_y = endy
+
+!-----------------------------------------------------------------------
+!
+!     search for location of this segment in ocean grid using cross
+!     product method to determine whether a point is enclosed by a cell
+!
+!-----------------------------------------------------------------------
+
+      call timer_start(12)
+      srch_corners = size(srch_corner_lat,DIM=1)
+      srch_loop: do
+
+        !***
+        !*** if last segment crossed threshold, use that location
+        !***
+
+        if (lthresh) then
+          do cell=1,num_srch_cells
+            if (srch_add(cell) == location) then
+              eps = tiny
+              exit srch_loop
+            endif
+          end do
+        endif
+
+        !***
+        !*** otherwise normal search algorithm
+        !***
+
+        cell_loop: do cell=1,num_srch_cells
+          corner_loop: do n=1,srch_corners
+            next_n = MOD(n,srch_corners) + 1
+
+            !***
+            !*** here we take the cross product of the vector making 
+            !*** up each cell side with the vector formed by the vertex
+            !*** and search point.  if all the cross products are 
+            !*** positive, the point is contained in the cell.
+            !***
+
+            vec1_x = srch_corner_x(next_n,cell) - 
+     &               srch_corner_x(n     ,cell)
+            vec1_y = srch_corner_y(next_n,cell) - 
+     &               srch_corner_y(n     ,cell)
+            vec2_x = x1 - srch_corner_x(n,cell)
+            vec2_y = y1 - srch_corner_y(n,cell)
+
+            !***
+            !*** if endpoint coincident with vertex, offset
+            !*** the endpoint
+            !***
+
+            if (vec2_x == 0 .and. vec2_y == 0) then
+              x1 = x1 + 1.d-10*(x2-x1)
+              y1 = y1 + 1.d-10*(y2-y1)
+              vec2_x = x1 - srch_corner_x(n,cell)
+              vec2_y = y1 - srch_corner_y(n,cell)
+            endif
+
+            cross_product = vec1_x*vec2_y - vec2_x*vec1_y
+
+            !***
+            !*** if the cross product for a side is zero, the point 
+            !***   lies exactly on the side or the length of a side
+            !***   is zero.  if the length is zero set det > 0.
+            !***   otherwise, perform another cross 
+            !***   product between the side and the segment itself. 
+            !*** if this cross product is also zero, the line is 
+            !***   coincident with the cell boundary - perform the 
+            !***   dot product and only choose the cell if the dot 
+            !***   product is positive (parallel vs anti-parallel).
+            !***
+
+            if (cross_product == zero) then
+              if (vec1_x /= zero .or. vec1_y /= 0) then
+                vec2_x = x2 - x1
+                vec2_y = y2 - y1
+                cross_product = vec1_x*vec2_y - vec2_x*vec1_y
+              else
+                cross_product = one
+              endif
+
+              if (cross_product == zero) then
+                lcoinc = .true.
+                cross_product = vec1_x*vec2_x + vec1_y*vec2_y
+                if (lrevers) cross_product = -cross_product
+              endif
+            endif
+
+            !***
+            !*** if cross product is less than zero, this cell
+            !*** doesn't work
+            !***
+
+            if (cross_product < zero) exit corner_loop
+
+          end do corner_loop
+
+          !***
+          !*** if cross products all positive, we found the location
+          !***
+
+          if (n > srch_corners) then
+            location = srch_add(cell)
+
+            !***
+            !*** if the beginning of this segment was outside the
+            !*** grid, invert the segment so the intersection found
+            !*** will be the first intersection with the grid
+            !***
+
+            if (loutside) then
+              x2 = begx
+              y2 = begy
+              location = 0
+              eps  = -tiny
+            else
+              eps  = tiny
+            endif
+
+            exit srch_loop
+          endif
+
+          !***
+          !*** otherwise move on to next cell
+          !***
+
+        end do cell_loop
+
+        !***
+        !*** if no cell found, the point lies outside the grid.
+        !***   take some baby steps along the segment to see if any
+        !***   part of the segment lies inside the grid.  
+        !***
+
+        loutside = .true.
+        s1 = s1 + 0.001_dbl_kind
+        x1 = begx + s1*(x2 - begx)
+        y1 = begy + s1*(y2 - begy)
+
+        !***
+        !*** reached the end of the segment and still outside the grid
+        !*** return no intersection
+        !***
+
+        if (s1 >= one) then
+          deallocate(srch_corner_x, srch_corner_y)
+          luse_last = .false.
+          return
+        endif
+
+      end do srch_loop
+      call timer_stop(12)
+
+!-----------------------------------------------------------------------
+!
+!     now that a cell is found, search for the next intersection.
+!     loop over sides of the cell to find intersection with side
+!     must check all sides for coincidences or intersections
+!
+!-----------------------------------------------------------------------
+
+      call timer_start(13)
+      intrsct_loop: do n=1,srch_corners
+        next_n = mod(n,srch_corners) + 1
+
+        grdy1 = srch_corner_y(n     ,cell)
+        grdy2 = srch_corner_y(next_n,cell)
+        grdx1 = srch_corner_x(n     ,cell)
+        grdx2 = srch_corner_x(next_n,cell)
+
+        !***
+        !*** set up linear system to solve for intersection
+        !***
+
+        mat1 = x2 - x1
+        mat2 = grdx1 - grdx2
+        mat3 = y2 - y1
+        mat4 = grdy1 - grdy2
+        rhs1 = grdx1 - x1
+        rhs2 = grdy1 - y1
+
+        determ = mat1*mat4 - mat2*mat3
+
+        !***
+        !*** if the determinant is zero, the segments are either 
+        !***   parallel or coincident or one segment has zero length.  
+        !***   coincidences were detected above so do nothing.
+        !*** if the determinant is non-zero, solve for the linear 
+        !***   parameters s for the intersection point on each line 
+        !***   segment.
+        !*** if 0<s1,s2<1 then the segment intersects with this side.
+        !***   return the point of intersection (adding a small
+        !***   number so the intersection is off the grid line).
+        !***
+
+        if (abs(determ) > 1.e-30) then
+
+          s1 = (rhs1*mat4 - mat2*rhs2)/determ
+          s2 = (mat1*rhs2 - rhs1*mat3)/determ
+
+          if (s2 >= zero .and. s2 <= one .and.
+     &        s1 >  zero. and. s1 <= one) then
+
+            !***
+            !*** recompute intersection using entire segment
+            !*** for consistency between sweeps
+            !***
+
+            if (.not. loutside) then
+              mat1 = x2 - begsegx
+              mat3 = y2 - begsegy
+              rhs1 = grdx1 - begsegx
+              rhs2 = grdy1 - begsegy
+            else 
+              mat1 = x2 - endx
+              mat3 = y2 - endy
+              rhs1 = grdx1 - endx
+              rhs2 = grdy1 - endy
+            endif
+
+            determ = mat1*mat4 - mat2*mat3
+
+            !***
+            !*** sometimes due to roundoff, the previous 
+            !*** determinant is non-zero, but the lines
+            !*** are actually coincident.  if this is the
+            !*** case, skip the rest.
+            !***
+
+            if (determ /= zero) then
+              s1 = (rhs1*mat4 - mat2*rhs2)/determ
+              s2 = (mat1*rhs2 - rhs1*mat3)/determ
+
+              if (.not. loutside) then
+                intrsct_x = begsegx + s1*mat1
+                intrsct_y = begsegy + s1*mat3
+              else 
+                intrsct_x = endx + s1*mat1
+                intrsct_y = endy + s1*mat3
+              endif
+
+              !***
+              !*** convert back to lat/lon coordinates
+              !***
+
+              intrsct_lon = rns*atan2(intrsct_y,intrsct_x)
+              if (intrsct_lon < zero) 
+     &          intrsct_lon = intrsct_lon + pi2
+
+              if (abs(intrsct_x) > 1.d-10) then
+                intrsct_lat = (pi4 - 
+     &            asin(rns*half*intrsct_x/cos(intrsct_lon)))*two
+              else if (abs(intrsct_y) > 1.d-10) then
+                intrsct_lat = (pi4 - 
+     &            asin(half*intrsct_y/sin(intrsct_lon)))*two
+              else
+                intrsct_lat = two*pi4
+              endif
+
+              !***
+              !*** add offset in transformed space for next pass.
+              !***
+
+              if (s1 - eps/determ < one) then
+                intrsct_x = intrsct_x - mat1*(eps/determ)
+                intrsct_y = intrsct_y - mat3*(eps/determ)
+              else
+                if (.not. loutside) then
+                  intrsct_x = endx
+                  intrsct_y = endy
+                  intrsct_lat = endlat
+                  intrsct_lon = endlon
+                else 
+                  intrsct_x = begsegx
+                  intrsct_y = begsegy
+                  intrsct_lat = begseg(1)
+                  intrsct_lon = begseg(2)
+                endif
+              endif
+
+              exit intrsct_loop
+            endif
+          endif
+        endif
+
+        !***
+        !*** no intersection this side, move on to next side
+        !***
+
+      end do intrsct_loop
+      call timer_stop(13)
+
+      deallocate(srch_corner_x, srch_corner_y)
+
+!-----------------------------------------------------------------------
+!
+!     if segment manages to cross over pole, shift the beginning 
+!     endpoint in order to avoid hitting pole directly
+!     (it is ok for endpoint to be pole point)
+!
+!-----------------------------------------------------------------------
+
+      if (abs(intrsct_x) < 1.e-10 .and. abs(intrsct_y) < 1.e-10 .and.
+     &    (endx /= zero .and. endy /=0)) then
+        if (avoid_pole_count > 2) then
+           avoid_pole_count = 0
+           avoid_pole_offset = 10.*avoid_pole_offset
+        endif
+
+        cross_product = begsegx*(endy-begsegy) - begsegy*(endx-begsegx)
+        intrsct_lat = begseg(1)
+        if (cross_product*intrsct_lat > zero) then
+          intrsct_lon = beglon    + avoid_pole_offset
+          begseg(2)   = begseg(2) + avoid_pole_offset
+        else
+          intrsct_lon = beglon    - avoid_pole_offset
+          begseg(2)   = begseg(2) - avoid_pole_offset
+        endif
+
+        avoid_pole_count = avoid_pole_count + 1
+        luse_last = .false.
+      else
+        avoid_pole_count = 0
+        avoid_pole_offset = tiny
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     if the segment crosses a pole threshold, reset the intersection
+!     to be the threshold latitude and do not reuse x,y intersect
+!     on next entry.  only check if did not cross threshold last
+!     time - sometimes the coordinate transformation can place a
+!     segment on the other side of the threshold again
+!
+!-----------------------------------------------------------------------
+
+      if (lthresh) then
+        if (intrsct_lat > north_thresh .or. intrsct_lat < south_thresh)
+     &    lthresh = .false.
+      else if (beglat > zero .and. intrsct_lat < north_thresh) then
+        mat4 = endlat - begseg(1)
+        mat3 = endlon - begseg(2)
+        if (mat3 >  pi) mat3 = mat3 - pi2
+        if (mat3 < -pi) mat3 = mat3 + pi2
+        intrsct_lat = north_thresh - tiny
+        s1 = (north_thresh - begseg(1))/mat4
+        intrsct_lon = begseg(2) + s1*mat3
+        luse_last = .false.
+        lthresh = .true.
+      else if (beglat < zero .and. intrsct_lat > south_thresh) then
+        mat4 = endlat - begseg(1)
+        mat3 = endlon - begseg(2)
+        if (mat3 >  pi) mat3 = mat3 - pi2
+        if (mat3 < -pi) mat3 = mat3 + pi2
+        intrsct_lat = south_thresh + tiny
+        s1 = (south_thresh - begseg(1))/mat4
+        intrsct_lon = begseg(2) + s1*mat3
+        luse_last = .false.
+        lthresh = .true.
+      endif
+
+      !***
+      !*** if reached end of segment, do not use x,y intersect 
+      !*** on next entry
+      !***
+
+      if (intrsct_lat == endlat .and. intrsct_lon == endlon) then
+        luse_last = .false.
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine pole_intersection
+
+!***********************************************************************
+
+      subroutine line_integral(weights, num_wts, 
+     &                       in_phi1, in_phi2, theta1, theta2,
+     &                       grid1_lat, grid1_lon, grid2_lat, grid2_lon)
+
+!-----------------------------------------------------------------------
+!
+!     this routine computes the line integral of the flux function 
+!     that results in the interpolation weights.  the line is defined
+!     by the input lat/lon of the endpoints.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     intent(in):
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::
+     &        num_wts  ! number of weights to compute
+
+      real (kind=dbl_kind), intent(in) :: 
+     &     in_phi1, in_phi2,     ! longitude endpoints for the segment
+     &     theta1, theta2,       ! latitude  endpoints for the segment
+     &     grid1_lat, grid1_lon, ! reference coordinates for each
+     &     grid2_lat, grid2_lon  ! grid (to ensure correct 0,2pi interv.
+
+!-----------------------------------------------------------------------
+!
+!     intent(out):
+!
+!-----------------------------------------------------------------------
+
+      real (kind=dbl_kind), dimension(2*num_wts), intent(out) ::
+     &     weights   ! line integral contribution to weights
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      real (kind=dbl_kind) :: dphi, sinth1, sinth2, costh1, costh2, fac,
+     &                        phi1, phi2, phidiff1, phidiff2, sinint
+      real (kind=dbl_kind) :: f1, f2, fint
+
+!-----------------------------------------------------------------------
+!
+!     weights for the general case based on a trapezoidal approx to
+!     the integrals.
+!
+!-----------------------------------------------------------------------
+
+      sinth1 = SIN(theta1)
+      sinth2 = SIN(theta2)
+      costh1 = COS(theta1)
+      costh2 = COS(theta2)
+
+      dphi = in_phi1 - in_phi2
+      if (dphi >  pi) then
+        dphi = dphi - pi2
+      else if (dphi < -pi) then
+        dphi = dphi + pi2
+      endif
+      dphi = half*dphi
+
+!-----------------------------------------------------------------------
+!
+!     the first weight is the area overlap integral. the second and
+!     fourth are second-order latitude gradient weights.
+!
+!-----------------------------------------------------------------------
+
+      weights(        1) = dphi*(sinth1 + sinth2)
+      weights(num_wts+1) = dphi*(sinth1 + sinth2)
+      weights(        2) = dphi*(costh1 + costh2 + (theta1*sinth1 +
+     &                                              theta2*sinth2))
+      weights(num_wts+2) = dphi*(costh1 + costh2 + (theta1*sinth1 +
+     &                                              theta2*sinth2))
+
+!-----------------------------------------------------------------------
+!
+!     the third and fifth weights are for the second-order phi gradient
+!     component.  must be careful of longitude range.
+!
+!-----------------------------------------------------------------------
+
+      f1 = half*(costh1*sinth1 + theta1)
+      f2 = half*(costh2*sinth2 + theta2)
+
+      phi1 = in_phi1 - grid1_lon
+      if (phi1 >  pi) then
+        phi1 = phi1 - pi2
+      else if (phi1 < -pi) then
+        phi1 = phi1 + pi2
+      endif
+
+      phi2 = in_phi2 - grid1_lon
+      if (phi2 >  pi) then
+        phi2 = phi2 - pi2
+      else if (phi2 < -pi) then
+        phi2 = phi2 + pi2
+      endif
+
+      if ((phi2-phi1) <  pi .and. (phi2-phi1) > -pi) then
+        weights(3) = dphi*(phi1*f1 + phi2*f2)
+      else
+        if (phi1 > zero) then
+          fac = pi
+        else
+          fac = -pi
+        endif
+        fint = f1 + (f2-f1)*(fac-phi1)/abs(dphi)
+        weights(3) = half*phi1*(phi1-fac)*f1 -
+     &               half*phi2*(phi2+fac)*f2 +
+     &               half*fac*(phi1+phi2)*fint
+      endif
+
+      phi1 = in_phi1 - grid2_lon
+      if (phi1 >  pi) then
+        phi1 = phi1 - pi2
+      else if (phi1 < -pi) then
+        phi1 = phi1 + pi2
+      endif
+
+      phi2 = in_phi2 - grid2_lon
+      if (phi2 >  pi) then
+        phi2 = phi2 - pi2
+      else if (phi2 < -pi) then
+        phi2 = phi2 + pi2
+      endif
+
+      if ((phi2-phi1) <  pi .and. (phi2-phi1) > -pi) then
+        weights(num_wts+3) = dphi*(phi1*f1 + phi2*f2)
+      else
+        if (phi1 > zero) then
+          fac = pi
+        else
+          fac = -pi
+        endif
+        fint = f1 + (f2-f1)*(fac-phi1)/abs(dphi)
+        weights(num_wts+3) = half*phi1*(phi1-fac)*f1 -
+     &                       half*phi2*(phi2+fac)*f2 +
+     &                       half*fac*(phi1+phi2)*fint
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine line_integral
+
+!***********************************************************************
+
+      subroutine store_link_cnsrv(add1, add2, weights)
+
+!-----------------------------------------------------------------------
+!
+!     this routine stores the address and weight for this link in
+!     the appropriate address and weight arrays and resizes those
+!     arrays if necessary.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::
+     &        add1,  ! address on grid1
+     &        add2   ! address on grid2
+
+      real (kind=dbl_kind), dimension(:), intent(in) ::
+     &        weights ! array of remapping weights for this link
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: nlink, min_link, max_link ! link index
+
+      integer (kind=int_kind), dimension(:,:), allocatable, save ::
+     &        link_add1,  ! min,max link add to restrict search
+     &        link_add2   ! min,max link add to restrict search
+
+      logical (kind=log_kind), save :: first_call = .true.
+
+!-----------------------------------------------------------------------
+!
+!     if all weights are zero, do not bother storing the link
+!
+!-----------------------------------------------------------------------
+
+      if (all(weights == zero)) return
+
+!-----------------------------------------------------------------------
+!
+!     restrict the range of links to search for existing links
+!
+!-----------------------------------------------------------------------
+
+      if (first_call) then
+        allocate(link_add1(2,grid1_size), link_add2(2,grid2_size))
+        link_add1 = 0
+        link_add2 = 0
+        first_call = .false.
+        min_link = 1
+        max_link = 0
+      else
+        min_link = min(link_add1(1,add1),link_add2(1,add2))
+        max_link = max(link_add1(2,add1),link_add2(2,add2))
+        if (min_link == 0) then
+          min_link = 1
+          max_link = 0
+        endif
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     if the link already exists, add the weight to the current weight
+!     arrays
+!
+!-----------------------------------------------------------------------
+
+      do nlink=min_link,max_link
+        if (add1 == grid1_add_map1(nlink)) then
+        if (add2 == grid2_add_map1(nlink)) then
+
+          wts_map1(:,nlink) = wts_map1(:,nlink) + weights(1:num_wts)
+          if (num_maps == 2) then
+            wts_map2(:,nlink) = wts_map2(:,nlink) + 
+     &                                  weights(num_wts+1:2*num_wts)
+          endif
+          return
+
+        endif
+        endif
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     if the link does not yet exist, increment number of links and 
+!     check to see if remap arrays need to be increased to accomodate 
+!     the new link.  then store the link.
+!
+!-----------------------------------------------------------------------
+
+      num_links_map1  = num_links_map1 + 1
+      if (num_links_map1 > max_links_map1) 
+     &   call resize_remap_vars(1,resize_increment)
+
+      grid1_add_map1(num_links_map1) = add1
+      grid2_add_map1(num_links_map1) = add2
+      wts_map1    (:,num_links_map1) = weights(1:num_wts)
+
+      if (num_maps > 1) then
+        num_links_map2  = num_links_map2 + 1
+        if (num_links_map2 > max_links_map2) 
+     &     call resize_remap_vars(2,resize_increment)
+
+        grid1_add_map2(num_links_map2) = add1
+        grid2_add_map2(num_links_map2) = add2
+        wts_map2    (:,num_links_map2) = weights(num_wts+1:2*num_wts)
+      endif
+
+      if (link_add1(1,add1) == 0) link_add1(1,add1) = num_links_map1
+      if (link_add2(1,add2) == 0) link_add2(1,add2) = num_links_map1
+      link_add1(2,add1) = num_links_map1
+      link_add2(2,add2) = num_links_map1
+
+!-----------------------------------------------------------------------
+
+      end subroutine store_link_cnsrv
+
+!***********************************************************************
+
+      end module remap_conservative
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_distwgt.f
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_distwgt.f	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_distwgt.f	(revision 2528)
@@ -0,0 +1,498 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this module contains necessary routines for performing an 
+!     interpolation using a distance-weighted average of n nearest
+!     neighbors.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_distwgt.f,v 1.3 2000/04/19 21:56:26 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_distance_weight
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod     ! defines common data types
+      use constants     ! defines common constants
+      use grids         ! module containing grid info
+      use remap_vars    ! module containing remap info
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     module variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), parameter :: 
+     &     num_neighbors=4  ! num nearest neighbors to interpolate from
+
+      real (kind=dbl_kind), dimension(:), allocatable, save ::
+     &     coslat, sinlat, ! cosine, sine of grid lats (for distance)
+     &     coslon, sinlon, ! cosine, sine of grid lons (for distance)
+     &     wgtstmp         ! an array to hold the link weight
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine remap_distwgt
+
+!-----------------------------------------------------------------------
+!
+!     this routine computes the inverse-distance weights for a
+!     nearest-neighbor interpolation.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      logical (kind=log_kind), dimension(num_neighbors) ::
+     &     nbr_mask        ! mask at nearest neighbors
+
+      integer (kind=int_kind) :: n,
+     &     dst_add,        ! destination address
+     &     nmap            ! index of current map being computed
+
+      integer (kind=int_kind), dimension(num_neighbors) ::
+     &     nbr_add         ! source address at nearest neighbors
+
+      real (kind=dbl_kind), dimension(num_neighbors) ::
+     &     nbr_dist        ! angular distance four nearest neighbors
+
+      real (kind=dbl_kind) ::
+     &     coslat_dst,     ! cos(lat) of destination grid point
+     &     coslon_dst,     ! cos(lon) of destination grid point
+     &     sinlat_dst,     ! sin(lat) of destination grid point
+     &     sinlon_dst,     ! sin(lon) of destination grid point
+     &     dist_tot        ! sum of neighbor distances (for normalizing)
+
+!-----------------------------------------------------------------------
+!
+!     compute mappings from grid1 to grid2
+!
+!-----------------------------------------------------------------------
+
+      nmap = 1
+
+      !***
+      !*** allocate wgtstmp to be consistent with store_link interface
+      !***
+
+      allocate (wgtstmp(num_wts))
+
+      !***
+      !*** compute cos, sin of lat/lon on source grid for distance
+      !*** calculations
+      !***
+
+      allocate (coslat(grid1_size), coslon(grid1_size),
+     &          sinlat(grid1_size), sinlon(grid1_size))
+
+      coslat = cos(grid1_center_lat)
+      coslon = cos(grid1_center_lon)
+      sinlat = sin(grid1_center_lat)
+      sinlon = sin(grid1_center_lon)
+
+      !***
+      !*** loop over destination grid 
+      !***
+
+      grid_loop1: do dst_add = 1, grid2_size
+
+        if (.not. grid2_mask(dst_add)) cycle grid_loop1
+
+        coslat_dst = cos(grid2_center_lat(dst_add))
+        coslon_dst = cos(grid2_center_lon(dst_add))
+        sinlat_dst = sin(grid2_center_lat(dst_add))
+        sinlon_dst = sin(grid2_center_lon(dst_add))
+
+        !***
+        !*** find nearest grid points on source grid and
+        !*** distances to each point
+        !***
+
+        call grid_search_nbr(nbr_add, nbr_dist, 
+     &                       grid2_center_lat(dst_add),
+     &                       grid2_center_lon(dst_add),
+     &                       coslat_dst, coslon_dst, 
+     &                       sinlat_dst, sinlon_dst,
+     &                       bin_addr1, bin_addr2)
+
+        !***
+        !*** compute weights based on inverse distance
+        !*** if mask is false, eliminate those points
+        !***
+
+        dist_tot = zero
+        do n=1,num_neighbors
+          if (grid1_mask(nbr_add(n))) then
+            nbr_dist(n) = one/nbr_dist(n)
+            dist_tot = dist_tot + nbr_dist(n)
+            nbr_mask(n) = .true.
+          else
+            nbr_mask(n) = .false.
+          endif
+        end do
+
+        !***
+        !*** normalize weights and store the link
+        !***
+
+        do n=1,num_neighbors
+          if (nbr_mask(n)) then
+            wgtstmp(1) = nbr_dist(n)/dist_tot
+            call store_link_nbr(nbr_add(n), dst_add, wgtstmp, nmap)
+            grid2_frac(dst_add) = one
+          endif
+        end do
+
+      end do grid_loop1
+
+      deallocate (coslat, coslon, sinlat, sinlon)
+
+!-----------------------------------------------------------------------
+!
+!     compute mappings from grid2 to grid1 if necessary
+!
+!-----------------------------------------------------------------------
+
+      if (num_maps > 1) then
+
+      nmap = 2
+
+      !***
+      !*** compute cos, sin of lat/lon on source grid for distance
+      !*** calculations
+      !***
+
+      allocate (coslat(grid2_size), coslon(grid2_size),
+     &          sinlat(grid2_size), sinlon(grid2_size))
+
+      coslat = cos(grid2_center_lat)
+      coslon = cos(grid2_center_lon)
+      sinlat = sin(grid2_center_lat)
+      sinlon = sin(grid2_center_lon)
+
+      !***
+      !*** loop over destination grid 
+      !***
+
+      grid_loop2: do dst_add = 1, grid1_size
+
+        if (.not. grid1_mask(dst_add)) cycle grid_loop2
+
+        coslat_dst = cos(grid1_center_lat(dst_add))
+        coslon_dst = cos(grid1_center_lon(dst_add))
+        sinlat_dst = sin(grid1_center_lat(dst_add))
+        sinlon_dst = sin(grid1_center_lon(dst_add))
+
+        !***
+        !*** find four nearest grid points on source grid and
+        !*** distances to each point
+        !***
+
+        call grid_search_nbr(nbr_add, nbr_dist,
+     &                       grid1_center_lat(dst_add),
+     &                       grid1_center_lon(dst_add),
+     &                       coslat_dst, coslon_dst, 
+     &                       sinlat_dst, sinlon_dst,
+     &                       bin_addr2, bin_addr1)
+
+        !***
+        !*** compute weights based on inverse distance
+        !*** if mask is false, eliminate those points
+        !***
+
+        dist_tot = zero
+        do n=1,num_neighbors
+          if (grid2_mask(nbr_add(n))) then
+            nbr_dist(n) = one/nbr_dist(n)
+            dist_tot = dist_tot + nbr_dist(n)
+            nbr_mask(n) = .true.
+          else
+            nbr_mask(n) = .false.
+          endif
+        end do
+
+        !***
+        !*** normalize weights and store the link
+        !***
+
+        do n=1,num_neighbors
+          if (nbr_mask(n)) then
+            wgtstmp(1) = nbr_dist(n)/dist_tot
+            call store_link_nbr(dst_add, nbr_add(n), wgtstmp, nmap)
+            grid1_frac(dst_add) = one
+          endif
+        end do
+
+      end do grid_loop2
+
+      deallocate (coslat, coslon, sinlat, sinlon)
+
+      endif
+
+      deallocate(wgtstmp)
+
+!-----------------------------------------------------------------------
+
+      end subroutine remap_distwgt
+
+!***********************************************************************
+
+      subroutine grid_search_nbr(nbr_add, nbr_dist, plat, plon, 
+     &               coslat_dst, coslon_dst, sinlat_dst, sinlon_dst,
+     &               src_bin_add, dst_bin_add)
+
+!-----------------------------------------------------------------------
+!
+!     this routine finds the closest num_neighbor points to a search 
+!     point and computes a distance to each of the neighbors.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     output variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(num_neighbors), intent(out) ::
+     &        nbr_add  ! address of each of the closest points
+
+      real (kind=dbl_kind), dimension(num_neighbors), intent(out) ::
+     &        nbr_dist ! distance to each of the closest points
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(:,:), intent(in) ::
+     &        src_bin_add, ! search bins for restricting search
+     &        dst_bin_add   
+
+      real (kind=dbl_kind), intent(in) ::
+     &        plat,         ! latitude  of the search point
+     &        plon,         ! longitude of the search point
+     &        coslat_dst,   ! cos(lat)  of the search point
+     &        coslon_dst,   ! cos(lon)  of the search point
+     &        sinlat_dst,   ! sin(lat)  of the search point
+     &        sinlon_dst    ! sin(lon)  of the search point
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, nmax, nadd, nchk, ! dummy indices
+     &        min_add, max_add, nm1, np1, i, j, ip1, im1, jp1, jm1
+
+      real (kind=dbl_kind) ::
+     &        distance      ! angular distance
+
+!-----------------------------------------------------------------------
+!
+!     loop over source grid and find nearest neighbors
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** restrict the search using search bins
+      !*** expand the bins to catch neighbors
+      !***
+
+      select case (restrict_type)
+      case('latitude')
+
+        do n=1,num_srch_bins
+          if (plat >= bin_lats(1,n) .and. plat <= bin_lats(2,n)) then
+            min_add = src_bin_add(1,n)
+            max_add = src_bin_add(2,n)
+
+            nm1 = max(n-1,1)
+            np1 = min(n+1,num_srch_bins)
+
+            min_add = min(min_add,src_bin_add(1,nm1))
+            max_add = max(max_add,src_bin_add(2,nm1))
+            min_add = min(min_add,src_bin_add(1,np1))
+            max_add = max(max_add,src_bin_add(2,np1))
+          endif
+        end do
+
+      case('latlon')
+
+        n = 0
+        nmax = nint(sqrt(real(num_srch_bins)))
+        do j=1,nmax
+        jp1 = min(j+1,nmax)
+        jm1 = max(j-1,1)
+        do i=1,nmax
+          ip1 = min(i+1,nmax)
+          im1 = max(i-1,1)
+
+          n = n+1
+          if (plat >= bin_lats(1,n) .and. plat <= bin_lats(2,n) .and.
+     &        plon >= bin_lons(1,n) .and. plon <= bin_lons(3,n)) then
+            min_add = src_bin_add(1,n)
+            max_add = src_bin_add(2,n)
+
+            nm1 = (jm1-1)*nmax + im1
+            np1 = (jp1-1)*nmax + ip1
+            nm1 = max(nm1,1)
+            np1 = min(np1,num_srch_bins)
+
+            min_add = min(min_add,src_bin_add(1,nm1))
+            max_add = max(max_add,src_bin_add(2,nm1))
+            min_add = min(min_add,src_bin_add(1,np1))
+            max_add = max(max_add,src_bin_add(2,np1))
+          endif
+        end do
+        end do
+
+      end select
+
+      !***
+      !*** initialize distance and address arrays
+      !***
+
+      nbr_add = 0
+      nbr_dist = bignum
+
+      do nadd=min_add,max_add
+
+        !***
+        !*** find distance to this point
+        !***
+
+        distance = acos(sinlat_dst*sinlat(nadd) +
+     &                  coslat_dst*coslat(nadd)*
+     &                 (coslon_dst*coslon(nadd) +
+     &                  sinlon_dst*sinlon(nadd)) )
+
+        !***
+        !*** store the address and distance if this is one of the
+        !*** smallest four so far
+        !***
+
+        check_loop: do nchk=1,num_neighbors
+          if (distance .lt. nbr_dist(nchk)) then
+            do n=num_neighbors,nchk+1,-1
+              nbr_add(n) = nbr_add(n-1)
+              nbr_dist(n) = nbr_dist(n-1)
+            end do
+            nbr_add(nchk) = nadd
+            nbr_dist(nchk) = distance
+            exit check_loop
+          endif
+        end do check_loop
+
+      end do
+
+!-----------------------------------------------------------------------
+
+      end subroutine grid_search_nbr 
+
+!***********************************************************************
+
+      subroutine store_link_nbr(add1, add2, weights, nmap)
+
+!-----------------------------------------------------------------------
+!
+!     this routine stores the address and weight for this link in
+!     the appropriate address and weight arrays and resizes those
+!     arrays if necessary.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::
+     &        add1,  ! address on grid1
+     &        add2,  ! address on grid2
+     &        nmap   ! identifies which direction for mapping
+
+      real (kind=dbl_kind), dimension(:), intent(in) ::
+     &        weights ! array of remapping weights for this link
+
+!-----------------------------------------------------------------------
+!
+!     increment number of links and check to see if remap arrays need
+!     to be increased to accomodate the new link.  then store the
+!     link.
+!
+!-----------------------------------------------------------------------
+
+      select case (nmap)
+      case(1)
+
+        num_links_map1  = num_links_map1 + 1
+
+        if (num_links_map1 > max_links_map1) 
+     &     call resize_remap_vars(1,resize_increment)
+
+        grid1_add_map1(num_links_map1) = add1
+        grid2_add_map1(num_links_map1) = add2
+        wts_map1    (:,num_links_map1) = weights
+
+      case(2)
+
+        num_links_map2  = num_links_map2 + 1
+
+        if (num_links_map2 > max_links_map2) 
+     &     call resize_remap_vars(2,resize_increment)
+
+        grid1_add_map2(num_links_map2) = add1
+        grid2_add_map2(num_links_map2) = add2
+        wts_map2    (:,num_links_map2) = weights
+
+      end select
+
+!-----------------------------------------------------------------------
+
+      end subroutine store_link_nbr
+
+!***********************************************************************
+
+      end module remap_distance_weight
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_read.f
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_read.f	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_read.f	(revision 2528)
@@ -0,0 +1,1027 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This routine reads remapping information from files written
+!     by remap_setup.  If remapping in both directions are required,
+!     two input files must be specified.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_read.f,v 1.6 2000/04/19 21:56:26 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_read
+
+!-----------------------------------------------------------------------
+!
+!     contains routines for reading a remap file
+!
+!-----------------------------------------------------------------------
+
+      use kinds_mod     ! defines common data types
+      use constants     ! defines useful constants
+      use grids         ! includes all grid information
+      use netcdf_mod    ! module with netcdf vars and utilities
+      use remap_vars    ! module for all required remapping variables
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     module variables
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+!     various netCDF ids for files variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), private :: ! netCDF ids
+     &         ncstat, nc_file_id,
+     &         nc_srcgrdsize_id, nc_dstgrdsize_id,
+     &         nc_srcgrdcorn_id, nc_dstgrdcorn_id,
+     &         nc_srcgrdrank_id, nc_dstgrdrank_id,
+     &         nc_srcgrddims_id, nc_dstgrddims_id,
+     &         nc_numlinks_id, nc_numwgts_id, 
+     &         nc_srcgrdimask_id, nc_dstgrdimask_id,
+     &         nc_srcgrdcntrlat_id, nc_srcgrdcntrlon_id,
+     &         nc_srcgrdcrnrlat_id, nc_srcgrdcrnrlon_id,
+     &         nc_srcgrdarea_id, nc_srcgrdfrac_id,
+     &         nc_dstgrdcntrlat_id, nc_dstgrdcntrlon_id,
+     &         nc_dstgrdcrnrlat_id, nc_dstgrdcrnrlon_id,
+     &         nc_dstgrdarea_id, nc_dstgrdfrac_id,
+     &         nc_srcgrdadd_id, nc_dstgrdadd_id, nc_rmpmatrix_id
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine read_remap(map_name, interp_file)
+
+!-----------------------------------------------------------------------
+!
+!     this driver routine reads some global attributes and then
+!     calls a specific read routine based on file conventions
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len), intent(in) ::
+     &  interp_file        ! filename for remap data
+
+!-----------------------------------------------------------------------
+!
+!     output variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len), intent(out) ::
+     &  map_name            ! name for mapping
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len) :: 
+     &   map_method       ! character string for map_type
+     &,  normalize_opt    ! character string for normalization option
+     &,  convention       ! character string for output convention
+
+!-----------------------------------------------------------------------
+!
+!     open file and read some global information
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_open(interp_file, NF_NOWRITE, nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** map name
+      !***
+      map_name = ' '
+      ncstat = nf_get_att_text(nc_file_id, NF_GLOBAL, 'title',
+     &                         map_name)
+      call netcdf_error_handler(ncstat)
+
+      print *,'Reading remapping:',trim(map_name)
+      print *,'From file:',trim(interp_file)
+
+      !***
+      !*** normalization option
+      !***
+      normalize_opt = ' '
+      ncstat = nf_get_att_text(nc_file_id, NF_GLOBAL, 'normalization',
+     &                         normalize_opt)
+      call netcdf_error_handler(ncstat)
+
+      select case(normalize_opt)
+      case ('none')
+        norm_opt = norm_opt_none
+      case ('fracarea')
+        norm_opt = norm_opt_frcarea
+      case ('destarea')
+        norm_opt = norm_opt_dstarea
+      case default
+        print *,'normalize_opt = ',normalize_opt
+        stop 'Invalid normalization option'
+      end select
+
+      !***
+      !*** map method
+      !***
+      map_method = ' '
+      ncstat = nf_get_att_text (nc_file_id, NF_GLOBAL, 'map_method',
+     &                          map_method)
+      call netcdf_error_handler(ncstat)
+
+      select case(map_method)
+      case('Conservative remapping')
+        map_type = map_type_conserv
+      case('Bilinear remapping')
+        map_type = map_type_bilinear
+      case('Distance weighted avg of nearest neighbors')
+        map_type = map_type_distwgt
+      case('Bicubic remapping')
+        map_type = map_type_bicubic
+      case default
+        print *,'map_type = ',map_method
+        stop 'Invalid Map Type'
+      end select
+
+      !***
+      !*** file convention
+      !***
+      convention = ' '
+      ncstat = nf_get_att_text (nc_file_id, NF_GLOBAL, 'conventions',
+     &                          convention)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     call appropriate read routine based on output convention
+!
+!-----------------------------------------------------------------------
+
+      select case(convention)
+      case ('SCRIP')
+        call read_remap_scrip
+      case ('NCAR-CSM')
+        call read_remap_csm
+      case default
+        print *,'convention = ',convention
+        stop 'unknown output file convention'
+      end select
+
+!-----------------------------------------------------------------------
+
+      end subroutine read_remap
+
+!***********************************************************************
+
+      subroutine read_remap_scrip
+
+!-----------------------------------------------------------------------
+!
+!     the routine reads a netCDF file to extract remapping info
+!     in SCRIP format
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      character (char_len) ::
+     &  grid1_name           ! grid name for source grid
+     &, grid2_name           ! grid name for dest   grid
+
+      integer (kind=int_kind) ::  
+     &  n                    ! dummy index
+
+      integer (kind=int_kind), dimension(:), allocatable ::
+     &  grid1_mask_int,      ! integer masks to determine
+     &  grid2_mask_int       ! cells that participate in map
+
+!-----------------------------------------------------------------------
+!
+!     read some additional global attributes
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** source and destination grid names
+      !***
+
+      grid1_name = ' '
+      grid2_name = ' '
+      ncstat = nf_get_att_text (nc_file_id, NF_GLOBAL, 'source_grid',
+     &                          grid1_name)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_att_text (nc_file_id, NF_GLOBAL, 'dest_grid',
+     &                          grid2_name)
+      call netcdf_error_handler(ncstat)
+
+      print *,' '
+      print *,'Remapping between:',trim(grid1_name)
+      print *,'and ',trim(grid2_name)
+      print *,' '
+
+!-----------------------------------------------------------------------
+!
+!     read dimension information
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_inq_dimid(nc_file_id, 'src_grid_size', 
+     &                      nc_srcgrdsize_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_srcgrdsize_id, grid1_size)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'dst_grid_size', 
+     &                      nc_dstgrdsize_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_dstgrdsize_id, grid2_size)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'src_grid_corners', 
+     &                      nc_srcgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_srcgrdcorn_id, 
+     &                       grid1_corners)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'dst_grid_corners', 
+     &                      nc_dstgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_dstgrdcorn_id, 
+     &                       grid2_corners)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'src_grid_rank', 
+     &                      nc_srcgrdrank_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_srcgrdrank_id, 
+     &                       grid1_rank)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'dst_grid_rank', 
+     &                      nc_dstgrdrank_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_dstgrdrank_id, 
+     &                       grid2_rank)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'num_links', 
+     &                      nc_numlinks_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_numlinks_id, 
+     &                       num_links_map1)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'num_wgts', 
+     &                      nc_numwgts_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_numwgts_id, num_wts)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     allocate arrays
+!
+!-----------------------------------------------------------------------
+
+      allocate( grid1_dims      (grid1_rank),
+     &          grid1_center_lat(grid1_size), 
+     &          grid1_center_lon(grid1_size),
+     &          grid1_area      (grid1_size),
+     &          grid1_frac      (grid1_size),
+     &          grid1_mask      (grid1_size),
+     &          grid1_mask_int  (grid1_size),
+     &          grid1_corner_lat(grid1_corners, grid1_size),
+     &          grid1_corner_lon(grid1_corners, grid1_size) )
+
+      allocate( grid2_dims      (grid2_rank),
+     &          grid2_center_lat(grid2_size), 
+     &          grid2_center_lon(grid2_size),
+     &          grid2_area      (grid2_size),
+     &          grid2_frac      (grid2_size),
+     &          grid2_mask      (grid2_size),
+     &          grid2_mask_int  (grid2_size),
+     &          grid2_corner_lat(grid2_corners, grid2_size),
+     &          grid2_corner_lon(grid2_corners, grid2_size) )
+
+      allocate( grid1_add_map1(num_links_map1),
+     &          grid2_add_map1(num_links_map1),
+     &          wts_map1(num_wts,num_links_map1) )
+
+!-----------------------------------------------------------------------
+!
+!     get variable ids
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_dims', 
+     &                      nc_srcgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_imask', 
+     &                      nc_srcgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_center_lat', 
+     &                                   nc_srcgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_center_lon', 
+     &                                   nc_srcgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_corner_lat', 
+     &                                   nc_srcgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_corner_lon', 
+     &                                   nc_srcgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_area', 
+     &                                   nc_srcgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_frac', 
+     &                                   nc_srcgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_dims', 
+     &                      nc_dstgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_imask', 
+     &                      nc_dstgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_center_lat', 
+     &                                   nc_dstgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_center_lon', 
+     &                                   nc_dstgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_corner_lat', 
+     &                                   nc_dstgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_corner_lon', 
+     &                                   nc_dstgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_area', 
+     &                                   nc_dstgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_frac', 
+     &                                   nc_dstgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_address', 
+     &                                   nc_srcgrdadd_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_address', 
+     &                                   nc_dstgrdadd_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'remap_matrix', 
+     &                                   nc_rmpmatrix_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     read all variables
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_get_var_int(nc_file_id, nc_srcgrddims_id, 
+     &                        grid1_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_srcgrdimask_id, 
+     &                        grid1_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcntrlat_id, 
+     &                                       grid1_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcntrlon_id, 
+     &                                       grid1_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      grid1_units = ' '
+      ncstat = nf_get_att_text(nc_file_id, nc_srcgrdcntrlat_id, 'units',
+     &                         grid1_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid1_units(1:7))
+      case ('degrees')
+        grid1_center_lat = grid1_center_lat*deg2rad
+        grid1_center_lon = grid1_center_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid1 center lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcrnrlat_id, 
+     &                                       grid1_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcrnrlon_id, 
+     &                                       grid1_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      grid1_units = ' '
+      ncstat = nf_get_att_text(nc_file_id, nc_srcgrdcrnrlat_id, 'units',
+     &                         grid1_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid1_units(1:7))
+      case ('degrees')
+        grid1_corner_lat = grid1_corner_lat*deg2rad
+        grid1_corner_lon = grid1_corner_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid1 corner lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdarea_id, 
+     &                                       grid1_area)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdfrac_id, 
+     &                                       grid1_frac)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_dstgrddims_id, 
+     &                        grid2_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_dstgrdimask_id, 
+     &                        grid2_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcntrlat_id, 
+     &                                       grid2_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcntrlon_id, 
+     &                                       grid2_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      grid2_units = ' '
+      ncstat = nf_get_att_text(nc_file_id, nc_dstgrdcntrlat_id, 'units',
+     &                         grid2_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid2_units(1:7))
+      case ('degrees')
+        grid2_center_lat = grid2_center_lat*deg2rad
+        grid2_center_lon = grid2_center_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid2 center lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcrnrlat_id, 
+     &                                       grid2_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcrnrlon_id, 
+     &                                       grid2_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      grid2_units = ' '
+      ncstat = nf_get_att_text(nc_file_id, nc_dstgrdcrnrlat_id, 'units',
+     &                         grid2_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid2_units(1:7))
+      case ('degrees')
+        grid2_corner_lat = grid2_corner_lat*deg2rad
+        grid2_corner_lon = grid2_corner_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid2 corner lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdarea_id, 
+     &                                       grid2_area)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdfrac_id, 
+     &                                       grid2_frac)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_srcgrdadd_id, 
+     &                        grid1_add_map1)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_dstgrdadd_id, 
+     &                        grid2_add_map1)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_rmpmatrix_id, 
+     &                                       wts_map1)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     initialize logical mask 
+!
+!-----------------------------------------------------------------------
+
+      where (grid1_mask_int == 1)
+        grid1_mask = .true.
+      elsewhere
+        grid1_mask = .false.
+      endwhere
+      where (grid2_mask_int == 1)
+        grid2_mask = .true.
+      elsewhere
+        grid2_mask = .false.
+      endwhere
+      deallocate(grid1_mask_int, grid2_mask_int)
+
+!-----------------------------------------------------------------------
+!
+!     close input file
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_close(nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+
+      end subroutine read_remap_scrip
+
+!***********************************************************************
+
+      subroutine read_remap_csm
+
+!-----------------------------------------------------------------------
+!
+!     the routine reads a netCDF file to extract remapping info
+!     in NCAR-CSM format
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      character (char_len) ::
+     &  grid1_name           ! grid name for source grid
+     &, grid2_name           ! grid name for dest   grid
+
+      integer (kind=int_kind) ::
+     &  nc_numwgts1_id    ! extra netCDF id for num_wgts > 1 
+     &, nc_rmpmatrix2_id  ! extra netCDF id for high-order remap matrix
+
+      real (kind=dbl_kind), dimension(:),allocatable ::
+     &  wts1              ! CSM wants single array for 1st-order wts
+
+      real (kind=dbl_kind), dimension(:,:),allocatable ::
+     &  wts2              ! write remaining weights in different array
+
+      integer (kind=int_kind) ::  
+     &  n                    ! dummy index
+
+      integer (kind=int_kind), dimension(:), allocatable ::
+     &  grid1_mask_int,      ! integer masks to determine
+     &  grid2_mask_int       ! cells that participate in map
+
+!-----------------------------------------------------------------------
+!
+!     read some additional global attributes
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** source and destination grid names
+      !***
+
+      grid1_name = ' '
+      grid2_name = ' '
+      ncstat = nf_get_att_text (nc_file_id, NF_GLOBAL, 'domain_a',
+     &                          grid1_name)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_att_text (nc_file_id, NF_GLOBAL, 'domain_b',
+     &                          grid2_name)
+      call netcdf_error_handler(ncstat)
+
+      print *,' '
+      print *,'Remapping between:',trim(grid1_name)
+      print *,'and ',trim(grid2_name)
+      print *,' '
+
+!-----------------------------------------------------------------------
+!
+!     read dimension information
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_inq_dimid(nc_file_id, 'n_a', nc_srcgrdsize_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_srcgrdsize_id, grid1_size)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'n_b', nc_dstgrdsize_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_dstgrdsize_id, grid2_size)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'nv_a', nc_srcgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_srcgrdcorn_id, 
+     &                       grid1_corners)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'nv_b', nc_dstgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_dstgrdcorn_id, 
+     &                       grid2_corners)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'src_grid_rank', 
+     &                      nc_srcgrdrank_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_srcgrdrank_id, 
+     &                       grid1_rank)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'dst_grid_rank', 
+     &                      nc_dstgrdrank_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_dstgrdrank_id, 
+     &                       grid2_rank)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'n_s', 
+     &                      nc_numlinks_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_numlinks_id, 
+     &                       num_links_map1)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'num_wgts', 
+     &                      nc_numwgts_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_numwgts_id, num_wts)
+      call netcdf_error_handler(ncstat)
+
+      if (num_wts > 1) then
+        ncstat = nf_inq_dimid(nc_file_id, 'num_wgts1', 
+     &                        nc_numwgts1_id)
+        call netcdf_error_handler(ncstat)
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     allocate arrays
+!
+!-----------------------------------------------------------------------
+
+      allocate( grid1_dims      (grid1_rank),
+     &          grid1_center_lat(grid1_size), 
+     &          grid1_center_lon(grid1_size),
+     &          grid1_area      (grid1_size),
+     &          grid1_frac      (grid1_size),
+     &          grid1_mask      (grid1_size),
+     &          grid1_mask_int  (grid1_size),
+     &          grid1_corner_lat(grid1_corners, grid1_size),
+     &          grid1_corner_lon(grid1_corners, grid1_size) )
+
+      allocate( grid2_dims      (grid2_rank),
+     &          grid2_center_lat(grid2_size), 
+     &          grid2_center_lon(grid2_size),
+     &          grid2_area      (grid2_size),
+     &          grid2_frac      (grid2_size),
+     &          grid2_mask      (grid2_size),
+     &          grid2_mask_int  (grid2_size),
+     &          grid2_corner_lat(grid2_corners, grid2_size),
+     &          grid2_corner_lon(grid2_corners, grid2_size) )
+
+      allocate( grid1_add_map1(num_links_map1),
+     &          grid2_add_map1(num_links_map1),
+     &          wts_map1(num_wts,num_links_map1),
+     &          wts1(num_links_map1),
+     &          wts2(num_wts-1,num_links_map1) )
+
+!-----------------------------------------------------------------------
+!
+!     get variable ids
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_dims', 
+     &                      nc_srcgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'mask_a', 
+     &                      nc_srcgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'yc_a', nc_srcgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'xc_a', nc_srcgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'yv_a', nc_srcgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'xv_a', nc_srcgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'area_a', nc_srcgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'frac_a', nc_srcgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_dims', 
+     &                      nc_dstgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'mask_b', 
+     &                      nc_dstgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'yc_b', nc_dstgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'xc_b', nc_dstgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'yv_b', nc_dstgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'xv_b', nc_dstgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'area_b', nc_dstgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'frac_b', nc_dstgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'col', nc_srcgrdadd_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'row', nc_dstgrdadd_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'S', nc_rmpmatrix_id)
+      call netcdf_error_handler(ncstat)
+
+      if (num_wts > 1) then
+        ncstat = nf_inq_varid(nc_file_id, 'S2', nc_rmpmatrix2_id)
+        call netcdf_error_handler(ncstat)
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     read all variables
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_get_var_int(nc_file_id, nc_srcgrddims_id, 
+     &                        grid1_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_srcgrdimask_id, 
+     &                        grid1_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcntrlat_id, 
+     &                                       grid1_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcntrlon_id, 
+     &                                       grid1_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_att_text(nc_file_id, nc_srcgrdcntrlat_id, 'units',
+     &                         grid1_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid1_units(1:7))
+      case ('degrees')
+        grid1_center_lat = grid1_center_lat*deg2rad
+        grid1_center_lon = grid1_center_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid1 center lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcrnrlat_id, 
+     &                                       grid1_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcrnrlon_id, 
+     &                                       grid1_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_att_text(nc_file_id, nc_srcgrdcrnrlat_id, 'units',
+     &                         grid1_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid1_units(1:7))
+      case ('degrees')
+        grid1_corner_lat = grid1_corner_lat*deg2rad
+        grid1_corner_lon = grid1_corner_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid1 corner lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdarea_id, 
+     &                                       grid1_area)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdfrac_id, 
+     &                                       grid1_frac)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_dstgrddims_id, 
+     &                        grid2_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_dstgrdimask_id, 
+     &                        grid2_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcntrlat_id, 
+     &                                       grid2_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcntrlon_id, 
+     &                                       grid2_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_att_text(nc_file_id, nc_dstgrdcntrlat_id, 'units',
+     &                         grid2_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid2_units(1:7))
+      case ('degrees')
+        grid2_center_lat = grid2_center_lat*deg2rad
+        grid2_center_lon = grid2_center_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid2 center lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcrnrlat_id, 
+     &                                       grid2_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcrnrlon_id, 
+     &                                       grid2_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+
+      ncstat = nf_get_att_text(nc_file_id, nc_dstgrdcrnrlat_id, 'units',
+     &                         grid2_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid2_units(1:7))
+      case ('degrees')
+        grid2_corner_lat = grid2_corner_lat*deg2rad
+        grid2_corner_lon = grid2_corner_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid2 corner lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdarea_id, 
+     &                                       grid2_area)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdfrac_id, 
+     &                                       grid2_frac)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_srcgrdadd_id, 
+     &                        grid1_add_map1)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_dstgrdadd_id, 
+     &                        grid2_add_map1)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_rmpmatrix_id, 
+     &                                       wts1)
+      wts_map1(1,:) = wts1
+      deallocate(wts1)
+
+      if (num_wts > 1) then
+        ncstat = nf_get_var_double(nc_file_id, nc_rmpmatrix2_id, 
+     &                                         wts2)
+        wts_map1(2:,:) = wts2
+        deallocate(wts2)
+      endif
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     initialize logical mask 
+!
+!-----------------------------------------------------------------------
+
+      where (grid1_mask_int == 1)
+        grid1_mask = .true.
+      elsewhere
+        grid1_mask = .false.
+      endwhere
+      where (grid2_mask_int == 1)
+        grid2_mask = .true.
+      elsewhere
+        grid2_mask = .false.
+      endwhere
+      deallocate(grid1_mask_int, grid2_mask_int)
+
+!-----------------------------------------------------------------------
+!
+!     close input file
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_close(nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+
+      end subroutine read_remap_csm
+
+!***********************************************************************
+
+      end module remap_read
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_vars.f
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_vars.f	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_vars.f	(revision 2528)
@@ -0,0 +1,302 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this module contains necessary variables for remapping between
+!     two grids.  also routines for resizing and initializing these
+!     variables.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_vars.f,v 1.5 2000/04/19 21:56:26 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_vars
+
+      use kinds_mod
+      use constants
+      use grids
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     module variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), parameter ::
+     &      norm_opt_none    = 1
+     &,     norm_opt_dstarea = 2
+     &,     norm_opt_frcarea = 3
+
+      integer (kind=int_kind), parameter ::
+     &      map_type_conserv  = 1
+     &,     map_type_bilinear = 2
+     &,     map_type_bicubic  = 3
+     &,     map_type_distwgt  = 4
+
+      integer (kind=int_kind), save :: 
+     &      max_links_map1  ! current size of link arrays
+     &,     num_links_map1  ! actual number of links for remapping
+     &,     max_links_map2  ! current size of link arrays
+     &,     num_links_map2  ! actual number of links for remapping
+     &,     num_maps        ! num of remappings for this grid pair
+     &,     num_wts         ! num of weights used in remapping
+     &,     map_type        ! identifier for remapping method
+     &,     norm_opt        ! option for normalization (conserv only)
+     &,     resize_increment ! default amount to increase array size
+
+      integer (kind=int_kind), dimension(:), allocatable, save ::
+     &      grid1_add_map1, ! grid1 address for each link in mapping 1
+     &      grid2_add_map1, ! grid2 address for each link in mapping 1
+     &      grid1_add_map2, ! grid1 address for each link in mapping 2
+     &      grid2_add_map2  ! grid2 address for each link in mapping 2
+
+      real (kind=dbl_kind), dimension(:,:), allocatable, save ::
+     &      wts_map1, ! map weights for each link (num_wts,max_links)
+     &      wts_map2  ! map weights for each link (num_wts,max_links)
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine init_remap_vars
+
+!-----------------------------------------------------------------------
+!
+!     this routine initializes some variables and provides an initial
+!     allocation of arrays (fairly large so frequent resizing 
+!     unnecessary).
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     determine the number of weights
+!
+!-----------------------------------------------------------------------
+
+      select case (map_type)
+      case(map_type_conserv)
+        num_wts = 3
+      case(map_type_bilinear)
+        num_wts = 1
+      case(map_type_bicubic)
+        num_wts = 4
+      case(map_type_distwgt)
+        num_wts = 1
+      end select
+
+!-----------------------------------------------------------------------
+!
+!     initialize num_links and set max_links to four times the largest 
+!     of the destination grid sizes initially (can be changed later).
+!     set a default resize increment to increase the size of link
+!     arrays if the number of links exceeds the initial size
+!   
+!-----------------------------------------------------------------------
+
+      num_links_map1 = 0
+      max_links_map1 = 4*grid2_size
+      if (num_maps > 1) then
+        num_links_map2 = 0
+        max_links_map1 = max(4*grid1_size,4*grid2_size)
+        max_links_map2 = max_links_map1
+      endif
+
+      resize_increment = 0.1*max(grid1_size,grid2_size)
+
+!-----------------------------------------------------------------------
+!
+!     allocate address and weight arrays for mapping 1
+!   
+!-----------------------------------------------------------------------
+
+      allocate (grid1_add_map1(max_links_map1),
+     &          grid2_add_map1(max_links_map1),
+     &          wts_map1(num_wts, max_links_map1))
+
+!-----------------------------------------------------------------------
+!
+!     allocate address and weight arrays for mapping 2 if necessary 
+!   
+!-----------------------------------------------------------------------
+
+      if (num_maps > 1) then
+        allocate (grid1_add_map2(max_links_map2),
+     &            grid2_add_map2(max_links_map2),
+     &            wts_map2(num_wts, max_links_map2))
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine init_remap_vars
+
+!***********************************************************************
+
+      subroutine resize_remap_vars(nmap, increment)
+
+!-----------------------------------------------------------------------
+!
+!     this routine resizes remapping arrays by increasing(decreasing)
+!     the max_links by increment
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::
+     &     nmap,      ! identifies which mapping array to resize
+     &     increment  ! the number of links to add(subtract) to arrays
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) ::
+     &   ierr,     ! error flag
+     &   mxlinks   ! size of link arrays
+
+      integer (kind=int_kind), dimension(:), allocatable ::
+     &   add1_tmp, ! temp array for resizing address arrays
+     &   add2_tmp  ! temp array for resizing address arrays
+
+      real (kind=dbl_kind), dimension(:,:), allocatable ::
+     &   wts_tmp   ! temp array for resizing weight arrays
+
+!-----------------------------------------------------------------------
+!
+!     resize map 1 arrays if required.
+!
+!-----------------------------------------------------------------------
+
+      select case (nmap)
+      case(1)
+
+        !***
+        !*** allocate temporaries to hold original values
+        !***
+
+        mxlinks = size(grid1_add_map1)
+        allocate (add1_tmp(mxlinks), add2_tmp(mxlinks), 
+     &            wts_tmp(num_wts,mxlinks))
+
+        add1_tmp = grid1_add_map1
+        add2_tmp = grid2_add_map1
+        wts_tmp  = wts_map1
+        
+        !***
+        !*** deallocate originals and increment max_links then
+        !*** reallocate arrays at new size
+        !***
+
+        deallocate (grid1_add_map1, grid2_add_map1, wts_map1)
+        max_links_map1 = mxlinks + increment
+        allocate (grid1_add_map1(max_links_map1),
+     &            grid2_add_map1(max_links_map1),
+     &            wts_map1(num_wts,max_links_map1))
+
+        !***
+        !*** restore original values from temp arrays and
+        !*** deallocate temps
+        !***
+
+        mxlinks = min(mxlinks, max_links_map1)
+        grid1_add_map1(1:mxlinks) = add1_tmp (1:mxlinks)
+        grid2_add_map1(1:mxlinks) = add2_tmp (1:mxlinks)
+        wts_map1    (:,1:mxlinks) = wts_tmp(:,1:mxlinks)
+        deallocate(add1_tmp, add2_tmp, wts_tmp)
+
+!-----------------------------------------------------------------------
+!
+!     resize map 2 arrays if required.
+!
+!-----------------------------------------------------------------------
+
+      case(2)
+
+        !***
+        !*** allocate temporaries to hold original values
+        !***
+
+        mxlinks = size(grid1_add_map2)
+        allocate (add1_tmp(mxlinks), add2_tmp(mxlinks), 
+     &            wts_tmp(num_wts,mxlinks),stat=ierr)
+        if (ierr .ne. 0) then
+          print *,'error allocating temps in resize: ',ierr
+          stop
+        endif
+
+        add1_tmp = grid1_add_map2
+        add2_tmp = grid2_add_map2
+        wts_tmp  = wts_map2
+        
+        !***
+        !*** deallocate originals and increment max_links then
+        !*** reallocate arrays at new size
+        !***
+
+        deallocate (grid1_add_map2, grid2_add_map2, wts_map2)
+        max_links_map2 = mxlinks + increment
+        allocate (grid1_add_map2(max_links_map2),
+     &            grid2_add_map2(max_links_map2),
+     &            wts_map2(num_wts,max_links_map2),stat=ierr)
+        if (ierr .ne. 0) then
+          print *,'error allocating new arrays in resize: ',ierr
+          stop
+        endif
+
+
+        !***
+        !*** restore original values from temp arrays and
+        !*** deallocate temps
+        !***
+
+        mxlinks = min(mxlinks, max_links_map2)
+        grid1_add_map2(1:mxlinks) = add1_tmp (1:mxlinks)
+        grid2_add_map2(1:mxlinks) = add2_tmp (1:mxlinks)
+        wts_map2    (:,1:mxlinks) = wts_tmp(:,1:mxlinks)
+        deallocate(add1_tmp, add2_tmp, wts_tmp)
+
+      end select
+
+!-----------------------------------------------------------------------
+
+      end subroutine resize_remap_vars
+
+!***********************************************************************
+
+      end module remap_vars
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_write.f
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_write.f	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_write.f	(revision 2528)
@@ -0,0 +1,1763 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module contains routines for writing the remapping data to 
+!     a file.  Before writing the data for each mapping, the links are 
+!     sorted by destination grid address.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_write.f,v 1.7 2001/08/21 21:06:42 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_write
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod     ! defines common data types
+      use constants     ! defines common scalar constants
+      use grids         ! module containing grid information
+      use remap_vars    ! module containing remap information
+      use netcdf_mod    ! module with netCDF stuff
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     module variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len), private :: 
+     &   map_method       ! character string for map_type
+     &,  normalize_opt    ! character string for normalization option
+     &,  history          ! character string for history information
+     &,  convention       ! character string for output convention
+
+      character(8), private :: 
+     &   cdate            ! character date string
+
+      integer (kind=int_kind), dimension(:), allocatable, private ::
+     &   src_mask_int     ! integer masks to determine
+     &,  dst_mask_int     ! cells that participate in map
+
+!-----------------------------------------------------------------------
+!
+!     various netCDF identifiers used by output routines
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), private ::
+     &   ncstat               ! error flag for netCDF calls 
+     &,  nc_file_id           ! id for netCDF file
+     &,  nc_srcgrdsize_id     ! id for source grid size
+     &,  nc_dstgrdsize_id     ! id for destination grid size
+     &,  nc_srcgrdcorn_id     ! id for number of source grid corners
+     &,  nc_dstgrdcorn_id     ! id for number of dest grid corners
+     &,  nc_srcgrdrank_id     ! id for source grid rank
+     &,  nc_dstgrdrank_id     ! id for dest grid rank
+     &,  nc_numlinks_id       ! id for number of links in mapping
+     &,  nc_numwgts_id        ! id for number of weights for mapping
+     &,  nc_srcgrddims_id     ! id for source grid dimensions
+     &,  nc_dstgrddims_id     ! id for dest grid dimensions
+     &,  nc_srcgrdcntrlat_id  ! id for source grid center latitude
+     &,  nc_dstgrdcntrlat_id  ! id for dest grid center latitude
+     &,  nc_srcgrdcntrlon_id  ! id for source grid center longitude
+     &,  nc_dstgrdcntrlon_id  ! id for dest grid center longitude
+     &,  nc_srcgrdimask_id    ! id for source grid mask
+     &,  nc_dstgrdimask_id    ! id for dest grid mask
+     &,  nc_srcgrdcrnrlat_id  ! id for latitude of source grid corners
+     &,  nc_srcgrdcrnrlon_id  ! id for longitude of source grid corners
+     &,  nc_dstgrdcrnrlat_id  ! id for latitude of dest grid corners
+     &,  nc_dstgrdcrnrlon_id  ! id for longitude of dest grid corners
+     &,  nc_srcgrdarea_id     ! id for area of source grid cells
+     &,  nc_dstgrdarea_id     ! id for area of dest grid cells
+     &,  nc_srcgrdfrac_id     ! id for area fraction on source grid
+     &,  nc_dstgrdfrac_id     ! id for area fraction on dest grid
+     &,  nc_srcadd_id         ! id for map source address
+     &,  nc_dstadd_id         ! id for map destination address
+     &,  nc_rmpmatrix_id      ! id for remapping matrix
+
+      integer (kind=int_kind), dimension(2), private ::
+     &   nc_dims2_id  ! netCDF ids for 2d array dims
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine write_remap(map1_name, map2_name, 
+     &                       interp_file1, interp_file2, output_opt)
+
+!-----------------------------------------------------------------------
+!
+!     calls correct output routine based on output format choice
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len), intent(in) ::
+     &            map1_name,    ! name for mapping grid1 to grid2
+     &            map2_name,    ! name for mapping grid2 to grid1
+     &            interp_file1, ! filename for map1 remap data
+     &            interp_file2, ! filename for map2 remap data
+     &            output_opt    ! option for output conventions
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     define some common variables to be used in all routines
+!
+!-----------------------------------------------------------------------
+
+      select case(norm_opt)
+      case (norm_opt_none)
+        normalize_opt = 'none'
+      case (norm_opt_frcarea)
+        normalize_opt = 'fracarea'
+      case (norm_opt_dstarea)
+        normalize_opt = 'destarea'
+      end select
+
+      select case(map_type)
+      case(map_type_conserv)
+        map_method = 'Conservative remapping'
+      case(map_type_bilinear)
+        map_method = 'Bilinear remapping'
+      case(map_type_distwgt)
+        map_method = 'Distance weighted avg of nearest neighbors'
+      case(map_type_bicubic)
+        map_method = 'Bicubic remapping'
+      case default
+        stop 'Invalid Map Type'
+      end select
+
+      call date_and_time(date=cdate)
+      write (history,1000) cdate(5:6),cdate(7:8),cdate(1:4)
+ 1000 format('Created: ',a2,'-',a2,'-',a4)
+
+!-----------------------------------------------------------------------
+!
+!     sort address and weight arrays
+!
+!-----------------------------------------------------------------------
+
+      call sort_add(grid2_add_map1, grid1_add_map1, wts_map1)
+      if (num_maps > 1) then
+        call sort_add(grid1_add_map2, grid2_add_map2, wts_map2)
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     call appropriate output routine
+!
+!-----------------------------------------------------------------------
+
+      select case(output_opt)
+      case ('scrip')
+        call write_remap_scrip(map1_name, interp_file1, 1)
+      case ('ncar-csm')
+        call write_remap_csm  (map1_name, interp_file1, 1)
+      case default
+        stop 'unknown output file convention'
+      end select
+
+!-----------------------------------------------------------------------
+!
+!     call appropriate output routine for second mapping if required
+!
+!-----------------------------------------------------------------------
+
+      if (num_maps > 1) then
+        select case(output_opt)
+        case ('scrip')
+          call write_remap_scrip(map2_name, interp_file2, 2)
+        case ('ncar-csm')
+          call write_remap_csm  (map2_name, interp_file2, 2)
+        case default
+          stop 'unknown output file convention'
+        end select
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine write_remap
+
+!***********************************************************************
+
+      subroutine write_remap_scrip(map_name, interp_file, direction)
+
+!-----------------------------------------------------------------------
+!
+!     writes remap data to a netCDF file using SCRIP conventions
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len), intent(in) ::
+     &            map_name     ! name for mapping 
+     &,           interp_file  ! filename for remap data
+
+      integer (kind=int_kind), intent(in) ::
+     &  direction              ! direction of map (1=grid1 to grid2
+                               !                   2=grid2 to grid1)
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len) ::
+     &  grid1_ctmp        ! character temp for grid1 names
+     &, grid2_ctmp        ! character temp for grid2 names
+
+      integer (kind=int_kind) ::
+     &  itmp1             ! integer temp
+     &, itmp2             ! integer temp
+     &, itmp3             ! integer temp
+     &, itmp4             ! integer temp
+
+!-----------------------------------------------------------------------
+!
+!     create netCDF file for mapping and define some global attributes
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_create (interp_file, NF_CLOBBER, nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** map name
+      !***
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'title',
+     &                          len_trim(map_name), map_name)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** normalization option
+      !***
+      ncstat = nf_put_att_text(nc_file_id, NF_GLOBAL, 'normalization',
+     &                         len_trim(normalize_opt), normalize_opt)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** map method
+      !***
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'map_method',
+     &                          len_trim(map_method), map_method)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** history
+      !***
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'history',
+     &                          len_trim(history), history)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** file convention
+      !***
+      convention = 'SCRIP'
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'conventions',
+     &                          len_trim(convention), convention)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** source and destination grid names
+      !***
+
+      if (direction == 1) then
+        grid1_ctmp = 'source_grid'
+        grid2_ctmp = 'dest_grid'
+      else
+        grid1_ctmp = 'dest_grid'
+        grid2_ctmp = 'source_grid'
+      endif
+
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, trim(grid1_ctmp),
+     &                          len_trim(grid1_name), grid1_name)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, trim(grid2_ctmp),
+     &                          len_trim(grid2_name), grid2_name)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     prepare netCDF dimension info
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** define grid size dimensions
+      !***
+
+      if (direction == 1) then
+        itmp1 = grid1_size
+        itmp2 = grid2_size
+      else
+        itmp1 = grid2_size
+        itmp2 = grid1_size
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'src_grid_size', itmp1, 
+     &                     nc_srcgrdsize_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'dst_grid_size', itmp2, 
+     &                     nc_dstgrdsize_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner dimension
+      !***
+
+      if (direction == 1) then
+        itmp1 = grid1_corners
+        itmp2 = grid2_corners
+      else
+        itmp1 = grid2_corners
+        itmp2 = grid1_corners
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'src_grid_corners', 
+     &                     itmp1, nc_srcgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'dst_grid_corners', 
+     &                     itmp2, nc_dstgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid rank dimension
+      !***
+
+      if (direction == 1) then
+        itmp1 = grid1_rank
+        itmp2 = grid2_rank
+      else
+        itmp1 = grid2_rank
+        itmp2 = grid1_rank
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'src_grid_rank', 
+     &                     itmp1, nc_srcgrdrank_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'dst_grid_rank', 
+     &                     itmp2, nc_dstgrdrank_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define map size dimensions
+      !***
+
+      if (direction == 1) then
+        itmp1 = num_links_map1
+      else
+        itmp1 = num_links_map2
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'num_links', 
+     &                     itmp1, nc_numlinks_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'num_wgts', 
+     &                     num_wts, nc_numwgts_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid dimensions
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_dims', NF_INT,
+     &                     1, nc_srcgrdrank_id, nc_srcgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_dims', NF_INT,
+     &                     1, nc_dstgrdrank_id, nc_dstgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     define all arrays for netCDF descriptors
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** define grid center latitude array
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_center_lat', 
+     &                     NF_DOUBLE, 1, nc_srcgrdsize_id, 
+     &                     nc_srcgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_center_lat', 
+     &                     NF_DOUBLE, 1, nc_dstgrdsize_id, 
+     &                     nc_dstgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid center longitude array
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_center_lon', 
+     &                     NF_DOUBLE, 1, nc_srcgrdsize_id, 
+     &                     nc_srcgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_center_lon', 
+     &                     NF_DOUBLE, 1, nc_dstgrdsize_id, 
+     &                     nc_dstgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner lat/lon arrays
+      !***
+
+      nc_dims2_id(1) = nc_srcgrdcorn_id
+      nc_dims2_id(2) = nc_srcgrdsize_id
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_corner_lat', 
+     &                     NF_DOUBLE, 2, nc_dims2_id, 
+     &                     nc_srcgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_corner_lon', 
+     &                     NF_DOUBLE, 2, nc_dims2_id, 
+     &                     nc_srcgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      nc_dims2_id(1) = nc_dstgrdcorn_id
+      nc_dims2_id(2) = nc_dstgrdsize_id
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_corner_lat', 
+     &                     NF_DOUBLE, 2, nc_dims2_id, 
+     &                     nc_dstgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_corner_lon', 
+     &                     NF_DOUBLE, 2, nc_dims2_id, 
+     &                     nc_dstgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define units for all coordinate arrays
+      !***
+
+      if (direction == 1) then
+        grid1_ctmp = grid1_units
+        grid2_ctmp = grid2_units
+      else
+        grid1_ctmp = grid2_units
+        grid2_ctmp = grid1_units
+      endif
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcntrlat_id, 
+     &                          'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcntrlat_id, 
+     &                          'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcntrlon_id, 
+     &                          'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcntrlon_id, 
+     &                          'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcrnrlat_id, 
+     &                          'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcrnrlon_id, 
+     &                          'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcrnrlat_id, 
+     &                          'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcrnrlon_id, 
+     &                          'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid mask
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_imask', NF_INT,
+     &                     1, nc_srcgrdsize_id, nc_srcgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdimask_id, 
+     &                          'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_imask', NF_INT,
+     &                     1, nc_dstgrdsize_id, nc_dstgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdimask_id, 
+     &                          'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid area arrays
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_area', 
+     &                     NF_DOUBLE, 1, nc_srcgrdsize_id, 
+     &                     nc_srcgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdarea_id, 
+     &                          'units', 14, 'square radians')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_area', 
+     &                     NF_DOUBLE, 1, nc_dstgrdsize_id, 
+     &                     nc_dstgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdarea_id, 
+     &                          'units', 14, 'square radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid fraction arrays
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_frac', 
+     &                     NF_DOUBLE, 1, nc_srcgrdsize_id, 
+     &                     nc_srcgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdfrac_id, 
+     &                          'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_frac', 
+     &                     NF_DOUBLE, 1, nc_dstgrdsize_id, 
+     &                     nc_dstgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdfrac_id, 
+     &                          'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define mapping arrays
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_address', 
+     &                     NF_INT, 1, nc_numlinks_id, 
+     &                     nc_srcadd_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_address', 
+     &                     NF_INT, 1, nc_numlinks_id, 
+     &                     nc_dstadd_id)
+      call netcdf_error_handler(ncstat)
+
+      nc_dims2_id(1) = nc_numwgts_id
+      nc_dims2_id(2) = nc_numlinks_id
+
+      ncstat = nf_def_var (nc_file_id, 'remap_matrix', 
+     &                     NF_DOUBLE, 2, nc_dims2_id, 
+     &                     nc_rmpmatrix_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** end definition stage
+      !***
+
+      ncstat = nf_enddef(nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     compute integer masks
+!
+!-----------------------------------------------------------------------
+
+      if (direction == 1) then
+        allocate (src_mask_int(grid1_size),
+     &            dst_mask_int(grid2_size))
+
+        where (grid2_mask)
+          dst_mask_int = 1
+        elsewhere
+          dst_mask_int = 0
+        endwhere
+
+        where (grid1_mask)
+          src_mask_int = 1
+        elsewhere
+          src_mask_int = 0
+        endwhere
+      else
+        allocate (src_mask_int(grid2_size),
+     &            dst_mask_int(grid1_size))
+
+        where (grid1_mask)
+          dst_mask_int = 1
+        elsewhere
+          dst_mask_int = 0
+        endwhere
+
+        where (grid2_mask)
+          src_mask_int = 1
+        elsewhere
+          src_mask_int = 0
+        endwhere
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     change units of lat/lon coordinates if input units different
+!     from radians
+!
+!-----------------------------------------------------------------------
+
+      if (grid1_units(1:7) == 'degrees' .and. direction == 1) then
+        grid1_center_lat = grid1_center_lat/deg2rad
+        grid1_center_lon = grid1_center_lon/deg2rad
+        grid1_corner_lat = grid1_corner_lat/deg2rad
+        grid1_corner_lon = grid1_corner_lon/deg2rad
+      endif
+
+      if (grid2_units(1:7) == 'degrees' .and. direction == 1) then
+        grid2_center_lat = grid2_center_lat/deg2rad
+        grid2_center_lon = grid2_center_lon/deg2rad
+        grid2_corner_lat = grid2_corner_lat/deg2rad
+        grid2_corner_lon = grid2_corner_lon/deg2rad
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     write mapping data
+!
+!-----------------------------------------------------------------------
+
+      if (direction == 1) then
+        itmp1 = nc_srcgrddims_id
+        itmp2 = nc_dstgrddims_id
+      else
+        itmp2 = nc_srcgrddims_id
+        itmp1 = nc_dstgrddims_id
+      endif
+
+      ncstat = nf_put_var_int(nc_file_id, itmp1, grid1_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_file_id, itmp2, grid2_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_file_id, nc_srcgrdimask_id, 
+     &                        src_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_file_id, nc_dstgrdimask_id,
+     &                        dst_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      deallocate(src_mask_int, dst_mask_int)
+
+      if (direction == 1) then
+        itmp1 = nc_srcgrdcntrlat_id
+        itmp2 = nc_srcgrdcntrlon_id
+        itmp3 = nc_srcgrdcrnrlat_id
+        itmp4 = nc_srcgrdcrnrlon_id
+      else
+        itmp1 = nc_dstgrdcntrlat_id
+        itmp2 = nc_dstgrdcntrlon_id
+        itmp3 = nc_dstgrdcrnrlat_id
+        itmp4 = nc_dstgrdcrnrlon_id
+      endif
+
+      ncstat = nf_put_var_double(nc_file_id, itmp1, grid1_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp2, grid1_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp3, grid1_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp4, grid1_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      if (direction == 1) then
+        itmp1 = nc_dstgrdcntrlat_id
+        itmp2 = nc_dstgrdcntrlon_id
+        itmp3 = nc_dstgrdcrnrlat_id
+        itmp4 = nc_dstgrdcrnrlon_id
+      else
+        itmp1 = nc_srcgrdcntrlat_id
+        itmp2 = nc_srcgrdcntrlon_id
+        itmp3 = nc_srcgrdcrnrlat_id
+        itmp4 = nc_srcgrdcrnrlon_id
+      endif
+
+      ncstat = nf_put_var_double(nc_file_id, itmp1, grid2_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp2, grid2_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp3, grid2_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp4, grid2_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      if (direction == 1) then
+        itmp1 = nc_srcgrdarea_id
+        itmp2 = nc_srcgrdfrac_id
+        itmp3 = nc_dstgrdarea_id
+        itmp4 = nc_dstgrdfrac_id
+      else
+        itmp1 = nc_dstgrdarea_id
+        itmp2 = nc_dstgrdfrac_id
+        itmp3 = nc_srcgrdarea_id
+        itmp4 = nc_srcgrdfrac_id
+      endif
+
+      if (luse_grid1_area) then
+        ncstat = nf_put_var_double(nc_file_id, itmp1, grid1_area_in)
+      else
+        ncstat = nf_put_var_double(nc_file_id, itmp1, grid1_area)
+      endif
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp2, grid1_frac)
+      call netcdf_error_handler(ncstat)
+
+      if (luse_grid2_area) then
+        ncstat = nf_put_var_double(nc_file_id, itmp3, grid2_area_in)
+      else
+        ncstat = nf_put_var_double(nc_file_id, itmp3, grid2_area)
+      endif
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp4, grid2_frac)
+      call netcdf_error_handler(ncstat)
+
+      if (direction == 1) then
+        ncstat = nf_put_var_int(nc_file_id, nc_srcadd_id, 
+     &                          grid1_add_map1)
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_int(nc_file_id, nc_dstadd_id, 
+     &                          grid2_add_map1)
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id, 
+     &                             wts_map1)
+        call netcdf_error_handler(ncstat)
+      else
+        ncstat = nf_put_var_int(nc_file_id, nc_srcadd_id, 
+     &                          grid2_add_map2)
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_int(nc_file_id, nc_dstadd_id, 
+     &                          grid1_add_map2)
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id, 
+     &                             wts_map2)
+        call netcdf_error_handler(ncstat)
+      endif
+
+      ncstat = nf_close(nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+
+      end subroutine write_remap_scrip
+
+!***********************************************************************
+
+      subroutine write_remap_csm(map_name, interp_file, direction)
+
+!-----------------------------------------------------------------------
+!
+!     writes remap data to a netCDF file using NCAR-CSM conventions
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len), intent(in) ::
+     &            map_name     ! name for mapping 
+     &,           interp_file  ! filename for remap data
+
+      integer (kind=int_kind), intent(in) ::
+     &  direction              ! direction of map (1=grid1 to grid2
+                               !                   2=grid2 to grid1)
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len) ::
+     &  grid1_ctmp        ! character temp for grid1 names
+     &, grid2_ctmp        ! character temp for grid2 names
+
+      integer (kind=int_kind) ::
+     &  itmp1             ! integer temp
+     &, itmp2             ! integer temp
+     &, itmp3             ! integer temp
+     &, itmp4             ! integer temp
+     &, nc_numwgts1_id    ! extra netCDF id for additional weights
+     &, nc_src_isize_id   ! extra netCDF id for ni_a
+     &, nc_src_jsize_id   ! extra netCDF id for nj_a
+     &, nc_dst_isize_id   ! extra netCDF id for ni_b
+     &, nc_dst_jsize_id   ! extra netCDF id for nj_b
+     &, nc_rmpmatrix2_id  ! extra netCDF id for high-order remap matrix
+
+      real (kind=dbl_kind), dimension(:),allocatable ::
+     &  wts1              ! CSM wants single array for 1st-order wts
+
+      real (kind=dbl_kind), dimension(:,:),allocatable ::
+     &  wts2              ! write remaining weights in different array
+
+!-----------------------------------------------------------------------
+!
+!     create netCDF file for mapping and define some global attributes
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_create (interp_file, NF_CLOBBER, nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** map name
+      !***
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'title',
+     &                          len_trim(map_name), map_name)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** normalization option
+      !***
+      ncstat = nf_put_att_text(nc_file_id, NF_GLOBAL, 'normalization',
+     &                         len_trim(normalize_opt), normalize_opt)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** map method
+      !***
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'map_method',
+     &                          len_trim(map_method), map_method)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** history
+      !***
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'history',
+     &                          len_trim(history), history)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** file convention
+      !***
+      convention = 'NCAR-CSM'
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'conventions',
+     &                          len_trim(convention), convention)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** source and destination grid names
+      !***
+
+      if (direction == 1) then
+        grid1_ctmp = 'domain_a'
+        grid2_ctmp = 'domain_b'
+      else
+        grid1_ctmp = 'domain_b'
+        grid2_ctmp = 'domain_a'
+      endif
+
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, trim(grid1_ctmp),
+     &                          len_trim(grid1_name), grid1_name)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, trim(grid2_ctmp),
+     &                          len_trim(grid2_name), grid2_name)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     prepare netCDF dimension info
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** define grid size dimensions
+      !***
+
+      if (direction == 1) then
+        itmp1 = grid1_size
+        itmp2 = grid2_size
+      else
+        itmp1 = grid2_size
+        itmp2 = grid1_size
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'n_a', itmp1, nc_srcgrdsize_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'n_b', itmp2, nc_dstgrdsize_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner dimension
+      !***
+
+      if (direction == 1) then
+        itmp1 = grid1_corners
+        itmp2 = grid2_corners
+      else
+        itmp1 = grid2_corners
+        itmp2 = grid1_corners
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'nv_a', itmp1, nc_srcgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'nv_b', itmp2, nc_dstgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid rank dimension
+      !***
+
+      if (direction == 1) then
+        itmp1 = grid1_rank
+        itmp2 = grid2_rank
+      else
+        itmp1 = grid2_rank
+        itmp2 = grid1_rank
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'src_grid_rank', 
+     &                     itmp1, nc_srcgrdrank_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'dst_grid_rank', 
+     &                     itmp2, nc_dstgrdrank_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define first two dims as if 2-d cartesian domain
+      !***
+
+      if (direction == 1) then
+        itmp1 = grid1_dims(1)
+        if (grid1_rank > 1) then
+          itmp2 = grid1_dims(2)
+        else
+          itmp2 = 0
+        endif
+        itmp3 = grid2_dims(1)
+        if (grid2_rank > 1) then
+          itmp4 = grid2_dims(2)
+        else
+          itmp4 = 0
+        endif
+      else
+        itmp1 = grid2_dims(1)
+        if (grid2_rank > 1) then
+          itmp2 = grid2_dims(2)
+        else
+          itmp2 = 0
+        endif
+        itmp3 = grid1_dims(1)
+        if (grid1_rank > 1) then
+          itmp4 = grid1_dims(2)
+        else
+          itmp4 = 0
+        endif
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'ni_a', itmp1, nc_src_isize_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'nj_a', itmp2, nc_src_jsize_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'ni_b', itmp3, nc_dst_isize_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'nj_b', itmp4, nc_dst_jsize_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define map size dimensions
+      !***
+
+      if (direction == 1) then
+        itmp1 = num_links_map1
+      else
+        itmp1 = num_links_map2
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'n_s', itmp1, nc_numlinks_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'num_wgts', 
+     &                     num_wts, nc_numwgts_id)
+      call netcdf_error_handler(ncstat)
+
+      if (num_wts > 1) then
+        ncstat = nf_def_dim (nc_file_id, 'num_wgts1', 
+     &                       num_wts-1, nc_numwgts1_id)
+        call netcdf_error_handler(ncstat)
+      endif
+
+      !***
+      !*** define grid dimensions
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_dims', NF_INT,
+     &                     1, nc_srcgrdrank_id, nc_srcgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_dims', NF_INT,
+     &                     1, nc_dstgrdrank_id, nc_dstgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     define all arrays for netCDF descriptors
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** define grid center latitude array
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'yc_a',
+     &                     NF_DOUBLE, 1, nc_srcgrdsize_id, 
+     &                     nc_srcgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'yc_b', 
+     &                     NF_DOUBLE, 1, nc_dstgrdsize_id, 
+     &                     nc_dstgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid center longitude array
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'xc_a', 
+     &                     NF_DOUBLE, 1, nc_srcgrdsize_id, 
+     &                     nc_srcgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'xc_b', 
+     &                     NF_DOUBLE, 1, nc_dstgrdsize_id, 
+     &                     nc_dstgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner lat/lon arrays
+      !***
+
+      nc_dims2_id(1) = nc_srcgrdcorn_id
+      nc_dims2_id(2) = nc_srcgrdsize_id
+
+      ncstat = nf_def_var (nc_file_id, 'yv_a', 
+     &                     NF_DOUBLE, 2, nc_dims2_id, 
+     &                     nc_srcgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'xv_a', 
+     &                     NF_DOUBLE, 2, nc_dims2_id, 
+     &                     nc_srcgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      nc_dims2_id(1) = nc_dstgrdcorn_id
+      nc_dims2_id(2) = nc_dstgrdsize_id
+
+      ncstat = nf_def_var (nc_file_id, 'yv_b', 
+     &                     NF_DOUBLE, 2, nc_dims2_id, 
+     &                     nc_dstgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'xv_b', 
+     &                     NF_DOUBLE, 2, nc_dims2_id, 
+     &                     nc_dstgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** CSM wants all in degrees
+      !***
+
+      grid1_units = 'degrees'
+      grid2_units = 'degrees'
+
+      if (direction == 1) then
+        grid1_ctmp = grid1_units
+        grid2_ctmp = grid2_units
+      else
+        grid1_ctmp = grid2_units
+        grid2_ctmp = grid1_units
+      endif
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcntrlat_id, 
+     &                          'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcntrlat_id, 
+     &                          'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcntrlon_id, 
+     &                          'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcntrlon_id, 
+     &                          'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcrnrlat_id, 
+     &                          'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcrnrlon_id, 
+     &                          'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcrnrlat_id, 
+     &                          'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcrnrlon_id, 
+     &                          'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid mask
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'mask_a', NF_INT,
+     &                     1, nc_srcgrdsize_id, nc_srcgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdimask_id, 
+     &                          'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'mask_b', NF_INT,
+     &                     1, nc_dstgrdsize_id, nc_dstgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdimask_id, 
+     &                          'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid area arrays
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'area_a', 
+     &                     NF_DOUBLE, 1, nc_srcgrdsize_id, 
+     &                     nc_srcgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdarea_id, 
+     &                          'units', 14, 'square radians')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'area_b', 
+     &                     NF_DOUBLE, 1, nc_dstgrdsize_id, 
+     &                     nc_dstgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdarea_id, 
+     &                          'units', 14, 'square radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid fraction arrays
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'frac_a', 
+     &                     NF_DOUBLE, 1, nc_srcgrdsize_id, 
+     &                     nc_srcgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdfrac_id, 
+     &                          'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'frac_b', 
+     &                     NF_DOUBLE, 1, nc_dstgrdsize_id, 
+     &                     nc_dstgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdfrac_id, 
+     &                          'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define mapping arrays
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'col', 
+     &                     NF_INT, 1, nc_numlinks_id, 
+     &                     nc_srcadd_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'row', 
+     &                     NF_INT, 1, nc_numlinks_id, 
+     &                     nc_dstadd_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'S', 
+     &                     NF_DOUBLE, 1, nc_numlinks_id, 
+     &                     nc_rmpmatrix_id)
+      call netcdf_error_handler(ncstat)
+
+      if (num_wts > 1) then
+        nc_dims2_id(1) = nc_numwgts1_id
+        nc_dims2_id(2) = nc_numlinks_id
+
+        ncstat = nf_def_var (nc_file_id, 'S2', 
+     &                     NF_DOUBLE, 2, nc_dims2_id, 
+     &                     nc_rmpmatrix2_id)
+        call netcdf_error_handler(ncstat)
+      endif
+
+      !***
+      !*** end definition stage
+      !***
+
+      ncstat = nf_enddef(nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     compute integer masks
+!
+!-----------------------------------------------------------------------
+
+      if (direction == 1) then
+        allocate (src_mask_int(grid1_size),
+     &            dst_mask_int(grid2_size))
+
+        where (grid2_mask)
+          dst_mask_int = 1
+        elsewhere
+          dst_mask_int = 0
+        endwhere
+
+        where (grid1_mask)
+          src_mask_int = 1
+        elsewhere
+          src_mask_int = 0
+        endwhere
+      else
+        allocate (src_mask_int(grid2_size),
+     &            dst_mask_int(grid1_size))
+
+        where (grid1_mask)
+          dst_mask_int = 1
+        elsewhere
+          dst_mask_int = 0
+        endwhere
+
+        where (grid2_mask)
+          src_mask_int = 1
+        elsewhere
+          src_mask_int = 0
+        endwhere
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     change units of lat/lon coordinates if input units different
+!     from radians. if this is the second mapping, the conversion has
+!     alread been done.
+!
+!-----------------------------------------------------------------------
+
+      if (grid1_units(1:7) == 'degrees' .and. direction == 1) then
+        grid1_center_lat = grid1_center_lat/deg2rad
+        grid1_center_lon = grid1_center_lon/deg2rad
+        grid1_corner_lat = grid1_corner_lat/deg2rad
+        grid1_corner_lon = grid1_corner_lon/deg2rad
+      endif
+
+      if (grid2_units(1:7) == 'degrees' .and. direction == 1) then
+        grid2_center_lat = grid2_center_lat/deg2rad
+        grid2_center_lon = grid2_center_lon/deg2rad
+        grid2_corner_lat = grid2_corner_lat/deg2rad
+        grid2_corner_lon = grid2_corner_lon/deg2rad
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     write mapping data
+!
+!-----------------------------------------------------------------------
+
+      if (direction == 1) then
+        itmp1 = nc_srcgrddims_id
+        itmp2 = nc_dstgrddims_id
+      else
+        itmp2 = nc_srcgrddims_id
+        itmp1 = nc_dstgrddims_id
+      endif
+
+      ncstat = nf_put_var_int(nc_file_id, itmp1, grid1_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_file_id, itmp2, grid2_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_file_id, nc_srcgrdimask_id, 
+     &                        src_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_file_id, nc_dstgrdimask_id,
+     &                        dst_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      deallocate(src_mask_int, dst_mask_int)
+
+      if (direction == 1) then
+        itmp1 = nc_srcgrdcntrlat_id
+        itmp2 = nc_srcgrdcntrlon_id
+        itmp3 = nc_srcgrdcrnrlat_id
+        itmp4 = nc_srcgrdcrnrlon_id
+      else
+        itmp1 = nc_dstgrdcntrlat_id
+        itmp2 = nc_dstgrdcntrlon_id
+        itmp3 = nc_dstgrdcrnrlat_id
+        itmp4 = nc_dstgrdcrnrlon_id
+      endif
+
+      ncstat = nf_put_var_double(nc_file_id, itmp1, grid1_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp2, grid1_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp3, grid1_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp4, grid1_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      if (direction == 1) then
+        itmp1 = nc_dstgrdcntrlat_id
+        itmp2 = nc_dstgrdcntrlon_id
+        itmp3 = nc_dstgrdcrnrlat_id
+        itmp4 = nc_dstgrdcrnrlon_id
+      else
+        itmp1 = nc_srcgrdcntrlat_id
+        itmp2 = nc_srcgrdcntrlon_id
+        itmp3 = nc_srcgrdcrnrlat_id
+        itmp4 = nc_srcgrdcrnrlon_id
+      endif
+
+      ncstat = nf_put_var_double(nc_file_id, itmp1, grid2_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp2, grid2_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp3, grid2_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp4, grid2_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      if (direction == 1) then
+        itmp1 = nc_srcgrdarea_id
+        itmp2 = nc_srcgrdfrac_id
+        itmp3 = nc_dstgrdarea_id
+        itmp4 = nc_dstgrdfrac_id
+      else
+        itmp1 = nc_dstgrdarea_id
+        itmp2 = nc_dstgrdfrac_id
+        itmp3 = nc_srcgrdarea_id
+        itmp4 = nc_srcgrdfrac_id
+      endif
+
+      if (luse_grid1_area) then
+        ncstat = nf_put_var_double(nc_file_id, itmp1, grid1_area_in)
+      else
+        ncstat = nf_put_var_double(nc_file_id, itmp1, grid1_area)
+      endif
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp2, grid1_frac)
+      call netcdf_error_handler(ncstat)
+
+      if (luse_grid2_area) then
+        ncstat = nf_put_var_double(nc_file_id, itmp3, grid2_area)
+      else
+        ncstat = nf_put_var_double(nc_file_id, itmp3, grid2_area)
+      endif
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp4, grid2_frac)
+      call netcdf_error_handler(ncstat)
+
+      if (direction == 1) then
+        ncstat = nf_put_var_int(nc_file_id, nc_srcadd_id, 
+     &                          grid1_add_map1)
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_int(nc_file_id, nc_dstadd_id, 
+     &                          grid2_add_map1)
+        call netcdf_error_handler(ncstat)
+
+        if (num_wts == 1) then
+          ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id, 
+     &                               wts_map1)
+          call netcdf_error_handler(ncstat)
+        else
+          allocate(wts1(num_links_map1),wts2(num_wts-1,num_links_map1))
+
+          wts1 = wts_map1(1,:)
+          wts2 = wts_map1(2:,:)
+
+          ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id, 
+     &                               wts1)
+          call netcdf_error_handler(ncstat)
+          ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix2_id, 
+     &                               wts2)
+          call netcdf_error_handler(ncstat)
+          deallocate(wts1,wts2)
+        endif
+      else
+        ncstat = nf_put_var_int(nc_file_id, nc_srcadd_id, 
+     &                          grid2_add_map2)
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_int(nc_file_id, nc_dstadd_id, 
+     &                          grid1_add_map2)
+        call netcdf_error_handler(ncstat)
+
+        if (num_wts == 1) then
+          ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id, 
+     &                               wts_map2)
+          call netcdf_error_handler(ncstat)
+        else
+          allocate(wts1(num_links_map2),wts2(num_wts-1,num_links_map2))
+
+          wts1 = wts_map2(1,:)
+          wts2 = wts_map2(2:,:)
+
+          ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id, 
+     &                               wts1)
+          call netcdf_error_handler(ncstat)
+          ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix2_id, 
+     &                               wts2)
+          call netcdf_error_handler(ncstat)
+          deallocate(wts1,wts2)
+        endif
+      endif
+
+      ncstat = nf_close(nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+
+      end subroutine write_remap_csm
+
+!***********************************************************************
+
+      subroutine sort_add(add1, add2, weights)
+
+!-----------------------------------------------------------------------
+!
+!     this routine sorts address and weight arrays based on the
+!     destination address with the source address as a secondary
+!     sorting criterion.  the method is a standard heap sort.
+!
+!-----------------------------------------------------------------------
+
+      use kinds_mod     ! defines common data types
+      use constants     ! defines common scalar constants
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     Input and Output arrays
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(inout), dimension(:) ::
+     &        add1,       ! destination address array (num_links)
+     &        add2        ! source      address array
+
+      real (kind=dbl_kind), intent(inout), dimension(:,:) ::
+     &        weights     ! remapping weights (num_wts, num_links)
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) ::
+     &          num_links,          ! num of links for this mapping
+     &          num_wts,            ! num of weights for this mapping
+     &          add1_tmp, add2_tmp, ! temp for addresses during swap
+     &          nwgt,
+     &          lvl, final_lvl,     ! level indexes for heap sort levels
+     &          chk_lvl1, chk_lvl2, max_lvl
+
+      real (kind=dbl_kind), dimension(SIZE(weights,DIM=1)) ::
+     &          wgttmp              ! temp for holding wts during swap
+
+!-----------------------------------------------------------------------
+!
+!     determine total number of links to sort and number of weights
+!
+!-----------------------------------------------------------------------
+
+      num_links = SIZE(add1)
+      num_wts   = SIZE(weights, DIM=1)
+
+!-----------------------------------------------------------------------
+!
+!     start at the lowest level (N/2) of the tree and sift lower 
+!     values to the bottom of the tree, promoting the larger numbers
+!
+!-----------------------------------------------------------------------
+
+      do lvl=num_links/2,1,-1
+
+        final_lvl = lvl
+        add1_tmp = add1(lvl)
+        add2_tmp = add2(lvl)
+        wgttmp(:) = weights(:,lvl)
+
+        !***
+        !*** loop until proper level is found for this link, or reach
+        !*** bottom
+        !***
+
+        sift_loop1: do
+
+          !***
+          !*** find the largest of the two daughters
+          !***
+
+          chk_lvl1 = 2*final_lvl
+          chk_lvl2 = 2*final_lvl+1
+          if (chk_lvl1 .EQ. num_links) chk_lvl2 = chk_lvl1
+
+          if ((add1(chk_lvl1) >  add1(chk_lvl2)) .OR.
+     &       ((add1(chk_lvl1) == add1(chk_lvl2)) .AND.
+     &        (add2(chk_lvl1) >  add2(chk_lvl2)))) then
+            max_lvl = chk_lvl1
+          else 
+            max_lvl = chk_lvl2
+          endif
+
+          !***
+          !*** if the parent is greater than both daughters,
+          !*** the correct level has been found
+          !***
+
+          if ((add1_tmp .GT. add1(max_lvl)) .OR.
+     &       ((add1_tmp .EQ. add1(max_lvl)) .AND.
+     &        (add2_tmp .GT. add2(max_lvl)))) then
+            add1(final_lvl) = add1_tmp
+            add2(final_lvl) = add2_tmp
+            weights(:,final_lvl) = wgttmp(:)
+            exit sift_loop1
+
+          !***
+          !*** otherwise, promote the largest daughter and push
+          !*** down one level in the tree.  if haven't reached
+          !*** the end of the tree, repeat the process.  otherwise
+          !*** store last values and exit the loop
+          !***
+
+          else 
+            add1(final_lvl) = add1(max_lvl)
+            add2(final_lvl) = add2(max_lvl)
+            weights(:,final_lvl) = weights(:,max_lvl)
+
+            final_lvl = max_lvl
+            if (2*final_lvl > num_links) then
+              add1(final_lvl) = add1_tmp
+              add2(final_lvl) = add2_tmp
+              weights(:,final_lvl) = wgttmp(:)
+              exit sift_loop1
+            endif
+          endif
+        end do sift_loop1
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     now that the heap has been sorted, strip off the top (largest)
+!     value and promote the values below
+!
+!-----------------------------------------------------------------------
+
+      do lvl=num_links,3,-1
+
+        !***
+        !*** move the top value and insert it into the correct place
+        !***
+
+        add1_tmp = add1(lvl)
+        add1(lvl) = add1(1)
+
+        add2_tmp = add2(lvl)
+        add2(lvl) = add2(1)
+
+        wgttmp(:) = weights(:,lvl)
+        weights(:,lvl) = weights(:,1)
+
+        !***
+        !*** as above this loop sifts the tmp values down until proper 
+        !*** level is reached
+        !***
+
+        final_lvl = 1
+
+        sift_loop2: do
+
+          !***
+          !*** find the largest of the two daughters
+          !***
+
+          chk_lvl1 = 2*final_lvl
+          chk_lvl2 = 2*final_lvl+1
+          if (chk_lvl2 >= lvl) chk_lvl2 = chk_lvl1
+
+          if ((add1(chk_lvl1) >  add1(chk_lvl2)) .OR.
+     &       ((add1(chk_lvl1) == add1(chk_lvl2)) .AND.
+     &        (add2(chk_lvl1) >  add2(chk_lvl2)))) then
+            max_lvl = chk_lvl1
+          else 
+            max_lvl = chk_lvl2
+          endif
+
+          !***
+          !*** if the parent is greater than both daughters,
+          !*** the correct level has been found
+          !***
+
+          if ((add1_tmp >  add1(max_lvl)) .OR.
+     &       ((add1_tmp == add1(max_lvl)) .AND.
+     &        (add2_tmp >  add2(max_lvl)))) then
+            add1(final_lvl) = add1_tmp
+            add2(final_lvl) = add2_tmp
+            weights(:,final_lvl) = wgttmp(:)
+            exit sift_loop2
+
+          !***
+          !*** otherwise, promote the largest daughter and push
+          !*** down one level in the tree.  if haven't reached
+          !*** the end of the tree, repeat the process.  otherwise
+          !*** store last values and exit the loop
+          !***
+
+          else 
+            add1(final_lvl) = add1(max_lvl)
+            add2(final_lvl) = add2(max_lvl)
+            weights(:,final_lvl) = weights(:,max_lvl)
+
+            final_lvl = max_lvl
+            if (2*final_lvl >= lvl) then
+              add1(final_lvl) = add1_tmp
+              add2(final_lvl) = add2_tmp
+              weights(:,final_lvl) = wgttmp(:)
+              exit sift_loop2
+            endif
+          endif
+        end do sift_loop2
+      end do
+
+      !***
+      !*** swap the last two entries
+      !***
+
+
+      add1_tmp = add1(2)
+      add1(2)  = add1(1)
+      add1(1)  = add1_tmp
+
+      add2_tmp = add2(2)
+      add2(2)  = add2(1)
+      add2(1)  = add2_tmp
+
+      wgttmp (:)   = weights(:,2)
+      weights(:,2) = weights(:,1)
+      weights(:,1) = wgttmp (:)
+
+!-----------------------------------------------------------------------
+
+      end subroutine sort_add
+
+!***********************************************************************
+
+      end module remap_write
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/scrip.f
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/scrip.f	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/scrip.f	(revision 2528)
@@ -0,0 +1,214 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This routine is the driver for computing the addresses and weights 
+!     for interpolating between two grids on a sphere.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: scrip.f,v 1.6 2001/08/21 21:06:44 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      program scrip
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod                  ! module defining data types
+      use constants                  ! module for common constants
+      use iounits                    ! I/O unit manager
+      use timers                     ! CPU timers
+      use grids                      ! module with grid information
+      use remap_vars                 ! common remapping variables
+      use remap_conservative         ! routines for conservative remap
+      use remap_distance_weight      ! routines for dist-weight remap
+      use remap_bilinear             ! routines for bilinear interp
+      use remap_bicubic              ! routines for bicubic  interp
+      use remap_write                ! routines for remap output
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     input namelist variables
+!
+!-----------------------------------------------------------------------
+
+      character (char_len) :: 
+     &           grid1_file,   ! filename of grid file containing grid1
+     &           grid2_file,   ! filename of grid file containing grid2
+     &           interp_file1, ! filename for output remap data (map1)
+     &           interp_file2, ! filename for output remap data (map2)
+     &           map1_name,    ! name for mapping from grid1 to grid2
+     &           map2_name,    ! name for mapping from grid2 to grid1
+     &           map_method,   ! choice for mapping method
+     &           normalize_opt,! option for normalizing weights
+     &           output_opt    ! option for output conventions
+
+      integer (kind=int_kind) ::
+     &           nmap          ! number of mappings to compute (1 or 2)
+
+      namelist /remap_inputs/ grid1_file, grid2_file, 
+     &                        interp_file1, interp_file2,
+     &                        map1_name, map2_name, num_maps,
+     &                        luse_grid1_area, luse_grid2_area,
+     &                        map_method, normalize_opt, output_opt,
+     &                        restrict_type, num_srch_bins
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n,     ! dummy counter
+     &                           iunit  ! unit number for namelist file
+
+!-----------------------------------------------------------------------
+!
+!     initialize timers
+!
+!-----------------------------------------------------------------------
+
+      call timers_init
+      do n=1,max_timers
+        call timer_clear(n)
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     read input namelist
+!
+!-----------------------------------------------------------------------
+
+      grid1_file    = 'unknown'
+      grid2_file    = 'unknown'
+      interp_file1  = 'unknown'
+      interp_file2  = 'unknown'
+      map1_name     = 'unknown'
+      map2_name     = 'unknown'
+      luse_grid1_area = .false.
+      luse_grid2_area = .false.
+      num_maps      = 2
+      map_type      = 1
+      normalize_opt = 'fracarea'
+      output_opt    = 'scrip'
+      restrict_type = 'latitude'
+      num_srch_bins = 900
+
+      call get_unit(iunit)
+      open(iunit, file='scrip_in', status='old', form='formatted')
+      read(iunit, nml=remap_inputs)
+      call release_unit(iunit)
+
+      select case(map_method)
+      case ('conservative')
+        map_type = map_type_conserv
+        luse_grid_centers = .false.
+      case ('bilinear')
+        map_type = map_type_bilinear
+        luse_grid_centers = .true.
+      case ('bicubic')
+        map_type = map_type_bicubic
+        luse_grid_centers = .true.
+      case ('distwgt')
+        map_type = map_type_distwgt
+        luse_grid_centers = .true.
+      case default
+        stop 'unknown mapping method'
+      end select
+
+      select case(normalize_opt(1:4))
+      case ('none')
+        norm_opt = norm_opt_none
+      case ('frac')
+        norm_opt = norm_opt_frcarea
+      case ('dest')
+        norm_opt = norm_opt_dstarea
+      case default
+        stop 'unknown normalization option'
+      end select
+
+!-----------------------------------------------------------------------
+!
+!     initialize grid information for both grids
+!
+!-----------------------------------------------------------------------
+
+      call grid_init(grid1_file, grid2_file)
+
+      write(stdout, *) ' Computing remappings between: ',grid1_name
+      write(stdout, *) '                          and  ',grid2_name
+
+!-----------------------------------------------------------------------
+!
+!     initialize some remapping variables.
+!
+!-----------------------------------------------------------------------
+
+      call init_remap_vars
+
+!-----------------------------------------------------------------------
+!
+!     call appropriate interpolation setup routine based on type of
+!     remapping requested.
+!
+!-----------------------------------------------------------------------
+
+      select case(map_type)
+      case(map_type_conserv)
+        call remap_conserv
+      case(map_type_bilinear)
+        call remap_bilin
+      case(map_type_distwgt)
+        call remap_distwgt
+      case(map_type_bicubic)
+        call remap_bicub
+      case default
+        stop 'Invalid Map Type'
+      end select
+
+!-----------------------------------------------------------------------
+!
+!     reduce size of remapping arrays and then write remapping info
+!     to a file.
+!
+!-----------------------------------------------------------------------
+
+      if (num_links_map1 /= max_links_map1) then
+        call resize_remap_vars(1, num_links_map1-max_links_map1)
+      endif
+      if ((num_maps > 1) .and. (num_links_map2 /= max_links_map2)) then
+        call resize_remap_vars(2, num_links_map2-max_links_map2)
+      endif
+
+      call write_remap(map1_name, map2_name, 
+     &                 interp_file1, interp_file2, output_opt)
+
+!-----------------------------------------------------------------------
+
+      end program scrip
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/scrip_test.f
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/scrip_test.f	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/scrip_test.f	(revision 2528)
@@ -0,0 +1,981 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this program is a short driver that tests the remappings using
+!     a simple analytic field.  the results are written in netCDF
+!     format.
+!
+!     CVS: $Id: scrip_test.f,v 1.6 2000/04/19 21:45:09 pwjones Exp $
+!
+!-----------------------------------------------------------------------
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      program remap_test
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod    ! defines common data types
+      use constants    ! defines common constants
+      use iounits      ! I/O unit manager
+      use netcdf_mod   ! netcdf I/O stuff
+      use grids        ! module containing grid info
+      use remap_vars   ! module containing remapping info
+      use remap_mod    ! module containing remapping routines
+      use remap_read   ! routines for reading remap files
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     input namelist variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) ::
+     &  field_choice   ! choice of field to be interpolated
+
+      character (char_len) :: 
+     &  interp_file,   ! filename containing remap data (map1)
+     &  output_file    ! filename for test results
+
+      namelist /remap_inputs/ field_choice, interp_file, output_file
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      character (char_len) :: 
+     &        map_name      ! name for mapping from grid1 to grid2
+
+      integer (kind=int_kind) ::    ! netCDF ids for files and arrays
+     &        ncstat, nc_outfile_id, 
+     &        nc_srcgrdcntrlat_id, nc_srcgrdcntrlon_id,
+     &        nc_dstgrdcntrlat_id, nc_dstgrdcntrlon_id,
+     &        nc_srcgrdrank_id, nc_dstgrdrank_id,
+     &        nc_srcgrdimask_id, nc_dstgrdimask_id,
+     &        nc_srcgrdarea_id, nc_dstgrdarea_id,
+     &        nc_srcgrdfrac_id, nc_dstgrdfrac_id,
+     &        nc_srcarray_id, nc_srcgradlat_id, nc_srcgradlon_id,
+     &        nc_dstarray1_id, nc_dstarray1a_id, nc_dstarray2_id,
+     &        nc_dsterror1_id, nc_dsterror1a_id, nc_dsterror2_id
+
+      integer (kind=int_kind), dimension(:), allocatable ::
+     &        nc_grid1size_id, nc_grid2size_id
+
+!-----------------------------------------------------------------------
+
+      character (char_len) :: 
+     &          dim_name    ! netCDF dimension name
+
+      integer (kind=int_kind) :: i,j,n,imin,imax,idiff,
+     &    ip1,im1,jp1,jm1,nx,ny, ! for computing bicub gradients
+     &    in,is,ie,iw,ine,inw,ise,isw,
+     &    iunit                  ! unit number for namelist file
+
+      integer (kind=int_kind), dimension(:), allocatable ::
+     &    grid1_imask, grid2_imask, grid2_count
+
+      real (kind=dbl_kind) ::
+     &    delew, delns,     ! variables for computing bicub gradients
+     &    length            ! length scale for cosine hill test field
+
+      real (kind=dbl_kind), dimension(:), allocatable ::
+     &    grid1_array, 
+     &    grid1_tmp, 
+     &    grad1_lat, 
+     &    grad1_lon, 
+     &    grad1_latlon, 
+     &    grad1_lat_zero, 
+     &    grad1_lon_zero, 
+     &    grid2_array, 
+     &    grid2_err,
+     &    grid2_tmp
+
+!-----------------------------------------------------------------------
+!
+!     read namelist for file and mapping info
+!
+!-----------------------------------------------------------------------
+
+      call get_unit(iunit)
+      open(iunit, file='scrip_test_in', status='old', form='formatted')
+      read(iunit, nml=remap_inputs)
+      call release_unit(iunit)
+      write(*,nml=remap_inputs)
+
+!-----------------------------------------------------------------------
+!
+!     read remapping data
+!
+!-----------------------------------------------------------------------
+
+      call read_remap(map_name, interp_file)
+
+!-----------------------------------------------------------------------
+!
+!     allocate arrays
+!
+!-----------------------------------------------------------------------
+
+      allocate (grid1_array    (grid1_size), 
+     &          grid1_tmp      (grid1_size),
+     &          grad1_lat      (grid1_size), 
+     &          grad1_lon      (grid1_size), 
+     &          grad1_lat_zero (grid1_size), 
+     &          grad1_lon_zero (grid1_size), 
+     &          grid1_imask    (grid1_size),
+     &          grid2_array    (grid2_size), 
+     &          grid2_err      (grid2_size),
+     &          grid2_tmp      (grid2_size),
+     &          grid2_imask    (grid2_size),
+     &          grid2_count    (grid2_size))
+
+      where (grid1_mask)
+        grid1_imask = 1
+      elsewhere
+        grid1_imask = 0
+      endwhere
+      where (grid2_mask)
+        grid2_imask = 1
+      elsewhere
+        grid2_imask = 0
+      endwhere
+
+!-----------------------------------------------------------------------
+!
+!     setup a NetCDF file for output
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** create netCDF dataset 
+      !***
+
+      ncstat = nf_create (output_file, NF_CLOBBER, nc_outfile_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_outfile_id, NF_GLOBAL, 'title',
+     &                          len_trim(map_name), map_name)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid size dimensions
+      !***
+
+      allocate( nc_grid1size_id(grid1_rank),
+     &          nc_grid2size_id(grid2_rank))
+
+      do n=1,grid1_rank
+        write(dim_name,1000) 'grid1_dim',n
+        ncstat = nf_def_dim (nc_outfile_id, dim_name, 
+     &                       grid1_dims(n), nc_grid1size_id(n))
+        call netcdf_error_handler(ncstat)
+      end do
+
+      do n=1,grid2_rank
+        write(dim_name,1000) 'grid2_dim',n
+        ncstat = nf_def_dim (nc_outfile_id, dim_name, 
+     &                       grid2_dims(n), nc_grid2size_id(n))
+        call netcdf_error_handler(ncstat)
+      end do
+ 1000 format(a9,i1)
+
+      !***
+      !*** define grid center latitude array
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_grid_center_lat', 
+     &                     NF_DOUBLE, grid1_rank, nc_grid1size_id, 
+     &                     nc_srcgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_outfile_id, nc_srcgrdcntrlat_id, 
+     &                          'units', 7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_grid_center_lat', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dstgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_outfile_id, nc_dstgrdcntrlat_id, 
+     &                          'units', 7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid center longitude array
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_grid_center_lon', 
+     &                     NF_DOUBLE, grid1_rank, nc_grid1size_id, 
+     &                     nc_srcgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_outfile_id, nc_srcgrdcntrlon_id, 
+     &                          'units', 7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_grid_center_lon', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dstgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_outfile_id, nc_dstgrdcntrlon_id, 
+     &                          'units', 7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid mask
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_grid_imask', NF_INT,
+     &               grid1_rank, nc_grid1size_id, nc_srcgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_outfile_id, nc_srcgrdimask_id, 
+     &                          'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_grid_imask', NF_INT,
+     &               grid2_rank, nc_grid2size_id, nc_dstgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_outfile_id, nc_dstgrdimask_id, 
+     &                          'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid area arrays
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_grid_area', 
+     &                     NF_DOUBLE, grid1_rank, nc_grid1size_id, 
+     &                     nc_srcgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_grid_area', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dstgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid fraction arrays
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_grid_frac', 
+     &                     NF_DOUBLE, grid1_rank, nc_grid1size_id, 
+     &                     nc_srcgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_grid_frac', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dstgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define source array
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_array', 
+     &                     NF_DOUBLE, grid1_rank, nc_grid1size_id, 
+     &                     nc_srcarray_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define gradient arrays
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_grad_lat', 
+     &                     NF_DOUBLE, grid1_rank, nc_grid1size_id, 
+     &                     nc_srcgradlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_grad_lon', 
+     &                     NF_DOUBLE, grid1_rank, nc_grid1size_id, 
+     &                     nc_srcgradlon_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define destination arrays
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_array1', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dstarray1_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_array1a', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dstarray1a_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_array2', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dstarray2_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define error arrays
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_error1', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dsterror1_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_error1a', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dsterror1a_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_error2', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dsterror2_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** end definition stage
+      !***
+
+      ncstat = nf_enddef(nc_outfile_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     write some grid info
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** write grid center latitude array
+      !***
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_srcgrdcntrlat_id,
+     &                           grid1_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_dstgrdcntrlat_id,
+     &                           grid2_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** write grid center longitude array
+      !***
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_srcgrdcntrlon_id,
+     &                           grid1_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_dstgrdcntrlon_id,
+     &                           grid2_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** write grid mask
+      !***
+
+      ncstat = nf_put_var_int(nc_outfile_id, nc_srcgrdimask_id,
+     &                        grid1_imask)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_outfile_id, nc_dstgrdimask_id,
+     &                        grid2_imask)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid area arrays
+      !***
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_srcgrdarea_id,
+     &                           grid1_area)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_dstgrdarea_id,
+     &                           grid2_area)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid fraction arrays
+      !***
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_srcgrdfrac_id,
+     &                           grid1_frac)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_dstgrdfrac_id,
+     &                           grid2_frac)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     set up fields for test cases based on user choice
+!
+!-----------------------------------------------------------------------
+
+      select case (field_choice)
+      case(1)  !*** cosine hill at lon=pi and lat=0
+
+        length = 0.1*pi2
+
+        grid1_array = cos(grid1_center_lat)*cos(grid1_center_lon)
+        grid2_array = cos(grid2_center_lat)*cos(grid2_center_lon)
+
+        grid1_tmp = acos(-grid1_array)/length
+        grid2_tmp = acos(-grid2_array)/length
+
+        where (grid1_tmp <= one)
+          grad1_lat   = (pi/length)*sin(pi*grid1_tmp)*
+     &                  sin(grid1_center_lat)*cos(grid1_center_lon)/
+     &                  sqrt(one-grid1_array**2)
+          grad1_lon   = (pi/length)*sin(pi*grid1_tmp)*
+     &                  sin(grid1_center_lon)/
+     &                  sqrt(one-grid1_array**2)
+          grid1_array = two + cos(pi*grid1_tmp)
+        elsewhere
+          grid1_array = one
+          grad1_lat   = zero
+          grad1_lon   = zero
+        endwhere
+        
+        where (grid2_tmp <= one)
+          grid2_array = two + cos(pi*grid2_tmp)
+        elsewhere
+          grid2_array = one
+        endwhere
+        
+        where (.not. grid1_mask)
+          grid1_array = zero
+          grad1_lat   = zero
+          grad1_lon   = zero
+        end where
+
+        where (grid2_frac < .001) grid2_array = zero
+
+      case(2)  !*** pseudo-spherical harmonic l=2,m=2
+
+        where (grid1_mask)
+          grid1_array = two + cos(grid1_center_lat)**2*
+     &                    cos(two*grid1_center_lon)
+          grad1_lat   = -sin(two*grid1_center_lat)*
+     &                   cos(two*grid1_center_lon)
+          grad1_lon   = -two*cos(grid1_center_lat)*
+     &                   sin(two*grid1_center_lon)
+        elsewhere
+          grid1_array = zero
+          grad1_lat   = zero
+          grad1_lon   = zero
+        end where
+
+        where (grid2_frac > .001) 
+          grid2_array = two + cos(grid2_center_lat)**2*
+     &                        cos(two*grid2_center_lon)
+        elsewhere
+          grid2_array = zero
+        end where
+
+      case(3)  !*** pseudo-spherical harmonic l=32, m=16
+
+        where (grid1_mask)
+          grid1_array = two + sin(two*grid1_center_lat)**16*
+     &                        cos(16.*grid1_center_lon)
+          grad1_lat   = 32.*sin(two*grid1_center_lat)**15*
+     &                      cos(two*grid1_center_lat)*
+     &                      cos(16.*grid1_center_lon)
+          grad1_lon   = -32.*sin(two*grid1_center_lat)**15*
+     &                       sin(grid1_center_lat)*
+     &                   sin(16.*grid1_center_lon)
+        elsewhere
+          grid1_array = zero
+          grad1_lat   = zero
+          grad1_lon   = zero
+        end where
+
+        where (grid2_frac > .001) 
+          grid2_array = two + sin(two*grid2_center_lat)**16*
+     &                        cos(16.*grid2_center_lon)
+        elsewhere
+          grid2_array = zero
+        end where
+
+      case default
+
+        stop 'Bad choice for field to interpolate'
+
+      end select
+
+!-----------------------------------------------------------------------
+!
+!     if bicubic, we need 3 gradients in logical space
+!
+!-----------------------------------------------------------------------
+
+      if (map_type == map_type_bicubic) then
+        allocate (grad1_latlon (grid1_size)) 
+
+        nx = grid1_dims(1)
+        ny = grid1_dims(2)
+
+        do n=1,grid1_size
+
+          grad1_lat(n) = zero
+          grad1_lon(n) = zero
+          grad1_latlon(n) = zero
+
+          if (grid1_mask(n)) then
+
+            delew = half
+            delns = half
+
+            j = (n-1)/nx + 1
+            i = n - (j-1)*nx
+
+            ip1 = i+1
+            im1 = i-1
+            jp1 = j+1
+            jm1 = j-1
+
+            if (ip1 > nx) ip1 = ip1 - nx
+            if (im1 < 1 ) im1 = nx
+            if (jp1 > ny) then
+              jp1 = j
+              delns = one
+            endif
+            if (jm1 < 1 ) then
+              jm1 = j
+              delns = one
+            endif
+
+            in  = (jp1-1)*nx + i
+            is  = (jm1-1)*nx + i
+            ie  = (j  -1)*nx + ip1
+            iw  = (j  -1)*nx + im1
+
+            ine = (jp1-1)*nx + ip1
+            inw = (jp1-1)*nx + im1
+            ise = (jm1-1)*nx + ip1
+            isw = (jm1-1)*nx + im1
+
+            !*** compute i-gradient
+
+            if (.not. grid1_mask(ie)) then
+              ie = n
+              delew = one
+            endif
+            if (.not. grid1_mask(iw)) then
+              iw = n
+              delew = one
+            endif
+ 
+            grad1_lat(n) = delew*(grid1_array(ie) - grid1_array(iw))
+
+            !*** compute j-gradient
+
+            if (.not. grid1_mask(in)) then
+              in = n
+              delns = one
+            endif
+            if (.not. grid1_mask(is)) then
+              is = n
+              delns = one
+            endif
+ 
+            grad1_lon(n) = delns*(grid1_array(in) - grid1_array(is))
+
+            !*** compute ij-gradient
+
+            delew = half
+            if (jp1 == j .or. jm1 == j) then
+              delns = one
+            else 
+              delns = half
+            endif
+
+            if (.not. grid1_mask(ine)) then
+              if (in /= n) then
+                ine = in
+                delew = one
+              else if (ie /= n) then
+                ine = ie
+                inw = iw
+                if (inw == n) delew = one
+                delns = one
+              else
+                ine = n
+                inw = iw
+                delew = one
+                delns = one
+              endif
+            endif
+
+            if (.not. grid1_mask(inw)) then
+              if (in /= n) then
+                inw = in
+                delew = one
+              else if (iw /= n) then
+                inw = iw
+                ine = ie
+                if (ie == n) delew = one
+                delns = one
+              else
+                inw = n
+                ine = ie
+                delew = one
+                delns = one
+              endif
+            endif
+
+            grad1_lat_zero(n) = delew*(grid1_array(ine) -
+     &                                 grid1_array(inw))
+
+            if (.not. grid1_mask(ise)) then
+              if (is /= n) then
+                ise = is
+                delew = one
+              else if (ie /= n) then
+                ise = ie
+                isw = iw
+                if (isw == n) delew = one
+                delns = one
+              else
+                ise = n
+                isw = iw
+                delew = one
+                delns = one
+              endif
+            endif
+
+            if (.not. grid1_mask(isw)) then
+              if (is /= n) then
+                isw = is
+                delew = one
+              else if (iw /= n) then
+                isw = iw
+                ise = ie
+                if (ie == n) delew = one
+                delns = one
+              else
+                isw = n
+                ise = ie
+                delew = one
+                delns = one
+              endif
+            endif
+
+            grad1_lon_zero(n) = delew*(grid1_array(ise) -
+     &                                 grid1_array(isw))
+
+            grad1_latlon(n) = delns*(grad1_lat_zero(n) -
+     &                               grad1_lon_zero(n))
+
+          endif
+        enddo
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     test a first-order map from grid1 to grid2
+!
+!-----------------------------------------------------------------------
+
+      grad1_lat_zero = zero
+      grad1_lon_zero = zero
+
+      if (map_type /= map_type_bicubic) then
+        call remap(grid2_tmp, wts_map1, grid2_add_map1, grid1_add_map1,
+     &             grid1_array)
+      else
+        call remap(grid2_tmp, wts_map1, grid2_add_map1, grid1_add_map1,
+     &             grid1_array, src_grad1=grad1_lat,
+     &                          src_grad2=grad1_lon,
+     &                          src_grad3=grad1_latlon)
+      endif
+
+      if (map_type == map_type_conserv) then
+        select case (norm_opt)
+        case (norm_opt_none)
+          grid2_err = grid2_frac*grid2_area
+          where (grid2_err /= zero)
+            grid2_tmp = grid2_tmp/grid2_err
+          else where
+            grid2_tmp = zero
+          end where
+        case (norm_opt_frcarea)
+        case (norm_opt_dstarea)
+          where (grid2_frac /= zero)
+            grid2_tmp = grid2_tmp/grid2_frac
+          else where
+            grid2_tmp = zero
+          end where
+        end select
+      end if
+
+      where (grid2_frac > .999)
+        grid2_err = (grid2_tmp - grid2_array)/grid2_array
+      elsewhere 
+        grid2_err = zero
+      end where
+
+      print *,'First order mapping from grid1 to grid2:'
+      print *,'----------------------------------------'
+      print *,'Grid1 min,max: ',minval(grid1_array),maxval(grid1_array)
+      print *,'Grid2 min,max: ',minval(grid2_tmp  ),maxval(grid2_tmp  )
+      print *,' Err2 min,max: ',minval(grid2_err),maxval(grid2_err)
+      print *,' Err2    mean: ',sum(abs(grid2_err))/
+     &                          count(grid2_frac > .999)
+
+      !***
+      !*** Conservation Test
+      !***
+
+      print *,'Conservation:'
+      print *,'Grid1 Integral = ',sum(grid1_array*grid1_area*grid1_frac)
+      print *,'Grid2 Integral = ',sum(grid2_tmp  *grid2_area*grid2_frac)
+
+!-----------------------------------------------------------------------
+!
+!     write results to NetCDF file
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_srcarray_id,
+     &                           grid1_array)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_dstarray1_id,
+     &                           grid2_tmp  )
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_dsterror1_id,
+     &                           grid2_err)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     for conservative mappings:
+!     test a second-order map from grid1 to grid2 with only lat grads
+!
+!-----------------------------------------------------------------------
+
+      if (map_type == map_type_conserv) then
+
+        call remap(grid2_tmp, wts_map1, grid2_add_map1, grid1_add_map1,
+     &             grid1_array, src_grad1=grad1_lat,
+     &                          src_grad2=grad1_lon_zero) 
+
+        select case (norm_opt)
+        case (norm_opt_none)
+          grid2_err = grid2_frac*grid2_area
+          where (grid2_err /= zero)
+            grid2_tmp = grid2_tmp/grid2_err
+          else where
+            grid2_tmp = zero
+          end where
+        case (norm_opt_frcarea)
+        case (norm_opt_dstarea)
+          where (grid2_frac /= zero)
+            grid2_tmp = grid2_tmp/grid2_frac
+          else where
+            grid2_tmp = zero
+          end where
+        end select
+
+        where (grid2_frac > .999)
+          grid2_err = (grid2_tmp - grid2_array)/grid2_array
+        elsewhere 
+          grid2_err = zero
+        end where
+
+        print *,'Second order mapping from grid1 to grid2 (lat only):'
+        print *,'----------------------------------------'
+        print *,'Grid1 min,max: ',minval(grid1_array),
+     &                            maxval(grid1_array)
+        print *,'Grid2 min,max: ',minval(grid2_tmp  ),
+     &                            maxval(grid2_tmp  )
+        print *,' Err2 min,max: ',minval(grid2_err),maxval(grid2_err)
+        print *,' Err2    mean: ',sum(abs(grid2_err))/
+     &                            count(grid2_frac > .999)
+
+        !***
+        !*** Conservation Test
+        !***
+
+        print *,'Conservation:'
+        print *,'Grid1 Integral = ',
+     &          sum(grid1_array*grid1_area*grid1_frac)
+        print *,'Grid2 Integral = ',
+     &          sum(grid2_tmp  *grid2_area*grid2_frac)
+
+!-----------------------------------------------------------------------
+!
+!       write results to NetCDF file
+!
+!-----------------------------------------------------------------------
+
+        ncstat = nf_put_var_double(nc_outfile_id, nc_srcgradlat_id,
+     &                             grad1_lat)
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_double(nc_outfile_id, nc_dstarray1a_id,
+     &                             grid2_tmp  )
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_double(nc_outfile_id, nc_dsterror1a_id,
+     &                             grid2_err)
+        call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     for conservative mappings:
+!     test a second-order map from grid1 to grid2
+!
+!-----------------------------------------------------------------------
+
+        call remap(grid2_tmp,wts_map1,grid2_add_map1,grid1_add_map1,
+     &             grid1_array, src_grad1=grad1_lat,
+     &                          src_grad2=grad1_lon) 
+
+        select case (norm_opt)
+        case (norm_opt_none)
+          grid2_err = grid2_frac*grid2_area
+          where (grid2_err /= zero)
+            grid2_tmp = grid2_tmp/grid2_err
+          else where
+            grid2_tmp = zero
+          end where
+        case (norm_opt_frcarea)
+        case (norm_opt_dstarea)
+          where (grid2_frac /= zero)
+            grid2_tmp = grid2_tmp/grid2_frac
+          else where
+            grid2_tmp = zero
+          end where
+        end select
+
+        where (grid2_frac > .999)
+          grid2_err = (grid2_tmp - grid2_array)/grid2_array
+        elsewhere 
+          grid2_err = zero
+        end where
+
+        print *,'Second order mapping from grid1 to grid2:'
+        print *,'-----------------------------------------'
+        print *,'Grid1 min,max: ',minval(grid1_array),
+     &                            maxval(grid1_array)
+        print *,'Grid2 min,max: ',minval(grid2_tmp  ),
+     &                            maxval(grid2_tmp  )
+        print *,' Err2 min,max: ',minval(grid2_err),maxval(grid2_err)
+        print *,' Err2    mean: ',sum(abs(grid2_err))/
+     &                            count(grid2_frac > .999)
+
+        !***
+        !*** Conservation Test
+        !***
+
+        print *,'Conservation:'
+        print *,'Grid1 Integral = ',
+     &           sum(grid1_array*grid1_area*grid1_frac)
+        print *,'Grid2 Integral = ',
+     &           sum(grid2_tmp  *grid2_area*grid2_frac)
+
+!-----------------------------------------------------------------------
+!
+!       write results to NetCDF file
+!
+!-----------------------------------------------------------------------
+
+        ncstat = nf_put_var_double(nc_outfile_id, nc_srcgradlon_id,
+     &                             grad1_lon)
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_double(nc_outfile_id, nc_dstarray2_id,
+     &                             grid2_tmp  )
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_double(nc_outfile_id, nc_dsterror2_id,
+     &                             grid2_err)
+        call netcdf_error_handler(ncstat)
+
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     close netCDF file
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_close(nc_outfile_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     calculate some statistics
+!
+!-----------------------------------------------------------------------
+
+      grid2_count = zero
+      grid2_tmp   = zero
+      grid2_err   = zero
+
+      print *,'number of sparse matrix entries ',num_links_map1
+      do n=1,num_links_map1
+        grid2_count(grid2_add_map1(n)) = 
+     &  grid2_count(grid2_add_map1(n)) + 1
+        if (wts_map1(1,n) > one .or. wts_map1(1,n) < zero) then
+          grid2_tmp(grid2_add_map1(n)) = 
+     &    grid2_tmp(grid2_add_map1(n)) + 1
+          grid2_err(grid2_add_map1(n)) = max(abs(wts_map1(1,n)),
+     &    grid2_err(grid2_add_map1(n)) )
+        endif
+      end do
+
+      do n=1,grid2_size
+        if (grid2_tmp(n) > zero) print *,n,grid2_err(n)
+      end do
+
+      imin = minval(grid2_count, mask=(grid2_count > 0))
+      imax = maxval(grid2_count)
+      idiff =  (imax - imin)/10 + 1
+      print *,'total number of dest cells ',grid2_size
+      print *,'number of cells participating in remap ',
+     &   count(grid2_count > zero)
+      print *,'min no of entries/row = ',imin
+      print *,'max no of entries/row = ',imax
+
+      imax = imin + idiff
+      do n=1,10
+        print *,'num of rows with entries between ',imin,' - ',imax-1,
+     &     count(grid2_count >= imin .and. grid2_count < imax)
+        imin = imin + idiff
+        imax = imax + idiff
+      end do
+
+!-----------------------------------------------------------------------
+
+      end program remap_test
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/scrip_test_repeat.f
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/scrip_test_repeat.f	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/scrip_test_repeat.f	(revision 2528)
@@ -0,0 +1,709 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this program is a short driver that tests the remappings using
+!     a simple analytic field.  the results are written in netCDF
+!     format.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: scrip_test_repeat.f,v 1.3 2000/04/19 21:56:26 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      program remap_test_repeat
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod    ! defines common data types
+      use constants    ! defines common constants
+      use iounits      ! I/O unit manager
+      use netcdf_mod   ! netcdf I/O stuff
+      use grids        ! module containing grid info
+      use remap_vars   ! module containing remapping info
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     interface for remap routine
+!
+!-----------------------------------------------------------------------
+
+      interface
+        subroutine remap(dst_array, map_wts, dst_add, src_add, 
+     &                   src_array, src_grad1, src_grad2, src_grad3)
+
+        use kinds_mod
+        use constants
+
+        implicit none
+
+        integer (kind=int_kind), dimension(:), intent(in) ::
+     &       dst_add, src_add 
+
+        real (kind=dbl_kind), dimension(:,:), intent(in) :: map_wts
+
+        real (kind=dbl_kind), dimension(:), intent(in) :: src_array
+
+        real (kind=dbl_kind), dimension(:), intent(in), optional ::
+     &     src_grad1, src_grad2, src_grad3
+
+        real (kind=dbl_kind), dimension(:), intent(inout) :: dst_array
+
+        end subroutine remap
+      end interface
+
+!-----------------------------------------------------------------------
+!
+!     input namelist variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) ::
+     &           field_choice, ! choice of field to be interpolated
+     &           num_repeats   ! number of times to repeat remappings
+
+      character (char_len) :: 
+     &           interp_file1, ! filename containing remap data (map1)
+     &           interp_file2, ! filename containing remap data (map2)
+     &           output_file   ! filename containing output test data
+
+      namelist /remap_inputs/ field_choice, num_repeats,
+     &                        interp_file1, interp_file2, output_file
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      character (char_len) :: 
+     &           map_name1,    ! name for mapping from grid1 to grid2
+     &           map_name2     ! name for mapping from grid2 to grid1
+
+      integer (kind=int_kind) ::    ! netCDF ids for files and arrays
+     &        n, ncstat, nc_outfile_id, 
+     &        nc_srcgrdcntrlat_id, nc_srcgrdcntrlon_id,
+     &        nc_dstgrdcntrlat_id, nc_dstgrdcntrlon_id,
+     &        nc_srcgrdrank_id, nc_dstgrdrank_id,
+     &        nc_srcgrdimask_id, nc_dstgrdimask_id,
+     &        nc_srcgrdarea_id, nc_dstgrdarea_id,
+     &        nc_srcgrdfrac_id, nc_dstgrdfrac_id,
+     &        nc_srcarray_id, nc_srcgradlat_id, nc_srcgradlon_id,
+     &        nc_dstarray1_id, nc_dstarray2_id,
+     &        nc_dsterror1_id, nc_dsterror2_id
+
+      integer (kind=int_kind), dimension(:), allocatable ::
+     &        nc_grid1size_id, nc_grid2size_id
+
+!-----------------------------------------------------------------------
+
+      character (char_len) :: 
+     &          dim_name    ! netCDF dimension name
+
+      integer (kind=int_kind) :: i,j,n,
+     &    iunit  ! unit number for namelist file
+
+      integer (kind=int_kind), dimension(:), allocatable ::
+     &    grid1_imask, grid2_imask
+
+      real (kind=dbl_kind) ::
+     &    length            ! length scale for cosine hill test field
+
+      real (kind=dbl_kind), dimension(:), allocatable ::
+     &    grid1_array, 
+     &    grid1_tmp, 
+     &    grad1_lat, 
+     &    grad1_lon, 
+     &    grid2_array, 
+     &    grid2_err,
+     &    grid2_tmp,
+     &    grad2_lat, 
+     &    grad2_lon  
+
+!-----------------------------------------------------------------------
+!
+!     read namelist for file and mapping info
+!
+!-----------------------------------------------------------------------
+
+      call get_unit(iunit)
+      open(iunit, file='repeat_test_in', status='old', form='formatted')
+      read(iunit, nml=remap_inputs)
+      call release_unit(iunit)
+      write(*,nml=remap_inputs)
+
+!-----------------------------------------------------------------------
+!
+!     read remapping data
+!
+!-----------------------------------------------------------------------
+
+      num_maps = 2
+
+      call read_remap(map_name1, map_name2, interp_file1, interp_file2)
+
+!-----------------------------------------------------------------------
+!
+!     allocate arrays
+!
+!-----------------------------------------------------------------------
+
+      allocate (grid1_array    (grid1_size), 
+     &          grid1_tmp      (grid1_size),
+     &          grad1_lat      (grid1_size), 
+     &          grad1_lon      (grid1_size), 
+     &          grid1_imask    (grid1_size),
+     &          grid2_array    (grid2_size), 
+     &          grid2_err      (grid2_size),
+     &          grid2_tmp      (grid2_size),
+     &          grad2_lat      (grid2_size), 
+     &          grad2_lon      (grid2_size), 
+     &          grid2_imask    (grid2_size))
+
+      where (grid1_mask)
+        grid1_imask = 1
+      elsewhere
+        grid1_imask = 0
+      endwhere
+      where (grid2_mask)
+        grid2_imask = 1
+      elsewhere
+        grid2_imask = 0
+      endwhere
+
+!-----------------------------------------------------------------------
+!
+!     setup a NetCDF file for output
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** create netCDF dataset 
+      !***
+
+      ncstat = nf_create (output_file, NF_CLOBBER, nc_outfile_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_outfile_id, NF_GLOBAL, 'title',
+     &                          len_trim(map_name1), map_name1)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid size dimensions
+      !***
+
+      allocate( nc_grid1size_id(grid1_rank),
+     &          nc_grid2size_id(grid2_rank))
+
+      do n=1,grid1_rank
+        write(dim_name,1000) 'grid1_dim',n
+        ncstat = nf_def_dim (nc_outfile_id, dim_name, 
+     &                       grid1_dims(n), nc_grid1size_id(n))
+        call netcdf_error_handler(ncstat)
+      end do
+
+      do n=1,grid2_rank
+        write(dim_name,1000) 'grid2_dim',n
+        ncstat = nf_def_dim (nc_outfile_id, dim_name, 
+     &                       grid2_dims(n), nc_grid2size_id(n))
+        call netcdf_error_handler(ncstat)
+      end do
+ 1000 format(a9,i1)
+
+      !***
+      !*** define grid center latitude array
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_grid_center_lat', 
+     &                     NF_DOUBLE, grid1_rank, nc_grid1size_id, 
+     &                     nc_srcgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_outfile_id, nc_srcgrdcntrlat_id, 
+     &                          'units', 7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_grid_center_lat', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dstgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_outfile_id, nc_dstgrdcntrlat_id, 
+     &                          'units', 7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid center longitude array
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_grid_center_lon', 
+     &                     NF_DOUBLE, grid1_rank, nc_grid1size_id, 
+     &                     nc_srcgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_outfile_id, nc_srcgrdcntrlon_id, 
+     &                          'units', 7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_grid_center_lon', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dstgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_outfile_id, nc_dstgrdcntrlon_id, 
+     &                          'units', 7, 'radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid mask
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_grid_imask', NF_INT,
+     &               grid1_rank, nc_grid1size_id, nc_srcgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_outfile_id, nc_srcgrdimask_id, 
+     &                          'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_grid_imask', NF_INT,
+     &               grid2_rank, nc_grid2size_id, nc_dstgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_outfile_id, nc_dstgrdimask_id, 
+     &                          'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid area arrays
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_grid_area', 
+     &                     NF_DOUBLE, grid1_rank, nc_grid1size_id, 
+     &                     nc_srcgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_grid_area', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dstgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid fraction arrays
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_grid_frac', 
+     &                     NF_DOUBLE, grid1_rank, nc_grid1size_id, 
+     &                     nc_srcgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_grid_frac', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dstgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define source array
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_array', 
+     &                     NF_DOUBLE, grid1_rank, nc_grid1size_id, 
+     &                     nc_srcarray_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define gradient arrays
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_grad_lat', 
+     &                     NF_DOUBLE, grid1_rank, nc_grid1size_id, 
+     &                     nc_srcgradlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'src_grad_lon', 
+     &                     NF_DOUBLE, grid1_rank, nc_grid1size_id, 
+     &                     nc_srcgradlon_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define destination arrays
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_array1', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dstarray1_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_array2', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dstarray2_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define error arrays
+      !***
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_error1', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dsterror1_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_outfile_id, 'dst_error2', 
+     &                     NF_DOUBLE, grid2_rank, nc_grid2size_id, 
+     &                     nc_dsterror2_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** end definition stage
+      !***
+
+      ncstat = nf_enddef(nc_outfile_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     write some grid info
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** write grid center latitude array
+      !***
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_srcgrdcntrlat_id,
+     &                           grid1_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_dstgrdcntrlat_id,
+     &                           grid2_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** write grid center longitude array
+      !***
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_srcgrdcntrlon_id,
+     &                           grid1_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_dstgrdcntrlon_id,
+     &                           grid2_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** write grid mask
+      !***
+
+      ncstat = nf_put_var_int(nc_outfile_id, nc_srcgrdimask_id,
+     &                        grid1_imask)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_outfile_id, nc_dstgrdimask_id,
+     &                        grid2_imask)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid area arrays
+      !***
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_srcgrdarea_id,
+     &                           grid1_area)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_dstgrdarea_id,
+     &                           grid2_area)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid fraction arrays
+      !***
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_srcgrdfrac_id,
+     &                           grid1_frac)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_dstgrdfrac_id,
+     &                           grid2_frac)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     set up fields for test cases based on user choice
+!
+!-----------------------------------------------------------------------
+
+      select case (field_choice)
+      case(1)  !*** cosine hill at lon=pi and lat=0
+
+        length = 0.1*pi2
+
+        grid1_array = cos(grid1_center_lat)*cos(grid1_center_lon)
+        grid2_array = cos(grid2_center_lat)*cos(grid2_center_lon)
+
+        grid1_tmp = acos(-grid1_array)/length
+        grid2_tmp = acos(-grid2_array)/length
+
+        where (grid1_tmp <= one)
+          grad1_lat   = (pi/length)*sin(pi*grid1_tmp)*
+     &                  sin(grid1_center_lat)*cos(grid1_center_lon)/
+     &                  sqrt(one-grid1_array**2)
+          grad1_lon   = (pi/length)*sin(pi*grid1_tmp)*
+     &                  sin(grid1_center_lon)/
+     &                  sqrt(one-grid1_array**2)
+          grid1_array = two + cos(pi*grid1_tmp)
+        elsewhere
+          grid1_array = one
+          grad1_lat   = zero
+          grad1_lon   = zero
+        endwhere
+        
+        where (grid2_tmp <= one)
+          grad2_lat   = (pi/length)*sin(pi*grid2_tmp)*
+     &                  sin(grid2_center_lat)*cos(grid2_center_lon)/
+     &                  sqrt(one-grid2_array**2)
+          grad2_lon   = (pi/length)*sin(pi*grid2_tmp)*
+     &                  sin(grid2_center_lon)/
+     &                  sqrt(one-grid2_array**2)
+          grid2_array = two + cos(pi*grid2_tmp)
+        elsewhere
+          grid2_array = one
+          grad2_lat   = zero
+          grad2_lon   = zero
+        endwhere
+        
+        where (.not. grid1_mask)
+          grid1_array = zero
+          grad1_lat   = zero
+          grad1_lon   = zero
+        end where
+
+        where (.not. grid2_mask)
+          grid2_array = zero
+          grad2_lat   = zero
+          grad2_lon   = zero
+        end where
+
+      case(2)  !*** pseudo-spherical harmonic l=2,m=2
+
+        where (grid1_mask)
+          grid1_array = two + cos(grid1_center_lat)**2*
+     &                    cos(two*grid1_center_lon)
+          grad1_lat   = -sin(two*grid1_center_lat)*
+     &                   cos(two*grid1_center_lon)
+          grad1_lon   = -two*cos(grid1_center_lat)*
+     &                   sin(two*grid1_center_lon)
+        elsewhere
+          grid1_array = zero
+          grad1_lat   = zero
+          grad1_lon   = zero
+        end where
+
+        where (grid2_mask)
+          grid2_array = two + cos(grid2_center_lat)**2*
+     &                        cos(two*grid2_center_lon)
+          grad2_lat   = -sin(two*grid2_center_lat)*
+     &                   cos(two*grid2_center_lon)
+          grad2_lon   = -two*cos(grid2_center_lat)*
+     &                   sin(two*grid2_center_lon)
+        elsewhere
+          grid2_array = zero
+          grad2_lat   = zero
+          grad2_lon   = zero
+        end where
+
+      case(3)  !*** pseudo-spherical harmonic l=32, m=16
+
+        where (grid1_mask)
+          grid1_array = two + sin(two*grid1_center_lat)**16*
+     &                        cos(16.*grid1_center_lon)
+          grad1_lat   = 32.*sin(two*grid1_center_lat)**15*
+     &                      cos(two*grid1_center_lat)*
+     &                      cos(16.*grid1_center_lon)
+          grad1_lon   = -32.*sin(two*grid1_center_lat)**15*
+     &                       sin(grid1_center_lat)*
+     &                   sin(16.*grid1_center_lon)
+        elsewhere
+          grid1_array = zero
+          grad1_lat   = zero
+          grad1_lon   = zero
+        end where
+
+        where (grid2_mask)
+          grid2_array = two + sin(two*grid2_center_lat)**16*
+     &                        cos(16.*grid2_center_lon)
+          grad2_lat   = 32.*sin(two*grid2_center_lat)**15*
+     &                      cos(two*grid2_center_lat)*
+     &                      cos(16.*grid2_center_lon)
+          grad2_lon   = -32.*sin(two*grid2_center_lat)**15*
+     &                       sin(grid2_center_lat)*
+     &                   sin(16.*grid2_center_lon)
+        elsewhere
+          grid2_array = zero
+          grad2_lat   = zero
+          grad2_lon   = zero
+        end where
+
+      case default
+
+        stop 'Bad choice for field to interpolate'
+
+      end select
+
+!-----------------------------------------------------------------------
+!
+!     test repeated first-order maps between grid1 and grid2
+!
+!-----------------------------------------------------------------------
+
+      call remap(grid2_tmp, wts_map1, grid2_add_map1, grid1_add_map1,
+     &           grid1_array)
+      do n=1,num_repeats
+        call remap(grid1_tmp, wts_map2, grid1_add_map2, grid2_add_map2,
+     &             grid2_tmp)
+        call remap(grid2_tmp, wts_map1, grid2_add_map1, grid1_add_map1,
+     &             grid1_tmp)
+      end do
+
+      where (grid2_frac > .999)
+        grid2_err = (grid2_tmp - grid2_array)/grid2_array
+      elsewhere 
+        grid2_err = zero
+      end where
+
+      print *,'First order mapping from grid1 to grid2:'
+      print *,'----------------------------------------'
+      print *,'Grid1 min,max: ',minval(grid1_array),maxval(grid1_array)
+      print *,'Grid2 min,max: ',minval(grid2_tmp  ),maxval(grid2_tmp  )
+      print *,' Err2 min,max: ',minval(grid2_err),maxval(grid2_err)
+      print *,' Err2    mean: ',sum(abs(grid2_err))/
+     &                          count(grid2_frac > .001)
+
+      !***
+      !*** Conservation Test
+      !***
+
+      print *,'Conservation:'
+      print *,'Grid1 Integral = ',sum(grid1_array*grid1_area*grid1_frac)
+      print *,'Grid2 Integral = ',sum(grid2_tmp  *grid2_area*grid2_frac)
+
+!-----------------------------------------------------------------------
+!
+!     write results to NetCDF file
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_srcarray_id,
+     &                           grid1_array)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_dstarray1_id,
+     &                           grid2_tmp  )
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_dsterror1_id,
+     &                           grid2_err)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     test repeated second-order mapppings between grid1 and grid2
+!
+!-----------------------------------------------------------------------
+
+      if (num_wts > 1) then
+
+      call remap(grid2_tmp  , wts_map1, grid2_add_map1, grid1_add_map1,
+     &           grid1_array, src_grad1=grad1_lat,
+     &                        src_grad2=grad1_lon) 
+
+      do n=1,num_repeats
+        call remap(grid1_tmp, wts_map2, grid1_add_map2, grid2_add_map2,
+     &             grid2_tmp, src_grad1=grad2_lat,
+     &                        src_grad2=grad2_lon) 
+
+        call remap(grid2_tmp, wts_map1, grid2_add_map1, grid1_add_map1,
+     &             grid1_tmp, src_grad1=grad1_lat,
+     &                        src_grad2=grad1_lon) 
+
+      end do
+
+      where (grid2_frac > .999)
+        grid2_err = (grid2_tmp - grid2_array)/grid2_array
+      elsewhere 
+        grid2_err = zero
+      end where
+
+      print *,'Second order mapping from grid1 to grid2:'
+      print *,'-----------------------------------------'
+      print *,'Grid1 min,max: ',minval(grid1_array),maxval(grid1_array)
+      print *,'Grid2 min,max: ',minval(grid2_tmp  ),maxval(grid2_tmp  )
+      print *,' Err2 min,max: ',minval(grid2_err),maxval(grid2_err)
+      print *,' Err2    mean: ',sum(abs(grid2_err))/
+     &                          count(grid2_frac > .001)
+
+      !***
+      !*** Conservation Test
+      !***
+
+      print *,'Conservation:'
+      print *,'Grid1 Integral = ',sum(grid1_array*grid1_area*grid1_frac)
+      print *,'Grid2 Integral = ',sum(grid2_tmp  *grid2_area*grid2_frac)
+
+!-----------------------------------------------------------------------
+!
+!     write results to NetCDF file
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_srcgradlon_id,
+     &                           grad1_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_dstarray2_id,
+     &                           grid2_tmp  )
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_outfile_id, nc_dsterror2_id,
+     &                           grid2_err)
+      call netcdf_error_handler(ncstat)
+
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     close netCDF file
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_close(nc_outfile_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+
+      end program remap_test_repeat
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/timers.f
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/timers.f	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/timers.f	(revision 2528)
@@ -0,0 +1,343 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module uses F90 cpu time routines to allowing setting of
+!     multiple CPU timers.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: timers.f,v 1.2 2000/04/19 21:56:26 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module timers
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod
+
+      implicit none
+
+      integer (kind=int_kind), parameter ::  
+     &     max_timers = 99  ! max number of timers allowed
+
+      integer (kind=int_kind), save :: 
+     &     cycles_max       ! max value of clock allowed by system
+
+      integer (kind=int_kind), dimension(max_timers), save :: 
+     &     cycles1,         ! cycle number at start for each timer
+     &     cycles2          ! cycle number at stop  for each timer
+
+      real (kind=real_kind), save ::  
+     &     clock_rate       ! clock_rate in seconds for each cycle
+
+      real (kind=real_kind), dimension(max_timers), save ::  
+     &     cputime          ! accumulated cpu time in each timer
+
+      character (len=8), dimension(max_timers), save ::  
+     &     status           ! timer status string
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine timer_check(timer)
+
+!-----------------------------------------------------------------------
+!
+!     This routine checks a given timer.  This is primarily used to
+!     periodically accumulate time in the timer to prevent timer cycles
+!     from wrapping around max_cycles.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     Input Variables:
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::  
+     &    timer            ! timer number
+
+!-----------------------------------------------------------------------
+
+      if (status(timer) .eq. 'running') then
+        call timer_stop (timer)
+        call timer_start(timer)
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine timer_check
+
+!***********************************************************************
+
+      subroutine timer_clear(timer)
+
+!-----------------------------------------------------------------------
+!
+!     This routine resets a given timer.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     Input Variables:
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::  
+     &    timer            ! timer number
+
+!-----------------------------------------------------------------------
+
+      cputime(timer) = 0.0_real_kind  ! clear the timer
+
+!-----------------------------------------------------------------------
+
+      end subroutine timer_clear
+
+!***********************************************************************
+
+      function timer_get(timer)
+
+!-----------------------------------------------------------------------
+!
+!     This routine returns the result of a given timer.  This can be
+!     called instead of timer_print so that the calling routine can 
+!     print it in desired format.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     Input Variables:
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::  
+     &    timer            ! timer number
+
+!-----------------------------------------------------------------------
+!
+!     Output Variables:
+!
+!-----------------------------------------------------------------------
+
+      real (kind=real_kind) ::  
+     &     timer_get   ! accumulated cputime in given timer
+
+!-----------------------------------------------------------------------
+
+      if (status(timer) .eq. 'stopped') then
+        timer_get = cputime(timer)
+      else
+        call timer_stop(timer)
+        timer_get = cputime(timer)
+        call timer_start(timer)
+      endif
+
+!-----------------------------------------------------------------------
+
+      end function timer_get
+
+!***********************************************************************
+
+      subroutine timer_print(timer)
+
+!-----------------------------------------------------------------------
+!
+!     This routine prints the accumulated cpu time in given timer.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     Input Variables:
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::  
+     &    timer            ! timer number
+
+!-----------------------------------------------------------------------
+
+      !--- 
+      !--- print the cputime accumulated for timer 
+      !--- make sure timer is stopped
+      !---
+
+      if (status(timer) .eq. 'stopped') then
+        write(*,"(' CPU time for timer',i3,':',1p,e16.8)")  
+     &       timer,cputime(timer)
+      else
+        call timer_stop(timer)
+        write(*,"(' CPU time for timer',i3,':',1p,e16.8)")  
+     &       timer,cputime(timer)
+        call timer_start(timer)
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine timer_print
+
+!***********************************************************************
+
+      subroutine timer_start(timer)
+
+!-----------------------------------------------------------------------
+!
+!     This routine starts a given timer.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     Input Variables:
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::  
+     &    timer            ! timer number
+
+!-----------------------------------------------------------------------
+
+      !---
+      !--- Start the timer and change timer status.
+      !---
+
+      if (status(timer) .eq. 'stopped') then
+        call system_clock(count=cycles1(timer))
+        status(timer) = 'running'
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine timer_start
+
+!***********************************************************************
+
+      subroutine timer_stop(timer)
+
+!-----------------------------------------------------------------------
+!
+!     This routine stops a given timer.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     Input Variables:
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::  
+     &    timer            ! timer number
+
+!-----------------------------------------------------------------------
+
+      if (status(timer) .eq. 'running') then
+
+        !---
+        !--- Stop the desired timer.
+        !---
+
+        call system_clock(count=cycles2(timer))
+
+        !---
+        !--- check and correct for cycle wrapping
+        !---
+
+        if (cycles2(timer) .ge. cycles1(timer)) then
+          cputime(timer) = cputime(timer) + clock_rate*  
+     &                     (cycles2(timer) - cycles1(timer))
+        else
+          cputime(timer) = cputime(timer) + clock_rate*  
+     &                (cycles2(timer) - cycles1(timer) + cycles_max)
+        endif
+
+        !---
+        !--- Change timer status.
+        !---
+
+        status(timer)='stopped'
+
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine timer_stop
+
+!***********************************************************************
+
+      subroutine timers_init
+
+!-----------------------------------------------------------------------
+!
+!     This routine initializes some machine parameters necessary for
+!     computing cpu time from F90 intrinsics.
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: cycles ! count rate return by sys_clock
+
+!-----------------------------------------------------------------------
+
+      !---
+      !--- Initialize timer arrays and clock_rate.
+      !---
+
+      clock_rate = 0.0_real_kind
+      cycles1    = 0
+      cycles2    = 0
+      cputime    = 0.0_real_kind
+      status     = 'stopped'
+
+      !---
+      !--- Call F90 intrinsic system_clock to determine clock rate
+      !--- and maximum cycles.  If no clock available, print message.
+      !---
+
+      call system_clock(count_rate=cycles, count_max=cycles_max)
+
+      if (cycles /= 0) then
+        clock_rate = 1.0_real_kind/real(cycles)
+      else
+        clock_rate = 0.0_real_kind
+        print *, '--- No system clock available ---'
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine timers_init
+
+!***********************************************************************
+
+      end module timers
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/bin/freeform.py
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/bin/freeform.py	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/bin/freeform.py	(revision 2528)
@@ -0,0 +1,115 @@
+#!/usr/bin/env python2.6
+
+import os
+import shutil
+
+def freer(oldname, newname, fdir, edits):
+
+    fin = file(os.path.join(fdir,oldname))
+    lines = fin.readlines()
+    fin.close()
+
+    if not os.path.exists('src'):
+        print "creating src directory"
+        os.mkdir('src')
+    fout = file(os.path.join('src',newname), 'w')
+
+    lastline = None
+    for nextline in lines:
+        for edit in edits:
+            nextline = nextline.replace(edit[0],edit[1])
+        if nextline.strip().startswith('&'):
+            parts = lastline.split('!')
+            if parts[0].endswith('\n'):
+                parts[0] = parts[0].replace('\n',' &\n')
+            else:
+                parts[0] = parts[0] + ' & '
+            lastline = '!'.join(parts)
+            nextline = nextline.replace('&',' ')
+        if lastline is not None:
+            fout.write(lastline)
+        lastline = nextline
+
+    # - write out last line (this assumes it is not a continuation line)
+    fout.write(lastline)
+
+def scrip(adir, apairs, edits=[]):
+
+    if not os.path.exists('src'):
+        print "creating src directory"
+        os.mkdir('src')
+
+    for (f1,f2) in apairs:
+        if not f2.endswith('.f90'):
+            shutil.copy(os.path.join(adir,f1), os.path.join('src',f2))
+        else:
+            freer(f1,f2,adir,edits)
+
+if __name__ == "__main__":
+
+    # - changes to scrip routines made here
+
+    pairs = [('constants.f', 'constants.f90'),
+              ('copyright', 'copyright'),
+              ('grids.f', 'grids.f90'),
+              ('iounits.f', 'iounits.f90'),
+              ('kinds_mod.f', 'kinds_mod.f90'),
+              ('netcdf.f', 'netcdf_mod.f90'),
+              ('remap.f', 'remap.f90'),
+              ('remap_bicubic.f', 'remap_bicubic.f90'),
+              ('remap_bilinear.f', 'remap_bilinear.f90'),
+              ('remap_conserv.f', 'remap_conserv.f90'),
+              ('remap_distwgt.f', 'remap_distwgt.f90'),
+              ('remap_read.f', 'remap_read.f90'),
+              ('remap_vars.f', 'remap_vars.f90'),
+              ('remap_write.f', 'remap_write.f90'),
+              ('timers.f', 'timers.f90')]
+
+    # - add some edits
+    # - note that this is very crude method since every line is inspected for the first string
+    # - in every input file
+    # - you have been warned!
+
+    ed1 = [" .and."]
+    ed2 = ["subroutine netcdf_error_handler(istat, mess)"]
+    ed3 = ["    &    istat   ! integer status returned by netCDF function call",
+           "      character (len=*), intent(in), optional :: mess"]
+    ed4 = ["       if (present(mess)) then",
+           "         print *,'Error in netCDF: ',nf_strerror(istat), 'Message: ',mess",
+           "       else",
+           "         print *,'Error in netCDF: ',nf_strerror(istat)",
+           "       endif"]
+
+    edits = [(". and.",'\n'.join(ed1)),
+             ("subroutine netcdf_error_handler(istat)", '\n'.join(ed2)),
+             ("    &    istat   ! integer status returned by netCDF function call", '\n'.join(ed3)),
+             ("        print *,'Error in netCDF: ',nf_strerror(istat)", '\n'.join(ed4))
+            ]
+    scrip('SCRIP1.4/source', pairs, edits)
+
+
+    # - on to NOCS routines
+
+    pairs = [('scrip.F90', 'scrip.F90'),
+             ('scripgrid.F90', 'scripgrid.F90'),
+             ('scripgrid_mod.F90', 'scripgrid_mod.F90'),
+             ('scripinterp.F90', 'scripinterp.F90'),
+             ('scripinterp_mod.F90', 'scripinterp_mod.F90'),
+             ('scripshape.F90', 'scripshape.F90')]
+    scrip('nocsutil', pairs)
+
+    changes = """
+      SCRIP code, version 1.4, from Los Alamos National Laboratory (http://climate.lanl.gov/Software/SCRIP)
+
+      Changes made at NOCS for inclusion of weights generation code in NEMO 3.3 and later:
+
+          - File extensions changed from '.f' to '.f90'
+          - File netcdf.f renamed as netcdf_mod.f90 to avoid clash with netcdf library module filename
+          - File netcdf.f modified to add error message to netcdf_error_handler
+          - Small bug in remap_conserv when using gfortran compiler: replace ". and." with " .and."
+          - continuation lines reformatted with '&' moved from the start of the continuation line to 
+            the end of the line before
+    """
+    fp = file("src/CHANGES_BY_NOCS","w")
+    fp.write(changes)
+    fp.close()
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/nocsutil/CHANGES
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/nocsutil/CHANGES	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/nocsutil/CHANGES	(revision 2528)
@@ -0,0 +1,20 @@
+Release 1.1
+===========
+Modified for compilation by fcm in NEMO 3.3 framework.
+SCRIP 1.4 package included in unmodified form.
+python script added to transform into correct shape for fcm, producing copied code in 'src' directory
+
+scripshape.F90 now has one possible command line argument: the namelist file
+               from which it reads the names of the input and output files 
+               as well as the value for the cyclicity attribute
+
+Because gfortran doesnt understand ICHAR and GETCHAR system routines default behaviour of all programs
+is to ask for namelist filename during execution rather than reading it from the command line.
+Define symbol ARGC at compilation to return to original command line behaviour.
+
+Release 1.0
+===========
+Routines written by sga and acc at NOCS to use SCRIP library to produce weights
+
+Compilation by makefile and explicit compiler and options.
+
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/nocsutil/namelist_example_bilin
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/nocsutil/namelist_example_bilin	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/nocsutil/namelist_example_bilin	(revision 2528)
@@ -0,0 +1,101 @@
+&comments
+ -----------------------------------------------------------------------------------
+ - grid_inputs holds parameters for the scripgrid routine which reformats information 
+   about the input grids
+ - scripgrid always needs a coordinates.nc file in the
+   current directory and creates the remapped grid file correspondingly
+ - it uses the following namelist block to determine its actions
+     method:  only 'regular' is yet implemented, this assumes a cartesian grid
+     input_lon: name of longitude variable in the input_file
+     input_lat: name of latitude variable in the input_file
+     nemo_lon: name of longitude variable in the coordinates.nc
+     nemo_lat: name of latitude variable in the coordinates.nc
+/
+&grid_inputs
+    input_file = 'snow_1m_DUM_1958.nc'
+    nemo_file = 'coordinates.nc'
+    datagrid_file = 'remap_data_grid.nc'
+    nemogrid_file = 'remap_nemo_grid.nc'
+    method = 'regular'
+    input_lon = 'lon'
+    input_lat = 'lat'
+    nemo_lon = 'glamt'
+    nemo_lat = 'gphit'
+    nemo_mask = 'none'
+    nemo_mask_value = 10
+    input_mask = 'none'
+    input_mask_value = 10
+/
+&comments
+ -----------------------------------------------------------------------------------
+ - remap_inputs holds parameters for the scrip routine which calculates the weights
+   needed to convert between two grids
+ - two remap grid files are required as output by scripgrid
+ - num_maps is either 1 or 2 depending on whether the reverse transformation is required
+ - one or two interp_file names are then supplied; these hold the weights to convert 
+   one grid to another
+ - the map_name variable is just descriptive
+ - map_method can be 'bilinear' 'bicubic' or 'conservative' (the latter untested)
+ - normalize_opt should usually be 'frac' or else the user needs to do this scaling
+   manually (this seems to the case for fractional ice cover)
+ - restrict_type should be 'latitude' or 'latlon' in which case num_srch_bins only are 
+   used in one or two directions
+ - use_grid_area fields override the scrip calculation of area in case the model gets
+   slightly different answers, but the area needs to be supplied in the input files
+ - output_opt may be supplied and set to either 'scrip' or 'ncar-csm'
+/
+&remap_inputs
+    num_maps = 1
+    grid1_file = 'remap_data_grid.nc'
+    grid2_file = 'remap_nemo_grid.nc'
+    interp_file1 = 'data_nemo_bilin.nc'
+    interp_file2 = 'nemo_data_bilin.nc'
+    map1_name = 'data to nemo bilin Mapping'
+    map2_name = 'nemo to data bilin Mapping'
+    map_method = 'bilinear'
+    normalize_opt = 'frac'
+    output_opt = 'scrip'
+    restrict_type = 'latitude'
+    num_srch_bins = 90 
+    luse_grid1_area = .false.
+    luse_grid2_area = .false.
+/
+
+&interp_inputs
+    input_file = "snow_1m_DUM_1958.nc"
+    interp_file = "data_nemo_bilin.nc"
+    input_name = "snow"
+    input_start = 1,1,1,1
+    input_stride = 1,1,1,1
+    input_stop = 0,0,0,1
+    input_vars = 'initial_time0_hours'
+/
+
+&interp_outputs
+    output_file = "snow_orca.nc"
+    output_mode = "create"
+    output_dims = 'x', 'y', 'time_counter'
+    output_scaling = "snow|1.0", "time_counter|86400.0"
+    output_name = 'snow'
+    output_lon = 'x'
+    output_lat = 'y'
+    output_vars = 'time_counter'
+    output_attributes = 'time_counter|units|seconds since 1995-00-00 00:00:00',
+                        'time_counter|calendar|noleap',
+                        'snow|units|mm/s'
+/
+
+&comments
+ -----------------------------------------------------------------------------------
+ -  shape_inputs are the input fields required by scripshape.f90
+ -  first is the interpolation file created by scrip.f90 mapping data to model grid
+ -  second is the name of the output weights file to create
+ -  third is the east-west wrap to assume in the model (needed when calculating gradient 
+          terms in the bicubic scheme); the number is just the number of columns on one side
+          that are repeats of those on the opposite side (-1 for not cyclic)
+/
+&shape_inputs
+    interp_file = 'data_nemo_bilin.nc'
+    output_file = 'weights_bilin.nc'
+    ew_wrap     = 0
+/
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scrip.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scrip.F90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scrip.F90	(revision 2528)
@@ -0,0 +1,232 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This routine is the driver for computing the addresses and weights 
+!     for interpolating between two grids on a sphere.
+!
+!     Modified slightly to get name of namelist file from command line - sga 2/12/05
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: scrip.f,v 1.6 2001/08/21 21:06:44 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      program scrip
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod                  ! module defining data types
+      use constants                  ! module for common constants
+      use iounits                    ! I/O unit manager
+      use timers                     ! CPU timers
+      use grids                      ! module with grid information
+      use remap_vars                 ! common remapping variables
+      use remap_conservative         ! routines for conservative remap
+      use remap_distance_weight      ! routines for dist-weight remap
+      use remap_bilinear             ! routines for bilinear interp
+      use remap_bicubic              ! routines for bicubic  interp
+      use remap_write                ! routines for remap output
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     input namelist variables
+!
+!-----------------------------------------------------------------------
+
+      character (char_len) :: &
+         grid1_file,       &  ! filename of grid file containing grid1
+         grid2_file,       &  ! filename of grid file containing grid2
+         interp_file1,     &  ! filename for output remap data (map1)
+         interp_file2,     &  ! filename for output remap data (map2)
+         map1_name,        &  ! name for mapping from grid1 to grid2
+         map2_name,        &  ! name for mapping from grid2 to grid1
+         map_method,       &  ! choice for mapping method
+         normalize_opt,    &  ! option for normalizing weights
+         output_opt           ! option for output conventions
+
+      integer (kind=int_kind) :: &
+         nmap                 ! number of mappings to compute (1 or 2)
+
+      namelist /remap_inputs/ grid1_file, grid2_file,  &
+         interp_file1, interp_file2,                   &
+         map1_name, map2_name, num_maps,               &
+         luse_grid1_area, luse_grid2_area,             &
+         map_method, normalize_opt, output_opt,        &
+         restrict_type, num_srch_bins
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n,   &  ! dummy counter
+                                 iunit   ! unit number for namelist file
+
+      character (char_len) :: nm_in
+#if defined ARGC
+      integer :: iargc
+      external iargc
+
+      if (iargc() == 1) then
+        call getarg(1, nm_in)
+      else
+        write(6,*) 'need name of namelist file'
+        stop
+      endif
+#else
+      write(6,*) 'enter name for namelist file'
+      read(5,*) nm_in
+#endif
+
+!-----------------------------------------------------------------------
+!
+!     initialize timers
+!
+!-----------------------------------------------------------------------
+
+      call timers_init
+      do n=1,max_timers
+        call timer_clear(n)
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     read input namelist
+!
+!-----------------------------------------------------------------------
+
+      grid1_file    = 'unknown'
+      grid2_file    = 'unknown'
+      interp_file1  = 'unknown'
+      interp_file2  = 'unknown'
+      map1_name     = 'unknown'
+      map2_name     = 'unknown'
+      luse_grid1_area = .false.
+      luse_grid2_area = .false.
+      num_maps      = 2
+      map_type      = 1
+      normalize_opt = 'fracarea'
+      output_opt    = 'scrip'
+      restrict_type = 'latitude'
+      num_srch_bins = 900
+
+      call get_unit(iunit)
+      open(iunit, file=nm_in, status='old', form='formatted')
+      read(iunit, nml=remap_inputs)
+      call release_unit(iunit)
+
+      select case(map_method)
+      case ('conservative')
+        map_type = map_type_conserv
+        luse_grid_centers = .false.
+      case ('bilinear')
+        map_type = map_type_bilinear
+        luse_grid_centers = .true.
+      case ('bicubic')
+        map_type = map_type_bicubic
+        luse_grid_centers = .true.
+      case ('distwgt')
+        map_type = map_type_distwgt
+        luse_grid_centers = .true.
+      case default
+        stop 'unknown mapping method'
+      end select
+
+      select case(normalize_opt(1:4))
+      case ('none')
+        norm_opt = norm_opt_none
+      case ('frac')
+        norm_opt = norm_opt_frcarea
+      case ('dest')
+        norm_opt = norm_opt_dstarea
+      case default
+        stop 'unknown normalization option'
+      end select
+
+!-----------------------------------------------------------------------
+!
+!     initialize grid information for both grids
+!
+!-----------------------------------------------------------------------
+
+      call grid_init(grid1_file, grid2_file)
+
+      write(stdout, *) ' Computing remappings between: ',grid1_name
+      write(stdout, *) '                          and  ',grid2_name
+
+!-----------------------------------------------------------------------
+!
+!     initialize some remapping variables.
+!
+!-----------------------------------------------------------------------
+
+      call init_remap_vars
+
+!-----------------------------------------------------------------------
+!
+!     call appropriate interpolation setup routine based on type of
+!     remapping requested.
+!
+!-----------------------------------------------------------------------
+
+      select case(map_type)
+      case(map_type_conserv)
+        call remap_conserv
+      case(map_type_bilinear)
+        call remap_bilin
+      case(map_type_distwgt)
+        call remap_distwgt
+      case(map_type_bicubic)
+        call remap_bicub
+      case default
+        stop 'Invalid Map Type'
+      end select
+
+!-----------------------------------------------------------------------
+!
+!     reduce size of remapping arrays and then write remapping info
+!     to a file.
+!
+!-----------------------------------------------------------------------
+
+      if (num_links_map1 /= max_links_map1) then
+        call resize_remap_vars(1, num_links_map1-max_links_map1)
+      endif
+      if ((num_maps > 1) .and. (num_links_map2 /= max_links_map2)) then
+        call resize_remap_vars(2, num_links_map2-max_links_map2)
+      endif
+
+      call write_remap(map1_name, map2_name, &
+                       interp_file1, interp_file2, output_opt)
+
+!-----------------------------------------------------------------------
+
+      end program scrip
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripgrid.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripgrid.F90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripgrid.F90	(revision 2528)
@@ -0,0 +1,26 @@
+! ==============================================================================
+
+PROGRAM scripgrid
+
+  USE scripgrid_mod
+
+  CHARACTER(char_len) :: infile
+
+#if defined ARGC
+  INTEGER :: IARGC
+  EXTERNAL IARGC
+
+  if (IARGC() == 1) then
+    CALL GETARG(1, infile)
+    CALL convert( infile )
+  ELSE
+    write(6,*) 'need to supply a namelist file'
+  ENDIF
+#else
+  write(6,*) 'enter name of namelist file'
+  read(5,*) infile
+
+  CALL convert( infile )
+#endif
+
+END PROGRAM scripgrid
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripgrid_mod.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripgrid_mod.F90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripgrid_mod.F90	(revision 2528)
@@ -0,0 +1,764 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module creates grid description files for input to the SCRIP code
+!
+!-----------------------------------------------------------------------
+
+MODULE scripgrid_mod
+
+  USE kinds_mod
+  USE constants
+  USE iounits
+  USE netcdf
+  USE netcdf_mod
+  
+  IMPLICIT NONE
+
+  !-----------------------------------------------------------------------
+  !     module variables that describe the grid
+
+  INTEGER (kind=int_kind), parameter :: &
+       grid_rank = 2,         &
+       grid_corners = 4
+  INTEGER (kind=int_kind) :: nx, ny, grid_size
+  INTEGER (kind=int_kind), dimension(2) :: &
+       grid_dims,    &  ! size of x, y dimensions
+       grid_dim_ids     ! ids of the x, y dimensions
+  INTEGER (kind=int_kind), ALLOCATABLE, DIMENSION(:) :: &
+       grid_imask          ! land-sea mask
+  REAL (kind=int_kind), ALLOCATABLE, DIMENSION(:) :: &
+       grid_center_lat, &  ! lat/lon coordinates for
+       grid_center_lon     ! each grid center in degrees
+  REAL (kind=dbl_kind), ALLOCATABLE, DIMENSION(:,:) :: &
+       grid_corner_lat, &  ! lat/lon coordinates for
+       grid_corner_lon     ! each grid corner in degrees
+  REAL (kind=dbl_kind), ALLOCATABLE, DIMENSION(:,:,:) :: &
+       corner_lon, &
+       corner_lat
+  REAL (kind=dbl_kind), PARAMETER :: circle = 360.0
+
+  !-----------------------------------------------------------------------
+  !     module variables that describe the netcdf file
+
+  INTEGER (kind=int_kind) :: &
+       ncstat,           &   ! general netCDF status variable
+       ncid_in
+
+CONTAINS
+
+  ! ==============================================================================
+  
+  SUBROUTINE convert(nm_in)
+  
+    ! -----------------------------------------------------------------------------
+    ! - input variables
+  
+    CHARACTER(char_len), INTENT(in) ::  &
+      nm_in
+  
+    ! -----------------------------------------------------------------------------
+    ! - local variables
+  
+    CHARACTER(char_len) ::  &
+      nemo_file, input_file, method, input_lon, input_lat, datagrid_file, &
+      nemogrid_file, nemo_lon, nemo_lat, corn_lon, corn_lat, nemo_mask, input_mask
+    INTEGER (kind=int_kind), dimension(2) :: &
+      offset
+    INTEGER (kind=int_kind) :: &
+      iunit, nemo_mask_value, input_mask_value
+  
+    namelist /grid_inputs/ nemo_file, input_file, datagrid_file, nemogrid_file,  &
+                           method, input_lon, input_lat, nemo_lon, nemo_lat,     &
+                           nemo_mask, nemo_mask_value, input_mask, input_mask_value
+  
+    !-----------------------------------------------------------------------
+    ! - namelist describing the processing
+    !   note that mask_value is the minimum good value,
+    !   so that where the mask is less than the value is masked
+
+    nemo_file = "coordinates.nc"
+    nemo_lon = "glamt"
+    nemo_lat = "gphit"
+    input_lon = "lon"
+    input_lat = "lat"
+    input_mask = "none"
+    input_mask_value = 0
+    datagrid_file = 'remap_data_grid.nc'
+    nemogrid_file = 'remap_nemo_grid.nc'
+
+    call get_unit(iunit)
+    open(iunit, file=nm_in, status='old', form='formatted')
+    read(iunit, nml=grid_inputs) 
+    call release_unit(iunit)
+
+    if (trim(nemo_file) .eq. 'coordinates.nc') then
+
+      ! set up the names of the corner variables for a given input
+      ! the offset represents what needs to be added to (i,j) to get to the correct 
+      ! element in the corner arrays to correspond to the point northeast of the center
+      if (nemo_lon(5:5) == "t") then
+        corn_lon = "glamf"
+        corn_lat = "gphif"
+        offset = (/ 0,0 /)
+      else if (nemo_lon(5:5) == "u") then
+        corn_lon = "glamv"
+        corn_lat = "gphiv"
+        offset = (/ 1,0 /)
+      else if (nemo_lon(5:5) == "v") then
+        corn_lon = "glamu"
+        corn_lat = "gphiu"
+        offset = (/ 0,1 /)
+      else
+        write(6,*) 'unknown nemo_lon name'
+        stop
+      endif
+
+      write(6,*) "processing " // trim(nemo_file)
+      call convertNEMO(nemo_file, nemo_lon, nemo_lat, corn_lon, corn_lat, &
+                       offset, nemogrid_file)
+
+    else
+
+      write(6,*) "processing regular grid " // trim(nemo_file)
+      call convertFLUX(nemo_file, nemo_lon, nemo_lat, &
+                       nemo_mask, nemo_mask_value, nemogrid_file)
+
+    endif
+
+    write(6,*) "processing regular grid"
+    call convertFLUX(input_file, input_lon, input_lat, &
+                     input_mask, input_mask_value, datagrid_file)
+
+  END SUBROUTINE convert
+  
+  ! ==============================================================================
+  
+  SUBROUTINE convertNEMO(grid_file_in, cent_lon, cent_lat, corn_lon, corn_lat, &
+                         off, grid_file_out)
+  
+    !-----------------------------------------------------------------------
+    !
+    !     This routine converts a NEMO coordinates.nc file to a remapping grid file.
+    !
+    
+    CHARACTER(char_len), INTENT(in) :: cent_lon, cent_lat, corn_lon, corn_lat
+    INTEGER (kind=int_kind), INTENT(in), DIMENSION(2) :: off
+    CHARACTER(char_len), INTENT(in) :: grid_file_out
+    CHARACTER(char_len), INTENT(in) :: grid_file_in
+
+    !-----------------------------------------------------------------------
+    !     module variables that describe the grid
+  
+    CHARACTER(char_len), parameter ::  &
+         grid_name = 'Remapped NEMO grid for SCRIP'
+  
+    !-----------------------------------------------------------------------
+    !     grid coordinates and masks
+  
+    REAL (kind=dbl_kind), ALLOCATABLE, DIMENSION(:,:) :: &
+         clon, clat, &             ! expanded corner arrays
+         glam, &                   ! center longitude
+         gphi, &                   ! center latitude
+         glamc, &                  ! corner longitude
+         gphic                     ! corner latitude
+  
+    !-----------------------------------------------------------------------
+    !     other local variables
+  
+    INTEGER (kind=int_kind) :: i, j, n, iunit, im1, jm1, imid, isame, ic, jc
+    INTEGER (kind=int_kind) :: varid_lam, varid_phi, varid_lamc, varid_phic
+    INTEGER (kind=int_kind) :: jdim
+    INTEGER (kind=int_kind), dimension(4) :: grid_dimids  ! input fields have 4 dims
+    REAL (kind=dbl_kind) :: tmplon, dxt, dyt
+  
+    !-----------------------------------------------------------------------
+    !     read in grid info
+    !
+    !     For NEMO input grids, assume that variable names are glam, glamc etc.
+    !     Assume that 1st 2 dimensions of these variables are x and y directions.
+    !     These assumptions are made by NEMO, so should be valid for coordinates.nc.
+    !
+    ! write in nf90 calls (without error handling) and then think about 
+    ! making more readable by taking chunks into ncutil
+    !
+  
+    ncstat = nf90_open( grid_file_in, NF90_NOWRITE, ncid_in )
+    call netcdf_error_handler(ncstat)
+  
+    ! find dimids for 'glam'
+    ! use dimids to get dimlengths
+    ! allocate glam array
+    ! get glam from file 
+  
+    ncstat = nf90_inq_varid( ncid_in, cent_lon, varid_lam )
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_inq_varid( ncid_in, corn_lon, varid_lamc )
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_inq_varid( ncid_in, cent_lat, varid_phi )
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_inq_varid( ncid_in, corn_lat, varid_phic )
+    call netcdf_error_handler(ncstat)
+  
+    ncstat = nf90_inquire_variable( ncid_in, varid_lam, dimids=grid_dimids(:) )
+    call netcdf_error_handler(ncstat)
+    DO jdim = 1, SIZE(grid_dims)
+       ncstat = nf90_inquire_dimension( ncid_in, grid_dimids(jdim),  &
+                                        len=grid_dims(jdim) )
+       call netcdf_error_handler(ncstat)
+    END DO
+    nx = grid_dims(1)
+    ny = grid_dims(2)
+    grid_size = nx * ny
+    WRITE(*,FMT='("Input grid dimensions are:",2i6)') nx, ny
+    
+    ! assume that dimensions are all the same as glam
+    ALLOCATE( glam(nx,ny), glamc(nx,ny), gphi(nx,ny), gphic(nx,ny) )
+    ncstat = nf90_get_var( ncid_in, varid_lam, glam(:,:) )
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_get_var( ncid_in, varid_lamc, glamc(:,:) )
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_get_var( ncid_in, varid_phi, gphi(:,:) )
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_get_var( ncid_in, varid_phic, gphic(:,:) )
+    call netcdf_error_handler(ncstat)
+    
+    !-----------------------------------------------------------------------
+    ! - Mask is all ocean for now
+  
+    ALLOCATE( grid_imask(grid_size) )
+    grid_imask(:) = 1
+  
+    !-----------------------------------------------------------------------
+    ! corners are arranged as follows:    4 3
+    !                                     1 2
+    !
+    ! Assume that cyclic grids have 2 wrap columns in coordinates.nc
+    !  (this is the case for ORCA grids)
+    !
+  
+    ! -----------------------------------------------------------------------------
+    ! create a single pair of arrays for the corners where clon(1,1) corresponds
+    ! to the south west corner of a box containing glam(1,1)
+    ! various special cases then apply
+    !   bottom row:  assume clon(:,j) = clon(:,j+1)
+  
+    ALLOCATE ( clon(nx+1,ny+1), clat(nx+1,ny+1) )
+
+    ! first the easy internal points
+    DO j = 2,ny
+      DO i = 2,nx
+        ic = i + off(1) - 1
+        jc = j + off(2) - 1
+        clon(i,j) = glamc(ic,jc)
+        clat(i,j) = gphic(ic,jc)
+      ENDDO
+    ENDDO
+
+    ! then the tricky boundary points
+    imid = (nx-1)/2 + 1
+    DO j = 1,ny+1,ny
+      DO i = 1,nx+1,nx
+        ic = i + off(1) - 1
+        jc = j + off(2) - 1
+        if (ic == 0 .and. jc == 0) then
+          clon(i,j) = glamc(nx,1)
+          clat(i,j) = gphic(nx,1) - (gphic(nx,2)-gphic(nx,1))
+        else if (ic == nx+1 .and. jc == 0) then
+          clon(i,j) = glamc(1,1)
+          clat(i,j) = gphic(1,1) - (gphic(1,2)-gphic(1,1))
+        else if (ic == 0 .and. jc == ny+1) then
+          isame = 2*imid - nx + 1
+          clon(i,j) = glamc(isame,jc-1)
+          clat(i,j) = gphic(isame,jc-1)
+        else if (ic == nx+1 .and. jc == ny+1) then
+          isame = 2*imid
+          clon(i,j) = glamc(isame,jc-1)
+          clat(i,j) = gphic(isame,jc-1)
+        else if (ic == 0) then
+          clon(i,j) = glamc(nx,jc)
+          clat(i,j) = gphic(nx,jc)
+        else if (jc == 0) then
+          clon(i,j) = glamc(ic,1)
+          clat(i,j) = gphic(ic,1) - (gphic(ic,2)-gphic(ic,1))
+        else if (ic == nx+1) then
+          clon(i,j) = glamc(1,jc)
+          clat(i,j) = gphic(1,jc)
+        else if (jc == ny+1) then
+          isame = 2*imid - ic + 1
+          clon(i,j) = glamc(isame,jc-1)
+          clat(i,j) = gphic(isame,jc-1)
+        endif
+      ENDDO
+    ENDDO
+
+    ALLOCATE ( corner_lon(4,nx,ny), corner_lat(4,nx,ny) )
+  
+    ! top-right corner
+    corner_lon(3,:,:) = clon(2:nx+1,2:ny+1)
+    corner_lat(3,:,:) = clat(2:nx+1,2:ny+1)
+  
+    ! top-left corner
+    corner_lon(4,:,:) = clon(1:nx,2:ny+1)
+    corner_lat(4,:,:) = clat(1:nx,2:ny+1)
+  
+    ! bottom-right corner 
+    corner_lon(2,:,:) = clon(2:nx+1,1:ny)
+    corner_lat(2,:,:) = clat(2:nx+1,1:ny)
+  
+    ! bottom-left corner
+    corner_lon(1,:,:) = clon(1:nx,1:ny)
+    corner_lat(1,:,:) = clat(1:nx,1:ny)
+  
+  ! For [N, E, W]-ward extrapolation near the poles, should we use stereographic (or
+  ! similar) projection?  This issue will come for V,F interpolation, and for all
+  ! grids with non-cyclic grids.
+  
+    ! -----------------------------------------------------------------------------
+    !     correct for 0,2pi longitude crossings
+    !      (In practice this means putting all corners into 0,2pi range
+    !       and ensuring that no box corners are miles from each other.
+    !       3pi/2 is used as threshold - I think this is quite arbitrary.)
+  
+    corner_lon(:,:,:) = MODULO( corner_lon(:,:,:), circle )
+    DO n = 2, grid_corners
+       WHERE    ( corner_lon(n,:,:) - corner_lon(n-1,:,:) < -three*circle*0.25 )
+          corner_lon(n,:,:) = corner_lon(n,:,:) + circle
+       ELSEWHERE( corner_lon(n,:,:) - corner_lon(n-1,:,:) >  three*circle*0.25 )
+          corner_lon(n,:,:) = corner_lon(n,:,:) - circle
+       END WHERE
+    END DO
+  
+    ! -----------------------------------------------------------------------------
+    ! - put longitudes on smooth grid 
+  
+ !  call mouldlon(glam,nx,ny)
+ !  call mouldlon(corner_lon(1,:,:),nx,ny)
+ !  call mouldlon(corner_lon(2,:,:),nx,ny)
+ !  call mouldlon(corner_lon(3,:,:),nx,ny)
+ !  call mouldlon(corner_lon(4,:,:),nx,ny)
+
+    ! -----------------------------------------------------------------------------
+    ! - reshape for SCRIP input format
+  
+    ALLOCATE( grid_center_lon(grid_size), grid_center_lat(grid_size) )
+    
+    grid_center_lon(:) = RESHAPE( glam(:,:), (/ grid_size /) )
+    grid_center_lat(:) = RESHAPE( gphi(:,:), (/ grid_size /) )
+  
+    DEALLOCATE( glam, gphi, glamc, gphic )
+  
+    ALLOCATE( grid_corner_lon(4, grid_size), grid_corner_lat(4, grid_size) )
+  
+    grid_corner_lon(:,:) = RESHAPE( corner_lon(:,:,:), (/ 4, grid_size /) )
+    grid_corner_lat(:,:) = RESHAPE( corner_lat(:,:,:), (/ 4, grid_size /) )
+  
+    DEALLOCATE( corner_lon, corner_lat )
+  
+    CALL createSCRIPgrid(grid_file_out, grid_name)
+  
+  END SUBROUTINE convertNEMO
+  
+  ! ==============================================================================
+  
+  SUBROUTINE convertFLUX(grid_file_in, name_lon, name_lat, &
+                         name_mask, value_mask, grid_file_out)
+  
+    !-----------------------------------------------------------------------
+    !
+    !     This routine creates a remapping grid file from an input grid.
+    !
+    !-----------------------------------------------------------------------
+    
+    CHARACTER(char_len), INTENT(in) ::  &
+         grid_file_in, name_lon, name_lat, name_mask, grid_file_out
+    INTEGER (kind=int_kind) :: value_mask
+  
+    !-----------------------------------------------------------------------
+    !     variables that describe the grid
+  
+    CHARACTER(char_len), parameter ::  &
+         grid_name = 'Remapped regular grid for SCRIP'
+  
+    !-----------------------------------------------------------------------
+    !     grid coordinates (note that a flux file just has lon and lat)
+  
+    REAL (kind=dbl_kind), ALLOCATABLE, DIMENSION(:) :: &
+         lam, phi
+    REAL (kind=dbl_kind), ALLOCATABLE, DIMENSION(:,:) :: &
+         glam, &                   ! longitude
+         gphi, &                   ! latitude
+         glamc, &
+         gphic
+    REAL (kind=dbl_kind), ALLOCATABLE, DIMENSION(:,:) :: mask
+  
+    !-----------------------------------------------------------------------
+    !     other local variables
+  
+    INTEGER (kind=int_kind) :: i, j, n, iunit, im1, jm1
+    INTEGER (kind=int_kind) :: varid_lam, varid_phi, varid_mask
+    INTEGER (kind=int_kind) :: jdim, nspace
+    INTEGER (kind=int_kind), dimension(4) :: grid_dimids  ! input fields have 4 dims
+    REAL (kind=dbl_kind) :: tmplon, dxt, dyt
+  
+    !-----------------------------------------------------------------------
+    !     read in grid info
+    !
+    !     For NEMO input grids, assume that variable names are glam, glamc etc.
+    !     Assume that 1st 2 dimensions of these variables are x and y directions.
+    !     These assumptions are made by NEMO, so should be valid for coordinates.nc.
+    !
+    ! write in nf90 calls (without error handling) and then think about 
+    ! making more readable by taking chunks into ncutil
+  
+    ncstat = nf90_open( grid_file_in, NF90_NOWRITE, ncid_in )
+    call netcdf_error_handler(ncstat)
+  
+    ! find dimids for 'glamt'
+    ! use dimids to get dimlengths
+    ! allocate glam array
+    ! get glam from file 
+  
+    ncstat = nf90_inq_varid( ncid_in, name_lat, varid_phi )
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_inq_varid( ncid_in, name_lon, varid_lam )
+    call netcdf_error_handler(ncstat)
+  
+    ncstat = nf90_inquire_variable( ncid_in, varid_lam, ndims=nspace )
+    call netcdf_error_handler(ncstat)
+
+    if (nspace == 1) then
+      ncstat = nf90_inquire_variable( ncid_in, varid_lam, dimids=grid_dimids(:1) )
+      call netcdf_error_handler(ncstat)
+      ncstat = nf90_inquire_variable( ncid_in, varid_phi, dimids=grid_dimids(2:) )
+      call netcdf_error_handler(ncstat)
+      ncstat = nf90_inquire_dimension( ncid_in, grid_dimids(1), len=grid_dims(1) )
+      call netcdf_error_handler(ncstat)
+      ncstat = nf90_inquire_dimension( ncid_in, grid_dimids(2), len=grid_dims(2) )
+      call netcdf_error_handler(ncstat)
+      nx = grid_dims(1)
+      ny = grid_dims(2)
+      grid_size = nx * ny
+      WRITE(*,FMT='("Input grid dimensions are:",2i6)') nx, ny
+    
+      ALLOCATE( lam(nx), phi(ny) )
+      write(6,*) 'double'
+      ncstat = nf90_get_var( ncid_in, varid_lam, lam )
+      call netcdf_error_handler(ncstat)
+      ncstat = nf90_get_var( ncid_in, varid_phi, phi )
+      call netcdf_error_handler(ncstat)
+    
+      ALLOCATE( glam(nx,ny), gphi(nx,ny))
+      write(6,*) shape(lam),shape(phi)
+      glam(:,:) = SPREAD(lam,2,ny)
+      gphi(:,:) = SPREAD(phi,1,nx)
+    else
+
+      ncstat = nf90_inquire_variable( ncid_in, varid_lam, dimids=grid_dimids(:2) )
+      call netcdf_error_handler(ncstat)
+      ncstat = nf90_inquire_dimension( ncid_in, grid_dimids(1), len=grid_dims(1) )
+      call netcdf_error_handler(ncstat)
+      ncstat = nf90_inquire_dimension( ncid_in, grid_dimids(2), len=grid_dims(2) )
+      call netcdf_error_handler(ncstat)
+      nx = grid_dims(1)
+      ny = grid_dims(2)
+      grid_size = nx * ny
+      WRITE(*,FMT='("Input grid dimensions are:",2i6)') nx, ny
+    
+      ALLOCATE( glam(nx,ny), gphi(nx,ny))
+      ncstat = nf90_get_var( ncid_in, varid_lam, glam )
+      call netcdf_error_handler(ncstat)
+      ncstat = nf90_get_var( ncid_in, varid_phi, gphi )
+      call netcdf_error_handler(ncstat)
+
+    endif
+    write(6,*) grid_size,nx,ny
+  
+    ALLOCATE(glamc(0:nx,0:ny), gphic(0:nx,0:ny) )
+
+    ! - for now a simple average to get top right box corners
+    ! - glamc(i,j), gphic(i,j) are top right coordinates of box containing 
+    ! - glam(i,j),gphi(i,j)
+    write(6,*) 'averaging'
+    write(6,*) size(gphic),size(gphi)
+    gphic(1:nx,1:ny-1) = 0.5*(gphi(:,1:ny-1)+gphi(:,2:ny))
+    write(6,*) size(glamc),size(glam)
+    glamc(1:nx-1,1:ny) = 0.5*(glam(1:nx-1,:)+glam(2:nx,:))
+  
+    ! - left and right column of longitudes 
+    write(6,*) 'columns'
+    glamc(nx,1:ny) = 1.5*glam(nx,:)-0.5*glam(nx-1,:)
+    glamc( 0,1:ny) = 1.5*glam(1,:)-0.5*glam(2,:)
+    glamc(nx, 0) = glamc(nx,1)
+    glamc( 0, 0) = glamc( 0,1)
+
+    ! - top and bottom row of latitudes by extrapolation
+    write(6,*) 'rows'
+    gphic(1:nx,ny) = 1.5*gphi(:,ny)-0.5*gphi(:,ny-1)
+    gphic(1:nx, 0) = 1.5*gphi(:,1)-0.5*gphi(:,2)
+    gphic( 0,ny) = gphic(1,ny)
+    gphic( 0, 0) = gphic(1, 0)
+
+    !-----------------------------------------------------------------------
+  
+    write(6,*) 'allocating'
+    ALLOCATE( grid_imask(grid_size) )
+    grid_imask(:) = 1
+    write(6,*) name_mask
+    if (trim(name_mask) /= "none") then
+      write(6,*) 'masking'
+      ncstat = nf90_inq_varid( ncid_in, name_mask, varid_mask )
+      call netcdf_error_handler(ncstat)
+      ALLOCATE( mask(nx,ny) )
+      write(6,*) 'reading mask'
+      ncstat = nf90_get_var( ncid_in, varid_mask, mask )
+      call netcdf_error_handler(ncstat)
+      write(6,*) 'setting mask'
+      WHERE ( RESHAPE(mask(:,:),(/ grid_size /)) < value_mask)
+        grid_imask = 0
+      END WHERE
+      write(6,*) 'masked'
+    END IF
+  
+    !-----------------------------------------------------------------------
+    ! corners are arranged as follows:    4 3
+    !                                     1 2
+  
+    ALLOCATE ( corner_lon(4,nx,ny), corner_lat(4,nx,ny) )
+  
+    ! - bottom-left corner
+    corner_lon(1,:,:) = glamc(0:nx-1, 0:ny-1 )
+    corner_lat(1,:,:) = gphic(0:nx-1, 0:ny-1 )
+  
+    ! - bottom-right corner 
+    corner_lon(2,:,:) = glamc(1:nx, 0:ny-1 )
+    corner_lat(2,:,:) = gphic(1:nx, 0:ny-1 )
+  
+    ! - top-right corner
+    corner_lon(3,:,:) = glamc(1:nx,1:ny)
+    corner_lat(3,:,:) = gphic(1:nx,1:ny)
+    write(6,*) corner_lat(3,nx-2:nx,ny)
+  
+    ! - top-left corner
+    corner_lon(4,:,:) = glamc(0:nx-1, 1:ny )
+    corner_lat(4,:,:) = gphic(0:nx-1, 1:ny )
+  
+  ! For [N, E, W]-ward extrapolation near the poles, should we use stereographic (or
+  ! similar) projection?  This issue will come for V,F interpolation, and for all
+  ! grids with non-cyclic grids.
+  
+    ! -----------------------------------------------------------------------------
+    !     correct for 0,2pi longitude crossings
+    !      (In practice this means putting all corners into 0,2pi range
+    !       and ensuring that no box corners are miles from each other.
+    !       3pi/2 is used as threshold - I think this is quite arbitrary.)
+  
+  ! corner_lon(:,:,:) = MODULO( corner_lon(:,:,:), circle )
+  ! DO n = 2, grid_corners
+  !    WHERE    ( corner_lon(n,:,:) - corner_lon(n-1,:,:) < -three*circle*0.25 )
+  !       corner_lon(n,:,:) = corner_lon(n,:,:) + circle
+  !    ELSEWHERE( corner_lon(n,:,:) - corner_lon(n-1,:,:) >  three*circle*0.25 )
+  !       corner_lon(n,:,:) = corner_lon(n,:,:) - circle
+  !    END WHERE
+  ! END DO
+  
+    ! -----------------------------------------------------------------------------
+    ! - reshape for SCRIP input format
+  
+    ALLOCATE( grid_center_lon(grid_size), grid_center_lat(grid_size) )
+    
+    grid_center_lon(:) = RESHAPE( glam(:,:), (/ grid_size /) )
+    grid_center_lat(:) = RESHAPE( gphi(:,:), (/ grid_size /) )
+  
+    DEALLOCATE( glam, gphi, glamc, gphic )
+  
+    ALLOCATE( grid_corner_lon(4, grid_size), grid_corner_lat(4, grid_size) )
+  
+    grid_corner_lon(:,:) = RESHAPE( corner_lon(:,:,:), (/ 4, grid_size /) )
+    grid_corner_lat(:,:) = RESHAPE( corner_lat(:,:,:), (/ 4, grid_size /) )
+  
+    DEALLOCATE( corner_lon, corner_lat )
+  
+    CALL createSCRIPgrid(grid_file_out, grid_name)
+  
+  END SUBROUTINE convertFLUX
+  
+  ! ==============================================================================
+  
+  SUBROUTINE mouldlon(lon_grid, nx, ny)
+
+    ! -----------------------------------------------------------------------------
+    ! - input variables
+
+    INTEGER, INTENT(in) :: nx, ny
+    REAL (kind=dbl_kind), INTENT(inout), DIMENSION(nx,ny) ::  &
+      lon_grid
+  
+    ! -----------------------------------------------------------------------------
+    ! - local variables
+
+    INTEGER :: ix, iy
+    REAL (kind=dbl_kind), DIMENSION(:,:), ALLOCATABLE ::  &
+      dlon
+    REAL :: step
+
+    ! -----------------------------------------------------------------------------
+    ! - try to eliminate any 360 degree steps in a grid of longitudes
+
+    ALLOCATE(dlon(nx,ny))
+
+    step = 0.75*circle
+    dlon(:,:) = 0
+    dlon(2:,:) = lon_grid(2:,:) - lon_grid(:nx-1,:)
+    WHERE (dlon > -step .AND. dlon < step)
+      dlon = 0.0
+    ELSEWHERE
+      dlon = -SIGN(circle,dlon)
+    END WHERE
+
+    ! - close your eyes this is nasty
+    DO ix = 2,nx
+      dlon(ix,:) = dlon(ix,:) + dlon(ix-1,:)
+    END DO
+    lon_grid = lon_grid + dlon
+
+  END SUBROUTINE mouldlon
+  
+  ! ==============================================================================
+  
+  SUBROUTINE createSCRIPgrid(grid_file_out, grid_name)
+  
+    ! -----------------------------------------------------------------------------
+    ! - input variables
+  
+    CHARACTER(char_len), INTENT(in) ::  &
+         grid_name, grid_file_out
+  
+    ! -----------------------------------------------------------------------------
+    ! - local variables that describe the netcdf file
+  
+    INTEGER (kind=int_kind) :: &
+         nc_grid_id,       &   ! netCDF grid dataset id
+         nc_gridsize_id,   &   ! netCDF grid size dim id
+         nc_gridcorn_id,   &   ! netCDF grid corner dim id
+         nc_gridrank_id,   &   ! netCDF grid rank dim id
+         nc_griddims_id,   &   ! netCDF grid dimensions id
+         nc_grdcntrlat_id, &   ! netCDF grid center lat id
+         nc_grdcntrlon_id, &   ! netCDF grid center lon id
+         nc_grdimask_id,   &   ! netCDF grid mask id
+         nc_gridarea_id,   &   ! netCDF grid area id
+         nc_grdcrnrlat_id, &   ! netCDF grid corner lat id
+         nc_grdcrnrlon_id      ! netCDF grid corner lon id
+  
+    ! -----------------------------------------------------------------------------
+    ! - create netCDF dataset for this grid
+    ! - rewrite in nf90 
+    ! - (bring out functional blocks into ncclear for readability)
+  
+    ncstat = nf90_create (grid_file_out, NF90_CLOBBER, nc_grid_id)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_att (nc_grid_id, NF90_GLOBAL, 'title', grid_name)
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid size dimension
+  
+    ncstat = nf90_def_dim (nc_grid_id, 'grid_size', grid_size, nc_gridsize_id)
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid rank dimension
+  
+    ncstat = nf90_def_dim (nc_grid_id, 'grid_rank', grid_rank, nc_gridrank_id)
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid corner dimension
+  
+    ncstat = nf90_def_dim (nc_grid_id, 'grid_corners', grid_corners, nc_gridcorn_id)
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid dim size array
+  
+    ncstat = nf90_def_var(nc_grid_id, 'grid_dims', NF90_INT, nc_gridrank_id, nc_griddims_id)
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid mask
+  
+    ncstat = nf90_def_var(nc_grid_id, 'grid_imask', NF90_INT, &
+                          nc_gridsize_id, nc_grdimask_id)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_att(nc_grid_id, nc_grdimask_id, 'units', 'unitless')
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid center latitude array
+  
+    ncstat = nf90_def_var(nc_grid_id, 'grid_center_lat', NF90_DOUBLE, &
+                          nc_gridsize_id, nc_grdcntrlat_id)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_att(nc_grid_id, nc_grdcntrlat_id, 'units', 'degrees')
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid center longitude array
+  
+    ncstat = nf90_def_var(nc_grid_id, 'grid_center_lon', NF90_DOUBLE, &
+                          nc_gridsize_id, nc_grdcntrlon_id)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_att(nc_grid_id, nc_grdcntrlon_id, 'units', 'degrees')
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid corner latitude array
+  
+    grid_dim_ids = (/ nc_gridcorn_id, nc_gridsize_id /)
+    ncstat = nf90_def_var(nc_grid_id, 'grid_corner_lat', NF90_DOUBLE, &
+                          grid_dim_ids, nc_grdcrnrlat_id)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_att(nc_grid_id, nc_grdcrnrlat_id, 'units', 'degrees')
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid corner longitude array
+  
+    ncstat = nf90_def_var(nc_grid_id, 'grid_corner_lon', NF90_DOUBLE, &
+                          grid_dim_ids, nc_grdcrnrlon_id)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_att(nc_grid_id, nc_grdcrnrlon_id, 'units', 'degrees')
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! end definition stage
+  
+    ncstat = nf90_enddef(nc_grid_id)
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! write grid data
+  
+    ncstat = nf90_put_var(nc_grid_id, nc_griddims_id, grid_dims)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_var(nc_grid_id, nc_grdimask_id, grid_imask)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_var(nc_grid_id, nc_grdcntrlat_id, grid_center_lat)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_var(nc_grid_id, nc_grdcntrlon_id, grid_center_lon)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_var(nc_grid_id, nc_grdcrnrlat_id, grid_corner_lat)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_var(nc_grid_id, nc_grdcrnrlon_id, grid_corner_lon)
+    call netcdf_error_handler(ncstat)
+  
+    ncstat = nf90_close(nc_grid_id)
+    call netcdf_error_handler(ncstat)
+  
+    DEALLOCATE( grid_imask, grid_center_lon, grid_center_lat, &
+                grid_corner_lon, grid_corner_lat )
+  
+  
+  END SUBROUTINE createSCRIPgrid
+  
+END MODULE scripgrid_mod
+
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripinterp.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripinterp.F90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripinterp.F90	(revision 2528)
@@ -0,0 +1,23 @@
+! ==========================================================================
+
+program scripinterp
+
+  use scripinterp_mod
+
+  character (char_len) ::  nm_in
+#if defined ARGC
+  integer :: iargc
+  external iargc
+
+  if (iargc() == 1) then
+    call getarg(1, nm_in)
+    call process_grid(nm_in)
+  else
+    write(6,*) 'need the name of an input namelist'
+  endif
+#else
+  write(6,*) 'enter the name of an input namelist'
+  read(5,*) nm_in
+#endif
+
+end program scripinterp
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripinterp_mod.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripinterp_mod.F90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripinterp_mod.F90	(revision 2528)
@@ -0,0 +1,1031 @@
+! **************************************************************************
+
+  module scripinterp_mod
+
+! ==========================================================================
+
+  use kinds_mod    ! defines common data types
+  use constants    ! defines common constants
+  use iounits      ! I/O unit manager
+  use netcdf
+  use netcdf_mod   ! netcdf I/O stuff
+  use grids        ! module containing grid info
+  use remap_vars   ! module containing remapping info
+  use remap_mod    ! module containing remapping routines
+  use remap_read   ! routines for reading remap files
+
+  implicit none
+
+  real(kind=dbl_kind), dimension(:), allocatable ::   &
+    grid_out
+
+  integer(kind=int_kind) ::                           &  ! netCDF ids for files and arrays
+          ncstat, nc_outfile_id, nc_infile_id
+  integer (kind=int_kind), dimension(4) ::    &
+      input_dims, input_dimids, input_count
+  real (kind=dbl_kind), dimension(:), allocatable ::   &
+      scale
+  integer (kind=int_kind), dimension(:), allocatable ::        &
+      nc_xysize_id, nc_gridsize_id, nc_gridsize,           &
+      nc_variable_id
+  integer :: nc_lon_id, nc_lat_id, nc_array_id
+
+  character (char_len) ::  &
+          map_name      ! name for mapping from grid1 to grid2
+  character (1), parameter ::  &
+          separator = '|'
+  
+  ! - input namelist variables
+  
+  character (char_len) ::  &
+    input_file,            &  ! filename containing input fields
+    interp_file,           &  ! filename containing remap data (map1)
+    input_name                ! name of variable to grid
+  integer (kind=int_kind), dimension(4) :: &
+    input_stride,  &          ! how much of input array to process
+    input_start,   &          ! where to start
+    input_stop                ! and where to stop
+  character (char_len), dimension(4) ::  &
+    input_vars                ! input variables to be copied
+  
+  ! - output namelist variables
+  
+  character (char_len) ::  &
+    output_file,           &  ! filename for test results
+    output_mode,           &  ! 'create' or 'append'
+    output_name,           &  ! name of new grid variable
+    output_lat,            &  ! as it says
+    output_lon,            &  ! as it says
+    output_ydir               ! choose to invert output arrays in y direction
+  character (char_len), dimension(4) ::  &
+    output_dims,           &    ! name of new grid variable
+    output_vars                 ! variables to copy
+  character (char_len), dimension(10) ::  &
+    output_attributes,     &  ! attributes of stuff in output file
+    output_scaling             ! scaling factor to apply to input data to get
+                               ! correct units in output file
+contains
+
+! ==========================================================================
+
+  subroutine process_grid(nm_in)
+  
+    !-----------------------------------------------------------------------
+    ! - dummy variables
+
+    character (char_len) ::  &
+      nm_in                    ! name of input namelist file
+  
+    !-----------------------------------------------------------------------
+    ! - local variables
+
+    integer (kind=int_kind), dimension(4) ::    &
+        astart, acount, plus_one
+    integer (kind=int_kind), dimension(3) ::    &
+        write_dims
+    integer (kind=int_kind) ::                  &
+      i1, i2, jdim, n, nx, ny, nloop,           &
+      nc_input_id, nc_input_rank,               &
+      vstart, vstride, numv
+
+    real (kind=dbl_kind), dimension(:), allocatable  ::    &
+      grid1_array
+    real (kind=dbl_kind), dimension(:,:), allocatable  ::    &
+      var_out
+
+    plus_one(:) = 1
+
+    !-----------------------------------------------------------------------
+
+    call read_mappings(nm_in)
+
+    !-----------------------------------------------------------------------
+    ! - read input grid
+    ! - WARNING - lots of assumptions here at the moment
+  
+    ncstat = nf90_open( input_file, NF90_NOWRITE, nc_infile_id )
+    call netcdf_error_handler(ncstat,"open")
+  
+    ncstat = nf90_inq_varid( nc_infile_id, input_name, nc_input_id )
+    call netcdf_error_handler(ncstat,"inq_varid")
+  
+    input_dims(:) = 0
+    ncstat = nf90_inquire_variable( nc_infile_id, nc_input_id,   &
+                  ndims=nc_input_rank, dimids=input_dimids(:) )
+    call netcdf_error_handler(ncstat,"inquire_variable")
+
+    do jdim = 1,nc_input_rank
+      ncstat = nf90_inquire_dimension(nc_infile_id,              &
+                    input_dimids(jdim), len=input_dims(jdim) )
+      call netcdf_error_handler(ncstat,"inquire_dimension")
+    enddo
+  
+    ! - dimids seem to be returned in storage order so the outer dimension of 
+    ! - the array as described by the netcdf file becomes the first dimension
+    ! - as far as f90 is concerned (confused? you will be!)
+
+    do jdim = 1,nc_input_rank
+      if (input_stop(jdim) == 0) then
+        input_stop(jdim) = input_dims(jdim)
+      endif
+      input_count(jdim) = input_stop(jdim) - input_start(jdim) + 1
+    enddo
+
+    ! - rashly we assume x followed by y
+    nx = input_dims(1)
+    ny = input_dims(2)
+    write(*,fmt='("Input grid dimensions are:",2i6)') nx, ny
+    if (nx*ny /= grid1_size) then
+      write(6,*) "mismatch between input grid and remap data"
+      stop
+    endif
+
+    ! - calculate number of horizontal slices to process
+    ! - at the moment this is not very general and will only work with 3 dimensions
+
+    acount(1:nc_input_rank) = &
+             (input_stop(1:nc_input_rank)-input_start(1:nc_input_rank)+1) / &
+             input_stride(1:nc_input_rank)
+    nloop = 1
+    do jdim = 1,nc_input_rank
+      nloop = nloop*acount(jdim)
+    enddo
+    nloop = nloop/grid1_size
+    write(6,*) "total slices requested: ",nloop
+
+    vstart = input_start(nc_input_rank)            ! ie extra var has outer dimension
+    vstride = input_stride(nc_input_rank)
+
+    ! - in general we cant read in the whole array so do it slice by slice
+    ! - slow but sure
+
+    write(6,*) "allocating input and output grids"
+    allocate( grid1_array(grid1_size))
+    allocate( grid_out(grid2_size) )
+
+    numv = 0
+    do n = 1,4
+      if (trim(input_vars(n)) /= '-' .and. &
+          trim(output_vars(n)) /= '-') numv = numv + 1
+    enddo
+
+    write_dims(1) = grid2_dims(1)
+    write_dims(2) = grid2_dims(2)
+    write_dims(3) = nloop
+    call define_grid(write_dims(1:3) , 2+numv)
+
+    astart(:) = input_start(:)
+    astart(3) = astart(3) - input_stride(3)
+    acount(:) = 1
+    acount(1) = nx
+    acount(2) = ny
+
+    do n = 1,nloop
+
+      write(6,*) "processing slice: ",n
+      astart(3) = astart(3) + input_stride(3)
+      ncstat = nf90_get_var(nc_infile_id, nc_input_id, grid1_array,  &
+                            start=astart(1:nc_input_rank),              &
+                            count=acount(1:nc_input_rank))
+      call netcdf_error_handler(ncstat,"get_var")
+
+      call calculate_grid(grid1_array, grid_out)
+
+      call write_grid(grid_out, n, write_dims(1:2) , 2)
+
+    enddo
+
+    ! ---------------------------------------------------------------------
+    ! - now for any extra variables to copy
+
+    if (numv > 0) then
+
+      write(6,*) "reading ",numv," extra variables"
+      allocate( var_out(nloop,numv) )
+  
+      do n = 1,numv
+        write(6,*) "looking for variable: ",trim(input_vars(n))
+        ncstat = nf90_inq_varid( nc_infile_id, trim(input_vars(n)), nc_input_id )
+        call netcdf_error_handler(ncstat,"inq_varid")
+      
+        input_dims(:) = 0
+        ncstat = nf90_inquire_variable( nc_infile_id, nc_input_id,   &
+                      ndims=nc_input_rank, dimids=input_dimids(:) )
+        call netcdf_error_handler(ncstat,"inquire_variable")
+  
+        if (nc_input_rank /= 1) then
+          write(6,*) 'sorry, only rank 1 variables can be copied'
+          cycle
+        endif
+        ncstat = nf90_inquire_dimension(nc_infile_id,              &
+                      input_dimids(1), len=input_dims(1) )
+        call netcdf_error_handler(ncstat,"inquire_dimension")
+  
+        ncstat = nf90_get_var(nc_infile_id, nc_input_id, var_out(1:nloop,n),  &
+                              start=(/ vstart /), stride=(/ vstride /))
+        call netcdf_error_handler(ncstat,"get_var")
+      enddo
+  
+      call write_extra(var_out, numv+2)
+      deallocate(var_out)
+
+    endif
+
+    ncstat = nf90_close(nc_outfile_id)
+    call netcdf_error_handler(ncstat,"out close")
+    ncstat = nf90_close(nc_infile_id)
+    call netcdf_error_handler(ncstat,"in close")
+
+    ! ---------------------------------------------------------------------
+
+    deallocate( grid1_array, grid_out)
+
+    ! ---------------------------------------------------------------------
+
+  end subroutine process_grid
+
+  ! ==========================================================================
+
+  subroutine define_grid(thedims, therank)
+
+    !-----------------------------------------------------------------------
+    ! - dummy variables
+    
+    integer (kind=int_kind) :: &
+      therank
+    integer (kind=int_kind), dimension(therank) :: &
+      thedims
+
+    !-----------------------------------------------------------------------
+    ! - local variables
+
+    integer ::               &
+      k, n, ilon, ilat, icolon, i1, i2, natt, nvar, id, jd, kd, nd
+    character (char_len) ::  &
+      aname, vname, att
+    real (kind=dbl_kind) ::   s
+
+    ! - netcdf variables
+
+    integer :: xtype
+
+    !-----------------------------------------------------------------------
+    ! -  define grid size dimensions
+  
+    allocate(nc_xysize_id(grid2_rank))
+    allocate(nc_gridsize_id(therank))
+    allocate(nc_gridsize(therank))
+    allocate(nc_variable_id(therank-2))
+    
+    !-----------------------------------------------------------------------
+    ! - setup a NetCDF file for output
+  
+    xtype = NF90_FLOAT
+
+    write(6,*) 'creating output file'
+    ncstat = nf90_create (output_file, NF90_CLOBBER, nc_outfile_id)
+    call netcdf_error_handler(ncstat,"create")
+  
+    write(6,*) 'setting global attributes'
+    ncstat = nf90_put_att(nc_outfile_id, NF90_GLOBAL, 'title', map_name)
+    call netcdf_error_handler(ncstat,"put_att")
+  
+    write(6,*) 'setting dimensions'
+    do n=1,therank
+      if (n .eq. therank .and. therank .gt. 2) then
+        write(6,*) '    unlimited dim ',trim(output_dims(n)),' size: ',thedims(n)
+        ncstat = nf90_def_dim (nc_outfile_id, output_dims(n), NF90_UNLIMITED, &
+                               nc_gridsize_id(n))
+      else
+        write(6,*) '    dim ',trim(output_dims(n)),' size: ',thedims(n)
+        ncstat = nf90_def_dim (nc_outfile_id, output_dims(n), thedims(n), &
+                               nc_gridsize_id(n))
+      endif
+      call netcdf_error_handler(ncstat,"def_dim")
+    end do
+    nc_gridsize(:) = thedims(1:therank)
+
+    ! - at the moment there is an assumption here that the ordering is (lon,lat)
+
+    ilon = 1
+    ilat = 2
+    nc_xysize_id(1) = nc_gridsize_id(ilon)
+    nc_xysize_id(2) = nc_gridsize_id(ilat)
+
+    ! ----------------------------------------------------------------
+    ! -  define grid center longitude array
+  
+    write(6,*) 'defining longitude variable'
+    ncstat = nf90_def_var (nc_outfile_id, output_lon,   &
+                         xtype, nc_xysize_id,   &
+                         nc_lon_id)
+    call netcdf_error_handler(ncstat,"def_var")
+  
+    ncstat = nf90_put_att (nc_outfile_id, nc_lon_id, 'units', 'degrees')
+    call netcdf_error_handler(ncstat,"put_att")
+  
+    ! ----------------------------------------------------------------
+    ! -  define grid center latitude array
+  
+    write(6,*) 'defining latitude variable'
+    ncstat = nf90_def_var (nc_outfile_id, output_lat,     &
+                         xtype, nc_xysize_id,   &
+                         nc_lat_id)
+    call netcdf_error_handler(ncstat,"def_var")
+  
+    ncstat = nf90_put_att (nc_outfile_id, nc_lat_id, 'units', 'degrees')
+    call netcdf_error_handler(ncstat,"put_att")
+  
+    ! ----------------------------------------------------------------
+    ! -  define copy variables array
+  
+    write(6,*) 'defining copy variables'
+    do n = 3,therank
+      ncstat = nf90_def_var (nc_outfile_id, output_vars(n-2),   &
+                           xtype, nc_gridsize_id(n),    &
+                           nc_variable_id(n-2))
+      call netcdf_error_handler(ncstat,"def_var")
+    enddo
+  
+    ! ----------------------------------------------------------------
+    ! -  define output array
+  
+    write(6,*) 'defining grid variable'
+    ncstat = nf90_def_var (nc_outfile_id, output_name,               &
+                         xtype, nc_gridsize_id,    &
+                         nc_array_id)
+    call netcdf_error_handler(ncstat,"def_var")
+  
+    ! ----------------------------------------------------------------
+    ! - output attributes has to come after all other definitions
+    ! - this code currently a bit murky, needs a rewrite
+  
+    ncstat = nf90_inquire (nc_outfile_id, nVariables=nvar)
+    call netcdf_error_handler(ncstat,"inquire")
+    do n = 1,10
+      att = trim(output_attributes(n))
+      natt = len(att)
+      if (att /= '-') then
+        i1 = index(att,separator)
+        aname = att(1:i1-1)
+        do k = 1,nvar
+          ncstat = nf90_inquire_variable(nc_outfile_id, k, vname)
+          call netcdf_error_handler(ncstat,"inquire_variable")
+          if (vname == aname) then
+            i2 = index(att,separator,.true.)
+            ncstat = nf90_put_att (nc_outfile_id, k, &
+                                   att(i1+1:i2-1), att(i2+1:natt))
+            call netcdf_error_handler(ncstat,"put_att")
+            exit      ! from innermost do
+          endif
+        enddo
+      endif
+    enddo
+  
+    ! output scaling
+
+    allocate (scale(nvar))
+    scale(:) = 1.0
+
+    do n = 1,10
+      att = trim(output_scaling(n))
+      natt = len(att)
+      if (att /= '-') then
+        i1 = index(att,separator)
+        aname = att(1:i1-1)
+        do k = 1,nvar
+          ncstat = nf90_inquire_variable(nc_outfile_id, k, vname)
+          call netcdf_error_handler(ncstat,"inquire_variable")
+          if (vname == aname) then
+            i2 = index(att,separator,.true.)
+            read(att(i2+1:natt),*) scale(k)
+            call netcdf_error_handler(ncstat,"put_att")
+            exit      ! from innermost do
+          endif
+        enddo
+      endif
+    enddo
+  
+    ! ----------------------------------------------------------------
+    ! -  end definition stage
+  
+    ncstat = nf90_enddef(nc_outfile_id)
+    call netcdf_error_handler(ncstat,"enddef")
+ 
+  end subroutine define_grid
+
+  ! ==========================================================================
+
+  subroutine write_grid(thegrid, thelevel, thedims, therank)
+
+    !-----------------------------------------------------------------------
+    ! - dummy variables
+    
+    integer (kind=int_kind), intent(in) :: &
+      therank, thelevel
+    real (kind=dbl_kind), dimension(:), intent(in) ::   &
+      thegrid
+    integer (kind=int_kind), dimension(therank) :: &
+      thedims
+
+    !-----------------------------------------------------------------------
+    ! - local variables
+
+    integer ::               &
+      k, n, ilon, ilat, icolon, j1, j2, dj, natt, nvar, id, jd, kd, nd
+    character (char_len) ::  &
+      aname, vname, att
+    real (kind=dbl_kind), dimension(:,:,:), allocatable ::   &
+      data
+    real (kind=dbl_kind) ::   s
+    real (kind=dbl_kind), parameter :: todeg = 57.295779513082323
+    integer (kind=int_kind), dimension(3) ::   &
+      start
+
+    ! - netcdf variables
+
+    integer :: xtype
+
+    !-----------------------------------------------------------------------
+    ! - write results to NetCDF file
+  
+    allocate (data(thedims(1),thedims(2),1))
+    if (output_ydir .eq. 'invert') then
+      j1 = thedims(2)
+      j2 = 1
+      dj = -1
+    else
+      j1 = 1
+      j2 = thedims(2)
+      dj = 1
+    endif
+
+    if (thelevel .eq. 1) then
+
+      ! -  grid center latitude array
+  
+      write(6,*) 'writing latitude variable'
+      s = scale(nc_lat_id)
+      nd = 0
+      do jd = j1,j2,dj
+        do id =1,thedims(1)
+          nd = nd + 1
+          data(id,jd,1) = s*todeg*grid2_center_lat(nd)
+        enddo
+      enddo
+      ncstat = nf90_put_var(nc_outfile_id, nc_lat_id, data(:,:,1))
+      call netcdf_error_handler(ncstat,"put_var")
+  
+      ! -  grid center longitude array
+  
+      write(6,*) 'writing longitude variable'
+      s = scale(nc_lon_id)
+      nd = 0
+      do jd = j1,j2,dj
+        do id =1,thedims(1)
+          nd = nd + 1
+          data(id,jd,1) = s*todeg*grid2_center_lon(nd)
+        enddo
+      enddo
+      ncstat = nf90_put_var(nc_outfile_id, nc_lon_id, data(:,:,1))
+      call netcdf_error_handler(ncstat,"put_var")
+
+    endif
+
+    !-----------------------------------------------------------------------
+    ! -  new grid
+
+    write(6,*) 'writing grid variable'
+    n = therank
+    s = scale(nc_array_id)
+    nd = 0
+    do jd = j1,j2,dj
+      do id =1,thedims(1)
+        nd = nd + 1
+        data(id,jd,1) = thegrid(nd)
+      enddo
+    enddo
+    write(6,*) 'scaling data '
+    data(:,:,1) = s*data(:,:,1)
+    start(:) = (/ 1, 1, thelevel /)
+    ncstat = nf90_put_var(nc_outfile_id, nc_array_id, data, start)
+    call netcdf_error_handler(ncstat,"put_var")
+    deallocate(data)
+
+  end subroutine write_grid
+
+  ! ==========================================================================
+
+  subroutine write_extra(thevars, therank)
+
+    real (kind=dbl_kind), dimension(:,:), intent(in) ::   &
+      thevars
+    real (kind=dbl_kind), dimension(:), allocatable ::   &
+      thedata
+    integer (kind=int_kind), intent(in) :: &
+      therank
+    real (kind=dbl_kind) ::   s
+    integer :: n
+
+    allocate( thedata(size(thevars,1)) )
+
+    ! -  copy variable arrays
+
+    write(6,*) 'writing copy variables'
+    do n = 3,therank
+      s = scale(nc_variable_id(n-2))
+      thedata(:) = s*thevars(:,n-2)
+      ncstat = nf90_put_var(nc_outfile_id, nc_variable_id(n-2), thedata)
+      call netcdf_error_handler(ncstat,"put_var")
+    enddo
+
+    deallocate( thedata )
+
+  end subroutine write_extra
+
+  ! ==========================================================================
+
+  subroutine close_grid()
+
+  !     close netCDF file
+  
+    write(6,*) 'closing file'
+    ncstat = nf90_close(nc_outfile_id)
+    call netcdf_error_handler(ncstat,"close")
+  
+  end subroutine close_grid
+
+  ! ==========================================================================
+
+  subroutine read_mappings(nm_in)
+
+    !-----------------------------------------------------------------------
+    ! - dummy variables
+
+    character (char_len) ::  &
+      nm_in                    ! name of input namelist file
+  
+    !-----------------------------------------------------------------------
+    ! - local variables
+  
+    character (char_len) ::   &
+              dim_name    ! netCDF dimension name
+  
+    integer (kind=int_kind) ::     &
+        iunit                                                ! unit number for namelist file
+  
+    !-----------------------------------------------------------------------
+    ! - namelist block
+
+    namelist /interp_inputs/ input_file, interp_file, input_name, &
+                             input_stride, input_start, input_stop, &
+                             input_vars
+    namelist /interp_outputs/ output_dims, output_file, output_mode, output_name, &
+                              output_lat, output_lon, output_ydir,  &
+                              output_scaling, output_vars, output_attributes
+  
+    !-----------------------------------------------------------------------
+    ! - read namelist for file and mapping info
+  
+    input_stride(:) = 1
+    input_start(:) = 1
+    input_stop(:) = 0
+    output_scaling(:) = '-'
+    input_vars(:) = '-'
+    output_lon = '-'
+    output_lat = '-'
+    output_vars(:) = '-'
+    output_ydir = 'none'
+    output_attributes(:) = '-'
+
+    call get_unit(iunit)
+    open(iunit, file=nm_in, status='old', form='formatted')
+    read(iunit, nml=interp_inputs)
+    read(iunit, nml=interp_outputs)
+    call release_unit(iunit)
+    write(*,nml=interp_inputs)
+    write(*,nml=interp_outputs)
+    if (trim(output_mode) == "create") then
+      if (trim(output_lon) == '-' .or. trim(output_lat) == '-') then
+        write(6,*) 'if creating, need to supply lon and lat names'
+        stop
+      endif
+    endif
+
+    !-----------------------------------------------------------------------
+    ! - read remapping data
+    ! - via the scrip package this sets variables:
+    !    grid1_size, grid2_size:     sizes of input and output grids
+    !    grid1_mask, grid2_mask:     masks
+    !    grid1_rank, grid2_rank:     ranks
+  
+    call read_remap(map_name, interp_file)
+  
+  end subroutine read_mappings
+
+  ! ==========================================================================
+
+  subroutine calculate_grid(grid1_array, grid2_array)
+
+    !-----------------------------------------------------------------------
+    ! - dummy variables
+
+    real (kind=dbl_kind), intent(in), dimension(:) ::    &
+      grid1_array
+    real (kind=dbl_kind), intent(out), dimension(:) ::    &
+      grid2_array
+
+    !-----------------------------------------------------------------------
+    ! - local variables
+
+    integer (kind=int_kind), dimension(:), allocatable :: &
+        grid1_imask, grid2_imask, grid2_count
+
+    real (kind=dbl_kind), dimension(:), allocatable :: &
+        grid1_tmp,           &
+        grad1_lat,           &
+        grad1_lon,           &
+        grad1_latlon,        &
+        grad1_lat_zero,      &
+        grad1_lon_zero,      &
+        grid2_tmp1,           &
+        grid2_tmp2
+
+    real (kind=dbl_kind) ::  &
+        delew, delns            ! variables for computing bicub gradients
+
+    integer (kind=int_kind) ::                          &
+        i,j,n,imin,imax,idiff,                          &
+        ip1,im1,jp1,jm1,nx,ny,                          &  ! for computing bicub gradients
+        in,is,ie,iw,ine,inw,ise,isw
+
+    logical, parameter :: lat_gradient = .false.
+  
+    write(6,*) 'starting'
+
+    !-----------------------------------------------------------------------
+    ! - allocate arrays
+  
+    allocate (grid1_tmp      (grid1_size),   &
+              grad1_lat      (grid1_size),    &
+              grad1_lon      (grid1_size),    &
+              grad1_lat_zero (grid1_size),    &
+              grad1_lon_zero (grid1_size),    &
+              grid1_imask    (grid1_size),   &
+              grid2_tmp1     (grid2_size),   &
+              grid2_tmp2     (grid2_size),   &
+              grid2_imask    (grid2_size),   &
+              grid2_count    (grid2_size))
+  
+    write(6,*) 'allocated'
+    write(6,*) grid1_size,grid2_size
+
+    grid1_imask(:) = 1
+    grid2_imask(:) = 1
+    where (grid1_mask)
+      grid1_imask = 1
+    elsewhere
+      grid1_imask = 0
+    endwhere
+    where (grid2_mask)
+      grid2_imask = 1
+    elsewhere
+      grid2_imask = 0
+    endwhere
+
+    write(6,*) 'masked'
+
+    grad1_lat_zero = zero
+    grad1_lon_zero = zero
+    nx = input_dims(1)
+    ny = input_dims(2)
+    write(6,*) nx,ny
+  
+    !-----------------------------------------------------------------------
+    ! - if bicubic, we need 3 gradients in logical space
+  
+    if (map_type == map_type_bicubic) then
+  
+      write(6,*) 'bicubic'
+      write(6,*) grid1_size
+
+      allocate (grad1_latlon (grid1_size)) 
+  
+      do n=1,grid1_size
+  
+        grad1_lat(n) = zero
+        grad1_lon(n) = zero
+        grad1_latlon(n) = zero
+  
+!       if (n.ge.8000) write(6,*) 0,grid1_mask(n),nx
+        if (grid1_mask(n)) then
+  
+          delew = half
+          delns = half
+  
+          j = (n-1)/nx + 1
+          i = n - (j-1)*nx
+  
+          ip1 = i+1
+          im1 = i-1
+          jp1 = j+1
+          jm1 = j-1
+  
+          if (ip1 > nx) ip1 = ip1 - nx
+          if (im1 < 1 ) im1 = nx
+          if (jp1 > ny) then
+            jp1 = j
+            delns = one
+          endif
+          if (jm1 < 1 ) then
+            jm1 = j
+            delns = one
+          endif
+  
+          in  = (jp1-1)*nx + i
+          is  = (jm1-1)*nx + i
+          ie  = (j  -1)*nx + ip1
+          iw  = (j  -1)*nx + im1
+  
+          ine = (jp1-1)*nx + ip1
+          inw = (jp1-1)*nx + im1
+          ise = (jm1-1)*nx + ip1
+          isw = (jm1-1)*nx + im1
+  
+          ! -  compute i-gradient
+  
+          if (.not. grid1_mask(ie)) then
+            ie = n
+            delew = one
+          endif
+          if (.not. grid1_mask(iw)) then
+            iw = n
+            delew = one
+          endif
+   
+          grad1_lat(n) = delew*(grid1_array(ie) - grid1_array(iw))
+!         if (n.ge.8000) write(6,*) 1,grad1_lat(n)
+  
+          ! -  compute j-gradient
+  
+          if (.not. grid1_mask(in)) then
+            in = n
+            delns = one
+          endif
+          if (.not. grid1_mask(is)) then
+            is = n
+            delns = one
+          endif
+   
+          grad1_lon(n) = delns*(grid1_array(in) - grid1_array(is))
+!         if (n.ge.8000) write(6,*) 2,grad1_lon(n)
+  
+          ! -  compute ij-gradient
+  
+          delew = half
+          if (jp1 == j .or. jm1 == j) then
+            delns = one
+          else 
+            delns = half
+          endif
+  
+          if (.not. grid1_mask(ine)) then
+            if (in /= n) then
+              ine = in
+              delew = one
+            else if (ie /= n) then
+              ine = ie
+              inw = iw
+              if (inw == n) delew = one
+              delns = one
+            else
+              ine = n
+              inw = iw
+              delew = one
+              delns = one
+            endif
+          endif
+  
+          if (.not. grid1_mask(inw)) then
+            if (in /= n) then
+              inw = in
+              delew = one
+            else if (iw /= n) then
+              inw = iw
+              ine = ie
+              if (ie == n) delew = one
+              delns = one
+            else
+              inw = n
+              ine = ie
+              delew = one
+              delns = one
+            endif
+          endif
+  
+          grad1_lat_zero(n) = delew*(grid1_array(ine) - grid1_array(inw))
+!         if (n.ge.8000) write(6,*) 3,grad1_lat_zero(n)
+  
+          if (.not. grid1_mask(ise)) then
+            if (is /= n) then
+              ise = is
+              delew = one
+            else if (ie /= n) then
+              ise = ie
+              isw = iw
+              if (isw == n) delew = one
+              delns = one
+            else
+              ise = n
+              isw = iw
+              delew = one
+              delns = one
+            endif
+          endif
+  
+          if (.not. grid1_mask(isw)) then
+            if (is /= n) then
+              isw = is
+              delew = one
+            else if (iw /= n) then
+              isw = iw
+              ise = ie
+              if (ie == n) delew = one
+              delns = one
+            else
+              isw = n
+              ise = ie
+              delew = one
+              delns = one
+            endif
+          endif
+  
+          grad1_lon_zero(n) = delew*(grid1_array(ise) - grid1_array(isw))
+          grad1_latlon(n) = delns*(grad1_lat_zero(n) - grad1_lon_zero(n))
+!         if (n.ge.8000) write(6,*) 4,grad1_lon_zero(n),grad1_latlon(n)
+  
+        endif
+      enddo
+  
+      write(6,*) 'remapping'
+      call remap(grid2_array, wts_map1, grid2_add_map1, grid1_add_map1, &
+                 grid1_array, src_grad1=grad1_lat,                    &
+                 src_grad2=grad1_lon, src_grad3=grad1_latlon)
+  
+      print *,'Third order mapping from grid1 to grid2:'
+      print *,'----------------------------------------'
+      print *,'Grid1 min,max: ',minval(grid1_array),maxval(grid1_array)
+      print *,'Grid2 min,max: ',minval(grid2_array  ),maxval(grid2_array  )
+    
+      ! -  Conservation Test
+    
+      print *,'Conservation:'
+      print *,'Grid1 Integral = ',sum(grid1_array*grid1_area*grid1_frac)
+      print *,'Grid2 Integral = ',sum(grid2_array  *grid2_area*grid2_frac)
+    
+    !-----------------------------------------------------------------------
+    ! - a first-order map from grid1 to grid2
+  
+    else if (map_type /= map_type_conserv .AND.map_type /= map_type_bicubic) then
+
+      write(6,*) 'bilinear or conservative'
+  
+      call remap(grid2_array, wts_map1, grid2_add_map1, grid1_add_map1,grid1_array)
+  
+      print *,'First order mapping from grid1 to grid2:'
+      print *,'----------------------------------------'
+      print *,'Grid1 min,max: ',minval(grid1_array),maxval(grid1_array)
+      print *,'Grid2 min,max: ',minval(grid2_array  ),maxval(grid2_array  )
+    
+      ! -  Conservation Test
+    
+      print *,'Conservation:'
+      print *,'Grid1 Integral = ',sum(grid1_array*grid1_area*grid1_frac)
+      print *,'Grid2 Integral = ',sum(grid2_array  *grid2_area*grid2_frac)
+    
+    !-----------------------------------------------------------------------
+    ! - conservative mappings:
+    ! - a second-order map from grid1 to grid2 with only lat grads
+  
+    else if (map_type == map_type_conserv .AND. lat_gradient) then
+  
+      call remap(grid2_array, wts_map1, grid2_add_map1, grid1_add_map1,  &
+                 grid1_array, src_grad1=grad1_lat,src_grad2=grad1_lon_zero) 
+  
+      select case (norm_opt)
+      case (norm_opt_none)
+        grid2_tmp2 = grid2_frac*grid2_area
+        where (grid2_tmp2 /= zero)
+          grid2_array = grid2_array/grid2_tmp2
+        elsewhere
+          grid2_array = zero
+        end where
+      case (norm_opt_frcarea)
+      case (norm_opt_dstarea)
+        where (grid2_frac /= zero)
+          grid2_array = grid2_array/grid2_frac
+        elsewhere
+          grid2_array = zero
+        end where
+      end select
+  
+      print *,'Second order mapping from grid1 to grid2 (lat only):'
+      print *,'----------------------------------------'
+      print *,'Grid1 min,max: ',minval(grid1_array),maxval(grid1_array)
+      print *,'Grid2 min,max: ',minval(grid2_array  ),maxval(grid2_array  )
+  
+      ! -  Conservation Test
+  
+      print *,'Conservation:'
+      print *,'Grid1 Integral = ',sum(grid1_array*grid1_area*grid1_frac)
+      print *,'Grid2 Integral = ',sum(grid2_array*grid2_area*grid2_frac)
+  
+    !-----------------------------------------------------------------------
+    ! - conservative mappings:
+    ! - a second-order map from grid1 to grid2 both gradients
+  
+    else if (map_type == map_type_conserv .AND..NOT. lat_gradient) then
+  
+      call remap(grid2_array,wts_map1,grid2_add_map1,grid1_add_map1,  &
+                 grid1_array, src_grad1=grad1_lat,src_grad2=grad1_lon) 
+  
+      select case (norm_opt)
+      case (norm_opt_none)
+        grid2_tmp2 = grid2_frac*grid2_area
+        where (grid2_tmp2 /= zero)
+          grid2_array = grid2_array/grid2_tmp2
+        elsewhere
+          grid2_array = zero
+        end where
+      case (norm_opt_frcarea)
+      case (norm_opt_dstarea)
+        where (grid2_frac /= zero)
+          grid2_array = grid2_array/grid2_frac
+        elsewhere
+          grid2_array = zero
+        end where
+      end select
+  
+      print *,'Second order mapping from grid1 to grid2:'
+      print *,'-----------------------------------------'
+      print *,'Grid1 min,max: ',minval(grid1_array),maxval(grid1_array)
+      print *,'Grid2 min,max: ',minval(grid2_array  ),maxval(grid2_array  )
+  
+      ! -  Conservation Test
+  
+      print *,'Conservation:'
+      print *,'Grid1 Integral = ',sum(grid1_array*grid1_area*grid1_frac)
+      print *,'Grid2 Integral = ',sum(grid2_array*grid2_area*grid2_frac)
+  
+    endif
+  
+    !-----------------------------------------------------------------------
+    !     calculate some statistics
+  
+    grid2_count = zero
+    grid2_tmp1  = zero
+    grid2_tmp2  = zero
+  
+    print *,'number of sparse matrix entries ',num_links_map1
+    do n=1,num_links_map1
+      grid2_count(grid2_add_map1(n)) = grid2_count(grid2_add_map1(n)) + 1
+      if (wts_map1(1,n) > one .or. wts_map1(1,n) < zero) then
+        grid2_tmp1(grid2_add_map1(n)) = grid2_tmp1(grid2_add_map1(n)) + 1
+        grid2_tmp2(grid2_add_map1(n)) = max(abs(wts_map1(1,n)),grid2_tmp2(grid2_add_map1(n)) )
+      endif
+    end do
+  
+    do n=1,grid2_size
+      if (grid2_tmp1(n) > zero) print *,n,grid2_tmp2(n)
+    end do
+  
+    imin = minval(grid2_count, mask=(grid2_count > 0))
+    imax = maxval(grid2_count)
+    idiff =  (imax - imin)/10 + 1
+    print *,'total number of dest cells ',grid2_size
+    print *,'number of cells participating in remap ',count(grid2_count > zero)
+    print *,'min no of entries/row = ',imin
+    print *,'max no of entries/row = ',imax
+  
+    imax = imin + idiff
+    do n=1,10
+      print *,'num of rows with entries between ',imin,' - ',imax-1,   &
+               count(grid2_count >= imin .and. grid2_count < imax)
+      imin = imin + idiff
+      imax = imax + idiff
+    end do
+  
+    !-----------------------------------------------------------------------
+    ! - deallocate arrays
+  
+    deallocate (grid1_tmp, grad1_lat, grad1_lon,    &
+                grad1_lat_zero, grad1_lon_zero, grid1_imask,     &
+                grid2_tmp1, grid2_tmp2,   &
+                grid2_imask, grid2_count)
+  
+  end subroutine calculate_grid
+
+  ! ==========================================================================
+
+end module scripinterp_mod
+
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripshape.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripshape.F90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripshape.F90	(revision 2528)
@@ -0,0 +1,419 @@
+      PROGRAM scripshape
+!
+! program to take output from the SCRIP weights generator
+! and rearrange the data into a series of 2D fields suitable
+! for reading with iom_get in NEMO configurations using the
+! interpolation on the fly option
+!
+      USE netcdf
+      IMPLICIT none
+      INTEGER    :: ncId, VarId, status
+      INTEGER    :: start(4), count(4)
+      CHARACTER(LEN=1) :: y
+      INTEGER    :: nd, ns, nl, nw, sx, sy, dx, dy
+      INTEGER    :: i, j, k, m, n, smax
+!
+!  ifort -O2 -o scripshape scripshape.f90 \
+!        -I/nerc/packages/netcdfifort/v3.6.0-pl1/include \
+!        -L/nerc/packages/netcdfifort/v3.6.0-pl1/lib -lnetcdf
+!
+!
+      INTEGER(KIND=4), ALLOCATABLE :: src(:)
+      INTEGER(KIND=4), ALLOCATABLE :: dst(:)
+      REAL(KIND=8), ALLOCATABLE :: wgt(:,:)
+      REAL(KIND=8), ALLOCATABLE :: src1(:,:),dst1(:,:),wgt1(:,:)
+      LOGICAL  :: around, verbose
+#if defined ARGC
+      INTEGER(KIND=4) :: iargc
+      EXTERNAL :: iargc
+#endif
+
+      CHARACTER(LEN=256) :: interp_file, output_file, name_file
+      INTEGER            :: ew_wrap
+      NAMELIST /shape_inputs/ interp_file, output_file, ew_wrap
+
+! scripshape requires 1 arguments; the name of the file containing
+! the input namelist.
+! This namelist contains:
+!     the name of the input file containing the weights ! produced by SCRIP in its format;
+!     the name of the new output file which ! is to contain the reorganized fields ready for input to NEMO.
+!     the east-west wrapping of the input grid (-1, 0, 1 and 2 are accepted values)
+!
+! E.g.
+!     interp_file = 'data_nemo_bilin.nc'
+!     output_file = 'weights_bilin.nc'
+!     ew_wrap     = 2
+!
+#if defined ARGC
+      IF (iargc() == 1) THEN
+        CALL getarg(1, name_file)
+      ELSE
+        WRITE(*,*) 'Usage: scripshape namelist_file'
+        STOP
+      ENDIF
+#else
+      WRITE(6,*) 'enter name of namelist file'
+      READ(5,*) name_file
+#endif
+      interp_file = 'none'
+      output_file = 'none'
+      ew_wrap = 0
+      OPEN(12, FILE=name_file, STATUS='OLD', FORM='FORMATTED')
+      READ(12, NML=shape_inputs)
+      CLOSE(12)
+!
+      INQUIRE(FILE = TRIM(interp_file), EXIST=around)
+      IF (.not.around) THEN
+       WRITE(*,*) 'Input file: '//TRIM(interp_file)//' not found'
+       STOP
+      ENDIF
+! 
+      INQUIRE(FILE = TRIM(output_file), EXIST=around)
+      IF (around) THEN
+       WRITE(*,*) 'Output file: '//TRIM(output_file)//' exists'
+       WRITE(*,*) 'Ok to overwrite (y/n)?'
+       READ(5,'(a)') y
+       IF ( y .ne. 'y' .AND. y .ne. 'Y' ) STOP
+      ENDIF
+!
+      verbose = .true.
+!
+! Obtain grid size information from interp_file
+!
+      CALL ncgetsize
+!
+! Allocate array spaces
+!
+      ALLOCATE(src(nl), STAT=status)
+      IF(status /= 0 ) CALL alloc_err('src')
+      ALLOCATE(dst(nl), STAT=status)
+      IF(status /= 0 ) CALL alloc_err('dst')
+      ALLOCATE(wgt(nw,nl), STAT=status)
+      IF(status /= 0 ) CALL alloc_err('wgt')
+      ALLOCATE(src1(dx,dy), STAT=status)
+      IF(status /= 0 ) CALL alloc_err('src1')
+      ALLOCATE(dst1(dx,dy), STAT=status)
+      IF(status /= 0 ) CALL alloc_err('dst1')
+      ALLOCATE(wgt1(dx,dy), STAT=status)
+      IF(status /= 0 ) CALL alloc_err('wgt1')
+!
+! Read all required data from interp_file
+!
+      CALL ncgetfields
+!
+! Check that dst is monotonically increasing
+!
+      DO k = 1,nl-1
+       IF(dst(k+1).lt.dst(k)) THEN
+        WRITE(*,*) 'non-monotonic at ',k
+        WRITE(*,*) dst(k-4:k+16)
+        STOP
+       ENDIF
+      END DO
+!
+! Remove references to the top row of src
+!
+      IF(verbose) WRITE(*,*) &
+        'Removing references to the top row of the source grid'
+      smax = (sy-1)*sx
+      n = 0
+      DO k = 1,nl
+       IF(src(k).gt.smax-1) THEN
+        src(k) = src(k)-sx
+        n = n + 1
+       ENDIF
+      END DO
+      IF(verbose) WRITE(*,*) n,' values changed (',100.*n/nl,'%)'
+!
+! Loop through weights for each corner in turn and
+! rearrange weight fields into separate 2D fields for
+! reading with iom_get in NEMO
+!
+      DO k = 1,nw
+       DO n = 1,4
+
+        i = 0
+        j = 1
+        DO m = n,nl,4
+         i = i+1
+         IF(i.gt.dx) THEN
+          i = 1
+          j = j + 1
+         ENDIF
+         src1(i,j) = src(m)
+         dst1(i,j) = dst(m)
+         wgt1(i,j) = wgt(k,m)
+        END DO
+!
+! Write out this set which will be labelled with
+! a 2 digit number equal to n+4*(k-1)
+!
+        CALL wrwgts
+!   
+       END DO
+      END DO
+      STOP
+      CONTAINS
+!
+!----------------------------------------------------------------------*
+      SUBROUTINE ncgetsize
+!
+! Access grid size information in interp_file and set the
+! following integers:
+!
+!    nd = dst_grid_size
+!    ns = src_grid_size
+!    nl = num_links    
+!    nw = num_wgts     
+! sx,sy = src_grid_dims     
+! dx,dy = dst_grid_dims     
+!
+      INTEGER idims(2)
+!
+       status = nf90_open(interp_file, nf90_NoWrite, ncid)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_inq_dimid(ncid, 'dst_grid_size', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       status = nf90_inquire_dimension(ncid, VarId, LEN = nd)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_inq_dimid(ncid, 'src_grid_size', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       status = nf90_inquire_dimension(ncid, VarId, LEN = ns)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_inq_dimid(ncid, 'num_links', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       status = nf90_inquire_dimension(ncid, VarId, LEN = nl)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_inq_dimid(ncid, 'num_wgts', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       status = nf90_inquire_dimension(ncid, VarId, LEN = nw)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       start = 1
+       count = 2
+       status = nf90_inq_varid(ncid, 'src_grid_dims', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       status = nf90_get_var(ncid, VarId, idims, start, count)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       sx = idims(1) ; sy = idims(2)
+!
+       status = nf90_inq_varid(ncid, 'dst_grid_dims', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       status = nf90_get_var(ncid, VarId, idims, start, count)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       dx = idims(1) ; dy = idims(2)
+!
+       status = nf90_close(ncid)
+       IF (status /= nf90_noerr) CALL handle_err(status)
+!
+       IF(verbose) THEN
+         WRITE(*,*) 'Detected sizes: '
+         WRITE(*,*) 'dst_grid_size: ', nd
+         WRITE(*,*) 'src_grid_size: ', ns
+         WRITE(*,*) 'num_links    : ', nl
+         WRITE(*,*) 'num_wgts     : ', nw
+         WRITE(*,*) 'src_grid_dims: ', sx, ' x ', sy
+         WRITE(*,*) 'dst_grid_dims: ', dx, ' x ', dy
+       ENDIF
+!
+      END SUBROUTINE ncgetsize
+
+!----------------------------------------------------------------------*
+      SUBROUTINE ncgetfields
+!
+! Read all required data from interp_file. The data read are:
+!
+! netcdf variable    size   internal array
+!-----------------+-------+--------------
+! src_address        nl     src
+! dst_address        nl     dst
+! remap_matrix     (nw,nl)  wgt
+!
+       status = nf90_open(interp_file, nf90_NoWrite, ncid)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_inq_varid(ncid, 'src_address', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! Read the values for src
+       status = nf90_get_var(ncid, VarId, src, &
+                         start = (/ 1 /),      &
+                         count = (/ nl /))
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_inq_varid(ncid, 'dst_address', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! Read the values for dst
+       status = nf90_get_var(ncid, VarId, dst, &
+                         start = (/ 1 /),      &
+                         count = (/ nl /))
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_inq_varid(ncid, 'remap_matrix', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! Read the values for wgt
+       status = nf90_get_var(ncid, VarId, wgt, &
+                         start = (/ 1, 1 /),   &
+                         count = (/ nw, nl /))
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_close(ncid)
+       IF (status /= nf90_noerr) CALL handle_err(status)
+!
+      END SUBROUTINE ncgetfields
+
+!----------------------------------------------------------------------*
+      SUBROUTINE handle_err(status)
+!
+! Simple netcdf error checking routine
+!
+      INTEGER, intent ( in) :: status
+!
+      IF(status /= nf90_noerr) THEN
+       IF(trim(nf90_strerror(status)) .eq. 'Attribute not found') THEN
+! ignore
+       ELSE
+        WRITE(*,*) trim(nf90_strerror(status))
+        STOP "Stopped"
+       END IF
+      END IF
+      END SUBROUTINE handle_err
+
+!----------------------------------------------------------------------*
+      SUBROUTINE alloc_err(arname)
+!
+! Simple allocation error checking routine
+!
+      CHARACTER(LEN=*) :: arname
+!
+      WRITE(*,*) 'Allocation error attempting to ALLOCATE '//arname
+      STOP "Stopped"
+      END SUBROUTINE alloc_err
+
+!                                                                       
+!----------------------------------------------------------------------*
+      SUBROUTINE wrwgts
+!
+! Write out each set of 2D fields to output_file.
+! Each call will write out a set of srcXX, dstXX and wgtXX fields
+! where XX is a two digit number equal to n + 4*(k-1). The first
+! and last calls to this routine initialise and close the output
+! file respectively. The first call is detected when k*n=1 and the
+! last call is detected when k*n=4*nw. The outfile file remains
+! open between the first and last calls. 
+!
+      INTEGER :: status, ncid, ncin
+      INTEGER :: Lontdid, Lattdid
+      INTEGER :: tvid, tvid2, tvid3
+      INTEGER :: ioldfill
+      CHARACTER(LEN=2) :: cs
+      SAVE ncid, Lontdid, Lattdid
+!
+      IF(k*n.eq.1) THEN
+!
+! Create output_file and set the dimensions
+!
+         status = nf90_create(output_file, nf90_Clobber, ncid)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+         status = nf90_set_fill(ncid, nf90_NoFill, ioldfill)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+         status = nf90_def_dim(ncid, "lon", dx, Lontdid)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+         status = nf90_def_dim(ncid, "lat", dy, Lattdid)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+         status = nf90_put_att(ncid, nf90_global, 'ew_wrap', ew_wrap)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+      ELSE
+!
+! Reenter define mode
+!
+         status = nf90_redef(ncid)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+      ENDIF
+!
+      WRITE(cs,'(i2.2)') n + 4*(k-1)
+!
+! Define new variables
+!
+      status = nf90_def_var(ncid, "src"//cs, nf90_double, &
+                         (/ Lontdid, Lattdid /), tvid)
+      IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+      status = nf90_def_var(ncid, "dst"//cs, nf90_double, &
+                         (/ Lontdid, Lattdid /), tvid2)
+      IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+      status = nf90_def_var(ncid, "wgt"//cs, nf90_double, &
+                         (/ Lontdid, Lattdid /), tvid3)
+      IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! Leave define mode
+!
+      status = nf90_enddef(ncid)
+      IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! Write the data
+!
+      status = nf90_put_var(ncid, tvid, src1,    &
+                            start = (/ 1, 1 /),  &
+                            count = (/ dx, dy /) )
+      IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+      status = nf90_put_var(ncid, tvid2, dst1,   &
+                            start = (/ 1, 1 /),  &
+                            count = (/ dx, dy /) )
+      IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+      status = nf90_put_var(ncid, tvid3, wgt1,   &
+                            start = (/ 1, 1  /), &
+                            count = (/ dx, dy /) )
+      IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+      IF(k*n.eq.4*nw) THEN
+!
+! --     Reenter define mode
+!
+         status = nf90_redef(ncid)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! --     Reopen interp_file and transfer some global attributes
+!
+         status = nf90_open(interp_file, nf90_NoWrite, ncin)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+         status = nf90_copy_att(ncin,NF90_GLOBAL,'title',        ncid,NF90_GLOBAL)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+         status = nf90_copy_att(ncin,NF90_GLOBAL,'normalization',ncid,NF90_GLOBAL)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+         status = nf90_copy_att(ncin,NF90_GLOBAL,'map_method',   ncid,NF90_GLOBAL)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+         status = nf90_copy_att(ncin,NF90_GLOBAL,'conventions',  ncid,NF90_GLOBAL)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+         status = nf90_copy_att(ncin,NF90_GLOBAL,'history',      ncid,NF90_GLOBAL)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! --     Close interp_file
+!
+         status = nf90_close(ncin)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! --     Close output_file
+!
+         status = nf90_close(ncid)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+      ENDIF
+
+      END SUBROUTINE wrwgts
+      END PROGRAM scripshape
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/src/CHANGES_BY_NOCS
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/src/CHANGES_BY_NOCS	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/src/CHANGES_BY_NOCS	(revision 2528)
@@ -0,0 +1,12 @@
+
+      SCRIP code, version 1.4, from Los Alamos National Laboratory (http://climate.lanl.gov/Software/SCRIP)
+
+      Changes made at NOCS for inclusion of weights generation code in NEMO 3.3 and later:
+
+          - File extensions changed from '.f' to '.f90'
+          - File netcdf.f renamed as netcdf_mod.f90 to avoid clash with netcdf library module filename
+          - File netcdf.f modified to add error message to netcdf_error_handler
+          - Small bug in remap_conserv when using gfortran compiler: replace ". and." with " .and."
+          - continuation lines reformatted with '&' moved from the start of the continuation line to 
+            the end of the line before
+    
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/src/constants.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/src/constants.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/src/constants.f90	(revision 2528)
@@ -0,0 +1,65 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module defines common constants used in many routines.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: constants.f,v 1.2 2000/04/19 21:56:25 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module constants
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod  ! defines common data types
+
+      implicit none
+
+      save
+
+!-----------------------------------------------------------------------
+
+      real (kind = dbl_kind), parameter ::  &
+                              zero   = 0.0_dbl_kind, &
+                              one    = 1.0_dbl_kind, &
+                              two    = 2.0_dbl_kind, &
+                              three  = 3.0_dbl_kind, &
+                              four   = 4.0_dbl_kind, &
+                              five   = 5.0_dbl_kind, &
+                              half   = 0.5_dbl_kind, &
+                              quart  = 0.25_dbl_kind, &
+                              bignum = 1.e+20_dbl_kind, &
+                              tiny   = 1.e-14_dbl_kind, &
+                              pi     = 3.14159265359_dbl_kind, &
+                              pi2    = two*pi, &
+                              pih    = half*pi
+
+!-----------------------------------------------------------------------
+
+      end module constants
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/src/copyright
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/src/copyright	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/src/copyright	(revision 2528)
@@ -0,0 +1,26 @@
+!-----------------------------------------------------------------------
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!-----------------------------------------------------------------------
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/src/grids.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/src/grids.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/src/grids.f90	(revision 2528)
@@ -0,0 +1,831 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module reads in and initializes two grids for remapping.
+!     NOTE: grid1 must be the master grid -- the grid that determines
+!           which cells participate (e.g. land mask) and the fractional
+!           area of grid2 cells that participate in the remapping.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: grids.f,v 1.6 2001/08/21 21:06:41 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module grids
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod    ! defines data types
+      use constants    ! common constants
+      use iounits      ! I/O unit manager
+      use netcdf_mod   ! netCDF stuff
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     variables that describe each grid
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), save :: &
+                   grid1_size, grid2_size,  & ! total points on each grid
+                   grid1_rank, grid2_rank,  & ! rank of each grid
+                   grid1_corners, grid2_corners ! number of corners
+                                                ! for each grid cell
+
+      integer (kind=int_kind), dimension(:), allocatable, save :: &
+                   grid1_dims, grid2_dims  ! size of each grid dimension
+
+      character(char_len), save ::  &
+                   grid1_name, grid2_name  ! name for each grid
+
+      character (char_len), save ::  &
+                   grid1_units,  & ! units for grid coords (degs/radians)
+                   grid2_units  ! units for grid coords
+
+      real (kind=dbl_kind), parameter :: &
+            deg2rad = pi/180.   ! conversion for deg to rads
+
+!-----------------------------------------------------------------------
+!
+!     grid coordinates and masks
+!
+!-----------------------------------------------------------------------
+
+      logical (kind=log_kind), dimension(:), allocatable, save :: &
+                   grid1_mask,         & ! flag which cells participate
+                   grid2_mask         ! flag which cells participate
+
+      real (kind=dbl_kind), dimension(:), allocatable, save :: &
+                   grid1_center_lat,   & ! lat/lon coordinates for
+                   grid1_center_lon,   & ! each grid center in radians
+                   grid2_center_lat,  &
+                   grid2_center_lon, &
+                   grid1_area,         & ! tot area of each grid1 cell
+                   grid2_area,         & ! tot area of each grid2 cell
+                   grid1_area_in,      & ! area of grid1 cell from file
+                   grid2_area_in,      & ! area of grid2 cell from file
+                   grid1_frac,         & ! fractional area of grid cells
+                   grid2_frac         ! participating in remapping
+
+      real (kind=dbl_kind), dimension(:,:), allocatable, save :: &
+                   grid1_corner_lat,   & ! lat/lon coordinates for
+                   grid1_corner_lon,   & ! each grid corner in radians
+                   grid2_corner_lat,  &
+                   grid2_corner_lon
+
+      logical (kind=log_kind), save :: &
+                   luse_grid_centers  & ! use centers for bounding boxes
+      ,            luse_grid1_area    & ! use area from grid file
+      ,            luse_grid2_area   ! use area from grid file
+
+      real (kind=dbl_kind), dimension(:,:), allocatable, save :: &
+                   grid1_bound_box,   & ! lat/lon bounding box for use
+                   grid2_bound_box   ! in restricting grid searches
+
+!-----------------------------------------------------------------------
+!
+!     bins for restricting searches
+!
+!-----------------------------------------------------------------------
+
+      character (char_len), save :: &
+              restrict_type  ! type of bins to use
+
+      integer (kind=int_kind), save :: &
+              num_srch_bins  ! num of bins for restricted srch
+
+      integer (kind=int_kind), dimension(:,:), allocatable, save :: &
+              bin_addr1,  & ! min,max adds for grid1 cells in this lat bin
+              bin_addr2  ! min,max adds for grid2 cells in this lat bin
+
+      real(kind=dbl_kind), dimension(:,:), allocatable, save :: &
+              bin_lats    & ! min,max latitude for each search bin
+      ,       bin_lons   ! min,max longitude for each search bin
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine grid_init(grid1_file, grid2_file)
+
+!-----------------------------------------------------------------------
+!
+!     this routine reads grid info from grid files and makes any
+!     necessary changes (e.g. for 0,2pi longitude range)
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len), intent(in) ::  &
+                   grid1_file, grid2_file  ! grid data files
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) ::  &
+        n       & ! loop counter
+      , nele    & ! element loop counter
+      , iunit   & ! unit number for opening files
+      , i,j     & ! logical 2d addresses
+      , ip1,jp1 &
+      , n_add, e_add, ne_add &
+      , nx, ny
+
+      integer (kind=int_kind) ::  &
+               ncstat,            & ! netCDF status variable
+               nc_grid1_id,        & ! netCDF grid file id
+               nc_grid2_id,        & ! netCDF grid file id
+               nc_grid1size_id,    & ! netCDF grid size dim id
+               nc_grid2size_id,    & ! netCDF grid size dim id
+               nc_grid1corn_id,    & ! netCDF grid corner dim id
+               nc_grid2corn_id,    & ! netCDF grid corner dim id
+               nc_grid1rank_id,    & ! netCDF grid rank dim id
+               nc_grid2rank_id,    & ! netCDF grid rank dim id
+               nc_grid1area_id,    & ! netCDF grid rank dim id
+               nc_grid2area_id,    & ! netCDF grid rank dim id
+               nc_grid1dims_id,    & ! netCDF grid dimension size id
+               nc_grid2dims_id,    & ! netCDF grid dimension size id
+               nc_grd1imask_id,    & ! netCDF grid imask var id
+               nc_grd2imask_id,    & ! netCDF grid imask var id
+               nc_grd1crnrlat_id,  & ! netCDF grid corner lat var id
+               nc_grd2crnrlat_id,  & ! netCDF grid corner lat var id
+               nc_grd1crnrlon_id,  & ! netCDF grid corner lon var id
+               nc_grd2crnrlon_id,  & ! netCDF grid corner lon var id
+               nc_grd1cntrlat_id,  & ! netCDF grid center lat var id
+               nc_grd2cntrlat_id,  & ! netCDF grid center lat var id
+               nc_grd1cntrlon_id,  & ! netCDF grid center lon var id
+               nc_grd2cntrlon_id  ! netCDF grid center lon var id
+
+      integer (kind=int_kind), dimension(:), allocatable ::  &
+                                  imask ! integer mask read from file
+
+      real (kind=dbl_kind) ::  &
+        dlat,dlon           ! lat/lon intervals for search bins
+
+      real (kind=dbl_kind), dimension(4) :: &
+        tmp_lats, tmp_lons  ! temps for computing bounding boxes
+
+!-----------------------------------------------------------------------
+!
+!     open grid files and read grid size/name data
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_open(grid1_file, NF_NOWRITE, nc_grid1_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_open(grid2_file, NF_NOWRITE, nc_grid2_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_grid1_id, 'grid_size', nc_grid1size_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_grid1_id, nc_grid1size_id, grid1_size)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_grid2_id, 'grid_size', nc_grid2size_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_grid2_id, nc_grid2size_id, grid2_size)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_grid1_id, 'grid_rank', nc_grid1rank_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_grid1_id, nc_grid1rank_id, grid1_rank)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_grid2_id, 'grid_rank', nc_grid2rank_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_grid2_id, nc_grid2rank_id, grid2_rank)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_grid1_id,'grid_corners',nc_grid1corn_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_grid1_id,nc_grid1corn_id,grid1_corners)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_grid2_id,'grid_corners',nc_grid2corn_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_grid2_id,nc_grid2corn_id,grid2_corners)
+      call netcdf_error_handler(ncstat)
+
+      allocate( grid1_dims(grid1_rank), &
+                grid2_dims(grid2_rank))
+
+      ncstat = nf_get_att_text(nc_grid1_id, nf_global, 'title', &
+                               grid1_name)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_att_text(nc_grid2_id, nf_global, 'title', &
+                               grid2_name)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     allocate grid coordinates/masks and read data
+!
+!-----------------------------------------------------------------------
+
+      allocate( grid1_mask      (grid1_size), &
+                grid2_mask      (grid2_size), &
+                grid1_center_lat(grid1_size),  &
+                grid1_center_lon(grid1_size), &
+                grid2_center_lat(grid2_size),  &
+                grid2_center_lon(grid2_size), &
+                grid1_area      (grid1_size), &
+                grid2_area      (grid2_size), &
+                grid1_frac      (grid1_size), &
+                grid2_frac      (grid2_size), &
+                grid1_corner_lat(grid1_corners, grid1_size), &
+                grid1_corner_lon(grid1_corners, grid1_size), &
+                grid2_corner_lat(grid2_corners, grid2_size), &
+                grid2_corner_lon(grid2_corners, grid2_size), &
+                grid1_bound_box (4            , grid1_size), &
+                grid2_bound_box (4            , grid2_size))
+
+      allocate(imask(grid1_size))
+
+      ncstat = nf_inq_varid(nc_grid1_id, 'grid_dims', nc_grid1dims_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid1_id, 'grid_imask', nc_grd1imask_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid1_id, 'grid_center_lat',  &
+                                         nc_grd1cntrlat_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid1_id, 'grid_center_lon',  &
+                                         nc_grd1cntrlon_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid1_id, 'grid_corner_lat',  &
+                                         nc_grd1crnrlat_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid1_id, 'grid_corner_lon',  &
+                                         nc_grd1crnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_grid1_id, nc_grid1dims_id, grid1_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_grid1_id, nc_grd1imask_id, imask)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid1_id, nc_grd1cntrlat_id,  &
+                                             grid1_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid1_id, nc_grd1cntrlon_id,  &
+                                             grid1_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid1_id, nc_grd1crnrlat_id,  &
+                                             grid1_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid1_id, nc_grd1crnrlon_id,  &
+                                             grid1_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      if (luse_grid1_area) then
+        allocate (grid1_area_in(grid1_size))
+        ncstat = nf_inq_varid(nc_grid1_id, 'grid_area', nc_grid1area_id)
+        call netcdf_error_handler(ncstat)
+        ncstat = nf_get_var_double(nc_grid1_id, nc_grid1area_id,  &
+                                                grid1_area_in)
+        call netcdf_error_handler(ncstat)
+      endif
+
+      grid1_area = zero
+      grid1_frac = zero
+
+!-----------------------------------------------------------------------
+!
+!     initialize logical mask and convert lat/lon units if required
+!
+!-----------------------------------------------------------------------
+
+      where (imask == 1)
+        grid1_mask = .true.
+      elsewhere
+        grid1_mask = .false.
+      endwhere
+      deallocate(imask)
+
+      grid1_units = ' '
+      ncstat = nf_get_att_text(nc_grid1_id, nc_grd1cntrlat_id, 'units', &
+                               grid1_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid1_units(1:7))
+      case ('degrees')
+
+        grid1_center_lat = grid1_center_lat*deg2rad
+        grid1_center_lon = grid1_center_lon*deg2rad
+
+      case ('radians')
+
+        !*** no conversion necessary
+
+      case default
+
+        print *,'unknown units supplied for grid1 center lat/lon: '
+        print *,'proceeding assuming radians'
+
+      end select
+
+      grid1_units = ' '
+      ncstat = nf_get_att_text(nc_grid1_id, nc_grd1crnrlat_id, 'units', &
+                               grid1_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid1_units(1:7))
+      case ('degrees')
+
+        grid1_corner_lat = grid1_corner_lat*deg2rad
+        grid1_corner_lon = grid1_corner_lon*deg2rad
+
+      case ('radians')
+
+        !*** no conversion necessary
+
+      case default
+
+        print *,'unknown units supplied for grid1 corner lat/lon: '
+        print *,'proceeding assuming radians'
+
+      end select
+
+      ncstat = nf_close(nc_grid1_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     read data for grid 2
+!
+!-----------------------------------------------------------------------
+
+      allocate(imask(grid2_size))
+
+      ncstat = nf_inq_varid(nc_grid2_id, 'grid_dims', nc_grid2dims_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid2_id, 'grid_imask', nc_grd2imask_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid2_id, 'grid_center_lat',  &
+                                         nc_grd2cntrlat_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid2_id, 'grid_center_lon',  &
+                                         nc_grd2cntrlon_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid2_id, 'grid_corner_lat',  &
+                                         nc_grd2crnrlat_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_varid(nc_grid2_id, 'grid_corner_lon',  &
+                                         nc_grd2crnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_grid2_id, nc_grid2dims_id, grid2_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_grid2_id, nc_grd2imask_id, imask)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid2_id, nc_grd2cntrlat_id,  &
+                                             grid2_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid2_id, nc_grd2cntrlon_id,  &
+                                             grid2_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid2_id, nc_grd2crnrlat_id,  &
+                                             grid2_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_grid2_id, nc_grd2crnrlon_id,  &
+                                             grid2_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      if (luse_grid2_area) then
+        allocate (grid2_area_in(grid2_size))
+        ncstat = nf_inq_varid(nc_grid2_id, 'grid_area', nc_grid2area_id)
+        call netcdf_error_handler(ncstat)
+        ncstat = nf_get_var_double(nc_grid2_id, nc_grid2area_id,  &
+                                                grid2_area_in)
+        call netcdf_error_handler(ncstat)
+      endif
+
+      grid2_area = zero
+      grid2_frac = zero
+
+!-----------------------------------------------------------------------
+!
+!     initialize logical mask and convert lat/lon units if required
+!
+!-----------------------------------------------------------------------
+
+      where (imask == 1)
+        grid2_mask = .true.
+      elsewhere
+        grid2_mask = .false.
+      endwhere
+      deallocate(imask)
+
+      grid2_units = ' '
+      ncstat = nf_get_att_text(nc_grid2_id, nc_grd2cntrlat_id, 'units', &
+                               grid2_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid2_units(1:7))
+      case ('degrees')
+
+        grid2_center_lat = grid2_center_lat*deg2rad
+        grid2_center_lon = grid2_center_lon*deg2rad
+
+      case ('radians')
+
+        !*** no conversion necessary
+
+      case default
+
+        print *,'unknown units supplied for grid2 center lat/lon: '
+        print *,'proceeding assuming radians'
+
+      end select
+
+      grid2_units = ' '
+      ncstat = nf_get_att_text(nc_grid2_id, nc_grd2crnrlat_id, 'units', &
+                               grid2_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid2_units(1:7))
+      case ('degrees')
+
+        grid2_corner_lat = grid2_corner_lat*deg2rad
+        grid2_corner_lon = grid2_corner_lon*deg2rad
+
+      case ('radians')
+
+        !*** no conversion necessary
+
+      case default
+
+        print *,'no units supplied for grid2 corner lat/lon: '
+        print *,'proceeding assuming radians'
+
+      end select
+
+      ncstat = nf_close(nc_grid2_id)
+      call netcdf_error_handler(ncstat)
+
+
+!-----------------------------------------------------------------------
+!
+!     convert longitudes to 0,2pi interval
+!
+!-----------------------------------------------------------------------
+
+      where (grid1_center_lon .gt. pi2)  grid1_center_lon = &
+                                         grid1_center_lon - pi2
+      where (grid1_center_lon .lt. zero) grid1_center_lon = &
+                                         grid1_center_lon + pi2
+      where (grid2_center_lon .gt. pi2)  grid2_center_lon = &
+                                         grid2_center_lon - pi2
+      where (grid2_center_lon .lt. zero) grid2_center_lon = &
+                                         grid2_center_lon + pi2
+      where (grid1_corner_lon .gt. pi2)  grid1_corner_lon = &
+                                         grid1_corner_lon - pi2
+      where (grid1_corner_lon .lt. zero) grid1_corner_lon = &
+                                         grid1_corner_lon + pi2
+      where (grid2_corner_lon .gt. pi2)  grid2_corner_lon = &
+                                         grid2_corner_lon - pi2
+      where (grid2_corner_lon .lt. zero) grid2_corner_lon = &
+                                         grid2_corner_lon + pi2
+
+!-----------------------------------------------------------------------
+!
+!     make sure input latitude range is within the machine values
+!     for +/- pi/2 
+!
+!-----------------------------------------------------------------------
+
+      where (grid1_center_lat >  pih) grid1_center_lat =  pih
+      where (grid1_corner_lat >  pih) grid1_corner_lat =  pih
+      where (grid1_center_lat < -pih) grid1_center_lat = -pih
+      where (grid1_corner_lat < -pih) grid1_corner_lat = -pih
+
+      where (grid2_center_lat >  pih) grid2_center_lat =  pih
+      where (grid2_corner_lat >  pih) grid2_corner_lat =  pih
+      where (grid2_center_lat < -pih) grid2_center_lat = -pih
+      where (grid2_corner_lat < -pih) grid2_corner_lat = -pih
+
+!-----------------------------------------------------------------------
+!
+!     compute bounding boxes for restricting future grid searches
+!
+!-----------------------------------------------------------------------
+
+      if (.not. luse_grid_centers) then
+        grid1_bound_box(1,:) = minval(grid1_corner_lat, DIM=1)
+        grid1_bound_box(2,:) = maxval(grid1_corner_lat, DIM=1)
+        grid1_bound_box(3,:) = minval(grid1_corner_lon, DIM=1)
+        grid1_bound_box(4,:) = maxval(grid1_corner_lon, DIM=1)
+
+        grid2_bound_box(1,:) = minval(grid2_corner_lat, DIM=1)
+        grid2_bound_box(2,:) = maxval(grid2_corner_lat, DIM=1)
+        grid2_bound_box(3,:) = minval(grid2_corner_lon, DIM=1)
+        grid2_bound_box(4,:) = maxval(grid2_corner_lon, DIM=1)
+
+      else
+
+        nx = grid1_dims(1)
+        ny = grid1_dims(2)
+
+        do n=1,grid1_size
+
+          !*** find N,S and NE points to this grid point
+
+          j = (n - 1)/nx +1
+          i = n - (j-1)*nx
+
+          if (i < nx) then
+            ip1 = i + 1
+          else
+            !*** assume cyclic
+            ip1 = 1
+            !*** but if it is not, correct
+            e_add = (j - 1)*nx + ip1
+            if (abs(grid1_center_lat(e_add) -  &
+                    grid1_center_lat(n   )) > pih) then
+              ip1 = i
+            endif
+          endif
+
+          if (j < ny) then
+            jp1 = j+1
+          else
+            !*** assume cyclic
+            jp1 = 1
+            !*** but if it is not, correct
+            n_add = (jp1 - 1)*nx + i
+            if (abs(grid1_center_lat(n_add) -  &
+                    grid1_center_lat(n   )) > pih) then
+              jp1 = j
+            endif
+          endif
+
+          n_add = (jp1 - 1)*nx + i
+          e_add = (j - 1)*nx + ip1
+          ne_add = (jp1 - 1)*nx + ip1
+
+          !*** find N,S and NE lat/lon coords and check bounding box
+
+          tmp_lats(1) = grid1_center_lat(n)
+          tmp_lats(2) = grid1_center_lat(e_add)
+          tmp_lats(3) = grid1_center_lat(ne_add)
+          tmp_lats(4) = grid1_center_lat(n_add)
+
+          tmp_lons(1) = grid1_center_lon(n)
+          tmp_lons(2) = grid1_center_lon(e_add)
+          tmp_lons(3) = grid1_center_lon(ne_add)
+          tmp_lons(4) = grid1_center_lon(n_add)
+
+          grid1_bound_box(1,n) = minval(tmp_lats)
+          grid1_bound_box(2,n) = maxval(tmp_lats)
+          grid1_bound_box(3,n) = minval(tmp_lons)
+          grid1_bound_box(4,n) = maxval(tmp_lons)
+        end do
+
+        nx = grid2_dims(1)
+        ny = grid2_dims(2)
+
+        do n=1,grid2_size
+
+          !*** find N,S and NE points to this grid point
+
+          j = (n - 1)/nx +1
+          i = n - (j-1)*nx
+
+          if (i < nx) then
+            ip1 = i + 1
+          else
+            !*** assume cyclic
+            ip1 = 1
+            !*** but if it is not, correct
+            e_add = (j - 1)*nx + ip1
+            if (abs(grid2_center_lat(e_add) -  &
+                    grid2_center_lat(n   )) > pih) then
+              ip1 = i
+            endif
+          endif
+
+          if (j < ny) then
+            jp1 = j+1
+          else
+            !*** assume cyclic
+            jp1 = 1
+            !*** but if it is not, correct
+            n_add = (jp1 - 1)*nx + i
+            if (abs(grid2_center_lat(n_add) -  &
+                    grid2_center_lat(n   )) > pih) then
+              jp1 = j
+            endif
+          endif
+
+          n_add = (jp1 - 1)*nx + i
+          e_add = (j - 1)*nx + ip1
+          ne_add = (jp1 - 1)*nx + ip1
+
+          !*** find N,S and NE lat/lon coords and check bounding box
+
+          tmp_lats(1) = grid2_center_lat(n)
+          tmp_lats(2) = grid2_center_lat(e_add)
+          tmp_lats(3) = grid2_center_lat(ne_add)
+          tmp_lats(4) = grid2_center_lat(n_add)
+
+          tmp_lons(1) = grid2_center_lon(n)
+          tmp_lons(2) = grid2_center_lon(e_add)
+          tmp_lons(3) = grid2_center_lon(ne_add)
+          tmp_lons(4) = grid2_center_lon(n_add)
+
+          grid2_bound_box(1,n) = minval(tmp_lats)
+          grid2_bound_box(2,n) = maxval(tmp_lats)
+          grid2_bound_box(3,n) = minval(tmp_lons)
+          grid2_bound_box(4,n) = maxval(tmp_lons)
+        end do
+
+      endif
+
+      where (abs(grid1_bound_box(4,:) - grid1_bound_box(3,:)) > pi)
+        grid1_bound_box(3,:) = zero
+        grid1_bound_box(4,:) = pi2
+      end where
+
+      where (abs(grid2_bound_box(4,:) - grid2_bound_box(3,:)) > pi)
+        grid2_bound_box(3,:) = zero
+        grid2_bound_box(4,:) = pi2
+      end where
+
+      !***
+      !*** try to check for cells that overlap poles
+      !***
+
+      where (grid1_center_lat > grid1_bound_box(2,:)) &
+        grid1_bound_box(2,:) = pih
+
+      where (grid1_center_lat < grid1_bound_box(1,:)) &
+        grid1_bound_box(1,:) = -pih
+
+      where (grid2_center_lat > grid2_bound_box(2,:)) &
+        grid2_bound_box(2,:) = pih
+
+      where (grid2_center_lat < grid2_bound_box(1,:)) &
+        grid2_bound_box(1,:) = -pih
+
+!-----------------------------------------------------------------------
+!
+!     set up and assign address ranges to search bins in order to 
+!     further restrict later searches
+!
+!-----------------------------------------------------------------------
+
+      select case (restrict_type)
+
+      case ('latitude')
+        write(stdout,*) 'Using latitude bins to restrict search.'
+
+        allocate(bin_addr1(2,num_srch_bins))
+        allocate(bin_addr2(2,num_srch_bins))
+        allocate(bin_lats (2,num_srch_bins))
+        allocate(bin_lons (2,num_srch_bins))
+
+        dlat = pi/num_srch_bins
+
+        do n=1,num_srch_bins
+          bin_lats(1,n) = (n-1)*dlat - pih
+          bin_lats(2,n) =     n*dlat - pih
+          bin_lons(1,n) = zero
+          bin_lons(2,n) = pi2
+          bin_addr1(1,n) = grid1_size + 1
+          bin_addr1(2,n) = 0
+          bin_addr2(1,n) = grid2_size + 1
+          bin_addr2(2,n) = 0
+        end do
+
+        do nele=1,grid1_size
+          do n=1,num_srch_bins
+            if (grid1_bound_box(1,nele) <= bin_lats(2,n) .and. &
+                grid1_bound_box(2,nele) >= bin_lats(1,n)) then
+              bin_addr1(1,n) = min(nele,bin_addr1(1,n))
+              bin_addr1(2,n) = max(nele,bin_addr1(2,n))
+            endif
+          end do
+        end do
+
+        do nele=1,grid2_size
+          do n=1,num_srch_bins
+            if (grid2_bound_box(1,nele) <= bin_lats(2,n) .and. &
+                grid2_bound_box(2,nele) >= bin_lats(1,n)) then
+              bin_addr2(1,n) = min(nele,bin_addr2(1,n))
+              bin_addr2(2,n) = max(nele,bin_addr2(2,n))
+            endif
+          end do
+        end do
+
+      case ('latlon')
+        write(stdout,*) 'Using lat/lon boxes to restrict search.'
+
+        dlat = pi /num_srch_bins
+        dlon = pi2/num_srch_bins
+
+        allocate(bin_addr1(2,num_srch_bins*num_srch_bins))
+        allocate(bin_addr2(2,num_srch_bins*num_srch_bins))
+        allocate(bin_lats (2,num_srch_bins*num_srch_bins))
+        allocate(bin_lons (2,num_srch_bins*num_srch_bins))
+
+        n = 0
+        do j=1,num_srch_bins
+        do i=1,num_srch_bins
+          n = n + 1
+
+          bin_lats(1,n) = (j-1)*dlat - pih
+          bin_lats(2,n) =     j*dlat - pih
+          bin_lons(1,n) = (i-1)*dlon
+          bin_lons(2,n) =     i*dlon
+          bin_addr1(1,n) = grid1_size + 1
+          bin_addr1(2,n) = 0
+          bin_addr2(1,n) = grid2_size + 1
+          bin_addr2(2,n) = 0
+        end do
+        end do
+
+        num_srch_bins = num_srch_bins**2
+
+        do nele=1,grid1_size
+          do n=1,num_srch_bins
+            if (grid1_bound_box(1,nele) <= bin_lats(2,n) .and. &
+                grid1_bound_box(2,nele) >= bin_lats(1,n) .and. &
+                grid1_bound_box(3,nele) <= bin_lons(2,n) .and. &
+                grid1_bound_box(4,nele) >= bin_lons(1,n)) then
+              bin_addr1(1,n) = min(nele,bin_addr1(1,n))
+              bin_addr1(2,n) = max(nele,bin_addr1(2,n))
+            endif
+          end do
+        end do
+
+        do nele=1,grid2_size
+          do n=1,num_srch_bins
+            if (grid2_bound_box(1,nele) <= bin_lats(2,n) .and. &
+                grid2_bound_box(2,nele) >= bin_lats(1,n) .and. &
+                grid2_bound_box(3,nele) <= bin_lons(2,n) .and. &
+                grid2_bound_box(4,nele) >= bin_lons(1,n)) then
+              bin_addr2(1,n) = min(nele,bin_addr2(1,n))
+              bin_addr2(2,n) = max(nele,bin_addr2(2,n))
+            endif
+          end do
+        end do
+
+      case default
+        stop 'unknown search restriction method'
+      end select
+
+!-----------------------------------------------------------------------
+
+      end subroutine grid_init
+
+!***********************************************************************
+
+      end module grids
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/src/iounits.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/src/iounits.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/src/iounits.f90	(revision 2528)
@@ -0,0 +1,154 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module is a dynamic I/O unit manager.  It keeps track of
+!     which units are in use and reserves units for stdin, stdout, and
+!     stderr.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: iounits.f,v 1.2 2000/04/19 21:56:25 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module iounits
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod   ! defines data types
+
+      implicit none
+
+!-----------------------------------------------------------------------
+
+      logical (kind=log_kind), dimension(99), save :: &
+          unit_free   ! flags to determine whether unit is free for use
+
+      integer (kind=int_kind), parameter :: &
+          stdin  = 5,  & ! reserves unit for standard input
+          stdout = 6,  & ! reserves unit for standard output
+          stderr = 6  ! reserves unit for standard error
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine get_unit(iunit)
+
+!-----------------------------------------------------------------------
+!
+!     This routine returns the next available I/O unit number.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     output variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(out) :: &
+           iunit   ! next free I/O unit
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n
+
+      logical (kind=log_kind), save :: first_call = .true.
+
+!-----------------------------------------------------------------------
+!
+!     if this is the first call, reserve stdout, stdin and stderr
+!
+!-----------------------------------------------------------------------
+
+      if (first_call) then
+        unit_free = .true.
+        unit_free(stdin)  = .false.
+        unit_free(stdout) = .false.
+        unit_free(stderr) = .false.
+        first_call = .false.
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     search for next available unit
+!
+!-----------------------------------------------------------------------
+
+      srch_unit: do n=1,99
+        if (unit_free(n)) then
+          iunit = n
+          unit_free(n) = .false.
+          exit srch_unit
+        endif
+      end do srch_unit
+
+!-----------------------------------------------------------------------
+
+      end subroutine get_unit
+
+!***********************************************************************
+
+      subroutine release_unit(iunit)
+
+!-----------------------------------------------------------------------
+!
+!     This routine releases the specified unit and closes the file.
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) :: &
+           iunit   ! I/O unit to release
+
+!-----------------------------------------------------------------------
+!
+!     closes I/O unit and declares it free
+!
+!-----------------------------------------------------------------------
+
+      unit_free(iunit) = .true.
+      close(iunit)
+
+!-----------------------------------------------------------------------
+
+      end subroutine release_unit
+
+!***********************************************************************
+
+      end module iounits
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/src/kinds_mod.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/src/kinds_mod.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/src/kinds_mod.f90	(revision 2528)
@@ -0,0 +1,53 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module defines the F90 kind parameter for common data types.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: kinds_mod.f,v 1.2 2000/04/19 21:56:25 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module kinds_mod
+
+!-----------------------------------------------------------------------
+
+      implicit none
+      save
+
+!-----------------------------------------------------------------------
+
+      integer, parameter :: char_len  = 80, &
+                            int_kind  = kind(1), &
+                            log_kind  = kind(.true.), &
+                            real_kind = selected_real_kind(6), &
+                            dbl_kind  = selected_real_kind(13)
+
+!-----------------------------------------------------------------------
+
+      end module kinds_mod
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/src/netcdf_mod.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/src/netcdf_mod.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/src/netcdf_mod.f90	(revision 2528)
@@ -0,0 +1,84 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module contains the netCDF include file and a netcdf error
+!     handling routine.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: netcdf.f,v 1.2 2000/04/19 21:56:25 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module netcdf_mod
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod
+      use constants
+
+      implicit none
+
+      include 'netcdf.inc'
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine netcdf_error_handler(istat, mess)
+
+!-----------------------------------------------------------------------
+!
+!     This routine provides a simple interface to netCDF error message
+!     routine.
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::  &
+          istat   ! integer status returned by netCDF function call
+      character (len=*), intent(in), optional :: mess
+
+!-----------------------------------------------------------------------
+
+      if (istat /= NF_NOERR) then
+       if (present(mess)) then
+         print *,'Error in netCDF: ',nf_strerror(istat), 'Message: ',mess
+       else
+         print *,'Error in netCDF: ',nf_strerror(istat)
+       endif
+        stop
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine netcdf_error_handler
+
+!***********************************************************************
+
+      end module netcdf_mod
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/src/remap.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/src/remap.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/src/remap.f90	(revision 2528)
@@ -0,0 +1,165 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this routine performs a remapping based on addresses and weights
+!     computed in a setup phase
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap.f,v 1.5 2000/04/19 21:56:25 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_mod
+
+!-----------------------------------------------------------------------
+!
+!     this module contains the routines for performing the actual
+!     remappings
+!
+!-----------------------------------------------------------------------
+
+      use kinds_mod    ! defines common data types
+      use constants    ! defines common constants
+
+      implicit none
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine remap(dst_array, map_wts, dst_add, src_add,  &
+                       src_array, src_grad1, src_grad2, src_grad3)
+
+!-----------------------------------------------------------------------
+!
+!     performs the remapping based on weights computed elsewhere
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input arrays
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(:), intent(in) :: &
+           dst_add,      & ! destination address for each link
+           src_add      ! source      address for each link
+
+      real (kind=dbl_kind), dimension(:,:), intent(in) :: &
+           map_wts      ! remapping weights for each link
+
+      real (kind=dbl_kind), dimension(:), intent(in) :: &
+           src_array    ! array with source field to be remapped
+
+      real (kind=dbl_kind), dimension(:), intent(in), optional :: &
+           src_grad1     & ! gradient arrays on source grid necessary for
+      ,    src_grad2     & ! higher-order remappings
+      ,    src_grad3
+
+!-----------------------------------------------------------------------
+!
+!     output variables
+!
+!-----------------------------------------------------------------------
+
+      real (kind=dbl_kind), dimension(:), intent(inout) :: &
+           dst_array    ! array for remapped field on destination grid
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, iorder
+
+!-----------------------------------------------------------------------
+!
+!     check the order of the interpolation
+!
+!-----------------------------------------------------------------------
+
+      if (present(src_grad1)) then
+        iorder = 2
+      else
+        iorder = 1
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     first order remapping
+!
+!-----------------------------------------------------------------------
+
+      dst_array = zero
+
+      select case (iorder)
+      case(1)
+
+        do n=1,size(dst_add)
+          dst_array(dst_add(n)) = dst_array(dst_add(n)) +  &
+                                  src_array(src_add(n))*map_wts(1,n)
+        end do
+
+!-----------------------------------------------------------------------
+!
+!     second order remapping
+!
+!-----------------------------------------------------------------------
+
+      case(2)
+
+        if (size(map_wts,DIM=1) == 3) then
+          do n=1,size(dst_add)
+            dst_array(dst_add(n)) = dst_array(dst_add(n)) + &
+                                    src_array(src_add(n))*map_wts(1,n) + &
+                                    src_grad1(src_add(n))*map_wts(2,n) + &
+                                    src_grad2(src_add(n))*map_wts(3,n)
+          end do
+        else if (size(map_wts,DIM=1) == 4) then
+          do n=1,size(dst_add)
+            dst_array(dst_add(n)) = dst_array(dst_add(n)) + &
+                                    src_array(src_add(n))*map_wts(1,n) + &
+                                    src_grad1(src_add(n))*map_wts(2,n) + &
+                                    src_grad2(src_add(n))*map_wts(3,n) + &
+                                    src_grad3(src_add(n))*map_wts(4,n)
+          end do
+        endif
+
+      end select
+
+!-----------------------------------------------------------------------
+
+      end subroutine remap
+
+!***********************************************************************
+
+      end module remap_mod
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/src/remap_bicubic.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/src/remap_bicubic.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/src/remap_bicubic.f90	(revision 2528)
@@ -0,0 +1,844 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this module contains necessary routines for performing an 
+!     bicubic interpolation.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_bicubic.f,v 1.5 2001/08/22 18:20:41 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_bicubic
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod     ! defines common data types
+      use constants     ! defines common constants
+      use grids         ! module containing grid info
+      use remap_vars    ! module containing remap info
+
+      implicit none
+
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), parameter :: &
+          max_iter = 100   ! max iteration count for i,j iteration
+
+      real (kind=dbl_kind), parameter :: &
+           converge = 1.e-10_dbl_kind  ! convergence criterion
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine remap_bicub
+
+!-----------------------------------------------------------------------
+!
+!     this routine computes the weights for a bicubic interpolation.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n,icount, &
+           dst_add,         & ! destination address
+           iter,            & ! iteration counter
+           nmap            ! index of current map being computed
+
+      integer (kind=int_kind), dimension(4) ::  &
+           src_add         ! address for the four source points
+
+      real (kind=dbl_kind), dimension(4)  :: &
+           src_lats,        & ! latitudes  of four bilinear corners
+           src_lons        ! longitudes of four bilinear corners
+
+      real (kind=dbl_kind), dimension(4,4)  :: &
+           wgts            ! bicubic weights for four corners
+
+      real (kind=dbl_kind) :: &
+           plat, plon,        & ! lat/lon coords of destination point
+           iguess, jguess,    & ! current guess for bilinear coordinate
+           thguess, phguess,  & ! current guess for lat/lon coordinate
+           deli, delj,        & ! corrections to i,j
+           dth1, dth2, dth3,  & ! some latitude  differences
+           dph1, dph2, dph3,  & ! some longitude differences
+           dthp, dphp,        & ! difference between point and sw corner
+           mat1, mat2, mat3, mat4,  & ! matrix elements
+           determinant,       & ! matrix determinant
+           sum_wgts,          & ! sum of weights for normalization
+           w1,w2,w3,w4,w5,w6,w7,w8,  & ! 16 bicubic weight functions
+           w9,w10,w11,w12,w13,w14,w15,w16
+
+!-----------------------------------------------------------------------
+!
+!     compute mappings from grid1 to grid2
+!
+!-----------------------------------------------------------------------
+
+      nmap = 1
+      if (grid1_rank /= 2) then
+        stop 'Can not do bicubic interpolation when grid_rank /= 2'
+      endif
+
+      !***
+      !*** loop over destination grid 
+      !***
+
+      grid_loop1: do dst_add = 1, grid2_size
+
+        if (.not. grid2_mask(dst_add)) cycle grid_loop1
+
+        plat = grid2_center_lat(dst_add)
+        plon = grid2_center_lon(dst_add)
+
+!-----------------------------------------------------------------------
+!
+!       find nearest square of grid points on source grid
+!
+!-----------------------------------------------------------------------
+
+        call grid_search_bicub(src_add, src_lats, src_lons,  &
+                               plat, plon, grid1_dims, &
+                               grid1_center_lat, grid1_center_lon, &
+                               grid1_bound_box, bin_addr1, bin_addr2)
+
+        !***
+        !*** check to see if points are land points
+        !***
+
+        if (src_add(1) > 0) then
+          do n=1,4
+            if (.not. grid1_mask(src_add(n))) src_add(1) = 0
+          end do
+        endif
+
+!-----------------------------------------------------------------------
+!
+!       if point found, find local i,j coordinates for weights
+!
+!-----------------------------------------------------------------------
+
+        if (src_add(1) > 0) then
+
+          grid2_frac(dst_add) = one
+
+          !***
+          !*** iterate to find i,j for bicubic approximation
+          !***
+
+          dth1 = src_lats(2) - src_lats(1)
+          dth2 = src_lats(4) - src_lats(1)
+          dth3 = src_lats(3) - src_lats(2) - dth2
+
+          dph1 = src_lons(2) - src_lons(1)
+          dph2 = src_lons(4) - src_lons(1)
+          dph3 = src_lons(3) - src_lons(2)
+
+          if (dph1 >  three*pih) dph1 = dph1 - pi2
+          if (dph2 >  three*pih) dph2 = dph2 - pi2
+          if (dph3 >  three*pih) dph3 = dph3 - pi2
+          if (dph1 < -three*pih) dph1 = dph1 + pi2
+          if (dph2 < -three*pih) dph2 = dph2 + pi2
+          if (dph3 < -three*pih) dph3 = dph3 + pi2
+
+          dph3 = dph3 - dph2
+
+          iguess = half
+          jguess = half
+
+          iter_loop1: do iter=1,max_iter
+
+            dthp = plat - src_lats(1) - dth1*iguess - &
+                          dth2*jguess - dth3*iguess*jguess
+            dphp = plon - src_lons(1)
+
+            if (dphp >  three*pih) dphp = dphp - pi2
+            if (dphp < -three*pih) dphp = dphp + pi2
+
+            dphp = dphp - dph1*iguess - dph2*jguess -  &
+                          dph3*iguess*jguess
+
+            mat1 = dth1 + dth3*jguess
+            mat2 = dth2 + dth3*iguess
+            mat3 = dph1 + dph3*jguess
+            mat4 = dph2 + dph3*iguess
+
+            determinant = mat1*mat4 - mat2*mat3
+
+            deli = (dthp*mat4 - mat2*dphp)/determinant
+            delj = (mat1*dphp - dthp*mat3)/determinant
+
+            if (abs(deli) < converge .and.  &
+                abs(delj) < converge) exit iter_loop1
+
+            iguess = iguess + deli
+            jguess = jguess + delj
+
+          end do iter_loop1
+
+          if (iter <= max_iter) then
+
+!-----------------------------------------------------------------------
+!
+!           successfully found i,j - compute weights
+!
+!-----------------------------------------------------------------------
+
+            wgts(1,1) = (one - jguess**2*(three-two*jguess))* &
+                        (one - iguess**2*(three-two*iguess))
+            wgts(1,2) = (one - jguess**2*(three-two*jguess))* &
+                               iguess**2*(three-two*iguess)
+            wgts(1,3) =        jguess**2*(three-two*jguess)* &
+                               iguess**2*(three-two*iguess)
+            wgts(1,4) =        jguess**2*(three-two*jguess)* &
+                        (one - iguess**2*(three-two*iguess))
+            wgts(2,1) = (one - jguess**2*(three-two*jguess))* &
+                               iguess*(iguess-one)**2
+            wgts(2,2) = (one - jguess**2*(three-two*jguess))* &
+                               iguess**2*(iguess-one)
+            wgts(2,3) =        jguess**2*(three-two*jguess)* &
+                               iguess**2*(iguess-one)
+            wgts(2,4) =        jguess**2*(three-two*jguess)* &
+                               iguess*(iguess-one)**2
+            wgts(3,1) =        jguess*(jguess-one)**2* &
+                        (one - iguess**2*(three-two*iguess))
+            wgts(3,2) =        jguess*(jguess-one)**2* &
+                               iguess**2*(three-two*iguess)
+            wgts(3,3) =        jguess**2*(jguess-one)* &
+                               iguess**2*(three-two*iguess)
+            wgts(3,4) =        jguess**2*(jguess-one)* &
+                        (one - iguess**2*(three-two*iguess))
+            wgts(4,1) =        iguess*(iguess-one)**2* &
+                               jguess*(jguess-one)**2
+            wgts(4,2) =        iguess**2*(iguess-one)* &
+                               jguess*(jguess-one)**2
+            wgts(4,3) =        iguess**2*(iguess-one)* &
+                               jguess**2*(jguess-one)
+            wgts(4,4) =        iguess*(iguess-one)**2* &
+                               jguess**2*(jguess-one)
+
+            call store_link_bicub(dst_add, src_add, wgts, nmap)
+
+          else
+            stop 'Iteration for i,j exceed max iteration count'
+          endif
+
+!-----------------------------------------------------------------------
+!
+!       search for bilinear failed - use a distance-weighted
+!       average instead (this is typically near the pole)
+!
+!-----------------------------------------------------------------------
+
+        else if (src_add(1) < 0) then
+
+          src_add = abs(src_add)
+
+          icount = 0
+          do n=1,4
+            if (grid1_mask(src_add(n))) then
+              icount = icount + 1
+            else
+              src_lats(n) = zero
+            endif
+          end do
+
+          if (icount > 0) then
+            !*** renormalize weights
+
+            sum_wgts = sum(src_lats)
+            wgts(1,1) = src_lats(1)/sum_wgts
+            wgts(1,2) = src_lats(2)/sum_wgts
+            wgts(1,3) = src_lats(3)/sum_wgts
+            wgts(1,4) = src_lats(4)/sum_wgts
+            wgts(2:4,:) = zero
+
+            grid2_frac(dst_add) = one
+            call store_link_bicub(dst_add, src_add, wgts, nmap)
+          endif
+
+        endif
+      end do grid_loop1
+
+!-----------------------------------------------------------------------
+!
+!     compute mappings from grid2 to grid1 if necessary
+!
+!-----------------------------------------------------------------------
+
+      if (num_maps > 1) then
+
+      nmap = 2
+      if (grid2_rank /= 2) then
+        stop 'Can not do bicubic interpolation when grid_rank /= 2'
+      endif
+
+      !***
+      !*** loop over destination grid 
+      !***
+
+      grid_loop2: do dst_add = 1, grid1_size
+
+        if (.not. grid1_mask(dst_add)) cycle grid_loop2
+
+        plat = grid1_center_lat(dst_add)
+        plon = grid1_center_lon(dst_add)
+
+        !***
+        !*** find nearest square of grid points on source grid
+        !***
+
+        call grid_search_bicub(src_add, src_lats, src_lons,  &
+                               plat, plon, grid2_dims, &
+                               grid2_center_lat, grid2_center_lon, &
+                               grid2_bound_box, bin_addr2, bin_addr1)
+
+        !***
+        !*** check to see if points are land points
+        !***
+
+        if (src_add(1) > 0) then
+          do n=1,4
+            if (.not. grid2_mask(src_add(n))) src_add(1) = 0
+          end do
+        endif
+
+        !***
+        !*** if point found, find i,j coordinates for weights
+        !***
+
+        if (src_add(1) > 0) then
+
+          grid1_frac(dst_add) = one
+
+          !***
+          !*** iterate to find i,j for bilinear approximation
+          !***
+
+          dth1 = src_lats(2) - src_lats(1)
+          dth2 = src_lats(4) - src_lats(1)
+          dth3 = src_lats(3) - src_lats(2) - dth2
+
+          dph1 = src_lons(2) - src_lons(1)
+          dph2 = src_lons(4) - src_lons(1)
+          dph3 = src_lons(3) - src_lons(2)
+
+          if (dph1 >  pi) dph1 = dph1 - pi2
+          if (dph2 >  pi) dph2 = dph2 - pi2
+          if (dph3 >  pi) dph3 = dph3 - pi2
+          if (dph1 < -pi) dph1 = dph1 + pi2
+          if (dph2 < -pi) dph2 = dph2 + pi2
+          if (dph3 < -pi) dph3 = dph3 + pi2
+
+          dph3 = dph3 - dph2
+
+          iguess = zero
+          jguess = zero
+
+          iter_loop2: do iter=1,max_iter
+
+            dthp = plat - src_lats(1) - dth1*iguess - &
+                          dth2*jguess - dth3*iguess*jguess
+            dphp = plon - src_lons(1)
+
+            if (dphp >  pi) dphp = dphp - pi2
+            if (dphp < -pi) dphp = dphp + pi2
+
+            dphp = dphp - dph1*iguess - dph2*jguess -  &
+                          dph3*iguess*jguess
+
+            mat1 = dth1 + dth3*jguess
+            mat2 = dth2 + dth3*iguess
+            mat3 = dph1 + dph3*jguess
+            mat4 = dph2 + dph3*iguess
+
+            determinant = mat1*mat4 - mat2*mat3
+
+            deli = (dthp*mat4 - mat2*dphp)/determinant
+            delj = (mat1*dphp - dthp*mat3)/determinant
+
+            if (abs(deli) < converge .and.  &
+                abs(delj) < converge) exit iter_loop2
+
+            iguess = iguess + deli
+            jguess = jguess + delj
+
+          end do iter_loop2
+
+          if (iter <= max_iter) then
+
+            !***
+            !*** successfully found i,j - compute weights
+            !***
+
+            wgts(1,1) = (one - jguess**2*(three-two*jguess))* &
+                        (one - iguess**2*(three-two*iguess))
+            wgts(1,2) = (one - jguess**2*(three-two*jguess))* &
+                               iguess**2*(three-two*iguess)
+            wgts(1,3) =        jguess**2*(three-two*jguess)* &
+                               iguess**2*(three-two*iguess)
+            wgts(1,4) =        jguess**2*(three-two*jguess)* &
+                        (one - iguess**2*(three-two*iguess))
+            wgts(2,1) = (one - jguess**2*(three-two*jguess))* &
+                               iguess*(iguess-one)**2
+            wgts(2,2) = (one - jguess**2*(three-two*jguess))* &
+                               iguess**2*(iguess-one)
+            wgts(2,3) =        jguess**2*(three-two*jguess)* &
+                               iguess**2*(iguess-one)
+            wgts(2,4) =        jguess**2*(three-two*jguess)* &
+                               iguess*(iguess-one)**2
+            wgts(3,1) =        jguess*(jguess-one)**2* &
+                        (one - iguess**2*(three-two*iguess))
+            wgts(3,2) =        jguess*(jguess-one)**2* &
+                               iguess**2*(three-two*iguess)
+            wgts(3,3) =        jguess**2*(jguess-one)* &
+                               iguess**2*(three-two*iguess)
+            wgts(3,4) =        jguess**2*(jguess-one)* &
+                        (one - iguess**2*(three-two*iguess))
+            wgts(4,1) =        iguess*(iguess-one)**2* &
+                               jguess*(jguess-one)**2
+            wgts(4,2) =        iguess**2*(iguess-one)* &
+                               jguess*(jguess-one)**2
+            wgts(4,3) =        iguess**2*(iguess-one)* &
+                               jguess**2*(jguess-one)
+            wgts(4,4) =        iguess*(iguess-one)**2* &
+                               jguess**2*(jguess-one)
+
+            call store_link_bicub(dst_add, src_add, wgts, nmap)
+
+          else
+            stop 'Iteration for i,j exceed max iteration count'
+          endif
+
+        !***
+        !*** search for bilinear failed - us a distance-weighted
+        !*** average instead
+        !***
+
+        else if (src_add(1) < 0) then
+
+          src_add = abs(src_add)
+
+          icount = 0
+          do n=1,4
+            if (grid2_mask(src_add(n))) then
+              icount = icount + 1
+            else
+              src_lats(n) = zero
+            endif
+          end do
+
+          if (icount > 0) then
+            !*** renormalize weights
+
+            sum_wgts = sum(src_lats)
+            wgts(1,1) = src_lats(1)/sum_wgts
+            wgts(1,2) = src_lats(2)/sum_wgts
+            wgts(1,3) = src_lats(3)/sum_wgts
+            wgts(1,4) = src_lats(4)/sum_wgts
+            wgts(2:4,:) = zero
+
+            grid1_frac(dst_add) = one
+            call store_link_bicub(dst_add, src_add, wgts, nmap)
+          endif
+
+        endif
+      end do grid_loop2
+
+      endif ! nmap=2
+
+!-----------------------------------------------------------------------
+
+      end subroutine remap_bicub
+
+!***********************************************************************
+
+      subroutine grid_search_bicub(src_add, src_lats, src_lons,  &
+                                   plat, plon, src_grid_dims, &
+                                   src_center_lat, src_center_lon, &
+                                   src_bound_box, &
+                                   src_bin_add, dst_bin_add)
+
+!-----------------------------------------------------------------------
+!
+!     this routine finds the location of the search point plat, plon
+!     in the source grid and returns the corners needed for a bicubic
+!     interpolation.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     output variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(4), intent(out) :: &
+              src_add  ! address of each corner point enclosing P
+
+      real (kind=dbl_kind), dimension(4), intent(out) :: &
+              src_lats,  & ! latitudes  of the four corner points
+              src_lons  ! longitudes of the four corner points
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      real (kind=dbl_kind), intent(in) :: &
+              plat,    & ! latitude  of the search point
+              plon    ! longitude of the search point
+
+      integer (kind=int_kind), dimension(2), intent(in) :: &
+              src_grid_dims  ! size of each src grid dimension
+
+      real (kind=dbl_kind), dimension(:), intent(in) :: &
+              src_center_lat,  & ! latitude  of each src grid center 
+              src_center_lon  ! longitude of each src grid center
+
+      real (kind=dbl_kind), dimension(:,:), intent(in) :: &
+              src_bound_box   ! bounding box for src grid search
+
+      integer (kind=int_kind), dimension(:,:), intent(in) :: &
+              src_bin_add,     & ! search bins for restricting
+              dst_bin_add     ! searches
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, next_n, srch_add,    & ! dummy indices
+          nx, ny,             & ! dimensions of src grid
+          min_add, max_add,   & ! addresses for restricting search
+          i, j, jp1, ip1, n_add, e_add, ne_add  ! addresses
+
+      real (kind=dbl_kind) ::   & ! vectors for cross-product check
+            vec1_lat, vec1_lon, &
+            vec2_lat, vec2_lon, cross_product, cross_product_last, &
+            coslat_dst, sinlat_dst, coslon_dst, sinlon_dst, &
+            dist_min, distance ! for computing dist-weighted avg
+
+!-----------------------------------------------------------------------
+!
+!     restrict search first using search bins. 
+!
+!-----------------------------------------------------------------------
+
+      src_add = 0
+
+      min_add = size(src_center_lat)
+      max_add = 1
+      do n=1,num_srch_bins
+        if (plat >= bin_lats(1,n) .and. plat <= bin_lats(2,n) .and. &
+            plon >= bin_lons(1,n) .and. plon <= bin_lons(2,n)) then
+          min_add = min(min_add, src_bin_add(1,n))
+          max_add = max(max_add, src_bin_add(2,n))
+        endif
+      end do
+ 
+!-----------------------------------------------------------------------
+!
+!     now perform a more detailed search 
+!
+!-----------------------------------------------------------------------
+
+      nx = src_grid_dims(1)
+      ny = src_grid_dims(2)
+
+      srch_loop: do srch_add = min_add,max_add
+
+        if (plat <= src_bound_box(2,srch_add) .and.  &
+            plat >= src_bound_box(1,srch_add) .and. &
+            plon <= src_bound_box(4,srch_add) .and.  &
+            plon >= src_bound_box(3,srch_add)) then
+
+          !***
+          !*** we are within bounding box so get really serious
+          !***
+
+          !*** find N,S and NE points to this grid point
+
+          j = (srch_add - 1)/nx +1
+          i = srch_add - (j-1)*nx
+
+          if (i < nx) then
+            ip1 = i + 1
+          else
+            ip1 = 1
+          endif
+
+          if (j < ny) then
+            jp1 = j+1
+          else
+            jp1 = 1
+          endif
+
+          n_add = (jp1 - 1)*nx + i
+          e_add = (j - 1)*nx + ip1
+          ne_add = (jp1 - 1)*nx + ip1
+
+          !***
+          !*** find N,S and NE lat/lon coords and check bounding box
+          !***
+
+          src_lats(1) = src_center_lat(srch_add)
+          src_lats(2) = src_center_lat(e_add)
+          src_lats(3) = src_center_lat(ne_add)
+          src_lats(4) = src_center_lat(n_add)
+
+          src_lons(1) = src_center_lon(srch_add)
+          src_lons(2) = src_center_lon(e_add)
+          src_lons(3) = src_center_lon(ne_add)
+          src_lons(4) = src_center_lon(n_add)
+
+          !***
+          !*** for consistency, we must make sure all lons are in
+          !*** same 2pi interval
+          !***
+
+          vec1_lon = src_lons(1) - plon
+          if (vec1_lon > pi) then
+            src_lons(1) = src_lons(1) - pi2
+          else if (vec1_lon < -pi) then
+            src_lons(1) = src_lons(1) + pi2
+          endif
+          do n=2,4
+            vec1_lon = src_lons(n) - src_lons(1)
+            if (vec1_lon > pi) then
+              src_lons(n) = src_lons(n) - pi2
+            else if (vec1_lon < -pi) then
+              src_lons(n) = src_lons(n) + pi2
+            endif
+          end do
+
+          corner_loop: do n=1,4
+            next_n = MOD(n,4) + 1
+
+            !***
+            !*** here we take the cross product of the vector making 
+            !*** up each box side with the vector formed by the vertex
+            !*** and search point.  if all the cross products are 
+            !*** same sign, the point is contained in the box.
+            !***
+
+            vec1_lat = src_lats(next_n) - src_lats(n)
+            vec1_lon = src_lons(next_n) - src_lons(n)
+            vec2_lat = plat - src_lats(n)
+            vec2_lon = plon - src_lons(n)
+
+            !***
+            !*** check for 0,2pi crossings
+            !***
+
+            if (vec1_lon >  three*pih) then
+              vec1_lon = vec1_lon - pi2
+            else if (vec1_lon < -three*pih) then
+              vec1_lon = vec1_lon + pi2
+            endif
+            if (vec2_lon >  three*pih) then
+              vec2_lon = vec2_lon - pi2
+            else if (vec2_lon < -three*pih) then
+              vec2_lon = vec2_lon + pi2
+            endif
+
+            cross_product = vec1_lon*vec2_lat - vec2_lon*vec1_lat
+
+            !***
+            !*** if cross product is less than zero, this cell
+            !*** doesn't work
+            !***
+
+            if (n==1) cross_product_last = cross_product
+            if (cross_product*cross_product_last < zero) then
+              exit corner_loop
+            else
+              cross_product_last = cross_product
+            endif
+
+          end do corner_loop
+
+          !***
+          !*** if cross products all positive, we found the location
+          !***
+
+          if (n > 4) then
+            src_add(1) = srch_add
+            src_add(2) = e_add
+            src_add(3) = ne_add
+            src_add(4) = n_add
+
+            return
+          endif
+
+          !***
+          !*** otherwise move on to next cell
+          !***
+
+        endif !bounding box check
+      end do srch_loop
+
+      !***
+      !*** if no cell found, point is likely either in a box that
+      !*** straddles either pole or is outside the grid.  fall back
+      !*** to a distance-weighted average of the four closest
+      !*** points.  go ahead and compute weights here, but store
+      !*** in src_lats and return -add to prevent the parent
+      !*** routine from computing bilinear weights
+      !***
+
+      coslat_dst = cos(plat)
+      sinlat_dst = sin(plat)
+      coslon_dst = cos(plon)
+      sinlon_dst = sin(plon)
+
+      dist_min = bignum
+      src_lats = bignum
+      do srch_add = min_add,max_add
+        distance = acos(coslat_dst*cos(src_center_lat(srch_add))* &
+                       (coslon_dst*cos(src_center_lon(srch_add)) + &
+                        sinlon_dst*sin(src_center_lon(srch_add)))+ &
+                        sinlat_dst*sin(src_center_lat(srch_add)))
+
+        if (distance < dist_min) then
+          sort_loop: do n=1,4
+            if (distance < src_lats(n)) then
+              do i=4,n+1,-1
+                src_add (i) = src_add (i-1)
+                src_lats(i) = src_lats(i-1)
+              end do
+              src_add (n) = -srch_add
+              src_lats(n) = distance
+              dist_min = src_lats(4)
+              exit sort_loop
+            endif
+          end do sort_loop
+        endif
+      end do
+
+      src_lons = one/(src_lats + tiny)
+      distance = sum(src_lons)
+      src_lats = src_lons/distance
+
+!-----------------------------------------------------------------------
+
+      end subroutine grid_search_bicub 
+
+!***********************************************************************
+
+      subroutine store_link_bicub(dst_add, src_add, weights, nmap)
+
+!-----------------------------------------------------------------------
+!
+!     this routine stores the address and weight for four links 
+!     associated with one destination point in the appropriate address 
+!     and weight arrays and resizes those arrays if necessary.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) :: &
+              dst_add,   & ! address on destination grid
+              nmap      ! identifies which direction for mapping
+
+      integer (kind=int_kind), dimension(4), intent(in) :: &
+              src_add   ! addresses on source grid
+
+      real (kind=dbl_kind), dimension(4,4), intent(in) :: &
+              weights ! array of remapping weights for these links
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n,  & ! dummy index
+             num_links_old          ! placeholder for old link number
+
+!-----------------------------------------------------------------------
+!
+!     increment number of links and check to see if remap arrays need
+!     to be increased to accomodate the new link.  then store the
+!     link.
+!
+!-----------------------------------------------------------------------
+
+      select case (nmap)
+      case(1)
+
+        num_links_old  = num_links_map1
+        num_links_map1 = num_links_old + 4
+
+        if (num_links_map1 > max_links_map1)  &
+           call resize_remap_vars(1,resize_increment)
+
+        do n=1,4
+          grid1_add_map1(num_links_old+n) = src_add(n)
+          grid2_add_map1(num_links_old+n) = dst_add
+          wts_map1    (:,num_links_old+n) = weights(:,n)
+        end do
+
+      case(2)
+
+        num_links_old  = num_links_map2
+        num_links_map2 = num_links_old + 4
+
+        if (num_links_map2 > max_links_map2)  &
+           call resize_remap_vars(2,resize_increment)
+
+        do n=1,4
+          grid1_add_map2(num_links_old+n) = dst_add
+          grid2_add_map2(num_links_old+n) = src_add(n)
+          wts_map2    (:,num_links_old+n) = weights(:,n)
+        end do
+
+      end select
+
+!-----------------------------------------------------------------------
+
+      end subroutine store_link_bicub
+
+!***********************************************************************
+
+      end module remap_bicubic
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/src/remap_bilinear.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/src/remap_bilinear.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/src/remap_bilinear.f90	(revision 2528)
@@ -0,0 +1,781 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this module contains necessary routines for performing an 
+!     bilinear interpolation.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_bilinear.f,v 1.6 2001/08/22 18:20:40 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_bilinear
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod     ! defines common data types
+      use constants     ! defines common constants
+      use grids         ! module containing grid info
+      use remap_vars    ! module containing remap info
+
+      implicit none
+
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), parameter :: &
+          max_iter = 100   ! max iteration count for i,j iteration
+
+      real (kind=dbl_kind), parameter :: &
+           converge = 1.e-10_dbl_kind  ! convergence criterion
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine remap_bilin
+
+!-----------------------------------------------------------------------
+!
+!     this routine computes the weights for a bilinear interpolation.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n,icount, &
+           dst_add,         & ! destination address
+           iter,            & ! iteration counter
+           nmap            ! index of current map being computed
+
+      integer (kind=int_kind), dimension(4) ::  &
+           src_add         ! address for the four source points
+
+      real (kind=dbl_kind), dimension(4)  :: &
+           src_lats,        & ! latitudes  of four bilinear corners
+           src_lons,        & ! longitudes of four bilinear corners
+           wgts            ! bilinear weights for four corners
+
+      real (kind=dbl_kind) :: &
+           plat, plon,        & ! lat/lon coords of destination point
+           iguess, jguess,    & ! current guess for bilinear coordinate
+           thguess, phguess,  & ! current guess for lat/lon coordinate
+           deli, delj,        & ! corrections to i,j
+           dth1, dth2, dth3,  & ! some latitude  differences
+           dph1, dph2, dph3,  & ! some longitude differences
+           dthp, dphp,        & ! difference between point and sw corner
+           mat1, mat2, mat3, mat4,  & ! matrix elements
+           determinant,       & ! matrix determinant
+           sum_wgts          ! sum of weights for normalization
+
+!-----------------------------------------------------------------------
+!
+!     compute mappings from grid1 to grid2
+!
+!-----------------------------------------------------------------------
+
+      nmap = 1
+      if (grid1_rank /= 2) then
+        stop 'Can not do bilinear interpolation when grid_rank /= 2'
+      endif
+
+      !***
+      !*** loop over destination grid 
+      !***
+
+      grid_loop1: do dst_add = 1, grid2_size
+
+        if (.not. grid2_mask(dst_add)) cycle grid_loop1
+
+        plat = grid2_center_lat(dst_add)
+        plon = grid2_center_lon(dst_add)
+
+        !***
+        !*** find nearest square of grid points on source grid
+        !***
+
+        call grid_search_bilin(src_add, src_lats, src_lons,  &
+                               plat, plon, grid1_dims, &
+                               grid1_center_lat, grid1_center_lon, &
+                               grid1_bound_box, bin_addr1, bin_addr2)
+
+        !***
+        !*** check to see if points are land points
+        !***
+
+        if (src_add(1) > 0) then
+          do n=1,4
+            if (.not. grid1_mask(src_add(n))) src_add(1) = 0
+          end do
+        endif
+
+        !***
+        !*** if point found, find local i,j coordinates for weights
+        !***
+
+        if (src_add(1) > 0) then
+
+          grid2_frac(dst_add) = one
+
+          !***
+          !*** iterate to find i,j for bilinear approximation
+          !***
+
+          dth1 = src_lats(2) - src_lats(1)
+          dth2 = src_lats(4) - src_lats(1)
+          dth3 = src_lats(3) - src_lats(2) - dth2
+
+          dph1 = src_lons(2) - src_lons(1)
+          dph2 = src_lons(4) - src_lons(1)
+          dph3 = src_lons(3) - src_lons(2)
+
+          if (dph1 >  three*pih) dph1 = dph1 - pi2
+          if (dph2 >  three*pih) dph2 = dph2 - pi2
+          if (dph3 >  three*pih) dph3 = dph3 - pi2
+          if (dph1 < -three*pih) dph1 = dph1 + pi2
+          if (dph2 < -three*pih) dph2 = dph2 + pi2
+          if (dph3 < -three*pih) dph3 = dph3 + pi2
+
+          dph3 = dph3 - dph2
+
+          iguess = half
+          jguess = half
+
+          iter_loop1: do iter=1,max_iter
+
+            dthp = plat - src_lats(1) - dth1*iguess - &
+                          dth2*jguess - dth3*iguess*jguess
+            dphp = plon - src_lons(1)
+
+            if (dphp >  three*pih) dphp = dphp - pi2
+            if (dphp < -three*pih) dphp = dphp + pi2
+
+            dphp = dphp - dph1*iguess - dph2*jguess -  &
+                          dph3*iguess*jguess
+
+            mat1 = dth1 + dth3*jguess
+            mat2 = dth2 + dth3*iguess
+            mat3 = dph1 + dph3*jguess
+            mat4 = dph2 + dph3*iguess
+
+            determinant = mat1*mat4 - mat2*mat3
+
+            deli = (dthp*mat4 - mat2*dphp)/determinant
+            delj = (mat1*dphp - dthp*mat3)/determinant
+
+            if (abs(deli) < converge .and.  &
+                abs(delj) < converge) exit iter_loop1
+
+            iguess = iguess + deli
+            jguess = jguess + delj
+
+          end do iter_loop1
+
+          if (iter <= max_iter) then
+
+            !***
+            !*** successfully found i,j - compute weights
+            !***
+
+            wgts(1) = (one-iguess)*(one-jguess)
+            wgts(2) = iguess*(one-jguess)
+            wgts(3) = iguess*jguess
+            wgts(4) = (one-iguess)*jguess
+
+            call store_link_bilin(dst_add, src_add, wgts, nmap)
+
+          else
+            print *,'Point coords: ',plat,plon
+            print *,'Dest grid lats: ',src_lats
+            print *,'Dest grid lons: ',src_lons
+            print *,'Dest grid addresses: ',src_add
+            print *,'Current i,j : ',iguess, jguess
+            stop 'Iteration for i,j exceed max iteration count'
+          endif
+
+        !***
+        !*** search for bilinear failed - use a distance-weighted
+        !*** average instead (this is typically near the pole)
+        !***
+
+        else if (src_add(1) < 0) then
+
+          src_add = abs(src_add)
+          icount = 0
+          do n=1,4
+            if (grid1_mask(src_add(n))) then
+              icount = icount + 1
+            else
+              src_lats(n) = zero
+            endif
+          end do
+
+          if (icount > 0) then
+            !*** renormalize weights
+
+            sum_wgts = sum(src_lats)
+            wgts(1) = src_lats(1)/sum_wgts
+            wgts(2) = src_lats(2)/sum_wgts
+            wgts(3) = src_lats(3)/sum_wgts
+            wgts(4) = src_lats(4)/sum_wgts
+
+            grid2_frac(dst_add) = one
+            call store_link_bilin(dst_add, src_add, wgts, nmap)
+          endif
+
+        endif
+      end do grid_loop1
+
+!-----------------------------------------------------------------------
+!
+!     compute mappings from grid2 to grid1 if necessary
+!
+!-----------------------------------------------------------------------
+
+      if (num_maps > 1) then
+
+      nmap = 2
+      if (grid2_rank /= 2) then
+        stop 'Can not do bilinear interpolation when grid_rank /= 2'
+      endif
+
+      !***
+      !*** loop over destination grid 
+      !***
+
+      grid_loop2: do dst_add = 1, grid1_size
+
+        if (.not. grid1_mask(dst_add)) cycle grid_loop2
+
+        plat = grid1_center_lat(dst_add)
+        plon = grid1_center_lon(dst_add)
+
+        !***
+        !*** find nearest square of grid points on source grid
+        !***
+
+        call grid_search_bilin(src_add, src_lats, src_lons,  &
+                               plat, plon, grid2_dims, &
+                               grid2_center_lat, grid2_center_lon, &
+                               grid2_bound_box, bin_addr2, bin_addr1)
+
+        !***
+        !*** check to see if points are land points
+        !***
+
+        if (src_add(1) > 0) then
+          do n=1,4
+            if (.not. grid2_mask(src_add(n))) src_add(1) = 0
+          end do
+        endif
+
+        !***
+        !*** if point found, find i,j coordinates for weights
+        !***
+
+        if (src_add(1) > 0) then
+
+          grid1_frac(dst_add) = one
+
+          !***
+          !*** iterate to find i,j for bilinear approximation
+          !***
+
+          dth1 = src_lats(2) - src_lats(1)
+          dth2 = src_lats(4) - src_lats(1)
+          dth3 = src_lats(3) - src_lats(2) - dth2
+
+          dph1 = src_lons(2) - src_lons(1)
+          dph2 = src_lons(4) - src_lons(1)
+          dph3 = src_lons(3) - src_lons(2)
+
+          if (dph1 >  pi) dph1 = dph1 - pi2
+          if (dph2 >  pi) dph2 = dph2 - pi2
+          if (dph3 >  pi) dph3 = dph3 - pi2
+          if (dph1 < -pi) dph1 = dph1 + pi2
+          if (dph2 < -pi) dph2 = dph2 + pi2
+          if (dph3 < -pi) dph3 = dph3 + pi2
+
+          dph3 = dph3 - dph2
+
+          iguess = zero
+          jguess = zero
+
+          iter_loop2: do iter=1,max_iter
+
+            dthp = plat - src_lats(1) - dth1*iguess - &
+                          dth2*jguess - dth3*iguess*jguess
+            dphp = plon - src_lons(1)
+
+            if (dphp >  pi) dphp = dphp - pi2
+            if (dphp < -pi) dphp = dphp + pi2
+
+            dphp = dphp - dph1*iguess - dph2*jguess -  &
+                          dph3*iguess*jguess
+
+            mat1 = dth1 + dth3*jguess
+            mat2 = dth2 + dth3*iguess
+            mat3 = dph1 + dph3*jguess
+            mat4 = dph2 + dph3*iguess
+
+            determinant = mat1*mat4 - mat2*mat3
+
+            deli = (dthp*mat4 - mat2*dphp)/determinant
+            delj = (mat1*dphp - dthp*mat3)/determinant
+
+            if (abs(deli) < converge .and.  &
+                abs(delj) < converge) exit iter_loop2
+
+            iguess = iguess + deli
+            jguess = jguess + delj
+
+          end do iter_loop2
+
+          if (iter <= max_iter) then
+
+            !***
+            !*** successfully found i,j - compute weights
+            !***
+
+            wgts(1) = (one-iguess)*(one-jguess)
+            wgts(2) = iguess*(one-jguess)
+            wgts(3) = iguess*jguess
+            wgts(4) = (one-iguess)*jguess
+
+            call store_link_bilin(dst_add, src_add, wgts, nmap)
+
+          else
+            print *,'Point coords: ',plat,plon
+            print *,'Dest grid lats: ',src_lats
+            print *,'Dest grid lons: ',src_lons
+            print *,'Dest grid addresses: ',src_add
+            print *,'Current i,j : ',iguess, jguess
+            stop 'Iteration for i,j exceed max iteration count'
+          endif
+
+        !***
+        !*** search for bilinear failed - us a distance-weighted
+        !*** average instead
+        !***
+
+        else if (src_add(1) < 0) then
+
+          src_add = abs(src_add)
+          icount = 0
+          do n=1,4
+            if (grid2_mask(src_add(n))) then
+              icount = icount + 1
+            else
+              src_lats(n) = zero
+            endif
+          end do
+
+          if (icount > 0) then
+            !*** renormalize weights
+
+            sum_wgts = sum(src_lats)
+            wgts(1) = src_lats(1)/sum_wgts
+            wgts(2) = src_lats(2)/sum_wgts
+            wgts(3) = src_lats(3)/sum_wgts
+            wgts(4) = src_lats(4)/sum_wgts
+
+            grid1_frac(dst_add) = one
+            call store_link_bilin(dst_add, src_add, wgts, nmap)
+          endif
+
+        endif
+      end do grid_loop2
+
+      endif ! nmap=2
+
+!-----------------------------------------------------------------------
+
+      end subroutine remap_bilin
+
+!***********************************************************************
+
+      subroutine grid_search_bilin(src_add, src_lats, src_lons,  &
+                                   plat, plon, src_grid_dims, &
+                                   src_center_lat, src_center_lon, &
+                                   src_grid_bound_box, &
+                                   src_bin_add, dst_bin_add)
+
+!-----------------------------------------------------------------------
+!
+!     this routine finds the location of the search point plat, plon
+!     in the source grid and returns the corners needed for a bilinear
+!     interpolation.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     output variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(4), intent(out) :: &
+              src_add  ! address of each corner point enclosing P
+
+      real (kind=dbl_kind), dimension(4), intent(out) :: &
+              src_lats,  & ! latitudes  of the four corner points
+              src_lons  ! longitudes of the four corner points
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      real (kind=dbl_kind), intent(in) :: &
+              plat,    & ! latitude  of the search point
+              plon    ! longitude of the search point
+
+      integer (kind=int_kind), dimension(2), intent(in) :: &
+              src_grid_dims  ! size of each src grid dimension
+
+      real (kind=dbl_kind), dimension(:), intent(in) :: &
+              src_center_lat,  & ! latitude  of each src grid center 
+              src_center_lon  ! longitude of each src grid center
+
+      real (kind=dbl_kind), dimension(:,:), intent(in) :: &
+              src_grid_bound_box ! bound box for source grid
+
+      integer (kind=int_kind), dimension(:,:), intent(in) :: &
+              src_bin_add,     & ! latitude bins for restricting
+              dst_bin_add     ! searches
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, next_n, srch_add,    & ! dummy indices
+          nx, ny,             & ! dimensions of src grid
+          min_add, max_add,   & ! addresses for restricting search
+          i, j, jp1, ip1, n_add, e_add, ne_add  ! addresses
+
+      real (kind=dbl_kind) ::   & ! vectors for cross-product check
+            vec1_lat, vec1_lon, &
+            vec2_lat, vec2_lon, cross_product, cross_product_last, &
+            coslat_dst, sinlat_dst, coslon_dst, sinlon_dst, &
+            dist_min, distance ! for computing dist-weighted avg
+
+!-----------------------------------------------------------------------
+!
+!     restrict search first using bins
+!
+!-----------------------------------------------------------------------
+
+      src_add = 0
+
+      min_add = size(src_center_lat)
+      max_add = 1
+      do n=1,num_srch_bins
+        if (plat >= bin_lats(1,n) .and. plat <= bin_lats(2,n) .and. &
+            plon >= bin_lons(1,n) .and. plon <= bin_lons(2,n)) then
+          min_add = min(min_add, src_bin_add(1,n))
+          max_add = max(max_add, src_bin_add(2,n))
+        endif
+      end do
+ 
+!-----------------------------------------------------------------------
+!
+!     now perform a more detailed search 
+!
+!-----------------------------------------------------------------------
+
+      nx = src_grid_dims(1)
+      ny = src_grid_dims(2)
+
+      srch_loop: do srch_add = min_add,max_add
+
+        !*** first check bounding box
+
+        if (plat <= src_grid_bound_box(2,srch_add) .and.  &
+            plat >= src_grid_bound_box(1,srch_add) .and. &
+            plon <= src_grid_bound_box(4,srch_add) .and.  &
+            plon >= src_grid_bound_box(3,srch_add)) then
+
+          !***
+          !*** we are within bounding box so get really serious
+          !***
+
+          !*** determine neighbor addresses
+
+          j = (srch_add - 1)/nx +1
+          i = srch_add - (j-1)*nx
+
+          if (i < nx) then
+            ip1 = i + 1
+          else
+            ip1 = 1
+          endif
+
+          if (j < ny) then
+            jp1 = j+1
+          else
+            jp1 = 1
+          endif
+
+          n_add = (jp1 - 1)*nx + i
+          e_add = (j - 1)*nx + ip1
+          ne_add = (jp1 - 1)*nx + ip1
+
+          src_lats(1) = src_center_lat(srch_add)
+          src_lats(2) = src_center_lat(e_add)
+          src_lats(3) = src_center_lat(ne_add)
+          src_lats(4) = src_center_lat(n_add)
+
+          src_lons(1) = src_center_lon(srch_add)
+          src_lons(2) = src_center_lon(e_add)
+          src_lons(3) = src_center_lon(ne_add)
+          src_lons(4) = src_center_lon(n_add)
+
+          !***
+          !*** for consistency, we must make sure all lons are in
+          !*** same 2pi interval
+          !***
+
+          vec1_lon = src_lons(1) - plon
+          if (vec1_lon >  pi) then
+            src_lons(1) = src_lons(1) - pi2
+          else if (vec1_lon < -pi) then
+            src_lons(1) = src_lons(1) + pi2
+          endif
+          do n=2,4
+            vec1_lon = src_lons(n) - src_lons(1)
+            if (vec1_lon >  pi) then
+              src_lons(n) = src_lons(n) - pi2
+            else if (vec1_lon < -pi) then
+              src_lons(n) = src_lons(n) + pi2
+            endif
+          end do
+
+          corner_loop: do n=1,4
+            next_n = MOD(n,4) + 1
+
+            !***
+            !*** here we take the cross product of the vector making 
+            !*** up each box side with the vector formed by the vertex
+            !*** and search point.  if all the cross products are 
+            !*** positive, the point is contained in the box.
+            !***
+
+            vec1_lat = src_lats(next_n) - src_lats(n)
+            vec1_lon = src_lons(next_n) - src_lons(n)
+            vec2_lat = plat - src_lats(n)
+            vec2_lon = plon - src_lons(n)
+
+            !***
+            !*** check for 0,2pi crossings
+            !***
+
+            if (vec1_lon >  three*pih) then
+              vec1_lon = vec1_lon - pi2
+            else if (vec1_lon < -three*pih) then
+              vec1_lon = vec1_lon + pi2
+            endif
+            if (vec2_lon >  three*pih) then
+              vec2_lon = vec2_lon - pi2
+            else if (vec2_lon < -three*pih) then
+              vec2_lon = vec2_lon + pi2
+            endif
+
+            cross_product = vec1_lon*vec2_lat - vec2_lon*vec1_lat
+
+            !***
+            !*** if cross product is less than zero, this cell
+            !*** doesn't work
+            !***
+
+            if (n == 1) cross_product_last = cross_product
+            if (cross_product*cross_product_last < zero)  &
+                exit corner_loop
+            cross_product_last = cross_product
+
+          end do corner_loop
+
+          !***
+          !*** if cross products all same sign, we found the location
+          !***
+
+          if (n > 4) then
+            src_add(1) = srch_add
+            src_add(2) = e_add
+            src_add(3) = ne_add
+            src_add(4) = n_add
+
+            return
+          endif
+
+          !***
+          !*** otherwise move on to next cell
+          !***
+
+        endif !bounding box check
+      end do srch_loop
+
+      !***
+      !*** if no cell found, point is likely either in a box that
+      !*** straddles either pole or is outside the grid.  fall back
+      !*** to a distance-weighted average of the four closest
+      !*** points.  go ahead and compute weights here, but store
+      !*** in src_lats and return -add to prevent the parent
+      !*** routine from computing bilinear weights
+      !***
+
+      !print *,'Could not find location for ',plat,plon
+      !print *,'Using nearest-neighbor average for this point'
+
+      coslat_dst = cos(plat)
+      sinlat_dst = sin(plat)
+      coslon_dst = cos(plon)
+      sinlon_dst = sin(plon)
+
+      dist_min = bignum
+      src_lats = bignum
+      do srch_add = min_add,max_add
+        distance = acos(coslat_dst*cos(src_center_lat(srch_add))* &
+                       (coslon_dst*cos(src_center_lon(srch_add)) + &
+                        sinlon_dst*sin(src_center_lon(srch_add)))+ &
+                        sinlat_dst*sin(src_center_lat(srch_add)))
+
+        if (distance < dist_min) then
+          sort_loop: do n=1,4
+            if (distance < src_lats(n)) then
+              do i=4,n+1,-1
+                src_add (i) = src_add (i-1)
+                src_lats(i) = src_lats(i-1)
+              end do
+              src_add (n) = -srch_add
+              src_lats(n) = distance
+              dist_min = src_lats(4)
+              exit sort_loop
+            endif
+          end do sort_loop
+        endif
+      end do
+
+      src_lons = one/(src_lats + tiny)
+      distance = sum(src_lons)
+      src_lats = src_lons/distance
+
+!-----------------------------------------------------------------------
+
+      end subroutine grid_search_bilin 
+
+!***********************************************************************
+
+      subroutine store_link_bilin(dst_add, src_add, weights, nmap)
+
+!-----------------------------------------------------------------------
+!
+!     this routine stores the address and weight for four links 
+!     associated with one destination point in the appropriate address 
+!     and weight arrays and resizes those arrays if necessary.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) :: &
+              dst_add,   & ! address on destination grid
+              nmap      ! identifies which direction for mapping
+
+      integer (kind=int_kind), dimension(4), intent(in) :: &
+              src_add   ! addresses on source grid
+
+      real (kind=dbl_kind), dimension(4), intent(in) :: &
+              weights ! array of remapping weights for these links
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n,  & ! dummy index
+             num_links_old          ! placeholder for old link number
+
+!-----------------------------------------------------------------------
+!
+!     increment number of links and check to see if remap arrays need
+!     to be increased to accomodate the new link.  then store the
+!     link.
+!
+!-----------------------------------------------------------------------
+
+      select case (nmap)
+      case(1)
+
+        num_links_old  = num_links_map1
+        num_links_map1 = num_links_old + 4
+
+        if (num_links_map1 > max_links_map1)  &
+           call resize_remap_vars(1,resize_increment)
+
+        do n=1,4
+          grid1_add_map1(num_links_old+n) = src_add(n)
+          grid2_add_map1(num_links_old+n) = dst_add
+          wts_map1    (1,num_links_old+n) = weights(n)
+        end do
+
+      case(2)
+
+        num_links_old  = num_links_map2
+        num_links_map2 = num_links_old + 4
+
+        if (num_links_map2 > max_links_map2)  &
+           call resize_remap_vars(2,resize_increment)
+
+        do n=1,4
+          grid1_add_map2(num_links_old+n) = dst_add
+          grid2_add_map2(num_links_old+n) = src_add(n)
+          wts_map2    (1,num_links_old+n) = weights(n)
+        end do
+
+      end select
+
+!-----------------------------------------------------------------------
+
+      end subroutine store_link_bilin
+
+!***********************************************************************
+
+      end module remap_bilinear
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/src/remap_conserv.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/src/remap_conserv.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/src/remap_conserv.f90	(revision 2528)
@@ -0,0 +1,2197 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this module contains necessary routines for computing addresses
+!     and weights for a conservative interpolation  between any two 
+!     grids on a sphere.  the weights are computed by performing line 
+!     integrals around all overlap regions of the two grids.  see 
+!     Dukowicz and Kodis, SIAM J. Sci. Stat. Comput. 8, 305 (1987) and
+!     Jones, P.W. Monthly Weather Review (submitted).
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_conserv.f,v 1.10 2001/08/21 21:05:13 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_conservative
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod    ! defines common data types
+      use constants    ! defines common constants
+      use timers       ! module for timing
+      use grids        ! module containing grid information
+      use remap_vars   ! module containing remap information
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     module variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), save ::  &
+              num_srch_cells ! num cells in restricted search arrays
+
+      integer (kind=int_kind), dimension(:), allocatable, save ::  &
+              srch_add       ! global address of cells in srch arrays
+
+      real (kind=dbl_kind), parameter ::  &
+           north_thresh = 1.45_dbl_kind,  & ! threshold for coord transf.
+           south_thresh =-2.00_dbl_kind  ! threshold for coord transf.
+
+      real (kind=dbl_kind), dimension(:,:), allocatable, save :: &
+           srch_corner_lat,   & ! lat of each corner of srch cells
+           srch_corner_lon   ! lon of each corner of srch cells
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine remap_conserv
+
+!-----------------------------------------------------------------------
+!
+!     this routine traces the perimeters of every grid cell on each
+!     grid checking for intersections with the other grid and computing
+!     line integrals for each subsegment.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), parameter ::  &
+              max_subseg = 10000 ! max number of subsegments per segment
+                                 ! to prevent infinite loop
+
+      integer (kind=int_kind) ::  &
+              grid1_add,   & ! current linear address for grid1 cell
+              grid2_add,   & ! current linear address for grid2 cell
+              min_add,     & ! addresses for restricting search of
+              max_add,     & !   destination grid
+              n, nwgt,     & ! generic counters
+              corner,      & ! corner of cell that segment starts from
+              next_corn,   & ! corner of cell that segment ends on
+              num_subseg  ! number of subsegments 
+
+      logical (kind=log_kind) ::  &
+              lcoinc,   & ! flag for coincident segments
+              lrevers,  & ! flag for reversing direction of segment
+              lbegin   ! flag for first integration of a segment
+
+      logical (kind=log_kind), dimension(:), allocatable :: &
+              srch_mask   ! mask for restricting searches
+
+      real (kind=dbl_kind) :: &
+           intrsct_lat, intrsct_lon,        & ! lat/lon of next intersect
+           beglat, endlat, beglon, endlon,  & ! endpoints of current seg.
+           norm_factor                     ! factor for normalizing wts
+
+      real (kind=dbl_kind), dimension(:), allocatable :: &
+             grid2_centroid_lat, grid2_centroid_lon,  & ! centroid coords
+             grid1_centroid_lat, grid1_centroid_lon  ! on each grid
+
+      real (kind=dbl_kind), dimension(2) :: begseg ! begin lat/lon for
+                                                   ! full segment
+
+      real (kind=dbl_kind), dimension(6) :: weights ! local wgt array
+
+!-----------------------------------------------------------------------
+!
+!     initialize centroid arrays
+!
+!-----------------------------------------------------------------------
+
+      allocate( grid1_centroid_lat(grid1_size), &
+                grid1_centroid_lon(grid1_size), &
+                grid2_centroid_lat(grid2_size), &
+                grid2_centroid_lon(grid2_size))
+
+      grid1_centroid_lat = zero
+      grid1_centroid_lon = zero
+      grid2_centroid_lat = zero
+      grid2_centroid_lon = zero
+
+!-----------------------------------------------------------------------
+!
+!     integrate around each cell on grid1
+!
+!-----------------------------------------------------------------------
+
+      allocate(srch_mask(grid2_size))
+
+      print *,'grid1 sweep '
+      do grid1_add = 1,grid1_size
+
+        !***
+        !*** restrict searches first using search bins
+        !***
+
+        call timer_start(1)
+        min_add = grid2_size
+        max_add = 1
+        do n=1,num_srch_bins
+          if (grid1_add >= bin_addr1(1,n) .and. &
+              grid1_add <= bin_addr1(2,n)) then
+            min_add = min(min_add, bin_addr2(1,n))
+            max_add = max(max_add, bin_addr2(2,n))
+          endif
+        end do
+
+        !***
+        !*** further restrict searches using bounding boxes
+        !***
+
+        num_srch_cells = 0
+        do grid2_add = min_add,max_add
+          srch_mask(grid2_add) = (grid2_bound_box(1,grid2_add) <=  &
+                                  grid1_bound_box(2,grid1_add)) .and. &
+                                 (grid2_bound_box(2,grid2_add) >=  &
+                                  grid1_bound_box(1,grid1_add)) .and. &
+                                 (grid2_bound_box(3,grid2_add) <=  &
+                                  grid1_bound_box(4,grid1_add)) .and. &
+                                 (grid2_bound_box(4,grid2_add) >=  &
+                                  grid1_bound_box(3,grid1_add))
+
+          if (srch_mask(grid2_add)) num_srch_cells = num_srch_cells+1
+        end do
+
+        !***
+        !*** create search arrays
+        !***
+
+        allocate(srch_add(num_srch_cells), &
+                 srch_corner_lat(grid2_corners,num_srch_cells), &
+                 srch_corner_lon(grid2_corners,num_srch_cells))
+
+        n = 0
+        gather1: do grid2_add = min_add,max_add
+          if (srch_mask(grid2_add)) then
+            n = n+1
+            srch_add(n) = grid2_add
+            srch_corner_lat(:,n) = grid2_corner_lat(:,grid2_add)
+            srch_corner_lon(:,n) = grid2_corner_lon(:,grid2_add)
+          endif
+        end do gather1
+        call timer_stop(1)
+
+        !***
+        !*** integrate around this cell
+        !***
+
+        do corner = 1,grid1_corners
+          next_corn = mod(corner,grid1_corners) + 1
+
+          !***
+          !*** define endpoints of the current segment
+          !***
+
+          beglat = grid1_corner_lat(corner,grid1_add)
+          beglon = grid1_corner_lon(corner,grid1_add)
+          endlat = grid1_corner_lat(next_corn,grid1_add)
+          endlon = grid1_corner_lon(next_corn,grid1_add)
+          lrevers = .false.
+
+          !***
+          !*** to ensure exact path taken during both
+          !*** sweeps, always integrate segments in the same 
+          !*** direction (SW to NE).
+          !***
+
+          if ((endlat < beglat) .or. &
+              (endlat == beglat .and. endlon < beglon)) then 
+            beglat = grid1_corner_lat(next_corn,grid1_add)
+            beglon = grid1_corner_lon(next_corn,grid1_add)
+            endlat = grid1_corner_lat(corner,grid1_add)
+            endlon = grid1_corner_lon(corner,grid1_add)
+            lrevers = .true.
+          endif
+
+          begseg(1) = beglat
+          begseg(2) = beglon
+          lbegin = .true.
+          num_subseg = 0
+
+          !***
+          !*** if this is a constant-longitude segment, skip the rest 
+          !*** since the line integral contribution will be zero.
+          !***
+
+          if (endlon /= beglon) then
+
+          !***
+          !*** integrate along this segment, detecting intersections 
+          !*** and computing the line integral for each sub-segment
+          !***
+
+          do while (beglat /= endlat .or. beglon /= endlon)
+
+            !***
+            !*** prevent infinite loops if integration gets stuck
+            !*** near cell or threshold boundary
+            !***
+
+            num_subseg = num_subseg + 1
+            if (num_subseg > max_subseg) then
+              stop 'integration stalled: num_subseg exceeded limit'
+            endif
+
+            !***
+            !*** find next intersection of this segment with a grid
+            !*** line on grid 2.
+            !***
+
+            call timer_start(2)
+            call intersection(grid2_add,intrsct_lat,intrsct_lon,lcoinc, &
+                              beglat, beglon, endlat, endlon, begseg,  &
+                              lbegin, lrevers)
+            call timer_stop(2)
+            lbegin = .false.
+
+            !***
+            !*** compute line integral for this subsegment.
+            !***
+
+            call timer_start(3)
+            if (grid2_add /= 0) then
+              call line_integral(weights, num_wts, &
+                               beglon, intrsct_lon, beglat, intrsct_lat, &
+                               grid1_center_lat(grid1_add),  &
+                               grid1_center_lon(grid1_add), &
+                               grid2_center_lat(grid2_add),  &
+                               grid2_center_lon(grid2_add))
+            else
+              call line_integral(weights, num_wts, &
+                               beglon, intrsct_lon, beglat, intrsct_lat, &
+                               grid1_center_lat(grid1_add),  &
+                               grid1_center_lon(grid1_add), &
+                               grid1_center_lat(grid1_add),  &
+                               grid1_center_lon(grid1_add))
+            endif
+            call timer_stop(3)
+
+            !***
+            !*** if integrating in reverse order, change
+            !*** sign of weights
+            !***
+
+            if (lrevers) then
+              weights = -weights
+            endif
+
+            !***
+            !*** store the appropriate addresses and weights. 
+            !*** also add contributions to cell areas and centroids.
+            !***
+
+            !if (grid1_add == 119247) then
+            !  print *,grid1_add,grid2_add,corner,weights(1)
+            !  print *,grid1_corner_lat(:,grid1_add)
+            !  print *,grid1_corner_lon(:,grid1_add)
+            !  print *,grid2_corner_lat(:,grid2_add)
+            !  print *,grid2_corner_lon(:,grid2_add)
+            !  print *,beglat,beglon,intrsct_lat,intrsct_lon
+            !endif
+
+            if (grid2_add /= 0) then
+              if (grid1_mask(grid1_add)) then
+                call timer_start(4)
+                call store_link_cnsrv(grid1_add, grid2_add, weights)
+                call timer_stop(4)
+                grid1_frac(grid1_add) = grid1_frac(grid1_add) +  &
+                                        weights(1)
+                grid2_frac(grid2_add) = grid2_frac(grid2_add) +  &
+                                        weights(num_wts+1)
+              endif
+
+            endif
+
+            grid1_area(grid1_add) = grid1_area(grid1_add) + weights(1)
+            grid1_centroid_lat(grid1_add) =  &
+            grid1_centroid_lat(grid1_add) + weights(2)
+            grid1_centroid_lon(grid1_add) =  &
+            grid1_centroid_lon(grid1_add) + weights(3)
+
+            !***
+            !*** reset beglat and beglon for next subsegment.
+            !***
+
+            beglat = intrsct_lat
+            beglon = intrsct_lon
+          end do
+
+          endif
+
+          !***
+          !*** end of segment
+          !***
+
+        end do
+
+        !***
+        !*** finished with this cell: deallocate search array and
+        !*** start on next cell
+
+        deallocate(srch_add, srch_corner_lat, srch_corner_lon)
+
+      end do
+
+      deallocate(srch_mask)
+
+!-----------------------------------------------------------------------
+!
+!     integrate around each cell on grid2
+!
+!-----------------------------------------------------------------------
+
+      allocate(srch_mask(grid1_size))
+
+      print *,'grid2 sweep '
+      do grid2_add = 1,grid2_size
+
+        !***
+        !*** restrict searches first using search bins
+        !***
+
+        call timer_start(5)
+        min_add = grid1_size
+        max_add = 1
+        do n=1,num_srch_bins
+          if (grid2_add >= bin_addr2(1,n) .and. &
+              grid2_add <= bin_addr2(2,n)) then
+            min_add = min(min_add, bin_addr1(1,n))
+            max_add = max(max_add, bin_addr1(2,n))
+          endif
+        end do
+
+        !***
+        !*** further restrict searches using bounding boxes
+        !***
+
+        num_srch_cells = 0
+        do grid1_add = min_add, max_add
+          srch_mask(grid1_add) = (grid1_bound_box(1,grid1_add) <=  &
+                                  grid2_bound_box(2,grid2_add)) .and. &
+                                 (grid1_bound_box(2,grid1_add) >=  &
+                                  grid2_bound_box(1,grid2_add)) .and. &
+                                 (grid1_bound_box(3,grid1_add) <=  &
+                                  grid2_bound_box(4,grid2_add)) .and. &
+                                 (grid1_bound_box(4,grid1_add) >=  &
+                                  grid2_bound_box(3,grid2_add))
+
+          if (srch_mask(grid1_add)) num_srch_cells = num_srch_cells+1
+        end do
+
+        allocate(srch_add(num_srch_cells), &
+                 srch_corner_lat(grid1_corners,num_srch_cells), &
+                 srch_corner_lon(grid1_corners,num_srch_cells))
+
+        n = 0
+        gather2: do grid1_add = min_add,max_add
+          if (srch_mask(grid1_add)) then
+            n = n+1
+            srch_add(n) = grid1_add
+            srch_corner_lat(:,n) = grid1_corner_lat(:,grid1_add)
+            srch_corner_lon(:,n) = grid1_corner_lon(:,grid1_add)
+          endif
+        end do gather2
+        call timer_stop(5)
+
+        !***
+        !*** integrate around this cell
+        !***
+
+        do corner = 1,grid2_corners
+          next_corn = mod(corner,grid2_corners) + 1
+
+          beglat = grid2_corner_lat(corner,grid2_add)
+          beglon = grid2_corner_lon(corner,grid2_add)
+          endlat = grid2_corner_lat(next_corn,grid2_add)
+          endlon = grid2_corner_lon(next_corn,grid2_add)
+          lrevers = .false.
+
+          !***
+          !*** to ensure exact path taken during both
+          !*** sweeps, always integrate in the same direction
+          !***
+
+          if ((endlat < beglat) .or. &
+              (endlat == beglat .and. endlon < beglon)) then 
+            beglat = grid2_corner_lat(next_corn,grid2_add)
+            beglon = grid2_corner_lon(next_corn,grid2_add)
+            endlat = grid2_corner_lat(corner,grid2_add)
+            endlon = grid2_corner_lon(corner,grid2_add)
+            lrevers = .true.
+          endif
+
+          begseg(1) = beglat
+          begseg(2) = beglon
+          lbegin = .true.
+
+          !***
+          !*** if this is a constant-longitude segment, skip the rest 
+          !*** since the line integral contribution will be zero.
+          !***
+
+          if (endlon /= beglon) then
+          num_subseg = 0
+
+          !***
+          !*** integrate along this segment, detecting intersections 
+          !*** and computing the line integral for each sub-segment
+          !***
+
+          do while (beglat /= endlat .or. beglon /= endlon)
+
+            !***
+            !*** prevent infinite loops if integration gets stuck
+            !*** near cell or threshold boundary
+            !***
+
+            num_subseg = num_subseg + 1
+            if (num_subseg > max_subseg) then
+              stop 'integration stalled: num_subseg exceeded limit'
+            endif
+
+            !***
+            !*** find next intersection of this segment with a line 
+            !*** on grid 2.
+            !***
+
+            call timer_start(6)
+            call intersection(grid1_add,intrsct_lat,intrsct_lon,lcoinc, &
+                              beglat, beglon, endlat, endlon, begseg, &
+                              lbegin, lrevers)
+            call timer_stop(6)
+            lbegin = .false.
+
+            !***
+            !*** compute line integral for this subsegment.
+            !***
+
+            call timer_start(7)
+            if (grid1_add /= 0) then
+              call line_integral(weights, num_wts, &
+                               beglon, intrsct_lon, beglat, intrsct_lat, &
+                               grid1_center_lat(grid1_add),  &
+                               grid1_center_lon(grid1_add), &
+                               grid2_center_lat(grid2_add),  &
+                               grid2_center_lon(grid2_add))
+            else
+              call line_integral(weights, num_wts, &
+                               beglon, intrsct_lon, beglat, intrsct_lat, &
+                               grid2_center_lat(grid2_add),  &
+                               grid2_center_lon(grid2_add), &
+                               grid2_center_lat(grid2_add),  &
+                               grid2_center_lon(grid2_add))
+            endif
+            call timer_stop(7)
+
+            if (lrevers) then
+              weights = -weights
+            endif
+
+            !***
+            !*** store the appropriate addresses and weights. 
+            !*** also add contributions to cell areas and centroids.
+            !*** if there is a coincidence, do not store weights
+            !*** because they have been captured in the previous loop.
+            !*** the grid1 mask is the master mask
+            !***
+
+            !if (grid1_add == 119247) then
+            !  print *,grid1_add,grid2_add,corner,weights(1)
+            !  print *,grid1_corner_lat(:,grid1_add)
+            !  print *,grid1_corner_lon(:,grid1_add)
+            !  print *,grid2_corner_lat(:,grid2_add)
+            !  print *,grid2_corner_lon(:,grid2_add)
+            !  print *,beglat,beglon,intrsct_lat,intrsct_lon
+            !endif
+
+            if (.not. lcoinc .and. grid1_add /= 0) then
+              if (grid1_mask(grid1_add)) then
+                call timer_start(8)
+                call store_link_cnsrv(grid1_add, grid2_add, weights)
+                call timer_stop(8)
+                grid1_frac(grid1_add) = grid1_frac(grid1_add) +  &
+                                        weights(1)
+                grid2_frac(grid2_add) = grid2_frac(grid2_add) +  &
+                                        weights(num_wts+1)
+              endif
+
+            endif
+
+            grid2_area(grid2_add) = grid2_area(grid2_add) +  &
+                                            weights(num_wts+1)
+            grid2_centroid_lat(grid2_add) =  &
+            grid2_centroid_lat(grid2_add) + weights(num_wts+2)
+            grid2_centroid_lon(grid2_add) =  &
+            grid2_centroid_lon(grid2_add) + weights(num_wts+3)
+
+            !***
+            !*** reset beglat and beglon for next subsegment.
+            !***
+
+            beglat = intrsct_lat
+            beglon = intrsct_lon
+          end do
+
+          endif
+
+          !***
+          !*** end of segment
+          !***
+
+        end do
+
+        !***
+        !*** finished with this cell: deallocate search array and
+        !*** start on next cell
+
+        deallocate(srch_add, srch_corner_lat, srch_corner_lon)
+
+      end do
+
+      deallocate(srch_mask)
+
+!-----------------------------------------------------------------------
+!
+!     correct for situations where N/S pole not explicitly included in
+!     grid (i.e. as a grid corner point). if pole is missing from only
+!     one grid, need to correct only the area and centroid of that 
+!     grid.  if missing from both, do complete weight calculation.
+!
+!-----------------------------------------------------------------------
+
+      !*** North Pole
+      weights(1) =  pi2
+      weights(2) =  pi*pi
+      weights(3) =  zero
+      weights(4) =  pi2
+      weights(5) =  pi*pi
+      weights(6) =  zero
+
+      grid1_add = 0
+      pole_loop1: do n=1,grid1_size
+        if (grid1_area(n) < -three*pih .and. &
+            grid1_center_lat(n) > zero) then
+          grid1_add = n
+          exit pole_loop1
+        endif
+      end do pole_loop1
+
+      grid2_add = 0
+      pole_loop2: do n=1,grid2_size
+        if (grid2_area(n) < -three*pih .and. &
+            grid2_center_lat(n) > zero) then
+          grid2_add = n
+          exit pole_loop2
+        endif
+      end do pole_loop2
+
+      if (grid1_add /=0) then
+        grid1_area(grid1_add) = grid1_area(grid1_add) + weights(1)
+        grid1_centroid_lat(grid1_add) =  &
+        grid1_centroid_lat(grid1_add) + weights(2)
+        grid1_centroid_lon(grid1_add) = &
+        grid1_centroid_lon(grid1_add) + weights(3)
+      endif
+
+      if (grid2_add /=0) then
+        grid2_area(grid2_add) = grid2_area(grid2_add) +  &
+                                        weights(num_wts+1)
+        grid2_centroid_lat(grid2_add) =  &
+        grid2_centroid_lat(grid2_add) + weights(num_wts+2)
+        grid2_centroid_lon(grid2_add) = &
+        grid2_centroid_lon(grid2_add) + weights(num_wts+3)
+      endif
+
+      if (grid1_add /= 0 .and. grid2_add /=0) then
+        call store_link_cnsrv(grid1_add, grid2_add, weights)
+
+        grid1_frac(grid1_add) = grid1_frac(grid1_add) +  &
+                                weights(1)
+        grid2_frac(grid2_add) = grid2_frac(grid2_add) +  &
+                                weights(num_wts+1)
+      endif
+
+      !*** South Pole
+      weights(1) =  pi2
+      weights(2) = -pi*pi
+      weights(3) =  zero
+      weights(4) =  pi2
+      weights(5) = -pi*pi
+      weights(6) =  zero
+
+      grid1_add = 0
+      pole_loop3: do n=1,grid1_size
+        if (grid1_area(n) < -three*pih .and. &
+            grid1_center_lat(n) < zero) then
+          grid1_add = n
+          exit pole_loop3
+        endif
+      end do pole_loop3
+
+      grid2_add = 0
+      pole_loop4: do n=1,grid2_size
+        if (grid2_area(n) < -three*pih .and. &
+            grid2_center_lat(n) < zero) then
+          grid2_add = n
+          exit pole_loop4
+        endif
+      end do pole_loop4
+
+      if (grid1_add /=0) then
+        grid1_area(grid1_add) = grid1_area(grid1_add) + weights(1)
+        grid1_centroid_lat(grid1_add) =  &
+        grid1_centroid_lat(grid1_add) + weights(2)
+        grid1_centroid_lon(grid1_add) = &
+        grid1_centroid_lon(grid1_add) + weights(3)
+      endif
+
+      if (grid2_add /=0) then
+        grid2_area(grid2_add) = grid2_area(grid2_add) +  &
+                                        weights(num_wts+1)
+        grid2_centroid_lat(grid2_add) =  &
+        grid2_centroid_lat(grid2_add) + weights(num_wts+2)
+        grid2_centroid_lon(grid2_add) = &
+        grid2_centroid_lon(grid2_add) + weights(num_wts+3)
+      endif
+
+      if (grid1_add /= 0 .and. grid2_add /=0) then
+        call store_link_cnsrv(grid1_add, grid2_add, weights)
+
+        grid1_frac(grid1_add) = grid1_frac(grid1_add) +  &
+                                weights(1)
+        grid2_frac(grid2_add) = grid2_frac(grid2_add) +  &
+                                weights(num_wts+1)
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     finish centroid computation
+!
+!-----------------------------------------------------------------------
+
+      where (grid1_area /= zero)
+        grid1_centroid_lat = grid1_centroid_lat/grid1_area
+        grid1_centroid_lon = grid1_centroid_lon/grid1_area
+      end where
+
+      where (grid2_area /= zero)
+        grid2_centroid_lat = grid2_centroid_lat/grid2_area
+        grid2_centroid_lon = grid2_centroid_lon/grid2_area
+      end where
+
+!-----------------------------------------------------------------------
+!
+!     include centroids in weights and normalize using destination
+!     area if requested
+!
+!-----------------------------------------------------------------------
+
+      do n=1,num_links_map1
+        grid1_add = grid1_add_map1(n)
+        grid2_add = grid2_add_map1(n)
+        do nwgt=1,num_wts
+          weights(        nwgt) = wts_map1(nwgt,n)
+          if (num_maps > 1) then
+            weights(num_wts+nwgt) = wts_map2(nwgt,n)
+          endif
+        end do
+
+        select case(norm_opt)
+        case (norm_opt_dstarea)
+          if (grid2_area(grid2_add) /= zero) then
+            if (luse_grid2_area) then
+              norm_factor = one/grid2_area_in(grid2_add)
+            else
+              norm_factor = one/grid2_area(grid2_add)
+            endif
+          else
+            norm_factor = zero
+          endif
+        case (norm_opt_frcarea)
+          if (grid2_frac(grid2_add) /= zero) then
+            if (luse_grid2_area) then
+              norm_factor = grid2_area(grid2_add)/ &
+                           (grid2_frac(grid2_add)* &
+                            grid2_area_in(grid2_add))
+            else
+              norm_factor = one/grid2_frac(grid2_add)
+            endif
+          else
+            norm_factor = zero
+          endif
+        case (norm_opt_none)
+          norm_factor = one
+        end select
+
+        wts_map1(1,n) =  weights(1)*norm_factor
+        wts_map1(2,n) = (weights(2) - weights(1)* &
+                                    grid1_centroid_lat(grid1_add))* &
+                                    norm_factor
+        wts_map1(3,n) = (weights(3) - weights(1)* &
+                                    grid1_centroid_lon(grid1_add))* &
+                                    norm_factor
+
+        if (num_maps > 1) then
+          select case(norm_opt)
+          case (norm_opt_dstarea)
+            if (grid1_area(grid1_add) /= zero) then
+              if (luse_grid1_area) then
+                norm_factor = one/grid1_area_in(grid1_add)
+              else
+                norm_factor = one/grid1_area(grid1_add)
+              endif
+            else
+              norm_factor = zero
+            endif
+          case (norm_opt_frcarea)
+            if (grid1_frac(grid1_add) /= zero) then
+              if (luse_grid1_area) then
+                norm_factor = grid1_area(grid1_add)/ &
+                             (grid1_frac(grid1_add)* &
+                              grid1_area_in(grid1_add))
+              else
+                norm_factor = one/grid1_frac(grid1_add)
+              endif
+            else
+              norm_factor = zero
+            endif
+          case (norm_opt_none)
+            norm_factor = one
+          end select
+
+          wts_map2(1,n) =  weights(num_wts+1)*norm_factor
+          wts_map2(2,n) = (weights(num_wts+2) - weights(num_wts+1)* &
+                                      grid2_centroid_lat(grid2_add))* &
+                                      norm_factor
+          wts_map2(3,n) = (weights(num_wts+3) - weights(num_wts+1)* &
+                                      grid2_centroid_lon(grid2_add))* &
+                                      norm_factor
+        endif
+
+      end do
+
+      print *, 'Total number of links = ',num_links_map1
+
+      where (grid1_area /= zero) grid1_frac = grid1_frac/grid1_area
+      where (grid2_area /= zero) grid2_frac = grid2_frac/grid2_area
+
+!-----------------------------------------------------------------------
+!
+!     perform some error checking on final weights
+!
+!-----------------------------------------------------------------------
+
+      grid2_centroid_lat = zero
+      grid2_centroid_lon = zero
+
+      do n=1,grid1_size
+        if (grid1_area(n) < -.01) then
+          print *,'Grid 1 area error: ',n,grid1_area(n)
+        endif
+        if (grid1_centroid_lat(n) < -pih-.01 .or. &
+            grid1_centroid_lat(n) >  pih+.01) then
+          print *,'Grid 1 centroid lat error: ',n,grid1_centroid_lat(n)
+        endif
+        grid1_centroid_lat(n) = zero
+        grid1_centroid_lon(n) = zero
+      end do
+
+      do n=1,grid2_size
+        if (grid2_area(n) < -.01) then
+          print *,'Grid 2 area error: ',n,grid2_area(n)
+        endif
+        if (grid2_centroid_lat(n) < -pih-.01 .or. &
+            grid2_centroid_lat(n) >  pih+.01) then
+          print *,'Grid 2 centroid lat error: ',n,grid2_centroid_lat(n)
+        endif
+        grid2_centroid_lat(n) = zero
+        grid2_centroid_lon(n) = zero
+      end do
+
+      do n=1,num_links_map1
+        grid1_add = grid1_add_map1(n)
+        grid2_add = grid2_add_map1(n)
+        
+        if (wts_map1(1,n) < -.01) then
+          print *,'Map 1 weight < 0 ',grid1_add,grid2_add,wts_map1(1,n)
+        endif
+        if (norm_opt /= norm_opt_none .and. wts_map1(1,n) > 1.01) then
+          print *,'Map 1 weight > 1 ',grid1_add,grid2_add,wts_map1(1,n)
+        endif
+        grid2_centroid_lat(grid2_add) =  &
+        grid2_centroid_lat(grid2_add) + wts_map1(1,n)
+
+        if (num_maps > 1) then
+          if (wts_map2(1,n) < -.01) then
+            print *,'Map 2 weight < 0 ',grid1_add,grid2_add, &
+                                        wts_map2(1,n)
+          endif
+          if (norm_opt /= norm_opt_none .and. wts_map2(1,n) > 1.01) then
+            print *,'Map 2 weight < 0 ',grid1_add,grid2_add, &
+                                        wts_map2(1,n)
+          endif
+          grid1_centroid_lat(grid1_add) =  &
+          grid1_centroid_lat(grid1_add) + wts_map2(1,n)
+        endif
+      end do
+
+      do n=1,grid2_size
+        select case(norm_opt)
+        case (norm_opt_dstarea)
+          norm_factor = grid2_frac(grid2_add)
+        case (norm_opt_frcarea)
+          norm_factor = one
+        case (norm_opt_none)
+          if (luse_grid2_area) then
+            norm_factor = grid2_area_in(grid2_add)
+          else
+            norm_factor = grid2_area(grid2_add)
+          endif
+        end select
+        if (abs(grid2_centroid_lat(grid2_add)-norm_factor) > .01) then
+          print *,'Error: sum of wts for map1 ',grid2_add, &
+                  grid2_centroid_lat(grid2_add),norm_factor
+        endif
+      end do
+
+      if (num_maps > 1) then
+        do n=1,grid1_size
+          select case(norm_opt)
+          case (norm_opt_dstarea)
+            norm_factor = grid1_frac(grid1_add)
+          case (norm_opt_frcarea)
+            norm_factor = one
+          case (norm_opt_none)
+            if (luse_grid1_area) then
+              norm_factor = grid1_area_in(grid1_add)
+            else
+              norm_factor = grid1_area(grid1_add)
+            endif
+          end select
+          if (abs(grid1_centroid_lat(grid1_add)-norm_factor) > .01) then
+            print *,'Error: sum of wts for map2 ',grid1_add, &
+                    grid1_centroid_lat(grid1_add),norm_factor
+          endif
+        end do
+      endif
+!-----------------------------------------------------------------------
+
+      end subroutine remap_conserv
+
+!***********************************************************************
+
+      subroutine intersection(location,intrsct_lat,intrsct_lon,lcoinc, &
+                              beglat, beglon, endlat, endlon, begseg, &
+                              lbegin, lrevers)
+
+!-----------------------------------------------------------------------
+!
+!     this routine finds the next intersection of a destination grid 
+!     line with the line segment given by beglon, endlon, etc.
+!     a coincidence flag is returned if the segment is entirely 
+!     coincident with an ocean grid line.  the cells in which to search
+!     for an intersection must have already been restricted in the
+!     calling routine.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     intent(in): 
+!
+!-----------------------------------------------------------------------
+
+      logical (kind=log_kind), intent(in) :: &
+           lbegin,  & ! flag for first integration along this segment
+           lrevers ! flag whether segment integrated in reverse
+
+      real (kind=dbl_kind), intent(in) ::  &
+           beglat, beglon,   & ! beginning lat/lon endpoints for segment
+           endlat, endlon   ! ending    lat/lon endpoints for segment
+
+      real (kind=dbl_kind), dimension(2), intent(inout) ::  &
+           begseg ! begin lat/lon of full segment
+
+!-----------------------------------------------------------------------
+!
+!     intent(out): 
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(out) :: &
+              location  ! address in destination array containing this
+                        ! segment
+
+      logical (kind=log_kind), intent(out) :: &
+              lcoinc    ! flag segments which are entirely coincident
+                        ! with a grid line
+
+      real (kind=dbl_kind), intent(out) :: &
+           intrsct_lat, intrsct_lon ! lat/lon coords of next intersect.
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, next_n, cell, srch_corners, pole_loc
+
+      integer (kind=int_kind), save ::  &
+           last_loc  ! save location when crossing threshold
+
+      logical (kind=log_kind) ::  &
+           loutside  ! flags points outside grid
+
+      logical (kind=log_kind), save ::  &
+           lthresh = .false.  ! flags segments crossing threshold bndy
+
+      real (kind=dbl_kind) :: &
+           lon1, lon2,        & ! local longitude variables for segment
+           lat1, lat2,        & ! local latitude  variables for segment
+           grdlon1, grdlon2,  & ! local longitude variables for grid cell
+           grdlat1, grdlat2,  & ! local latitude  variables for grid cell
+           vec1_lat, vec1_lon,  & ! vectors and cross products used
+           vec2_lat, vec2_lon,  & ! during grid search
+           cross_product,  &
+           eps, offset,         & ! small offset away from intersect
+           s1, s2, determ,      & ! variables used for linear solve to
+           mat1, mat2, mat3, mat4, rhs1, rhs2  ! find intersection
+
+      real (kind=dbl_kind), save :: &
+           intrsct_lat_off, intrsct_lon_off ! lat/lon coords offset 
+                                            ! for next search
+
+!-----------------------------------------------------------------------
+!
+!     initialize defaults, flags, etc.
+!
+!-----------------------------------------------------------------------
+
+      location = 0
+      lcoinc = .false.
+      intrsct_lat = endlat
+      intrsct_lon = endlon
+
+      if (num_srch_cells == 0) return
+
+      if (beglat > north_thresh .or. beglat < south_thresh) then
+
+        if (lthresh) location = last_loc
+        call pole_intersection(location, &
+                     intrsct_lat,intrsct_lon,lcoinc,lthresh, &
+                     beglat, beglon, endlat, endlon, begseg, lrevers)
+        if (lthresh) then
+          last_loc = location
+          intrsct_lat_off = intrsct_lat
+          intrsct_lon_off = intrsct_lon
+        endif
+        return
+
+      endif
+
+      loutside = .false.
+      if (lbegin) then
+        lat1 = beglat
+        lon1 = beglon
+      else
+        lat1 = intrsct_lat_off
+        lon1 = intrsct_lon_off
+      endif
+      lat2 = endlat
+      lon2 = endlon
+      if ((lon2-lon1) > three*pih) then
+        lon2 = lon2 - pi2
+      else if ((lon2-lon1) < -three*pih) then
+        lon2 = lon2 + pi2
+      endif
+      s1 = zero
+
+!-----------------------------------------------------------------------
+!
+!     search for location of this segment in ocean grid using cross
+!     product method to determine whether a point is enclosed by a cell
+!
+!-----------------------------------------------------------------------
+
+      call timer_start(12)
+      srch_corners = size(srch_corner_lat,DIM=1)
+      srch_loop: do
+
+        !***
+        !*** if last segment crossed threshold, use that location
+        !***
+
+        if (lthresh) then
+          do cell=1,num_srch_cells
+            if (srch_add(cell) == last_loc) then
+              location = last_loc
+              eps = tiny
+              exit srch_loop
+            endif
+          end do
+        endif
+
+        !***
+        !*** otherwise normal search algorithm
+        !***
+
+        cell_loop: do cell=1,num_srch_cells
+          corner_loop: do n=1,srch_corners
+            next_n = MOD(n,srch_corners) + 1
+
+            !***
+            !*** here we take the cross product of the vector making 
+            !*** up each cell side with the vector formed by the vertex
+            !*** and search point.  if all the cross products are 
+            !*** positive, the point is contained in the cell.
+            !***
+
+            vec1_lat = srch_corner_lat(next_n,cell) -  &
+                       srch_corner_lat(n     ,cell)
+            vec1_lon = srch_corner_lon(next_n,cell) -  &
+                       srch_corner_lon(n     ,cell)
+            vec2_lat = lat1 - srch_corner_lat(n,cell)
+            vec2_lon = lon1 - srch_corner_lon(n,cell)
+
+            !***
+            !*** if endpoint coincident with vertex, offset
+            !*** the endpoint
+            !***
+
+            if (vec2_lat == 0 .and. vec2_lon == 0) then
+              lat1 = lat1 + 1.d-10*(lat2-lat1)
+              lon1 = lon1 + 1.d-10*(lon2-lon1)
+              vec2_lat = lat1 - srch_corner_lat(n,cell)
+              vec2_lon = lon1 - srch_corner_lon(n,cell)
+            endif
+
+            !***
+            !*** check for 0,2pi crossings
+            !***
+
+            if (vec1_lon >  pi) then
+              vec1_lon = vec1_lon - pi2
+            else if (vec1_lon < -pi) then
+              vec1_lon = vec1_lon + pi2
+            endif
+            if (vec2_lon >  pi) then
+              vec2_lon = vec2_lon - pi2
+            else if (vec2_lon < -pi) then
+              vec2_lon = vec2_lon + pi2
+            endif
+
+            cross_product = vec1_lon*vec2_lat - vec2_lon*vec1_lat
+
+            !***
+            !*** if the cross product for a side is zero, the point 
+            !***   lies exactly on the side or the side is degenerate
+            !***   (zero length).  if degenerate, set the cross 
+            !***   product to a positive number.  otherwise perform 
+            !***   another cross product between the side and the 
+            !***   segment itself. 
+            !*** if this cross product is also zero, the line is 
+            !***   coincident with the cell boundary - perform the 
+            !***   dot product and only choose the cell if the dot 
+            !***   product is positive (parallel vs anti-parallel).
+            !***
+
+            if (cross_product == zero) then
+              if (vec1_lat /= zero .or. vec1_lon /= zero) then
+                vec2_lat = lat2 - lat1
+                vec2_lon = lon2 - lon1
+
+                if (vec2_lon >  pi) then
+                  vec2_lon = vec2_lon - pi2
+                else if (vec2_lon < -pi) then
+                  vec2_lon = vec2_lon + pi2
+                endif
+
+                cross_product = vec1_lon*vec2_lat - vec2_lon*vec1_lat
+              else
+                cross_product = one
+              endif
+
+              if (cross_product == zero) then
+                lcoinc = .true.
+                cross_product = vec1_lon*vec2_lon + vec1_lat*vec2_lat
+                if (lrevers) cross_product = -cross_product
+              endif
+            endif
+
+            !***
+            !*** if cross product is less than zero, this cell
+            !*** doesn't work
+            !***
+
+            if (cross_product < zero) exit corner_loop
+
+          end do corner_loop
+
+          !***
+          !*** if cross products all positive, we found the location
+          !***
+
+          if (n > srch_corners) then
+            location = srch_add(cell)
+
+            !***
+            !*** if the beginning of this segment was outside the
+            !*** grid, invert the segment so the intersection found
+            !*** will be the first intersection with the grid
+            !***
+
+            if (loutside) then
+              lat2 = beglat
+              lon2 = beglon
+              location = 0
+              eps  = -tiny
+            else
+              eps  = tiny
+            endif
+
+            exit srch_loop
+          endif
+
+          !***
+          !*** otherwise move on to next cell
+          !***
+
+        end do cell_loop
+
+        !***
+        !*** if still no cell found, the point lies outside the grid.
+        !***   take some baby steps along the segment to see if any
+        !***   part of the segment lies inside the grid.  
+        !***
+
+        loutside = .true.
+        s1 = s1 + 0.001_dbl_kind
+        lat1 = beglat + s1*(endlat - beglat)
+        lon1 = beglon + s1*(lon2   - beglon)
+
+        !***
+        !*** reached the end of the segment and still outside the grid
+        !*** return no intersection
+        !***
+
+        if (s1 >= one) return
+
+      end do srch_loop
+      call timer_stop(12)
+
+!-----------------------------------------------------------------------
+!
+!     now that a cell is found, search for the next intersection.
+!     loop over sides of the cell to find intersection with side
+!     must check all sides for coincidences or intersections
+!
+!-----------------------------------------------------------------------
+
+      call timer_start(13)
+      intrsct_loop: do n=1,srch_corners
+        next_n = mod(n,srch_corners) + 1
+
+        grdlon1 = srch_corner_lon(n     ,cell)
+        grdlon2 = srch_corner_lon(next_n,cell)
+        grdlat1 = srch_corner_lat(n     ,cell)
+        grdlat2 = srch_corner_lat(next_n,cell)
+
+        !***
+        !*** set up linear system to solve for intersection
+        !***
+
+        mat1 = lat2 - lat1
+        mat2 = grdlat1 - grdlat2
+        mat3 = lon2 - lon1
+        mat4 = grdlon1 - grdlon2
+        rhs1 = grdlat1 - lat1
+        rhs2 = grdlon1 - lon1
+
+        if (mat3 >  pi) then
+          mat3 = mat3 - pi2
+        else if (mat3 < -pi) then
+          mat3 = mat3 + pi2
+        endif
+        if (mat4 >  pi) then
+          mat4 = mat4 - pi2
+        else if (mat4 < -pi) then
+          mat4 = mat4 + pi2
+        endif
+        if (rhs2 >  pi) then
+          rhs2 = rhs2 - pi2
+        else if (rhs2 < -pi) then
+          rhs2 = rhs2 + pi2
+        endif
+
+        determ = mat1*mat4 - mat2*mat3
+
+        !***
+        !*** if the determinant is zero, the segments are either 
+        !***   parallel or coincident.  coincidences were detected 
+        !***   above so do nothing.
+        !*** if the determinant is non-zero, solve for the linear 
+        !***   parameters s for the intersection point on each line 
+        !***   segment.
+        !*** if 0<s1,s2<1 then the segment intersects with this side.
+        !***   return the point of intersection (adding a small
+        !***   number so the intersection is off the grid line).
+        !***
+
+        if (abs(determ) > 1.e-30) then
+
+          s1 = (rhs1*mat4 - mat2*rhs2)/determ
+          s2 = (mat1*rhs2 - rhs1*mat3)/determ
+
+          if (s2 >= zero .and. s2 <= one .and. &
+              s1 >  zero .and. s1 <= one) then
+
+            !***
+            !*** recompute intersection based on full segment
+            !*** so intersections are consistent for both sweeps
+            !***
+
+            if (.not. loutside) then
+              mat1 = lat2 - begseg(1)
+              mat3 = lon2 - begseg(2)
+              rhs1 = grdlat1 - begseg(1)
+              rhs2 = grdlon1 - begseg(2)
+            else
+              mat1 = begseg(1) - endlat
+              mat3 = begseg(2) - endlon
+              rhs1 = grdlat1 - endlat
+              rhs2 = grdlon1 - endlon
+            endif
+
+            if (mat3 >  pi) then
+              mat3 = mat3 - pi2
+            else if (mat3 < -pi) then
+              mat3 = mat3 + pi2
+            endif
+            if (rhs2 >  pi) then
+              rhs2 = rhs2 - pi2
+            else if (rhs2 < -pi) then
+              rhs2 = rhs2 + pi2
+            endif
+
+            determ = mat1*mat4 - mat2*mat3
+
+            !***
+            !*** sometimes due to roundoff, the previous 
+            !*** determinant is non-zero, but the lines
+            !*** are actually coincident.  if this is the
+            !*** case, skip the rest.
+            !***
+
+            if (determ /= zero) then
+              s1 = (rhs1*mat4 - mat2*rhs2)/determ
+              s2 = (mat1*rhs2 - rhs1*mat3)/determ
+
+              offset = s1 + eps/determ
+              if (offset > one) offset = one
+
+              if (.not. loutside) then
+                intrsct_lat = begseg(1) + mat1*s1
+                intrsct_lon = begseg(2) + mat3*s1
+                intrsct_lat_off = begseg(1) + mat1*offset
+                intrsct_lon_off = begseg(2) + mat3*offset
+              else
+                intrsct_lat = endlat + mat1*s1
+                intrsct_lon = endlon + mat3*s1
+                intrsct_lat_off = endlat + mat1*offset
+                intrsct_lon_off = endlon + mat3*offset
+              endif
+              exit intrsct_loop
+            endif
+
+          endif
+        endif
+
+        !***
+        !*** no intersection this side, move on to next side
+        !***
+
+      end do intrsct_loop
+      call timer_stop(13)
+
+!-----------------------------------------------------------------------
+!
+!     if the segment crosses a pole threshold, reset the intersection
+!     to be the threshold latitude.  only check if this was not a
+!     threshold segment since sometimes coordinate transform can end
+!     up on other side of threshold again.
+!
+!-----------------------------------------------------------------------
+
+      if (lthresh) then
+        if (intrsct_lat < north_thresh .or. intrsct_lat > south_thresh) &
+            lthresh = .false.
+      else if (lat1 > zero .and. intrsct_lat > north_thresh) then
+        intrsct_lat = north_thresh + tiny
+        intrsct_lat_off = north_thresh + eps*mat1
+        s1 = (intrsct_lat - begseg(1))/mat1
+        intrsct_lon     = begseg(2) + s1*mat3
+        intrsct_lon_off = begseg(2) + (s1+eps)*mat3
+        last_loc = location
+        lthresh = .true.
+      else if (lat1 < zero .and. intrsct_lat < south_thresh) then
+        intrsct_lat = south_thresh - tiny
+        intrsct_lat_off = south_thresh + eps*mat1
+        s1 = (intrsct_lat - begseg(1))/mat1
+        intrsct_lon     = begseg(2) + s1*mat3
+        intrsct_lon_off = begseg(2) + (s1+eps)*mat3
+        last_loc = location
+        lthresh = .true.
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine intersection
+
+!***********************************************************************
+
+      subroutine pole_intersection(location, &
+                       intrsct_lat,intrsct_lon,lcoinc,lthresh, &
+                       beglat, beglon, endlat, endlon, begseg, lrevers)
+
+!-----------------------------------------------------------------------
+!
+!     this routine is identical to the intersection routine except
+!     that a coordinate transformation (using a Lambert azimuthal
+!     equivalent projection) is performed to treat polar cells more
+!     accurately.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     intent(in): 
+!
+!-----------------------------------------------------------------------
+
+      real (kind=dbl_kind), intent(in) ::  &
+           beglat, beglon,   & ! beginning lat/lon endpoints for segment
+           endlat, endlon   ! ending    lat/lon endpoints for segment
+
+      real (kind=dbl_kind), dimension(2), intent(inout) ::  &
+           begseg ! begin lat/lon of full segment
+
+      logical (kind=log_kind), intent(in) :: &
+              lrevers   ! flag true if segment integrated in reverse
+
+!-----------------------------------------------------------------------
+!
+!     intent(out): 
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(inout) :: &
+              location  ! address in destination array containing this
+                        ! segment -- also may contain last location on
+                        ! entry
+
+      logical (kind=log_kind), intent(out) :: &
+              lcoinc    ! flag segment coincident with grid line
+
+      logical (kind=log_kind), intent(inout) :: &
+              lthresh   ! flag segment crossing threshold boundary
+
+      real (kind=dbl_kind), intent(out) :: &
+           intrsct_lat, intrsct_lon ! lat/lon coords of next intersect.
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, next_n, cell, srch_corners, pole_loc
+
+      logical (kind=log_kind) :: loutside ! flags points outside grid
+
+      real (kind=dbl_kind) :: pi4, rns,  & ! north/south conversion
+           x1, x2,        & ! local x variables for segment
+           y1, y2,        & ! local y variables for segment
+           begx, begy,    & ! beginning x,y variables for segment
+           endx, endy,    & ! beginning x,y variables for segment
+           begsegx, begsegy,    & ! beginning x,y variables for segment
+           grdx1, grdx2,  & ! local x variables for grid cell
+           grdy1, grdy2,  & ! local y variables for grid cell
+           vec1_y, vec1_x,  & ! vectors and cross products used
+           vec2_y, vec2_x,  & ! during grid search
+           cross_product, eps,  & ! eps=small offset away from intersect
+           s1, s2, determ,      & ! variables used for linear solve to
+           mat1, mat2, mat3, mat4, rhs1, rhs2  ! find intersection
+
+      real (kind=dbl_kind), dimension(:,:), allocatable :: &
+           srch_corner_x,   & ! x of each corner of srch cells
+           srch_corner_y   ! y of each corner of srch cells
+
+      !***
+      !*** save last intersection to avoid roundoff during coord
+      !*** transformation
+      !***
+
+      logical (kind=log_kind), save :: luse_last = .false.
+
+      real (kind=dbl_kind), save ::  &
+           intrsct_x, intrsct_y  ! x,y for intersection
+
+      !***
+      !*** variables necessary if segment manages to hit pole
+      !***
+
+      integer (kind=int_kind), save ::  &
+           avoid_pole_count = 0  ! count attempts to avoid pole
+
+      real (kind=dbl_kind), save ::  &
+           avoid_pole_offset = tiny  ! endpoint offset to avoid pole
+
+!-----------------------------------------------------------------------
+!
+!     initialize defaults, flags, etc.
+!
+!-----------------------------------------------------------------------
+
+      if (.not. lthresh) location = 0
+      lcoinc = .false.
+      intrsct_lat = endlat
+      intrsct_lon = endlon
+
+      loutside = .false.
+      s1 = zero
+
+!-----------------------------------------------------------------------
+!
+!     convert coordinates
+!
+!-----------------------------------------------------------------------
+
+      allocate(srch_corner_x(size(srch_corner_lat,DIM=1), &
+                             size(srch_corner_lat,DIM=2)), &
+               srch_corner_y(size(srch_corner_lat,DIM=1), &
+                             size(srch_corner_lat,DIM=2)))
+
+      if (beglat > zero) then
+        pi4 = quart*pi
+        rns = one
+      else
+        pi4 = -quart*pi
+        rns = -one
+      endif
+
+      if (luse_last) then
+        x1 = intrsct_x
+        y1 = intrsct_y
+      else
+        x1 = rns*two*sin(pi4 - half*beglat)*cos(beglon)
+        y1 =     two*sin(pi4 - half*beglat)*sin(beglon)
+        luse_last = .true.
+      endif
+      x2 = rns*two*sin(pi4 - half*endlat)*cos(endlon)
+      y2 =     two*sin(pi4 - half*endlat)*sin(endlon)
+      srch_corner_x = rns*two*sin(pi4 - half*srch_corner_lat)* &
+                              cos(srch_corner_lon)
+      srch_corner_y =     two*sin(pi4 - half*srch_corner_lat)* &
+                              sin(srch_corner_lon)
+
+      begx = x1
+      begy = y1
+      endx = x2
+      endy = y2
+      begsegx = rns*two*sin(pi4 - half*begseg(1))*cos(begseg(2))
+      begsegy =     two*sin(pi4 - half*begseg(1))*sin(begseg(2))
+      intrsct_x = endx
+      intrsct_y = endy
+
+!-----------------------------------------------------------------------
+!
+!     search for location of this segment in ocean grid using cross
+!     product method to determine whether a point is enclosed by a cell
+!
+!-----------------------------------------------------------------------
+
+      call timer_start(12)
+      srch_corners = size(srch_corner_lat,DIM=1)
+      srch_loop: do
+
+        !***
+        !*** if last segment crossed threshold, use that location
+        !***
+
+        if (lthresh) then
+          do cell=1,num_srch_cells
+            if (srch_add(cell) == location) then
+              eps = tiny
+              exit srch_loop
+            endif
+          end do
+        endif
+
+        !***
+        !*** otherwise normal search algorithm
+        !***
+
+        cell_loop: do cell=1,num_srch_cells
+          corner_loop: do n=1,srch_corners
+            next_n = MOD(n,srch_corners) + 1
+
+            !***
+            !*** here we take the cross product of the vector making 
+            !*** up each cell side with the vector formed by the vertex
+            !*** and search point.  if all the cross products are 
+            !*** positive, the point is contained in the cell.
+            !***
+
+            vec1_x = srch_corner_x(next_n,cell) -  &
+                     srch_corner_x(n     ,cell)
+            vec1_y = srch_corner_y(next_n,cell) -  &
+                     srch_corner_y(n     ,cell)
+            vec2_x = x1 - srch_corner_x(n,cell)
+            vec2_y = y1 - srch_corner_y(n,cell)
+
+            !***
+            !*** if endpoint coincident with vertex, offset
+            !*** the endpoint
+            !***
+
+            if (vec2_x == 0 .and. vec2_y == 0) then
+              x1 = x1 + 1.d-10*(x2-x1)
+              y1 = y1 + 1.d-10*(y2-y1)
+              vec2_x = x1 - srch_corner_x(n,cell)
+              vec2_y = y1 - srch_corner_y(n,cell)
+            endif
+
+            cross_product = vec1_x*vec2_y - vec2_x*vec1_y
+
+            !***
+            !*** if the cross product for a side is zero, the point 
+            !***   lies exactly on the side or the length of a side
+            !***   is zero.  if the length is zero set det > 0.
+            !***   otherwise, perform another cross 
+            !***   product between the side and the segment itself. 
+            !*** if this cross product is also zero, the line is 
+            !***   coincident with the cell boundary - perform the 
+            !***   dot product and only choose the cell if the dot 
+            !***   product is positive (parallel vs anti-parallel).
+            !***
+
+            if (cross_product == zero) then
+              if (vec1_x /= zero .or. vec1_y /= 0) then
+                vec2_x = x2 - x1
+                vec2_y = y2 - y1
+                cross_product = vec1_x*vec2_y - vec2_x*vec1_y
+              else
+                cross_product = one
+              endif
+
+              if (cross_product == zero) then
+                lcoinc = .true.
+                cross_product = vec1_x*vec2_x + vec1_y*vec2_y
+                if (lrevers) cross_product = -cross_product
+              endif
+            endif
+
+            !***
+            !*** if cross product is less than zero, this cell
+            !*** doesn't work
+            !***
+
+            if (cross_product < zero) exit corner_loop
+
+          end do corner_loop
+
+          !***
+          !*** if cross products all positive, we found the location
+          !***
+
+          if (n > srch_corners) then
+            location = srch_add(cell)
+
+            !***
+            !*** if the beginning of this segment was outside the
+            !*** grid, invert the segment so the intersection found
+            !*** will be the first intersection with the grid
+            !***
+
+            if (loutside) then
+              x2 = begx
+              y2 = begy
+              location = 0
+              eps  = -tiny
+            else
+              eps  = tiny
+            endif
+
+            exit srch_loop
+          endif
+
+          !***
+          !*** otherwise move on to next cell
+          !***
+
+        end do cell_loop
+
+        !***
+        !*** if no cell found, the point lies outside the grid.
+        !***   take some baby steps along the segment to see if any
+        !***   part of the segment lies inside the grid.  
+        !***
+
+        loutside = .true.
+        s1 = s1 + 0.001_dbl_kind
+        x1 = begx + s1*(x2 - begx)
+        y1 = begy + s1*(y2 - begy)
+
+        !***
+        !*** reached the end of the segment and still outside the grid
+        !*** return no intersection
+        !***
+
+        if (s1 >= one) then
+          deallocate(srch_corner_x, srch_corner_y)
+          luse_last = .false.
+          return
+        endif
+
+      end do srch_loop
+      call timer_stop(12)
+
+!-----------------------------------------------------------------------
+!
+!     now that a cell is found, search for the next intersection.
+!     loop over sides of the cell to find intersection with side
+!     must check all sides for coincidences or intersections
+!
+!-----------------------------------------------------------------------
+
+      call timer_start(13)
+      intrsct_loop: do n=1,srch_corners
+        next_n = mod(n,srch_corners) + 1
+
+        grdy1 = srch_corner_y(n     ,cell)
+        grdy2 = srch_corner_y(next_n,cell)
+        grdx1 = srch_corner_x(n     ,cell)
+        grdx2 = srch_corner_x(next_n,cell)
+
+        !***
+        !*** set up linear system to solve for intersection
+        !***
+
+        mat1 = x2 - x1
+        mat2 = grdx1 - grdx2
+        mat3 = y2 - y1
+        mat4 = grdy1 - grdy2
+        rhs1 = grdx1 - x1
+        rhs2 = grdy1 - y1
+
+        determ = mat1*mat4 - mat2*mat3
+
+        !***
+        !*** if the determinant is zero, the segments are either 
+        !***   parallel or coincident or one segment has zero length.  
+        !***   coincidences were detected above so do nothing.
+        !*** if the determinant is non-zero, solve for the linear 
+        !***   parameters s for the intersection point on each line 
+        !***   segment.
+        !*** if 0<s1,s2<1 then the segment intersects with this side.
+        !***   return the point of intersection (adding a small
+        !***   number so the intersection is off the grid line).
+        !***
+
+        if (abs(determ) > 1.e-30) then
+
+          s1 = (rhs1*mat4 - mat2*rhs2)/determ
+          s2 = (mat1*rhs2 - rhs1*mat3)/determ
+
+          if (s2 >= zero .and. s2 <= one .and. &
+              s1 >  zero .and. s1 <= one) then
+
+            !***
+            !*** recompute intersection using entire segment
+            !*** for consistency between sweeps
+            !***
+
+            if (.not. loutside) then
+              mat1 = x2 - begsegx
+              mat3 = y2 - begsegy
+              rhs1 = grdx1 - begsegx
+              rhs2 = grdy1 - begsegy
+            else 
+              mat1 = x2 - endx
+              mat3 = y2 - endy
+              rhs1 = grdx1 - endx
+              rhs2 = grdy1 - endy
+            endif
+
+            determ = mat1*mat4 - mat2*mat3
+
+            !***
+            !*** sometimes due to roundoff, the previous 
+            !*** determinant is non-zero, but the lines
+            !*** are actually coincident.  if this is the
+            !*** case, skip the rest.
+            !***
+
+            if (determ /= zero) then
+              s1 = (rhs1*mat4 - mat2*rhs2)/determ
+              s2 = (mat1*rhs2 - rhs1*mat3)/determ
+
+              if (.not. loutside) then
+                intrsct_x = begsegx + s1*mat1
+                intrsct_y = begsegy + s1*mat3
+              else 
+                intrsct_x = endx + s1*mat1
+                intrsct_y = endy + s1*mat3
+              endif
+
+              !***
+              !*** convert back to lat/lon coordinates
+              !***
+
+              intrsct_lon = rns*atan2(intrsct_y,intrsct_x)
+              if (intrsct_lon < zero)  &
+                intrsct_lon = intrsct_lon + pi2
+
+              if (abs(intrsct_x) > 1.d-10) then
+                intrsct_lat = (pi4 -  &
+                  asin(rns*half*intrsct_x/cos(intrsct_lon)))*two
+              else if (abs(intrsct_y) > 1.d-10) then
+                intrsct_lat = (pi4 -  &
+                  asin(half*intrsct_y/sin(intrsct_lon)))*two
+              else
+                intrsct_lat = two*pi4
+              endif
+
+              !***
+              !*** add offset in transformed space for next pass.
+              !***
+
+              if (s1 - eps/determ < one) then
+                intrsct_x = intrsct_x - mat1*(eps/determ)
+                intrsct_y = intrsct_y - mat3*(eps/determ)
+              else
+                if (.not. loutside) then
+                  intrsct_x = endx
+                  intrsct_y = endy
+                  intrsct_lat = endlat
+                  intrsct_lon = endlon
+                else 
+                  intrsct_x = begsegx
+                  intrsct_y = begsegy
+                  intrsct_lat = begseg(1)
+                  intrsct_lon = begseg(2)
+                endif
+              endif
+
+              exit intrsct_loop
+            endif
+          endif
+        endif
+
+        !***
+        !*** no intersection this side, move on to next side
+        !***
+
+      end do intrsct_loop
+      call timer_stop(13)
+
+      deallocate(srch_corner_x, srch_corner_y)
+
+!-----------------------------------------------------------------------
+!
+!     if segment manages to cross over pole, shift the beginning 
+!     endpoint in order to avoid hitting pole directly
+!     (it is ok for endpoint to be pole point)
+!
+!-----------------------------------------------------------------------
+
+      if (abs(intrsct_x) < 1.e-10 .and. abs(intrsct_y) < 1.e-10 .and. &
+          (endx /= zero .and. endy /=0)) then
+        if (avoid_pole_count > 2) then
+           avoid_pole_count = 0
+           avoid_pole_offset = 10.*avoid_pole_offset
+        endif
+
+        cross_product = begsegx*(endy-begsegy) - begsegy*(endx-begsegx)
+        intrsct_lat = begseg(1)
+        if (cross_product*intrsct_lat > zero) then
+          intrsct_lon = beglon    + avoid_pole_offset
+          begseg(2)   = begseg(2) + avoid_pole_offset
+        else
+          intrsct_lon = beglon    - avoid_pole_offset
+          begseg(2)   = begseg(2) - avoid_pole_offset
+        endif
+
+        avoid_pole_count = avoid_pole_count + 1
+        luse_last = .false.
+      else
+        avoid_pole_count = 0
+        avoid_pole_offset = tiny
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     if the segment crosses a pole threshold, reset the intersection
+!     to be the threshold latitude and do not reuse x,y intersect
+!     on next entry.  only check if did not cross threshold last
+!     time - sometimes the coordinate transformation can place a
+!     segment on the other side of the threshold again
+!
+!-----------------------------------------------------------------------
+
+      if (lthresh) then
+        if (intrsct_lat > north_thresh .or. intrsct_lat < south_thresh) &
+          lthresh = .false.
+      else if (beglat > zero .and. intrsct_lat < north_thresh) then
+        mat4 = endlat - begseg(1)
+        mat3 = endlon - begseg(2)
+        if (mat3 >  pi) mat3 = mat3 - pi2
+        if (mat3 < -pi) mat3 = mat3 + pi2
+        intrsct_lat = north_thresh - tiny
+        s1 = (north_thresh - begseg(1))/mat4
+        intrsct_lon = begseg(2) + s1*mat3
+        luse_last = .false.
+        lthresh = .true.
+      else if (beglat < zero .and. intrsct_lat > south_thresh) then
+        mat4 = endlat - begseg(1)
+        mat3 = endlon - begseg(2)
+        if (mat3 >  pi) mat3 = mat3 - pi2
+        if (mat3 < -pi) mat3 = mat3 + pi2
+        intrsct_lat = south_thresh + tiny
+        s1 = (south_thresh - begseg(1))/mat4
+        intrsct_lon = begseg(2) + s1*mat3
+        luse_last = .false.
+        lthresh = .true.
+      endif
+
+      !***
+      !*** if reached end of segment, do not use x,y intersect 
+      !*** on next entry
+      !***
+
+      if (intrsct_lat == endlat .and. intrsct_lon == endlon) then
+        luse_last = .false.
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine pole_intersection
+
+!***********************************************************************
+
+      subroutine line_integral(weights, num_wts,  &
+                             in_phi1, in_phi2, theta1, theta2, &
+                             grid1_lat, grid1_lon, grid2_lat, grid2_lon)
+
+!-----------------------------------------------------------------------
+!
+!     this routine computes the line integral of the flux function 
+!     that results in the interpolation weights.  the line is defined
+!     by the input lat/lon of the endpoints.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     intent(in):
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) :: &
+              num_wts  ! number of weights to compute
+
+      real (kind=dbl_kind), intent(in) ::  &
+           in_phi1, in_phi2,      & ! longitude endpoints for the segment
+           theta1, theta2,        & ! latitude  endpoints for the segment
+           grid1_lat, grid1_lon,  & ! reference coordinates for each
+           grid2_lat, grid2_lon  ! grid (to ensure correct 0,2pi interv.
+
+!-----------------------------------------------------------------------
+!
+!     intent(out):
+!
+!-----------------------------------------------------------------------
+
+      real (kind=dbl_kind), dimension(2*num_wts), intent(out) :: &
+           weights   ! line integral contribution to weights
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      real (kind=dbl_kind) :: dphi, sinth1, sinth2, costh1, costh2, fac, &
+                              phi1, phi2, phidiff1, phidiff2, sinint
+      real (kind=dbl_kind) :: f1, f2, fint
+
+!-----------------------------------------------------------------------
+!
+!     weights for the general case based on a trapezoidal approx to
+!     the integrals.
+!
+!-----------------------------------------------------------------------
+
+      sinth1 = SIN(theta1)
+      sinth2 = SIN(theta2)
+      costh1 = COS(theta1)
+      costh2 = COS(theta2)
+
+      dphi = in_phi1 - in_phi2
+      if (dphi >  pi) then
+        dphi = dphi - pi2
+      else if (dphi < -pi) then
+        dphi = dphi + pi2
+      endif
+      dphi = half*dphi
+
+!-----------------------------------------------------------------------
+!
+!     the first weight is the area overlap integral. the second and
+!     fourth are second-order latitude gradient weights.
+!
+!-----------------------------------------------------------------------
+
+      weights(        1) = dphi*(sinth1 + sinth2)
+      weights(num_wts+1) = dphi*(sinth1 + sinth2)
+      weights(        2) = dphi*(costh1 + costh2 + (theta1*sinth1 + &
+                                                    theta2*sinth2))
+      weights(num_wts+2) = dphi*(costh1 + costh2 + (theta1*sinth1 + &
+                                                    theta2*sinth2))
+
+!-----------------------------------------------------------------------
+!
+!     the third and fifth weights are for the second-order phi gradient
+!     component.  must be careful of longitude range.
+!
+!-----------------------------------------------------------------------
+
+      f1 = half*(costh1*sinth1 + theta1)
+      f2 = half*(costh2*sinth2 + theta2)
+
+      phi1 = in_phi1 - grid1_lon
+      if (phi1 >  pi) then
+        phi1 = phi1 - pi2
+      else if (phi1 < -pi) then
+        phi1 = phi1 + pi2
+      endif
+
+      phi2 = in_phi2 - grid1_lon
+      if (phi2 >  pi) then
+        phi2 = phi2 - pi2
+      else if (phi2 < -pi) then
+        phi2 = phi2 + pi2
+      endif
+
+      if ((phi2-phi1) <  pi .and. (phi2-phi1) > -pi) then
+        weights(3) = dphi*(phi1*f1 + phi2*f2)
+      else
+        if (phi1 > zero) then
+          fac = pi
+        else
+          fac = -pi
+        endif
+        fint = f1 + (f2-f1)*(fac-phi1)/abs(dphi)
+        weights(3) = half*phi1*(phi1-fac)*f1 - &
+                     half*phi2*(phi2+fac)*f2 + &
+                     half*fac*(phi1+phi2)*fint
+      endif
+
+      phi1 = in_phi1 - grid2_lon
+      if (phi1 >  pi) then
+        phi1 = phi1 - pi2
+      else if (phi1 < -pi) then
+        phi1 = phi1 + pi2
+      endif
+
+      phi2 = in_phi2 - grid2_lon
+      if (phi2 >  pi) then
+        phi2 = phi2 - pi2
+      else if (phi2 < -pi) then
+        phi2 = phi2 + pi2
+      endif
+
+      if ((phi2-phi1) <  pi .and. (phi2-phi1) > -pi) then
+        weights(num_wts+3) = dphi*(phi1*f1 + phi2*f2)
+      else
+        if (phi1 > zero) then
+          fac = pi
+        else
+          fac = -pi
+        endif
+        fint = f1 + (f2-f1)*(fac-phi1)/abs(dphi)
+        weights(num_wts+3) = half*phi1*(phi1-fac)*f1 - &
+                             half*phi2*(phi2+fac)*f2 + &
+                             half*fac*(phi1+phi2)*fint
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine line_integral
+
+!***********************************************************************
+
+      subroutine store_link_cnsrv(add1, add2, weights)
+
+!-----------------------------------------------------------------------
+!
+!     this routine stores the address and weight for this link in
+!     the appropriate address and weight arrays and resizes those
+!     arrays if necessary.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) :: &
+              add1,   & ! address on grid1
+              add2   ! address on grid2
+
+      real (kind=dbl_kind), dimension(:), intent(in) :: &
+              weights ! array of remapping weights for this link
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: nlink, min_link, max_link ! link index
+
+      integer (kind=int_kind), dimension(:,:), allocatable, save :: &
+              link_add1,   & ! min,max link add to restrict search
+              link_add2   ! min,max link add to restrict search
+
+      logical (kind=log_kind), save :: first_call = .true.
+
+!-----------------------------------------------------------------------
+!
+!     if all weights are zero, do not bother storing the link
+!
+!-----------------------------------------------------------------------
+
+      if (all(weights == zero)) return
+
+!-----------------------------------------------------------------------
+!
+!     restrict the range of links to search for existing links
+!
+!-----------------------------------------------------------------------
+
+      if (first_call) then
+        allocate(link_add1(2,grid1_size), link_add2(2,grid2_size))
+        link_add1 = 0
+        link_add2 = 0
+        first_call = .false.
+        min_link = 1
+        max_link = 0
+      else
+        min_link = min(link_add1(1,add1),link_add2(1,add2))
+        max_link = max(link_add1(2,add1),link_add2(2,add2))
+        if (min_link == 0) then
+          min_link = 1
+          max_link = 0
+        endif
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     if the link already exists, add the weight to the current weight
+!     arrays
+!
+!-----------------------------------------------------------------------
+
+      do nlink=min_link,max_link
+        if (add1 == grid1_add_map1(nlink)) then
+        if (add2 == grid2_add_map1(nlink)) then
+
+          wts_map1(:,nlink) = wts_map1(:,nlink) + weights(1:num_wts)
+          if (num_maps == 2) then
+            wts_map2(:,nlink) = wts_map2(:,nlink) +  &
+                                        weights(num_wts+1:2*num_wts)
+          endif
+          return
+
+        endif
+        endif
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     if the link does not yet exist, increment number of links and 
+!     check to see if remap arrays need to be increased to accomodate 
+!     the new link.  then store the link.
+!
+!-----------------------------------------------------------------------
+
+      num_links_map1  = num_links_map1 + 1
+      if (num_links_map1 > max_links_map1)  &
+         call resize_remap_vars(1,resize_increment)
+
+      grid1_add_map1(num_links_map1) = add1
+      grid2_add_map1(num_links_map1) = add2
+      wts_map1    (:,num_links_map1) = weights(1:num_wts)
+
+      if (num_maps > 1) then
+        num_links_map2  = num_links_map2 + 1
+        if (num_links_map2 > max_links_map2)  &
+           call resize_remap_vars(2,resize_increment)
+
+        grid1_add_map2(num_links_map2) = add1
+        grid2_add_map2(num_links_map2) = add2
+        wts_map2    (:,num_links_map2) = weights(num_wts+1:2*num_wts)
+      endif
+
+      if (link_add1(1,add1) == 0) link_add1(1,add1) = num_links_map1
+      if (link_add2(1,add2) == 0) link_add2(1,add2) = num_links_map1
+      link_add1(2,add1) = num_links_map1
+      link_add2(2,add2) = num_links_map1
+
+!-----------------------------------------------------------------------
+
+      end subroutine store_link_cnsrv
+
+!***********************************************************************
+
+      end module remap_conservative
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/src/remap_distwgt.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/src/remap_distwgt.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/src/remap_distwgt.f90	(revision 2528)
@@ -0,0 +1,498 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this module contains necessary routines for performing an 
+!     interpolation using a distance-weighted average of n nearest
+!     neighbors.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_distwgt.f,v 1.3 2000/04/19 21:56:26 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_distance_weight
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod     ! defines common data types
+      use constants     ! defines common constants
+      use grids         ! module containing grid info
+      use remap_vars    ! module containing remap info
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     module variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), parameter ::  &
+           num_neighbors=4  ! num nearest neighbors to interpolate from
+
+      real (kind=dbl_kind), dimension(:), allocatable, save :: &
+           coslat, sinlat,  & ! cosine, sine of grid lats (for distance)
+           coslon, sinlon,  & ! cosine, sine of grid lons (for distance)
+           wgtstmp         ! an array to hold the link weight
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine remap_distwgt
+
+!-----------------------------------------------------------------------
+!
+!     this routine computes the inverse-distance weights for a
+!     nearest-neighbor interpolation.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      logical (kind=log_kind), dimension(num_neighbors) :: &
+           nbr_mask        ! mask at nearest neighbors
+
+      integer (kind=int_kind) :: n, &
+           dst_add,         & ! destination address
+           nmap            ! index of current map being computed
+
+      integer (kind=int_kind), dimension(num_neighbors) :: &
+           nbr_add         ! source address at nearest neighbors
+
+      real (kind=dbl_kind), dimension(num_neighbors) :: &
+           nbr_dist        ! angular distance four nearest neighbors
+
+      real (kind=dbl_kind) :: &
+           coslat_dst,      & ! cos(lat) of destination grid point
+           coslon_dst,      & ! cos(lon) of destination grid point
+           sinlat_dst,      & ! sin(lat) of destination grid point
+           sinlon_dst,      & ! sin(lon) of destination grid point
+           dist_tot        ! sum of neighbor distances (for normalizing)
+
+!-----------------------------------------------------------------------
+!
+!     compute mappings from grid1 to grid2
+!
+!-----------------------------------------------------------------------
+
+      nmap = 1
+
+      !***
+      !*** allocate wgtstmp to be consistent with store_link interface
+      !***
+
+      allocate (wgtstmp(num_wts))
+
+      !***
+      !*** compute cos, sin of lat/lon on source grid for distance
+      !*** calculations
+      !***
+
+      allocate (coslat(grid1_size), coslon(grid1_size), &
+                sinlat(grid1_size), sinlon(grid1_size))
+
+      coslat = cos(grid1_center_lat)
+      coslon = cos(grid1_center_lon)
+      sinlat = sin(grid1_center_lat)
+      sinlon = sin(grid1_center_lon)
+
+      !***
+      !*** loop over destination grid 
+      !***
+
+      grid_loop1: do dst_add = 1, grid2_size
+
+        if (.not. grid2_mask(dst_add)) cycle grid_loop1
+
+        coslat_dst = cos(grid2_center_lat(dst_add))
+        coslon_dst = cos(grid2_center_lon(dst_add))
+        sinlat_dst = sin(grid2_center_lat(dst_add))
+        sinlon_dst = sin(grid2_center_lon(dst_add))
+
+        !***
+        !*** find nearest grid points on source grid and
+        !*** distances to each point
+        !***
+
+        call grid_search_nbr(nbr_add, nbr_dist,  &
+                             grid2_center_lat(dst_add), &
+                             grid2_center_lon(dst_add), &
+                             coslat_dst, coslon_dst,  &
+                             sinlat_dst, sinlon_dst, &
+                             bin_addr1, bin_addr2)
+
+        !***
+        !*** compute weights based on inverse distance
+        !*** if mask is false, eliminate those points
+        !***
+
+        dist_tot = zero
+        do n=1,num_neighbors
+          if (grid1_mask(nbr_add(n))) then
+            nbr_dist(n) = one/nbr_dist(n)
+            dist_tot = dist_tot + nbr_dist(n)
+            nbr_mask(n) = .true.
+          else
+            nbr_mask(n) = .false.
+          endif
+        end do
+
+        !***
+        !*** normalize weights and store the link
+        !***
+
+        do n=1,num_neighbors
+          if (nbr_mask(n)) then
+            wgtstmp(1) = nbr_dist(n)/dist_tot
+            call store_link_nbr(nbr_add(n), dst_add, wgtstmp, nmap)
+            grid2_frac(dst_add) = one
+          endif
+        end do
+
+      end do grid_loop1
+
+      deallocate (coslat, coslon, sinlat, sinlon)
+
+!-----------------------------------------------------------------------
+!
+!     compute mappings from grid2 to grid1 if necessary
+!
+!-----------------------------------------------------------------------
+
+      if (num_maps > 1) then
+
+      nmap = 2
+
+      !***
+      !*** compute cos, sin of lat/lon on source grid for distance
+      !*** calculations
+      !***
+
+      allocate (coslat(grid2_size), coslon(grid2_size), &
+                sinlat(grid2_size), sinlon(grid2_size))
+
+      coslat = cos(grid2_center_lat)
+      coslon = cos(grid2_center_lon)
+      sinlat = sin(grid2_center_lat)
+      sinlon = sin(grid2_center_lon)
+
+      !***
+      !*** loop over destination grid 
+      !***
+
+      grid_loop2: do dst_add = 1, grid1_size
+
+        if (.not. grid1_mask(dst_add)) cycle grid_loop2
+
+        coslat_dst = cos(grid1_center_lat(dst_add))
+        coslon_dst = cos(grid1_center_lon(dst_add))
+        sinlat_dst = sin(grid1_center_lat(dst_add))
+        sinlon_dst = sin(grid1_center_lon(dst_add))
+
+        !***
+        !*** find four nearest grid points on source grid and
+        !*** distances to each point
+        !***
+
+        call grid_search_nbr(nbr_add, nbr_dist, &
+                             grid1_center_lat(dst_add), &
+                             grid1_center_lon(dst_add), &
+                             coslat_dst, coslon_dst,  &
+                             sinlat_dst, sinlon_dst, &
+                             bin_addr2, bin_addr1)
+
+        !***
+        !*** compute weights based on inverse distance
+        !*** if mask is false, eliminate those points
+        !***
+
+        dist_tot = zero
+        do n=1,num_neighbors
+          if (grid2_mask(nbr_add(n))) then
+            nbr_dist(n) = one/nbr_dist(n)
+            dist_tot = dist_tot + nbr_dist(n)
+            nbr_mask(n) = .true.
+          else
+            nbr_mask(n) = .false.
+          endif
+        end do
+
+        !***
+        !*** normalize weights and store the link
+        !***
+
+        do n=1,num_neighbors
+          if (nbr_mask(n)) then
+            wgtstmp(1) = nbr_dist(n)/dist_tot
+            call store_link_nbr(dst_add, nbr_add(n), wgtstmp, nmap)
+            grid1_frac(dst_add) = one
+          endif
+        end do
+
+      end do grid_loop2
+
+      deallocate (coslat, coslon, sinlat, sinlon)
+
+      endif
+
+      deallocate(wgtstmp)
+
+!-----------------------------------------------------------------------
+
+      end subroutine remap_distwgt
+
+!***********************************************************************
+
+      subroutine grid_search_nbr(nbr_add, nbr_dist, plat, plon,  &
+                     coslat_dst, coslon_dst, sinlat_dst, sinlon_dst, &
+                     src_bin_add, dst_bin_add)
+
+!-----------------------------------------------------------------------
+!
+!     this routine finds the closest num_neighbor points to a search 
+!     point and computes a distance to each of the neighbors.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     output variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(num_neighbors), intent(out) :: &
+              nbr_add  ! address of each of the closest points
+
+      real (kind=dbl_kind), dimension(num_neighbors), intent(out) :: &
+              nbr_dist ! distance to each of the closest points
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), dimension(:,:), intent(in) :: &
+              src_bin_add,  & ! search bins for restricting search
+              dst_bin_add   
+
+      real (kind=dbl_kind), intent(in) :: &
+              plat,          & ! latitude  of the search point
+              plon,          & ! longitude of the search point
+              coslat_dst,    & ! cos(lat)  of the search point
+              coslon_dst,    & ! cos(lon)  of the search point
+              sinlat_dst,    & ! sin(lat)  of the search point
+              sinlon_dst    ! sin(lon)  of the search point
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n, nmax, nadd, nchk,  & ! dummy indices
+              min_add, max_add, nm1, np1, i, j, ip1, im1, jp1, jm1
+
+      real (kind=dbl_kind) :: &
+              distance      ! angular distance
+
+!-----------------------------------------------------------------------
+!
+!     loop over source grid and find nearest neighbors
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** restrict the search using search bins
+      !*** expand the bins to catch neighbors
+      !***
+
+      select case (restrict_type)
+      case('latitude')
+
+        do n=1,num_srch_bins
+          if (plat >= bin_lats(1,n) .and. plat <= bin_lats(2,n)) then
+            min_add = src_bin_add(1,n)
+            max_add = src_bin_add(2,n)
+
+            nm1 = max(n-1,1)
+            np1 = min(n+1,num_srch_bins)
+
+            min_add = min(min_add,src_bin_add(1,nm1))
+            max_add = max(max_add,src_bin_add(2,nm1))
+            min_add = min(min_add,src_bin_add(1,np1))
+            max_add = max(max_add,src_bin_add(2,np1))
+          endif
+        end do
+
+      case('latlon')
+
+        n = 0
+        nmax = nint(sqrt(real(num_srch_bins)))
+        do j=1,nmax
+        jp1 = min(j+1,nmax)
+        jm1 = max(j-1,1)
+        do i=1,nmax
+          ip1 = min(i+1,nmax)
+          im1 = max(i-1,1)
+
+          n = n+1
+          if (plat >= bin_lats(1,n) .and. plat <= bin_lats(2,n) .and. &
+              plon >= bin_lons(1,n) .and. plon <= bin_lons(3,n)) then
+            min_add = src_bin_add(1,n)
+            max_add = src_bin_add(2,n)
+
+            nm1 = (jm1-1)*nmax + im1
+            np1 = (jp1-1)*nmax + ip1
+            nm1 = max(nm1,1)
+            np1 = min(np1,num_srch_bins)
+
+            min_add = min(min_add,src_bin_add(1,nm1))
+            max_add = max(max_add,src_bin_add(2,nm1))
+            min_add = min(min_add,src_bin_add(1,np1))
+            max_add = max(max_add,src_bin_add(2,np1))
+          endif
+        end do
+        end do
+
+      end select
+
+      !***
+      !*** initialize distance and address arrays
+      !***
+
+      nbr_add = 0
+      nbr_dist = bignum
+
+      do nadd=min_add,max_add
+
+        !***
+        !*** find distance to this point
+        !***
+
+        distance = acos(sinlat_dst*sinlat(nadd) + &
+                        coslat_dst*coslat(nadd)* &
+                       (coslon_dst*coslon(nadd) + &
+                        sinlon_dst*sinlon(nadd)) )
+
+        !***
+        !*** store the address and distance if this is one of the
+        !*** smallest four so far
+        !***
+
+        check_loop: do nchk=1,num_neighbors
+          if (distance .lt. nbr_dist(nchk)) then
+            do n=num_neighbors,nchk+1,-1
+              nbr_add(n) = nbr_add(n-1)
+              nbr_dist(n) = nbr_dist(n-1)
+            end do
+            nbr_add(nchk) = nadd
+            nbr_dist(nchk) = distance
+            exit check_loop
+          endif
+        end do check_loop
+
+      end do
+
+!-----------------------------------------------------------------------
+
+      end subroutine grid_search_nbr 
+
+!***********************************************************************
+
+      subroutine store_link_nbr(add1, add2, weights, nmap)
+
+!-----------------------------------------------------------------------
+!
+!     this routine stores the address and weight for this link in
+!     the appropriate address and weight arrays and resizes those
+!     arrays if necessary.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) :: &
+              add1,   & ! address on grid1
+              add2,   & ! address on grid2
+              nmap   ! identifies which direction for mapping
+
+      real (kind=dbl_kind), dimension(:), intent(in) :: &
+              weights ! array of remapping weights for this link
+
+!-----------------------------------------------------------------------
+!
+!     increment number of links and check to see if remap arrays need
+!     to be increased to accomodate the new link.  then store the
+!     link.
+!
+!-----------------------------------------------------------------------
+
+      select case (nmap)
+      case(1)
+
+        num_links_map1  = num_links_map1 + 1
+
+        if (num_links_map1 > max_links_map1)  &
+           call resize_remap_vars(1,resize_increment)
+
+        grid1_add_map1(num_links_map1) = add1
+        grid2_add_map1(num_links_map1) = add2
+        wts_map1    (:,num_links_map1) = weights
+
+      case(2)
+
+        num_links_map2  = num_links_map2 + 1
+
+        if (num_links_map2 > max_links_map2)  &
+           call resize_remap_vars(2,resize_increment)
+
+        grid1_add_map2(num_links_map2) = add1
+        grid2_add_map2(num_links_map2) = add2
+        wts_map2    (:,num_links_map2) = weights
+
+      end select
+
+!-----------------------------------------------------------------------
+
+      end subroutine store_link_nbr
+
+!***********************************************************************
+
+      end module remap_distance_weight
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/src/remap_read.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/src/remap_read.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/src/remap_read.f90	(revision 2528)
@@ -0,0 +1,1027 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This routine reads remapping information from files written
+!     by remap_setup.  If remapping in both directions are required,
+!     two input files must be specified.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_read.f,v 1.6 2000/04/19 21:56:26 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_read
+
+!-----------------------------------------------------------------------
+!
+!     contains routines for reading a remap file
+!
+!-----------------------------------------------------------------------
+
+      use kinds_mod     ! defines common data types
+      use constants     ! defines useful constants
+      use grids         ! includes all grid information
+      use netcdf_mod    ! module with netcdf vars and utilities
+      use remap_vars    ! module for all required remapping variables
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     module variables
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+!     various netCDF ids for files variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), private ::  & ! netCDF ids
+               ncstat, nc_file_id, &
+               nc_srcgrdsize_id, nc_dstgrdsize_id, &
+               nc_srcgrdcorn_id, nc_dstgrdcorn_id, &
+               nc_srcgrdrank_id, nc_dstgrdrank_id, &
+               nc_srcgrddims_id, nc_dstgrddims_id, &
+               nc_numlinks_id, nc_numwgts_id,  &
+               nc_srcgrdimask_id, nc_dstgrdimask_id, &
+               nc_srcgrdcntrlat_id, nc_srcgrdcntrlon_id, &
+               nc_srcgrdcrnrlat_id, nc_srcgrdcrnrlon_id, &
+               nc_srcgrdarea_id, nc_srcgrdfrac_id, &
+               nc_dstgrdcntrlat_id, nc_dstgrdcntrlon_id, &
+               nc_dstgrdcrnrlat_id, nc_dstgrdcrnrlon_id, &
+               nc_dstgrdarea_id, nc_dstgrdfrac_id, &
+               nc_srcgrdadd_id, nc_dstgrdadd_id, nc_rmpmatrix_id
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine read_remap(map_name, interp_file)
+
+!-----------------------------------------------------------------------
+!
+!     this driver routine reads some global attributes and then
+!     calls a specific read routine based on file conventions
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len), intent(in) :: &
+        interp_file        ! filename for remap data
+
+!-----------------------------------------------------------------------
+!
+!     output variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len), intent(out) :: &
+        map_name            ! name for mapping
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len) ::  &
+         map_method        & ! character string for map_type
+      ,  normalize_opt     & ! character string for normalization option
+      ,  convention       ! character string for output convention
+
+!-----------------------------------------------------------------------
+!
+!     open file and read some global information
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_open(interp_file, NF_NOWRITE, nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** map name
+      !***
+      map_name = ' '
+      ncstat = nf_get_att_text(nc_file_id, NF_GLOBAL, 'title', &
+                               map_name)
+      call netcdf_error_handler(ncstat)
+
+      print *,'Reading remapping:',trim(map_name)
+      print *,'From file:',trim(interp_file)
+
+      !***
+      !*** normalization option
+      !***
+      normalize_opt = ' '
+      ncstat = nf_get_att_text(nc_file_id, NF_GLOBAL, 'normalization', &
+                               normalize_opt)
+      call netcdf_error_handler(ncstat)
+
+      select case(normalize_opt)
+      case ('none')
+        norm_opt = norm_opt_none
+      case ('fracarea')
+        norm_opt = norm_opt_frcarea
+      case ('destarea')
+        norm_opt = norm_opt_dstarea
+      case default
+        print *,'normalize_opt = ',normalize_opt
+        stop 'Invalid normalization option'
+      end select
+
+      !***
+      !*** map method
+      !***
+      map_method = ' '
+      ncstat = nf_get_att_text (nc_file_id, NF_GLOBAL, 'map_method', &
+                                map_method)
+      call netcdf_error_handler(ncstat)
+
+      select case(map_method)
+      case('Conservative remapping')
+        map_type = map_type_conserv
+      case('Bilinear remapping')
+        map_type = map_type_bilinear
+      case('Distance weighted avg of nearest neighbors')
+        map_type = map_type_distwgt
+      case('Bicubic remapping')
+        map_type = map_type_bicubic
+      case default
+        print *,'map_type = ',map_method
+        stop 'Invalid Map Type'
+      end select
+
+      !***
+      !*** file convention
+      !***
+      convention = ' '
+      ncstat = nf_get_att_text (nc_file_id, NF_GLOBAL, 'conventions', &
+                                convention)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     call appropriate read routine based on output convention
+!
+!-----------------------------------------------------------------------
+
+      select case(convention)
+      case ('SCRIP')
+        call read_remap_scrip
+      case ('NCAR-CSM')
+        call read_remap_csm
+      case default
+        print *,'convention = ',convention
+        stop 'unknown output file convention'
+      end select
+
+!-----------------------------------------------------------------------
+
+      end subroutine read_remap
+
+!***********************************************************************
+
+      subroutine read_remap_scrip
+
+!-----------------------------------------------------------------------
+!
+!     the routine reads a netCDF file to extract remapping info
+!     in SCRIP format
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      character (char_len) :: &
+        grid1_name            & ! grid name for source grid
+      , grid2_name           ! grid name for dest   grid
+
+      integer (kind=int_kind) ::   &
+        n                    ! dummy index
+
+      integer (kind=int_kind), dimension(:), allocatable :: &
+        grid1_mask_int,       & ! integer masks to determine
+        grid2_mask_int       ! cells that participate in map
+
+!-----------------------------------------------------------------------
+!
+!     read some additional global attributes
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** source and destination grid names
+      !***
+
+      grid1_name = ' '
+      grid2_name = ' '
+      ncstat = nf_get_att_text (nc_file_id, NF_GLOBAL, 'source_grid', &
+                                grid1_name)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_att_text (nc_file_id, NF_GLOBAL, 'dest_grid', &
+                                grid2_name)
+      call netcdf_error_handler(ncstat)
+
+      print *,' '
+      print *,'Remapping between:',trim(grid1_name)
+      print *,'and ',trim(grid2_name)
+      print *,' '
+
+!-----------------------------------------------------------------------
+!
+!     read dimension information
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_inq_dimid(nc_file_id, 'src_grid_size',  &
+                            nc_srcgrdsize_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_srcgrdsize_id, grid1_size)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'dst_grid_size',  &
+                            nc_dstgrdsize_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_dstgrdsize_id, grid2_size)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'src_grid_corners',  &
+                            nc_srcgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_srcgrdcorn_id,  &
+                             grid1_corners)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'dst_grid_corners',  &
+                            nc_dstgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_dstgrdcorn_id,  &
+                             grid2_corners)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'src_grid_rank',  &
+                            nc_srcgrdrank_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_srcgrdrank_id,  &
+                             grid1_rank)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'dst_grid_rank',  &
+                            nc_dstgrdrank_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_dstgrdrank_id,  &
+                             grid2_rank)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'num_links',  &
+                            nc_numlinks_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_numlinks_id,  &
+                             num_links_map1)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'num_wgts',  &
+                            nc_numwgts_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_numwgts_id, num_wts)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     allocate arrays
+!
+!-----------------------------------------------------------------------
+
+      allocate( grid1_dims      (grid1_rank), &
+                grid1_center_lat(grid1_size),  &
+                grid1_center_lon(grid1_size), &
+                grid1_area      (grid1_size), &
+                grid1_frac      (grid1_size), &
+                grid1_mask      (grid1_size), &
+                grid1_mask_int  (grid1_size), &
+                grid1_corner_lat(grid1_corners, grid1_size), &
+                grid1_corner_lon(grid1_corners, grid1_size) )
+
+      allocate( grid2_dims      (grid2_rank), &
+                grid2_center_lat(grid2_size),  &
+                grid2_center_lon(grid2_size), &
+                grid2_area      (grid2_size), &
+                grid2_frac      (grid2_size), &
+                grid2_mask      (grid2_size), &
+                grid2_mask_int  (grid2_size), &
+                grid2_corner_lat(grid2_corners, grid2_size), &
+                grid2_corner_lon(grid2_corners, grid2_size) )
+
+      allocate( grid1_add_map1(num_links_map1), &
+                grid2_add_map1(num_links_map1), &
+                wts_map1(num_wts,num_links_map1) )
+
+!-----------------------------------------------------------------------
+!
+!     get variable ids
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_dims',  &
+                            nc_srcgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_imask',  &
+                            nc_srcgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_center_lat',  &
+                                         nc_srcgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_center_lon',  &
+                                         nc_srcgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_corner_lat',  &
+                                         nc_srcgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_corner_lon',  &
+                                         nc_srcgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_area',  &
+                                         nc_srcgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_frac',  &
+                                         nc_srcgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_dims',  &
+                            nc_dstgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_imask',  &
+                            nc_dstgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_center_lat',  &
+                                         nc_dstgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_center_lon',  &
+                                         nc_dstgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_corner_lat',  &
+                                         nc_dstgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_corner_lon',  &
+                                         nc_dstgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_area',  &
+                                         nc_dstgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_frac',  &
+                                         nc_dstgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_address',  &
+                                         nc_srcgrdadd_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_address',  &
+                                         nc_dstgrdadd_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'remap_matrix',  &
+                                         nc_rmpmatrix_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     read all variables
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_get_var_int(nc_file_id, nc_srcgrddims_id,  &
+                              grid1_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_srcgrdimask_id,  &
+                              grid1_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcntrlat_id,  &
+                                             grid1_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcntrlon_id,  &
+                                             grid1_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      grid1_units = ' '
+      ncstat = nf_get_att_text(nc_file_id, nc_srcgrdcntrlat_id, 'units', &
+                               grid1_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid1_units(1:7))
+      case ('degrees')
+        grid1_center_lat = grid1_center_lat*deg2rad
+        grid1_center_lon = grid1_center_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid1 center lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcrnrlat_id,  &
+                                             grid1_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcrnrlon_id,  &
+                                             grid1_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      grid1_units = ' '
+      ncstat = nf_get_att_text(nc_file_id, nc_srcgrdcrnrlat_id, 'units', &
+                               grid1_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid1_units(1:7))
+      case ('degrees')
+        grid1_corner_lat = grid1_corner_lat*deg2rad
+        grid1_corner_lon = grid1_corner_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid1 corner lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdarea_id,  &
+                                             grid1_area)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdfrac_id,  &
+                                             grid1_frac)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_dstgrddims_id,  &
+                              grid2_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_dstgrdimask_id,  &
+                              grid2_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcntrlat_id,  &
+                                             grid2_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcntrlon_id,  &
+                                             grid2_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      grid2_units = ' '
+      ncstat = nf_get_att_text(nc_file_id, nc_dstgrdcntrlat_id, 'units', &
+                               grid2_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid2_units(1:7))
+      case ('degrees')
+        grid2_center_lat = grid2_center_lat*deg2rad
+        grid2_center_lon = grid2_center_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid2 center lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcrnrlat_id,  &
+                                             grid2_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcrnrlon_id,  &
+                                             grid2_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      grid2_units = ' '
+      ncstat = nf_get_att_text(nc_file_id, nc_dstgrdcrnrlat_id, 'units', &
+                               grid2_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid2_units(1:7))
+      case ('degrees')
+        grid2_corner_lat = grid2_corner_lat*deg2rad
+        grid2_corner_lon = grid2_corner_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid2 corner lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdarea_id,  &
+                                             grid2_area)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdfrac_id,  &
+                                             grid2_frac)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_srcgrdadd_id,  &
+                              grid1_add_map1)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_dstgrdadd_id,  &
+                              grid2_add_map1)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_rmpmatrix_id,  &
+                                             wts_map1)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     initialize logical mask 
+!
+!-----------------------------------------------------------------------
+
+      where (grid1_mask_int == 1)
+        grid1_mask = .true.
+      elsewhere
+        grid1_mask = .false.
+      endwhere
+      where (grid2_mask_int == 1)
+        grid2_mask = .true.
+      elsewhere
+        grid2_mask = .false.
+      endwhere
+      deallocate(grid1_mask_int, grid2_mask_int)
+
+!-----------------------------------------------------------------------
+!
+!     close input file
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_close(nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+
+      end subroutine read_remap_scrip
+
+!***********************************************************************
+
+      subroutine read_remap_csm
+
+!-----------------------------------------------------------------------
+!
+!     the routine reads a netCDF file to extract remapping info
+!     in NCAR-CSM format
+!
+!-----------------------------------------------------------------------
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      character (char_len) :: &
+        grid1_name            & ! grid name for source grid
+      , grid2_name           ! grid name for dest   grid
+
+      integer (kind=int_kind) :: &
+        nc_numwgts1_id     & ! extra netCDF id for num_wgts > 1 
+      , nc_rmpmatrix2_id  ! extra netCDF id for high-order remap matrix
+
+      real (kind=dbl_kind), dimension(:),allocatable :: &
+        wts1              ! CSM wants single array for 1st-order wts
+
+      real (kind=dbl_kind), dimension(:,:),allocatable :: &
+        wts2              ! write remaining weights in different array
+
+      integer (kind=int_kind) ::   &
+        n                    ! dummy index
+
+      integer (kind=int_kind), dimension(:), allocatable :: &
+        grid1_mask_int,       & ! integer masks to determine
+        grid2_mask_int       ! cells that participate in map
+
+!-----------------------------------------------------------------------
+!
+!     read some additional global attributes
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** source and destination grid names
+      !***
+
+      grid1_name = ' '
+      grid2_name = ' '
+      ncstat = nf_get_att_text (nc_file_id, NF_GLOBAL, 'domain_a', &
+                                grid1_name)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_att_text (nc_file_id, NF_GLOBAL, 'domain_b', &
+                                grid2_name)
+      call netcdf_error_handler(ncstat)
+
+      print *,' '
+      print *,'Remapping between:',trim(grid1_name)
+      print *,'and ',trim(grid2_name)
+      print *,' '
+
+!-----------------------------------------------------------------------
+!
+!     read dimension information
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_inq_dimid(nc_file_id, 'n_a', nc_srcgrdsize_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_srcgrdsize_id, grid1_size)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'n_b', nc_dstgrdsize_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_dstgrdsize_id, grid2_size)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'nv_a', nc_srcgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_srcgrdcorn_id,  &
+                             grid1_corners)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'nv_b', nc_dstgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_dstgrdcorn_id,  &
+                             grid2_corners)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'src_grid_rank',  &
+                            nc_srcgrdrank_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_srcgrdrank_id,  &
+                             grid1_rank)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'dst_grid_rank',  &
+                            nc_dstgrdrank_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_dstgrdrank_id,  &
+                             grid2_rank)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'n_s',  &
+                            nc_numlinks_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_numlinks_id,  &
+                             num_links_map1)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_dimid(nc_file_id, 'num_wgts',  &
+                            nc_numwgts_id)
+      call netcdf_error_handler(ncstat)
+      ncstat = nf_inq_dimlen(nc_file_id, nc_numwgts_id, num_wts)
+      call netcdf_error_handler(ncstat)
+
+      if (num_wts > 1) then
+        ncstat = nf_inq_dimid(nc_file_id, 'num_wgts1',  &
+                              nc_numwgts1_id)
+        call netcdf_error_handler(ncstat)
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     allocate arrays
+!
+!-----------------------------------------------------------------------
+
+      allocate( grid1_dims      (grid1_rank), &
+                grid1_center_lat(grid1_size),  &
+                grid1_center_lon(grid1_size), &
+                grid1_area      (grid1_size), &
+                grid1_frac      (grid1_size), &
+                grid1_mask      (grid1_size), &
+                grid1_mask_int  (grid1_size), &
+                grid1_corner_lat(grid1_corners, grid1_size), &
+                grid1_corner_lon(grid1_corners, grid1_size) )
+
+      allocate( grid2_dims      (grid2_rank), &
+                grid2_center_lat(grid2_size),  &
+                grid2_center_lon(grid2_size), &
+                grid2_area      (grid2_size), &
+                grid2_frac      (grid2_size), &
+                grid2_mask      (grid2_size), &
+                grid2_mask_int  (grid2_size), &
+                grid2_corner_lat(grid2_corners, grid2_size), &
+                grid2_corner_lon(grid2_corners, grid2_size) )
+
+      allocate( grid1_add_map1(num_links_map1), &
+                grid2_add_map1(num_links_map1), &
+                wts_map1(num_wts,num_links_map1), &
+                wts1(num_links_map1), &
+                wts2(num_wts-1,num_links_map1) )
+
+!-----------------------------------------------------------------------
+!
+!     get variable ids
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_inq_varid(nc_file_id, 'src_grid_dims',  &
+                            nc_srcgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'mask_a',  &
+                            nc_srcgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'yc_a', nc_srcgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'xc_a', nc_srcgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'yv_a', nc_srcgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'xv_a', nc_srcgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'area_a', nc_srcgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'frac_a', nc_srcgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'dst_grid_dims',  &
+                            nc_dstgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'mask_b',  &
+                            nc_dstgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'yc_b', nc_dstgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'xc_b', nc_dstgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'yv_b', nc_dstgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'xv_b', nc_dstgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'area_b', nc_dstgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'frac_b', nc_dstgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'col', nc_srcgrdadd_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'row', nc_dstgrdadd_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_inq_varid(nc_file_id, 'S', nc_rmpmatrix_id)
+      call netcdf_error_handler(ncstat)
+
+      if (num_wts > 1) then
+        ncstat = nf_inq_varid(nc_file_id, 'S2', nc_rmpmatrix2_id)
+        call netcdf_error_handler(ncstat)
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     read all variables
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_get_var_int(nc_file_id, nc_srcgrddims_id,  &
+                              grid1_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_srcgrdimask_id,  &
+                              grid1_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcntrlat_id,  &
+                                             grid1_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcntrlon_id,  &
+                                             grid1_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_att_text(nc_file_id, nc_srcgrdcntrlat_id, 'units', &
+                               grid1_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid1_units(1:7))
+      case ('degrees')
+        grid1_center_lat = grid1_center_lat*deg2rad
+        grid1_center_lon = grid1_center_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid1 center lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcrnrlat_id,  &
+                                             grid1_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdcrnrlon_id,  &
+                                             grid1_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_att_text(nc_file_id, nc_srcgrdcrnrlat_id, 'units', &
+                               grid1_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid1_units(1:7))
+      case ('degrees')
+        grid1_corner_lat = grid1_corner_lat*deg2rad
+        grid1_corner_lon = grid1_corner_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid1 corner lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdarea_id,  &
+                                             grid1_area)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_srcgrdfrac_id,  &
+                                             grid1_frac)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_dstgrddims_id,  &
+                              grid2_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_dstgrdimask_id,  &
+                              grid2_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcntrlat_id,  &
+                                             grid2_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcntrlon_id,  &
+                                             grid2_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_att_text(nc_file_id, nc_dstgrdcntrlat_id, 'units', &
+                               grid2_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid2_units(1:7))
+      case ('degrees')
+        grid2_center_lat = grid2_center_lat*deg2rad
+        grid2_center_lon = grid2_center_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid2 center lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcrnrlat_id,  &
+                                             grid2_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdcrnrlon_id,  &
+                                             grid2_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+
+      ncstat = nf_get_att_text(nc_file_id, nc_dstgrdcrnrlat_id, 'units', &
+                               grid2_units)
+      call netcdf_error_handler(ncstat)
+
+      select case (grid2_units(1:7))
+      case ('degrees')
+        grid2_corner_lat = grid2_corner_lat*deg2rad
+        grid2_corner_lon = grid2_corner_lon*deg2rad
+      case ('radians')
+        !*** no conversion necessary
+      case default
+        print *,'unknown units supplied for grid2 corner lat/lon: '
+        print *,'proceeding assuming radians'
+      end select
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdarea_id,  &
+                                             grid2_area)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_dstgrdfrac_id,  &
+                                             grid2_frac)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_srcgrdadd_id,  &
+                              grid1_add_map1)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_int(nc_file_id, nc_dstgrdadd_id,  &
+                              grid2_add_map1)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_get_var_double(nc_file_id, nc_rmpmatrix_id,  &
+                                             wts1)
+      wts_map1(1,:) = wts1
+      deallocate(wts1)
+
+      if (num_wts > 1) then
+        ncstat = nf_get_var_double(nc_file_id, nc_rmpmatrix2_id,  &
+                                               wts2)
+        wts_map1(2:,:) = wts2
+        deallocate(wts2)
+      endif
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     initialize logical mask 
+!
+!-----------------------------------------------------------------------
+
+      where (grid1_mask_int == 1)
+        grid1_mask = .true.
+      elsewhere
+        grid1_mask = .false.
+      endwhere
+      where (grid2_mask_int == 1)
+        grid2_mask = .true.
+      elsewhere
+        grid2_mask = .false.
+      endwhere
+      deallocate(grid1_mask_int, grid2_mask_int)
+
+!-----------------------------------------------------------------------
+!
+!     close input file
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_close(nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+
+      end subroutine read_remap_csm
+
+!***********************************************************************
+
+      end module remap_read
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/src/remap_vars.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/src/remap_vars.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/src/remap_vars.f90	(revision 2528)
@@ -0,0 +1,302 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     this module contains necessary variables for remapping between
+!     two grids.  also routines for resizing and initializing these
+!     variables.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_vars.f,v 1.5 2000/04/19 21:56:26 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_vars
+
+      use kinds_mod
+      use constants
+      use grids
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     module variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), parameter :: &
+            norm_opt_none    = 1 &
+      ,     norm_opt_dstarea = 2 &
+      ,     norm_opt_frcarea = 3
+
+      integer (kind=int_kind), parameter :: &
+            map_type_conserv  = 1 &
+      ,     map_type_bilinear = 2 &
+      ,     map_type_bicubic  = 3 &
+      ,     map_type_distwgt  = 4
+
+      integer (kind=int_kind), save ::  &
+            max_links_map1   & ! current size of link arrays
+      ,     num_links_map1   & ! actual number of links for remapping
+      ,     max_links_map2   & ! current size of link arrays
+      ,     num_links_map2   & ! actual number of links for remapping
+      ,     num_maps         & ! num of remappings for this grid pair
+      ,     num_wts          & ! num of weights used in remapping
+      ,     map_type         & ! identifier for remapping method
+      ,     norm_opt         & ! option for normalization (conserv only)
+      ,     resize_increment ! default amount to increase array size
+
+      integer (kind=int_kind), dimension(:), allocatable, save :: &
+            grid1_add_map1,  & ! grid1 address for each link in mapping 1
+            grid2_add_map1,  & ! grid2 address for each link in mapping 1
+            grid1_add_map2,  & ! grid1 address for each link in mapping 2
+            grid2_add_map2  ! grid2 address for each link in mapping 2
+
+      real (kind=dbl_kind), dimension(:,:), allocatable, save :: &
+            wts_map1,  & ! map weights for each link (num_wts,max_links)
+            wts_map2  ! map weights for each link (num_wts,max_links)
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine init_remap_vars
+
+!-----------------------------------------------------------------------
+!
+!     this routine initializes some variables and provides an initial
+!     allocation of arrays (fairly large so frequent resizing 
+!     unnecessary).
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     determine the number of weights
+!
+!-----------------------------------------------------------------------
+
+      select case (map_type)
+      case(map_type_conserv)
+        num_wts = 3
+      case(map_type_bilinear)
+        num_wts = 1
+      case(map_type_bicubic)
+        num_wts = 4
+      case(map_type_distwgt)
+        num_wts = 1
+      end select
+
+!-----------------------------------------------------------------------
+!
+!     initialize num_links and set max_links to four times the largest 
+!     of the destination grid sizes initially (can be changed later).
+!     set a default resize increment to increase the size of link
+!     arrays if the number of links exceeds the initial size
+!   
+!-----------------------------------------------------------------------
+
+      num_links_map1 = 0
+      max_links_map1 = 4*grid2_size
+      if (num_maps > 1) then
+        num_links_map2 = 0
+        max_links_map1 = max(4*grid1_size,4*grid2_size)
+        max_links_map2 = max_links_map1
+      endif
+
+      resize_increment = 0.1*max(grid1_size,grid2_size)
+
+!-----------------------------------------------------------------------
+!
+!     allocate address and weight arrays for mapping 1
+!   
+!-----------------------------------------------------------------------
+
+      allocate (grid1_add_map1(max_links_map1), &
+                grid2_add_map1(max_links_map1), &
+                wts_map1(num_wts, max_links_map1))
+
+!-----------------------------------------------------------------------
+!
+!     allocate address and weight arrays for mapping 2 if necessary 
+!   
+!-----------------------------------------------------------------------
+
+      if (num_maps > 1) then
+        allocate (grid1_add_map2(max_links_map2), &
+                  grid2_add_map2(max_links_map2), &
+                  wts_map2(num_wts, max_links_map2))
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine init_remap_vars
+
+!***********************************************************************
+
+      subroutine resize_remap_vars(nmap, increment)
+
+!-----------------------------------------------------------------------
+!
+!     this routine resizes remapping arrays by increasing(decreasing)
+!     the max_links by increment
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) :: &
+           nmap,       & ! identifies which mapping array to resize
+           increment  ! the number of links to add(subtract) to arrays
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: &
+         ierr,      & ! error flag
+         mxlinks   ! size of link arrays
+
+      integer (kind=int_kind), dimension(:), allocatable :: &
+         add1_tmp,  & ! temp array for resizing address arrays
+         add2_tmp  ! temp array for resizing address arrays
+
+      real (kind=dbl_kind), dimension(:,:), allocatable :: &
+         wts_tmp   ! temp array for resizing weight arrays
+
+!-----------------------------------------------------------------------
+!
+!     resize map 1 arrays if required.
+!
+!-----------------------------------------------------------------------
+
+      select case (nmap)
+      case(1)
+
+        !***
+        !*** allocate temporaries to hold original values
+        !***
+
+        mxlinks = size(grid1_add_map1)
+        allocate (add1_tmp(mxlinks), add2_tmp(mxlinks),  &
+                  wts_tmp(num_wts,mxlinks))
+
+        add1_tmp = grid1_add_map1
+        add2_tmp = grid2_add_map1
+        wts_tmp  = wts_map1
+        
+        !***
+        !*** deallocate originals and increment max_links then
+        !*** reallocate arrays at new size
+        !***
+
+        deallocate (grid1_add_map1, grid2_add_map1, wts_map1)
+        max_links_map1 = mxlinks + increment
+        allocate (grid1_add_map1(max_links_map1), &
+                  grid2_add_map1(max_links_map1), &
+                  wts_map1(num_wts,max_links_map1))
+
+        !***
+        !*** restore original values from temp arrays and
+        !*** deallocate temps
+        !***
+
+        mxlinks = min(mxlinks, max_links_map1)
+        grid1_add_map1(1:mxlinks) = add1_tmp (1:mxlinks)
+        grid2_add_map1(1:mxlinks) = add2_tmp (1:mxlinks)
+        wts_map1    (:,1:mxlinks) = wts_tmp(:,1:mxlinks)
+        deallocate(add1_tmp, add2_tmp, wts_tmp)
+
+!-----------------------------------------------------------------------
+!
+!     resize map 2 arrays if required.
+!
+!-----------------------------------------------------------------------
+
+      case(2)
+
+        !***
+        !*** allocate temporaries to hold original values
+        !***
+
+        mxlinks = size(grid1_add_map2)
+        allocate (add1_tmp(mxlinks), add2_tmp(mxlinks),  &
+                  wts_tmp(num_wts,mxlinks),stat=ierr)
+        if (ierr .ne. 0) then
+          print *,'error allocating temps in resize: ',ierr
+          stop
+        endif
+
+        add1_tmp = grid1_add_map2
+        add2_tmp = grid2_add_map2
+        wts_tmp  = wts_map2
+        
+        !***
+        !*** deallocate originals and increment max_links then
+        !*** reallocate arrays at new size
+        !***
+
+        deallocate (grid1_add_map2, grid2_add_map2, wts_map2)
+        max_links_map2 = mxlinks + increment
+        allocate (grid1_add_map2(max_links_map2), &
+                  grid2_add_map2(max_links_map2), &
+                  wts_map2(num_wts,max_links_map2),stat=ierr)
+        if (ierr .ne. 0) then
+          print *,'error allocating new arrays in resize: ',ierr
+          stop
+        endif
+
+
+        !***
+        !*** restore original values from temp arrays and
+        !*** deallocate temps
+        !***
+
+        mxlinks = min(mxlinks, max_links_map2)
+        grid1_add_map2(1:mxlinks) = add1_tmp (1:mxlinks)
+        grid2_add_map2(1:mxlinks) = add2_tmp (1:mxlinks)
+        wts_map2    (:,1:mxlinks) = wts_tmp(:,1:mxlinks)
+        deallocate(add1_tmp, add2_tmp, wts_tmp)
+
+      end select
+
+!-----------------------------------------------------------------------
+
+      end subroutine resize_remap_vars
+
+!***********************************************************************
+
+      end module remap_vars
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/src/remap_write.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/src/remap_write.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/src/remap_write.f90	(revision 2528)
@@ -0,0 +1,1763 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module contains routines for writing the remapping data to 
+!     a file.  Before writing the data for each mapping, the links are 
+!     sorted by destination grid address.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: remap_write.f,v 1.7 2001/08/21 21:06:42 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module remap_write
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod     ! defines common data types
+      use constants     ! defines common scalar constants
+      use grids         ! module containing grid information
+      use remap_vars    ! module containing remap information
+      use netcdf_mod    ! module with netCDF stuff
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     module variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len), private ::  &
+         map_method        & ! character string for map_type
+      ,  normalize_opt     & ! character string for normalization option
+      ,  history           & ! character string for history information
+      ,  convention       ! character string for output convention
+
+      character(8), private ::  &
+         cdate            ! character date string
+
+      integer (kind=int_kind), dimension(:), allocatable, private :: &
+         src_mask_int      & ! integer masks to determine
+      ,  dst_mask_int     ! cells that participate in map
+
+!-----------------------------------------------------------------------
+!
+!     various netCDF identifiers used by output routines
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), private :: &
+         ncstat                & ! error flag for netCDF calls 
+      ,  nc_file_id            & ! id for netCDF file
+      ,  nc_srcgrdsize_id      & ! id for source grid size
+      ,  nc_dstgrdsize_id      & ! id for destination grid size
+      ,  nc_srcgrdcorn_id      & ! id for number of source grid corners
+      ,  nc_dstgrdcorn_id      & ! id for number of dest grid corners
+      ,  nc_srcgrdrank_id      & ! id for source grid rank
+      ,  nc_dstgrdrank_id      & ! id for dest grid rank
+      ,  nc_numlinks_id        & ! id for number of links in mapping
+      ,  nc_numwgts_id         & ! id for number of weights for mapping
+      ,  nc_srcgrddims_id      & ! id for source grid dimensions
+      ,  nc_dstgrddims_id      & ! id for dest grid dimensions
+      ,  nc_srcgrdcntrlat_id   & ! id for source grid center latitude
+      ,  nc_dstgrdcntrlat_id   & ! id for dest grid center latitude
+      ,  nc_srcgrdcntrlon_id   & ! id for source grid center longitude
+      ,  nc_dstgrdcntrlon_id   & ! id for dest grid center longitude
+      ,  nc_srcgrdimask_id     & ! id for source grid mask
+      ,  nc_dstgrdimask_id     & ! id for dest grid mask
+      ,  nc_srcgrdcrnrlat_id   & ! id for latitude of source grid corners
+      ,  nc_srcgrdcrnrlon_id   & ! id for longitude of source grid corners
+      ,  nc_dstgrdcrnrlat_id   & ! id for latitude of dest grid corners
+      ,  nc_dstgrdcrnrlon_id   & ! id for longitude of dest grid corners
+      ,  nc_srcgrdarea_id      & ! id for area of source grid cells
+      ,  nc_dstgrdarea_id      & ! id for area of dest grid cells
+      ,  nc_srcgrdfrac_id      & ! id for area fraction on source grid
+      ,  nc_dstgrdfrac_id      & ! id for area fraction on dest grid
+      ,  nc_srcadd_id          & ! id for map source address
+      ,  nc_dstadd_id          & ! id for map destination address
+      ,  nc_rmpmatrix_id      ! id for remapping matrix
+
+      integer (kind=int_kind), dimension(2), private :: &
+         nc_dims2_id  ! netCDF ids for 2d array dims
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine write_remap(map1_name, map2_name,  &
+                             interp_file1, interp_file2, output_opt)
+
+!-----------------------------------------------------------------------
+!
+!     calls correct output routine based on output format choice
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len), intent(in) :: &
+                  map1_name,     & ! name for mapping grid1 to grid2
+                  map2_name,     & ! name for mapping grid2 to grid1
+                  interp_file1,  & ! filename for map1 remap data
+                  interp_file2,  & ! filename for map2 remap data
+                  output_opt    ! option for output conventions
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     define some common variables to be used in all routines
+!
+!-----------------------------------------------------------------------
+
+      select case(norm_opt)
+      case (norm_opt_none)
+        normalize_opt = 'none'
+      case (norm_opt_frcarea)
+        normalize_opt = 'fracarea'
+      case (norm_opt_dstarea)
+        normalize_opt = 'destarea'
+      end select
+
+      select case(map_type)
+      case(map_type_conserv)
+        map_method = 'Conservative remapping'
+      case(map_type_bilinear)
+        map_method = 'Bilinear remapping'
+      case(map_type_distwgt)
+        map_method = 'Distance weighted avg of nearest neighbors'
+      case(map_type_bicubic)
+        map_method = 'Bicubic remapping'
+      case default
+        stop 'Invalid Map Type'
+      end select
+
+      call date_and_time(date=cdate)
+      write (history,1000) cdate(5:6),cdate(7:8),cdate(1:4)
+ 1000 format('Created: ',a2,'-',a2,'-',a4)
+
+!-----------------------------------------------------------------------
+!
+!     sort address and weight arrays
+!
+!-----------------------------------------------------------------------
+
+      call sort_add(grid2_add_map1, grid1_add_map1, wts_map1)
+      if (num_maps > 1) then
+        call sort_add(grid1_add_map2, grid2_add_map2, wts_map2)
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     call appropriate output routine
+!
+!-----------------------------------------------------------------------
+
+      select case(output_opt)
+      case ('scrip')
+        call write_remap_scrip(map1_name, interp_file1, 1)
+      case ('ncar-csm')
+        call write_remap_csm  (map1_name, interp_file1, 1)
+      case default
+        stop 'unknown output file convention'
+      end select
+
+!-----------------------------------------------------------------------
+!
+!     call appropriate output routine for second mapping if required
+!
+!-----------------------------------------------------------------------
+
+      if (num_maps > 1) then
+        select case(output_opt)
+        case ('scrip')
+          call write_remap_scrip(map2_name, interp_file2, 2)
+        case ('ncar-csm')
+          call write_remap_csm  (map2_name, interp_file2, 2)
+        case default
+          stop 'unknown output file convention'
+        end select
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine write_remap
+
+!***********************************************************************
+
+      subroutine write_remap_scrip(map_name, interp_file, direction)
+
+!-----------------------------------------------------------------------
+!
+!     writes remap data to a netCDF file using SCRIP conventions
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len), intent(in) :: &
+                  map_name      & ! name for mapping 
+      ,           interp_file  ! filename for remap data
+
+      integer (kind=int_kind), intent(in) :: &
+        direction              ! direction of map (1=grid1 to grid2
+                               !                   2=grid2 to grid1)
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len) :: &
+        grid1_ctmp         & ! character temp for grid1 names
+      , grid2_ctmp        ! character temp for grid2 names
+
+      integer (kind=int_kind) :: &
+        itmp1              & ! integer temp
+      , itmp2              & ! integer temp
+      , itmp3              & ! integer temp
+      , itmp4             ! integer temp
+
+!-----------------------------------------------------------------------
+!
+!     create netCDF file for mapping and define some global attributes
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_create (interp_file, NF_CLOBBER, nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** map name
+      !***
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'title', &
+                                len_trim(map_name), map_name)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** normalization option
+      !***
+      ncstat = nf_put_att_text(nc_file_id, NF_GLOBAL, 'normalization', &
+                               len_trim(normalize_opt), normalize_opt)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** map method
+      !***
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'map_method', &
+                                len_trim(map_method), map_method)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** history
+      !***
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'history', &
+                                len_trim(history), history)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** file convention
+      !***
+      convention = 'SCRIP'
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'conventions', &
+                                len_trim(convention), convention)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** source and destination grid names
+      !***
+
+      if (direction == 1) then
+        grid1_ctmp = 'source_grid'
+        grid2_ctmp = 'dest_grid'
+      else
+        grid1_ctmp = 'dest_grid'
+        grid2_ctmp = 'source_grid'
+      endif
+
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, trim(grid1_ctmp), &
+                                len_trim(grid1_name), grid1_name)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, trim(grid2_ctmp), &
+                                len_trim(grid2_name), grid2_name)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     prepare netCDF dimension info
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** define grid size dimensions
+      !***
+
+      if (direction == 1) then
+        itmp1 = grid1_size
+        itmp2 = grid2_size
+      else
+        itmp1 = grid2_size
+        itmp2 = grid1_size
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'src_grid_size', itmp1,  &
+                           nc_srcgrdsize_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'dst_grid_size', itmp2,  &
+                           nc_dstgrdsize_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner dimension
+      !***
+
+      if (direction == 1) then
+        itmp1 = grid1_corners
+        itmp2 = grid2_corners
+      else
+        itmp1 = grid2_corners
+        itmp2 = grid1_corners
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'src_grid_corners',  &
+                           itmp1, nc_srcgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'dst_grid_corners',  &
+                           itmp2, nc_dstgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid rank dimension
+      !***
+
+      if (direction == 1) then
+        itmp1 = grid1_rank
+        itmp2 = grid2_rank
+      else
+        itmp1 = grid2_rank
+        itmp2 = grid1_rank
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'src_grid_rank',  &
+                           itmp1, nc_srcgrdrank_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'dst_grid_rank',  &
+                           itmp2, nc_dstgrdrank_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define map size dimensions
+      !***
+
+      if (direction == 1) then
+        itmp1 = num_links_map1
+      else
+        itmp1 = num_links_map2
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'num_links',  &
+                           itmp1, nc_numlinks_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'num_wgts',  &
+                           num_wts, nc_numwgts_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid dimensions
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_dims', NF_INT, &
+                           1, nc_srcgrdrank_id, nc_srcgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_dims', NF_INT, &
+                           1, nc_dstgrdrank_id, nc_dstgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     define all arrays for netCDF descriptors
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** define grid center latitude array
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_center_lat',  &
+                           NF_DOUBLE, 1, nc_srcgrdsize_id,  &
+                           nc_srcgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_center_lat',  &
+                           NF_DOUBLE, 1, nc_dstgrdsize_id,  &
+                           nc_dstgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid center longitude array
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_center_lon',  &
+                           NF_DOUBLE, 1, nc_srcgrdsize_id,  &
+                           nc_srcgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_center_lon',  &
+                           NF_DOUBLE, 1, nc_dstgrdsize_id,  &
+                           nc_dstgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner lat/lon arrays
+      !***
+
+      nc_dims2_id(1) = nc_srcgrdcorn_id
+      nc_dims2_id(2) = nc_srcgrdsize_id
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_corner_lat',  &
+                           NF_DOUBLE, 2, nc_dims2_id,  &
+                           nc_srcgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_corner_lon',  &
+                           NF_DOUBLE, 2, nc_dims2_id,  &
+                           nc_srcgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      nc_dims2_id(1) = nc_dstgrdcorn_id
+      nc_dims2_id(2) = nc_dstgrdsize_id
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_corner_lat',  &
+                           NF_DOUBLE, 2, nc_dims2_id,  &
+                           nc_dstgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_corner_lon',  &
+                           NF_DOUBLE, 2, nc_dims2_id,  &
+                           nc_dstgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define units for all coordinate arrays
+      !***
+
+      if (direction == 1) then
+        grid1_ctmp = grid1_units
+        grid2_ctmp = grid2_units
+      else
+        grid1_ctmp = grid2_units
+        grid2_ctmp = grid1_units
+      endif
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcntrlat_id,  &
+                                'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcntrlat_id,  &
+                                'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcntrlon_id,  &
+                                'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcntrlon_id,  &
+                                'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcrnrlat_id,  &
+                                'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcrnrlon_id,  &
+                                'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcrnrlat_id,  &
+                                'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcrnrlon_id,  &
+                                'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid mask
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_imask', NF_INT, &
+                           1, nc_srcgrdsize_id, nc_srcgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdimask_id,  &
+                                'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_imask', NF_INT, &
+                           1, nc_dstgrdsize_id, nc_dstgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdimask_id,  &
+                                'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid area arrays
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_area',  &
+                           NF_DOUBLE, 1, nc_srcgrdsize_id,  &
+                           nc_srcgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdarea_id,  &
+                                'units', 14, 'square radians')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_area',  &
+                           NF_DOUBLE, 1, nc_dstgrdsize_id,  &
+                           nc_dstgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdarea_id,  &
+                                'units', 14, 'square radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid fraction arrays
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_frac',  &
+                           NF_DOUBLE, 1, nc_srcgrdsize_id,  &
+                           nc_srcgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdfrac_id,  &
+                                'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_frac',  &
+                           NF_DOUBLE, 1, nc_dstgrdsize_id,  &
+                           nc_dstgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdfrac_id,  &
+                                'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define mapping arrays
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_address',  &
+                           NF_INT, 1, nc_numlinks_id,  &
+                           nc_srcadd_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_address',  &
+                           NF_INT, 1, nc_numlinks_id,  &
+                           nc_dstadd_id)
+      call netcdf_error_handler(ncstat)
+
+      nc_dims2_id(1) = nc_numwgts_id
+      nc_dims2_id(2) = nc_numlinks_id
+
+      ncstat = nf_def_var (nc_file_id, 'remap_matrix',  &
+                           NF_DOUBLE, 2, nc_dims2_id,  &
+                           nc_rmpmatrix_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** end definition stage
+      !***
+
+      ncstat = nf_enddef(nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     compute integer masks
+!
+!-----------------------------------------------------------------------
+
+      if (direction == 1) then
+        allocate (src_mask_int(grid1_size), &
+                  dst_mask_int(grid2_size))
+
+        where (grid2_mask)
+          dst_mask_int = 1
+        elsewhere
+          dst_mask_int = 0
+        endwhere
+
+        where (grid1_mask)
+          src_mask_int = 1
+        elsewhere
+          src_mask_int = 0
+        endwhere
+      else
+        allocate (src_mask_int(grid2_size), &
+                  dst_mask_int(grid1_size))
+
+        where (grid1_mask)
+          dst_mask_int = 1
+        elsewhere
+          dst_mask_int = 0
+        endwhere
+
+        where (grid2_mask)
+          src_mask_int = 1
+        elsewhere
+          src_mask_int = 0
+        endwhere
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     change units of lat/lon coordinates if input units different
+!     from radians
+!
+!-----------------------------------------------------------------------
+
+      if (grid1_units(1:7) == 'degrees' .and. direction == 1) then
+        grid1_center_lat = grid1_center_lat/deg2rad
+        grid1_center_lon = grid1_center_lon/deg2rad
+        grid1_corner_lat = grid1_corner_lat/deg2rad
+        grid1_corner_lon = grid1_corner_lon/deg2rad
+      endif
+
+      if (grid2_units(1:7) == 'degrees' .and. direction == 1) then
+        grid2_center_lat = grid2_center_lat/deg2rad
+        grid2_center_lon = grid2_center_lon/deg2rad
+        grid2_corner_lat = grid2_corner_lat/deg2rad
+        grid2_corner_lon = grid2_corner_lon/deg2rad
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     write mapping data
+!
+!-----------------------------------------------------------------------
+
+      if (direction == 1) then
+        itmp1 = nc_srcgrddims_id
+        itmp2 = nc_dstgrddims_id
+      else
+        itmp2 = nc_srcgrddims_id
+        itmp1 = nc_dstgrddims_id
+      endif
+
+      ncstat = nf_put_var_int(nc_file_id, itmp1, grid1_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_file_id, itmp2, grid2_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_file_id, nc_srcgrdimask_id,  &
+                              src_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_file_id, nc_dstgrdimask_id, &
+                              dst_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      deallocate(src_mask_int, dst_mask_int)
+
+      if (direction == 1) then
+        itmp1 = nc_srcgrdcntrlat_id
+        itmp2 = nc_srcgrdcntrlon_id
+        itmp3 = nc_srcgrdcrnrlat_id
+        itmp4 = nc_srcgrdcrnrlon_id
+      else
+        itmp1 = nc_dstgrdcntrlat_id
+        itmp2 = nc_dstgrdcntrlon_id
+        itmp3 = nc_dstgrdcrnrlat_id
+        itmp4 = nc_dstgrdcrnrlon_id
+      endif
+
+      ncstat = nf_put_var_double(nc_file_id, itmp1, grid1_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp2, grid1_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp3, grid1_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp4, grid1_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      if (direction == 1) then
+        itmp1 = nc_dstgrdcntrlat_id
+        itmp2 = nc_dstgrdcntrlon_id
+        itmp3 = nc_dstgrdcrnrlat_id
+        itmp4 = nc_dstgrdcrnrlon_id
+      else
+        itmp1 = nc_srcgrdcntrlat_id
+        itmp2 = nc_srcgrdcntrlon_id
+        itmp3 = nc_srcgrdcrnrlat_id
+        itmp4 = nc_srcgrdcrnrlon_id
+      endif
+
+      ncstat = nf_put_var_double(nc_file_id, itmp1, grid2_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp2, grid2_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp3, grid2_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp4, grid2_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      if (direction == 1) then
+        itmp1 = nc_srcgrdarea_id
+        itmp2 = nc_srcgrdfrac_id
+        itmp3 = nc_dstgrdarea_id
+        itmp4 = nc_dstgrdfrac_id
+      else
+        itmp1 = nc_dstgrdarea_id
+        itmp2 = nc_dstgrdfrac_id
+        itmp3 = nc_srcgrdarea_id
+        itmp4 = nc_srcgrdfrac_id
+      endif
+
+      if (luse_grid1_area) then
+        ncstat = nf_put_var_double(nc_file_id, itmp1, grid1_area_in)
+      else
+        ncstat = nf_put_var_double(nc_file_id, itmp1, grid1_area)
+      endif
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp2, grid1_frac)
+      call netcdf_error_handler(ncstat)
+
+      if (luse_grid2_area) then
+        ncstat = nf_put_var_double(nc_file_id, itmp3, grid2_area_in)
+      else
+        ncstat = nf_put_var_double(nc_file_id, itmp3, grid2_area)
+      endif
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp4, grid2_frac)
+      call netcdf_error_handler(ncstat)
+
+      if (direction == 1) then
+        ncstat = nf_put_var_int(nc_file_id, nc_srcadd_id,  &
+                                grid1_add_map1)
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_int(nc_file_id, nc_dstadd_id,  &
+                                grid2_add_map1)
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id,  &
+                                   wts_map1)
+        call netcdf_error_handler(ncstat)
+      else
+        ncstat = nf_put_var_int(nc_file_id, nc_srcadd_id,  &
+                                grid2_add_map2)
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_int(nc_file_id, nc_dstadd_id,  &
+                                grid1_add_map2)
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id,  &
+                                   wts_map2)
+        call netcdf_error_handler(ncstat)
+      endif
+
+      ncstat = nf_close(nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+
+      end subroutine write_remap_scrip
+
+!***********************************************************************
+
+      subroutine write_remap_csm(map_name, interp_file, direction)
+
+!-----------------------------------------------------------------------
+!
+!     writes remap data to a netCDF file using NCAR-CSM conventions
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     input variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len), intent(in) :: &
+                  map_name      & ! name for mapping 
+      ,           interp_file  ! filename for remap data
+
+      integer (kind=int_kind), intent(in) :: &
+        direction              ! direction of map (1=grid1 to grid2
+                               !                   2=grid2 to grid1)
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      character(char_len) :: &
+        grid1_ctmp         & ! character temp for grid1 names
+      , grid2_ctmp        ! character temp for grid2 names
+
+      integer (kind=int_kind) :: &
+        itmp1              & ! integer temp
+      , itmp2              & ! integer temp
+      , itmp3              & ! integer temp
+      , itmp4              & ! integer temp
+      , nc_numwgts1_id     & ! extra netCDF id for additional weights
+      , nc_src_isize_id    & ! extra netCDF id for ni_a
+      , nc_src_jsize_id    & ! extra netCDF id for nj_a
+      , nc_dst_isize_id    & ! extra netCDF id for ni_b
+      , nc_dst_jsize_id    & ! extra netCDF id for nj_b
+      , nc_rmpmatrix2_id  ! extra netCDF id for high-order remap matrix
+
+      real (kind=dbl_kind), dimension(:),allocatable :: &
+        wts1              ! CSM wants single array for 1st-order wts
+
+      real (kind=dbl_kind), dimension(:,:),allocatable :: &
+        wts2              ! write remaining weights in different array
+
+!-----------------------------------------------------------------------
+!
+!     create netCDF file for mapping and define some global attributes
+!
+!-----------------------------------------------------------------------
+
+      ncstat = nf_create (interp_file, NF_CLOBBER, nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** map name
+      !***
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'title', &
+                                len_trim(map_name), map_name)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** normalization option
+      !***
+      ncstat = nf_put_att_text(nc_file_id, NF_GLOBAL, 'normalization', &
+                               len_trim(normalize_opt), normalize_opt)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** map method
+      !***
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'map_method', &
+                                len_trim(map_method), map_method)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** history
+      !***
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'history', &
+                                len_trim(history), history)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** file convention
+      !***
+      convention = 'NCAR-CSM'
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, 'conventions', &
+                                len_trim(convention), convention)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** source and destination grid names
+      !***
+
+      if (direction == 1) then
+        grid1_ctmp = 'domain_a'
+        grid2_ctmp = 'domain_b'
+      else
+        grid1_ctmp = 'domain_b'
+        grid2_ctmp = 'domain_a'
+      endif
+
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, trim(grid1_ctmp), &
+                                len_trim(grid1_name), grid1_name)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, NF_GLOBAL, trim(grid2_ctmp), &
+                                len_trim(grid2_name), grid2_name)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     prepare netCDF dimension info
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** define grid size dimensions
+      !***
+
+      if (direction == 1) then
+        itmp1 = grid1_size
+        itmp2 = grid2_size
+      else
+        itmp1 = grid2_size
+        itmp2 = grid1_size
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'n_a', itmp1, nc_srcgrdsize_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'n_b', itmp2, nc_dstgrdsize_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner dimension
+      !***
+
+      if (direction == 1) then
+        itmp1 = grid1_corners
+        itmp2 = grid2_corners
+      else
+        itmp1 = grid2_corners
+        itmp2 = grid1_corners
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'nv_a', itmp1, nc_srcgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'nv_b', itmp2, nc_dstgrdcorn_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid rank dimension
+      !***
+
+      if (direction == 1) then
+        itmp1 = grid1_rank
+        itmp2 = grid2_rank
+      else
+        itmp1 = grid2_rank
+        itmp2 = grid1_rank
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'src_grid_rank',  &
+                           itmp1, nc_srcgrdrank_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'dst_grid_rank',  &
+                           itmp2, nc_dstgrdrank_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define first two dims as if 2-d cartesian domain
+      !***
+
+      if (direction == 1) then
+        itmp1 = grid1_dims(1)
+        if (grid1_rank > 1) then
+          itmp2 = grid1_dims(2)
+        else
+          itmp2 = 0
+        endif
+        itmp3 = grid2_dims(1)
+        if (grid2_rank > 1) then
+          itmp4 = grid2_dims(2)
+        else
+          itmp4 = 0
+        endif
+      else
+        itmp1 = grid2_dims(1)
+        if (grid2_rank > 1) then
+          itmp2 = grid2_dims(2)
+        else
+          itmp2 = 0
+        endif
+        itmp3 = grid1_dims(1)
+        if (grid1_rank > 1) then
+          itmp4 = grid1_dims(2)
+        else
+          itmp4 = 0
+        endif
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'ni_a', itmp1, nc_src_isize_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'nj_a', itmp2, nc_src_jsize_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'ni_b', itmp3, nc_dst_isize_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'nj_b', itmp4, nc_dst_jsize_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define map size dimensions
+      !***
+
+      if (direction == 1) then
+        itmp1 = num_links_map1
+      else
+        itmp1 = num_links_map2
+      endif
+
+      ncstat = nf_def_dim (nc_file_id, 'n_s', itmp1, nc_numlinks_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_dim (nc_file_id, 'num_wgts',  &
+                           num_wts, nc_numwgts_id)
+      call netcdf_error_handler(ncstat)
+
+      if (num_wts > 1) then
+        ncstat = nf_def_dim (nc_file_id, 'num_wgts1',  &
+                             num_wts-1, nc_numwgts1_id)
+        call netcdf_error_handler(ncstat)
+      endif
+
+      !***
+      !*** define grid dimensions
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'src_grid_dims', NF_INT, &
+                           1, nc_srcgrdrank_id, nc_srcgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'dst_grid_dims', NF_INT, &
+                           1, nc_dstgrdrank_id, nc_dstgrddims_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     define all arrays for netCDF descriptors
+!
+!-----------------------------------------------------------------------
+
+      !***
+      !*** define grid center latitude array
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'yc_a', &
+                           NF_DOUBLE, 1, nc_srcgrdsize_id,  &
+                           nc_srcgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'yc_b',  &
+                           NF_DOUBLE, 1, nc_dstgrdsize_id,  &
+                           nc_dstgrdcntrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid center longitude array
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'xc_a',  &
+                           NF_DOUBLE, 1, nc_srcgrdsize_id,  &
+                           nc_srcgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'xc_b',  &
+                           NF_DOUBLE, 1, nc_dstgrdsize_id,  &
+                           nc_dstgrdcntrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid corner lat/lon arrays
+      !***
+
+      nc_dims2_id(1) = nc_srcgrdcorn_id
+      nc_dims2_id(2) = nc_srcgrdsize_id
+
+      ncstat = nf_def_var (nc_file_id, 'yv_a',  &
+                           NF_DOUBLE, 2, nc_dims2_id,  &
+                           nc_srcgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'xv_a',  &
+                           NF_DOUBLE, 2, nc_dims2_id,  &
+                           nc_srcgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      nc_dims2_id(1) = nc_dstgrdcorn_id
+      nc_dims2_id(2) = nc_dstgrdsize_id
+
+      ncstat = nf_def_var (nc_file_id, 'yv_b',  &
+                           NF_DOUBLE, 2, nc_dims2_id,  &
+                           nc_dstgrdcrnrlat_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'xv_b',  &
+                           NF_DOUBLE, 2, nc_dims2_id,  &
+                           nc_dstgrdcrnrlon_id)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** CSM wants all in degrees
+      !***
+
+      grid1_units = 'degrees'
+      grid2_units = 'degrees'
+
+      if (direction == 1) then
+        grid1_ctmp = grid1_units
+        grid2_ctmp = grid2_units
+      else
+        grid1_ctmp = grid2_units
+        grid2_ctmp = grid1_units
+      endif
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcntrlat_id,  &
+                                'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcntrlat_id,  &
+                                'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcntrlon_id,  &
+                                'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcntrlon_id,  &
+                                'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcrnrlat_id,  &
+                                'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdcrnrlon_id,  &
+                                'units', 7, grid1_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcrnrlat_id,  &
+                                'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdcrnrlon_id,  &
+                                'units', 7, grid2_ctmp)
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid mask
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'mask_a', NF_INT, &
+                           1, nc_srcgrdsize_id, nc_srcgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdimask_id,  &
+                                'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'mask_b', NF_INT, &
+                           1, nc_dstgrdsize_id, nc_dstgrdimask_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdimask_id,  &
+                                'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid area arrays
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'area_a',  &
+                           NF_DOUBLE, 1, nc_srcgrdsize_id,  &
+                           nc_srcgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdarea_id,  &
+                                'units', 14, 'square radians')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'area_b',  &
+                           NF_DOUBLE, 1, nc_dstgrdsize_id,  &
+                           nc_dstgrdarea_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdarea_id,  &
+                                'units', 14, 'square radians')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define grid fraction arrays
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'frac_a',  &
+                           NF_DOUBLE, 1, nc_srcgrdsize_id,  &
+                           nc_srcgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_srcgrdfrac_id,  &
+                                'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'frac_b',  &
+                           NF_DOUBLE, 1, nc_dstgrdsize_id,  &
+                           nc_dstgrdfrac_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_att_text (nc_file_id, nc_dstgrdfrac_id,  &
+                                'units', 8, 'unitless')
+      call netcdf_error_handler(ncstat)
+
+      !***
+      !*** define mapping arrays
+      !***
+
+      ncstat = nf_def_var (nc_file_id, 'col',  &
+                           NF_INT, 1, nc_numlinks_id,  &
+                           nc_srcadd_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'row',  &
+                           NF_INT, 1, nc_numlinks_id,  &
+                           nc_dstadd_id)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_def_var (nc_file_id, 'S',  &
+                           NF_DOUBLE, 1, nc_numlinks_id,  &
+                           nc_rmpmatrix_id)
+      call netcdf_error_handler(ncstat)
+
+      if (num_wts > 1) then
+        nc_dims2_id(1) = nc_numwgts1_id
+        nc_dims2_id(2) = nc_numlinks_id
+
+        ncstat = nf_def_var (nc_file_id, 'S2',  &
+                           NF_DOUBLE, 2, nc_dims2_id,  &
+                           nc_rmpmatrix2_id)
+        call netcdf_error_handler(ncstat)
+      endif
+
+      !***
+      !*** end definition stage
+      !***
+
+      ncstat = nf_enddef(nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+!
+!     compute integer masks
+!
+!-----------------------------------------------------------------------
+
+      if (direction == 1) then
+        allocate (src_mask_int(grid1_size), &
+                  dst_mask_int(grid2_size))
+
+        where (grid2_mask)
+          dst_mask_int = 1
+        elsewhere
+          dst_mask_int = 0
+        endwhere
+
+        where (grid1_mask)
+          src_mask_int = 1
+        elsewhere
+          src_mask_int = 0
+        endwhere
+      else
+        allocate (src_mask_int(grid2_size), &
+                  dst_mask_int(grid1_size))
+
+        where (grid1_mask)
+          dst_mask_int = 1
+        elsewhere
+          dst_mask_int = 0
+        endwhere
+
+        where (grid2_mask)
+          src_mask_int = 1
+        elsewhere
+          src_mask_int = 0
+        endwhere
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     change units of lat/lon coordinates if input units different
+!     from radians. if this is the second mapping, the conversion has
+!     alread been done.
+!
+!-----------------------------------------------------------------------
+
+      if (grid1_units(1:7) == 'degrees' .and. direction == 1) then
+        grid1_center_lat = grid1_center_lat/deg2rad
+        grid1_center_lon = grid1_center_lon/deg2rad
+        grid1_corner_lat = grid1_corner_lat/deg2rad
+        grid1_corner_lon = grid1_corner_lon/deg2rad
+      endif
+
+      if (grid2_units(1:7) == 'degrees' .and. direction == 1) then
+        grid2_center_lat = grid2_center_lat/deg2rad
+        grid2_center_lon = grid2_center_lon/deg2rad
+        grid2_corner_lat = grid2_corner_lat/deg2rad
+        grid2_corner_lon = grid2_corner_lon/deg2rad
+      endif
+
+!-----------------------------------------------------------------------
+!
+!     write mapping data
+!
+!-----------------------------------------------------------------------
+
+      if (direction == 1) then
+        itmp1 = nc_srcgrddims_id
+        itmp2 = nc_dstgrddims_id
+      else
+        itmp2 = nc_srcgrddims_id
+        itmp1 = nc_dstgrddims_id
+      endif
+
+      ncstat = nf_put_var_int(nc_file_id, itmp1, grid1_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_file_id, itmp2, grid2_dims)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_file_id, nc_srcgrdimask_id,  &
+                              src_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_int(nc_file_id, nc_dstgrdimask_id, &
+                              dst_mask_int)
+      call netcdf_error_handler(ncstat)
+
+      deallocate(src_mask_int, dst_mask_int)
+
+      if (direction == 1) then
+        itmp1 = nc_srcgrdcntrlat_id
+        itmp2 = nc_srcgrdcntrlon_id
+        itmp3 = nc_srcgrdcrnrlat_id
+        itmp4 = nc_srcgrdcrnrlon_id
+      else
+        itmp1 = nc_dstgrdcntrlat_id
+        itmp2 = nc_dstgrdcntrlon_id
+        itmp3 = nc_dstgrdcrnrlat_id
+        itmp4 = nc_dstgrdcrnrlon_id
+      endif
+
+      ncstat = nf_put_var_double(nc_file_id, itmp1, grid1_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp2, grid1_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp3, grid1_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp4, grid1_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      if (direction == 1) then
+        itmp1 = nc_dstgrdcntrlat_id
+        itmp2 = nc_dstgrdcntrlon_id
+        itmp3 = nc_dstgrdcrnrlat_id
+        itmp4 = nc_dstgrdcrnrlon_id
+      else
+        itmp1 = nc_srcgrdcntrlat_id
+        itmp2 = nc_srcgrdcntrlon_id
+        itmp3 = nc_srcgrdcrnrlat_id
+        itmp4 = nc_srcgrdcrnrlon_id
+      endif
+
+      ncstat = nf_put_var_double(nc_file_id, itmp1, grid2_center_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp2, grid2_center_lon)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp3, grid2_corner_lat)
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp4, grid2_corner_lon)
+      call netcdf_error_handler(ncstat)
+
+      if (direction == 1) then
+        itmp1 = nc_srcgrdarea_id
+        itmp2 = nc_srcgrdfrac_id
+        itmp3 = nc_dstgrdarea_id
+        itmp4 = nc_dstgrdfrac_id
+      else
+        itmp1 = nc_dstgrdarea_id
+        itmp2 = nc_dstgrdfrac_id
+        itmp3 = nc_srcgrdarea_id
+        itmp4 = nc_srcgrdfrac_id
+      endif
+
+      if (luse_grid1_area) then
+        ncstat = nf_put_var_double(nc_file_id, itmp1, grid1_area_in)
+      else
+        ncstat = nf_put_var_double(nc_file_id, itmp1, grid1_area)
+      endif
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp2, grid1_frac)
+      call netcdf_error_handler(ncstat)
+
+      if (luse_grid2_area) then
+        ncstat = nf_put_var_double(nc_file_id, itmp3, grid2_area)
+      else
+        ncstat = nf_put_var_double(nc_file_id, itmp3, grid2_area)
+      endif
+      call netcdf_error_handler(ncstat)
+
+      ncstat = nf_put_var_double(nc_file_id, itmp4, grid2_frac)
+      call netcdf_error_handler(ncstat)
+
+      if (direction == 1) then
+        ncstat = nf_put_var_int(nc_file_id, nc_srcadd_id,  &
+                                grid1_add_map1)
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_int(nc_file_id, nc_dstadd_id,  &
+                                grid2_add_map1)
+        call netcdf_error_handler(ncstat)
+
+        if (num_wts == 1) then
+          ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id,  &
+                                     wts_map1)
+          call netcdf_error_handler(ncstat)
+        else
+          allocate(wts1(num_links_map1),wts2(num_wts-1,num_links_map1))
+
+          wts1 = wts_map1(1,:)
+          wts2 = wts_map1(2:,:)
+
+          ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id,  &
+                                     wts1)
+          call netcdf_error_handler(ncstat)
+          ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix2_id,  &
+                                     wts2)
+          call netcdf_error_handler(ncstat)
+          deallocate(wts1,wts2)
+        endif
+      else
+        ncstat = nf_put_var_int(nc_file_id, nc_srcadd_id,  &
+                                grid2_add_map2)
+        call netcdf_error_handler(ncstat)
+
+        ncstat = nf_put_var_int(nc_file_id, nc_dstadd_id,  &
+                                grid1_add_map2)
+        call netcdf_error_handler(ncstat)
+
+        if (num_wts == 1) then
+          ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id,  &
+                                     wts_map2)
+          call netcdf_error_handler(ncstat)
+        else
+          allocate(wts1(num_links_map2),wts2(num_wts-1,num_links_map2))
+
+          wts1 = wts_map2(1,:)
+          wts2 = wts_map2(2:,:)
+
+          ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix_id,  &
+                                     wts1)
+          call netcdf_error_handler(ncstat)
+          ncstat = nf_put_var_double(nc_file_id, nc_rmpmatrix2_id,  &
+                                     wts2)
+          call netcdf_error_handler(ncstat)
+          deallocate(wts1,wts2)
+        endif
+      endif
+
+      ncstat = nf_close(nc_file_id)
+      call netcdf_error_handler(ncstat)
+
+!-----------------------------------------------------------------------
+
+      end subroutine write_remap_csm
+
+!***********************************************************************
+
+      subroutine sort_add(add1, add2, weights)
+
+!-----------------------------------------------------------------------
+!
+!     this routine sorts address and weight arrays based on the
+!     destination address with the source address as a secondary
+!     sorting criterion.  the method is a standard heap sort.
+!
+!-----------------------------------------------------------------------
+
+      use kinds_mod     ! defines common data types
+      use constants     ! defines common scalar constants
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     Input and Output arrays
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(inout), dimension(:) :: &
+              add1,        & ! destination address array (num_links)
+              add2        ! source      address array
+
+      real (kind=dbl_kind), intent(inout), dimension(:,:) :: &
+              weights     ! remapping weights (num_wts, num_links)
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: &
+                num_links,           & ! num of links for this mapping
+                num_wts,             & ! num of weights for this mapping
+                add1_tmp, add2_tmp,  & ! temp for addresses during swap
+                nwgt, &
+                lvl, final_lvl,      & ! level indexes for heap sort levels
+                chk_lvl1, chk_lvl2, max_lvl
+
+      real (kind=dbl_kind), dimension(SIZE(weights,DIM=1)) :: &
+                wgttmp              ! temp for holding wts during swap
+
+!-----------------------------------------------------------------------
+!
+!     determine total number of links to sort and number of weights
+!
+!-----------------------------------------------------------------------
+
+      num_links = SIZE(add1)
+      num_wts   = SIZE(weights, DIM=1)
+
+!-----------------------------------------------------------------------
+!
+!     start at the lowest level (N/2) of the tree and sift lower 
+!     values to the bottom of the tree, promoting the larger numbers
+!
+!-----------------------------------------------------------------------
+
+      do lvl=num_links/2,1,-1
+
+        final_lvl = lvl
+        add1_tmp = add1(lvl)
+        add2_tmp = add2(lvl)
+        wgttmp(:) = weights(:,lvl)
+
+        !***
+        !*** loop until proper level is found for this link, or reach
+        !*** bottom
+        !***
+
+        sift_loop1: do
+
+          !***
+          !*** find the largest of the two daughters
+          !***
+
+          chk_lvl1 = 2*final_lvl
+          chk_lvl2 = 2*final_lvl+1
+          if (chk_lvl1 .EQ. num_links) chk_lvl2 = chk_lvl1
+
+          if ((add1(chk_lvl1) >  add1(chk_lvl2)) .OR. &
+             ((add1(chk_lvl1) == add1(chk_lvl2)) .AND. &
+              (add2(chk_lvl1) >  add2(chk_lvl2)))) then
+            max_lvl = chk_lvl1
+          else 
+            max_lvl = chk_lvl2
+          endif
+
+          !***
+          !*** if the parent is greater than both daughters,
+          !*** the correct level has been found
+          !***
+
+          if ((add1_tmp .GT. add1(max_lvl)) .OR. &
+             ((add1_tmp .EQ. add1(max_lvl)) .AND. &
+              (add2_tmp .GT. add2(max_lvl)))) then
+            add1(final_lvl) = add1_tmp
+            add2(final_lvl) = add2_tmp
+            weights(:,final_lvl) = wgttmp(:)
+            exit sift_loop1
+
+          !***
+          !*** otherwise, promote the largest daughter and push
+          !*** down one level in the tree.  if haven't reached
+          !*** the end of the tree, repeat the process.  otherwise
+          !*** store last values and exit the loop
+          !***
+
+          else 
+            add1(final_lvl) = add1(max_lvl)
+            add2(final_lvl) = add2(max_lvl)
+            weights(:,final_lvl) = weights(:,max_lvl)
+
+            final_lvl = max_lvl
+            if (2*final_lvl > num_links) then
+              add1(final_lvl) = add1_tmp
+              add2(final_lvl) = add2_tmp
+              weights(:,final_lvl) = wgttmp(:)
+              exit sift_loop1
+            endif
+          endif
+        end do sift_loop1
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     now that the heap has been sorted, strip off the top (largest)
+!     value and promote the values below
+!
+!-----------------------------------------------------------------------
+
+      do lvl=num_links,3,-1
+
+        !***
+        !*** move the top value and insert it into the correct place
+        !***
+
+        add1_tmp = add1(lvl)
+        add1(lvl) = add1(1)
+
+        add2_tmp = add2(lvl)
+        add2(lvl) = add2(1)
+
+        wgttmp(:) = weights(:,lvl)
+        weights(:,lvl) = weights(:,1)
+
+        !***
+        !*** as above this loop sifts the tmp values down until proper 
+        !*** level is reached
+        !***
+
+        final_lvl = 1
+
+        sift_loop2: do
+
+          !***
+          !*** find the largest of the two daughters
+          !***
+
+          chk_lvl1 = 2*final_lvl
+          chk_lvl2 = 2*final_lvl+1
+          if (chk_lvl2 >= lvl) chk_lvl2 = chk_lvl1
+
+          if ((add1(chk_lvl1) >  add1(chk_lvl2)) .OR. &
+             ((add1(chk_lvl1) == add1(chk_lvl2)) .AND. &
+              (add2(chk_lvl1) >  add2(chk_lvl2)))) then
+            max_lvl = chk_lvl1
+          else 
+            max_lvl = chk_lvl2
+          endif
+
+          !***
+          !*** if the parent is greater than both daughters,
+          !*** the correct level has been found
+          !***
+
+          if ((add1_tmp >  add1(max_lvl)) .OR. &
+             ((add1_tmp == add1(max_lvl)) .AND. &
+              (add2_tmp >  add2(max_lvl)))) then
+            add1(final_lvl) = add1_tmp
+            add2(final_lvl) = add2_tmp
+            weights(:,final_lvl) = wgttmp(:)
+            exit sift_loop2
+
+          !***
+          !*** otherwise, promote the largest daughter and push
+          !*** down one level in the tree.  if haven't reached
+          !*** the end of the tree, repeat the process.  otherwise
+          !*** store last values and exit the loop
+          !***
+
+          else 
+            add1(final_lvl) = add1(max_lvl)
+            add2(final_lvl) = add2(max_lvl)
+            weights(:,final_lvl) = weights(:,max_lvl)
+
+            final_lvl = max_lvl
+            if (2*final_lvl >= lvl) then
+              add1(final_lvl) = add1_tmp
+              add2(final_lvl) = add2_tmp
+              weights(:,final_lvl) = wgttmp(:)
+              exit sift_loop2
+            endif
+          endif
+        end do sift_loop2
+      end do
+
+      !***
+      !*** swap the last two entries
+      !***
+
+
+      add1_tmp = add1(2)
+      add1(2)  = add1(1)
+      add1(1)  = add1_tmp
+
+      add2_tmp = add2(2)
+      add2(2)  = add2(1)
+      add2(1)  = add2_tmp
+
+      wgttmp (:)   = weights(:,2)
+      weights(:,2) = weights(:,1)
+      weights(:,1) = wgttmp (:)
+
+!-----------------------------------------------------------------------
+
+      end subroutine sort_add
+
+!***********************************************************************
+
+      end module remap_write
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/src/scrip.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/src/scrip.F90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/src/scrip.F90	(revision 2528)
@@ -0,0 +1,232 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This routine is the driver for computing the addresses and weights 
+!     for interpolating between two grids on a sphere.
+!
+!     Modified slightly to get name of namelist file from command line - sga 2/12/05
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: scrip.f,v 1.6 2001/08/21 21:06:44 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      program scrip
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod                  ! module defining data types
+      use constants                  ! module for common constants
+      use iounits                    ! I/O unit manager
+      use timers                     ! CPU timers
+      use grids                      ! module with grid information
+      use remap_vars                 ! common remapping variables
+      use remap_conservative         ! routines for conservative remap
+      use remap_distance_weight      ! routines for dist-weight remap
+      use remap_bilinear             ! routines for bilinear interp
+      use remap_bicubic              ! routines for bicubic  interp
+      use remap_write                ! routines for remap output
+
+      implicit none
+
+!-----------------------------------------------------------------------
+!
+!     input namelist variables
+!
+!-----------------------------------------------------------------------
+
+      character (char_len) :: &
+         grid1_file,       &  ! filename of grid file containing grid1
+         grid2_file,       &  ! filename of grid file containing grid2
+         interp_file1,     &  ! filename for output remap data (map1)
+         interp_file2,     &  ! filename for output remap data (map2)
+         map1_name,        &  ! name for mapping from grid1 to grid2
+         map2_name,        &  ! name for mapping from grid2 to grid1
+         map_method,       &  ! choice for mapping method
+         normalize_opt,    &  ! option for normalizing weights
+         output_opt           ! option for output conventions
+
+      integer (kind=int_kind) :: &
+         nmap                 ! number of mappings to compute (1 or 2)
+
+      namelist /remap_inputs/ grid1_file, grid2_file,  &
+         interp_file1, interp_file2,                   &
+         map1_name, map2_name, num_maps,               &
+         luse_grid1_area, luse_grid2_area,             &
+         map_method, normalize_opt, output_opt,        &
+         restrict_type, num_srch_bins
+
+!-----------------------------------------------------------------------
+!
+!     local variables
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: n,   &  ! dummy counter
+                                 iunit   ! unit number for namelist file
+
+      character (char_len) :: nm_in
+#if defined ARGC
+      integer :: iargc
+      external iargc
+
+      if (iargc() == 1) then
+        call getarg(1, nm_in)
+      else
+        write(6,*) 'need name of namelist file'
+        stop
+      endif
+#else
+      write(6,*) 'enter name for namelist file'
+      read(5,*) nm_in
+#endif
+
+!-----------------------------------------------------------------------
+!
+!     initialize timers
+!
+!-----------------------------------------------------------------------
+
+      call timers_init
+      do n=1,max_timers
+        call timer_clear(n)
+      end do
+
+!-----------------------------------------------------------------------
+!
+!     read input namelist
+!
+!-----------------------------------------------------------------------
+
+      grid1_file    = 'unknown'
+      grid2_file    = 'unknown'
+      interp_file1  = 'unknown'
+      interp_file2  = 'unknown'
+      map1_name     = 'unknown'
+      map2_name     = 'unknown'
+      luse_grid1_area = .false.
+      luse_grid2_area = .false.
+      num_maps      = 2
+      map_type      = 1
+      normalize_opt = 'fracarea'
+      output_opt    = 'scrip'
+      restrict_type = 'latitude'
+      num_srch_bins = 900
+
+      call get_unit(iunit)
+      open(iunit, file=nm_in, status='old', form='formatted')
+      read(iunit, nml=remap_inputs)
+      call release_unit(iunit)
+
+      select case(map_method)
+      case ('conservative')
+        map_type = map_type_conserv
+        luse_grid_centers = .false.
+      case ('bilinear')
+        map_type = map_type_bilinear
+        luse_grid_centers = .true.
+      case ('bicubic')
+        map_type = map_type_bicubic
+        luse_grid_centers = .true.
+      case ('distwgt')
+        map_type = map_type_distwgt
+        luse_grid_centers = .true.
+      case default
+        stop 'unknown mapping method'
+      end select
+
+      select case(normalize_opt(1:4))
+      case ('none')
+        norm_opt = norm_opt_none
+      case ('frac')
+        norm_opt = norm_opt_frcarea
+      case ('dest')
+        norm_opt = norm_opt_dstarea
+      case default
+        stop 'unknown normalization option'
+      end select
+
+!-----------------------------------------------------------------------
+!
+!     initialize grid information for both grids
+!
+!-----------------------------------------------------------------------
+
+      call grid_init(grid1_file, grid2_file)
+
+      write(stdout, *) ' Computing remappings between: ',grid1_name
+      write(stdout, *) '                          and  ',grid2_name
+
+!-----------------------------------------------------------------------
+!
+!     initialize some remapping variables.
+!
+!-----------------------------------------------------------------------
+
+      call init_remap_vars
+
+!-----------------------------------------------------------------------
+!
+!     call appropriate interpolation setup routine based on type of
+!     remapping requested.
+!
+!-----------------------------------------------------------------------
+
+      select case(map_type)
+      case(map_type_conserv)
+        call remap_conserv
+      case(map_type_bilinear)
+        call remap_bilin
+      case(map_type_distwgt)
+        call remap_distwgt
+      case(map_type_bicubic)
+        call remap_bicub
+      case default
+        stop 'Invalid Map Type'
+      end select
+
+!-----------------------------------------------------------------------
+!
+!     reduce size of remapping arrays and then write remapping info
+!     to a file.
+!
+!-----------------------------------------------------------------------
+
+      if (num_links_map1 /= max_links_map1) then
+        call resize_remap_vars(1, num_links_map1-max_links_map1)
+      endif
+      if ((num_maps > 1) .and. (num_links_map2 /= max_links_map2)) then
+        call resize_remap_vars(2, num_links_map2-max_links_map2)
+      endif
+
+      call write_remap(map1_name, map2_name, &
+                       interp_file1, interp_file2, output_opt)
+
+!-----------------------------------------------------------------------
+
+      end program scrip
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/src/scripgrid.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/src/scripgrid.F90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/src/scripgrid.F90	(revision 2528)
@@ -0,0 +1,26 @@
+! ==============================================================================
+
+PROGRAM scripgrid
+
+  USE scripgrid_mod
+
+  CHARACTER(char_len) :: infile
+
+#if defined ARGC
+  INTEGER :: IARGC
+  EXTERNAL IARGC
+
+  if (IARGC() == 1) then
+    CALL GETARG(1, infile)
+    CALL convert( infile )
+  ELSE
+    write(6,*) 'need to supply a namelist file'
+  ENDIF
+#else
+  write(6,*) 'enter name of namelist file'
+  read(5,*) infile
+
+  CALL convert( infile )
+#endif
+
+END PROGRAM scripgrid
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/src/scripgrid_mod.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/src/scripgrid_mod.F90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/src/scripgrid_mod.F90	(revision 2528)
@@ -0,0 +1,764 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module creates grid description files for input to the SCRIP code
+!
+!-----------------------------------------------------------------------
+
+MODULE scripgrid_mod
+
+  USE kinds_mod
+  USE constants
+  USE iounits
+  USE netcdf
+  USE netcdf_mod
+  
+  IMPLICIT NONE
+
+  !-----------------------------------------------------------------------
+  !     module variables that describe the grid
+
+  INTEGER (kind=int_kind), parameter :: &
+       grid_rank = 2,         &
+       grid_corners = 4
+  INTEGER (kind=int_kind) :: nx, ny, grid_size
+  INTEGER (kind=int_kind), dimension(2) :: &
+       grid_dims,    &  ! size of x, y dimensions
+       grid_dim_ids     ! ids of the x, y dimensions
+  INTEGER (kind=int_kind), ALLOCATABLE, DIMENSION(:) :: &
+       grid_imask          ! land-sea mask
+  REAL (kind=int_kind), ALLOCATABLE, DIMENSION(:) :: &
+       grid_center_lat, &  ! lat/lon coordinates for
+       grid_center_lon     ! each grid center in degrees
+  REAL (kind=dbl_kind), ALLOCATABLE, DIMENSION(:,:) :: &
+       grid_corner_lat, &  ! lat/lon coordinates for
+       grid_corner_lon     ! each grid corner in degrees
+  REAL (kind=dbl_kind), ALLOCATABLE, DIMENSION(:,:,:) :: &
+       corner_lon, &
+       corner_lat
+  REAL (kind=dbl_kind), PARAMETER :: circle = 360.0
+
+  !-----------------------------------------------------------------------
+  !     module variables that describe the netcdf file
+
+  INTEGER (kind=int_kind) :: &
+       ncstat,           &   ! general netCDF status variable
+       ncid_in
+
+CONTAINS
+
+  ! ==============================================================================
+  
+  SUBROUTINE convert(nm_in)
+  
+    ! -----------------------------------------------------------------------------
+    ! - input variables
+  
+    CHARACTER(char_len), INTENT(in) ::  &
+      nm_in
+  
+    ! -----------------------------------------------------------------------------
+    ! - local variables
+  
+    CHARACTER(char_len) ::  &
+      nemo_file, input_file, method, input_lon, input_lat, datagrid_file, &
+      nemogrid_file, nemo_lon, nemo_lat, corn_lon, corn_lat, nemo_mask, input_mask
+    INTEGER (kind=int_kind), dimension(2) :: &
+      offset
+    INTEGER (kind=int_kind) :: &
+      iunit, nemo_mask_value, input_mask_value
+  
+    namelist /grid_inputs/ nemo_file, input_file, datagrid_file, nemogrid_file,  &
+                           method, input_lon, input_lat, nemo_lon, nemo_lat,     &
+                           nemo_mask, nemo_mask_value, input_mask, input_mask_value
+  
+    !-----------------------------------------------------------------------
+    ! - namelist describing the processing
+    !   note that mask_value is the minimum good value,
+    !   so that where the mask is less than the value is masked
+
+    nemo_file = "coordinates.nc"
+    nemo_lon = "glamt"
+    nemo_lat = "gphit"
+    input_lon = "lon"
+    input_lat = "lat"
+    input_mask = "none"
+    input_mask_value = 0
+    datagrid_file = 'remap_data_grid.nc'
+    nemogrid_file = 'remap_nemo_grid.nc'
+
+    call get_unit(iunit)
+    open(iunit, file=nm_in, status='old', form='formatted')
+    read(iunit, nml=grid_inputs) 
+    call release_unit(iunit)
+
+    if (trim(nemo_file) .eq. 'coordinates.nc') then
+
+      ! set up the names of the corner variables for a given input
+      ! the offset represents what needs to be added to (i,j) to get to the correct 
+      ! element in the corner arrays to correspond to the point northeast of the center
+      if (nemo_lon(5:5) == "t") then
+        corn_lon = "glamf"
+        corn_lat = "gphif"
+        offset = (/ 0,0 /)
+      else if (nemo_lon(5:5) == "u") then
+        corn_lon = "glamv"
+        corn_lat = "gphiv"
+        offset = (/ 1,0 /)
+      else if (nemo_lon(5:5) == "v") then
+        corn_lon = "glamu"
+        corn_lat = "gphiu"
+        offset = (/ 0,1 /)
+      else
+        write(6,*) 'unknown nemo_lon name'
+        stop
+      endif
+
+      write(6,*) "processing " // trim(nemo_file)
+      call convertNEMO(nemo_file, nemo_lon, nemo_lat, corn_lon, corn_lat, &
+                       offset, nemogrid_file)
+
+    else
+
+      write(6,*) "processing regular grid " // trim(nemo_file)
+      call convertFLUX(nemo_file, nemo_lon, nemo_lat, &
+                       nemo_mask, nemo_mask_value, nemogrid_file)
+
+    endif
+
+    write(6,*) "processing regular grid"
+    call convertFLUX(input_file, input_lon, input_lat, &
+                     input_mask, input_mask_value, datagrid_file)
+
+  END SUBROUTINE convert
+  
+  ! ==============================================================================
+  
+  SUBROUTINE convertNEMO(grid_file_in, cent_lon, cent_lat, corn_lon, corn_lat, &
+                         off, grid_file_out)
+  
+    !-----------------------------------------------------------------------
+    !
+    !     This routine converts a NEMO coordinates.nc file to a remapping grid file.
+    !
+    
+    CHARACTER(char_len), INTENT(in) :: cent_lon, cent_lat, corn_lon, corn_lat
+    INTEGER (kind=int_kind), INTENT(in), DIMENSION(2) :: off
+    CHARACTER(char_len), INTENT(in) :: grid_file_out
+    CHARACTER(char_len), INTENT(in) :: grid_file_in
+
+    !-----------------------------------------------------------------------
+    !     module variables that describe the grid
+  
+    CHARACTER(char_len), parameter ::  &
+         grid_name = 'Remapped NEMO grid for SCRIP'
+  
+    !-----------------------------------------------------------------------
+    !     grid coordinates and masks
+  
+    REAL (kind=dbl_kind), ALLOCATABLE, DIMENSION(:,:) :: &
+         clon, clat, &             ! expanded corner arrays
+         glam, &                   ! center longitude
+         gphi, &                   ! center latitude
+         glamc, &                  ! corner longitude
+         gphic                     ! corner latitude
+  
+    !-----------------------------------------------------------------------
+    !     other local variables
+  
+    INTEGER (kind=int_kind) :: i, j, n, iunit, im1, jm1, imid, isame, ic, jc
+    INTEGER (kind=int_kind) :: varid_lam, varid_phi, varid_lamc, varid_phic
+    INTEGER (kind=int_kind) :: jdim
+    INTEGER (kind=int_kind), dimension(4) :: grid_dimids  ! input fields have 4 dims
+    REAL (kind=dbl_kind) :: tmplon, dxt, dyt
+  
+    !-----------------------------------------------------------------------
+    !     read in grid info
+    !
+    !     For NEMO input grids, assume that variable names are glam, glamc etc.
+    !     Assume that 1st 2 dimensions of these variables are x and y directions.
+    !     These assumptions are made by NEMO, so should be valid for coordinates.nc.
+    !
+    ! write in nf90 calls (without error handling) and then think about 
+    ! making more readable by taking chunks into ncutil
+    !
+  
+    ncstat = nf90_open( grid_file_in, NF90_NOWRITE, ncid_in )
+    call netcdf_error_handler(ncstat)
+  
+    ! find dimids for 'glam'
+    ! use dimids to get dimlengths
+    ! allocate glam array
+    ! get glam from file 
+  
+    ncstat = nf90_inq_varid( ncid_in, cent_lon, varid_lam )
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_inq_varid( ncid_in, corn_lon, varid_lamc )
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_inq_varid( ncid_in, cent_lat, varid_phi )
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_inq_varid( ncid_in, corn_lat, varid_phic )
+    call netcdf_error_handler(ncstat)
+  
+    ncstat = nf90_inquire_variable( ncid_in, varid_lam, dimids=grid_dimids(:) )
+    call netcdf_error_handler(ncstat)
+    DO jdim = 1, SIZE(grid_dims)
+       ncstat = nf90_inquire_dimension( ncid_in, grid_dimids(jdim),  &
+                                        len=grid_dims(jdim) )
+       call netcdf_error_handler(ncstat)
+    END DO
+    nx = grid_dims(1)
+    ny = grid_dims(2)
+    grid_size = nx * ny
+    WRITE(*,FMT='("Input grid dimensions are:",2i6)') nx, ny
+    
+    ! assume that dimensions are all the same as glam
+    ALLOCATE( glam(nx,ny), glamc(nx,ny), gphi(nx,ny), gphic(nx,ny) )
+    ncstat = nf90_get_var( ncid_in, varid_lam, glam(:,:) )
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_get_var( ncid_in, varid_lamc, glamc(:,:) )
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_get_var( ncid_in, varid_phi, gphi(:,:) )
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_get_var( ncid_in, varid_phic, gphic(:,:) )
+    call netcdf_error_handler(ncstat)
+    
+    !-----------------------------------------------------------------------
+    ! - Mask is all ocean for now
+  
+    ALLOCATE( grid_imask(grid_size) )
+    grid_imask(:) = 1
+  
+    !-----------------------------------------------------------------------
+    ! corners are arranged as follows:    4 3
+    !                                     1 2
+    !
+    ! Assume that cyclic grids have 2 wrap columns in coordinates.nc
+    !  (this is the case for ORCA grids)
+    !
+  
+    ! -----------------------------------------------------------------------------
+    ! create a single pair of arrays for the corners where clon(1,1) corresponds
+    ! to the south west corner of a box containing glam(1,1)
+    ! various special cases then apply
+    !   bottom row:  assume clon(:,j) = clon(:,j+1)
+  
+    ALLOCATE ( clon(nx+1,ny+1), clat(nx+1,ny+1) )
+
+    ! first the easy internal points
+    DO j = 2,ny
+      DO i = 2,nx
+        ic = i + off(1) - 1
+        jc = j + off(2) - 1
+        clon(i,j) = glamc(ic,jc)
+        clat(i,j) = gphic(ic,jc)
+      ENDDO
+    ENDDO
+
+    ! then the tricky boundary points
+    imid = (nx-1)/2 + 1
+    DO j = 1,ny+1,ny
+      DO i = 1,nx+1,nx
+        ic = i + off(1) - 1
+        jc = j + off(2) - 1
+        if (ic == 0 .and. jc == 0) then
+          clon(i,j) = glamc(nx,1)
+          clat(i,j) = gphic(nx,1) - (gphic(nx,2)-gphic(nx,1))
+        else if (ic == nx+1 .and. jc == 0) then
+          clon(i,j) = glamc(1,1)
+          clat(i,j) = gphic(1,1) - (gphic(1,2)-gphic(1,1))
+        else if (ic == 0 .and. jc == ny+1) then
+          isame = 2*imid - nx + 1
+          clon(i,j) = glamc(isame,jc-1)
+          clat(i,j) = gphic(isame,jc-1)
+        else if (ic == nx+1 .and. jc == ny+1) then
+          isame = 2*imid
+          clon(i,j) = glamc(isame,jc-1)
+          clat(i,j) = gphic(isame,jc-1)
+        else if (ic == 0) then
+          clon(i,j) = glamc(nx,jc)
+          clat(i,j) = gphic(nx,jc)
+        else if (jc == 0) then
+          clon(i,j) = glamc(ic,1)
+          clat(i,j) = gphic(ic,1) - (gphic(ic,2)-gphic(ic,1))
+        else if (ic == nx+1) then
+          clon(i,j) = glamc(1,jc)
+          clat(i,j) = gphic(1,jc)
+        else if (jc == ny+1) then
+          isame = 2*imid - ic + 1
+          clon(i,j) = glamc(isame,jc-1)
+          clat(i,j) = gphic(isame,jc-1)
+        endif
+      ENDDO
+    ENDDO
+
+    ALLOCATE ( corner_lon(4,nx,ny), corner_lat(4,nx,ny) )
+  
+    ! top-right corner
+    corner_lon(3,:,:) = clon(2:nx+1,2:ny+1)
+    corner_lat(3,:,:) = clat(2:nx+1,2:ny+1)
+  
+    ! top-left corner
+    corner_lon(4,:,:) = clon(1:nx,2:ny+1)
+    corner_lat(4,:,:) = clat(1:nx,2:ny+1)
+  
+    ! bottom-right corner 
+    corner_lon(2,:,:) = clon(2:nx+1,1:ny)
+    corner_lat(2,:,:) = clat(2:nx+1,1:ny)
+  
+    ! bottom-left corner
+    corner_lon(1,:,:) = clon(1:nx,1:ny)
+    corner_lat(1,:,:) = clat(1:nx,1:ny)
+  
+  ! For [N, E, W]-ward extrapolation near the poles, should we use stereographic (or
+  ! similar) projection?  This issue will come for V,F interpolation, and for all
+  ! grids with non-cyclic grids.
+  
+    ! -----------------------------------------------------------------------------
+    !     correct for 0,2pi longitude crossings
+    !      (In practice this means putting all corners into 0,2pi range
+    !       and ensuring that no box corners are miles from each other.
+    !       3pi/2 is used as threshold - I think this is quite arbitrary.)
+  
+    corner_lon(:,:,:) = MODULO( corner_lon(:,:,:), circle )
+    DO n = 2, grid_corners
+       WHERE    ( corner_lon(n,:,:) - corner_lon(n-1,:,:) < -three*circle*0.25 )
+          corner_lon(n,:,:) = corner_lon(n,:,:) + circle
+       ELSEWHERE( corner_lon(n,:,:) - corner_lon(n-1,:,:) >  three*circle*0.25 )
+          corner_lon(n,:,:) = corner_lon(n,:,:) - circle
+       END WHERE
+    END DO
+  
+    ! -----------------------------------------------------------------------------
+    ! - put longitudes on smooth grid 
+  
+ !  call mouldlon(glam,nx,ny)
+ !  call mouldlon(corner_lon(1,:,:),nx,ny)
+ !  call mouldlon(corner_lon(2,:,:),nx,ny)
+ !  call mouldlon(corner_lon(3,:,:),nx,ny)
+ !  call mouldlon(corner_lon(4,:,:),nx,ny)
+
+    ! -----------------------------------------------------------------------------
+    ! - reshape for SCRIP input format
+  
+    ALLOCATE( grid_center_lon(grid_size), grid_center_lat(grid_size) )
+    
+    grid_center_lon(:) = RESHAPE( glam(:,:), (/ grid_size /) )
+    grid_center_lat(:) = RESHAPE( gphi(:,:), (/ grid_size /) )
+  
+    DEALLOCATE( glam, gphi, glamc, gphic )
+  
+    ALLOCATE( grid_corner_lon(4, grid_size), grid_corner_lat(4, grid_size) )
+  
+    grid_corner_lon(:,:) = RESHAPE( corner_lon(:,:,:), (/ 4, grid_size /) )
+    grid_corner_lat(:,:) = RESHAPE( corner_lat(:,:,:), (/ 4, grid_size /) )
+  
+    DEALLOCATE( corner_lon, corner_lat )
+  
+    CALL createSCRIPgrid(grid_file_out, grid_name)
+  
+  END SUBROUTINE convertNEMO
+  
+  ! ==============================================================================
+  
+  SUBROUTINE convertFLUX(grid_file_in, name_lon, name_lat, &
+                         name_mask, value_mask, grid_file_out)
+  
+    !-----------------------------------------------------------------------
+    !
+    !     This routine creates a remapping grid file from an input grid.
+    !
+    !-----------------------------------------------------------------------
+    
+    CHARACTER(char_len), INTENT(in) ::  &
+         grid_file_in, name_lon, name_lat, name_mask, grid_file_out
+    INTEGER (kind=int_kind) :: value_mask
+  
+    !-----------------------------------------------------------------------
+    !     variables that describe the grid
+  
+    CHARACTER(char_len), parameter ::  &
+         grid_name = 'Remapped regular grid for SCRIP'
+  
+    !-----------------------------------------------------------------------
+    !     grid coordinates (note that a flux file just has lon and lat)
+  
+    REAL (kind=dbl_kind), ALLOCATABLE, DIMENSION(:) :: &
+         lam, phi
+    REAL (kind=dbl_kind), ALLOCATABLE, DIMENSION(:,:) :: &
+         glam, &                   ! longitude
+         gphi, &                   ! latitude
+         glamc, &
+         gphic
+    REAL (kind=dbl_kind), ALLOCATABLE, DIMENSION(:,:) :: mask
+  
+    !-----------------------------------------------------------------------
+    !     other local variables
+  
+    INTEGER (kind=int_kind) :: i, j, n, iunit, im1, jm1
+    INTEGER (kind=int_kind) :: varid_lam, varid_phi, varid_mask
+    INTEGER (kind=int_kind) :: jdim, nspace
+    INTEGER (kind=int_kind), dimension(4) :: grid_dimids  ! input fields have 4 dims
+    REAL (kind=dbl_kind) :: tmplon, dxt, dyt
+  
+    !-----------------------------------------------------------------------
+    !     read in grid info
+    !
+    !     For NEMO input grids, assume that variable names are glam, glamc etc.
+    !     Assume that 1st 2 dimensions of these variables are x and y directions.
+    !     These assumptions are made by NEMO, so should be valid for coordinates.nc.
+    !
+    ! write in nf90 calls (without error handling) and then think about 
+    ! making more readable by taking chunks into ncutil
+  
+    ncstat = nf90_open( grid_file_in, NF90_NOWRITE, ncid_in )
+    call netcdf_error_handler(ncstat)
+  
+    ! find dimids for 'glamt'
+    ! use dimids to get dimlengths
+    ! allocate glam array
+    ! get glam from file 
+  
+    ncstat = nf90_inq_varid( ncid_in, name_lat, varid_phi )
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_inq_varid( ncid_in, name_lon, varid_lam )
+    call netcdf_error_handler(ncstat)
+  
+    ncstat = nf90_inquire_variable( ncid_in, varid_lam, ndims=nspace )
+    call netcdf_error_handler(ncstat)
+
+    if (nspace == 1) then
+      ncstat = nf90_inquire_variable( ncid_in, varid_lam, dimids=grid_dimids(:1) )
+      call netcdf_error_handler(ncstat)
+      ncstat = nf90_inquire_variable( ncid_in, varid_phi, dimids=grid_dimids(2:) )
+      call netcdf_error_handler(ncstat)
+      ncstat = nf90_inquire_dimension( ncid_in, grid_dimids(1), len=grid_dims(1) )
+      call netcdf_error_handler(ncstat)
+      ncstat = nf90_inquire_dimension( ncid_in, grid_dimids(2), len=grid_dims(2) )
+      call netcdf_error_handler(ncstat)
+      nx = grid_dims(1)
+      ny = grid_dims(2)
+      grid_size = nx * ny
+      WRITE(*,FMT='("Input grid dimensions are:",2i6)') nx, ny
+    
+      ALLOCATE( lam(nx), phi(ny) )
+      write(6,*) 'double'
+      ncstat = nf90_get_var( ncid_in, varid_lam, lam )
+      call netcdf_error_handler(ncstat)
+      ncstat = nf90_get_var( ncid_in, varid_phi, phi )
+      call netcdf_error_handler(ncstat)
+    
+      ALLOCATE( glam(nx,ny), gphi(nx,ny))
+      write(6,*) shape(lam),shape(phi)
+      glam(:,:) = SPREAD(lam,2,ny)
+      gphi(:,:) = SPREAD(phi,1,nx)
+    else
+
+      ncstat = nf90_inquire_variable( ncid_in, varid_lam, dimids=grid_dimids(:2) )
+      call netcdf_error_handler(ncstat)
+      ncstat = nf90_inquire_dimension( ncid_in, grid_dimids(1), len=grid_dims(1) )
+      call netcdf_error_handler(ncstat)
+      ncstat = nf90_inquire_dimension( ncid_in, grid_dimids(2), len=grid_dims(2) )
+      call netcdf_error_handler(ncstat)
+      nx = grid_dims(1)
+      ny = grid_dims(2)
+      grid_size = nx * ny
+      WRITE(*,FMT='("Input grid dimensions are:",2i6)') nx, ny
+    
+      ALLOCATE( glam(nx,ny), gphi(nx,ny))
+      ncstat = nf90_get_var( ncid_in, varid_lam, glam )
+      call netcdf_error_handler(ncstat)
+      ncstat = nf90_get_var( ncid_in, varid_phi, gphi )
+      call netcdf_error_handler(ncstat)
+
+    endif
+    write(6,*) grid_size,nx,ny
+  
+    ALLOCATE(glamc(0:nx,0:ny), gphic(0:nx,0:ny) )
+
+    ! - for now a simple average to get top right box corners
+    ! - glamc(i,j), gphic(i,j) are top right coordinates of box containing 
+    ! - glam(i,j),gphi(i,j)
+    write(6,*) 'averaging'
+    write(6,*) size(gphic),size(gphi)
+    gphic(1:nx,1:ny-1) = 0.5*(gphi(:,1:ny-1)+gphi(:,2:ny))
+    write(6,*) size(glamc),size(glam)
+    glamc(1:nx-1,1:ny) = 0.5*(glam(1:nx-1,:)+glam(2:nx,:))
+  
+    ! - left and right column of longitudes 
+    write(6,*) 'columns'
+    glamc(nx,1:ny) = 1.5*glam(nx,:)-0.5*glam(nx-1,:)
+    glamc( 0,1:ny) = 1.5*glam(1,:)-0.5*glam(2,:)
+    glamc(nx, 0) = glamc(nx,1)
+    glamc( 0, 0) = glamc( 0,1)
+
+    ! - top and bottom row of latitudes by extrapolation
+    write(6,*) 'rows'
+    gphic(1:nx,ny) = 1.5*gphi(:,ny)-0.5*gphi(:,ny-1)
+    gphic(1:nx, 0) = 1.5*gphi(:,1)-0.5*gphi(:,2)
+    gphic( 0,ny) = gphic(1,ny)
+    gphic( 0, 0) = gphic(1, 0)
+
+    !-----------------------------------------------------------------------
+  
+    write(6,*) 'allocating'
+    ALLOCATE( grid_imask(grid_size) )
+    grid_imask(:) = 1
+    write(6,*) name_mask
+    if (trim(name_mask) /= "none") then
+      write(6,*) 'masking'
+      ncstat = nf90_inq_varid( ncid_in, name_mask, varid_mask )
+      call netcdf_error_handler(ncstat)
+      ALLOCATE( mask(nx,ny) )
+      write(6,*) 'reading mask'
+      ncstat = nf90_get_var( ncid_in, varid_mask, mask )
+      call netcdf_error_handler(ncstat)
+      write(6,*) 'setting mask'
+      WHERE ( RESHAPE(mask(:,:),(/ grid_size /)) < value_mask)
+        grid_imask = 0
+      END WHERE
+      write(6,*) 'masked'
+    END IF
+  
+    !-----------------------------------------------------------------------
+    ! corners are arranged as follows:    4 3
+    !                                     1 2
+  
+    ALLOCATE ( corner_lon(4,nx,ny), corner_lat(4,nx,ny) )
+  
+    ! - bottom-left corner
+    corner_lon(1,:,:) = glamc(0:nx-1, 0:ny-1 )
+    corner_lat(1,:,:) = gphic(0:nx-1, 0:ny-1 )
+  
+    ! - bottom-right corner 
+    corner_lon(2,:,:) = glamc(1:nx, 0:ny-1 )
+    corner_lat(2,:,:) = gphic(1:nx, 0:ny-1 )
+  
+    ! - top-right corner
+    corner_lon(3,:,:) = glamc(1:nx,1:ny)
+    corner_lat(3,:,:) = gphic(1:nx,1:ny)
+    write(6,*) corner_lat(3,nx-2:nx,ny)
+  
+    ! - top-left corner
+    corner_lon(4,:,:) = glamc(0:nx-1, 1:ny )
+    corner_lat(4,:,:) = gphic(0:nx-1, 1:ny )
+  
+  ! For [N, E, W]-ward extrapolation near the poles, should we use stereographic (or
+  ! similar) projection?  This issue will come for V,F interpolation, and for all
+  ! grids with non-cyclic grids.
+  
+    ! -----------------------------------------------------------------------------
+    !     correct for 0,2pi longitude crossings
+    !      (In practice this means putting all corners into 0,2pi range
+    !       and ensuring that no box corners are miles from each other.
+    !       3pi/2 is used as threshold - I think this is quite arbitrary.)
+  
+  ! corner_lon(:,:,:) = MODULO( corner_lon(:,:,:), circle )
+  ! DO n = 2, grid_corners
+  !    WHERE    ( corner_lon(n,:,:) - corner_lon(n-1,:,:) < -three*circle*0.25 )
+  !       corner_lon(n,:,:) = corner_lon(n,:,:) + circle
+  !    ELSEWHERE( corner_lon(n,:,:) - corner_lon(n-1,:,:) >  three*circle*0.25 )
+  !       corner_lon(n,:,:) = corner_lon(n,:,:) - circle
+  !    END WHERE
+  ! END DO
+  
+    ! -----------------------------------------------------------------------------
+    ! - reshape for SCRIP input format
+  
+    ALLOCATE( grid_center_lon(grid_size), grid_center_lat(grid_size) )
+    
+    grid_center_lon(:) = RESHAPE( glam(:,:), (/ grid_size /) )
+    grid_center_lat(:) = RESHAPE( gphi(:,:), (/ grid_size /) )
+  
+    DEALLOCATE( glam, gphi, glamc, gphic )
+  
+    ALLOCATE( grid_corner_lon(4, grid_size), grid_corner_lat(4, grid_size) )
+  
+    grid_corner_lon(:,:) = RESHAPE( corner_lon(:,:,:), (/ 4, grid_size /) )
+    grid_corner_lat(:,:) = RESHAPE( corner_lat(:,:,:), (/ 4, grid_size /) )
+  
+    DEALLOCATE( corner_lon, corner_lat )
+  
+    CALL createSCRIPgrid(grid_file_out, grid_name)
+  
+  END SUBROUTINE convertFLUX
+  
+  ! ==============================================================================
+  
+  SUBROUTINE mouldlon(lon_grid, nx, ny)
+
+    ! -----------------------------------------------------------------------------
+    ! - input variables
+
+    INTEGER, INTENT(in) :: nx, ny
+    REAL (kind=dbl_kind), INTENT(inout), DIMENSION(nx,ny) ::  &
+      lon_grid
+  
+    ! -----------------------------------------------------------------------------
+    ! - local variables
+
+    INTEGER :: ix, iy
+    REAL (kind=dbl_kind), DIMENSION(:,:), ALLOCATABLE ::  &
+      dlon
+    REAL :: step
+
+    ! -----------------------------------------------------------------------------
+    ! - try to eliminate any 360 degree steps in a grid of longitudes
+
+    ALLOCATE(dlon(nx,ny))
+
+    step = 0.75*circle
+    dlon(:,:) = 0
+    dlon(2:,:) = lon_grid(2:,:) - lon_grid(:nx-1,:)
+    WHERE (dlon > -step .AND. dlon < step)
+      dlon = 0.0
+    ELSEWHERE
+      dlon = -SIGN(circle,dlon)
+    END WHERE
+
+    ! - close your eyes this is nasty
+    DO ix = 2,nx
+      dlon(ix,:) = dlon(ix,:) + dlon(ix-1,:)
+    END DO
+    lon_grid = lon_grid + dlon
+
+  END SUBROUTINE mouldlon
+  
+  ! ==============================================================================
+  
+  SUBROUTINE createSCRIPgrid(grid_file_out, grid_name)
+  
+    ! -----------------------------------------------------------------------------
+    ! - input variables
+  
+    CHARACTER(char_len), INTENT(in) ::  &
+         grid_name, grid_file_out
+  
+    ! -----------------------------------------------------------------------------
+    ! - local variables that describe the netcdf file
+  
+    INTEGER (kind=int_kind) :: &
+         nc_grid_id,       &   ! netCDF grid dataset id
+         nc_gridsize_id,   &   ! netCDF grid size dim id
+         nc_gridcorn_id,   &   ! netCDF grid corner dim id
+         nc_gridrank_id,   &   ! netCDF grid rank dim id
+         nc_griddims_id,   &   ! netCDF grid dimensions id
+         nc_grdcntrlat_id, &   ! netCDF grid center lat id
+         nc_grdcntrlon_id, &   ! netCDF grid center lon id
+         nc_grdimask_id,   &   ! netCDF grid mask id
+         nc_gridarea_id,   &   ! netCDF grid area id
+         nc_grdcrnrlat_id, &   ! netCDF grid corner lat id
+         nc_grdcrnrlon_id      ! netCDF grid corner lon id
+  
+    ! -----------------------------------------------------------------------------
+    ! - create netCDF dataset for this grid
+    ! - rewrite in nf90 
+    ! - (bring out functional blocks into ncclear for readability)
+  
+    ncstat = nf90_create (grid_file_out, NF90_CLOBBER, nc_grid_id)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_att (nc_grid_id, NF90_GLOBAL, 'title', grid_name)
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid size dimension
+  
+    ncstat = nf90_def_dim (nc_grid_id, 'grid_size', grid_size, nc_gridsize_id)
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid rank dimension
+  
+    ncstat = nf90_def_dim (nc_grid_id, 'grid_rank', grid_rank, nc_gridrank_id)
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid corner dimension
+  
+    ncstat = nf90_def_dim (nc_grid_id, 'grid_corners', grid_corners, nc_gridcorn_id)
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid dim size array
+  
+    ncstat = nf90_def_var(nc_grid_id, 'grid_dims', NF90_INT, nc_gridrank_id, nc_griddims_id)
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid mask
+  
+    ncstat = nf90_def_var(nc_grid_id, 'grid_imask', NF90_INT, &
+                          nc_gridsize_id, nc_grdimask_id)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_att(nc_grid_id, nc_grdimask_id, 'units', 'unitless')
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid center latitude array
+  
+    ncstat = nf90_def_var(nc_grid_id, 'grid_center_lat', NF90_DOUBLE, &
+                          nc_gridsize_id, nc_grdcntrlat_id)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_att(nc_grid_id, nc_grdcntrlat_id, 'units', 'degrees')
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid center longitude array
+  
+    ncstat = nf90_def_var(nc_grid_id, 'grid_center_lon', NF90_DOUBLE, &
+                          nc_gridsize_id, nc_grdcntrlon_id)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_att(nc_grid_id, nc_grdcntrlon_id, 'units', 'degrees')
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid corner latitude array
+  
+    grid_dim_ids = (/ nc_gridcorn_id, nc_gridsize_id /)
+    ncstat = nf90_def_var(nc_grid_id, 'grid_corner_lat', NF90_DOUBLE, &
+                          grid_dim_ids, nc_grdcrnrlat_id)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_att(nc_grid_id, nc_grdcrnrlat_id, 'units', 'degrees')
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! - define grid corner longitude array
+  
+    ncstat = nf90_def_var(nc_grid_id, 'grid_corner_lon', NF90_DOUBLE, &
+                          grid_dim_ids, nc_grdcrnrlon_id)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_att(nc_grid_id, nc_grdcrnrlon_id, 'units', 'degrees')
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! end definition stage
+  
+    ncstat = nf90_enddef(nc_grid_id)
+    call netcdf_error_handler(ncstat)
+  
+    ! -----------------------------------------------------------------------------
+    ! write grid data
+  
+    ncstat = nf90_put_var(nc_grid_id, nc_griddims_id, grid_dims)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_var(nc_grid_id, nc_grdimask_id, grid_imask)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_var(nc_grid_id, nc_grdcntrlat_id, grid_center_lat)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_var(nc_grid_id, nc_grdcntrlon_id, grid_center_lon)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_var(nc_grid_id, nc_grdcrnrlat_id, grid_corner_lat)
+    call netcdf_error_handler(ncstat)
+    ncstat = nf90_put_var(nc_grid_id, nc_grdcrnrlon_id, grid_corner_lon)
+    call netcdf_error_handler(ncstat)
+  
+    ncstat = nf90_close(nc_grid_id)
+    call netcdf_error_handler(ncstat)
+  
+    DEALLOCATE( grid_imask, grid_center_lon, grid_center_lat, &
+                grid_corner_lon, grid_corner_lat )
+  
+  
+  END SUBROUTINE createSCRIPgrid
+  
+END MODULE scripgrid_mod
+
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/src/scripinterp.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/src/scripinterp.F90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/src/scripinterp.F90	(revision 2528)
@@ -0,0 +1,23 @@
+! ==========================================================================
+
+program scripinterp
+
+  use scripinterp_mod
+
+  character (char_len) ::  nm_in
+#if defined ARGC
+  integer :: iargc
+  external iargc
+
+  if (iargc() == 1) then
+    call getarg(1, nm_in)
+    call process_grid(nm_in)
+  else
+    write(6,*) 'need the name of an input namelist'
+  endif
+#else
+  write(6,*) 'enter the name of an input namelist'
+  read(5,*) nm_in
+#endif
+
+end program scripinterp
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/src/scripinterp_mod.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/src/scripinterp_mod.F90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/src/scripinterp_mod.F90	(revision 2528)
@@ -0,0 +1,1031 @@
+! **************************************************************************
+
+  module scripinterp_mod
+
+! ==========================================================================
+
+  use kinds_mod    ! defines common data types
+  use constants    ! defines common constants
+  use iounits      ! I/O unit manager
+  use netcdf
+  use netcdf_mod   ! netcdf I/O stuff
+  use grids        ! module containing grid info
+  use remap_vars   ! module containing remapping info
+  use remap_mod    ! module containing remapping routines
+  use remap_read   ! routines for reading remap files
+
+  implicit none
+
+  real(kind=dbl_kind), dimension(:), allocatable ::   &
+    grid_out
+
+  integer(kind=int_kind) ::                           &  ! netCDF ids for files and arrays
+          ncstat, nc_outfile_id, nc_infile_id
+  integer (kind=int_kind), dimension(4) ::    &
+      input_dims, input_dimids, input_count
+  real (kind=dbl_kind), dimension(:), allocatable ::   &
+      scale
+  integer (kind=int_kind), dimension(:), allocatable ::        &
+      nc_xysize_id, nc_gridsize_id, nc_gridsize,           &
+      nc_variable_id
+  integer :: nc_lon_id, nc_lat_id, nc_array_id
+
+  character (char_len) ::  &
+          map_name      ! name for mapping from grid1 to grid2
+  character (1), parameter ::  &
+          separator = '|'
+  
+  ! - input namelist variables
+  
+  character (char_len) ::  &
+    input_file,            &  ! filename containing input fields
+    interp_file,           &  ! filename containing remap data (map1)
+    input_name                ! name of variable to grid
+  integer (kind=int_kind), dimension(4) :: &
+    input_stride,  &          ! how much of input array to process
+    input_start,   &          ! where to start
+    input_stop                ! and where to stop
+  character (char_len), dimension(4) ::  &
+    input_vars                ! input variables to be copied
+  
+  ! - output namelist variables
+  
+  character (char_len) ::  &
+    output_file,           &  ! filename for test results
+    output_mode,           &  ! 'create' or 'append'
+    output_name,           &  ! name of new grid variable
+    output_lat,            &  ! as it says
+    output_lon,            &  ! as it says
+    output_ydir               ! choose to invert output arrays in y direction
+  character (char_len), dimension(4) ::  &
+    output_dims,           &    ! name of new grid variable
+    output_vars                 ! variables to copy
+  character (char_len), dimension(10) ::  &
+    output_attributes,     &  ! attributes of stuff in output file
+    output_scaling             ! scaling factor to apply to input data to get
+                               ! correct units in output file
+contains
+
+! ==========================================================================
+
+  subroutine process_grid(nm_in)
+  
+    !-----------------------------------------------------------------------
+    ! - dummy variables
+
+    character (char_len) ::  &
+      nm_in                    ! name of input namelist file
+  
+    !-----------------------------------------------------------------------
+    ! - local variables
+
+    integer (kind=int_kind), dimension(4) ::    &
+        astart, acount, plus_one
+    integer (kind=int_kind), dimension(3) ::    &
+        write_dims
+    integer (kind=int_kind) ::                  &
+      i1, i2, jdim, n, nx, ny, nloop,           &
+      nc_input_id, nc_input_rank,               &
+      vstart, vstride, numv
+
+    real (kind=dbl_kind), dimension(:), allocatable  ::    &
+      grid1_array
+    real (kind=dbl_kind), dimension(:,:), allocatable  ::    &
+      var_out
+
+    plus_one(:) = 1
+
+    !-----------------------------------------------------------------------
+
+    call read_mappings(nm_in)
+
+    !-----------------------------------------------------------------------
+    ! - read input grid
+    ! - WARNING - lots of assumptions here at the moment
+  
+    ncstat = nf90_open( input_file, NF90_NOWRITE, nc_infile_id )
+    call netcdf_error_handler(ncstat,"open")
+  
+    ncstat = nf90_inq_varid( nc_infile_id, input_name, nc_input_id )
+    call netcdf_error_handler(ncstat,"inq_varid")
+  
+    input_dims(:) = 0
+    ncstat = nf90_inquire_variable( nc_infile_id, nc_input_id,   &
+                  ndims=nc_input_rank, dimids=input_dimids(:) )
+    call netcdf_error_handler(ncstat,"inquire_variable")
+
+    do jdim = 1,nc_input_rank
+      ncstat = nf90_inquire_dimension(nc_infile_id,              &
+                    input_dimids(jdim), len=input_dims(jdim) )
+      call netcdf_error_handler(ncstat,"inquire_dimension")
+    enddo
+  
+    ! - dimids seem to be returned in storage order so the outer dimension of 
+    ! - the array as described by the netcdf file becomes the first dimension
+    ! - as far as f90 is concerned (confused? you will be!)
+
+    do jdim = 1,nc_input_rank
+      if (input_stop(jdim) == 0) then
+        input_stop(jdim) = input_dims(jdim)
+      endif
+      input_count(jdim) = input_stop(jdim) - input_start(jdim) + 1
+    enddo
+
+    ! - rashly we assume x followed by y
+    nx = input_dims(1)
+    ny = input_dims(2)
+    write(*,fmt='("Input grid dimensions are:",2i6)') nx, ny
+    if (nx*ny /= grid1_size) then
+      write(6,*) "mismatch between input grid and remap data"
+      stop
+    endif
+
+    ! - calculate number of horizontal slices to process
+    ! - at the moment this is not very general and will only work with 3 dimensions
+
+    acount(1:nc_input_rank) = &
+             (input_stop(1:nc_input_rank)-input_start(1:nc_input_rank)+1) / &
+             input_stride(1:nc_input_rank)
+    nloop = 1
+    do jdim = 1,nc_input_rank
+      nloop = nloop*acount(jdim)
+    enddo
+    nloop = nloop/grid1_size
+    write(6,*) "total slices requested: ",nloop
+
+    vstart = input_start(nc_input_rank)            ! ie extra var has outer dimension
+    vstride = input_stride(nc_input_rank)
+
+    ! - in general we cant read in the whole array so do it slice by slice
+    ! - slow but sure
+
+    write(6,*) "allocating input and output grids"
+    allocate( grid1_array(grid1_size))
+    allocate( grid_out(grid2_size) )
+
+    numv = 0
+    do n = 1,4
+      if (trim(input_vars(n)) /= '-' .and. &
+          trim(output_vars(n)) /= '-') numv = numv + 1
+    enddo
+
+    write_dims(1) = grid2_dims(1)
+    write_dims(2) = grid2_dims(2)
+    write_dims(3) = nloop
+    call define_grid(write_dims(1:3) , 2+numv)
+
+    astart(:) = input_start(:)
+    astart(3) = astart(3) - input_stride(3)
+    acount(:) = 1
+    acount(1) = nx
+    acount(2) = ny
+
+    do n = 1,nloop
+
+      write(6,*) "processing slice: ",n
+      astart(3) = astart(3) + input_stride(3)
+      ncstat = nf90_get_var(nc_infile_id, nc_input_id, grid1_array,  &
+                            start=astart(1:nc_input_rank),              &
+                            count=acount(1:nc_input_rank))
+      call netcdf_error_handler(ncstat,"get_var")
+
+      call calculate_grid(grid1_array, grid_out)
+
+      call write_grid(grid_out, n, write_dims(1:2) , 2)
+
+    enddo
+
+    ! ---------------------------------------------------------------------
+    ! - now for any extra variables to copy
+
+    if (numv > 0) then
+
+      write(6,*) "reading ",numv," extra variables"
+      allocate( var_out(nloop,numv) )
+  
+      do n = 1,numv
+        write(6,*) "looking for variable: ",trim(input_vars(n))
+        ncstat = nf90_inq_varid( nc_infile_id, trim(input_vars(n)), nc_input_id )
+        call netcdf_error_handler(ncstat,"inq_varid")
+      
+        input_dims(:) = 0
+        ncstat = nf90_inquire_variable( nc_infile_id, nc_input_id,   &
+                      ndims=nc_input_rank, dimids=input_dimids(:) )
+        call netcdf_error_handler(ncstat,"inquire_variable")
+  
+        if (nc_input_rank /= 1) then
+          write(6,*) 'sorry, only rank 1 variables can be copied'
+          cycle
+        endif
+        ncstat = nf90_inquire_dimension(nc_infile_id,              &
+                      input_dimids(1), len=input_dims(1) )
+        call netcdf_error_handler(ncstat,"inquire_dimension")
+  
+        ncstat = nf90_get_var(nc_infile_id, nc_input_id, var_out(1:nloop,n),  &
+                              start=(/ vstart /), stride=(/ vstride /))
+        call netcdf_error_handler(ncstat,"get_var")
+      enddo
+  
+      call write_extra(var_out, numv+2)
+      deallocate(var_out)
+
+    endif
+
+    ncstat = nf90_close(nc_outfile_id)
+    call netcdf_error_handler(ncstat,"out close")
+    ncstat = nf90_close(nc_infile_id)
+    call netcdf_error_handler(ncstat,"in close")
+
+    ! ---------------------------------------------------------------------
+
+    deallocate( grid1_array, grid_out)
+
+    ! ---------------------------------------------------------------------
+
+  end subroutine process_grid
+
+  ! ==========================================================================
+
+  subroutine define_grid(thedims, therank)
+
+    !-----------------------------------------------------------------------
+    ! - dummy variables
+    
+    integer (kind=int_kind) :: &
+      therank
+    integer (kind=int_kind), dimension(therank) :: &
+      thedims
+
+    !-----------------------------------------------------------------------
+    ! - local variables
+
+    integer ::               &
+      k, n, ilon, ilat, icolon, i1, i2, natt, nvar, id, jd, kd, nd
+    character (char_len) ::  &
+      aname, vname, att
+    real (kind=dbl_kind) ::   s
+
+    ! - netcdf variables
+
+    integer :: xtype
+
+    !-----------------------------------------------------------------------
+    ! -  define grid size dimensions
+  
+    allocate(nc_xysize_id(grid2_rank))
+    allocate(nc_gridsize_id(therank))
+    allocate(nc_gridsize(therank))
+    allocate(nc_variable_id(therank-2))
+    
+    !-----------------------------------------------------------------------
+    ! - setup a NetCDF file for output
+  
+    xtype = NF90_FLOAT
+
+    write(6,*) 'creating output file'
+    ncstat = nf90_create (output_file, NF90_CLOBBER, nc_outfile_id)
+    call netcdf_error_handler(ncstat,"create")
+  
+    write(6,*) 'setting global attributes'
+    ncstat = nf90_put_att(nc_outfile_id, NF90_GLOBAL, 'title', map_name)
+    call netcdf_error_handler(ncstat,"put_att")
+  
+    write(6,*) 'setting dimensions'
+    do n=1,therank
+      if (n .eq. therank .and. therank .gt. 2) then
+        write(6,*) '    unlimited dim ',trim(output_dims(n)),' size: ',thedims(n)
+        ncstat = nf90_def_dim (nc_outfile_id, output_dims(n), NF90_UNLIMITED, &
+                               nc_gridsize_id(n))
+      else
+        write(6,*) '    dim ',trim(output_dims(n)),' size: ',thedims(n)
+        ncstat = nf90_def_dim (nc_outfile_id, output_dims(n), thedims(n), &
+                               nc_gridsize_id(n))
+      endif
+      call netcdf_error_handler(ncstat,"def_dim")
+    end do
+    nc_gridsize(:) = thedims(1:therank)
+
+    ! - at the moment there is an assumption here that the ordering is (lon,lat)
+
+    ilon = 1
+    ilat = 2
+    nc_xysize_id(1) = nc_gridsize_id(ilon)
+    nc_xysize_id(2) = nc_gridsize_id(ilat)
+
+    ! ----------------------------------------------------------------
+    ! -  define grid center longitude array
+  
+    write(6,*) 'defining longitude variable'
+    ncstat = nf90_def_var (nc_outfile_id, output_lon,   &
+                         xtype, nc_xysize_id,   &
+                         nc_lon_id)
+    call netcdf_error_handler(ncstat,"def_var")
+  
+    ncstat = nf90_put_att (nc_outfile_id, nc_lon_id, 'units', 'degrees')
+    call netcdf_error_handler(ncstat,"put_att")
+  
+    ! ----------------------------------------------------------------
+    ! -  define grid center latitude array
+  
+    write(6,*) 'defining latitude variable'
+    ncstat = nf90_def_var (nc_outfile_id, output_lat,     &
+                         xtype, nc_xysize_id,   &
+                         nc_lat_id)
+    call netcdf_error_handler(ncstat,"def_var")
+  
+    ncstat = nf90_put_att (nc_outfile_id, nc_lat_id, 'units', 'degrees')
+    call netcdf_error_handler(ncstat,"put_att")
+  
+    ! ----------------------------------------------------------------
+    ! -  define copy variables array
+  
+    write(6,*) 'defining copy variables'
+    do n = 3,therank
+      ncstat = nf90_def_var (nc_outfile_id, output_vars(n-2),   &
+                           xtype, nc_gridsize_id(n),    &
+                           nc_variable_id(n-2))
+      call netcdf_error_handler(ncstat,"def_var")
+    enddo
+  
+    ! ----------------------------------------------------------------
+    ! -  define output array
+  
+    write(6,*) 'defining grid variable'
+    ncstat = nf90_def_var (nc_outfile_id, output_name,               &
+                         xtype, nc_gridsize_id,    &
+                         nc_array_id)
+    call netcdf_error_handler(ncstat,"def_var")
+  
+    ! ----------------------------------------------------------------
+    ! - output attributes has to come after all other definitions
+    ! - this code currently a bit murky, needs a rewrite
+  
+    ncstat = nf90_inquire (nc_outfile_id, nVariables=nvar)
+    call netcdf_error_handler(ncstat,"inquire")
+    do n = 1,10
+      att = trim(output_attributes(n))
+      natt = len(att)
+      if (att /= '-') then
+        i1 = index(att,separator)
+        aname = att(1:i1-1)
+        do k = 1,nvar
+          ncstat = nf90_inquire_variable(nc_outfile_id, k, vname)
+          call netcdf_error_handler(ncstat,"inquire_variable")
+          if (vname == aname) then
+            i2 = index(att,separator,.true.)
+            ncstat = nf90_put_att (nc_outfile_id, k, &
+                                   att(i1+1:i2-1), att(i2+1:natt))
+            call netcdf_error_handler(ncstat,"put_att")
+            exit      ! from innermost do
+          endif
+        enddo
+      endif
+    enddo
+  
+    ! output scaling
+
+    allocate (scale(nvar))
+    scale(:) = 1.0
+
+    do n = 1,10
+      att = trim(output_scaling(n))
+      natt = len(att)
+      if (att /= '-') then
+        i1 = index(att,separator)
+        aname = att(1:i1-1)
+        do k = 1,nvar
+          ncstat = nf90_inquire_variable(nc_outfile_id, k, vname)
+          call netcdf_error_handler(ncstat,"inquire_variable")
+          if (vname == aname) then
+            i2 = index(att,separator,.true.)
+            read(att(i2+1:natt),*) scale(k)
+            call netcdf_error_handler(ncstat,"put_att")
+            exit      ! from innermost do
+          endif
+        enddo
+      endif
+    enddo
+  
+    ! ----------------------------------------------------------------
+    ! -  end definition stage
+  
+    ncstat = nf90_enddef(nc_outfile_id)
+    call netcdf_error_handler(ncstat,"enddef")
+ 
+  end subroutine define_grid
+
+  ! ==========================================================================
+
+  subroutine write_grid(thegrid, thelevel, thedims, therank)
+
+    !-----------------------------------------------------------------------
+    ! - dummy variables
+    
+    integer (kind=int_kind), intent(in) :: &
+      therank, thelevel
+    real (kind=dbl_kind), dimension(:), intent(in) ::   &
+      thegrid
+    integer (kind=int_kind), dimension(therank) :: &
+      thedims
+
+    !-----------------------------------------------------------------------
+    ! - local variables
+
+    integer ::               &
+      k, n, ilon, ilat, icolon, j1, j2, dj, natt, nvar, id, jd, kd, nd
+    character (char_len) ::  &
+      aname, vname, att
+    real (kind=dbl_kind), dimension(:,:,:), allocatable ::   &
+      data
+    real (kind=dbl_kind) ::   s
+    real (kind=dbl_kind), parameter :: todeg = 57.295779513082323
+    integer (kind=int_kind), dimension(3) ::   &
+      start
+
+    ! - netcdf variables
+
+    integer :: xtype
+
+    !-----------------------------------------------------------------------
+    ! - write results to NetCDF file
+  
+    allocate (data(thedims(1),thedims(2),1))
+    if (output_ydir .eq. 'invert') then
+      j1 = thedims(2)
+      j2 = 1
+      dj = -1
+    else
+      j1 = 1
+      j2 = thedims(2)
+      dj = 1
+    endif
+
+    if (thelevel .eq. 1) then
+
+      ! -  grid center latitude array
+  
+      write(6,*) 'writing latitude variable'
+      s = scale(nc_lat_id)
+      nd = 0
+      do jd = j1,j2,dj
+        do id =1,thedims(1)
+          nd = nd + 1
+          data(id,jd,1) = s*todeg*grid2_center_lat(nd)
+        enddo
+      enddo
+      ncstat = nf90_put_var(nc_outfile_id, nc_lat_id, data(:,:,1))
+      call netcdf_error_handler(ncstat,"put_var")
+  
+      ! -  grid center longitude array
+  
+      write(6,*) 'writing longitude variable'
+      s = scale(nc_lon_id)
+      nd = 0
+      do jd = j1,j2,dj
+        do id =1,thedims(1)
+          nd = nd + 1
+          data(id,jd,1) = s*todeg*grid2_center_lon(nd)
+        enddo
+      enddo
+      ncstat = nf90_put_var(nc_outfile_id, nc_lon_id, data(:,:,1))
+      call netcdf_error_handler(ncstat,"put_var")
+
+    endif
+
+    !-----------------------------------------------------------------------
+    ! -  new grid
+
+    write(6,*) 'writing grid variable'
+    n = therank
+    s = scale(nc_array_id)
+    nd = 0
+    do jd = j1,j2,dj
+      do id =1,thedims(1)
+        nd = nd + 1
+        data(id,jd,1) = thegrid(nd)
+      enddo
+    enddo
+    write(6,*) 'scaling data '
+    data(:,:,1) = s*data(:,:,1)
+    start(:) = (/ 1, 1, thelevel /)
+    ncstat = nf90_put_var(nc_outfile_id, nc_array_id, data, start)
+    call netcdf_error_handler(ncstat,"put_var")
+    deallocate(data)
+
+  end subroutine write_grid
+
+  ! ==========================================================================
+
+  subroutine write_extra(thevars, therank)
+
+    real (kind=dbl_kind), dimension(:,:), intent(in) ::   &
+      thevars
+    real (kind=dbl_kind), dimension(:), allocatable ::   &
+      thedata
+    integer (kind=int_kind), intent(in) :: &
+      therank
+    real (kind=dbl_kind) ::   s
+    integer :: n
+
+    allocate( thedata(size(thevars,1)) )
+
+    ! -  copy variable arrays
+
+    write(6,*) 'writing copy variables'
+    do n = 3,therank
+      s = scale(nc_variable_id(n-2))
+      thedata(:) = s*thevars(:,n-2)
+      ncstat = nf90_put_var(nc_outfile_id, nc_variable_id(n-2), thedata)
+      call netcdf_error_handler(ncstat,"put_var")
+    enddo
+
+    deallocate( thedata )
+
+  end subroutine write_extra
+
+  ! ==========================================================================
+
+  subroutine close_grid()
+
+  !     close netCDF file
+  
+    write(6,*) 'closing file'
+    ncstat = nf90_close(nc_outfile_id)
+    call netcdf_error_handler(ncstat,"close")
+  
+  end subroutine close_grid
+
+  ! ==========================================================================
+
+  subroutine read_mappings(nm_in)
+
+    !-----------------------------------------------------------------------
+    ! - dummy variables
+
+    character (char_len) ::  &
+      nm_in                    ! name of input namelist file
+  
+    !-----------------------------------------------------------------------
+    ! - local variables
+  
+    character (char_len) ::   &
+              dim_name    ! netCDF dimension name
+  
+    integer (kind=int_kind) ::     &
+        iunit                                                ! unit number for namelist file
+  
+    !-----------------------------------------------------------------------
+    ! - namelist block
+
+    namelist /interp_inputs/ input_file, interp_file, input_name, &
+                             input_stride, input_start, input_stop, &
+                             input_vars
+    namelist /interp_outputs/ output_dims, output_file, output_mode, output_name, &
+                              output_lat, output_lon, output_ydir,  &
+                              output_scaling, output_vars, output_attributes
+  
+    !-----------------------------------------------------------------------
+    ! - read namelist for file and mapping info
+  
+    input_stride(:) = 1
+    input_start(:) = 1
+    input_stop(:) = 0
+    output_scaling(:) = '-'
+    input_vars(:) = '-'
+    output_lon = '-'
+    output_lat = '-'
+    output_vars(:) = '-'
+    output_ydir = 'none'
+    output_attributes(:) = '-'
+
+    call get_unit(iunit)
+    open(iunit, file=nm_in, status='old', form='formatted')
+    read(iunit, nml=interp_inputs)
+    read(iunit, nml=interp_outputs)
+    call release_unit(iunit)
+    write(*,nml=interp_inputs)
+    write(*,nml=interp_outputs)
+    if (trim(output_mode) == "create") then
+      if (trim(output_lon) == '-' .or. trim(output_lat) == '-') then
+        write(6,*) 'if creating, need to supply lon and lat names'
+        stop
+      endif
+    endif
+
+    !-----------------------------------------------------------------------
+    ! - read remapping data
+    ! - via the scrip package this sets variables:
+    !    grid1_size, grid2_size:     sizes of input and output grids
+    !    grid1_mask, grid2_mask:     masks
+    !    grid1_rank, grid2_rank:     ranks
+  
+    call read_remap(map_name, interp_file)
+  
+  end subroutine read_mappings
+
+  ! ==========================================================================
+
+  subroutine calculate_grid(grid1_array, grid2_array)
+
+    !-----------------------------------------------------------------------
+    ! - dummy variables
+
+    real (kind=dbl_kind), intent(in), dimension(:) ::    &
+      grid1_array
+    real (kind=dbl_kind), intent(out), dimension(:) ::    &
+      grid2_array
+
+    !-----------------------------------------------------------------------
+    ! - local variables
+
+    integer (kind=int_kind), dimension(:), allocatable :: &
+        grid1_imask, grid2_imask, grid2_count
+
+    real (kind=dbl_kind), dimension(:), allocatable :: &
+        grid1_tmp,           &
+        grad1_lat,           &
+        grad1_lon,           &
+        grad1_latlon,        &
+        grad1_lat_zero,      &
+        grad1_lon_zero,      &
+        grid2_tmp1,           &
+        grid2_tmp2
+
+    real (kind=dbl_kind) ::  &
+        delew, delns            ! variables for computing bicub gradients
+
+    integer (kind=int_kind) ::                          &
+        i,j,n,imin,imax,idiff,                          &
+        ip1,im1,jp1,jm1,nx,ny,                          &  ! for computing bicub gradients
+        in,is,ie,iw,ine,inw,ise,isw
+
+    logical, parameter :: lat_gradient = .false.
+  
+    write(6,*) 'starting'
+
+    !-----------------------------------------------------------------------
+    ! - allocate arrays
+  
+    allocate (grid1_tmp      (grid1_size),   &
+              grad1_lat      (grid1_size),    &
+              grad1_lon      (grid1_size),    &
+              grad1_lat_zero (grid1_size),    &
+              grad1_lon_zero (grid1_size),    &
+              grid1_imask    (grid1_size),   &
+              grid2_tmp1     (grid2_size),   &
+              grid2_tmp2     (grid2_size),   &
+              grid2_imask    (grid2_size),   &
+              grid2_count    (grid2_size))
+  
+    write(6,*) 'allocated'
+    write(6,*) grid1_size,grid2_size
+
+    grid1_imask(:) = 1
+    grid2_imask(:) = 1
+    where (grid1_mask)
+      grid1_imask = 1
+    elsewhere
+      grid1_imask = 0
+    endwhere
+    where (grid2_mask)
+      grid2_imask = 1
+    elsewhere
+      grid2_imask = 0
+    endwhere
+
+    write(6,*) 'masked'
+
+    grad1_lat_zero = zero
+    grad1_lon_zero = zero
+    nx = input_dims(1)
+    ny = input_dims(2)
+    write(6,*) nx,ny
+  
+    !-----------------------------------------------------------------------
+    ! - if bicubic, we need 3 gradients in logical space
+  
+    if (map_type == map_type_bicubic) then
+  
+      write(6,*) 'bicubic'
+      write(6,*) grid1_size
+
+      allocate (grad1_latlon (grid1_size)) 
+  
+      do n=1,grid1_size
+  
+        grad1_lat(n) = zero
+        grad1_lon(n) = zero
+        grad1_latlon(n) = zero
+  
+!       if (n.ge.8000) write(6,*) 0,grid1_mask(n),nx
+        if (grid1_mask(n)) then
+  
+          delew = half
+          delns = half
+  
+          j = (n-1)/nx + 1
+          i = n - (j-1)*nx
+  
+          ip1 = i+1
+          im1 = i-1
+          jp1 = j+1
+          jm1 = j-1
+  
+          if (ip1 > nx) ip1 = ip1 - nx
+          if (im1 < 1 ) im1 = nx
+          if (jp1 > ny) then
+            jp1 = j
+            delns = one
+          endif
+          if (jm1 < 1 ) then
+            jm1 = j
+            delns = one
+          endif
+  
+          in  = (jp1-1)*nx + i
+          is  = (jm1-1)*nx + i
+          ie  = (j  -1)*nx + ip1
+          iw  = (j  -1)*nx + im1
+  
+          ine = (jp1-1)*nx + ip1
+          inw = (jp1-1)*nx + im1
+          ise = (jm1-1)*nx + ip1
+          isw = (jm1-1)*nx + im1
+  
+          ! -  compute i-gradient
+  
+          if (.not. grid1_mask(ie)) then
+            ie = n
+            delew = one
+          endif
+          if (.not. grid1_mask(iw)) then
+            iw = n
+            delew = one
+          endif
+   
+          grad1_lat(n) = delew*(grid1_array(ie) - grid1_array(iw))
+!         if (n.ge.8000) write(6,*) 1,grad1_lat(n)
+  
+          ! -  compute j-gradient
+  
+          if (.not. grid1_mask(in)) then
+            in = n
+            delns = one
+          endif
+          if (.not. grid1_mask(is)) then
+            is = n
+            delns = one
+          endif
+   
+          grad1_lon(n) = delns*(grid1_array(in) - grid1_array(is))
+!         if (n.ge.8000) write(6,*) 2,grad1_lon(n)
+  
+          ! -  compute ij-gradient
+  
+          delew = half
+          if (jp1 == j .or. jm1 == j) then
+            delns = one
+          else 
+            delns = half
+          endif
+  
+          if (.not. grid1_mask(ine)) then
+            if (in /= n) then
+              ine = in
+              delew = one
+            else if (ie /= n) then
+              ine = ie
+              inw = iw
+              if (inw == n) delew = one
+              delns = one
+            else
+              ine = n
+              inw = iw
+              delew = one
+              delns = one
+            endif
+          endif
+  
+          if (.not. grid1_mask(inw)) then
+            if (in /= n) then
+              inw = in
+              delew = one
+            else if (iw /= n) then
+              inw = iw
+              ine = ie
+              if (ie == n) delew = one
+              delns = one
+            else
+              inw = n
+              ine = ie
+              delew = one
+              delns = one
+            endif
+          endif
+  
+          grad1_lat_zero(n) = delew*(grid1_array(ine) - grid1_array(inw))
+!         if (n.ge.8000) write(6,*) 3,grad1_lat_zero(n)
+  
+          if (.not. grid1_mask(ise)) then
+            if (is /= n) then
+              ise = is
+              delew = one
+            else if (ie /= n) then
+              ise = ie
+              isw = iw
+              if (isw == n) delew = one
+              delns = one
+            else
+              ise = n
+              isw = iw
+              delew = one
+              delns = one
+            endif
+          endif
+  
+          if (.not. grid1_mask(isw)) then
+            if (is /= n) then
+              isw = is
+              delew = one
+            else if (iw /= n) then
+              isw = iw
+              ise = ie
+              if (ie == n) delew = one
+              delns = one
+            else
+              isw = n
+              ise = ie
+              delew = one
+              delns = one
+            endif
+          endif
+  
+          grad1_lon_zero(n) = delew*(grid1_array(ise) - grid1_array(isw))
+          grad1_latlon(n) = delns*(grad1_lat_zero(n) - grad1_lon_zero(n))
+!         if (n.ge.8000) write(6,*) 4,grad1_lon_zero(n),grad1_latlon(n)
+  
+        endif
+      enddo
+  
+      write(6,*) 'remapping'
+      call remap(grid2_array, wts_map1, grid2_add_map1, grid1_add_map1, &
+                 grid1_array, src_grad1=grad1_lat,                    &
+                 src_grad2=grad1_lon, src_grad3=grad1_latlon)
+  
+      print *,'Third order mapping from grid1 to grid2:'
+      print *,'----------------------------------------'
+      print *,'Grid1 min,max: ',minval(grid1_array),maxval(grid1_array)
+      print *,'Grid2 min,max: ',minval(grid2_array  ),maxval(grid2_array  )
+    
+      ! -  Conservation Test
+    
+      print *,'Conservation:'
+      print *,'Grid1 Integral = ',sum(grid1_array*grid1_area*grid1_frac)
+      print *,'Grid2 Integral = ',sum(grid2_array  *grid2_area*grid2_frac)
+    
+    !-----------------------------------------------------------------------
+    ! - a first-order map from grid1 to grid2
+  
+    else if (map_type /= map_type_conserv .AND.map_type /= map_type_bicubic) then
+
+      write(6,*) 'bilinear or conservative'
+  
+      call remap(grid2_array, wts_map1, grid2_add_map1, grid1_add_map1,grid1_array)
+  
+      print *,'First order mapping from grid1 to grid2:'
+      print *,'----------------------------------------'
+      print *,'Grid1 min,max: ',minval(grid1_array),maxval(grid1_array)
+      print *,'Grid2 min,max: ',minval(grid2_array  ),maxval(grid2_array  )
+    
+      ! -  Conservation Test
+    
+      print *,'Conservation:'
+      print *,'Grid1 Integral = ',sum(grid1_array*grid1_area*grid1_frac)
+      print *,'Grid2 Integral = ',sum(grid2_array  *grid2_area*grid2_frac)
+    
+    !-----------------------------------------------------------------------
+    ! - conservative mappings:
+    ! - a second-order map from grid1 to grid2 with only lat grads
+  
+    else if (map_type == map_type_conserv .AND. lat_gradient) then
+  
+      call remap(grid2_array, wts_map1, grid2_add_map1, grid1_add_map1,  &
+                 grid1_array, src_grad1=grad1_lat,src_grad2=grad1_lon_zero) 
+  
+      select case (norm_opt)
+      case (norm_opt_none)
+        grid2_tmp2 = grid2_frac*grid2_area
+        where (grid2_tmp2 /= zero)
+          grid2_array = grid2_array/grid2_tmp2
+        elsewhere
+          grid2_array = zero
+        end where
+      case (norm_opt_frcarea)
+      case (norm_opt_dstarea)
+        where (grid2_frac /= zero)
+          grid2_array = grid2_array/grid2_frac
+        elsewhere
+          grid2_array = zero
+        end where
+      end select
+  
+      print *,'Second order mapping from grid1 to grid2 (lat only):'
+      print *,'----------------------------------------'
+      print *,'Grid1 min,max: ',minval(grid1_array),maxval(grid1_array)
+      print *,'Grid2 min,max: ',minval(grid2_array  ),maxval(grid2_array  )
+  
+      ! -  Conservation Test
+  
+      print *,'Conservation:'
+      print *,'Grid1 Integral = ',sum(grid1_array*grid1_area*grid1_frac)
+      print *,'Grid2 Integral = ',sum(grid2_array*grid2_area*grid2_frac)
+  
+    !-----------------------------------------------------------------------
+    ! - conservative mappings:
+    ! - a second-order map from grid1 to grid2 both gradients
+  
+    else if (map_type == map_type_conserv .AND..NOT. lat_gradient) then
+  
+      call remap(grid2_array,wts_map1,grid2_add_map1,grid1_add_map1,  &
+                 grid1_array, src_grad1=grad1_lat,src_grad2=grad1_lon) 
+  
+      select case (norm_opt)
+      case (norm_opt_none)
+        grid2_tmp2 = grid2_frac*grid2_area
+        where (grid2_tmp2 /= zero)
+          grid2_array = grid2_array/grid2_tmp2
+        elsewhere
+          grid2_array = zero
+        end where
+      case (norm_opt_frcarea)
+      case (norm_opt_dstarea)
+        where (grid2_frac /= zero)
+          grid2_array = grid2_array/grid2_frac
+        elsewhere
+          grid2_array = zero
+        end where
+      end select
+  
+      print *,'Second order mapping from grid1 to grid2:'
+      print *,'-----------------------------------------'
+      print *,'Grid1 min,max: ',minval(grid1_array),maxval(grid1_array)
+      print *,'Grid2 min,max: ',minval(grid2_array  ),maxval(grid2_array  )
+  
+      ! -  Conservation Test
+  
+      print *,'Conservation:'
+      print *,'Grid1 Integral = ',sum(grid1_array*grid1_area*grid1_frac)
+      print *,'Grid2 Integral = ',sum(grid2_array*grid2_area*grid2_frac)
+  
+    endif
+  
+    !-----------------------------------------------------------------------
+    !     calculate some statistics
+  
+    grid2_count = zero
+    grid2_tmp1  = zero
+    grid2_tmp2  = zero
+  
+    print *,'number of sparse matrix entries ',num_links_map1
+    do n=1,num_links_map1
+      grid2_count(grid2_add_map1(n)) = grid2_count(grid2_add_map1(n)) + 1
+      if (wts_map1(1,n) > one .or. wts_map1(1,n) < zero) then
+        grid2_tmp1(grid2_add_map1(n)) = grid2_tmp1(grid2_add_map1(n)) + 1
+        grid2_tmp2(grid2_add_map1(n)) = max(abs(wts_map1(1,n)),grid2_tmp2(grid2_add_map1(n)) )
+      endif
+    end do
+  
+    do n=1,grid2_size
+      if (grid2_tmp1(n) > zero) print *,n,grid2_tmp2(n)
+    end do
+  
+    imin = minval(grid2_count, mask=(grid2_count > 0))
+    imax = maxval(grid2_count)
+    idiff =  (imax - imin)/10 + 1
+    print *,'total number of dest cells ',grid2_size
+    print *,'number of cells participating in remap ',count(grid2_count > zero)
+    print *,'min no of entries/row = ',imin
+    print *,'max no of entries/row = ',imax
+  
+    imax = imin + idiff
+    do n=1,10
+      print *,'num of rows with entries between ',imin,' - ',imax-1,   &
+               count(grid2_count >= imin .and. grid2_count < imax)
+      imin = imin + idiff
+      imax = imax + idiff
+    end do
+  
+    !-----------------------------------------------------------------------
+    ! - deallocate arrays
+  
+    deallocate (grid1_tmp, grad1_lat, grad1_lon,    &
+                grad1_lat_zero, grad1_lon_zero, grid1_imask,     &
+                grid2_tmp1, grid2_tmp2,   &
+                grid2_imask, grid2_count)
+  
+  end subroutine calculate_grid
+
+  ! ==========================================================================
+
+end module scripinterp_mod
+
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/src/scripshape.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/src/scripshape.F90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/src/scripshape.F90	(revision 2528)
@@ -0,0 +1,419 @@
+      PROGRAM scripshape
+!
+! program to take output from the SCRIP weights generator
+! and rearrange the data into a series of 2D fields suitable
+! for reading with iom_get in NEMO configurations using the
+! interpolation on the fly option
+!
+      USE netcdf
+      IMPLICIT none
+      INTEGER    :: ncId, VarId, status
+      INTEGER    :: start(4), count(4)
+      CHARACTER(LEN=1) :: y
+      INTEGER    :: nd, ns, nl, nw, sx, sy, dx, dy
+      INTEGER    :: i, j, k, m, n, smax
+!
+!  ifort -O2 -o scripshape scripshape.f90 \
+!        -I/nerc/packages/netcdfifort/v3.6.0-pl1/include \
+!        -L/nerc/packages/netcdfifort/v3.6.0-pl1/lib -lnetcdf
+!
+!
+      INTEGER(KIND=4), ALLOCATABLE :: src(:)
+      INTEGER(KIND=4), ALLOCATABLE :: dst(:)
+      REAL(KIND=8), ALLOCATABLE :: wgt(:,:)
+      REAL(KIND=8), ALLOCATABLE :: src1(:,:),dst1(:,:),wgt1(:,:)
+      LOGICAL  :: around, verbose
+#if defined ARGC
+      INTEGER(KIND=4) :: iargc
+      EXTERNAL :: iargc
+#endif
+
+      CHARACTER(LEN=256) :: interp_file, output_file, name_file
+      INTEGER            :: ew_wrap
+      NAMELIST /shape_inputs/ interp_file, output_file, ew_wrap
+
+! scripshape requires 1 arguments; the name of the file containing
+! the input namelist.
+! This namelist contains:
+!     the name of the input file containing the weights ! produced by SCRIP in its format;
+!     the name of the new output file which ! is to contain the reorganized fields ready for input to NEMO.
+!     the east-west wrapping of the input grid (-1, 0, 1 and 2 are accepted values)
+!
+! E.g.
+!     interp_file = 'data_nemo_bilin.nc'
+!     output_file = 'weights_bilin.nc'
+!     ew_wrap     = 2
+!
+#if defined ARGC
+      IF (iargc() == 1) THEN
+        CALL getarg(1, name_file)
+      ELSE
+        WRITE(*,*) 'Usage: scripshape namelist_file'
+        STOP
+      ENDIF
+#else
+      WRITE(6,*) 'enter name of namelist file'
+      READ(5,*) name_file
+#endif
+      interp_file = 'none'
+      output_file = 'none'
+      ew_wrap = 0
+      OPEN(12, FILE=name_file, STATUS='OLD', FORM='FORMATTED')
+      READ(12, NML=shape_inputs)
+      CLOSE(12)
+!
+      INQUIRE(FILE = TRIM(interp_file), EXIST=around)
+      IF (.not.around) THEN
+       WRITE(*,*) 'Input file: '//TRIM(interp_file)//' not found'
+       STOP
+      ENDIF
+! 
+      INQUIRE(FILE = TRIM(output_file), EXIST=around)
+      IF (around) THEN
+       WRITE(*,*) 'Output file: '//TRIM(output_file)//' exists'
+       WRITE(*,*) 'Ok to overwrite (y/n)?'
+       READ(5,'(a)') y
+       IF ( y .ne. 'y' .AND. y .ne. 'Y' ) STOP
+      ENDIF
+!
+      verbose = .true.
+!
+! Obtain grid size information from interp_file
+!
+      CALL ncgetsize
+!
+! Allocate array spaces
+!
+      ALLOCATE(src(nl), STAT=status)
+      IF(status /= 0 ) CALL alloc_err('src')
+      ALLOCATE(dst(nl), STAT=status)
+      IF(status /= 0 ) CALL alloc_err('dst')
+      ALLOCATE(wgt(nw,nl), STAT=status)
+      IF(status /= 0 ) CALL alloc_err('wgt')
+      ALLOCATE(src1(dx,dy), STAT=status)
+      IF(status /= 0 ) CALL alloc_err('src1')
+      ALLOCATE(dst1(dx,dy), STAT=status)
+      IF(status /= 0 ) CALL alloc_err('dst1')
+      ALLOCATE(wgt1(dx,dy), STAT=status)
+      IF(status /= 0 ) CALL alloc_err('wgt1')
+!
+! Read all required data from interp_file
+!
+      CALL ncgetfields
+!
+! Check that dst is monotonically increasing
+!
+      DO k = 1,nl-1
+       IF(dst(k+1).lt.dst(k)) THEN
+        WRITE(*,*) 'non-monotonic at ',k
+        WRITE(*,*) dst(k-4:k+16)
+        STOP
+       ENDIF
+      END DO
+!
+! Remove references to the top row of src
+!
+      IF(verbose) WRITE(*,*) &
+        'Removing references to the top row of the source grid'
+      smax = (sy-1)*sx
+      n = 0
+      DO k = 1,nl
+       IF(src(k).gt.smax-1) THEN
+        src(k) = src(k)-sx
+        n = n + 1
+       ENDIF
+      END DO
+      IF(verbose) WRITE(*,*) n,' values changed (',100.*n/nl,'%)'
+!
+! Loop through weights for each corner in turn and
+! rearrange weight fields into separate 2D fields for
+! reading with iom_get in NEMO
+!
+      DO k = 1,nw
+       DO n = 1,4
+
+        i = 0
+        j = 1
+        DO m = n,nl,4
+         i = i+1
+         IF(i.gt.dx) THEN
+          i = 1
+          j = j + 1
+         ENDIF
+         src1(i,j) = src(m)
+         dst1(i,j) = dst(m)
+         wgt1(i,j) = wgt(k,m)
+        END DO
+!
+! Write out this set which will be labelled with
+! a 2 digit number equal to n+4*(k-1)
+!
+        CALL wrwgts
+!   
+       END DO
+      END DO
+      STOP
+      CONTAINS
+!
+!----------------------------------------------------------------------*
+      SUBROUTINE ncgetsize
+!
+! Access grid size information in interp_file and set the
+! following integers:
+!
+!    nd = dst_grid_size
+!    ns = src_grid_size
+!    nl = num_links    
+!    nw = num_wgts     
+! sx,sy = src_grid_dims     
+! dx,dy = dst_grid_dims     
+!
+      INTEGER idims(2)
+!
+       status = nf90_open(interp_file, nf90_NoWrite, ncid)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_inq_dimid(ncid, 'dst_grid_size', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       status = nf90_inquire_dimension(ncid, VarId, LEN = nd)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_inq_dimid(ncid, 'src_grid_size', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       status = nf90_inquire_dimension(ncid, VarId, LEN = ns)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_inq_dimid(ncid, 'num_links', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       status = nf90_inquire_dimension(ncid, VarId, LEN = nl)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_inq_dimid(ncid, 'num_wgts', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       status = nf90_inquire_dimension(ncid, VarId, LEN = nw)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       start = 1
+       count = 2
+       status = nf90_inq_varid(ncid, 'src_grid_dims', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       status = nf90_get_var(ncid, VarId, idims, start, count)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       sx = idims(1) ; sy = idims(2)
+!
+       status = nf90_inq_varid(ncid, 'dst_grid_dims', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       status = nf90_get_var(ncid, VarId, idims, start, count)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+       dx = idims(1) ; dy = idims(2)
+!
+       status = nf90_close(ncid)
+       IF (status /= nf90_noerr) CALL handle_err(status)
+!
+       IF(verbose) THEN
+         WRITE(*,*) 'Detected sizes: '
+         WRITE(*,*) 'dst_grid_size: ', nd
+         WRITE(*,*) 'src_grid_size: ', ns
+         WRITE(*,*) 'num_links    : ', nl
+         WRITE(*,*) 'num_wgts     : ', nw
+         WRITE(*,*) 'src_grid_dims: ', sx, ' x ', sy
+         WRITE(*,*) 'dst_grid_dims: ', dx, ' x ', dy
+       ENDIF
+!
+      END SUBROUTINE ncgetsize
+
+!----------------------------------------------------------------------*
+      SUBROUTINE ncgetfields
+!
+! Read all required data from interp_file. The data read are:
+!
+! netcdf variable    size   internal array
+!-----------------+-------+--------------
+! src_address        nl     src
+! dst_address        nl     dst
+! remap_matrix     (nw,nl)  wgt
+!
+       status = nf90_open(interp_file, nf90_NoWrite, ncid)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_inq_varid(ncid, 'src_address', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! Read the values for src
+       status = nf90_get_var(ncid, VarId, src, &
+                         start = (/ 1 /),      &
+                         count = (/ nl /))
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_inq_varid(ncid, 'dst_address', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! Read the values for dst
+       status = nf90_get_var(ncid, VarId, dst, &
+                         start = (/ 1 /),      &
+                         count = (/ nl /))
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_inq_varid(ncid, 'remap_matrix', VarId)
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! Read the values for wgt
+       status = nf90_get_var(ncid, VarId, wgt, &
+                         start = (/ 1, 1 /),   &
+                         count = (/ nw, nl /))
+       IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+       status = nf90_close(ncid)
+       IF (status /= nf90_noerr) CALL handle_err(status)
+!
+      END SUBROUTINE ncgetfields
+
+!----------------------------------------------------------------------*
+      SUBROUTINE handle_err(status)
+!
+! Simple netcdf error checking routine
+!
+      INTEGER, intent ( in) :: status
+!
+      IF(status /= nf90_noerr) THEN
+       IF(trim(nf90_strerror(status)) .eq. 'Attribute not found') THEN
+! ignore
+       ELSE
+        WRITE(*,*) trim(nf90_strerror(status))
+        STOP "Stopped"
+       END IF
+      END IF
+      END SUBROUTINE handle_err
+
+!----------------------------------------------------------------------*
+      SUBROUTINE alloc_err(arname)
+!
+! Simple allocation error checking routine
+!
+      CHARACTER(LEN=*) :: arname
+!
+      WRITE(*,*) 'Allocation error attempting to ALLOCATE '//arname
+      STOP "Stopped"
+      END SUBROUTINE alloc_err
+
+!                                                                       
+!----------------------------------------------------------------------*
+      SUBROUTINE wrwgts
+!
+! Write out each set of 2D fields to output_file.
+! Each call will write out a set of srcXX, dstXX and wgtXX fields
+! where XX is a two digit number equal to n + 4*(k-1). The first
+! and last calls to this routine initialise and close the output
+! file respectively. The first call is detected when k*n=1 and the
+! last call is detected when k*n=4*nw. The outfile file remains
+! open between the first and last calls. 
+!
+      INTEGER :: status, ncid, ncin
+      INTEGER :: Lontdid, Lattdid
+      INTEGER :: tvid, tvid2, tvid3
+      INTEGER :: ioldfill
+      CHARACTER(LEN=2) :: cs
+      SAVE ncid, Lontdid, Lattdid
+!
+      IF(k*n.eq.1) THEN
+!
+! Create output_file and set the dimensions
+!
+         status = nf90_create(output_file, nf90_Clobber, ncid)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+         status = nf90_set_fill(ncid, nf90_NoFill, ioldfill)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+         status = nf90_def_dim(ncid, "lon", dx, Lontdid)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+         status = nf90_def_dim(ncid, "lat", dy, Lattdid)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+         status = nf90_put_att(ncid, nf90_global, 'ew_wrap', ew_wrap)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+      ELSE
+!
+! Reenter define mode
+!
+         status = nf90_redef(ncid)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+      ENDIF
+!
+      WRITE(cs,'(i2.2)') n + 4*(k-1)
+!
+! Define new variables
+!
+      status = nf90_def_var(ncid, "src"//cs, nf90_double, &
+                         (/ Lontdid, Lattdid /), tvid)
+      IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+      status = nf90_def_var(ncid, "dst"//cs, nf90_double, &
+                         (/ Lontdid, Lattdid /), tvid2)
+      IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+      status = nf90_def_var(ncid, "wgt"//cs, nf90_double, &
+                         (/ Lontdid, Lattdid /), tvid3)
+      IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! Leave define mode
+!
+      status = nf90_enddef(ncid)
+      IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! Write the data
+!
+      status = nf90_put_var(ncid, tvid, src1,    &
+                            start = (/ 1, 1 /),  &
+                            count = (/ dx, dy /) )
+      IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+      status = nf90_put_var(ncid, tvid2, dst1,   &
+                            start = (/ 1, 1 /),  &
+                            count = (/ dx, dy /) )
+      IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+      status = nf90_put_var(ncid, tvid3, wgt1,   &
+                            start = (/ 1, 1  /), &
+                            count = (/ dx, dy /) )
+      IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+      IF(k*n.eq.4*nw) THEN
+!
+! --     Reenter define mode
+!
+         status = nf90_redef(ncid)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! --     Reopen interp_file and transfer some global attributes
+!
+         status = nf90_open(interp_file, nf90_NoWrite, ncin)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+         status = nf90_copy_att(ncin,NF90_GLOBAL,'title',        ncid,NF90_GLOBAL)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+         status = nf90_copy_att(ncin,NF90_GLOBAL,'normalization',ncid,NF90_GLOBAL)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+         status = nf90_copy_att(ncin,NF90_GLOBAL,'map_method',   ncid,NF90_GLOBAL)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+         status = nf90_copy_att(ncin,NF90_GLOBAL,'conventions',  ncid,NF90_GLOBAL)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+         status = nf90_copy_att(ncin,NF90_GLOBAL,'history',      ncid,NF90_GLOBAL)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! --     Close interp_file
+!
+         status = nf90_close(ncin)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+!
+! --     Close output_file
+!
+         status = nf90_close(ncid)
+         IF(status /= nf90_NoErr) CALL handle_err(status)
+      ENDIF
+
+      END SUBROUTINE wrwgts
+      END PROGRAM scripshape
Index: trunk/NEMOGCM/TOOLS/WEIGHTS/src/timers.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/WEIGHTS/src/timers.f90	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/WEIGHTS/src/timers.f90	(revision 2528)
@@ -0,0 +1,343 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!     This module uses F90 cpu time routines to allowing setting of
+!     multiple CPU timers.
+!
+!-----------------------------------------------------------------------
+!
+!     CVS:$Id: timers.f,v 1.2 2000/04/19 21:56:26 pwjones Exp $
+!
+!     Copyright (c) 1997, 1998 the Regents of the University of 
+!       California.
+!
+!     This software and ancillary information (herein called software) 
+!     called SCRIP is made available under the terms described here.  
+!     The software has been approved for release with associated 
+!     LA-CC Number 98-45.
+!
+!     Unless otherwise indicated, this software has been authored
+!     by an employee or employees of the University of California,
+!     operator of the Los Alamos National Laboratory under Contract
+!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
+!     Government has rights to use, reproduce, and distribute this
+!     software.  The public may copy and use this software without
+!     charge, provided that this Notice and any statement of authorship
+!     are reproduced on all copies.  Neither the Government nor the
+!     University makes any warranty, express or implied, or assumes
+!     any liability or responsibility for the use of this software.
+!
+!     If software is modified to produce derivative works, such modified
+!     software should be clearly marked, so as not to confuse it with 
+!     the version available from Los Alamos National Laboratory.
+!
+!***********************************************************************
+
+      module timers
+
+!-----------------------------------------------------------------------
+
+      use kinds_mod
+
+      implicit none
+
+      integer (kind=int_kind), parameter ::   &
+           max_timers = 99  ! max number of timers allowed
+
+      integer (kind=int_kind), save ::  &
+           cycles_max       ! max value of clock allowed by system
+
+      integer (kind=int_kind), dimension(max_timers), save ::  &
+           cycles1,          & ! cycle number at start for each timer
+           cycles2          ! cycle number at stop  for each timer
+
+      real (kind=real_kind), save ::   &
+           clock_rate       ! clock_rate in seconds for each cycle
+
+      real (kind=real_kind), dimension(max_timers), save ::   &
+           cputime          ! accumulated cpu time in each timer
+
+      character (len=8), dimension(max_timers), save ::   &
+           status           ! timer status string
+
+!***********************************************************************
+
+      contains
+
+!***********************************************************************
+
+      subroutine timer_check(timer)
+
+!-----------------------------------------------------------------------
+!
+!     This routine checks a given timer.  This is primarily used to
+!     periodically accumulate time in the timer to prevent timer cycles
+!     from wrapping around max_cycles.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     Input Variables:
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::   &
+          timer            ! timer number
+
+!-----------------------------------------------------------------------
+
+      if (status(timer) .eq. 'running') then
+        call timer_stop (timer)
+        call timer_start(timer)
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine timer_check
+
+!***********************************************************************
+
+      subroutine timer_clear(timer)
+
+!-----------------------------------------------------------------------
+!
+!     This routine resets a given timer.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     Input Variables:
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::   &
+          timer            ! timer number
+
+!-----------------------------------------------------------------------
+
+      cputime(timer) = 0.0_real_kind  ! clear the timer
+
+!-----------------------------------------------------------------------
+
+      end subroutine timer_clear
+
+!***********************************************************************
+
+      function timer_get(timer)
+
+!-----------------------------------------------------------------------
+!
+!     This routine returns the result of a given timer.  This can be
+!     called instead of timer_print so that the calling routine can 
+!     print it in desired format.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     Input Variables:
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::   &
+          timer            ! timer number
+
+!-----------------------------------------------------------------------
+!
+!     Output Variables:
+!
+!-----------------------------------------------------------------------
+
+      real (kind=real_kind) ::   &
+           timer_get   ! accumulated cputime in given timer
+
+!-----------------------------------------------------------------------
+
+      if (status(timer) .eq. 'stopped') then
+        timer_get = cputime(timer)
+      else
+        call timer_stop(timer)
+        timer_get = cputime(timer)
+        call timer_start(timer)
+      endif
+
+!-----------------------------------------------------------------------
+
+      end function timer_get
+
+!***********************************************************************
+
+      subroutine timer_print(timer)
+
+!-----------------------------------------------------------------------
+!
+!     This routine prints the accumulated cpu time in given timer.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     Input Variables:
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::   &
+          timer            ! timer number
+
+!-----------------------------------------------------------------------
+
+      !--- 
+      !--- print the cputime accumulated for timer 
+      !--- make sure timer is stopped
+      !---
+
+      if (status(timer) .eq. 'stopped') then
+        write(*,"(' CPU time for timer',i3,':',1p,e16.8)")   &
+             timer,cputime(timer)
+      else
+        call timer_stop(timer)
+        write(*,"(' CPU time for timer',i3,':',1p,e16.8)")   &
+             timer,cputime(timer)
+        call timer_start(timer)
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine timer_print
+
+!***********************************************************************
+
+      subroutine timer_start(timer)
+
+!-----------------------------------------------------------------------
+!
+!     This routine starts a given timer.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     Input Variables:
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::   &
+          timer            ! timer number
+
+!-----------------------------------------------------------------------
+
+      !---
+      !--- Start the timer and change timer status.
+      !---
+
+      if (status(timer) .eq. 'stopped') then
+        call system_clock(count=cycles1(timer))
+        status(timer) = 'running'
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine timer_start
+
+!***********************************************************************
+
+      subroutine timer_stop(timer)
+
+!-----------------------------------------------------------------------
+!
+!     This routine stops a given timer.
+!
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!
+!     Input Variables:
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind), intent(in) ::   &
+          timer            ! timer number
+
+!-----------------------------------------------------------------------
+
+      if (status(timer) .eq. 'running') then
+
+        !---
+        !--- Stop the desired timer.
+        !---
+
+        call system_clock(count=cycles2(timer))
+
+        !---
+        !--- check and correct for cycle wrapping
+        !---
+
+        if (cycles2(timer) .ge. cycles1(timer)) then
+          cputime(timer) = cputime(timer) + clock_rate*   &
+                           (cycles2(timer) - cycles1(timer))
+        else
+          cputime(timer) = cputime(timer) + clock_rate*   &
+                      (cycles2(timer) - cycles1(timer) + cycles_max)
+        endif
+
+        !---
+        !--- Change timer status.
+        !---
+
+        status(timer)='stopped'
+
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine timer_stop
+
+!***********************************************************************
+
+      subroutine timers_init
+
+!-----------------------------------------------------------------------
+!
+!     This routine initializes some machine parameters necessary for
+!     computing cpu time from F90 intrinsics.
+!
+!-----------------------------------------------------------------------
+
+      integer (kind=int_kind) :: cycles ! count rate return by sys_clock
+
+!-----------------------------------------------------------------------
+
+      !---
+      !--- Initialize timer arrays and clock_rate.
+      !---
+
+      clock_rate = 0.0_real_kind
+      cycles1    = 0
+      cycles2    = 0
+      cputime    = 0.0_real_kind
+      status     = 'stopped'
+
+      !---
+      !--- Call F90 intrinsic system_clock to determine clock rate
+      !--- and maximum cycles.  If no clock available, print message.
+      !---
+
+      call system_clock(count_rate=cycles, count_max=cycles_max)
+
+      if (cycles /= 0) then
+        clock_rate = 1.0_real_kind/real(cycles)
+      else
+        clock_rate = 0.0_real_kind
+        print *, '--- No system clock available ---'
+      endif
+
+!-----------------------------------------------------------------------
+
+      end subroutine timers_init
+
+!***********************************************************************
+
+      end module timers
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Index: trunk/NEMOGCM/TOOLS/maketools
===================================================================
--- trunk/NEMOGCM/TOOLS/maketools	(revision 2528)
+++ trunk/NEMOGCM/TOOLS/maketools	(revision 2528)
@@ -0,0 +1,183 @@
+#!/bin/bash
+#set -x
+set -o posix
+#set -u 
+#set -e
+#+
+#
+# ===============
+# maketools
+# ===============
+#
+# --------------------------
+# Compile NEMO
+# --------------------------
+#
+# SYNOPSIS
+# ========
+#
+# ::
+#
+#  $ maketools
+#
+#
+# DESCRIPTION
+# ===========
+#
+#
+# This script aims :
+#
+# - to choose a tool to compile
+# - to choose compiler options  
+# - to compile this tool
+#
+#  Variables used :
+#
+#  From user input
+#
+# - NEW_CONF    : configuration to be created
+# - CMP_NAM     : compiler name 
+# - NBR_PRC     : number of processes used to compile  
+#
+#  Locally defined :
+#
+# - MAIN_DIR : self explaining
+# - MODELES_DIR :   "    "    " 
+# - TOOLS_DIR   :   "    "    " 
+# - NEMO_DIR    :   "    "    "
+#
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./maketools -t ifort_osx - j3 -n NESTING
+#
+#
+# TODO
+# ====
+#
+# option debug
+#
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id$
+#
+#
+#
+#   * creation
+#
+#-
+
+#- Local variables ---
+b_n=$(basename ${0})
+export MAIN_DIR=${PWD%/TOOLS*}
+export TOOLS_DIR=${MAIN_DIR}/TOOLS
+export COMPIL_DIR=${MAIN_DIR}/TOOLS/COMPILE
+export NEMO_DIR=${MAIN_DIR}/NEMO
+#-
+#- FCM and functions location ---
+export PATH=${MAIN_DIR}/EXTERNAL/fcm/bin:$PATH
+
+#-
+#- Choice of the options ---
+x_n="";
+x_m="";
+x_t="";
+x_c="";
+x_j=1;
+while getopts :hm:n:r:j:t: V
+  do
+	 case $V in
+		(h)  echo "Usage	 : "${b_n} \
+					 " [-h] [-n name] [-m arch] [-j No] [-t tmpdir]";
+			  echo " -h	 : help";
+			  echo " -n name : tool name, [-n help] to list existing tools";
+			  echo " -m arch : choose compiler, [-m help] to list exiting compilers";
+			  echo " -j No	 : number of processes used to compile (0=nocompilation)";
+			  echo " -t dir  : remporary directory for compilation"
+			  echo "";
+			  echo "Example to compile Agrif Nesting tools";
+			  echo "maketools -n NESTING" ;
+			  echo "";
+                          printf "%s\n" "Available tools :" `ls ${TOOLS_DIR}|grep -v COMPILE | grep -v maketools`;
+			  echo "";
+                          . ${COMPIL_DIR}/Flist_archfile.sh  ;
+			  echo "";
+			  echo "Default : previous tool and compiler";
+			  exit 0;;
+		(n)  x_n=${OPTARG};;
+		(m)  x_m=${OPTARG};;
+		(j)  x_j=${OPTARG};;
+		(t)  x_t=${OPTARG};;
+		(:)  echo ${b_n}" : -"${OPTARG}" option : missing value" 1>&2;
+			  exit 2;;
+		(\?) echo ${b_n}" : -"${OPTARG}" option : not supported" 1>&2;
+			  exit 2;;
+	 esac
+  done
+shift $(($OPTIND-1));
+
+#-
+#- Get the clean option
+[[ "${#@}" -ne 0 && "${@}" != clean ]] && echo "Invalid option "$@" " && exit
+[ "${#@}" -ne 0 ] && x_c="--$@"
+
+#-
+#- Go to NEMOGCM/TOOLS directory ---
+cd ${TOOLS_DIR}
+
+#-
+#- Initialisation from input ---
+export NEW_CONF=${x_n}
+NBR_PRC=${x_j}
+CMP_NAM=${x_m}
+NEMO_TDIR=${x_t:-$NEMO_TDIR}
+export NEMO_TDIR=${NEMO_TDIR:-$TOOLS_DIR}
+
+#- Check if the tool or the compiler exist or list it
+[ "${NEW_CONF}" == help ] && printf "%s\n"  "Available tools :" `ls ${TOOLS_DIR}|grep -v COMPILE | grep -v maketools` && exit
+[ "${CMP_NAM}" ==  help ] && . ${COMPIL_DIR}/Flist_archfile.sh && exit
+
+#- When used for the first time, choose a compiler ---
+. ${COMPIL_DIR}/Fcheck_archfile.sh arch_tools.fcm ${CMP_NAM} || exit
+
+#- Choose a default tool if needed ---
+#- REBUILD or last one used ---
+. ${COMPIL_DIR}/Fcheck_config.sh tools.txt ${NEW_CONF} || exit
+
+#- Save new configuration ---
+echo "${NEW_CONF} "  > ${COMPIL_DIR}/tools.txt
+
+#- Make the building directory
+. ${COMPIL_DIR}/Fmake_bld.sh ${TOOLS_DIR} ${NEW_CONF} ${NEMO_TDIR} || exit
+
+#-
+#_ END OF CONFIGURATION PHASE
+#_
+
+#-
+#- Compile ---
+
+if [ "${NBR_PRC}" -gt 0 ]; then
+cd ${NEMO_TDIR}/${NEW_CONF} || cd -
+
+fcm build ${x_c} --ignore-lock -v 1 -j ${NBR_PRC} ${COMPIL_DIR}/bld_tools.cfg || cd -
+if [ -n "$(ls ${NEMO_TDIR}/${NEW_CONF}/BLD/bin/*.exe)" ]; then
+for i in `ls ${NEMO_TDIR}/${NEW_CONF}/BLD/bin/*.exe`
+   do
+      ln -sf ${i}  ${TOOLS_DIR}/${NEW_CONF}/.
+   done
+fi
+fi
+#-
+#- Come back to original directory ---
+cd -
+
+#-
+#- Unset variables
+${COMPIL_DIR}/Fclean_var.sh
+
+exit 0;
